Imported Upstream version 8.8.2upstream/8.8.2

2578 files changed, 124146 insertions, 96135 deletions

diff --git a/.bintray.json b/.bintray.json
new file mode 100644
index 00000000..34a501e8
--- /dev/null
+++ b/.bintray.json
@@ -0,0 +1,20 @@
+{
+    "package": {
+        "name": "coq",
+        "repo": "coq",
+        "subject": "coq"
+    },
+
+    "version": {
+        "name": "8.8.2"
+    },
+
+    "files":
+        [
+        {"includePattern": "_build/(.*\\.dmg)", "uploadPattern": "$1",
+         "matrixParams": {
+             "override": 1 }
+        }
+        ],
+    "publish": true
+}
diff --git a/.gitattributes b/.gitattributes
deleted file mode 100644
index 6af0a106..00000000
--- a/.gitattributes
+++ /dev/null
@@ -1,5 +0,0 @@
-.dir-locals.el export-ignore
-.gitattributes export-ignore
-.gitignore export-ignore
-.mailmap export-ignore
-TODO export-ignore
diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md
new file mode 100644
index 00000000..c9cb516c
--- /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 00000000..a9230042
--- /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/.gitlab-ci.yml b/.gitlab-ci.yml
new file mode 100644
index 00000000..799f5b14
--- /dev/null
+++ b/.gitlab-ci.yml
@@ -0,0 +1,352 @@
+image: "$IMAGE"
+
+stages:
+  - docker
+  - build
+  - test
+
+# some default values
+variables:
+  # Format: $IMAGE-V$DATE [Cache is not used as of today but kept here
+  # for reference]
+  CACHEKEY: "bionic_coq-v8.8-V2018-09-20"
+  IMAGE: "$CI_REGISTRY_IMAGE:$CACHEKEY"
+  # By default, jobs run in the base switch; override to select another switch
+  OPAM_SWITCH: "base"
+  # Used to select special compiler switches such as flambda, 32bits, etc...
+  OPAM_VARIANT: ""
+
+docker-boot:
+  stage: docker
+  image: docker:stable
+  services:
+    - docker:dind
+  before_script: []
+  script:
+    - docker login -u gitlab-ci-token -p "$CI_JOB_TOKEN" "$CI_REGISTRY"
+    - cd dev/ci/docker/bionic_coq/
+    - if docker pull "$IMAGE"; then echo "Image prebuilt!"; exit 0; fi
+    - docker build -t "$IMAGE" .
+    - docker push "$IMAGE"
+  except:
+    variables:
+      - $SKIP_DOCKER == "true"
+  tags:
+    - docker
+
+before_script:
+  - cat /proc/{cpu,mem}info || true
+  - ls -a # figure out if artifacts are around
+  - printenv | sort
+  - declare -A switch_table
+  - switch_table=( ["base"]="$COMPILER" ["edge"]="$COMPILER_EDGE" )
+  - opam switch -y "${switch_table[$OPAM_SWITCH]}$OPAM_VARIANT"
+  - eval $(opam config env)
+  - opam list
+  - opam config list
+
+after_script:
+  - echo "The build completed normally (not a runner failure)."
+
+################ GITLAB CACHING ######################
+# - use artifacts between jobs                       #
+######################################################
+
+# TODO figure out how to build doc for installed Coq
+.build-template: &build-template
+  stage: build
+  artifacts:
+    name: "$CI_JOB_NAME"
+    paths:
+      - _install_ci
+      - config/Makefile
+      - test-suite/misc/universes/all_stdlib.v
+    expire_in: 1 week
+  script:
+    - set -e
+
+    - echo 'start:coq.config'
+    - ./configure -warn-error yes -prefix "$(pwd)/_install_ci" ${COQ_EXTRA_CONF}"$COQ_EXTRA_CONF_QUOTE"
+    - 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
+    - make install-byte
+    - cp bin/fake_ide _install_ci/bin/
+    - echo 'end:coq.install'
+
+    - set +e
+
+# every non build job must set dependencies otherwise all build
+# artifacts are used together and we may get some random Coq. To that
+# purpose, we add a spurious dependency `not-a-real-job` that must be
+# overridden otherwise the CI will fail.
+
+# set dependencies when using
+.test-suite-template: &test-suite-template
+  stage: test
+  dependencies:
+    - not-a-real-job
+  script:
+    - cd test-suite
+    - make clean
+    # careful with the ending /
+    - 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
+    paths:
+      - test-suite/logs
+
+# set dependencies when using
+.validate-template: &validate-template
+  stage: test
+  dependencies:
+    - not-a-real-job
+  script:
+    - 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/
+
+.ci-template: &ci-template
+  stage: test
+  script:
+    - set -e
+    - echo 'start:coq.test'
+    - make -f Makefile.ci -j "$NJOBS" ${TEST_TARGET}
+    - echo 'end:coq.test'
+    - set +e
+  dependencies:
+    - build:base
+  variables: &ci-template-vars
+    TEST_TARGET: "$CI_JOB_NAME"
+
+.ci-template-flambda: &ci-template-flambda
+  <<: *ci-template
+  dependencies:
+    - build:edge+flambda
+  variables:
+    <<: *ci-template-vars
+    OPAM_SWITCH: "edge"
+    OPAM_VARIANT: "+flambda"
+
+.windows-template: &windows-template
+  stage: test
+  artifacts:
+    name: "%CI_JOB_NAME%"
+    paths:
+      - artifacts
+    when: always
+    expire_in: 1 week
+  dependencies: []
+  tags:
+    - windows
+  before_script: []
+  script:
+    - call dev/ci/gitlab.bat
+  only:
+    variables:
+      - $WINDOWS == "enabled"
+
+build:base:
+  <<: *build-template
+  variables:
+    COQ_EXTRA_CONF: "-native-compiler yes -coqide opt -with-doc yes"
+
+# no coqide for 32bit: libgtk installation problems
+build:base+32bit:
+  <<: *build-template
+  variables:
+    OPAM_VARIANT: "+32bit"
+    COQ_EXTRA_CONF: "-native-compiler yes"
+
+build:edge:
+  <<: *build-template
+  variables:
+    OPAM_SWITCH: edge
+    COQ_EXTRA_CONF: "-native-compiler yes -coqide opt"
+
+build:edge+flambda:
+  <<: *build-template
+  variables:
+    OPAM_SWITCH: edge
+    OPAM_VARIANT: "+flambda"
+    COQ_EXTRA_CONF: "-native-compiler yes -coqide opt -flambda-opts "
+    COQ_EXTRA_CONF_QUOTE: "-O3 -unbox-closures"
+
+windows64:
+  <<: *windows-template
+  variables:
+    ARCH: "64"
+
+windows32:
+  <<: *windows-template
+  variables:
+    ARCH: "32"
+  except:
+    - /^pr-.*$/
+
+
+pkg:nix:
+  image: nixorg/nix:latest # Minimal NixOS image which doesn't even contain git
+  stage: test
+  variables:
+    # By default we use coq.cachix.org as an extra substituter but this can be overridden
+    EXTRA_SUBSTITUTERS: https://coq.cachix.org
+    EXTRA_PUBLIC_KEYS: coq.cachix.org-1:Jgt0DwGAUo+wpxCM52k2V+E0hLoOzFPzvg94F65agtI=
+    # The following variables should not be overridden
+    GIT_STRATEGY: none
+    CACHIX_PUBLIC_KEY: cachix.cachix.org-1:eWNHQldwUO7G2VkjpnjDbWwy4KQ/HNxht7H4SSoMckM=
+    NIXOS_PUBLIC_KEY: cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
+
+  dependencies: [] # We don't need to download build artifacts
+  before_script: [] # We don't want to use the shared 'before_script'
+  script:
+    # Use current worktree as tmpdir to allow exporting artifacts in case of failure
+    - export TMPDIR=$PWD
+    # Install Cachix as documented at https://github.com/cachix/cachix
+    - nix-env -if https://github.com/cachix/cachix/tarball/master --substituters https://cachix.cachix.org --trusted-public-keys "$CACHIX_PUBLIC_KEY"
+    # We build an expression rather than a direct URL to not be dependent on
+    # the URL location; we are forced to put the public key of cache.nixos.org
+    # because there is no --extra-trusted-public-key option.
+    - nix-build -E "import (fetchTarball $CI_PROJECT_URL/-/archive/$CI_COMMIT_SHA.tar.gz) {}" -K --extra-substituters "$EXTRA_SUBSTITUTERS" --trusted-public-keys "$NIXOS_PUBLIC_KEY $EXTRA_PUBLIC_KEYS" | if [ ! -z "$CACHIX_SIGNING_KEY" ]; then cachix push coq; fi
+  artifacts:
+    name: "$CI_JOB_NAME.logs"
+    when: on_failure
+    paths:
+      - nix-build-coq.drv-0/*/test-suite/logs
+
+test-suite:base:
+  <<: *test-suite-template
+  dependencies:
+    - build:base
+
+test-suite:base+32bit:
+  <<: *test-suite-template
+  dependencies:
+    - build:base+32bit
+  variables:
+    OPAM_VARIANT: "+32bit"
+
+test-suite:edge:
+  <<: *test-suite-template
+  dependencies:
+    - build:edge
+  variables:
+    OPAM_SWITCH: edge
+
+test-suite:edge+flambda:
+  <<: *test-suite-template
+  dependencies:
+    - build:edge+flambda
+  variables:
+    OPAM_SWITCH: edge
+    OPAM_VARIANT: "+flambda"
+
+validate:base:
+  <<: *validate-template
+  dependencies:
+    - build:base
+
+validate:base+32bit:
+  <<: *validate-template
+  dependencies:
+    - build:base+32bit
+  variables:
+    OPAM_VARIANT: "+32bit"
+
+validate:edge:
+  <<: *validate-template
+  dependencies:
+    - build:edge
+  variables:
+    OPAM_SWITCH: edge
+
+validate:edge+flambda:
+  <<: *validate-template
+  dependencies:
+    - build:edge+flambda
+  variables:
+    OPAM_SWITCH: edge
+    OPAM_VARIANT: "+flambda"
+
+ci-bedrock2:
+  <<: *ci-template
+
+ci-bignums:
+  <<: *ci-template
+
+ci-color:
+  <<: *ci-template-flambda
+
+ci-compcert:
+  <<: *ci-template-flambda
+
+ci-coq-dpdgraph:
+  <<: *ci-template
+
+ci-coquelicot:
+  <<: *ci-template
+
+ci-elpi:
+  <<: *ci-template
+
+ci-equations:
+  <<: *ci-template
+
+ci-fcsl-pcm:
+  <<: *ci-template
+
+ci-fiat-crypto:
+  <<: *ci-template-flambda
+
+ci-fiat-crypto-legacy:
+  <<: *ci-template-flambda
+
+ci-fiat-parsers:
+  <<: *ci-template
+
+ci-flocq:
+  <<: *ci-template
+
+ci-formal-topology:
+  <<: *ci-template-flambda
+
+ci-geocoq:
+  <<: *ci-template-flambda
+
+ci-hott:
+  <<: *ci-template
+
+ci-iris-lambda-rust:
+  <<: *ci-template-flambda
+
+ci-ltac2:
+  <<: *ci-template
+
+ci-math-comp:
+  <<: *ci-template-flambda
+
+ci-quickchick:
+  <<: *ci-template-flambda
+
+ci-mtac2:
+  <<: *ci-template
+
+ci-sf:
+  <<: *ci-template
+
+ci-unimath:
+  <<: *ci-template-flambda
+
+ci-vst:
+  <<: *ci-template-flambda
diff --git a/.mailmap b/.mailmap
deleted file mode 100644
index 51c8778f..00000000
--- a/.mailmap
+++ /dev/null
@@ -1,93 +0,0 @@
-## Coq contributors
-##
-## This file allows joining the different accounts of a same person.
-## Cf for instance: git shortlog -nse. More details via: man git shortlog
-##
-## To avoid spam issues, we use by default a pseudo-email <login@gforge>
-## for all persons that haven't made commits with real emails
-##
-## If you're mentionned here and want to update your information,
-## either amend this file and commit it, or contact the coqdev list
-
-Jim Apple <github.public@jbapple.com>              jbapple <github.public@jbapple.com>
-Bruno Barras <bruno.barras@inria.fr>               barras <barras@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Bruno Barras <bruno.barras@inria.fr>               barras-local <barras-local@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Yves Bertot <bertot@inria.fr>                      bertot <bertot@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Frédéric Besson <frederic.besson@inria.fr>         fbesson <fbesson@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Pierre Boutillier <pierre.boutillier@ens-lyon.org> pboutill <pboutill@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Pierre Boutillier <pierre.boutillier@ens-lyon.org> Pierre <pierre.boutillier@ens-lyon.org>
-Pierre Boutillier <pierre.boutillier@ens-lyon.org> Pierre Boutillier <pierre.boutillier@pps.univ-paris-diderot.fr>
-Xavier Clerc <xavier.clerc@inria.fr>               xclerc <xclerc@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Xavier Clerc <xavier.clerc@inria.fr>               xclerc <xavier.clerc@inria.fr>
-Pierre Corbineau <Pierre.Corbineau@NOSPAM@imag.fr> corbinea <corbinea@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Judicaël Courant <courant@gforge>                  courant <courant@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Pierre Courtieu <Pierre.Courtieu@cnam.fr>          courtieu <courtieu@85f007b7-540e-0410-9357-904b9bb8a0f7>
-David Delahaye <delahaye@gforge>                   delahaye <delahaye@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Maxime Dénès <mail@maximedenes.fr>                 mdenes <mdenes@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Daniel De Rauglaudre <ddr@gforge>                  ddr <ddr@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Olivier Desmettre <desmettr@gforge>                desmettr <desmettr@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Damien Doligez <doligez@gforge>                    doligez <doligez@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Jean-Christophe Filliâtre <Jean-Christophe.Filliatre@lri.fr> filliatr <filliatr@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Jean-Christophe Filliâtre <Jean-Christophe.Filliatre@lri.fr> Jean-Christophe Filliatre <Jean-Christophe.Filliatre@lri.fr>
-Julien Forest <julien.forest@ensiie.fr>            jforest <jforest@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Julien Forest <julien.forest@ensiie.fr>            forest <jforest@mourvedre.ensiie.fr>
-Julien Forest <julien.forest@ensiie.fr>            jforest <jforest@thune>
-Julien Forest <julien.forest@ensiie.fr>            jforest <jforest@daneel.lan.home>
-Stéphane Glondu <steph@glondu.net>                 glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Stéphane Glondu <steph@glondu.net>                 Stephane Glondu <steph@glondu.net>
-Benjamin Grégoire <benjamin.gregoire@inria.fr>     Benjamin Gregoire <Benjamin.Gregoire@inria.fr>
-Benjamin Grégoire <benjamin.gregoire@inria.fr>     bgregoir <bgregoir@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Benjamin Grégoire <benjamin.gregoire@inria.fr>     gregoire <gregoire@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Jason Gross <jgross@mit.edu>                       Jason Gross <t-jagro@microsoft.com>
-Jason Gross <jgross@mit.edu>                       Jason Gross <jasongross9@gmail.com>
-Vincent Gross <vgross@gforge>                      vgross <vgross@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Huang Guan-Shieng <huang@gforge>                   huang <huang@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Hugo Herbelin <Hugo.Herbelin@inria.fr>             herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Tom Hutchinson <thutchin@gforge>                   thutchin <thutchin@85f007b7-540e-0410-9357-904b9bb8a0f7>
-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>
-Marc Lasson <marc.lasson@gmail.com>                mlasson <marc.lasson@gmail.com>
-Pierre Letouzey <pierre.letouzey@inria.fr>         letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Assia Mahboubi <assia.mahboubi@inria.fr>           amahboub <amahboub@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Evgeny Makarov <emakarov@gforge>                   emakarov <emakarov@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Gregory Malecha <gmalecha@eecs.harvard.edu>        Gregory Malecha <gmalecha@cs.harvard.edu>
-Gregory Malecha <gmalecha@eecs.harvard.edu>        Gregory Malecha <gmalecha@gmail.com>
-Lionel Elie Mamane <lmamane@gforge>                lmamane <lmamane@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Claude Marché <marche@gforge>                      marche <marche@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Micaela Mayero <mayero@gforge>                     mayero <mayero@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Guillaume Melquiond <guillaume.melquiond@inria.fr> gmelquio <gmelquio@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Alexandre Miquel <miquel@gforge>                   miquel <miquel@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Benjamin Monate <monate@gforge>                    monate <monate@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Julien Narboux <jnarboux@gforge>                   jnarboux <jnarboux@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Julien Narboux <jnarboux@gforge>                   narboux <narboux@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Jean-Marc Notin <notin@gforge>                     notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty <notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Jean-Marc Notin <notin@gforge>                     notin <notin@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Russel O'Connor <roconnor@gforge>                  roconnor <roconnor@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Christine Paulin <cpaulin@gforge>                  cpaulin <cpaulin@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Christine Paulin <cpaulin@gforge>                  mohring <mohring@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> ppedrot <ppedrot@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Loïc Pottier <pottier@gforge>                      pottier <pottier@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Matthias Puech <puech@gforge>                      puech <puech@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Yann Régis-Gianas <yrg@pps.univ-paris-diderot.fr>  regisgia <regisgia@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr>
-Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> Daniel De Rauglaudre <ddr@gforge>
-Clément Renard <clrenard@gforge>                   clrenard <clrenard@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Claudio Sacerdoti Coen <sacerdot@gforge>           sacerdot <sacerdot@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Vincent Siles <vsiles@gforge>                      vsiles <vsiles@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Elie Soubiran <soubiran@gforge>                    soubiran <soubiran@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Matthieu Sozeau <mattam@mattam.org>                msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Matthieu Sozeau <mattam@mattam.org>                Matthieu Sozeau <matthieu.sozeau@inria.fr>
-Arnaud Spiwack <arnaud@spiwack.net>                aspiwack <aspiwack@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Enrico Tassi <Enrico.Tassi@inria.fr>               gareuselesinge <gareuselesinge@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Enrico Tassi <Enrico.Tassi@inria.fr>               Enrico Tassi <enrico.tassi@inria.fr>
-Enrico Tassi <Enrico.Tassi@inria.fr>               Enrico Tassi <gares@fettunta.org>
-Laurent Théry <laurent.thery@inria.fr>             thery <thery@85f007b7-540e-0410-9357-904b9bb8a0f7>
-Laurent Théry <laurent.thery@inria.fr>             thery <thery@sophia.inria.fr>
-Benjamin Werner <werner@gforge>                    werner <werner@85f007b7-540e-0410-9357-904b9bb8a0f7>
-
-# Anonymous accounts
-
-anonymous < >                                      coq <coq@85f007b7-540e-0410-9357-904b9bb8a0f7>
-anonymous < >                                      (no author) <(no author)@85f007b7-540e-0410-9357-904b9bb8a0f7>
-anonymous < >                                      serpyc <serpyc@85f007b7-540e-0410-9357-904b9bb8a0f7>
diff --git a/.merlin b/.merlin
index 24226a91..d60f5037 100644
--- a/.merlin
+++ b/.merlin
@@ -1,17 +1,17 @@
-FLG -rectypes -thread
+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,8 +30,16 @@ S parsing
 B parsing
 S stm
 B stm
+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
@@ -40,4 +48,7 @@ B tools/coqdoc
 S dev
 B dev
 
-PKG threads.posix
+S plugins/**
+B plugins/**
+
+PKG threads.posix camlp5
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 00000000..f20599ed
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,235 @@
+dist: trusty
+
+# Travis builds are slower using sudo: false (the container-based
+# infrastructure) as of March 2017; see
+# https://github.com/coq/coq/pull/467 for some discussion.
+sudo: required
+
+# Until Ocaml becomes a language, we set a known one.
+language: c
+
+cache:
+  apt: true
+  directories:
+  - $HOME/.opam
+
+before_cache:
+  - rm -rf ~/.opam/log/
+
+addons:
+  apt:
+    sources:
+    - avsm
+## 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.07.0"
+  - DUNE_VER=".1.0.0"
+  - CAMLP5_VER=".6.14"
+  - CAMLP5_VER_BE=".7.06"
+  - FINDLIB_VER=".1.4.1"
+  - FINDLIB_VER_BE=".1.8.0"
+  - LABLGTK="lablgtk.2.18.3 conf-gtksourceview.2"
+  - LABLGTK_BE="lablgtk.2.18.6 conf-gtksourceview.2"
+  - NATIVE_COMP="yes"
+  - COQ_DEST="-local"
+  - MAIN_TARGET="world"
+
+matrix:
+
+  include:
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="test-suite" COMPILER="4.02.3+32bit"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="validate"                           TW="travis_wait"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="validate"   COMPILER="4.02.3+32bit" TW="travis_wait"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="validate"   COMPILER="${COMPILER_BE}+flambda" CAMLP5_VER="${CAMLP5_VER_BE}" EXTRA_CONF="-flambda-opts -O3" FINDLIB_VER="${FINDLIB_VER_BE}"
+    - 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-equations"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-flocq"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-hott"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-ltac2"
+
+    - env:
+      - TEST_TARGET="lint"
+      install: []
+      before_script: []
+      addons:
+      apt:
+        sources: []
+        packages: []
+      script:
+        - dev/lint-repository.sh
+
+    # Full Coq test-suite with two compilers
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="sphinx test-suite"
+      - EXTRA_CONF="-coqide opt"
+      - EXTRA_OPAM="hevea ${LABLGTK}"
+      before_install: &sphinx-install
+      - sudo pip3 install bs4 sphinx sphinx_rtd_theme pexpect antlr4-python3-runtime sphinxcontrib-bibtex
+      addons:
+        apt:
+          sources:
+          - avsm
+          packages: &extra-packages
+          - opam
+          - aspcud
+          - libgtk2.0-dev
+          - libgtksourceview2.0-dev
+          - python3
+          - python3-pip
+          - python3-setuptools
+
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="sphinx test-suite"
+      - COMPILER="${COMPILER_BE}"
+      - FINDLIB_VER="${FINDLIB_VER_BE}"
+      - CAMLP5_VER="${CAMLP5_VER_BE}"
+      - EXTRA_CONF="-coqide opt"
+      - EXTRA_OPAM="hevea ${LABLGTK_BE}"
+      before_install: *sphinx-install
+      addons:
+        apt:
+          sources:
+          - avsm
+          packages: *extra-packages
+
+    # Full test-suite with flambda
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="sphinx test-suite"
+      - COMPILER="${COMPILER_BE}+flambda"
+      - FINDLIB_VER="${FINDLIB_VER_BE}"
+      - CAMLP5_VER="${CAMLP5_VER_BE}"
+      - EXTRA_CONF="-coqide opt -flambda-opts -O3"
+      - EXTRA_OPAM="hevea ${LABLGTK_BE}"
+      before_install: *sphinx-install
+      addons:
+        apt:
+          sources:
+          - avsm
+          packages: *extra-packages
+
+    - os: osx
+      env:
+      - TEST_TARGET="test-suite"
+      - COMPILER="${COMPILER_BE}"
+      - FINDLIB_VER="${FINDLIB_VER_BE}"
+      - CAMLP5_VER="${CAMLP5_VER_BE}"
+      - NATIVE_COMP="no"
+      - COQ_DEST="-local"
+      before_install:
+      - brew update
+      - brew unlink python
+      - brew install gnu-time
+      # only way to continue using OPAM 1.2
+      - brew install https://raw.githubusercontent.com/Homebrew/homebrew-core/d156edeeed7291f4bc1e08620b331bbd05d52b78/Formula/opam.rb
+
+    - if: NOT (type = pull_request)
+      os: osx
+      osx_image: xcode7.3
+      env:
+      - TEST_TARGET=""
+      - COMPILER="${COMPILER_BE}"
+      - FINDLIB_VER="${FINDLIB_VER_BE}"
+      - CAMLP5_VER="${CAMLP5_VER_BE}"
+      - NATIVE_COMP="no"
+      - COQ_DEST="-prefix ${PWD}/_install"
+      - EXTRA_CONF="-coqide opt -warn-error yes"
+      - EXTRA_OPAM="${LABLGTK_BE}"
+      before_install:
+      - brew update
+      - brew unlink python
+      - brew install gnu-time gtk+ expat gtksourceview gdk-pixbuf
+      # only way to continue using OPAM 1.2
+      - brew install https://raw.githubusercontent.com/Homebrew/homebrew-core/d156edeeed7291f4bc1e08620b331bbd05d52b78/Formula/opam.rb
+      - brew unlink python@2
+      - brew install python3
+      - pip3 install macpack
+      before_deploy:
+        - dev/build/osx/make-macos-dmg.sh
+      deploy:
+      - provider: bintray
+        user: maximedenes
+        file: .bintray.json
+        key:
+          secure: "gUvXWwWR0gicDqsKOnBfe45taToSFied6gN8tCa5IOtl6E6gFoHoPZ83ZWXQsZP50oMDFS5eji0VQAFGEbOsGrTZaD9Y9Jnu34NND78SWL1tsJ6nHO3aCAoMpB0N3+oRuF6S+9HStU6KXWqgj+GeU4vZ4TOlG01RGctJa6U3vII="
+        skip_cleanup: true
+        on:
+          all_branches: true
+
+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 --allow-unauthenticated; fi
+- opam init -j ${NJOBS} --compiler=${COMPILER} -n -y
+- opam switch "$COMPILER" && opam update
+- eval $(opam config env)
+- opam config list
+- opam install -j ${NJOBS} -y num ocamlfind${FINDLIB_VER} camlp5${CAMLP5_VER} ${EXTRA_OPAM}
+- opam list
+
+script:
+
+- set -e
+- echo 'Configuring Coq...' && echo -en 'travis_fold:start:coq.config\\r'
+- ./configure ${COQ_DEST} -warn-error yes -native-compiler ${NATIVE_COMP} ${EXTRA_CONF}
+- echo -en 'travis_fold:end:coq.config\\r'
+
+- echo 'Building Coq...' && echo -en 'travis_fold:start:coq.build\\r'
+- make -j ${NJOBS} ${MAIN_TARGET}
+- echo -en 'travis_fold:end:coq.build\\r'
+
+- echo 'Running tests...' && echo -en 'travis_fold:start:coq.test\\r'
+- if [ -n "${TEST_TARGET}" ]; then ${TW} make -j ${NJOBS} ${TEST_TARGET}; fi
+- echo -en 'travis_fold:end:coq.test\\r'
+- set +e
+
+# Testing Gitter webhook
+notifications:
+  webhooks:
+    urls:
+      - https://webhooks.gitter.im/e/3cdabdec318214c7cd63
+    on_success: change  # options: [always|never|change] default: always
+    on_failure: always  # options: [always|never|change] default: always
+    on_start: never     # options: [always|never|change] default: always
diff --git a/CHANGES b/CHANGES
index 3cb0eaa2..ab63d8ec 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,538 @@
+Changes from 8.8.1 to 8.8.2
+===========================
+
+Documentation
+
+- A PDF version of the reference manual is available once again.
+
+Tools
+
+- The coq-makefile targets `print-pretty-timed`, `print-pretty-timed-diff`,
+  and `print-pretty-single-time-diff` now correctly label the "before" and
+  "after" columns, rather than swapping them.
+
+Kernel
+
+- The kernel does not tolerate capture of global universes by
+  polymorphic universe binders, fixing a soundness break (triggered
+  only through custom plugins)
+
+Windows installer
+
+- The Windows installer now includes many more external packages that can be
+individually selected for installation.
+
+Many other bug fixes and lots of documentation improvements (for details,
+see the 8.8.2 milestone at https://github.com/coq/coq/milestone/15?closed=1).
+
+Changes from 8.8.0 to 8.8.1
+===========================
+
+Kernel
+
+- Fix a critical bug with cofixpoints and vm_compute/native_compute (#7333).
+- Fix a critical bug with modules and algebraic universes (#7695)
+- Fix a critical bug with inlining of polymorphic constants (#7615).
+- Fix a critical bug with universe polymorphism and vm_compute (#7723). Was
+  present since 8.5.
+
+Notations
+
+- Fixed unexpected collision between only-parsing and only-printing
+  notations (issue #7462).
+
+Windows installer
+
+- The Windows installer now includes external packages Ltac2 and Equations
+  (it included the Bignums package since 8.8+beta1).
+
+Many other bug fixes, documentation improvements (including fixes of
+regressions due to the Sphinx migration), and user message improvements
+(for details, see the 8.8.1 milestone at
+https://github.com/coq/coq/milestone/13?closed=1).
+
+Changes from 8.8+beta1 to 8.8.0
+===============================
+
+Tools
+
+- Asynchronous proof delegation policy was fixed. Since version 8.7
+  Coq was ignoring previous runs and the -async-proofs-delegation-threshold
+  option did not have the expected behavior.
+
+Tactic language
+
+- The undocumented "nameless" forms `fix N`, `cofix N` have been
+  deprecated; please use `fix/cofix ident N` to explicitely name
+  hypothesis to be introduced.
+
+Documentation
+
+- The reference manual is now fully ported to Sphinx.
+
+Other small deprecations and bug fixes.
+
+Changes from 8.7.2 to 8.8+beta1
+===============================
+
+Kernel
+
+- Support for template polymorphism for definitions was removed. May trigger
+  more "universe inconsistency" errors in rare occasions.
+- Fixpoints are no longer allowed on non-recursive inductive types.
+
+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.
+- 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
+
+- On Linux, "native_compute" calls can be profiled using the "perf"
+  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.
+- A bug fixed in "rewrite H in *" and "rewrite H in * |-" may cause a
+  few rare incompatibilities (it was unintendedly recursively
+  rewriting in the side conditions generated by H).
+- Added tactics "assert_succeeds tac" and "assert_fails tac" to ensure
+  properties of the executation of a tactic without keeping the effect
+  of the execution.
+- `vm_compute` now supports existential variables.
+- Calls to `shelve` and `give_up` within calls to tactic `refine` now working.
+- Deprecated tactic `appcontext` was removed.
+
+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.
+  The `Focus` and `Unfocus` commands are now deprecated.
+
+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.
+- Using “Require� inside a section is deprecated.
+- An experimental command "Show Extraction" allows to extract the content
+  of the current ongoing proof (grant wish #4129).
+- Coercion now accepts the type of its argument to be "Prop" or "Type".
+- The "Export" modifier can now be used when setting and unsetting options, and
+  will result in performing the same change when the module corresponding the
+  command is imported.
+- The `Axiom` command does not automatically declare axioms as instances when
+  their type is a class. Previous behavior can be restored using `Set
+  Typeclasses Axioms Are Instances`.
+
+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.
+- Inference of universe constraints with cumulative inductive types
+  produces more general constraints. Unsetting new option Cumulativity
+  Weak Constraints produces even more general constraints (but may
+  produce too many universes to be practical).
+- Fix #5726: Notations that start with `Type` now support universe instances
+  with `@{u}`.
+- `with Definition` now understands universe declarations
+  (like `@{u| Set < u}`).
+
+Tools
+
+- Coq can now be run with the option -mangle-names to change the auto-generated
+  name scheme. This is intended to function as a linter for developments that
+  want to be robust to changes in auto-generated names. This feature is experimental,
+  and may change or disappear without warning.
+- GeoProof support was removed.
+
+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.
+
+coqdep
+
+- Learned to read -I, -Q, -R and filenames from _CoqProject files.
+  This is used by coq_makefile when generating dependencies for .v
+  files (but not other files).
+
+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.
+- Documentation: a large community effort resulted in the migration
+  of the reference manual to the Sphinx documentation tool. The result
+  is partially integrated in this version.
+
+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.
+- Added [Coq.Strings.String.concat] to concatenate a list of strings
+  inserting a separator between each item
+- Notation `'` for Zpos in QArith was removed.
+
+- Some deprecated aliases are now emitting warnings when used.
+
+Compatibility support
+
+- Support for compatibility with versions before 8.6 was dropped.
+
+Options
+
+- The following deprecated options have been removed:
+
+  + `Refolding Reduction`
+  + `Standard Proposition Elimination`
+  + `Dependent Propositions Elimination`
+  + `Discriminate Introduction`
+  + `Shrink Abstract`
+  + `Tactic Pattern Unification`
+  + `Intuition Iff Unfolding`
+  + `Injection L2R Pattern Order`
+  + `Record Elimination Schemes`
+  + `Match Strict`
+  + `Tactic Compat Context`
+  + `Typeclasses Legacy Resolution`
+  + `Typeclasses Module Eta`
+  + `Typeclass Resolution After Apply`
+
+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
+
+- New tactic "extensionality in H" which applies (possibly dependent)
+  functional extensionality in H supposed to be a quantified equality
+  until giving a bare equality.
+- New tactic "inversion_sigma" which turns equalities of dependent
+  pairs (e.g., "existT P x p = existT P y q", frequently left over by
+  "inversion" on a dependent type family) into pairs of equalities
+  (e.g., a hypothesis "H : x = y" and a hypothesis of type "rew H in p
+  = q"); these hypotheses can subsequently be simplified using
+  "subst", without ever invoking any kind of axiom asserting
+  uniqueness of identity proofs. If you want to explicitly specify the
+  hypothesis to be inverted, or name the generated hypotheses, you can
+  invoke "induction H as [H1 H2] using eq_sigT_rect".  The tactic also
+  works for "sig", "sigT2", and "sig2", and there are similar
+  "eq_sig*_rect" induction lemmas.
+- Tactic "specialize with ..." now accepts any partial bindings.
+  Missing bindings are either solved by unification or left quantified
+  in the hypothesis.
+- New representation of terms that statically ensure stability by
+  evar-expansion. This has several consequences.
+  * In terms of performance, this adds a cost to every term destructuration,
+    but at the same time most eager evar normalizations were removed, which
+    couterbalances this drawback and even sometimes outperforms the old
+    implementation. For instance, many operations that would require O(n)
+    normalization of the term are now O(1) in tactics. YMMV.
+  * This triggers small changes in unification, which was not evar-insensitive.
+    Most notably, the new implementation recognizes Miller patterns that were
+    missed before because of a missing normalization step. Hopefully this should
+    be fairly uncommon.
+- Tactic "auto with real" can now discharge comparisons of literals.
+- The types of variables in patterns of "match" are now
+  beta-iota-reduced after type-checking. This has an impact on the
+  type of the variables that the tactic "refine" introduces in the
+  context, producing types a priori closer to the expectations.
+- In "Tactic Notation" or "TACTIC EXTEND", entry "constr_with_bindings"
+  now uses type classes and rejects terms with unresolved holes, like
+  entry "constr" does. To get the former behavior use
+  "open_constr_with_bindings" (possible source of incompatibility).
+- New e-variants eassert, eenough, epose proof, eset, eremember, epose
+  which behave like the corresponding variants with no "e" but turn
+  unresolved implicit arguments into existential variables, on the
+  shelf, rather than failing.
+- Tactic injection has become more powerful (closes BZ#4890) and its
+  documentation has been updated.
+- New variants of the `first` and `solve` tacticals that do not rely
+  on parsing rules, meant to define tactic notations.
+- Added support for side effects hooks in `cbv`, `cbn` and `simpl`.
+  The side effects are provided via a plugin:
+  https://github.com/herbelin/reduction-effects/
+- It is now possible to take hint database names as parameters in a
+  Ltac definition or a Tactic Notation.
+- New option `Set Ltac Batch Debug` on top of `Set Ltac Debug` for
+  non-interactive Ltac debug output.
+
+Gallina
+
+- Now supporting all kinds of binders, including 'pat, in syntax of record fields.
+
+Vernacular Commands
+
+- Goals context can be printed in a more compact way when `Set
+  Printing Compact Contexts` is activated.
+- Unfocused goals can be printed with the `Set Printing Unfocused`
+  option.
+- `Print` now shows the types of let-bindings.
+- The compatibility options for printing primitive projections
+  (`Set Printing Primitive Projection Parameters` and
+  `Set Printing Primitive Projection Compatibility`) are now off by default.
+- Possibility to unset the printing of notations in a more fine grained
+  fashion than `Unset Printing Notations` is provided without any
+  user-syntax. The goal is that someone creates a plugin to experiment
+  such a user-syntax, to be later integrated in Coq when stabilized.
+- `About` now tells if a reference is a coercion.
+- The deprecated `Save` vernacular and its form `Save Theorem id` to
+  close proofs have been removed from the syntax. Please use `Qed`.
+- `Search` now sorts results by relevance (the relevance metric is a
+  weighted sum of number of distinct symbols and size of the term).
+
+Standard Library
+
+- New file PropExtensionality.v to explicitly work in the axiomatic
+  context of propositional extensionality.
+- New file SetoidChoice.v axiomatically providing choice over setoids,
+  and, consequently, choice of representatives in equivalence classes.
+  Various proof-theoretic characterizations of choice over setoids in
+  file ChoiceFacts.v.
+- New lemmas about iff and about orders on positive and Z.
+- New lemmas on powerRZ.
+- Strengthened statement of JMeq_eq_dep (closes BZ#4912).
+- The BigN, BigZ, BigZ libraries are no longer part of the Coq standard
+  library, they are now provided by a separate repository
+    https://github.com/coq/bignums
+  The split has been done just after the Int31 library.
+
+- IZR (Reals) has been changed to produce a compact representation of
+  integers. As a consequence, IZR is no longer convertible to INR and
+  lemmas such as INR_IZR_INZ should be used instead.
+- Real constants are now represented using IZR rather than R0 and R1;
+  this might cause rewriting rules to fail to apply to constants.
+- Added new notation {x & P} for sigT (without a type for x)
+
+Plugins
+
+- The Ssreflect plugin is now distributed with Coq. Its documentation has
+  been integrated as a chapter of the reference manual. This chapter is
+  work in progress so feedback is welcome.
+- 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
+
+- Support for camlp4 has been removed.
+
+Tools
+
+- coq_makefile was completely redesigned to improve its maintainability and
+  the extensibility of generated Makefiles, and to make _CoqProject files
+  more palatable to IDEs.  Overview:
+  * _CoqProject files contain only Coq specific data (i.e. the list of
+    files, -R options, ...)
+  * coq_makefile translates _CoqProject to Makefile.conf and copies in the
+    desired location a standard Makefile (that reads Makefile.conf)
+  * Makefile extensions can be implemented in a Makefile.local file (read
+    by the main Makefile) by installing a hook in the extension points
+    provided by the standard Makefile
+  The current version contains code for retro compatibility that prints
+  warnings when a deprecated feature is used.  Please upgrade your _CoqProject
+  accordingly.
+  * Additionally, coq_makefile-made Makefiles now support experimental timing
+    targets `pretty-timed`, `pretty-timed-before`, `pretty-timed-after`,
+    `print-pretty-timed-diff`, `print-pretty-single-time-diff`,
+    `all.timing.diff`, and the variable `TIMING=1` (or `TIMING=before` or
+    `TIMING=after`); see the documentation for more details.
+
+Build Infrastructure
+
+- Note that 'make world' does not build the bytecode binaries anymore.
+  For that, you can use 'make byte' (and 'make install-byte' afterwards).
+  Warning: native and byte compilations should *not* be mixed in the same
+  instance of 'make -j', otherwise both ocamlc and ocamlopt might race for
+  access to the same .cmi files. In short, use "make -j && make -j byte"
+  instead of "make -j world byte".
+
+Universes
+
+- Cumulative inductive types. see prefixes "Cumulative", "NonCumulative"
+  for inductive definitions and the option "Set Polymorphic Inductive Cumulativity"
+  in the reference manual.
+- New syntax `foo@{_}` to instantiate a polymorphic definition with
+  anonymous universes (can also be used with `Type`).
+
+XML Protocol and internal changes
+
+See dev/doc/changes.txt
+
+Many bugfixes including BZ#1859, BZ#2884, BZ#3613, BZ#3943, BZ#3994,
+BZ#4250, BZ#4709, BZ#4720, BZ#4824, BZ#4844, BZ#4911, BZ#5026, BZ#5233,
+BZ#5275, BZ#5315, BZ#5336, BZ#5360, BZ#5390, BZ#5414, BZ#5417, BZ#5420,
+BZ#5439, BZ#5449, BZ#5475, BZ#5476, BZ#5482, BZ#5501, BZ#5507, BZ#5520,
+BZ#5523, BZ#5524, BZ#5553, BZ#5577, BZ#5578, BZ#5589, BZ#5597, BZ#5598,
+BZ#5607, BZ#5618, BZ#5619, BZ#5620, BZ#5641, BZ#5648, BZ#5651, BZ#5671.
+
+Many bugfixes on OS X and Windows (now the test-suite passes on these
+platforms too).
+
+Many optimizations.
+
+Many documentation improvements.
+
+Changes from 8.6 to 8.6.1
+=========================
+
+- Fix #5380: Default colors for CoqIDE are actually applied.
+- Fix plugin warnings
+- Document named evars (including Show ident)
+- Fix Bug #5574, document function scope
+- Adding a test case as requested in bug 5205.
+- Fix Bug #5568, no dup notation warnings on repeated module imports
+- Fix documentation of Typeclasses eauto :=
+- Refactor documentation of records.
+- Protecting from warnings while compiling 8.6
+- Fixing an inconsistency between configure and configure.ml
+- Add test-suite checks for coqchk with constraints
+- Fix bug #5019 (looping zify on dependent types)
+- 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
+- Fixing #5522 (anomaly with free vars of pat)
+- Fix bug #5526, don't check for nonlinearity in notation if printing only
+- Fix bug #5255
+- Fix bug #3659: -time should understand multibyte encodings.
+- FIx bug #5300: Anomaly: Uncaught exception Not_found" in "Print Assumptions".
+- Fix outdated description in RefMan.
+- Repairing `Set Rewriting Schemes`
+- Fixing #5487 (v8.5 regression on ltac-matching expressions with evars).
+- Fix description of command-line arguments for Add (Rec) LoadPath
+- Fix bug #5377: @? patterns broken.
+- add XML protocol doc
+- Fix anomaly when doing [all:Check _.] during a proof.
+- Correction of bug #4306
+- Fix #5435: [Eval native_compute in] raises anomaly.
+- Instances should obey universe binders even when defined by tactics.
+- Intern names bound in match patterns
+- funind: Ignore missing info for current function
+- Do not typecheck twice the type of opaque constants.
+- 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
+- Run non-tactic comands without resilient_command
+- Univs: fix bug #5365, generation of u+k <= v constraints
+- make `emit' tail recursive
+- Don't require printing-only notation to be productive
+- Fix the way setoid_rewrite handles bindings.
+- Fix for bug 5244 - set printing width ignored when given enough space
+- Fix bug 4969, autoapply was not tagging shelved subgoals correctly
+
 Changes from V8.6beta1 to V8.6
 ==============================
 
@@ -2116,7 +2651,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
@@ -2693,11 +3228,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
 
@@ -2710,18 +3245,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
new file mode 100644
index 00000000..213b8773
--- /dev/null
+++ b/CONTRIBUTING.md
@@ -0,0 +1,69 @@
+# Contributing to Coq
+
+Thank you for your interest in contributing to Coq! There are many ways to contribute, and we appreciate all of them.
+
+## Bug Reports
+
+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 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.
+
+When it applies, it's extremely helpful for bug reports to include sample code, and much better if the code is self-contained and complete. It's not necessary to minimize your bug or identify precisely where the issue is, since someone else can often do this if you include a complete example. We tend to include the code in the bug description itself, but if you have a very large input file then you can add it as an attachment.
+
+If you want to minimize your bug (or help minimize someone else's) for more extra credit, then you can use the [Coq bug minimizer](https://github.com/JasonGross/coq-tools) (specifically, the bug minimizer is the `find-bug.py` script in that repo).
+
+## Pull requests
+
+If you want to contribute a bug fix or feature yourself, pull requests on the [GitHub repository](https://github.com/coq/coq) are the way to contribute directly to the Coq implementation. We recommend you create a fork of the repository on GitHub and push your changes to a new "topic branch" in that fork. From there you can follow the [GitHub pull request documentation](https://help.github.com/articles/about-pull-requests/) to get your changes reviewed and pulled into the Coq source repository.
+
+Documentation for getting started with the Coq sources is located in various files in [`dev/doc`](/dev/doc) (for example, [debugging.md](/dev/doc/debugging.md)). For further help with the Coq sources, feel free to join the [Coq Gitter chat](https://gitter.im/coq/coq) and ask questions.
+
+Please make pull requests against the `master` branch.
+
+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.
+
+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 fc4b7baa..00000000
--- 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 c6848648..7d9dfb49 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,28 @@ 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)
+  Clément Pit-Claudel (MIT, 2015-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 df9e8552..bb41e490 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,6 +1,6 @@
 
-            INSTALLATION PROCEDURES FOR THE COQ V8.6 SYSTEM
-            -----------------------------------------------
+            INSTALLATION PROCEDURE
+            ----------------------
 
 
 WHAT DO YOU NEED ?
@@ -27,27 +27,52 @@ WHAT DO YOU NEED ?
 
      port install coq
 
-   To compile Coq V8.6 yourself, you need:
+   To compile Coq yourself, you need:
 
-   - Objective Caml version 4.01.0 or later
-     (available at http://caml.inria.fr/)
+   - OCaml (version >= 4.02.3)
+     (available at https://ocaml.org/)
+     (This version of Coq has been tested up to OCaml 4.07.0)
 
-   - Findlib (included in OCaml binary distribution under windows,
-     probably available in your distribution and for sure at
-     http://projects.camlcity.org/projects/findlib.html)
+   - The Num package, which used to be part of the OCaml standard library,
+     if you are using an OCaml version >= 4.06.0
 
-   - Camlp5 (version >= 6.02) (Coq compiles with Camlp4 but might be
-     less well supported, for instance, Objective Caml version 4.02.1
-     is then needed or a patched version of 4.01.0 as e.g. version
-     4.01.0-4 in Debian Jessie)
+   - Findlib (version >= 1.4.1)
+     (available at http://projects.camlcity.org/projects/findlib.html)
+
+   - 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
+
+   Note that num, camlp5 and lablgtk should be properly registered with
+   findlib/ocamlfind as Coq's makefile will use it to locate the
+   libraries during the build.
+
+   Opam (https://opam.ocaml.org/) is recommended to install OCaml and
+   the corresponding packages.
+
+   $ opam install num ocamlfind camlp5 lablgtk conf-gtksourceview
+
+   should get you a reasonable OCaml environment to compile Coq.
+
+   Nix users can also get all the required dependencies by running:
 
+   $ nix-shell
+
+   Advanced users may want to experiment with the OCaml Flambda
+   compiler as way to improve the performance of Coq. In order to
+   profit from Flambda, a special build of the OCaml compiler that has
+   the Flambda optimizer enabled must be installed. For OPAM users,
+   this amounts to installing a compiler switch ending in `+flambda`,
+   such as `4.07.0+flambda`. For other users, YMMV. Once `ocamlopt
+   -config` reports that Flambda is available, some further
+   optimization options can be used; see the entry about -flambda-opts
+   below for more details.
 
 QUICK INSTALLATION PROCEDURE.
 =============================
@@ -55,29 +80,26 @@ QUICK INSTALLATION PROCEDURE.
 1. ./configure
 2. make
 3. make install (you may need superuser rights)
-4. make clean
-
 
 INSTALLATION PROCEDURE IN DETAILS (NORMAL USERS).
 =================================================
 
-1- Check that you have the Objective Caml compiler installed on your
+1- Check that you have the OCaml compiler installed on your
    computer and that "ocamlc" (or, better, its native code version
    "ocamlc.opt") lies in a directory which is present in your $PATH
    environment variable. At the time of writing this sentence, all
-   versions of Objective Caml later or equal to 4.01.0 are
-   supported to the exception of Objective Caml 4.02.0.
+   versions of Objective Caml later or equal to 4.02.3 are
+   supported.
 
    To get Coq in native-code, (it runs 4 to 10 times faster than
    bytecode, but it takes more time to get compiled and the binary is
    bigger), you will also need the "ocamlopt" (or its native code version
    "ocamlopt.opt") command.
 
-2- Check that you have Camlp5 (or a supported Camlp4) installed on your
-   computer and that the command "camlp5" lies in a directory which
-   is present in your $PATH environment variable path.
-   (You need Camlp5/4 in both bytecode and native versions if
-   your platform supports it).
+2- Check that you have Camlp5 installed on your computer and that the
+   command "camlp5" lies in a directory which is present in your $PATH
+   environment variable path.  (You need Camlp5 in both bytecode and
+   native versions if your platform supports it).
 
 3- The uncompression and un-tarring of the distribution file gave birth
    to a directory named "coq-8.xx". You can rename this directory and put
@@ -128,14 +150,38 @@ 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; for maximum performance 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 OCaml >= 4.07.0.
+
+        c.f. https://caml.inria.fr/mantis/view.php?id=7630
+
 5- Still in the root directory, do
 
 	make
 
-   to compile Coq in Objective Caml bytecode (and native-code if supported).
+   to compile Coq in the best OCaml mode available (native-code if supported,
+   bytecode otherwise).
 
    This will compile the entire system. This phase can take more or less time,
-   depending on your architecture and is fairly verbose.
+   depending on your architecture and is fairly verbose. On a multi-core machine,
+   it is recommended to compile in parallel, via make -jN where N is your number
+   of cores.
 
 6- You can now install the Coq system. Executables, libraries, manual pages
    and emacs mode are copied in some standard places of your system, defined at
@@ -145,13 +191,20 @@ INSTALLATION PROCEDURE IN DETAILS (NORMAL USERS).
        	make install
 
    Of course, you may need superuser rights to do that.
-   To use the Coq emacs mode you also need to put the following lines
-   in you .emacs file:
 
-        (setq auto-mode-alist (cons '("\\.v$" . coq-mode) auto-mode-alist))
-        (autoload 'coq-mode "gallina" "Major mode for editing Coq vernacular." t)
+7- Optionally, you could build the bytecode version of Coq via:
+
+        make byte
+
+   and install it via
 
-7- You can now clean all the sources. (You can even erase them.)
+        make install-byte
+
+  This version is quite slower than the native code version of Coq, but could
+  be helpful for debugging purposes. In particular, coqtop.byte embeds an OCaml
+  toplevel accessible via the Drop command.
+
+8- You can now clean all the sources. (You can even erase them.)
 
 	make clean
 
@@ -169,16 +222,10 @@ INSTALLATION PROCEDURE FOR ADVANCED USERS.
    Then compile the sources as described in step 5 above. The resulting
    binaries will reside in the subdirectory bin/.
 
-   If you want to compile the sources for debugging (i.e. with the option
-   -g of the Caml compiler) then add the -debug option at configuration
-   step :
-
-	./configure -debug <other options>
-
-   and then compile the sources (step 5). Then you must make a Coq toplevel
-   including your own tactics, which must be compiled with -g, with coqmktop.
-   See the chapter 16 of the Coq Reference Manual for details about how
-   to use coqmktop and the Objective Caml debugger with Coq.
+   Unless you pass the -nodebug option to ./configure, the -g option of the
+   OCaml compiler will be used during compilation to allow debugging.
+   See the debugging file in dev/doc and the chapter 15 of the Coq Reference
+   Manual for details about how to use the OCaml debugger with Coq.
 
 
 THE AVAILABLE COMMANDS.
@@ -189,11 +236,14 @@ THE AVAILABLE COMMANDS.
 	coqtop		The Coq toplevel
 	coqc		The Coq compiler
 
-   Under architecture where ocamlopt is available, there are actually two
-   binaries for the interactive system, coqtop.byte and coqtop (respectively
-   bytecode and native code versions of Coq).  coqtop is a link to coqtop.byte
-   otherwise. coqc also invokes the fastest version of Coq.  Options -opt and
-   -byte to coqtop and coqc selects a particular binary.
+   Under architecture where ocamlopt is available, coqtop is the native code
+   version of Coq. On such architecture, you could additionally request
+   the build of the bytecode version of Coq via 'make byte' and install it via
+   'make install-byte'. This will create  an extra binary named coqtop.byte,
+   that could be used for debugging purpose. If native code isn't available,
+   coqtop.byte is directly built by 'make', and coqtop is a link to coqtop.byte.
+   coqc also invokes the fastest version of Coq. Options -opt and -byte to coqtop
+   and coqc selects a particular binary.
 
     * `coqtop' launches Coq in the interactive mode. By default it loads
       basic logical definitions and tactics from the Init directory.
@@ -211,8 +261,6 @@ THE AVAILABLE COMMANDS.
    directory, or read online on http://coq.inria.fr/doc/)
    and in the corresponding manual pages.
 
-   There is also a tutorial and a FAQ; see http://coq.inria.fr/getting-started
-
 
 COMPILING FOR DIFFERENT ARCHITECTURES.
 ======================================
diff --git a/INSTALL.doc b/INSTALL.doc
index 2472d2b2..f8a08528 100644
--- a/INSTALL.doc
+++ b/INSTALL.doc
@@ -22,25 +22,42 @@ To produce all the documents, the following tools are needed:
   - dvips
   - bibtex
   - makeindex
-  - fig2dev (transfig)
-  - convert (ImageMagick)
   - hevea
-  - hacha
+  - Python 3
+  - Sphinx 1.6.5 (http://www.sphinx-doc.org/en/stable/)
+  - sphinx_rtd_theme
+  - pexpect
+  - beautifulsoup4
+  - Antlr4 runtime for Python 3
 
 
-Under Debian based operating systems (Debian, Ubuntu, ...) a
-working set of packages for compiling the documentation for Coq is:
+Under recent Debian based operating systems (Debian 10 "Buster",
+Ubuntu 18.04, ...) a working set of packages for compiling the
+documentation for Coq is:
 
-  texlive texlive-latex-extra texlive-math-extra texlive-fonts-extra
-  texlive-humanities texlive-pictures latex-xcolor hevea transfig
-  imagemagick
+  texlive-latex-extra texlive-fonts-recommended hevea python3-sphinx
+  python3-pexpect python3-sphinx-rtd-theme python3-bs4
+  python3-sphinxcontrib.bibtex python3-pip
 
+Then, install the Python3 Antlr4 package:
+
+  pip3 install antlr4-python3-runtime
+
+Nix users should get the correct development environment to build the
+Sphinx documentation from Coq's `default.nix`. [Note Nix setup doesn't
+include the LaTeX packages needed to build the full documentation.]
+
+If you are in an older/different distribution you can install the
+Python packages required to build the user manual using python3-pip:
+
+  pip3 install sphinx sphinx_rtd_theme beautifulsoup4 antlr4-python3-runtime pexpect sphinxcontrib-bibtex
 
 Compilation
 -----------
 
 To produce all documentation about Coq, just run:
 
+   ./configure            (if you hadn't already)
    make doc
 
 
@@ -55,8 +72,8 @@ Alternatively, you can use some specific targets:
    make doc-html
         to produce all html documents
 
-   make refman
-        to produce all formats of the reference manual
+   make sphinx
+        to produce the HTML version of the reference manual
 
    make tutorial
         to produce all formats of the tutorial
@@ -71,6 +88,10 @@ Alternatively, you can use some specific targets:
         to produce all formats of the Coq standard library
 
 
+Also note the "-with-doc yes" option of ./configure to enable the
+build of the documentation as part of the default make target.
+
+
 Installation
 ------------
 
diff --git a/INSTALL.ide b/INSTALL.ide
index cb7ca325..c4da8404 100644
--- a/INSTALL.ide
+++ b/INSTALL.ide
@@ -22,7 +22,7 @@ Else, read the rest of this document to compile your own CoqIde.
 
 COMPILATION REQUIREMENTS
 
-- OCaml >= 4.01 with native threads support.
+- OCaml >= 4.02.3 with native threads support.
 - make world must succeed.
 - The graphical toolkit GTK+ 2.x. See http://www.gtk.org.
   The official supported version is at least 2.24.x.
@@ -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 5be69d5f..30bfdd67 100644
--- a/META.coq
+++ b/META.coq
@@ -1,5 +1,7 @@
+# TODO: Generate automatically with Dune
+
 description = "The Coq Proof Assistant Plugin API"
-version = "8.6"
+version = "8.8"
 
 directory = ""
 requires = "camlp5"
@@ -7,61 +9,67 @@ requires = "camlp5"
 package "config" (
 
   description = "Coq Configuration Variables"
-  version     = "8.6"
+  version     = "8.8"
 
   directory   = "config"
 
 )
 
+package "clib" (
+  description = "Base General Coq Library"
+  version     = "8.8"
+
+  directory   = "clib"
+  requires    = "num, str, unix, threads"
+
+  archive(byte)    = "clib.cma"
+  archive(native)  = "clib.cmxa"
+)
+
 package "lib" (
 
-  description = "Base Coq Library"
-  version     = "8.6"
+  description = "Base Coq-Specific Library"
+  version     = "8.8"
 
   directory   = "lib"
 
-  requires         = "coq.config"
-
-  archive(byte)    = "clib.cma"
-  archive(byte)   += "lib.cma"
+  requires    = "coq.clib, coq.config"
 
-  archive(native)  = "clib.cmxa"
-  archive(native) += "lib.cmxa"
+  archive(byte)   = "lib.cma"
+  archive(native) = "lib.cmxa"
 
 )
 
 package "vm" (
 
   description = "Coq VM"
+  version     = "8.8"
 
-  version     = "8.6"
+  directory        = "kernel/byterun"
 
-# EJGA FIXME: Unfortunately dllpath is dependent on the type of Coq
-# install. In a local one we'll want kernel/byterun, in a non-local
-# one we want to set it to coqlib. We should thus generate this file
-# at configure time, but let's hear for some more feedback from
-# experts.
+# 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"
 
-# Enable for local native & byte builds
-#  directory        = "kernel/byterun"
+# We currently prefer static linking of the VM.
+  archive(byte)    = "libcoqrun.a"
+  linkopts(byte)   = "-custom"
 
-# Enable for local byte builds and set up properly
-#  linkopts(byte)   = "-dllpath /path/to/coq/kernel/byterun/ -dllib -lcoqrun"
-
-# Disable for local byte builds
-  linkopts(byte)   = "-dllib -lcoqrun"
   linkopts(native) = "-cclib -lcoqrun"
 
 )
 
 package "kernel" (
 
-  description = "The Coq's Kernel"
-  version     = "8.6"
+  description = "Coq's Kernel"
+  version     = "8.8"
 
   directory   = "kernel"
 
-  requires    = "coq.lib, coq.vm"
+  requires    = "dynlink, coq.lib, coq.vm"
 
   archive(byte)    = "kernel.cma"
   archive(native)  = "kernel.cmxa"
@@ -71,7 +79,7 @@ package "kernel" (
 package "library" (
 
   description = "Coq Libraries (vo) support"
-  version     = "8.6"
+  version     = "8.8"
 
   requires    = "coq.kernel"
 
@@ -85,18 +93,20 @@ package "library" (
 package "intf" (
 
   description = "Coq Public Data Types"
-  version     = "8.6"
+  version     = "8.8"
 
   requires    = "coq.library"
 
   directory   = "intf"
 
+  archive(byte)    = "intf.cma"
+  archive(native)  = "intf.cmxa"
 )
 
 package "engine" (
 
-  description = "Coq Libraries (vo) support"
-  version     = "8.6"
+  description = "Coq Tactic Engine"
+  version     = "8.8"
 
   requires    = "coq.library"
   directory   = "engine"
@@ -109,7 +119,7 @@ package "engine" (
 package "pretyping" (
 
   description = "Coq Pretyper"
-  version     = "8.6"
+  version     = "8.8"
 
   requires    = "coq.engine"
   directory   = "pretyping"
@@ -122,7 +132,7 @@ package "pretyping" (
 package "interp" (
 
   description = "Coq Term Interpretation"
-  version     = "8.6"
+  version     = "8.8"
 
   requires    = "coq.pretyping"
   directory   = "interp"
@@ -135,7 +145,7 @@ package "interp" (
 package "grammar" (
 
   description = "Coq Base Grammar"
-  version     = "8.6"
+  version     = "8.8"
 
   requires    = "coq.interp"
   directory   = "grammar"
@@ -147,7 +157,7 @@ package "grammar" (
 package "proofs" (
 
   description = "Coq Proof Engine"
-  version     = "8.6"
+  version     = "8.8"
 
   requires    = "coq.interp"
   directory   = "proofs"
@@ -160,9 +170,9 @@ package "proofs" (
 package "parsing" (
 
   description = "Coq Parsing Engine"
-  version     = "8.6"
+  version     = "8.8"
 
-  requires    = "coq.proofs"
+  requires    = "camlp5.gramlib, coq.proofs"
   directory   = "parsing"
 
   archive(byte)    = "parsing.cma"
@@ -172,8 +182,8 @@ package "parsing" (
 
 package "printing" (
 
-  description = "Coq Printing Libraries"
-  version     = "8.6"
+  description = "Coq Printing Engine"
+  version     = "8.8"
 
   requires    = "coq.parsing"
   directory   = "printing"
@@ -185,8 +195,8 @@ package "printing" (
 
 package "tactics" (
 
-  description = "Coq Tactics"
-  version     = "8.6"
+  description = "Coq Basic Tactics"
+  version     = "8.8"
 
   requires    = "coq.printing"
   directory   = "tactics"
@@ -196,12 +206,25 @@ package "tactics" (
 
 )
 
+package "vernac" (
+
+  description = "Coq Vernacular Interpreter"
+  version     = "8.8"
+
+  requires    = "coq.tactics"
+  directory   = "vernac"
+
+  archive(byte)    = "vernac.cma"
+  archive(native)  = "vernac.cmxa"
+
+)
+
 package "stm" (
 
   description = "Coq State Transactional Machine"
-  version     = "8.6"
+  version     = "8.8"
 
-  requires    = "coq.tactics"
+  requires    = "coq.vernac"
   directory   = "stm"
 
   archive(byte)    = "stm.cma"
@@ -212,7 +235,7 @@ package "stm" (
 package "toplevel" (
 
   description = "Coq Toplevel"
-  version     = "8.6"
+  version     = "8.8"
 
   requires    = "coq.stm"
   directory   = "toplevel"
@@ -222,28 +245,327 @@ package "toplevel" (
 
 )
 
-package "highparsing" (
+package "idetop" (
 
-  description = "Coq Extra Parsing"
-  version     = "8.6"
+  description = "Coq IDE Libraries"
+  version     = "8.8"
 
   requires    = "coq.toplevel"
-  directory   = "parsing"
+  directory   = "ide"
 
-  archive(byte)    = "highparsing.cma"
-  archive(native)  = "highparsing.cmxa"
+  archive(byte)    = "coqidetop.cma"
+  archive(native)  = "coqidetop.cmxa"
 
 )
 
-package "ltac" (
+# XXX Depends on way less than toplevel
+package "ide" (
+
+  description = "Coq IDE Libraries"
+  version     = "8.8"
+
+# XXX Add GTK
+  requires    = "coq.toplevel"
+  directory   = "ide"
+
+  archive(byte)    = "ide.cma"
+  archive(native)  = "ide.cmxa"
+
+)
+
+package "plugins" (
+
+  description = "Coq built-in plugins"
+  version     = "8.8"
+
+  directory   = "plugins"
+
+  package "ltac" (
+
+    description = "Coq LTAC Plugin"
+    version     = "8.8"
+
+    requires    = "coq.stm"
+    directory   = "ltac"
+
+    archive(byte)    = "ltac_plugin.cmo"
+    archive(native)  = "ltac_plugin.cmx"
+
+  )
+
+  package "tauto" (
+
+    description = "Coq tauto plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "ltac"
+
+    archive(byte)    = "tauto_plugin.cmo"
+    archive(native)  = "tauto_plugin.cmx"
+  )
+
+  package "omega" (
+
+    description = "Coq omega plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "omega"
+
+    archive(byte)    = "omega_plugin.cmo"
+    archive(native)  = "omega_plugin.cmx"
+  )
+
+  package "romega" (
+
+    description = "Coq romega plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.omega"
+    directory   = "romega"
+
+    archive(byte)    = "romega_plugin.cmo"
+    archive(native)  = "romega_plugin.cmx"
+  )
+
+  package "micromega" (
+
+    description = "Coq micromega plugin"
+    version     = "8.8"
+
+    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.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "quote"
+
+    archive(byte)    = "quote_plugin.cmo"
+    archive(native)  = "quote_plugin.cmx"
+  )
+
+  package "newring" (
+
+    description = "Coq newring plugin"
+    version     = "8.8"
+
+    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.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "fourier"
+
+    archive(byte)    = "fourier_plugin.cmo"
+    archive(native)  = "fourier_plugin.cmx"
+  )
+
+  package "extraction" (
+
+    description = "Coq extraction plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "extraction"
+
+    archive(byte)    = "extraction_plugin.cmo"
+    archive(native)  = "extraction_plugin.cmx"
+  )
+
+  package "cc" (
+
+    description = "Coq cc plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "cc"
+
+    archive(byte)    = "cc_plugin.cmo"
+    archive(native)  = "cc_plugin.cmx"
+  )
+
+  package "ground" (
+
+    description = "Coq ground plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "firstorder"
+
+    archive(byte)    = "ground_plugin.cmo"
+    archive(native)  = "ground_plugin.cmx"
+  )
+
+  package "rtauto" (
+
+    description = "Coq rtauto plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "rtauto"
+
+    archive(byte)    = "rtauto_plugin.cmo"
+    archive(native)  = "rtauto_plugin.cmx"
+  )
+
+  package "btauto" (
+
+    description = "Coq btauto plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "btauto"
+
+    archive(byte)    = "btauto_plugin.cmo"
+    archive(native)  = "btauto_plugin.cmx"
+  )
+
+  package "recdef" (
+
+    description = "Coq recdef plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.extraction"
+    directory   = "funind"
+
+    archive(byte)    = "recdef_plugin.cmo"
+    archive(native)  = "recdef_plugin.cmx"
+  )
+
+  package "nsatz" (
+
+    description = "Coq nsatz plugin"
+    version     = "8.8"
+
+    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.8"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "nat_syntax_plugin.cmo"
+    archive(native)  = "nat_syntax_plugin.cmx"
+  )
+
+  package "zsyntax" (
+
+    description = "Coq zsyntax plugin"
+    version     = "8.8"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "z_syntax_plugin.cmo"
+    archive(native)  = "z_syntax_plugin.cmx"
+  )
+
+  package "rsyntax" (
+
+    description = "Coq rsyntax plugin"
+    version     = "8.8"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "r_syntax_plugin.cmo"
+    archive(native)  = "r_syntax_plugin.cmx"
+  )
+
+  package "int31syntax" (
+
+    description = "Coq int31syntax plugin"
+    version     = "8.8"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "int31_syntax_plugin.cmo"
+    archive(native)  = "int31_syntax_plugin.cmx"
+  )
+
+  package "asciisyntax" (
+
+    description = "Coq asciisyntax plugin"
+    version     = "8.8"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "ascii_syntax_plugin.cmo"
+    archive(native)  = "ascii_syntax_plugin.cmx"
+  )
+
+  package "stringsyntax" (
+
+    description = "Coq stringsyntax plugin"
+    version     = "8.8"
+
+    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.8"
+
+    requires    = ""
+    directory   = "derive"
+
+    archive(byte)    = "derive_plugin.cmo"
+    archive(native)  = "derive_plugin.cmx"
+  )
+
+  package "ssrmatching" (
+
+    description = "Coq ssrmatching plugin"
+    version     = "8.8"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "ssrmatching"
+
+    archive(byte)    = "ssrmatching_plugin.cmo"
+    archive(native)  = "ssrmatching_plugin.cmx"
+  )
 
-  description = "Coq LTAC Plugin"
-  version     = "8.6"
+  package "ssreflect" (
 
-  requires    = "coq.highparsing"
-  directory   = "ltac"
+    description = "Coq ssreflect plugin"
+    version     = "8.8"
 
-  archive(byte)    = "ltac.cma"
-  archive(native)  = "ltac.cmxa"
+    requires    = "coq.plugins.ssrmatching"
+    directory   = "ssr"
 
+    archive(byte)    = "ssreflect_plugin.cmo"
+    archive(native)  = "ssreflect_plugin.cmx"
+  )
 )
diff --git a/Makefile b/Makefile
index 1dd4efca..86ff596a 100644
--- a/Makefile
+++ b/Makefile
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-osay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 
 # Makefile for Coq
@@ -15,9 +17,9 @@
 # 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
 # upper directory using "make -C ..", and the output is still understood
 # by Emacs' next-error.
@@ -42,9 +44,9 @@
 # to communicate between make sub-calls (in Win32, 8kb max per env variable,
 # 32kb total)
 
-# !! Before using FIND_VCS_CLAUSE, please read how you should in the !!
-# !! FIND_VCS_CLAUSE section of dev/doc/build-system.dev.txt         !!
-FIND_VCS_CLAUSE:='(' \
+# !! Before using FIND_SKIP_DIRS, please read how you should in the !!
+# !! FIND_SKIP_DIRS section of dev/doc/build-system.dev.txt         !!
+FIND_SKIP_DIRS:='(' \
   -name '{arch}' -o \
   -name '.svn' -o \
   -name '_darcs' -o \
@@ -52,27 +54,31 @@ FIND_VCS_CLAUSE:='(' \
   -name '.bzr' -o \
   -name 'debian' -o \
   -name "$${GIT_DIR}" -o \
-  -name '_build' \
+  -name '_build' -o \
+  -name '_build_ci' -o \
+  -name '_install_ci' -o \
+  -name 'user-contrib' -o \
+  -name 'coq-makefile' -o \
+  -name '.opamcache' -o \
+  -name '.coq-native' \
 ')' -prune -o
 
 define find
- $(shell find . $(FIND_VCS_CLAUSE) '(' -name $(1) ')' -print | sed 's|^\./||')
+ $(shell find . $(FIND_SKIP_DIRS) '(' -name $(1) ')' -print | sed 's|^\./||')
 endef
 
 define findindir
- $(shell find $(1) $(FIND_VCS_CLAUSE) '(' -name $(2) ')' -print | sed 's|^\./||')
-endef
-
-define findx
- $(shell find . $(FIND_VCS_CLAUSE) '(' -name $(1) ')' -exec $(2) {} \; | sed 's|^\./||')
+ $(shell find $(1) $(FIND_SKIP_DIRS) '(' -name $(2) ')' -print | sed 's|^\./||')
 endef
 
 ## Files in the source tree
 
 LEXFILES := $(call find, '*.mll')
-export MLLIBFILES := $(call find, '*.mllib') $(call find, '*.mlpack')
+export MLLIBFILES := $(call find, '*.mllib')
+export MLPACKFILES := $(call find, '*.mlpack')
 export ML4FILES := $(call find, '*.ml4')
 export CFILES := $(call findindir, 'kernel/byterun', '*.c')
+export MERLINFILES := $(call find, '.merlin')
 
 # NB: The lists of currently existing .ml and .mli files will change
 # before and after a build or a make clean. Hence we do not export
@@ -84,10 +90,9 @@ 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 GENVFILES:=theories/Numbers/Natural/BigN/NMake_gen.v
-export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES) $(GENVFILES)
+export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES)
 
 # NB: all files in $(GENFILES) can be created initially, while
 # .ml files in $(GENML4FILES) might need some intermediate building.
@@ -95,11 +100,7 @@ export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES) $(GENVFILES)
 
 ## More complex file lists
 
-define diff
- $(strip $(foreach f, $(1), $(if $(filter $(f),$(2)),,$f)))
-endef
-
-export MLSTATICFILES := $(call diff, $(EXISTINGML), $(GENMLFILES) $(GENML4FILES))
+export MLSTATICFILES := $(filter-out $(GENMLFILES) $(GENML4FILES), $(EXISTINGML))
 export MLIFILES := $(sort $(GENMLIFILES) $(EXISTINGMLI))
 
 include Makefile.common
@@ -113,16 +114,19 @@ NOARG: world
 .PHONY: NOARG help noconfig submake
 
 help:
-	@echo "Please use either"
+	@echo "Please use either:"
 	@echo "   ./configure"
 	@echo "   make world"
 	@echo "   make install"
 	@echo "   make clean"
 	@echo "or make archclean"
-	@echo
 	@echo "For make to be verbose, add VERBOSE=1"
+	@echo "If you want camlp5 to generate human-readable files, add READABLE_ML4=1"
 	@echo
-	@echo "If you want camlp{4,5} to generate human-readable files, add READABLE_ML4=1"
+	@echo "Bytecode compilation is now a separate target:"
+	@echo "   make byte"
+	@echo "   make install-byte"
+	@echo "Please do not mix bytecode and native targets in the same make -j"
 
 UNSAVED_FILES:=$(shell find . -name '.\#*v' -o -name '.\#*.ml' -o -name '.\#*.ml?')
 ifdef UNSAVED_FILES
@@ -134,6 +138,40 @@ Then, you may want to consider whether you want to restore the autosaves)
 #run.
 endif
 
+# Check that every compiled file around has a known source file.
+# This should help preventing weird compilation failures caused by leftover
+# compiled files after deleting or moving some source files.
+
+EXISTINGVO:=$(call find, '*.vo')
+KNOWNVO:=$(patsubst %.v,%.vo,$(call find, '*.v'))
+ALIENVO:=$(filter-out $(KNOWNVO),$(EXISTINGVO))
+
+EXISTINGOBJS:=$(call find, '*.cm[oxia]' -o -name '*.cmxa')
+KNOWNML:=$(EXISTINGML) $(GENMLFILES) $(GENML4FILES) $(MLPACKFILES:.mlpack=.ml) \
+ $(patsubst %.mlp,%.ml,$(wildcard grammar/*.mlp))
+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' or 'make alienclean' \
+(or skip this check via 'make ACCEPT_ALIEN_OBJ=1'))
+endif
+endif
+endif
+
 # Apart from clean and tags, everything will be done in a sub-call to make
 # on Makefile.build. This way, we avoid doing here the -include of .d :
 # since they trigger some compilations, we do not want them for a mere clean.
@@ -163,7 +201,7 @@ Makefile $(wildcard Makefile.*) config/Makefile : ;
 # Cleaning
 ###########################################################################
 
-.PHONY: clean cleankeepvo objclean cruftclean indepclean docclean archclean optclean clean-ide ml4clean depclean cleanconfig distclean voclean 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
 
@@ -185,6 +223,7 @@ indepclean:
 	rm -f test-suite/check.log
 	rm -f glob.dump
 	rm -f config/revision.ml revision
+	rm -f plugins/micromega/.micromega.ml.generated
 	$(MAKE) -C test-suite clean
 
 docclean:
@@ -197,22 +236,19 @@ 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 -f doc/refman/euclid.ml doc/refman/euclid.mli
-	rm -f doc/refman/heapsort.ml doc/refman/heapsort.mli
+	rm -rf doc/stdlib/html doc/tutorial/tutorial.v.html
 	rm -f doc/common/version.tex
-	rm -f doc/refman/styles.hva doc/refman/cover.html doc/refman/Reference-Manual.html
 	rm -f doc/coq.tex
+	rm -rf doc/sphinx/_build
 
 archclean: clean-ide optclean voclean
 	rm -rf _build
 	rm -f $(ALLSTDLIB).*
 
 optclean:
-	rm -f $(COQTOPEXE) $(COQMKTOP) $(CHICKEN)
+	rm -f $(COQTOPEXE) $(CHICKEN)
 	rm -f $(TOOLS) $(PRIVATEBINARIES) $(CSDPCERT)
-	find . -name '*.cmx' -o -name '*.cmxs' -o -name '*.cmxa' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f
+	find . -name '*.cmx' -o -name '*.cmx[as]' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f
 
 clean-ide:
 	rm -f $(COQIDECMO) $(COQIDECMX) $(COQIDECMO:.cmo=.cmi) $(COQIDEBYTE) $(COQIDE)
@@ -225,26 +261,37 @@ ml4clean:
 	rm -f $(GENML4FILES)
 
 depclean:
-	find . $(FIND_VCS_CLAUSE) '(' -name '*.d' ')' -print | xargs rm -f
+	find . $(FIND_SKIP_DIRS) '(' -name '*.d' ')' -print | xargs rm -f
 
 cacheclean:
 	find theories plugins test-suite -name '.*.aux' -delete
 
 cleanconfig:
-	rm -f config/Makefile config/coq_config.ml myocamlbuild_config.ml dev/ocamldebug-v7 config/Info-*.plist
+	rm -f config/Makefile config/coq_config.ml myocamlbuild_config.ml dev/ocamldebug-coq dev/camlp5.dbg config/Info-*.plist
 
-distclean: clean cleanconfig cacheclean
+distclean: clean cleanconfig cacheclean timingclean
 
 voclean:
 	find theories plugins test-suite \( -name '*.vo' -o -name '*.glob' -o -name "*.cmxs" -o -name "*.native" -o -name "*.cmx" -o -name "*.cmi" -o -name "*.o" \) -delete
 	find theories plugins test-suite -name .coq-native -empty -delete
 
+timingclean:
+	find theories plugins test-suite \( -name '*.v.timing' -o -name '*.v.before-timing' -o -name "*.v.after-timing" -o -name "*.v.timing.diff" -o -name "time-of-build.log" -o -name "time-of-build-before.log" -o -name "time-of-build-after.log" -o -name "time-of-build-pretty.log" -o -name "time-of-build-both.log" \) -delete
+
 devdocclean:
 	find . -name '*.dep.ps' -o -name '*.dot' | xargs rm -f
-	rm -f $(OCAMLDOCDIR)/*.log $(OCAMLDOCDIR)/*.aux $(OCAMLDOCDIR)/*.toc 
-	rm -f $(OCAMLDOCDIR)/ocamldoc.sty $(OCAMLDOCDIR)/coq.tex 
+	rm -f $(OCAMLDOCDIR)/*.log $(OCAMLDOCDIR)/*.aux $(OCAMLDOCDIR)/*.toc
+	rm -f $(OCAMLDOCDIR)/ocamldoc.sty $(OCAMLDOCDIR)/coq.tex
 	rm -f $(OCAMLDOCDIR)/html/*.html
 
+alienclean:
+	rm -f $(ALIENOBJS) $(ALIENVO)
+
+###########################################################################
+# Continuous Intregration Tests
+###########################################################################
+include Makefile.ci
+
 ###########################################################################
 # Emacs tags
 ###########################################################################
@@ -288,4 +335,3 @@ printenv:
 	@env | wc -L
 	@echo -n "Total (win32 limit is 32k) : "
 	@env | wc -m
-
diff --git a/Makefile.build b/Makefile.build
index 95df69c2..ffe60575 100644
--- a/Makefile.build
+++ b/Makefile.build
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 # This makefile is normally called by the main Makefile after setting
 # some variables.
@@ -31,17 +33,30 @@ TIMED ?=
 
 # When $(TIMED) is set, the time command used by default is $(STDTIME)
 # (see below), unless the following variable is non-empty. For instance,
-# it could be set to "'/usr/bin/time -p'".
+# it could be set to "'/usr/bin/env time -p'".
 TIMECMD ?=
 
+# When non-empty, -time is passed to coqc and the output is recorded
+# in a timing file for each .v file.  If set to "before" or "after",
+# the file name for foo.v is foo.v.$(TIMING)-timing; otherwise, it is
+# foo.v.timing
+TIMING ?=
+
 # Non-empty skips the update of all dependency .d files:
 NO_RECALC_DEPS ?=
 
 # Non-empty runs the checker on all produced .vo files:
 VALIDATE ?=
 
-# Is "-xml" when building XML library:
-COQ_XML ?=
+# Output file names for timed builds
+TIME_OF_BUILD_FILE               ?= time-of-build.log
+TIME_OF_BUILD_BEFORE_FILE        ?= time-of-build-before.log
+TIME_OF_BUILD_AFTER_FILE         ?= time-of-build-after.log
+TIME_OF_PRETTY_BUILD_FILE        ?= time-of-build-pretty.log
+TIME_OF_PRETTY_BOTH_BUILD_FILE   ?= time-of-build-both.log
+TIME_OF_PRETTY_BUILD_EXTRA_FILES ?= - # also output to the command line
+BEFORE ?=
+AFTER ?=
 
 ###########################################################################
 # Default starting rule
@@ -51,9 +66,19 @@ COQ_XML ?=
 
 world: coq coqide documentation revision
 
-coq: coqlib coqbinaries tools printers
+coq: coqlib coqbinaries tools
+
+world.timing.diff: coq.timing.diff
+coq.timing.diff: coqlib.timing.diff
+
+# Note: 'world' does not build the bytecode binaries anymore.
+# For that, you can use the 'byte' rule. Native and byte compilations
+# shouldn't be done in a same make -j... run, otherwise both ocamlc and
+# ocamlopt might race for access to the same .cmi files.
 
-.PHONY: world coq
+byte: coqbyte coqide-byte pluginsbyte printers
+
+.PHONY: world coq byte world.timing.diff coq.timing.diff
 
 ###########################################################################
 # Includes
@@ -70,13 +95,68 @@ include Makefile.ide      ## provides the 'coqide' rule
 include Makefile.install
 include Makefile.dev      ## provides the 'printers' and 'revision' rules
 
+###########################################################################
+# Timing targets
+###########################################################################
+make-pretty-timed-before:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_BEFORE_FILE)
+make-pretty-timed-after:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_AFTER_FILE)
+make-pretty-timed make-pretty-timed-before make-pretty-timed-after::
+	$(HIDE)rm -f pretty-timed-success.ok
+	$(HIDE)($(MAKE) --no-print-directory $(TGTS) TIMED=1 2>&1 && touch pretty-timed-success.ok) | tee -a $(TIME_OF_BUILD_FILE)
+	$(HIDE)rm pretty-timed-success.ok # must not be -f; must fail if the touch failed
+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)
+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'
+	$(HIDE)false
+else
+ifeq (,$(AFTER))
+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'
+	$(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)
+endif
+endif
+pretty-timed:
+	$(HIDE)$(MAKE) --no-print-directory make-pretty-timed
+	$(HIDE)$(MAKE) --no-print-directory print-pretty-timed
+.PHONY: pretty-timed make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff
+
+ifneq (,$(TIMING))
+TIMING_ARG=-time
+ifeq (after,$(TIMING))
+TIMING_EXT=after-timing
+else
+ifeq (before,$(TIMING))
+TIMING_EXT=before-timing
+else
+TIMING_EXT=timing
+endif
+endif
+else
+TIMING_ARG=
+endif
+
+###########################################################################
+
 # This include below will lauch the build of all .d.
 # The - at front is for disabling warnings about currently missing ones.
 # For creating the missing .d, make will recursively build things like
 # coqdep_boot (for the .v.d files) or grammar.cma (for .ml4 -> .ml -> .ml.d).
 
+VDFILE := .vfiles
+MLDFILE := .mlfiles
+PLUGMLDFILE := plugins/.mlfiles
+MLLIBDFILE := .mllibfiles
+PLUGMLLIBDFILE := plugins/.mllibfiles
+
 DEPENDENCIES := \
- $(addsuffix .d, $(MLFILES) $(MLIFILES) $(MLLIBFILES) $(CFILES) $(VFILES))
+ $(addsuffix .d, $(MLDFILE) $(MLLIBDFILE) $(PLUGMLDFILE) $(PLUGMLLIBDFILE) $(CFILES) $(VDFILE))
 
 -include $(DEPENDENCIES)
 
@@ -92,7 +172,21 @@ DEPENDENCIES := \
 ###########################################################################
 
 # Default timing command
-STDTIME=/usr/bin/time -f "$* (user: %U mem: %M ko)"
+# Use /usr/bin/env time on linux, gtime on Mac OS
+TIMEFMT?="$* (real: %e, user: %U, sys: %S, mem: %M ko)"
+ifneq (,$(TIMED))
+ifeq (0,$(shell /usr/bin/env time -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?))
+STDTIME?=/usr/bin/env time -f $(TIMEFMT)
+else
+ifeq (0,$(shell gtime -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?))
+STDTIME?=gtime -f $(TIMEFMT)
+else
+STDTIME?=time
+endif
+endif
+else
+STDTIME?=/usr/bin/env time -f $(TIMEFMT)
+endif
 
 TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))
 
@@ -100,18 +194,18 @@ TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))
 # the output format of the unix command time. For instance:
 #   TIME="%C (%U user, %S sys, %e total, %M maxres)"
 
-COQOPTS=$(COQ_XML) $(NATIVECOMPUTE)
-BOOTCOQC=$(TIMER) $(COQTOPEXE) -boot $(COQOPTS) -compile
+COQOPTS=$(NATIVECOMPUTE)
+BOOTCOQC=$(TIMER) $(COQTOPBEST) -boot $(COQOPTS) -compile
 
-LOCALINCLUDES=$(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) -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)
@@ -142,31 +236,22 @@ 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
 
-# Camlp4 / Camlp5 settings
+# Camlp5 settings
 
-CAMLP4DEPS:=grammar/compat5.cmo grammar/grammar.cma
-ifeq ($(CAMLP4),camlp5)
-CAMLP4USE=pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION)
-else
-CAMLP4USE=-D$(CAMLVERSION)
-endif
+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
-ifeq ($(CAMLP4),camlp5)
 P4CMA:=gramlib.cma
-else
-P4CMA:=camlp4lib.cma
-endif
 
 ###########################################################################
 # Infrastructure for the rest of the Makefile
@@ -191,10 +276,7 @@ ifndef ORDER_ONLY_SEP
 $(error This Makefile needs GNU Make 3.81 or later (that is a version that supports the order-only dependency feature without major bugs.))
 endif
 
-VO_TOOLS_DEP := $(COQTOPEXE)
-ifdef COQ_XML
- VO_TOOLS_DEP += $(COQDOC)
-endif
+VO_TOOLS_DEP := $(COQTOPBEST)
 ifdef VALIDATE
  VO_TOOLS_DEP += $(CHICKEN)
 endif
@@ -220,14 +302,14 @@ CINCLUDES= -I $(CAMLHLIB)
 
 $(LIBCOQRUN): kernel/byterun/coq_jumptbl.h $(BYTERUN)
 	cd $(dir $(LIBCOQRUN)) && \
-	$(OCAMLFIND) ocamlmklib -oc $(COQRUN) $(foreach u,$(BYTERUN),$(notdir $(u)))
+	$(OCAMLFIND) ocamlmklib -oc $(COQRUN) $(notdir $(BYTERUN))
 
 kernel/byterun/coq_jumptbl.h : kernel/byterun/coq_instruct.h
 	sed -n -e '/^  /s/ \([A-Z]\)/ \&\&coq_lbl_\1/gp' \
                -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
@@ -243,26 +325,6 @@ kernel/copcodes.ml: kernel/byterun/coq_instruct.h
 	$(HIDE)$(OCAMLC) -ccopt "-MM -MQ $@ -MQ $(<:.c=.o) -isystem $(CAMLHLIB)" $< $(TOTARGET)
 
 ###########################################################################
-### Special rules (Camlp5 / Camlp4)
-###########################################################################
-
-# Special rule for the compatibility-with-camlp5 extension for camlp4
-#
-# - grammar/compat5.cmo changes 'GEXTEND' into 'EXTEND'. Safe, always loaded
-# - grammar/compat5b.cmo changes 'EXTEND' into 'EXTEND Gram'. Interact badly with
-#    syntax such that 'VERNAC EXTEND', we only load it in grammar/
-
-ifeq ($(CAMLP4),camlp4)
-grammar/compat5.cmo: grammar/compat5.mlp
-	$(OCAMLC) -c -I $(MYCAMLP4LIB) -pp '$(CAMLP4O) -I $(MYCAMLP4LIB) -impl' -impl $<
-grammar/compat5b.cmo: grammar/compat5b.mlp
-	$(OCAMLC) -c -I $(MYCAMLP4LIB) -pp '$(CAMLP4O) -I $(MYCAMLP4LIB) -impl' -impl $<
-else
-grammar/compat5.cmo: grammar/compat5.ml
-	$(OCAMLC) -c $<
-endif
-
-###########################################################################
 #  grammar/grammar.cma
 ###########################################################################
 
@@ -272,11 +334,10 @@ endif
 
 ## Explicit dependencies for grammar stuff
 
-GRAMBASEDEPS := grammar/gramCompat.cmo grammar/q_util.cmi
-GRAMCMO := grammar/gramCompat.cmo grammar/q_util.cmo \
+GRAMBASEDEPS := grammar/q_util.cmi
+GRAMCMO := grammar/q_util.cmo \
  grammar/argextend.cmo grammar/tacextend.cmo grammar/vernacextend.cmo
 
-grammar/q_util.cmi : grammar/gramCompat.cmo
 grammar/argextend.cmo : $(GRAMBASEDEPS)
 grammar/q_util.cmo : $(GRAMBASEDEPS)
 grammar/tacextend.cmo : $(GRAMBASEDEPS) grammar/argextend.cmo
@@ -286,29 +347,23 @@ 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 $@'   
+	$(SHOW)'OCAMLC -a $@'
 	$(HIDE)$(GRAMC) $^ -linkall -a -o $@
 
 ## Support of Camlp5 and Camlp5
 
-ifeq ($(CAMLP4),camlp4)
- COMPATCMO:=grammar/compat5.cmo grammar/compat5b.cmo
- GRAMP4USE:=$(COMPATCMO) -D$(CAMLVERSION)
- GRAMPP:=$(CAMLP4O) -I $(MYCAMLP4LIB) $(GRAMP4USE) $(CAMLP4COMPAT) -impl
-else
- COMPATCMO:=
- GRAMP4USE:=$(COMPATCMO) pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION)
- GRAMPP:=$(CAMLP4O) -I $(MYCAMLP4LIB) $(GRAMP4USE) $(CAMLP4COMPAT) -impl
-endif
+COMPATCMO:=
+GRAMP4USE:=$(COMPATCMO) pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION)
+GRAMPP:=$(CAMLP5O) -I $(MYCAMLP5LIB) $(GRAMP4USE) $(CAMLP5COMPAT) -impl
 
 ## Rules for standard .mlp and .mli files in grammar/
 
@@ -322,19 +377,25 @@ grammar/%.cmi: grammar/%.mli
 
 
 ###########################################################################
-# Main targets (coqmktop, coqtop.opt, coqtop.byte)
+# Main targets (coqtop.opt, coqtop.byte)
 ###########################################################################
 
-.PHONY: coqbinaries
+.PHONY: coqbinaries coqbyte
+
+coqbinaries: $(COQTOPEXE) $(CHICKEN) $(CSDPCERT) $(FAKEIDE)
 
-coqbinaries: $(COQMKTOP) $(COQTOPEXE) $(COQTOPBYTE) \
- $(CHICKEN) $(CHICKENBYTE) $(CSDPCERT) $(FAKEIDE)
+coqbyte: $(COQTOPBYTE) $(CHICKENBYTE)
 
+COQTOP_OPT=toplevel/coqtop_opt_bin.ml
+COQTOP_BYTE=toplevel/coqtop_byte_bin.ml
 
 ifeq ($(BEST),opt)
-$(COQTOPEXE): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(TOPLOOPCMA:.cma=.cmxs)
-	$(SHOW)'COQMKTOP -o $@'	
-	$(HIDE)$(COQMKTOP) -boot -opt $(OPTFLAGS) $(LINKMETADATA) -o $@
+$(COQTOPEXE): $(LINKCMX) $(LIBCOQRUN) $(TOPLOOPCMA:.cma=.cmxs) $(COQTOP_OPT)
+	$(SHOW)'COQMKTOP -o $@'
+	$(HIDE)$(OCAMLOPT) -linkall -linkpkg -I vernac -I toplevel \
+	                   -I kernel/byterun/ -cclib -lcoqrun \
+			   $(SYSMOD) -package camlp5.gramlib \
+			   $(LINKCMX) $(OPTFLAGS) $(LINKMETADATA) $(COQTOP_OPT) -o $@
 	$(STRIP) $@
 	$(CODESIGN) $@
 else
@@ -342,31 +403,20 @@ $(COQTOPEXE): $(COQTOPBYTE)
 	cp $< $@
 endif
 
-$(COQTOPBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(TOPLOOPCMA)
-	$(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)"\"" >> $@
-
-# coqc
+# VMBYTEFLAGS will either contain -custom of the right -dllpath for the VM
+$(COQTOPBYTE): $(LINKCMO) $(LIBCOQRUN) $(TOPLOOPCMA) $(COQTOP_BYTE)
+	$(SHOW)'COQMKTOP -o $@'
+	$(HIDE)$(OCAMLC) -linkall -linkpkg -I lib -I vernac -I toplevel \
+	                 -I kernel/byterun/ -cclib -lcoqrun $(VMBYTEFLAGS) \
+			 $(SYSMOD) -package camlp5.gramlib,compiler-libs.toplevel \
+			 $(LINKCMO) $(BYTEFLAGS) $(COQTOP_BYTE) -o $@
 
-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
@@ -380,91 +430,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 ide/project_file.cmo 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/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
@@ -486,10 +547,9 @@ MAKE_TSOPTS=-C test-suite -s VERBOSE=$(VERBOSE)
 
 check: validate test-suite
 
-test-suite: world $(ALLSTDLIB).v
+test-suite: world byte $(ALLSTDLIB).v
 	$(MAKE) $(MAKE_TSOPTS) clean
 	$(MAKE) $(MAKE_TSOPTS) all
-	$(MAKE) $(MAKE_TSOPTS) report
 
 ###########################################################################
 # Default rules for compiling ML code
@@ -505,6 +565,12 @@ test-suite: world $(ALLSTDLIB).v
 # but the -include mechanism should already ensure that we have
 # up-to-date dependencies.
 
+# Specific rule for kernel.cma, with $(VMBYTEFLAGS).
+# This helps loading dllcoqrun.so during an ocamldebug
+kernel/kernel.cma: kernel/kernel.mllib
+	$(SHOW)'OCAMLC -a -o $@'
+	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(VMBYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
+
 %.cma: %.mllib
 	$(SHOW)'OCAMLC -a -o $@'
 	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
@@ -515,29 +581,43 @@ test-suite: world $(ALLSTDLIB).v
 
 # For plugin packs
 
-# Note: both ocamlc -pack and ocamlopt -pack will create the same .cmi, and there's
-# apparently no way to avoid that (no -intf-suffix hack as below).
-# We at least ensure that these two commands won't run at the same time, by a fake
-# dependency from the packed .cmx to the packed .cmo.
-
 %.cmo: %.mlpack
 	$(SHOW)'OCAMLC -pack -o $@'
 	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -pack -o $@ $(filter-out %.mlpack, $^)
 
-%.cmx: %.mlpack %.cmo
+%.cmx: %.mlpack
 	$(SHOW)'OCAMLOPT -pack -o $@'
-	$(HIDE)$(OCAMLOPT) $(MLINCLUDES) $(OPTFLAGS) -pack -o $@ $(filter-out %.mlpack %.cmo, $^)
+	$(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 $<
@@ -571,6 +651,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 $<
@@ -591,10 +679,10 @@ plugins/%.cmx: plugins/%.ml
 	$(SHOW)'OCAMLLEX  $<'
 	$(HIDE)$(OCAMLLEX) -o $@ "$*.mll"
 
-%.ml: %.ml4 | $(CAMLP4DEPS)
-	$(SHOW)'CAMLP4O   $<'
-	$(HIDE)$(CAMLP4O) -I $(MYCAMLP4LIB) $(PR_O) \
-	  $(CAMLP4DEPS) $(CAMLP4USE) $(CAMLP4COMPAT) -impl $< -o $@
+%.ml: %.ml4 $(CAMLP5DEPS)
+	$(SHOW)'CAMLP5O   $<'
+	$(HIDE)$(CAMLP5O) -I $(MYCAMLP5LIB) $(PR_O) \
+	  $(CAMLP5DEPS) $(CAMLP5USE) $(CAMLP5COMPAT) -impl $< -o $@
 
 
 ###########################################################################
@@ -604,21 +692,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
@@ -628,41 +719,51 @@ OCAMLDEP = $(OCAMLFIND) ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack
 # since they are all mentioned in at least one Declare ML Module in some .v
 
 coqlib: theories plugins
+coqlib.timing.diff: theories.timing.diff plugins.timing.diff
 
 theories: $(THEORIESVO)
 plugins: $(PLUGINSVO)
 
-.PHONY: coqlib theories plugins
+theories.timing.diff: $(THEORIESVO:.vo=.v.timing.diff)
+plugins.timing.diff: $(PLUGINSVO:.vo=.v.timing.diff)
 
-# One of the .v files is macro-generated
-
-theories/Numbers/Natural/BigN/NMake_gen.v: theories/Numbers/Natural/BigN/NMake_gen.ml
-	$(OCAML) $< $(TOTARGET)
+.PHONY: coqlib theories plugins coqlib.timing.diff theories.timing.diff plugins.timing.diff
 
 # The .vo files in Init are built with the -noinit option
 
+ifneq (,$(TIMING))
+TIMING_EXTRA = > $<.$(TIMING_EXT)
+else
+TIMING_EXTRA =
+endif
+
 theories/Init/%.vo theories/Init/%.glob: theories/Init/%.v $(VO_TOOLS_DEP)
-	$(SHOW)'COQC $(COQ_XML) -noinit $<'
+	$(SHOW)'COQC -noinit $<'
 	$(HIDE)rm -f theories/Init/$*.glob
-	$(HIDE)$(BOOTCOQC) $< $(COQ_XML) -noinit -R theories Coq
+	$(HIDE)$(BOOTCOQC) $< -noinit -R theories Coq $(TIMING_ARG) $(TIMING_EXTRA)
 
 # The general rule for building .vo files :
 
 %.vo %.glob: %.v theories/Init/Prelude.vo $(VO_TOOLS_DEP)
 	$(SHOW)'COQC      $<'
 	$(HIDE)rm -f $*.glob
-	$(HIDE)$(BOOTCOQC) $<
+	$(HIDE)$(BOOTCOQC) $< $(TIMING_ARG) $(TIMING_EXTRA)
 ifdef VALIDATE
 	$(SHOW)'COQCHK    $(call vo_to_mod,$@)'
 	$(HIDE)$(CHICKEN) -boot -silent -norec $(call vo_to_mod,$@) \
 	  || ( RV=$$?; rm -f "$@"; exit $${RV} )
 endif
 
+%.v.timing.diff: %.v.before-timing %.v.after-timing
+	$(SHOW)PYTHON TIMING-DIFF $<
+	$(HIDE)$(MAKE) --no-print-directory print-pretty-single-time-diff BEFORE=$*.v.before-timing AFTER=$*.v.after-timing TIME_OF_PRETTY_BUILD_FILE="$@"
+
+
 # Dependencies of .v files
 
-%.v.d: $(D_DEPEND_BEFORE_SRC) %.v $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENVFILES)
-	$(SHOW)'COQDEP    $<'
-	$(HIDE)$(COQDEPBOOT) -boot $(DEPNATDYN) "$<" $(TOTARGET)
+$(VDFILE).d: $(D_DEPEND_BEFORE_SRC) $(VFILES) $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT)
+	$(SHOW)'COQDEP    VFILES'
+	$(HIDE)$(COQDEPBOOT) -boot $(DYNDEP) $(VFILES) $(TOTARGET)
 
 ###########################################################################
 
@@ -678,7 +779,7 @@ Makefile $(wildcard Makefile.*) config/Makefile : ;
 %:
 	@echo "Error: no rule to make target $@ (or missing .PHONY)" && false
 
-# For emacs: 
-# Local Variables: 
-# mode: makefile 
+# For emacs:
+# Local Variables:
+# mode: makefile
 # End:
diff --git a/Makefile.checker b/Makefile.checker
index 3ea0bace..172c64af 100644
--- a/Makefile.checker
+++ b/Makefile.checker
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 ## Makefile rules for building Coqchk
 
@@ -20,16 +22,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 +45,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 +57,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    $<'
@@ -71,12 +75,12 @@ checker/%.cmo: checker/%.ml
 
 checker/%.cmx: checker/%.ml
 	$(SHOW)'OCAMLOPT  $<'
-	$(HIDE)$(OCAMLOPT) $(CHKLIBS) $(OPTFLAGS) $(HACKMLI) -c $<
+	$(HIDE)$(OCAMLOPT) $(CHKLIBS) $(OPTFLAGS) -c $<
 
 md5chk:
 	$(SHOW)'MD5SUM cic.mli'
-	$(HIDE)if grep -q `$(MD5SUM) checker/cic.mli` checker/values.ml; \
-	       then true; else echo "Error: outdated checker/values.ml"; false; fi
+	$(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
new file mode 100644
index 00000000..20712b60
--- /dev/null
+++ b/Makefile.ci
@@ -0,0 +1,67 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+
+CI_TARGETS=ci-bedrock2 \
+    ci-bignums \
+    ci-color \
+    ci-compcert \
+    ci-coq-dpdgraph \
+    ci-coquelicot \
+    ci-corn \
+    ci-cpdt \
+    ci-elpi \
+    ci-ext-lib \
+    ci-equations \
+    ci-fcsl-pcm \
+    ci-fiat-crypto \
+    ci-fiat-crypto-legacy \
+    ci-fiat-parsers \
+    ci-flocq \
+    ci-formal-topology \
+    ci-geocoq \
+    ci-hott \
+    ci-iris-lambda-rust \
+    ci-ltac2 \
+    ci-math-classes \
+    ci-math-comp \
+    ci-mtac2 \
+    ci-quickchick \
+    ci-sf \
+    ci-simple-io \
+    ci-tlc \
+    ci-unimath \
+    ci-vst
+
+.PHONY: ci-all $(CI_TARGETS)
+
+ci-help:
+	echo '*** Coq CI system, please specify a target to build.'
+	false
+
+ci-all: $(CI_TARGETS)
+
+ci-color: ci-bignums
+
+ci-math-classes: ci-bignums
+
+ci-corn: ci-math-classes
+
+ci-quickchick: ci-ext-lib ci-simple-io
+
+ci-formal-topology: ci-corn
+
+# Generic rule, we use make to ease travis integration with mixed rules
+$(CI_TARGETS): ci-%:
+	+./dev/ci/ci-wrapper.sh $*
+
+# For emacs:
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Makefile.common b/Makefile.common
index 49fe1fd9..1e63d52f 100644
--- a/Makefile.common
+++ b/Makefile.common
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 -include config/Makefile
 
@@ -12,8 +14,6 @@
 # Executables
 ###########################################################################
 
-COQMKTOP:=bin/coqmktop$(EXE) 
-
 COQTOPBYTE:=bin/coqtop.byte$(EXE)
 COQTOPEXE:=bin/coqtop$(EXE)
 
@@ -25,9 +25,15 @@ COQWC:=bin/coqwc$(EXE)
 COQDOC:=bin/coqdoc$(EXE)
 COQC:=bin/coqc$(EXE)
 COQWORKMGR:=bin/coqworkmgr$(EXE)
+COQMAKE_ONE_TIME_FILE:=tools/make-one-time-file.py
+COQTIME_FILE_MAKER:=tools/TimeFileMaker.py
+COQMAKE_BOTH_TIME_FILES:=tools/make-both-time-files.py
+COQMAKE_BOTH_SINGLE_TIMING_FILES:=tools/make-both-single-timing-files.py
 
 TOOLS:=$(COQDEP) $(COQMAKEFILE) $(GALLINA) $(COQTEX) $(COQWC) $(COQDOC) $(COQC)\
 	$(COQWORKMGR)
+TOOLS_HELPERS:=tools/CoqMakefile.in $(COQMAKE_ONE_TIME_FILE) $(COQTIME_FILE_MAKER)\
+	$(COQMAKE_BOTH_TIME_FILES) $(COQMAKE_BOTH_SINGLE_TIMING_FILES)
 
 COQDEPBOOT:=bin/coqdep_boot$(EXE)
 OCAMLLIBDEP:=bin/ocamllibdep$(EXE)
@@ -41,28 +47,44 @@ CSDPCERT:=plugins/micromega/csdpcert$(EXE)
 # Object and Source files
 ###########################################################################
 
-ifeq ($(HASNATDYNLINK)-$(BEST),true-opt)
-  DEPNATDYN:=
+ifeq ($(HASNATDYNLINK)-$(BEST),false-opt)
+ # static link of plugins, do not mention them in .v.d
+ DYNDEP:=-dyndep no
+else
+ DYNDEP:=-dyndep var
+endif
+
+# Which coqtop do we use to build .vo file ? The best ;-)
+# Note: $(BEST) could be overridden by the user if a byte build is desired
+# Note: coqdep -dyndep var will use $(DYNOBJ) and $(DYNLIB) extensions
+# for Declare ML Module files.
+
+ifeq ($(BEST),opt)
+COQTOPBEST:=$(COQTOPEXE)
+DYNOBJ:=.cmxs
+DYNLIB:=.cmxs
 else
-  DEPNATDYN:=-natdynlink no
+COQTOPBEST:=$(COQTOPBYTE)
+DYNOBJ:=.cmo
+DYNLIB:=.cma
 endif
 
 INSTALLBIN:=install
-INSTALLLIB:=install -m 644 
+INSTALLLIB:=install -m 644
 INSTALLSH:=./install.sh
 MKDIR:=install -d
 
 CORESRCDIRS:=\
-  config 	lib		kernel		kernel/byterun	library \
-  proofs 	tactics 	pretyping	interp		stm \
-  toplevel	parsing 	printing	intf	engine	ltac
+  config 	clib 		lib		kernel	intf	kernel/byterun	library \
+  engine 	pretyping	interp	proofs	parsing 	printing \
+  tactics 	vernac		stm		toplevel
 
 PLUGINDIRS:=\
   omega		romega 		micromega 	quote \
   setoid_ring 	extraction 	fourier \
   cc 		funind 		firstorder 	derive \
-  rtauto 	nsatz           syntax          decl_mode	btauto \
-  ssrmatching
+  rtauto 	nsatz           syntax          btauto \
+  ssrmatching	ltac		ssr
 
 SRCDIRS:=\
   $(CORESRCDIRS)  \
@@ -77,18 +99,17 @@ BYTERUN:=$(addprefix kernel/byterun/, \
   coq_fix_code.o coq_memory.o coq_values.o coq_interp.o )
 
 # LINK ORDER:
-# Beware that highparsing.cma should appear before ltac.cma
 # 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 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 \
-	stm/stm.cma toplevel/toplevel.cma parsing/highparsing.cma ltac/ltac.cma
+        parsing/parsing.cma printing/printing.cma tactics/tactics.cma vernac/vernac.cma \
+	stm/stm.cma toplevel/toplevel.cma
 
 TOPLOOPCMA:=stm/proofworkertop.cma stm/tacworkertop.cma stm/queryworkertop.cma
 
-GRAMMARCMA:=grammar/compat5.cmo grammar/grammar.cma
+GRAMMARCMA:=grammar/grammar.cma
 
 # modules known by the toplevel of Coq
 
@@ -114,20 +135,21 @@ RTAUTOCMO:=plugins/rtauto/rtauto_plugin.cmo
 NATSYNTAXCMO:=plugins/syntax/nat_syntax_plugin.cmo
 OTHERSYNTAXCMO:=$(addprefix plugins/syntax/, \
         z_syntax_plugin.cmo \
-        numbers_syntax_plugin.cmo \
         r_syntax_plugin.cmo \
+	int31_syntax_plugin.cmo \
 	ascii_syntax_plugin.cmo \
         string_syntax_plugin.cmo )
-DECLMODECMO:=plugins/decl_mode/decl_mode_plugin.cmo
 DERIVECMO:=plugins/derive/derive_plugin.cmo
+LTACCMO:=plugins/ltac/ltac_plugin.cmo plugins/ltac/tauto_plugin.cmo
 SSRMATCHINGCMO:=plugins/ssrmatching/ssrmatching_plugin.cmo
+SSRCMO:=plugins/ssr/ssreflect_plugin.cmo
 
-PLUGINSCMO:=$(OMEGACMO) $(ROMEGACMO) $(MICROMEGACMO) $(DECLMODECMO) \
+PLUGINSCMO:=$(LTACCMO) $(OMEGACMO) $(ROMEGACMO) $(MICROMEGACMO) \
         $(QUOTECMO) $(RINGCMO) \
         $(FOURIERCMO) $(EXTRACTIONCMO) \
         $(CCCMO)  $(FOCMO) $(RTAUTOCMO) $(BTAUTOCMO) \
         $(FUNINDCMO) $(NSATZCMO) $(NATSYNTAXCMO) $(OTHERSYNTAXCMO) \
-	$(DERIVECMO) $(SSRMATCHINGCMO)
+	$(DERIVECMO) $(SSRMATCHINGCMO) $(SSRCMO)
 
 ifeq ($(HASNATDYNLINK)-$(BEST),false-opt)
  STATICPLUGINS:=$(PLUGINSCMO)
@@ -145,16 +167,10 @@ LINKCMX:=$(CORECMA:.cma=.cmxa) $(STATICPLUGINS:.cmo=.cmx)
 # vo files
 ###########################################################################
 
-## we now retrieve the names of .vo file to compile in */vo.itarget files
-
-THEORIESVO:= $(foreach f, $(wildcard theories/*/vo.itarget), \
-                $(addprefix $(dir $(f)),$(shell cat $(f))))
-
-PLUGINSVO:=  $(foreach f, $(wildcard plugins/*/vo.itarget), \
-                $(addprefix $(dir $(f)),$(shell cat $(f))))
-
-ALLVO:= $(THEORIESVO) $(PLUGINSVO)
-VFILES:= $(ALLVO:.vo=.v)
+THEORIESVO := $(patsubst %.v,%.vo,$(shell find theories -type f -name "*.v"))
+PLUGINSVO := $(patsubst %.v,%.vo,$(shell find plugins -type f -name "*.v"))
+ALLVO := $(THEORIESVO) $(PLUGINSVO)
+VFILES := $(ALLVO:.vo=.v)
 
 ## More specific targets
 
@@ -176,13 +192,15 @@ vo_to_cm = $(foreach vo,$(1),$(dir $(vo)).coq-native/$(subst /,_,$(patsubst theo
 
 vo_to_obj = $(foreach vo,$(1),$(dir $(vo)).coq-native/$(subst /,_,$(patsubst theories/%,NCoq_%,$(patsubst plugins/%,NCoq_%,$(vo:.vo=.o)))))
 
-LIBFILES:=$(THEORIESVO) $(PLUGINSVO) $(call vo_to_cm,$(THEORIESVO)) \
-	    $(call vo_to_cm,$(PLUGINSVO)) $(call vo_to_obj,$(THEORIESVO)) \
-	    $(call vo_to_obj,$(PLUGINSVO)) \
-	    $(PLUGINSVO:.vo=.v) $(THEORIESVO:.vo=.v) \
-	    $(PLUGINSVO:.vo=.glob) $(THEORIESVO:.vo=.glob)
+GLOBFILES:=$(ALLVO:.vo=.glob)
+ifdef NATIVECOMPUTE
+NATIVEFILES := $(call vo_to_cm,$(ALLVO)) $(call vo_to_obj,$(ALLVO))
+else
+NATIVEFILES :=
+endif
+LIBFILES:=$(ALLVO) $(NATIVEFILES) $(VFILES) $(GLOBFILES)
 
-# For emacs: 
-# Local Variables: 
-# mode: makefile 
+# For emacs:
+# Local Variables:
+# mode: makefile
 # End:
diff --git a/Makefile.dev b/Makefile.dev
index 1f81edc2..0461fe07 100644
--- a/Makefile.dev
+++ b/Makefile.dev
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 # Extra targets for developpers :
 # debug printers, revision, partial targets ...
@@ -15,21 +17,13 @@
 
 .PHONY: devel printers
 
-DEBUGPRINTERS:=dev/top_printers.cmo dev/vm_printers.cmo dev/printers.cma
+DEBUGPRINTERS:=dev/top_printers.cmo dev/vm_printers.cmo
 
 devel: printers
-printers: $(DEBUGPRINTERS)
+printers: $(CORECMA) $(DEBUGPRINTERS) dev/camlp5.dbg
 
-dev/printers.cma: dev/printers.mllib
-	$(SHOW)'Testing $@'
-	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(SYSCMA) $(P4CMA) $(filter-out %.mllib, $^) -o test-printer
-	@rm -f test-printer
-	$(SHOW)'OCAMLC -a $@'
-	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(SYSCMA) $(P4CMA) $(filter-out %.mllib, $^) -linkall -a -o $@
-
-dev/%.mllib.d: dev/%.mllib | $(OCAMLLIBDEP) $(GENFILES)
-	$(SHOW)'OCAMLLIBDEP  $<'
-	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) -I dev "$<" $(TOTARGET)
+dev/camlp5.dbg:
+	echo "load_printer gramlib.cma" > $@
 
 ############
 # revision
@@ -105,7 +99,10 @@ minibyte: $(COQTOPBYTE) pluginsbyte
 pluginsopt: $(PLUGINSOPT)
 pluginsbyte: $(PLUGINS)
 
-.PHONY: coqlight states miniopt minibyte pluginsopt pluginsbyte
+# This should build all the ocaml code but not (most of) the .v files
+coqocaml: tools coqbinaries $(PLUGINSCMO:.cmo=$(DYNOBJ)) coqide printers bin/votour
+
+.PHONY: coqlight states miniopt minibyte pluginsopt pluginsbyte coqocaml
 
 ##########################
 ### 2) core ML components
@@ -121,13 +118,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
-ltac: ltac/ltac.cma
 
 .PHONY: lib kernel byterun library proofs tactics interp parsing pretyping
-.PHONY: engine highparsing stm toplevel ltac
+.PHONY: engine stm toplevel
 
 ######################
 ### 3) theories files
@@ -186,36 +181,22 @@ RTAUTOVO:=$(filter plugins/rtauto/%, $(PLUGINSVO))
 EXTRACTIONVO:=$(filter plugins/extraction/%, $(PLUGINSVO))
 CCVO:=
 DERIVEVO:=$(filter plugins/derive/%, $(PLUGINSVO))
+LTACVO:=$(filter plugins/ltac/%, $(PLUGINSVO))
 
 omega: $(OMEGAVO) $(OMEGACMO) $(ROMEGAVO) $(ROMEGACMO)
 micromega: $(MICROMEGAVO) $(MICROMEGACMO) $(CSDPCERT)
 setoid_ring: $(RINGVO) $(RINGCMO)
 nsatz: $(NSATZVO) $(NSATZCMO)
-extraction: $(EXTRACTIONCMO)
+extraction: $(EXTRACTIONCMO) $(EXTRACTIONVO)
 fourier: $(FOURIERVO) $(FOURIERCMO)
 funind: $(FUNINDCMO) $(FUNINDVO)
 cc: $(CCVO) $(CCCMO)
 rtauto: $(RTAUTOVO) $(RTAUTOCMO)
 btauto: $(BTAUTOVO) $(BTAUTOCMO)
+ltac: $(LTACVO) $(LTACCMO)
 
 .PHONY: omega micromega setoid_ring nsatz extraction
-.PHONY: fourier funind cc rtauto btauto
-
-#################################
-### Misc other development rules
-#################################
-
-# NOTA : otags only accepts camlp4 as preprocessor, so the following rule
-# won't build tags of .ml4 when compiling with camlp5
-
-otags:
-	otags $(MLIFILES) $(filter-out configure.ml, $(MLSTATICFILES)) \
-	$(if $(filter camlp5,$(CAMLP4)), , \
-          -pa op -pa g -pa m -pa rq $(addprefix -pa , $(CAMLP4DEPS)) \
-          $(addprefix -impl , $(ML4FILES)))
-
-.PHONY: otags
-
+.PHONY: fourier funind cc rtauto btauto ltac
 
 # For emacs:
 # Local Variables:
diff --git a/Makefile.doc b/Makefile.doc
index cdd9852e..07581748 100644
--- a/Makefile.doc
+++ b/Makefile.doc
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 # Makefile for the Coq documentation
 
@@ -30,69 +32,68 @@ BIBTEX:=BIBINPUTS=.: bibtex -min-crossrefs=10
 MAKEINDEX:=makeindex
 PDFLATEX:=pdflatex
 DVIPS:=dvips
-FIG2DEV:=fig2dev
-CONVERT:=convert
 HEVEA:=hevea
-HACHA:=hacha
 HEVEAOPTS:=-fix -exec xxdate.exe
 HEVEALIB:=/usr/local/lib/hevea:/usr/lib/hevea
-HTMLSTYLE:=simple
+HTMLSTYLE:=coqremote
 export TEXINPUTS:=$(HEVEALIB):
+ifdef COQDOC_NOBOOT
+COQTEXOPTS:=-n 72 -sl -small
+else
 COQTEXOPTS:=-boot -n 72 -sl -small
+endif
 
-DOCCOMMON:=doc/common/version.tex doc/common/title.tex doc/common/macros.tex
+# Sphinx-related variables
+SPHINXOPTS= -j4
+SPHINXBUILD= sphinx-build
+SPHINXBUILDDIR= doc/sphinx/_build
 
-REFMANCOQTEXFILES:=$(addprefix doc/refman/, \
-  RefMan-gal.v.tex RefMan-ext.v.tex \
-  RefMan-mod.v.tex RefMan-tac.v.tex \
-  RefMan-cic.v.tex RefMan-lib.v.tex \
-  RefMan-tacex.v.tex RefMan-syn.v.tex \
-  RefMan-oth.v.tex RefMan-ltac.v.tex \
-  RefMan-decl.v.tex RefMan-pro.v.tex RefMan-sch.v.tex \
-  Cases.v.tex Coercion.v.tex CanonicalStructures.v.tex Extraction.v.tex \
-  Program.v.tex Omega.v.tex Micromega.v.tex Polynom.v.tex Nsatz.v.tex \
-  Setoid.v.tex Classes.v.tex Universes.v.tex \
-  Misc.v.tex)
+# Internal variables.
+ALLSPHINXOPTS= -d $(SPHINXBUILDDIR)/doctrees $(SPHINXOPTS)
 
-REFMANTEXFILES:=$(addprefix doc/refman/, \
-  headers.sty Reference-Manual.tex \
-  RefMan-pre.tex RefMan-int.tex RefMan-com.tex \
-  RefMan-uti.tex RefMan-ide.tex RefMan-add.tex RefMan-modr.tex \
-  AsyncProofs.tex ) \
-  $(REFMANCOQTEXFILES) \
+DOCCOMMON:=doc/common/version.tex doc/common/title.tex doc/common/macros.tex
 
-REFMANEPSFILES:=doc/refman/coqide.eps doc/refman/coqide-queries.eps
+######################################################################
+### General rules
+######################################################################
 
-REFMANFILES:=$(REFMANTEXFILES) $(DOCCOMMON) $(REFMANEPSFILES) doc/refman/biblio.bib
+.PHONY: doc doc-html doc-pdf doc-ps
+.PHONY: stdlib full-stdlib sphinx
+.PHONY: tutorial rectutorial
 
-REFMANPNGFILES:=$(REFMANEPSFILES:.eps=.png)
+doc: refman tutorial rectutorial stdlib
 
+ifndef QUICK
+SPHINX_DEPS := coq
+endif
 
-######################################################################
-### General rules
-######################################################################
+# refman-html and refman-latex
+refman-%: coq
+	$(SHOW)'SPHINXBUILD doc/sphinx ($*)'
+	$(HIDE)COQBIN="$(abspath bin)" $(SPHINXBUILD) -b $* \
+		$(ALLSPHINXOPTS) doc/sphinx $(SPHINXBUILDDIR)/$*
 
-.PHONY: doc doc-html doc-pdf doc-ps refman refman-quick tutorial
-.PHONY: stdlib full-stdlib faq rectutorial refman-html-dir
+refman-pdf: refman-latex
+	+$(MAKE) -C $(SPHINXBUILDDIR)/latex
 
-INDEXURLS:=doc/refman/html/index_urls.txt
+refman: coq
+	+$(MAKE) refman-html
+	+$(MAKE) refman-pdf
 
-doc: refman faq tutorial rectutorial stdlib $(INDEXURLS)
+# compatibility alias
+sphinx: refman-html
 
 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/tutorial/Tutorial.v.html doc/stdlib/html/index.html \
+  doc/RecTutorial/RecTutorial.html refman-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/tutorial/Tutorial.v.pdf doc/stdlib/Library.pdf \
+  doc/RecTutorial/RecTutorial.pdf refman-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
-
-refman: \
-  doc/refman/html/index.html doc/refman/Reference-Manual.ps doc/refman/Reference-Manual.pdf
+  doc/tutorial/Tutorial.v.ps \
+  doc/stdlib/Library.ps doc/RecTutorial/RecTutorial.ps
 
 tutorial: \
   doc/tutorial/Tutorial.v.html doc/tutorial/Tutorial.v.ps doc/tutorial/Tutorial.v.pdf
@@ -103,8 +104,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
 
@@ -123,20 +122,6 @@ endif
 %.ps: %.dvi
 	(cd `dirname $<`; $(DVIPS) -q -o `basename $@` `basename $<`)
 
-%.png: %.fig
-	$(FIG2DEV) -L png -m 2 $< $@
-
-%.pdf: %.fig
-	$(FIG2DEV) -L pdftex $< $@
-	$(FIG2DEV) -L pdftex_t -p `basename $@` $< $@_t
-
-%.eps: %.fig
-	$(FIG2DEV) -L pstex $< $@
-	$(FIG2DEV) -L pstex_t -p `basename $@` $< $@_t
-
-%.eps: %.png
-	$(CONVERT) $< $@
-
 ######################################################################
 # Macros for filtering outputs
 ######################################################################
@@ -144,9 +129,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
 ######################################################################
@@ -157,76 +139,6 @@ doc/common/version.tex: config/Makefile
 	printf '\\newcommand{\\coqversion}{$(VERSION)}' > doc/common/version.tex
 
 ######################################################################
-# Reference Manual
-######################################################################
-
-
-### Reference Manual (printable format)
-
-# The second LATEX compilation is necessary otherwise the pages of the index
-# are not correct (don't know why...) - BB
-doc/refman/Reference-Manual.dvi: $(REFMANFILES) doc/refman/Reference-Manual.tex
-	@(cd doc/refman;\
-	$(LATEX) -interaction=batchmode Reference-Manual;\
-	$(BIBTEX) -terse Reference-Manual $(HIDEBIBTEXINFO);\
-	$(LATEX) -interaction=batchmode Reference-Manual > /dev/null;\
-	$(MAKEINDEX) -q Reference-Manual;\
-	$(SHOWMAKEINDEXERROR) Reference-Manual.ilg;\
-	$(MAKEINDEX) -q Reference-Manual.tacidx -o Reference-Manual.tacind;\
-	$(SHOWMAKEINDEXERROR) Reference-Manual.ilg;\
-	$(MAKEINDEX) -q Reference-Manual.comidx -o Reference-Manual.comind;\
-	$(SHOWMAKEINDEXERROR) Reference-Manual.ilg;\
-	$(MAKEINDEX) -q Reference-Manual.optidx -o Reference-Manual.optind;\
-	$(SHOWMAKEINDEXERROR) Reference-Manual.ilg;\
-	$(MAKEINDEX) -q Reference-Manual.erridx -o Reference-Manual.errind;\
-	$(SHOWMAKEINDEXERROR) Reference-Manual.ilg;\
-	$(LATEX) -interaction=batchmode Reference-Manual > /dev/null;\
-	$(LATEX) -interaction=batchmode Reference-Manual > /dev/null;\
-	../tools/show_latex_messages -no-overfull Reference-Manual.log)
-
-doc/refman/Reference-Manual.pdf: doc/refman/Reference-Manual.dvi $(REFMANPNGFILES)
-	(cd doc/refman;\
-	$(PDFLATEX) -interaction=batchmode Reference-Manual.tex;\
-	../tools/show_latex_messages -no-overfull Reference-Manual.log)
-
-### Reference Manual (browsable format)
-
-doc/refman/Reference-Manual.html: doc/refman/styles.hva doc/refman/headers.hva doc/refman/Reference-Manual.dvi # to ensure bbl file
-	(cd doc/refman; BIBINPUTS=.: $(HEVEA) $(HEVEAOPTS) ./styles.hva ./Reference-Manual.tex)
-
-doc/refman/cover.html: doc/common/styles/html/$(HTMLSTYLE)/cover.html
-	sed -e "s/COQVERSION/$(VERSION)/g" $< > $@
-
-doc/refman/styles.hva: doc/common/styles/html/$(HTMLSTYLE)/styles.hva
-	$(INSTALLLIB) $< doc/refman
-
-INDEXES:= doc/refman/html/command-index.html doc/refman/html/tactic-index.html
-ALLINDEXES:= doc/refman/html/index.html $(INDEXES)
-
-refman-html-dir $(ALLINDEXES): doc/refman/Reference-Manual.html $(REFMANPNGFILES) \
-	       doc/refman/cover.html doc/refman/styles.hva doc/refman/index.html
-	- rm -rf doc/refman/html
-	$(MKDIR) doc/refman/html
-	$(INSTALLLIB) $(REFMANPNGFILES) doc/refman/html
-	(cd doc/refman/html; $(HACHA) -nolinks -tocbis -o toc.html ../styles.hva ../Reference-Manual.html)
-	$(INSTALLLIB) doc/refman/cover.html doc/refman/html/index.html
-	-$(INSTALLLIB) doc/common/styles/html/$(HTMLSTYLE)/*.css doc/refman/html
-
-refman-quick:
-	(cd doc/refman;\
-	$(PDFLATEX) -interaction=batchmode Reference-Manual.tex;\
-	../tools/show_latex_messages -no-overfull Reference-Manual.log && \
-	$(HEVEA) $(HEVEAOPTS) ./Reference-Manual.tex)
-
-######################################################################
-# Index file for CoqIDE
-######################################################################
-
-$(INDEXURLS): $(INDEXES)
-	cat $< | grep li-indexenv | grep href= | sed -e 's@.*>\([^<]*\)</span>.*, <a href="\([^"]*\)">.*@\1,\2@' > $@
-
-
-######################################################################
 # Tutorial
 ######################################################################
 
@@ -243,33 +155,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
 ######################################################################
@@ -367,39 +252,39 @@ doc/RecTutorial/RecTutorial.html: doc/RecTutorial/RecTutorial.tex
 # Install all documentation files
 ######################################################################
 
-.PHONY: install-doc install-doc-meta install-doc-html install-doc-printable install-doc-index-urls
+.PHONY: install-doc install-doc-meta install-doc-html install-doc-printable \
+	install-doc-index-urls install-doc-sphinx
 
-install-doc: install-doc-meta install-doc-html install-doc-printable install-doc-index-urls
+install-doc: install-doc-meta install-doc-html install-doc-printable \
+	install-doc-index-urls install-doc-sphinx
 
 install-doc-meta:
 	$(MKDIR) $(FULLDOCDIR)
 	$(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 
+install-doc-html: install-doc-stdlib-html install-doc-sphinx
+
+install-doc-stdlib-html:
+	$(MKDIR) $(FULLDOCDIR)/html/stdlib
+	$(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: 
 	$(MKDIR) $(FULLDOCDIR)/ps $(FULLDOCDIR)/pdf
-	$(INSTALLLIB) doc/refman/Reference-Manual.pdf \
-		doc/stdlib/Library.pdf $(FULLDOCDIR)/pdf
-	$(INSTALLLIB) doc/refman/Reference-Manual.ps \
-		doc/stdlib/Library.ps $(FULLDOCDIR)/ps
+	$(INSTALLLIB) doc/stdlib/Library.pdf $(FULLDOCDIR)/pdf
+	$(INSTALLLIB) 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)
-	$(INSTALLLIB) $(INDEXURLS) $(FULLDATADIR)
 
+install-doc-sphinx:
+	$(MKDIR) $(FULLDOCDIR)/sphinx
+	(for f in `cd doc/sphinx/_build; find . -type f`; do \
+		$(MKDIR) $$(dirname $(FULLDOCDIR)/sphinx/$$f);\
+		$(INSTALLLIB) doc/sphinx/_build/$$f $(FULLDOCDIR)/sphinx/$$f;\
+	done)
 
 ###########################################################################
 # Documentation of the source code (using ocamldoc)
@@ -407,10 +292,10 @@ install-doc-index-urls:
 
 OCAMLDOCDIR=dev/ocamldoc
 
-DOCMLIS=$(wildcard ./lib/*.mli ./intf/*.mli ./kernel/*.mli ./library/*.mli \
-	./engine/*.mli ./pretyping/*.mli ./interp/*.mli printing/*.mli \
-	./parsing/*.mli ./proofs/*.mli \
-	./tactics/*.mli ./stm/*.mli ./toplevel/*.mli ./ltac/*.mli)
+DOCMLLIBS= $(CORECMA:.cma=_MLLIB_DEPENDENCIES) $(PLUGINSCMO:.cmo=_MLPACK_DEPENDENCIES)
+DOCMLS=$(foreach lib,$(DOCMLLIBS),$(addsuffix .ml, $($(lib))))
+
+DOCMLIS=$(wildcard $(addsuffix /*.mli, $(SRCDIRS)))
 
 # Defining options to generate dependencies graphs
 DOT=dot
@@ -422,7 +307,7 @@ source-doc: mli-doc $(OCAMLDOCDIR)/coq.pdf
 
 $(OCAMLDOCDIR)/coq.tex: $(DOCMLIS:.mli=.cmi)
 	$(SHOW)'OCAMLDOC -latex -o $@'
-	$(HIDE)$(OCAMLFIND) ocamldoc -latex -rectypes -I $(MYCAMLP4LIB) $(MLINCLUDES)\
+	$(HIDE)$(OCAMLFIND) ocamldoc -latex -rectypes -I $(MYCAMLP5LIB) $(MLINCLUDES)\
 	$(DOCMLIS) -noheader -t "Coq mlis documentation" \
 	-intro $(OCAMLDOCDIR)/docintro -o $@.tmp
 	$(SHOW)'OCAMLDOC utf8 fix'
@@ -432,13 +317,13 @@ $(OCAMLDOCDIR)/coq.tex: $(DOCMLIS:.mli=.cmi)
 
 mli-doc: $(DOCMLIS:.mli=.cmi)
 	$(SHOW)'OCAMLDOC -html'
-	$(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads -I $(MYCAMLP4LIB) $(MLINCLUDES) \
+	$(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads -I $(MYCAMLP5LIB) $(MLINCLUDES) \
 	$(DOCMLIS) -d $(OCAMLDOCDIR)/html -colorize-code \
 	-t "Coq mlis documentation" -intro $(OCAMLDOCDIR)/docintro \
 	-css-style style.css
 
 ml-dot: $(MLFILES)
-	$(OCAMLFIND) ocamldoc -dot -dot-reduce -rectypes -I +threads -I $(CAMLLIB) -I $(MYCAMLP4LIB) $(MLINCLUDES) \
+	$(OCAMLFIND) ocamldoc -dot -dot-reduce -rectypes -I +threads -I $(CAMLLIB) -I $(MYCAMLP5LIB) $(MLINCLUDES) \
 	$(filter $(addsuffix /%.ml,$(CORESRCDIRS)),$(MLFILES)) -o $(OCAMLDOCDIR)/coq.dot
 
 %_dep.png: %.dot
@@ -454,9 +339,14 @@ OCAMLDOC_MLLIBD = $(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -
 	$(OCAMLDOC_MLLIBD)
 
 ml-doc:
-	$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads $(MLINCLUDES) $(COQIDEFLAGS) -d $(OCAMLDOCDIR) $(MLSTATICFILES)
+	$(SHOW)'OCAMLDOC -html'
+	$(HIDE)mkdir -p $(OCAMLDOCDIR)/html/implementation
+	$(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads $(MLINCLUDES) $(COQIDEFLAGS) \
+	$(DOCMLS) -d $(OCAMLDOCDIR)/html/implementation -colorize-code \
+	-t "Coq mls documentation" \
+	-css-style ../style.css
 
-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
@@ -471,8 +361,7 @@ tactics/tactics.dot: | tactics/tactics.mllib.d ltac/ltac.mllib.d
 $(OCAMLDOCDIR)/%.pdf: $(OCAMLDOCDIR)/%.tex
 	$(SHOW)'PDFLATEX $*.tex'
 	$(HIDE)(cd $(OCAMLDOCDIR) ; pdflatex -interaction=batchmode $*.tex && pdflatex -interaction=batchmode $*.tex)
-	$(HIDE)(cd doc/tools/; show_latex_messages -no-overfull ../../$(OCAMLDOCDIR)/$*.log)
-
+	$(HIDE)(cd doc/tools/; ./show_latex_messages -no-overfull ../../$(OCAMLDOCDIR)/$*.log)
 
 # For emacs:
 # Local Variables:
diff --git a/Makefile.ide b/Makefile.ide
index 48a269ab..ac4ba75d 100644
--- a/Makefile.ide
+++ b/Makefile.ide
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 ## Makefile rules for building the CoqIDE interface
 
@@ -41,12 +43,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
 
@@ -55,29 +57,41 @@ IDEFILES=$(wildcard ide/*.lang) ide/coq_style.xml ide/coq.png ide/MacOS/default_
 GTKSHARE=$(shell pkg-config --variable=prefix gtk+-2.0)/share
 GTKBIN=$(shell pkg-config --variable=prefix gtk+-2.0)/bin
 GTKLIBS=$(shell pkg-config --variable=libdir gtk+-2.0)
-
+PIXBUFBIN=$(shell pkg-config --variable=prefix gdk-pixbuf-2.0)/bin
+SOURCEVIEWSHARE=$(shell pkg-config --variable=prefix gtksourceview-2.0)/share
 
 ###########################################################################
 # CoqIde special targets
 ###########################################################################
 
-.PHONY: coqide coqide-binaries coqide-no coqide-byte coqide-opt coqide-files
-.PHONY: ide-toploop
+.PHONY: coqide coqide-opt coqide-byte coqide-files coqide-binaries
+.PHONY: ide-toploop ide-byteloop ide-optloop
 
-# target to build CoqIde
-coqide: coqide-files coqide-binaries theories/Init/Prelude.vo
+# target to build CoqIde (native version) and the stuff needed to lauch it
+coqide: coqide-files coqide-opt theories/Init/Prelude.vo
 
-coqide-binaries: coqide-$(HASCOQIDE) ide-toploop
-coqide-no:
-coqide-byte: $(COQIDEBYTE) $(COQIDE)
-coqide-opt:  $(COQIDEBYTE) $(COQIDE)
-coqide-files: $(IDEFILES)
-ifeq ($(BEST),opt)
-ide-toploop: $(IDETOPLOOPCMA) $(IDETOPLOOPCMA:.cma=.cmxs)
+# target to build CoqIde (in native and byte versions), and no more
+# NB: this target is used in the opam package coq-coqide
+coqide-binaries: coqide-opt coqide-byte
+
+ifeq ($(HASCOQIDE),opt)
+coqide-opt: $(COQIDE) ide-toploop
 else
-ide-toploop: $(IDETOPLOOPCMA)
+coqide-opt: ide-toploop
 endif
 
+ifeq ($(HASCOQIDE),no)
+coqide-byte: ide-byteloop
+else
+coqide-byte: $(COQIDEBYTE) ide-byteloop
+endif
+
+coqide-files: $(IDEFILES)
+
+ide-byteloop: $(IDETOPLOOPCMA)
+ide-optloop: $(IDETOPLOOPCMA:.cma=.cmxs)
+ide-toploop: ide-$(BEST)loop
+
 ifeq ($(HASCOQIDE),opt)
 $(COQIDE): $(LINKIDEOPT)
 	$(SHOW)'OCAMLOPT -o $@'
@@ -94,9 +108,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
@@ -109,35 +123,59 @@ ide/%.cmo: ide/%.ml
 
 ide/%.cmx: ide/%.ml
 	$(SHOW)'OCAMLOPT  $<'
-	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) $(HACKMLI) -c $<
+	$(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
 ####################
 
-.PHONY: install-coqide install-ide-bin install-ide-toploop install-ide-files install-ide-info install-ide-devfiles
+.PHONY: install-coqide install-ide-bin install-ide-toploop install-ide-files install-ide-info install-ide-devfiles install-ide-byte install-ide-toploop-byte install-coqide-byte
 
 ifeq ($(HASCOQIDE),no)
 install-coqide: install-ide-toploop
 else
 install-coqide: install-ide-bin install-ide-toploop install-ide-files install-ide-info install-ide-devfiles
 endif
+ifeq ($(HASCOQIDE),no)
+install-coqide-byte: install-ide-toploop-byte
+else
+install-coqide-byte: install-ide-toploop-byte install-ide-byte
+endif
+
+# Apparently, coqide.byte is not meant to be installed
+
+install-ide-byte:
+	$(MKDIR) $(FULLCOQLIB)
+	$(INSTALLSH) $(FULLCOQLIB) $(IDECMA)
 
 install-ide-bin:
 	$(MKDIR) $(FULLBINDIR)
 	$(INSTALLBIN) $(COQIDE) $(FULLBINDIR)
 
 install-ide-toploop:
-	$(MKDIR) $(FULLCOQLIB)/toploop
-	$(INSTALLBIN) $(IDETOPLOOPCMA) $(FULLCOQLIB)/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
 
 install-ide-devfiles:
 	$(MKDIR) $(FULLCOQLIB)
-	$(INSTALLSH) $(FULLCOQLIB) $(IDECMA) \
+	$(INSTALLSH) $(FULLCOQLIB) \
 	  $(foreach lib,$(IDECMA:.cma=_MLLIB_DEPENDENCIES),$(addsuffix .cmi,$($(lib))))
 ifeq ($(BEST),opt)
 	$(INSTALLSH) $(FULLCOQLIB) $(IDECMA:.cma=.cmxa) $(IDECMA:.cma=.a)
@@ -176,15 +214,14 @@ $(COQIDEAPP)/Contents/Resources/share: $(COQIDEAPP)/Contents
 	$(MKDIR) $@/coq/
 	$(INSTALLLIB) ide/coq.png ide/*.lang ide/coq_style.xml $@/coq/
 	$(MKDIR) $@/gtksourceview-2.0/{language-specs,styles}
-	$(INSTALLLIB) "$(GTKSHARE)/"gtksourceview-2.0/language-specs/{def.lang,language2.rng} $@/gtksourceview-2.0/language-specs/
-	$(INSTALLLIB) "$(GTKSHARE)/"gtksourceview-2.0/styles/{styles.rng,classic.xml} $@/gtksourceview-2.0/styles/
+	$(INSTALLLIB) "$(SOURCEVIEWSHARE)/"gtksourceview-2.0/language-specs/{def.lang,language2.rng} $@/gtksourceview-2.0/language-specs/
+	$(INSTALLLIB) "$(SOURCEVIEWSHARE)/"gtksourceview-2.0/styles/{styles.rng,classic.xml} $@/gtksourceview-2.0/styles/
 	cp -R "$(GTKSHARE)/"locale $@
-	cp -R "$(GTKSHARE)/"icons $@
 	cp -R "$(GTKSHARE)/"themes $@
 
 $(COQIDEAPP)/Contents/Resources/loaders: $(COQIDEAPP)/Contents
 	$(MKDIR) $@
-	$(INSTALLLIB) $$("$(GTKBIN)/gdk-pixbuf-query-loaders" | sed -n -e '5 s!.*= \(.*\)$$!\1!p')/libpixbufloader-png.so $@
+	$(INSTALLLIB) $$("$(PIXBUFBIN)/gdk-pixbuf-query-loaders" | sed -n -e '5 s!.*= \(.*\)$$!\1!p')/libpixbufloader-png.so $@
 
 $(COQIDEAPP)/Contents/Resources/immodules: $(COQIDEAPP)/Contents
 	$(MKDIR) $@
@@ -195,7 +232,7 @@ $(COQIDEAPP)/Contents/Resources/etc: $(COQIDEAPP)/Contents/Resources/lib
 	$(MKDIR) $@/xdg/coq
 	$(INSTALLLIB) ide/MacOS/default_accel_map $@/xdg/coq/coqide.keys
 	$(MKDIR) $@/gtk-2.0
-	{ "$(GTKBIN)/gdk-pixbuf-query-loaders" $@/../loaders/*.so |\
+	{ "$(PIXBUFBIN)/gdk-pixbuf-query-loaders" $@/../loaders/*.so |\
 	 sed -e "s!/.*\(/loaders/.*.so\)!@executable_path/../Resources/\1!"; } \
 	> $@/gtk-2.0/gdk-pixbuf.loaders
 	{ "$(GTKBIN)/gtk-query-immodules-2.0" $@/../immodules/*.so |\
@@ -207,32 +244,11 @@ $(COQIDEAPP)/Contents/Resources/etc: $(COQIDEAPP)/Contents/Resources/lib
 
 $(COQIDEAPP)/Contents/Resources/lib: $(COQIDEAPP)/Contents/Resources/immodules $(COQIDEAPP)/Contents/Resources/loaders $(COQIDEAPP)/Contents $(COQIDEINAPP)
 	$(MKDIR) $@
-	$(INSTALLLIB) $(GTKLIBS)/charset.alias $@/
-	$(MKDIR) $@/pango/1.8.0/modules
-	$(INSTALLLIB) "$(GTKLIBS)/pango/1.8.0/modules/"*.so $@/pango/1.8.0/modules/
-	{ "$(GTKBIN)/pango-querymodules" $@/pango/1.8.0/modules/*.so |\
-	 sed -e "s!/.*\(/pango/1.8.0/modules/.*.so\)!@executable_path/../Resources/lib\1!"; } \
-	> $@/pango/1.8.0/modules.cache
-
-	for i in $$(otool -L $(COQIDEINAPP) |sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
-	    do cp $$i $@/; \
-	    ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$i) $(GTKLIBS) $@; \
-	done
-	for i in $@/../loaders/*.so $@/../immodules/*.so $@/pango/1.8.0/modules/*.so; \
-	    do \
-		for j in $$(otool -L $$i | sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
-		do cp $$j $@/; ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$j) $(GTKLIBS) $@; done; \
-		ide/MacOS/relatify_with-respect-to_.sh $$i $(GTKLIBS) $@; \
-	    done
-	EXTRAWORK=1; \
-	while [ $${EXTRAWORK} -eq 1 ]; \
-	do EXTRAWORK=0; \
-	    for i in $@/*.dylib; \
-	    do for j in $$(otool -L $$i | sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
-		do EXTRAWORK=1; cp $$j $@/; ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$j) $(GTKLIBS) $@; done; \
-	    done; \
+	macpack -d ../Resources/lib $(COQIDEINAPP)
+	for i in $@/../loaders/*.so $@/../immodules/*.so; \
+	do \
+	  macpack -d ../lib $$i; \
 	done
-	ide/MacOS/relatify_with-respect-to_.sh $(COQIDEINAPP) $(GTKLIBS) $@
 
 $(COQIDEAPP)/Contents/Resources:$(COQIDEAPP)/Contents/Resources/etc $(COQIDEAPP)/Contents/Resources/share
 	$(INSTALLLIB) ide/MacOS/*.icns $@
diff --git a/Makefile.install b/Makefile.install
index 4800ea0b..5f4458c2 100644
--- a/Makefile.install
+++ b/Makefile.install
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 # This makefile regroups installation rules
 # It is included by Makefile.build
@@ -56,27 +58,38 @@ FULLDOCDIR=$(DOCDIR)
 endif
 
 .PHONY: install-coq install-binaries install-byte install-opt
-.PHONY: install-tools install-library install-devfiles
+.PHONY: install-tools install-library install-devfiles install-merlin
 .PHONY: install-coq-info install-coq-manpages install-emacs install-latex
 .PHONY: install-meta
 
 install-coq: install-binaries install-library install-coq-info install-devfiles
 
+ifeq ($(BEST),byte)
+install-coq: install-byte
+endif
+
 install-binaries: install-tools
 	$(MKDIR) $(FULLBINDIR)
-	$(INSTALLBIN) $(COQC) $(COQTOPBYTE) $(COQTOPEXE) $(CHICKEN) $(FULLBINDIR)
+	$(INSTALLBIN) $(COQC) $(COQTOPEXE) $(CHICKEN) $(FULLBINDIR)
 	$(MKDIR) $(FULLCOQLIB)/toploop
-	$(INSTALLBIN) $(TOPLOOPCMA) $(FULLCOQLIB)/toploop/
 ifeq ($(BEST),opt)
 	$(INSTALLBIN) $(TOPLOOPCMA:.cma=.cmxs) $(FULLCOQLIB)/toploop/
 endif
 
+install-byte: install-coqide-byte
+	$(MKDIR) $(FULLBINDIR)
+	$(INSTALLBIN) $(COQTOPBYTE) $(FULLBINDIR)
+	$(MKDIR) $(FULLCOQLIB)/toploop
+	$(INSTALLBIN) $(TOPLOOPCMA) $(FULLCOQLIB)/toploop/
+	$(INSTALLSH) $(FULLCOQLIB) $(LINKCMO) $(PLUGINS)
+ifndef CUSTOM
+	$(INSTALLLIB) $(DLLCOQRUN) $(FULLCOQLIB)
+endif
 
 install-tools:
 	$(MKDIR) $(FULLBINDIR)
-	# recopie des fichiers de style pour coqide
+	# copy style files for 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)
 
@@ -90,25 +103,36 @@ INSTALLCMI = $(sort \
 	$(foreach lib,$(CORECMA), $(addsuffix .cmi,$($(lib:.cma=_MLLIB_DEPENDENCIES))))) \
 	$(PLUGINS:.cmo=.cmi)
 
+INSTALLCMX = $(sort $(filter-out checker/% ide/% tools/% dev/% \
+	configure.cmx toplevel/coqtop_byte_bin.cmx plugins/extraction/big.cmx, \
+	$(MLFILES:.ml=.cmx)))
+
 install-devfiles:
 	$(MKDIR) $(FULLBINDIR)
-	$(INSTALLBIN) $(COQMKTOP) $(FULLBINDIR)
 	$(MKDIR) $(FULLCOQLIB)
-	$(INSTALLSH)  $(FULLCOQLIB) $(LINKCMO) $(GRAMMARCMA)
-	$(INSTALLSH)  $(FULLCOQLIB) $(INSTALLCMI)
+	$(INSTALLSH)  $(FULLCOQLIB) $(GRAMMARCMA)
+	$(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)
 endif
 
+install-merlin:
+	$(INSTALLSH) $(FULLCOQLIB) $(wildcard $(INSTALLCMX:.cmx=.cmt) $(INSTALLCMI:.cmi=.cmti) $(MLIFILES) $(MLFILES) $(MERLINFILES))
+
 install-library:
 	$(MKDIR) $(FULLCOQLIB)
-	$(INSTALLSH) $(FULLCOQLIB) $(LIBFILES) $(PLUGINS)
+	$(INSTALLSH) $(FULLCOQLIB) $(LIBFILES)
 	$(MKDIR) $(FULLCOQLIB)/user-contrib
+	$(MKDIR) $(FULLCOQLIB)/kernel/byterun
 ifndef CUSTOM
-	$(INSTALLLIB) $(DLLCOQRUN) $(FULLCOQLIB)
+	$(INSTALLLIB) $(DLLCOQRUN) $(FULLCOQLIB)/kernel/byterun
 endif
 ifeq ($(BEST),opt)
-	$(INSTALLLIB) $(LIBCOQRUN) $(FULLCOQLIB)
+	$(INSTALLLIB) $(LIBCOQRUN) $(FULLCOQLIB)/kernel/byterun
 	$(INSTALLSH) $(FULLCOQLIB) $(PLUGINSOPT)
 endif
 # csdpcert is not meant to be directly called by the user; we install
@@ -123,7 +147,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
@@ -131,7 +155,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.doc b/README.doc
deleted file mode 100644
index 4e72c894..00000000
--- 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 a41ee7cc..51dd3f27 100644
--- a/README.md
+++ b/README.md
@@ -1,24 +1,33 @@
 # 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)
+[![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
-See the file `INSTALL` for installation procedure.
+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/doc](http://coq.inria.fr/doc).
+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` that explains the differences and the
+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
@@ -33,12 +42,13 @@ 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
 used, and include a complete source example leading to the bug.
+
+## Contributing
+
+Guidelines for contributing to Coq in various ways are listed in the [contributor's guide](CONTRIBUTING.md).
diff --git a/appveyor.yml b/appveyor.yml
new file mode 100644
index 00000000..cd3b88d0
--- /dev/null
+++ b/appveyor.yml
@@ -0,0 +1,19 @@
+version: '{branch}~{build}'
+clone_depth: 10
+
+platform:
+- x64
+
+image:
+- Visual Studio 2017
+
+environment:
+  CYGMIRROR: http://ftp.inf.tu-dresden.de/software/windows/cygwin32
+  matrix:
+  - USEOPAM: true
+    ARCH: 64
+
+build_script:
+- cmd: 'call %APPVEYOR_BUILD_FOLDER%\dev\ci\appveyor.bat'
+
+test: off
diff --git a/checker/Makefile b/checker/Makefile
deleted file mode 100644
index 2bcc9d36..00000000
--- a/checker/Makefile
+++ /dev/null
@@ -1,88 +0,0 @@
-OCAMLC=ocamlc
-OCAMLOPT=ocamlopt
-
-COQSRC=..
-
-MLDIRS=-I $(COQSRC)/config -I $(COQSRC)/lib -I $(COQSRC)/kernel -I +camlp4
-BYTEFLAGS=$(MLDIRS)
-OPTFLAGS=$(MLDIRS)
-
-CHECKERNAME=coqchk
-
-BINARIES=../bin/$(CHECKERNAME)$(EXE) ../bin/$(CHECKERNAME).opt$(EXE)
-MCHECKERLOCAL :=\
-  declarations.cmo environ.cmo \
-  closure.cmo reduction.cmo \
-  type_errors.cmo \
-  modops.cmo \
-  inductive.cmo typeops.cmo \
-  indtypes.cmo subtyping.cmo mod_checking.cmo \
-validate.cmo \
-  safe_typing.cmo check.cmo \
-  check_stat.cmo checker.cmo
-
-MCHECKER:=\
-  $(COQSRC)/config/coq_config.cmo \
-  $(COQSRC)/lib/pp_control.cmo $(COQSRC)/lib/pp.cmo $(COQSRC)/lib/compat.cmo \
-  $(COQSRC)/lib/util.cmo $(COQSRC)/lib/option.cmo $(COQSRC)/lib/hashcons.cmo \
-  $(COQSRC)/lib/system.cmo $(COQSRC)/lib/flags.cmo \
-  $(COQSRC)/lib/predicate.cmo $(COQSRC)/lib/rtree.cmo \
-  $(COQSRC)/kernel/names.cmo $(COQSRC)/kernel/univ.cmo \
-  $(COQSRC)/kernel/esubst.cmo term.cmo \
-  $(MCHECKERLOCAL)
-
-all: $(BINARIES)
-
-byte : ../bin/$(CHECKERNAME)$(EXE)
-opt : ../bin/$(CHECKERNAME).opt$(EXE)
-
-check.cma: $(MCHECKERLOCAL)
-	ocamlc $(BYTEFLAGS) -a -o $@ $(MCHECKER)
-
-check.cmxa: $(MCHECKERLOCAL:.cmo=.cmx)
-	ocamlopt $(OPTFLAGS) -a -o $@ $(MCHECKER:.cmo=.cmx)
-
-../bin/$(CHECKERNAME)$(EXE): check.cma
-	ocamlc $(BYTEFLAGS) -o $@ unix.cma gramlib.cma check.cma main.ml
-
-../bin/$(CHECKERNAME).opt$(EXE): check.cmxa
-	ocamlopt $(OPTFLAGS) -o $@ unix.cmxa gramlib.cmxa check.cmxa main.ml
-
-stats:
-	@echo STRUCTURE
-	@wc names.ml term.ml declarations.ml environ.ml type_errors.ml
-	@echo
-	@echo REDUCTION
-	@-wc esubst.ml closure.ml reduction.ml
-	@echo
-	@echo TYPAGE
-	@wc univ.ml inductive.ml indtypes.ml typeops.ml safe_typing.ml
-	@echo
-	@echo MODULES
-	@wc modops.ml subtyping.ml
-	@echo
-	@echo INTERFACE
-	@wc check*.ml main.ml 
-	@echo
-	@echo TOTAL
-	@wc *.ml | tail -1
-
-.SUFFIXES:.ml .mli .cmi .cmo .cmx
-
-.ml.cmo:
-	$(OCAMLC) -c $(BYTEFLAGS) $<
-
-.ml.cmx:
-	$(OCAMLOPT) -c $(OPTFLAGS) $<
-
-.mli.cmi:
-	$(OCAMLC) -c $(BYTEFLAGS) $<
-
-
-depend::
-	ocamldep *.ml* > .depend
-
-clean::
-	rm -f *.cm* *.o *.a *~ $(BINARIES)
-
--include .depend
diff --git a/checker/analyze.ml b/checker/analyze.ml
index c48b8301..7047d8a1 100644
--- a/checker/analyze.ml
+++ b/checker/analyze.ml
@@ -4,6 +4,7 @@ let prefix_small_block =         0x80
 let prefix_small_int =           0x40
 let prefix_small_string =        0x20
 
+[@@@ocaml.warning "-32"]
 let code_int8 =                  0x00
 let code_int16 =                 0x01
 let code_int32 =                 0x02
@@ -25,6 +26,7 @@ let code_infixpointer =          0x11
 let code_custom =                0x12
 let code_block64 =               0x13
 
+[@@@ocaml.warning "-37"]
 type code_descr =
 | CODE_INT8
 | CODE_INT16
@@ -53,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 *)
@@ -80,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) =
@@ -101,11 +152,11 @@ let input_binary_int chan =
   input_binary_int chan
 
 let input_char chan = Char.chr (input_byte chan)
+let input_string len chan = String.init len (fun _ -> input_char chan)
 
 let parse_header chan =
   let () = current_offset := 0 in
-  let magic = String.create 4 in
-  let () = for i = 0 to 3 do magic.[i] <- input_char chan done in
+  let magic = input_string 4 chan in
   let length = input_binary_int chan in
   let objects = input_binary_int chan in
   let size32 = input_binary_int chan in
@@ -204,13 +255,6 @@ let input_header64 chan =
   in
   (tag, len)
 
-let input_string len chan =
-  let ans = String.create len in
-  for i = 0 to pred len do
-    ans.[i] <- input_char chan;
-  done;
-  ans
-
 let parse_object chan =
   let data = input_byte chan in
   if prefix_small_block <= data then
@@ -251,7 +295,7 @@ let parse_object chan =
     RString (input_string len chan)
   | CODE_CODEPOINTER ->
     let addr = input_int32u chan in
-    for i = 0 to 15 do ignore (input_byte chan); done;
+    for _i = 0 to 15 do ignore (input_byte chan); done;
     RCode addr
   | CODE_DOUBLE_ARRAY32_LITTLE
   | CODE_DOUBLE_BIG
@@ -266,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 ->
@@ -277,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) ->
@@ -287,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 ->
@@ -348,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 42efcf01..9c837643 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 8b299bf2..4bb485d2 100644
--- a/checker/check.ml
+++ b/checker/check.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -22,6 +24,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 +76,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 ->
-    error ("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 +131,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: "./" *)
@@ -165,7 +165,7 @@ let find_logical_path phys_dir =
   match List.filter2 (fun p d -> p = phys_dir) physical logical with
   | _,[dir] -> dir
   | _,[] -> default_root_prefix
-  | _,l -> anomaly (Pp.str ("Two logical paths are associated to "^phys_dir))
+  | _,l -> anomaly (Pp.str ("Two logical paths are associated to "^phys_dir^"."))
 
 let remove_load_path dir =
   let physical, logical = !load_paths in
@@ -197,7 +197,7 @@ let add_load_path (phys_path,coq_path) =
 	    end
       | _,[] ->
 	  load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths)
-      | _ -> anomaly (Pp.str ("Two logical paths are associated to "^phys_path))
+      | _ -> anomaly (Pp.str ("Two logical paths are associated to "^phys_path^"."))
 
 let load_paths_of_dir_path dir =
   let physical, logical = !load_paths in
@@ -227,13 +227,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
@@ -248,12 +243,12 @@ let locate_qualified_library qid =
 
 let error_unmapped_dir qid =
   let prefix = qid.dirpath in
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str "Cannot load " ++ pr_path qid ++ str ":" ++ spc () ++
      str "no physical path bound to" ++ spc () ++ pr_dirlist prefix ++ fnl ())
 
 let error_lib_not_found qid =
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str"Cannot find library " ++ pr_path qid ++ str" in loadpath")
 
 let try_locate_absolute_library dir =
@@ -263,7 +258,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,34 +303,43 @@ 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
       if not (String.equal (Digest.channel ch pos) checksum) then
-        errorlabstrm "intern_from_file" (str "Checksum mismatch");
+        user_err ~hdr:"intern_from_file" (str "Checksum mismatch");
       let () = close_in ch in
       if dir <> sd.md_name then
-        errorlabstrm "intern_from_file"
+        user_err ~hdr:"intern_from_file"
           (name_clash_message dir sd.md_name f);
       if tasks <> None || discharging <> None then
-        errorlabstrm "intern_from_file"
+        user_err ~hdr:"intern_from_file"
           (str "The file "++str f++str " contains unfinished tasks");
       if opaque_csts <> None then begin
        chk_pp (str " (was a vio file) ");
       Option.iter (fun (_,_,b) -> if not b then
-        errorlabstrm "intern_from_file"
+        user_err ~hdr:"intern_from_file"
           (str "The file "++str f++str " is still a .vio"))
         opaque_csts;
       Validate.validate !Flags.debug Values.v_univopaques opaque_csts;
@@ -412,9 +426,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 00000000..eb6404a1
--- /dev/null
+++ b/checker/check.mli
@@ -0,0 +1,32 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 488507a1..f79ba66e 100644
--- a/checker/check.mllib
+++ b/checker/check.mllib
@@ -1,5 +1,6 @@
 Coq_config
 
+Analyze
 Hook
 Terminal
 Canary
diff --git a/checker/check_stat.ml b/checker/check_stat.ml
index 741f5328..3f00f924 100644
--- a/checker/check_stat.ml
+++ b/checker/check_stat.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
diff --git a/checker/check_stat.mli b/checker/check_stat.mli
index 39e19d10..823b107f 100644
--- a/checker/check_stat.mli
+++ b/checker/check_stat.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val memory_stat : bool ref
diff --git a/checker/checker.ml b/checker/checker.ml
index 8dbb7e01..fd2725c8 100644
--- a/checker/checker.ml
+++ b/checker/checker.ml
@@ -1,25 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open System
-open Flags
 open Names
 open Check
 
 let () = at_exit flush_all
 
-let chk_pp = Pp.pp_with Format.std_formatter
+let pp_arrayi pp fmt a = Array.iteri (fun i x -> pp fmt (i,x)) a
 
 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 +42,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 +76,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 +98,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 +130,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 +142,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 +176,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,15 +210,16 @@ 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 "\""
 
-let where s =
+let where = function
+| None -> mt ()
+| Some s ->
   if !Flags.debug then  (str"in " ++ str s ++ str":" ++ spc ()) else (mt ())
 
-let rec explain_exn = function
+let explain_exn = function
   | Stream.Failure ->
       hov 0 (anomaly_string () ++ str "uncaught Stream.Failure.")
   | Stream.Error txt ->
@@ -269,26 +269,26 @@ let rec explain_exn = function
       | Generalization _ -> str"Generalization"
       | ActualType _ -> str"ActualType"
       | CantApplyBadType ((n,a,b),(hd,hdty),args) ->
-          Format.printf "====== ill-typed term ====@\n";
-          Format.printf "@[<hov 2>application head=@ ";
-          Print.print_pure_constr hd;
-          Format.printf "@]@\n@[<hov 2>head type=@ ";
-          Print.print_pure_constr hdty;
-          Format.printf "@]@\narguments:@\n@[<hv>";
-          Array.iteri (fun i (t,ty) ->
-            Format.printf "@[<hov 2>arg %d=@ " (i+1);
-            Print.print_pure_constr t;
-            Format.printf "@ type=@ ";
-            Print.print_pure_constr ty) args;
-          Format.printf "@]@\n====== type error ====@\n";
-          Print.print_pure_constr b;
-          Format.printf "@\nis not convertible with@\n";
-          Print.print_pure_constr a;
-          Format.printf "@\n====== universes ====@\n";
-          chk_pp
-            (Univ.pr_universes
-            (ctx.Environ.env_stratification.Environ.env_universes));
-          str "\nCantApplyBadType at argument " ++ int n
+        (* This mix of printf / pp was here before... *)
+        let fmt = Format.std_formatter in
+        let open Format in
+        let open Print in
+        fprintf fmt "====== ill-typed term ====@\n";
+        fprintf fmt "@[<hov 2>application head=@ %a@]@\n" print_pure_constr hd;
+        fprintf fmt "@[<hov 2>head type=@ %a@]@\n" print_pure_constr hdty;
+        let pp_arg fmt (i,(t,ty)) = fprintf fmt "@[<hv>@[<1>arg %d=@ @[%a@]@]@,@[<1>type=@ @[%a@]@]@]@\n@," (i+1)
+            print_pure_constr t print_pure_constr ty
+        in
+        fprintf fmt "arguments:@\n@[<hv>%a@]@\n" (pp_arrayi pp_arg) args;
+        fprintf fmt "====== type error ====@\n";
+        fprintf fmt "%a@\n" print_pure_constr b;
+        fprintf fmt "is not convertible with@\n";
+        fprintf fmt "%a@\n" print_pure_constr a;
+        fprintf fmt "====== universes ====@\n";
+        fprintf fmt "%a@\n%!" Pp.pp_with
+          (Univ.pr_universes
+             (ctx.Environ.env_stratification.Environ.env_universes));
+        str "CantApplyBadType at argument " ++ int n
       | CantApplyNonFunctional _ -> str"CantApplyNonFunctional"
       | IllFormedRecBody _ -> str"IllFormedRecBody"
       | IllTypedRecBody _ -> str"IllTypedRecBody"
@@ -309,6 +309,9 @@ let rec 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
     | [] -> ()
@@ -322,25 +325,28 @@ 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
 
     | "-where" :: _ ->
-        Envars.set_coqlib ~fail:CErrors.error;
+        Envars.set_coqlib ~fail:(fun x -> CErrors.user_err Pp.(str x));
         print_endline (Envars.coqlib ());
         exit 0
 
     | ("-?"|"-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
@@ -352,7 +358,7 @@ let parse_args argv =
     | "-norec" :: [] -> usage ()
 
     | "-silent" :: rem ->
-        Flags.make_silent true; parse rem
+        Flags.quiet := true; parse rem
 
     | s :: _ when s<>"" && s.[0]='-' ->
         fatal_error (str "Unknown option " ++ str s) false
@@ -364,15 +370,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:CErrors.error;
-      if_verbose print_header ();
+      Envars.set_coqlib ~fail:(fun x -> CErrors.user_err Pp.(str x));
+      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 00000000..582f4258
--- /dev/null
+++ b/checker/checker.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val start : unit -> unit
diff --git a/checker/cic.mli b/checker/cic.mli
index 36455875..c4b00d0d 100644
--- a/checker/cic.mli
+++ b/checker/cic.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Type definitions for the Calculus of Inductive Constructions *)
@@ -81,7 +83,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
 
@@ -102,7 +104,7 @@ type constr =
   | Case      of case_info * constr * constr * constr array
   | Fix       of constr pfixpoint
   | CoFix     of constr pcofixpoint
-  | Proj      of projection * constr
+  | Proj      of Projection.t * constr
 
 type existential = constr pexistential
 type rec_declaration = constr prec_declaration
@@ -127,12 +129,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 +172,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) } *)
 
 
@@ -182,8 +195,6 @@ type ('a, 'b) declaration_arity =
   | RegularArity of 'a
   | TemplateArity of 'b
 
-type constant_type = (constr, rel_context * template_arity) declaration_arity
-
 (** Inlining level of parameters at functor applications.
     This is ignored by the checker. *)
 
@@ -196,7 +207,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 *)
@@ -209,7 +220,9 @@ type constant_def =
   | Def of constr_substituted
   | OpaqueDef of lazy_constr
 
-type constant_universes = Univ.universe_context
+type constant_universes =
+  | Monomorphic_const of Univ.ContextSet.t
+  | Polymorphic_const of Univ.abstract_universe_context
 
 (** The [typing_flags] are instructions to the type-checker which
     modify its behaviour. The typing flags used in the type-checking
@@ -219,14 +232,14 @@ 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 = {
     const_hyps : section_context; (** New: younger hyp at top *)
     const_body : constant_def;
-    const_type : constant_type;
+    const_type : constr;
     const_body_code : to_patch_substituted;
-    const_polymorphic : bool; (** Is it polymorphic or not *)
     const_universes : constant_universes;
     const_proj : projection_body option;
     const_inline_code : bool;
@@ -242,7 +255,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,6 +316,11 @@ type one_inductive_body = {
     mind_reloc_tbl : reloc_table;
   }
 
+type abstract_inductive_universes =
+  | Monomorphic_ind of Univ.ContextSet.t
+  | Polymorphic_ind of Univ.abstract_universe_context
+  | Cumulative_ind of Univ.abstract_cumulativity_info
+
 type mutual_inductive_body = {
 
     mind_packets : one_inductive_body array;  (** The component of the mutual inductive block *)
@@ -321,9 +339,7 @@ type mutual_inductive_body = {
 
     mind_params_ctxt : rel_context;  (** The context of parameters (includes let-in declaration) *)
 
-    mind_polymorphic : bool; (** Is it polymorphic or not *)
-
-    mind_universes : Univ.universe_context; (** Local universe variables and constraints *)
+    mind_universes : abstract_inductive_universes; (** Local universe variables and constraints together with subtyping constraints *)
 
     mind_private : bool option; (** allow pattern-matching: Some true ok, Some false blocked *)
 
@@ -344,13 +360,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 *)
@@ -383,9 +397,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;
@@ -393,13 +407,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 cef1d31a..b9ae4daa 100644
--- a/checker/closure.ml
+++ b/checker/closure.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -49,13 +51,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 +58,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 +73,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 *)
@@ -160,22 +135,16 @@ let betaiotazeta = mkflags [fBETA;fIOTA;fZETA]
  * instantiations (cbv or lazy) are.
  *)
 
-type 'a tableKey =
-  | ConstKey of 'a
-  | VarKey of Id.t
-  | RelKey of int
+type table_key = Constant.t puniverses tableKey
+
 
-type table_key = constant puniverses tableKey
+let eq_pconstant_key (c,u) (c',u') =
+  eq_constant_key c c' && Univ.Instance.equal u u'
 
 module KeyHash =
 struct
   type t = table_key
-  let equal k1 k2 = match k1, k2 with
-  | ConstKey (c1,u1), ConstKey (c2,u2) -> Constant.UserOrd.equal c1 c2 
-    && Univ.Instance.equal u1 u2
-  | VarKey id1, VarKey id2 -> Id.equal id1 id2
-  | RelKey i1, RelKey i2 -> Int.equal i1 i2
-  | (ConstKey _ | VarKey _ | RelKey _), _ -> false
+  let equal = Names.eq_table_key eq_pconstant_key
 
   open Hashset.Combine
 
@@ -226,8 +195,6 @@ let defined_rels flags env =
 
 let mind_equiv_infos info = mind_equiv info.i_env
 
-let eq_table_key = KeyHash.equal
-
 let create mk_cl flgs env =
   { i_flags = flgs;
     i_repr = mk_cl;
@@ -276,14 +243,13 @@ and fterm =
   | FInd of pinductive
   | FConstruct of pconstructor
   | FApp of fconstr * fconstr array
-  | FProj of projection * fconstr
+  | FProj of Projection.t * 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,9 +272,8 @@ 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
+  | Zproj of int * int * Projection.t
   | Zfix of fconstr * stack
   | Zshift of int
   | Zupdate of fconstr
@@ -328,6 +293,12 @@ let zshift n s =
     | (_,Zshift(k)::s) -> Zshift(n+k)::s
     | _ -> Zshift(n)::s
 
+let rec stack_args_size = function
+  | Zapp v :: s -> Array.length v + stack_args_size s
+  | Zshift(_)::s -> stack_args_size s
+  | Zupdate(_)::s -> stack_args_size s
+  | _ -> 0
+
 (* Lifting. Preserves sharing (useful only for cell with norm=Red).
    lft_fconstr always create a new cell, while lift_fconstr avoids it
    when the lift is 0. *)
@@ -450,13 +421,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
@@ -526,9 +494,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
@@ -610,7 +575,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
   | [] ->
@@ -651,22 +616,6 @@ let drop_parameters depth n argstk =
 
 (** Projections and eta expansion *)
 
-let rec get_parameters depth n argstk =
-  match argstk with
-      Zapp args::s ->
-        let q = Array.length args in
-        if n > q then Array.append args (get_parameters depth (n-q) s)
-        else if Int.equal n q then [||]
-        else Array.sub args 0 n
-    | Zshift(k)::s -> 
-      get_parameters (depth-k) n s
-    | [] -> (* we know that n < stack_args_size(argstk) (if well-typed term) *)
-	if Int.equal n 0 then [||]
-	else raise Not_found (* Trying to eta-expand a partial application..., should do 
-				eta expansion first? *)
-    | _ -> assert false
-	(* strip_update_shift_app only produces Zapp and Zshift items *)
-
 let eta_expand_ind_stack env ind m s (f, s') =
   let mib = lookup_mind (fst ind) env in
     match mib.mind_record with
@@ -718,6 +667,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
@@ -730,7 +682,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
@@ -739,10 +690,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 *)
@@ -774,11 +724,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)))
@@ -788,10 +738,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
@@ -808,7 +754,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 _|Zproj _)::_) as stk')) ->
             let (fxe,fxbd) = contract_fix_vect m.term in
             knit info fxe fxbd (args@stk')
         | (_,args,s) -> (m,args@s))
@@ -845,6 +791,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 8b1f246c..49b07f73 100644
--- a/checker/closure.mli
+++ b/checker/closure.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -24,14 +26,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 +36,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
@@ -66,12 +58,8 @@ val betaiotazeta       : reds
 val betadeltaiotanolet : reds
 
 (***********************************************************************)
-type 'a tableKey =
-  | ConstKey of 'a
-  | 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
@@ -95,14 +83,13 @@ type fterm =
   | FInd of pinductive
   | FConstruct of pconstructor
   | FApp of fconstr * fconstr array
-  | FProj of projection * fconstr
+  | FProj of Projection.t * 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,9 +102,8 @@ 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
+  | Zproj of int * int * Projection.t
   | Zfix of fconstr * stack
   | Zshift of int
   | Zupdate of fconstr
@@ -125,11 +111,16 @@ type stack_member =
 and stack = stack_member list
 
 val append_stack : fconstr array -> stack -> stack
+
+val stack_args_size : stack -> int
+    
 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 *)
@@ -139,13 +130,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 *)
 
@@ -165,7 +158,6 @@ val unfold_reference : clos_infos -> table_key -> fconstr option
 (* [mind_equiv] checks whether two inductive types are intentionally equal *)
 val mind_equiv_infos : clos_infos -> inductive -> inductive -> bool
 
-val eq_table_key : table_key -> table_key -> bool
 (************************************************************************)
 (*i This is for lazy debug *)
 
diff --git a/checker/declarations.ml b/checker/declarations.ml
index 1fe02c8b..d2c3f203 100644
--- a/checker/declarations.ml
+++ b/checker/declarations.ml
@@ -6,6 +6,7 @@ open Term
 (** Substitutions, code imported from kernel/mod_subst *)
 
 module Deltamap = struct
+  [@@@ocaml.warning "-32-34"]
   type t = delta_resolver
   let empty = MPmap.empty, KNmap.empty
   let is_empty (mm, km) = MPmap.is_empty mm && KNmap.is_empty km
@@ -25,6 +26,7 @@ end
 let empty_delta_resolver = Deltamap.empty
 
 module Umap = struct
+  [@@@ocaml.warning "-32-34"]
   type 'a t = 'a umap_t
   let empty = MPmap.empty, MBImap.empty
   let is_empty (m1,m2) = MPmap.is_empty m1 && MBImap.is_empty m2
@@ -194,7 +196,7 @@ let subst_con0 sub con u =
   let dup con = con, Const (con, u) in
   let side,con',resolve = gen_subst_mp rebuild_con sub mp1 mp2 in
   match constant_of_delta_with_inline resolve con' with
-    | Some t -> con', t
+    | Some t -> con', subst_instance_constr u t
     | None ->
       let con'' = match side with
 	| User -> constant_of_delta resolve con'
@@ -461,13 +463,6 @@ let is_opaque cb = match cb.const_body with
 
 let opaque_univ_context cb = force_lazy_constr_univs cb.const_body
 
-let subst_rel_declaration sub (id,copt,t as x) =
-  let copt' = Option.smartmap (subst_mps sub) copt in
-  let t' = subst_mps sub t in
-  if copt == copt' && t == t' then x else (id,copt',t')
-
-let subst_rel_context sub = List.smartmap (subst_rel_declaration sub)
-
 let subst_recarg sub r = match r with
   | Norec  -> r
   | (Mrec(kn,i)|Imbr (kn,i)) -> let kn' = subst_ind sub kn in
@@ -489,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
@@ -515,27 +510,22 @@ let subst_decl_arity f g sub ar =
       if x' == x then ar
       else TemplateArity x'
 
-let map_decl_arity f g = function
-  | RegularArity a -> RegularArity (f a)
-  | TemplateArity a -> TemplateArity (g a)
-
 let subst_rel_declaration sub =
   Term.map_rel_decl (subst_mps sub)
 
 let subst_rel_context sub = List.smartmap (subst_rel_declaration sub)
 
-let subst_template_cst_arity sub (ctx,s as arity) =
-  let ctx' = subst_rel_context sub ctx in
-    if ctx==ctx' then arity else (ctx',s)
-
-let subst_arity sub s = subst_decl_arity subst_mps subst_template_cst_arity sub s
+let constant_is_polymorphic cb =
+  match cb.const_universes with
+  | Monomorphic_const _ -> false
+  | Polymorphic_const _ -> true
 
 (* TODO: should be changed to non-coping after Term.subst_mps *)
 (* NB: we leave bytecode and native code fields untouched *)
 let subst_const_body sub cb =
  { cb with
     const_body = subst_constant_def sub cb.const_body;
-    const_type = subst_arity sub cb.const_type }
+    const_type = subst_mps sub cb.const_type }
 
 
 let subst_regular_ind_arity sub s =
@@ -583,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 456df836..7458b3e0 100644
--- a/checker/declarations.mli
+++ b/checker/declarations.mli
@@ -14,6 +14,7 @@ val body_of_constant : constant_body -> constr option
 val constant_has_body : constant_body -> bool
 val is_opaque : constant_body -> bool
 val opaque_univ_context : constant_body -> Univ.ContextSet.t
+val constant_is_polymorphic : constant_body -> bool
 
 (* Mutual inductives *)
 
@@ -33,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 7b59c6b9..bbd043c8 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
@@ -45,12 +54,14 @@ let set_engagement (impr_set as c) env =
     env.env_stratification.env_engagement in
   begin
     match impr_set,expected_impr_set with
-    | PredicativeSet, ImpredicativeSet -> error "Incompatible engagement"
+    | PredicativeSet, ImpredicativeSet -> user_err Pp.(str "Incompatible engagement")
     | _ -> ()
   end;
   { 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 =
@@ -106,7 +117,7 @@ let anomaly s = anomaly (Pp.str s)
 
 let add_constant kn cs env =
   if Cmap_env.mem kn env.env_globals.env_constants then
-    Printf.ksprintf anomaly ("Constant %s is already defined")
+    Printf.ksprintf anomaly ("Constant %s is already defined.")
       (Constant.to_string kn);
   let new_constants =
     Cmap_env.add kn cs env.env_globals.env_constants in
@@ -120,35 +131,33 @@ type const_evaluation_result = NoBody | Opaque
 (* Constant types *)
 
 let constraints_of cb u =
-  let univs = cb.const_universes in
-    Univ.subst_instance_constraints u (Univ.UContext.constraints univs)
-
-let map_regular_arity f = function
-  | RegularArity a as ar -> 
-    let a' = f a in 
-      if a' == a then ar else RegularArity a'
-  | TemplateArity _ -> assert false
+  match cb.const_universes with
+  | Monomorphic_const _ -> Univ.Constraint.empty
+  | Polymorphic_const ctx -> Univ.AUContext.instantiate u ctx
 
 (* constant_type gives the type of a constant *)
 let constant_type env (kn,u) =
   let cb = lookup_constant kn env in
-    if cb.const_polymorphic then
-      let csts = constraints_of cb u in
-	(map_regular_arity (subst_instance_constr u) cb.const_type, csts)
-    else cb.const_type, Univ.Constraint.empty
+  match cb.const_universes with
+  | Monomorphic_const _ -> cb.const_type, Univ.Constraint.empty
+  | Polymorphic_const ctx -> 
+    let csts = constraints_of cb u in
+    (subst_instance_constr u cb.const_type, csts)
 
 exception NotEvaluableConst of const_evaluation_result
 
 let constant_value env (kn,u) =
   let cb = lookup_constant kn env in
-    match cb.const_body with
-    | Def l_body -> 
-      let b = force_constr l_body in
-	if cb.const_polymorphic then
-	  subst_instance_constr u (force_constr l_body)
-	else b
-    | OpaqueDef _ -> raise (NotEvaluableConst Opaque)
-    | Undef _ -> raise (NotEvaluableConst NoBody)
+  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 =
@@ -161,7 +170,7 @@ let is_projection cst env =
 let lookup_projection p env =
   match (lookup_constant (Projection.constant p) env).const_proj with 
   | Some pb -> pb
-  | None -> anomaly ("lookup_projection: constant is not a projection")
+  | None -> anomaly ("lookup_projection: constant is not a projection.")
 
 (* Mutual Inductives *)
 let scrape_mind env kn=
@@ -182,7 +191,7 @@ let lookup_mind kn env =
 
 let add_mind kn mib env =
   if Mindmap_env.mem kn env.env_globals.env_inductives then
-    Printf.ksprintf anomaly ("Inductive %s is already defined")
+    Printf.ksprintf anomaly ("Inductive %s is already defined.")
       (MutInd.to_string kn);
   let new_inds = Mindmap_env.add kn mib env.env_globals.env_inductives in
   let kn1,kn2 =  MutInd.user kn, MutInd.canonical kn in
@@ -201,7 +210,7 @@ let add_mind kn mib env =
 
 let add_modtype ln mtb env =
   if MPmap.mem ln env.env_globals.env_modtypes then
-    Printf.ksprintf anomaly ("Module type %s is already defined")
+    Printf.ksprintf anomaly ("Module type %s is already defined.")
       (ModPath.to_string ln);
   let new_modtypes = MPmap.add ln mtb env.env_globals.env_modtypes in
   let new_globals =
@@ -211,7 +220,7 @@ let add_modtype ln mtb env =
 
 let shallow_add_module mp mb env =
   if MPmap.mem mp env.env_globals.env_modules then
-    Printf.ksprintf anomaly ("Module %s is already defined")
+    Printf.ksprintf anomaly ("Module %s is already defined.")
       (ModPath.to_string mp);
   let new_mods = MPmap.add mp mb env.env_globals.env_modules in
   let new_globals =
@@ -221,7 +230,7 @@ let shallow_add_module mp mb env =
 
 let shallow_remove_module mp env =
   if not (MPmap.mem mp env.env_globals.env_modules) then
-    Printf.ksprintf anomaly ("Module %s is unknown")
+    Printf.ksprintf anomaly ("Module %s is unknown.")
       (ModPath.to_string mp);
   let new_mods = MPmap.remove mp env.env_globals.env_modules in
   let new_globals =
diff --git a/checker/environ.mli b/checker/environ.mli
index 87f143d1..81da8387 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 -> constant_type Univ.constrained
+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 lookup_projection : projection -> env -> projection_body
+val is_projection : Constant.t -> env -> bool
+val lookup_projection : Projection.t -> 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 6bea3c91..da034635 100644
--- a/checker/include
+++ b/checker/include
@@ -13,7 +13,6 @@
 #directory "kernel";;
 #directory "checker";;
 #directory "+threads";;
-#directory "+camlp4";;
 #directory "+camlp5";;
 
 #load "unix.cma";;
@@ -116,7 +115,7 @@ let prsub s =
 #install_printer prsub;;*)
 
 Checker.init_with_argv [|"";"-coqlib";"."|];;
-Flags.make_silent false;;
+Flags.quiet := false;;
 Flags.debug := true;;
 Sys.catch_break true;;
 
diff --git a/checker/indtypes.ml b/checker/indtypes.ml
index 27f79e79..916934a8 100644
--- a/checker/indtypes.ml
+++ b/checker/indtypes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -100,7 +102,7 @@ let rec sorts_of_constr_args env t =
         let env1 = push_rel (LocalDef (name,def,ty)) env in
 	sorts_of_constr_args env1 c
     | _ when is_constructor_head t -> []
-    | _ -> anomaly ~label:"infos_and_sort" (Pp.str "not a positive constructor")
+    | _ -> anomaly ~label:"infos_and_sort" (Pp.str "not a positive constructor.")
 
 
 (* Prop and Set are small *)
@@ -302,11 +304,11 @@ let failwith_non_pos n ntypes c =
 
 let failwith_non_pos_vect n ntypes v =
   Array.iter (failwith_non_pos n ntypes) v;
-  anomaly ~label:"failwith_non_pos_vect" (Pp.str "some k in [n;n+ntypes-1] should occur")
+  anomaly ~label:"failwith_non_pos_vect" (Pp.str "some k in [n;n+ntypes-1] should occur.")
 
 let failwith_non_pos_list n ntypes l =
   List.iter (failwith_non_pos n ntypes) l;
-  anomaly ~label:"failwith_non_pos_list" (Pp.str "some k in [n;n+ntypes-1] should occur")
+  anomaly ~label:"failwith_non_pos_list" (Pp.str "some k in [n;n+ntypes-1] should occur.")
 
 (* Conclusion of constructors: check the inductive type is called with
    the expected parameters *)
@@ -502,10 +504,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 =
@@ -524,29 +535,104 @@ let check_positivity env_ar mind params nrecp inds =
   let wfp = Rtree.mk_rec irecargs in
   Array.iter2 (fun ind wfpi -> check_subtree ind.mind_recargs wfpi) inds wfp
 
+(* Check arities and constructors *)
+let check_subtyping_arity_constructor env (subst : Univ.Instance.t) (arcn : constr) numparams is_arity =
+  let numchecked = ref 0 in
+  let basic_check ev tp =
+    if !numchecked < numparams then () else conv_leq ev tp (Term.subst_instance_constr subst tp);
+    numchecked := !numchecked + 1
+  in
+  let check_typ typ typ_env =
+    match typ with
+    | LocalAssum (_, typ') ->
+      begin
+       try
+          basic_check typ_env typ'; Environ.push_rel typ typ_env
+        with NotConvertible -> 
+          anomaly ~label:"bad inductive subtyping relation" (Pp.str "Invalid subtyping relation")
+      end
+    | _ -> anomaly (Pp.str "")
+  in
+  let typs, codom = dest_prod env arcn in
+  let last_env = fold_rel_context_outside check_typ typs ~init:env in
+  if not is_arity then basic_check last_env codom else ()
+
+(* Check that the subtyping information inferred for inductive types in the block is correct. *)
+(* This check produces a value of the unit type if successful or raises an anomaly if check fails. *)
+let check_subtyping cumi paramsctxt env inds =
+  let open Univ in
+  let numparams = rel_context_nhyps paramsctxt in
+  (** In [env] we already have [ Var(0) ... Var(n-1) |- cst ] available.
+      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 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_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
+      | RegularArity { mind_user_arity = full_arity} ->
+        check_subtyping_arity_constructor env inst full_arity numparams true;
+        Array.iter (fun cnt -> check_subtyping_arity_constructor env inst cnt numparams false) lc
+      | TemplateArity _ -> ()
+    ) inds
+    
 (************************************************************************)
 (************************************************************************)
 
 let check_inductive env kn mib =
   Flags.if_verbose Feedback.msg_notice (str "  checking ind: " ++ MutInd.print kn);
   (* check mind_constraints: should be consistent with env *)
-  let env = add_constraints (Univ.UContext.constraints mib.mind_universes) env in
+  let env0 =
+    match mib.mind_universes with
+    | Monomorphic_ind _ -> env
+    | Polymorphic_ind auctx ->
+      let uctx = Univ.AUContext.repr auctx in
+      Environ.push_context uctx env
+    | Cumulative_ind cumi -> 
+      let uctx = Univ.AUContext.repr (Univ.ACumulativityInfo.univ_context cumi) in
+      Environ.push_context uctx env
+  in
+  (** Locally set the oracle for further typechecking *)
+  let env0 = Environ.set_oracle env0 mib.mind_typing_flags.conv_oracle in
   (* check mind_record : TODO ? check #constructor = 1 ? *)
   (* check mind_finite : always OK *)
   (* check mind_ntypes *)
   if Array.length mib.mind_packets <> mib.mind_ntypes then
-    error "not the right number of packets";
+    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
-    error "number the right number of parameters";
+    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 *)
+  let () = 
+    match mib.mind_universes with
+    | Monomorphic_ind _ | Polymorphic_ind _ -> ()
+    | Cumulative_ind acumi ->
+      check_subtyping acumi params env_ar mib.mind_packets
+  in
   (* check mind_nparams_rec: positivity condition *)
   check_positivity env_ar kn params mib.mind_nparams_rec mib.mind_packets;
   (* check mind_equiv... *)
diff --git a/checker/indtypes.mli b/checker/indtypes.mli
index 071eecbb..baaa66a6 100644
--- a/checker/indtypes.mli
+++ b/checker/indtypes.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -12,8 +14,8 @@ open Cic
 open Environ
 (*i*)
 
-val prkn : kernel_name -> Pp.std_ppcmds
-val prcon : constant -> Pp.std_ppcmds
+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 +36,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 c4ffc141..e1c6b135 100644
--- a/checker/inductive.ml
+++ b/checker/inductive.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -27,7 +29,7 @@ type mind_specif = mutual_inductive_body * one_inductive_body
 let lookup_mind_specif env (kn,tyi) =
   let mib = lookup_mind kn env in
   if tyi >= Array.length mib.mind_packets then
-    error "Inductive.lookup_mind_specif: invalid inductive index";
+    user_err Pp.(str "Inductive.lookup_mind_specif: invalid inductive index");
   (mib, mib.mind_packets.(tyi))
 
 let find_rectype env c =
@@ -54,10 +56,17 @@ let inductive_params (mib,_) = mib.mind_nparams
 
 (** Polymorphic inductives *)
 
-let inductive_instance mib =
-  if mib.mind_polymorphic then
-    UContext.instance mib.mind_universes
-  else Instance.empty
+let inductive_is_polymorphic mib =
+  match mib.mind_universes with
+  | Monomorphic_ind _ -> false
+  | Polymorphic_ind ctx -> true
+  | Cumulative_ind cumi -> true
+
+let inductive_is_cumulative mib =
+  match mib.mind_universes with
+  | Monomorphic_ind _ -> false
+  | Polymorphic_ind ctx -> false
+  | Cumulative_ind cumi -> true
 
 (************************************************************************)
 
@@ -75,7 +84,7 @@ let constructor_instantiate mind u mib c =
 
 let instantiate_params full t u args sign =
   let fail () =
-    anomaly ~label:"instantiate_params" (Pp.str "type, ctxt and args mismatch") in
+    anomaly ~label:"instantiate_params" (Pp.str "type, ctxt and args mismatch.") in
   let (rem_args, subs, ty) =
     fold_rel_context
       (fun decl (largs,subs,ty) ->
@@ -93,7 +102,7 @@ let instantiate_params full t u args sign =
 
 let full_inductive_instantiate mib u params sign =
   let dummy = Prop Null in
-  let t = mkArity (subst_instance_context u sign,dummy) in
+  let t = mkArity (Term.subst_instance_context u sign,dummy) in
     fst (destArity (instantiate_params true t u params mib.mind_params_ctxt))
 
 let full_constructor_instantiate ((mind,_),u,(mib,_),params) t =
@@ -149,7 +158,7 @@ let remember_subst u subst =
 
 (* Bind expected levels of parameters to actual levels *)
 (* Propagate the new levels in the signature *)
-let rec make_subst env =
+let make_subst env =
   let rec make subst = function
     | LocalDef _ :: sign, exp, args ->
         make subst (sign, exp, args)
@@ -199,7 +208,7 @@ let instantiate_universes env ctx ar argsorts =
 let type_of_inductive_gen env ((mib,mip),u) paramtyps =
   match mip.mind_arity with
   | RegularArity a ->
-    if not mib.mind_polymorphic then a.mind_user_arity
+    if not (inductive_is_polymorphic mib) then a.mind_user_arity
     else subst_instance_constr u a.mind_user_arity
   | TemplateArity ar ->
     let ctx = List.rev mip.mind_arity_ctxt in
@@ -232,7 +241,7 @@ let type_of_constructor_subst cstr u (mib,mip) =
   let specif = mip.mind_user_lc in
   let i = index_of_constructor cstr in
   let nconstr = Array.length mip.mind_consnames in
-  if i > nconstr then error "Not enough constructors in the type.";
+  if i > nconstr then user_err Pp.(str "Not enough constructors in the type.");
     constructor_instantiate (fst ind) u mib specif.(i-1)
 
 let type_of_constructor_gen (cstr,u) (mib,mip as mspec) =
@@ -374,7 +383,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)
@@ -428,27 +437,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 pp_recarg = function
-  | Norec -> Pp.str "Norec"
-  | Mrec i -> Pp.str ("Mrec "^MutInd.to_string (fst i))
-  | Imbr i -> Pp.str ("Imbr "^MutInd.to_string (fst i))
-
-let pp_wf_paths = Rtree.pp_tree pp_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 +540,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 +641,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
@@ -993,7 +989,7 @@ let check_one_fix renv recpos trees def =
             List.iter (check_rec_call renv []) l;
             check_rec_call renv [] c
 
-        | Var _ -> anomaly (Pp.str "Section variable in Coqchk !")
+        | Var _ -> anomaly (Pp.str "Section variable in Coqchk!")
 
 	| Sort _ -> assert (l = [])
 
@@ -1011,7 +1007,7 @@ let check_one_fix renv recpos trees def =
 	    check_rec_call renv [] a;
             let renv' = push_var_renv renv (x,a) in
 	      check_nested_fix_body renv' (decr-1) recArgsDecrArg b
-	| _ -> anomaly (Pp.str "Not enough abstractions in fix body")
+	| _ -> anomaly (Pp.str "Not enough abstractions in fix body.")
 	    
   in
   check_rec_call renv [] def
@@ -1025,7 +1021,7 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
     || Array.length names <> nbfix
     || bodynum < 0
     || bodynum >= nbfix
-  then anomaly (Pp.str "Ill-formed fix term");
+  then anomaly (Pp.str "Ill-formed fix term.");
   let fixenv = push_rec_types recdef env in
   let raise_err env i err =
     error_ill_formed_rec_body env err names i in
@@ -1046,7 +1042,7 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
 		    raise_err env i (RecursionNotOnInductiveType a) in
                 (mind, (env', b))
 	      else check_occur env' (n+1) b
-            else anomaly ~label:"check_one_fix" (Pp.str "Bad occurrence of recursive call")
+            else anomaly ~label:"check_one_fix" (Pp.str "Bad occurrence of recursive call.")
         | _ -> raise_err env i NotEnoughAbstractionInFixBody in
     check_occur fixenv 1 def in
   (* Do it on every fixpoint *)
@@ -1070,8 +1066,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;;
 *)
 
 (************************************************************************)
@@ -1080,7 +1076,7 @@ let check_fix env fix = Profile.profile3 cfkey check_fix env fix;;
 exception CoFixGuardError of env * guard_error
 
 let anomaly_ill_typed () =
-  anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor")
+  anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor.")
 
 let rec codomain_is_coind env c =
   let b = whd_all env c in
diff --git a/checker/inductive.mli b/checker/inductive.mli
index ed3a7b53..0ca0d14a 100644
--- a/checker/inductive.mli
+++ b/checker/inductive.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -22,14 +24,16 @@ type mind_specif = mutual_inductive_body * one_inductive_body
     Raises [Not_found] if the inductive type is not found. *)
 val lookup_mind_specif : env -> inductive -> mind_specif
 
-val inductive_instance : mutual_inductive_body -> Univ.universe_instance
+val inductive_is_polymorphic : mutual_inductive_body -> bool
+
+val inductive_is_cumulative : mutual_inductive_body -> bool
 
 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 00000000..9db9ecd1
--- /dev/null
+++ b/checker/main.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* 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 7f93e156..3ef2b340 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -1,9 +1,7 @@
-
 open Pp
 open Util
 open Names
 open Cic
-open Term
 open Reduction
 open Typeops
 open Indtypes
@@ -14,51 +12,39 @@ open Environ
 
 (** {6 Checking constants } *)
 
-let refresh_arity ar =
-  let ctxt, hd = decompose_prod_assum ar in
-  match hd with
-      Sort (Type u) when not (Univ.is_univ_variable u) ->
-      let ul = Univ.Level.make DirPath.empty 1 in
-      let u' = Univ.Universe.make ul in
-      let cst = Univ.enforce_leq u u' Univ.empty_constraint in
-      let ctx = Univ.ContextSet.make (Univ.LSet.singleton ul) cst in
-        mkArity (ctxt,Prop Null), ctx
-    | _ -> ar, Univ.ContextSet.empty
-
 let check_constant_declaration env kn cb =
-  Flags.if_verbose 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' =
-    if cb.const_polymorphic then
-      let inst = Univ.make_abstract_instance cb.const_universes in
-      let ctx = Univ.UContext.make (inst, Univ.UContext.constraints cb.const_universes) in
-        push_context ~strict:false ctx env
-    else push_context ~strict:true cb.const_universes env
-  in
-  let envty, ty = 
-    match cb.const_type with
-      RegularArity ty ->
-        let ty', cu = refresh_arity ty in
-        let envty = push_context_set cu env' in
-        let _ = infer_type envty ty' in envty, ty
-    | TemplateArity(ctxt,par) ->
-        let _ = check_ctxt env' ctxt in
-        check_polymorphic_arity env' ctxt par;
-	env', it_mkProd_or_LetIn (Sort(Type par.template_level)) ctxt 
+    match cb.const_universes with
+    | 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
   in
+  let ty = cb.const_type in
+  let () = ignore(infer_type env' ty) in
   let () = 
     match body_of_constant cb with
     | Some bd ->
       (match cb.const_proj with 
-      | None -> let j = infer envty bd in
-		  conv_leq envty j ty
+      | None -> let j = infer env' bd in
+                  conv_leq env' j ty
       | Some pb -> 
 	let env' = add_constant kn cb env' in
 	let j = infer env' bd in
-	  conv_leq envty j ty)
+          conv_leq env' j ty)
     | None -> ()
   in
-  if cb.const_polymorphic 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 } *)
 
@@ -74,12 +60,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 5c7b392f..c9e7f9a1 100644
--- a/checker/mod_checking.mli
+++ b/checker/mod_checking.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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 b720fb62..c7ad0977 100644
--- a/checker/modops.ml
+++ b/checker/modops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -16,29 +18,29 @@ open Declarations
 (*i*)
 
 let error_not_a_constant l =
-  error ("\""^(Label.to_string l)^"\" is not a constant")
+  user_err Pp.(str ("\""^(Label.to_string l)^"\" is not a constant"))
 
-let error_not_a_functor () = error "Application of not a functor"
+let error_not_a_functor () = user_err Pp.(str "Application of not a functor")
 
-let error_incompatible_modtypes _ _ = error "Incompatible module types"
+let error_incompatible_modtypes _ _ = user_err Pp.(str "Incompatible module types")
 
 let error_not_match l _ =
-  error ("Signature components for label "^Label.to_string l^" do not match")
+  user_err Pp.(str ("Signature components for label "^Label.to_string l^" do not match"))
 
-let error_no_such_label l = error ("No such label "^Label.to_string l)
+let error_no_such_label l = user_err Pp.(str ("No such label "^Label.to_string l))
 
 let error_no_such_label_sub l l1 =
   let l1 = ModPath.to_string l1 in
-  error ("The field "^
-         Label.to_string l^" is missing in "^l1^".")
+  user_err Pp.(str ("The field "^
+         Label.to_string l^" is missing in "^l1^"."))
 
-let error_not_a_module_loc loc s =
-  user_err_loc (loc,"",str ("\""^Label.to_string s^"\" is not a module"))
+let error_not_a_module_loc ?loc s =
+  user_err ?loc  (str ("\""^Label.to_string s^"\" is not a module"))
 
-let error_not_a_module s = error_not_a_module_loc Loc.ghost s
+let error_not_a_module s = error_not_a_module_loc s
 
 let error_with_module () =
-  error "Unsupported 'with' constraint in module implementation"
+  user_err Pp.(str "Unsupported 'with' constraint in module implementation")
 
 let is_functor = function
   | MoreFunctor _ -> true
@@ -49,7 +51,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) =
@@ -83,27 +85,29 @@ let strengthen_const mp_from l cb resolver =
     | Def _ -> cb
     | _ ->
       let con = Constant.make2 mp_from l in
-      let u = 
-	if cb.const_polymorphic then
-	  Univ.make_abstract_instance cb.const_universes
-	else Univ.Instance.empty
+      let u =
+        match cb.const_universes with
+      | Monomorphic_const _ -> Univ.Instance.empty
+      | Polymorphic_const auctx -> Univ.make_abstract_instance auctx
       in
       { cb with
 	const_body = Def (Declarations.from_val (Const (con,u))) }
 
 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 +134,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 +142,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 26a088f3..9f6f7811 100644
--- a/checker/modops.mli
+++ b/checker/modops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -15,7 +17,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 +26,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.ml b/checker/print.ml
index 7ef752b0..fc9cd687 100644
--- a/checker/print.ml
+++ b/checker/print.ml
@@ -1,146 +1,96 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Format
 open Cic
 open Names
 
-let chk_pp = Pp.pp_with Format.std_formatter
+let chk_pp fmt = Pp.pp_with fmt
+let pp_arrayi pp fmt a = Array.iteri (fun i x -> pp fmt (i,x)) a
+let pp_instance fmt i = chk_pp fmt (Univ.Instance.pr i)
+let pp_id fmt id = fprintf fmt "%s" (Id.to_string id)
 
-let print_instance i = chk_pp (Univ.Instance.pr i)
-
-let print_pure_constr csr =
-  let rec term_display c = match  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)
-  | Sort s -> sort_display s
-  | Cast (c,_, t) -> open_hovbox 1;
-      print_string "("; (term_display c); print_cut();
-      print_string "::"; (term_display t); print_string ")"; close_box()
+let print_pure_constr fmt csr =
+  let rec pp_term fmt c = match  c with
+  | Rel n  -> fprintf fmt "#%d" n
+  | Meta n -> fprintf fmt "Meta(%d)" n
+  | Var id -> pp_id fmt id
+  | Sort s -> pp_sort fmt s
+  | Cast (c,_, t) ->
+    fprintf fmt "@[<hov 1>(%a@;::%a)@]" pp_term c pp_term t
   | Prod (Name(id),t,c) ->
-      open_hovbox 1;
-      print_string"("; print_string (Id.to_string id);
-      print_string ":"; box_display t;
-      print_string ")"; print_cut();
-      box_display c; close_box()
+    fprintf fmt "@[<hov 1>(%a:%a)@;@[%a@]@]" pp_id id pp_term t pp_term c
   | Prod (Anonymous,t,c) ->
-      print_string"("; box_display t; print_cut(); print_string "->";
-      box_display c; print_string ")";
+    fprintf fmt "(%a@,->@[%a@])" pp_term t pp_term c
   | Lambda (na,t,c) ->
-      print_string "["; name_display na;
-      print_string ":"; box_display t; print_string "]";
-      print_cut(); box_display c;
+    fprintf fmt "[%a:@[%a@]]@,@[%a@]" pp_name na pp_term t pp_term c
   | LetIn (na,b,t,c) ->
-      print_string "["; name_display na; print_string "=";
-      box_display b; print_cut();
-      print_string ":"; box_display t; print_string "]";
-      print_cut(); box_display c;
+    fprintf fmt "[%a=@[%a@]@,:@[%a@]]@,@[%a@]" pp_name na pp_term b pp_term t pp_term c
   | App (c,l) ->
-      print_string "(";
-      box_display c;
-      Array.iter (fun x -> print_space (); box_display x) l;
-      print_string ")"
-  | Evar _ -> print_string "Evar#"
-  | Const (c,u) -> print_string "Cons(";
-      sp_con_display c;
-      print_string ","; print_instance u;
-      print_string ")"
+    fprintf fmt "(@[%a@]@, @[<hov 1>%a@])" pp_term c (pp_arrayi (fun _ (_,s) -> fprintf fmt "@[%a@]@," pp_term s)) l;
+  | Evar _ -> pp_print_string fmt "Evar#"
+  | Const (c,u) ->
+    fprintf fmt "Cons(@[%a,%a@])" sp_con_display c pp_instance u
   | Ind ((sp,i),u) ->
-      print_string "Ind(";
-      sp_display sp;
-      print_string ","; print_int i;
-      print_string ","; print_instance u;
-      print_string ")"
+    fprintf fmt "Ind(@[%a,%d,%a@])" sp_display sp i pp_instance u
   | Construct (((sp,i),j),u) ->
-      print_string "Constr(";
-      sp_display sp;
-      print_string ",";
-      print_int i; print_string ","; print_int j; 
-      print_string ","; print_instance u; print_string ")"
+    fprintf fmt "Constr(%a,%d,%d,%a)" sp_display sp i j pp_instance u
   | Case (ci,p,c,bl) ->
-      open_vbox 0;
-      print_string "<"; box_display p; print_string ">";
-      print_cut(); print_string "Case";
-      print_space(); box_display c; print_space (); print_string "of";
-      open_vbox 0;
-      Array.iter (fun x ->  print_cut();  box_display x) bl;
-      close_box();
-      print_cut();
-      print_string "end";
-      close_box()
+    let pp_match fmt (_,mc) = fprintf fmt " @[%a@]" pp_term mc in
+    fprintf fmt "@[<v><@[%a@]>@,Case@ @[%a@]@ of@[<v>%a@]@,end@]" pp_term p pp_term c (pp_arrayi pp_match) bl
   | Fix ((t,i),(lna,tl,bl)) ->
-      print_string "Fix("; print_int i; print_string ")";
-      print_cut();
-      open_vbox 0;
-      let print_fix () =
-        for k = 0 to (Array.length tl) - 1 do
-	  open_vbox 0;
-	  name_display lna.(k); print_string "/";
-	  print_int t.(k); print_cut(); print_string ":";
-	  box_display tl.(k) ; print_cut(); print_string ":=";
-	  box_display bl.(k); close_box ();
-	  print_cut()
-        done
-      in print_string"{"; print_fix(); print_string"}"
+    let pp_fixc fmt (k,_) =
+      fprintf fmt "@[<v 0> %a/%d@,:@[%a@]@,:=@[%a@]@]@," pp_name lna.(k) t.(k) pp_term tl.(k) pp_term bl.(k) in
+    fprintf fmt "Fix(%d)@,@[<v>{%a}@]" i (pp_arrayi pp_fixc) tl
   | CoFix(i,(lna,tl,bl)) ->
-      print_string "CoFix("; print_int i; print_string ")";
-      print_cut();
-      open_vbox 0;
-      let print_fix () =
-        for k = 0 to (Array.length tl) - 1 do
-          open_vbox 1;
-	  name_display lna.(k);  print_cut(); print_string ":";
-	  box_display tl.(k) ; print_cut(); print_string ":=";
-	  box_display bl.(k); close_box ();
-	  print_cut();
-        done
-      in print_string"{"; print_fix (); print_string"}"
+    let pp_fixc fmt (k,_) =
+      fprintf fmt "@[<v 0> %a@,:@[%a@]@,:=@[%a@]@]@," pp_name lna.(k) pp_term tl.(k) pp_term bl.(k) in
+    fprintf fmt "CoFix(%d)@,@[<v>{%a}@]" i (pp_arrayi pp_fixc) tl
   | Proj (p, c) ->
-    print_string "Proj("; sp_con_display (Projection.constant p); print_string ","; 
-    box_display c; print_string ")"
+    fprintf fmt "Proj(%a,@,@[%a@])" sp_con_display (Projection.constant p) pp_term c
 
-  and box_display c = open_hovbox 1; term_display c; close_box()
+  and pp_sort fmt = function
+    | Prop(Pos) -> pp_print_string fmt  "Set"
+    | Prop(Null) -> pp_print_string fmt "Prop"
+    | Type u -> fprintf fmt "Type(%a)" chk_pp (Univ.pr_uni u)
 
-  and sort_display = function
-    | Prop(Pos) -> print_string "Set"
-    | Prop(Null) -> print_string "Prop"
-    | Type u -> print_string "Type("; chk_pp (Univ.pr_uni u); print_string ")"
+  and pp_name fmt = function
+    | Name id -> pp_id fmt id
+    | Anonymous -> pp_print_string fmt "_"
 
-  and name_display = function
-    | Name id -> print_string (Id.to_string id)
-    | Anonymous -> print_string "_"
 (* Remove the top names for library and Scratch to avoid long names *)
-  and sp_display sp =
-(*    let dir,l = decode_kn sp in
+  and sp_display fmt sp =
+(*  let dir,l = decode_kn sp in
     let ls =
       match List.rev_map Id.to_string (DirPath.repr dir) with
           ("Top"::l)-> l
 	| ("Coq"::_::l) -> l
 	| l             -> l
     in  List.iter (fun x -> print_string x; print_string ".") ls;*)
-      print_string (MutInd.debug_to_string sp)
-  and sp_con_display sp =
-(*    let dir,l = decode_kn sp in
+    pp_print_string fmt (MutInd.debug_to_string sp)
+
+  and sp_con_display fmt sp =
+    (*
+    let dir,l = decode_kn sp in
     let ls =
       match List.rev_map Id.to_string (DirPath.repr dir) with
           ("Top"::l)-> l
 	| ("Coq"::_::l) -> l
 	| l             -> l
     in  List.iter (fun x -> print_string x; print_string ".") ls;*)
-      print_string (Constant.debug_to_string sp)
+    pp_print_string fmt (Constant.debug_to_string sp)
 
   in
-    try
-     box_display csr; print_flush()
-    with e ->
-	print_string (Printexc.to_string e);print_flush ();
-	raise e
-
-
-
+  try
+    fprintf fmt "@[%a@]%!" pp_term csr
+  with e ->
+    pp_print_string fmt (Printexc.to_string e);
+    print_flush ();
+    raise e
diff --git a/checker/print.mli b/checker/print.mli
new file mode 100644
index 00000000..da1362ca
--- /dev/null
+++ b/checker/print.mli
@@ -0,0 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Cic
+
+val print_pure_constr : Format.formatter -> constr -> unit
diff --git a/checker/reduction.ml b/checker/reduction.ml
index ec16aa26..4e508dc7 100644
--- a/checker/reduction.ml
+++ b/checker/reduction.ml
@@ -1,11 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+open Names
 open CErrors
 open Util
 open Cic
@@ -42,8 +45,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
@@ -52,7 +55,7 @@ let compare_stack_shape stk1 stk2 =
 
 type lft_constr_stack_elt =
     Zlapp of (lift * fconstr) array
-  | Zlproj of Names.projection * lift
+  | Zlproj of Names.Projection.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
@@ -78,8 +81,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)
 
 (****************************************************************************)
@@ -117,6 +119,10 @@ let beta_appvect c v =
 (*                         Conversion                               *)
 (********************************************************************)
 
+type conv_pb =
+  | CONV
+  | CUMUL
+
 (* Conversion utility functions *)
 type 'a conversion_function = env -> 'a -> 'a -> unit
 
@@ -137,7 +143,7 @@ let compare_stacks f fmind lft1 stk1 lft2 stk2 =
             | (Zlfix(fx1,a1),Zlfix(fx2,a2)) ->
                 f fx1 fx2; cmp_rec a1 a2
 	    | (Zlproj (c1,l1),Zlproj (c2,l2)) -> 
-	       if not (Names.eq_con_chk
+               if not (Names.Constant.UserOrd.equal
 		       (Names.Projection.constant c1)
 		       (Names.Projection.constant c2)) then 
 		raise NotConvertible
@@ -152,11 +158,55 @@ let compare_stacks f fmind lft1 stk1 lft2 stk2 =
     cmp_rec (pure_stack lft1 stk1) (pure_stack lft2 stk2)
   else raise NotConvertible
 
-(* Convertibility of sorts *)
+let convert_inductive_instances cv_pb cumi u u' univs =
+  let len_instance =
+      Univ.AUContext.size (Univ.ACumulativityInfo.univ_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 variance = Univ.ACumulativityInfo.variance cumi in
+    let comp_cst =
+      match cv_pb with
+      | 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
+
+let convert_inductives
+    cv_pb (mind, ind) u1 sv1 u2 sv2 univs =
+  match mind.mind_universes with
+  | Monomorphic_ind _ | Polymorphic_ind _ -> convert_universes univs u1 u2
+  | Cumulative_ind cumi ->
+    let num_param_arity =
+      mind.mind_nparams + mind.mind_packets.(ind).mind_nrealargs
+    in
+    if not (num_param_arity = sv1 && num_param_arity = sv2) then
+      convert_universes univs u1 u2
+    else
+      convert_inductive_instances cv_pb cumi u1 u2 univs
+
+let convert_constructors
+    (mind, ind, cns) u1 sv1 u2 sv2 univs =
+  match mind.mind_universes with
+  | Monomorphic_ind _ | Polymorphic_ind _ -> convert_universes univs u1 u2
+  | Cumulative_ind cumi ->
+    let num_cnstr_args =
+      let nparamsctxt =
+        mind.mind_nparams + mind.mind_packets.(ind).mind_nrealargs
+      in
+      nparamsctxt + mind.mind_packets.(ind).mind_consnrealargs.(cns - 1)
+    in
+    if not (num_cnstr_args = sv1 && num_cnstr_args = sv2) then
+      convert_universes univs u1 u2
+    else
+      (** By invariant, both constructors have a common supertype,
+          so they are convertible _at that type_. *)
+      ()
 
-type conv_pb =
-  | CONV
-  | CUMUL
+(* Convertibility of sorts *)
 
 let sort_cmp env univ pb s0 s1 =
   match (s0,s1) with
@@ -176,9 +226,9 @@ let sort_cmp env univ pb s0 s1 =
         then begin
           if !Flags.debug then begin
             let op = match pb with CONV -> "=" | CUMUL -> "<=" in
-            Printf.eprintf "sort_cmp: %s\n%!" Pp.(string_of_ppcmds
-              (str"Error: " ++ Univ.pr_uni u1 ++ str op ++ Univ.pr_uni u2 ++ str ":" ++ cut()
-               ++ Univ.pr_universes univ))
+            Format.eprintf "sort_cmp: @[%a@]\n%!" Pp.pp_with Pp.(
+               str"Error: " ++ Univ.pr_uni u1 ++ str op ++ Univ.pr_uni u2 ++ str ":" ++ cut()
+               ++ Univ.pr_universes univ)
           end;
           raise NotConvertible
         end
@@ -190,7 +240,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
 
@@ -203,7 +252,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
 
@@ -213,13 +261,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
@@ -227,16 +274,34 @@ 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
+
+let eq_table_key univ =
+  Names.eq_table_key (fun (c1,u1) (c2,u2) ->
+      Constant.UserOrd.equal c1 c2 &&
+      Univ.Instance.check_eq univ u1 u2)
 
 (* Conversion between  [lft1]term1 and [lft2]term2 *)
 let rec ccnv univ cv_pb infos lft1 lft2 term1 term2 =
@@ -284,13 +349,13 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) =
     (* 2 constants, 2 local defined vars or 2 defined rels *)
     | (FFlex fl1, FFlex fl2) ->
 	(try (* try first intensional equality *)
-	  if eq_table_key fl1 fl2
+          if eq_table_key univ fl1 fl2
           then convert_stacks univ infos lft1 lft2 v1 v2
           else raise NotConvertible
         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 ->
@@ -307,12 +372,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 _) ->
@@ -333,13 +398,13 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) =
     (* Eta-expansion on the fly *)
     | (FLambda _, _) ->
         if v1 <> [] then
-          anomaly (Pp.str "conversion was given unreduced term (FLambda)");
+          anomaly (Pp.str "conversion was given unreduced term (FLambda).");
         let (_,_ty1,bd1) = destFLambda mk_clos hd1 in
         eqappr univ CONV infos
           (el_lift lft1,(bd1,[])) (el_lift lft2,(hd2,eta_expand_stack v2))
     | (_, FLambda _) ->
         if v2 <> [] then
-          anomaly (Pp.str "conversion was given unreduced term (FLambda)");
+          anomaly (Pp.str "conversion was given unreduced term (FLambda).");
         let (_,_ty2,bd2) = destFLambda mk_clos hd2 in
         eqappr univ CONV infos
           (el_lift lft1,(hd1,eta_expand_stack v1)) (el_lift lft2,(bd2,[]))
@@ -375,18 +440,37 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) =
     (* Inductive types:  MutInd MutConstruct Fix Cofix *)
 
     | (FInd (ind1,u1), FInd (ind2,u2)) ->
-        if mind_equiv_infos infos ind1 ind2
-	then
-	  (let () = convert_universes univ u1 u2 in
-           convert_stacks univ infos lft1 lft2 v1 v2)
-        else raise NotConvertible
-
-     | (FConstruct ((ind1,j1),u1), FConstruct ((ind2,j2),u2)) ->
-	 if Int.equal j1 j2 && mind_equiv_infos infos ind1 ind2
-	 then
-	  (let () = convert_universes univ u1 u2 in
-           convert_stacks univ infos lft1 lft2 v1 v2)
-         else raise NotConvertible
+      if mind_equiv_infos infos ind1 ind2 then
+        if Univ.Instance.length u1 = 0 || Univ.Instance.length u2 = 0 then
+          begin
+            convert_universes univ u1 u2;
+            convert_stacks univ infos lft1 lft2 v1 v2
+          end
+        else
+          let mind = Environ.lookup_mind (fst ind1) (infos_env infos) in
+          let () =
+            convert_inductives cv_pb (mind, snd ind1) u1 (stack_args_size v1)
+              u2 (stack_args_size v2) univ
+          in
+          convert_stacks univ infos lft1 lft2 v1 v2
+      else raise NotConvertible
+
+    | (FConstruct ((ind1,j1),u1), FConstruct ((ind2,j2),u2)) ->
+      if Int.equal j1 j2 && mind_equiv_infos infos ind1 ind2 then
+        if Univ.Instance.length u1 = 0 || Univ.Instance.length u2 = 0 then
+          begin
+            convert_universes univ u1 u2;
+            convert_stacks univ infos lft1 lft2 v1 v2
+          end
+        else
+          let mind = Environ.lookup_mind (fst ind1) (infos_env infos) in
+          let () =
+            convert_constructors
+              (mind, snd ind1, j1) u1 (stack_args_size v1)
+              u2 (stack_args_size v2) univ
+          in
+          convert_stacks univ infos lft1 lft2 v1 v2
+      else raise NotConvertible
 
      (* Eta expansion of records *)
      | (FConstruct ((ind1,j1),u1), _) ->
@@ -432,8 +516,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 *)
@@ -479,7 +563,7 @@ let vm_conv cv_pb = fconv cv_pb true
 let hnf_prod_app env t n =
   match whd_all env t with
     | Prod (_,_,b) -> subst1 n b
-    | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product")
+    | _ -> 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
@@ -508,7 +592,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
@@ -526,7 +609,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
@@ -536,5 +618,5 @@ let dest_arity env c =
   let l, c = dest_prod_assum env c in
   match c with
     | Sort s -> l,s
-    | _ -> error "not an arity"
+    | _ -> user_err Pp.(str "not an arity")
 
diff --git a/checker/reduction.mli b/checker/reduction.mli
index 15a2df1f..3bbf4654 100644
--- a/checker/reduction.mli
+++ b/checker/reduction.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
diff --git a/checker/safe_typing.ml b/checker/safe_typing.ml
index 11cd742b..e3640c37 100644
--- a/checker/safe_typing.ml
+++ b/checker/safe_typing.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -40,7 +42,7 @@ let check_engagement env expected_impredicative_set =
   begin
     match impredicative_set, expected_impredicative_set with
     | PredicativeSet, ImpredicativeSet ->
-        CErrors.error "Needs option -impredicative-set."
+        CErrors.user_err Pp.(str "Needs option -impredicative-set.")
     | _ -> ()
   end;
   ()
@@ -61,7 +63,7 @@ let check_imports f caller env needed =
       let actual_stamp = lookup_digest env dp in
       if stamp <> actual_stamp then report_clash f caller dp
     with Not_found ->
-      error ("Reference to unknown module " ^ (DirPath.to_string dp))
+      user_err Pp.(str ("Reference to unknown module " ^ (DirPath.to_string dp)))
   in
   Array.iter check needed
 
@@ -89,6 +91,6 @@ let import file clib univs digest =
 let unsafe_import file clib univs digest =
   let env = !genv in
   if !Flags.debug then check_imports Feedback.msg_warning clib.comp_name env clib.comp_deps
-  else check_imports (errorlabstrm"unsafe_import") clib.comp_name env clib.comp_deps;
+  else check_imports (user_err ~hdr:"unsafe_import") clib.comp_name env clib.comp_deps;
   check_engagement env clib.comp_enga;
   full_add_module clib.comp_name clib.comp_mod univs digest
diff --git a/checker/safe_typing.mli b/checker/safe_typing.mli
index 8724f8e0..51e5ca32 100644
--- a/checker/safe_typing.mli
+++ b/checker/safe_typing.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
diff --git a/checker/subtyping.ml b/checker/subtyping.ml
index 7eae9b83..31dab0c9 100644
--- a/checker/subtyping.ml
+++ b/checker/subtyping.ml
@@ -1,13 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
-open CErrors
 open Util
 open Names
 open Cic
@@ -81,6 +82,14 @@ let check_conv_error error f env a1 a2 =
   with
       NotConvertible -> error ()
 
+let check_polymorphic_instance error env auctx1 auctx2 =
+  if not (Univ.AUContext.size auctx1 == Univ.AUContext.size auctx2) then
+    error ()
+  else if not (Univ.check_subtype (Environ.universes env) auctx2 auctx1) then
+    error ()
+  else
+    Environ.push_context ~strict:false (Univ.AUContext.repr auctx2) env
+
 (* for now we do not allow reorderings *)
 let check_inductive  env mp1 l info1 mib2 spec2 subst1 subst2= 
   let kn = MutInd.make2 mp1 l in
@@ -88,18 +97,31 @@ let check_inductive  env mp1 l info1 mib2 spec2 subst1 subst2=
   let check_conv f = check_conv_error error f in
   let mib1 =
     match info1 with
-      | IndType ((_,0), mib) -> mib
+      | IndType ((_,0), mib) -> subst_mind subst1 mib
       | _ -> error ()
   in
   let mib2 = subst_mind subst2 mib2 in
   let check eq f = if not (eq (f mib1) (f mib2)) then error () in
-  let bool_equal (x : bool) (y : bool) = x = y in
-  let u = 
-    check bool_equal (fun x -> x.mind_polymorphic);
-    if mib1.mind_polymorphic then (
-      check Univ.Instance.equal (fun x -> Univ.UContext.instance x.mind_universes);
-      Univ.UContext.instance mib1.mind_universes)
-    else Univ.Instance.empty
+  let env, u =
+    match mib1.mind_universes, mib2.mind_universes with
+    | Monomorphic_ind _, Monomorphic_ind _ -> env, Univ.Instance.empty
+    | Polymorphic_ind auctx, Polymorphic_ind auctx' ->
+      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
+      env, Univ.make_abstract_instance auctx'
+    | _ -> error ()
   in
   let eq_projection_body p1 p2 =
     let check eq f = if not (eq (f p1) (f p2)) then error () in
@@ -111,40 +133,7 @@ let check_inductive  env mp1 l info1 mib2 spec2 subst1 subst2=
     check (eq_constr) (fun x -> snd x.proj_eta);
     check (eq_constr) (fun x -> x.proj_body); true
   in
-  let check_inductive_type env t1 t2 =
-
-    (* Due to sort-polymorphism in inductive types, the conclusions of
-       t1 and t2, if in Type, are generated as the least upper bounds
-       of the types of the constructors.
-
-       By monotonicity of the infered l.u.b.  wrt subtyping (i.e.  if X:U
-       |- T(X):s and |- M:U' and U'<=U then infer_type(T(M))<=s), each
-       universe in the conclusion of t1 has an bounding universe in
-       the conclusion of t2, so that we don't need to check the
-       subtyping of the conclusions of t1 and t2.
-
-       Even if we'd like to recheck it, the inference of constraints
-       is not designed to deal with algebraic constraints of the form
-       max-univ(u1..un) <= max-univ(u'1..u'n), so that it is not easy
-       to recheck it (in short, we would need the actual graph of
-       constraints as input while type checking is currently designed
-       to output a set of constraints instead) *)
-
-    (* So we cheat and replace the subtyping problem on algebraic
-       constraints of the form max-univ(u1..un) <= max-univ(u'1..u'n)
-       (that we know are necessary true) by trivial constraints that
-       the constraint generator knows how to deal with *)
-
-    let (ctx1,s1) = dest_arity env t1 in
-    let (ctx2,s2) = dest_arity env t2 in
-    let s1,s2 =
-      match s1, s2 with
-      | Type _, Type _ -> (* shortcut here *) Prop Null, Prop Null
-      | (Prop _, Type _) | (Type _,Prop _) -> error ()
-      | _ -> (s1, s2) in
-    check_conv conv_leq env
-      (mkArity (ctx1,s1)) (mkArity (ctx2,s2))
-  in
+  let check_inductive_type t1 t2 = check_conv conv_leq env t1 t2 in
 
   let check_packet p1 p2 =
     let check eq f = if not (eq (f p1) (f p2)) then error () in
@@ -163,8 +152,8 @@ let check_inductive  env mp1 l info1 mib2 spec2 subst1 subst2=
       (* nparams done *)
       (* params_ctxt done because part of the inductive types *)
       (* Don't check the sort of the type if polymorphic *)
-      check_inductive_type env
-        (type_of_inductive env ((mib1,p1),u)) (type_of_inductive env ((mib2,p2),u))
+      check_inductive_type
+        (type_of_inductive env ((mib1,p1), u)) (type_of_inductive env ((mib2,p2),u))
   in
   let check_cons_types i p1 p2 =
     Array.iter2 (check_conv conv env)
@@ -201,7 +190,7 @@ let check_inductive  env mp1 l info1 mib2 spec2 subst1 subst2=
     | Some None, Some None -> true
     | Some (Some (id1,p1,pb1)), Some (Some (id2,p2,pb2)) ->
       Id.equal id1 id2 &&
-      Array.for_all2 eq_con_chk p1 p2 &&
+      Array.for_all2 Constant.UserOrd.equal p1 p2 &&
       Array.for_all2 eq_projection_body pb1 pb2
     | _, _ -> false
   in
@@ -230,59 +219,25 @@ let check_inductive  env mp1 l info1 mib2 spec2 subst1 subst2=
 let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 =
   let error () = error_not_match l spec2 in
   let check_conv f = check_conv_error error f in
-  let check_type env t1 t2 =
-
-    (* If the type of a constant is generated, it may mention
-       non-variable algebraic universes that the general conversion
-       algorithm is not ready to handle. Anyway, generated types of
-       constants are functions of the body of the constant. If the
-       bodies are the same in environments that are subtypes one of
-       the other, the types are subtypes too (i.e. if Gamma <= Gamma',
-       Gamma |- A |> T, Gamma |- A' |> T' and Gamma |- A=A' then T <= T').
-       Hence they don't have to be checked again *)
-
-    let t1,t2 =
-      if isArity t2 then
-        let (ctx2,s2) = destArity t2 in
-        match s2 with
-        | Type v when not (Univ.is_univ_variable v) ->
-          (* The type in the interface is inferred and is made of algebraic
-             universes *)
-          begin try
-            let (ctx1,s1) = dest_arity env t1 in
-            match s1 with
-            | Type u when not (Univ.is_univ_variable u) ->
-              (* Both types are inferred, no need to recheck them. We
-                 cheat and collapse the types to Prop *)
-                mkArity (ctx1,Prop Null), mkArity (ctx2,Prop Null)
-            | 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 Null), mkArity (ctx2,Prop Null)
-            | Type _ ->
-              (* The type in the interface is inferred and the type in the
-                 implementation is not inferred or is inferred but from a
-                 more reduced body so that it is just a variable. Since
-                 constraints of the form "univ <= max(...)" are not
-                 expressible in the system of algebraic universes: we fail
-                 (the user has to use an explicit type in the interface *)
-                error ()
-          with UserError _ (* "not an arity" *) ->
-            error () end
-        | _ -> t1,t2
-      else
-        (t1,t2) in
-    check_conv conv_leq env t1 t2
-  in
+  let check_type env t1 t2 = check_conv conv_leq env t1 t2 in
     match info1 with
       | Constant cb1 ->
 	let cb1 = subst_const_body subst1 cb1 in
 	let cb2 = subst_const_body subst2 cb2 in
-	(*Start by checking types*)
-	let typ1 = Typeops.type_of_constant_type env cb1.const_type in
-	let typ2 = Typeops.type_of_constant_type env cb2.const_type in
+        (*Start by checking universes *)
+        let env =
+          match cb1.const_universes, cb2.const_universes with
+          | Monomorphic_const _, Monomorphic_const _ -> env
+          | Polymorphic_const auctx1, Polymorphic_const auctx2 ->
+            check_polymorphic_instance error env auctx1 auctx2
+          | Monomorphic_const _, Polymorphic_const _ ->
+            error ()
+          | Polymorphic_const _, Monomorphic_const _ ->
+            error ()
+        in
+        (* Now check types *)
+	let typ1 = cb1.const_type in
+	let typ2 = cb2.const_type in
 	check_type env typ1 typ2;
 	(* Now we check the bodies:
 	 - A transparent constant can only be implemented by a compatible
@@ -302,27 +257,17 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 =
 		let c2 = force_constr lc2 in
 		check_conv conv env c1 c2))
       | IndType ((kn,i),mind1) ->
-	  ignore (CErrors.error (
+        CErrors.user_err (Pp.str (
 		    "The kernel does not recognize yet that a parameter can be " ^
 		      "instantiated by an inductive type. Hint: you can rename the " ^
 		      "inductive type and give a definition to map the old name to the new " ^
-		      "name."));
-      if constant_has_body cb2 then error () ;
-      let u = inductive_instance mind1 in
-      let arity1 = type_of_inductive env ((mind1,mind1.mind_packets.(i)),u) in
-      let typ2 = Typeops.type_of_constant_type env cb2.const_type in
-       check_conv conv_leq env arity1 typ2
-   | IndConstr (((kn,i),j) as cstr,mind1) ->
-      ignore (CErrors.error (
+		      "name."))
+   | IndConstr (((kn,i),j),mind1) ->
+      CErrors.user_err (Pp.str (
        "The kernel does not recognize yet that a parameter can be " ^
        "instantiated by a constructor. Hint: you can rename the " ^
        "constructor and give a definition to map the old name to the new " ^
-       "name."));
-      if constant_has_body cb2 then error () ;
-      let u1 = inductive_instance mind1 in
-      let ty1 = type_of_constructor (cstr,u1) (mind1,mind1.mind_packets.(i)) in
-      let ty2 = Typeops.type_of_constant_type env cb2.const_type in
-       check_conv conv env ty1 ty2
+       "name."))
 
 let rec check_modules  env msb1 msb2 subst1 subst2 =
   let mty1 = module_type_of_module None msb1 in
@@ -390,7 +335,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/subtyping.mli b/checker/subtyping.mli
index cc66fc53..bb867186 100644
--- a/checker/subtyping.mli
+++ b/checker/subtyping.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
diff --git a/checker/term.ml b/checker/term.ml
index 591348cb..0236f786 100644
--- a/checker/term.ml
+++ b/checker/term.ml
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(* This module instantiates the structure of generic deBruijn terms to Coq *)
+(* This module instantiates the structure of generic de Bruijn terms to Coq *)
 
 open CErrors
 open Util
@@ -94,7 +96,7 @@ let closedn n c =
   in
   try closed_rec n c; true with LocalOccur -> false
 
-(* [closed0 M] is true iff [M] is a (deBruijn) closed term *)
+(* [closed0 M] is true iff [M] is a (de Bruijn) closed term *)
 
 let closed0 = closedn 0
 
@@ -227,6 +229,8 @@ let rel_context_nhyps hyps =
   nhyps 0 hyps
 let fold_rel_context f l ~init = List.fold_right f l init
 
+let fold_rel_context_outside f l ~init = List.fold_right f l init
+
 let map_rel_decl f = function
   | LocalAssum (n, typ) as decl ->
      let typ' = f typ in
@@ -273,14 +277,14 @@ let decompose_lam =
   abstractions *)
 let decompose_lam_n_assum n =
   if n < 0 then
-    error "decompose_lam_n_assum: integer parameter must be positive";
+    user_err Pp.(str "decompose_lam_n_assum: integer parameter must be positive");
   let rec lamdec_rec l n c =
     if Int.equal n 0 then l,c
     else match c with
     | Lambda (x,t,c)  -> lamdec_rec (LocalAssum (x,t) :: l) (n-1) c
     | LetIn (x,b,t,c) -> lamdec_rec (LocalDef (x,b,t) :: l) n c
     | Cast (c,_,_)      -> lamdec_rec l n c
-    | c -> error "decompose_lam_n_assum: not enough abstractions"
+    | c -> user_err Pp.(str "decompose_lam_n_assum: not enough abstractions")
   in
   lamdec_rec empty_rel_context n
 
@@ -306,14 +310,14 @@ let decompose_prod_assum =
 
 let decompose_prod_n_assum n =
   if n < 0 then
-    error "decompose_prod_n_assum: integer parameter must be positive";
+    user_err Pp.(str "decompose_prod_n_assum: integer parameter must be positive");
   let rec prodec_rec l n c =
     if Int.equal n 0 then l,c
     else match c with
     | Prod (x,t,c)    -> prodec_rec (LocalAssum (x,t) :: l) (n-1) c
     | LetIn (x,b,t,c) -> prodec_rec (LocalDef (x,b,t) :: l) (n-1) c
     | Cast (c,_,_)    -> prodec_rec l n c
-    | c -> error "decompose_prod_n_assum: not enough assumptions"
+    | c -> user_err Pp.(str "decompose_prod_n_assum: not enough assumptions")
   in
   prodec_rec empty_rel_context n
 
@@ -333,7 +337,7 @@ let destArity =
     | 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")
+    | _               -> anomaly ~label:"destArity" (Pp.str "not an arity.")
   in
   prodec_rec []
 
@@ -386,7 +390,7 @@ let compare_constr f t1 t2 =
           f h1 h2 && List.for_all2 f l1 l2
         else false
   | Evar (e1,l1), Evar (e2,l2) -> Int.equal e1 e2 && Array.equal f l1 l2
-  | Const c1, Const c2 -> eq_puniverses eq_con_chk c1 c2
+  | Const c1, Const c2 -> eq_puniverses Constant.UserOrd.equal c1 c2
   | Ind c1, Ind c2 -> eq_puniverses eq_ind_chk c1 c2
   | Construct ((c1,i1),u1), Construct ((c2,i2),u2) -> Int.equal i1 i2 && eq_ind_chk c1 c2
     && Univ.Instance.equal u1 u2
@@ -414,35 +418,33 @@ let subst_instance_constr subst c =
   if Univ.Instance.is_empty subst then c
   else
     let f u = Univ.subst_instance_instance subst u in
-    let changed = ref false in
-    let rec aux t = 
+    let rec aux t =
       match t with
-      | Const (c, u) -> 
-	if Univ.Instance.is_empty u then t
-	else 
-          let u' = f u in 
-	    if u' == u then t
-	    else (changed := true; Const (c, u'))
+      | Const (c, u) ->
+       if Univ.Instance.is_empty u then t
+       else
+          let u' = f u in
+           if u' == u then t
+           else (Const (c, u'))
       | Ind (i, u) ->
-	if Univ.Instance.is_empty u then t
-	else 
-	  let u' = f u in 
-	    if u' == u then t
-	    else (changed := true; Ind (i, u'))
+       if Univ.Instance.is_empty u then t
+       else
+         let u' = f u in
+           if u' == u then t
+           else (Ind (i, u'))
       | Construct (c, u) ->
-	if Univ.Instance.is_empty u then t
-	else 
-          let u' = f u in 
-	    if u' == u then t
-	    else (changed := true; Construct (c, u'))
-      | Sort (Type u) -> 
+       if Univ.Instance.is_empty u then t
+       else
+          let u' = f u in
+           if u' == u then t
+           else (Construct (c, u'))
+      | Sort (Type u) ->
          let u' = Univ.subst_instance_universe subst u in
-	   if u' == u then t else 
-	     (changed := true; Sort (sort_of_univ u'))
+          if u' == u then t else
+            (Sort (sort_of_univ u'))
       | _ -> map_constr aux t
     in
-    let c' = aux c in
-      if !changed then c' else c
+    aux c
 
 let subst_instance_context s ctx = 
   if Univ.Instance.is_empty s then ctx
diff --git a/checker/term.mli b/checker/term.mli
index 0af83e05..2524dff1 100644
--- a/checker/term.mli
+++ b/checker/term.mli
@@ -4,8 +4,6 @@ open Cic
 val family_of_sort : sorts -> sorts_family
 val family_equal : sorts_family -> sorts_family -> bool
 
-val strip_outer_cast : constr -> constr
-val collapse_appl : constr -> constr
 val decompose_app : constr -> constr * constr list
 val applist : constr * constr list -> constr
 val iter_constr_with_binders :
@@ -35,11 +33,13 @@ val rel_context_length : rel_context -> int
 val rel_context_nhyps : rel_context -> int
 val fold_rel_context :
   (rel_declaration -> 'a -> 'a) -> rel_context -> init:'a -> 'a
+val fold_rel_context_outside :
+  (rel_declaration -> 'a -> 'a) -> rel_context -> init:'a -> 'a
 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 b7718e02..50796437 100644
--- a/checker/type_errors.ml
+++ b/checker/type_errors.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -52,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
diff --git a/checker/type_errors.mli b/checker/type_errors.mli
index d9d14795..09703458 100644
--- a/checker/type_errors.mli
+++ b/checker/type_errors.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -54,14 +56,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 +98,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/typeops.ml b/checker/typeops.ml
index 173e19ce..18f07dc0 100644
--- a/checker/typeops.ml
+++ b/checker/typeops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -69,38 +71,16 @@ let judge_of_relative env n =
 
 (* Type of constants *)
 
-
-let type_of_constant_type_knowing_parameters env t paramtyps =
-  match t with
-  | RegularArity t -> t
-  | TemplateArity (sign,ar) ->
-      let ctx = List.rev sign in
-      let ctx,s = instantiate_universes env ctx ar paramtyps in
-      mkArity (List.rev ctx,s)
-
-let type_of_constant_knowing_parameters env cst paramtyps =
-  let ty, cu = constant_type env cst in
-    type_of_constant_type_knowing_parameters env ty paramtyps, cu
-
-let type_of_constant_type env t =
-  type_of_constant_type_knowing_parameters env t [||]
-
-let type_of_constant env cst =
-  type_of_constant_knowing_parameters env cst [||]
-
-let judge_of_constant_knowing_parameters env (kn,u as cst) paramstyp =
+let judge_of_constant env (kn,u as cst) =
   let _cb =
     try lookup_constant kn env
     with Not_found ->
       failwith ("Cannot find constant: "^Constant.to_string kn)
   in
-  let ty, cu = type_of_constant_knowing_parameters env cst paramstyp in
+  let ty, cu = constant_type env cst in
   let () = check_constraints cu env in
     ty
 
-let judge_of_constant env cst =
-  judge_of_constant_knowing_parameters env cst [||]
-
 (* Type of an application. *)
 
 let judge_of_apply env (f,funj) argjv =
@@ -265,7 +245,7 @@ let rec execute env cstr =
 
     | Rel n -> judge_of_relative env n
 
-    | Var _ -> anomaly (Pp.str "Section variable in Coqchk !")
+    | Var _ -> anomaly (Pp.str "Section variable in Coqchk!")
 
     | Const c -> judge_of_constant env c
 
@@ -278,13 +258,9 @@ let rec execute env cstr =
 	let j =
 	  match f with
 	    | Ind ind ->
-		(* Sort-polymorphism of inductive types *)
 		judge_of_inductive_knowing_parameters env ind jl
-	    | Const cst ->
-		(* Sort-polymorphism of constant *)
-		judge_of_constant_knowing_parameters env cst jl
 	    | _ ->
-		(* No sort-polymorphism *)
+		(* No template polymorphism *)
 		execute env f
 	in
         let jl = Array.map2 (fun c ty -> c,ty) args jl in
@@ -334,7 +310,6 @@ let rec execute env cstr =
         let pj = execute env p in
         let lfj = execute_array env lf in
         judge_of_case env ci (p,pj) (c,cj) lfj
-
     | Fix ((_,i as vni),recdef) ->
         let fix_ty = execute_recdef env recdef i in
         let fix = (vni,recdef) in
@@ -349,10 +324,10 @@ let rec execute env cstr =
 
     (* Partial proofs: unsupported by the kernel *)
     | Meta _ ->
-	anomaly (Pp.str "the kernel does not support metavariables")
+	anomaly (Pp.str "the kernel does not support metavariables.")
 
     | Evar _ ->
-	anomaly (Pp.str "the kernel does not support existential variables")
+	anomaly (Pp.str "the kernel does not support existential variables.")
 
 and execute_type env constr =
   let j = execute env constr in
diff --git a/checker/typeops.mli b/checker/typeops.mli
index db8e467a..c2d7d19c 100644
--- a/checker/typeops.mli
+++ b/checker/typeops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -18,6 +20,3 @@ val infer_type : env -> constr      -> sorts
 val check_ctxt : env -> rel_context -> env
 val check_polymorphic_arity :
   env -> rel_context -> template_arity -> unit
-
-val type_of_constant_type : env -> constant_type -> constr
-
diff --git a/checker/univ.ml b/checker/univ.ml
index 668f3a05..1619010c 100644
--- a/checker/univ.ml
+++ b/checker/univ.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created in Caml by Gérard Huet for CoC 4.8 [Dec 1988] *)
@@ -29,114 +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 remove : elt -> t -> t
-    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
-
-  let rec remove x = function
-  | Nil -> nil
-  | Cons (y, _, l) ->
-    if H.eq x y then l
-    else cons y (remove x l)
-
-  end
-end
-
 module RawLevel =
 struct
   open Names
@@ -174,24 +68,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
@@ -223,24 +99,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
@@ -277,7 +136,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
 
@@ -310,48 +169,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
-
-      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 make l = (l, 0)
 
-    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
@@ -361,22 +184,15 @@ struct
       (let (u,n) = x and (v,n') = y in
 	 Int.equal n n' && Level.equal u v)
 
-    let leq (u,n) (v,n') =
-      let cmp = Level.compare u v in
-	if Int.equal cmp 0 then n <= n'
-	else if n <= n' then 
-	  (Level.is_prop u && Level.is_small v)
-	else false
-
     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
@@ -401,31 +217,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)
@@ -445,16 +259,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
@@ -466,28 +280,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
 
@@ -552,7 +366,7 @@ let repr g u =
     let a =
       try UMap.find u g
       with Not_found -> anomaly ~label:"Univ.repr"
-	  (str"Universe " ++ Level.pr u ++ str" undefined")
+	  (str"Universe " ++ Level.pr u ++ str" undefined.")
     in
     match a with
       | Equiv v -> repr_rec v
@@ -775,9 +589,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
@@ -791,11 +605,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 ||
@@ -855,7 +669,7 @@ let merge g arcu arcv =
       else (max_rank, old_max_rank, best_arc, arc::rest)
     in
       match between g arcu arcv with
-      | [] -> anomaly (str "Univ.between")
+      | [] -> anomaly (str "Univ.between.")
       | arc::rest ->
         let (max_rank, old_max_rank, best_arc, rest) =
           List.fold_left best_ranked (arc.rank, min_int, arc, []) rest in
@@ -918,7 +732,7 @@ let enforce_univ_eq u v g =
       | FastLT -> error_inconsistency Eq u v
       | FastLE -> merge g arcv arcu
       | FastNLE -> merge_disc g arcu arcv
-      | FastEQ -> anomaly (Pp.str "Univ.compare"))
+      | FastEQ -> anomaly (Pp.str "Univ.compare."))
 
 (* enforce_univ_leq : Level.t -> Level.t -> unit *)
 (* enforce_univ_leq u v will force u<=v if possible, will fail otherwise *)
@@ -931,7 +745,7 @@ let enforce_univ_leq u v g =
     | FastLT -> error_inconsistency Le u v
     | FastLE  -> merge g arcv arcu
     | FastNLE -> fst (setleq g arcu arcv)
-    | FastEQ -> anomaly (Pp.str "Univ.compare")
+    | FastEQ -> anomaly (Pp.str "Univ.compare.")
 
 (* enforce_univ_lt u v will force u<v if possible, will fail otherwise *)
 let enforce_univ_lt u v g =
@@ -944,7 +758,7 @@ let enforce_univ_lt u v g =
     | FastNLE ->
       match fast_compare_neq false g arcv arcu with
 	FastNLE -> fst (setlt g arcu arcv)
-      | FastEQ -> anomaly (Pp.str "Univ.compare")
+      | FastEQ -> anomaly (Pp.str "Univ.compare.")
       | FastLE | FastLT -> error_inconsistency Lt u v
 
 (* Prop = Set is forbidden here. *)
@@ -975,7 +789,23 @@ struct
       else Level.compare v v'
 end
 
-module Constraint = Set.Make(UConstraintOrd)
+let pr_constraint_type op = 
+  let op_str = match op with
+    | Lt -> " < "
+    | Le -> " <= "
+    | Eq -> " = "
+  in str op_str
+
+module Constraint = 
+struct 
+  module S = Set.Make(UConstraintOrd)
+  include S
+
+  let pr prl c =
+    fold (fun (u1,op,u2) pp_std ->
+      pp_std ++ prl u1 ++ pr_constraint_type op ++
+	prl u2 ++ fnl () )  c (str "")
+end
 
 let empty_constraint = Constraint.empty
 let merge_constraints c g =
@@ -990,41 +820,6 @@ type 'a constrained = 'a * constraints
 
 type 'a constraint_function = 'a -> 'a -> constraints -> constraints
 
-let constraint_add_leq v u c =
-  (* We just discard trivial constraints like u<=u *)
-  if Expr.equal v u then c
-  else 
-    match v, u with
-    | (x,n), (y,m) -> 
-    let j = m - n in
-      if j = -1 (* n = m+1, v+1 <= u <-> v < u *) then
-	Constraint.add (x,Lt,y) c
-      else if j <= -1 (* n = m+k, v+k <= u <-> v+(k-1) < u *) then
-	if Level.equal x y then (* u+(k+1) <= u *)
-	  raise (UniverseInconsistency (Le, Universe.tip v, Universe.tip u))
-	else anomaly (Pp.str"Unable to handle arbitrary u+k <= v constraints")
-      else if j = 0 then
-	Constraint.add (x,Le,y) c
-      else (* j >= 1 *) (* m = n + k, u <= v+k *)
-	if Level.equal x y then c (* u <= u+k, trivial *)
-	else if Level.is_small x then c (* Prop,Set <= u+S k, trivial *)
-	else anomaly (Pp.str"Unable to handle arbitrary u <= v+k constraints")
-	  
-let check_univ_leq_one u v = Universe.exists (Expr.leq u) v
-
-let check_univ_leq u v = 
-  Universe.for_all (fun u -> check_univ_leq_one u v) u
-
-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
-  | _ -> anomaly (Pp.str"A universe bound can only be a variable")
-
-let enforce_leq u v c =
-  if check_univ_leq u v then c
-  else enforce_leq u v c
-
 let check_constraint g (l,d,r) =
   match d with
   | Eq -> check_equal g l r
@@ -1046,14 +841,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
 
@@ -1062,68 +849,27 @@ module Instance : sig
     val equal : t -> t -> bool
     val subst_fn : universe_level_subst_fn -> t -> t
     val subst : universe_level_subst -> t -> t
-    val pr : t -> Pp.std_ppcmds
-    val check_eq : t check_function 
+    val pr : t -> Pp.t
+    val check_eq : t check_function
+    val length : t -> int
+    val append : t -> t -> t
+    val of_array : Level.t array -> t
 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
@@ -1142,8 +888,41 @@ struct
 	   (Int.equal i (Array.length t1)) || (check_eq_level g t1.(i) t2.(i) && aux (i + 1))
 	 in aux 0)
 
+  let length = Array.length
+
+  let append = Array.append
+
+  let of_array i = i
+
 end
 
+(** Substitute instance inst for ctx in csts *)
+
+let subst_instance_level s l =
+  match l.Level.data with
+  | Level.Var n -> s.(n) 
+  | _ -> l
+
+let subst_instance_instance s i = 
+  Array.smartmap (fun l -> subst_instance_level s l) i
+
+let subst_instance_universe s u =
+  let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in
+  let u' = Universe.smartmap f u in
+    if u == u' then u
+    else Universe.sort u'
+
+let subst_instance_constraint s (u,d,v as c) =
+  let u' = subst_instance_level s u in
+  let v' = subst_instance_level s v in
+    if u' == u && v' == v then c
+    else (u',d,v')
+
+let subst_instance_constraints s csts =
+  Constraint.fold 
+    (fun c csts -> Constraint.add (subst_instance_constraint s c) csts)
+    csts Constraint.empty
+
 type universe_instance = Instance.t
 
 type 'a puniverses = 'a * Instance.t
@@ -1159,10 +938,80 @@ struct
   let make x = x
   let instance (univs, cst) = univs
   let constraints (univs, cst) = cst
+  let size (univs, _) = Instance.length univs
+
+  let is_empty (univs, cst) = Instance.is_empty univs && Constraint.is_empty cst
+  let pr prl (univs, cst as ctx) =
+    if is_empty ctx then mt() else
+      h 0 (Instance.pr univs ++ str " |= ") ++ h 0 (v 0 (Constraint.pr prl cst))
 end
 
 type universe_context = UContext.t
 
+module AUContext =
+struct
+  include UContext
+
+  let repr (inst, cst) =
+    (Array.mapi (fun i l -> Level.var i) inst, cst)
+
+  let instantiate inst (u, cst) =
+    assert (Array.length u = Array.length inst);
+    subst_instance_constraints inst cst
+
+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 * Variance.t array
+
+  let univ_context (univcst, subtypcst) = univcst
+  let variance (univs, variance) = variance
+
+end
+
+module ACumulativityInfo = CumulativityInfo
+type abstract_cumulativity_info = ACumulativityInfo.t
+
 module ContextSet =
 struct
   type t = LSet.t constrained
@@ -1173,6 +1022,18 @@ struct
 end
 type universe_context_set = ContextSet.t
 
+(** Instance subtyping *)
+
+let check_subtype univs ctxT ctx =
+  if AUContext.size ctx == AUContext.size ctx then
+    let (inst, cst) = AUContext.repr ctx in
+    let cstT = UContext.constraints (AUContext.repr ctxT) in
+    let push accu v = add_universe v false accu in
+    let univs = Array.fold_left push univs inst in
+    let univs = merge_constraints cstT univs in
+    check_constraints cst univs
+  else false
+
 (** Substitutions. *)
 
 let is_empty_subst = LMap.is_empty
@@ -1192,43 +1053,9 @@ let subst_univs_level_universe subst u =
     if u == u' then u
     else Universe.sort u'
 
-(** Substitute instance inst for ctx in csts *)
-
-let subst_instance_level s l =
-  match l.Level.data with
-  | Level.Var n -> s.(n) 
-  | _ -> l
-
-let subst_instance_instance s i = 
-  Array.smartmap (fun l -> subst_instance_level s l) i
-
-let subst_instance_universe s u =
-  let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in
-  let u' = Universe.smartmap f u in
-    if u == u' then u
-    else Universe.sort u'
-
-let subst_instance_constraint s (u,d,v as c) =
-  let u' = subst_instance_level s u in
-  let v' = subst_instance_level s v in
-    if u' == u && v' == v then c
-    else (u',d,v')
-
-let subst_instance_constraints s csts =
-  Constraint.fold 
-    (fun c csts -> Constraint.add (subst_instance_constraint s c) csts)
-    csts Constraint.empty 
-
 let make_abstract_instance (ctx, _) = 
   Array.mapi (fun i l -> Level.var i) ctx
 
-(** Substitute instance inst for ctx in csts *)
-let instantiate_univ_context (ctx, csts) = 
-  (ctx, subst_instance_constraints ctx csts)
-
-let instantiate_univ_constraints u (_, csts) = 
-  subst_instance_constraints u csts
-
 (** With level to universe substitutions. *)
 type universe_subst_fn = universe_level -> universe
 
@@ -1239,7 +1066,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))
@@ -1250,7 +1077,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 =
@@ -1269,6 +1096,10 @@ let merge_context_set strict ctx g =
 
 (** Pretty-printing *)
 
+let pr_constraints prl = Constraint.pr prl
+    
+let pr_universe_context = UContext.pr
+
 let pr_arc = function
   | _, Canonical {univ=u; lt=[]; le=[]} ->
       mt ()
diff --git a/checker/univ.mli b/checker/univ.mli
index 7d4c629a..473159c0 100644
--- a/checker/univ.mli
+++ b/checker/univ.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Universes. *)
@@ -18,6 +20,11 @@ sig
   (** Create a new universe level from a unique identifier and an associated
       module path. *)
 
+  val var : int -> t
+
+  val pr : t -> Pp.t
+  (** Pretty-printing *)
+  
   val equal : t -> t -> bool
 end
 
@@ -48,7 +55,7 @@ type universe = Universe.t
 
 (** Alias name. *)
 
-val pr_uni : universe -> Pp.std_ppcmds
+val pr_uni : universe -> 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 *)
@@ -71,11 +78,13 @@ type 'a check_function = universes -> 'a -> 'a -> bool
 val check_leq : universe check_function
 val check_eq : universe check_function
 
+
+
 (** The initial graph of universes: Prop < Set *)
 val initial_universes : universes
 
 (** Adds a universe to the graph, ensuring it is >= or > Set.
-   @raises AlreadyDeclared if the level is already declared in the graph. *)
+   @raise AlreadyDeclared if the level is already declared in the graph. *)
 
 exception AlreadyDeclared
 
@@ -99,8 +108,6 @@ type 'a constrained = 'a * constraints
 
 type 'a constraint_function = 'a -> 'a -> constraints -> constraints
 
-val enforce_leq : universe constraint_function
-
 (** {6 ... } *)
 (** Merge of constraints in a universes graph.
   The function [merge_constraints] merges a set of constraints in a given
@@ -143,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 :
@@ -157,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. *)
@@ -165,11 +169,19 @@ sig
   val subst : universe_level_subst -> t -> t
   (** Substitution by a level-to-level function. *)
 
-  val pr : t -> Pp.std_ppcmds
+  val pr : t -> Pp.t
   (** Pretty-printing, no comments *)
 
   val check_eq : t check_function
   (** Check equality of instances w.r.t. a universe graph *)
+
+  val length : t -> int
+  (** Compute the length of the instance  *)
+
+  val of_array : Level.t array -> t
+
+  val append : t -> t -> t
+  (** Append two universe instances *)
 end
 
 type universe_instance = Instance.t
@@ -187,9 +199,49 @@ sig
   val make : universe_instance constrained -> t
   val instance : t -> Instance.t
   val constraints : t -> constraints
+  val is_empty : t -> bool
+    
+end
+
+type universe_context = UContext.t
+
+module AUContext :
+sig
+  type t
+
+  val size : t -> int
+
+  val instantiate : Instance.t -> t -> Constraint.t
+  val repr : t -> UContext.t
 
 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 variance : t -> Variance.t array
+
+end
+
+type abstract_cumulativity_info = ACumulativityInfo.t
+
 module ContextSet :
   sig 
     type t
@@ -198,7 +250,6 @@ module ContextSet :
     val constraints : t -> constraints
   end
 
-type universe_context = UContext.t
 type universe_context_set = ContextSet.t
 
 val merge_context : bool -> universe_context -> universes -> universes
@@ -221,18 +272,20 @@ val subst_univs_universe : universe_subst_fn -> universe -> universe
 (** Substitution of instances *)
 val subst_instance_instance : universe_instance -> universe_instance -> universe_instance
 val subst_instance_universe : universe_instance -> universe -> universe
-val subst_instance_constraints : universe_instance -> constraints -> constraints
 
 (* val make_instance_subst : universe_instance -> universe_level_subst *)
 (* val make_inverse_instance_subst : universe_instance -> universe_level_subst *)
 
-(** Get the instantiated graph. *)
-val instantiate_univ_context : universe_context -> universe_context
-val instantiate_univ_constraints : universe_instance -> universe_context -> constraints
-
 (** Build the relative instance corresponding to the context *)
-val make_abstract_instance : universe_context -> universe_instance
-									    
+val make_abstract_instance : abstract_universe_context -> universe_instance
+
+(** Check instance subtyping *)
+val check_subtype : universes -> AUContext.t -> AUContext.t -> bool
+
 (** {6 Pretty-printing of universes. } *)
 
-val pr_universes : universes -> Pp.std_ppcmds
+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_universes : universes -> Pp.t
diff --git a/checker/validate.ml b/checker/validate.ml
index c434ef09..f831875d 100644
--- a/checker/validate.ml
+++ b/checker/validate.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This module defines validation functions to ensure an imported
@@ -49,8 +51,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 00000000..6c2ab8d3
--- /dev/null
+++ b/checker/validate.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val validate : bool -> Values.value -> 'a -> unit
diff --git a/checker/values.ml b/checker/values.ml
index c175aed6..1ac8d7ce 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Abstract representations of values in a vo *)
@@ -13,7 +15,7 @@
 To ensure this file is up-to-date, 'make' now compares the md5 of cic.mli
 with a copy we maintain here:
 
-MD5 6466d8cc443b5896cb905776df0cc49e  checker/cic.mli
+MD5 c4fdf8a846aed45c27b5acb1add7d1c6 checker/cic.mli
 
 *)
 
@@ -54,6 +56,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 +72,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 +103,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,8 +112,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; Array v_variance|]
 let v_context_set = v_tuple "universe_context_set" [|v_hset v_level;v_cstrs|]
 
 (** kernel/term *)
@@ -196,12 +205,20 @@ 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|]
 
-let v_cst_type =
-  v_sum "constant_type" 0 [|[|v_constr|]; [|v_pair v_rctxt v_pol_arity|]|]
-
 let v_cst_def =
   v_sum "constant_def" 0
     [|[|Opt Int|]; [|v_cstr_subst|]; [|v_lazy_constr|]|]
@@ -213,15 +230,16 @@ 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_set|]; [|v_abs_context|]|]
 
 let v_cb = v_tuple "constant_body"
   [|v_section_ctxt;
     v_cst_def;
-    v_cst_type;
+    v_constr;
     Any;
-    v_bool;
-    v_context;
+    v_const_univs;
     Opt v_projbody;
     v_bool;
     v_typing_flags|]
@@ -262,6 +280,10 @@ let v_finite = v_enum "recursivity_kind" 3
 let v_mind_record = Annot ("mind_record", 
 			   Opt (Opt (v_tuple "record" [| v_id; Array v_cst; Array v_projbody |])))
 
+let v_ind_pack_univs = 
+  v_sum "abstract_inductive_universes" 0
+    [|[|v_context_set|]; [|v_abs_context|]; [|v_abs_cum_info|]|]
+
 let v_ind_pack = v_tuple "mutual_inductive_body"
   [|Array v_one_ind;
     v_mind_record;
@@ -271,21 +293,15 @@ let v_ind_pack = v_tuple "mutual_inductive_body"
     Int;
     Int;
     v_rctxt;
-    v_bool;
-    v_context;
+    v_ind_pack_univs; (* universes *)
     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 =
@@ -308,13 +324,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 *)
 
@@ -368,22 +384,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 00000000..20b9d54a
--- /dev/null
+++ b/checker/values.mli
@@ -0,0 +1,28 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 48f9f45e..bc820e23 100644
--- a/checker/votour.ml
+++ b/checker/votour.ml
@@ -1,15 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Values
 
 (** {6 Interactive visit of a vo} *)
 
+let max_string_length = 1024
+
 let rec read_num max =
   let quit () =
     Printf.printf "\nGoodbye!\n%!";
@@ -19,14 +23,14 @@ let rec read_num max =
   if l = "u" then None
   else if l = "x" then quit ()
   else
-    try
-      let v = int_of_string l in
+    match int_of_string l with
+    | v ->
       if v < 0 || v >= max then
         let () =
           Printf.printf "Out-of-range input! (only %d children)\n%!" max in
         read_num max
       else Some v
-    with Failure "int_of_string" ->
+    | exception Failure _ ->
       Printf.printf "Unrecognized input! <n> enters the <n>-th child, u goes up 1 level, x exits\n%!";
       read_num max
 
@@ -75,48 +79,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
@@ -149,22 +156,25 @@ let rec get_name ?(extra=false) = function
 (** For tuples, its quite handy to display the inner 1st string (if any).
     Cf. [structure_body] for instance *)
 
+exception TupleString of string
 let get_string_in_tuple o =
   try
     for i = 0 to Array.length o - 1 do
       match Repr.repr o.(i) with
       | STRING s ->
-        failwith (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;
     ""
-  with Failure s -> s
+  with TupleString s -> s
 
 (** Some details : tags, integer value for non-block, etc etc *)
 
 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
@@ -191,20 +201,20 @@ 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
 let rec get_children v o pos = match v with
   |Tuple (_, v) ->
     let (_, os) = access_block o in
@@ -225,18 +235,26 @@ 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
-  |Fail s -> failwith "forbidden"
+  |Fail s -> raise Forbidden
 
 let get_children v o pos =
   try get_children v o pos
@@ -257,9 +275,10 @@ let init () = stk := []
 
 let push name v o p = stk := { nam = name; typ = v; obj = o; pos = p } :: !stk
 
+exception EmptyStack
 let pop () = match !stk with
   | i::s -> stk := s; i
-  | _ -> failwith "empty stack"
+  | _ -> raise EmptyStack
 
 let rec visit v o pos =
   Printf.printf "\nDepth %d Pos %s Context %s\n"
@@ -283,8 +302,8 @@ let rec visit v o pos =
        push (get_name v) v o pos;
        visit v' o' pos'
   with
-  | Failure "empty stack" -> ()
-  | Failure "forbidden" -> let info = pop () in visit info.typ info.obj info.pos
+  | EmptyStack -> ()
+  | Forbidden -> let info = pop () in visit info.typ info.obj info.pos
   | Failure _ | Invalid_argument _ -> visit v o pos
 
 end
@@ -313,8 +332,7 @@ let dummy_header = {
 }
 
 let parse_header chan =
-  let magic = String.create 4 in
-  let () = for i = 0 to 3 do magic.[i] <- input_char chan done in
+  let magic = really_input_string chan 4 in
   let length = input_binary_int chan in
   let objects = input_binary_int chan in
   let size32 = input_binary_int chan in
@@ -377,7 +395,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 00000000..9db9ecd1
--- /dev/null
+++ b/checker/votour.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* 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 b3b8bdea..27ed6fbf 100644
--- a/lib/backtrace.ml
+++ b/clib/backtrace.ml
@@ -1,10 +1,13 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+[@@@ocaml.warning "-37"]
 
 type raw_frame =
 | Known_location of bool   (* is_raise *)
diff --git a/lib/backtrace.mli b/clib/backtrace.mli
index dd82165b..cd315116 100644
--- a/lib/backtrace.mli
+++ b/clib/backtrace.mli
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Low-level management of OCaml backtraces.
 
diff --git a/lib/bigint.ml b/clib/bigint.ml
index e95604ff..9e7b44ee 100644
--- a/lib/bigint.ml
+++ b/clib/bigint.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (***************************************************)
@@ -257,9 +259,9 @@ let sub_mult m d q k =
     end
   done
 
-(** Euclid division m/d = (q,r)
-    This is the "Floor" variant, as with ocaml's /
-    (but not as ocaml's Big_int.quomod_big_int).
+(** Euclid division m/d = (q,r), with m = q*d+r and |r|<|q|.
+    This is the "Trunc" variant (a.k.a "Truncated-Toward-Zero"),
+    as with ocaml's / (but not as ocaml's Big_int.quomod_big_int).
     We have sign r = sign m *)
 
 let euclid m d =
diff --git a/lib/bigint.mli b/clib/bigint.mli
index e5525f16..ac66b41f 100644
--- a/lib/bigint.mli
+++ b/clib/bigint.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Arbitrary large integer numbers *)
@@ -30,6 +32,12 @@ val mult_2 : bigint -> bigint
 val add : bigint -> bigint -> bigint
 val sub : bigint -> bigint -> bigint
 val mult : bigint -> bigint -> bigint
+
+(** Euclid division m/d = (q,r), with m = q*d+r and |r|<|q|.
+    This is the "Trunc" variant (a.k.a "Truncated-Toward-Zero"),
+    as with ocaml's / (but not as ocaml's Big_int.quomod_big_int).
+    We have sign r = sign m *)
+
 val euclid : bigint -> bigint -> bigint * bigint
 
 val less_than : bigint -> bigint -> bool
diff --git a/lib/cArray.ml b/clib/cArray.ml
index bb1e3354..e2b1a7be 100644
--- a/lib/cArray.ml
+++ b/clib/cArray.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 module type S = module type of Array
 
@@ -53,10 +55,17 @@ sig
     ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
   val map_left : ('a -> 'b) -> 'a array -> 'b array
   val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
-  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+  val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
   val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  [@@ocaml.deprecated "Same as [fold_left_map]"]
+  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  [@@ocaml.deprecated "Same as [fold_right_map]"]
   val fold_map2' :
     ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+  [@@ocaml.deprecated "Same as [fold_right2_map]"]
   val distinct : 'a array -> bool
   val rev_of_list : 'a list -> 'a array
   val rev_to_list : 'a array -> 'a list
@@ -283,8 +292,7 @@ let rev_of_list = function
   let () = set (len - 1) l in
   ans
 
-let map_to_list f v =
-  List.map f (Array.to_list v)
+let map_to_list = CList.map_of_array
 
 let map_of_list f l =
   let len = List.length l in
@@ -331,7 +339,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
@@ -434,7 +442,7 @@ let iter2 f v1 v2 =
 
 let pure_functional = false
 
-let fold_map' f v e =
+let fold_right_map f v e =
 if pure_functional then
   let (l,e) =
     Array.fold_right
@@ -446,18 +454,28 @@ else
   let v' = Array.map (fun x -> let (y,e) = f x !e' in e' := e; y) v in
   (v',!e')
 
-let fold_map f e v =
+let fold_map' = fold_right_map
+
+let fold_left_map f e v =
   let e' = ref e in
   let v' = Array.map (fun x -> let (e,y) = f !e' x in e' := e; y) v in
   (!e',v')
 
-let fold_map2' f v1 v2 e =
+let fold_map = fold_left_map
+
+let fold_right2_map f v1 v2 e =
   let e' = ref e in
   let v' =
     map2 (fun x1 x2 -> let (y,e) = f x1 x2 !e' in e' := e; y) v1 v2
   in
   (v',!e')
 
+let fold_map2' = fold_right2_map
+
+let fold_left2_map f e v1 v2 =
+  let e' = ref e in
+  let v' = map2 (fun x1 x2 -> let (e,y) = f !e' x1 x2 in e' := e; y) v1 v2 in
+  (!e',v')
 
 let distinct v =
   let visited = Hashtbl.create 23 in
@@ -514,7 +532,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 7e5c93b5..fa3978bd 100644
--- a/lib/cArray.mli
+++ b/clib/cArray.mli
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 module type S = module type of Array
 
@@ -96,10 +98,28 @@ sig
   val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
   (** Iter on two arrays. Raise [Invalid_argument "Array.iter2"] if sizes differ. *)
 
-  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  (** [fold_left_map f e_0 [|l_1...l_n|] = e_n,[|k_1...k_n|]]
+    where [(e_i,k_i)=f e_{i-1} l_i] *)
+
+  val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  (** Same, folding on the right *)
+
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+  (** Same with two arrays, folding on the left *)
+
+  val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+  (** Same with two arrays, folding on the left *)
+
   val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  [@@ocaml.deprecated "Same as [fold_left_map]"]
+
+  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  [@@ocaml.deprecated "Same as [fold_right_map]"]
+
   val fold_map2' :
     ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+  [@@ocaml.deprecated "Same as [fold_right2_map]"]
 
   val distinct : 'a array -> bool
   (** Return [true] if every element of the array is unique (for default 
diff --git a/lib/cEphemeron.ml b/clib/cEphemeron.ml
index a38ea11e..3136d66e 100644
--- a/lib/cEphemeron.ml
+++ b/clib/cEphemeron.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type key_type = int
@@ -35,10 +37,10 @@ end)
    would make the key always reachable) *)
 let values : Obj.t HT.t = HT.create 1001
 
-(* To avoid a race contidion between the finalization function and
+(* To avoid a race condition between the finalization function and
    get/create on the values hashtable, the finalization function just
    enqueues in an imperative list the item to be collected.  Being the list
-   imperative, even if the Gc enqueue an item while run_collection is operating,
+   imperative, even if the Gc enqueues an item while run_collection is operating,
    the tail of the list is eventually set to Empty on completion.
    Kudos to the authors of Why3 that came up with this solution for their
    implementation of weak hash tables! *)
diff --git a/lib/cEphemeron.mli b/clib/cEphemeron.mli
index 1200e4e2..8e753d0b 100644
--- a/lib/cEphemeron.mli
+++ b/clib/cEphemeron.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Use case:
@@ -26,7 +28,7 @@
 
    Proposed solution:
      Turn all occurrences of [bad] into [bad key] in your data structure.
-     Use [crate bad_val] to obtain a unique key [k] for [bad_val], and store
+     Use [create bad_val] to obtain a unique key [k] for [bad_val], and store
      [k] in the data structure.  Use [get k] to obtain [bad_val].
 
      An ['a key] can always be marshalled.  When marshalled, a key loses its
diff --git a/lib/cList.ml b/clib/cList.ml
index c8283e3c..b25c4ffd 100644
--- a/lib/cList.ml
+++ b/clib/cList.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 type 'a cmp = 'a -> 'a -> int
 type 'a eq = 'a -> 'a -> bool
@@ -49,6 +51,7 @@ sig
     (int -> 'a -> bool) -> 'a list -> 'a list
   val partitioni :
     (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
+  val map_of_array : ('a -> 'b) -> 'a array -> 'b list
   val smartfilter : ('a -> bool) -> 'a list -> 'a list
   val extend : bool list -> 'a -> 'a list -> 'a list
   val count : ('a -> bool) -> 'a list -> int
@@ -61,6 +64,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
@@ -91,12 +95,21 @@ sig
   val map_append : ('a -> 'b list) -> 'a list -> 'b list
   val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list
   val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  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
+  [@@ocaml.deprecated "Same as [fold_left_map]"]
   val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  [@@ocaml.deprecated "Same as [fold_right_map]"]
   val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
   val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b
   val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list
   val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool
+  val min : 'a cmp -> 'a list -> 'a
   val cartesian : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
   val cartesians : ('a -> 'b -> 'b) -> 'b -> 'a list list -> 'b list
   val combinations : 'a list list -> 'a list list
@@ -159,6 +172,21 @@ let map2 f l1 l2 = match l1, l2 with
   cast c
 | _ -> invalid_arg "List.map2"
 
+let rec map_of_array_loop f p a i l =
+  if Int.equal i l then ()
+  else
+    let c = { head = f (Array.unsafe_get a i); tail = [] } in
+    p.tail <- cast c;
+    map_of_array_loop f c a (i + 1) l
+
+let map_of_array f a =
+  let l = Array.length a in
+  if Int.equal l 0 then []
+  else
+    let c = { head = f (Array.unsafe_get a 0); tail = [] } in
+    map_of_array_loop f c a 1 l;
+    cast c
+
 let rec append_loop p tl = function
 | [] -> p.tail <- tl
 | x :: l ->
@@ -426,6 +454,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
@@ -444,6 +478,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 =
@@ -542,6 +589,15 @@ let rec uniquize_sorted cmp = function
 
 let sort_uniquize cmp l = uniquize_sorted cmp (List.sort cmp l)
 
+let min cmp l =
+  let rec aux cur = function
+    | [] -> cur
+    | x :: l -> if cmp x cur < 0 then aux x l else aux cur l
+  in
+  match l with
+  | x :: l -> aux x l
+  | [] -> raise Not_found
+
 (* FIXME: again, generic hash function *)
 
 let distinct l =
@@ -745,12 +801,15 @@ let share_tails l1 l2 =
   in
   shr_rev [] (List.rev l1, List.rev l2)
 
-let rec fold_map f e = function
-  |  []  -> (e,[])
-  |  h::t ->
-       let e',h' = f e h in
-       let e'',t' = fold_map f e' t in
-         e'',h'::t'
+(* 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'
+
+let fold_map = fold_left_map
 
 (* (* tail-recursive version of the above function *)
 let fold_map f e l =
@@ -763,9 +822,31 @@ let fold_map f e l =
 *)
 
 (* The same, based on fold_right, with the effect accumulated on the right *)
-let fold_map' f l e =
+let fold_right_map f l e =
   List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) 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' =
+  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 bc8749b4..e025f7b4 100644
--- a/lib/cList.mli
+++ b/clib/cList.mli
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 type 'a cmp = 'a -> 'a -> int
 type 'a eq = 'a -> 'a -> bool
@@ -53,7 +55,7 @@ sig
       [Invalid_argument "List.make"] if [n] is negative. *)
 
   val assign : 'a list -> int -> 'a -> 'a list
-  (** [assign l i x] set the [i]-th element of [l] to [x], starting from [0]. *)
+  (** [assign l i x] sets the [i]-th element of [l] to [x], starting from [0]. *)
 
   val distinct : 'a list -> bool
   (** Return [true] if all elements of the list are distinct. *)
@@ -91,6 +93,9 @@ sig
   val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
   val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
 
+  val map_of_array : ('a -> 'b) -> 'a array -> 'b list
+  (** [map_of_array f a] behaves as [List.map f (Array.to_list a)] *)
+
   val smartfilter : ('a -> bool) -> 'a list -> 'a list
   (** [smartfilter f [a1...an] = List.filter f [a1...an]] but if for all i
     [f ai = true], then [smartfilter f l == l] *)
@@ -118,6 +123,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
@@ -195,16 +208,41 @@ sig
 
   val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
 
-  val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
-  (** [fold_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  (** [fold_left_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
     where [(e_i,k_i)=f e_{i-1} l_i] *)
 
+  val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  (** Same, folding on the right *)
+
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
+  (** Same with two lists, folding on the left *)
+
+  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]"]
+
   val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  [@@ocaml.deprecated "Same as [fold_right_map]"]
+
   val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
   val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b
   val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list
   val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool
 
+  val min : 'a cmp -> 'a list -> 'a
+  (** Return minimum element according to some comparison function.
+
+      @raise Not_found on an empty list. *)
+
   val cartesian : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
   (** A generic cartesian product: for any operator (**),
     [cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]],
diff --git a/lib/cMap.ml b/clib/cMap.ml
index ba0873ff..373e3f8f 100644
--- a/lib/cMap.ml
+++ b/clib/cMap.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type OrderedType =
@@ -26,7 +28,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 +52,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 +95,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 2838b374..bb0019bb 100644
--- a/lib/cMap.mli
+++ b/clib/cMap.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {5 Extended version of OCaml's maps} *)
@@ -34,7 +36,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 7f3ee185..e26f4811 100644
--- a/lib/cObj.ml
+++ b/clib/cObj.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (*s Logical and physical size of ocaml values. *)
 
diff --git a/lib/cObj.mli b/clib/cObj.mli
index 16933a4a..27082f68 100644
--- a/lib/cObj.mli
+++ b/clib/cObj.mli
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** {6 Physical size of an ocaml value.}
 
diff --git a/lib/cSet.ml b/clib/cSet.ml
index 037cdc35..b276df1a 100644
--- a/lib/cSet.ml
+++ b/clib/cSet.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type OrderedType =
diff --git a/lib/cSet.mli b/clib/cSet.mli
index 2452bb60..ea99a791 100644
--- a/lib/cSet.mli
+++ b/clib/cSet.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type OrderedType =
diff --git a/lib/cSig.mli b/clib/cSig.mli
index 151cfbdc..fb36cc5b 100644
--- a/lib/cSig.mli
+++ b/clib/cSig.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Missing pervasive types from OCaml stdlib *)
@@ -48,8 +50,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 +58,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 4acb2930..b86b0024 100644
--- a/lib/cStack.ml
+++ b/clib/cStack.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
 exception Empty = Stack.Empty
diff --git a/lib/cStack.mli b/clib/cStack.mli
index 8dde1d1a..d6b8464e 100644
--- a/lib/cStack.mli
+++ b/clib/cStack.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Extended interface for OCaml stacks. *)
diff --git a/lib/cString.ml b/clib/cString.ml
index 0c2ed2e7..dd33562f 100644
--- a/lib/cString.ml
+++ b/clib/cString.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type S = module type of String
@@ -11,13 +13,14 @@ module type S = module type of String
 module type ExtS =
 sig
   include S
+  [@@@ocaml.warning "-3"]     (* [@@noalloc] since 4.03.0 GPR#240 *)
   external equal : string -> string -> bool = "caml_string_equal" "noalloc"
+  [@@@ocaml.warning "+3"]
   val hash : string -> int
   val is_empty : string -> bool
   val explode : string -> string list
   val implode : string list -> string
   val strip : string -> string
-  val map : (char -> char) -> string -> string
   val drop_simple_quotes : string -> string
   val string_index_from : string -> int -> string -> int
   val string_contains : where:string -> what:string -> bool
@@ -34,7 +37,9 @@ end
 
 include String
 
+[@@@ocaml.warning "-3"]     (* [@@noalloc] since 4.03.0 GPR#240 *)
 external equal : string -> string -> bool = "caml_string_equal" "noalloc"
+[@@@ocaml.warning "+3"]
 
 let rec hash len s i accu =
   if i = len then accu
@@ -78,12 +83,6 @@ let strip s =
   let a = lstrip_rec 0 and b = rstrip_rec (n-1) in
   String.sub s a (b-a+1)
 
-let map f s =
-  let l = String.length s in
-  let r = String.create l in
-  for i = 0 to (l - 1) do r.[i] <- f (s.[i]) done;
-  r
-
 let drop_simple_quotes s =
   let n = String.length s in
   if n > 2 && s.[0] = '\'' && s.[n-1] = '\'' then String.sub s 1 (n-2) else s
diff --git a/lib/cString.mli b/clib/cString.mli
index 5292b34d..2000dfaf 100644
--- a/lib/cString.mli
+++ b/clib/cString.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Module type [S] is the one from OCaml Stdlib. *)
@@ -14,7 +16,10 @@ sig
   include S
   (** We include the standard library *)
 
+  [@@@ocaml.warning "-3"]     (* [@@noalloc] since 4.03.0 GPR#240 *)
   external equal : string -> string -> bool = "caml_string_equal" "noalloc"
+  [@@@ocaml.warning "+3"]
+
   (** Equality on strings *)
 
   val hash : string -> int
@@ -32,9 +37,6 @@ sig
   val strip : string -> string
   (** Remove the surrounding blank characters from a string *)
 
-  val map : (char -> char) -> string -> string
-  (** Apply a function on a string character-wise. *)
-
   val drop_simple_quotes : string -> string
   (** Remove the eventual first surrounding simple quotes of a string. *)
 
diff --git a/lib/cThread.ml b/clib/cThread.ml
index 4f60a697..0b7955aa 100644
--- a/lib/cThread.ml
+++ b/clib/cThread.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type thread_ic = in_channel
@@ -36,7 +38,7 @@ let really_read_fd fd s off len =
 let really_read_fd_2_oc fd oc len =
   let i = ref 0 in
   let size = 4096 in
-  let s = String.create size in
+  let s = Bytes.create size in
   while !i < len do
     let len = len - !i in
     let r = thread_friendly_read_fd fd s ~off:0 ~len:(min len size) in
@@ -55,11 +57,13 @@ let thread_friendly_really_read_line ic =
   try
     let fd = Unix.descr_of_in_channel ic in
     let b = Buffer.create 1024 in
-    let s = String.make 1 '\000' in
-    while s <> "\n" do
+    let s = Bytes.make 1 '\000' in
+    let endl = Bytes.of_string "\n" in
+    (* Bytes.equal is in 4.03.0 *)
+    while Bytes.compare s endl <> 0 do
       let n = thread_friendly_read_fd fd s ~off:0 ~len:1 in
       if n = 0 then raise End_of_file;
-      if s <> "\n" then Buffer.add_string b s;
+      if Bytes.compare s endl <> 0 then Buffer.add_bytes b s;
     done;
     Buffer.contents b
   with Unix.Unix_error _ -> raise End_of_file
@@ -67,15 +71,15 @@ let thread_friendly_really_read_line ic =
 let thread_friendly_input_value ic =
   try
     let fd = Unix.descr_of_in_channel ic in
-    let header = String.create Marshal.header_size in
+    let header = Bytes.create Marshal.header_size in
     really_read_fd fd header 0 Marshal.header_size;
     let body_size = Marshal.data_size header 0 in
     let desired_size = body_size + Marshal.header_size in
     if desired_size <= Sys.max_string_length then begin
-      let msg = String.create desired_size in
-      String.blit header 0 msg 0 Marshal.header_size;
+      let msg = Bytes.create desired_size in
+      Bytes.blit header 0 msg 0 Marshal.header_size;
       really_read_fd fd msg Marshal.header_size body_size;
-      Marshal.from_string msg 0
+      Marshal.from_bytes msg 0
     end else begin
       (* Workaround for 32 bit systems and data > 16M *)
       let name, oc =
diff --git a/lib/cThread.mli b/clib/cThread.mli
index 7302dfb5..acc5a60c 100644
--- a/lib/cThread.mli
+++ b/clib/cThread.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* As of OCaml 4.01.0 input_value and input do not quite work well
@@ -19,8 +21,8 @@ val prepare_in_channel_for_thread_friendly_io : in_channel -> thread_ic
 
 val thread_friendly_input_value : thread_ic -> 'a
 val thread_friendly_read :
-  thread_ic -> string -> off:int -> len:int -> int
+  thread_ic -> Bytes.t -> off:int -> len:int -> int
 val thread_friendly_really_read :
-  thread_ic -> string -> off:int -> len:int -> unit
+  thread_ic -> Bytes.t -> off:int -> len:int -> unit
 val thread_friendly_really_read_line : thread_ic -> string
 
diff --git a/lib/cUnix.ml b/clib/cUnix.ml
index cb436511..6b42e304 100644
--- a/lib/cUnix.ml
+++ b/clib/cUnix.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Files and load path. *)
@@ -14,6 +16,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
@@ -91,15 +98,15 @@ let rec waitpid_non_intr pid =
 let run_command ?(hook=(fun _ ->())) c =
   let result = Buffer.create 127 in
   let cin,cout,cerr = Unix.open_process_full c (Unix.environment ()) in
-  let buff = String.make 127 ' ' in
-  let buffe = String.make 127 ' ' in
+  let buff = Bytes.make 127 ' ' in
+  let buffe = Bytes.make 127 ' ' in
   let n = ref 0 in
   let ne = ref 0 in
   while n:= input cin buff 0 127 ; ne := input cerr buffe 0 127 ;
     !n+ !ne <> 0
   do
-    let r = String.sub buff 0 !n in (hook r; Buffer.add_string result r);
-    let r = String.sub buffe 0 !ne in (hook r; Buffer.add_string result r);
+    let r = Bytes.sub buff 0 !n in (hook r; Buffer.add_bytes result r);
+    let r = Bytes.sub buffe 0 !ne in (hook r; Buffer.add_bytes result r);
   done;
   (Unix.close_process_full (cin,cout,cerr),  Buffer.contents result)
 
diff --git a/lib/cUnix.mli b/clib/cUnix.mli
index f03719c3..1b185345 100644
--- a/lib/cUnix.mli
+++ b/clib/cUnix.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {5 System utilities} *)
@@ -14,9 +16,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
@@ -46,7 +51,7 @@ val file_readable_p : string -> bool
     is called on each elements read on stdout or stderr. *)
 
 val run_command :
-  ?hook:(string->unit) -> string -> Unix.process_status * string
+  ?hook:(bytes->unit) -> string -> Unix.process_status * string
 
 (** [sys_command] launches program [prog] with arguments [args].
     It behaves like [Sys.command], except that we rely on
@@ -61,6 +66,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 c01bc158..b8b79ed7 100644
--- a/lib/canary.ml
+++ b/clib/canary.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t = Obj.t
diff --git a/lib/canary.mli b/clib/canary.mli
index 21949e73..d993eabc 100644
--- a/lib/canary.mli
+++ b/clib/canary.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t
diff --git a/lib/clib.mllib b/clib/clib.mllib
index 1e33173e..c9b4d72f 100644
--- a/lib/clib.mllib
+++ b/clib/clib.mllib
@@ -1,37 +1,40 @@
-Coq_config
-
-Terminal
 Canary
-Hook
+CObj
+CEphemeron
+
 Hashset
 Hashcons
+
+OrderedType
 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
-Pp_control
-Flags
-Control
-Loc
-CList
-CString
-Deque
-CObj
-CArray
-CStack
-Util
-Stateid
-Pp
-Ppstyle
-Richpp
-Feedback
-CUnix
-Envars
-Aux_file
+Terminal
 Monad
diff --git a/lib/dyn.ml b/clib/dyn.ml
index 65d1442a..e9b04198 100644
--- a/lib/dyn.ml
+++ b/clib/dyn.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type TParam =
@@ -11,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 PreS =
 sig
 type 'a tag
@@ -24,24 +46,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 +57,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 +66,7 @@ sig
 
 end
 
-module Make(M : CSig.EmptyS) = struct
+module Make () = struct
 module Self : PreS = struct
 (* Dynamics, programmed with DANGER !!! *)
 
@@ -104,6 +111,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 +133,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 +143,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 448b11a1..51d30914 100644
--- a/lib/dyn.mli
+++ b/clib/dyn.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Dynamically typed values *)
@@ -13,6 +15,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 +48,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 +65,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 d049dc6c..2d130498 100644
--- a/lib/exninfo.ml
+++ b/clib/exninfo.ml
@@ -1,16 +1,18 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** Enriched exceptions have an additional field at the end of their usual data
     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 c960ac7c..4a5a6095 100644
--- a/lib/exninfo.mli
+++ b/clib/exninfo.mli
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** Additional information worn by exceptions. *)
 
diff --git a/lib/hMap.ml b/clib/hMap.ml
index ea76e742..37f867c6 100644
--- a/lib/hMap.ml
+++ b/clib/hMap.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type HashedType =
@@ -47,7 +49,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 +67,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 +137,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 +244,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 +269,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 +369,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 +377,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 c4e6a08e..b26d0e04 100644
--- a/lib/hMap.mli
+++ b/clib/hMap.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type HashedType =
diff --git a/lib/hashcons.ml b/clib/hashcons.ml
index 4eaacf91..ec73c6d9 100644
--- a/lib/hashcons.ml
+++ b/clib/hashcons.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Hash consing of datastructures *)
@@ -130,7 +132,11 @@ module Hstring = Make(
     type t = string
     type u = unit
     let hashcons () s =(* incr accesstr;*) s
+
+    [@@@ocaml.warning "-3"]     (* [@@noalloc] since 4.03.0 GPR#240 *)
     external eq : string -> string -> bool = "caml_string_equal" "noalloc"
+    [@@@ocaml.warning "+3"]
+
     (** Copy from CString *)
     let rec hash len s i accu =
       if i = len then accu
diff --git a/lib/hashcons.mli b/clib/hashcons.mli
index 150899ce..3e396ff2 100644
--- a/lib/hashcons.mli
+++ b/clib/hashcons.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Generic hash-consing. *)
diff --git a/lib/hashset.ml b/clib/hashset.ml
index af33544d..965cb67c 100644
--- a/lib/hashset.ml
+++ b/clib/hashset.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Adapted from Damien Doligez, projet Para, INRIA Rocquencourt,
@@ -181,7 +183,7 @@ module Make (E : EqType) =
     let sz = Weak.length bucket in
     let rec loop i =
       if i >= sz then ifnotfound index
-      else if h = hashes.(i) then begin
+      else if Int.equal h hashes.(i) then begin
         match Weak.get bucket i with
         | Some v when E.eq v d -> v
         | _ -> loop (i + 1)
diff --git a/lib/hashset.mli b/clib/hashset.mli
index 733c8962..0699d4e8 100644
--- a/lib/hashset.mli
+++ b/clib/hashset.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Adapted from Damien Doligez, projet Para, INRIA Rocquencourt,
diff --git a/lib/heap.ml b/clib/heap.ml
index 97ccadeb..49034bbc 100644
--- a/lib/heap.ml
+++ b/clib/heap.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s Heaps *)
diff --git a/lib/heap.mli b/clib/heap.mli
index 0e77a3a0..ab0864c7 100644
--- a/lib/heap.mli
+++ b/clib/heap.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Heaps *)
diff --git a/lib/iStream.ml b/clib/iStream.ml
index 26a666e1..8daf2279 100644
--- a/lib/iStream.ml
+++ b/clib/iStream.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type ('a,'r) u =
diff --git a/lib/iStream.mli b/clib/iStream.mli
index 50f5389b..40d579be 100644
--- a/lib/iStream.mli
+++ b/clib/iStream.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {5 Purely functional streams}
diff --git a/lib/int.ml b/clib/int.ml
index 70bd7424..3ae836ae 100644
--- a/lib/int.ml
+++ b/clib/int.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t = int
diff --git a/lib/int.mli b/clib/int.mli
index 93d1be1f..76aecf05 100644
--- a/lib/int.mli
+++ b/clib/int.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** A native integer module with usual utility functions. *)
diff --git a/lib/minisys.ml b/clib/minisys.ml
index f15021c6..bbcf46b9 100644
--- a/lib/minisys.ml
+++ b/clib/minisys.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Minisys regroups some code that used to be in System.
@@ -36,23 +38,35 @@ 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 *)
 
 let exists_dir dir =
+  (* See BZ#5391 on windows failing on a trailing (back)slash *)
+  let rec strip_trailing_slash dir =
+    let len = String.length dir in
+    if len > 0 && (dir.[len-1] = '/' || dir.[len-1] = '\\')
+    then strip_trailing_slash (String.sub dir 0 (len-1)) else dir in
+  let dir = if Sys.os_type = "Win32" then strip_trailing_slash dir else dir in
   try Sys.is_directory dir with Sys_error _ -> false
 
 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 2e55e969..8740cae0 100644
--- a/lib/monad.ml
+++ b/clib/monad.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 
 (** Combinators on monadic computations. *)
diff --git a/lib/monad.mli b/clib/monad.mli
index f7de71f5..d1d42eb8 100644
--- a/lib/monad.mli
+++ b/clib/monad.mli
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 
 (** Combinators on monadic computations. *)
@@ -66,7 +68,8 @@ module type ListS = sig
       its second argument in a tail position. *)
   val iter : ('a -> unit t) -> 'a list -> unit t
 
-  (** Like the regular {!CList.map_filter}. The monadic effects are threaded left*)
+  (** Like the regular {!CList.map_filter}. The monadic effects are
+      threaded left to right. *)
   val map_filter : ('a -> 'b option t) -> 'a list -> 'b list t
 
 
diff --git a/lib/option.ml b/clib/option.ml
index fbb883d3..32fe2fc5 100644
--- a/lib/option.ml
+++ b/clib/option.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Module implementing basic combinators for OCaml option type.
@@ -20,29 +22,29 @@ let has_some = function
   | _ -> true
 
 let is_empty = function
-| None -> true
-| Some _ -> false
+  | None -> true
+  | Some _ -> false
 
 (** Lifting equality onto option types. *)
 let equal f x y = match x, y with
-| None, None -> true
-| Some x, Some y -> f x y
-| _, _ -> false
+  | None, None -> true
+  | Some x, Some y -> f x y
+  | _, _ -> false
 
 let compare f x y = match x, y with
-| None, None -> 0
-| Some x, Some y -> f x y
-| None, Some _ -> -1
-| Some _, None -> 1
+  | None, None -> 0
+  | Some x, Some y -> f x y
+  | None, Some _ -> -1
+  | Some _, None -> 1
 
 let hash f = function
-| None -> 0
-| Some x -> f x
+  | None -> 0
+  | Some x -> f x
 
 exception IsNone
 
 (** [get x] returns [y] where [x] is [Some y].
-    @raise [IsNone] if [x] equals [None]. *)
+    @raise IsNone if [x] equals [None]. *)
 let get = function
   | Some y -> y
   | _ -> raise IsNone
@@ -50,6 +52,9 @@ let get = function
 (** [make x] returns [Some x]. *)
 let make x = Some x
 
+(** [bind x f] is [f y] if [x] is [Some y] and [None] otherwise *)
+let bind x f = match x with Some y -> f y | None -> None
+
 (** [init b x] returns [Some x] if [b] is [true] and [None] otherwise. *)
 let init b x =
   if b then
@@ -57,13 +62,11 @@ let init b x =
   else
     None
 
-
 (** [flatten x] is [Some y] if [x] is [Some (Some y)] and [None] otherwise. *)
 let flatten = function
   | Some (Some y) -> Some y
   | _ -> None
 
-
 (** [append x y] is the first element of the concatenation of [x] and
     [y] seen as lists. *)
 let append o1 o2 =
@@ -123,17 +126,25 @@ let fold_right f x a =
   | Some y -> f y a
   | _ -> a
 
-(** [fold_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
-let fold_map f a x =
+(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+let fold_left_map f a x =
   match x with
   | Some y -> let a, z = f a y in a, Some z
   | _ -> a, None
 
+let fold_right_map f x a =
+  match x with
+  | Some y -> let z, a = f y a in Some z, a
+  | _ -> None, a
+
+let fold_map = fold_left_map
+
 (** [cata f a x] is [a] if [x] is [None] and [f y] if [x] is [Some y]. *)
 let cata f a = function
   | Some c -> f c
   | None -> a
 
+
 (** {6 More Specific operations} ***)
 
 (** [default a x] is [y] if [x] is [Some y] and [a] otherwise. *)
@@ -165,7 +176,6 @@ let lift2 f x y =
   | _,_ -> None
 
 
-
 (** {6 Operations with Lists} *)
 
 module List =
@@ -183,9 +193,19 @@ module List =
     | [] -> []
 
   let rec find f = function
-    |[] -> None
-    |h :: t -> match f h with
-	 |None -> find f t
-	 |x -> x
+    | [] -> None
+    | h :: t -> match f h with
+	 | None -> find f t
+	 | x -> x
+
+  let map f l =
+    let rec aux f l = match l with
+    | [] -> []
+    | x :: l ->
+      match f x with
+      | None -> raise Exit
+      | Some y -> y :: aux f l
+    in
+    try Some (aux f l) with Exit -> None
 
 end
diff --git a/lib/option.mli b/clib/option.mli
index 5e085620..14fa9da3 100644
--- a/lib/option.mli
+++ b/clib/option.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Module implementing basic combinators for OCaml option type.
@@ -41,6 +43,9 @@ val get : 'a option -> 'a
 (** [make x] returns [Some x]. *)
 val make : 'a -> 'a option
 
+(** [bind x f] is [f y] if [x] is [Some y] and [None] otherwise *)
+val bind : 'a option -> ('a -> 'b option) -> 'b option
+
 (** [init b x] returns [Some x] if [b] is [true] and [None] otherwise. *)
 val init : bool -> 'a -> 'a option
 
@@ -85,8 +90,15 @@ val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b option -> 'c option -> 'a
 (** [fold_right f x a] is [f y a] if [x] is [Some y], and [a] otherwise. *)
 val fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b
 
-(** [fold_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
+
+(** Same as [fold_left_map] on the right *)
+val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b option -> 'a -> 'c option * 'a
+
+(** @deprecated Same as [fold_left_map] *)
 val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
+[@@ocaml.deprecated "Same as [fold_left_map]"]
 
 (** [cata f e x] is [e] if [x] is [None] and [f a] if [x] is [Some a] *)
 val cata : ('a -> 'b) -> 'b -> 'a option -> 'b
@@ -122,5 +134,14 @@ module List : sig
       [Some y] (in the same order). *)
   val flatten : 'a option list -> 'a list
 
+  (** [List.find f l] is the first [f a] different from [None],
+      scrolling through elements [a] of [l] in left-to-right order;
+      it is [None] if no such element exists. *)
   val find : ('a -> 'b option) -> 'a list -> 'b option
+
+  (** [List.map f [a1;...;an]] is the list [Some [b1;...;bn]] if
+      for all i, there is a [bi] such that [f ai] is [Some bi]; it is
+      [None] if, for at least one i, [f ai] is [None]. *)
+  val map : ('a -> 'b option) -> 'a list -> 'b list option
+
 end
diff --git a/clib/orderedType.ml b/clib/orderedType.ml
new file mode 100644
index 00000000..922eb76a
--- /dev/null
+++ b/clib/orderedType.ml
@@ -0,0 +1,35 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+module type S =
+sig
+  type t
+  val compare : t -> t -> int
+end
+
+module Pair (M:S) (N:S) = struct
+  type t = M.t * N.t
+
+  let compare (a,b) (a',b') =
+    let i = M.compare a a' in
+    if Int.equal i 0 then N.compare b b'
+    else i
+end
+
+module UnorderedPair (M:S) = struct
+  type t = M.t * M.t
+
+  let reorder (a,b as p) =
+    if M.compare a b <= 0 then p else (b,a)
+
+  let compare p p' =
+    let p = reorder p and p' = reorder p' in
+    let module P = Pair(M)(M) in P.compare p p'
+end
diff --git a/clib/orderedType.mli b/clib/orderedType.mli
new file mode 100644
index 00000000..3578ea0d
--- /dev/null
+++ b/clib/orderedType.mli
@@ -0,0 +1,19 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+module type S =
+sig
+  type t
+  val compare : t -> t -> int
+end
+
+module Pair (M:S) (N:S) : S with type t = M.t * N.t
+
+module UnorderedPair (M:S) : S with type t = M.t * M.t
diff --git a/lib/predicate.ml b/clib/predicate.ml
index 1aa7db6a..1aa7db6a 100644
--- a/lib/predicate.ml
+++ b/clib/predicate.ml
diff --git a/lib/predicate.mli b/clib/predicate.mli
index cee3b0bd..cee3b0bd 100644
--- a/lib/predicate.mli
+++ b/clib/predicate.mli
diff --git a/clib/range.ml b/clib/range.ml
new file mode 100644
index 00000000..7271514f
--- /dev/null
+++ b/clib/range.ml
@@ -0,0 +1,93 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 00000000..c14b0cf5
--- /dev/null
+++ b/clib/range.mli
@@ -0,0 +1,39 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** 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 9ce348a0..24243b7a 100644
--- a/lib/segmenttree.ml
+++ b/clib/segmenttree.ml
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 (** 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 3258537b..63c968f5 100644
--- a/lib/segmenttree.mli
+++ b/clib/segmenttree.mli
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 (** 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 a1788f7d..1469358c 100644
--- a/lib/store.ml
+++ b/clib/store.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** This module implements an "untyped store", in this particular case
     we see it as an extensible record whose fields are left
@@ -14,10 +16,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 +28,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 8eab314e..0c2b2e08 100644
--- a/lib/store.mli
+++ b/clib/store.mli
@@ -1,19 +1,16 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (*** 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 +39,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 de21f102..1d946813 100644
--- a/lib/terminal.ml
+++ b/clib/terminal.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type color = [
@@ -35,6 +37,8 @@ type style = {
   italic : bool option;
   underline : bool option;
   negative : bool option;
+  prefix : string option;
+  suffix : string option;
 }
 
 let set o1 o2 = match o1 with
@@ -51,9 +55,11 @@ let default = {
   italic = None;
   underline = None;
   negative = None;
+  prefix = None;
+  suffix = None;
 }
 
-let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style () =
+let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style ?prefix ?suffix () =
   let st = match style with
   | None -> default
   | Some st -> st
@@ -65,6 +71,8 @@ let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style () =
     italic = set st.italic italic;
     underline = set st.underline underline;
     negative = set st.negative negative;
+    prefix = set st.prefix prefix;
+    suffix = set st.suffix suffix;
   }
 
 let merge s1 s2 =
@@ -75,6 +83,8 @@ let merge s1 s2 =
     italic = set s1.italic s2.italic;
     underline = set s1.underline s2.underline;
     negative = set s1.negative s2.negative;
+    prefix = set s1.prefix s2.prefix;
+    suffix = set s1.suffix s2.suffix;
   }
 
 let base_color = function
@@ -168,6 +178,8 @@ let reset_style = {
   italic = Some false;
   underline = Some false;
   negative = Some false;
+  prefix = None;
+  suffix = None;
 }
 
 let has_style t =
diff --git a/lib/terminal.mli b/clib/terminal.mli
index e0fd7f22..dbf8d464 100644
--- a/lib/terminal.mli
+++ b/clib/terminal.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type color = [
@@ -35,11 +37,14 @@ type style = {
   italic : bool option;
   underline : bool option;
   negative : bool option;
+  prefix : string option;
+  suffix : string option;
 }
 
 val make : ?fg_color:color -> ?bg_color:color ->
   ?bold:bool -> ?italic:bool -> ?underline:bool ->
-  ?negative:bool -> ?style:style -> unit -> style
+  ?negative:bool -> ?style:style ->
+  ?prefix:string -> ?suffix:string -> unit -> style
 (** Create a style from the given flags. It is derived from the optional
     [style] argument if given. *)
 
diff --git a/lib/trie.ml b/clib/trie.ml
index 0309fde9..ea43e9e0 100644
--- a/lib/trie.ml
+++ b/clib/trie.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type S =
diff --git a/lib/trie.mli b/clib/trie.mli
index de67e8f9..dae346d3 100644
--- a/lib/trie.mli
+++ b/clib/trie.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Generic functorized trie data structure. *)
diff --git a/lib/unicode.ml b/clib/unicode.ml
index ced5e258..1e45c0d2 100644
--- a/lib/unicode.ml
+++ b/clib/unicode.ml
@@ -1,20 +1,23 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** 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 +27,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 +54,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 +72,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 +112,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
@@ -124,27 +129,11 @@ exception End_of_input
 let utf8_of_unicode n =
   if n < 128 then
     String.make 1 (Char.chr n)
-  else if n < 2048 then
-    let s = String.make 2 (Char.chr (128 + n mod 64)) in
-    begin
-      s.[0] <- Char.chr (192 + n / 64);
-      s
-    end
-  else if n < 65536 then
-    let s = String.make 3 (Char.chr (128 + n mod 64)) in
-    begin
-      s.[1] <- Char.chr (128 + (n / 64) mod 64);
-      s.[0] <- Char.chr (224 + n / 4096);
-      s
-    end
   else
-    let s = String.make 4 (Char.chr (128 + n mod 64)) in
-    begin
-      s.[2] <- Char.chr (128 + (n / 64) mod 64);
-      s.[1] <- Char.chr (128 + (n / 4096) mod 64);
-      s.[0] <- Char.chr (240 + n / 262144);
-      s
-    end
+    let (m,s) = if n < 2048 then (2,192) else if n < 65536 then (3,224) else (4,240) in
+    String.init m (fun i ->
+        let j = (n lsr ((m - 1 - i) * 6)) land 63 in
+        Char.chr (j + if i = 0 then s else 128))
 
 (* If [s] is some UTF-8 encoded string
    and [i] is a position of some UTF-8 character within [s]
@@ -179,24 +168,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
@@ -214,7 +254,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
@@ -230,6 +270,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 =
@@ -284,9 +344,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
@@ -315,9 +373,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 2609e196..23e168cd 100644
--- a/lib/unicode.mli
+++ b/clib/unicode.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** 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 +19,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 +55,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/clib/unicodetable.ml b/clib/unicodetable.ml
new file mode 100644
index 00000000..b607058c
--- /dev/null
+++ b/clib/unicodetable.ml
@@ -0,0 +1,7427 @@
+(** Unicode tables generated using UUCD. *)
+
+(* Letter, Uppercase *)
+let lu = [
+  (0x00041,0x0005A);
+  (0x000C0,0x000D6);
+  (0x000D8,0x000DE);
+  (0x00100,0x00100);
+  (0x00102,0x00102);
+  (0x00104,0x00104);
+  (0x00106,0x00106);
+  (0x00108,0x00108);
+  (0x0010A,0x0010A);
+  (0x0010C,0x0010C);
+  (0x0010E,0x0010E);
+  (0x00110,0x00110);
+  (0x00112,0x00112);
+  (0x00114,0x00114);
+  (0x00116,0x00116);
+  (0x00118,0x00118);
+  (0x0011A,0x0011A);
+  (0x0011C,0x0011C);
+  (0x0011E,0x0011E);
+  (0x00120,0x00120);
+  (0x00122,0x00122);
+  (0x00124,0x00124);
+  (0x00126,0x00126);
+  (0x00128,0x00128);
+  (0x0012A,0x0012A);
+  (0x0012C,0x0012C);
+  (0x0012E,0x0012E);
+  (0x00130,0x00130);
+  (0x00132,0x00132);
+  (0x00134,0x00134);
+  (0x00136,0x00136);
+  (0x00139,0x00139);
+  (0x0013B,0x0013B);
+  (0x0013D,0x0013D);
+  (0x0013F,0x0013F);
+  (0x00141,0x00141);
+  (0x00143,0x00143);
+  (0x00145,0x00145);
+  (0x00147,0x00147);
+  (0x0014A,0x0014A);
+  (0x0014C,0x0014C);
+  (0x0014E,0x0014E);
+  (0x00150,0x00150);
+  (0x00152,0x00152);
+  (0x00154,0x00154);
+  (0x00156,0x00156);
+  (0x00158,0x00158);
+  (0x0015A,0x0015A);
+  (0x0015C,0x0015C);
+  (0x0015E,0x0015E);
+  (0x00160,0x00160);
+  (0x00162,0x00162);
+  (0x00164,0x00164);
+  (0x00166,0x00166);
+  (0x00168,0x00168);
+  (0x0016A,0x0016A);
+  (0x0016C,0x0016C);
+  (0x0016E,0x0016E);
+  (0x00170,0x00170);
+  (0x00172,0x00172);
+  (0x00174,0x00174);
+  (0x00176,0x00176);
+  (0x00178,0x00179);
+  (0x0017B,0x0017B);
+  (0x0017D,0x0017D);
+  (0x00181,0x00182);
+  (0x00184,0x00184);
+  (0x00186,0x00187);
+  (0x00189,0x0018B);
+  (0x0018E,0x00191);
+  (0x00193,0x00194);
+  (0x00196,0x00198);
+  (0x0019C,0x0019D);
+  (0x0019F,0x001A0);
+  (0x001A2,0x001A2);
+  (0x001A4,0x001A4);
+  (0x001A6,0x001A7);
+  (0x001A9,0x001A9);
+  (0x001AC,0x001AC);
+  (0x001AE,0x001AF);
+  (0x001B1,0x001B3);
+  (0x001B5,0x001B5);
+  (0x001B7,0x001B8);
+  (0x001BC,0x001BC);
+  (0x001C4,0x001C4);
+  (0x001C7,0x001C7);
+  (0x001CA,0x001CA);
+  (0x001CD,0x001CD);
+  (0x001CF,0x001CF);
+  (0x001D1,0x001D1);
+  (0x001D3,0x001D3);
+  (0x001D5,0x001D5);
+  (0x001D7,0x001D7);
+  (0x001D9,0x001D9);
+  (0x001DB,0x001DB);
+  (0x001DE,0x001DE);
+  (0x001E0,0x001E0);
+  (0x001E2,0x001E2);
+  (0x001E4,0x001E4);
+  (0x001E6,0x001E6);
+  (0x001E8,0x001E8);
+  (0x001EA,0x001EA);
+  (0x001EC,0x001EC);
+  (0x001EE,0x001EE);
+  (0x001F1,0x001F1);
+  (0x001F4,0x001F4);
+  (0x001F6,0x001F8);
+  (0x001FA,0x001FA);
+  (0x001FC,0x001FC);
+  (0x001FE,0x001FE);
+  (0x00200,0x00200);
+  (0x00202,0x00202);
+  (0x00204,0x00204);
+  (0x00206,0x00206);
+  (0x00208,0x00208);
+  (0x0020A,0x0020A);
+  (0x0020C,0x0020C);
+  (0x0020E,0x0020E);
+  (0x00210,0x00210);
+  (0x00212,0x00212);
+  (0x00214,0x00214);
+  (0x00216,0x00216);
+  (0x00218,0x00218);
+  (0x0021A,0x0021A);
+  (0x0021C,0x0021C);
+  (0x0021E,0x0021E);
+  (0x00220,0x00220);
+  (0x00222,0x00222);
+  (0x00224,0x00224);
+  (0x00226,0x00226);
+  (0x00228,0x00228);
+  (0x0022A,0x0022A);
+  (0x0022C,0x0022C);
+  (0x0022E,0x0022E);
+  (0x00230,0x00230);
+  (0x00232,0x00232);
+  (0x0023A,0x0023B);
+  (0x0023D,0x0023E);
+  (0x00241,0x00241);
+  (0x00243,0x00246);
+  (0x00248,0x00248);
+  (0x0024A,0x0024A);
+  (0x0024C,0x0024C);
+  (0x0024E,0x0024E);
+  (0x00370,0x00370);
+  (0x00372,0x00372);
+  (0x00376,0x00376);
+  (0x0037F,0x0037F);
+  (0x00386,0x00386);
+  (0x00388,0x0038A);
+  (0x0038C,0x0038C);
+  (0x0038E,0x0038F);
+  (0x00391,0x003A1);
+  (0x003A3,0x003AB);
+  (0x003CF,0x003CF);
+  (0x003D2,0x003D4);
+  (0x003D8,0x003D8);
+  (0x003DA,0x003DA);
+  (0x003DC,0x003DC);
+  (0x003DE,0x003DE);
+  (0x003E0,0x003E0);
+  (0x003E2,0x003E2);
+  (0x003E4,0x003E4);
+  (0x003E6,0x003E6);
+  (0x003E8,0x003E8);
+  (0x003EA,0x003EA);
+  (0x003EC,0x003EC);
+  (0x003EE,0x003EE);
+  (0x003F4,0x003F4);
+  (0x003F7,0x003F7);
+  (0x003F9,0x003FA);
+  (0x003FD,0x0042F);
+  (0x00460,0x00460);
+  (0x00462,0x00462);
+  (0x00464,0x00464);
+  (0x00466,0x00466);
+  (0x00468,0x00468);
+  (0x0046A,0x0046A);
+  (0x0046C,0x0046C);
+  (0x0046E,0x0046E);
+  (0x00470,0x00470);
+  (0x00472,0x00472);
+  (0x00474,0x00474);
+  (0x00476,0x00476);
+  (0x00478,0x00478);
+  (0x0047A,0x0047A);
+  (0x0047C,0x0047C);
+  (0x0047E,0x0047E);
+  (0x00480,0x00480);
+  (0x0048A,0x0048A);
+  (0x0048C,0x0048C);
+  (0x0048E,0x0048E);
+  (0x00490,0x00490);
+  (0x00492,0x00492);
+  (0x00494,0x00494);
+  (0x00496,0x00496);
+  (0x00498,0x00498);
+  (0x0049A,0x0049A);
+  (0x0049C,0x0049C);
+  (0x0049E,0x0049E);
+  (0x004A0,0x004A0);
+  (0x004A2,0x004A2);
+  (0x004A4,0x004A4);
+  (0x004A6,0x004A6);
+  (0x004A8,0x004A8);
+  (0x004AA,0x004AA);
+  (0x004AC,0x004AC);
+  (0x004AE,0x004AE);
+  (0x004B0,0x004B0);
+  (0x004B2,0x004B2);
+  (0x004B4,0x004B4);
+  (0x004B6,0x004B6);
+  (0x004B8,0x004B8);
+  (0x004BA,0x004BA);
+  (0x004BC,0x004BC);
+  (0x004BE,0x004BE);
+  (0x004C0,0x004C1);
+  (0x004C3,0x004C3);
+  (0x004C5,0x004C5);
+  (0x004C7,0x004C7);
+  (0x004C9,0x004C9);
+  (0x004CB,0x004CB);
+  (0x004CD,0x004CD);
+  (0x004D0,0x004D0);
+  (0x004D2,0x004D2);
+  (0x004D4,0x004D4);
+  (0x004D6,0x004D6);
+  (0x004D8,0x004D8);
+  (0x004DA,0x004DA);
+  (0x004DC,0x004DC);
+  (0x004DE,0x004DE);
+  (0x004E0,0x004E0);
+  (0x004E2,0x004E2);
+  (0x004E4,0x004E4);
+  (0x004E6,0x004E6);
+  (0x004E8,0x004E8);
+  (0x004EA,0x004EA);
+  (0x004EC,0x004EC);
+  (0x004EE,0x004EE);
+  (0x004F0,0x004F0);
+  (0x004F2,0x004F2);
+  (0x004F4,0x004F4);
+  (0x004F6,0x004F6);
+  (0x004F8,0x004F8);
+  (0x004FA,0x004FA);
+  (0x004FC,0x004FC);
+  (0x004FE,0x004FE);
+  (0x00500,0x00500);
+  (0x00502,0x00502);
+  (0x00504,0x00504);
+  (0x00506,0x00506);
+  (0x00508,0x00508);
+  (0x0050A,0x0050A);
+  (0x0050C,0x0050C);
+  (0x0050E,0x0050E);
+  (0x00510,0x00510);
+  (0x00512,0x00512);
+  (0x00514,0x00514);
+  (0x00516,0x00516);
+  (0x00518,0x00518);
+  (0x0051A,0x0051A);
+  (0x0051C,0x0051C);
+  (0x0051E,0x0051E);
+  (0x00520,0x00520);
+  (0x00522,0x00522);
+  (0x00524,0x00524);
+  (0x00526,0x00526);
+  (0x00528,0x00528);
+  (0x0052A,0x0052A);
+  (0x0052C,0x0052C);
+  (0x0052E,0x0052E);
+  (0x00531,0x00556);
+  (0x010A0,0x010C5);
+  (0x010C7,0x010C7);
+  (0x010CD,0x010CD);
+  (0x013A0,0x013F5);
+  (0x01E00,0x01E00);
+  (0x01E02,0x01E02);
+  (0x01E04,0x01E04);
+  (0x01E06,0x01E06);
+  (0x01E08,0x01E08);
+  (0x01E0A,0x01E0A);
+  (0x01E0C,0x01E0C);
+  (0x01E0E,0x01E0E);
+  (0x01E10,0x01E10);
+  (0x01E12,0x01E12);
+  (0x01E14,0x01E14);
+  (0x01E16,0x01E16);
+  (0x01E18,0x01E18);
+  (0x01E1A,0x01E1A);
+  (0x01E1C,0x01E1C);
+  (0x01E1E,0x01E1E);
+  (0x01E20,0x01E20);
+  (0x01E22,0x01E22);
+  (0x01E24,0x01E24);
+  (0x01E26,0x01E26);
+  (0x01E28,0x01E28);
+  (0x01E2A,0x01E2A);
+  (0x01E2C,0x01E2C);
+  (0x01E2E,0x01E2E);
+  (0x01E30,0x01E30);
+  (0x01E32,0x01E32);
+  (0x01E34,0x01E34);
+  (0x01E36,0x01E36);
+  (0x01E38,0x01E38);
+  (0x01E3A,0x01E3A);
+  (0x01E3C,0x01E3C);
+  (0x01E3E,0x01E3E);
+  (0x01E40,0x01E40);
+  (0x01E42,0x01E42);
+  (0x01E44,0x01E44);
+  (0x01E46,0x01E46);
+  (0x01E48,0x01E48);
+  (0x01E4A,0x01E4A);
+  (0x01E4C,0x01E4C);
+  (0x01E4E,0x01E4E);
+  (0x01E50,0x01E50);
+  (0x01E52,0x01E52);
+  (0x01E54,0x01E54);
+  (0x01E56,0x01E56);
+  (0x01E58,0x01E58);
+  (0x01E5A,0x01E5A);
+  (0x01E5C,0x01E5C);
+  (0x01E5E,0x01E5E);
+  (0x01E60,0x01E60);
+  (0x01E62,0x01E62);
+  (0x01E64,0x01E64);
+  (0x01E66,0x01E66);
+  (0x01E68,0x01E68);
+  (0x01E6A,0x01E6A);
+  (0x01E6C,0x01E6C);
+  (0x01E6E,0x01E6E);
+  (0x01E70,0x01E70);
+  (0x01E72,0x01E72);
+  (0x01E74,0x01E74);
+  (0x01E76,0x01E76);
+  (0x01E78,0x01E78);
+  (0x01E7A,0x01E7A);
+  (0x01E7C,0x01E7C);
+  (0x01E7E,0x01E7E);
+  (0x01E80,0x01E80);
+  (0x01E82,0x01E82);
+  (0x01E84,0x01E84);
+  (0x01E86,0x01E86);
+  (0x01E88,0x01E88);
+  (0x01E8A,0x01E8A);
+  (0x01E8C,0x01E8C);
+  (0x01E8E,0x01E8E);
+  (0x01E90,0x01E90);
+  (0x01E92,0x01E92);
+  (0x01E94,0x01E94);
+  (0x01E9E,0x01E9E);
+  (0x01EA0,0x01EA0);
+  (0x01EA2,0x01EA2);
+  (0x01EA4,0x01EA4);
+  (0x01EA6,0x01EA6);
+  (0x01EA8,0x01EA8);
+  (0x01EAA,0x01EAA);
+  (0x01EAC,0x01EAC);
+  (0x01EAE,0x01EAE);
+  (0x01EB0,0x01EB0);
+  (0x01EB2,0x01EB2);
+  (0x01EB4,0x01EB4);
+  (0x01EB6,0x01EB6);
+  (0x01EB8,0x01EB8);
+  (0x01EBA,0x01EBA);
+  (0x01EBC,0x01EBC);
+  (0x01EBE,0x01EBE);
+  (0x01EC0,0x01EC0);
+  (0x01EC2,0x01EC2);
+  (0x01EC4,0x01EC4);
+  (0x01EC6,0x01EC6);
+  (0x01EC8,0x01EC8);
+  (0x01ECA,0x01ECA);
+  (0x01ECC,0x01ECC);
+  (0x01ECE,0x01ECE);
+  (0x01ED0,0x01ED0);
+  (0x01ED2,0x01ED2);
+  (0x01ED4,0x01ED4);
+  (0x01ED6,0x01ED6);
+  (0x01ED8,0x01ED8);
+  (0x01EDA,0x01EDA);
+  (0x01EDC,0x01EDC);
+  (0x01EDE,0x01EDE);
+  (0x01EE0,0x01EE0);
+  (0x01EE2,0x01EE2);
+  (0x01EE4,0x01EE4);
+  (0x01EE6,0x01EE6);
+  (0x01EE8,0x01EE8);
+  (0x01EEA,0x01EEA);
+  (0x01EEC,0x01EEC);
+  (0x01EEE,0x01EEE);
+  (0x01EF0,0x01EF0);
+  (0x01EF2,0x01EF2);
+  (0x01EF4,0x01EF4);
+  (0x01EF6,0x01EF6);
+  (0x01EF8,0x01EF8);
+  (0x01EFA,0x01EFA);
+  (0x01EFC,0x01EFC);
+  (0x01EFE,0x01EFE);
+  (0x01F08,0x01F0F);
+  (0x01F18,0x01F1D);
+  (0x01F28,0x01F2F);
+  (0x01F38,0x01F3F);
+  (0x01F48,0x01F4D);
+  (0x01F59,0x01F59);
+  (0x01F5B,0x01F5B);
+  (0x01F5D,0x01F5D);
+  (0x01F5F,0x01F5F);
+  (0x01F68,0x01F6F);
+  (0x01FB8,0x01FBB);
+  (0x01FC8,0x01FCB);
+  (0x01FD8,0x01FDB);
+  (0x01FE8,0x01FEC);
+  (0x01FF8,0x01FFB);
+  (0x02102,0x02102);
+  (0x02107,0x02107);
+  (0x0210B,0x0210D);
+  (0x02110,0x02112);
+  (0x02115,0x02115);
+  (0x02119,0x0211D);
+  (0x02124,0x02124);
+  (0x02126,0x02126);
+  (0x02128,0x02128);
+  (0x0212A,0x0212D);
+  (0x02130,0x02133);
+  (0x0213E,0x0213F);
+  (0x02145,0x02145);
+  (0x02183,0x02183);
+  (0x02C00,0x02C2E);
+  (0x02C60,0x02C60);
+  (0x02C62,0x02C64);
+  (0x02C67,0x02C67);
+  (0x02C69,0x02C69);
+  (0x02C6B,0x02C6B);
+  (0x02C6D,0x02C70);
+  (0x02C72,0x02C72);
+  (0x02C75,0x02C75);
+  (0x02C7E,0x02C80);
+  (0x02C82,0x02C82);
+  (0x02C84,0x02C84);
+  (0x02C86,0x02C86);
+  (0x02C88,0x02C88);
+  (0x02C8A,0x02C8A);
+  (0x02C8C,0x02C8C);
+  (0x02C8E,0x02C8E);
+  (0x02C90,0x02C90);
+  (0x02C92,0x02C92);
+  (0x02C94,0x02C94);
+  (0x02C96,0x02C96);
+  (0x02C98,0x02C98);
+  (0x02C9A,0x02C9A);
+  (0x02C9C,0x02C9C);
+  (0x02C9E,0x02C9E);
+  (0x02CA0,0x02CA0);
+  (0x02CA2,0x02CA2);
+  (0x02CA4,0x02CA4);
+  (0x02CA6,0x02CA6);
+  (0x02CA8,0x02CA8);
+  (0x02CAA,0x02CAA);
+  (0x02CAC,0x02CAC);
+  (0x02CAE,0x02CAE);
+  (0x02CB0,0x02CB0);
+  (0x02CB2,0x02CB2);
+  (0x02CB4,0x02CB4);
+  (0x02CB6,0x02CB6);
+  (0x02CB8,0x02CB8);
+  (0x02CBA,0x02CBA);
+  (0x02CBC,0x02CBC);
+  (0x02CBE,0x02CBE);
+  (0x02CC0,0x02CC0);
+  (0x02CC2,0x02CC2);
+  (0x02CC4,0x02CC4);
+  (0x02CC6,0x02CC6);
+  (0x02CC8,0x02CC8);
+  (0x02CCA,0x02CCA);
+  (0x02CCC,0x02CCC);
+  (0x02CCE,0x02CCE);
+  (0x02CD0,0x02CD0);
+  (0x02CD2,0x02CD2);
+  (0x02CD4,0x02CD4);
+  (0x02CD6,0x02CD6);
+  (0x02CD8,0x02CD8);
+  (0x02CDA,0x02CDA);
+  (0x02CDC,0x02CDC);
+  (0x02CDE,0x02CDE);
+  (0x02CE0,0x02CE0);
+  (0x02CE2,0x02CE2);
+  (0x02CEB,0x02CEB);
+  (0x02CED,0x02CED);
+  (0x02CF2,0x02CF2);
+  (0x0A640,0x0A640);
+  (0x0A642,0x0A642);
+  (0x0A644,0x0A644);
+  (0x0A646,0x0A646);
+  (0x0A648,0x0A648);
+  (0x0A64A,0x0A64A);
+  (0x0A64C,0x0A64C);
+  (0x0A64E,0x0A64E);
+  (0x0A650,0x0A650);
+  (0x0A652,0x0A652);
+  (0x0A654,0x0A654);
+  (0x0A656,0x0A656);
+  (0x0A658,0x0A658);
+  (0x0A65A,0x0A65A);
+  (0x0A65C,0x0A65C);
+  (0x0A65E,0x0A65E);
+  (0x0A660,0x0A660);
+  (0x0A662,0x0A662);
+  (0x0A664,0x0A664);
+  (0x0A666,0x0A666);
+  (0x0A668,0x0A668);
+  (0x0A66A,0x0A66A);
+  (0x0A66C,0x0A66C);
+  (0x0A680,0x0A680);
+  (0x0A682,0x0A682);
+  (0x0A684,0x0A684);
+  (0x0A686,0x0A686);
+  (0x0A688,0x0A688);
+  (0x0A68A,0x0A68A);
+  (0x0A68C,0x0A68C);
+  (0x0A68E,0x0A68E);
+  (0x0A690,0x0A690);
+  (0x0A692,0x0A692);
+  (0x0A694,0x0A694);
+  (0x0A696,0x0A696);
+  (0x0A698,0x0A698);
+  (0x0A69A,0x0A69A);
+  (0x0A722,0x0A722);
+  (0x0A724,0x0A724);
+  (0x0A726,0x0A726);
+  (0x0A728,0x0A728);
+  (0x0A72A,0x0A72A);
+  (0x0A72C,0x0A72C);
+  (0x0A72E,0x0A72E);
+  (0x0A732,0x0A732);
+  (0x0A734,0x0A734);
+  (0x0A736,0x0A736);
+  (0x0A738,0x0A738);
+  (0x0A73A,0x0A73A);
+  (0x0A73C,0x0A73C);
+  (0x0A73E,0x0A73E);
+  (0x0A740,0x0A740);
+  (0x0A742,0x0A742);
+  (0x0A744,0x0A744);
+  (0x0A746,0x0A746);
+  (0x0A748,0x0A748);
+  (0x0A74A,0x0A74A);
+  (0x0A74C,0x0A74C);
+  (0x0A74E,0x0A74E);
+  (0x0A750,0x0A750);
+  (0x0A752,0x0A752);
+  (0x0A754,0x0A754);
+  (0x0A756,0x0A756);
+  (0x0A758,0x0A758);
+  (0x0A75A,0x0A75A);
+  (0x0A75C,0x0A75C);
+  (0x0A75E,0x0A75E);
+  (0x0A760,0x0A760);
+  (0x0A762,0x0A762);
+  (0x0A764,0x0A764);
+  (0x0A766,0x0A766);
+  (0x0A768,0x0A768);
+  (0x0A76A,0x0A76A);
+  (0x0A76C,0x0A76C);
+  (0x0A76E,0x0A76E);
+  (0x0A779,0x0A779);
+  (0x0A77B,0x0A77B);
+  (0x0A77D,0x0A77E);
+  (0x0A780,0x0A780);
+  (0x0A782,0x0A782);
+  (0x0A784,0x0A784);
+  (0x0A786,0x0A786);
+  (0x0A78B,0x0A78B);
+  (0x0A78D,0x0A78D);
+  (0x0A790,0x0A790);
+  (0x0A792,0x0A792);
+  (0x0A796,0x0A796);
+  (0x0A798,0x0A798);
+  (0x0A79A,0x0A79A);
+  (0x0A79C,0x0A79C);
+  (0x0A79E,0x0A79E);
+  (0x0A7A0,0x0A7A0);
+  (0x0A7A2,0x0A7A2);
+  (0x0A7A4,0x0A7A4);
+  (0x0A7A6,0x0A7A6);
+  (0x0A7A8,0x0A7A8);
+  (0x0A7AA,0x0A7AE);
+  (0x0A7B0,0x0A7B4);
+  (0x0A7B6,0x0A7B6);
+  (0x0FF21,0x0FF3A);
+  (0x10400,0x10427);
+  (0x104B0,0x104D3);
+  (0x10C80,0x10CB2);
+  (0x118A0,0x118BF);
+  (0x1D400,0x1D419);
+  (0x1D434,0x1D44D);
+  (0x1D468,0x1D481);
+  (0x1D49C,0x1D49C);
+  (0x1D49E,0x1D49F);
+  (0x1D4A2,0x1D4A2);
+  (0x1D4A5,0x1D4A6);
+  (0x1D4A9,0x1D4AC);
+  (0x1D4AE,0x1D4B5);
+  (0x1D4D0,0x1D4E9);
+  (0x1D504,0x1D505);
+  (0x1D507,0x1D50A);
+  (0x1D50D,0x1D514);
+  (0x1D516,0x1D51C);
+  (0x1D538,0x1D539);
+  (0x1D53B,0x1D53E);
+  (0x1D540,0x1D544);
+  (0x1D546,0x1D546);
+  (0x1D54A,0x1D550);
+  (0x1D56C,0x1D585);
+  (0x1D5A0,0x1D5B9);
+  (0x1D5D4,0x1D5ED);
+  (0x1D608,0x1D621);
+  (0x1D63C,0x1D655);
+  (0x1D670,0x1D689);
+  (0x1D6A8,0x1D6C0);
+  (0x1D6E2,0x1D6FA);
+  (0x1D71C,0x1D734);
+  (0x1D756,0x1D76E);
+  (0x1D790,0x1D7A8);
+  (0x1D7CA,0x1D7CA)
+]
+(* Letter, Lowercase *)
+let ll = [
+  (0x00061,0x0007A);
+  (0x000B5,0x000B5);
+  (0x000DF,0x000F6);
+  (0x000F8,0x000FF);
+  (0x00101,0x00101);
+  (0x00103,0x00103);
+  (0x00105,0x00105);
+  (0x00107,0x00107);
+  (0x00109,0x00109);
+  (0x0010B,0x0010B);
+  (0x0010D,0x0010D);
+  (0x0010F,0x0010F);
+  (0x00111,0x00111);
+  (0x00113,0x00113);
+  (0x00115,0x00115);
+  (0x00117,0x00117);
+  (0x00119,0x00119);
+  (0x0011B,0x0011B);
+  (0x0011D,0x0011D);
+  (0x0011F,0x0011F);
+  (0x00121,0x00121);
+  (0x00123,0x00123);
+  (0x00125,0x00125);
+  (0x00127,0x00127);
+  (0x00129,0x00129);
+  (0x0012B,0x0012B);
+  (0x0012D,0x0012D);
+  (0x0012F,0x0012F);
+  (0x00131,0x00131);
+  (0x00133,0x00133);
+  (0x00135,0x00135);
+  (0x00137,0x00138);
+  (0x0013A,0x0013A);
+  (0x0013C,0x0013C);
+  (0x0013E,0x0013E);
+  (0x00140,0x00140);
+  (0x00142,0x00142);
+  (0x00144,0x00144);
+  (0x00146,0x00146);
+  (0x00148,0x00149);
+  (0x0014B,0x0014B);
+  (0x0014D,0x0014D);
+  (0x0014F,0x0014F);
+  (0x00151,0x00151);
+  (0x00153,0x00153);
+  (0x00155,0x00155);
+  (0x00157,0x00157);
+  (0x00159,0x00159);
+  (0x0015B,0x0015B);
+  (0x0015D,0x0015D);
+  (0x0015F,0x0015F);
+  (0x00161,0x00161);
+  (0x00163,0x00163);
+  (0x00165,0x00165);
+  (0x00167,0x00167);
+  (0x00169,0x00169);
+  (0x0016B,0x0016B);
+  (0x0016D,0x0016D);
+  (0x0016F,0x0016F);
+  (0x00171,0x00171);
+  (0x00173,0x00173);
+  (0x00175,0x00175);
+  (0x00177,0x00177);
+  (0x0017A,0x0017A);
+  (0x0017C,0x0017C);
+  (0x0017E,0x00180);
+  (0x00183,0x00183);
+  (0x00185,0x00185);
+  (0x00188,0x00188);
+  (0x0018C,0x0018D);
+  (0x00192,0x00192);
+  (0x00195,0x00195);
+  (0x00199,0x0019B);
+  (0x0019E,0x0019E);
+  (0x001A1,0x001A1);
+  (0x001A3,0x001A3);
+  (0x001A5,0x001A5);
+  (0x001A8,0x001A8);
+  (0x001AA,0x001AB);
+  (0x001AD,0x001AD);
+  (0x001B0,0x001B0);
+  (0x001B4,0x001B4);
+  (0x001B6,0x001B6);
+  (0x001B9,0x001BA);
+  (0x001BD,0x001BF);
+  (0x001C6,0x001C6);
+  (0x001C9,0x001C9);
+  (0x001CC,0x001CC);
+  (0x001CE,0x001CE);
+  (0x001D0,0x001D0);
+  (0x001D2,0x001D2);
+  (0x001D4,0x001D4);
+  (0x001D6,0x001D6);
+  (0x001D8,0x001D8);
+  (0x001DA,0x001DA);
+  (0x001DC,0x001DD);
+  (0x001DF,0x001DF);
+  (0x001E1,0x001E1);
+  (0x001E3,0x001E3);
+  (0x001E5,0x001E5);
+  (0x001E7,0x001E7);
+  (0x001E9,0x001E9);
+  (0x001EB,0x001EB);
+  (0x001ED,0x001ED);
+  (0x001EF,0x001F0);
+  (0x001F3,0x001F3);
+  (0x001F5,0x001F5);
+  (0x001F9,0x001F9);
+  (0x001FB,0x001FB);
+  (0x001FD,0x001FD);
+  (0x001FF,0x001FF);
+  (0x00201,0x00201);
+  (0x00203,0x00203);
+  (0x00205,0x00205);
+  (0x00207,0x00207);
+  (0x00209,0x00209);
+  (0x0020B,0x0020B);
+  (0x0020D,0x0020D);
+  (0x0020F,0x0020F);
+  (0x00211,0x00211);
+  (0x00213,0x00213);
+  (0x00215,0x00215);
+  (0x00217,0x00217);
+  (0x00219,0x00219);
+  (0x0021B,0x0021B);
+  (0x0021D,0x0021D);
+  (0x0021F,0x0021F);
+  (0x00221,0x00221);
+  (0x00223,0x00223);
+  (0x00225,0x00225);
+  (0x00227,0x00227);
+  (0x00229,0x00229);
+  (0x0022B,0x0022B);
+  (0x0022D,0x0022D);
+  (0x0022F,0x0022F);
+  (0x00231,0x00231);
+  (0x00233,0x00239);
+  (0x0023C,0x0023C);
+  (0x0023F,0x00240);
+  (0x00242,0x00242);
+  (0x00247,0x00247);
+  (0x00249,0x00249);
+  (0x0024B,0x0024B);
+  (0x0024D,0x0024D);
+  (0x0024F,0x00293);
+  (0x00295,0x002AF);
+  (0x00371,0x00371);
+  (0x00373,0x00373);
+  (0x00377,0x00377);
+  (0x0037B,0x0037D);
+  (0x00390,0x00390);
+  (0x003AC,0x003CE);
+  (0x003D0,0x003D1);
+  (0x003D5,0x003D7);
+  (0x003D9,0x003D9);
+  (0x003DB,0x003DB);
+  (0x003DD,0x003DD);
+  (0x003DF,0x003DF);
+  (0x003E1,0x003E1);
+  (0x003E3,0x003E3);
+  (0x003E5,0x003E5);
+  (0x003E7,0x003E7);
+  (0x003E9,0x003E9);
+  (0x003EB,0x003EB);
+  (0x003ED,0x003ED);
+  (0x003EF,0x003F3);
+  (0x003F5,0x003F5);
+  (0x003F8,0x003F8);
+  (0x003FB,0x003FC);
+  (0x00430,0x0045F);
+  (0x00461,0x00461);
+  (0x00463,0x00463);
+  (0x00465,0x00465);
+  (0x00467,0x00467);
+  (0x00469,0x00469);
+  (0x0046B,0x0046B);
+  (0x0046D,0x0046D);
+  (0x0046F,0x0046F);
+  (0x00471,0x00471);
+  (0x00473,0x00473);
+  (0x00475,0x00475);
+  (0x00477,0x00477);
+  (0x00479,0x00479);
+  (0x0047B,0x0047B);
+  (0x0047D,0x0047D);
+  (0x0047F,0x0047F);
+  (0x00481,0x00481);
+  (0x0048B,0x0048B);
+  (0x0048D,0x0048D);
+  (0x0048F,0x0048F);
+  (0x00491,0x00491);
+  (0x00493,0x00493);
+  (0x00495,0x00495);
+  (0x00497,0x00497);
+  (0x00499,0x00499);
+  (0x0049B,0x0049B);
+  (0x0049D,0x0049D);
+  (0x0049F,0x0049F);
+  (0x004A1,0x004A1);
+  (0x004A3,0x004A3);
+  (0x004A5,0x004A5);
+  (0x004A7,0x004A7);
+  (0x004A9,0x004A9);
+  (0x004AB,0x004AB);
+  (0x004AD,0x004AD);
+  (0x004AF,0x004AF);
+  (0x004B1,0x004B1);
+  (0x004B3,0x004B3);
+  (0x004B5,0x004B5);
+  (0x004B7,0x004B7);
+  (0x004B9,0x004B9);
+  (0x004BB,0x004BB);
+  (0x004BD,0x004BD);
+  (0x004BF,0x004BF);
+  (0x004C2,0x004C2);
+  (0x004C4,0x004C4);
+  (0x004C6,0x004C6);
+  (0x004C8,0x004C8);
+  (0x004CA,0x004CA);
+  (0x004CC,0x004CC);
+  (0x004CE,0x004CF);
+  (0x004D1,0x004D1);
+  (0x004D3,0x004D3);
+  (0x004D5,0x004D5);
+  (0x004D7,0x004D7);
+  (0x004D9,0x004D9);
+  (0x004DB,0x004DB);
+  (0x004DD,0x004DD);
+  (0x004DF,0x004DF);
+  (0x004E1,0x004E1);
+  (0x004E3,0x004E3);
+  (0x004E5,0x004E5);
+  (0x004E7,0x004E7);
+  (0x004E9,0x004E9);
+  (0x004EB,0x004EB);
+  (0x004ED,0x004ED);
+  (0x004EF,0x004EF);
+  (0x004F1,0x004F1);
+  (0x004F3,0x004F3);
+  (0x004F5,0x004F5);
+  (0x004F7,0x004F7);
+  (0x004F9,0x004F9);
+  (0x004FB,0x004FB);
+  (0x004FD,0x004FD);
+  (0x004FF,0x004FF);
+  (0x00501,0x00501);
+  (0x00503,0x00503);
+  (0x00505,0x00505);
+  (0x00507,0x00507);
+  (0x00509,0x00509);
+  (0x0050B,0x0050B);
+  (0x0050D,0x0050D);
+  (0x0050F,0x0050F);
+  (0x00511,0x00511);
+  (0x00513,0x00513);
+  (0x00515,0x00515);
+  (0x00517,0x00517);
+  (0x00519,0x00519);
+  (0x0051B,0x0051B);
+  (0x0051D,0x0051D);
+  (0x0051F,0x0051F);
+  (0x00521,0x00521);
+  (0x00523,0x00523);
+  (0x00525,0x00525);
+  (0x00527,0x00527);
+  (0x00529,0x00529);
+  (0x0052B,0x0052B);
+  (0x0052D,0x0052D);
+  (0x0052F,0x0052F);
+  (0x00561,0x00587);
+  (0x013F8,0x013FD);
+  (0x01C80,0x01C88);
+  (0x01D00,0x01D2B);
+  (0x01D6B,0x01D77);
+  (0x01D79,0x01D9A);
+  (0x01E01,0x01E01);
+  (0x01E03,0x01E03);
+  (0x01E05,0x01E05);
+  (0x01E07,0x01E07);
+  (0x01E09,0x01E09);
+  (0x01E0B,0x01E0B);
+  (0x01E0D,0x01E0D);
+  (0x01E0F,0x01E0F);
+  (0x01E11,0x01E11);
+  (0x01E13,0x01E13);
+  (0x01E15,0x01E15);
+  (0x01E17,0x01E17);
+  (0x01E19,0x01E19);
+  (0x01E1B,0x01E1B);
+  (0x01E1D,0x01E1D);
+  (0x01E1F,0x01E1F);
+  (0x01E21,0x01E21);
+  (0x01E23,0x01E23);
+  (0x01E25,0x01E25);
+  (0x01E27,0x01E27);
+  (0x01E29,0x01E29);
+  (0x01E2B,0x01E2B);
+  (0x01E2D,0x01E2D);
+  (0x01E2F,0x01E2F);
+  (0x01E31,0x01E31);
+  (0x01E33,0x01E33);
+  (0x01E35,0x01E35);
+  (0x01E37,0x01E37);
+  (0x01E39,0x01E39);
+  (0x01E3B,0x01E3B);
+  (0x01E3D,0x01E3D);
+  (0x01E3F,0x01E3F);
+  (0x01E41,0x01E41);
+  (0x01E43,0x01E43);
+  (0x01E45,0x01E45);
+  (0x01E47,0x01E47);
+  (0x01E49,0x01E49);
+  (0x01E4B,0x01E4B);
+  (0x01E4D,0x01E4D);
+  (0x01E4F,0x01E4F);
+  (0x01E51,0x01E51);
+  (0x01E53,0x01E53);
+  (0x01E55,0x01E55);
+  (0x01E57,0x01E57);
+  (0x01E59,0x01E59);
+  (0x01E5B,0x01E5B);
+  (0x01E5D,0x01E5D);
+  (0x01E5F,0x01E5F);
+  (0x01E61,0x01E61);
+  (0x01E63,0x01E63);
+  (0x01E65,0x01E65);
+  (0x01E67,0x01E67);
+  (0x01E69,0x01E69);
+  (0x01E6B,0x01E6B);
+  (0x01E6D,0x01E6D);
+  (0x01E6F,0x01E6F);
+  (0x01E71,0x01E71);
+  (0x01E73,0x01E73);
+  (0x01E75,0x01E75);
+  (0x01E77,0x01E77);
+  (0x01E79,0x01E79);
+  (0x01E7B,0x01E7B);
+  (0x01E7D,0x01E7D);
+  (0x01E7F,0x01E7F);
+  (0x01E81,0x01E81);
+  (0x01E83,0x01E83);
+  (0x01E85,0x01E85);
+  (0x01E87,0x01E87);
+  (0x01E89,0x01E89);
+  (0x01E8B,0x01E8B);
+  (0x01E8D,0x01E8D);
+  (0x01E8F,0x01E8F);
+  (0x01E91,0x01E91);
+  (0x01E93,0x01E93);
+  (0x01E95,0x01E9D);
+  (0x01E9F,0x01E9F);
+  (0x01EA1,0x01EA1);
+  (0x01EA3,0x01EA3);
+  (0x01EA5,0x01EA5);
+  (0x01EA7,0x01EA7);
+  (0x01EA9,0x01EA9);
+  (0x01EAB,0x01EAB);
+  (0x01EAD,0x01EAD);
+  (0x01EAF,0x01EAF);
+  (0x01EB1,0x01EB1);
+  (0x01EB3,0x01EB3);
+  (0x01EB5,0x01EB5);
+  (0x01EB7,0x01EB7);
+  (0x01EB9,0x01EB9);
+  (0x01EBB,0x01EBB);
+  (0x01EBD,0x01EBD);
+  (0x01EBF,0x01EBF);
+  (0x01EC1,0x01EC1);
+  (0x01EC3,0x01EC3);
+  (0x01EC5,0x01EC5);
+  (0x01EC7,0x01EC7);
+  (0x01EC9,0x01EC9);
+  (0x01ECB,0x01ECB);
+  (0x01ECD,0x01ECD);
+  (0x01ECF,0x01ECF);
+  (0x01ED1,0x01ED1);
+  (0x01ED3,0x01ED3);
+  (0x01ED5,0x01ED5);
+  (0x01ED7,0x01ED7);
+  (0x01ED9,0x01ED9);
+  (0x01EDB,0x01EDB);
+  (0x01EDD,0x01EDD);
+  (0x01EDF,0x01EDF);
+  (0x01EE1,0x01EE1);
+  (0x01EE3,0x01EE3);
+  (0x01EE5,0x01EE5);
+  (0x01EE7,0x01EE7);
+  (0x01EE9,0x01EE9);
+  (0x01EEB,0x01EEB);
+  (0x01EED,0x01EED);
+  (0x01EEF,0x01EEF);
+  (0x01EF1,0x01EF1);
+  (0x01EF3,0x01EF3);
+  (0x01EF5,0x01EF5);
+  (0x01EF7,0x01EF7);
+  (0x01EF9,0x01EF9);
+  (0x01EFB,0x01EFB);
+  (0x01EFD,0x01EFD);
+  (0x01EFF,0x01F07);
+  (0x01F10,0x01F15);
+  (0x01F20,0x01F27);
+  (0x01F30,0x01F37);
+  (0x01F40,0x01F45);
+  (0x01F50,0x01F57);
+  (0x01F60,0x01F67);
+  (0x01F70,0x01F7D);
+  (0x01F80,0x01F87);
+  (0x01F90,0x01F97);
+  (0x01FA0,0x01FA7);
+  (0x01FB0,0x01FB4);
+  (0x01FB6,0x01FB7);
+  (0x01FBE,0x01FBE);
+  (0x01FC2,0x01FC4);
+  (0x01FC6,0x01FC7);
+  (0x01FD0,0x01FD3);
+  (0x01FD6,0x01FD7);
+  (0x01FE0,0x01FE7);
+  (0x01FF2,0x01FF4);
+  (0x01FF6,0x01FF7);
+  (0x0210A,0x0210A);
+  (0x0210E,0x0210F);
+  (0x02113,0x02113);
+  (0x0212F,0x0212F);
+  (0x02134,0x02134);
+  (0x02139,0x02139);
+  (0x0213C,0x0213D);
+  (0x02146,0x02149);
+  (0x0214E,0x0214E);
+  (0x02184,0x02184);
+  (0x02C30,0x02C5E);
+  (0x02C61,0x02C61);
+  (0x02C65,0x02C66);
+  (0x02C68,0x02C68);
+  (0x02C6A,0x02C6A);
+  (0x02C6C,0x02C6C);
+  (0x02C71,0x02C71);
+  (0x02C73,0x02C74);
+  (0x02C76,0x02C7B);
+  (0x02C81,0x02C81);
+  (0x02C83,0x02C83);
+  (0x02C85,0x02C85);
+  (0x02C87,0x02C87);
+  (0x02C89,0x02C89);
+  (0x02C8B,0x02C8B);
+  (0x02C8D,0x02C8D);
+  (0x02C8F,0x02C8F);
+  (0x02C91,0x02C91);
+  (0x02C93,0x02C93);
+  (0x02C95,0x02C95);
+  (0x02C97,0x02C97);
+  (0x02C99,0x02C99);
+  (0x02C9B,0x02C9B);
+  (0x02C9D,0x02C9D);
+  (0x02C9F,0x02C9F);
+  (0x02CA1,0x02CA1);
+  (0x02CA3,0x02CA3);
+  (0x02CA5,0x02CA5);
+  (0x02CA7,0x02CA7);
+  (0x02CA9,0x02CA9);
+  (0x02CAB,0x02CAB);
+  (0x02CAD,0x02CAD);
+  (0x02CAF,0x02CAF);
+  (0x02CB1,0x02CB1);
+  (0x02CB3,0x02CB3);
+  (0x02CB5,0x02CB5);
+  (0x02CB7,0x02CB7);
+  (0x02CB9,0x02CB9);
+  (0x02CBB,0x02CBB);
+  (0x02CBD,0x02CBD);
+  (0x02CBF,0x02CBF);
+  (0x02CC1,0x02CC1);
+  (0x02CC3,0x02CC3);
+  (0x02CC5,0x02CC5);
+  (0x02CC7,0x02CC7);
+  (0x02CC9,0x02CC9);
+  (0x02CCB,0x02CCB);
+  (0x02CCD,0x02CCD);
+  (0x02CCF,0x02CCF);
+  (0x02CD1,0x02CD1);
+  (0x02CD3,0x02CD3);
+  (0x02CD5,0x02CD5);
+  (0x02CD7,0x02CD7);
+  (0x02CD9,0x02CD9);
+  (0x02CDB,0x02CDB);
+  (0x02CDD,0x02CDD);
+  (0x02CDF,0x02CDF);
+  (0x02CE1,0x02CE1);
+  (0x02CE3,0x02CE4);
+  (0x02CEC,0x02CEC);
+  (0x02CEE,0x02CEE);
+  (0x02CF3,0x02CF3);
+  (0x02D00,0x02D25);
+  (0x02D27,0x02D27);
+  (0x02D2D,0x02D2D);
+  (0x0A641,0x0A641);
+  (0x0A643,0x0A643);
+  (0x0A645,0x0A645);
+  (0x0A647,0x0A647);
+  (0x0A649,0x0A649);
+  (0x0A64B,0x0A64B);
+  (0x0A64D,0x0A64D);
+  (0x0A64F,0x0A64F);
+  (0x0A651,0x0A651);
+  (0x0A653,0x0A653);
+  (0x0A655,0x0A655);
+  (0x0A657,0x0A657);
+  (0x0A659,0x0A659);
+  (0x0A65B,0x0A65B);
+  (0x0A65D,0x0A65D);
+  (0x0A65F,0x0A65F);
+  (0x0A661,0x0A661);
+  (0x0A663,0x0A663);
+  (0x0A665,0x0A665);
+  (0x0A667,0x0A667);
+  (0x0A669,0x0A669);
+  (0x0A66B,0x0A66B);
+  (0x0A66D,0x0A66D);
+  (0x0A681,0x0A681);
+  (0x0A683,0x0A683);
+  (0x0A685,0x0A685);
+  (0x0A687,0x0A687);
+  (0x0A689,0x0A689);
+  (0x0A68B,0x0A68B);
+  (0x0A68D,0x0A68D);
+  (0x0A68F,0x0A68F);
+  (0x0A691,0x0A691);
+  (0x0A693,0x0A693);
+  (0x0A695,0x0A695);
+  (0x0A697,0x0A697);
+  (0x0A699,0x0A699);
+  (0x0A69B,0x0A69B);
+  (0x0A723,0x0A723);
+  (0x0A725,0x0A725);
+  (0x0A727,0x0A727);
+  (0x0A729,0x0A729);
+  (0x0A72B,0x0A72B);
+  (0x0A72D,0x0A72D);
+  (0x0A72F,0x0A731);
+  (0x0A733,0x0A733);
+  (0x0A735,0x0A735);
+  (0x0A737,0x0A737);
+  (0x0A739,0x0A739);
+  (0x0A73B,0x0A73B);
+  (0x0A73D,0x0A73D);
+  (0x0A73F,0x0A73F);
+  (0x0A741,0x0A741);
+  (0x0A743,0x0A743);
+  (0x0A745,0x0A745);
+  (0x0A747,0x0A747);
+  (0x0A749,0x0A749);
+  (0x0A74B,0x0A74B);
+  (0x0A74D,0x0A74D);
+  (0x0A74F,0x0A74F);
+  (0x0A751,0x0A751);
+  (0x0A753,0x0A753);
+  (0x0A755,0x0A755);
+  (0x0A757,0x0A757);
+  (0x0A759,0x0A759);
+  (0x0A75B,0x0A75B);
+  (0x0A75D,0x0A75D);
+  (0x0A75F,0x0A75F);
+  (0x0A761,0x0A761);
+  (0x0A763,0x0A763);
+  (0x0A765,0x0A765);
+  (0x0A767,0x0A767);
+  (0x0A769,0x0A769);
+  (0x0A76B,0x0A76B);
+  (0x0A76D,0x0A76D);
+  (0x0A76F,0x0A76F);
+  (0x0A771,0x0A778);
+  (0x0A77A,0x0A77A);
+  (0x0A77C,0x0A77C);
+  (0x0A77F,0x0A77F);
+  (0x0A781,0x0A781);
+  (0x0A783,0x0A783);
+  (0x0A785,0x0A785);
+  (0x0A787,0x0A787);
+  (0x0A78C,0x0A78C);
+  (0x0A78E,0x0A78E);
+  (0x0A791,0x0A791);
+  (0x0A793,0x0A795);
+  (0x0A797,0x0A797);
+  (0x0A799,0x0A799);
+  (0x0A79B,0x0A79B);
+  (0x0A79D,0x0A79D);
+  (0x0A79F,0x0A79F);
+  (0x0A7A1,0x0A7A1);
+  (0x0A7A3,0x0A7A3);
+  (0x0A7A5,0x0A7A5);
+  (0x0A7A7,0x0A7A7);
+  (0x0A7A9,0x0A7A9);
+  (0x0A7B5,0x0A7B5);
+  (0x0A7B7,0x0A7B7);
+  (0x0A7FA,0x0A7FA);
+  (0x0AB30,0x0AB5A);
+  (0x0AB60,0x0AB65);
+  (0x0AB70,0x0ABBF);
+  (0x0FB00,0x0FB06);
+  (0x0FB13,0x0FB17);
+  (0x0FF41,0x0FF5A);
+  (0x10428,0x1044F);
+  (0x104D8,0x104FB);
+  (0x10CC0,0x10CF2);
+  (0x118C0,0x118DF);
+  (0x1D41A,0x1D433);
+  (0x1D44E,0x1D454);
+  (0x1D456,0x1D467);
+  (0x1D482,0x1D49B);
+  (0x1D4B6,0x1D4B9);
+  (0x1D4BB,0x1D4BB);
+  (0x1D4BD,0x1D4C3);
+  (0x1D4C5,0x1D4CF);
+  (0x1D4EA,0x1D503);
+  (0x1D51E,0x1D537);
+  (0x1D552,0x1D56B);
+  (0x1D586,0x1D59F);
+  (0x1D5BA,0x1D5D3);
+  (0x1D5EE,0x1D607);
+  (0x1D622,0x1D63B);
+  (0x1D656,0x1D66F);
+  (0x1D68A,0x1D6A5);
+  (0x1D6C2,0x1D6DA);
+  (0x1D6DC,0x1D6E1);
+  (0x1D6FC,0x1D714);
+  (0x1D716,0x1D71B);
+  (0x1D736,0x1D74E);
+  (0x1D750,0x1D755);
+  (0x1D770,0x1D788);
+  (0x1D78A,0x1D78F);
+  (0x1D7AA,0x1D7C2);
+  (0x1D7C4,0x1D7C9);
+  (0x1D7CB,0x1D7CB)
+]
+(* Letter, Titlecase *)
+let lt = [
+  (0x001C5,0x001C5);
+  (0x001C8,0x001C8);
+  (0x001CB,0x001CB);
+  (0x001F2,0x001F2);
+  (0x01F88,0x01F8F);
+  (0x01F98,0x01F9F);
+  (0x01FA8,0x01FAF);
+  (0x01FBC,0x01FBC);
+  (0x01FCC,0x01FCC)
+]
+(* Mark, Non-Spacing *)
+let mn = [
+  (0x00300,0x0036F);
+  (0x00483,0x00487);
+  (0x00591,0x005BD);
+  (0x005BF,0x005BF);
+  (0x005C1,0x005C2);
+  (0x005C4,0x005C5);
+  (0x005C7,0x005C7);
+  (0x00610,0x0061A);
+  (0x0064B,0x0065F);
+  (0x00670,0x00670);
+  (0x006D6,0x006DC);
+  (0x006DF,0x006E4);
+  (0x006E7,0x006E8);
+  (0x006EA,0x006ED);
+  (0x00711,0x00711);
+  (0x00730,0x0074A);
+  (0x007A6,0x007B0);
+  (0x007EB,0x007F3);
+  (0x00816,0x00819);
+  (0x0081B,0x00823);
+  (0x00825,0x00827);
+  (0x00829,0x0082D);
+  (0x00859,0x0085B);
+  (0x008D4,0x008E1);
+  (0x008E3,0x00902);
+  (0x0093A,0x0093A);
+  (0x0093C,0x0093C);
+  (0x00941,0x00948);
+  (0x0094D,0x0094D);
+  (0x00951,0x00957);
+  (0x00962,0x00963);
+  (0x00981,0x00981);
+  (0x009BC,0x009BC);
+  (0x009C1,0x009C4);
+  (0x009CD,0x009CD);
+  (0x009E2,0x009E3);
+  (0x00A01,0x00A02);
+  (0x00A3C,0x00A3C);
+  (0x00A41,0x00A42);
+  (0x00A47,0x00A48);
+  (0x00A4B,0x00A4D);
+  (0x00A51,0x00A51);
+  (0x00A70,0x00A71);
+  (0x00A75,0x00A75);
+  (0x00A81,0x00A82);
+  (0x00ABC,0x00ABC);
+  (0x00AC1,0x00AC5);
+  (0x00AC7,0x00AC8);
+  (0x00ACD,0x00ACD);
+  (0x00AE2,0x00AE3);
+  (0x00B01,0x00B01);
+  (0x00B3C,0x00B3C);
+  (0x00B3F,0x00B3F);
+  (0x00B41,0x00B44);
+  (0x00B4D,0x00B4D);
+  (0x00B56,0x00B56);
+  (0x00B62,0x00B63);
+  (0x00B82,0x00B82);
+  (0x00BC0,0x00BC0);
+  (0x00BCD,0x00BCD);
+  (0x00C00,0x00C00);
+  (0x00C3E,0x00C40);
+  (0x00C46,0x00C48);
+  (0x00C4A,0x00C4D);
+  (0x00C55,0x00C56);
+  (0x00C62,0x00C63);
+  (0x00C81,0x00C81);
+  (0x00CBC,0x00CBC);
+  (0x00CBF,0x00CBF);
+  (0x00CC6,0x00CC6);
+  (0x00CCC,0x00CCD);
+  (0x00CE2,0x00CE3);
+  (0x00D01,0x00D01);
+  (0x00D41,0x00D44);
+  (0x00D4D,0x00D4D);
+  (0x00D62,0x00D63);
+  (0x00DCA,0x00DCA);
+  (0x00DD2,0x00DD4);
+  (0x00DD6,0x00DD6);
+  (0x00E31,0x00E31);
+  (0x00E34,0x00E3A);
+  (0x00E47,0x00E4E);
+  (0x00EB1,0x00EB1);
+  (0x00EB4,0x00EB9);
+  (0x00EBB,0x00EBC);
+  (0x00EC8,0x00ECD);
+  (0x00F18,0x00F19);
+  (0x00F35,0x00F35);
+  (0x00F37,0x00F37);
+  (0x00F39,0x00F39);
+  (0x00F71,0x00F7E);
+  (0x00F80,0x00F84);
+  (0x00F86,0x00F87);
+  (0x00F8D,0x00F97);
+  (0x00F99,0x00FBC);
+  (0x00FC6,0x00FC6);
+  (0x0102D,0x01030);
+  (0x01032,0x01037);
+  (0x01039,0x0103A);
+  (0x0103D,0x0103E);
+  (0x01058,0x01059);
+  (0x0105E,0x01060);
+  (0x01071,0x01074);
+  (0x01082,0x01082);
+  (0x01085,0x01086);
+  (0x0108D,0x0108D);
+  (0x0109D,0x0109D);
+  (0x0135D,0x0135F);
+  (0x01712,0x01714);
+  (0x01732,0x01734);
+  (0x01752,0x01753);
+  (0x01772,0x01773);
+  (0x017B4,0x017B5);
+  (0x017B7,0x017BD);
+  (0x017C6,0x017C6);
+  (0x017C9,0x017D3);
+  (0x017DD,0x017DD);
+  (0x0180B,0x0180D);
+  (0x01885,0x01886);
+  (0x018A9,0x018A9);
+  (0x01920,0x01922);
+  (0x01927,0x01928);
+  (0x01932,0x01932);
+  (0x01939,0x0193B);
+  (0x01A17,0x01A18);
+  (0x01A1B,0x01A1B);
+  (0x01A56,0x01A56);
+  (0x01A58,0x01A5E);
+  (0x01A60,0x01A60);
+  (0x01A62,0x01A62);
+  (0x01A65,0x01A6C);
+  (0x01A73,0x01A7C);
+  (0x01A7F,0x01A7F);
+  (0x01AB0,0x01ABD);
+  (0x01B00,0x01B03);
+  (0x01B34,0x01B34);
+  (0x01B36,0x01B3A);
+  (0x01B3C,0x01B3C);
+  (0x01B42,0x01B42);
+  (0x01B6B,0x01B73);
+  (0x01B80,0x01B81);
+  (0x01BA2,0x01BA5);
+  (0x01BA8,0x01BA9);
+  (0x01BAB,0x01BAD);
+  (0x01BE6,0x01BE6);
+  (0x01BE8,0x01BE9);
+  (0x01BED,0x01BED);
+  (0x01BEF,0x01BF1);
+  (0x01C2C,0x01C33);
+  (0x01C36,0x01C37);
+  (0x01CD0,0x01CD2);
+  (0x01CD4,0x01CE0);
+  (0x01CE2,0x01CE8);
+  (0x01CED,0x01CED);
+  (0x01CF4,0x01CF4);
+  (0x01CF8,0x01CF9);
+  (0x01DC0,0x01DF5);
+  (0x01DFB,0x01DFF);
+  (0x020D0,0x020DC);
+  (0x020E1,0x020E1);
+  (0x020E5,0x020F0);
+  (0x02CEF,0x02CF1);
+  (0x02D7F,0x02D7F);
+  (0x02DE0,0x02DFF);
+  (0x0302A,0x0302D);
+  (0x03099,0x0309A);
+  (0x0A66F,0x0A66F);
+  (0x0A674,0x0A67D);
+  (0x0A69E,0x0A69F);
+  (0x0A6F0,0x0A6F1);
+  (0x0A802,0x0A802);
+  (0x0A806,0x0A806);
+  (0x0A80B,0x0A80B);
+  (0x0A825,0x0A826);
+  (0x0A8C4,0x0A8C5);
+  (0x0A8E0,0x0A8F1);
+  (0x0A926,0x0A92D);
+  (0x0A947,0x0A951);
+  (0x0A980,0x0A982);
+  (0x0A9B3,0x0A9B3);
+  (0x0A9B6,0x0A9B9);
+  (0x0A9BC,0x0A9BC);
+  (0x0A9E5,0x0A9E5);
+  (0x0AA29,0x0AA2E);
+  (0x0AA31,0x0AA32);
+  (0x0AA35,0x0AA36);
+  (0x0AA43,0x0AA43);
+  (0x0AA4C,0x0AA4C);
+  (0x0AA7C,0x0AA7C);
+  (0x0AAB0,0x0AAB0);
+  (0x0AAB2,0x0AAB4);
+  (0x0AAB7,0x0AAB8);
+  (0x0AABE,0x0AABF);
+  (0x0AAC1,0x0AAC1);
+  (0x0AAEC,0x0AAED);
+  (0x0AAF6,0x0AAF6);
+  (0x0ABE5,0x0ABE5);
+  (0x0ABE8,0x0ABE8);
+  (0x0ABED,0x0ABED);
+  (0x0FB1E,0x0FB1E);
+  (0x0FE00,0x0FE0F);
+  (0x0FE20,0x0FE2F);
+  (0x101FD,0x101FD);
+  (0x102E0,0x102E0);
+  (0x10376,0x1037A);
+  (0x10A01,0x10A03);
+  (0x10A05,0x10A06);
+  (0x10A0C,0x10A0F);
+  (0x10A38,0x10A3A);
+  (0x10A3F,0x10A3F);
+  (0x10AE5,0x10AE6);
+  (0x11001,0x11001);
+  (0x11038,0x11046);
+  (0x1107F,0x11081);
+  (0x110B3,0x110B6);
+  (0x110B9,0x110BA);
+  (0x11100,0x11102);
+  (0x11127,0x1112B);
+  (0x1112D,0x11134);
+  (0x11173,0x11173);
+  (0x11180,0x11181);
+  (0x111B6,0x111BE);
+  (0x111CA,0x111CC);
+  (0x1122F,0x11231);
+  (0x11234,0x11234);
+  (0x11236,0x11237);
+  (0x1123E,0x1123E);
+  (0x112DF,0x112DF);
+  (0x112E3,0x112EA);
+  (0x11300,0x11301);
+  (0x1133C,0x1133C);
+  (0x11340,0x11340);
+  (0x11366,0x1136C);
+  (0x11370,0x11374);
+  (0x11438,0x1143F);
+  (0x11442,0x11444);
+  (0x11446,0x11446);
+  (0x114B3,0x114B8);
+  (0x114BA,0x114BA);
+  (0x114BF,0x114C0);
+  (0x114C2,0x114C3);
+  (0x115B2,0x115B5);
+  (0x115BC,0x115BD);
+  (0x115BF,0x115C0);
+  (0x115DC,0x115DD);
+  (0x11633,0x1163A);
+  (0x1163D,0x1163D);
+  (0x1163F,0x11640);
+  (0x116AB,0x116AB);
+  (0x116AD,0x116AD);
+  (0x116B0,0x116B5);
+  (0x116B7,0x116B7);
+  (0x1171D,0x1171F);
+  (0x11722,0x11725);
+  (0x11727,0x1172B);
+  (0x11C30,0x11C36);
+  (0x11C38,0x11C3D);
+  (0x11C3F,0x11C3F);
+  (0x11C92,0x11CA7);
+  (0x11CAA,0x11CB0);
+  (0x11CB2,0x11CB3);
+  (0x11CB5,0x11CB6);
+  (0x16AF0,0x16AF4);
+  (0x16B30,0x16B36);
+  (0x16F8F,0x16F92);
+  (0x1BC9D,0x1BC9E);
+  (0x1D167,0x1D169);
+  (0x1D17B,0x1D182);
+  (0x1D185,0x1D18B);
+  (0x1D1AA,0x1D1AD);
+  (0x1D242,0x1D244);
+  (0x1DA00,0x1DA36);
+  (0x1DA3B,0x1DA6C);
+  (0x1DA75,0x1DA75);
+  (0x1DA84,0x1DA84);
+  (0x1DA9B,0x1DA9F);
+  (0x1DAA1,0x1DAAF);
+  (0x1E000,0x1E006);
+  (0x1E008,0x1E018);
+  (0x1E01B,0x1E021);
+  (0x1E023,0x1E024);
+  (0x1E026,0x1E02A);
+  (0x1E8D0,0x1E8D6);
+  (0x1E944,0x1E94A)
+]
+(* Mark, Spacing Combining *)
+let mc = [
+  (0x00903,0x00903);
+  (0x0093B,0x0093B);
+  (0x0093E,0x00940);
+  (0x00949,0x0094C);
+  (0x0094E,0x0094F);
+  (0x00982,0x00983);
+  (0x009BE,0x009C0);
+  (0x009C7,0x009C8);
+  (0x009CB,0x009CC);
+  (0x009D7,0x009D7);
+  (0x00A03,0x00A03);
+  (0x00A3E,0x00A40);
+  (0x00A83,0x00A83);
+  (0x00ABE,0x00AC0);
+  (0x00AC9,0x00AC9);
+  (0x00ACB,0x00ACC);
+  (0x00B02,0x00B03);
+  (0x00B3E,0x00B3E);
+  (0x00B40,0x00B40);
+  (0x00B47,0x00B48);
+  (0x00B4B,0x00B4C);
+  (0x00B57,0x00B57);
+  (0x00BBE,0x00BBF);
+  (0x00BC1,0x00BC2);
+  (0x00BC6,0x00BC8);
+  (0x00BCA,0x00BCC);
+  (0x00BD7,0x00BD7);
+  (0x00C01,0x00C03);
+  (0x00C41,0x00C44);
+  (0x00C82,0x00C83);
+  (0x00CBE,0x00CBE);
+  (0x00CC0,0x00CC4);
+  (0x00CC7,0x00CC8);
+  (0x00CCA,0x00CCB);
+  (0x00CD5,0x00CD6);
+  (0x00D02,0x00D03);
+  (0x00D3E,0x00D40);
+  (0x00D46,0x00D48);
+  (0x00D4A,0x00D4C);
+  (0x00D57,0x00D57);
+  (0x00D82,0x00D83);
+  (0x00DCF,0x00DD1);
+  (0x00DD8,0x00DDF);
+  (0x00DF2,0x00DF3);
+  (0x00F3E,0x00F3F);
+  (0x00F7F,0x00F7F);
+  (0x0102B,0x0102C);
+  (0x01031,0x01031);
+  (0x01038,0x01038);
+  (0x0103B,0x0103C);
+  (0x01056,0x01057);
+  (0x01062,0x01064);
+  (0x01067,0x0106D);
+  (0x01083,0x01084);
+  (0x01087,0x0108C);
+  (0x0108F,0x0108F);
+  (0x0109A,0x0109C);
+  (0x017B6,0x017B6);
+  (0x017BE,0x017C5);
+  (0x017C7,0x017C8);
+  (0x01923,0x01926);
+  (0x01929,0x0192B);
+  (0x01930,0x01931);
+  (0x01933,0x01938);
+  (0x01A19,0x01A1A);
+  (0x01A55,0x01A55);
+  (0x01A57,0x01A57);
+  (0x01A61,0x01A61);
+  (0x01A63,0x01A64);
+  (0x01A6D,0x01A72);
+  (0x01B04,0x01B04);
+  (0x01B35,0x01B35);
+  (0x01B3B,0x01B3B);
+  (0x01B3D,0x01B41);
+  (0x01B43,0x01B44);
+  (0x01B82,0x01B82);
+  (0x01BA1,0x01BA1);
+  (0x01BA6,0x01BA7);
+  (0x01BAA,0x01BAA);
+  (0x01BE7,0x01BE7);
+  (0x01BEA,0x01BEC);
+  (0x01BEE,0x01BEE);
+  (0x01BF2,0x01BF3);
+  (0x01C24,0x01C2B);
+  (0x01C34,0x01C35);
+  (0x01CE1,0x01CE1);
+  (0x01CF2,0x01CF3);
+  (0x0302E,0x0302F);
+  (0x0A823,0x0A824);
+  (0x0A827,0x0A827);
+  (0x0A880,0x0A881);
+  (0x0A8B4,0x0A8C3);
+  (0x0A952,0x0A953);
+  (0x0A983,0x0A983);
+  (0x0A9B4,0x0A9B5);
+  (0x0A9BA,0x0A9BB);
+  (0x0A9BD,0x0A9C0);
+  (0x0AA2F,0x0AA30);
+  (0x0AA33,0x0AA34);
+  (0x0AA4D,0x0AA4D);
+  (0x0AA7B,0x0AA7B);
+  (0x0AA7D,0x0AA7D);
+  (0x0AAEB,0x0AAEB);
+  (0x0AAEE,0x0AAEF);
+  (0x0AAF5,0x0AAF5);
+  (0x0ABE3,0x0ABE4);
+  (0x0ABE6,0x0ABE7);
+  (0x0ABE9,0x0ABEA);
+  (0x0ABEC,0x0ABEC);
+  (0x11000,0x11000);
+  (0x11002,0x11002);
+  (0x11082,0x11082);
+  (0x110B0,0x110B2);
+  (0x110B7,0x110B8);
+  (0x1112C,0x1112C);
+  (0x11182,0x11182);
+  (0x111B3,0x111B5);
+  (0x111BF,0x111C0);
+  (0x1122C,0x1122E);
+  (0x11232,0x11233);
+  (0x11235,0x11235);
+  (0x112E0,0x112E2);
+  (0x11302,0x11303);
+  (0x1133E,0x1133F);
+  (0x11341,0x11344);
+  (0x11347,0x11348);
+  (0x1134B,0x1134D);
+  (0x11357,0x11357);
+  (0x11362,0x11363);
+  (0x11435,0x11437);
+  (0x11440,0x11441);
+  (0x11445,0x11445);
+  (0x114B0,0x114B2);
+  (0x114B9,0x114B9);
+  (0x114BB,0x114BE);
+  (0x114C1,0x114C1);
+  (0x115AF,0x115B1);
+  (0x115B8,0x115BB);
+  (0x115BE,0x115BE);
+  (0x11630,0x11632);
+  (0x1163B,0x1163C);
+  (0x1163E,0x1163E);
+  (0x116AC,0x116AC);
+  (0x116AE,0x116AF);
+  (0x116B6,0x116B6);
+  (0x11720,0x11721);
+  (0x11726,0x11726);
+  (0x11C2F,0x11C2F);
+  (0x11C3E,0x11C3E);
+  (0x11CA9,0x11CA9);
+  (0x11CB1,0x11CB1);
+  (0x11CB4,0x11CB4);
+  (0x16F51,0x16F7E);
+  (0x1D165,0x1D166)
+]
+(* Mark, Enclosing *)
+let me = [
+  (0x00488,0x00489);
+  (0x01ABE,0x01ABE);
+  (0x020DD,0x020E0);
+  (0x020E2,0x020E4)
+]
+(* Number, Decimal Digit *)
+let nd = [
+  (0x00030,0x00039);
+  (0x00660,0x00669);
+  (0x006F0,0x006F9);
+  (0x007C0,0x007C9);
+  (0x00966,0x0096F);
+  (0x009E6,0x009EF);
+  (0x00A66,0x00A6F);
+  (0x00AE6,0x00AEF);
+  (0x00B66,0x00B6F);
+  (0x00BE6,0x00BEF);
+  (0x00C66,0x00C6F);
+  (0x00CE6,0x00CEF);
+  (0x00D66,0x00D6F);
+  (0x00DE6,0x00DEF);
+  (0x00E50,0x00E59);
+  (0x00ED0,0x00ED9);
+  (0x00F20,0x00F29);
+  (0x01040,0x01049);
+  (0x01090,0x01099);
+  (0x017E0,0x017E9);
+  (0x01810,0x01819);
+  (0x01946,0x0194F);
+  (0x019D0,0x019D9);
+  (0x01A80,0x01A89);
+  (0x01A90,0x01A99);
+  (0x01B50,0x01B59);
+  (0x01BB0,0x01BB9);
+  (0x01C40,0x01C49);
+  (0x01C50,0x01C59);
+  (0x0A620,0x0A629);
+  (0x0A8D0,0x0A8D9);
+  (0x0A900,0x0A909);
+  (0x0A9D0,0x0A9D9);
+  (0x0A9F0,0x0A9F9);
+  (0x0AA50,0x0AA59);
+  (0x0ABF0,0x0ABF9);
+  (0x0FF10,0x0FF19);
+  (0x104A0,0x104A9);
+  (0x11066,0x1106F);
+  (0x110F0,0x110F9);
+  (0x11136,0x1113F);
+  (0x111D0,0x111D9);
+  (0x112F0,0x112F9);
+  (0x11450,0x11459);
+  (0x114D0,0x114D9);
+  (0x11650,0x11659);
+  (0x116C0,0x116C9);
+  (0x11730,0x11739);
+  (0x118E0,0x118E9);
+  (0x11C50,0x11C59);
+  (0x16A60,0x16A69);
+  (0x16B50,0x16B59);
+  (0x1D7CE,0x1D7FF)
+]
+(* Number, Letter *)
+let nl = [
+  (0x016EE,0x016F0);
+  (0x02160,0x02182);
+  (0x02185,0x02188);
+  (0x03007,0x03007);
+  (0x03021,0x03029);
+  (0x03038,0x0303A);
+  (0x0A6E6,0x0A6EF);
+  (0x10140,0x10174);
+  (0x10341,0x10341);
+  (0x1034A,0x1034A);
+  (0x103D1,0x103D5)
+]
+(* Number, Other *)
+let no = [
+  (0x000B2,0x000B3);
+  (0x000B9,0x000B9);
+  (0x000BC,0x000BE);
+  (0x009F4,0x009F9);
+  (0x00B72,0x00B77);
+  (0x00BF0,0x00BF2);
+  (0x00C78,0x00C7E);
+  (0x00D58,0x00D5E);
+  (0x00D70,0x00D78);
+  (0x00F2A,0x00F33);
+  (0x01369,0x0137C);
+  (0x017F0,0x017F9);
+  (0x019DA,0x019DA);
+  (0x02070,0x02070);
+  (0x02074,0x02079);
+  (0x02080,0x02089);
+  (0x02150,0x0215F);
+  (0x02189,0x02189);
+  (0x02460,0x0249B);
+  (0x024EA,0x024FF);
+  (0x02776,0x02793);
+  (0x02CFD,0x02CFD);
+  (0x03192,0x03195);
+  (0x03220,0x03229);
+  (0x03248,0x0324F);
+  (0x03251,0x0325F);
+  (0x03280,0x03289);
+  (0x032B1,0x032BF);
+  (0x0A830,0x0A835);
+  (0x10107,0x10133);
+  (0x10175,0x10178);
+  (0x1018A,0x1018B);
+  (0x102E1,0x102FB);
+  (0x10320,0x10323);
+  (0x10858,0x1085F);
+  (0x10879,0x1087F);
+  (0x108A7,0x108AF);
+  (0x108FB,0x108FF);
+  (0x10916,0x1091B);
+  (0x109BC,0x109BD);
+  (0x109C0,0x109CF);
+  (0x109D2,0x109FF);
+  (0x10A40,0x10A47);
+  (0x10A7D,0x10A7E);
+  (0x10A9D,0x10A9F);
+  (0x10AEB,0x10AEF);
+  (0x10B58,0x10B5F);
+  (0x10B78,0x10B7F);
+  (0x10BA9,0x10BAF);
+  (0x10CFA,0x10CFF);
+  (0x10E60,0x10E7E);
+  (0x11052,0x11065);
+  (0x111E1,0x111F4);
+  (0x1173A,0x1173B);
+  (0x118EA,0x118F2);
+  (0x11C5A,0x11C6C);
+  (0x16B5B,0x16B61);
+  (0x1D360,0x1D371);
+  (0x1E8C7,0x1E8CF)
+]
+(* Separator, Space *)
+let zs = [
+  (0x00020,0x00020);
+  (0x000A0,0x000A0);
+  (0x01680,0x01680);
+  (0x02000,0x0200A);
+  (0x0202F,0x0202F);
+  (0x0205F,0x0205F)
+]
+(* Separator, Line *)
+let zl = [
+
+]
+(* Separator, Paragraph *)
+let zp = [
+
+]
+(* Other, Control *)
+let cc = [
+  (0x00000,0x0001F)
+]
+(* Other, Format *)
+let cf = [
+  (0x000AD,0x000AD);
+  (0x00600,0x00605);
+  (0x0061C,0x0061C);
+  (0x006DD,0x006DD);
+  (0x0070F,0x0070F);
+  (0x008E2,0x008E2);
+  (0x0180E,0x0180E);
+  (0x0200B,0x0200F);
+  (0x0202A,0x0202E);
+  (0x02060,0x02064);
+  (0x02066,0x0206F);
+  (0x0FEFF,0x0FEFF);
+  (0x0FFF9,0x0FFFB);
+  (0x110BD,0x110BD);
+  (0x1BCA0,0x1BCA3);
+  (0x1D173,0x1D17A);
+  (0xE0001,0xE0001)
+]
+(* Other, Surrogate *)
+let cs = [
+
+]
+(* Other, Private Use *)
+let co = [
+  (0x0E000,0x0F8FF);
+  (0xF0000,0xFFFFD)
+]
+(* Other, Not Assigned *)
+let cn = [
+  (0x00378,0x00379);
+  (0x00380,0x00383);
+  (0x0038B,0x0038B);
+  (0x0038D,0x0038D);
+  (0x003A2,0x003A2);
+  (0x00530,0x00530);
+  (0x00557,0x00558);
+  (0x00560,0x00560);
+  (0x00588,0x00588);
+  (0x0058B,0x0058C);
+  (0x00590,0x00590);
+  (0x005C8,0x005CF);
+  (0x005EB,0x005EF);
+  (0x005F5,0x005FF);
+  (0x0061D,0x0061D);
+  (0x0070E,0x0070E);
+  (0x0074B,0x0074C);
+  (0x007B2,0x007BF);
+  (0x007FB,0x007FF);
+  (0x0082E,0x0082F);
+  (0x0083F,0x0083F);
+  (0x0085C,0x0085D);
+  (0x0085F,0x0089F);
+  (0x008B5,0x008B5);
+  (0x008BE,0x008D3);
+  (0x00984,0x00984);
+  (0x0098D,0x0098E);
+  (0x00991,0x00992);
+  (0x009A9,0x009A9);
+  (0x009B1,0x009B1);
+  (0x009B3,0x009B5);
+  (0x009BA,0x009BB);
+  (0x009C5,0x009C6);
+  (0x009C9,0x009CA);
+  (0x009CF,0x009D6);
+  (0x009D8,0x009DB);
+  (0x009DE,0x009DE);
+  (0x009E4,0x009E5);
+  (0x009FC,0x00A00);
+  (0x00A04,0x00A04);
+  (0x00A0B,0x00A0E);
+  (0x00A11,0x00A12);
+  (0x00A29,0x00A29);
+  (0x00A31,0x00A31);
+  (0x00A34,0x00A34);
+  (0x00A37,0x00A37);
+  (0x00A3A,0x00A3B);
+  (0x00A3D,0x00A3D);
+  (0x00A43,0x00A46);
+  (0x00A49,0x00A4A);
+  (0x00A4E,0x00A50);
+  (0x00A52,0x00A58);
+  (0x00A5D,0x00A5D);
+  (0x00A5F,0x00A65);
+  (0x00A76,0x00A80);
+  (0x00A84,0x00A84);
+  (0x00A8E,0x00A8E);
+  (0x00A92,0x00A92);
+  (0x00AA9,0x00AA9);
+  (0x00AB1,0x00AB1);
+  (0x00AB4,0x00AB4);
+  (0x00ABA,0x00ABB);
+  (0x00AC6,0x00AC6);
+  (0x00ACA,0x00ACA);
+  (0x00ACE,0x00ACF);
+  (0x00AD1,0x00ADF);
+  (0x00AE4,0x00AE5);
+  (0x00AF2,0x00AF8);
+  (0x00AFA,0x00B00);
+  (0x00B04,0x00B04);
+  (0x00B0D,0x00B0E);
+  (0x00B11,0x00B12);
+  (0x00B29,0x00B29);
+  (0x00B31,0x00B31);
+  (0x00B34,0x00B34);
+  (0x00B3A,0x00B3B);
+  (0x00B45,0x00B46);
+  (0x00B49,0x00B4A);
+  (0x00B4E,0x00B55);
+  (0x00B58,0x00B5B);
+  (0x00B5E,0x00B5E);
+  (0x00B64,0x00B65);
+  (0x00B78,0x00B81);
+  (0x00B84,0x00B84);
+  (0x00B8B,0x00B8D);
+  (0x00B91,0x00B91);
+  (0x00B96,0x00B98);
+  (0x00B9B,0x00B9B);
+  (0x00B9D,0x00B9D);
+  (0x00BA0,0x00BA2);
+  (0x00BA5,0x00BA7);
+  (0x00BAB,0x00BAD);
+  (0x00BBA,0x00BBD);
+  (0x00BC3,0x00BC5);
+  (0x00BC9,0x00BC9);
+  (0x00BCE,0x00BCF);
+  (0x00BD1,0x00BD6);
+  (0x00BD8,0x00BE5);
+  (0x00BFB,0x00BFF);
+  (0x00C04,0x00C04);
+  (0x00C0D,0x00C0D);
+  (0x00C11,0x00C11);
+  (0x00C29,0x00C29);
+  (0x00C3A,0x00C3C);
+  (0x00C45,0x00C45);
+  (0x00C49,0x00C49);
+  (0x00C4E,0x00C54);
+  (0x00C57,0x00C57);
+  (0x00C5B,0x00C5F);
+  (0x00C64,0x00C65);
+  (0x00C70,0x00C77);
+  (0x00C84,0x00C84);
+  (0x00C8D,0x00C8D);
+  (0x00C91,0x00C91);
+  (0x00CA9,0x00CA9);
+  (0x00CB4,0x00CB4);
+  (0x00CBA,0x00CBB);
+  (0x00CC5,0x00CC5);
+  (0x00CC9,0x00CC9);
+  (0x00CCE,0x00CD4);
+  (0x00CD7,0x00CDD);
+  (0x00CDF,0x00CDF);
+  (0x00CE4,0x00CE5);
+  (0x00CF0,0x00CF0);
+  (0x00CF3,0x00D00);
+  (0x00D04,0x00D04);
+  (0x00D0D,0x00D0D);
+  (0x00D11,0x00D11);
+  (0x00D3B,0x00D3C);
+  (0x00D45,0x00D45);
+  (0x00D49,0x00D49);
+  (0x00D50,0x00D53);
+  (0x00D64,0x00D65);
+  (0x00D80,0x00D81);
+  (0x00D84,0x00D84);
+  (0x00D97,0x00D99);
+  (0x00DB2,0x00DB2);
+  (0x00DBC,0x00DBC);
+  (0x00DBE,0x00DBF);
+  (0x00DC7,0x00DC9);
+  (0x00DCB,0x00DCE);
+  (0x00DD5,0x00DD5);
+  (0x00DD7,0x00DD7);
+  (0x00DE0,0x00DE5);
+  (0x00DF0,0x00DF1);
+  (0x00DF5,0x00E00);
+  (0x00E3B,0x00E3E);
+  (0x00E5C,0x00E80);
+  (0x00E83,0x00E83);
+  (0x00E85,0x00E86);
+  (0x00E89,0x00E89);
+  (0x00E8B,0x00E8C);
+  (0x00E8E,0x00E93);
+  (0x00E98,0x00E98);
+  (0x00EA0,0x00EA0);
+  (0x00EA4,0x00EA4);
+  (0x00EA6,0x00EA6);
+  (0x00EA8,0x00EA9);
+  (0x00EAC,0x00EAC);
+  (0x00EBA,0x00EBA);
+  (0x00EBE,0x00EBF);
+  (0x00EC5,0x00EC5);
+  (0x00EC7,0x00EC7);
+  (0x00ECE,0x00ECF);
+  (0x00EDA,0x00EDB);
+  (0x00EE0,0x00EFF);
+  (0x00F48,0x00F48);
+  (0x00F6D,0x00F70);
+  (0x00F98,0x00F98);
+  (0x00FBD,0x00FBD);
+  (0x00FCD,0x00FCD);
+  (0x00FDB,0x00FFF);
+  (0x010C6,0x010C6);
+  (0x010C8,0x010CC);
+  (0x010CE,0x010CF);
+  (0x01249,0x01249);
+  (0x0124E,0x0124F);
+  (0x01257,0x01257);
+  (0x01259,0x01259);
+  (0x0125E,0x0125F);
+  (0x01289,0x01289);
+  (0x0128E,0x0128F);
+  (0x012B1,0x012B1);
+  (0x012B6,0x012B7);
+  (0x012BF,0x012BF);
+  (0x012C1,0x012C1);
+  (0x012C6,0x012C7);
+  (0x012D7,0x012D7);
+  (0x01311,0x01311);
+  (0x01316,0x01317);
+  (0x0135B,0x0135C);
+  (0x0137D,0x0137F);
+  (0x0139A,0x0139F);
+  (0x013F6,0x013F7);
+  (0x013FE,0x013FF);
+  (0x0169D,0x0169F);
+  (0x016F9,0x016FF);
+  (0x0170D,0x0170D);
+  (0x01715,0x0171F);
+  (0x01737,0x0173F);
+  (0x01754,0x0175F);
+  (0x0176D,0x0176D);
+  (0x01771,0x01771);
+  (0x01774,0x0177F);
+  (0x017DE,0x017DF);
+  (0x017EA,0x017EF);
+  (0x017FA,0x017FF);
+  (0x0180F,0x0180F);
+  (0x0181A,0x0181F);
+  (0x01878,0x0187F);
+  (0x018AB,0x018AF);
+  (0x018F6,0x018FF);
+  (0x0191F,0x0191F);
+  (0x0192C,0x0192F);
+  (0x0193C,0x0193F);
+  (0x01941,0x01943);
+  (0x0196E,0x0196F);
+  (0x01975,0x0197F);
+  (0x019AC,0x019AF);
+  (0x019CA,0x019CF);
+  (0x019DB,0x019DD);
+  (0x01A1C,0x01A1D);
+  (0x01A5F,0x01A5F);
+  (0x01A7D,0x01A7E);
+  (0x01A8A,0x01A8F);
+  (0x01A9A,0x01A9F);
+  (0x01AAE,0x01AAF);
+  (0x01ABF,0x01AFF);
+  (0x01B4C,0x01B4F);
+  (0x01B7D,0x01B7F);
+  (0x01BF4,0x01BFB);
+  (0x01C38,0x01C3A);
+  (0x01C4A,0x01C4C);
+  (0x01C89,0x01CBF);
+  (0x01CC8,0x01CCF);
+  (0x01CF7,0x01CF7);
+  (0x01CFA,0x01CFF);
+  (0x01DF6,0x01DFA);
+  (0x01F16,0x01F17);
+  (0x01F1E,0x01F1F);
+  (0x01F46,0x01F47);
+  (0x01F4E,0x01F4F);
+  (0x01F58,0x01F58);
+  (0x01F5A,0x01F5A);
+  (0x01F5C,0x01F5C);
+  (0x01F5E,0x01F5E);
+  (0x01F7E,0x01F7F);
+  (0x01FB5,0x01FB5);
+  (0x01FC5,0x01FC5);
+  (0x01FD4,0x01FD5);
+  (0x01FDC,0x01FDC);
+  (0x01FF0,0x01FF1);
+  (0x01FF5,0x01FF5);
+  (0x01FFF,0x01FFF);
+  (0x02065,0x02065);
+  (0x02072,0x02073);
+  (0x0208F,0x0208F);
+  (0x0209D,0x0209F);
+  (0x020BF,0x020CF);
+  (0x020F1,0x020FF);
+  (0x0218C,0x0218F);
+  (0x023FF,0x023FF);
+  (0x02427,0x0243F);
+  (0x0244B,0x0245F);
+  (0x02B74,0x02B75);
+  (0x02B96,0x02B97);
+  (0x02BBA,0x02BBC);
+  (0x02BC9,0x02BC9);
+  (0x02BD2,0x02BEB);
+  (0x02BF0,0x02BFF);
+  (0x02C2F,0x02C2F);
+  (0x02C5F,0x02C5F);
+  (0x02CF4,0x02CF8);
+  (0x02D26,0x02D26);
+  (0x02D28,0x02D2C);
+  (0x02D2E,0x02D2F);
+  (0x02D68,0x02D6E);
+  (0x02D71,0x02D7E);
+  (0x02D97,0x02D9F);
+  (0x02DA7,0x02DA7);
+  (0x02DAF,0x02DAF);
+  (0x02DB7,0x02DB7);
+  (0x02DBF,0x02DBF);
+  (0x02DC7,0x02DC7);
+  (0x02DCF,0x02DCF);
+  (0x02DD7,0x02DD7);
+  (0x02DDF,0x02DDF);
+  (0x02E45,0x02E7F);
+  (0x02E9A,0x02E9A);
+  (0x02EF4,0x02EFF);
+  (0x02FD6,0x02FEF);
+  (0x02FFC,0x02FFF);
+  (0x03040,0x03040);
+  (0x03097,0x03098);
+  (0x03100,0x03104);
+  (0x0312E,0x03130);
+  (0x0318F,0x0318F);
+  (0x031BB,0x031BF);
+  (0x031E4,0x031EF);
+  (0x0321F,0x0321F);
+  (0x032FF,0x032FF);
+  (0x04DB6,0x04DBF);
+  (0x09FD6,0x09FFF);
+  (0x0A48D,0x0A48F);
+  (0x0A4C7,0x0A4CF);
+  (0x0A62C,0x0A63F);
+  (0x0A6F8,0x0A6FF);
+  (0x0A7AF,0x0A7AF);
+  (0x0A7B8,0x0A7F6);
+  (0x0A82C,0x0A82F);
+  (0x0A83A,0x0A83F);
+  (0x0A878,0x0A87F);
+  (0x0A8C6,0x0A8CD);
+  (0x0A8DA,0x0A8DF);
+  (0x0A8FE,0x0A8FF);
+  (0x0A954,0x0A95E);
+  (0x0A97D,0x0A97F);
+  (0x0A9CE,0x0A9CE);
+  (0x0A9DA,0x0A9DD);
+  (0x0A9FF,0x0A9FF);
+  (0x0AA37,0x0AA3F);
+  (0x0AA4E,0x0AA4F);
+  (0x0AA5A,0x0AA5B);
+  (0x0AAC3,0x0AADA);
+  (0x0AAF7,0x0AB00);
+  (0x0AB07,0x0AB08);
+  (0x0AB0F,0x0AB10);
+  (0x0AB17,0x0AB1F);
+  (0x0AB27,0x0AB27);
+  (0x0AB2F,0x0AB2F);
+  (0x0AB66,0x0AB6F);
+  (0x0ABEE,0x0ABEF);
+  (0x0ABFA,0x0ABFF);
+  (0x0D7A4,0x0D7AF);
+  (0x0D7C7,0x0D7CA);
+  (0x0D7FC,0x0D7FF);
+  (0x0FA6E,0x0FA6F);
+  (0x0FADA,0x0FAFF);
+  (0x0FB07,0x0FB12);
+  (0x0FB18,0x0FB1C);
+  (0x0FB37,0x0FB37);
+  (0x0FB3D,0x0FB3D);
+  (0x0FB3F,0x0FB3F);
+  (0x0FB42,0x0FB42);
+  (0x0FB45,0x0FB45);
+  (0x0FBC2,0x0FBD2);
+  (0x0FD40,0x0FD4F);
+  (0x0FD90,0x0FD91);
+  (0x0FDC8,0x0FDEF);
+  (0x0FDFE,0x0FDFF);
+  (0x0FE1A,0x0FE1F);
+  (0x0FE53,0x0FE53);
+  (0x0FE67,0x0FE67);
+  (0x0FE6C,0x0FE6F);
+  (0x0FE75,0x0FE75);
+  (0x0FEFD,0x0FEFE);
+  (0x0FF00,0x0FF00);
+  (0x0FFBF,0x0FFC1);
+  (0x0FFC8,0x0FFC9);
+  (0x0FFD0,0x0FFD1);
+  (0x0FFD8,0x0FFD9);
+  (0x0FFDD,0x0FFDF);
+  (0x0FFE7,0x0FFE7);
+  (0x0FFEF,0x0FFF8);
+  (0x0FFFE,0x0FFFF);
+  (0x1000C,0x1000C);
+  (0x10027,0x10027);
+  (0x1003B,0x1003B);
+  (0x1003E,0x1003E);
+  (0x1004E,0x1004F);
+  (0x1005E,0x1007F);
+  (0x100FB,0x100FF);
+  (0x10103,0x10106);
+  (0x10134,0x10136);
+  (0x1018F,0x1018F);
+  (0x1019C,0x1019F);
+  (0x101A1,0x101CF);
+  (0x101FE,0x1027F);
+  (0x1029D,0x1029F);
+  (0x102D1,0x102DF);
+  (0x102FC,0x102FF);
+  (0x10324,0x1032F);
+  (0x1034B,0x1034F);
+  (0x1037B,0x1037F);
+  (0x1039E,0x1039E);
+  (0x103C4,0x103C7);
+  (0x103D6,0x103FF);
+  (0x1049E,0x1049F);
+  (0x104AA,0x104AF);
+  (0x104D4,0x104D7);
+  (0x104FC,0x104FF);
+  (0x10528,0x1052F);
+  (0x10564,0x1056E);
+  (0x10570,0x105FF);
+  (0x10737,0x1073F);
+  (0x10756,0x1075F);
+  (0x10768,0x107FF);
+  (0x10806,0x10807);
+  (0x10809,0x10809);
+  (0x10836,0x10836);
+  (0x10839,0x1083B);
+  (0x1083D,0x1083E);
+  (0x10856,0x10856);
+  (0x1089F,0x108A6);
+  (0x108B0,0x108DF);
+  (0x108F3,0x108F3);
+  (0x108F6,0x108FA);
+  (0x1091C,0x1091E);
+  (0x1093A,0x1093E);
+  (0x10940,0x1097F);
+  (0x109B8,0x109BB);
+  (0x109D0,0x109D1);
+  (0x10A04,0x10A04);
+  (0x10A07,0x10A0B);
+  (0x10A14,0x10A14);
+  (0x10A18,0x10A18);
+  (0x10A34,0x10A37);
+  (0x10A3B,0x10A3E);
+  (0x10A48,0x10A4F);
+  (0x10A59,0x10A5F);
+  (0x10AA0,0x10ABF);
+  (0x10AE7,0x10AEA);
+  (0x10AF7,0x10AFF);
+  (0x10B36,0x10B38);
+  (0x10B56,0x10B57);
+  (0x10B73,0x10B77);
+  (0x10B92,0x10B98);
+  (0x10B9D,0x10BA8);
+  (0x10BB0,0x10BFF);
+  (0x10C49,0x10C7F);
+  (0x10CB3,0x10CBF);
+  (0x10CF3,0x10CF9);
+  (0x10D00,0x10E5F);
+  (0x10E7F,0x10FFF);
+  (0x1104E,0x11051);
+  (0x11070,0x1107E);
+  (0x110C2,0x110CF);
+  (0x110E9,0x110EF);
+  (0x110FA,0x110FF);
+  (0x11135,0x11135);
+  (0x11144,0x1114F);
+  (0x11177,0x1117F);
+  (0x111CE,0x111CF);
+  (0x111E0,0x111E0);
+  (0x111F5,0x111FF);
+  (0x11212,0x11212);
+  (0x1123F,0x1127F);
+  (0x11287,0x11287);
+  (0x11289,0x11289);
+  (0x1128E,0x1128E);
+  (0x1129E,0x1129E);
+  (0x112AA,0x112AF);
+  (0x112EB,0x112EF);
+  (0x112FA,0x112FF);
+  (0x11304,0x11304);
+  (0x1130D,0x1130E);
+  (0x11311,0x11312);
+  (0x11329,0x11329);
+  (0x11331,0x11331);
+  (0x11334,0x11334);
+  (0x1133A,0x1133B);
+  (0x11345,0x11346);
+  (0x11349,0x1134A);
+  (0x1134E,0x1134F);
+  (0x11351,0x11356);
+  (0x11358,0x1135C);
+  (0x11364,0x11365);
+  (0x1136D,0x1136F);
+  (0x11375,0x113FF);
+  (0x1145A,0x1145A);
+  (0x1145C,0x1145C);
+  (0x1145E,0x1147F);
+  (0x114C8,0x114CF);
+  (0x114DA,0x1157F);
+  (0x115B6,0x115B7);
+  (0x115DE,0x115FF);
+  (0x11645,0x1164F);
+  (0x1165A,0x1165F);
+  (0x1166D,0x1167F);
+  (0x116B8,0x116BF);
+  (0x116CA,0x116FF);
+  (0x1171A,0x1171C);
+  (0x1172C,0x1172F);
+  (0x11740,0x1189F);
+  (0x118F3,0x118FE);
+  (0x11900,0x11ABF);
+  (0x11AF9,0x11BFF);
+  (0x11C09,0x11C09);
+  (0x11C37,0x11C37);
+  (0x11C46,0x11C4F);
+  (0x11C6D,0x11C6F);
+  (0x11C90,0x11C91);
+  (0x11CA8,0x11CA8);
+  (0x11CB7,0x11FFF);
+  (0x1239A,0x123FF);
+  (0x1246F,0x1246F);
+  (0x12475,0x1247F);
+  (0x12544,0x12FFF);
+  (0x1342F,0x143FF);
+  (0x14647,0x167FF);
+  (0x16A39,0x16A3F);
+  (0x16A5F,0x16A5F);
+  (0x16A6A,0x16A6D);
+  (0x16A70,0x16ACF);
+  (0x16AEE,0x16AEF);
+  (0x16AF6,0x16AFF);
+  (0x16B46,0x16B4F);
+  (0x16B5A,0x16B5A);
+  (0x16B62,0x16B62);
+  (0x16B78,0x16B7C);
+  (0x16B90,0x16EFF);
+  (0x16F45,0x16F4F);
+  (0x16F7F,0x16F8E);
+  (0x16FA0,0x16FDF);
+  (0x16FE1,0x16FFF);
+  (0x187ED,0x187FF);
+  (0x18AF3,0x1AFFF);
+  (0x1B002,0x1BBFF);
+  (0x1BC6B,0x1BC6F);
+  (0x1BC7D,0x1BC7F);
+  (0x1BC89,0x1BC8F);
+  (0x1BC9A,0x1BC9B);
+  (0x1BCA4,0x1CFFF);
+  (0x1D0F6,0x1D0FF);
+  (0x1D127,0x1D128);
+  (0x1D1E9,0x1D1FF);
+  (0x1D246,0x1D2FF);
+  (0x1D357,0x1D35F);
+  (0x1D372,0x1D3FF);
+  (0x1D455,0x1D455);
+  (0x1D49D,0x1D49D);
+  (0x1D4A0,0x1D4A1);
+  (0x1D4A3,0x1D4A4);
+  (0x1D4A7,0x1D4A8);
+  (0x1D4AD,0x1D4AD);
+  (0x1D4BA,0x1D4BA);
+  (0x1D4BC,0x1D4BC);
+  (0x1D4C4,0x1D4C4);
+  (0x1D506,0x1D506);
+  (0x1D50B,0x1D50C);
+  (0x1D515,0x1D515);
+  (0x1D51D,0x1D51D);
+  (0x1D53A,0x1D53A);
+  (0x1D53F,0x1D53F);
+  (0x1D545,0x1D545);
+  (0x1D547,0x1D549);
+  (0x1D551,0x1D551);
+  (0x1D6A6,0x1D6A7);
+  (0x1D7CC,0x1D7CD);
+  (0x1DA8C,0x1DA9A);
+  (0x1DAA0,0x1DAA0);
+  (0x1DAB0,0x1DFFF);
+  (0x1E007,0x1E007);
+  (0x1E019,0x1E01A);
+  (0x1E022,0x1E022);
+  (0x1E025,0x1E025);
+  (0x1E02B,0x1E7FF);
+  (0x1E8C5,0x1E8C6);
+  (0x1E8D7,0x1E8FF);
+  (0x1E94B,0x1E94F);
+  (0x1E95A,0x1E95D);
+  (0x1E960,0x1EDFF);
+  (0x1EE04,0x1EE04);
+  (0x1EE20,0x1EE20);
+  (0x1EE23,0x1EE23);
+  (0x1EE25,0x1EE26);
+  (0x1EE28,0x1EE28);
+  (0x1EE33,0x1EE33);
+  (0x1EE38,0x1EE38);
+  (0x1EE3A,0x1EE3A);
+  (0x1EE3C,0x1EE41);
+  (0x1EE43,0x1EE46);
+  (0x1EE48,0x1EE48);
+  (0x1EE4A,0x1EE4A);
+  (0x1EE4C,0x1EE4C);
+  (0x1EE50,0x1EE50);
+  (0x1EE53,0x1EE53);
+  (0x1EE55,0x1EE56);
+  (0x1EE58,0x1EE58);
+  (0x1EE5A,0x1EE5A);
+  (0x1EE5C,0x1EE5C);
+  (0x1EE5E,0x1EE5E);
+  (0x1EE60,0x1EE60);
+  (0x1EE63,0x1EE63);
+  (0x1EE65,0x1EE66);
+  (0x1EE6B,0x1EE6B);
+  (0x1EE73,0x1EE73);
+  (0x1EE78,0x1EE78);
+  (0x1EE7D,0x1EE7D);
+  (0x1EE7F,0x1EE7F);
+  (0x1EE8A,0x1EE8A);
+  (0x1EE9C,0x1EEA0);
+  (0x1EEA4,0x1EEA4);
+  (0x1EEAA,0x1EEAA);
+  (0x1EEBC,0x1EEEF);
+  (0x1EEF2,0x1EFFF);
+  (0x1F02C,0x1F02F);
+  (0x1F094,0x1F09F);
+  (0x1F0AF,0x1F0B0);
+  (0x1F0C0,0x1F0C0);
+  (0x1F0D0,0x1F0D0);
+  (0x1F0F6,0x1F0FF);
+  (0x1F10D,0x1F10F);
+  (0x1F12F,0x1F12F);
+  (0x1F16C,0x1F16F);
+  (0x1F1AD,0x1F1E5);
+  (0x1F203,0x1F20F);
+  (0x1F23C,0x1F23F);
+  (0x1F249,0x1F24F);
+  (0x1F252,0x1F2FF);
+  (0x1F6D3,0x1F6DF);
+  (0x1F6ED,0x1F6EF);
+  (0x1F6F7,0x1F6FF);
+  (0x1F774,0x1F77F);
+  (0x1F7D5,0x1F7FF);
+  (0x1F80C,0x1F80F);
+  (0x1F848,0x1F84F);
+  (0x1F85A,0x1F85F);
+  (0x1F888,0x1F88F);
+  (0x1F8AE,0x1F90F);
+  (0x1F91F,0x1F91F);
+  (0x1F928,0x1F92F);
+  (0x1F931,0x1F932);
+  (0x1F93F,0x1F93F);
+  (0x1F94C,0x1F94F);
+  (0x1F95F,0x1F97F);
+  (0x1F992,0x1F9BF);
+  (0x1F9C1,0x1FFFF);
+  (0x2A6D7,0x2A6FF);
+  (0x2B735,0x2B73F);
+  (0x2B81E,0x2B81F);
+  (0x2CEA2,0x2F7FF);
+  (0x2FA1E,0xE0000);
+  (0xE0002,0xE001F);
+  (0xE0080,0xE00FF);
+  (0xE01F0,0xEFFFF);
+  (0xFFFFE,0xFFFFF)
+]
+(* Letter, Modifier *)
+let lm = [
+  (0x002B0,0x002C1);
+  (0x002C6,0x002D1);
+  (0x002E0,0x002E4);
+  (0x002EC,0x002EC);
+  (0x002EE,0x002EE);
+  (0x00374,0x00374);
+  (0x0037A,0x0037A);
+  (0x00559,0x00559);
+  (0x00640,0x00640);
+  (0x006E5,0x006E6);
+  (0x007F4,0x007F5);
+  (0x007FA,0x007FA);
+  (0x0081A,0x0081A);
+  (0x00824,0x00824);
+  (0x00828,0x00828);
+  (0x00971,0x00971);
+  (0x00E46,0x00E46);
+  (0x00EC6,0x00EC6);
+  (0x010FC,0x010FC);
+  (0x017D7,0x017D7);
+  (0x01843,0x01843);
+  (0x01AA7,0x01AA7);
+  (0x01C78,0x01C7D);
+  (0x01D2C,0x01D6A);
+  (0x01D78,0x01D78);
+  (0x01D9B,0x01DBF);
+  (0x02071,0x02071);
+  (0x0207F,0x0207F);
+  (0x02090,0x0209C);
+  (0x02C7C,0x02C7D);
+  (0x02D6F,0x02D6F);
+  (0x02E2F,0x02E2F);
+  (0x03005,0x03005);
+  (0x03031,0x03035);
+  (0x0303B,0x0303B);
+  (0x0309D,0x0309E);
+  (0x030FC,0x030FE);
+  (0x0A015,0x0A015);
+  (0x0A4F8,0x0A4FD);
+  (0x0A60C,0x0A60C);
+  (0x0A67F,0x0A67F);
+  (0x0A69C,0x0A69D);
+  (0x0A717,0x0A71F);
+  (0x0A770,0x0A770);
+  (0x0A788,0x0A788);
+  (0x0A7F8,0x0A7F9);
+  (0x0A9CF,0x0A9CF);
+  (0x0A9E6,0x0A9E6);
+  (0x0AA70,0x0AA70);
+  (0x0AADD,0x0AADD);
+  (0x0AAF3,0x0AAF4);
+  (0x0AB5C,0x0AB5F);
+  (0x0FF70,0x0FF70);
+  (0x0FF9E,0x0FF9F);
+  (0x16B40,0x16B43);
+  (0x16F93,0x16F9F)
+]
+(* Letter, Other *)
+let lo = [
+  (0x000AA,0x000AA);
+  (0x000BA,0x000BA);
+  (0x001BB,0x001BB);
+  (0x001C0,0x001C3);
+  (0x00294,0x00294);
+  (0x005D0,0x005EA);
+  (0x005F0,0x005F2);
+  (0x00620,0x0063F);
+  (0x00641,0x0064A);
+  (0x0066E,0x0066F);
+  (0x00671,0x006D3);
+  (0x006D5,0x006D5);
+  (0x006EE,0x006EF);
+  (0x006FA,0x006FC);
+  (0x006FF,0x006FF);
+  (0x00710,0x00710);
+  (0x00712,0x0072F);
+  (0x0074D,0x007A5);
+  (0x007B1,0x007B1);
+  (0x007CA,0x007EA);
+  (0x00800,0x00815);
+  (0x00840,0x00858);
+  (0x008A0,0x008B4);
+  (0x008B6,0x008BD);
+  (0x00904,0x00939);
+  (0x0093D,0x0093D);
+  (0x00950,0x00950);
+  (0x00958,0x00961);
+  (0x00972,0x00980);
+  (0x00985,0x0098C);
+  (0x0098F,0x00990);
+  (0x00993,0x009A8);
+  (0x009AA,0x009B0);
+  (0x009B2,0x009B2);
+  (0x009B6,0x009B9);
+  (0x009BD,0x009BD);
+  (0x009CE,0x009CE);
+  (0x009DC,0x009DD);
+  (0x009DF,0x009E1);
+  (0x009F0,0x009F1);
+  (0x00A05,0x00A0A);
+  (0x00A0F,0x00A10);
+  (0x00A13,0x00A28);
+  (0x00A2A,0x00A30);
+  (0x00A32,0x00A33);
+  (0x00A35,0x00A36);
+  (0x00A38,0x00A39);
+  (0x00A59,0x00A5C);
+  (0x00A5E,0x00A5E);
+  (0x00A72,0x00A74);
+  (0x00A85,0x00A8D);
+  (0x00A8F,0x00A91);
+  (0x00A93,0x00AA8);
+  (0x00AAA,0x00AB0);
+  (0x00AB2,0x00AB3);
+  (0x00AB5,0x00AB9);
+  (0x00ABD,0x00ABD);
+  (0x00AD0,0x00AD0);
+  (0x00AE0,0x00AE1);
+  (0x00AF9,0x00AF9);
+  (0x00B05,0x00B0C);
+  (0x00B0F,0x00B10);
+  (0x00B13,0x00B28);
+  (0x00B2A,0x00B30);
+  (0x00B32,0x00B33);
+  (0x00B35,0x00B39);
+  (0x00B3D,0x00B3D);
+  (0x00B5C,0x00B5D);
+  (0x00B5F,0x00B61);
+  (0x00B71,0x00B71);
+  (0x00B83,0x00B83);
+  (0x00B85,0x00B8A);
+  (0x00B8E,0x00B90);
+  (0x00B92,0x00B95);
+  (0x00B99,0x00B9A);
+  (0x00B9C,0x00B9C);
+  (0x00B9E,0x00B9F);
+  (0x00BA3,0x00BA4);
+  (0x00BA8,0x00BAA);
+  (0x00BAE,0x00BB9);
+  (0x00BD0,0x00BD0);
+  (0x00C05,0x00C0C);
+  (0x00C0E,0x00C10);
+  (0x00C12,0x00C28);
+  (0x00C2A,0x00C39);
+  (0x00C3D,0x00C3D);
+  (0x00C58,0x00C5A);
+  (0x00C60,0x00C61);
+  (0x00C80,0x00C80);
+  (0x00C85,0x00C8C);
+  (0x00C8E,0x00C90);
+  (0x00C92,0x00CA8);
+  (0x00CAA,0x00CB3);
+  (0x00CB5,0x00CB9);
+  (0x00CBD,0x00CBD);
+  (0x00CDE,0x00CDE);
+  (0x00CE0,0x00CE1);
+  (0x00CF1,0x00CF2);
+  (0x00D05,0x00D0C);
+  (0x00D0E,0x00D10);
+  (0x00D12,0x00D3A);
+  (0x00D3D,0x00D3D);
+  (0x00D4E,0x00D4E);
+  (0x00D54,0x00D56);
+  (0x00D5F,0x00D61);
+  (0x00D7A,0x00D7F);
+  (0x00D85,0x00D96);
+  (0x00D9A,0x00DB1);
+  (0x00DB3,0x00DBB);
+  (0x00DBD,0x00DBD);
+  (0x00DC0,0x00DC6);
+  (0x00E01,0x00E30);
+  (0x00E32,0x00E33);
+  (0x00E40,0x00E45);
+  (0x00E81,0x00E82);
+  (0x00E84,0x00E84);
+  (0x00E87,0x00E88);
+  (0x00E8A,0x00E8A);
+  (0x00E8D,0x00E8D);
+  (0x00E94,0x00E97);
+  (0x00E99,0x00E9F);
+  (0x00EA1,0x00EA3);
+  (0x00EA5,0x00EA5);
+  (0x00EA7,0x00EA7);
+  (0x00EAA,0x00EAB);
+  (0x00EAD,0x00EB0);
+  (0x00EB2,0x00EB3);
+  (0x00EBD,0x00EBD);
+  (0x00EC0,0x00EC4);
+  (0x00EDC,0x00EDF);
+  (0x00F00,0x00F00);
+  (0x00F40,0x00F47);
+  (0x00F49,0x00F6C);
+  (0x00F88,0x00F8C);
+  (0x01000,0x0102A);
+  (0x0103F,0x0103F);
+  (0x01050,0x01055);
+  (0x0105A,0x0105D);
+  (0x01061,0x01061);
+  (0x01065,0x01066);
+  (0x0106E,0x01070);
+  (0x01075,0x01081);
+  (0x0108E,0x0108E);
+  (0x010D0,0x010FA);
+  (0x010FD,0x01248);
+  (0x0124A,0x0124D);
+  (0x01250,0x01256);
+  (0x01258,0x01258);
+  (0x0125A,0x0125D);
+  (0x01260,0x01288);
+  (0x0128A,0x0128D);
+  (0x01290,0x012B0);
+  (0x012B2,0x012B5);
+  (0x012B8,0x012BE);
+  (0x012C0,0x012C0);
+  (0x012C2,0x012C5);
+  (0x012C8,0x012D6);
+  (0x012D8,0x01310);
+  (0x01312,0x01315);
+  (0x01318,0x0135A);
+  (0x01380,0x0138F);
+  (0x01401,0x0166C);
+  (0x0166F,0x0167F);
+  (0x01681,0x0169A);
+  (0x016A0,0x016EA);
+  (0x016F1,0x016F8);
+  (0x01700,0x0170C);
+  (0x0170E,0x01711);
+  (0x01720,0x01731);
+  (0x01740,0x01751);
+  (0x01760,0x0176C);
+  (0x0176E,0x01770);
+  (0x01780,0x017B3);
+  (0x017DC,0x017DC);
+  (0x01820,0x01842);
+  (0x01844,0x01877);
+  (0x01880,0x01884);
+  (0x01887,0x018A8);
+  (0x018AA,0x018AA);
+  (0x018B0,0x018F5);
+  (0x01900,0x0191E);
+  (0x01950,0x0196D);
+  (0x01970,0x01974);
+  (0x01980,0x019AB);
+  (0x019B0,0x019C9);
+  (0x01A00,0x01A16);
+  (0x01A20,0x01A54);
+  (0x01B05,0x01B33);
+  (0x01B45,0x01B4B);
+  (0x01B83,0x01BA0);
+  (0x01BAE,0x01BAF);
+  (0x01BBA,0x01BE5);
+  (0x01C00,0x01C23);
+  (0x01C4D,0x01C4F);
+  (0x01C5A,0x01C77);
+  (0x01CE9,0x01CEC);
+  (0x01CEE,0x01CF1);
+  (0x01CF5,0x01CF6);
+  (0x02135,0x02138);
+  (0x02D30,0x02D67);
+  (0x02D80,0x02D96);
+  (0x02DA0,0x02DA6);
+  (0x02DA8,0x02DAE);
+  (0x02DB0,0x02DB6);
+  (0x02DB8,0x02DBE);
+  (0x02DC0,0x02DC6);
+  (0x02DC8,0x02DCE);
+  (0x02DD0,0x02DD6);
+  (0x02DD8,0x02DDE);
+  (0x03006,0x03006);
+  (0x0303C,0x0303C);
+  (0x03041,0x03096);
+  (0x0309F,0x0309F);
+  (0x030A1,0x030FA);
+  (0x030FF,0x030FF);
+  (0x03105,0x0312D);
+  (0x03131,0x0318E);
+  (0x031A0,0x031BA);
+  (0x031F0,0x031FF);
+  (0x03400,0x04DB5);
+  (0x04E00,0x09FD5);
+  (0x0A000,0x0A014);
+  (0x0A016,0x0A48C);
+  (0x0A4D0,0x0A4F7);
+  (0x0A500,0x0A60B);
+  (0x0A610,0x0A61F);
+  (0x0A62A,0x0A62B);
+  (0x0A66E,0x0A66E);
+  (0x0A6A0,0x0A6E5);
+  (0x0A78F,0x0A78F);
+  (0x0A7F7,0x0A7F7);
+  (0x0A7FB,0x0A801);
+  (0x0A803,0x0A805);
+  (0x0A807,0x0A80A);
+  (0x0A80C,0x0A822);
+  (0x0A840,0x0A873);
+  (0x0A882,0x0A8B3);
+  (0x0A8F2,0x0A8F7);
+  (0x0A8FB,0x0A8FB);
+  (0x0A8FD,0x0A8FD);
+  (0x0A90A,0x0A925);
+  (0x0A930,0x0A946);
+  (0x0A960,0x0A97C);
+  (0x0A984,0x0A9B2);
+  (0x0A9E0,0x0A9E4);
+  (0x0A9E7,0x0A9EF);
+  (0x0A9FA,0x0A9FE);
+  (0x0AA00,0x0AA28);
+  (0x0AA40,0x0AA42);
+  (0x0AA44,0x0AA4B);
+  (0x0AA60,0x0AA6F);
+  (0x0AA71,0x0AA76);
+  (0x0AA7A,0x0AA7A);
+  (0x0AA7E,0x0AAAF);
+  (0x0AAB1,0x0AAB1);
+  (0x0AAB5,0x0AAB6);
+  (0x0AAB9,0x0AABD);
+  (0x0AAC0,0x0AAC0);
+  (0x0AAC2,0x0AAC2);
+  (0x0AADB,0x0AADC);
+  (0x0AAE0,0x0AAEA);
+  (0x0AAF2,0x0AAF2);
+  (0x0AB01,0x0AB06);
+  (0x0AB09,0x0AB0E);
+  (0x0AB11,0x0AB16);
+  (0x0AB20,0x0AB26);
+  (0x0AB28,0x0AB2E);
+  (0x0ABC0,0x0ABE2);
+  (0x0AC00,0x0D7A3);
+  (0x0D7B0,0x0D7C6);
+  (0x0D7CB,0x0D7FB);
+  (0x0F900,0x0FA6D);
+  (0x0FA70,0x0FAD9);
+  (0x0FB1D,0x0FB1D);
+  (0x0FB1F,0x0FB28);
+  (0x0FB2A,0x0FB36);
+  (0x0FB38,0x0FB3C);
+  (0x0FB3E,0x0FB3E);
+  (0x0FB40,0x0FB41);
+  (0x0FB43,0x0FB44);
+  (0x0FB46,0x0FBB1);
+  (0x0FBD3,0x0FD3D);
+  (0x0FD50,0x0FD8F);
+  (0x0FD92,0x0FDC7);
+  (0x0FDF0,0x0FDFB);
+  (0x0FE70,0x0FE74);
+  (0x0FE76,0x0FEFC);
+  (0x0FF66,0x0FF6F);
+  (0x0FF71,0x0FF9D);
+  (0x0FFA0,0x0FFBE);
+  (0x0FFC2,0x0FFC7);
+  (0x0FFCA,0x0FFCF);
+  (0x0FFD2,0x0FFD7);
+  (0x0FFDA,0x0FFDC);
+  (0x10000,0x1000B);
+  (0x1000D,0x10026);
+  (0x10028,0x1003A);
+  (0x1003C,0x1003D);
+  (0x1003F,0x1004D);
+  (0x10050,0x1005D);
+  (0x10080,0x100FA);
+  (0x10280,0x1029C);
+  (0x102A0,0x102D0);
+  (0x10300,0x1031F);
+  (0x10330,0x10340);
+  (0x10342,0x10349);
+  (0x10350,0x10375);
+  (0x10380,0x1039D);
+  (0x103A0,0x103C3);
+  (0x103C8,0x103CF);
+  (0x10450,0x1049D);
+  (0x10500,0x10527);
+  (0x10530,0x10563);
+  (0x10600,0x10736);
+  (0x10740,0x10755);
+  (0x10760,0x10767);
+  (0x10800,0x10805);
+  (0x10808,0x10808);
+  (0x1080A,0x10835);
+  (0x10837,0x10838);
+  (0x1083C,0x1083C);
+  (0x1083F,0x10855);
+  (0x10860,0x10876);
+  (0x10880,0x1089E);
+  (0x108E0,0x108F2);
+  (0x108F4,0x108F5);
+  (0x10900,0x10915);
+  (0x10920,0x10939);
+  (0x10980,0x109B7);
+  (0x109BE,0x109BF);
+  (0x10A00,0x10A00);
+  (0x10A10,0x10A13);
+  (0x10A15,0x10A17);
+  (0x10A19,0x10A33);
+  (0x10A60,0x10A7C);
+  (0x10A80,0x10A9C);
+  (0x10AC0,0x10AC7);
+  (0x10AC9,0x10AE4);
+  (0x10B00,0x10B35);
+  (0x10B40,0x10B55);
+  (0x10B60,0x10B72);
+  (0x10B80,0x10B91);
+  (0x10C00,0x10C48);
+  (0x11003,0x11037);
+  (0x11083,0x110AF);
+  (0x110D0,0x110E8);
+  (0x11103,0x11126);
+  (0x11150,0x11172);
+  (0x11176,0x11176);
+  (0x11183,0x111B2);
+  (0x111C1,0x111C4);
+  (0x111DA,0x111DA);
+  (0x111DC,0x111DC);
+  (0x11200,0x11211);
+  (0x11213,0x1122B);
+  (0x11280,0x11286);
+  (0x11288,0x11288);
+  (0x1128A,0x1128D);
+  (0x1128F,0x1129D);
+  (0x1129F,0x112A8);
+  (0x112B0,0x112DE);
+  (0x11305,0x1130C);
+  (0x1130F,0x11310);
+  (0x11313,0x11328);
+  (0x1132A,0x11330);
+  (0x11332,0x11333);
+  (0x11335,0x11339);
+  (0x1133D,0x1133D);
+  (0x11350,0x11350);
+  (0x1135D,0x11361);
+  (0x11400,0x11434);
+  (0x11447,0x1144A);
+  (0x11480,0x114AF);
+  (0x114C4,0x114C5);
+  (0x114C7,0x114C7);
+  (0x11580,0x115AE);
+  (0x115D8,0x115DB);
+  (0x11600,0x1162F);
+  (0x11644,0x11644);
+  (0x11680,0x116AA);
+  (0x11700,0x11719);
+  (0x118FF,0x118FF);
+  (0x11AC0,0x11AF8);
+  (0x11C00,0x11C08);
+  (0x11C0A,0x11C2E);
+  (0x11C40,0x11C40);
+  (0x11C72,0x11C8F);
+  (0x12000,0x12399);
+  (0x12480,0x12543);
+  (0x13000,0x1342E);
+  (0x14400,0x14646);
+  (0x16800,0x16A38);
+  (0x16A40,0x16A5E);
+  (0x16AD0,0x16AED);
+  (0x16B00,0x16B2F);
+  (0x16B63,0x16B77);
+  (0x16B7D,0x16B8F);
+  (0x16F00,0x16F44);
+  (0x16F50,0x16F50);
+  (0x17000,0x187EC);
+  (0x18800,0x18AF2);
+  (0x1B000,0x1B001);
+  (0x1BC00,0x1BC6A);
+  (0x1BC70,0x1BC7C);
+  (0x1BC80,0x1BC88);
+  (0x1BC90,0x1BC99);
+  (0x1E800,0x1E8C4);
+  (0x1EE00,0x1EE03);
+  (0x1EE05,0x1EE1F);
+  (0x1EE21,0x1EE22);
+  (0x1EE24,0x1EE24);
+  (0x1EE27,0x1EE27);
+  (0x1EE29,0x1EE32);
+  (0x1EE34,0x1EE37);
+  (0x1EE39,0x1EE39);
+  (0x1EE3B,0x1EE3B);
+  (0x1EE42,0x1EE42);
+  (0x1EE47,0x1EE47);
+  (0x1EE49,0x1EE49);
+  (0x1EE4B,0x1EE4B);
+  (0x1EE4D,0x1EE4F);
+  (0x1EE51,0x1EE52);
+  (0x1EE54,0x1EE54);
+  (0x1EE57,0x1EE57);
+  (0x1EE59,0x1EE59);
+  (0x1EE5B,0x1EE5B);
+  (0x1EE5D,0x1EE5D);
+  (0x1EE5F,0x1EE5F);
+  (0x1EE61,0x1EE62);
+  (0x1EE64,0x1EE64);
+  (0x1EE67,0x1EE6A);
+  (0x1EE6C,0x1EE72);
+  (0x1EE74,0x1EE77);
+  (0x1EE79,0x1EE7C);
+  (0x1EE7E,0x1EE7E);
+  (0x1EE80,0x1EE89);
+  (0x1EE8B,0x1EE9B);
+  (0x1EEA1,0x1EEA3);
+  (0x1EEA5,0x1EEA9);
+  (0x1EEAB,0x1EEBB);
+  (0x20000,0x2A6D6);
+  (0x2A700,0x2B734);
+  (0x2B740,0x2B81D);
+  (0x2B820,0x2CEA1)
+]
+(* Punctuation, Connector *)
+let pc = [
+  (0x0005F,0x0005F);
+  (0x0203F,0x02040);
+  (0x02054,0x02054);
+  (0x0FE33,0x0FE34);
+  (0x0FE4D,0x0FE4F)
+]
+(* Punctuation, Dash *)
+let pd = [
+  (0x0002D,0x0002D);
+  (0x0058A,0x0058A);
+  (0x005BE,0x005BE);
+  (0x01400,0x01400);
+  (0x01806,0x01806);
+  (0x02010,0x02015);
+  (0x02E17,0x02E17);
+  (0x02E1A,0x02E1A);
+  (0x02E3A,0x02E3B);
+  (0x02E40,0x02E40);
+  (0x0301C,0x0301C);
+  (0x03030,0x03030);
+  (0x030A0,0x030A0);
+  (0x0FE31,0x0FE32);
+  (0x0FE58,0x0FE58);
+  (0x0FE63,0x0FE63)
+]
+(* Punctuation, Open *)
+let ps = [
+  (0x00028,0x00028);
+  (0x0005B,0x0005B);
+  (0x0007B,0x0007B);
+  (0x00F3A,0x00F3A);
+  (0x00F3C,0x00F3C);
+  (0x0169B,0x0169B);
+  (0x0201A,0x0201A);
+  (0x0201E,0x0201E);
+  (0x02045,0x02045);
+  (0x0207D,0x0207D);
+  (0x0208D,0x0208D);
+  (0x02308,0x02308);
+  (0x0230A,0x0230A);
+  (0x02329,0x02329);
+  (0x02768,0x02768);
+  (0x0276A,0x0276A);
+  (0x0276C,0x0276C);
+  (0x0276E,0x0276E);
+  (0x02770,0x02770);
+  (0x02772,0x02772);
+  (0x02774,0x02774);
+  (0x027C5,0x027C5);
+  (0x027E6,0x027E6);
+  (0x027E8,0x027E8);
+  (0x027EA,0x027EA);
+  (0x027EC,0x027EC);
+  (0x027EE,0x027EE);
+  (0x02983,0x02983);
+  (0x02985,0x02985);
+  (0x02987,0x02987);
+  (0x02989,0x02989);
+  (0x0298B,0x0298B);
+  (0x0298D,0x0298D);
+  (0x0298F,0x0298F);
+  (0x02991,0x02991);
+  (0x02993,0x02993);
+  (0x02995,0x02995);
+  (0x02997,0x02997);
+  (0x029D8,0x029D8);
+  (0x029DA,0x029DA);
+  (0x029FC,0x029FC);
+  (0x02E22,0x02E22);
+  (0x02E24,0x02E24);
+  (0x02E26,0x02E26);
+  (0x02E28,0x02E28);
+  (0x02E42,0x02E42);
+  (0x03008,0x03008);
+  (0x0300A,0x0300A);
+  (0x0300C,0x0300C);
+  (0x0300E,0x0300E);
+  (0x03010,0x03010);
+  (0x03014,0x03014);
+  (0x03016,0x03016);
+  (0x03018,0x03018);
+  (0x0301A,0x0301A);
+  (0x0301D,0x0301D);
+  (0x0FD3F,0x0FD3F);
+  (0x0FE17,0x0FE17);
+  (0x0FE35,0x0FE35);
+  (0x0FE37,0x0FE37);
+  (0x0FE39,0x0FE39);
+  (0x0FE3B,0x0FE3B);
+  (0x0FE3D,0x0FE3D);
+  (0x0FE3F,0x0FE3F);
+  (0x0FE41,0x0FE41);
+  (0x0FE43,0x0FE43);
+  (0x0FE47,0x0FE47);
+  (0x0FE59,0x0FE59);
+  (0x0FE5B,0x0FE5B);
+  (0x0FE5D,0x0FE5D);
+  (0x0FF08,0x0FF08);
+  (0x0FF3B,0x0FF3B);
+  (0x0FF5B,0x0FF5B);
+  (0x0FF5F,0x0FF5F)
+]
+(* Punctuation, Close *)
+let pe = [
+  (0x00029,0x00029);
+  (0x0005D,0x0005D);
+  (0x0007D,0x0007D);
+  (0x00F3B,0x00F3B);
+  (0x00F3D,0x00F3D);
+  (0x0169C,0x0169C);
+  (0x02046,0x02046);
+  (0x0207E,0x0207E);
+  (0x0208E,0x0208E);
+  (0x02309,0x02309);
+  (0x0230B,0x0230B);
+  (0x0232A,0x0232A);
+  (0x02769,0x02769);
+  (0x0276B,0x0276B);
+  (0x0276D,0x0276D);
+  (0x0276F,0x0276F);
+  (0x02771,0x02771);
+  (0x02773,0x02773);
+  (0x02775,0x02775);
+  (0x027C6,0x027C6);
+  (0x027E7,0x027E7);
+  (0x027E9,0x027E9);
+  (0x027EB,0x027EB);
+  (0x027ED,0x027ED);
+  (0x027EF,0x027EF);
+  (0x02984,0x02984);
+  (0x02986,0x02986);
+  (0x02988,0x02988);
+  (0x0298A,0x0298A);
+  (0x0298C,0x0298C);
+  (0x0298E,0x0298E);
+  (0x02990,0x02990);
+  (0x02992,0x02992);
+  (0x02994,0x02994);
+  (0x02996,0x02996);
+  (0x02998,0x02998);
+  (0x029D9,0x029D9);
+  (0x029DB,0x029DB);
+  (0x029FD,0x029FD);
+  (0x02E23,0x02E23);
+  (0x02E25,0x02E25);
+  (0x02E27,0x02E27);
+  (0x02E29,0x02E29);
+  (0x03009,0x03009);
+  (0x0300B,0x0300B);
+  (0x0300D,0x0300D);
+  (0x0300F,0x0300F);
+  (0x03011,0x03011);
+  (0x03015,0x03015);
+  (0x03017,0x03017);
+  (0x03019,0x03019);
+  (0x0301B,0x0301B);
+  (0x0301E,0x0301F);
+  (0x0FD3E,0x0FD3E);
+  (0x0FE18,0x0FE18);
+  (0x0FE36,0x0FE36);
+  (0x0FE38,0x0FE38);
+  (0x0FE3A,0x0FE3A);
+  (0x0FE3C,0x0FE3C);
+  (0x0FE3E,0x0FE3E);
+  (0x0FE40,0x0FE40);
+  (0x0FE42,0x0FE42);
+  (0x0FE44,0x0FE44);
+  (0x0FE48,0x0FE48);
+  (0x0FE5A,0x0FE5A);
+  (0x0FE5C,0x0FE5C);
+  (0x0FE5E,0x0FE5E);
+  (0x0FF09,0x0FF09);
+  (0x0FF3D,0x0FF3D);
+  (0x0FF5D,0x0FF5D);
+  (0x0FF60,0x0FF60)
+]
+(* Punctuation, Initial quote  *)
+let pi = [
+  (0x000AB,0x000AB);
+  (0x02018,0x02018);
+  (0x0201B,0x0201C);
+  (0x0201F,0x0201F);
+  (0x02039,0x02039);
+  (0x02E02,0x02E02);
+  (0x02E04,0x02E04);
+  (0x02E09,0x02E09);
+  (0x02E0C,0x02E0C);
+  (0x02E1C,0x02E1C)
+]
+(* Punctuation, Final quote  *)
+let pf = [
+  (0x000BB,0x000BB);
+  (0x02019,0x02019);
+  (0x0201D,0x0201D);
+  (0x0203A,0x0203A);
+  (0x02E03,0x02E03);
+  (0x02E05,0x02E05);
+  (0x02E0A,0x02E0A);
+  (0x02E0D,0x02E0D);
+  (0x02E1D,0x02E1D)
+]
+(* Punctuation, Other *)
+let po = [
+  (0x00021,0x00023);
+  (0x00025,0x00027);
+  (0x0002A,0x0002A);
+  (0x0002C,0x0002C);
+  (0x0002E,0x0002F);
+  (0x0003A,0x0003B);
+  (0x0003F,0x00040);
+  (0x0005C,0x0005C);
+  (0x000A1,0x000A1);
+  (0x000A7,0x000A7);
+  (0x000B6,0x000B7);
+  (0x000BF,0x000BF);
+  (0x0037E,0x0037E);
+  (0x00387,0x00387);
+  (0x0055A,0x0055F);
+  (0x00589,0x00589);
+  (0x005C0,0x005C0);
+  (0x005C3,0x005C3);
+  (0x005C6,0x005C6);
+  (0x005F3,0x005F4);
+  (0x00609,0x0060A);
+  (0x0060C,0x0060D);
+  (0x0061B,0x0061B);
+  (0x0061E,0x0061F);
+  (0x0066A,0x0066D);
+  (0x006D4,0x006D4);
+  (0x00700,0x0070D);
+  (0x007F7,0x007F9);
+  (0x00830,0x0083E);
+  (0x0085E,0x0085E);
+  (0x00964,0x00965);
+  (0x00970,0x00970);
+  (0x00AF0,0x00AF0);
+  (0x00DF4,0x00DF4);
+  (0x00E4F,0x00E4F);
+  (0x00E5A,0x00E5B);
+  (0x00F04,0x00F12);
+  (0x00F14,0x00F14);
+  (0x00F85,0x00F85);
+  (0x00FD0,0x00FD4);
+  (0x00FD9,0x00FDA);
+  (0x0104A,0x0104F);
+  (0x010FB,0x010FB);
+  (0x01360,0x01368);
+  (0x0166D,0x0166E);
+  (0x016EB,0x016ED);
+  (0x01735,0x01736);
+  (0x017D4,0x017D6);
+  (0x017D8,0x017DA);
+  (0x01800,0x01805);
+  (0x01807,0x0180A);
+  (0x01944,0x01945);
+  (0x01A1E,0x01A1F);
+  (0x01AA0,0x01AA6);
+  (0x01AA8,0x01AAD);
+  (0x01B5A,0x01B60);
+  (0x01BFC,0x01BFF);
+  (0x01C3B,0x01C3F);
+  (0x01C7E,0x01C7F);
+  (0x01CC0,0x01CC7);
+  (0x01CD3,0x01CD3);
+  (0x02016,0x02017);
+  (0x02020,0x02027);
+  (0x02030,0x02038);
+  (0x0203B,0x0203E);
+  (0x02041,0x02043);
+  (0x02047,0x02051);
+  (0x02053,0x02053);
+  (0x02055,0x0205E);
+  (0x02CF9,0x02CFC);
+  (0x02CFE,0x02CFF);
+  (0x02D70,0x02D70);
+  (0x02E00,0x02E01);
+  (0x02E06,0x02E08);
+  (0x02E0B,0x02E0B);
+  (0x02E0E,0x02E16);
+  (0x02E18,0x02E19);
+  (0x02E1B,0x02E1B);
+  (0x02E1E,0x02E1F);
+  (0x02E2A,0x02E2E);
+  (0x02E30,0x02E39);
+  (0x02E3C,0x02E3F);
+  (0x02E41,0x02E41);
+  (0x02E43,0x02E44);
+  (0x03001,0x03003);
+  (0x0303D,0x0303D);
+  (0x030FB,0x030FB);
+  (0x0A4FE,0x0A4FF);
+  (0x0A60D,0x0A60F);
+  (0x0A673,0x0A673);
+  (0x0A67E,0x0A67E);
+  (0x0A6F2,0x0A6F7);
+  (0x0A874,0x0A877);
+  (0x0A8CE,0x0A8CF);
+  (0x0A8F8,0x0A8FA);
+  (0x0A8FC,0x0A8FC);
+  (0x0A92E,0x0A92F);
+  (0x0A95F,0x0A95F);
+  (0x0A9C1,0x0A9CD);
+  (0x0A9DE,0x0A9DF);
+  (0x0AA5C,0x0AA5F);
+  (0x0AADE,0x0AADF);
+  (0x0AAF0,0x0AAF1);
+  (0x0ABEB,0x0ABEB);
+  (0x0FE10,0x0FE16);
+  (0x0FE19,0x0FE19);
+  (0x0FE30,0x0FE30);
+  (0x0FE45,0x0FE46);
+  (0x0FE49,0x0FE4C);
+  (0x0FE50,0x0FE52);
+  (0x0FE54,0x0FE57);
+  (0x0FE5F,0x0FE61);
+  (0x0FE68,0x0FE68);
+  (0x0FE6A,0x0FE6B);
+  (0x0FF01,0x0FF03);
+  (0x0FF05,0x0FF07);
+  (0x0FF0A,0x0FF0A);
+  (0x0FF0C,0x0FF0C);
+  (0x0FF0E,0x0FF0F);
+  (0x0FF1A,0x0FF1B);
+  (0x0FF1F,0x0FF20);
+  (0x0FF3C,0x0FF3C);
+  (0x0FF61,0x0FF61);
+  (0x0FF64,0x0FF65);
+  (0x10100,0x10102);
+  (0x1039F,0x1039F);
+  (0x103D0,0x103D0);
+  (0x1056F,0x1056F);
+  (0x10857,0x10857);
+  (0x1091F,0x1091F);
+  (0x1093F,0x1093F);
+  (0x10A50,0x10A58);
+  (0x10A7F,0x10A7F);
+  (0x10AF0,0x10AF6);
+  (0x10B39,0x10B3F);
+  (0x10B99,0x10B9C);
+  (0x11047,0x1104D);
+  (0x110BB,0x110BC);
+  (0x110BE,0x110C1);
+  (0x11140,0x11143);
+  (0x11174,0x11175);
+  (0x111C5,0x111C9);
+  (0x111CD,0x111CD);
+  (0x111DB,0x111DB);
+  (0x111DD,0x111DF);
+  (0x11238,0x1123D);
+  (0x112A9,0x112A9);
+  (0x1144B,0x1144F);
+  (0x1145B,0x1145B);
+  (0x1145D,0x1145D);
+  (0x114C6,0x114C6);
+  (0x115C1,0x115D7);
+  (0x11641,0x11643);
+  (0x11660,0x1166C);
+  (0x1173C,0x1173E);
+  (0x11C41,0x11C45);
+  (0x11C70,0x11C71);
+  (0x12470,0x12474);
+  (0x16A6E,0x16A6F);
+  (0x16AF5,0x16AF5);
+  (0x16B37,0x16B3B);
+  (0x16B44,0x16B44);
+  (0x1BC9F,0x1BC9F);
+  (0x1DA87,0x1DA8B)
+]
+(* Symbol, Math *)
+let sm = [
+  (0x0002B,0x0002B);
+  (0x0003C,0x0003E);
+  (0x0007C,0x0007C);
+  (0x0007E,0x0007E);
+  (0x000AC,0x000AC);
+  (0x000B1,0x000B1);
+  (0x000D7,0x000D7);
+  (0x000F7,0x000F7);
+  (0x003F6,0x003F6);
+  (0x00606,0x00608);
+  (0x02044,0x02044);
+  (0x02052,0x02052);
+  (0x0207A,0x0207C);
+  (0x0208A,0x0208C);
+  (0x02118,0x02118);
+  (0x02140,0x02144);
+  (0x0214B,0x0214B);
+  (0x02190,0x02194);
+  (0x0219A,0x0219B);
+  (0x021A0,0x021A0);
+  (0x021A3,0x021A3);
+  (0x021A6,0x021A6);
+  (0x021AE,0x021AE);
+  (0x021CE,0x021CF);
+  (0x021D2,0x021D2);
+  (0x021D4,0x021D4);
+  (0x021F4,0x022FF);
+  (0x02320,0x02321);
+  (0x0237C,0x0237C);
+  (0x0239B,0x023B3);
+  (0x023DC,0x023E1);
+  (0x025B7,0x025B7);
+  (0x025C1,0x025C1);
+  (0x025F8,0x025FF);
+  (0x0266F,0x0266F);
+  (0x027C0,0x027C4);
+  (0x027C7,0x027E5);
+  (0x027F0,0x027FF);
+  (0x02900,0x02982);
+  (0x02999,0x029D7);
+  (0x029DC,0x029FB);
+  (0x029FE,0x02AFF);
+  (0x02B30,0x02B44);
+  (0x02B47,0x02B4C);
+  (0x0FB29,0x0FB29);
+  (0x0FE62,0x0FE62);
+  (0x0FE64,0x0FE66);
+  (0x0FF0B,0x0FF0B);
+  (0x0FF1C,0x0FF1E);
+  (0x0FF5C,0x0FF5C);
+  (0x0FF5E,0x0FF5E);
+  (0x0FFE2,0x0FFE2);
+  (0x0FFE9,0x0FFEC);
+  (0x1D6C1,0x1D6C1);
+  (0x1D6DB,0x1D6DB);
+  (0x1D6FB,0x1D6FB);
+  (0x1D715,0x1D715);
+  (0x1D735,0x1D735);
+  (0x1D74F,0x1D74F);
+  (0x1D76F,0x1D76F);
+  (0x1D789,0x1D789);
+  (0x1D7A9,0x1D7A9);
+  (0x1D7C3,0x1D7C3)
+]
+(* Symbol, Currency *)
+let sc = [
+  (0x00024,0x00024);
+  (0x000A2,0x000A5);
+  (0x0058F,0x0058F);
+  (0x0060B,0x0060B);
+  (0x009F2,0x009F3);
+  (0x009FB,0x009FB);
+  (0x00AF1,0x00AF1);
+  (0x00BF9,0x00BF9);
+  (0x00E3F,0x00E3F);
+  (0x017DB,0x017DB);
+  (0x020A0,0x020BE);
+  (0x0A838,0x0A838);
+  (0x0FDFC,0x0FDFC);
+  (0x0FE69,0x0FE69);
+  (0x0FF04,0x0FF04);
+  (0x0FFE0,0x0FFE1)
+]
+(* Symbol, Modifier *)
+let sk = [
+  (0x0005E,0x0005E);
+  (0x00060,0x00060);
+  (0x000A8,0x000A8);
+  (0x000AF,0x000AF);
+  (0x000B4,0x000B4);
+  (0x000B8,0x000B8);
+  (0x002C2,0x002C5);
+  (0x002D2,0x002DF);
+  (0x002E5,0x002EB);
+  (0x002ED,0x002ED);
+  (0x002EF,0x002FF);
+  (0x00375,0x00375);
+  (0x00384,0x00385);
+  (0x01FBD,0x01FBD);
+  (0x01FBF,0x01FC1);
+  (0x01FCD,0x01FCF);
+  (0x01FDD,0x01FDF);
+  (0x01FED,0x01FEF);
+  (0x01FFD,0x01FFE);
+  (0x0309B,0x0309C);
+  (0x0A700,0x0A716);
+  (0x0A720,0x0A721);
+  (0x0A789,0x0A78A);
+  (0x0AB5B,0x0AB5B);
+  (0x0FBB2,0x0FBC1);
+  (0x0FF3E,0x0FF3E);
+  (0x0FF40,0x0FF40);
+  (0x0FFE3,0x0FFE3)
+]
+(* Symbol, Other  *)
+let so = [
+  (0x000A6,0x000A6);
+  (0x000A9,0x000A9);
+  (0x000AE,0x000AE);
+  (0x000B0,0x000B0);
+  (0x00482,0x00482);
+  (0x0058D,0x0058E);
+  (0x0060E,0x0060F);
+  (0x006DE,0x006DE);
+  (0x006E9,0x006E9);
+  (0x006FD,0x006FE);
+  (0x007F6,0x007F6);
+  (0x009FA,0x009FA);
+  (0x00B70,0x00B70);
+  (0x00BF3,0x00BF8);
+  (0x00BFA,0x00BFA);
+  (0x00C7F,0x00C7F);
+  (0x00D4F,0x00D4F);
+  (0x00D79,0x00D79);
+  (0x00F01,0x00F03);
+  (0x00F13,0x00F13);
+  (0x00F15,0x00F17);
+  (0x00F1A,0x00F1F);
+  (0x00F34,0x00F34);
+  (0x00F36,0x00F36);
+  (0x00F38,0x00F38);
+  (0x00FBE,0x00FC5);
+  (0x00FC7,0x00FCC);
+  (0x00FCE,0x00FCF);
+  (0x00FD5,0x00FD8);
+  (0x0109E,0x0109F);
+  (0x01390,0x01399);
+  (0x01940,0x01940);
+  (0x019DE,0x019FF);
+  (0x01B61,0x01B6A);
+  (0x01B74,0x01B7C);
+  (0x02100,0x02101);
+  (0x02103,0x02106);
+  (0x02108,0x02109);
+  (0x02114,0x02114);
+  (0x02116,0x02117);
+  (0x0211E,0x02123);
+  (0x02125,0x02125);
+  (0x02127,0x02127);
+  (0x02129,0x02129);
+  (0x0212E,0x0212E);
+  (0x0213A,0x0213B);
+  (0x0214A,0x0214A);
+  (0x0214C,0x0214D);
+  (0x0214F,0x0214F);
+  (0x0218A,0x0218B);
+  (0x02195,0x02199);
+  (0x0219C,0x0219F);
+  (0x021A1,0x021A2);
+  (0x021A4,0x021A5);
+  (0x021A7,0x021AD);
+  (0x021AF,0x021CD);
+  (0x021D0,0x021D1);
+  (0x021D3,0x021D3);
+  (0x021D5,0x021F3);
+  (0x02300,0x02307);
+  (0x0230C,0x0231F);
+  (0x02322,0x02328);
+  (0x0232B,0x0237B);
+  (0x0237D,0x0239A);
+  (0x023B4,0x023DB);
+  (0x023E2,0x023FE);
+  (0x02400,0x02426);
+  (0x02440,0x0244A);
+  (0x0249C,0x024E9);
+  (0x02500,0x025B6);
+  (0x025B8,0x025C0);
+  (0x025C2,0x025F7);
+  (0x02600,0x0266E);
+  (0x02670,0x02767);
+  (0x02794,0x027BF);
+  (0x02800,0x028FF);
+  (0x02B00,0x02B2F);
+  (0x02B45,0x02B46);
+  (0x02B4D,0x02B73);
+  (0x02B76,0x02B95);
+  (0x02B98,0x02BB9);
+  (0x02BBD,0x02BC8);
+  (0x02BCA,0x02BD1);
+  (0x02BEC,0x02BEF);
+  (0x02CE5,0x02CEA);
+  (0x02E80,0x02E99);
+  (0x02E9B,0x02EF3);
+  (0x02F00,0x02FD5);
+  (0x02FF0,0x02FFB);
+  (0x03004,0x03004);
+  (0x03012,0x03013);
+  (0x03020,0x03020);
+  (0x03036,0x03037);
+  (0x0303E,0x0303F);
+  (0x03190,0x03191);
+  (0x03196,0x0319F);
+  (0x031C0,0x031E3);
+  (0x03200,0x0321E);
+  (0x0322A,0x03247);
+  (0x03250,0x03250);
+  (0x03260,0x0327F);
+  (0x0328A,0x032B0);
+  (0x032C0,0x032FE);
+  (0x03300,0x033FF);
+  (0x04DC0,0x04DFF);
+  (0x0A490,0x0A4C6);
+  (0x0A828,0x0A82B);
+  (0x0A836,0x0A837);
+  (0x0A839,0x0A839);
+  (0x0AA77,0x0AA79);
+  (0x0FDFD,0x0FDFD);
+  (0x0FFE4,0x0FFE4);
+  (0x0FFE8,0x0FFE8);
+  (0x0FFED,0x0FFEE);
+  (0x0FFFC,0x0FFFD);
+  (0x10137,0x1013F);
+  (0x10179,0x10189);
+  (0x1018C,0x1018E);
+  (0x10190,0x1019B);
+  (0x101A0,0x101A0);
+  (0x101D0,0x101FC);
+  (0x10877,0x10878);
+  (0x10AC8,0x10AC8);
+  (0x1173F,0x1173F);
+  (0x16B3C,0x16B3F);
+  (0x16B45,0x16B45);
+  (0x1BC9C,0x1BC9C);
+  (0x1D000,0x1D0F5);
+  (0x1D100,0x1D126);
+  (0x1D129,0x1D164);
+  (0x1D16A,0x1D16C);
+  (0x1D183,0x1D184);
+  (0x1D18C,0x1D1A9);
+  (0x1D1AE,0x1D1E8);
+  (0x1D200,0x1D241);
+  (0x1D245,0x1D245);
+  (0x1D300,0x1D356);
+  (0x1D800,0x1D9FF);
+  (0x1DA37,0x1DA3A);
+  (0x1DA6D,0x1DA74);
+  (0x1DA76,0x1DA83);
+  (0x1DA85,0x1DA86);
+  (0x1F000,0x1F02B);
+  (0x1F030,0x1F093);
+  (0x1F0A0,0x1F0AE);
+  (0x1F0B1,0x1F0BF);
+  (0x1F0C1,0x1F0CF);
+  (0x1F0D1,0x1F0F5);
+  (0x1F110,0x1F12E);
+  (0x1F130,0x1F16B);
+  (0x1F170,0x1F1AC);
+  (0x1F1E6,0x1F202);
+  (0x1F210,0x1F23B);
+  (0x1F240,0x1F248);
+  (0x1F250,0x1F251);
+  (0x1F300,0x1F3FA);
+  (0x1F400,0x1F6D2);
+  (0x1F6E0,0x1F6EC);
+  (0x1F6F0,0x1F6F6);
+  (0x1F700,0x1F773);
+  (0x1F780,0x1F7D4);
+  (0x1F800,0x1F80B);
+  (0x1F810,0x1F847);
+  (0x1F850,0x1F859);
+  (0x1F860,0x1F887);
+  (0x1F890,0x1F8AD);
+  (0x1F910,0x1F91E);
+  (0x1F920,0x1F927);
+  (0x1F930,0x1F930);
+  (0x1F933,0x1F93E);
+  (0x1F940,0x1F94B);
+  (0x1F950,0x1F95E);
+  (0x1F980,0x1F991)
+]
+let to_lower = [
+  (0x00041,0x0005A), `Delta (32);
+  (0x000C0,0x000D6), `Delta (32);
+  (0x000D8,0x000DE), `Delta (32);
+  (0x00100,0x00100), `Abs (0x00101);
+  (0x00102,0x00102), `Abs (0x00103);
+  (0x00104,0x00104), `Abs (0x00105);
+  (0x00106,0x00106), `Abs (0x00107);
+  (0x00108,0x00108), `Abs (0x00109);
+  (0x0010A,0x0010A), `Abs (0x0010B);
+  (0x0010C,0x0010C), `Abs (0x0010D);
+  (0x0010E,0x0010E), `Abs (0x0010F);
+  (0x00110,0x00110), `Abs (0x00111);
+  (0x00112,0x00112), `Abs (0x00113);
+  (0x00114,0x00114), `Abs (0x00115);
+  (0x00116,0x00116), `Abs (0x00117);
+  (0x00118,0x00118), `Abs (0x00119);
+  (0x0011A,0x0011A), `Abs (0x0011B);
+  (0x0011C,0x0011C), `Abs (0x0011D);
+  (0x0011E,0x0011E), `Abs (0x0011F);
+  (0x00120,0x00120), `Abs (0x00121);
+  (0x00122,0x00122), `Abs (0x00123);
+  (0x00124,0x00124), `Abs (0x00125);
+  (0x00126,0x00126), `Abs (0x00127);
+  (0x00128,0x00128), `Abs (0x00129);
+  (0x0012A,0x0012A), `Abs (0x0012B);
+  (0x0012C,0x0012C), `Abs (0x0012D);
+  (0x0012E,0x0012E), `Abs (0x0012F);
+  (0x00130,0x00130), `Abs (0x00069);
+  (0x00132,0x00132), `Abs (0x00133);
+  (0x00134,0x00134), `Abs (0x00135);
+  (0x00136,0x00136), `Abs (0x00137);
+  (0x00139,0x00139), `Abs (0x0013A);
+  (0x0013B,0x0013B), `Abs (0x0013C);
+  (0x0013D,0x0013D), `Abs (0x0013E);
+  (0x0013F,0x0013F), `Abs (0x00140);
+  (0x00141,0x00141), `Abs (0x00142);
+  (0x00143,0x00143), `Abs (0x00144);
+  (0x00145,0x00145), `Abs (0x00146);
+  (0x00147,0x00147), `Abs (0x00148);
+  (0x0014A,0x0014A), `Abs (0x0014B);
+  (0x0014C,0x0014C), `Abs (0x0014D);
+  (0x0014E,0x0014E), `Abs (0x0014F);
+  (0x00150,0x00150), `Abs (0x00151);
+  (0x00152,0x00152), `Abs (0x00153);
+  (0x00154,0x00154), `Abs (0x00155);
+  (0x00156,0x00156), `Abs (0x00157);
+  (0x00158,0x00158), `Abs (0x00159);
+  (0x0015A,0x0015A), `Abs (0x0015B);
+  (0x0015C,0x0015C), `Abs (0x0015D);
+  (0x0015E,0x0015E), `Abs (0x0015F);
+  (0x00160,0x00160), `Abs (0x00161);
+  (0x00162,0x00162), `Abs (0x00163);
+  (0x00164,0x00164), `Abs (0x00165);
+  (0x00166,0x00166), `Abs (0x00167);
+  (0x00168,0x00168), `Abs (0x00169);
+  (0x0016A,0x0016A), `Abs (0x0016B);
+  (0x0016C,0x0016C), `Abs (0x0016D);
+  (0x0016E,0x0016E), `Abs (0x0016F);
+  (0x00170,0x00170), `Abs (0x00171);
+  (0x00172,0x00172), `Abs (0x00173);
+  (0x00174,0x00174), `Abs (0x00175);
+  (0x00176,0x00176), `Abs (0x00177);
+  (0x00178,0x00178), `Abs (0x000FF);
+  (0x00179,0x00179), `Abs (0x0017A);
+  (0x0017B,0x0017B), `Abs (0x0017C);
+  (0x0017D,0x0017D), `Abs (0x0017E);
+  (0x00181,0x00181), `Abs (0x00253);
+  (0x00182,0x00182), `Abs (0x00183);
+  (0x00184,0x00184), `Abs (0x00185);
+  (0x00186,0x00186), `Abs (0x00254);
+  (0x00187,0x00187), `Abs (0x00188);
+  (0x00189,0x0018A), `Delta (205);
+  (0x0018B,0x0018B), `Abs (0x0018C);
+  (0x0018E,0x0018E), `Abs (0x001DD);
+  (0x0018F,0x0018F), `Abs (0x00259);
+  (0x00190,0x00190), `Abs (0x0025B);
+  (0x00191,0x00191), `Abs (0x00192);
+  (0x00193,0x00193), `Abs (0x00260);
+  (0x00194,0x00194), `Abs (0x00263);
+  (0x00196,0x00196), `Abs (0x00269);
+  (0x00197,0x00197), `Abs (0x00268);
+  (0x00198,0x00198), `Abs (0x00199);
+  (0x0019C,0x0019C), `Abs (0x0026F);
+  (0x0019D,0x0019D), `Abs (0x00272);
+  (0x0019F,0x0019F), `Abs (0x00275);
+  (0x001A0,0x001A0), `Abs (0x001A1);
+  (0x001A2,0x001A2), `Abs (0x001A3);
+  (0x001A4,0x001A4), `Abs (0x001A5);
+  (0x001A6,0x001A6), `Abs (0x00280);
+  (0x001A7,0x001A7), `Abs (0x001A8);
+  (0x001A9,0x001A9), `Abs (0x00283);
+  (0x001AC,0x001AC), `Abs (0x001AD);
+  (0x001AE,0x001AE), `Abs (0x00288);
+  (0x001AF,0x001AF), `Abs (0x001B0);
+  (0x001B1,0x001B2), `Delta (217);
+  (0x001B3,0x001B3), `Abs (0x001B4);
+  (0x001B5,0x001B5), `Abs (0x001B6);
+  (0x001B7,0x001B7), `Abs (0x00292);
+  (0x001B8,0x001B8), `Abs (0x001B9);
+  (0x001BC,0x001BC), `Abs (0x001BD);
+  (0x001C4,0x001C4), `Abs (0x001C6);
+  (0x001C7,0x001C7), `Abs (0x001C9);
+  (0x001CA,0x001CA), `Abs (0x001CC);
+  (0x001CD,0x001CD), `Abs (0x001CE);
+  (0x001CF,0x001CF), `Abs (0x001D0);
+  (0x001D1,0x001D1), `Abs (0x001D2);
+  (0x001D3,0x001D3), `Abs (0x001D4);
+  (0x001D5,0x001D5), `Abs (0x001D6);
+  (0x001D7,0x001D7), `Abs (0x001D8);
+  (0x001D9,0x001D9), `Abs (0x001DA);
+  (0x001DB,0x001DB), `Abs (0x001DC);
+  (0x001DE,0x001DE), `Abs (0x001DF);
+  (0x001E0,0x001E0), `Abs (0x001E1);
+  (0x001E2,0x001E2), `Abs (0x001E3);
+  (0x001E4,0x001E4), `Abs (0x001E5);
+  (0x001E6,0x001E6), `Abs (0x001E7);
+  (0x001E8,0x001E8), `Abs (0x001E9);
+  (0x001EA,0x001EA), `Abs (0x001EB);
+  (0x001EC,0x001EC), `Abs (0x001ED);
+  (0x001EE,0x001EE), `Abs (0x001EF);
+  (0x001F1,0x001F1), `Abs (0x001F3);
+  (0x001F4,0x001F4), `Abs (0x001F5);
+  (0x001F6,0x001F6), `Abs (0x00195);
+  (0x001F7,0x001F7), `Abs (0x001BF);
+  (0x001F8,0x001F8), `Abs (0x001F9);
+  (0x001FA,0x001FA), `Abs (0x001FB);
+  (0x001FC,0x001FC), `Abs (0x001FD);
+  (0x001FE,0x001FE), `Abs (0x001FF);
+  (0x00200,0x00200), `Abs (0x00201);
+  (0x00202,0x00202), `Abs (0x00203);
+  (0x00204,0x00204), `Abs (0x00205);
+  (0x00206,0x00206), `Abs (0x00207);
+  (0x00208,0x00208), `Abs (0x00209);
+  (0x0020A,0x0020A), `Abs (0x0020B);
+  (0x0020C,0x0020C), `Abs (0x0020D);
+  (0x0020E,0x0020E), `Abs (0x0020F);
+  (0x00210,0x00210), `Abs (0x00211);
+  (0x00212,0x00212), `Abs (0x00213);
+  (0x00214,0x00214), `Abs (0x00215);
+  (0x00216,0x00216), `Abs (0x00217);
+  (0x00218,0x00218), `Abs (0x00219);
+  (0x0021A,0x0021A), `Abs (0x0021B);
+  (0x0021C,0x0021C), `Abs (0x0021D);
+  (0x0021E,0x0021E), `Abs (0x0021F);
+  (0x00220,0x00220), `Abs (0x0019E);
+  (0x00222,0x00222), `Abs (0x00223);
+  (0x00224,0x00224), `Abs (0x00225);
+  (0x00226,0x00226), `Abs (0x00227);
+  (0x00228,0x00228), `Abs (0x00229);
+  (0x0022A,0x0022A), `Abs (0x0022B);
+  (0x0022C,0x0022C), `Abs (0x0022D);
+  (0x0022E,0x0022E), `Abs (0x0022F);
+  (0x00230,0x00230), `Abs (0x00231);
+  (0x00232,0x00232), `Abs (0x00233);
+  (0x0023A,0x0023A), `Abs (0x02C65);
+  (0x0023B,0x0023B), `Abs (0x0023C);
+  (0x0023D,0x0023D), `Abs (0x0019A);
+  (0x0023E,0x0023E), `Abs (0x02C66);
+  (0x00241,0x00241), `Abs (0x00242);
+  (0x00243,0x00243), `Abs (0x00180);
+  (0x00244,0x00244), `Abs (0x00289);
+  (0x00245,0x00245), `Abs (0x0028C);
+  (0x00246,0x00246), `Abs (0x00247);
+  (0x00248,0x00248), `Abs (0x00249);
+  (0x0024A,0x0024A), `Abs (0x0024B);
+  (0x0024C,0x0024C), `Abs (0x0024D);
+  (0x0024E,0x0024E), `Abs (0x0024F);
+  (0x00370,0x00370), `Abs (0x00371);
+  (0x00372,0x00372), `Abs (0x00373);
+  (0x00376,0x00376), `Abs (0x00377);
+  (0x0037F,0x0037F), `Abs (0x003F3);
+  (0x00386,0x00386), `Abs (0x003AC);
+  (0x00388,0x0038A), `Delta (37);
+  (0x0038C,0x0038C), `Abs (0x003CC);
+  (0x0038E,0x0038F), `Delta (63);
+  (0x00391,0x003A1), `Delta (32);
+  (0x003A3,0x003AB), `Delta (32);
+  (0x003CF,0x003CF), `Abs (0x003D7);
+  (0x003D2,0x003D4), `Delta (0);
+  (0x003D8,0x003D8), `Abs (0x003D9);
+  (0x003DA,0x003DA), `Abs (0x003DB);
+  (0x003DC,0x003DC), `Abs (0x003DD);
+  (0x003DE,0x003DE), `Abs (0x003DF);
+  (0x003E0,0x003E0), `Abs (0x003E1);
+  (0x003E2,0x003E2), `Abs (0x003E3);
+  (0x003E4,0x003E4), `Abs (0x003E5);
+  (0x003E6,0x003E6), `Abs (0x003E7);
+  (0x003E8,0x003E8), `Abs (0x003E9);
+  (0x003EA,0x003EA), `Abs (0x003EB);
+  (0x003EC,0x003EC), `Abs (0x003ED);
+  (0x003EE,0x003EE), `Abs (0x003EF);
+  (0x003F4,0x003F4), `Abs (0x003B8);
+  (0x003F7,0x003F7), `Abs (0x003F8);
+  (0x003F9,0x003F9), `Abs (0x003F2);
+  (0x003FA,0x003FA), `Abs (0x003FB);
+  (0x003FD,0x003FF), `Delta (-130);
+  (0x00400,0x0040F), `Delta (80);
+  (0x00410,0x0042F), `Delta (32);
+  (0x00460,0x00460), `Abs (0x00461);
+  (0x00462,0x00462), `Abs (0x00463);
+  (0x00464,0x00464), `Abs (0x00465);
+  (0x00466,0x00466), `Abs (0x00467);
+  (0x00468,0x00468), `Abs (0x00469);
+  (0x0046A,0x0046A), `Abs (0x0046B);
+  (0x0046C,0x0046C), `Abs (0x0046D);
+  (0x0046E,0x0046E), `Abs (0x0046F);
+  (0x00470,0x00470), `Abs (0x00471);
+  (0x00472,0x00472), `Abs (0x00473);
+  (0x00474,0x00474), `Abs (0x00475);
+  (0x00476,0x00476), `Abs (0x00477);
+  (0x00478,0x00478), `Abs (0x00479);
+  (0x0047A,0x0047A), `Abs (0x0047B);
+  (0x0047C,0x0047C), `Abs (0x0047D);
+  (0x0047E,0x0047E), `Abs (0x0047F);
+  (0x00480,0x00480), `Abs (0x00481);
+  (0x0048A,0x0048A), `Abs (0x0048B);
+  (0x0048C,0x0048C), `Abs (0x0048D);
+  (0x0048E,0x0048E), `Abs (0x0048F);
+  (0x00490,0x00490), `Abs (0x00491);
+  (0x00492,0x00492), `Abs (0x00493);
+  (0x00494,0x00494), `Abs (0x00495);
+  (0x00496,0x00496), `Abs (0x00497);
+  (0x00498,0x00498), `Abs (0x00499);
+  (0x0049A,0x0049A), `Abs (0x0049B);
+  (0x0049C,0x0049C), `Abs (0x0049D);
+  (0x0049E,0x0049E), `Abs (0x0049F);
+  (0x004A0,0x004A0), `Abs (0x004A1);
+  (0x004A2,0x004A2), `Abs (0x004A3);
+  (0x004A4,0x004A4), `Abs (0x004A5);
+  (0x004A6,0x004A6), `Abs (0x004A7);
+  (0x004A8,0x004A8), `Abs (0x004A9);
+  (0x004AA,0x004AA), `Abs (0x004AB);
+  (0x004AC,0x004AC), `Abs (0x004AD);
+  (0x004AE,0x004AE), `Abs (0x004AF);
+  (0x004B0,0x004B0), `Abs (0x004B1);
+  (0x004B2,0x004B2), `Abs (0x004B3);
+  (0x004B4,0x004B4), `Abs (0x004B5);
+  (0x004B6,0x004B6), `Abs (0x004B7);
+  (0x004B8,0x004B8), `Abs (0x004B9);
+  (0x004BA,0x004BA), `Abs (0x004BB);
+  (0x004BC,0x004BC), `Abs (0x004BD);
+  (0x004BE,0x004BE), `Abs (0x004BF);
+  (0x004C0,0x004C0), `Abs (0x004CF);
+  (0x004C1,0x004C1), `Abs (0x004C2);
+  (0x004C3,0x004C3), `Abs (0x004C4);
+  (0x004C5,0x004C5), `Abs (0x004C6);
+  (0x004C7,0x004C7), `Abs (0x004C8);
+  (0x004C9,0x004C9), `Abs (0x004CA);
+  (0x004CB,0x004CB), `Abs (0x004CC);
+  (0x004CD,0x004CD), `Abs (0x004CE);
+  (0x004D0,0x004D0), `Abs (0x004D1);
+  (0x004D2,0x004D2), `Abs (0x004D3);
+  (0x004D4,0x004D4), `Abs (0x004D5);
+  (0x004D6,0x004D6), `Abs (0x004D7);
+  (0x004D8,0x004D8), `Abs (0x004D9);
+  (0x004DA,0x004DA), `Abs (0x004DB);
+  (0x004DC,0x004DC), `Abs (0x004DD);
+  (0x004DE,0x004DE), `Abs (0x004DF);
+  (0x004E0,0x004E0), `Abs (0x004E1);
+  (0x004E2,0x004E2), `Abs (0x004E3);
+  (0x004E4,0x004E4), `Abs (0x004E5);
+  (0x004E6,0x004E6), `Abs (0x004E7);
+  (0x004E8,0x004E8), `Abs (0x004E9);
+  (0x004EA,0x004EA), `Abs (0x004EB);
+  (0x004EC,0x004EC), `Abs (0x004ED);
+  (0x004EE,0x004EE), `Abs (0x004EF);
+  (0x004F0,0x004F0), `Abs (0x004F1);
+  (0x004F2,0x004F2), `Abs (0x004F3);
+  (0x004F4,0x004F4), `Abs (0x004F5);
+  (0x004F6,0x004F6), `Abs (0x004F7);
+  (0x004F8,0x004F8), `Abs (0x004F9);
+  (0x004FA,0x004FA), `Abs (0x004FB);
+  (0x004FC,0x004FC), `Abs (0x004FD);
+  (0x004FE,0x004FE), `Abs (0x004FF);
+  (0x00500,0x00500), `Abs (0x00501);
+  (0x00502,0x00502), `Abs (0x00503);
+  (0x00504,0x00504), `Abs (0x00505);
+  (0x00506,0x00506), `Abs (0x00507);
+  (0x00508,0x00508), `Abs (0x00509);
+  (0x0050A,0x0050A), `Abs (0x0050B);
+  (0x0050C,0x0050C), `Abs (0x0050D);
+  (0x0050E,0x0050E), `Abs (0x0050F);
+  (0x00510,0x00510), `Abs (0x00511);
+  (0x00512,0x00512), `Abs (0x00513);
+  (0x00514,0x00514), `Abs (0x00515);
+  (0x00516,0x00516), `Abs (0x00517);
+  (0x00518,0x00518), `Abs (0x00519);
+  (0x0051A,0x0051A), `Abs (0x0051B);
+  (0x0051C,0x0051C), `Abs (0x0051D);
+  (0x0051E,0x0051E), `Abs (0x0051F);
+  (0x00520,0x00520), `Abs (0x00521);
+  (0x00522,0x00522), `Abs (0x00523);
+  (0x00524,0x00524), `Abs (0x00525);
+  (0x00526,0x00526), `Abs (0x00527);
+  (0x00528,0x00528), `Abs (0x00529);
+  (0x0052A,0x0052A), `Abs (0x0052B);
+  (0x0052C,0x0052C), `Abs (0x0052D);
+  (0x0052E,0x0052E), `Abs (0x0052F);
+  (0x00531,0x00556), `Delta (48);
+  (0x010A0,0x010C5), `Delta (7264);
+  (0x010C7,0x010C7), `Abs (0x02D27);
+  (0x010CD,0x010CD), `Abs (0x02D2D);
+  (0x013A0,0x013EF), `Delta (38864);
+  (0x013F0,0x013F5), `Delta (8);
+  (0x01E00,0x01E00), `Abs (0x01E01);
+  (0x01E02,0x01E02), `Abs (0x01E03);
+  (0x01E04,0x01E04), `Abs (0x01E05);
+  (0x01E06,0x01E06), `Abs (0x01E07);
+  (0x01E08,0x01E08), `Abs (0x01E09);
+  (0x01E0A,0x01E0A), `Abs (0x01E0B);
+  (0x01E0C,0x01E0C), `Abs (0x01E0D);
+  (0x01E0E,0x01E0E), `Abs (0x01E0F);
+  (0x01E10,0x01E10), `Abs (0x01E11);
+  (0x01E12,0x01E12), `Abs (0x01E13);
+  (0x01E14,0x01E14), `Abs (0x01E15);
+  (0x01E16,0x01E16), `Abs (0x01E17);
+  (0x01E18,0x01E18), `Abs (0x01E19);
+  (0x01E1A,0x01E1A), `Abs (0x01E1B);
+  (0x01E1C,0x01E1C), `Abs (0x01E1D);
+  (0x01E1E,0x01E1E), `Abs (0x01E1F);
+  (0x01E20,0x01E20), `Abs (0x01E21);
+  (0x01E22,0x01E22), `Abs (0x01E23);
+  (0x01E24,0x01E24), `Abs (0x01E25);
+  (0x01E26,0x01E26), `Abs (0x01E27);
+  (0x01E28,0x01E28), `Abs (0x01E29);
+  (0x01E2A,0x01E2A), `Abs (0x01E2B);
+  (0x01E2C,0x01E2C), `Abs (0x01E2D);
+  (0x01E2E,0x01E2E), `Abs (0x01E2F);
+  (0x01E30,0x01E30), `Abs (0x01E31);
+  (0x01E32,0x01E32), `Abs (0x01E33);
+  (0x01E34,0x01E34), `Abs (0x01E35);
+  (0x01E36,0x01E36), `Abs (0x01E37);
+  (0x01E38,0x01E38), `Abs (0x01E39);
+  (0x01E3A,0x01E3A), `Abs (0x01E3B);
+  (0x01E3C,0x01E3C), `Abs (0x01E3D);
+  (0x01E3E,0x01E3E), `Abs (0x01E3F);
+  (0x01E40,0x01E40), `Abs (0x01E41);
+  (0x01E42,0x01E42), `Abs (0x01E43);
+  (0x01E44,0x01E44), `Abs (0x01E45);
+  (0x01E46,0x01E46), `Abs (0x01E47);
+  (0x01E48,0x01E48), `Abs (0x01E49);
+  (0x01E4A,0x01E4A), `Abs (0x01E4B);
+  (0x01E4C,0x01E4C), `Abs (0x01E4D);
+  (0x01E4E,0x01E4E), `Abs (0x01E4F);
+  (0x01E50,0x01E50), `Abs (0x01E51);
+  (0x01E52,0x01E52), `Abs (0x01E53);
+  (0x01E54,0x01E54), `Abs (0x01E55);
+  (0x01E56,0x01E56), `Abs (0x01E57);
+  (0x01E58,0x01E58), `Abs (0x01E59);
+  (0x01E5A,0x01E5A), `Abs (0x01E5B);
+  (0x01E5C,0x01E5C), `Abs (0x01E5D);
+  (0x01E5E,0x01E5E), `Abs (0x01E5F);
+  (0x01E60,0x01E60), `Abs (0x01E61);
+  (0x01E62,0x01E62), `Abs (0x01E63);
+  (0x01E64,0x01E64), `Abs (0x01E65);
+  (0x01E66,0x01E66), `Abs (0x01E67);
+  (0x01E68,0x01E68), `Abs (0x01E69);
+  (0x01E6A,0x01E6A), `Abs (0x01E6B);
+  (0x01E6C,0x01E6C), `Abs (0x01E6D);
+  (0x01E6E,0x01E6E), `Abs (0x01E6F);
+  (0x01E70,0x01E70), `Abs (0x01E71);
+  (0x01E72,0x01E72), `Abs (0x01E73);
+  (0x01E74,0x01E74), `Abs (0x01E75);
+  (0x01E76,0x01E76), `Abs (0x01E77);
+  (0x01E78,0x01E78), `Abs (0x01E79);
+  (0x01E7A,0x01E7A), `Abs (0x01E7B);
+  (0x01E7C,0x01E7C), `Abs (0x01E7D);
+  (0x01E7E,0x01E7E), `Abs (0x01E7F);
+  (0x01E80,0x01E80), `Abs (0x01E81);
+  (0x01E82,0x01E82), `Abs (0x01E83);
+  (0x01E84,0x01E84), `Abs (0x01E85);
+  (0x01E86,0x01E86), `Abs (0x01E87);
+  (0x01E88,0x01E88), `Abs (0x01E89);
+  (0x01E8A,0x01E8A), `Abs (0x01E8B);
+  (0x01E8C,0x01E8C), `Abs (0x01E8D);
+  (0x01E8E,0x01E8E), `Abs (0x01E8F);
+  (0x01E90,0x01E90), `Abs (0x01E91);
+  (0x01E92,0x01E92), `Abs (0x01E93);
+  (0x01E94,0x01E94), `Abs (0x01E95);
+  (0x01E9E,0x01E9E), `Abs (0x000DF);
+  (0x01EA0,0x01EA0), `Abs (0x01EA1);
+  (0x01EA2,0x01EA2), `Abs (0x01EA3);
+  (0x01EA4,0x01EA4), `Abs (0x01EA5);
+  (0x01EA6,0x01EA6), `Abs (0x01EA7);
+  (0x01EA8,0x01EA8), `Abs (0x01EA9);
+  (0x01EAA,0x01EAA), `Abs (0x01EAB);
+  (0x01EAC,0x01EAC), `Abs (0x01EAD);
+  (0x01EAE,0x01EAE), `Abs (0x01EAF);
+  (0x01EB0,0x01EB0), `Abs (0x01EB1);
+  (0x01EB2,0x01EB2), `Abs (0x01EB3);
+  (0x01EB4,0x01EB4), `Abs (0x01EB5);
+  (0x01EB6,0x01EB6), `Abs (0x01EB7);
+  (0x01EB8,0x01EB8), `Abs (0x01EB9);
+  (0x01EBA,0x01EBA), `Abs (0x01EBB);
+  (0x01EBC,0x01EBC), `Abs (0x01EBD);
+  (0x01EBE,0x01EBE), `Abs (0x01EBF);
+  (0x01EC0,0x01EC0), `Abs (0x01EC1);
+  (0x01EC2,0x01EC2), `Abs (0x01EC3);
+  (0x01EC4,0x01EC4), `Abs (0x01EC5);
+  (0x01EC6,0x01EC6), `Abs (0x01EC7);
+  (0x01EC8,0x01EC8), `Abs (0x01EC9);
+  (0x01ECA,0x01ECA), `Abs (0x01ECB);
+  (0x01ECC,0x01ECC), `Abs (0x01ECD);
+  (0x01ECE,0x01ECE), `Abs (0x01ECF);
+  (0x01ED0,0x01ED0), `Abs (0x01ED1);
+  (0x01ED2,0x01ED2), `Abs (0x01ED3);
+  (0x01ED4,0x01ED4), `Abs (0x01ED5);
+  (0x01ED6,0x01ED6), `Abs (0x01ED7);
+  (0x01ED8,0x01ED8), `Abs (0x01ED9);
+  (0x01EDA,0x01EDA), `Abs (0x01EDB);
+  (0x01EDC,0x01EDC), `Abs (0x01EDD);
+  (0x01EDE,0x01EDE), `Abs (0x01EDF);
+  (0x01EE0,0x01EE0), `Abs (0x01EE1);
+  (0x01EE2,0x01EE2), `Abs (0x01EE3);
+  (0x01EE4,0x01EE4), `Abs (0x01EE5);
+  (0x01EE6,0x01EE6), `Abs (0x01EE7);
+  (0x01EE8,0x01EE8), `Abs (0x01EE9);
+  (0x01EEA,0x01EEA), `Abs (0x01EEB);
+  (0x01EEC,0x01EEC), `Abs (0x01EED);
+  (0x01EEE,0x01EEE), `Abs (0x01EEF);
+  (0x01EF0,0x01EF0), `Abs (0x01EF1);
+  (0x01EF2,0x01EF2), `Abs (0x01EF3);
+  (0x01EF4,0x01EF4), `Abs (0x01EF5);
+  (0x01EF6,0x01EF6), `Abs (0x01EF7);
+  (0x01EF8,0x01EF8), `Abs (0x01EF9);
+  (0x01EFA,0x01EFA), `Abs (0x01EFB);
+  (0x01EFC,0x01EFC), `Abs (0x01EFD);
+  (0x01EFE,0x01EFE), `Abs (0x01EFF);
+  (0x01F08,0x01F0F), `Delta (-8);
+  (0x01F18,0x01F1D), `Delta (-8);
+  (0x01F28,0x01F2F), `Delta (-8);
+  (0x01F38,0x01F3F), `Delta (-8);
+  (0x01F48,0x01F4D), `Delta (-8);
+  (0x01F59,0x01F59), `Abs (0x01F51);
+  (0x01F5B,0x01F5B), `Abs (0x01F53);
+  (0x01F5D,0x01F5D), `Abs (0x01F55);
+  (0x01F5F,0x01F5F), `Abs (0x01F57);
+  (0x01F68,0x01F6F), `Delta (-8);
+  (0x01FB8,0x01FB9), `Delta (-8);
+  (0x01FBA,0x01FBB), `Delta (-74);
+  (0x01FC8,0x01FCB), `Delta (-86);
+  (0x01FD8,0x01FD9), `Delta (-8);
+  (0x01FDA,0x01FDB), `Delta (-100);
+  (0x01FE8,0x01FE9), `Delta (-8);
+  (0x01FEA,0x01FEB), `Delta (-112);
+  (0x01FEC,0x01FEC), `Abs (0x01FE5);
+  (0x01FF8,0x01FF9), `Delta (-128);
+  (0x01FFA,0x01FFB), `Delta (-126);
+  (0x02102,0x02102), `Abs (0x02102);
+  (0x02107,0x02107), `Abs (0x02107);
+  (0x0210B,0x0210D), `Delta (0);
+  (0x02110,0x02112), `Delta (0);
+  (0x02115,0x02115), `Abs (0x02115);
+  (0x02119,0x0211D), `Delta (0);
+  (0x02124,0x02124), `Abs (0x02124);
+  (0x02126,0x02126), `Abs (0x003C9);
+  (0x02128,0x02128), `Abs (0x02128);
+  (0x0212A,0x0212A), `Abs (0x0006B);
+  (0x0212B,0x0212B), `Abs (0x000E5);
+  (0x0212C,0x0212D), `Delta (0);
+  (0x02130,0x02131), `Delta (0);
+  (0x02132,0x02132), `Abs (0x0214E);
+  (0x02133,0x02133), `Abs (0x02133);
+  (0x0213E,0x0213F), `Delta (0);
+  (0x02145,0x02145), `Abs (0x02145);
+  (0x02183,0x02183), `Abs (0x02184);
+  (0x02C00,0x02C2E), `Delta (48);
+  (0x02C60,0x02C60), `Abs (0x02C61);
+  (0x02C62,0x02C62), `Abs (0x0026B);
+  (0x02C63,0x02C63), `Abs (0x01D7D);
+  (0x02C64,0x02C64), `Abs (0x0027D);
+  (0x02C67,0x02C67), `Abs (0x02C68);
+  (0x02C69,0x02C69), `Abs (0x02C6A);
+  (0x02C6B,0x02C6B), `Abs (0x02C6C);
+  (0x02C6D,0x02C6D), `Abs (0x00251);
+  (0x02C6E,0x02C6E), `Abs (0x00271);
+  (0x02C6F,0x02C6F), `Abs (0x00250);
+  (0x02C70,0x02C70), `Abs (0x00252);
+  (0x02C72,0x02C72), `Abs (0x02C73);
+  (0x02C75,0x02C75), `Abs (0x02C76);
+  (0x02C7E,0x02C7F), `Delta (-10815);
+  (0x02C80,0x02C80), `Abs (0x02C81);
+  (0x02C82,0x02C82), `Abs (0x02C83);
+  (0x02C84,0x02C84), `Abs (0x02C85);
+  (0x02C86,0x02C86), `Abs (0x02C87);
+  (0x02C88,0x02C88), `Abs (0x02C89);
+  (0x02C8A,0x02C8A), `Abs (0x02C8B);
+  (0x02C8C,0x02C8C), `Abs (0x02C8D);
+  (0x02C8E,0x02C8E), `Abs (0x02C8F);
+  (0x02C90,0x02C90), `Abs (0x02C91);
+  (0x02C92,0x02C92), `Abs (0x02C93);
+  (0x02C94,0x02C94), `Abs (0x02C95);
+  (0x02C96,0x02C96), `Abs (0x02C97);
+  (0x02C98,0x02C98), `Abs (0x02C99);
+  (0x02C9A,0x02C9A), `Abs (0x02C9B);
+  (0x02C9C,0x02C9C), `Abs (0x02C9D);
+  (0x02C9E,0x02C9E), `Abs (0x02C9F);
+  (0x02CA0,0x02CA0), `Abs (0x02CA1);
+  (0x02CA2,0x02CA2), `Abs (0x02CA3);
+  (0x02CA4,0x02CA4), `Abs (0x02CA5);
+  (0x02CA6,0x02CA6), `Abs (0x02CA7);
+  (0x02CA8,0x02CA8), `Abs (0x02CA9);
+  (0x02CAA,0x02CAA), `Abs (0x02CAB);
+  (0x02CAC,0x02CAC), `Abs (0x02CAD);
+  (0x02CAE,0x02CAE), `Abs (0x02CAF);
+  (0x02CB0,0x02CB0), `Abs (0x02CB1);
+  (0x02CB2,0x02CB2), `Abs (0x02CB3);
+  (0x02CB4,0x02CB4), `Abs (0x02CB5);
+  (0x02CB6,0x02CB6), `Abs (0x02CB7);
+  (0x02CB8,0x02CB8), `Abs (0x02CB9);
+  (0x02CBA,0x02CBA), `Abs (0x02CBB);
+  (0x02CBC,0x02CBC), `Abs (0x02CBD);
+  (0x02CBE,0x02CBE), `Abs (0x02CBF);
+  (0x02CC0,0x02CC0), `Abs (0x02CC1);
+  (0x02CC2,0x02CC2), `Abs (0x02CC3);
+  (0x02CC4,0x02CC4), `Abs (0x02CC5);
+  (0x02CC6,0x02CC6), `Abs (0x02CC7);
+  (0x02CC8,0x02CC8), `Abs (0x02CC9);
+  (0x02CCA,0x02CCA), `Abs (0x02CCB);
+  (0x02CCC,0x02CCC), `Abs (0x02CCD);
+  (0x02CCE,0x02CCE), `Abs (0x02CCF);
+  (0x02CD0,0x02CD0), `Abs (0x02CD1);
+  (0x02CD2,0x02CD2), `Abs (0x02CD3);
+  (0x02CD4,0x02CD4), `Abs (0x02CD5);
+  (0x02CD6,0x02CD6), `Abs (0x02CD7);
+  (0x02CD8,0x02CD8), `Abs (0x02CD9);
+  (0x02CDA,0x02CDA), `Abs (0x02CDB);
+  (0x02CDC,0x02CDC), `Abs (0x02CDD);
+  (0x02CDE,0x02CDE), `Abs (0x02CDF);
+  (0x02CE0,0x02CE0), `Abs (0x02CE1);
+  (0x02CE2,0x02CE2), `Abs (0x02CE3);
+  (0x02CEB,0x02CEB), `Abs (0x02CEC);
+  (0x02CED,0x02CED), `Abs (0x02CEE);
+  (0x02CF2,0x02CF2), `Abs (0x02CF3);
+  (0x0A640,0x0A640), `Abs (0x0A641);
+  (0x0A642,0x0A642), `Abs (0x0A643);
+  (0x0A644,0x0A644), `Abs (0x0A645);
+  (0x0A646,0x0A646), `Abs (0x0A647);
+  (0x0A648,0x0A648), `Abs (0x0A649);
+  (0x0A64A,0x0A64A), `Abs (0x0A64B);
+  (0x0A64C,0x0A64C), `Abs (0x0A64D);
+  (0x0A64E,0x0A64E), `Abs (0x0A64F);
+  (0x0A650,0x0A650), `Abs (0x0A651);
+  (0x0A652,0x0A652), `Abs (0x0A653);
+  (0x0A654,0x0A654), `Abs (0x0A655);
+  (0x0A656,0x0A656), `Abs (0x0A657);
+  (0x0A658,0x0A658), `Abs (0x0A659);
+  (0x0A65A,0x0A65A), `Abs (0x0A65B);
+  (0x0A65C,0x0A65C), `Abs (0x0A65D);
+  (0x0A65E,0x0A65E), `Abs (0x0A65F);
+  (0x0A660,0x0A660), `Abs (0x0A661);
+  (0x0A662,0x0A662), `Abs (0x0A663);
+  (0x0A664,0x0A664), `Abs (0x0A665);
+  (0x0A666,0x0A666), `Abs (0x0A667);
+  (0x0A668,0x0A668), `Abs (0x0A669);
+  (0x0A66A,0x0A66A), `Abs (0x0A66B);
+  (0x0A66C,0x0A66C), `Abs (0x0A66D);
+  (0x0A680,0x0A680), `Abs (0x0A681);
+  (0x0A682,0x0A682), `Abs (0x0A683);
+  (0x0A684,0x0A684), `Abs (0x0A685);
+  (0x0A686,0x0A686), `Abs (0x0A687);
+  (0x0A688,0x0A688), `Abs (0x0A689);
+  (0x0A68A,0x0A68A), `Abs (0x0A68B);
+  (0x0A68C,0x0A68C), `Abs (0x0A68D);
+  (0x0A68E,0x0A68E), `Abs (0x0A68F);
+  (0x0A690,0x0A690), `Abs (0x0A691);
+  (0x0A692,0x0A692), `Abs (0x0A693);
+  (0x0A694,0x0A694), `Abs (0x0A695);
+  (0x0A696,0x0A696), `Abs (0x0A697);
+  (0x0A698,0x0A698), `Abs (0x0A699);
+  (0x0A69A,0x0A69A), `Abs (0x0A69B);
+  (0x0A722,0x0A722), `Abs (0x0A723);
+  (0x0A724,0x0A724), `Abs (0x0A725);
+  (0x0A726,0x0A726), `Abs (0x0A727);
+  (0x0A728,0x0A728), `Abs (0x0A729);
+  (0x0A72A,0x0A72A), `Abs (0x0A72B);
+  (0x0A72C,0x0A72C), `Abs (0x0A72D);
+  (0x0A72E,0x0A72E), `Abs (0x0A72F);
+  (0x0A732,0x0A732), `Abs (0x0A733);
+  (0x0A734,0x0A734), `Abs (0x0A735);
+  (0x0A736,0x0A736), `Abs (0x0A737);
+  (0x0A738,0x0A738), `Abs (0x0A739);
+  (0x0A73A,0x0A73A), `Abs (0x0A73B);
+  (0x0A73C,0x0A73C), `Abs (0x0A73D);
+  (0x0A73E,0x0A73E), `Abs (0x0A73F);
+  (0x0A740,0x0A740), `Abs (0x0A741);
+  (0x0A742,0x0A742), `Abs (0x0A743);
+  (0x0A744,0x0A744), `Abs (0x0A745);
+  (0x0A746,0x0A746), `Abs (0x0A747);
+  (0x0A748,0x0A748), `Abs (0x0A749);
+  (0x0A74A,0x0A74A), `Abs (0x0A74B);
+  (0x0A74C,0x0A74C), `Abs (0x0A74D);
+  (0x0A74E,0x0A74E), `Abs (0x0A74F);
+  (0x0A750,0x0A750), `Abs (0x0A751);
+  (0x0A752,0x0A752), `Abs (0x0A753);
+  (0x0A754,0x0A754), `Abs (0x0A755);
+  (0x0A756,0x0A756), `Abs (0x0A757);
+  (0x0A758,0x0A758), `Abs (0x0A759);
+  (0x0A75A,0x0A75A), `Abs (0x0A75B);
+  (0x0A75C,0x0A75C), `Abs (0x0A75D);
+  (0x0A75E,0x0A75E), `Abs (0x0A75F);
+  (0x0A760,0x0A760), `Abs (0x0A761);
+  (0x0A762,0x0A762), `Abs (0x0A763);
+  (0x0A764,0x0A764), `Abs (0x0A765);
+  (0x0A766,0x0A766), `Abs (0x0A767);
+  (0x0A768,0x0A768), `Abs (0x0A769);
+  (0x0A76A,0x0A76A), `Abs (0x0A76B);
+  (0x0A76C,0x0A76C), `Abs (0x0A76D);
+  (0x0A76E,0x0A76E), `Abs (0x0A76F);
+  (0x0A779,0x0A779), `Abs (0x0A77A);
+  (0x0A77B,0x0A77B), `Abs (0x0A77C);
+  (0x0A77D,0x0A77D), `Abs (0x01D79);
+  (0x0A77E,0x0A77E), `Abs (0x0A77F);
+  (0x0A780,0x0A780), `Abs (0x0A781);
+  (0x0A782,0x0A782), `Abs (0x0A783);
+  (0x0A784,0x0A784), `Abs (0x0A785);
+  (0x0A786,0x0A786), `Abs (0x0A787);
+  (0x0A78B,0x0A78B), `Abs (0x0A78C);
+  (0x0A78D,0x0A78D), `Abs (0x00265);
+  (0x0A790,0x0A790), `Abs (0x0A791);
+  (0x0A792,0x0A792), `Abs (0x0A793);
+  (0x0A796,0x0A796), `Abs (0x0A797);
+  (0x0A798,0x0A798), `Abs (0x0A799);
+  (0x0A79A,0x0A79A), `Abs (0x0A79B);
+  (0x0A79C,0x0A79C), `Abs (0x0A79D);
+  (0x0A79E,0x0A79E), `Abs (0x0A79F);
+  (0x0A7A0,0x0A7A0), `Abs (0x0A7A1);
+  (0x0A7A2,0x0A7A2), `Abs (0x0A7A3);
+  (0x0A7A4,0x0A7A4), `Abs (0x0A7A5);
+  (0x0A7A6,0x0A7A6), `Abs (0x0A7A7);
+  (0x0A7A8,0x0A7A8), `Abs (0x0A7A9);
+  (0x0A7AA,0x0A7AA), `Abs (0x00266);
+  (0x0A7AB,0x0A7AB), `Abs (0x0025C);
+  (0x0A7AC,0x0A7AC), `Abs (0x00261);
+  (0x0A7AD,0x0A7AD), `Abs (0x0026C);
+  (0x0A7AE,0x0A7AE), `Abs (0x0026A);
+  (0x0A7B0,0x0A7B0), `Abs (0x0029E);
+  (0x0A7B1,0x0A7B1), `Abs (0x00287);
+  (0x0A7B2,0x0A7B2), `Abs (0x0029D);
+  (0x0A7B3,0x0A7B3), `Abs (0x0AB53);
+  (0x0A7B4,0x0A7B4), `Abs (0x0A7B5);
+  (0x0A7B6,0x0A7B6), `Abs (0x0A7B7);
+  (0x0FF21,0x0FF3A), `Delta (32);
+  (0x10400,0x10427), `Delta (40);
+  (0x104B0,0x104D3), `Delta (40);
+  (0x10C80,0x10CB2), `Delta (64);
+  (0x118A0,0x118BF), `Delta (32);
+  (0x1D400,0x1D419), `Delta (0);
+  (0x1D434,0x1D44D), `Delta (0);
+  (0x1D468,0x1D481), `Delta (0);
+  (0x1D49C,0x1D49C), `Abs (0x1D49C);
+  (0x1D49E,0x1D49F), `Delta (0);
+  (0x1D4A2,0x1D4A2), `Abs (0x1D4A2);
+  (0x1D4A5,0x1D4A6), `Delta (0);
+  (0x1D4A9,0x1D4AC), `Delta (0);
+  (0x1D4AE,0x1D4B5), `Delta (0);
+  (0x1D4D0,0x1D4E9), `Delta (0);
+  (0x1D504,0x1D505), `Delta (0);
+  (0x1D507,0x1D50A), `Delta (0);
+  (0x1D50D,0x1D514), `Delta (0);
+  (0x1D516,0x1D51C), `Delta (0);
+  (0x1D538,0x1D539), `Delta (0);
+  (0x1D53B,0x1D53E), `Delta (0);
+  (0x1D540,0x1D544), `Delta (0);
+  (0x1D546,0x1D546), `Abs (0x1D546);
+  (0x1D54A,0x1D550), `Delta (0);
+  (0x1D56C,0x1D585), `Delta (0);
+  (0x1D5A0,0x1D5B9), `Delta (0);
+  (0x1D5D4,0x1D5ED), `Delta (0);
+  (0x1D608,0x1D621), `Delta (0);
+  (0x1D63C,0x1D655), `Delta (0);
+  (0x1D670,0x1D689), `Delta (0);
+  (0x1D6A8,0x1D6C0), `Delta (0);
+  (0x1D6E2,0x1D6FA), `Delta (0);
+  (0x1D71C,0x1D734), `Delta (0);
+  (0x1D756,0x1D76E), `Delta (0);
+  (0x1D790,0x1D7A8), `Delta (0);
+  (0x1D7CA,0x1D7CA), `Abs (0x1D7CA);
+  (0x1E900,0x1E921), `Delta (34);
+  (0x00061,0x0007A), `Delta (0);
+  (0x000B5,0x000B5), `Abs (0x000B5);
+  (0x000DF,0x000F6), `Delta (0);
+  (0x000F8,0x000FF), `Delta (0);
+  (0x00101,0x00101), `Abs (0x00101);
+  (0x00103,0x00103), `Abs (0x00103);
+  (0x00105,0x00105), `Abs (0x00105);
+  (0x00107,0x00107), `Abs (0x00107);
+  (0x00109,0x00109), `Abs (0x00109);
+  (0x0010B,0x0010B), `Abs (0x0010B);
+  (0x0010D,0x0010D), `Abs (0x0010D);
+  (0x0010F,0x0010F), `Abs (0x0010F);
+  (0x00111,0x00111), `Abs (0x00111);
+  (0x00113,0x00113), `Abs (0x00113);
+  (0x00115,0x00115), `Abs (0x00115);
+  (0x00117,0x00117), `Abs (0x00117);
+  (0x00119,0x00119), `Abs (0x00119);
+  (0x0011B,0x0011B), `Abs (0x0011B);
+  (0x0011D,0x0011D), `Abs (0x0011D);
+  (0x0011F,0x0011F), `Abs (0x0011F);
+  (0x00121,0x00121), `Abs (0x00121);
+  (0x00123,0x00123), `Abs (0x00123);
+  (0x00125,0x00125), `Abs (0x00125);
+  (0x00127,0x00127), `Abs (0x00127);
+  (0x00129,0x00129), `Abs (0x00129);
+  (0x0012B,0x0012B), `Abs (0x0012B);
+  (0x0012D,0x0012D), `Abs (0x0012D);
+  (0x0012F,0x0012F), `Abs (0x0012F);
+  (0x00131,0x00131), `Abs (0x00131);
+  (0x00133,0x00133), `Abs (0x00133);
+  (0x00135,0x00135), `Abs (0x00135);
+  (0x00137,0x00138), `Delta (0);
+  (0x0013A,0x0013A), `Abs (0x0013A);
+  (0x0013C,0x0013C), `Abs (0x0013C);
+  (0x0013E,0x0013E), `Abs (0x0013E);
+  (0x00140,0x00140), `Abs (0x00140);
+  (0x00142,0x00142), `Abs (0x00142);
+  (0x00144,0x00144), `Abs (0x00144);
+  (0x00146,0x00146), `Abs (0x00146);
+  (0x00148,0x00149), `Delta (0);
+  (0x0014B,0x0014B), `Abs (0x0014B);
+  (0x0014D,0x0014D), `Abs (0x0014D);
+  (0x0014F,0x0014F), `Abs (0x0014F);
+  (0x00151,0x00151), `Abs (0x00151);
+  (0x00153,0x00153), `Abs (0x00153);
+  (0x00155,0x00155), `Abs (0x00155);
+  (0x00157,0x00157), `Abs (0x00157);
+  (0x00159,0x00159), `Abs (0x00159);
+  (0x0015B,0x0015B), `Abs (0x0015B);
+  (0x0015D,0x0015D), `Abs (0x0015D);
+  (0x0015F,0x0015F), `Abs (0x0015F);
+  (0x00161,0x00161), `Abs (0x00161);
+  (0x00163,0x00163), `Abs (0x00163);
+  (0x00165,0x00165), `Abs (0x00165);
+  (0x00167,0x00167), `Abs (0x00167);
+  (0x00169,0x00169), `Abs (0x00169);
+  (0x0016B,0x0016B), `Abs (0x0016B);
+  (0x0016D,0x0016D), `Abs (0x0016D);
+  (0x0016F,0x0016F), `Abs (0x0016F);
+  (0x00171,0x00171), `Abs (0x00171);
+  (0x00173,0x00173), `Abs (0x00173);
+  (0x00175,0x00175), `Abs (0x00175);
+  (0x00177,0x00177), `Abs (0x00177);
+  (0x0017A,0x0017A), `Abs (0x0017A);
+  (0x0017C,0x0017C), `Abs (0x0017C);
+  (0x0017E,0x00180), `Delta (0);
+  (0x00183,0x00183), `Abs (0x00183);
+  (0x00185,0x00185), `Abs (0x00185);
+  (0x00188,0x00188), `Abs (0x00188);
+  (0x0018C,0x0018D), `Delta (0);
+  (0x00192,0x00192), `Abs (0x00192);
+  (0x00195,0x00195), `Abs (0x00195);
+  (0x00199,0x0019B), `Delta (0);
+  (0x0019E,0x0019E), `Abs (0x0019E);
+  (0x001A1,0x001A1), `Abs (0x001A1);
+  (0x001A3,0x001A3), `Abs (0x001A3);
+  (0x001A5,0x001A5), `Abs (0x001A5);
+  (0x001A8,0x001A8), `Abs (0x001A8);
+  (0x001AA,0x001AB), `Delta (0);
+  (0x001AD,0x001AD), `Abs (0x001AD);
+  (0x001B0,0x001B0), `Abs (0x001B0);
+  (0x001B4,0x001B4), `Abs (0x001B4);
+  (0x001B6,0x001B6), `Abs (0x001B6);
+  (0x001B9,0x001BA), `Delta (0);
+  (0x001BD,0x001BF), `Delta (0);
+  (0x001C6,0x001C6), `Abs (0x001C6);
+  (0x001C9,0x001C9), `Abs (0x001C9);
+  (0x001CC,0x001CC), `Abs (0x001CC);
+  (0x001CE,0x001CE), `Abs (0x001CE);
+  (0x001D0,0x001D0), `Abs (0x001D0);
+  (0x001D2,0x001D2), `Abs (0x001D2);
+  (0x001D4,0x001D4), `Abs (0x001D4);
+  (0x001D6,0x001D6), `Abs (0x001D6);
+  (0x001D8,0x001D8), `Abs (0x001D8);
+  (0x001DA,0x001DA), `Abs (0x001DA);
+  (0x001DC,0x001DD), `Delta (0);
+  (0x001DF,0x001DF), `Abs (0x001DF);
+  (0x001E1,0x001E1), `Abs (0x001E1);
+  (0x001E3,0x001E3), `Abs (0x001E3);
+  (0x001E5,0x001E5), `Abs (0x001E5);
+  (0x001E7,0x001E7), `Abs (0x001E7);
+  (0x001E9,0x001E9), `Abs (0x001E9);
+  (0x001EB,0x001EB), `Abs (0x001EB);
+  (0x001ED,0x001ED), `Abs (0x001ED);
+  (0x001EF,0x001F0), `Delta (0);
+  (0x001F3,0x001F3), `Abs (0x001F3);
+  (0x001F5,0x001F5), `Abs (0x001F5);
+  (0x001F9,0x001F9), `Abs (0x001F9);
+  (0x001FB,0x001FB), `Abs (0x001FB);
+  (0x001FD,0x001FD), `Abs (0x001FD);
+  (0x001FF,0x001FF), `Abs (0x001FF);
+  (0x00201,0x00201), `Abs (0x00201);
+  (0x00203,0x00203), `Abs (0x00203);
+  (0x00205,0x00205), `Abs (0x00205);
+  (0x00207,0x00207), `Abs (0x00207);
+  (0x00209,0x00209), `Abs (0x00209);
+  (0x0020B,0x0020B), `Abs (0x0020B);
+  (0x0020D,0x0020D), `Abs (0x0020D);
+  (0x0020F,0x0020F), `Abs (0x0020F);
+  (0x00211,0x00211), `Abs (0x00211);
+  (0x00213,0x00213), `Abs (0x00213);
+  (0x00215,0x00215), `Abs (0x00215);
+  (0x00217,0x00217), `Abs (0x00217);
+  (0x00219,0x00219), `Abs (0x00219);
+  (0x0021B,0x0021B), `Abs (0x0021B);
+  (0x0021D,0x0021D), `Abs (0x0021D);
+  (0x0021F,0x0021F), `Abs (0x0021F);
+  (0x00221,0x00221), `Abs (0x00221);
+  (0x00223,0x00223), `Abs (0x00223);
+  (0x00225,0x00225), `Abs (0x00225);
+  (0x00227,0x00227), `Abs (0x00227);
+  (0x00229,0x00229), `Abs (0x00229);
+  (0x0022B,0x0022B), `Abs (0x0022B);
+  (0x0022D,0x0022D), `Abs (0x0022D);
+  (0x0022F,0x0022F), `Abs (0x0022F);
+  (0x00231,0x00231), `Abs (0x00231);
+  (0x00233,0x00239), `Delta (0);
+  (0x0023C,0x0023C), `Abs (0x0023C);
+  (0x0023F,0x00240), `Delta (0);
+  (0x00242,0x00242), `Abs (0x00242);
+  (0x00247,0x00247), `Abs (0x00247);
+  (0x00249,0x00249), `Abs (0x00249);
+  (0x0024B,0x0024B), `Abs (0x0024B);
+  (0x0024D,0x0024D), `Abs (0x0024D);
+  (0x0024F,0x00293), `Delta (0);
+  (0x00295,0x002AF), `Delta (0);
+  (0x00371,0x00371), `Abs (0x00371);
+  (0x00373,0x00373), `Abs (0x00373);
+  (0x00377,0x00377), `Abs (0x00377);
+  (0x0037B,0x0037D), `Delta (0);
+  (0x00390,0x00390), `Abs (0x00390);
+  (0x003AC,0x003CE), `Delta (0);
+  (0x003D0,0x003D1), `Delta (0);
+  (0x003D5,0x003D7), `Delta (0);
+  (0x003D9,0x003D9), `Abs (0x003D9);
+  (0x003DB,0x003DB), `Abs (0x003DB);
+  (0x003DD,0x003DD), `Abs (0x003DD);
+  (0x003DF,0x003DF), `Abs (0x003DF);
+  (0x003E1,0x003E1), `Abs (0x003E1);
+  (0x003E3,0x003E3), `Abs (0x003E3);
+  (0x003E5,0x003E5), `Abs (0x003E5);
+  (0x003E7,0x003E7), `Abs (0x003E7);
+  (0x003E9,0x003E9), `Abs (0x003E9);
+  (0x003EB,0x003EB), `Abs (0x003EB);
+  (0x003ED,0x003ED), `Abs (0x003ED);
+  (0x003EF,0x003F3), `Delta (0);
+  (0x003F5,0x003F5), `Abs (0x003F5);
+  (0x003F8,0x003F8), `Abs (0x003F8);
+  (0x003FB,0x003FC), `Delta (0);
+  (0x00430,0x0045F), `Delta (0);
+  (0x00461,0x00461), `Abs (0x00461);
+  (0x00463,0x00463), `Abs (0x00463);
+  (0x00465,0x00465), `Abs (0x00465);
+  (0x00467,0x00467), `Abs (0x00467);
+  (0x00469,0x00469), `Abs (0x00469);
+  (0x0046B,0x0046B), `Abs (0x0046B);
+  (0x0046D,0x0046D), `Abs (0x0046D);
+  (0x0046F,0x0046F), `Abs (0x0046F);
+  (0x00471,0x00471), `Abs (0x00471);
+  (0x00473,0x00473), `Abs (0x00473);
+  (0x00475,0x00475), `Abs (0x00475);
+  (0x00477,0x00477), `Abs (0x00477);
+  (0x00479,0x00479), `Abs (0x00479);
+  (0x0047B,0x0047B), `Abs (0x0047B);
+  (0x0047D,0x0047D), `Abs (0x0047D);
+  (0x0047F,0x0047F), `Abs (0x0047F);
+  (0x00481,0x00481), `Abs (0x00481);
+  (0x0048B,0x0048B), `Abs (0x0048B);
+  (0x0048D,0x0048D), `Abs (0x0048D);
+  (0x0048F,0x0048F), `Abs (0x0048F);
+  (0x00491,0x00491), `Abs (0x00491);
+  (0x00493,0x00493), `Abs (0x00493);
+  (0x00495,0x00495), `Abs (0x00495);
+  (0x00497,0x00497), `Abs (0x00497);
+  (0x00499,0x00499), `Abs (0x00499);
+  (0x0049B,0x0049B), `Abs (0x0049B);
+  (0x0049D,0x0049D), `Abs (0x0049D);
+  (0x0049F,0x0049F), `Abs (0x0049F);
+  (0x004A1,0x004A1), `Abs (0x004A1);
+  (0x004A3,0x004A3), `Abs (0x004A3);
+  (0x004A5,0x004A5), `Abs (0x004A5);
+  (0x004A7,0x004A7), `Abs (0x004A7);
+  (0x004A9,0x004A9), `Abs (0x004A9);
+  (0x004AB,0x004AB), `Abs (0x004AB);
+  (0x004AD,0x004AD), `Abs (0x004AD);
+  (0x004AF,0x004AF), `Abs (0x004AF);
+  (0x004B1,0x004B1), `Abs (0x004B1);
+  (0x004B3,0x004B3), `Abs (0x004B3);
+  (0x004B5,0x004B5), `Abs (0x004B5);
+  (0x004B7,0x004B7), `Abs (0x004B7);
+  (0x004B9,0x004B9), `Abs (0x004B9);
+  (0x004BB,0x004BB), `Abs (0x004BB);
+  (0x004BD,0x004BD), `Abs (0x004BD);
+  (0x004BF,0x004BF), `Abs (0x004BF);
+  (0x004C2,0x004C2), `Abs (0x004C2);
+  (0x004C4,0x004C4), `Abs (0x004C4);
+  (0x004C6,0x004C6), `Abs (0x004C6);
+  (0x004C8,0x004C8), `Abs (0x004C8);
+  (0x004CA,0x004CA), `Abs (0x004CA);
+  (0x004CC,0x004CC), `Abs (0x004CC);
+  (0x004CE,0x004CF), `Delta (0);
+  (0x004D1,0x004D1), `Abs (0x004D1);
+  (0x004D3,0x004D3), `Abs (0x004D3);
+  (0x004D5,0x004D5), `Abs (0x004D5);
+  (0x004D7,0x004D7), `Abs (0x004D7);
+  (0x004D9,0x004D9), `Abs (0x004D9);
+  (0x004DB,0x004DB), `Abs (0x004DB);
+  (0x004DD,0x004DD), `Abs (0x004DD);
+  (0x004DF,0x004DF), `Abs (0x004DF);
+  (0x004E1,0x004E1), `Abs (0x004E1);
+  (0x004E3,0x004E3), `Abs (0x004E3);
+  (0x004E5,0x004E5), `Abs (0x004E5);
+  (0x004E7,0x004E7), `Abs (0x004E7);
+  (0x004E9,0x004E9), `Abs (0x004E9);
+  (0x004EB,0x004EB), `Abs (0x004EB);
+  (0x004ED,0x004ED), `Abs (0x004ED);
+  (0x004EF,0x004EF), `Abs (0x004EF);
+  (0x004F1,0x004F1), `Abs (0x004F1);
+  (0x004F3,0x004F3), `Abs (0x004F3);
+  (0x004F5,0x004F5), `Abs (0x004F5);
+  (0x004F7,0x004F7), `Abs (0x004F7);
+  (0x004F9,0x004F9), `Abs (0x004F9);
+  (0x004FB,0x004FB), `Abs (0x004FB);
+  (0x004FD,0x004FD), `Abs (0x004FD);
+  (0x004FF,0x004FF), `Abs (0x004FF);
+  (0x00501,0x00501), `Abs (0x00501);
+  (0x00503,0x00503), `Abs (0x00503);
+  (0x00505,0x00505), `Abs (0x00505);
+  (0x00507,0x00507), `Abs (0x00507);
+  (0x00509,0x00509), `Abs (0x00509);
+  (0x0050B,0x0050B), `Abs (0x0050B);
+  (0x0050D,0x0050D), `Abs (0x0050D);
+  (0x0050F,0x0050F), `Abs (0x0050F);
+  (0x00511,0x00511), `Abs (0x00511);
+  (0x00513,0x00513), `Abs (0x00513);
+  (0x00515,0x00515), `Abs (0x00515);
+  (0x00517,0x00517), `Abs (0x00517);
+  (0x00519,0x00519), `Abs (0x00519);
+  (0x0051B,0x0051B), `Abs (0x0051B);
+  (0x0051D,0x0051D), `Abs (0x0051D);
+  (0x0051F,0x0051F), `Abs (0x0051F);
+  (0x00521,0x00521), `Abs (0x00521);
+  (0x00523,0x00523), `Abs (0x00523);
+  (0x00525,0x00525), `Abs (0x00525);
+  (0x00527,0x00527), `Abs (0x00527);
+  (0x00529,0x00529), `Abs (0x00529);
+  (0x0052B,0x0052B), `Abs (0x0052B);
+  (0x0052D,0x0052D), `Abs (0x0052D);
+  (0x0052F,0x0052F), `Abs (0x0052F);
+  (0x00561,0x00587), `Delta (0);
+  (0x013F8,0x013FD), `Delta (0);
+  (0x01C80,0x01C88), `Delta (0);
+  (0x01D00,0x01D2B), `Delta (0);
+  (0x01D6B,0x01D77), `Delta (0);
+  (0x01D79,0x01D9A), `Delta (0);
+  (0x01E01,0x01E01), `Abs (0x01E01);
+  (0x01E03,0x01E03), `Abs (0x01E03);
+  (0x01E05,0x01E05), `Abs (0x01E05);
+  (0x01E07,0x01E07), `Abs (0x01E07);
+  (0x01E09,0x01E09), `Abs (0x01E09);
+  (0x01E0B,0x01E0B), `Abs (0x01E0B);
+  (0x01E0D,0x01E0D), `Abs (0x01E0D);
+  (0x01E0F,0x01E0F), `Abs (0x01E0F);
+  (0x01E11,0x01E11), `Abs (0x01E11);
+  (0x01E13,0x01E13), `Abs (0x01E13);
+  (0x01E15,0x01E15), `Abs (0x01E15);
+  (0x01E17,0x01E17), `Abs (0x01E17);
+  (0x01E19,0x01E19), `Abs (0x01E19);
+  (0x01E1B,0x01E1B), `Abs (0x01E1B);
+  (0x01E1D,0x01E1D), `Abs (0x01E1D);
+  (0x01E1F,0x01E1F), `Abs (0x01E1F);
+  (0x01E21,0x01E21), `Abs (0x01E21);
+  (0x01E23,0x01E23), `Abs (0x01E23);
+  (0x01E25,0x01E25), `Abs (0x01E25);
+  (0x01E27,0x01E27), `Abs (0x01E27);
+  (0x01E29,0x01E29), `Abs (0x01E29);
+  (0x01E2B,0x01E2B), `Abs (0x01E2B);
+  (0x01E2D,0x01E2D), `Abs (0x01E2D);
+  (0x01E2F,0x01E2F), `Abs (0x01E2F);
+  (0x01E31,0x01E31), `Abs (0x01E31);
+  (0x01E33,0x01E33), `Abs (0x01E33);
+  (0x01E35,0x01E35), `Abs (0x01E35);
+  (0x01E37,0x01E37), `Abs (0x01E37);
+  (0x01E39,0x01E39), `Abs (0x01E39);
+  (0x01E3B,0x01E3B), `Abs (0x01E3B);
+  (0x01E3D,0x01E3D), `Abs (0x01E3D);
+  (0x01E3F,0x01E3F), `Abs (0x01E3F);
+  (0x01E41,0x01E41), `Abs (0x01E41);
+  (0x01E43,0x01E43), `Abs (0x01E43);
+  (0x01E45,0x01E45), `Abs (0x01E45);
+  (0x01E47,0x01E47), `Abs (0x01E47);
+  (0x01E49,0x01E49), `Abs (0x01E49);
+  (0x01E4B,0x01E4B), `Abs (0x01E4B);
+  (0x01E4D,0x01E4D), `Abs (0x01E4D);
+  (0x01E4F,0x01E4F), `Abs (0x01E4F);
+  (0x01E51,0x01E51), `Abs (0x01E51);
+  (0x01E53,0x01E53), `Abs (0x01E53);
+  (0x01E55,0x01E55), `Abs (0x01E55);
+  (0x01E57,0x01E57), `Abs (0x01E57);
+  (0x01E59,0x01E59), `Abs (0x01E59);
+  (0x01E5B,0x01E5B), `Abs (0x01E5B);
+  (0x01E5D,0x01E5D), `Abs (0x01E5D);
+  (0x01E5F,0x01E5F), `Abs (0x01E5F);
+  (0x01E61,0x01E61), `Abs (0x01E61);
+  (0x01E63,0x01E63), `Abs (0x01E63);
+  (0x01E65,0x01E65), `Abs (0x01E65);
+  (0x01E67,0x01E67), `Abs (0x01E67);
+  (0x01E69,0x01E69), `Abs (0x01E69);
+  (0x01E6B,0x01E6B), `Abs (0x01E6B);
+  (0x01E6D,0x01E6D), `Abs (0x01E6D);
+  (0x01E6F,0x01E6F), `Abs (0x01E6F);
+  (0x01E71,0x01E71), `Abs (0x01E71);
+  (0x01E73,0x01E73), `Abs (0x01E73);
+  (0x01E75,0x01E75), `Abs (0x01E75);
+  (0x01E77,0x01E77), `Abs (0x01E77);
+  (0x01E79,0x01E79), `Abs (0x01E79);
+  (0x01E7B,0x01E7B), `Abs (0x01E7B);
+  (0x01E7D,0x01E7D), `Abs (0x01E7D);
+  (0x01E7F,0x01E7F), `Abs (0x01E7F);
+  (0x01E81,0x01E81), `Abs (0x01E81);
+  (0x01E83,0x01E83), `Abs (0x01E83);
+  (0x01E85,0x01E85), `Abs (0x01E85);
+  (0x01E87,0x01E87), `Abs (0x01E87);
+  (0x01E89,0x01E89), `Abs (0x01E89);
+  (0x01E8B,0x01E8B), `Abs (0x01E8B);
+  (0x01E8D,0x01E8D), `Abs (0x01E8D);
+  (0x01E8F,0x01E8F), `Abs (0x01E8F);
+  (0x01E91,0x01E91), `Abs (0x01E91);
+  (0x01E93,0x01E93), `Abs (0x01E93);
+  (0x01E95,0x01E9D), `Delta (0);
+  (0x01E9F,0x01E9F), `Abs (0x01E9F);
+  (0x01EA1,0x01EA1), `Abs (0x01EA1);
+  (0x01EA3,0x01EA3), `Abs (0x01EA3);
+  (0x01EA5,0x01EA5), `Abs (0x01EA5);
+  (0x01EA7,0x01EA7), `Abs (0x01EA7);
+  (0x01EA9,0x01EA9), `Abs (0x01EA9);
+  (0x01EAB,0x01EAB), `Abs (0x01EAB);
+  (0x01EAD,0x01EAD), `Abs (0x01EAD);
+  (0x01EAF,0x01EAF), `Abs (0x01EAF);
+  (0x01EB1,0x01EB1), `Abs (0x01EB1);
+  (0x01EB3,0x01EB3), `Abs (0x01EB3);
+  (0x01EB5,0x01EB5), `Abs (0x01EB5);
+  (0x01EB7,0x01EB7), `Abs (0x01EB7);
+  (0x01EB9,0x01EB9), `Abs (0x01EB9);
+  (0x01EBB,0x01EBB), `Abs (0x01EBB);
+  (0x01EBD,0x01EBD), `Abs (0x01EBD);
+  (0x01EBF,0x01EBF), `Abs (0x01EBF);
+  (0x01EC1,0x01EC1), `Abs (0x01EC1);
+  (0x01EC3,0x01EC3), `Abs (0x01EC3);
+  (0x01EC5,0x01EC5), `Abs (0x01EC5);
+  (0x01EC7,0x01EC7), `Abs (0x01EC7);
+  (0x01EC9,0x01EC9), `Abs (0x01EC9);
+  (0x01ECB,0x01ECB), `Abs (0x01ECB);
+  (0x01ECD,0x01ECD), `Abs (0x01ECD);
+  (0x01ECF,0x01ECF), `Abs (0x01ECF);
+  (0x01ED1,0x01ED1), `Abs (0x01ED1);
+  (0x01ED3,0x01ED3), `Abs (0x01ED3);
+  (0x01ED5,0x01ED5), `Abs (0x01ED5);
+  (0x01ED7,0x01ED7), `Abs (0x01ED7);
+  (0x01ED9,0x01ED9), `Abs (0x01ED9);
+  (0x01EDB,0x01EDB), `Abs (0x01EDB);
+  (0x01EDD,0x01EDD), `Abs (0x01EDD);
+  (0x01EDF,0x01EDF), `Abs (0x01EDF);
+  (0x01EE1,0x01EE1), `Abs (0x01EE1);
+  (0x01EE3,0x01EE3), `Abs (0x01EE3);
+  (0x01EE5,0x01EE5), `Abs (0x01EE5);
+  (0x01EE7,0x01EE7), `Abs (0x01EE7);
+  (0x01EE9,0x01EE9), `Abs (0x01EE9);
+  (0x01EEB,0x01EEB), `Abs (0x01EEB);
+  (0x01EED,0x01EED), `Abs (0x01EED);
+  (0x01EEF,0x01EEF), `Abs (0x01EEF);
+  (0x01EF1,0x01EF1), `Abs (0x01EF1);
+  (0x01EF3,0x01EF3), `Abs (0x01EF3);
+  (0x01EF5,0x01EF5), `Abs (0x01EF5);
+  (0x01EF7,0x01EF7), `Abs (0x01EF7);
+  (0x01EF9,0x01EF9), `Abs (0x01EF9);
+  (0x01EFB,0x01EFB), `Abs (0x01EFB);
+  (0x01EFD,0x01EFD), `Abs (0x01EFD);
+  (0x01EFF,0x01F07), `Delta (0);
+  (0x01F10,0x01F15), `Delta (0);
+  (0x01F20,0x01F27), `Delta (0);
+  (0x01F30,0x01F37), `Delta (0);
+  (0x01F40,0x01F45), `Delta (0);
+  (0x01F50,0x01F57), `Delta (0);
+  (0x01F60,0x01F67), `Delta (0);
+  (0x01F70,0x01F7D), `Delta (0);
+  (0x01F80,0x01F87), `Delta (0);
+  (0x01F90,0x01F97), `Delta (0);
+  (0x01FA0,0x01FA7), `Delta (0);
+  (0x01FB0,0x01FB4), `Delta (0);
+  (0x01FB6,0x01FB7), `Delta (0);
+  (0x01FBE,0x01FBE), `Abs (0x01FBE);
+  (0x01FC2,0x01FC4), `Delta (0);
+  (0x01FC6,0x01FC7), `Delta (0);
+  (0x01FD0,0x01FD3), `Delta (0);
+  (0x01FD6,0x01FD7), `Delta (0);
+  (0x01FE0,0x01FE7), `Delta (0);
+  (0x01FF2,0x01FF4), `Delta (0);
+  (0x01FF6,0x01FF7), `Delta (0);
+  (0x0210A,0x0210A), `Abs (0x0210A);
+  (0x0210E,0x0210F), `Delta (0);
+  (0x02113,0x02113), `Abs (0x02113);
+  (0x0212F,0x0212F), `Abs (0x0212F);
+  (0x02134,0x02134), `Abs (0x02134);
+  (0x02139,0x02139), `Abs (0x02139);
+  (0x0213C,0x0213D), `Delta (0);
+  (0x02146,0x02149), `Delta (0);
+  (0x0214E,0x0214E), `Abs (0x0214E);
+  (0x02184,0x02184), `Abs (0x02184);
+  (0x02C30,0x02C5E), `Delta (0);
+  (0x02C61,0x02C61), `Abs (0x02C61);
+  (0x02C65,0x02C66), `Delta (0);
+  (0x02C68,0x02C68), `Abs (0x02C68);
+  (0x02C6A,0x02C6A), `Abs (0x02C6A);
+  (0x02C6C,0x02C6C), `Abs (0x02C6C);
+  (0x02C71,0x02C71), `Abs (0x02C71);
+  (0x02C73,0x02C74), `Delta (0);
+  (0x02C76,0x02C7B), `Delta (0);
+  (0x02C81,0x02C81), `Abs (0x02C81);
+  (0x02C83,0x02C83), `Abs (0x02C83);
+  (0x02C85,0x02C85), `Abs (0x02C85);
+  (0x02C87,0x02C87), `Abs (0x02C87);
+  (0x02C89,0x02C89), `Abs (0x02C89);
+  (0x02C8B,0x02C8B), `Abs (0x02C8B);
+  (0x02C8D,0x02C8D), `Abs (0x02C8D);
+  (0x02C8F,0x02C8F), `Abs (0x02C8F);
+  (0x02C91,0x02C91), `Abs (0x02C91);
+  (0x02C93,0x02C93), `Abs (0x02C93);
+  (0x02C95,0x02C95), `Abs (0x02C95);
+  (0x02C97,0x02C97), `Abs (0x02C97);
+  (0x02C99,0x02C99), `Abs (0x02C99);
+  (0x02C9B,0x02C9B), `Abs (0x02C9B);
+  (0x02C9D,0x02C9D), `Abs (0x02C9D);
+  (0x02C9F,0x02C9F), `Abs (0x02C9F);
+  (0x02CA1,0x02CA1), `Abs (0x02CA1);
+  (0x02CA3,0x02CA3), `Abs (0x02CA3);
+  (0x02CA5,0x02CA5), `Abs (0x02CA5);
+  (0x02CA7,0x02CA7), `Abs (0x02CA7);
+  (0x02CA9,0x02CA9), `Abs (0x02CA9);
+  (0x02CAB,0x02CAB), `Abs (0x02CAB);
+  (0x02CAD,0x02CAD), `Abs (0x02CAD);
+  (0x02CAF,0x02CAF), `Abs (0x02CAF);
+  (0x02CB1,0x02CB1), `Abs (0x02CB1);
+  (0x02CB3,0x02CB3), `Abs (0x02CB3);
+  (0x02CB5,0x02CB5), `Abs (0x02CB5);
+  (0x02CB7,0x02CB7), `Abs (0x02CB7);
+  (0x02CB9,0x02CB9), `Abs (0x02CB9);
+  (0x02CBB,0x02CBB), `Abs (0x02CBB);
+  (0x02CBD,0x02CBD), `Abs (0x02CBD);
+  (0x02CBF,0x02CBF), `Abs (0x02CBF);
+  (0x02CC1,0x02CC1), `Abs (0x02CC1);
+  (0x02CC3,0x02CC3), `Abs (0x02CC3);
+  (0x02CC5,0x02CC5), `Abs (0x02CC5);
+  (0x02CC7,0x02CC7), `Abs (0x02CC7);
+  (0x02CC9,0x02CC9), `Abs (0x02CC9);
+  (0x02CCB,0x02CCB), `Abs (0x02CCB);
+  (0x02CCD,0x02CCD), `Abs (0x02CCD);
+  (0x02CCF,0x02CCF), `Abs (0x02CCF);
+  (0x02CD1,0x02CD1), `Abs (0x02CD1);
+  (0x02CD3,0x02CD3), `Abs (0x02CD3);
+  (0x02CD5,0x02CD5), `Abs (0x02CD5);
+  (0x02CD7,0x02CD7), `Abs (0x02CD7);
+  (0x02CD9,0x02CD9), `Abs (0x02CD9);
+  (0x02CDB,0x02CDB), `Abs (0x02CDB);
+  (0x02CDD,0x02CDD), `Abs (0x02CDD);
+  (0x02CDF,0x02CDF), `Abs (0x02CDF);
+  (0x02CE1,0x02CE1), `Abs (0x02CE1);
+  (0x02CE3,0x02CE4), `Delta (0);
+  (0x02CEC,0x02CEC), `Abs (0x02CEC);
+  (0x02CEE,0x02CEE), `Abs (0x02CEE);
+  (0x02CF3,0x02CF3), `Abs (0x02CF3);
+  (0x02D00,0x02D25), `Delta (0);
+  (0x02D27,0x02D27), `Abs (0x02D27);
+  (0x02D2D,0x02D2D), `Abs (0x02D2D);
+  (0x0A641,0x0A641), `Abs (0x0A641);
+  (0x0A643,0x0A643), `Abs (0x0A643);
+  (0x0A645,0x0A645), `Abs (0x0A645);
+  (0x0A647,0x0A647), `Abs (0x0A647);
+  (0x0A649,0x0A649), `Abs (0x0A649);
+  (0x0A64B,0x0A64B), `Abs (0x0A64B);
+  (0x0A64D,0x0A64D), `Abs (0x0A64D);
+  (0x0A64F,0x0A64F), `Abs (0x0A64F);
+  (0x0A651,0x0A651), `Abs (0x0A651);
+  (0x0A653,0x0A653), `Abs (0x0A653);
+  (0x0A655,0x0A655), `Abs (0x0A655);
+  (0x0A657,0x0A657), `Abs (0x0A657);
+  (0x0A659,0x0A659), `Abs (0x0A659);
+  (0x0A65B,0x0A65B), `Abs (0x0A65B);
+  (0x0A65D,0x0A65D), `Abs (0x0A65D);
+  (0x0A65F,0x0A65F), `Abs (0x0A65F);
+  (0x0A661,0x0A661), `Abs (0x0A661);
+  (0x0A663,0x0A663), `Abs (0x0A663);
+  (0x0A665,0x0A665), `Abs (0x0A665);
+  (0x0A667,0x0A667), `Abs (0x0A667);
+  (0x0A669,0x0A669), `Abs (0x0A669);
+  (0x0A66B,0x0A66B), `Abs (0x0A66B);
+  (0x0A66D,0x0A66D), `Abs (0x0A66D);
+  (0x0A681,0x0A681), `Abs (0x0A681);
+  (0x0A683,0x0A683), `Abs (0x0A683);
+  (0x0A685,0x0A685), `Abs (0x0A685);
+  (0x0A687,0x0A687), `Abs (0x0A687);
+  (0x0A689,0x0A689), `Abs (0x0A689);
+  (0x0A68B,0x0A68B), `Abs (0x0A68B);
+  (0x0A68D,0x0A68D), `Abs (0x0A68D);
+  (0x0A68F,0x0A68F), `Abs (0x0A68F);
+  (0x0A691,0x0A691), `Abs (0x0A691);
+  (0x0A693,0x0A693), `Abs (0x0A693);
+  (0x0A695,0x0A695), `Abs (0x0A695);
+  (0x0A697,0x0A697), `Abs (0x0A697);
+  (0x0A699,0x0A699), `Abs (0x0A699);
+  (0x0A69B,0x0A69B), `Abs (0x0A69B);
+  (0x0A723,0x0A723), `Abs (0x0A723);
+  (0x0A725,0x0A725), `Abs (0x0A725);
+  (0x0A727,0x0A727), `Abs (0x0A727);
+  (0x0A729,0x0A729), `Abs (0x0A729);
+  (0x0A72B,0x0A72B), `Abs (0x0A72B);
+  (0x0A72D,0x0A72D), `Abs (0x0A72D);
+  (0x0A72F,0x0A731), `Delta (0);
+  (0x0A733,0x0A733), `Abs (0x0A733);
+  (0x0A735,0x0A735), `Abs (0x0A735);
+  (0x0A737,0x0A737), `Abs (0x0A737);
+  (0x0A739,0x0A739), `Abs (0x0A739);
+  (0x0A73B,0x0A73B), `Abs (0x0A73B);
+  (0x0A73D,0x0A73D), `Abs (0x0A73D);
+  (0x0A73F,0x0A73F), `Abs (0x0A73F);
+  (0x0A741,0x0A741), `Abs (0x0A741);
+  (0x0A743,0x0A743), `Abs (0x0A743);
+  (0x0A745,0x0A745), `Abs (0x0A745);
+  (0x0A747,0x0A747), `Abs (0x0A747);
+  (0x0A749,0x0A749), `Abs (0x0A749);
+  (0x0A74B,0x0A74B), `Abs (0x0A74B);
+  (0x0A74D,0x0A74D), `Abs (0x0A74D);
+  (0x0A74F,0x0A74F), `Abs (0x0A74F);
+  (0x0A751,0x0A751), `Abs (0x0A751);
+  (0x0A753,0x0A753), `Abs (0x0A753);
+  (0x0A755,0x0A755), `Abs (0x0A755);
+  (0x0A757,0x0A757), `Abs (0x0A757);
+  (0x0A759,0x0A759), `Abs (0x0A759);
+  (0x0A75B,0x0A75B), `Abs (0x0A75B);
+  (0x0A75D,0x0A75D), `Abs (0x0A75D);
+  (0x0A75F,0x0A75F), `Abs (0x0A75F);
+  (0x0A761,0x0A761), `Abs (0x0A761);
+  (0x0A763,0x0A763), `Abs (0x0A763);
+  (0x0A765,0x0A765), `Abs (0x0A765);
+  (0x0A767,0x0A767), `Abs (0x0A767);
+  (0x0A769,0x0A769), `Abs (0x0A769);
+  (0x0A76B,0x0A76B), `Abs (0x0A76B);
+  (0x0A76D,0x0A76D), `Abs (0x0A76D);
+  (0x0A76F,0x0A76F), `Abs (0x0A76F);
+  (0x0A771,0x0A778), `Delta (0);
+  (0x0A77A,0x0A77A), `Abs (0x0A77A);
+  (0x0A77C,0x0A77C), `Abs (0x0A77C);
+  (0x0A77F,0x0A77F), `Abs (0x0A77F);
+  (0x0A781,0x0A781), `Abs (0x0A781);
+  (0x0A783,0x0A783), `Abs (0x0A783);
+  (0x0A785,0x0A785), `Abs (0x0A785);
+  (0x0A787,0x0A787), `Abs (0x0A787);
+  (0x0A78C,0x0A78C), `Abs (0x0A78C);
+  (0x0A78E,0x0A78E), `Abs (0x0A78E);
+  (0x0A791,0x0A791), `Abs (0x0A791);
+  (0x0A793,0x0A795), `Delta (0);
+  (0x0A797,0x0A797), `Abs (0x0A797);
+  (0x0A799,0x0A799), `Abs (0x0A799);
+  (0x0A79B,0x0A79B), `Abs (0x0A79B);
+  (0x0A79D,0x0A79D), `Abs (0x0A79D);
+  (0x0A79F,0x0A79F), `Abs (0x0A79F);
+  (0x0A7A1,0x0A7A1), `Abs (0x0A7A1);
+  (0x0A7A3,0x0A7A3), `Abs (0x0A7A3);
+  (0x0A7A5,0x0A7A5), `Abs (0x0A7A5);
+  (0x0A7A7,0x0A7A7), `Abs (0x0A7A7);
+  (0x0A7A9,0x0A7A9), `Abs (0x0A7A9);
+  (0x0A7B5,0x0A7B5), `Abs (0x0A7B5);
+  (0x0A7B7,0x0A7B7), `Abs (0x0A7B7);
+  (0x0A7FA,0x0A7FA), `Abs (0x0A7FA);
+  (0x0AB30,0x0AB5A), `Delta (0);
+  (0x0AB60,0x0AB65), `Delta (0);
+  (0x0AB70,0x0ABBF), `Delta (0);
+  (0x0FB00,0x0FB06), `Delta (0);
+  (0x0FB13,0x0FB17), `Delta (0);
+  (0x0FF41,0x0FF5A), `Delta (0);
+  (0x10428,0x1044F), `Delta (0);
+  (0x104D8,0x104FB), `Delta (0);
+  (0x10CC0,0x10CF2), `Delta (0);
+  (0x118C0,0x118DF), `Delta (0);
+  (0x1D41A,0x1D433), `Delta (0);
+  (0x1D44E,0x1D454), `Delta (0);
+  (0x1D456,0x1D467), `Delta (0);
+  (0x1D482,0x1D49B), `Delta (0);
+  (0x1D4B6,0x1D4B9), `Delta (0);
+  (0x1D4BB,0x1D4BB), `Abs (0x1D4BB);
+  (0x1D4BD,0x1D4C3), `Delta (0);
+  (0x1D4C5,0x1D4CF), `Delta (0);
+  (0x1D4EA,0x1D503), `Delta (0);
+  (0x1D51E,0x1D537), `Delta (0);
+  (0x1D552,0x1D56B), `Delta (0);
+  (0x1D586,0x1D59F), `Delta (0);
+  (0x1D5BA,0x1D5D3), `Delta (0);
+  (0x1D5EE,0x1D607), `Delta (0);
+  (0x1D622,0x1D63B), `Delta (0);
+  (0x1D656,0x1D66F), `Delta (0);
+  (0x1D68A,0x1D6A5), `Delta (0);
+  (0x1D6C2,0x1D6DA), `Delta (0);
+  (0x1D6DC,0x1D6E1), `Delta (0);
+  (0x1D6FC,0x1D714), `Delta (0);
+  (0x1D716,0x1D71B), `Delta (0);
+  (0x1D736,0x1D74E), `Delta (0);
+  (0x1D750,0x1D755), `Delta (0);
+  (0x1D770,0x1D788), `Delta (0);
+  (0x1D78A,0x1D78F), `Delta (0);
+  (0x1D7AA,0x1D7C2), `Delta (0);
+  (0x1D7C4,0x1D7C9), `Delta (0);
+  (0x1D7CB,0x1D7CB), `Abs (0x1D7CB);
+  (0x1E922,0x1E943), `Delta (0);
+  (0x001C5,0x001C5), `Abs (0x001C6);
+  (0x001C8,0x001C8), `Abs (0x001C9);
+  (0x001CB,0x001CB), `Abs (0x001CC);
+  (0x001F2,0x001F2), `Abs (0x001F3);
+  (0x01F88,0x01F8F), `Delta (-8);
+  (0x01F98,0x01F9F), `Delta (-8);
+  (0x01FA8,0x01FAF), `Delta (-8);
+  (0x01FBC,0x01FBC), `Abs (0x01FB3);
+  (0x01FCC,0x01FCC), `Abs (0x01FC3);
+  (0x01FFC,0x01FFC), `Abs (0x01FF3);
+  (0x00300,0x0036F), `Delta (0);
+  (0x00483,0x00487), `Delta (0);
+  (0x00591,0x005BD), `Delta (0);
+  (0x005BF,0x005BF), `Abs (0x005BF);
+  (0x005C1,0x005C2), `Delta (0);
+  (0x005C4,0x005C5), `Delta (0);
+  (0x005C7,0x005C7), `Abs (0x005C7);
+  (0x00610,0x0061A), `Delta (0);
+  (0x0064B,0x0065F), `Delta (0);
+  (0x00670,0x00670), `Abs (0x00670);
+  (0x006D6,0x006DC), `Delta (0);
+  (0x006DF,0x006E4), `Delta (0);
+  (0x006E7,0x006E8), `Delta (0);
+  (0x006EA,0x006ED), `Delta (0);
+  (0x00711,0x00711), `Abs (0x00711);
+  (0x00730,0x0074A), `Delta (0);
+  (0x007A6,0x007B0), `Delta (0);
+  (0x007EB,0x007F3), `Delta (0);
+  (0x00816,0x00819), `Delta (0);
+  (0x0081B,0x00823), `Delta (0);
+  (0x00825,0x00827), `Delta (0);
+  (0x00829,0x0082D), `Delta (0);
+  (0x00859,0x0085B), `Delta (0);
+  (0x008D4,0x008E1), `Delta (0);
+  (0x008E3,0x00902), `Delta (0);
+  (0x0093A,0x0093A), `Abs (0x0093A);
+  (0x0093C,0x0093C), `Abs (0x0093C);
+  (0x00941,0x00948), `Delta (0);
+  (0x0094D,0x0094D), `Abs (0x0094D);
+  (0x00951,0x00957), `Delta (0);
+  (0x00962,0x00963), `Delta (0);
+  (0x00981,0x00981), `Abs (0x00981);
+  (0x009BC,0x009BC), `Abs (0x009BC);
+  (0x009C1,0x009C4), `Delta (0);
+  (0x009CD,0x009CD), `Abs (0x009CD);
+  (0x009E2,0x009E3), `Delta (0);
+  (0x00A01,0x00A02), `Delta (0);
+  (0x00A3C,0x00A3C), `Abs (0x00A3C);
+  (0x00A41,0x00A42), `Delta (0);
+  (0x00A47,0x00A48), `Delta (0);
+  (0x00A4B,0x00A4D), `Delta (0);
+  (0x00A51,0x00A51), `Abs (0x00A51);
+  (0x00A70,0x00A71), `Delta (0);
+  (0x00A75,0x00A75), `Abs (0x00A75);
+  (0x00A81,0x00A82), `Delta (0);
+  (0x00ABC,0x00ABC), `Abs (0x00ABC);
+  (0x00AC1,0x00AC5), `Delta (0);
+  (0x00AC7,0x00AC8), `Delta (0);
+  (0x00ACD,0x00ACD), `Abs (0x00ACD);
+  (0x00AE2,0x00AE3), `Delta (0);
+  (0x00B01,0x00B01), `Abs (0x00B01);
+  (0x00B3C,0x00B3C), `Abs (0x00B3C);
+  (0x00B3F,0x00B3F), `Abs (0x00B3F);
+  (0x00B41,0x00B44), `Delta (0);
+  (0x00B4D,0x00B4D), `Abs (0x00B4D);
+  (0x00B56,0x00B56), `Abs (0x00B56);
+  (0x00B62,0x00B63), `Delta (0);
+  (0x00B82,0x00B82), `Abs (0x00B82);
+  (0x00BC0,0x00BC0), `Abs (0x00BC0);
+  (0x00BCD,0x00BCD), `Abs (0x00BCD);
+  (0x00C00,0x00C00), `Abs (0x00C00);
+  (0x00C3E,0x00C40), `Delta (0);
+  (0x00C46,0x00C48), `Delta (0);
+  (0x00C4A,0x00C4D), `Delta (0);
+  (0x00C55,0x00C56), `Delta (0);
+  (0x00C62,0x00C63), `Delta (0);
+  (0x00C81,0x00C81), `Abs (0x00C81);
+  (0x00CBC,0x00CBC), `Abs (0x00CBC);
+  (0x00CBF,0x00CBF), `Abs (0x00CBF);
+  (0x00CC6,0x00CC6), `Abs (0x00CC6);
+  (0x00CCC,0x00CCD), `Delta (0);
+  (0x00CE2,0x00CE3), `Delta (0);
+  (0x00D01,0x00D01), `Abs (0x00D01);
+  (0x00D41,0x00D44), `Delta (0);
+  (0x00D4D,0x00D4D), `Abs (0x00D4D);
+  (0x00D62,0x00D63), `Delta (0);
+  (0x00DCA,0x00DCA), `Abs (0x00DCA);
+  (0x00DD2,0x00DD4), `Delta (0);
+  (0x00DD6,0x00DD6), `Abs (0x00DD6);
+  (0x00E31,0x00E31), `Abs (0x00E31);
+  (0x00E34,0x00E3A), `Delta (0);
+  (0x00E47,0x00E4E), `Delta (0);
+  (0x00EB1,0x00EB1), `Abs (0x00EB1);
+  (0x00EB4,0x00EB9), `Delta (0);
+  (0x00EBB,0x00EBC), `Delta (0);
+  (0x00EC8,0x00ECD), `Delta (0);
+  (0x00F18,0x00F19), `Delta (0);
+  (0x00F35,0x00F35), `Abs (0x00F35);
+  (0x00F37,0x00F37), `Abs (0x00F37);
+  (0x00F39,0x00F39), `Abs (0x00F39);
+  (0x00F71,0x00F7E), `Delta (0);
+  (0x00F80,0x00F84), `Delta (0);
+  (0x00F86,0x00F87), `Delta (0);
+  (0x00F8D,0x00F97), `Delta (0);
+  (0x00F99,0x00FBC), `Delta (0);
+  (0x00FC6,0x00FC6), `Abs (0x00FC6);
+  (0x0102D,0x01030), `Delta (0);
+  (0x01032,0x01037), `Delta (0);
+  (0x01039,0x0103A), `Delta (0);
+  (0x0103D,0x0103E), `Delta (0);
+  (0x01058,0x01059), `Delta (0);
+  (0x0105E,0x01060), `Delta (0);
+  (0x01071,0x01074), `Delta (0);
+  (0x01082,0x01082), `Abs (0x01082);
+  (0x01085,0x01086), `Delta (0);
+  (0x0108D,0x0108D), `Abs (0x0108D);
+  (0x0109D,0x0109D), `Abs (0x0109D);
+  (0x0135D,0x0135F), `Delta (0);
+  (0x01712,0x01714), `Delta (0);
+  (0x01732,0x01734), `Delta (0);
+  (0x01752,0x01753), `Delta (0);
+  (0x01772,0x01773), `Delta (0);
+  (0x017B4,0x017B5), `Delta (0);
+  (0x017B7,0x017BD), `Delta (0);
+  (0x017C6,0x017C6), `Abs (0x017C6);
+  (0x017C9,0x017D3), `Delta (0);
+  (0x017DD,0x017DD), `Abs (0x017DD);
+  (0x0180B,0x0180D), `Delta (0);
+  (0x01885,0x01886), `Delta (0);
+  (0x018A9,0x018A9), `Abs (0x018A9);
+  (0x01920,0x01922), `Delta (0);
+  (0x01927,0x01928), `Delta (0);
+  (0x01932,0x01932), `Abs (0x01932);
+  (0x01939,0x0193B), `Delta (0);
+  (0x01A17,0x01A18), `Delta (0);
+  (0x01A1B,0x01A1B), `Abs (0x01A1B);
+  (0x01A56,0x01A56), `Abs (0x01A56);
+  (0x01A58,0x01A5E), `Delta (0);
+  (0x01A60,0x01A60), `Abs (0x01A60);
+  (0x01A62,0x01A62), `Abs (0x01A62);
+  (0x01A65,0x01A6C), `Delta (0);
+  (0x01A73,0x01A7C), `Delta (0);
+  (0x01A7F,0x01A7F), `Abs (0x01A7F);
+  (0x01AB0,0x01ABD), `Delta (0);
+  (0x01B00,0x01B03), `Delta (0);
+  (0x01B34,0x01B34), `Abs (0x01B34);
+  (0x01B36,0x01B3A), `Delta (0);
+  (0x01B3C,0x01B3C), `Abs (0x01B3C);
+  (0x01B42,0x01B42), `Abs (0x01B42);
+  (0x01B6B,0x01B73), `Delta (0);
+  (0x01B80,0x01B81), `Delta (0);
+  (0x01BA2,0x01BA5), `Delta (0);
+  (0x01BA8,0x01BA9), `Delta (0);
+  (0x01BAB,0x01BAD), `Delta (0);
+  (0x01BE6,0x01BE6), `Abs (0x01BE6);
+  (0x01BE8,0x01BE9), `Delta (0);
+  (0x01BED,0x01BED), `Abs (0x01BED);
+  (0x01BEF,0x01BF1), `Delta (0);
+  (0x01C2C,0x01C33), `Delta (0);
+  (0x01C36,0x01C37), `Delta (0);
+  (0x01CD0,0x01CD2), `Delta (0);
+  (0x01CD4,0x01CE0), `Delta (0);
+  (0x01CE2,0x01CE8), `Delta (0);
+  (0x01CED,0x01CED), `Abs (0x01CED);
+  (0x01CF4,0x01CF4), `Abs (0x01CF4);
+  (0x01CF8,0x01CF9), `Delta (0);
+  (0x01DC0,0x01DF5), `Delta (0);
+  (0x01DFB,0x01DFF), `Delta (0);
+  (0x020D0,0x020DC), `Delta (0);
+  (0x020E1,0x020E1), `Abs (0x020E1);
+  (0x020E5,0x020F0), `Delta (0);
+  (0x02CEF,0x02CF1), `Delta (0);
+  (0x02D7F,0x02D7F), `Abs (0x02D7F);
+  (0x02DE0,0x02DFF), `Delta (0);
+  (0x0302A,0x0302D), `Delta (0);
+  (0x03099,0x0309A), `Delta (0);
+  (0x0A66F,0x0A66F), `Abs (0x0A66F);
+  (0x0A674,0x0A67D), `Delta (0);
+  (0x0A69E,0x0A69F), `Delta (0);
+  (0x0A6F0,0x0A6F1), `Delta (0);
+  (0x0A802,0x0A802), `Abs (0x0A802);
+  (0x0A806,0x0A806), `Abs (0x0A806);
+  (0x0A80B,0x0A80B), `Abs (0x0A80B);
+  (0x0A825,0x0A826), `Delta (0);
+  (0x0A8C4,0x0A8C5), `Delta (0);
+  (0x0A8E0,0x0A8F1), `Delta (0);
+  (0x0A926,0x0A92D), `Delta (0);
+  (0x0A947,0x0A951), `Delta (0);
+  (0x0A980,0x0A982), `Delta (0);
+  (0x0A9B3,0x0A9B3), `Abs (0x0A9B3);
+  (0x0A9B6,0x0A9B9), `Delta (0);
+  (0x0A9BC,0x0A9BC), `Abs (0x0A9BC);
+  (0x0A9E5,0x0A9E5), `Abs (0x0A9E5);
+  (0x0AA29,0x0AA2E), `Delta (0);
+  (0x0AA31,0x0AA32), `Delta (0);
+  (0x0AA35,0x0AA36), `Delta (0);
+  (0x0AA43,0x0AA43), `Abs (0x0AA43);
+  (0x0AA4C,0x0AA4C), `Abs (0x0AA4C);
+  (0x0AA7C,0x0AA7C), `Abs (0x0AA7C);
+  (0x0AAB0,0x0AAB0), `Abs (0x0AAB0);
+  (0x0AAB2,0x0AAB4), `Delta (0);
+  (0x0AAB7,0x0AAB8), `Delta (0);
+  (0x0AABE,0x0AABF), `Delta (0);
+  (0x0AAC1,0x0AAC1), `Abs (0x0AAC1);
+  (0x0AAEC,0x0AAED), `Delta (0);
+  (0x0AAF6,0x0AAF6), `Abs (0x0AAF6);
+  (0x0ABE5,0x0ABE5), `Abs (0x0ABE5);
+  (0x0ABE8,0x0ABE8), `Abs (0x0ABE8);
+  (0x0ABED,0x0ABED), `Abs (0x0ABED);
+  (0x0FB1E,0x0FB1E), `Abs (0x0FB1E);
+  (0x0FE00,0x0FE0F), `Delta (0);
+  (0x0FE20,0x0FE2F), `Delta (0);
+  (0x101FD,0x101FD), `Abs (0x101FD);
+  (0x102E0,0x102E0), `Abs (0x102E0);
+  (0x10376,0x1037A), `Delta (0);
+  (0x10A01,0x10A03), `Delta (0);
+  (0x10A05,0x10A06), `Delta (0);
+  (0x10A0C,0x10A0F), `Delta (0);
+  (0x10A38,0x10A3A), `Delta (0);
+  (0x10A3F,0x10A3F), `Abs (0x10A3F);
+  (0x10AE5,0x10AE6), `Delta (0);
+  (0x11001,0x11001), `Abs (0x11001);
+  (0x11038,0x11046), `Delta (0);
+  (0x1107F,0x11081), `Delta (0);
+  (0x110B3,0x110B6), `Delta (0);
+  (0x110B9,0x110BA), `Delta (0);
+  (0x11100,0x11102), `Delta (0);
+  (0x11127,0x1112B), `Delta (0);
+  (0x1112D,0x11134), `Delta (0);
+  (0x11173,0x11173), `Abs (0x11173);
+  (0x11180,0x11181), `Delta (0);
+  (0x111B6,0x111BE), `Delta (0);
+  (0x111CA,0x111CC), `Delta (0);
+  (0x1122F,0x11231), `Delta (0);
+  (0x11234,0x11234), `Abs (0x11234);
+  (0x11236,0x11237), `Delta (0);
+  (0x1123E,0x1123E), `Abs (0x1123E);
+  (0x112DF,0x112DF), `Abs (0x112DF);
+  (0x112E3,0x112EA), `Delta (0);
+  (0x11300,0x11301), `Delta (0);
+  (0x1133C,0x1133C), `Abs (0x1133C);
+  (0x11340,0x11340), `Abs (0x11340);
+  (0x11366,0x1136C), `Delta (0);
+  (0x11370,0x11374), `Delta (0);
+  (0x11438,0x1143F), `Delta (0);
+  (0x11442,0x11444), `Delta (0);
+  (0x11446,0x11446), `Abs (0x11446);
+  (0x114B3,0x114B8), `Delta (0);
+  (0x114BA,0x114BA), `Abs (0x114BA);
+  (0x114BF,0x114C0), `Delta (0);
+  (0x114C2,0x114C3), `Delta (0);
+  (0x115B2,0x115B5), `Delta (0);
+  (0x115BC,0x115BD), `Delta (0);
+  (0x115BF,0x115C0), `Delta (0);
+  (0x115DC,0x115DD), `Delta (0);
+  (0x11633,0x1163A), `Delta (0);
+  (0x1163D,0x1163D), `Abs (0x1163D);
+  (0x1163F,0x11640), `Delta (0);
+  (0x116AB,0x116AB), `Abs (0x116AB);
+  (0x116AD,0x116AD), `Abs (0x116AD);
+  (0x116B0,0x116B5), `Delta (0);
+  (0x116B7,0x116B7), `Abs (0x116B7);
+  (0x1171D,0x1171F), `Delta (0);
+  (0x11722,0x11725), `Delta (0);
+  (0x11727,0x1172B), `Delta (0);
+  (0x11C30,0x11C36), `Delta (0);
+  (0x11C38,0x11C3D), `Delta (0);
+  (0x11C3F,0x11C3F), `Abs (0x11C3F);
+  (0x11C92,0x11CA7), `Delta (0);
+  (0x11CAA,0x11CB0), `Delta (0);
+  (0x11CB2,0x11CB3), `Delta (0);
+  (0x11CB5,0x11CB6), `Delta (0);
+  (0x16AF0,0x16AF4), `Delta (0);
+  (0x16B30,0x16B36), `Delta (0);
+  (0x16F8F,0x16F92), `Delta (0);
+  (0x1BC9D,0x1BC9E), `Delta (0);
+  (0x1D167,0x1D169), `Delta (0);
+  (0x1D17B,0x1D182), `Delta (0);
+  (0x1D185,0x1D18B), `Delta (0);
+  (0x1D1AA,0x1D1AD), `Delta (0);
+  (0x1D242,0x1D244), `Delta (0);
+  (0x1DA00,0x1DA36), `Delta (0);
+  (0x1DA3B,0x1DA6C), `Delta (0);
+  (0x1DA75,0x1DA75), `Abs (0x1DA75);
+  (0x1DA84,0x1DA84), `Abs (0x1DA84);
+  (0x1DA9B,0x1DA9F), `Delta (0);
+  (0x1DAA1,0x1DAAF), `Delta (0);
+  (0x1E000,0x1E006), `Delta (0);
+  (0x1E008,0x1E018), `Delta (0);
+  (0x1E01B,0x1E021), `Delta (0);
+  (0x1E023,0x1E024), `Delta (0);
+  (0x1E026,0x1E02A), `Delta (0);
+  (0x1E8D0,0x1E8D6), `Delta (0);
+  (0x1E944,0x1E94A), `Delta (0);
+  (0xE0100,0xE01EF), `Delta (0);
+  (0x00903,0x00903), `Abs (0x00903);
+  (0x0093B,0x0093B), `Abs (0x0093B);
+  (0x0093E,0x00940), `Delta (0);
+  (0x00949,0x0094C), `Delta (0);
+  (0x0094E,0x0094F), `Delta (0);
+  (0x00982,0x00983), `Delta (0);
+  (0x009BE,0x009C0), `Delta (0);
+  (0x009C7,0x009C8), `Delta (0);
+  (0x009CB,0x009CC), `Delta (0);
+  (0x009D7,0x009D7), `Abs (0x009D7);
+  (0x00A03,0x00A03), `Abs (0x00A03);
+  (0x00A3E,0x00A40), `Delta (0);
+  (0x00A83,0x00A83), `Abs (0x00A83);
+  (0x00ABE,0x00AC0), `Delta (0);
+  (0x00AC9,0x00AC9), `Abs (0x00AC9);
+  (0x00ACB,0x00ACC), `Delta (0);
+  (0x00B02,0x00B03), `Delta (0);
+  (0x00B3E,0x00B3E), `Abs (0x00B3E);
+  (0x00B40,0x00B40), `Abs (0x00B40);
+  (0x00B47,0x00B48), `Delta (0);
+  (0x00B4B,0x00B4C), `Delta (0);
+  (0x00B57,0x00B57), `Abs (0x00B57);
+  (0x00BBE,0x00BBF), `Delta (0);
+  (0x00BC1,0x00BC2), `Delta (0);
+  (0x00BC6,0x00BC8), `Delta (0);
+  (0x00BCA,0x00BCC), `Delta (0);
+  (0x00BD7,0x00BD7), `Abs (0x00BD7);
+  (0x00C01,0x00C03), `Delta (0);
+  (0x00C41,0x00C44), `Delta (0);
+  (0x00C82,0x00C83), `Delta (0);
+  (0x00CBE,0x00CBE), `Abs (0x00CBE);
+  (0x00CC0,0x00CC4), `Delta (0);
+  (0x00CC7,0x00CC8), `Delta (0);
+  (0x00CCA,0x00CCB), `Delta (0);
+  (0x00CD5,0x00CD6), `Delta (0);
+  (0x00D02,0x00D03), `Delta (0);
+  (0x00D3E,0x00D40), `Delta (0);
+  (0x00D46,0x00D48), `Delta (0);
+  (0x00D4A,0x00D4C), `Delta (0);
+  (0x00D57,0x00D57), `Abs (0x00D57);
+  (0x00D82,0x00D83), `Delta (0);
+  (0x00DCF,0x00DD1), `Delta (0);
+  (0x00DD8,0x00DDF), `Delta (0);
+  (0x00DF2,0x00DF3), `Delta (0);
+  (0x00F3E,0x00F3F), `Delta (0);
+  (0x00F7F,0x00F7F), `Abs (0x00F7F);
+  (0x0102B,0x0102C), `Delta (0);
+  (0x01031,0x01031), `Abs (0x01031);
+  (0x01038,0x01038), `Abs (0x01038);
+  (0x0103B,0x0103C), `Delta (0);
+  (0x01056,0x01057), `Delta (0);
+  (0x01062,0x01064), `Delta (0);
+  (0x01067,0x0106D), `Delta (0);
+  (0x01083,0x01084), `Delta (0);
+  (0x01087,0x0108C), `Delta (0);
+  (0x0108F,0x0108F), `Abs (0x0108F);
+  (0x0109A,0x0109C), `Delta (0);
+  (0x017B6,0x017B6), `Abs (0x017B6);
+  (0x017BE,0x017C5), `Delta (0);
+  (0x017C7,0x017C8), `Delta (0);
+  (0x01923,0x01926), `Delta (0);
+  (0x01929,0x0192B), `Delta (0);
+  (0x01930,0x01931), `Delta (0);
+  (0x01933,0x01938), `Delta (0);
+  (0x01A19,0x01A1A), `Delta (0);
+  (0x01A55,0x01A55), `Abs (0x01A55);
+  (0x01A57,0x01A57), `Abs (0x01A57);
+  (0x01A61,0x01A61), `Abs (0x01A61);
+  (0x01A63,0x01A64), `Delta (0);
+  (0x01A6D,0x01A72), `Delta (0);
+  (0x01B04,0x01B04), `Abs (0x01B04);
+  (0x01B35,0x01B35), `Abs (0x01B35);
+  (0x01B3B,0x01B3B), `Abs (0x01B3B);
+  (0x01B3D,0x01B41), `Delta (0);
+  (0x01B43,0x01B44), `Delta (0);
+  (0x01B82,0x01B82), `Abs (0x01B82);
+  (0x01BA1,0x01BA1), `Abs (0x01BA1);
+  (0x01BA6,0x01BA7), `Delta (0);
+  (0x01BAA,0x01BAA), `Abs (0x01BAA);
+  (0x01BE7,0x01BE7), `Abs (0x01BE7);
+  (0x01BEA,0x01BEC), `Delta (0);
+  (0x01BEE,0x01BEE), `Abs (0x01BEE);
+  (0x01BF2,0x01BF3), `Delta (0);
+  (0x01C24,0x01C2B), `Delta (0);
+  (0x01C34,0x01C35), `Delta (0);
+  (0x01CE1,0x01CE1), `Abs (0x01CE1);
+  (0x01CF2,0x01CF3), `Delta (0);
+  (0x0302E,0x0302F), `Delta (0);
+  (0x0A823,0x0A824), `Delta (0);
+  (0x0A827,0x0A827), `Abs (0x0A827);
+  (0x0A880,0x0A881), `Delta (0);
+  (0x0A8B4,0x0A8C3), `Delta (0);
+  (0x0A952,0x0A953), `Delta (0);
+  (0x0A983,0x0A983), `Abs (0x0A983);
+  (0x0A9B4,0x0A9B5), `Delta (0);
+  (0x0A9BA,0x0A9BB), `Delta (0);
+  (0x0A9BD,0x0A9C0), `Delta (0);
+  (0x0AA2F,0x0AA30), `Delta (0);
+  (0x0AA33,0x0AA34), `Delta (0);
+  (0x0AA4D,0x0AA4D), `Abs (0x0AA4D);
+  (0x0AA7B,0x0AA7B), `Abs (0x0AA7B);
+  (0x0AA7D,0x0AA7D), `Abs (0x0AA7D);
+  (0x0AAEB,0x0AAEB), `Abs (0x0AAEB);
+  (0x0AAEE,0x0AAEF), `Delta (0);
+  (0x0AAF5,0x0AAF5), `Abs (0x0AAF5);
+  (0x0ABE3,0x0ABE4), `Delta (0);
+  (0x0ABE6,0x0ABE7), `Delta (0);
+  (0x0ABE9,0x0ABEA), `Delta (0);
+  (0x0ABEC,0x0ABEC), `Abs (0x0ABEC);
+  (0x11000,0x11000), `Abs (0x11000);
+  (0x11002,0x11002), `Abs (0x11002);
+  (0x11082,0x11082), `Abs (0x11082);
+  (0x110B0,0x110B2), `Delta (0);
+  (0x110B7,0x110B8), `Delta (0);
+  (0x1112C,0x1112C), `Abs (0x1112C);
+  (0x11182,0x11182), `Abs (0x11182);
+  (0x111B3,0x111B5), `Delta (0);
+  (0x111BF,0x111C0), `Delta (0);
+  (0x1122C,0x1122E), `Delta (0);
+  (0x11232,0x11233), `Delta (0);
+  (0x11235,0x11235), `Abs (0x11235);
+  (0x112E0,0x112E2), `Delta (0);
+  (0x11302,0x11303), `Delta (0);
+  (0x1133E,0x1133F), `Delta (0);
+  (0x11341,0x11344), `Delta (0);
+  (0x11347,0x11348), `Delta (0);
+  (0x1134B,0x1134D), `Delta (0);
+  (0x11357,0x11357), `Abs (0x11357);
+  (0x11362,0x11363), `Delta (0);
+  (0x11435,0x11437), `Delta (0);
+  (0x11440,0x11441), `Delta (0);
+  (0x11445,0x11445), `Abs (0x11445);
+  (0x114B0,0x114B2), `Delta (0);
+  (0x114B9,0x114B9), `Abs (0x114B9);
+  (0x114BB,0x114BE), `Delta (0);
+  (0x114C1,0x114C1), `Abs (0x114C1);
+  (0x115AF,0x115B1), `Delta (0);
+  (0x115B8,0x115BB), `Delta (0);
+  (0x115BE,0x115BE), `Abs (0x115BE);
+  (0x11630,0x11632), `Delta (0);
+  (0x1163B,0x1163C), `Delta (0);
+  (0x1163E,0x1163E), `Abs (0x1163E);
+  (0x116AC,0x116AC), `Abs (0x116AC);
+  (0x116AE,0x116AF), `Delta (0);
+  (0x116B6,0x116B6), `Abs (0x116B6);
+  (0x11720,0x11721), `Delta (0);
+  (0x11726,0x11726), `Abs (0x11726);
+  (0x11C2F,0x11C2F), `Abs (0x11C2F);
+  (0x11C3E,0x11C3E), `Abs (0x11C3E);
+  (0x11CA9,0x11CA9), `Abs (0x11CA9);
+  (0x11CB1,0x11CB1), `Abs (0x11CB1);
+  (0x11CB4,0x11CB4), `Abs (0x11CB4);
+  (0x16F51,0x16F7E), `Delta (0);
+  (0x1D165,0x1D166), `Delta (0);
+  (0x1D16D,0x1D172), `Delta (0);
+  (0x00488,0x00489), `Delta (0);
+  (0x01ABE,0x01ABE), `Abs (0x01ABE);
+  (0x020DD,0x020E0), `Delta (0);
+  (0x020E2,0x020E4), `Delta (0);
+  (0x0A670,0x0A672), `Delta (0);
+  (0x00030,0x00039), `Delta (0);
+  (0x00660,0x00669), `Delta (0);
+  (0x006F0,0x006F9), `Delta (0);
+  (0x007C0,0x007C9), `Delta (0);
+  (0x00966,0x0096F), `Delta (0);
+  (0x009E6,0x009EF), `Delta (0);
+  (0x00A66,0x00A6F), `Delta (0);
+  (0x00AE6,0x00AEF), `Delta (0);
+  (0x00B66,0x00B6F), `Delta (0);
+  (0x00BE6,0x00BEF), `Delta (0);
+  (0x00C66,0x00C6F), `Delta (0);
+  (0x00CE6,0x00CEF), `Delta (0);
+  (0x00D66,0x00D6F), `Delta (0);
+  (0x00DE6,0x00DEF), `Delta (0);
+  (0x00E50,0x00E59), `Delta (0);
+  (0x00ED0,0x00ED9), `Delta (0);
+  (0x00F20,0x00F29), `Delta (0);
+  (0x01040,0x01049), `Delta (0);
+  (0x01090,0x01099), `Delta (0);
+  (0x017E0,0x017E9), `Delta (0);
+  (0x01810,0x01819), `Delta (0);
+  (0x01946,0x0194F), `Delta (0);
+  (0x019D0,0x019D9), `Delta (0);
+  (0x01A80,0x01A89), `Delta (0);
+  (0x01A90,0x01A99), `Delta (0);
+  (0x01B50,0x01B59), `Delta (0);
+  (0x01BB0,0x01BB9), `Delta (0);
+  (0x01C40,0x01C49), `Delta (0);
+  (0x01C50,0x01C59), `Delta (0);
+  (0x0A620,0x0A629), `Delta (0);
+  (0x0A8D0,0x0A8D9), `Delta (0);
+  (0x0A900,0x0A909), `Delta (0);
+  (0x0A9D0,0x0A9D9), `Delta (0);
+  (0x0A9F0,0x0A9F9), `Delta (0);
+  (0x0AA50,0x0AA59), `Delta (0);
+  (0x0ABF0,0x0ABF9), `Delta (0);
+  (0x0FF10,0x0FF19), `Delta (0);
+  (0x104A0,0x104A9), `Delta (0);
+  (0x11066,0x1106F), `Delta (0);
+  (0x110F0,0x110F9), `Delta (0);
+  (0x11136,0x1113F), `Delta (0);
+  (0x111D0,0x111D9), `Delta (0);
+  (0x112F0,0x112F9), `Delta (0);
+  (0x11450,0x11459), `Delta (0);
+  (0x114D0,0x114D9), `Delta (0);
+  (0x11650,0x11659), `Delta (0);
+  (0x116C0,0x116C9), `Delta (0);
+  (0x11730,0x11739), `Delta (0);
+  (0x118E0,0x118E9), `Delta (0);
+  (0x11C50,0x11C59), `Delta (0);
+  (0x16A60,0x16A69), `Delta (0);
+  (0x16B50,0x16B59), `Delta (0);
+  (0x1D7CE,0x1D7FF), `Delta (0);
+  (0x1E950,0x1E959), `Delta (0);
+  (0x016EE,0x016F0), `Delta (0);
+  (0x02160,0x0216F), `Delta (16);
+  (0x02170,0x02182), `Delta (0);
+  (0x02185,0x02188), `Delta (0);
+  (0x03007,0x03007), `Abs (0x03007);
+  (0x03021,0x03029), `Delta (0);
+  (0x03038,0x0303A), `Delta (0);
+  (0x0A6E6,0x0A6EF), `Delta (0);
+  (0x10140,0x10174), `Delta (0);
+  (0x10341,0x10341), `Abs (0x10341);
+  (0x1034A,0x1034A), `Abs (0x1034A);
+  (0x103D1,0x103D5), `Delta (0);
+  (0x12400,0x1246E), `Delta (0);
+  (0x000B2,0x000B3), `Delta (0);
+  (0x000B9,0x000B9), `Abs (0x000B9);
+  (0x000BC,0x000BE), `Delta (0);
+  (0x009F4,0x009F9), `Delta (0);
+  (0x00B72,0x00B77), `Delta (0);
+  (0x00BF0,0x00BF2), `Delta (0);
+  (0x00C78,0x00C7E), `Delta (0);
+  (0x00D58,0x00D5E), `Delta (0);
+  (0x00D70,0x00D78), `Delta (0);
+  (0x00F2A,0x00F33), `Delta (0);
+  (0x01369,0x0137C), `Delta (0);
+  (0x017F0,0x017F9), `Delta (0);
+  (0x019DA,0x019DA), `Abs (0x019DA);
+  (0x02070,0x02070), `Abs (0x02070);
+  (0x02074,0x02079), `Delta (0);
+  (0x02080,0x02089), `Delta (0);
+  (0x02150,0x0215F), `Delta (0);
+  (0x02189,0x02189), `Abs (0x02189);
+  (0x02460,0x0249B), `Delta (0);
+  (0x024EA,0x024FF), `Delta (0);
+  (0x02776,0x02793), `Delta (0);
+  (0x02CFD,0x02CFD), `Abs (0x02CFD);
+  (0x03192,0x03195), `Delta (0);
+  (0x03220,0x03229), `Delta (0);
+  (0x03248,0x0324F), `Delta (0);
+  (0x03251,0x0325F), `Delta (0);
+  (0x03280,0x03289), `Delta (0);
+  (0x032B1,0x032BF), `Delta (0);
+  (0x0A830,0x0A835), `Delta (0);
+  (0x10107,0x10133), `Delta (0);
+  (0x10175,0x10178), `Delta (0);
+  (0x1018A,0x1018B), `Delta (0);
+  (0x102E1,0x102FB), `Delta (0);
+  (0x10320,0x10323), `Delta (0);
+  (0x10858,0x1085F), `Delta (0);
+  (0x10879,0x1087F), `Delta (0);
+  (0x108A7,0x108AF), `Delta (0);
+  (0x108FB,0x108FF), `Delta (0);
+  (0x10916,0x1091B), `Delta (0);
+  (0x109BC,0x109BD), `Delta (0);
+  (0x109C0,0x109CF), `Delta (0);
+  (0x109D2,0x109FF), `Delta (0);
+  (0x10A40,0x10A47), `Delta (0);
+  (0x10A7D,0x10A7E), `Delta (0);
+  (0x10A9D,0x10A9F), `Delta (0);
+  (0x10AEB,0x10AEF), `Delta (0);
+  (0x10B58,0x10B5F), `Delta (0);
+  (0x10B78,0x10B7F), `Delta (0);
+  (0x10BA9,0x10BAF), `Delta (0);
+  (0x10CFA,0x10CFF), `Delta (0);
+  (0x10E60,0x10E7E), `Delta (0);
+  (0x11052,0x11065), `Delta (0);
+  (0x111E1,0x111F4), `Delta (0);
+  (0x1173A,0x1173B), `Delta (0);
+  (0x118EA,0x118F2), `Delta (0);
+  (0x11C5A,0x11C6C), `Delta (0);
+  (0x16B5B,0x16B61), `Delta (0);
+  (0x1D360,0x1D371), `Delta (0);
+  (0x1E8C7,0x1E8CF), `Delta (0);
+  (0x1F100,0x1F10C), `Delta (0);
+  (0x00020,0x00020), `Abs (0x00020);
+  (0x000A0,0x000A0), `Abs (0x000A0);
+  (0x01680,0x01680), `Abs (0x01680);
+  (0x02000,0x0200A), `Delta (0);
+  (0x0202F,0x0202F), `Abs (0x0202F);
+  (0x0205F,0x0205F), `Abs (0x0205F);
+  (0x03000,0x03000), `Abs (0x03000);
+  (0x02028,0x02029), `Delta (0);
+  (0x00001,0x0001F), `Delta (0);
+  (0x0007F,0x0009F), `Delta (0);
+  (0x000AD,0x000AD), `Abs (0x000AD);
+  (0x00600,0x00605), `Delta (0);
+  (0x0061C,0x0061C), `Abs (0x0061C);
+  (0x006DD,0x006DD), `Abs (0x006DD);
+  (0x0070F,0x0070F), `Abs (0x0070F);
+  (0x008E2,0x008E2), `Abs (0x008E2);
+  (0x0180E,0x0180E), `Abs (0x0180E);
+  (0x0200B,0x0200F), `Delta (0);
+  (0x0202A,0x0202E), `Delta (0);
+  (0x02060,0x02064), `Delta (0);
+  (0x02066,0x0206F), `Delta (0);
+  (0x0FEFF,0x0FEFF), `Abs (0x0FEFF);
+  (0x0FFF9,0x0FFFB), `Delta (0);
+  (0x110BD,0x110BD), `Abs (0x110BD);
+  (0x1BCA0,0x1BCA3), `Delta (0);
+  (0x1D173,0x1D17A), `Delta (0);
+  (0xE0001,0xE0001), `Abs (0xE0001);
+  (0xE0020,0xE007F), `Delta (0);
+  (0x0D800,0x0F8FF), `Delta (0);
+  (0xF0000,0xFFFFD), `Delta (0);
+  (0x100000,0x10FFFD), `Delta (0);
+  (0x00378,0x00379), `Delta (0);
+  (0x00380,0x00383), `Delta (0);
+  (0x0038B,0x0038B), `Abs (0x0038B);
+  (0x0038D,0x0038D), `Abs (0x0038D);
+  (0x003A2,0x003A2), `Abs (0x003A2);
+  (0x00530,0x00530), `Abs (0x00530);
+  (0x00557,0x00558), `Delta (0);
+  (0x00560,0x00560), `Abs (0x00560);
+  (0x00588,0x00588), `Abs (0x00588);
+  (0x0058B,0x0058C), `Delta (0);
+  (0x00590,0x00590), `Abs (0x00590);
+  (0x005C8,0x005CF), `Delta (0);
+  (0x005EB,0x005EF), `Delta (0);
+  (0x005F5,0x005FF), `Delta (0);
+  (0x0061D,0x0061D), `Abs (0x0061D);
+  (0x0070E,0x0070E), `Abs (0x0070E);
+  (0x0074B,0x0074C), `Delta (0);
+  (0x007B2,0x007BF), `Delta (0);
+  (0x007FB,0x007FF), `Delta (0);
+  (0x0082E,0x0082F), `Delta (0);
+  (0x0083F,0x0083F), `Abs (0x0083F);
+  (0x0085C,0x0085D), `Delta (0);
+  (0x0085F,0x0089F), `Delta (0);
+  (0x008B5,0x008B5), `Abs (0x008B5);
+  (0x008BE,0x008D3), `Delta (0);
+  (0x00984,0x00984), `Abs (0x00984);
+  (0x0098D,0x0098E), `Delta (0);
+  (0x00991,0x00992), `Delta (0);
+  (0x009A9,0x009A9), `Abs (0x009A9);
+  (0x009B1,0x009B1), `Abs (0x009B1);
+  (0x009B3,0x009B5), `Delta (0);
+  (0x009BA,0x009BB), `Delta (0);
+  (0x009C5,0x009C6), `Delta (0);
+  (0x009C9,0x009CA), `Delta (0);
+  (0x009CF,0x009D6), `Delta (0);
+  (0x009D8,0x009DB), `Delta (0);
+  (0x009DE,0x009DE), `Abs (0x009DE);
+  (0x009E4,0x009E5), `Delta (0);
+  (0x009FC,0x00A00), `Delta (0);
+  (0x00A04,0x00A04), `Abs (0x00A04);
+  (0x00A0B,0x00A0E), `Delta (0);
+  (0x00A11,0x00A12), `Delta (0);
+  (0x00A29,0x00A29), `Abs (0x00A29);
+  (0x00A31,0x00A31), `Abs (0x00A31);
+  (0x00A34,0x00A34), `Abs (0x00A34);
+  (0x00A37,0x00A37), `Abs (0x00A37);
+  (0x00A3A,0x00A3B), `Delta (0);
+  (0x00A3D,0x00A3D), `Abs (0x00A3D);
+  (0x00A43,0x00A46), `Delta (0);
+  (0x00A49,0x00A4A), `Delta (0);
+  (0x00A4E,0x00A50), `Delta (0);
+  (0x00A52,0x00A58), `Delta (0);
+  (0x00A5D,0x00A5D), `Abs (0x00A5D);
+  (0x00A5F,0x00A65), `Delta (0);
+  (0x00A76,0x00A80), `Delta (0);
+  (0x00A84,0x00A84), `Abs (0x00A84);
+  (0x00A8E,0x00A8E), `Abs (0x00A8E);
+  (0x00A92,0x00A92), `Abs (0x00A92);
+  (0x00AA9,0x00AA9), `Abs (0x00AA9);
+  (0x00AB1,0x00AB1), `Abs (0x00AB1);
+  (0x00AB4,0x00AB4), `Abs (0x00AB4);
+  (0x00ABA,0x00ABB), `Delta (0);
+  (0x00AC6,0x00AC6), `Abs (0x00AC6);
+  (0x00ACA,0x00ACA), `Abs (0x00ACA);
+  (0x00ACE,0x00ACF), `Delta (0);
+  (0x00AD1,0x00ADF), `Delta (0);
+  (0x00AE4,0x00AE5), `Delta (0);
+  (0x00AF2,0x00AF8), `Delta (0);
+  (0x00AFA,0x00B00), `Delta (0);
+  (0x00B04,0x00B04), `Abs (0x00B04);
+  (0x00B0D,0x00B0E), `Delta (0);
+  (0x00B11,0x00B12), `Delta (0);
+  (0x00B29,0x00B29), `Abs (0x00B29);
+  (0x00B31,0x00B31), `Abs (0x00B31);
+  (0x00B34,0x00B34), `Abs (0x00B34);
+  (0x00B3A,0x00B3B), `Delta (0);
+  (0x00B45,0x00B46), `Delta (0);
+  (0x00B49,0x00B4A), `Delta (0);
+  (0x00B4E,0x00B55), `Delta (0);
+  (0x00B58,0x00B5B), `Delta (0);
+  (0x00B5E,0x00B5E), `Abs (0x00B5E);
+  (0x00B64,0x00B65), `Delta (0);
+  (0x00B78,0x00B81), `Delta (0);
+  (0x00B84,0x00B84), `Abs (0x00B84);
+  (0x00B8B,0x00B8D), `Delta (0);
+  (0x00B91,0x00B91), `Abs (0x00B91);
+  (0x00B96,0x00B98), `Delta (0);
+  (0x00B9B,0x00B9B), `Abs (0x00B9B);
+  (0x00B9D,0x00B9D), `Abs (0x00B9D);
+  (0x00BA0,0x00BA2), `Delta (0);
+  (0x00BA5,0x00BA7), `Delta (0);
+  (0x00BAB,0x00BAD), `Delta (0);
+  (0x00BBA,0x00BBD), `Delta (0);
+  (0x00BC3,0x00BC5), `Delta (0);
+  (0x00BC9,0x00BC9), `Abs (0x00BC9);
+  (0x00BCE,0x00BCF), `Delta (0);
+  (0x00BD1,0x00BD6), `Delta (0);
+  (0x00BD8,0x00BE5), `Delta (0);
+  (0x00BFB,0x00BFF), `Delta (0);
+  (0x00C04,0x00C04), `Abs (0x00C04);
+  (0x00C0D,0x00C0D), `Abs (0x00C0D);
+  (0x00C11,0x00C11), `Abs (0x00C11);
+  (0x00C29,0x00C29), `Abs (0x00C29);
+  (0x00C3A,0x00C3C), `Delta (0);
+  (0x00C45,0x00C45), `Abs (0x00C45);
+  (0x00C49,0x00C49), `Abs (0x00C49);
+  (0x00C4E,0x00C54), `Delta (0);
+  (0x00C57,0x00C57), `Abs (0x00C57);
+  (0x00C5B,0x00C5F), `Delta (0);
+  (0x00C64,0x00C65), `Delta (0);
+  (0x00C70,0x00C77), `Delta (0);
+  (0x00C84,0x00C84), `Abs (0x00C84);
+  (0x00C8D,0x00C8D), `Abs (0x00C8D);
+  (0x00C91,0x00C91), `Abs (0x00C91);
+  (0x00CA9,0x00CA9), `Abs (0x00CA9);
+  (0x00CB4,0x00CB4), `Abs (0x00CB4);
+  (0x00CBA,0x00CBB), `Delta (0);
+  (0x00CC5,0x00CC5), `Abs (0x00CC5);
+  (0x00CC9,0x00CC9), `Abs (0x00CC9);
+  (0x00CCE,0x00CD4), `Delta (0);
+  (0x00CD7,0x00CDD), `Delta (0);
+  (0x00CDF,0x00CDF), `Abs (0x00CDF);
+  (0x00CE4,0x00CE5), `Delta (0);
+  (0x00CF0,0x00CF0), `Abs (0x00CF0);
+  (0x00CF3,0x00D00), `Delta (0);
+  (0x00D04,0x00D04), `Abs (0x00D04);
+  (0x00D0D,0x00D0D), `Abs (0x00D0D);
+  (0x00D11,0x00D11), `Abs (0x00D11);
+  (0x00D3B,0x00D3C), `Delta (0);
+  (0x00D45,0x00D45), `Abs (0x00D45);
+  (0x00D49,0x00D49), `Abs (0x00D49);
+  (0x00D50,0x00D53), `Delta (0);
+  (0x00D64,0x00D65), `Delta (0);
+  (0x00D80,0x00D81), `Delta (0);
+  (0x00D84,0x00D84), `Abs (0x00D84);
+  (0x00D97,0x00D99), `Delta (0);
+  (0x00DB2,0x00DB2), `Abs (0x00DB2);
+  (0x00DBC,0x00DBC), `Abs (0x00DBC);
+  (0x00DBE,0x00DBF), `Delta (0);
+  (0x00DC7,0x00DC9), `Delta (0);
+  (0x00DCB,0x00DCE), `Delta (0);
+  (0x00DD5,0x00DD5), `Abs (0x00DD5);
+  (0x00DD7,0x00DD7), `Abs (0x00DD7);
+  (0x00DE0,0x00DE5), `Delta (0);
+  (0x00DF0,0x00DF1), `Delta (0);
+  (0x00DF5,0x00E00), `Delta (0);
+  (0x00E3B,0x00E3E), `Delta (0);
+  (0x00E5C,0x00E80), `Delta (0);
+  (0x00E83,0x00E83), `Abs (0x00E83);
+  (0x00E85,0x00E86), `Delta (0);
+  (0x00E89,0x00E89), `Abs (0x00E89);
+  (0x00E8B,0x00E8C), `Delta (0);
+  (0x00E8E,0x00E93), `Delta (0);
+  (0x00E98,0x00E98), `Abs (0x00E98);
+  (0x00EA0,0x00EA0), `Abs (0x00EA0);
+  (0x00EA4,0x00EA4), `Abs (0x00EA4);
+  (0x00EA6,0x00EA6), `Abs (0x00EA6);
+  (0x00EA8,0x00EA9), `Delta (0);
+  (0x00EAC,0x00EAC), `Abs (0x00EAC);
+  (0x00EBA,0x00EBA), `Abs (0x00EBA);
+  (0x00EBE,0x00EBF), `Delta (0);
+  (0x00EC5,0x00EC5), `Abs (0x00EC5);
+  (0x00EC7,0x00EC7), `Abs (0x00EC7);
+  (0x00ECE,0x00ECF), `Delta (0);
+  (0x00EDA,0x00EDB), `Delta (0);
+  (0x00EE0,0x00EFF), `Delta (0);
+  (0x00F48,0x00F48), `Abs (0x00F48);
+  (0x00F6D,0x00F70), `Delta (0);
+  (0x00F98,0x00F98), `Abs (0x00F98);
+  (0x00FBD,0x00FBD), `Abs (0x00FBD);
+  (0x00FCD,0x00FCD), `Abs (0x00FCD);
+  (0x00FDB,0x00FFF), `Delta (0);
+  (0x010C6,0x010C6), `Abs (0x010C6);
+  (0x010C8,0x010CC), `Delta (0);
+  (0x010CE,0x010CF), `Delta (0);
+  (0x01249,0x01249), `Abs (0x01249);
+  (0x0124E,0x0124F), `Delta (0);
+  (0x01257,0x01257), `Abs (0x01257);
+  (0x01259,0x01259), `Abs (0x01259);
+  (0x0125E,0x0125F), `Delta (0);
+  (0x01289,0x01289), `Abs (0x01289);
+  (0x0128E,0x0128F), `Delta (0);
+  (0x012B1,0x012B1), `Abs (0x012B1);
+  (0x012B6,0x012B7), `Delta (0);
+  (0x012BF,0x012BF), `Abs (0x012BF);
+  (0x012C1,0x012C1), `Abs (0x012C1);
+  (0x012C6,0x012C7), `Delta (0);
+  (0x012D7,0x012D7), `Abs (0x012D7);
+  (0x01311,0x01311), `Abs (0x01311);
+  (0x01316,0x01317), `Delta (0);
+  (0x0135B,0x0135C), `Delta (0);
+  (0x0137D,0x0137F), `Delta (0);
+  (0x0139A,0x0139F), `Delta (0);
+  (0x013F6,0x013F7), `Delta (0);
+  (0x013FE,0x013FF), `Delta (0);
+  (0x0169D,0x0169F), `Delta (0);
+  (0x016F9,0x016FF), `Delta (0);
+  (0x0170D,0x0170D), `Abs (0x0170D);
+  (0x01715,0x0171F), `Delta (0);
+  (0x01737,0x0173F), `Delta (0);
+  (0x01754,0x0175F), `Delta (0);
+  (0x0176D,0x0176D), `Abs (0x0176D);
+  (0x01771,0x01771), `Abs (0x01771);
+  (0x01774,0x0177F), `Delta (0);
+  (0x017DE,0x017DF), `Delta (0);
+  (0x017EA,0x017EF), `Delta (0);
+  (0x017FA,0x017FF), `Delta (0);
+  (0x0180F,0x0180F), `Abs (0x0180F);
+  (0x0181A,0x0181F), `Delta (0);
+  (0x01878,0x0187F), `Delta (0);
+  (0x018AB,0x018AF), `Delta (0);
+  (0x018F6,0x018FF), `Delta (0);
+  (0x0191F,0x0191F), `Abs (0x0191F);
+  (0x0192C,0x0192F), `Delta (0);
+  (0x0193C,0x0193F), `Delta (0);
+  (0x01941,0x01943), `Delta (0);
+  (0x0196E,0x0196F), `Delta (0);
+  (0x01975,0x0197F), `Delta (0);
+  (0x019AC,0x019AF), `Delta (0);
+  (0x019CA,0x019CF), `Delta (0);
+  (0x019DB,0x019DD), `Delta (0);
+  (0x01A1C,0x01A1D), `Delta (0);
+  (0x01A5F,0x01A5F), `Abs (0x01A5F);
+  (0x01A7D,0x01A7E), `Delta (0);
+  (0x01A8A,0x01A8F), `Delta (0);
+  (0x01A9A,0x01A9F), `Delta (0);
+  (0x01AAE,0x01AAF), `Delta (0);
+  (0x01ABF,0x01AFF), `Delta (0);
+  (0x01B4C,0x01B4F), `Delta (0);
+  (0x01B7D,0x01B7F), `Delta (0);
+  (0x01BF4,0x01BFB), `Delta (0);
+  (0x01C38,0x01C3A), `Delta (0);
+  (0x01C4A,0x01C4C), `Delta (0);
+  (0x01C89,0x01CBF), `Delta (0);
+  (0x01CC8,0x01CCF), `Delta (0);
+  (0x01CF7,0x01CF7), `Abs (0x01CF7);
+  (0x01CFA,0x01CFF), `Delta (0);
+  (0x01DF6,0x01DFA), `Delta (0);
+  (0x01F16,0x01F17), `Delta (0);
+  (0x01F1E,0x01F1F), `Delta (0);
+  (0x01F46,0x01F47), `Delta (0);
+  (0x01F4E,0x01F4F), `Delta (0);
+  (0x01F58,0x01F58), `Abs (0x01F58);
+  (0x01F5A,0x01F5A), `Abs (0x01F5A);
+  (0x01F5C,0x01F5C), `Abs (0x01F5C);
+  (0x01F5E,0x01F5E), `Abs (0x01F5E);
+  (0x01F7E,0x01F7F), `Delta (0);
+  (0x01FB5,0x01FB5), `Abs (0x01FB5);
+  (0x01FC5,0x01FC5), `Abs (0x01FC5);
+  (0x01FD4,0x01FD5), `Delta (0);
+  (0x01FDC,0x01FDC), `Abs (0x01FDC);
+  (0x01FF0,0x01FF1), `Delta (0);
+  (0x01FF5,0x01FF5), `Abs (0x01FF5);
+  (0x01FFF,0x01FFF), `Abs (0x01FFF);
+  (0x02065,0x02065), `Abs (0x02065);
+  (0x02072,0x02073), `Delta (0);
+  (0x0208F,0x0208F), `Abs (0x0208F);
+  (0x0209D,0x0209F), `Delta (0);
+  (0x020BF,0x020CF), `Delta (0);
+  (0x020F1,0x020FF), `Delta (0);
+  (0x0218C,0x0218F), `Delta (0);
+  (0x023FF,0x023FF), `Abs (0x023FF);
+  (0x02427,0x0243F), `Delta (0);
+  (0x0244B,0x0245F), `Delta (0);
+  (0x02B74,0x02B75), `Delta (0);
+  (0x02B96,0x02B97), `Delta (0);
+  (0x02BBA,0x02BBC), `Delta (0);
+  (0x02BC9,0x02BC9), `Abs (0x02BC9);
+  (0x02BD2,0x02BEB), `Delta (0);
+  (0x02BF0,0x02BFF), `Delta (0);
+  (0x02C2F,0x02C2F), `Abs (0x02C2F);
+  (0x02C5F,0x02C5F), `Abs (0x02C5F);
+  (0x02CF4,0x02CF8), `Delta (0);
+  (0x02D26,0x02D26), `Abs (0x02D26);
+  (0x02D28,0x02D2C), `Delta (0);
+  (0x02D2E,0x02D2F), `Delta (0);
+  (0x02D68,0x02D6E), `Delta (0);
+  (0x02D71,0x02D7E), `Delta (0);
+  (0x02D97,0x02D9F), `Delta (0);
+  (0x02DA7,0x02DA7), `Abs (0x02DA7);
+  (0x02DAF,0x02DAF), `Abs (0x02DAF);
+  (0x02DB7,0x02DB7), `Abs (0x02DB7);
+  (0x02DBF,0x02DBF), `Abs (0x02DBF);
+  (0x02DC7,0x02DC7), `Abs (0x02DC7);
+  (0x02DCF,0x02DCF), `Abs (0x02DCF);
+  (0x02DD7,0x02DD7), `Abs (0x02DD7);
+  (0x02DDF,0x02DDF), `Abs (0x02DDF);
+  (0x02E45,0x02E7F), `Delta (0);
+  (0x02E9A,0x02E9A), `Abs (0x02E9A);
+  (0x02EF4,0x02EFF), `Delta (0);
+  (0x02FD6,0x02FEF), `Delta (0);
+  (0x02FFC,0x02FFF), `Delta (0);
+  (0x03040,0x03040), `Abs (0x03040);
+  (0x03097,0x03098), `Delta (0);
+  (0x03100,0x03104), `Delta (0);
+  (0x0312E,0x03130), `Delta (0);
+  (0x0318F,0x0318F), `Abs (0x0318F);
+  (0x031BB,0x031BF), `Delta (0);
+  (0x031E4,0x031EF), `Delta (0);
+  (0x0321F,0x0321F), `Abs (0x0321F);
+  (0x032FF,0x032FF), `Abs (0x032FF);
+  (0x04DB6,0x04DBF), `Delta (0);
+  (0x09FD6,0x09FFF), `Delta (0);
+  (0x0A48D,0x0A48F), `Delta (0);
+  (0x0A4C7,0x0A4CF), `Delta (0);
+  (0x0A62C,0x0A63F), `Delta (0);
+  (0x0A6F8,0x0A6FF), `Delta (0);
+  (0x0A7AF,0x0A7AF), `Abs (0x0A7AF);
+  (0x0A7B8,0x0A7F6), `Delta (0);
+  (0x0A82C,0x0A82F), `Delta (0);
+  (0x0A83A,0x0A83F), `Delta (0);
+  (0x0A878,0x0A87F), `Delta (0);
+  (0x0A8C6,0x0A8CD), `Delta (0);
+  (0x0A8DA,0x0A8DF), `Delta (0);
+  (0x0A8FE,0x0A8FF), `Delta (0);
+  (0x0A954,0x0A95E), `Delta (0);
+  (0x0A97D,0x0A97F), `Delta (0);
+  (0x0A9CE,0x0A9CE), `Abs (0x0A9CE);
+  (0x0A9DA,0x0A9DD), `Delta (0);
+  (0x0A9FF,0x0A9FF), `Abs (0x0A9FF);
+  (0x0AA37,0x0AA3F), `Delta (0);
+  (0x0AA4E,0x0AA4F), `Delta (0);
+  (0x0AA5A,0x0AA5B), `Delta (0);
+  (0x0AAC3,0x0AADA), `Delta (0);
+  (0x0AAF7,0x0AB00), `Delta (0);
+  (0x0AB07,0x0AB08), `Delta (0);
+  (0x0AB0F,0x0AB10), `Delta (0);
+  (0x0AB17,0x0AB1F), `Delta (0);
+  (0x0AB27,0x0AB27), `Abs (0x0AB27);
+  (0x0AB2F,0x0AB2F), `Abs (0x0AB2F);
+  (0x0AB66,0x0AB6F), `Delta (0);
+  (0x0ABEE,0x0ABEF), `Delta (0);
+  (0x0ABFA,0x0ABFF), `Delta (0);
+  (0x0D7A4,0x0D7AF), `Delta (0);
+  (0x0D7C7,0x0D7CA), `Delta (0);
+  (0x0D7FC,0x0D7FF), `Delta (0);
+  (0x0FA6E,0x0FA6F), `Delta (0);
+  (0x0FADA,0x0FAFF), `Delta (0);
+  (0x0FB07,0x0FB12), `Delta (0);
+  (0x0FB18,0x0FB1C), `Delta (0);
+  (0x0FB37,0x0FB37), `Abs (0x0FB37);
+  (0x0FB3D,0x0FB3D), `Abs (0x0FB3D);
+  (0x0FB3F,0x0FB3F), `Abs (0x0FB3F);
+  (0x0FB42,0x0FB42), `Abs (0x0FB42);
+  (0x0FB45,0x0FB45), `Abs (0x0FB45);
+  (0x0FBC2,0x0FBD2), `Delta (0);
+  (0x0FD40,0x0FD4F), `Delta (0);
+  (0x0FD90,0x0FD91), `Delta (0);
+  (0x0FDC8,0x0FDEF), `Delta (0);
+  (0x0FDFE,0x0FDFF), `Delta (0);
+  (0x0FE1A,0x0FE1F), `Delta (0);
+  (0x0FE53,0x0FE53), `Abs (0x0FE53);
+  (0x0FE67,0x0FE67), `Abs (0x0FE67);
+  (0x0FE6C,0x0FE6F), `Delta (0);
+  (0x0FE75,0x0FE75), `Abs (0x0FE75);
+  (0x0FEFD,0x0FEFE), `Delta (0);
+  (0x0FF00,0x0FF00), `Abs (0x0FF00);
+  (0x0FFBF,0x0FFC1), `Delta (0);
+  (0x0FFC8,0x0FFC9), `Delta (0);
+  (0x0FFD0,0x0FFD1), `Delta (0);
+  (0x0FFD8,0x0FFD9), `Delta (0);
+  (0x0FFDD,0x0FFDF), `Delta (0);
+  (0x0FFE7,0x0FFE7), `Abs (0x0FFE7);
+  (0x0FFEF,0x0FFF8), `Delta (0);
+  (0x0FFFE,0x0FFFF), `Delta (0);
+  (0x1000C,0x1000C), `Abs (0x1000C);
+  (0x10027,0x10027), `Abs (0x10027);
+  (0x1003B,0x1003B), `Abs (0x1003B);
+  (0x1003E,0x1003E), `Abs (0x1003E);
+  (0x1004E,0x1004F), `Delta (0);
+  (0x1005E,0x1007F), `Delta (0);
+  (0x100FB,0x100FF), `Delta (0);
+  (0x10103,0x10106), `Delta (0);
+  (0x10134,0x10136), `Delta (0);
+  (0x1018F,0x1018F), `Abs (0x1018F);
+  (0x1019C,0x1019F), `Delta (0);
+  (0x101A1,0x101CF), `Delta (0);
+  (0x101FE,0x1027F), `Delta (0);
+  (0x1029D,0x1029F), `Delta (0);
+  (0x102D1,0x102DF), `Delta (0);
+  (0x102FC,0x102FF), `Delta (0);
+  (0x10324,0x1032F), `Delta (0);
+  (0x1034B,0x1034F), `Delta (0);
+  (0x1037B,0x1037F), `Delta (0);
+  (0x1039E,0x1039E), `Abs (0x1039E);
+  (0x103C4,0x103C7), `Delta (0);
+  (0x103D6,0x103FF), `Delta (0);
+  (0x1049E,0x1049F), `Delta (0);
+  (0x104AA,0x104AF), `Delta (0);
+  (0x104D4,0x104D7), `Delta (0);
+  (0x104FC,0x104FF), `Delta (0);
+  (0x10528,0x1052F), `Delta (0);
+  (0x10564,0x1056E), `Delta (0);
+  (0x10570,0x105FF), `Delta (0);
+  (0x10737,0x1073F), `Delta (0);
+  (0x10756,0x1075F), `Delta (0);
+  (0x10768,0x107FF), `Delta (0);
+  (0x10806,0x10807), `Delta (0);
+  (0x10809,0x10809), `Abs (0x10809);
+  (0x10836,0x10836), `Abs (0x10836);
+  (0x10839,0x1083B), `Delta (0);
+  (0x1083D,0x1083E), `Delta (0);
+  (0x10856,0x10856), `Abs (0x10856);
+  (0x1089F,0x108A6), `Delta (0);
+  (0x108B0,0x108DF), `Delta (0);
+  (0x108F3,0x108F3), `Abs (0x108F3);
+  (0x108F6,0x108FA), `Delta (0);
+  (0x1091C,0x1091E), `Delta (0);
+  (0x1093A,0x1093E), `Delta (0);
+  (0x10940,0x1097F), `Delta (0);
+  (0x109B8,0x109BB), `Delta (0);
+  (0x109D0,0x109D1), `Delta (0);
+  (0x10A04,0x10A04), `Abs (0x10A04);
+  (0x10A07,0x10A0B), `Delta (0);
+  (0x10A14,0x10A14), `Abs (0x10A14);
+  (0x10A18,0x10A18), `Abs (0x10A18);
+  (0x10A34,0x10A37), `Delta (0);
+  (0x10A3B,0x10A3E), `Delta (0);
+  (0x10A48,0x10A4F), `Delta (0);
+  (0x10A59,0x10A5F), `Delta (0);
+  (0x10AA0,0x10ABF), `Delta (0);
+  (0x10AE7,0x10AEA), `Delta (0);
+  (0x10AF7,0x10AFF), `Delta (0);
+  (0x10B36,0x10B38), `Delta (0);
+  (0x10B56,0x10B57), `Delta (0);
+  (0x10B73,0x10B77), `Delta (0);
+  (0x10B92,0x10B98), `Delta (0);
+  (0x10B9D,0x10BA8), `Delta (0);
+  (0x10BB0,0x10BFF), `Delta (0);
+  (0x10C49,0x10C7F), `Delta (0);
+  (0x10CB3,0x10CBF), `Delta (0);
+  (0x10CF3,0x10CF9), `Delta (0);
+  (0x10D00,0x10E5F), `Delta (0);
+  (0x10E7F,0x10FFF), `Delta (0);
+  (0x1104E,0x11051), `Delta (0);
+  (0x11070,0x1107E), `Delta (0);
+  (0x110C2,0x110CF), `Delta (0);
+  (0x110E9,0x110EF), `Delta (0);
+  (0x110FA,0x110FF), `Delta (0);
+  (0x11135,0x11135), `Abs (0x11135);
+  (0x11144,0x1114F), `Delta (0);
+  (0x11177,0x1117F), `Delta (0);
+  (0x111CE,0x111CF), `Delta (0);
+  (0x111E0,0x111E0), `Abs (0x111E0);
+  (0x111F5,0x111FF), `Delta (0);
+  (0x11212,0x11212), `Abs (0x11212);
+  (0x1123F,0x1127F), `Delta (0);
+  (0x11287,0x11287), `Abs (0x11287);
+  (0x11289,0x11289), `Abs (0x11289);
+  (0x1128E,0x1128E), `Abs (0x1128E);
+  (0x1129E,0x1129E), `Abs (0x1129E);
+  (0x112AA,0x112AF), `Delta (0);
+  (0x112EB,0x112EF), `Delta (0);
+  (0x112FA,0x112FF), `Delta (0);
+  (0x11304,0x11304), `Abs (0x11304);
+  (0x1130D,0x1130E), `Delta (0);
+  (0x11311,0x11312), `Delta (0);
+  (0x11329,0x11329), `Abs (0x11329);
+  (0x11331,0x11331), `Abs (0x11331);
+  (0x11334,0x11334), `Abs (0x11334);
+  (0x1133A,0x1133B), `Delta (0);
+  (0x11345,0x11346), `Delta (0);
+  (0x11349,0x1134A), `Delta (0);
+  (0x1134E,0x1134F), `Delta (0);
+  (0x11351,0x11356), `Delta (0);
+  (0x11358,0x1135C), `Delta (0);
+  (0x11364,0x11365), `Delta (0);
+  (0x1136D,0x1136F), `Delta (0);
+  (0x11375,0x113FF), `Delta (0);
+  (0x1145A,0x1145A), `Abs (0x1145A);
+  (0x1145C,0x1145C), `Abs (0x1145C);
+  (0x1145E,0x1147F), `Delta (0);
+  (0x114C8,0x114CF), `Delta (0);
+  (0x114DA,0x1157F), `Delta (0);
+  (0x115B6,0x115B7), `Delta (0);
+  (0x115DE,0x115FF), `Delta (0);
+  (0x11645,0x1164F), `Delta (0);
+  (0x1165A,0x1165F), `Delta (0);
+  (0x1166D,0x1167F), `Delta (0);
+  (0x116B8,0x116BF), `Delta (0);
+  (0x116CA,0x116FF), `Delta (0);
+  (0x1171A,0x1171C), `Delta (0);
+  (0x1172C,0x1172F), `Delta (0);
+  (0x11740,0x1189F), `Delta (0);
+  (0x118F3,0x118FE), `Delta (0);
+  (0x11900,0x11ABF), `Delta (0);
+  (0x11AF9,0x11BFF), `Delta (0);
+  (0x11C09,0x11C09), `Abs (0x11C09);
+  (0x11C37,0x11C37), `Abs (0x11C37);
+  (0x11C46,0x11C4F), `Delta (0);
+  (0x11C6D,0x11C6F), `Delta (0);
+  (0x11C90,0x11C91), `Delta (0);
+  (0x11CA8,0x11CA8), `Abs (0x11CA8);
+  (0x11CB7,0x11FFF), `Delta (0);
+  (0x1239A,0x123FF), `Delta (0);
+  (0x1246F,0x1246F), `Abs (0x1246F);
+  (0x12475,0x1247F), `Delta (0);
+  (0x12544,0x12FFF), `Delta (0);
+  (0x1342F,0x143FF), `Delta (0);
+  (0x14647,0x167FF), `Delta (0);
+  (0x16A39,0x16A3F), `Delta (0);
+  (0x16A5F,0x16A5F), `Abs (0x16A5F);
+  (0x16A6A,0x16A6D), `Delta (0);
+  (0x16A70,0x16ACF), `Delta (0);
+  (0x16AEE,0x16AEF), `Delta (0);
+  (0x16AF6,0x16AFF), `Delta (0);
+  (0x16B46,0x16B4F), `Delta (0);
+  (0x16B5A,0x16B5A), `Abs (0x16B5A);
+  (0x16B62,0x16B62), `Abs (0x16B62);
+  (0x16B78,0x16B7C), `Delta (0);
+  (0x16B90,0x16EFF), `Delta (0);
+  (0x16F45,0x16F4F), `Delta (0);
+  (0x16F7F,0x16F8E), `Delta (0);
+  (0x16FA0,0x16FDF), `Delta (0);
+  (0x16FE1,0x16FFF), `Delta (0);
+  (0x187ED,0x187FF), `Delta (0);
+  (0x18AF3,0x1AFFF), `Delta (0);
+  (0x1B002,0x1BBFF), `Delta (0);
+  (0x1BC6B,0x1BC6F), `Delta (0);
+  (0x1BC7D,0x1BC7F), `Delta (0);
+  (0x1BC89,0x1BC8F), `Delta (0);
+  (0x1BC9A,0x1BC9B), `Delta (0);
+  (0x1BCA4,0x1CFFF), `Delta (0);
+  (0x1D0F6,0x1D0FF), `Delta (0);
+  (0x1D127,0x1D128), `Delta (0);
+  (0x1D1E9,0x1D1FF), `Delta (0);
+  (0x1D246,0x1D2FF), `Delta (0);
+  (0x1D357,0x1D35F), `Delta (0);
+  (0x1D372,0x1D3FF), `Delta (0);
+  (0x1D455,0x1D455), `Abs (0x1D455);
+  (0x1D49D,0x1D49D), `Abs (0x1D49D);
+  (0x1D4A0,0x1D4A1), `Delta (0);
+  (0x1D4A3,0x1D4A4), `Delta (0);
+  (0x1D4A7,0x1D4A8), `Delta (0);
+  (0x1D4AD,0x1D4AD), `Abs (0x1D4AD);
+  (0x1D4BA,0x1D4BA), `Abs (0x1D4BA);
+  (0x1D4BC,0x1D4BC), `Abs (0x1D4BC);
+  (0x1D4C4,0x1D4C4), `Abs (0x1D4C4);
+  (0x1D506,0x1D506), `Abs (0x1D506);
+  (0x1D50B,0x1D50C), `Delta (0);
+  (0x1D515,0x1D515), `Abs (0x1D515);
+  (0x1D51D,0x1D51D), `Abs (0x1D51D);
+  (0x1D53A,0x1D53A), `Abs (0x1D53A);
+  (0x1D53F,0x1D53F), `Abs (0x1D53F);
+  (0x1D545,0x1D545), `Abs (0x1D545);
+  (0x1D547,0x1D549), `Delta (0);
+  (0x1D551,0x1D551), `Abs (0x1D551);
+  (0x1D6A6,0x1D6A7), `Delta (0);
+  (0x1D7CC,0x1D7CD), `Delta (0);
+  (0x1DA8C,0x1DA9A), `Delta (0);
+  (0x1DAA0,0x1DAA0), `Abs (0x1DAA0);
+  (0x1DAB0,0x1DFFF), `Delta (0);
+  (0x1E007,0x1E007), `Abs (0x1E007);
+  (0x1E019,0x1E01A), `Delta (0);
+  (0x1E022,0x1E022), `Abs (0x1E022);
+  (0x1E025,0x1E025), `Abs (0x1E025);
+  (0x1E02B,0x1E7FF), `Delta (0);
+  (0x1E8C5,0x1E8C6), `Delta (0);
+  (0x1E8D7,0x1E8FF), `Delta (0);
+  (0x1E94B,0x1E94F), `Delta (0);
+  (0x1E95A,0x1E95D), `Delta (0);
+  (0x1E960,0x1EDFF), `Delta (0);
+  (0x1EE04,0x1EE04), `Abs (0x1EE04);
+  (0x1EE20,0x1EE20), `Abs (0x1EE20);
+  (0x1EE23,0x1EE23), `Abs (0x1EE23);
+  (0x1EE25,0x1EE26), `Delta (0);
+  (0x1EE28,0x1EE28), `Abs (0x1EE28);
+  (0x1EE33,0x1EE33), `Abs (0x1EE33);
+  (0x1EE38,0x1EE38), `Abs (0x1EE38);
+  (0x1EE3A,0x1EE3A), `Abs (0x1EE3A);
+  (0x1EE3C,0x1EE41), `Delta (0);
+  (0x1EE43,0x1EE46), `Delta (0);
+  (0x1EE48,0x1EE48), `Abs (0x1EE48);
+  (0x1EE4A,0x1EE4A), `Abs (0x1EE4A);
+  (0x1EE4C,0x1EE4C), `Abs (0x1EE4C);
+  (0x1EE50,0x1EE50), `Abs (0x1EE50);
+  (0x1EE53,0x1EE53), `Abs (0x1EE53);
+  (0x1EE55,0x1EE56), `Delta (0);
+  (0x1EE58,0x1EE58), `Abs (0x1EE58);
+  (0x1EE5A,0x1EE5A), `Abs (0x1EE5A);
+  (0x1EE5C,0x1EE5C), `Abs (0x1EE5C);
+  (0x1EE5E,0x1EE5E), `Abs (0x1EE5E);
+  (0x1EE60,0x1EE60), `Abs (0x1EE60);
+  (0x1EE63,0x1EE63), `Abs (0x1EE63);
+  (0x1EE65,0x1EE66), `Delta (0);
+  (0x1EE6B,0x1EE6B), `Abs (0x1EE6B);
+  (0x1EE73,0x1EE73), `Abs (0x1EE73);
+  (0x1EE78,0x1EE78), `Abs (0x1EE78);
+  (0x1EE7D,0x1EE7D), `Abs (0x1EE7D);
+  (0x1EE7F,0x1EE7F), `Abs (0x1EE7F);
+  (0x1EE8A,0x1EE8A), `Abs (0x1EE8A);
+  (0x1EE9C,0x1EEA0), `Delta (0);
+  (0x1EEA4,0x1EEA4), `Abs (0x1EEA4);
+  (0x1EEAA,0x1EEAA), `Abs (0x1EEAA);
+  (0x1EEBC,0x1EEEF), `Delta (0);
+  (0x1EEF2,0x1EFFF), `Delta (0);
+  (0x1F02C,0x1F02F), `Delta (0);
+  (0x1F094,0x1F09F), `Delta (0);
+  (0x1F0AF,0x1F0B0), `Delta (0);
+  (0x1F0C0,0x1F0C0), `Abs (0x1F0C0);
+  (0x1F0D0,0x1F0D0), `Abs (0x1F0D0);
+  (0x1F0F6,0x1F0FF), `Delta (0);
+  (0x1F10D,0x1F10F), `Delta (0);
+  (0x1F12F,0x1F12F), `Abs (0x1F12F);
+  (0x1F16C,0x1F16F), `Delta (0);
+  (0x1F1AD,0x1F1E5), `Delta (0);
+  (0x1F203,0x1F20F), `Delta (0);
+  (0x1F23C,0x1F23F), `Delta (0);
+  (0x1F249,0x1F24F), `Delta (0);
+  (0x1F252,0x1F2FF), `Delta (0);
+  (0x1F6D3,0x1F6DF), `Delta (0);
+  (0x1F6ED,0x1F6EF), `Delta (0);
+  (0x1F6F7,0x1F6FF), `Delta (0);
+  (0x1F774,0x1F77F), `Delta (0);
+  (0x1F7D5,0x1F7FF), `Delta (0);
+  (0x1F80C,0x1F80F), `Delta (0);
+  (0x1F848,0x1F84F), `Delta (0);
+  (0x1F85A,0x1F85F), `Delta (0);
+  (0x1F888,0x1F88F), `Delta (0);
+  (0x1F8AE,0x1F90F), `Delta (0);
+  (0x1F91F,0x1F91F), `Abs (0x1F91F);
+  (0x1F928,0x1F92F), `Delta (0);
+  (0x1F931,0x1F932), `Delta (0);
+  (0x1F93F,0x1F93F), `Abs (0x1F93F);
+  (0x1F94C,0x1F94F), `Delta (0);
+  (0x1F95F,0x1F97F), `Delta (0);
+  (0x1F992,0x1F9BF), `Delta (0);
+  (0x1F9C1,0x1FFFF), `Delta (0);
+  (0x2A6D7,0x2A6FF), `Delta (0);
+  (0x2B735,0x2B73F), `Delta (0);
+  (0x2B81E,0x2B81F), `Delta (0);
+  (0x2CEA2,0x2F7FF), `Delta (0);
+  (0x2FA1E,0xE0000), `Delta (0);
+  (0xE0002,0xE001F), `Delta (0);
+  (0xE0080,0xE00FF), `Delta (0);
+  (0xE01F0,0xEFFFF), `Delta (0);
+  (0xFFFFE,0xFFFFF), `Delta (0);
+  (0x10FFFE,0x10FFFF), `Delta (0);
+  (0x002B0,0x002C1), `Delta (0);
+  (0x002C6,0x002D1), `Delta (0);
+  (0x002E0,0x002E4), `Delta (0);
+  (0x002EC,0x002EC), `Abs (0x002EC);
+  (0x002EE,0x002EE), `Abs (0x002EE);
+  (0x00374,0x00374), `Abs (0x00374);
+  (0x0037A,0x0037A), `Abs (0x0037A);
+  (0x00559,0x00559), `Abs (0x00559);
+  (0x00640,0x00640), `Abs (0x00640);
+  (0x006E5,0x006E6), `Delta (0);
+  (0x007F4,0x007F5), `Delta (0);
+  (0x007FA,0x007FA), `Abs (0x007FA);
+  (0x0081A,0x0081A), `Abs (0x0081A);
+  (0x00824,0x00824), `Abs (0x00824);
+  (0x00828,0x00828), `Abs (0x00828);
+  (0x00971,0x00971), `Abs (0x00971);
+  (0x00E46,0x00E46), `Abs (0x00E46);
+  (0x00EC6,0x00EC6), `Abs (0x00EC6);
+  (0x010FC,0x010FC), `Abs (0x010FC);
+  (0x017D7,0x017D7), `Abs (0x017D7);
+  (0x01843,0x01843), `Abs (0x01843);
+  (0x01AA7,0x01AA7), `Abs (0x01AA7);
+  (0x01C78,0x01C7D), `Delta (0);
+  (0x01D2C,0x01D6A), `Delta (0);
+  (0x01D78,0x01D78), `Abs (0x01D78);
+  (0x01D9B,0x01DBF), `Delta (0);
+  (0x02071,0x02071), `Abs (0x02071);
+  (0x0207F,0x0207F), `Abs (0x0207F);
+  (0x02090,0x0209C), `Delta (0);
+  (0x02C7C,0x02C7D), `Delta (0);
+  (0x02D6F,0x02D6F), `Abs (0x02D6F);
+  (0x02E2F,0x02E2F), `Abs (0x02E2F);
+  (0x03005,0x03005), `Abs (0x03005);
+  (0x03031,0x03035), `Delta (0);
+  (0x0303B,0x0303B), `Abs (0x0303B);
+  (0x0309D,0x0309E), `Delta (0);
+  (0x030FC,0x030FE), `Delta (0);
+  (0x0A015,0x0A015), `Abs (0x0A015);
+  (0x0A4F8,0x0A4FD), `Delta (0);
+  (0x0A60C,0x0A60C), `Abs (0x0A60C);
+  (0x0A67F,0x0A67F), `Abs (0x0A67F);
+  (0x0A69C,0x0A69D), `Delta (0);
+  (0x0A717,0x0A71F), `Delta (0);
+  (0x0A770,0x0A770), `Abs (0x0A770);
+  (0x0A788,0x0A788), `Abs (0x0A788);
+  (0x0A7F8,0x0A7F9), `Delta (0);
+  (0x0A9CF,0x0A9CF), `Abs (0x0A9CF);
+  (0x0A9E6,0x0A9E6), `Abs (0x0A9E6);
+  (0x0AA70,0x0AA70), `Abs (0x0AA70);
+  (0x0AADD,0x0AADD), `Abs (0x0AADD);
+  (0x0AAF3,0x0AAF4), `Delta (0);
+  (0x0AB5C,0x0AB5F), `Delta (0);
+  (0x0FF70,0x0FF70), `Abs (0x0FF70);
+  (0x0FF9E,0x0FF9F), `Delta (0);
+  (0x16B40,0x16B43), `Delta (0);
+  (0x16F93,0x16F9F), `Delta (0);
+  (0x16FE0,0x16FE0), `Abs (0x16FE0);
+  (0x000AA,0x000AA), `Abs (0x000AA);
+  (0x000BA,0x000BA), `Abs (0x000BA);
+  (0x001BB,0x001BB), `Abs (0x001BB);
+  (0x001C0,0x001C3), `Delta (0);
+  (0x00294,0x00294), `Abs (0x00294);
+  (0x005D0,0x005EA), `Delta (0);
+  (0x005F0,0x005F2), `Delta (0);
+  (0x00620,0x0063F), `Delta (0);
+  (0x00641,0x0064A), `Delta (0);
+  (0x0066E,0x0066F), `Delta (0);
+  (0x00671,0x006D3), `Delta (0);
+  (0x006D5,0x006D5), `Abs (0x006D5);
+  (0x006EE,0x006EF), `Delta (0);
+  (0x006FA,0x006FC), `Delta (0);
+  (0x006FF,0x006FF), `Abs (0x006FF);
+  (0x00710,0x00710), `Abs (0x00710);
+  (0x00712,0x0072F), `Delta (0);
+  (0x0074D,0x007A5), `Delta (0);
+  (0x007B1,0x007B1), `Abs (0x007B1);
+  (0x007CA,0x007EA), `Delta (0);
+  (0x00800,0x00815), `Delta (0);
+  (0x00840,0x00858), `Delta (0);
+  (0x008A0,0x008B4), `Delta (0);
+  (0x008B6,0x008BD), `Delta (0);
+  (0x00904,0x00939), `Delta (0);
+  (0x0093D,0x0093D), `Abs (0x0093D);
+  (0x00950,0x00950), `Abs (0x00950);
+  (0x00958,0x00961), `Delta (0);
+  (0x00972,0x00980), `Delta (0);
+  (0x00985,0x0098C), `Delta (0);
+  (0x0098F,0x00990), `Delta (0);
+  (0x00993,0x009A8), `Delta (0);
+  (0x009AA,0x009B0), `Delta (0);
+  (0x009B2,0x009B2), `Abs (0x009B2);
+  (0x009B6,0x009B9), `Delta (0);
+  (0x009BD,0x009BD), `Abs (0x009BD);
+  (0x009CE,0x009CE), `Abs (0x009CE);
+  (0x009DC,0x009DD), `Delta (0);
+  (0x009DF,0x009E1), `Delta (0);
+  (0x009F0,0x009F1), `Delta (0);
+  (0x00A05,0x00A0A), `Delta (0);
+  (0x00A0F,0x00A10), `Delta (0);
+  (0x00A13,0x00A28), `Delta (0);
+  (0x00A2A,0x00A30), `Delta (0);
+  (0x00A32,0x00A33), `Delta (0);
+  (0x00A35,0x00A36), `Delta (0);
+  (0x00A38,0x00A39), `Delta (0);
+  (0x00A59,0x00A5C), `Delta (0);
+  (0x00A5E,0x00A5E), `Abs (0x00A5E);
+  (0x00A72,0x00A74), `Delta (0);
+  (0x00A85,0x00A8D), `Delta (0);
+  (0x00A8F,0x00A91), `Delta (0);
+  (0x00A93,0x00AA8), `Delta (0);
+  (0x00AAA,0x00AB0), `Delta (0);
+  (0x00AB2,0x00AB3), `Delta (0);
+  (0x00AB5,0x00AB9), `Delta (0);
+  (0x00ABD,0x00ABD), `Abs (0x00ABD);
+  (0x00AD0,0x00AD0), `Abs (0x00AD0);
+  (0x00AE0,0x00AE1), `Delta (0);
+  (0x00AF9,0x00AF9), `Abs (0x00AF9);
+  (0x00B05,0x00B0C), `Delta (0);
+  (0x00B0F,0x00B10), `Delta (0);
+  (0x00B13,0x00B28), `Delta (0);
+  (0x00B2A,0x00B30), `Delta (0);
+  (0x00B32,0x00B33), `Delta (0);
+  (0x00B35,0x00B39), `Delta (0);
+  (0x00B3D,0x00B3D), `Abs (0x00B3D);
+  (0x00B5C,0x00B5D), `Delta (0);
+  (0x00B5F,0x00B61), `Delta (0);
+  (0x00B71,0x00B71), `Abs (0x00B71);
+  (0x00B83,0x00B83), `Abs (0x00B83);
+  (0x00B85,0x00B8A), `Delta (0);
+  (0x00B8E,0x00B90), `Delta (0);
+  (0x00B92,0x00B95), `Delta (0);
+  (0x00B99,0x00B9A), `Delta (0);
+  (0x00B9C,0x00B9C), `Abs (0x00B9C);
+  (0x00B9E,0x00B9F), `Delta (0);
+  (0x00BA3,0x00BA4), `Delta (0);
+  (0x00BA8,0x00BAA), `Delta (0);
+  (0x00BAE,0x00BB9), `Delta (0);
+  (0x00BD0,0x00BD0), `Abs (0x00BD0);
+  (0x00C05,0x00C0C), `Delta (0);
+  (0x00C0E,0x00C10), `Delta (0);
+  (0x00C12,0x00C28), `Delta (0);
+  (0x00C2A,0x00C39), `Delta (0);
+  (0x00C3D,0x00C3D), `Abs (0x00C3D);
+  (0x00C58,0x00C5A), `Delta (0);
+  (0x00C60,0x00C61), `Delta (0);
+  (0x00C80,0x00C80), `Abs (0x00C80);
+  (0x00C85,0x00C8C), `Delta (0);
+  (0x00C8E,0x00C90), `Delta (0);
+  (0x00C92,0x00CA8), `Delta (0);
+  (0x00CAA,0x00CB3), `Delta (0);
+  (0x00CB5,0x00CB9), `Delta (0);
+  (0x00CBD,0x00CBD), `Abs (0x00CBD);
+  (0x00CDE,0x00CDE), `Abs (0x00CDE);
+  (0x00CE0,0x00CE1), `Delta (0);
+  (0x00CF1,0x00CF2), `Delta (0);
+  (0x00D05,0x00D0C), `Delta (0);
+  (0x00D0E,0x00D10), `Delta (0);
+  (0x00D12,0x00D3A), `Delta (0);
+  (0x00D3D,0x00D3D), `Abs (0x00D3D);
+  (0x00D4E,0x00D4E), `Abs (0x00D4E);
+  (0x00D54,0x00D56), `Delta (0);
+  (0x00D5F,0x00D61), `Delta (0);
+  (0x00D7A,0x00D7F), `Delta (0);
+  (0x00D85,0x00D96), `Delta (0);
+  (0x00D9A,0x00DB1), `Delta (0);
+  (0x00DB3,0x00DBB), `Delta (0);
+  (0x00DBD,0x00DBD), `Abs (0x00DBD);
+  (0x00DC0,0x00DC6), `Delta (0);
+  (0x00E01,0x00E30), `Delta (0);
+  (0x00E32,0x00E33), `Delta (0);
+  (0x00E40,0x00E45), `Delta (0);
+  (0x00E81,0x00E82), `Delta (0);
+  (0x00E84,0x00E84), `Abs (0x00E84);
+  (0x00E87,0x00E88), `Delta (0);
+  (0x00E8A,0x00E8A), `Abs (0x00E8A);
+  (0x00E8D,0x00E8D), `Abs (0x00E8D);
+  (0x00E94,0x00E97), `Delta (0);
+  (0x00E99,0x00E9F), `Delta (0);
+  (0x00EA1,0x00EA3), `Delta (0);
+  (0x00EA5,0x00EA5), `Abs (0x00EA5);
+  (0x00EA7,0x00EA7), `Abs (0x00EA7);
+  (0x00EAA,0x00EAB), `Delta (0);
+  (0x00EAD,0x00EB0), `Delta (0);
+  (0x00EB2,0x00EB3), `Delta (0);
+  (0x00EBD,0x00EBD), `Abs (0x00EBD);
+  (0x00EC0,0x00EC4), `Delta (0);
+  (0x00EDC,0x00EDF), `Delta (0);
+  (0x00F00,0x00F00), `Abs (0x00F00);
+  (0x00F40,0x00F47), `Delta (0);
+  (0x00F49,0x00F6C), `Delta (0);
+  (0x00F88,0x00F8C), `Delta (0);
+  (0x01000,0x0102A), `Delta (0);
+  (0x0103F,0x0103F), `Abs (0x0103F);
+  (0x01050,0x01055), `Delta (0);
+  (0x0105A,0x0105D), `Delta (0);
+  (0x01061,0x01061), `Abs (0x01061);
+  (0x01065,0x01066), `Delta (0);
+  (0x0106E,0x01070), `Delta (0);
+  (0x01075,0x01081), `Delta (0);
+  (0x0108E,0x0108E), `Abs (0x0108E);
+  (0x010D0,0x010FA), `Delta (0);
+  (0x010FD,0x01248), `Delta (0);
+  (0x0124A,0x0124D), `Delta (0);
+  (0x01250,0x01256), `Delta (0);
+  (0x01258,0x01258), `Abs (0x01258);
+  (0x0125A,0x0125D), `Delta (0);
+  (0x01260,0x01288), `Delta (0);
+  (0x0128A,0x0128D), `Delta (0);
+  (0x01290,0x012B0), `Delta (0);
+  (0x012B2,0x012B5), `Delta (0);
+  (0x012B8,0x012BE), `Delta (0);
+  (0x012C0,0x012C0), `Abs (0x012C0);
+  (0x012C2,0x012C5), `Delta (0);
+  (0x012C8,0x012D6), `Delta (0);
+  (0x012D8,0x01310), `Delta (0);
+  (0x01312,0x01315), `Delta (0);
+  (0x01318,0x0135A), `Delta (0);
+  (0x01380,0x0138F), `Delta (0);
+  (0x01401,0x0166C), `Delta (0);
+  (0x0166F,0x0167F), `Delta (0);
+  (0x01681,0x0169A), `Delta (0);
+  (0x016A0,0x016EA), `Delta (0);
+  (0x016F1,0x016F8), `Delta (0);
+  (0x01700,0x0170C), `Delta (0);
+  (0x0170E,0x01711), `Delta (0);
+  (0x01720,0x01731), `Delta (0);
+  (0x01740,0x01751), `Delta (0);
+  (0x01760,0x0176C), `Delta (0);
+  (0x0176E,0x01770), `Delta (0);
+  (0x01780,0x017B3), `Delta (0);
+  (0x017DC,0x017DC), `Abs (0x017DC);
+  (0x01820,0x01842), `Delta (0);
+  (0x01844,0x01877), `Delta (0);
+  (0x01880,0x01884), `Delta (0);
+  (0x01887,0x018A8), `Delta (0);
+  (0x018AA,0x018AA), `Abs (0x018AA);
+  (0x018B0,0x018F5), `Delta (0);
+  (0x01900,0x0191E), `Delta (0);
+  (0x01950,0x0196D), `Delta (0);
+  (0x01970,0x01974), `Delta (0);
+  (0x01980,0x019AB), `Delta (0);
+  (0x019B0,0x019C9), `Delta (0);
+  (0x01A00,0x01A16), `Delta (0);
+  (0x01A20,0x01A54), `Delta (0);
+  (0x01B05,0x01B33), `Delta (0);
+  (0x01B45,0x01B4B), `Delta (0);
+  (0x01B83,0x01BA0), `Delta (0);
+  (0x01BAE,0x01BAF), `Delta (0);
+  (0x01BBA,0x01BE5), `Delta (0);
+  (0x01C00,0x01C23), `Delta (0);
+  (0x01C4D,0x01C4F), `Delta (0);
+  (0x01C5A,0x01C77), `Delta (0);
+  (0x01CE9,0x01CEC), `Delta (0);
+  (0x01CEE,0x01CF1), `Delta (0);
+  (0x01CF5,0x01CF6), `Delta (0);
+  (0x02135,0x02138), `Delta (0);
+  (0x02D30,0x02D67), `Delta (0);
+  (0x02D80,0x02D96), `Delta (0);
+  (0x02DA0,0x02DA6), `Delta (0);
+  (0x02DA8,0x02DAE), `Delta (0);
+  (0x02DB0,0x02DB6), `Delta (0);
+  (0x02DB8,0x02DBE), `Delta (0);
+  (0x02DC0,0x02DC6), `Delta (0);
+  (0x02DC8,0x02DCE), `Delta (0);
+  (0x02DD0,0x02DD6), `Delta (0);
+  (0x02DD8,0x02DDE), `Delta (0);
+  (0x03006,0x03006), `Abs (0x03006);
+  (0x0303C,0x0303C), `Abs (0x0303C);
+  (0x03041,0x03096), `Delta (0);
+  (0x0309F,0x0309F), `Abs (0x0309F);
+  (0x030A1,0x030FA), `Delta (0);
+  (0x030FF,0x030FF), `Abs (0x030FF);
+  (0x03105,0x0312D), `Delta (0);
+  (0x03131,0x0318E), `Delta (0);
+  (0x031A0,0x031BA), `Delta (0);
+  (0x031F0,0x031FF), `Delta (0);
+  (0x03400,0x04DB5), `Delta (0);
+  (0x04E00,0x09FD5), `Delta (0);
+  (0x0A000,0x0A014), `Delta (0);
+  (0x0A016,0x0A48C), `Delta (0);
+  (0x0A4D0,0x0A4F7), `Delta (0);
+  (0x0A500,0x0A60B), `Delta (0);
+  (0x0A610,0x0A61F), `Delta (0);
+  (0x0A62A,0x0A62B), `Delta (0);
+  (0x0A66E,0x0A66E), `Abs (0x0A66E);
+  (0x0A6A0,0x0A6E5), `Delta (0);
+  (0x0A78F,0x0A78F), `Abs (0x0A78F);
+  (0x0A7F7,0x0A7F7), `Abs (0x0A7F7);
+  (0x0A7FB,0x0A801), `Delta (0);
+  (0x0A803,0x0A805), `Delta (0);
+  (0x0A807,0x0A80A), `Delta (0);
+  (0x0A80C,0x0A822), `Delta (0);
+  (0x0A840,0x0A873), `Delta (0);
+  (0x0A882,0x0A8B3), `Delta (0);
+  (0x0A8F2,0x0A8F7), `Delta (0);
+  (0x0A8FB,0x0A8FB), `Abs (0x0A8FB);
+  (0x0A8FD,0x0A8FD), `Abs (0x0A8FD);
+  (0x0A90A,0x0A925), `Delta (0);
+  (0x0A930,0x0A946), `Delta (0);
+  (0x0A960,0x0A97C), `Delta (0);
+  (0x0A984,0x0A9B2), `Delta (0);
+  (0x0A9E0,0x0A9E4), `Delta (0);
+  (0x0A9E7,0x0A9EF), `Delta (0);
+  (0x0A9FA,0x0A9FE), `Delta (0);
+  (0x0AA00,0x0AA28), `Delta (0);
+  (0x0AA40,0x0AA42), `Delta (0);
+  (0x0AA44,0x0AA4B), `Delta (0);
+  (0x0AA60,0x0AA6F), `Delta (0);
+  (0x0AA71,0x0AA76), `Delta (0);
+  (0x0AA7A,0x0AA7A), `Abs (0x0AA7A);
+  (0x0AA7E,0x0AAAF), `Delta (0);
+  (0x0AAB1,0x0AAB1), `Abs (0x0AAB1);
+  (0x0AAB5,0x0AAB6), `Delta (0);
+  (0x0AAB9,0x0AABD), `Delta (0);
+  (0x0AAC0,0x0AAC0), `Abs (0x0AAC0);
+  (0x0AAC2,0x0AAC2), `Abs (0x0AAC2);
+  (0x0AADB,0x0AADC), `Delta (0);
+  (0x0AAE0,0x0AAEA), `Delta (0);
+  (0x0AAF2,0x0AAF2), `Abs (0x0AAF2);
+  (0x0AB01,0x0AB06), `Delta (0);
+  (0x0AB09,0x0AB0E), `Delta (0);
+  (0x0AB11,0x0AB16), `Delta (0);
+  (0x0AB20,0x0AB26), `Delta (0);
+  (0x0AB28,0x0AB2E), `Delta (0);
+  (0x0ABC0,0x0ABE2), `Delta (0);
+  (0x0AC00,0x0D7A3), `Delta (0);
+  (0x0D7B0,0x0D7C6), `Delta (0);
+  (0x0D7CB,0x0D7FB), `Delta (0);
+  (0x0F900,0x0FA6D), `Delta (0);
+  (0x0FA70,0x0FAD9), `Delta (0);
+  (0x0FB1D,0x0FB1D), `Abs (0x0FB1D);
+  (0x0FB1F,0x0FB28), `Delta (0);
+  (0x0FB2A,0x0FB36), `Delta (0);
+  (0x0FB38,0x0FB3C), `Delta (0);
+  (0x0FB3E,0x0FB3E), `Abs (0x0FB3E);
+  (0x0FB40,0x0FB41), `Delta (0);
+  (0x0FB43,0x0FB44), `Delta (0);
+  (0x0FB46,0x0FBB1), `Delta (0);
+  (0x0FBD3,0x0FD3D), `Delta (0);
+  (0x0FD50,0x0FD8F), `Delta (0);
+  (0x0FD92,0x0FDC7), `Delta (0);
+  (0x0FDF0,0x0FDFB), `Delta (0);
+  (0x0FE70,0x0FE74), `Delta (0);
+  (0x0FE76,0x0FEFC), `Delta (0);
+  (0x0FF66,0x0FF6F), `Delta (0);
+  (0x0FF71,0x0FF9D), `Delta (0);
+  (0x0FFA0,0x0FFBE), `Delta (0);
+  (0x0FFC2,0x0FFC7), `Delta (0);
+  (0x0FFCA,0x0FFCF), `Delta (0);
+  (0x0FFD2,0x0FFD7), `Delta (0);
+  (0x0FFDA,0x0FFDC), `Delta (0);
+  (0x10000,0x1000B), `Delta (0);
+  (0x1000D,0x10026), `Delta (0);
+  (0x10028,0x1003A), `Delta (0);
+  (0x1003C,0x1003D), `Delta (0);
+  (0x1003F,0x1004D), `Delta (0);
+  (0x10050,0x1005D), `Delta (0);
+  (0x10080,0x100FA), `Delta (0);
+  (0x10280,0x1029C), `Delta (0);
+  (0x102A0,0x102D0), `Delta (0);
+  (0x10300,0x1031F), `Delta (0);
+  (0x10330,0x10340), `Delta (0);
+  (0x10342,0x10349), `Delta (0);
+  (0x10350,0x10375), `Delta (0);
+  (0x10380,0x1039D), `Delta (0);
+  (0x103A0,0x103C3), `Delta (0);
+  (0x103C8,0x103CF), `Delta (0);
+  (0x10450,0x1049D), `Delta (0);
+  (0x10500,0x10527), `Delta (0);
+  (0x10530,0x10563), `Delta (0);
+  (0x10600,0x10736), `Delta (0);
+  (0x10740,0x10755), `Delta (0);
+  (0x10760,0x10767), `Delta (0);
+  (0x10800,0x10805), `Delta (0);
+  (0x10808,0x10808), `Abs (0x10808);
+  (0x1080A,0x10835), `Delta (0);
+  (0x10837,0x10838), `Delta (0);
+  (0x1083C,0x1083C), `Abs (0x1083C);
+  (0x1083F,0x10855), `Delta (0);
+  (0x10860,0x10876), `Delta (0);
+  (0x10880,0x1089E), `Delta (0);
+  (0x108E0,0x108F2), `Delta (0);
+  (0x108F4,0x108F5), `Delta (0);
+  (0x10900,0x10915), `Delta (0);
+  (0x10920,0x10939), `Delta (0);
+  (0x10980,0x109B7), `Delta (0);
+  (0x109BE,0x109BF), `Delta (0);
+  (0x10A00,0x10A00), `Abs (0x10A00);
+  (0x10A10,0x10A13), `Delta (0);
+  (0x10A15,0x10A17), `Delta (0);
+  (0x10A19,0x10A33), `Delta (0);
+  (0x10A60,0x10A7C), `Delta (0);
+  (0x10A80,0x10A9C), `Delta (0);
+  (0x10AC0,0x10AC7), `Delta (0);
+  (0x10AC9,0x10AE4), `Delta (0);
+  (0x10B00,0x10B35), `Delta (0);
+  (0x10B40,0x10B55), `Delta (0);
+  (0x10B60,0x10B72), `Delta (0);
+  (0x10B80,0x10B91), `Delta (0);
+  (0x10C00,0x10C48), `Delta (0);
+  (0x11003,0x11037), `Delta (0);
+  (0x11083,0x110AF), `Delta (0);
+  (0x110D0,0x110E8), `Delta (0);
+  (0x11103,0x11126), `Delta (0);
+  (0x11150,0x11172), `Delta (0);
+  (0x11176,0x11176), `Abs (0x11176);
+  (0x11183,0x111B2), `Delta (0);
+  (0x111C1,0x111C4), `Delta (0);
+  (0x111DA,0x111DA), `Abs (0x111DA);
+  (0x111DC,0x111DC), `Abs (0x111DC);
+  (0x11200,0x11211), `Delta (0);
+  (0x11213,0x1122B), `Delta (0);
+  (0x11280,0x11286), `Delta (0);
+  (0x11288,0x11288), `Abs (0x11288);
+  (0x1128A,0x1128D), `Delta (0);
+  (0x1128F,0x1129D), `Delta (0);
+  (0x1129F,0x112A8), `Delta (0);
+  (0x112B0,0x112DE), `Delta (0);
+  (0x11305,0x1130C), `Delta (0);
+  (0x1130F,0x11310), `Delta (0);
+  (0x11313,0x11328), `Delta (0);
+  (0x1132A,0x11330), `Delta (0);
+  (0x11332,0x11333), `Delta (0);
+  (0x11335,0x11339), `Delta (0);
+  (0x1133D,0x1133D), `Abs (0x1133D);
+  (0x11350,0x11350), `Abs (0x11350);
+  (0x1135D,0x11361), `Delta (0);
+  (0x11400,0x11434), `Delta (0);
+  (0x11447,0x1144A), `Delta (0);
+  (0x11480,0x114AF), `Delta (0);
+  (0x114C4,0x114C5), `Delta (0);
+  (0x114C7,0x114C7), `Abs (0x114C7);
+  (0x11580,0x115AE), `Delta (0);
+  (0x115D8,0x115DB), `Delta (0);
+  (0x11600,0x1162F), `Delta (0);
+  (0x11644,0x11644), `Abs (0x11644);
+  (0x11680,0x116AA), `Delta (0);
+  (0x11700,0x11719), `Delta (0);
+  (0x118FF,0x118FF), `Abs (0x118FF);
+  (0x11AC0,0x11AF8), `Delta (0);
+  (0x11C00,0x11C08), `Delta (0);
+  (0x11C0A,0x11C2E), `Delta (0);
+  (0x11C40,0x11C40), `Abs (0x11C40);
+  (0x11C72,0x11C8F), `Delta (0);
+  (0x12000,0x12399), `Delta (0);
+  (0x12480,0x12543), `Delta (0);
+  (0x13000,0x1342E), `Delta (0);
+  (0x14400,0x14646), `Delta (0);
+  (0x16800,0x16A38), `Delta (0);
+  (0x16A40,0x16A5E), `Delta (0);
+  (0x16AD0,0x16AED), `Delta (0);
+  (0x16B00,0x16B2F), `Delta (0);
+  (0x16B63,0x16B77), `Delta (0);
+  (0x16B7D,0x16B8F), `Delta (0);
+  (0x16F00,0x16F44), `Delta (0);
+  (0x16F50,0x16F50), `Abs (0x16F50);
+  (0x17000,0x187EC), `Delta (0);
+  (0x18800,0x18AF2), `Delta (0);
+  (0x1B000,0x1B001), `Delta (0);
+  (0x1BC00,0x1BC6A), `Delta (0);
+  (0x1BC70,0x1BC7C), `Delta (0);
+  (0x1BC80,0x1BC88), `Delta (0);
+  (0x1BC90,0x1BC99), `Delta (0);
+  (0x1E800,0x1E8C4), `Delta (0);
+  (0x1EE00,0x1EE03), `Delta (0);
+  (0x1EE05,0x1EE1F), `Delta (0);
+  (0x1EE21,0x1EE22), `Delta (0);
+  (0x1EE24,0x1EE24), `Abs (0x1EE24);
+  (0x1EE27,0x1EE27), `Abs (0x1EE27);
+  (0x1EE29,0x1EE32), `Delta (0);
+  (0x1EE34,0x1EE37), `Delta (0);
+  (0x1EE39,0x1EE39), `Abs (0x1EE39);
+  (0x1EE3B,0x1EE3B), `Abs (0x1EE3B);
+  (0x1EE42,0x1EE42), `Abs (0x1EE42);
+  (0x1EE47,0x1EE47), `Abs (0x1EE47);
+  (0x1EE49,0x1EE49), `Abs (0x1EE49);
+  (0x1EE4B,0x1EE4B), `Abs (0x1EE4B);
+  (0x1EE4D,0x1EE4F), `Delta (0);
+  (0x1EE51,0x1EE52), `Delta (0);
+  (0x1EE54,0x1EE54), `Abs (0x1EE54);
+  (0x1EE57,0x1EE57), `Abs (0x1EE57);
+  (0x1EE59,0x1EE59), `Abs (0x1EE59);
+  (0x1EE5B,0x1EE5B), `Abs (0x1EE5B);
+  (0x1EE5D,0x1EE5D), `Abs (0x1EE5D);
+  (0x1EE5F,0x1EE5F), `Abs (0x1EE5F);
+  (0x1EE61,0x1EE62), `Delta (0);
+  (0x1EE64,0x1EE64), `Abs (0x1EE64);
+  (0x1EE67,0x1EE6A), `Delta (0);
+  (0x1EE6C,0x1EE72), `Delta (0);
+  (0x1EE74,0x1EE77), `Delta (0);
+  (0x1EE79,0x1EE7C), `Delta (0);
+  (0x1EE7E,0x1EE7E), `Abs (0x1EE7E);
+  (0x1EE80,0x1EE89), `Delta (0);
+  (0x1EE8B,0x1EE9B), `Delta (0);
+  (0x1EEA1,0x1EEA3), `Delta (0);
+  (0x1EEA5,0x1EEA9), `Delta (0);
+  (0x1EEAB,0x1EEBB), `Delta (0);
+  (0x20000,0x2A6D6), `Delta (0);
+  (0x2A700,0x2B734), `Delta (0);
+  (0x2B740,0x2B81D), `Delta (0);
+  (0x2B820,0x2CEA1), `Delta (0);
+  (0x2F800,0x2FA1D), `Delta (0);
+  (0x0005F,0x0005F), `Abs (0x0005F);
+  (0x0203F,0x02040), `Delta (0);
+  (0x02054,0x02054), `Abs (0x02054);
+  (0x0FE33,0x0FE34), `Delta (0);
+  (0x0FE4D,0x0FE4F), `Delta (0);
+  (0x0FF3F,0x0FF3F), `Abs (0x0FF3F);
+  (0x0002D,0x0002D), `Abs (0x0002D);
+  (0x0058A,0x0058A), `Abs (0x0058A);
+  (0x005BE,0x005BE), `Abs (0x005BE);
+  (0x01400,0x01400), `Abs (0x01400);
+  (0x01806,0x01806), `Abs (0x01806);
+  (0x02010,0x02015), `Delta (0);
+  (0x02E17,0x02E17), `Abs (0x02E17);
+  (0x02E1A,0x02E1A), `Abs (0x02E1A);
+  (0x02E3A,0x02E3B), `Delta (0);
+  (0x02E40,0x02E40), `Abs (0x02E40);
+  (0x0301C,0x0301C), `Abs (0x0301C);
+  (0x03030,0x03030), `Abs (0x03030);
+  (0x030A0,0x030A0), `Abs (0x030A0);
+  (0x0FE31,0x0FE32), `Delta (0);
+  (0x0FE58,0x0FE58), `Abs (0x0FE58);
+  (0x0FE63,0x0FE63), `Abs (0x0FE63);
+  (0x0FF0D,0x0FF0D), `Abs (0x0FF0D);
+  (0x00028,0x00028), `Abs (0x00028);
+  (0x0005B,0x0005B), `Abs (0x0005B);
+  (0x0007B,0x0007B), `Abs (0x0007B);
+  (0x00F3A,0x00F3A), `Abs (0x00F3A);
+  (0x00F3C,0x00F3C), `Abs (0x00F3C);
+  (0x0169B,0x0169B), `Abs (0x0169B);
+  (0x0201A,0x0201A), `Abs (0x0201A);
+  (0x0201E,0x0201E), `Abs (0x0201E);
+  (0x02045,0x02045), `Abs (0x02045);
+  (0x0207D,0x0207D), `Abs (0x0207D);
+  (0x0208D,0x0208D), `Abs (0x0208D);
+  (0x02308,0x02308), `Abs (0x02308);
+  (0x0230A,0x0230A), `Abs (0x0230A);
+  (0x02329,0x02329), `Abs (0x02329);
+  (0x02768,0x02768), `Abs (0x02768);
+  (0x0276A,0x0276A), `Abs (0x0276A);
+  (0x0276C,0x0276C), `Abs (0x0276C);
+  (0x0276E,0x0276E), `Abs (0x0276E);
+  (0x02770,0x02770), `Abs (0x02770);
+  (0x02772,0x02772), `Abs (0x02772);
+  (0x02774,0x02774), `Abs (0x02774);
+  (0x027C5,0x027C5), `Abs (0x027C5);
+  (0x027E6,0x027E6), `Abs (0x027E6);
+  (0x027E8,0x027E8), `Abs (0x027E8);
+  (0x027EA,0x027EA), `Abs (0x027EA);
+  (0x027EC,0x027EC), `Abs (0x027EC);
+  (0x027EE,0x027EE), `Abs (0x027EE);
+  (0x02983,0x02983), `Abs (0x02983);
+  (0x02985,0x02985), `Abs (0x02985);
+  (0x02987,0x02987), `Abs (0x02987);
+  (0x02989,0x02989), `Abs (0x02989);
+  (0x0298B,0x0298B), `Abs (0x0298B);
+  (0x0298D,0x0298D), `Abs (0x0298D);
+  (0x0298F,0x0298F), `Abs (0x0298F);
+  (0x02991,0x02991), `Abs (0x02991);
+  (0x02993,0x02993), `Abs (0x02993);
+  (0x02995,0x02995), `Abs (0x02995);
+  (0x02997,0x02997), `Abs (0x02997);
+  (0x029D8,0x029D8), `Abs (0x029D8);
+  (0x029DA,0x029DA), `Abs (0x029DA);
+  (0x029FC,0x029FC), `Abs (0x029FC);
+  (0x02E22,0x02E22), `Abs (0x02E22);
+  (0x02E24,0x02E24), `Abs (0x02E24);
+  (0x02E26,0x02E26), `Abs (0x02E26);
+  (0x02E28,0x02E28), `Abs (0x02E28);
+  (0x02E42,0x02E42), `Abs (0x02E42);
+  (0x03008,0x03008), `Abs (0x03008);
+  (0x0300A,0x0300A), `Abs (0x0300A);
+  (0x0300C,0x0300C), `Abs (0x0300C);
+  (0x0300E,0x0300E), `Abs (0x0300E);
+  (0x03010,0x03010), `Abs (0x03010);
+  (0x03014,0x03014), `Abs (0x03014);
+  (0x03016,0x03016), `Abs (0x03016);
+  (0x03018,0x03018), `Abs (0x03018);
+  (0x0301A,0x0301A), `Abs (0x0301A);
+  (0x0301D,0x0301D), `Abs (0x0301D);
+  (0x0FD3F,0x0FD3F), `Abs (0x0FD3F);
+  (0x0FE17,0x0FE17), `Abs (0x0FE17);
+  (0x0FE35,0x0FE35), `Abs (0x0FE35);
+  (0x0FE37,0x0FE37), `Abs (0x0FE37);
+  (0x0FE39,0x0FE39), `Abs (0x0FE39);
+  (0x0FE3B,0x0FE3B), `Abs (0x0FE3B);
+  (0x0FE3D,0x0FE3D), `Abs (0x0FE3D);
+  (0x0FE3F,0x0FE3F), `Abs (0x0FE3F);
+  (0x0FE41,0x0FE41), `Abs (0x0FE41);
+  (0x0FE43,0x0FE43), `Abs (0x0FE43);
+  (0x0FE47,0x0FE47), `Abs (0x0FE47);
+  (0x0FE59,0x0FE59), `Abs (0x0FE59);
+  (0x0FE5B,0x0FE5B), `Abs (0x0FE5B);
+  (0x0FE5D,0x0FE5D), `Abs (0x0FE5D);
+  (0x0FF08,0x0FF08), `Abs (0x0FF08);
+  (0x0FF3B,0x0FF3B), `Abs (0x0FF3B);
+  (0x0FF5B,0x0FF5B), `Abs (0x0FF5B);
+  (0x0FF5F,0x0FF5F), `Abs (0x0FF5F);
+  (0x0FF62,0x0FF62), `Abs (0x0FF62);
+  (0x00029,0x00029), `Abs (0x00029);
+  (0x0005D,0x0005D), `Abs (0x0005D);
+  (0x0007D,0x0007D), `Abs (0x0007D);
+  (0x00F3B,0x00F3B), `Abs (0x00F3B);
+  (0x00F3D,0x00F3D), `Abs (0x00F3D);
+  (0x0169C,0x0169C), `Abs (0x0169C);
+  (0x02046,0x02046), `Abs (0x02046);
+  (0x0207E,0x0207E), `Abs (0x0207E);
+  (0x0208E,0x0208E), `Abs (0x0208E);
+  (0x02309,0x02309), `Abs (0x02309);
+  (0x0230B,0x0230B), `Abs (0x0230B);
+  (0x0232A,0x0232A), `Abs (0x0232A);
+  (0x02769,0x02769), `Abs (0x02769);
+  (0x0276B,0x0276B), `Abs (0x0276B);
+  (0x0276D,0x0276D), `Abs (0x0276D);
+  (0x0276F,0x0276F), `Abs (0x0276F);
+  (0x02771,0x02771), `Abs (0x02771);
+  (0x02773,0x02773), `Abs (0x02773);
+  (0x02775,0x02775), `Abs (0x02775);
+  (0x027C6,0x027C6), `Abs (0x027C6);
+  (0x027E7,0x027E7), `Abs (0x027E7);
+  (0x027E9,0x027E9), `Abs (0x027E9);
+  (0x027EB,0x027EB), `Abs (0x027EB);
+  (0x027ED,0x027ED), `Abs (0x027ED);
+  (0x027EF,0x027EF), `Abs (0x027EF);
+  (0x02984,0x02984), `Abs (0x02984);
+  (0x02986,0x02986), `Abs (0x02986);
+  (0x02988,0x02988), `Abs (0x02988);
+  (0x0298A,0x0298A), `Abs (0x0298A);
+  (0x0298C,0x0298C), `Abs (0x0298C);
+  (0x0298E,0x0298E), `Abs (0x0298E);
+  (0x02990,0x02990), `Abs (0x02990);
+  (0x02992,0x02992), `Abs (0x02992);
+  (0x02994,0x02994), `Abs (0x02994);
+  (0x02996,0x02996), `Abs (0x02996);
+  (0x02998,0x02998), `Abs (0x02998);
+  (0x029D9,0x029D9), `Abs (0x029D9);
+  (0x029DB,0x029DB), `Abs (0x029DB);
+  (0x029FD,0x029FD), `Abs (0x029FD);
+  (0x02E23,0x02E23), `Abs (0x02E23);
+  (0x02E25,0x02E25), `Abs (0x02E25);
+  (0x02E27,0x02E27), `Abs (0x02E27);
+  (0x02E29,0x02E29), `Abs (0x02E29);
+  (0x03009,0x03009), `Abs (0x03009);
+  (0x0300B,0x0300B), `Abs (0x0300B);
+  (0x0300D,0x0300D), `Abs (0x0300D);
+  (0x0300F,0x0300F), `Abs (0x0300F);
+  (0x03011,0x03011), `Abs (0x03011);
+  (0x03015,0x03015), `Abs (0x03015);
+  (0x03017,0x03017), `Abs (0x03017);
+  (0x03019,0x03019), `Abs (0x03019);
+  (0x0301B,0x0301B), `Abs (0x0301B);
+  (0x0301E,0x0301F), `Delta (0);
+  (0x0FD3E,0x0FD3E), `Abs (0x0FD3E);
+  (0x0FE18,0x0FE18), `Abs (0x0FE18);
+  (0x0FE36,0x0FE36), `Abs (0x0FE36);
+  (0x0FE38,0x0FE38), `Abs (0x0FE38);
+  (0x0FE3A,0x0FE3A), `Abs (0x0FE3A);
+  (0x0FE3C,0x0FE3C), `Abs (0x0FE3C);
+  (0x0FE3E,0x0FE3E), `Abs (0x0FE3E);
+  (0x0FE40,0x0FE40), `Abs (0x0FE40);
+  (0x0FE42,0x0FE42), `Abs (0x0FE42);
+  (0x0FE44,0x0FE44), `Abs (0x0FE44);
+  (0x0FE48,0x0FE48), `Abs (0x0FE48);
+  (0x0FE5A,0x0FE5A), `Abs (0x0FE5A);
+  (0x0FE5C,0x0FE5C), `Abs (0x0FE5C);
+  (0x0FE5E,0x0FE5E), `Abs (0x0FE5E);
+  (0x0FF09,0x0FF09), `Abs (0x0FF09);
+  (0x0FF3D,0x0FF3D), `Abs (0x0FF3D);
+  (0x0FF5D,0x0FF5D), `Abs (0x0FF5D);
+  (0x0FF60,0x0FF60), `Abs (0x0FF60);
+  (0x0FF63,0x0FF63), `Abs (0x0FF63);
+  (0x000AB,0x000AB), `Abs (0x000AB);
+  (0x02018,0x02018), `Abs (0x02018);
+  (0x0201B,0x0201C), `Delta (0);
+  (0x0201F,0x0201F), `Abs (0x0201F);
+  (0x02039,0x02039), `Abs (0x02039);
+  (0x02E02,0x02E02), `Abs (0x02E02);
+  (0x02E04,0x02E04), `Abs (0x02E04);
+  (0x02E09,0x02E09), `Abs (0x02E09);
+  (0x02E0C,0x02E0C), `Abs (0x02E0C);
+  (0x02E1C,0x02E1C), `Abs (0x02E1C);
+  (0x02E20,0x02E20), `Abs (0x02E20);
+  (0x000BB,0x000BB), `Abs (0x000BB);
+  (0x02019,0x02019), `Abs (0x02019);
+  (0x0201D,0x0201D), `Abs (0x0201D);
+  (0x0203A,0x0203A), `Abs (0x0203A);
+  (0x02E03,0x02E03), `Abs (0x02E03);
+  (0x02E05,0x02E05), `Abs (0x02E05);
+  (0x02E0A,0x02E0A), `Abs (0x02E0A);
+  (0x02E0D,0x02E0D), `Abs (0x02E0D);
+  (0x02E1D,0x02E1D), `Abs (0x02E1D);
+  (0x02E21,0x02E21), `Abs (0x02E21);
+  (0x00021,0x00023), `Delta (0);
+  (0x00025,0x00027), `Delta (0);
+  (0x0002A,0x0002A), `Abs (0x0002A);
+  (0x0002C,0x0002C), `Abs (0x0002C);
+  (0x0002E,0x0002F), `Delta (0);
+  (0x0003A,0x0003B), `Delta (0);
+  (0x0003F,0x00040), `Delta (0);
+  (0x0005C,0x0005C), `Abs (0x0005C);
+  (0x000A1,0x000A1), `Abs (0x000A1);
+  (0x000A7,0x000A7), `Abs (0x000A7);
+  (0x000B6,0x000B7), `Delta (0);
+  (0x000BF,0x000BF), `Abs (0x000BF);
+  (0x0037E,0x0037E), `Abs (0x0037E);
+  (0x00387,0x00387), `Abs (0x00387);
+  (0x0055A,0x0055F), `Delta (0);
+  (0x00589,0x00589), `Abs (0x00589);
+  (0x005C0,0x005C0), `Abs (0x005C0);
+  (0x005C3,0x005C3), `Abs (0x005C3);
+  (0x005C6,0x005C6), `Abs (0x005C6);
+  (0x005F3,0x005F4), `Delta (0);
+  (0x00609,0x0060A), `Delta (0);
+  (0x0060C,0x0060D), `Delta (0);
+  (0x0061B,0x0061B), `Abs (0x0061B);
+  (0x0061E,0x0061F), `Delta (0);
+  (0x0066A,0x0066D), `Delta (0);
+  (0x006D4,0x006D4), `Abs (0x006D4);
+  (0x00700,0x0070D), `Delta (0);
+  (0x007F7,0x007F9), `Delta (0);
+  (0x00830,0x0083E), `Delta (0);
+  (0x0085E,0x0085E), `Abs (0x0085E);
+  (0x00964,0x00965), `Delta (0);
+  (0x00970,0x00970), `Abs (0x00970);
+  (0x00AF0,0x00AF0), `Abs (0x00AF0);
+  (0x00DF4,0x00DF4), `Abs (0x00DF4);
+  (0x00E4F,0x00E4F), `Abs (0x00E4F);
+  (0x00E5A,0x00E5B), `Delta (0);
+  (0x00F04,0x00F12), `Delta (0);
+  (0x00F14,0x00F14), `Abs (0x00F14);
+  (0x00F85,0x00F85), `Abs (0x00F85);
+  (0x00FD0,0x00FD4), `Delta (0);
+  (0x00FD9,0x00FDA), `Delta (0);
+  (0x0104A,0x0104F), `Delta (0);
+  (0x010FB,0x010FB), `Abs (0x010FB);
+  (0x01360,0x01368), `Delta (0);
+  (0x0166D,0x0166E), `Delta (0);
+  (0x016EB,0x016ED), `Delta (0);
+  (0x01735,0x01736), `Delta (0);
+  (0x017D4,0x017D6), `Delta (0);
+  (0x017D8,0x017DA), `Delta (0);
+  (0x01800,0x01805), `Delta (0);
+  (0x01807,0x0180A), `Delta (0);
+  (0x01944,0x01945), `Delta (0);
+  (0x01A1E,0x01A1F), `Delta (0);
+  (0x01AA0,0x01AA6), `Delta (0);
+  (0x01AA8,0x01AAD), `Delta (0);
+  (0x01B5A,0x01B60), `Delta (0);
+  (0x01BFC,0x01BFF), `Delta (0);
+  (0x01C3B,0x01C3F), `Delta (0);
+  (0x01C7E,0x01C7F), `Delta (0);
+  (0x01CC0,0x01CC7), `Delta (0);
+  (0x01CD3,0x01CD3), `Abs (0x01CD3);
+  (0x02016,0x02017), `Delta (0);
+  (0x02020,0x02027), `Delta (0);
+  (0x02030,0x02038), `Delta (0);
+  (0x0203B,0x0203E), `Delta (0);
+  (0x02041,0x02043), `Delta (0);
+  (0x02047,0x02051), `Delta (0);
+  (0x02053,0x02053), `Abs (0x02053);
+  (0x02055,0x0205E), `Delta (0);
+  (0x02CF9,0x02CFC), `Delta (0);
+  (0x02CFE,0x02CFF), `Delta (0);
+  (0x02D70,0x02D70), `Abs (0x02D70);
+  (0x02E00,0x02E01), `Delta (0);
+  (0x02E06,0x02E08), `Delta (0);
+  (0x02E0B,0x02E0B), `Abs (0x02E0B);
+  (0x02E0E,0x02E16), `Delta (0);
+  (0x02E18,0x02E19), `Delta (0);
+  (0x02E1B,0x02E1B), `Abs (0x02E1B);
+  (0x02E1E,0x02E1F), `Delta (0);
+  (0x02E2A,0x02E2E), `Delta (0);
+  (0x02E30,0x02E39), `Delta (0);
+  (0x02E3C,0x02E3F), `Delta (0);
+  (0x02E41,0x02E41), `Abs (0x02E41);
+  (0x02E43,0x02E44), `Delta (0);
+  (0x03001,0x03003), `Delta (0);
+  (0x0303D,0x0303D), `Abs (0x0303D);
+  (0x030FB,0x030FB), `Abs (0x030FB);
+  (0x0A4FE,0x0A4FF), `Delta (0);
+  (0x0A60D,0x0A60F), `Delta (0);
+  (0x0A673,0x0A673), `Abs (0x0A673);
+  (0x0A67E,0x0A67E), `Abs (0x0A67E);
+  (0x0A6F2,0x0A6F7), `Delta (0);
+  (0x0A874,0x0A877), `Delta (0);
+  (0x0A8CE,0x0A8CF), `Delta (0);
+  (0x0A8F8,0x0A8FA), `Delta (0);
+  (0x0A8FC,0x0A8FC), `Abs (0x0A8FC);
+  (0x0A92E,0x0A92F), `Delta (0);
+  (0x0A95F,0x0A95F), `Abs (0x0A95F);
+  (0x0A9C1,0x0A9CD), `Delta (0);
+  (0x0A9DE,0x0A9DF), `Delta (0);
+  (0x0AA5C,0x0AA5F), `Delta (0);
+  (0x0AADE,0x0AADF), `Delta (0);
+  (0x0AAF0,0x0AAF1), `Delta (0);
+  (0x0ABEB,0x0ABEB), `Abs (0x0ABEB);
+  (0x0FE10,0x0FE16), `Delta (0);
+  (0x0FE19,0x0FE19), `Abs (0x0FE19);
+  (0x0FE30,0x0FE30), `Abs (0x0FE30);
+  (0x0FE45,0x0FE46), `Delta (0);
+  (0x0FE49,0x0FE4C), `Delta (0);
+  (0x0FE50,0x0FE52), `Delta (0);
+  (0x0FE54,0x0FE57), `Delta (0);
+  (0x0FE5F,0x0FE61), `Delta (0);
+  (0x0FE68,0x0FE68), `Abs (0x0FE68);
+  (0x0FE6A,0x0FE6B), `Delta (0);
+  (0x0FF01,0x0FF03), `Delta (0);
+  (0x0FF05,0x0FF07), `Delta (0);
+  (0x0FF0A,0x0FF0A), `Abs (0x0FF0A);
+  (0x0FF0C,0x0FF0C), `Abs (0x0FF0C);
+  (0x0FF0E,0x0FF0F), `Delta (0);
+  (0x0FF1A,0x0FF1B), `Delta (0);
+  (0x0FF1F,0x0FF20), `Delta (0);
+  (0x0FF3C,0x0FF3C), `Abs (0x0FF3C);
+  (0x0FF61,0x0FF61), `Abs (0x0FF61);
+  (0x0FF64,0x0FF65), `Delta (0);
+  (0x10100,0x10102), `Delta (0);
+  (0x1039F,0x1039F), `Abs (0x1039F);
+  (0x103D0,0x103D0), `Abs (0x103D0);
+  (0x1056F,0x1056F), `Abs (0x1056F);
+  (0x10857,0x10857), `Abs (0x10857);
+  (0x1091F,0x1091F), `Abs (0x1091F);
+  (0x1093F,0x1093F), `Abs (0x1093F);
+  (0x10A50,0x10A58), `Delta (0);
+  (0x10A7F,0x10A7F), `Abs (0x10A7F);
+  (0x10AF0,0x10AF6), `Delta (0);
+  (0x10B39,0x10B3F), `Delta (0);
+  (0x10B99,0x10B9C), `Delta (0);
+  (0x11047,0x1104D), `Delta (0);
+  (0x110BB,0x110BC), `Delta (0);
+  (0x110BE,0x110C1), `Delta (0);
+  (0x11140,0x11143), `Delta (0);
+  (0x11174,0x11175), `Delta (0);
+  (0x111C5,0x111C9), `Delta (0);
+  (0x111CD,0x111CD), `Abs (0x111CD);
+  (0x111DB,0x111DB), `Abs (0x111DB);
+  (0x111DD,0x111DF), `Delta (0);
+  (0x11238,0x1123D), `Delta (0);
+  (0x112A9,0x112A9), `Abs (0x112A9);
+  (0x1144B,0x1144F), `Delta (0);
+  (0x1145B,0x1145B), `Abs (0x1145B);
+  (0x1145D,0x1145D), `Abs (0x1145D);
+  (0x114C6,0x114C6), `Abs (0x114C6);
+  (0x115C1,0x115D7), `Delta (0);
+  (0x11641,0x11643), `Delta (0);
+  (0x11660,0x1166C), `Delta (0);
+  (0x1173C,0x1173E), `Delta (0);
+  (0x11C41,0x11C45), `Delta (0);
+  (0x11C70,0x11C71), `Delta (0);
+  (0x12470,0x12474), `Delta (0);
+  (0x16A6E,0x16A6F), `Delta (0);
+  (0x16AF5,0x16AF5), `Abs (0x16AF5);
+  (0x16B37,0x16B3B), `Delta (0);
+  (0x16B44,0x16B44), `Abs (0x16B44);
+  (0x1BC9F,0x1BC9F), `Abs (0x1BC9F);
+  (0x1DA87,0x1DA8B), `Delta (0);
+  (0x1E95E,0x1E95F), `Delta (0);
+  (0x0002B,0x0002B), `Abs (0x0002B);
+  (0x0003C,0x0003E), `Delta (0);
+  (0x0007C,0x0007C), `Abs (0x0007C);
+  (0x0007E,0x0007E), `Abs (0x0007E);
+  (0x000AC,0x000AC), `Abs (0x000AC);
+  (0x000B1,0x000B1), `Abs (0x000B1);
+  (0x000D7,0x000D7), `Abs (0x000D7);
+  (0x000F7,0x000F7), `Abs (0x000F7);
+  (0x003F6,0x003F6), `Abs (0x003F6);
+  (0x00606,0x00608), `Delta (0);
+  (0x02044,0x02044), `Abs (0x02044);
+  (0x02052,0x02052), `Abs (0x02052);
+  (0x0207A,0x0207C), `Delta (0);
+  (0x0208A,0x0208C), `Delta (0);
+  (0x02118,0x02118), `Abs (0x02118);
+  (0x02140,0x02144), `Delta (0);
+  (0x0214B,0x0214B), `Abs (0x0214B);
+  (0x02190,0x02194), `Delta (0);
+  (0x0219A,0x0219B), `Delta (0);
+  (0x021A0,0x021A0), `Abs (0x021A0);
+  (0x021A3,0x021A3), `Abs (0x021A3);
+  (0x021A6,0x021A6), `Abs (0x021A6);
+  (0x021AE,0x021AE), `Abs (0x021AE);
+  (0x021CE,0x021CF), `Delta (0);
+  (0x021D2,0x021D2), `Abs (0x021D2);
+  (0x021D4,0x021D4), `Abs (0x021D4);
+  (0x021F4,0x022FF), `Delta (0);
+  (0x02320,0x02321), `Delta (0);
+  (0x0237C,0x0237C), `Abs (0x0237C);
+  (0x0239B,0x023B3), `Delta (0);
+  (0x023DC,0x023E1), `Delta (0);
+  (0x025B7,0x025B7), `Abs (0x025B7);
+  (0x025C1,0x025C1), `Abs (0x025C1);
+  (0x025F8,0x025FF), `Delta (0);
+  (0x0266F,0x0266F), `Abs (0x0266F);
+  (0x027C0,0x027C4), `Delta (0);
+  (0x027C7,0x027E5), `Delta (0);
+  (0x027F0,0x027FF), `Delta (0);
+  (0x02900,0x02982), `Delta (0);
+  (0x02999,0x029D7), `Delta (0);
+  (0x029DC,0x029FB), `Delta (0);
+  (0x029FE,0x02AFF), `Delta (0);
+  (0x02B30,0x02B44), `Delta (0);
+  (0x02B47,0x02B4C), `Delta (0);
+  (0x0FB29,0x0FB29), `Abs (0x0FB29);
+  (0x0FE62,0x0FE62), `Abs (0x0FE62);
+  (0x0FE64,0x0FE66), `Delta (0);
+  (0x0FF0B,0x0FF0B), `Abs (0x0FF0B);
+  (0x0FF1C,0x0FF1E), `Delta (0);
+  (0x0FF5C,0x0FF5C), `Abs (0x0FF5C);
+  (0x0FF5E,0x0FF5E), `Abs (0x0FF5E);
+  (0x0FFE2,0x0FFE2), `Abs (0x0FFE2);
+  (0x0FFE9,0x0FFEC), `Delta (0);
+  (0x1D6C1,0x1D6C1), `Abs (0x1D6C1);
+  (0x1D6DB,0x1D6DB), `Abs (0x1D6DB);
+  (0x1D6FB,0x1D6FB), `Abs (0x1D6FB);
+  (0x1D715,0x1D715), `Abs (0x1D715);
+  (0x1D735,0x1D735), `Abs (0x1D735);
+  (0x1D74F,0x1D74F), `Abs (0x1D74F);
+  (0x1D76F,0x1D76F), `Abs (0x1D76F);
+  (0x1D789,0x1D789), `Abs (0x1D789);
+  (0x1D7A9,0x1D7A9), `Abs (0x1D7A9);
+  (0x1D7C3,0x1D7C3), `Abs (0x1D7C3);
+  (0x1EEF0,0x1EEF1), `Delta (0);
+  (0x00024,0x00024), `Abs (0x00024);
+  (0x000A2,0x000A5), `Delta (0);
+  (0x0058F,0x0058F), `Abs (0x0058F);
+  (0x0060B,0x0060B), `Abs (0x0060B);
+  (0x009F2,0x009F3), `Delta (0);
+  (0x009FB,0x009FB), `Abs (0x009FB);
+  (0x00AF1,0x00AF1), `Abs (0x00AF1);
+  (0x00BF9,0x00BF9), `Abs (0x00BF9);
+  (0x00E3F,0x00E3F), `Abs (0x00E3F);
+  (0x017DB,0x017DB), `Abs (0x017DB);
+  (0x020A0,0x020BE), `Delta (0);
+  (0x0A838,0x0A838), `Abs (0x0A838);
+  (0x0FDFC,0x0FDFC), `Abs (0x0FDFC);
+  (0x0FE69,0x0FE69), `Abs (0x0FE69);
+  (0x0FF04,0x0FF04), `Abs (0x0FF04);
+  (0x0FFE0,0x0FFE1), `Delta (0);
+  (0x0FFE5,0x0FFE6), `Delta (0);
+  (0x0005E,0x0005E), `Abs (0x0005E);
+  (0x00060,0x00060), `Abs (0x00060);
+  (0x000A8,0x000A8), `Abs (0x000A8);
+  (0x000AF,0x000AF), `Abs (0x000AF);
+  (0x000B4,0x000B4), `Abs (0x000B4);
+  (0x000B8,0x000B8), `Abs (0x000B8);
+  (0x002C2,0x002C5), `Delta (0);
+  (0x002D2,0x002DF), `Delta (0);
+  (0x002E5,0x002EB), `Delta (0);
+  (0x002ED,0x002ED), `Abs (0x002ED);
+  (0x002EF,0x002FF), `Delta (0);
+  (0x00375,0x00375), `Abs (0x00375);
+  (0x00384,0x00385), `Delta (0);
+  (0x01FBD,0x01FBD), `Abs (0x01FBD);
+  (0x01FBF,0x01FC1), `Delta (0);
+  (0x01FCD,0x01FCF), `Delta (0);
+  (0x01FDD,0x01FDF), `Delta (0);
+  (0x01FED,0x01FEF), `Delta (0);
+  (0x01FFD,0x01FFE), `Delta (0);
+  (0x0309B,0x0309C), `Delta (0);
+  (0x0A700,0x0A716), `Delta (0);
+  (0x0A720,0x0A721), `Delta (0);
+  (0x0A789,0x0A78A), `Delta (0);
+  (0x0AB5B,0x0AB5B), `Abs (0x0AB5B);
+  (0x0FBB2,0x0FBC1), `Delta (0);
+  (0x0FF3E,0x0FF3E), `Abs (0x0FF3E);
+  (0x0FF40,0x0FF40), `Abs (0x0FF40);
+  (0x0FFE3,0x0FFE3), `Abs (0x0FFE3);
+  (0x1F3FB,0x1F3FF), `Delta (0);
+  (0x000A6,0x000A6), `Abs (0x000A6);
+  (0x000A9,0x000A9), `Abs (0x000A9);
+  (0x000AE,0x000AE), `Abs (0x000AE);
+  (0x000B0,0x000B0), `Abs (0x000B0);
+  (0x00482,0x00482), `Abs (0x00482);
+  (0x0058D,0x0058E), `Delta (0);
+  (0x0060E,0x0060F), `Delta (0);
+  (0x006DE,0x006DE), `Abs (0x006DE);
+  (0x006E9,0x006E9), `Abs (0x006E9);
+  (0x006FD,0x006FE), `Delta (0);
+  (0x007F6,0x007F6), `Abs (0x007F6);
+  (0x009FA,0x009FA), `Abs (0x009FA);
+  (0x00B70,0x00B70), `Abs (0x00B70);
+  (0x00BF3,0x00BF8), `Delta (0);
+  (0x00BFA,0x00BFA), `Abs (0x00BFA);
+  (0x00C7F,0x00C7F), `Abs (0x00C7F);
+  (0x00D4F,0x00D4F), `Abs (0x00D4F);
+  (0x00D79,0x00D79), `Abs (0x00D79);
+  (0x00F01,0x00F03), `Delta (0);
+  (0x00F13,0x00F13), `Abs (0x00F13);
+  (0x00F15,0x00F17), `Delta (0);
+  (0x00F1A,0x00F1F), `Delta (0);
+  (0x00F34,0x00F34), `Abs (0x00F34);
+  (0x00F36,0x00F36), `Abs (0x00F36);
+  (0x00F38,0x00F38), `Abs (0x00F38);
+  (0x00FBE,0x00FC5), `Delta (0);
+  (0x00FC7,0x00FCC), `Delta (0);
+  (0x00FCE,0x00FCF), `Delta (0);
+  (0x00FD5,0x00FD8), `Delta (0);
+  (0x0109E,0x0109F), `Delta (0);
+  (0x01390,0x01399), `Delta (0);
+  (0x01940,0x01940), `Abs (0x01940);
+  (0x019DE,0x019FF), `Delta (0);
+  (0x01B61,0x01B6A), `Delta (0);
+  (0x01B74,0x01B7C), `Delta (0);
+  (0x02100,0x02101), `Delta (0);
+  (0x02103,0x02106), `Delta (0);
+  (0x02108,0x02109), `Delta (0);
+  (0x02114,0x02114), `Abs (0x02114);
+  (0x02116,0x02117), `Delta (0);
+  (0x0211E,0x02123), `Delta (0);
+  (0x02125,0x02125), `Abs (0x02125);
+  (0x02127,0x02127), `Abs (0x02127);
+  (0x02129,0x02129), `Abs (0x02129);
+  (0x0212E,0x0212E), `Abs (0x0212E);
+  (0x0213A,0x0213B), `Delta (0);
+  (0x0214A,0x0214A), `Abs (0x0214A);
+  (0x0214C,0x0214D), `Delta (0);
+  (0x0214F,0x0214F), `Abs (0x0214F);
+  (0x0218A,0x0218B), `Delta (0);
+  (0x02195,0x02199), `Delta (0);
+  (0x0219C,0x0219F), `Delta (0);
+  (0x021A1,0x021A2), `Delta (0);
+  (0x021A4,0x021A5), `Delta (0);
+  (0x021A7,0x021AD), `Delta (0);
+  (0x021AF,0x021CD), `Delta (0);
+  (0x021D0,0x021D1), `Delta (0);
+  (0x021D3,0x021D3), `Abs (0x021D3);
+  (0x021D5,0x021F3), `Delta (0);
+  (0x02300,0x02307), `Delta (0);
+  (0x0230C,0x0231F), `Delta (0);
+  (0x02322,0x02328), `Delta (0);
+  (0x0232B,0x0237B), `Delta (0);
+  (0x0237D,0x0239A), `Delta (0);
+  (0x023B4,0x023DB), `Delta (0);
+  (0x023E2,0x023FE), `Delta (0);
+  (0x02400,0x02426), `Delta (0);
+  (0x02440,0x0244A), `Delta (0);
+  (0x0249C,0x024B5), `Delta (0);
+  (0x024B6,0x024CF), `Delta (26);
+  (0x024D0,0x024E9), `Delta (0);
+  (0x02500,0x025B6), `Delta (0);
+  (0x025B8,0x025C0), `Delta (0);
+  (0x025C2,0x025F7), `Delta (0);
+  (0x02600,0x0266E), `Delta (0);
+  (0x02670,0x02767), `Delta (0);
+  (0x02794,0x027BF), `Delta (0);
+  (0x02800,0x028FF), `Delta (0);
+  (0x02B00,0x02B2F), `Delta (0);
+  (0x02B45,0x02B46), `Delta (0);
+  (0x02B4D,0x02B73), `Delta (0);
+  (0x02B76,0x02B95), `Delta (0);
+  (0x02B98,0x02BB9), `Delta (0);
+  (0x02BBD,0x02BC8), `Delta (0);
+  (0x02BCA,0x02BD1), `Delta (0);
+  (0x02BEC,0x02BEF), `Delta (0);
+  (0x02CE5,0x02CEA), `Delta (0);
+  (0x02E80,0x02E99), `Delta (0);
+  (0x02E9B,0x02EF3), `Delta (0);
+  (0x02F00,0x02FD5), `Delta (0);
+  (0x02FF0,0x02FFB), `Delta (0);
+  (0x03004,0x03004), `Abs (0x03004);
+  (0x03012,0x03013), `Delta (0);
+  (0x03020,0x03020), `Abs (0x03020);
+  (0x03036,0x03037), `Delta (0);
+  (0x0303E,0x0303F), `Delta (0);
+  (0x03190,0x03191), `Delta (0);
+  (0x03196,0x0319F), `Delta (0);
+  (0x031C0,0x031E3), `Delta (0);
+  (0x03200,0x0321E), `Delta (0);
+  (0x0322A,0x03247), `Delta (0);
+  (0x03250,0x03250), `Abs (0x03250);
+  (0x03260,0x0327F), `Delta (0);
+  (0x0328A,0x032B0), `Delta (0);
+  (0x032C0,0x032FE), `Delta (0);
+  (0x03300,0x033FF), `Delta (0);
+  (0x04DC0,0x04DFF), `Delta (0);
+  (0x0A490,0x0A4C6), `Delta (0);
+  (0x0A828,0x0A82B), `Delta (0);
+  (0x0A836,0x0A837), `Delta (0);
+  (0x0A839,0x0A839), `Abs (0x0A839);
+  (0x0AA77,0x0AA79), `Delta (0);
+  (0x0FDFD,0x0FDFD), `Abs (0x0FDFD);
+  (0x0FFE4,0x0FFE4), `Abs (0x0FFE4);
+  (0x0FFE8,0x0FFE8), `Abs (0x0FFE8);
+  (0x0FFED,0x0FFEE), `Delta (0);
+  (0x0FFFC,0x0FFFD), `Delta (0);
+  (0x10137,0x1013F), `Delta (0);
+  (0x10179,0x10189), `Delta (0);
+  (0x1018C,0x1018E), `Delta (0);
+  (0x10190,0x1019B), `Delta (0);
+  (0x101A0,0x101A0), `Abs (0x101A0);
+  (0x101D0,0x101FC), `Delta (0);
+  (0x10877,0x10878), `Delta (0);
+  (0x10AC8,0x10AC8), `Abs (0x10AC8);
+  (0x1173F,0x1173F), `Abs (0x1173F);
+  (0x16B3C,0x16B3F), `Delta (0);
+  (0x16B45,0x16B45), `Abs (0x16B45);
+  (0x1BC9C,0x1BC9C), `Abs (0x1BC9C);
+  (0x1D000,0x1D0F5), `Delta (0);
+  (0x1D100,0x1D126), `Delta (0);
+  (0x1D129,0x1D164), `Delta (0);
+  (0x1D16A,0x1D16C), `Delta (0);
+  (0x1D183,0x1D184), `Delta (0);
+  (0x1D18C,0x1D1A9), `Delta (0);
+  (0x1D1AE,0x1D1E8), `Delta (0);
+  (0x1D200,0x1D241), `Delta (0);
+  (0x1D245,0x1D245), `Abs (0x1D245);
+  (0x1D300,0x1D356), `Delta (0);
+  (0x1D800,0x1D9FF), `Delta (0);
+  (0x1DA37,0x1DA3A), `Delta (0);
+  (0x1DA6D,0x1DA74), `Delta (0);
+  (0x1DA76,0x1DA83), `Delta (0);
+  (0x1DA85,0x1DA86), `Delta (0);
+  (0x1F000,0x1F02B), `Delta (0);
+  (0x1F030,0x1F093), `Delta (0);
+  (0x1F0A0,0x1F0AE), `Delta (0);
+  (0x1F0B1,0x1F0BF), `Delta (0);
+  (0x1F0C1,0x1F0CF), `Delta (0);
+  (0x1F0D1,0x1F0F5), `Delta (0);
+  (0x1F110,0x1F12E), `Delta (0);
+  (0x1F130,0x1F16B), `Delta (0);
+  (0x1F170,0x1F1AC), `Delta (0);
+  (0x1F1E6,0x1F202), `Delta (0);
+  (0x1F210,0x1F23B), `Delta (0);
+  (0x1F240,0x1F248), `Delta (0);
+  (0x1F250,0x1F251), `Delta (0);
+  (0x1F300,0x1F3FA), `Delta (0);
+  (0x1F400,0x1F6D2), `Delta (0);
+  (0x1F6E0,0x1F6EC), `Delta (0);
+  (0x1F6F0,0x1F6F6), `Delta (0);
+  (0x1F700,0x1F773), `Delta (0);
+  (0x1F780,0x1F7D4), `Delta (0);
+  (0x1F800,0x1F80B), `Delta (0);
+  (0x1F810,0x1F847), `Delta (0);
+  (0x1F850,0x1F859), `Delta (0);
+  (0x1F860,0x1F887), `Delta (0);
+  (0x1F890,0x1F8AD), `Delta (0);
+  (0x1F910,0x1F91E), `Delta (0);
+  (0x1F920,0x1F927), `Delta (0);
+  (0x1F930,0x1F930), `Abs (0x1F930);
+  (0x1F933,0x1F93E), `Delta (0);
+  (0x1F940,0x1F94B), `Delta (0);
+  (0x1F950,0x1F95E), `Delta (0);
+  (0x1F980,0x1F991), `Delta (0)
+];;
diff --git a/lib/unionfind.ml b/clib/unionfind.ml
index 6e131d8f..980064a6 100644
--- a/lib/unionfind.ml
+++ b/clib/unionfind.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** An imperative implementation of partitions via Union-Find *)
diff --git a/lib/unionfind.mli b/clib/unionfind.mli
index ea249ae2..e5a3a438 100644
--- a/lib/unionfind.mli
+++ b/clib/unionfind.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** An imperative implementation of partitions via Union-Find *)
diff --git a/config/coq_config.mli b/config/coq_config.mli
index c171bd35..29065d3e 100644
--- a/config/coq_config.mli
+++ b/config/coq_config.mli
@@ -1,18 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val local : bool        (* local use (no installation) *)
 
-val coqlib : string option (* where the std library is installed *)
-val configdir : string option (* where configuration files are installed *)
-val datadir : string option (* where extra data files are installed *)
+(* The fields below are absolute paths *)
+val coqlib : string     (* where the std library is installed *)
+val configdir : string  (* where configuration files are installed *)
+val datadir : string    (* where extra data files are installed *)
 val docdir : string     (* where the doc is installed *)
 
+(* The fields below are paths relative to the installation prefix *)
+(* However, if an absolute path, it means discarding the actual prefix *)
+val coqlibsuffix : string    (* std library relative to installation prefix *)
+val configdirsuffix : string (* config files relative to installation prefix *)
+val datadirsuffix : string   (* data files relative to installation prefix *)
+val docdirsuffix : string    (* doc directory relative to installation prefix *)
+
 val ocaml : string      (* names of ocaml binaries *)
 val ocamlfind : string
 val ocamllex : string
@@ -20,35 +30,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 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
@@ -60,10 +68,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 b/configure
index 09585e59..4f11b2c2 100755
--- a/configure
+++ b/configure
@@ -3,7 +3,7 @@
 ## This micro-configure shell script is here only to
 ## launch the real configuration via ocaml
 
-cmd=ocaml
+ocaml=ocaml
 script=./configure.ml
 
 if [ ! -f $script ]; then
@@ -16,17 +16,18 @@ fi
 ## Parse the args, only looking for -camldir
 ## We avoid using shift to keep "$@" intact
 
+cmd=$ocaml
 last=
 for i; do
    case $last in
-       -camldir|--camldir) cmd="$i/ocaml"; break;;
+       -camldir) cmd="$i/$ocaml"; break;;
    esac
    last=$i
 done
 
 ## We check that $cmd is ok before the real exec $cmd
 
-`$cmd -version > /dev/null 2>&1` && exec $cmd $script "$@"
+`$cmd -version > /dev/null 2>&1` && exec $cmd -w "-3" $script "$@"
 
 ## If we're still here, something is wrong with $cmd
 
diff --git a/configure.ml b/configure.ml
index 99f5ae54..5bbf0111 100644
--- a/configure.ml
+++ b/configure.ml
@@ -11,19 +11,21 @@
 #load "str.cma"
 open Printf
 
-let coq_version = "8.6"
-let coq_macos_version = "8.6.00" (** "[...] should be a string comprised of
+let coq_version = "8.8.2"
+let coq_macos_version = "8.8.2" (** "[...] should be a string comprised of
 three non-negative, period-separated integers [...]" *)
-let vo_magic = 8600
-let state_magic = 58600
-let distributed_exec = ["coqtop";"coqc";"coqchk";"coqdoc";"coqmktop";"coqworkmgr";
+let vo_magic = 8800
+let state_magic = 58800
+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 *)
 
 (** * Utility functions *)
-
-let die msg = eprintf "%s\nConfiguration script failed!\n" msg; exit 1
+let cfprintf oc = kfprintf (fun oc -> fprintf oc "\n%!") oc
+let cprintf s = cfprintf stdout s
+let ceprintf s = cfprintf stderr s
+let die msg = ceprintf "%s\nConfiguration script failed!" msg; exit 1
 
 let s2i = int_of_string
 let i2s = string_of_int
@@ -107,7 +109,7 @@ let run ?(fatal=true) ?(err=StdErr) prog args =
       let cmd = String.concat " " (prog::args) in
       let exn = match e with Failure s -> s | _ -> Printexc.to_string e in
       let msg = sprintf "Error while running '%s' (%s)" cmd exn in
-      if fatal then die msg else (printf "W: %s\n" msg; "", [])
+      if fatal then die msg else (cprintf "W: %s" msg; "", [])
 
 let tryrun prog args = run ~fatal:false ~err:DevNull prog args
 
@@ -178,8 +180,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']
@@ -189,7 +205,7 @@ let win_aware_quote_executable str =
     sprintf "%S" str
   else
     let _ = if contains_suspicious_characters str then
-      printf "*Warning* The string %S contains suspicious characters; ocamlfind might fail\n" str in
+      cprintf "*Warning* The string %S contains suspicious characters; ocamlfind might fail" str in
     Str.global_replace (Str.regexp "\\\\") "/" str
 
 (** * Date *)
@@ -206,7 +222,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 ()
@@ -221,6 +237,101 @@ let _ = if not (dir_exists "bin") then Unix.mkdir "bin" 0o755
 
 type ide = Opt | Byte | No
 
+type preferences = {
+  prefix : string option;
+  local : bool;
+  vmbyteflags : string option;
+  custom : bool option;
+  bindir : string option;
+  libdir : string option;
+  configdir : string option;
+  datadir : string option;
+  mandir : string option;
+  docdir : string option;
+  emacslib : string option;
+  coqdocdir : string option;
+  ocamlfindcmd : string option;
+  lablgtkdir : string option;
+  camlp5dir : string option;
+  arch : string option;
+  natdynlink : bool;
+  coqide : ide option;
+  macintegration : bool;
+  browser : string option;
+  withdoc : bool;
+  byteonly : bool;
+  flambda_flags : string list;
+  debug : bool;
+  profile : bool;
+  bin_annot : bool;
+  annot : bool;
+  bytecodecompiler : bool;
+  nativecompiler : bool;
+  coqwebsite : string;
+  force_caml_version : bool;
+  force_findlib_version : bool;
+  warn_error : bool;
+}
+
+module Profiles = struct
+
+let default = {
+  prefix = None;
+  local = false;
+  vmbyteflags = None;
+  custom = None;
+  bindir = None;
+  libdir = None;
+  configdir = None;
+  datadir = None;
+  mandir = None;
+  docdir = None;
+  emacslib = None;
+  coqdocdir = None;
+  ocamlfindcmd = None;
+  lablgtkdir = None;
+  camlp5dir = None;
+  arch = None;
+  natdynlink = true;
+  coqide = None;
+  macintegration = true;
+  browser = None;
+  withdoc = false;
+  byteonly = false;
+  flambda_flags = [];
+  debug = true;
+  profile = false;
+  bin_annot = false;
+  annot = false;
+  bytecodecompiler = true;
+  nativecompiler = not (os_type_win32 || os_type_cygwin);
+  coqwebsite = "http://coq.inria.fr/";
+  force_caml_version = false;
+  force_findlib_version = false;
+  warn_error = false;
+}
+
+let devel state = { state with
+  local = true;
+  bin_annot = true;
+  annot = true;
+  warn_error = true;
+}
+let devel_doc = "-local -annot -bin-annot -warn-error yes"
+
+let get = function
+  | "devel" -> devel
+  | s -> raise (Arg.Bad ("profile name expected instead of "^s))
+
+let doc =
+  "<profile> Sets a bunch of flags. Supported profiles:
+     devel = " ^ devel_doc
+
+end
+
+let prefs = ref Profiles.default
+
+
 let get_bool = function
   | "true" | "yes" | "y" | "all" -> true
   | "false" | "no" | "n" -> false
@@ -232,123 +343,99 @@ let get_ide = function
   | "no" -> No
   | s -> raise (Arg.Bad ("(opt|byte|no) argument expected instead of "^s))
 
-let arg_bool r = Arg.String (fun s -> r := get_bool s)
-
-let arg_string_option r = Arg.String (fun s -> r := Some s)
-
-module Prefs = struct
-  let prefix = ref (None : string option)
-  let local = ref false
-  let vmbyteflags = ref (None : string option)
-  let custom = ref (None : bool option)
-  let bindir = ref (None : string option)
-  let libdir = ref (None : string option)
-  let configdir = ref (None : string option)
-  let datadir = ref (None : string option)
-  let mandir = ref (None : string option)
-  let docdir = ref (None : string option)
-  let emacslib = ref (None : string option)
-  let coqdocdir = ref (None : string option)
-  let ocamlfindcmd = ref (None : string option)
-  let lablgtkdir = ref (None : string option)
-  let usecamlp5 = ref true
-  let camlp5dir = ref (None : string option)
-  let arch = ref (None : string option)
-  let natdynlink = ref true
-  let coqide = ref (None : ide option)
-  let macintegration = ref true
-  let browser = ref (None : string option)
-  let withdoc = ref false
-  let geoproof = ref false
-  let byteonly = ref false
-  let debug = ref false
-  let profile = ref false
-  let annotate = ref false
-  let nativecompiler = ref (not (os_type_win32 || os_type_cygwin))
-  let coqwebsite = ref "http://coq.inria.fr/"
-  let force_caml_version = ref false
-end
+let arg_bool f = Arg.String (fun s -> prefs := f !prefs (get_bool s))
+
+let arg_string f = Arg.String (fun s -> prefs := f !prefs s)
+let arg_string_option f = Arg.String (fun s -> prefs := f !prefs (Some s))
+let arg_string_list c f = Arg.String (fun s -> prefs := f !prefs (string_split c s))
+
+let arg_set f = Arg.Unit (fun () -> prefs := f !prefs true)
+let arg_clear f = Arg.Unit (fun () -> prefs := f !prefs false)
+
+let arg_set_option f = Arg.Unit (fun () -> prefs := f !prefs (Some true))
+let arg_clear_option f = Arg.Unit (fun () -> prefs := f !prefs (Some false))
+
+let arg_ide f = Arg.String (fun s -> prefs := f !prefs (Some (get_ide s)))
+
+let arg_profile = Arg.String (fun s -> prefs := Profiles.get s !prefs)
 
 (* TODO : earlier any option -foo was also available as --foo *)
 
 let args_options = Arg.align [
-  "-prefix", arg_string_option Prefs.prefix,
+  "-prefix", arg_string_option (fun p prefix -> { p with prefix }),
     "<dir> Set installation directory to <dir>";
-  "-local", Arg.Set Prefs.local,
+  "-local", arg_set (fun p local -> { p with local }),
     " Set installation directory to the current source tree";
-  "-vmbyteflags", arg_string_option Prefs.vmbyteflags,
+  "-vmbyteflags", arg_string_option (fun p vmbyteflags -> { p with vmbyteflags }),
     "<flags> Comma-separated link flags for the VM of coqtop.byte";
-  "-custom", Arg.Unit (fun () -> Prefs.custom := Some true),
+  "-custom", arg_set_option (fun p custom -> { p with custom }),
     " Build bytecode executables with -custom (not recommended)";
-  "-no-custom", Arg.Unit (fun () -> Prefs.custom := Some false),
+  "-no-custom", arg_clear_option (fun p custom -> { p with custom }),
     " Do not build with -custom on Windows and MacOS";
-  "-bindir", arg_string_option Prefs.bindir,
+  "-bindir", arg_string_option (fun p bindir -> { p with bindir }),
     "<dir> Where to install bin files";
-  "-libdir", arg_string_option Prefs.libdir,
+  "-libdir", arg_string_option (fun p libdir -> { p with libdir }),
     "<dir> Where to install lib files";
-  "-configdir", arg_string_option Prefs.configdir,
+  "-configdir", arg_string_option (fun p configdir -> { p with configdir }),
     "<dir> Where to install config files";
-  "-datadir", arg_string_option Prefs.datadir,
+  "-datadir", arg_string_option (fun p datadir -> { p with datadir }),
     "<dir> Where to install data files";
-  "-mandir", arg_string_option Prefs.mandir,
+  "-mandir", arg_string_option (fun p mandir -> { p with mandir }),
     "<dir> Where to install man files";
-  "-docdir", arg_string_option Prefs.docdir,
+  "-docdir", arg_string_option (fun p docdir -> { p with docdir }),
     "<dir> Where to install doc files";
-  "-emacslib", arg_string_option Prefs.emacslib,
+  "-emacslib", arg_string_option (fun p emacslib -> { p with emacslib }),
     "<dir> Where to install emacs files";
-  "-emacs", Arg.String (fun s ->
-      printf "Warning: obsolete -emacs option\n";
-      Prefs.emacslib := Some s),
-    "<dir> Obsolete: same as -emacslib";
-  "-coqdocdir", arg_string_option Prefs.coqdocdir,
+  "-coqdocdir", arg_string_option (fun p coqdocdir -> { p with coqdocdir }),
     "<dir> Where to install Coqdoc style files";
-  "-ocamlfind", arg_string_option Prefs.ocamlfindcmd,
+  "-ocamlfind", arg_string_option (fun p ocamlfindcmd -> { p with ocamlfindcmd }),
     "<dir> Specifies the ocamlfind command to use";
-  "-lablgtkdir", arg_string_option Prefs.lablgtkdir,
+  "-lablgtkdir", arg_string_option (fun p lablgtkdir -> { p with lablgtkdir }),
     "<dir> Specifies the path to the Lablgtk library";
-  "-usecamlp5", Arg.Set Prefs.usecamlp5,
-    " Specifies to use camlp5 instead of camlp4";
-  "-usecamlp4", Arg.Clear Prefs.usecamlp5,
-    " Specifies to use camlp4 instead of camlp5";
-  "-camlp5dir",
-    Arg.String (fun s -> Prefs.usecamlp5:=true; Prefs.camlp5dir:=Some s),
+  "-camlp5dir", arg_string_option (fun p camlp5dir -> { p with camlp5dir }),
     "<dir> Specifies where is the Camlp5 library and tells to use it";
-  "-arch", arg_string_option Prefs.arch,
+  "-flambda-opts", arg_string_list ' ' (fun p flambda_flags -> { p with flambda_flags }),
+    "<flags> Specifies additional flags to be passed to the flambda optimizing compiler";
+  "-arch", arg_string_option (fun p arch -> { p with arch }),
     "<arch> Specifies the architecture";
-  "-opt", Arg.Unit (fun () -> printf "Warning: obsolete -opt option\n"),
-    " Obsolete: native OCaml executables detected automatically";
-  "-natdynlink", arg_bool Prefs.natdynlink,
+  "-natdynlink", arg_bool (fun p natdynlink -> { p with natdynlink }),
     "(yes|no) Use dynamic loading of native code or not";
-  "-coqide", Arg.String (fun s -> Prefs.coqide := Some (get_ide s)),
-    "(opt|byte|no) Specifies whether or not to compile Coqide";
-  "-nomacintegration", Arg.Clear Prefs.macintegration,
-    " Do not try to build coqide mac integration";
-  "-browser", arg_string_option Prefs.browser,
+  "-coqide", arg_ide (fun p coqide -> { p with coqide }),
+    "(opt|byte|no) Specifies whether or not to compile CoqIDE";
+  "-nomacintegration", arg_clear (fun p macintegration -> { p with macintegration }),
+    " Do not try to build CoqIDE MacOS integration";
+  "-browser", arg_string_option (fun p browser -> { p with browser }),
     "<command> Use <command> to open URL %s";
-  "-nodoc", Arg.Clear Prefs.withdoc,
-    " Do not compile the documentation";
-  "-with-doc", arg_bool Prefs.withdoc,
+  "-with-doc", arg_bool (fun p withdoc -> { p with 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";
-  "-byteonly", Arg.Set Prefs.byteonly,
+  "-byte-only", arg_set (fun p byteonly -> { p with byteonly }),
     " Compiles only bytecode version of Coq";
-  "-debug", Arg.Set Prefs.debug,
-    " Add debugging information in the Coq executables";
-  "-profile", Arg.Set Prefs.profile,
+  "-nodebug", arg_clear (fun p debug -> { p with debug }),
+    " Do not add debugging information in the Coq executables";
+  "-profiling", arg_set (fun p profile -> { p with profile }),
     " Add profiling information in the Coq executables";
-  "-annotate", Arg.Set Prefs.annotate,
-    " Dumps ml annotation files while compiling Coq";
-  "-makecmd", Arg.String (fun _ -> printf "Warning: obsolete -makecmd option\n"),
-    "<command> Obsolete: name of GNU Make command";
-  "-native-compiler", arg_bool Prefs.nativecompiler,
+  "-annotate", Arg.Unit (fun () -> cprintf "*Warning* -annotate is deprecated. Please use -annot or -bin-annot instead."),
+    " Deprecated. Please use -annot or -bin-annot instead";
+  "-annot", arg_set (fun p annot -> { p with annot }),
+    " Dumps ml text annotation files while compiling Coq (e.g. for Tuareg)";
+  "-bin-annot", arg_set (fun p bin_annot -> { p with bin_annot }),
+    " Dumps ml binary annotation files while compiling Coq (e.g. for Merlin)";
+  "-bytecode-compiler", arg_bool (fun p bytecodecompiler -> { p with bytecodecompiler }),
+    "(yes|no) Enable Coq's bytecode reduction machine (VM)";
+  "-native-compiler", arg_bool (fun p nativecompiler -> { p with nativecompiler }),
     "(yes|no) Compilation to native code for conversion and normalization";
-  "-coqwebsite", Arg.Set_string Prefs.coqwebsite,
+  "-coqwebsite", arg_string (fun p coqwebsite -> { p with coqwebsite }),
     " URL of the coq website";
-  "-force-caml-version", Arg.Set Prefs.force_caml_version,
+  "-force-caml-version", arg_set (fun p force_caml_version -> { p with force_caml_version }),
     " Force OCaml version";
+  "-force-findlib-version", arg_set (fun p force_findlib_version -> { p with force_findlib_version }),
+    " Force findlib version";
+  "-warn-error", arg_bool (fun p warn_error -> { p with warn_error }),
+    "(yes|no) Make OCaml warnings into errors (default no)";
+  "-camldir", Arg.String (fun _ -> ()),
+    "<dir> Specifies path to 'ocaml' for running configure script";
+  "-profile", arg_profile,
+    Profiles.doc
 ]
 
 let parse_args () =
@@ -356,7 +443,7 @@ let parse_args () =
     args_options
     (fun s -> raise (Arg.Bad ("Unknown option: "^s)))
     "Available options for configure are:";
-  if !Prefs.local && !Prefs.prefix <> None then
+  if !prefs.local && !prefs.prefix <> None then
     die "Options -prefix and -local are incompatible."
 
 let _ = parse_args ()
@@ -377,12 +464,14 @@ let reset_caml_lex c o = c.lex <- o
 let reset_caml_top c o = c.top <- o
 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 "-dtypes"
-  else ""
+let coq_debug_flag = if !prefs.debug then "-g" else ""
+let coq_profile_flag = if !prefs.profile then "-p" else ""
+let coq_annot_flag = if !prefs.annot then "-annot" else ""
+let coq_bin_annot_flag = if !prefs.bin_annot then "-bin-annot" 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"
 
@@ -396,8 +485,8 @@ let arch_progs =
    ("/usr/ucb/arch", []) ]
 
 let query_arch () =
-  printf "I can not automatically find the name of your architecture.\n";
-  printf "Give me a name, please [win32 for Win95, Win98 or WinNT]: %!";
+  cprintf "I can not automatically find the name of your architecture.";
+  cprintf "Give me a name, please [win32 for Win95, Win98 or WinNT]: %!";
   read_line ()
 
 let rec try_archs = function
@@ -407,7 +496,7 @@ let rec try_archs = function
   | _ :: rest -> try_archs rest
   | [] -> query_arch ()
 
-let arch = match !Prefs.arch with
+let arch = match !prefs.arch with
   | Some a -> a
   | None ->
     let arch,_ = tryrun "uname" ["-s"] in
@@ -416,11 +505,11 @@ let arch = match !Prefs.arch with
     else if arch <> "" then arch
     else try_archs arch_progs
 
-(** NB: [arch_win32] is broader than [os_type_win32], cf. cygwin *)
+(** NB: [arch_is_win32] is broader than [os_type_win32], cf. cygwin *)
 
-let arch_win32 = (arch = "win32")
+let arch_is_win32 = (arch = "win32")
 
-let exe = exe := if arch_win32 then ".exe" else ""; !exe
+let exe = exe := if arch_is_win32 then ".exe" else ""; !exe
 let dll = if os_type_win32 then ".dll" else ".so"
 
 (** * VCS
@@ -435,19 +524,35 @@ 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
+    cprintf "Creating pre-commit hook in %s" 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 =
-  match !Prefs.browser with
+  match !prefs.browser with
   | Some b -> b
-  | None when arch_win32 -> "start %s"
+  | None when arch_is_win32 -> "start %s"
   | None when arch = "Darwin" -> "open %s"
   | _ -> "firefox -remote \"OpenURL(%s,new-tab)\" || firefox %s &"
 
 (** * OCaml programs *)
 
-let camlbin, caml_version, camllib =
-  let () = match !Prefs.ocamlfindcmd with
+let camlbin, caml_version, camllib, findlib_version =
+  let () = match !prefs.ocamlfindcmd with
     | Some cmd -> reset_caml_find camlexec cmd
     | None ->
        try reset_caml_find camlexec (which camlexec.find)
@@ -458,6 +563,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 *)
@@ -468,9 +574,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"] *)
 
@@ -487,48 +593,104 @@ let caml_version_nums =
          "Is it installed properly?")
 
 let check_caml_version () =
-  if caml_version_nums >= [4;1;0] then
-    if caml_version_nums = [4;2;0] && not !Prefs.force_caml_version then
-      die ("Your version of OCaml is 4.02.0 which suffers from a bug inducing\n" ^
-        "very slow compilation times. If you still want to use it, use \n" ^
-        "option -force-caml-version.\n")
-    else
-      printf "You have OCaml %s. Good!\n" caml_version
+  if caml_version_nums >= [4;2;3] then
+    cprintf "You have OCaml %s. Good!" caml_version
   else
-    let () = printf "Your version of OCaml is %s.\n" caml_version in
-    if !Prefs.force_caml_version then
-      printf "*Warning* Your version of OCaml is outdated.\n"
+    let () = cprintf "Your version of OCaml is %s." caml_version in
+    if !prefs.force_caml_version then
+      cprintf "*Warning* Your version of OCaml is outdated."
     else
-      die "You need OCaml 4.01 or later."
+      die "You need OCaml 4.02.3 or later."
 
 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 camltag = match caml_version_list with
-  | x::y::_ -> "OCAML"^x^y
-  | _ -> assert false
+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
+    cprintf "You have OCamlfind %s. Good!" findlib_version
+  else
+    let () = cprintf "Your version of OCamlfind is %s." findlib_version in
+    if !prefs.force_findlib_version then
+      cprintf "*Warning* Your version of OCamlfind is outdated."
+    else
+      die "You need OCamlfind 1.4.1 or later."
 
-(** * CamlpX configuration *)
+let _ = check_findlib_version ()
 
-(* Convention: we use camldir as a prioritary location for camlpX, if given *)
+let camltag = match caml_version_list with
+  | x::y::_ -> "OCAML"^x^y
+  | _ -> assert false
 
-let which_camlpX base =
+(** Explanation of disabled warnings:
+    4: fragile pattern matching: too common in the code and too annoying to avoid in general
+    9: missing fields in a record pattern: too common in the code and not worth the bother
+    27: innocuous unused variable: innocuous
+    41: ambiguous constructor or label: too common
+    42: disambiguated counstructor or label: too common
+    44: "open" shadowing already defined identifier: too common, especially when some are aliases
+    45: "open" shadowing a label or constructor: see 44
+    48: implicit elimination of optional arguments: too common
+    50: unexpected documentation comment: too common and annoying to avoid
+    56: unreachable match case: the [_ -> .] syntax doesn't exist in 4.02.3
+    58: "no cmx file was found in path": See https://github.com/ocaml/num/issues/9
+    59: "potential assignment to a non-mutable value": See Coq's issue #8043
+*)
+let coq_warnings = "-w +a-4-9-27-41-42-44-45-48-50-58-59"
+let coq_warn_error =
+    if !prefs.warn_error
+    then "-warn-error +a"
+         ^ (if caml_version_nums > [4;2;3]
+            then "-56"
+            else "")
+    else ""
+
+(* 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
+
+(** * Camlp5 configuration *)
+
+(* 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 *)
+
+let strip_slash dir =
+  let n = String.length dir in
+  if n>0 && dir.[n - 1] = '/' then String.sub dir 0 (n-1) else dir
+
+let which_camlp5o_for camlp5lib =
+  let camlp5o = Filename.concat camlbin "camlp5o" in
+  let camlp5lib = strip_slash camlp5lib in
+  if fst (tryrun camlp5o ["-where"]) = camlp5lib then camlp5o else
+  let camlp5o = which "camlp5o" in
+  if fst (tryrun camlp5o ["-where"]) = camlp5lib then camlp5o else
+  die ("Error: cannot find Camlp5 binaries corresponding to Camlp5 library " ^ camlp5lib)
+
+let which_camlp5 base =
   let file = Filename.concat camlbin base in
   if is_executable file then file else which base
 
 (* TODO: camlp5dir should rather be the *binary* location, just as camldir *)
 (* TODO: remove the late attempts at finding gramlib.cma *)
 
-exception NoCamlp5
-
-let check_camlp5 testcma = match !Prefs.camlp5dir with
+let check_camlp5 testcma = match !prefs.camlp5dir with
   | Some dir ->
     if Sys.file_exists (dir/testcma) then
       let camlp5o =
-        try which_camlpX "camlp5o"
+        try which_camlp5o_for dir
         with Not_found -> die "Error: cannot find Camlp5 binaries in path.\n" in
       dir, camlp5o
     else
@@ -538,52 +700,28 @@ 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 ->
-      let () = printf "No Camlp5 installation found." in
-      let () = printf "Looking for Camlp4 instead...\n" in
-      raise NoCamlp5
+      die "No Camlp5 installation found."
 
 let check_camlp5_version camlp5o =
   let version_line, _ = run ~err:StdOut camlp5o ["-v"] in
   let version = List.nth (string_split ' ' version_line) 2 in
-  match string_split '.' version with
+  match numeric_prefix_list version with
   | major::minor::_ when s2i major > 6 || (s2i major, s2i minor) >= (6,6) ->
-    printf "You have Camlp5 %s. Good!\n" version; version
+    cprintf "You have Camlp5 %s. Good!" version; version
   | _ -> die "Error: unsupported Camlp5 (version < 6.06 or unrecognized).\n"
 
-let check_caml_version_for_camlp4 () =
-  if caml_version_nums = [4;1;0] && !Prefs.debug && not !Prefs.force_caml_version then
-    die ("Your version of OCaml is detected to be 4.01.0 which fails to compile\n" ^
-         "Coq in -debug mode with Camlp4. Remove -debug option or use a different\n" ^
-         "version of OCaml or use Camlp5, or bypass this test by using option\n" ^
-         "-force-caml-version.\n")
-
-let config_camlpX () =
-  try
-    if not !Prefs.usecamlp5 then raise NoCamlp5;
+let config_camlp5 () =
     let camlp5mod = "gramlib" in
     let camlp5libdir, camlp5o = check_camlp5 (camlp5mod^".cma") in
     let camlp5_version = check_camlp5_version camlp5o in
-    "camlp5", camlp5o, Filename.dirname camlp5o, camlp5libdir, camlp5mod, camlp5_version
-  with NoCamlp5 ->
-    (* We now try to use Camlp4, either by explicit choice or
-       by lack of proper Camlp5 installation *)
-    let camlp4mod = "camlp4lib" in
-    let camlp4libdir = camllib/"camlp4" in
-    if not (Sys.file_exists (camlp4libdir/camlp4mod^".cma")) then
-      die "No Camlp4 installation found.\n";
-    try
-      let camlp4orf = which_camlpX "camlp4orf" in
-      let version_line, _ = run ~err:StdOut camlp4orf ["-v"] in
-      let camlp4_version = List.nth (string_split ' ' version_line) 2 in
-      check_caml_version_for_camlp4 ();
-      "camlp4", camlp4orf, Filename.dirname camlp4orf, camlp4libdir, camlp4mod, camlp4_version
-    with _ -> die "No Camlp4 installation found.\n"
+    camlp5o, Filename.dirname camlp5o, camlp5libdir, camlp5mod, camlp5_version
 
-let 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
@@ -591,46 +729,46 @@ 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 *)
 
 let msg_byteonly () =
-  printf "Only the bytecode version of Coq will be available.\n"
+  cprintf "Only the bytecode version of Coq will be available."
 
 let msg_no_ocamlopt () =
-  printf "Cannot find the OCaml native-code compiler.\n"; msg_byteonly ()
+  cprintf "Cannot find the OCaml native-code compiler."; 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 () =
+  cprintf "Cannot find the native-code library of camlp5."; msg_byteonly ()
 
 let msg_no_dynlink_cmxa () =
-  printf "Cannot find native-code dynlink library.\n"; msg_byteonly ();
-  printf "For building a native-code Coq, you may try to first\n";
-  printf "compile and install a dummy dynlink.cmxa (see dev/dynlink.ml)\n";
-  printf "and then run ./configure -natdynlink no\n"
+  cprintf "Cannot find native-code dynlink library."; msg_byteonly ();
+  cprintf "For building a native-code Coq, you may try to first";
+  cprintf "compile and install a dummy dynlink.cmxa (see dev/dynlink.ml)";
+  cprintf "and then run ./configure -natdynlink no"
 
 let check_native () =
-  let () = if !Prefs.byteonly then raise Not_found in
+  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
     let () =
       if version <> caml_version then
-	printf
-	  "Warning: Native and bytecode compilers do not have the same version!\n"
-    in printf "You have native-code compilation. Good!\n"
+        cprintf
+          "Warning: Native and bytecode compilers do not have the same version!"
+    in cprintf "You have native-code compilation. Good!"
 
 let best_compiler =
   try check_native (); "opt" with Not_found -> "byte"
 
 (** * Native dynlink *)
 
-let hasnatdynlink = !Prefs.natdynlink && best_compiler = "opt"
+let hasnatdynlink = !prefs.natdynlink && best_compiler = "opt"
 
 let natdynlinkflag =
   if hasnatdynlink then "true" else "false"
@@ -638,18 +776,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"
+    | _   -> cprintf "You have the Num library installed. Good!"
 
+let numlib =
+  check_for_numlib ()
 
 (** * lablgtk2 and CoqIDE *)
 
@@ -663,7 +815,7 @@ let get_source = function
 (** Is some location a suitable LablGtk2 installation ? *)
 
 let check_lablgtkdir ?(fatal=false) src dir =
-  let yell msg = if fatal then die msg else (printf "%s\n" msg; false) in
+  let yell msg = if fatal then die msg else (cprintf "%s" msg; false) in
   let msg = get_source src in
   if not (dir_exists dir) then
     yell (sprintf "No such directory '%s' (%s)." dir msg)
@@ -676,18 +828,18 @@ let check_lablgtkdir ?(fatal=false) src dir =
 (** Detect and/or verify the Lablgtk2 location *)
 
 let get_lablgtkdir () =
-  match !Prefs.lablgtkdir with
+  match !prefs.lablgtkdir with
   | Some dir ->
     let msg = Manual in
     if check_lablgtkdir ~fatal:true msg dir then dir, msg
     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
@@ -699,24 +851,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")
+  cprintf "Warning: could not check the version of lablgtk2.\nMake sure your version is at least 2.18.3.";
+  (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 *)
+        cprintf "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." v;
+        (true, "an unknown version")
+      end
+    else
+      (true, v)
   with _ -> (false, v)
 
 let pr_ide = function No -> "no" | Byte -> "only bytecode" | Opt -> "native"
@@ -725,11 +875,11 @@ exception Ide of ide
 
 (** If the user asks an impossible coqide, we abort the configuration *)
 
-let set_ide ide msg = match ide, !Prefs.coqide with
+let set_ide ide msg = match ide, !prefs.coqide with
   | No, Some (Byte|Opt)
   | Byte, Some Opt -> die (msg^":\n=> cannot build requested CoqIde")
   | _ ->
-    printf "%s:\n=> %s CoqIde will be built.\n" msg (pr_ide ide);
+    cprintf "%s:\n=> %s CoqIde will be built." msg (pr_ide ide);
     raise (Ide ide)
 
 let lablgtkdir = ref ""
@@ -738,15 +888,15 @@ let lablgtkdir = ref ""
     This function also sets the lablgtkdir reference in case of success. *)
 
 let check_coqide () =
-  if !Prefs.coqide = Some No then set_ide No "CoqIde manually disabled";
+  if !prefs.coqide = Some No then set_ide No "CoqIde manually disabled";
   let dir, via = get_lablgtkdir () in
   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");
+  if !prefs.coqide = Some Byte then set_ide Byte (found^", bytecode requested");
   if best_compiler<>"opt" then set_ide Byte (found^", but no native compiler");
   if not (Sys.file_exists (dir/"gtkThread.cmx")) then
     set_ide Byte (found^", but no native LablGtk2");
@@ -769,8 +919,8 @@ let idearchdef = ref "X11"
 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
+    | "opt", "Darwin" when !prefs.macintegration ->
+      let osxdir,_ = tryrun camlexec.find ["query";"lablgtkosx"] in
       if osxdir <> "" then begin
         lablgtkincludes := sprintf "%s -I %S" !lablgtkincludes osxdir;
         idearchflags := "lablgtkosx.cma";
@@ -795,7 +945,7 @@ let strip =
   if arch = "Darwin" then
     if hasnatdynlink then "true" else "strip"
   else
-    if !Prefs.profile || !Prefs.debug then "true" else begin
+    if !prefs.profile || !prefs.debug then "true" else begin
     let _, all = run camlexec.find ["ocamlc";"-config"] in
     let strip = String.concat "" (List.map (fun l ->
         match string_split ' ' l with
@@ -806,106 +956,113 @@ 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, ... *)
 
+let check_sphinx_deps () =
+  ignore (run (which "python3") ["doc/tools/coqrst/checkdeps.py"])
+
 let check_doc () =
   let err s =
-    printf "%s was not found; documentation will not be available\n" s;
-    raise Not_found
+    die (sprintf "A documentation build was requested, but %s was not found." s);
   in
-  try
-    if not !Prefs.withdoc then raise Not_found;
-    if not (program_in_path "latex") then err "latex";
-    if not (program_in_path "hevea") then err "hevea";
-    if not (program_in_path "hacha") then err "hacha";
-    if not (program_in_path "fig2dev") then err "fig2dev";
-    if not (program_in_path "convert") then err "convert";
-    true
-  with Not_found -> false
-
-let withdoc = check_doc ()
+  if not (program_in_path "python3") then err "python3";
+  if not (program_in_path "sphinx-build") then err "sphinx-build";
+  check_sphinx_deps ()
 
+let _ = if !prefs.withdoc then check_doc ()
 
 (** * Installation directories : bindir, libdir, mandir, docdir, etc *)
 
 let coqtop = Sys.getcwd ()
 
-let unix = os_type_cygwin || not arch_win32
+let unix = os_type_cygwin || not arch_is_win32
+
+(** Variable name, description, ref in prefs, default dir, prefix-relative *)
 
-(** Variable name, description, ref in Prefs, default dir, prefix-relative *)
+type path_style =
+  | Absolute of string (* Should start with a "/" *)
+  | Relative of string (* Should not start with a "/" *)
 
 let install = [
-  "BINDIR", "the Coq binaries", Prefs.bindir,
-    (if unix then "/usr/local/bin" else "C:/coq/bin"),
-    "/bin";
-  "COQLIBINSTALL", "the Coq library", Prefs.libdir,
-    (if unix then "/usr/local/lib/coq" else "C:/coq/lib"),
-    (if arch_win32 then "" else "/lib/coq");
-  "CONFIGDIR", "the Coqide configuration files", Prefs.configdir,
-    (if unix then "/etc/xdg/coq" else "C:/coq/config"),
-    (if arch_win32 then "/config" else "/etc/xdg/coq");
-  "DATADIR", "the Coqide data files", Prefs.datadir,
-    (if unix then "/usr/local/share/coq" else "C:/coq/share"),
-    "/share/coq";
-  "MANDIR", "the Coq man pages", Prefs.mandir,
-    (if unix then "/usr/local/share/man" else "C:/coq/man"),
-    "/share/man";
-  "DOCDIR", "the Coq documentation", Prefs.docdir,
-    (if unix then "/usr/local/share/doc/coq" else "C:/coq/doc"),
-    "/share/doc/coq";
-  "EMACSLIB", "the Coq Emacs mode", Prefs.emacslib,
-    (if unix then "/usr/local/share/emacs/site-lisp" else "C:/coq/emacs"),
-    (if arch_win32 then "/emacs" else "/share/emacs/site-lisp");
-  "COQDOCDIR", "the Coqdoc LaTeX files", Prefs.coqdocdir,
-    (if unix then "/usr/local/share/texmf/tex/latex/misc" else "C:/coq/latex"),
-    (if arch_win32 then "/latex" else "/share/emacs/site-lisp");
+  "BINDIR", "the Coq binaries", !prefs.bindir,
+    Relative "bin", Relative "bin", Relative "bin";
+  "COQLIBINSTALL", "the Coq library", !prefs.libdir,
+    Relative "lib", Relative "lib/coq", Relative "";
+  "CONFIGDIR", "the Coqide configuration files", !prefs.configdir,
+    Relative "config", Absolute "/etc/xdg/coq", Relative "ide";
+  "DATADIR", "the Coqide data files", !prefs.datadir,
+    Relative "share", Relative "share/coq", Relative "ide";
+  "MANDIR", "the Coq man pages", !prefs.mandir,
+    Relative "man", Relative "share/man", Relative "man";
+  "DOCDIR", "the Coq documentation", !prefs.docdir,
+    Relative "doc", Relative "share/doc/coq", Relative "doc";
+  "EMACSLIB", "the Coq Emacs mode", !prefs.emacslib,
+    Relative "emacs", Relative "share/emacs/site-lisp", Relative "tools";
+  "COQDOCDIR", "the Coqdoc LaTeX files", !prefs.coqdocdir,
+    Relative "latex", Relative "share/texmf/tex/latex/misc", Relative "tools/coqdoc";
  ]
 
-let do_one_instdir (var,msg,r,dflt,suff) =
-  let dir = match !r, !Prefs.prefix with
-    | Some d, _ -> d
-    | _, Some p -> p^suff
-    | _ ->
+let strip_trailing_slash_if_any p =
+  if p.[String.length p - 1] = '/' then String.sub p 0 (String.length p - 1) else p
+
+let use_suffix prefix = function
+  | Relative "" -> prefix
+  | Relative suff -> prefix ^ "/" ^ suff
+  | Absolute path -> path
+
+let relativize = function
+  (* Turn a global layout based on some prefix to a relative layout *)
+  | Relative _ as suffix -> suffix
+  | Absolute path -> Relative (String.sub path 1 (String.length path - 1))
+
+let find_suffix prefix path = match prefix with
+  | None -> Absolute path
+  | Some p ->
+     let p = strip_trailing_slash_if_any p in
+     let lpath = String.length path in
+     let lp = String.length p in
+     if lpath > lp && String.sub path 0 lp = p then
+       Relative (String.sub path (lp+1) (lpath - lp - 1))
+     else
+       Absolute path
+
+let do_one_instdir (var,msg,uservalue,selfcontainedlayout,unixlayout,locallayout) =
+  let dir,suffix =
+    if !prefs.local then (use_suffix coqtop locallayout,locallayout)
+    else match uservalue, !prefs.prefix with
+    | Some d, p -> d,find_suffix p d
+    | _, Some p ->
+      let suffix = if arch_is_win32 then selfcontainedlayout else relativize unixlayout in
+      use_suffix p suffix, suffix
+    | _, p ->
+      let suffix = if unix then unixlayout else selfcontainedlayout in
+      let base = if unix then "/usr/local" else "C:/coq" in
+      let dflt = use_suffix base suffix in
       let () = printf "Where should I install %s [%s]? " msg dflt in
       let line = read_line () in
-      if line = "" then dflt else line
-  in (var,msg,dir,dir<>dflt)
+      if line = "" then (dflt,suffix) else (line,find_suffix p line)
+  in (var,msg,dir,suffix)
 
-let do_one_noinst (var,msg,_,_,_) =
-  if var="CONFIGDIR" || var="DATADIR" then (var,msg,coqtop^"/ide",true)
-  else (var,msg,"",false)
-
-let install_dirs =
-  let f = if !Prefs.local then do_one_noinst else do_one_instdir in
-  List.map f install
+let install_dirs = List.map do_one_instdir install
 
 let select var = List.find (fun (v,_,_,_) -> v=var) install_dirs
 
-let libdir = let (_,_,d,_) = select "COQLIBINSTALL" in d
-
-let docdir = let (_,_,d,_) = select "DOCDIR" in d
+let coqlib,coqlibsuffix = let (_,_,d,s) = select "COQLIBINSTALL" in d,s
 
-let configdir =
-  let (_,_,d,b) = select "CONFIGDIR" in if b then Some d else None
+let docdir,docdirsuffix = let (_,_,d,s) = select "DOCDIR" in d,s
 
-let datadir =
-  let (_,_,d,b) = select "DATADIR" in if b then Some d else None
+let configdir,configdirsuffix = let (_,_,d,s) = select "CONFIGDIR" in d,s
 
+let datadir,datadirsuffix = let (_,_,d,s) = select "DATADIR" in d,s
 
 (** * OCaml runtime flags *)
 
 (** Do we use -custom (yes by default on Windows and MacOS) *)
 
-let custom_os = arch_win32 || arch = "Darwin"
+let custom_os = arch_is_win32 || arch = "Darwin"
 
-let use_custom = match !Prefs.custom with
+let use_custom = match !prefs.custom with
   | Some b -> b
   | None -> custom_os
 
@@ -915,18 +1072,19 @@ let build_loadpath =
   ref "# you might want to set CAML_LD_LIBRARY_PATH by hand!"
 
 let config_runtime () =
-  match !Prefs.vmbyteflags with
+  match !prefs.vmbyteflags with
   | Some flags -> string_split ',' flags
   | _ when use_custom -> [custom_flag]
-  | _ when !Prefs.local ->
+  | _ when !prefs.local ->
     ["-dllib";"-lcoqrun";"-dllpath";coqtop/"kernel/byterun"]
   | _ ->
     let ld="CAML_LD_LIBRARY_PATH" in
     build_loadpath := sprintf "export %s:='%s/kernel/byterun':$(%s)" ld coqtop ld;
-    ["-dllib";"-lcoqrun";"-dllpath";libdir]
+    ["-dllib";"-lcoqrun";"-dllpath";coqlib/"kernel/byterun"]
 
 let vmbyteflags = config_runtime ()
 
+let esc s = if String.contains s ' ' then "\"" ^ s ^ "\"" else s
 
 (** * Summary of the configuration *)
 
@@ -938,32 +1096,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"     (String.capitalize camlpX) camlpX_version;
-  pr "  %s binaries in          : %s\n"     (String.capitalize camlpX) camlpXbindir;
-  pr "  %s library in           : %s\n"     (String.capitalize 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");
+    (if !prefs.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";
-  if !Prefs.local then
+  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";
@@ -977,21 +1135,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 =
@@ -1001,54 +1158,71 @@ let write_configml f =
   let pr_s = pr "let %s = %S\n" in
   let pr_b = pr "let %s = %B\n" in
   let pr_i = pr "let %s = %d\n" in
-  let pr_o s o = pr "let %s = %s\n" s
-    (match o with None -> "None" | Some d -> sprintf "Some %S" d)
-  in
+  let pr_p s o = pr "let %s = %S\n" s
+    (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));
-  pr_b "local" !Prefs.local;
+  pr_b "local" !prefs.local;
   pr "let vmbyteflags = ["; List.iter (pr "%S;") vmbyteflags; pr "]\n";
-  pr_o "coqlib" (if !Prefs.local then None else Some libdir);
-  pr_o "configdir" configdir;
-  pr_o "datadir" datadir;
+  pr_s "coqlib" coqlib;
+  pr_s "configdir" configdir;
+  pr_s "datadir" datadir;
   pr_s "docdir" docdir;
+  pr_p "coqlibsuffix" coqlibsuffix;
+  pr_p "configdirsuffix" configdirsuffix;
+  pr_p "datadirsuffix" datadirsuffix;
+  pr_p "docdirsuffix" docdirsuffix;
   pr_s "ocaml" camlexec.top;
   pr_s "ocamlfind" camlexec.find;
   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;
-  pr_b "arch_is_win32" arch_win32;
+  pr_b "arch_is_win32" arch_is_win32;
   pr_s "exec_extension" exe;
   pr_s "coqideincl" !lablgtkincludes;
   pr_s "has_coqide" coqide;
   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 "wwwcoq" !prefs.coqwebsite;
+  pr_s "wwwbugtracker" (!prefs.coqwebsite ^ "bugs/");
+  pr_s "wwwrefman" (!prefs.coqwebsite ^ "distrib/V" ^ coq_version ^ "/refman/");
+  pr_s "wwwstdlib" (!prefs.coqwebsite ^ "distrib/V" ^ 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"; "lib"; "clib"; "kernel"; "library";
+                        "engine"; "pretyping"; "interp"; "parsing"; "proofs";
+                        "tactics"; "toplevel"; "printing"; "intf";
+                        "grammar"; "ide"; "stm"; "vernac" ] in
+  let core_src_dirs = List.fold_left (fun acc core_src_subdir -> acc ^ "  \"" ^ core_src_subdir ^ "\";\n")
+                                    ""
+                                    core_src_dirs in
+
+  pr "\nlet core_src_dirs = [\n%s]\n" core_src_dirs;
   pr "\nlet plugins_dirs = [\n";
+
   let plugins = Sys.readdir "plugins" in
   Array.sort compare plugins;
   Array.iter
@@ -1057,6 +1231,9 @@ let write_configml f =
       if Sys.is_directory f' && f.[0] <> '.' then pr "  %S;\n" f')
     plugins;
   pr "]\n";
+
+  pr "\nlet all_src_dirs = core_src_dirs @ plugins_dirs\n";
+
   close_out o;
   Unix.chmod f 0o444
 
@@ -1090,9 +1267,10 @@ let write_makefile f =
   pr "#Variable used to detect whether ./configure has run successfully.\n";
   pr "COQ_CONFIGURED=yes\n\n";
   pr "# Local use (no installation)\n";
-  pr "LOCAL=%B\n\n" !Prefs.local;
+  pr "LOCAL=%B\n\n" !prefs.local;
   pr "# Bytecode link flags : should we use -custom or not ?\n";
   pr "CUSTOM=%s\n" custom_flag;
+  pr "VMBYTEFLAGS=%s\n" (String.concat " " vmbyteflags);
   pr "%s\n\n" !build_loadpath;
   pr "# Paths for true installation\n";
   List.iter (fun (v,msg,_,_) -> pr "# %s: path for %s\n" v msg) install_dirs;
@@ -1114,22 +1292,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\n" coq_annotate_flag;
+  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;
@@ -1137,7 +1316,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";
@@ -1149,8 +1327,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";
@@ -1163,9 +1339,9 @@ let write_makefile f =
   pr "# Defining REVISION\n";
   pr "CHECKEDOUT=%s\n\n" vcs;
   pr "# Option to control compilation and installation of the documentation\n";
-  pr "WITHDOC=%s\n\n" (if withdoc then "all" else "no");
+  pr "WITHDOC=%s\n\n" (if !prefs.withdoc then "all" else "no");
   pr "# Option to produce precompiled files for native_compute\n";
-  pr "NATIVECOMPUTE=%s\n" (if !Prefs.nativecompiler then "-native-compiler" else "");
+  pr "NATIVECOMPUTE=%s\n" (if !prefs.nativecompiler then "-native-compiler" else "");
   close_out o;
   Unix.chmod f 0o444
 
@@ -1197,3 +1373,13 @@ let write_macos_metadata exec =
 
 let () = if arch = "Darwin" then
 List.iter write_macos_metadata distributed_exec
+
+let write_configpy f =
+  safe_remove f;
+  let o = open_out f in
+  let pr s = fprintf o s in
+  let pr_s = pr "%s = '%s'\n" in
+  pr "# DO NOT EDIT THIS FILE: automatically generated by ../configure\n";
+  pr_s "version" coq_version
+
+let _ = write_configpy "config/coq_config.py"
diff --git a/default.nix b/default.nix
new file mode 100644
index 00000000..a64d8120
--- /dev/null
+++ b/default.nix
@@ -0,0 +1,105 @@
+# 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> {}).ocaml-ng.ocamlPackages_4_05" --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 doInstallCheck 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 (fetchTarball {
+      url = "https://github.com/NixOS/nixpkgs/archive/060a98e9f4ad879492e48d63e887b0b6db26299e.tar.gz";
+      sha256 = "1lzvp3md0hf6kp2bvc6dbzh40navlyd51qlns9wbkz6lqk3lgf6j";
+    }) {})
+, ocamlPackages ? pkgs.ocaml-ng.ocamlPackages_4_06
+, buildIde ? true
+, buildDoc ? true
+, doInstallCheck ? true
+, shell ? false
+  # We don't use lib.inNixShell because that would also apply
+  # when in a nix-shell of some package depending on this one.
+}:
+
+with pkgs;
+with stdenv.lib;
+
+stdenv.mkDerivation rec {
+
+  name = "coq";
+
+  buildInputs = [
+    hostname
+    python2 time # coq-makefile timing tools
+  ]
+  ++ (with ocamlPackages; [ ocaml findlib camlp5_strict num ])
+  ++ optional buildIde ocamlPackages.lablgtk
+  ++ optionals buildDoc [
+    # Sphinx doc dependencies
+    pkgconfig (python3.withPackages
+      (ps: [ ps.sphinx ps.sphinx_rtd_theme ps.pexpect ps.beautifulsoup4
+             ps.antlr4-python3-runtime ps.sphinxcontrib-bibtex ]))
+    antlr4
+  ]
+  ++ optionals doInstallCheck (
+    # Test-suite dependencies
+    # ncurses is required to build an OCaml REPL
+    optional (!versionAtLeast ocaml.version "4.07") ncurses
+    ++ [ ocamlPackages.ounit rsync which ]
+  )
+  ++ optionals shell (with ocamlPackages;
+    [ merlin ocp-indent ocp-index ] # Dev tools
+  );
+
+  src =
+    if shell then null
+    else
+      with builtins; filterSource
+        (path: _:
+           !elem (baseNameOf path) [".git" "result" "bin" "_build_ci"]) ./.;
+
+  prefixKey = "-prefix ";
+
+  buildFlags = [ "world" "byte" ] ++ optional buildDoc "sphinx";
+
+  installTargets =
+    [ "install" "install-byte" ] ++ optional buildDoc "install-doc-sphinx";
+
+  inherit doInstallCheck;
+
+  preInstallCheck = ''
+    patchShebangs tools/
+    patchShebangs test-suite/
+  '';
+
+  installCheckTarget = [ "check" ];
+
+  passthru = { inherit ocamlPackages; };
+
+  meta = {
+    description = "Coq proof assistant";
+    longDescription = ''
+      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.
+    '';
+    homepage = http://coq.inria.fr;
+    license = licenses.lgpl21;
+  };
+
+}
diff --git a/dev/Bugzilla_Coq_autolink.user.js b/dev/Bugzilla_Coq_autolink.user.js
new file mode 100644
index 00000000..ed056021
--- /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 00000000..5ff618a8
--- /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/Makefile.oug b/dev/Makefile.oug
deleted file mode 100644
index ee69ea80..00000000
--- a/dev/Makefile.oug
+++ /dev/null
@@ -1,74 +0,0 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
-
-
-#### Source Code Analysis via Oug ####
-#### Cf http://home.gna.org/oug ####
-
-
-# To be used from top dir : make -f dev/Makefile.oug ...
-
-include Makefile.build
-
-# Oug location: in the path by default, native version
-
-OUG:=oug.x
-
-# NB: coq should have been compiled with the same ocaml version as oug
-
-# NOTA: it seems we obtain more useless elements reported when _not_
-# providing the .mli files, and also when giving a precise start point.
-# TO BE INVESTIGATED
-
-ml_of_cma = $(patsubst %.cmo,%.ml,$(filter %.cmo,$(shell cat $(1:.cma=.mllib.d))))
-local_ml_of_cma = $(filter $(dir $(1))%,$(call ml_of_cma,$(1)))
-mli_of_ml = $(foreach ml,$(1),$(wildcard $(ml)i))
-
-# Analysis of coqtop, without plugins
-
-COREML:=config/coq_config.ml $(call ml_of_cma, $(CORECMA))
-COREMLI:=$(call mli_of_ml,$(COREML))
-
-core.oug:
-	$(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(COREML)
-
-core.useless: core.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --roots "<Coqtop.start>" --useless-elements $@
-
-core_intf.oug:
-	$(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(COREML) $(COREMLI)
-
-core_intf.useless: core_intf.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --roots "<Coqtop.start>" --useless-elements $@
-
-# Analysis of coqchk, considering only files in the checker/ subdir
-
-CHECKERML:=$(call local_ml_of_cma,checker/check.cma)
-CHECKERMLI:=$(call mli_of_ml,$(CHECKERML))
-
-## BUG: in oug, include dirs have reversed priority compared with ocaml, cannot use CHKLIBS
-MYCHKINCL:=$(MLINCLUDES) -I checker
-
-checker.oug:
-	$(OUG) --dump-data $@ -rectypes $(MYCHKINCL) $(CHECKERML) #$(CHECKERMLI)
-
-checker.useless: checker.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --roots "<Checker.start>" --useless-elements $@
-
-# Analysis of extraction
-
-EXTRACTIONML:=$(call local_ml_of_cma,$(EXTRACTIONCMA))
-EXTRACTIONMLI:=$(call mli_of_ml,$(EXTRACTIONMLI))
-
-extraction.oug:
-	$(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(EXTRACTIONML) #$(EXTRACTIONMLI)
-
-extraction.useless: extraction.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --useless-elements $@
-
-# More to come ...
\ No newline at end of file
diff --git a/dev/README b/dev/README
index 814f6095..453f85f0 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,11 +40,11 @@ Documentation of ML interfaces using ocamldoc (directory ocamldoc/html)
 Other development tools (directory tools)
 -----------------------
 
-Makefile.dir: makefile dedicated to intensive work in a given directory
-Makefile.subdir: makefile dedicated to intensive work in a given subdirectory
-Makefile.devel: utilities to automatically launch coq in various states
-Makefile.common: used by other Makefiles
+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/TODO b/dev/TODO
deleted file mode 100644
index e62ee6e5..00000000
--- a/dev/TODO
+++ /dev/null
@@ -1,22 +0,0 @@
-
- o options de la ligne de commande
-     - reporter les options de l'ancien script coqtop sur le nouveau coqtop.ml
-
- o arguments implicites
-     - les calculer une fois pour toutes à la déclaration (dans Declare)
-       et stocker cette information dans le in_variable, in_constant, etc.
-
- o Environnements compilés (type Environ.compiled_env)
-     - pas de timestamp mais plutôt un checksum avec Digest (mais comment ?)
-
- o Efficacité
-     - utiliser DOPL plutôt que DOPN (sauf pour Case)
-     - batch mode => pas de undo, ni de reset
-     - conversion : déplier la constante la plus récente
-     - un cache pour type_of_const, type_of_inductive, type_of_constructor,
-       lookup_mind_specif
-
- o Toplevel
-     - parsing de la ligne de commande : utiliser Arg ???
-
-
diff --git a/dev/base_db b/dev/base_db
index b540aed6..e18ac534 100644
--- a/dev/base_db
+++ b/dev/base_db
@@ -1,6 +1,6 @@
-load_printer "gramlib.cma"
-load_printer "top_printers.cmo"
-install_printer Top_printers.prid
-install_printer Top_printers.prsp
-install_printer Top_printers.print_pure_constr
+source core.dbg
+load_printer top_printers.cmo
+install_printer Top_printers.ppid
+install_printer Top_printers.ppsp
+install_printer Top_printers.ppconstr
 
diff --git a/dev/base_include b/dev/base_include
index b09b6df2..1fb80dc0 100644
--- a/dev/base_include
+++ b/dev/base_include
@@ -17,9 +17,8 @@
 #directory "grammar";;
 #directory "intf";;
 #directory "stm";;
-#directory "ltac";;
+#directory "vernac";;
 
-#directory "+camlp4";; (* lazy solution: add both of camlp4/5 so that *)
 #directory "+camlp5";; (* Gramext is found in top_printers.ml *)
 
 #use "top_printers.ml";;
@@ -52,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 *)
 
@@ -128,7 +127,6 @@ open Reserve
 open Syntax_def
 open Constrexpr
 open Constrexpr_ops
-open Topconstr
 open Notation_term
 open Notation_ops
 open Prettyp
@@ -147,9 +145,6 @@ open Refiner
 open Tacmach
 open Tactic_debug
 
-open Decl_proof_instr
-open Decl_mode
-
 open Hints
 open Auto
 open Autorewrite
@@ -172,7 +167,7 @@ open Eqschemes
 
 open ExplainErr
 open Class
-open Command
+open ComDefinition
 open Indschemes
 open Ind_tables
 open Auto_ind_decl
@@ -195,13 +190,16 @@ let qid = Libnames.qualid_of_string;;
 (* parsing of terms *)
 
 let parse_constr = Pcoq.parse_string Pcoq.Constr.constr;;
-let parse_tac    = Pcoq.parse_string Pcoq.Tactic.tactic;;
-let parse_vernac = Pcoq.parse_string Pcoq.Vernac_.vernac;;
+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 *)
 
-let e s = Constrintern.intern_constr (Global.env()) (parse_constr s);;
+let e s =
+  let env = Global.env () in
+  let sigma = Evd.from_env env in
+  Constrintern.intern_constr env sigma (parse_constr s);;
 
 (* build a term of type constr with type-checking and resolution of 
    implicit syntax *)
@@ -216,7 +214,7 @@ open Declareops;;
 
 let constbody_of_string s =
   let b = Global.lookup_constant (Nametab.locate_constant (qualid_of_string s)) in
-  Option.get (Declareops.body_of_constant Opaqueproof.empty_opaquetab b);;
+  Option.get (Global.body_of_constant_body b);;
 
 (* Get the current goal *)
 (*
@@ -232,10 +230,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 -> CAst.make ?loc @@ Libnames.Qualid (Nametab.shortest_qualid_of_global Id.Set.empty r));;
 
-open Coqloop
-let go = loop
+let go () = Coqloop.loop ~time:false ~state:Option.(get !Coqloop.drop_last_doc)
 
 let _ =
  print_string
diff --git a/dev/bugzilla2github_stripped.csv b/dev/bugzilla2github_stripped.csv
new file mode 100644
index 00000000..3f5cbfd7
--- /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 b43ada90..dc33838f 100755
--- a/dev/build/osx/make-macos-dmg.sh
+++ b/dev/build/osx/make-macos-dmg.sh
@@ -4,32 +4,25 @@
 set -e
 
 # Configuration setup
-eval `opam config env`
-make distclean
 OUTDIR=$PWD/_install
 DMGDIR=$PWD/_dmg
-./configure -debug -prefix $OUTDIR -native-compiler no
 VERSION=$(sed -n -e '/^let coq_version/ s/^[^"]*"\([^"]*\)"$/\1/p' configure.ml)
 APP=bin/CoqIDE_${VERSION}.app
 
-# Create a .app file with CoqIDE
-~/.local/bin/jhbuild run make -j -l2 $APP
-
-# Build Coq and run test-suite
-make && make check
+# 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
 cp -r $APP $DMGDIR
 
+mkdir -p _build
+
 # Temporary countermeasure to hdiutil error 5341
-head -c9703424 /dev/urandom > $DMGDIR/.padding
+# head -c9703424 /dev/urandom > $DMGDIR/.padding
 
-hdiutil create -imagekey zlib-level=9 -volname CoqIDE_$VERSION -srcfolder $DMGDIR -ov -format UDZO 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_84pl6_abs_ocaml.bat b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat
index bdcb01db..9dbce192 100644
--- a/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat
+++ b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat
@@ -1,3 +1,16 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^
   -ocaml=Y ^

   -make=Y ^

   -coqver=8.4pl6 ^

-  -destcyg=%ROOTPATH%\cygwin_coq64_84pl6_abs ^

-  -destcoq=%ROOTPATH%\coq64_84pl6_abs

+  -destcyg="%ROOTPATH%\cygwin_coq64_84pl6_abs" ^

+  -destcoq="%ROOTPATH%\coq64_84pl6_abs"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_84pl6_abs_ocaml.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat
index 2e4a692e..7faf3e9c 100644
--- a/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat
+++ b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat
@@ -1,3 +1,16 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^
   -ocaml=Y ^

   -make=Y ^

   -coqver=8.5pl2 ^

-  -destcyg=%ROOTPATH%\cygwin_coq64_85pl2_abs ^

-  -destcoq=%ROOTPATH%\coq64_85pl2_abs

+  -destcyg="%ROOTPATH%\cygwin_coq64_85pl2_abs" ^

+  -destcoq="%ROOTPATH%\coq64_85pl2_abs"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_85pl2_abs_ocaml.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat
index 6e4e440a..b719b14c 100644
--- a/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat
+++ b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat
@@ -1,3 +1,16 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^
   -ocaml=Y ^

   -make=Y ^

   -coqver=8.5pl3 ^

-  -destcyg=%ROOTPATH%\cygwin_coq64_85pl3_abs ^

-  -destcoq=%ROOTPATH%\coq64_85pl3_abs

+  -destcyg="%ROOTPATH%\cygwin_coq64_85pl3_abs" ^

+  -destcoq="%ROOTPATH%\coq64_85pl3_abs"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_85pl3_abs_ocaml.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_85pl3_installer.bat b/dev/build/windows/MakeCoq_85pl3_installer.bat
index c305e2f5..a9f4e2da 100644
--- a/dev/build/windows/MakeCoq_85pl3_installer.bat
+++ b/dev/build/windows/MakeCoq_85pl3_installer.bat
@@ -1,8 +1,26 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

   -arch=64 ^

   -installer=Y ^

   -coqver=8.5pl3 ^

-  -destcyg=%ROOTPATH%\cygwin_coq64_85pl3_inst ^

-  -destcoq=%ROOTPATH%\coq64_85pl3_inst

+  -destcyg="%ROOTPATH%\cygwin_coq64_85pl3_inst" ^

+  -destcoq="%ROOTPATH%\coq64_85pl3_inst"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_85pl3_installer.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_85pl3_installer_32.bat b/dev/build/windows/MakeCoq_85pl3_installer_32.bat
index d87ff591..ef593cc6 100644
--- a/dev/build/windows/MakeCoq_85pl3_installer_32.bat
+++ b/dev/build/windows/MakeCoq_85pl3_installer_32.bat
@@ -1,8 +1,26 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

   -arch=32 ^

   -installer=Y ^

   -coqver=8.5pl3 ^

-  -destcyg=%ROOTPATH%\cygwin_coq32_85pl3_inst ^

-  -destcoq=%ROOTPATH%\coq32_85pl3_inst

+  -destcyg="%ROOTPATH%\cygwin_coq32_85pl3_inst" ^

+  -destcoq="%ROOTPATH%\coq32_85pl3_inst"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_85pl3_installer_32.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat
index f1d855a0..99a1f156 100644
--- a/dev/build/windows/MakeCoq_86git_abs_ocaml.bat
+++ b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat
@@ -1,3 +1,16 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^
   -ocaml=Y ^

   -make=Y ^

   -coqver=git-v8.6 ^

-  -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs ^

-  -destcoq=%ROOTPATH%\coq64_86git_abs

+  -destcyg="%ROOTPATH%\cygwin_coq64_86git_abs" ^

+  -destcoq="%ROOTPATH%\coq64_86git_abs"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_86git_abs_ocaml.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat
index 70ab42bc..896d1cd6 100644
--- a/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat
+++ b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat
@@ -1,3 +1,16 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

@@ -7,5 +20,10 @@ call MakeCoq_MinGW.bat ^
   -make=Y ^

   -gtksrc=Y ^

   -coqver=git-v8.6 ^

-  -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs_gtksrc ^

-  -destcoq=%ROOTPATH%\coq64_86git_abs_gtksrc

+  -destcyg="%ROOTPATH%\cygwin_coq64_86git_abs_gtksrc" ^

+  -destcoq="%ROOTPATH%\coq64_86git_abs_gtksrc"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_86git_abs_ocaml_gtksrc.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_86git_installer.bat b/dev/build/windows/MakeCoq_86git_installer.bat
index 40506318..c4823103 100644
--- a/dev/build/windows/MakeCoq_86git_installer.bat
+++ b/dev/build/windows/MakeCoq_86git_installer.bat
@@ -1,8 +1,26 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

   -arch=64 ^

   -installer=Y ^

   -coqver=git-v8.6 ^

-  -destcyg=%ROOTPATH%\cygwin_coq64_86git_inst ^

-  -destcoq=%ROOTPATH%\coq64_86git_inst

+  -destcyg="%ROOTPATH%\cygwin_coq64_86git_inst" ^

+  -destcoq="%ROOTPATH%\coq64_86git_inst"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_86git_installer.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_86git_installer_32.bat b/dev/build/windows/MakeCoq_86git_installer_32.bat
index b9127c94..19146c96 100644
--- a/dev/build/windows/MakeCoq_86git_installer_32.bat
+++ b/dev/build/windows/MakeCoq_86git_installer_32.bat
@@ -1,8 +1,26 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 call MakeCoq_MinGW.bat ^

   -arch=32 ^

   -installer=Y ^

   -coqver=git-v8.6 ^

-  -destcyg=%ROOTPATH%\cygwin_coq32_86git_inst ^

-  -destcoq=%ROOTPATH%\coq32_86git_inst

+  -destcyg="%ROOTPATH%\cygwin_coq32_86git_inst" ^

+  -destcoq="%ROOTPATH%\coq32_86git_inst"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_86git_installer_32.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_86git_installer_cyglocal.bat b/dev/build/windows/MakeCoq_86git_installer_cyglocal.bat
new file mode 100755
index 00000000..cf6cafaa
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86git_installer_cyglocal.bat
@@ -0,0 +1,27 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=git-v8.6 ^

+  -cyglocal=Y ^

+  -destcyg="%ROOTPATH%\cygwin_coq64_86git_inst_cyglocal" ^

+  -destcoq="%ROOTPATH%\coq64_86git_inst_cyglocal"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_86git_installer_cyglocal.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_88git_installer.bat b/dev/build/windows/MakeCoq_88git_installer.bat
new file mode 100755
index 00000000..b016fb38
--- /dev/null
+++ b/dev/build/windows/MakeCoq_88git_installer.bat
@@ -0,0 +1,27 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=git-v8.8 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_88_inst ^

+  -destcoq=%ROOTPATH%\coq64_88_inst ^

+  -addon=bignums

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_88git_installer.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_MinGW.bat b/dev/build/windows/MakeCoq_MinGW.bat
index 1e08cc5a..61cf6bc4 100644..100755
--- a/dev/build/windows/MakeCoq_MinGW.bat
+++ b/dev/build/windows/MakeCoq_MinGW.bat
@@ -18,7 +18,7 @@ REM ========== DEFAULT VALUES FOR PARAMETERS ==========
 
 REM For a description of all parameters, see ReadMe.txt
 
-SET BATCHFILE=%0
+SET BATCHFILE=%~0
 SET BATCHDIR=%~dp0
 
 REM see -arch in ReadMe.txt, but values are x86_64 or i686 (not 64 or 32)
@@ -34,7 +34,7 @@ REM see -ocaml in ReadMe.txt
 SET INSTALLOCAML=N
 
 REM see -make in ReadMe.txt
-SET INSTALLMAKE=Y
+SET INSTALLMAKE=N
 
 REM see -destcyg in ReadMe.txt
 SET DESTCYG=C:\bin\cygwin_coq
@@ -47,9 +47,11 @@ SET SETUP=setup-x86_64.exe
 
 REM see -proxy in ReadMe.txt
 IF DEFINED HTTP_PROXY (
-  SET PROXY="%HTTP_PROXY:http://=%"
+  SET PROXY=%HTTP_PROXY:http://=%
 ) else (
-  SET PROXY=""
+  REM One can't set a variable to empty in DOS, but you can set it to a space this way.
+  REM The quotes are just there to make the space visible and to protect from "remove trailing spaces".
+  SET "PROXY= "
 )
 
 REM see -cygrepo in ReadMe.txt
@@ -76,18 +78,21 @@ SET GTK_FROM_SOURCES=N
 REM see -threads in ReadMe.txt
 SET MAKE_THREADS=8
 
+REM see -addon in ReadMe.txt
+SET "COQ_ADDONS= "
+
 REM ========== PARSE COMMAND LINE PARAMETERS ==========
 
 SHIFT
 
 :Parse
 
-IF "%0" == "-arch" (
-  IF "%1" == "32" (
+IF "%~0" == "-arch" (
+  IF "%~1" == "32" (
     SET ARCH=i686
     SET SETUP=setup-x86.exe
   ) ELSE (
-    IF "%1" == "64" (
+    IF "%~1" == "64" (
       SET ARCH=x86_64
       SET SETUP=setup-x86_64.exe
     ) ELSE (
@@ -100,15 +105,15 @@ IF "%0" == "-arch" (
   GOTO Parse
 )
 
-IF "%0" == "-mode" (
-  IF "%1" == "mingwincygwin" (
-    SET INSTALLMODE=%1
+IF "%~0" == "-mode" (
+  IF "%~1" == "mingwincygwin" (
+    SET INSTALLMODE=%~1
   ) ELSE (
-    IF "%1" == "absolute" (
-      SET INSTALLMODE=%1
+    IF "%~1" == "absolute" (
+      SET INSTALLMODE=%~1
     ) ELSE (
-      IF "%1" == "relocatable" (
-        SET INSTALLMODE=%1
+      IF "%~1" == "relocatable" (
+        SET INSTALLMODE=%~1
       ) ELSE (
         ECHO "Invalid -mode, valid are mingwincygwin, absolute and relocatable"
         GOTO :EOF
@@ -120,122 +125,137 @@ IF "%0" == "-mode" (
   GOTO Parse
 )
 
-IF "%0" == "-installer" (
-  SET MAKEINSTALLER=%1
+IF "%~0" == "-installer" (
+  SET MAKEINSTALLER=%~1
+  CALL :CheckYN -installer %~1 || GOTO ErrorExit
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%~0" == "-ocaml" (
+  SET INSTALLOCAML=%~1
+  CALL :CheckYN -installer %~1 || GOTO ErrorExit
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-ocaml" (
-  SET INSTALLOCAML=%1
+IF "%~0" == "-make" (
+  SET INSTALLMAKE=%~1
+  CALL :CheckYN -installer %~1 || GOTO ErrorExit
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-make" (
-  SET INSTALLMAKE=%1
+IF "%~0" == "-destcyg" (
+  SET DESTCYG=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-destcyg" (
-  SET DESTCYG=%1
+IF "%~0" == "-destcoq" (
+  SET DESTCOQ=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-destcoq" (
-  SET DESTCOQ=%1
+IF "%~0" == "-setup" (
+  SET SETUP=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-setup" (
-  SET SETUP=%1
+IF "%~0" == "-proxy" (
+  SET PROXY=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-proxy" (
-  SET PROXY="%1"
+IF "%~0" == "-cygrepo" (
+  SET CYGWIN_REPOSITORY=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-cygrepo" (
-  SET CYGWIN_REPOSITORY="%1"
+IF "%~0" == "-cygcache" (
+  SET CYGWIN_LOCAL_CACHE_WFMT=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-cygcache" (
-  SET CYGWIN_LOCAL_CACHE_WFMT="%1"
+IF "%~0" == "-cyglocal" (
+  SET CYGWIN_FROM_CACHE=%~1
+  CALL :CheckYN -cyglocal %~1 || GOTO ErrorExit
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-cyglocal" (
-  SET CYGWIN_FROM_CACHE=%1
+IF "%~0" == "-cygquiet" (
+  SET CYGWIN_QUIET=%~1
+  CALL :CheckYN -cygquiet %~1 || GOTO ErrorExit
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-cygquiet" (
-  SET CYGWIN_QUIET=%1
+IF "%~0" == "-srccache" (
+  SET SOURCE_LOCAL_CACHE_WFMT=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-srccache" (
-  SET SOURCE_LOCAL_CACHE_WFMT="%1"
+IF "%~0" == "-coqver" (
+  SET COQ_VERSION=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-coqver" (
-  SET COQ_VERSION=%1
+IF "%~0" == "-gtksrc" (
+  SET GTK_FROM_SOURCES=%~1
+  CALL :CheckYN -gtksrc %~1 || GOTO ErrorExit
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-gtksrc" (
-  SET GTK_FROM_SOURCES=%1
+IF "%~0" == "-threads" (
+  SET MAKE_THREADS=%~1
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF "%0" == "-threads" (
-  SET MAKE_THREADS=%1
+IF "%~0" == "-addon" (
+  SET "COQ_ADDONS=%COQ_ADDONS% %~1"
   SHIFT
   SHIFT
   GOTO Parse
 )
 
-IF NOT "%0" == "" (
+
+IF NOT "%~0" == "" (
   ECHO Install cygwin and download, compile and install OCaml and Coq for MinGW
-  ECHO !!! Illegal parameter %0
-  ECHO Usage: 
+  ECHO !!! Illegal parameter %~0
+  ECHO Usage:
   ECHO MakeCoq_MinGW
   CALL :PrintPars
-  goto :EOF
+  GOTO :EOF
 )
 
 IF NOT EXIST %SETUP% (
   ECHO The cygwin setup program %SETUP% doesn't exist. You must download it from https://cygwin.com/install.html.
+  ECHO If the setup is in a different folder, set the full path to %SETUP% using the -setup option.
   GOTO :EOF
 )
 
@@ -247,16 +267,14 @@ IF "%INSTALLMODE%" == "mingwincygwin" (
 
 IF "%MAKEINSTALLER%" == "Y" (
   SET INSTALLMODE=relocatable
-  SET INSTALLOCAML=Y
-  SET INSTALLMAKE=Y
 )
 
 REM ========== CONFIRM PARAMETERS ==========
 
 CALL :PrintPars
 REM Note: DOS batch replaces variables on parsing, so one can't use a variable just set in an () block
-IF "%COQREGTESTING%"=="Y" (GOTO :DontAsk)
-  SET /p ANSWER=Is this correct? y/n 
+IF "%COQREGTESTING%"=="Y" (GOTO DontAsk)
+  SET /p ANSWER="Is this correct? y/n "
   IF NOT "%ANSWER%"=="y" (GOTO :EOF)
 :DontAsk
 
@@ -296,12 +314,13 @@ ECHO RESULT INSTALL DIR (MINGW)  = %RESULT_INSTALLDIR_MFMT%
 ECHO RESULT INSTALL DIR (CYGWIN) = %RESULT_INSTALLDIR_CFMT%
 
 REM WARNING: Add a space after the = in case you want set this to empty, otherwise the variable will be unset
-SET MAKE_OPT=-j %MAKE_THREADS% 
+SET MAKE_OPT=-j %MAKE_THREADS%
 
 REM ========== DERIVED CYGWIN SETUP OPTIONS ==========
 
-REM WARNING: Add a space after the = otherwise the variable will be unset
-SET CYGWIN_OPT= 
+REM One can't set a variable to empty in DOS, but you can set it to a space this way.
+REM The quotes are just there to make the space visible and to protect from "remove trailing spaces".
+SET "CYGWIN_OPT= "
 
 IF "%CYGWIN_FROM_CACHE%" == "Y" (
   SET CYGWIN_OPT= %CYGWIN_OPT% -L
@@ -315,17 +334,9 @@ IF "%GTK_FROM_SOURCES%"=="N" (
   SET CYGWIN_OPT= %CYGWIN_OPT% -P mingw64-%ARCH%-gtk2.0,mingw64-%ARCH%-gtksourceview2.0
 )
 
-ECHO ========== INSTALL CYGWIN ==========
-
 REM Cygwin setup sets proper ACLs (permissions) for folders it CREATES.
 REM Otherwise chmod won't work and e.g. the ocaml build will fail.
 REM Cygwin setup does not touch the ACLs of existing folders.
-REM => Create the setup log in a temporary location and move it later.
-
-REM Get Unique temporary file name
-:logfileloop
-SET LOGFILE=%TEMP%\CygwinSetUp%RANDOM%-%RANDOM%-%RANDOM%-%RANDOM%.log
-if exist "%LOGFILE%" goto :logfileloop
 
 REM Run Cygwin Setup
 
@@ -337,18 +348,31 @@ IF NOT "%CYGWIN_QUIET%" == "Y" (
   SET RUNSETUP=Y
 )
 
+IF "%COQREGTESTING%" == "Y" (
+  ECHO "========== REMOVE EXISTING CYGWIN =========="
+  DEL /S /F /Q "%CYGWIN_INSTALLDIR_WFMT%" > NUL
+  SET RUNSETUP=Y
+)
+
+SET "EXTRAPACKAGES= "
+
+IF NOT "%APPVEYOR%" == "True" (
+  SET EXTRAPACKAGES=-P wget,curl,git,gcc-core,gcc-g++,automake1.5
+)
+
+ECHO "========== INSTALL CYGWIN =========="
+
 IF "%RUNSETUP%"=="Y" (
   %SETUP% ^
-    --proxy %PROXY% ^
-    --site %CYGWIN_REPOSITORY% ^
-    --root %CYGWIN_INSTALLDIR_WFMT% ^
-    --local-package-dir %CYGWIN_LOCAL_CACHE_WFMT% ^
+    --proxy "%PROXY%" ^
+    --site "%CYGWIN_REPOSITORY%" ^
+    --root "%CYGWIN_INSTALLDIR_WFMT%" ^
+    --local-package-dir "%CYGWIN_LOCAL_CACHE_WFMT%" ^
     --no-shortcuts ^
     %CYGWIN_OPT% ^
-    -P wget,curl,git,make,unzip ^
-    -P gcc-core,gcc-g++ ^
+    -P 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 ^
@@ -358,15 +382,13 @@ IF "%RUNSETUP%"=="Y" (
     -P gtk-update-icon-cache ^
     -P libtool,automake ^
     -P intltool ^
-    > "%LOGFILE%" ^
-    || GOTO :Error
+    %EXTRAPACKAGES% ^
+    || GOTO ErrorExit
 
-  MKDIR %CYGWIN_INSTALLDIR_WFMT%\build
-  MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs
-  MOVE  "%LOGFILE%" %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs\cygwinsetup.log || GOTO :Error
+  MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build"
+  MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build\buildlogs"
 )
 
-
 IF NOT "%CYGWIN_QUIET%" == "Y" (
   REM Like most setup programs, cygwin setup starts the real setup as a separate process, so wait for it.
   REM This is not required with the -cygquiet=Y and the resulting --no-admin option.
@@ -377,18 +399,24 @@ IF NOT "%CYGWIN_QUIET%" == "Y" (
 
 ECHO ========== CONFIGURE CYGWIN USER ACCOUNT ==========
 
-copy %BATCHDIR%\configure_profile.sh %CYGWIN_INSTALLDIR_WFMT%\var\tmp || GOTO :Error
-%BASH% --login %CYGWIN_INSTALLDIR_CFMT%\var\tmp\configure_profile.sh %PROXY% || GOTO :Error
+REM In case this batch file is called from a cygwin bash (e.g. a git repo) we need to clear
+REM HOME (otherwise we get to the home directory of the other installation)
+REM PROFILEREAD (this is set to true if the /etc/profile has been read, which creates user)
+SET "HOME="
+SET "PROFILEREAD="
+
+copy "%BATCHDIR%\configure_profile.sh" "%CYGWIN_INSTALLDIR_WFMT%\var\tmp" || GOTO ErrorExit
+%BASH% --login "%CYGWIN_INSTALLDIR_CFMT%\var\tmp\configure_profile.sh" "%PROXY%" || GOTO ErrorExit
 
 ECHO ========== BUILD COQ ==========
 
-MKDIR %CYGWIN_INSTALLDIR_WFMT%\build
-MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\patches
+MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build"
+MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build\patches"
 
-COPY %BATCHDIR%\makecoq_mingw.sh    %CYGWIN_INSTALLDIR_WFMT%\build || GOTO :Error
-COPY %BATCHDIR%\patches_coq\*.* %CYGWIN_INSTALLDIR_WFMT%\build\patches || GOTO :Error
+COPY "%BATCHDIR%\makecoq_mingw.sh" "%CYGWIN_INSTALLDIR_WFMT%\build" || GOTO ErrorExit
+COPY "%BATCHDIR%\patches_coq\*.*" "%CYGWIN_INSTALLDIR_WFMT%\build\patches" || GOTO ErrorExit
 
-%BASH% --login %CYGWIN_INSTALLDIR_CFMT%\build\makecoq_mingw.sh || GOTO :Error
+%BASH% --login "%CYGWIN_INSTALLDIR_CFMT%\build\makecoq_mingw.sh" || GOTO ErrorExit
 
 ECHO ========== FINISHED ==========
 
@@ -411,12 +439,13 @@ ECHO ========== BATCH FUNCTIONS ==========
   ECHO -proxy    ^<internet proxy^>
   ECHO -cygrepo  ^<cygwin download repository^>
   ECHO -cygcache ^<local cygwin repository/cache^>
-  ECHO -cyglocal ^<Y or N^> install cygwin from cache 
+  ECHO -cyglocal ^<Y or N^> install cygwin from cache
   ECHO -cygquiet ^<Y or N^> install cygwin without user interaction
   ECHO -srccache ^<local source code repository/cache^>
-  ECHO -coqver   ^<Coq version to install^> 
+  ECHO -coqver   ^<Coq version to install^>
   ECHO -gtksrc   ^<Y or N^> build GTK ^(90 min^) or use cygwin version
   ECHO -threads  ^<1..N^> Number of make threads
+  ECHO -addon    ^<name^>  Enable building selected addon (can be repeated)
   ECHO(
   ECHO See ReadMe.txt for a detailed description of all parameters
   ECHO(
@@ -426,9 +455,9 @@ ECHO ========== BATCH FUNCTIONS ==========
   ECHO -ocaml    = %INSTALLOCAML%
   ECHO -installer= %MAKEINSTALLER%
   ECHO -make     = %INSTALLMAKE%
-  ECHO -destcyg  = %DESTCYG% 
-  ECHO -destcoq  = %DESTCOQ% 
-  ECHO -setup    = %SETUP% 
+  ECHO -destcyg  = %DESTCYG%
+  ECHO -destcoq  = %DESTCOQ%
+  ECHO -setup    = %SETUP%
   ECHO -proxy    = %PROXY%
   ECHO -cygrepo  = %CYGWIN_REPOSITORY%
   ECHO -cygcache = %CYGWIN_LOCAL_CACHE_WFMT%
@@ -438,8 +467,22 @@ ECHO ========== BATCH FUNCTIONS ==========
   ECHO -coqver   = %COQ_VERSION%
   ECHO -gtksrc   = %GTK_FROM_SOURCES%
   ECHO -threads  = %MAKE_THREADS%
+  ECHO -addon    = %COQ_ADDONS%
+  GOTO :EOF
+
+:CheckYN
+  REM Reset errorlevel to 0
+  CMD /c "EXIT /b 0"
+  IF "%2" == "Y" (
+    REM OK Y
+  ) ELSE IF "%2" == "N" (
+    REM OK N
+  ) ELSE (
+    ECHO ERROR Parameter %1 must be Y or N, but is %2
+    GOTO ErrorExit
+  )
   GOTO :EOF
 
-:Error
-ECHO Building Coq failed with error code %errorlevel%
-EXIT /b %errorlevel%
+:ErrorExit
+  ECHO ERROR MakeCoq_MinGW.bat failed
+  EXIT /b 1
diff --git a/dev/build/windows/MakeCoq_SetRootPath.bat b/dev/build/windows/MakeCoq_SetRootPath.bat
index 3a371172..bcb10477 100644
--- a/dev/build/windows/MakeCoq_SetRootPath.bat
+++ b/dev/build/windows/MakeCoq_SetRootPath.bat
@@ -1,3 +1,14 @@
+REM ========== COPYRIGHT/COPYLEFT ==========
+
+REM (C) 2016 Intel Deutschland GmbH
+REM Author: Michael Soegtrop
+
+REM Released to the public by Intel under the
+REM GNU Lesser General Public License Version 2.1 or later
+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
+
+REM ========== CHOOSE A SENSIBLE ROOT PATH ==========
+
 @ ECHO OFF
 
 REM Figure out a root path for coq and cygwin
diff --git a/dev/build/windows/MakeCoq_explicitcachefolders_installer.bat b/dev/build/windows/MakeCoq_explicitcachefolders_installer.bat
new file mode 100755
index 00000000..d7d3c5b9
--- /dev/null
+++ b/dev/build/windows/MakeCoq_explicitcachefolders_installer.bat
@@ -0,0 +1,28 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=git-v8.6 ^

+  -destcyg="%ROOTPATH%\cygwin_coq64_cachefolder_inst" ^

+  -destcoq="%ROOTPATH%\coq64_cachefolder_inst" ^

+  -cygcache="%ROOTPATH%\cache\cygwin" ^

+  -srccache="%ROOTPATH%\cache\source"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_explicitcachefolders_installer.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_local_installer.bat b/dev/build/windows/MakeCoq_local_installer.bat
new file mode 100755
index 00000000..752b73c1
--- /dev/null
+++ b/dev/build/windows/MakeCoq_local_installer.bat
@@ -0,0 +1,26 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=/cygdrive/d/coqgit/coq-8.6 ^

+  -destcyg="%ROOTPATH%\cygwin_coq64_local_inst" ^

+  -destcoq="%ROOTPATH%\coq64_local_inst"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_local_installer.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/MakeCoq_regtest_noproxy.bat b/dev/build/windows/MakeCoq_regtest_noproxy.bat
index 2b0b83fe..7140a7c6 100644
--- a/dev/build/windows/MakeCoq_regtest_noproxy.bat
+++ b/dev/build/windows/MakeCoq_regtest_noproxy.bat
@@ -1,7 +1,18 @@
+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

 call MakeCoq_SetRootPath

 

 SET HTTP_PROXY=

-EXPORT HTTP_PROXY=

+SET HTTPS_PROXY=

 MKDIR C:\Temp\srccache

 

 call MakeCoq_MinGW.bat ^

@@ -14,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/MakeCoq_regtests.bat b/dev/build/windows/MakeCoq_regtests.bat
index 6e36d014..74c26456 100644
--- a/dev/build/windows/MakeCoq_regtests.bat
+++ b/dev/build/windows/MakeCoq_regtests.bat
@@ -1,16 +1,36 @@
-SET COQREGTESTING=Y
+REM ========== COPYRIGHT/COPYLEFT ==========
 
-REM Bleeding edge
-call MakeCoq_86git_abs_ocaml.bat
-call MakeCoq_86git_installer.bat
-call MakeCoq_86git_installer_32.bat
-call MakeCoq_86git_abs_ocaml_gtksrc.bat
+REM (C) 2016 Intel Deutschland GmbH
+REM Author: Michael Soegtrop
+
+REM Released to the public by Intel under the
+REM GNU Lesser General Public License Version 2.1 or later
+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
+
+REM ========== RUN REGRESSION TESTS FOR COQ BUILD SCRIPTS ==========
+
+SET COQREGTESTING=Y
 
 REM Current stable
-call MakeCoq_85pl3_abs_ocaml.bat
-call MakeCoq_85pl3_installer.bat
-call MakeCoq_85pl3_installer_32.bat
+call MakeCoq_86git_abs_ocaml.bat || GOTO Error
+call MakeCoq_86git_installer.bat || GOTO Error
+call MakeCoq_86git_installer_32.bat || GOTO Error
 
 REM Old but might still be used
-call MakeCoq_85pl2_abs_ocaml.bat
-call MakeCoq_84pl6_abs_ocaml.bat
+call MakeCoq_85pl3_abs_ocaml.bat || GOTO Error
+call MakeCoq_84pl6_abs_ocaml.bat || GOTO Error
+
+REM Special variants, e.g. for debugging
+call MakeCoq_86git_abs_ocaml_gtksrc.bat || GOTO Error
+call MakeCoq_local_installer.bat || GOTO Error
+call MakeCoq_explicitcachefolders_installer.bat || GOTO Error
+
+REM Bleeding edge
+call MakeCoq_trunk_installer.bat || GOTO Error
+
+ECHO MakeCoq_regtests.bat: All tests finished successfully
+GOTO :EOF
+
+:Error
+ECHO MakeCoq_regtests.bat failed with error code %ERRORLEVEL%
+EXIT /b %ERRORLEVEL%
diff --git a/dev/build/windows/MakeCoq_trunk_installer.bat b/dev/build/windows/MakeCoq_trunk_installer.bat
new file mode 100755
index 00000000..f4f58273
--- /dev/null
+++ b/dev/build/windows/MakeCoq_trunk_installer.bat
@@ -0,0 +1,26 @@
+@ECHO OFF

+

+REM ========== COPYRIGHT/COPYLEFT ==========

+

+REM (C) 2016 Intel Deutschland GmbH

+REM Author: Michael Soegtrop

+

+REM Released to the public by Intel under the

+REM GNU Lesser General Public License Version 2.1 or later

+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html

+

+REM ========== BUILD COQ ==========

+

+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=git-trunk ^

+  -destcyg="%ROOTPATH%\cygwin_coq64_trunk_inst" ^

+  -destcoq="%ROOTPATH%\coq64_trunk_inst"

+

+IF %ERRORLEVEL% NEQ 0 (

+  ECHO MakeCoq_86git_installer.bat failed with error code %ERRORLEVEL%

+  EXIT /b %ERRORLEVEL%

+)

diff --git a/dev/build/windows/ReadMe.txt b/dev/build/windows/ReadMe.txt
index 0faf5bc5..93851aeb 100644
--- a/dev/build/windows/ReadMe.txt
+++ b/dev/build/windows/ReadMe.txt
@@ -1,3 +1,12 @@
+(C) 2016 Intel Deutschland GmbH
+Author: Michael Soegtrop
+
+Released to the public by Intel under the
+GNU Lesser General Public License Version 2.1 or later
+See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
+
+This license also applies to all files in the patches_coq subfolder.
+
 ==================== Purpose / Goal ====================
 
 The main purpose of these scripts is to build Coq for Windows in a reproducible
@@ -52,6 +61,7 @@ The Script MakeCoq_MinGW does:
 - either installs MinGW GTK via Cygwin or compiles it fom sources
 - download, compile and install OCaml, CamlP5, Menhir, lablgtk
 - download, compile and install Coq
+- download, compile and install selected addons
 - create a Windows installer (NSIS based)
 
 The parameters are described below. Mostly paths and the HTTP proxy need to be
@@ -286,9 +296,16 @@ Default value: <folder of MakeCoq_MinGW.bat>\source_cache
 
 The version of Coq to download and compile.
 
-Possible values: 8.4pl6, 8.5pl2, 8.5pl3, git-v8.6 
-                 Others might work, but are untested.
+Possible values: 8.4pl6, 8.5pl2, 8.5pl3, 8.6
+                 (download from https://coq.inria.fr/distrib/V$COQ_VERSION/files/coq-<version>.tar.gz)
+                 Others versions might work, but are untested.
                  8.4 is only tested in mode=absoloute
+                 
+                 git-v8.6, git-trunk
+                 (download from https://github.com/coq/coq/archive/<version without git->.zip)
+                 
+                 /cygdrive/....
+                 Use local folder. The sources are archived as coq-local.tar.gz
 
 Default value: 8.5pl3
 
@@ -319,9 +336,15 @@ Possible values: 1..N.
                  Should not be more than 1.5x the number of cores.
                  Should not be more than available RAM/2GB (e.g. 4 for 8GB)
 
+===== -addon =====
+
+Enable build and installation of selected Coq package (can be repeated for
+selecting more packages)
 
 ==================== TODO ====================
 
+- Check for spaces in destination paths
+- Check for = signs in all paths (DOS commands don't work with pathes with = in it, possibly even when quoted)
 - Installer doesn't remove OCAMLLIB environment variables (it is in the script, but doesn't seem to work)
 - CoqIDE doesn't find theme files
 - Finish / test mingw_in_Cygwin mode (coqide doesn't start, coqc slow cause of scanning complete share folder)
@@ -400,7 +423,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
@@ -420,7 +442,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 09a9cf35..16c972e8 100644
--- a/dev/build/windows/configure_profile.sh
+++ b/dev/build/windows/configure_profile.sh
@@ -1,5 +1,16 @@
 #!/bin/bash
 
+###################### COPYRIGHT/COPYLEFT ######################
+
+# (C) 2016 Intel Deutschland GmbH
+# Author: Michael Soegtrop
+#
+# Released to the public by Intel under the
+# GNU Lesser General Public License Version 2.1 or later
+# See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
+
+###################### CONFIGURE CYGWIN USER PROFILE FOR BUILDING COQ ######################
+
 rcfile=~/.bash_profile
 donefile=~/.bash_profile.upated
 
@@ -7,7 +18,7 @@ if [ ! -f $donefile ] ; then
 
     echo >> $rcfile
     
-    if [ -n "$1" ]; then
+    if [ "$1" != "" -a "$1" != " " ]; then
       echo export http_proxy="http://$1" >> $rcfile
       echo export https_proxy="http://$1" >> $rcfile
       echo export ftp_proxy="http://$1" >> $rcfile
@@ -29,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/difftar-folder.sh b/dev/build/windows/difftar-folder.sh
index 65278d5c..cbcf14ec 100644
--- a/dev/build/windows/difftar-folder.sh
+++ b/dev/build/windows/difftar-folder.sh
@@ -8,35 +8,28 @@
 # Released to the public by Intel under the
 # GNU Lesser General Public License Version 2.1 or later
 # See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
-#
-# With very valuable help on building GTK from
-#   https://wiki.gnome.org/Projects/GTK+/Win32/MSVCCompilationOfGTKStack
-#   http://www.gaia-gis.it/spatialite-3.0.0-BETA/mingw64_how_to.html
 
-###################### Script safety and debugging settings ######################
+###################### DIFF A TAR FILE AND A FOLDER ######################
 
 set -o nounset
 
 # Print usage
 
-if [ "$#" -lt 1 ] ; then
+if [ "$#" -lt 2 ] ; then
   echo 'Diff a tar (or compressed tar) file with a folder'
-  echo 'difftar-folder.sh <tarfile> [<folder>] [strip]'
-  echo default for folder is .
-  echo default for strip is 0.
-  echo 'strip must be 0 or 1.'
+  echo 'difftar-folder.sh <tarfile> <folder> [strip]'
+  echo '<tarfile> is the name of the tar file do diff with (required)'
+  echo '<folder> is the name of the folder to diff with (required)'
+  echo '<strip> is the number of path components to strip from tar file (default is 0)'
+  echo 'All files in the tar file must have at least <strip> path components.'
+  echo 'This also adds new files from folder.new, if folder.new exists'
   exit 1
 fi
 
 # Parse parameters
 
 tarfile=$1
-
-if [ "$#" -ge 2 ] ; then
-  folder=$2
-else
-  folder=.
-fi
+folder=$2
 
 if [ "$#" -ge 3 ] ; then
   strip=$3
@@ -47,27 +40,33 @@ fi
 # Get path prefix if --strip is used
 
 if [ "$strip" -gt 0 ] ; then
-  prefix=`tar -t -f $tarfile | head -1`
+  # Get the path/name of the first file from teh tar and extract the first $strip path components
+  # This assumes that the first file in the tar file has at least $strip many path components
+  prefix=$(tar -t -f $tarfile | head -1 | cut -d / -f -$strip)/
 else
   prefix=
 fi
 
 # Original folder
 
-if [ "$strip" -gt 0 ] ; then
-  orig=${prefix%/}.orig
-elif [ "$folder" = "." ] ; then
-  orig=${tarfile##*/}
-  orig=./${orig%%.tar*}.orig
-elif [ "$folder" = "" ] ; then
-  orig=${tarfile##*/}
-  orig=${orig%%.tar*}.orig
-else
-  orig=$folder.orig
-fi
-echo $orig
+orig=$folder.orig
 mkdir -p "$orig"
 
+# New amd empty filefolder
+
+new=$folder.new
+empty=$folder.empty
+mkdir -p "$empty"
+
+# Print information (this is ignored by patch)
+
+echo diff/patch file created on $(date) with:
+echo difftar-folder.sh $@
+echo TARFILE=    $tarfile
+echo FOLDER=     $folder
+echo TARSTRIP=   $strip
+echo TARPREFIX=  $prefix
+echo ORIGFOLDER= $orig
 
 # Make sure tar uses english output (for Mod time differs)
 export LC_ALL=C
@@ -83,4 +82,8 @@ tar --diff -a -f "$tarfile" --strip $strip --directory "$folder" | grep "Mod tim
     # Compute diff
     diff -u "$orig/$file" "$folder/$file" 
   fi
-done
\ No newline at end of file
+done
+
+if [ -d "$new" ] ; then
+  diff -u -r --unidirectional-new-file $empty $new
+fi
diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh
index 52b15887..86cc5f2d 100644..100755
--- a/dev/build/windows/makecoq_mingw.sh
+++ b/dev/build/windows/makecoq_mingw.sh
@@ -2,7 +2,7 @@
 
 ###################### COPYRIGHT/COPYLEFT ######################
 
-# (C) 2016 Intel Deutschland GmbH
+# (C) 2016..2018 Intel Deutschland GmbH
 # Author: Michael Soegtrop
 #
 # Released to the public by Intel under the
@@ -18,6 +18,8 @@
 set -o nounset
 set -o errexit
 set -x
+# Print current wall time as part of the xtrace
+export PS4='+\t '
 
 # Set this to 1 if all module directories shall be removed before build (no incremental make)
 RMDIR_BEFORE_BUILD=1
@@ -67,7 +69,7 @@ RMDIR_BEFORE_BUILD=1
 ###################### ARCHITECTURES #####################
 
 # The OS on which the build of the tool/lib runs
-BUILD=`gcc -dumpmachine`
+BUILD=$(gcc -dumpmachine)
 
 # The OS on which the tool runs
 # "`find /bin -name "*mingw32-gcc.exe"`" -dumpmachine
@@ -98,6 +100,8 @@ mkdir -p $TARBALLS
 mkdir -p $FILELISTS
 cd /build
 
+# Create source cache folder
+mkdir -p "$SOURCE_LOCAL_CACHE_CFMT"
 
 # sysroot prefix for the above /build/host/target combination
 PREFIX=$CYGWIN_INSTALLDIR_MFMT/usr/$TARGET_ARCH/sys-root/mingw
@@ -112,9 +116,16 @@ else
   PREFIXOCAML=$PREFIX
 fi
 
-mkdir -p $PREFIX/bin
-mkdir -p $PREFIXCOQ/bin
-mkdir -p $PREFIXOCAML/bin
+mkdir -p "$PREFIX/bin"
+mkdir -p "$PREFIXCOQ/bin"
+mkdir -p "$PREFIXOCAML/bin"
+
+# This is required for building addons and plugins
+# This must be CFMT (/cygdrive/c/...) otherwise coquelicot 3.0.2 configure fails.
+# coquelicot uses which ${COQBIN}/coqc to check if coqc exists. This does not work with COQBIN in MFMT.
+export COQBIN=$RESULT_INSTALLDIR_CFMT/bin/
+# This must be MFMT (C:/) otherwise bignums 68a7a3d7e0b21985913a6c3ee12067f4c5ac4e20 fails
+export COQLIB=$RESULT_INSTALLDIR_MFMT/lib/coq/
 
 ###################### Copy Cygwin Setup Info #####################
 
@@ -128,36 +139,92 @@ CYGWIN_REPO_FOLDER=${CYGWIN_REPO_FOLDER//:/%3a}
 CYGWIN_REPO_FOLDER=${CYGWIN_REPO_FOLDER//\//%2f}
 
 # Copy files
-cp $CYGWIN_LOCAL_CACHE_WFMT/$CYGWIN_REPO_FOLDER/$CYGWINARCH/setup.ini $TARBALLS
+cp "$CYGWIN_LOCAL_CACHE_WFMT/$CYGWIN_REPO_FOLDER/$CYGWINARCH/setup.ini" $TARBALLS
 cp /etc/setup/installed.db $TARBALLS
-  
+
 ###################### LOGGING #####################
 
 # The folder which receives log files
 mkdir -p buildlogs
-LOGS=`pwd`/buildlogs
+LOGS=$(pwd)/buildlogs
 
 # The current log target (first part of the log file name)
 LOGTARGET=other
 
-log1() {
-  "$@" > $LOGS/$LOGTARGET-$1.log 2> $LOGS/$LOGTARGET-$1.err
-}
+# For an explanation of ${COQREGTESTING:-N} search for ${parameter:-word} in
+# http://pubs.opengroup.org/onlinepubs/009695399/utilities/xcu_chap02.html
+
+if [ "${COQREGTESTING:-N}" == "Y" ] ; then
+  # If COQREGTESTING, log to log files only
+  # Log command output - take log target name from command name (like log1 make => log target is "<module>-make")
+  log1() {
+    { local -; set +x; } 2> /dev/null
+    "$@" >"$LOGS/$LOGTARGET-$1.log"  2>"$LOGS/$LOGTARGET-$1.err"
+  }
+
+  # Log command output - take log target name from command name and first argument (like log2 make install => log target is "<module>-make-install")
+  log2() {
+    { local -; set +x; } 2> /dev/null
+    "$@" >"$LOGS/$LOGTARGET-$1-$2.log" 2>"$LOGS/$LOGTARGET-$1-$2.err"
+  }
+
+  # Log command output - take log target name from command name and second argument (like log_1_3 ocaml setup.ml -configure => log target is "<module>-ocaml--configure")
+  log_1_3() {
+    { local -; set +x; } 2> /dev/null
+    "$@" >"$LOGS/$LOGTARGET-$1-$3.log" 2>"$LOGS/$LOGTARGET-$1-$3.err"
+  }
+
+  # Log command output - log target name is first argument (like logn untar tar xvaf ... => log target is "<module>-untar")
+  logn() {
+    { local -; set +x; } 2> /dev/null
+    LOGTARGETEX=$1
+    shift
+    "$@" >"$LOGS/$LOGTARGET-$LOGTARGETEX.log" 2>"$LOGS/$LOGTARGET-$LOGTARGETEX.err"
+  }
+else
+  # If COQREGTESTING, log to log files and console
+  # Log command output - take log target name from command name (like log1 make => log target is "<module>-make")
+  log1() {
+    { local -; set +x; } 2> /dev/null
+    "$@" > >(tee "$LOGS/$LOGTARGET-$1.log" | sed -e "s/^/$LOGTARGET-$1.log: /") 2> >(tee "$LOGS/$LOGTARGET-$1.err" | sed -e "s/^/$LOGTARGET-$1.err: /" 1>&2)
+  }
+
+  # Log command output - take log target name from command name and first argument (like log2 make install => log target is "<module>-make-install")
+  log2() {
+    { local -; set +x; } 2> /dev/null
+    "$@" > >(tee "$LOGS/$LOGTARGET-$1-$2.log" | sed -e "s/^/$LOGTARGET-$1-$2.log: /") 2> >(tee "$LOGS/$LOGTARGET-$1-$2.err" | sed -e "s/^/$LOGTARGET-$1-$2.err: /" 1>&2)
+  }
+
+  # Log command output - take log target name from command name and second argument (like log_1_3 ocaml setup.ml -configure => log target is "<module>-ocaml--configure")
+  log_1_3() {
+    { local -; set +x; } 2> /dev/null
+    "$@" > >(tee "$LOGS/$LOGTARGET-$1-$3.log" | sed -e "s/^/$LOGTARGET-$1-$3.log: /") 2> >(tee "$LOGS/$LOGTARGET-$1-$3.err" | sed -e "s/^/$LOGTARGET-$1-$3.err: /" 1>&2)
+  }
+
+  # Log command output - log target name is first argument (like logn untar tar xvaf ... => log target is "<module>-untar")
+  logn() {
+    { local -; set +x; } 2> /dev/null
+    LOGTARGETEX=$1
+    shift
+    "$@" > >(tee "$LOGS/$LOGTARGET-$LOGTARGETEX.log" | sed -e "s/^/$LOGTARGET-$LOGTARGETEX.log: /") 2> >(tee "$LOGS/$LOGTARGET-$LOGTARGETEX.err" | sed -e "s/^/$LOGTARGET-$LOGTARGETEX.err: /" 1>&2)
+  }
+fi
 
-log2() {
-  "$@" > $LOGS/$LOGTARGET-$1-$2.log 2> $LOGS/$LOGTARGET-$1-$2.err
-}
+###################### 'UNFIX' SED #####################
 
-log_1_3() {
-  "$@" > $LOGS/$LOGTARGET-$1-$3.log 2> $LOGS/$LOGTARGET-$1-$3.err
-}
+# In Cygwin SED used to do CR-LF to LF conversion, but since sed 4.4-1 this was changed
+# We replace sed with a shell script which restores the old behavior for piped input
+
+#if [ -f /bin/sed.exe ]
+#then
+#  mv /bin/sed.exe /bin/sed_orig.exe
+#fi
+#cat  > /bin/sed << EOF
+##!/bin/sh
+#dos2unix | /bin/sed_orig.exe "$@"
+#EOF
+#chmod a+x /bin/sed
 
-logn() {
-  LOGTARGETEX=$1
-  shift
-  "$@" > $LOGS/$LOGTARGET-$LOGTARGETEX.log 2> $LOGS/$LOGTARGET-$LOGTARGETEX.err
-}
- 
 ###################### UTILITY FUNCTIONS #####################
 
 # ------------------------------------------------------------------------------
@@ -166,7 +233,7 @@ logn() {
 # - create build folder
 # - extract source archive
 # - patch source file if patch exists
-# 
+#
 # Parameters
 # $1 file server name including protocol prefix
 # $2 file name (without extension)
@@ -189,62 +256,68 @@ function get_expand_source_tar {
   else
     name=$2
   fi
-  
+
   if [ "$#" -ge 6 ] ; then
     folder=$6
   else
     folder=$name
   fi
-  
+
   # Set logging target
   logtargetold=$LOGTARGET
   LOGTARGET=$name
-  
+
   # Get the source archive either from the source cache or online
-  if [ ! -f $TARBALLS/$name.$3 ] ; then
-    if [ -f $SOURCE_LOCAL_CACHE_CFMT/$name.$3 ] ; then
-      cp $SOURCE_LOCAL_CACHE_CFMT/$name.$3 $TARBALLS
+  if [ ! -f "$TARBALLS/$name.$3" ] ; then
+    if [ -f "$SOURCE_LOCAL_CACHE_CFMT/$name.$3" ] ; then
+      cp "$SOURCE_LOCAL_CACHE_CFMT/$name.$3" "$TARBALLS"
     else
-      wget $1/$2.$3
+      wget --progress=dot:giga "$1/$2.$3"
+      if file -i "$2.$3" | grep text/html; then
+        echo Download failed: "$1/$2.$3"
+        echo The file wget downloaded is an html file:
+        cat "$2.$3"
+        exit 1
+      fi
       if [ ! "$2.$3" == "$name.$3" ] ; then
-        mv $2.$3 $name.$3
+        mv "$2.$3" "$name.$3"
       fi
-      mv $name.$3 $TARBALLS
+      mv "$name.$3" "$TARBALLS"
       # Save the source archive in the source cache
-      if [ -d $SOURCE_LOCAL_CACHE_CFMT ] ; then
-        cp $TARBALLS/$name.$3 $SOURCE_LOCAL_CACHE_CFMT
+      if [ -d "$SOURCE_LOCAL_CACHE_CFMT" ] ; then
+        cp "$TARBALLS/$name.$3" "$SOURCE_LOCAL_CACHE_CFMT"
       fi
     fi
   fi
-  
+
   # Remove build directory (clean build)
   if [ $RMDIR_BEFORE_BUILD -eq 1 ] ; then
-    rm -f -r $folder
+    rm -f -r "$folder"
   fi
-  
+
   # Create build directory and cd
-  mkdir -p $folder
-  cd $folder
-  
+  mkdir -p "$folder"
+  cd "$folder"
+
   # Extract source archive
   if [ "$3" == "zip" ] ; then
-    log1 unzip $TARBALLS/$name.$3
+    log1 unzip "$TARBALLS/$name.$3"
     if [ "$strip" == "1" ] ; then
-      # Ok, this is dirty, but it works and it fails if there are name clashes
-      mv */* .
+      # move subfolders of root folders one level up
+      find "$(ls)" -mindepth 1 -maxdepth 1 -exec mv -- "{}" . \;
     else
       echo "Unzip strip count not supported"
       return 1
     fi
   else
-    logn untar tar xvaf $TARBALLS/$name.$3 --strip $strip
+    logn untar tar xvaf "$TARBALLS/$name.$3" --strip $strip
   fi
-  
+
   # Patch if patch file exists
-  if [ -f $PATCHES/$name.patch ] ; then
-    log1 patch -p1 -i $PATCHES/$name.patch
+  if [ -f "$PATCHES/$name.patch" ] ; then
+    log1 patch -p1 -i "$PATCHES/$name.patch"
   fi
-  
+
   # Go back to base folder
   cd ..
 
@@ -260,7 +333,7 @@ function get_expand_source_tar {
 # - cd to build folder and extract source archive
 # - create bin_special subfolder and add it to $PATH
 # - remember things for build_post
-# 
+#
 # Parameters
 # $1 file server name including protocol prefix
 # $2 file name (without extension)
@@ -282,43 +355,102 @@ function build_prep {
   else
     name=$2
   fi
-  
+
+  # Set installer section to not set by default
+  installersection=
+
   # Check if build is already done
-  if [ ! -f flagfiles/$name.finished ] ; then
+  if [ ! -f "$FLAGFILES/$name.finished" ] ; then
     BUILD_PACKAGE_NAME=$name
     BUILD_OLDPATH=$PATH
-    BUILD_OLDPWD=`pwd`
+    BUILD_OLDPWD=$(pwd)
     LOGTARGET=$name
 
-    touch flagfiles/$name.started
-    
-    get_expand_source_tar $1 $2 $3 $strip $name
-    
-    cd $name
-    
+    touch "$FLAGFILES/$name.started"
+
+    get_expand_source_tar "$1" "$2" "$3" "$strip" "$name"
+
+    cd "$name"
+
     # Create a folder and add it to path, where we can put special binaries
     # The path is restored in build_post
     mkdir bin_special
-    PATH=`pwd`/bin_special:$PATH
-    
+    PATH=$(pwd)/bin_special:$PATH
+
     return 0
-  else  
+  else
     return 1
   fi
 }
 
 # ------------------------------------------------------------------------------
+# Like build_prep, but gets the data from an entry in ci-basic-overlay.sh
+# This assumes the following definitions exist in ci-basic-overlay.sh,
+# or in a file in the user-overlays folder:
+# $1_CI_REF
+# $1_CI_ARCHIVEURL
+# $1_CI_GITURL
+# ATTENTION: variables in ci-basic-overlay.sh are loaded by load_overlay_data.
+# load_overlay_data is is called at the end of make_coq (even if the build is skipped)
+#
+# Parameters
+# $1 base name of module in ci-basic-overlay.sh, e.g. mathcomp, bignums, ...
+# ------------------------------------------------------------------------------
+
+function build_prep_overlay {
+  urlvar=$1_CI_ARCHIVEURL
+  gitvar=$1_CI_GITURL
+  refvar=$1_CI_REF
+  url=${!urlvar}
+  git=${!gitvar}
+  ref=${!refvar}
+  ver=$(git ls-remote "$git" "refs/heads/$ref" | cut -f 1)
+  if [[ "$ver" == "" ]]; then
+      # $1_CI_REF must have been a tag or hash, not a branch
+      ver="$ref"
+  fi
+  build_prep "$url" "$ver" tar.gz 1 "$1-$ver"
+}
+
+# ------------------------------------------------------------------------------
+# Load overlay version variables from ci-basic-overlay.sh and user-overlays/*.sh
+# ------------------------------------------------------------------------------
+
+function load_overlay_data {
+  if [ -n "${GITLAB_CI+}" ]; then
+    export CI_BRANCH="$CI_COMMIT_REF_NAME"
+    if [[ ${CI_BRANCH#pr-} =~ ^[0-9]*$ ]]; then
+      export CI_PULL_REQUEST="${CI_BRANCH#pr-}"
+    else
+      export CI_PULL_REQUEST=""
+    fi
+  else
+    export CI_BRANCH=""
+    export CI_PULL_REQUEST=""
+    # Used when building 8.8.0 with the latest scripts
+    export TRAVIS_BRANCH=""
+    export TRAVIS_PULL_REQUEST=""
+  fi
+
+  for overlay in /build/user-overlays/*.sh; do
+    . "$overlay"
+  done
+  . /build/ci-basic-overlay.sh
+}
+
+# ------------------------------------------------------------------------------
 # Finalize a module build
 # - create name.finished
 # - go back to base folder
 # ------------------------------------------------------------------------------
 
 function build_post {
-  if [ ! -f flagfiles/$BUILD_PACKAGE_NAME.finished ]; then
-    cd $BUILD_OLDPWD
-    touch flagfiles/$BUILD_PACKAGE_NAME.finished
+  if [ ! -f "$FLAGFILES/$BUILD_PACKAGE_NAME.finished" ]; then
+    cd "$BUILD_OLDPWD"
+    touch "$FLAGFILES/$BUILD_PACKAGE_NAME.finished"
     PATH=$BUILD_OLDPATH
     LOGTARGET=other
+    installer_addon_end
   fi
 }
 
@@ -339,9 +471,10 @@ function build_post {
 # ------------------------------------------------------------------------------
 
 function build_conf_make_inst {
-  if build_prep $1 $2 $3 ; then
+  if build_prep "$1" "$2" "$3" ; then
     $4
-    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX "${@:5}"
+    logn configure ./configure --build="$BUILD" --host="$HOST" --target="$TARGET" --prefix="$PREFIX" "${@:5}"
+    # shellcheck disable=SC2086
     log1 make $MAKE_OPT
     log2 make install
     log2 make clean
@@ -353,18 +486,17 @@ function build_conf_make_inst {
 # Install all files given by a glob pattern to a given folder
 #
 # parameters
-# $1 glob pattern (in '')
-# $2 target folder
+# $1 source path
+# $2 pattern (in '')
+# $3 target folder
 # ------------------------------------------------------------------------------
 
 function install_glob {
-  # Check if any files matching the pattern exist
-  if [ "$(echo $1)" != "$1" ] ; then
-    install -D -t $2 $1
-  fi
+  SRCDIR=$(realpath -m $1)
+  DESTDIR=$(realpath -m $3)
+  ( cd "$SRCDIR" && find . -maxdepth 1 -type f -name "$2" -exec install -D -T  "$SRCDIR"/{} "$DESTDIR"/{} \; )
 }
 
-
 # ------------------------------------------------------------------------------
 # Recursively Install all files given by a glob pattern to a given folder
 #
@@ -375,12 +507,15 @@ function install_glob {
 # ------------------------------------------------------------------------------
 
 function install_rec {
-  ( cd $1 && find -type f -name "$2" -exec install -D -T  $1/{} $3/{} \; )
+  SRCDIR=$(realpath -m $1)
+  DESTDIR=$(realpath -m $3)
+  ( cd "$SRCDIR" && find . -type f -name "$2" -exec install -D -T  "$SRCDIR"/{} "$DESTDIR"/{} \; )
 }
 
 # ------------------------------------------------------------------------------
 # Write a file list of the target folder
 # The file lists are used to create file lists for the windows installer
+# Don't overwrite an existing file list
 #
 # parameters
 # $1 name of file list
@@ -388,11 +523,24 @@ function install_rec {
 
 function list_files {
   if [ ! -e "/build/filelists/$1" ] ; then
-    ( cd $PREFIXCOQ && find -type f | sort > /build/filelists/$1 )
+    ( cd "$PREFIXCOQ" && find . -type f | sort > /build/filelists/"$1" )
   fi
 }
 
 # ------------------------------------------------------------------------------
+# Write a file list of the target folder
+# The file lists are used to create file lists for the windows installer
+# Do overwrite an existing file list
+#
+# parameters
+# $1 name of file list
+# ------------------------------------------------------------------------------
+
+function list_files_always {
+  ( cd "$PREFIXCOQ" && find . -type f | sort > /build/filelists/"$1" )
+}
+
+# ------------------------------------------------------------------------------
 # Compute the set difference of two file lists
 #
 # parameters
@@ -416,7 +564,7 @@ function diff_files {
 # ------------------------------------------------------------------------------
 
 function filter_files {
-  egrep "$3" "/build/filelists/$2" > "/build/filelists/$1"
+  grep -E "$3" "/build/filelists/$2" > "/build/filelists/$1"
 }
 
 # ------------------------------------------------------------------------------
@@ -430,28 +578,124 @@ function files_to_nsis {
   # Split the path in the file list into path and filename and create SetOutPath and File instructions
   # Note: File /oname cannot be used, because it does not create the paths as SetOutPath does
   # Note: I didn't check if the redundant SetOutPath instructions have a bad impact on installer size or install time
-  cat "/build/filelists/$1" | tr '/' '\\' | sed -r 's/^\.(.*)\\([^\\]+)$/SetOutPath $INSTDIR\\\1\nFile ${COQ_SRC_PATH}\\\1\\\2/' > "/build/filelists/$1.nsh"
+  tr '/' '\\' < "/build/filelists/$1" | sed -r 's/^\.(.*)\\([^\\]+)$/SetOutPath $INSTDIR\\\1\nFile ${COQ_SRC_PATH}\\\1\\\2/' > "/build/filelists/$1.nsh"
 }
 
+# ------------------------------------------------------------------------------
+# Create an nsis installer addon section
+#
+# parameters
+# $1 identifier of installer section and base name of file list files
+# $2 human readable name of section
+# $3 description of section
+# $4 flags (space separated list of keywords): off = default off
+#
+# $1 must be a valid NSIS identifier!
+# ------------------------------------------------------------------------------
+
+function installer_addon_section {
+  installersection=$1
+  list_files "addon_pre_$installersection"
+
+  echo 'LangString' "DESC_$1" '${LANG_ENGLISH}' "\"$3\"" >> "/build/filelists/addon_strings.nsh"
+
+  echo '!insertmacro MUI_DESCRIPTION_TEXT' '${'"Sec_$1"'}' '$('"DESC_$1"')' >> "/build/filelists/addon_descriptions.nsh"
+
+  local sectionoptions=
+  if [[ "$4" == *off* ]] ; then sectionoptions+=" /o" ; fi
+
+  echo "Section $sectionoptions \"$2\" Sec_$1" >> "/build/filelists/addon_sections.nsh"
+  echo 'SetOutPath "$INSTDIR\"' >> "/build/filelists/addon_sections.nsh"
+  echo '!include "..\..\..\filelists\addon_'"$1"'.nsh"' >> "/build/filelists/addon_sections.nsh"
+  echo 'SectionEnd' >> "/build/filelists/addon_sections.nsh"
+}
+
+# ------------------------------------------------------------------------------
+# Start an installer addon dependency group
+#
+# parameters
+# $1 identifier of the section which depends on other sections
+# The parameters must match the $1 parameter of a installer_addon_section call
+# ------------------------------------------------------------------------------
+
+dependencysections=
+
+function installer_addon_dependency_beg {
+  installer_addon_dependency "$1"
+  dependencysections="$1 $dependencysections"
+}
+
+# ------------------------------------------------------------------------------
+# End an installer addon dependency group
+# ------------------------------------------------------------------------------
+
+function installer_addon_dependency_end {
+  set -- $dependencysections
+  shift
+  dependencysections="$*"
+}
+
+# ------------------------------------------------------------------------------
+# Create an nsis installer addon dependency entry
+# This needs to be bracketed with installer_addon_dependencies_beg/end
+#
+# parameters
+# $1 identifier of the section on which other sections might depend
+# The parameters must match the $1 parameter of a installer_addon_section call
+# ------------------------------------------------------------------------------
+
+function installer_addon_dependency {
+  for section in $dependencysections ; do
+    echo '${CheckSectionDependency} ${Sec_'"$section"'} ${Sec_'"$1"'} '"'$section' '$1'" >> "/build/filelists/addon_dependencies.nsh"
+  done
+}
+
+# ------------------------------------------------------------------------------
+# Finish an installer section after an addon build
+#
+# This creates the file list files
+#
+# parameters: none
+# ------------------------------------------------------------------------------
+
+function installer_addon_end {
+  if [ -n "$installersection" ]; then
+    list_files "addon_post_$installersection"
+    diff_files "addon_$installersection" "addon_post_$installersection" "addon_pre_$installersection"
+    files_to_nsis "addon_$installersection"
+  fi
+}
 
 ###################### MODULE BUILD FUNCTIONS #####################
 
+##### SED #####
+
+function make_sed {
+  if build_prep https://ftp.gnu.org/gnu/sed/  sed-4.2.2  tar.gz ; then
+    logn configure ./configure
+    log1 make
+    log2 make install
+    log2 make clean
+    build_post
+  fi
+}
+
 ##### LIBPNG #####
 
 function make_libpng {
-  build_conf_make_inst  http://prdownloads.sourceforge.net/libpng  libpng-1.6.18  tar.gz  true
+  build_conf_make_inst  http://prdownloads.sourceforge.net/libpng  libpng-1.6.34  tar.gz  true
 }
 
 ##### PIXMAN #####
 
 function make_pixman {
-  build_conf_make_inst  http://cairographics.org/releases  pixman-0.32.8  tar.gz  true
+  build_conf_make_inst  http://cairographics.org/releases  pixman-0.34.0  tar.gz  true
 }
 
 ##### FREETYPE #####
 
 function make_freetype {
-  build_conf_make_inst  http://sourceforge.net/projects/freetype/files/freetype2/2.6.1  freetype-2.6.1  tar.bz2  true
+  build_conf_make_inst  http://sourceforge.net/projects/freetype/files/freetype2/2.9.1  freetype-2.9.1  tar.bz2  true
 }
 
 ##### EXPAT #####
@@ -466,8 +710,8 @@ function make_fontconfig {
   make_freetype
   make_expat
   # CONFIGURE PARAMETERS
-  # build/install fails without --disable-docs 
-  build_conf_make_inst  http://www.freedesktop.org/software/fontconfig/release  fontconfig-2.11.94  tar.gz  true  --disable-docs
+  # build/install fails without --disable-docs
+  build_conf_make_inst  http://www.freedesktop.org/software/fontconfig/release  fontconfig-2.12.93  tar.gz  true  --disable-docs
 }
 
 ##### ICONV #####
@@ -497,7 +741,7 @@ function make_ncurses {
   #
   # CONFIGURE PARAMETERS
   # --enable-term-driver --enable-sp-funcs is rewuired for mingw (see README.MinGW)
-  # additional changes 
+  # additional changes
   # ADD --with-pkg-config
   # ADD --enable-pc-files
   # ADD --without-manpages
@@ -547,8 +791,7 @@ function make_glib {
   make_gettext
   make_libffi
   make_libpcre
-  # build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/glib/2.46  glib-2.46.0  tar.xz  true
-  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/glib/2.47  glib-2.47.5  tar.xz  true
+  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/glib/2.57  glib-2.57.1  tar.xz  true
 }
 
 ##### ATK #####
@@ -556,7 +799,7 @@ function make_glib {
 function make_atk {
   make_gettext
   make_glib
-  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/atk/2.18  atk-2.18.0  tar.xz  true
+  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/atk/2.29  atk-2.29.1  tar.xz  true
 }
 
 ##### PIXBUF #####
@@ -569,7 +812,7 @@ function make_gdk-pixbuf {
   # CONFIGURE PARAMETERS
   # --with-included-loaders=yes statically links the image file format handlers
   # This avoids "Cannot open pixbuf loader module file '/usr/x86_64-w64-mingw32/sys-root/mingw/lib/gdk-pixbuf-2.0/2.10.0/loaders.cache': No such file or directory"
-  build_conf_make_inst  http://ftp.gnome.org/pub/GNOME/sources/gdk-pixbuf/2.32  gdk-pixbuf-2.32.1  tar.xz  true  --with-included-loaders=yes 
+  build_conf_make_inst  http://ftp.gnome.org/pub/GNOME/sources/gdk-pixbuf/2.36  gdk-pixbuf-2.36.12  tar.xz  true  --with-included-loaders=yes
 }
 
 ##### CAIRO #####
@@ -580,7 +823,7 @@ function make_cairo {
   make_glib
   make_pixman
   make_fontconfig
-  build_conf_make_inst  http://cairographics.org/releases  cairo-1.14.2  tar.xz  true
+  build_conf_make_inst  http://cairographics.org/releases  rcairo-1.15.13  tar.xz  true
 }
 
 ##### PANGO #####
@@ -589,7 +832,7 @@ function make_pango {
   make_cairo
   make_glib
   make_fontconfig
-  build_conf_make_inst  http://ftp.gnome.org/pub/GNOME/sources/pango/1.38  pango-1.38.0  tar.xz  true
+  build_conf_make_inst  http://ftp.gnome.org/pub/GNOME/sources/pango/1.42  pango-1.42.1  tar.xz  true
 }
 
 ##### GTK2 #####
@@ -606,7 +849,7 @@ function make_gtk2 {
     make_pango
     make_gdk-pixbuf
     make_cairo
-    build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/gtk+/2.24  gtk+-2.24.28  tar.xz  patch_gtk2
+    build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/gtk+/2.24  gtk+-2.24.32  tar.xz  patch_gtk2
   fi
 }
 
@@ -619,11 +862,11 @@ function make_gtk3 {
   make_gdk-pixbuf
   make_cairo
   make_libepoxy
-  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/gtk+/3.16  gtk+-3.16.7  tar.xz  true
+  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/gtk+/3.22  gtk+-3.22.30  tar.xz  true
 
   # make all incl. tests and examples runs through fine
-  # make install fails with issue with 
-  # 
+  # make install fails with issue with
+  #
   # make[5]: Entering directory '/home/soegtrop/GTK/gtk+-3.16.7/demos/gtk-demo'
   # test -n "" || ../../gtk/gtk-update-icon-cache --ignore-theme-index --force "/usr/x86_64-w64-mingw32/sys-root/mingw/share/icons/hicolor"
   # gtk-update-icon-cache.exe: Failed to open file /usr/x86_64-w64-mingw32/sys-root/mingw/share/icons/hicolor/.icon-theme.cache : No such file or directory
@@ -639,9 +882,10 @@ function make_libxml2 {
   # Note: latest release version 2.9.2 fails during configuring lzma, so using 2.9.1
   # Note: python binding requires <sys/select.h> which doesn't exist on cygwin
   if build_prep https://git.gnome.org/browse/libxml2/snapshot  libxml2-2.9.1  tar.xz ; then
-    # ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX --disable-shared --without-python
+    # ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix="$PREFIX" --disable-shared --without-python
     # shared library required by gtksourceview
-    ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX --without-python
+    ./autogen.sh --build="$BUILD" --host="$HOST" --target="$TARGET" --prefix="$PREFIX" --without-python
+    # shellcheck disable=SC2086
     log1 make $MAKE_OPT all
     log2 make install
     log2 make clean
@@ -673,13 +917,13 @@ function make_gtk_sourceview2 {
 # Install flexdll objects
 
 function install_flexdll {
-  cp flexdll.h /usr/$TARGET_ARCH/sys-root/mingw/include
+  cp flexdll.h "/usr/$TARGET_ARCH/sys-root/mingw/include"
   if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then
-    cp flexdll*_mingw.o /usr/$TARGET_ARCH/bin
-    cp flexdll*_mingw.o $PREFIXOCAML/bin
+    cp flexdll*_mingw.o "/usr/$TARGET_ARCH/bin"
+    cp flexdll*_mingw.o "$PREFIXOCAML/bin"
   elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then
-    cp flexdll*_mingw64.o /usr/$TARGET_ARCH/bin
-    cp flexdll*_mingw64.o $PREFIXOCAML/bin
+    cp flexdll*_mingw64.o "/usr/$TARGET_ARCH/bin"
+    cp flexdll*_mingw64.o "$PREFIXOCAML/bin"
   else
     echo "Unknown target architecture"
     return 1
@@ -689,16 +933,16 @@ function install_flexdll {
 # Install flexlink
 
 function install_flexlink {
-  cp flexlink.exe /usr/$TARGET_ARCH/bin
-    
-  cp flexlink.exe $PREFIXOCAML/bin
+  cp flexlink.exe "/usr/$TARGET_ARCH/bin"
+
+  cp flexlink.exe "$PREFIXOCAML/bin"
 }
 
 # Get binary flexdll flexlink for building OCaml
 # An alternative is to first build an OCaml without shared library support and build flexlink with it
 
 function get_flex_dll_link_bin {
-  if build_prep http://alain.frisch.fr/flexdll flexdll-bin-0.34 zip 1 ; then
+  if build_prep https://github.com/alainfrisch/flexdll/releases/download/0.37/ flexdll-bin-0.37 zip 1 ; then
     install_flexdll
     install_flexlink
     build_post
@@ -708,10 +952,12 @@ function get_flex_dll_link_bin {
 # Build flexdll and flexlink from sources after building OCaml
 
 function make_flex_dll_link {
-  if build_prep http://alain.frisch.fr/flexdll flexdll-0.34 tar.gz ; then
+  if build_prep https://github.com/alainfrisch/flexdll/releases/download/0.37/ flexdll-bin-0.37 zip ; then
     if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then
+      # shellcheck disable=SC2086
       log1 make $MAKE_OPT build_mingw flexlink.exe
     elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then
+      # shellcheck disable=SC2086
       log1 make $MAKE_OPT build_mingw64 flexlink.exe
     else
       echo "Unknown target architecture"
@@ -731,15 +977,15 @@ function make_flex_dll_link {
 # For this purpose hard links are better.
 
 function make_ln {
-  if [ ! -f flagfiles/myln.finished ] ; then
-    touch flagfiles/myln.started
+  if [ ! -f $FLAGFILES/myln.finished ] ; then
+    touch $FLAGFILES/myln.started
     mkdir -p myln
-    cd myln
+    ( cd myln
     cp $PATCHES/ln.c .
-    $TARGET_ARCH-gcc -DUNICODE -D_UNICODE -DIGNORE_SYMBOLIC -mconsole -o ln.exe ln.c 
-    install -D ln.exe $PREFIXCOQ/bin/ln.exe
-    cd ..
-    touch flagfiles/myln.finished
+    "$TARGET_ARCH-gcc" -DUNICODE -D_UNICODE -DIGNORE_SYMBOLIC -mconsole -o ln.exe ln.c
+    install -D ln.exe "$PREFIXCOQ/bin/ln.exe"
+    )
+    touch $FLAGFILES/myln.finished
   fi
 }
 
@@ -747,11 +993,10 @@ function make_ln {
 
 function make_ocaml {
   get_flex_dll_link_bin
-  if build_prep http://caml.inria.fr/pub/distrib/ocaml-4.02 ocaml-4.02.3 tar.gz 1 ; then
-  # if build_prep http://caml.inria.fr/pub/distrib/ocaml-4.01 ocaml-4.01.0 tar.gz 1 ; then
-    # See README.win32
-    cp config/m-nt.h config/m.h
-    cp config/s-nt.h config/s.h
+  if build_prep https://github.com/ocaml/ocaml/archive 4.07.0 tar.gz 1 ocaml-4.07.0 ; then
+    # See README.win32.adoc
+    cp config/m-nt.h byterun/caml/m.h
+    cp config/s-nt.h byterun/caml/s.h
     if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then
         cp config/Makefile.mingw config/Makefile
     elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then
@@ -762,15 +1007,16 @@ function make_ocaml {
     fi
 
     # Prefix is fixed in make file - replace it with the real one
+    # 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
     sed -i "s|^LIBDIR=.*|LIBDIR=$PREFIXOCAML/libocaml|" config/Makefile
-    
+
     # Note: ocaml doesn't support -j 8, so don't pass MAKE_OPT
     # I verified that 4.02.3 still doesn't support parallel build
     log2 make world -f Makefile.nt
@@ -779,18 +1025,18 @@ function make_ocaml {
     log2 make opt.opt -f Makefile.nt
     log2 make install -f Makefile.nt
     # TODO log2 make clean -f Makefile.nt Temporarily disabled for ocamlbuild development
-    
+
     # Move license files and other into into special folder
     if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
-      mkdir -p $PREFIXOCAML/license_readme/ocaml
+      mkdir -p "$PREFIXOCAML/license_readme/ocaml"
       # 4.01 installs these files, 4.02 doesn't. So delete them and copy them from the sources.
-      rm -f *.txt
-      cp LICENSE      $PREFIXOCAML/license_readme/ocaml/License.txt
-      cp INSTALL      $PREFIXOCAML/license_readme/ocaml/Install.txt
-      cp README       $PREFIXOCAML/license_readme/ocaml/ReadMe.txt
-      cp README.win32 $PREFIXOCAML/license_readme/ocaml/ReadMeWin32.txt
-      cp VERSION      $PREFIXOCAML/license_readme/ocaml/Version.txt
-      cp Changes      $PREFIXOCAML/license_readme/ocaml/Changes.txt
+      rm -f ./*.txt
+      cp LICENSE      "$PREFIXOCAML/license_readme/ocaml/License.txt"
+      cp INSTALL.adoc "$PREFIXOCAML/license_readme/ocaml/Install.txt"
+      cp README.adoc  "$PREFIXOCAML/license_readme/ocaml/ReadMe.txt"
+      cp README.win32.adoc "$PREFIXOCAML/license_readme/ocaml/ReadMeWin32.txt"
+      cp VERSION      "$PREFIXOCAML/license_readme/ocaml/Version.txt"
+      cp Changes      "$PREFIXOCAML/license_readme/ocaml/Changes.txt"
     fi
 
     build_post
@@ -798,17 +1044,63 @@ function make_ocaml {
   make_flex_dll_link
 }
 
+##### OCAML EXTRA TOOLS #####
+
+function make_ocaml_tools {
+  make_findlib
+  make_camlp5
+}
+
+##### OCAML EXTRA LIBRARIES #####
+
+function make_ocaml_libs {
+  make_num
+  make_findlib
+  make_lablgtk
+  # make_stdint
+}
+
+##### Ocaml num library #####
+function make_num {
+  make_ocaml
+  # We need this commit due to windows fixed, IMHO this is better than patching v1.1.
+  if build_prep https://github.com/ocaml/num/archive 7dd5e935aaa2b902585b3b2d0e55ad9b2442fff0 zip 1 num-1.1-7d; then
+    log2 make all
+    # log2 make test
+    log2 make install
+    log2 make clean
+    build_post
+  fi
+}
+
+##### OCAMLBUILD #####
+
+function make_ocamlbuild {
+  make_ocaml
+  if build_prep https://github.com/ocaml/ocamlbuild/archive 0.12.0 tar.gz 1 ocamlbuild-0.12.0; then
+    log2 make configure OCAML_NATIVE=true OCAMLBUILD_PREFIX=$PREFIXOCAML OCAMLBUILD_BINDIR=$PREFIXOCAML/bin OCAMLBUILD_LIBDIR=$PREFIXOCAML/lib
+    log1 make
+    log2 make install
+    build_post
+  fi
+}
+
 ##### FINDLIB Ocaml library manager #####
 
 function make_findlib {
   make_ocaml
-  if build_prep http://download.camlcity.org/download findlib-1.5.6 tar.gz 1 ; then
-    ./configure -bindir $PREFIXOCAML\\bin -sitelib $PREFIXOCAML\\libocaml\\site-lib -config $PREFIXOCAML\\etc\\findlib.conf
+  make_ocamlbuild
+  if build_prep https://opam.ocaml.org/1.2.2/archives ocamlfind.1.8.0+opam tar.gz 1 ; then
+    logn configure ./configure -bindir "$PREFIXOCAML\\bin" -sitelib "$PREFIXOCAML\\libocaml\\site-lib" -config "$PREFIXOCAML\\etc\\findlib.conf"
     # Note: findlib doesn't support -j 8, so don't pass MAKE_OPT
     log2 make all
     log2 make opt
     log2 make install
     log2 make clean
+    # Add Coq install library path to ocamlfind config file
+    # $(ocamlfind printconf conf | tr -d '\r') is the name of the config file
+    # printf "%q" "$PREFIXCOQ/lib" | sed -e 's/\\/\\\\/g' is the coq lib path double escaped for sed
+    sed -i -e 's|path="\(.*\)"|path="\1;'$(printf "%q" "$PREFIXCOQ/lib" | sed -e 's/\\/\\\\/g')'"|' $(ocamlfind printconf conf | tr -d '\r')
     build_post
   fi
 }
@@ -818,15 +1110,11 @@ function make_findlib {
 function make_menhir {
   make_ocaml
   make_findlib
-  # if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20151112 tar.gz 1 ; then
-  # For Ocaml 4.02
-  # if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20151012 tar.gz 1 ; then
-  # For Ocaml 4.01
-  if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20140422 tar.gz 1 ; then
+  make_ocamlbuild
+  if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20180530 tar.gz 1 ; then
     # Note: menhir doesn't support -j 8, so don't pass MAKE_OPT
-    log2 make all PREFIX=$PREFIXOCAML
-    log2 make install PREFIX=$PREFIXOCAML
-    mv $PREFIXOCAML/bin/menhir $PREFIXOCAML/bin/menhir.exe
+    log2 make all PREFIX="$PREFIXOCAML"
+    log2 make install PREFIX="$PREFIXOCAML"
     build_post
   fi
 }
@@ -839,7 +1127,7 @@ function make_camlp4 {
   if ! command camlp4 ; then
     make_ocaml
     make_findlib
-    if build_prep https://github.com/ocaml/camlp4/archive 4.02+6 tar.gz 1 camlp4-4.02+6 ; then
+    if build_prep https://github.com/ocaml/camlp4/archive 4.06+2 tar.gz 1 camlp4-4.06+2 ; then
       # See https://github.com/ocaml/camlp4/issues/41#issuecomment-112018910
       logn configure ./configure
       # Note: camlp4 doesn't support -j 8, so don't pass MAKE_OPT
@@ -856,14 +1144,20 @@ function make_camlp4 {
 function make_camlp5 {
   make_ocaml
   make_findlib
-  if build_prep http://camlp5.gforge.inria.fr/distrib/src camlp5-6.14 tgz 1 ; then
-    logn configure ./configure 
+
+  if build_prep https://github.com/camlp5/camlp5/archive rel706 tar.gz 1 camlp5-rel706; then
+    logn configure ./configure
     # Somehow my virus scanner has the boot.new/SAVED directory locked after the move for a second => repeat until success
     sed -i 's/mv boot.new boot/until mv boot.new boot; do sleep 1; done/' Makefile
+    # shellcheck disable=SC2086
     log1 make world.opt $MAKE_OPT
     log2 make install
     # For some reason gramlib.a is not copied, but it is required by Coq
-    cp lib/gramlib.a $PREFIXOCAML/libocaml/camlp5/
+    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
@@ -878,19 +1172,36 @@ function make_camlp5 {
 function make_lablgtk {
   make_ocaml
   make_findlib
-  make_camlp4
-  if build_prep https://forge.ocamlcore.org/frs/download.php/1479 lablgtk-2.18.3 tar.gz 1 ; then
+  # make_camlp4 # required by lablgtk-2.18.3 and lablgtk-2.18.5
+  make_gtk2
+  make_gtk_sourceview2
+  if build_prep https://forge.ocamlcore.org/frs/download.php/1726 lablgtk-2.18.6 tar.gz 1 ; then
     # configure should be fixed to search for $TARGET_ARCH-pkg-config.exe
-    cp /bin/$TARGET_ARCH-pkg-config.exe  bin_special/pkg-config.exe
-    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIXOCAML
-    
+    cp "/bin/$TARGET_ARCH-pkg-config.exe"  bin_special/pkg-config.exe
+    logn configure ./configure --build="$BUILD" --host="$HOST" --target="$TARGET" --prefix="$PREFIXOCAML"
+
     # lablgtk shows occasional errors with -j, so don't pass $MAKE_OPT
-    
-    # See https://sympa.inria.fr/sympa/arc/caml-list/2015-10/msg00204.html for the make || true + strip
-    logn make-world-pre make world || true
-    $TARGET_ARCH-strip.exe --strip-unneeded src/dlllablgtk2.dll
-    
+
+    # lablgtk binary needs to be stripped - otherwise flexdll goes wild
+    # Fix version 1: explicit strip after failed build - this randomly fails in CI
+    # See https://sympa.inria.fr/sympa/arc/caml-list/2015-10/msg00204.html
+    # logn make-world-pre make world || true
+    # $TARGET_ARCH-strip.exe --strip-unneeded src/dlllablgtk2.dll
+
+    # Fix version 2: Strip by passing linker argument rather than explicit call to strip
+    # See https://github.com/alainfrisch/flexdll/issues/6
+    # Argument to ocamlmklib: -ldopt "-link -Wl,-s"
+    # -ldopt is the okamlmklib linker prefix option
+    # -link is the flexlink linker prefix option
+    # -Wl, is the gcc (linker driver) linker prefix option
+    # -s is the gnu linker option for stripping symbols
+    # These changes are included in dev/build/windows/patches_coq/lablgtk-2.18.3.patch
+
     log2 make world
+
+    # lablgtk does not escape FINDLIBDIR path, which can contain backslashes
+    sed -i "s|^FINDLIBDIR=.*|FINDLIBDIR=$PREFIXOCAML/libocaml/site-lib|" config.make
+
     log2 make install
     log2 make clean
     build_post
@@ -920,7 +1231,7 @@ function make_stdint {
 
 function copy_coq_dll {
   if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
-    cp /usr/${ARCH}-w64-mingw32/sys-root/mingw/bin/$1 $PREFIXCOQ/bin/$1
+    cp "/usr/${ARCH}-w64-mingw32/sys-root/mingw/bin/$1" "$PREFIXCOQ/bin/$1"
   fi
 }
 
@@ -936,7 +1247,7 @@ function copy_coq_dlls {
   # Do this recursively until there are no further missing DLLs (File close + reopen)
   # For running this quickly, just do "cd coq-<ver> ; call copy_coq_dlls ; cd .." at the end of this script.
   # Do the same for coqc and ocamlc (usually doesn't result in additional files)
-  
+
   copy_coq_dll LIBATK-1.0-0.DLL
   copy_coq_dll LIBCAIRO-2.DLL
   copy_coq_dll LIBEXPAT-1.DLL
@@ -954,15 +1265,15 @@ function copy_coq_dlls {
   copy_coq_dll LIBPANGO-1.0-0.DLL
   copy_coq_dll LIBPANGOCAIRO-1.0-0.DLL
   copy_coq_dll LIBPANGOWIN32-1.0-0.DLL
+  copy_coq_dll libpcre-1.dll
   copy_coq_dll LIBPIXMAN-1-0.DLL
   copy_coq_dll LIBPNG16-16.DLL
   copy_coq_dll LIBXML2-2.DLL
   copy_coq_dll ZLIB1.DLL
 
-  # Depends on if GTK is built from sources  
+  # Depends on if GTK is built from sources
   if [ "$GTK_FROM_SOURCES" == "Y" ]; then
     copy_coq_dll libiconv-2.dll
-    copy_coq_dll libpcre-1.dll
   else
     copy_coq_dll ICONV.DLL
     copy_coq_dll LIBBZ2-1.DLL
@@ -978,21 +1289,21 @@ function copy_coq_dlls {
     i686)   copy_coq_dll LIBGCC_S_SJLJ-1.DLL ;;
     *)      false ;;
   esac
-  
+
   # Win pthread version change
   copy_coq_dll LIBWINPTHREAD-1.DLL
 }
 
 function copy_coq_objects {
   # copy objects only from folders which exist in the target lib directory
-  find . -type d | while read FOLDER ; do
-    if [ -e $PREFIXCOQ/lib/$FOLDER ] ; then
-      install_glob $FOLDER/'*.cmxa' $PREFIXCOQ/lib/$FOLDER 
-      install_glob $FOLDER/'*.cmi'  $PREFIXCOQ/lib/$FOLDER 
-      install_glob $FOLDER/'*.cma'  $PREFIXCOQ/lib/$FOLDER 
-      install_glob $FOLDER/'*.cmo'  $PREFIXCOQ/lib/$FOLDER 
-      install_glob $FOLDER/'*.a'    $PREFIXCOQ/lib/$FOLDER 
-      install_glob $FOLDER/'*.o'    $PREFIXCOQ/lib/$FOLDER 
+  find . -type d | while read -r FOLDER ; do
+    if [ -e "$PREFIXCOQ/lib/coq/$FOLDER" ] ; then
+      install_glob "$FOLDER" '*.cmxa' "$PREFIXCOQ/lib/coq/$FOLDER"
+      install_glob "$FOLDER" '*.cmi'  "$PREFIXCOQ/lib/coq/$FOLDER"
+      install_glob "$FOLDER" '*.cma'  "$PREFIXCOQ/lib/coq/$FOLDER"
+      install_glob "$FOLDER" '*.cmo'  "$PREFIXCOQ/lib/coq/$FOLDER"
+      install_glob "$FOLDER" '*.a'    "$PREFIXCOQ/lib/coq/$FOLDER"
+      install_glob "$FOLDER" '*.o'    "$PREFIXCOQ/lib/coq/$FOLDER"
     fi
   done
 }
@@ -1000,23 +1311,28 @@ function copy_coq_objects {
 # Copy required GTK config and suport files
 
 function copq_coq_gtk {
-  echo 'gtk-theme-name = "MS-Windows"'     >  $PREFIX/etc/gtk-2.0/gtkrc
-  echo 'gtk-fallback-icon-theme = "Tango"' >> $PREFIX/etc/gtk-2.0/gtkrc
+  echo 'gtk-theme-name = "MS-Windows"'     >  "$PREFIX/etc/gtk-2.0/gtkrc"
+  echo 'gtk-fallback-icon-theme = "Tango"' >> "$PREFIX/etc/gtk-2.0/gtkrc"
 
   if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
-    install_glob $PREFIX/etc/gtk-2.0/'*'                            $PREFIXCOQ/gtk-2.0
-    install_glob $PREFIX/share/gtksourceview-2.0/language-specs/'*' $PREFIXCOQ/share/gtksourceview-2.0/language-specs
-    install_glob $PREFIX/share/gtksourceview-2.0/styles/'*'         $PREFIXCOQ/share/gtksourceview-2.0/styles
-    install_rec  $PREFIX/share/themes/ '*'                          $PREFIXCOQ/share/themes
-    
+    install_glob "$PREFIX/etc/gtk-2.0" '*'                            "$PREFIXCOQ/gtk-2.0"
+    install_glob "$PREFIX/share/gtksourceview-2.0/language-specs" '*' "$PREFIXCOQ/share/gtksourceview-2.0/language-specs"
+    install_glob "$PREFIX/share/gtksourceview-2.0/styles" '*'         "$PREFIXCOQ/share/gtksourceview-2.0/styles"
+    install_rec  "$PREFIX/share/themes" '*'                           "$PREFIXCOQ/share/themes"
+
     # This below item look like a bug in make install
+    if [ -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
+    mkdir -p "$PREFIXCOQ/ide"
+    mv "$COQSHARE"*.png  "$PREFIXCOQ/ide"
+    rmdir "$PREFIXCOQ/share/coq" || true
   fi
 }
 
@@ -1024,16 +1340,16 @@ function copq_coq_gtk {
 
 function copy_coq_license {
   if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
-    install -D doc/LICENSE                    $PREFIXCOQ/license_readme/coq/LicenseDoc.txt
-    install -D LICENSE                        $PREFIXCOQ/license_readme/coq/License.txt
-    install -D plugins/micromega/LICENSE.sos  $PREFIXCOQ/license_readme/coq/LicenseMicromega.txt
-    install -D README                         $PREFIXCOQ/license_readme/coq/ReadMe.txt || true
-    install -D README.md                      $PREFIXCOQ/license_readme/coq/ReadMe.md || true
-    install -D README.doc                     $PREFIXCOQ/license_readme/coq/ReadMeDoc.txt
-    install -D CHANGES                        $PREFIXCOQ/license_readme/coq/Changes.txt
-    install -D INSTALL                        $PREFIXCOQ/license_readme/coq/Install.txt
-    install -D INSTALL.doc                    $PREFIXCOQ/license_readme/coq/InstallDoc.txt
-    install -D INSTALL.ide                    $PREFIXCOQ/license_readme/coq/InstallIde.txt
+    install -D doc/LICENSE                    "$PREFIXCOQ/license_readme/coq/LicenseDoc.txt"
+    install -D LICENSE                        "$PREFIXCOQ/license_readme/coq/License.txt"
+    install -D plugins/micromega/LICENSE.sos  "$PREFIXCOQ/license_readme/coq/LicenseMicromega.txt"
+    install -D README                         "$PREFIXCOQ/license_readme/coq/ReadMe.txt" || true
+    install -D README.md                      "$PREFIXCOQ/license_readme/coq/ReadMe.md" || true
+    install -D README.win                     "$PREFIXCOQ/license_readme/coq/ReadMeWindows.txt" || true
+    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 doc/README.md                  "$PREFIXCOQ/license_readme/coq/ReadMeDoc.md" || true
   fi
 }
 
@@ -1041,54 +1357,82 @@ function copy_coq_license {
 
 function make_coq {
   make_ocaml
-  make_lablgtk
+  make_num
+  make_findlib
   make_camlp5
-  if 
+  make_lablgtk
+  if
     case $COQ_VERSION in
-      git-*) build_prep https://github.com/coq/coq/archive ${COQ_VERSION##git-} zip 1 coq-${COQ_VERSION} ;;
-      *)     build_prep https://coq.inria.fr/distrib/V$COQ_VERSION/files coq-$COQ_VERSION tar.gz ;;
+      # e.g. git-v8.6 => download from https://github.com/coq/coq/archive/v8.6.zip
+      # e.g. git-trunk => download from https://github.com/coq/coq/archive/trunk.zip
+      git-*)
+        COQ_BUILD_PATH=/build/coq-${COQ_VERSION}
+        build_prep https://github.com/coq/coq/archive "${COQ_VERSION##git-}" zip 1 "coq-${COQ_VERSION}"
+        ;;
+
+      # e.g. /cygdrive/d/coqgit
+      /*)
+        # Todo: --exclude-vcs-ignores doesn't work because tools/coqdoc/coqdoc.sty is excluded => fix .gitignore
+        # But this is not a big deal, only 2 files are removed with --exclude-vcs-ignores from a fresch clone
+        COQ_BUILD_PATH=/build/coq-local
+        tar -zcf $TARBALLS/coq-local.tar.gz --exclude-vcs -C "${COQ_VERSION%/*}" "${COQ_VERSION##*/}"
+        build_prep NEVER-DOWNLOADED coq-local tar.gz
+        ;;
+
+      # e.g. 8.6 => https://coq.inria.fr/distrib/8.6/files/coq-8.6.tar.gz
+      *)
+        COQ_BUILD_PATH=/build/coq-$COQ_VERSION
+        build_prep "https://coq.inria.fr/distrib/V$COQ_VERSION/files" "coq-$COQ_VERSION" tar.gz
+        ;;
     esac
   then
     if [ "$INSTALLMODE" == "relocatable" ]; then
       # HACK: for relocatable builds, first configure with ./, then build but before install reconfigure with the real target path
-      logn configure ./configure -debug -with-doc no -prefix ./ -libdir ./lib -mandir ./man
+      logn configure ./configure -with-doc no -prefix ./ -libdir ./lib/coq -mandir ./man
     elif [ "$INSTALLMODE" == "absolute" ]; then
-      logn configure ./configure -debug -with-doc no -prefix $PREFIXCOQ -libdir $PREFIXCOQ/lib -mandir $PREFIXCOQ/man
+      logn configure ./configure -with-doc no -prefix "$PREFIXCOQ" -libdir "$PREFIXCOQ/lib/coq" -mandir "$PREFIXCOQ/man"
     else
-      logn configure ./configure -debug -with-doc no -prefix $PREFIXCOQ
+      logn configure ./configure -with-doc no -prefix "$PREFIXCOQ"
     fi
 
     # The windows resource compiler binary name is hard coded
-    sed -i "s/i686-w64-mingw32-windres/$TARGET_ARCH-windres/" Makefile.build 
+    sed -i "s/i686-w64-mingw32-windres/$TARGET_ARCH-windres/" Makefile.build
     sed -i "s/i686-w64-mingw32-windres/$TARGET_ARCH-windres/" Makefile.ide || true
 
     # 8.4x doesn't support parallel make
     if [[ $COQ_VERSION == 8.4* ]] ; then
       log1 make
     else
+      # shellcheck disable=SC2086
       log1 make $MAKE_OPT
     fi
-    
+
     if [ "$INSTALLMODE" == "relocatable" ]; then
-      ./configure -debug -with-doc no -prefix $PREFIXCOQ -libdir $PREFIXCOQ/lib -mandir $PREFIXCOQ/man
+      logn reconfigure ./configure -with-doc no -prefix "$PREFIXCOQ" -libdir "$PREFIXCOQ/lib/coq" -mandir "$PREFIXCOQ/man"
     fi
 
     log2 make install
     log1 copy_coq_dlls
     if [ "$INSTALLOCAML" == "Y" ]; then
-      log1 copy_coq_objects
+      copy_coq_objects
     fi
-    
-    copq_coq_gtk
-    copy_coq_license
 
-    # make clean seems to br broken for 8.5pl2
+    log1 copq_coq_gtk
+    log1 copy_coq_license
+
+    # make clean seems to be broken for 8.5pl2
     # 1.) find | xargs fails on cygwin, can be fixed by sed -i 's|\| xargs rm -f|-exec rm -fv \{\} \+|' Makefile
     # 2.) clean of test suites fails with "cannot run complexity tests (no bogomips found)"
     # make clean
-    
+
+    # Copy these files somewhere the plugin builds can find them
+    logn copy-basic-overlays cp dev/ci/ci-basic-overlay.sh /build/
+    logn copy-user-overlays cp -r dev/ci/user-overlays /build/
+
     build_post
   fi
+
+  load_overlay_data
 }
 
 ##### GNU Make for MinGW #####
@@ -1097,11 +1441,11 @@ 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
-    cp GccRel/gnumake.exe $PREFIXCOQ/bin/make.exe
+    cp GccRel/gnumake.exe "$PREFIXCOQ/bin/make.exe"
     build_post
   fi
 }
@@ -1110,7 +1454,8 @@ function make_mingw_make {
 
 function make_binutils {
   if build_prep http://ftp.gnu.org/gnu/binutils binutils-2.27 tar.gz ; then
-    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIXCOQ --program-prefix=$TARGET-
+    logn configure ./configure --build="$BUILD" --host="$HOST" --target="$TARGET" --prefix="$PREFIXCOQ" --program-prefix="$TARGET-"
+    # shellcheck disable=SC2086
     log1 make $MAKE_OPT
     log2 make install
     # log2 make clean
@@ -1133,15 +1478,16 @@ function make_gcc {
     # For whatever reason gcc needs this (although it never puts anything into it)
     # Error: "The directory that should contain system headers does not exist:"
     # mkdir -p /mingw/include    without --with-sysroot
-    mkdir -p $PREFIXCOQ/mingw/include
+    mkdir -p "$PREFIXCOQ/mingw/include"
 
     # See https://gcc.gnu.org/install/configure.html
-    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET \
-        --prefix=$PREFIXCOQ --program-prefix=$TARGET- --disable-win32-registry --with-sysroot=$PREFIXCOQ \
+    logn configure ./configure --build="$BUILD" --host="$HOST" --target="$TARGET" \
+        --prefix="$PREFIXCOQ" --program-prefix="$TARGET-" --disable-win32-registry --with-sysroot="$PREFIXCOQ" \
         --enable-languages=c --disable-nls \
         --disable-libsanitizer --disable-libssp --disable-libquadmath --disable-libgomp --disable-libvtv --disable-lto
         # --disable-decimal-float seems to be required
-        # --with-sysroot=$PREFIX  results in configure error that this is not an absolute path
+        # --with-sysroot="$PREFIX"  results in configure error that this is not an absolute path
+    # shellcheck disable=SC2086
     log1 make $MAKE_OPT
     log2 make install
     # log2 make clean
@@ -1152,8 +1498,8 @@ function make_gcc {
 ##### Get sources for Cygwin MinGW packages #####
 
 function get_cygwin_mingw_sources {
-  if [ ! -f flagfiles/cygwin_mingw_sources.finished ] ; then
-    touch flagfiles/cygwin_mingw_sources.started
+  if [ ! -f $FLAGFILES/cygwin_mingw_sources.finished ] ; then
+    touch $FLAGFILES/cygwin_mingw_sources.started
 
     # Find all installed files with mingw in the name and download the corresponding source code file from cygwin
     # Steps:
@@ -1169,28 +1515,29 @@ function get_cygwin_mingw_sources {
     # Take the 2nd field of the last line          => ${SOURCE} = x86_64/release/mingw64-x86_64-gcc/mingw64-x86_64-gcc-5.4.0-2-src.tar.xz
     # Remove that path part                        => ${SOURCEFILE} = mingw64-x86_64-gcc-5.4.0-2-src.tar.xz
 
-    grep "mingw" /etc/setup/installed.db | sed 's/\.tar\.bz2 [0-1]$//' | sed 's/ /\//'  | while read ARCHIVE ; do
+    grep "mingw" /etc/setup/installed.db | sed 's/\.tar\.bz2 [0-1]$//' | sed 's/ /\//'  | while read -r ARCHIVE ; do
       local ARCHIVEESC=${ARCHIVE//+/\\+}
-      local SOURCE=`egrep -A 1 "install: ($CYGWINARCH|noarch)/release/[-+_/a-z0-9]*$ARCHIVEESC" $TARBALLS/setup.ini | tail -1 | cut -d " " -f 2`
+      local SOURCE
+      SOURCE=$(grep -E -A 1 "install: ($CYGWINARCH|noarch)/release/[-+_/a-z0-9]*$ARCHIVEESC" $TARBALLS/setup.ini | tail -1 | cut -d " " -f 2)
       local SOURCEFILE=${SOURCE##*/}
 
       # Get the source file (either from the source cache or online)
-      if [ ! -f $TARBALLS/$SOURCEFILE ] ; then
-        if [ -f $SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE ] ; then
-          cp $SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE $TARBALLS
+      if [ ! -f "$TARBALLS/$SOURCEFILE" ] ; then
+        if [ -f "$SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE" ] ; then
+          cp "$SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE" $TARBALLS
         else
-          wget "$CYGWIN_REPOSITORY/$SOURCE"
-          mv $SOURCEFILE $TARBALLS
+          wget --progress=dot:giga "$CYGWIN_REPOSITORY/$SOURCE"
+          mv "$SOURCEFILE" "$TARBALLS"
           # Save the source archive in the source cache
-          if [ -d $SOURCE_LOCAL_CACHE_CFMT ] ; then
-            cp $TARBALLS/$SOURCEFILE $SOURCE_LOCAL_CACHE_CFMT
+          if [ -d "$SOURCE_LOCAL_CACHE_CFMT" ] ; then
+            cp "$TARBALLS/$SOURCEFILE" "$SOURCE_LOCAL_CACHE_CFMT"
           fi
         fi
       fi
 
     done
 
-    touch flagfiles/cygwin_mingw_sources.finished
+    touch $FLAGFILES/cygwin_mingw_sources.finished
   fi
 }
 
@@ -1198,64 +1545,355 @@ function get_cygwin_mingw_sources {
 
 function make_coq_installer {
   make_coq
-  make_mingw_make
   get_cygwin_mingw_sources
 
   # Prepare the file lists for the installer. We created to file list dumps of the target folder during the build:
   # ocaml: ocaml + menhir + camlp5 + findlib
-  # ocal_coq: as above + coq
-  
+  # ocaml_coq: as above + coq
+  # ocaml_coq_addons: as above + lib/user-contrib/*
+
   # Create coq file list as ocaml_coq / ocaml
   diff_files coq ocaml_coq ocaml
-  
+
   # Filter out object files
-  filter_files coq_objects coq '\.(cmxa|cmi|cma|cmo|a|o)$' 
-  
+  filter_files coq_objects coq '\.(cmxa|cmi|cma|cmo|a|o)$'
+
   # Filter out plugin object files
-  filter_files coq_objects_plugins coq_objects '/lib/plugins/.*\.(cmxa|cmi|cma|cmo|a|o)$'
-  
+  filter_files coq_objects_plugins coq_objects '/lib/coq/plugins/.*\.(cmxa|cmi|cma|cmo|a|o)$'
+
   # Coq objects objects required for plugin development = coq objects except those for pre installed plugins
   diff_files coq_plugindev coq_objects coq_objects_plugins
-  
+
+  # Addons (TODO: including objects that could go to the plugindev thing, but
+  # then one would have to make that package depend on this one, so not
+  # implemented yet)
+  diff_files coq_addons ocaml_coq_addons ocaml_coq
+
   # Coq files, except objects needed only for plugin development
   diff_files coq_base coq coq_plugindev
-  
+
   # Convert section files to NSIS format
   files_to_nsis coq_base
+  files_to_nsis coq_addons
   files_to_nsis coq_plugindev
   files_to_nsis ocaml
-  
+
   # Get and extract NSIS Binaries
   if build_prep http://downloads.sourceforge.net/project/nsis/NSIS%202/2.51 nsis-2.51 zip ; then
-    NSIS=`pwd`/makensis.exe
+    NSIS=$(pwd)/makensis.exe
     chmod u+x "$NSIS"
     # Change to Coq folder
-    cd ../coq-${COQ_VERSION}
+    cd "$COQ_BUILD_PATH"
     # Copy patched nsi file
     cp ../patches/coq_new.nsi dev/nsis
     cp ../patches/StrRep.nsh dev/nsis
     cp ../patches/ReplaceInFile.nsh dev/nsis
-    VERSION=`grep ^VERSION= config/Makefile | cut -d = -f 2`
+    VERSION=$(grep '^VERSION=' config/Makefile | cut -d = -f 2 | tr -d '\r')
     cd dev/nsis
-    logn nsis-installer "$NSIS" -DVERSION=$VERSION -DARCH=$ARCH -DCOQ_SRC_PATH=$PREFIXCOQ -DCOQ_ICON=..\\..\\ide\\coq.ico coq_new.nsi
-    
+    logn nsis-installer "$NSIS" -DVERSION="$VERSION" -DARCH="$ARCH" -DCOQ_SRC_PATH="$PREFIXCOQ" -DCOQ_ICON=..\\..\\ide\\coq.ico -DCOQ_ADDONS="$COQ_ADDONS" coq_new.nsi
+
     build_post
   fi
 }
 
+###################### ADDON COQ LIBRARIES / PLUGINS / TOOLS #####################
+
+# The bignums library
+# Provides BigN, BigZ, BigQ that used to be part of Coq standard library
+
+function make_addon_bignums {
+  installer_addon_dependency bignums
+  if build_prep_overlay bignums; then
+    installer_addon_section bignums "Bignums" "Coq library for fast arbitrary size numbers" ""
+    # To make command lines shorter :-(
+    echo 'COQ_SRC_SUBDIRS:=$(filter-out plugins/%,$(COQ_SRC_SUBDIRS)) plugins/syntax' >> Makefile.coq.local
+    log1 make all
+    log2 make install
+    build_post
+  fi
+}
+
+# Equations plugin
+# A function definition plugin
+
+function make_addon_equations {
+  installer_addon_dependency equations
+  if build_prep_overlay Equations; then
+    installer_addon_section equations "Equations" "Coq plugin for defining functions by equations" ""
+    # Note: PATH is autmatically saved/restored by build_prep / build_post
+    PATH=$COQBIN:$PATH
+    logn coq_makefile ${COQBIN}coq_makefile -f _CoqProject -o Makefile
+    log1 make
+    log2 make install
+    build_post
+  fi
+}
+
+# mathcomp - ssreflect and mathematical components library
+
+function make_addon_mathcomp {
+  installer_addon_dependency mathcomp
+  if build_prep_overlay mathcomp; then
+    installer_addon_section mathcomp "Math-Components" "Coq library with mathematical components" ""
+    cd mathcomp
+    log1 make $MAKE_OPT
+    log2 make install
+    build_post
+  fi
+}
+
+# ssreflect part of mathcomp
+
+function make_addon_ssreflect {
+  # if mathcomp addon is requested, build this instead
+  if [[ "$COQ_ADDONS" == *mathcomp* ]]; then
+    make_addon_mathcomp
+  else
+    # Note: since either mathcomp or ssreflect is defined, it is fine to name both mathcomp
+    installer_addon_dependency ssreflect
+    if build_prep_overlay mathcomp; then
+      installer_addon_section ssreflect "SSReflect" "Coq support library for small scale reflection plugin" ""
+      cd mathcomp
+      logn make-makefile  make Makefile.coq
+      logn make-ssreflect make $MAKE_OPT -f Makefile.coq ssreflect/all_ssreflect.vo
+      logn make-install   make -f Makefile.coq install
+      build_post
+    fi
+  fi
+}
+
+# Ltac-2 plugin
+# A new (experimental) tactic language
+
+function make_addon_ltac2 {
+  installer_addon_dependency ltac2
+  if build_prep_overlay ltac2; then
+    installer_addon_section ltac2 "Ltac-2" "Coq plugin with the Ltac-2 enhanced tactics language" ""
+    log1 make all
+    log2 make install
+    build_post
+  fi
+}
+
+# UniCoq plugin
+# An alternative unification algorithm
+function make_addon_unicoq {
+  installer_addon_dependency unicoq
+  if build_prep_overlay unicoq; then
+    log1 coq_makefile -f Make -o Makefile
+    log1 make
+    log2 make install
+    build_post
+  fi
+}
+
+# Mtac2 plugin
+# An alternative typed tactic language
+function make_addon_mtac2 {
+  installer_addon_dependency_beg mtac2
+  make_addon_unicoq
+  installer_addon_dependency_end
+  if build_prep_overlay mtac2; then
+    log1 coq_makefile -f _CoqProject -o Makefile
+    log1 make
+    log2 make install
+    build_post
+  fi
+}
+
+# Menhir parser generator
+
+function make_addon_menhir {
+  make_menhir
+  # If COQ and OCaml are installed to the same folder, there is nothing to do
+  installer_addon_dependency menhir
+  if [ "$PREFIXOCAML" != "$PREFIXCOQ" ] ; then
+    # Just install menhir files required for COQ to COQ target folder
+    if [ ! -f "$FLAGFILES/menhir-addon.finished" ] ; then
+      installer_addon_section menhir "Menhir" "Menhir parser generator windows executable and libraries" ""
+      LOGTARGET=menhir-addon
+      touch "$FLAGFILES/menhir-addon.started"
+      # Menhir executable
+      install_glob "$PREFIXOCAML/bin" 'menhir.exe' "$PREFIXCOQ/bin/"
+      # Menhir Standard library
+      install_glob "$PREFIXOCAML/share/menhir/" '*.mly' "$PREFIXCOQ/share/menhir/"
+      # Menhir PDF doc
+      install_glob "$PREFIXOCAML/share/doc/menhir/" '*.pdf' "$PREFIXCOQ/doc/menhir/"
+      touch "$FLAGFILES/menhir-addon.finished"
+      LOGTARGET=other
+      installer_addon_end
+    fi
+  fi
+}
+
+# COQ library for Menhir
+
+function make_addon_menhirlib {
+  installer_addon_dependency menhirlib
+  if build_prep_overlay menhirlib; then
+    installer_addon_section menhirlib "Menhirlib" "Coq support library for using Menhir generated parsers in Coq" ""
+    # The supplied makefiles don't work in any way on cygwin
+    cd src
+    echo -R . MenhirLib > _CoqProject
+    ls -1 *.v >> _CoqProject
+    log1 coq_makefile -f _CoqProject -o Makefile.coq
+    log1 make -f Makefile.coq all
+    logn make-install make -f Makefile.coq install
+    build_post
+  fi
+}
+
+# CompCert
+
+function make_addon_compcert {
+  installer_addon_dependency_beg compcert
+  make_menhir
+  make_addon_menhirlib
+  installer_addon_dependency_end
+  if build_prep_overlay CompCert; then
+    installer_addon_section compcert "CompCert" "ATTENTION: THIS IS NOT OPEN SOURCE! CompCert verified C compiler and Clightgen (required for using VST for your own code)" "off"
+    logn configure ./configure -ignore-coq-version -clightgen -prefix "$PREFIXCOQ" -coqdevdir "$PREFIXCOQ/lib/coq/user-contrib/compcert" x86_32-cygwin
+    log1 make
+    log2 make install
+    logn install-license-1 install -D -T  "LICENSE" "$PREFIXCOQ/lib/coq/user-contrib/compcert/LICENSE"
+    logn install-license-2 install -D -T  "LICENSE" "$PREFIXCOQ/lib/compcert/LICENSE"
+    build_post
+  fi
+}
+
+# Princeton VST
+
+function install_addon_vst {
+    VSTDEST="$PREFIXCOQ/lib/coq/user-contrib/VST"
+
+    # Install VST .v, .vo, .c and .h files
+    install_rec compcert '*.v' "$VSTDEST/compcert/"
+    install_rec compcert '*.vo' "$VSTDEST/compcert/"
+    install_glob "msl" '*.v' "$VSTDEST/msl/"
+    install_glob "msl" '*.vo' "$VSTDEST/msl/"
+    install_glob "sepcomp" '*.v' "$VSTDEST/sepcomp/"
+    install_glob "sepcomp" '*.vo' "$VSTDEST/sepcomp/"
+    install_glob "floyd" '*.v' "$VSTDEST/floyd/"
+    install_glob "floyd" '*.vo' "$VSTDEST/floyd/"
+    install_glob "progs" '*.v' "$VSTDEST/progs/"
+    install_glob "progs" '*.c' "$VSTDEST/progs/"
+    install_glob "progs" '*.h' "$VSTDEST/progs/"
+    install_glob "veric" '*.v' "$VSTDEST/msl/"
+    install_glob "veric" '*.vo' "$VSTDEST/msl/"
+
+    # Install VST documentation files
+    install_glob "." 'LICENSE' "$VSTDEST"
+    install_glob "." '*.md' "$VSTDEST"
+    install_glob "compcert" '*' "$VSTDEST/compcert"
+    install_glob "doc" '*.pdf' "$VSTDEST/doc"
+
+    # Install VST _CoqProject files
+    install_glob "." '_CoqProject*' "$VSTDEST"
+    install_glob "." '_CoqProject-export' "$VSTDEST/progs"
+}
+
+function make_addon_vst {
+  installer_addon_dependency vst
+  if build_prep_overlay VST; then
+    installer_addon_section vst "VST" "ATTENTION: SOME INCLUDED COMPCERT PARTS ARE NOT OPEN SOURCE! Verified Software Toolchain for verifying C code" "off"
+    log1 make IGNORECOQVERSION=true $MAKE_OPT
+    log1 install_addon_vst
+    build_post
+  fi
+}
+
+# coquelicot Real analysis
+
+function make_addon_coquelicot {
+  installer_addon_dependency_beg coquelicot
+  make_addon_ssreflect
+  installer_addon_dependency_end
+  if build_prep_overlay Coquelicot; then
+    installer_addon_section coquelicot "Coquelicot" "Coq library for real analysis" ""
+    logn configure ./configure --libdir="$PREFIXCOQ/lib/coq/user-contrib/Coquelicot"
+    logn remake ./remake
+    logn remake-install ./remake install
+    build_post
+  fi
+}
+
+# AAC associative / commutative rewriting
+
+function make_addon_aactactics {
+  installer_addon_dependency aac
+  if build_prep_overlay aactactis; then
+    installer_addon_section aac "AAC" "Coq plugin for extensible associative and commutative rewriting" ""
+    log1 make
+    log2 make install
+    build_post
+  fi
+}
+
+# extlib
+
+function make_addon_extlib {
+  installer_addon_dependency extlib
+  if build_prep_overlay ext_lib; then
+    installer_addon_section extlib "Ext-Lib" "Coq library with many reusable general purpose components" ""
+    log1 make $MAKE_OPT
+    log2 make install
+    build_post
+  fi
+}
+
+# SimpleIO
+
+function make_addon_simple_io {
+  installer_addon_dependency simpleIO
+  if build_prep_overlay simple_io; then
+    installer_addon_section simpleIO "SimpleIO" "Coq plugin for reading and writing files directly from Coq code" ""
+    log1 make $MAKE_OPT
+    log2 make install
+    build_post
+  fi
+}
+
+# Quickchick Randomized Property-Based Testing Plugin for Coq
+
+function make_addon_quickchick {
+  installer_addon_dependency_beg quickchick
+  make_addon_ssreflect
+  make_addon_extlib
+  make_addon_simple_io
+  make_ocamlbuild
+  installer_addon_dependency_end
+  if build_prep_overlay quickchick; then
+    installer_addon_section quickchick "QuickChick" "Coq plugin for randomized testing and counter example search" ""
+    log1 make
+    log2 make install
+    build_post
+  fi
+}
+
+# Main function for building addons
+
+function make_addons {
+  # Note: ':' is the empty command, which does not produce any output
+  : > "/build/filelists/addon_dependencies.nsh"
+
+  for addon in $COQ_ADDONS; do
+    "make_addon_$addon"
+  done
+
+  sort -u -o "/build/filelists/addon_dependencies.nsh" "/build/filelists/addon_dependencies.nsh"
+}
+
 ###################### TOP LEVEL BUILD #####################
 
-make_gtk2
-make_gtk_sourceview2
+ocamlfind list || true
 
+make_sed
 make_ocaml
-make_findlib
-make_lablgtk
-make_camlp4
-make_camlp5
-make_menhir
-make_stdint
+make_ocaml_tools
+make_ocaml_libs
+
 list_files ocaml
+
 make_coq
 
 if [ "$INSTALLMAKE" == "Y" ] ; then
@@ -1264,7 +1902,10 @@ fi
 
 list_files ocaml_coq
 
+make_addons
+
+list_files_always ocaml_coq_addons
+
 if [ "$MAKEINSTALLER" == "Y" ] ; then
   make_coq_installer
 fi
-
diff --git a/dev/build/windows/patches_coq/ReplaceInFile.nsh b/dev/build/windows/patches_coq/ReplaceInFile.nsh
deleted file mode 100644
index 27c7eb2f..00000000
--- a/dev/build/windows/patches_coq/ReplaceInFile.nsh
+++ /dev/null
@@ -1,67 +0,0 @@
-; From NSIS Wiki http://nsis.sourceforge.net/ReplaceInFile
-; Modifications:
-; - Replace only once per line
-; - Don't keep original as .old
-; - Use StrRep instead of StrReplace (seems to be cleaner)
-
-Function Func_ReplaceInFile
-  ClearErrors
-
-  Exch $0      ; REPLACEMENT
-  Exch
-  Exch $1      ; SEARCH_TEXT
-  Exch 2
-  Exch $2      ; SOURCE_FILE
-
-  Push $R0     ; SOURCE_FILE file handle
-  Push $R1     ; temporary file handle
-  Push $R2     ; unique temporary file name
-  Push $R3     ; a line to search and replace / save
-  Push $R4     ; shift puffer
-
-  IfFileExists $2 +1 error          ; Check if file exists and open it
-  FileOpen $R0 $2 "r"
-
-  GetTempFileName $R2               ; Create temporary output file
-  FileOpen $R1 $R2 "w"
-
-  loop:                             ; Loop over lines of file
-    FileRead $R0 $R3                ; Read line
-    IfErrors finished
-    Push "$R3"                      ; Replacine string in line once
-    Push "$1"
-    Push "$0"
-    Call Func_StrRep
-    Pop $R3
-    FileWrite $R1 "$R3"             ; Write result
-  Goto loop
-
-  finished:
-    FileClose $R1                   ; Close files
-    FileClose $R0
-    Delete "$2"                     ; Delete original file and rename temporary file to target
-    Rename "$R2" "$2"
-    ClearErrors
-    Goto out
-
-  error:
-    SetErrors
-
-  out:
-  Pop $R4
-  Pop $R3
-  Pop $R2
-  Pop $R1
-  Pop $R0
-  Pop $2
-  Pop $0
-  Pop $1
-FunctionEnd
-
-!macro ReplaceInFile SOURCE_FILE SEARCH_TEXT REPLACEMENT
-  Push "${SOURCE_FILE}"
-  Push "${SEARCH_TEXT}"
-  Push "${REPLACEMENT}"
-  Call Func_ReplaceInFile
-!macroend
-
diff --git a/dev/build/windows/patches_coq/StrRep.nsh b/dev/build/windows/patches_coq/StrRep.nsh
deleted file mode 100644
index d94a9f88..00000000
--- a/dev/build/windows/patches_coq/StrRep.nsh
+++ /dev/null
@@ -1,60 +0,0 @@
-; From NSIS Wiki http://nsis.sourceforge.net/StrRep
-; Slightly modified
-
-Function Func_StrRep
-    Exch $R2 ;new
-    Exch 1
-    Exch $R1 ;old
-    Exch 2
-    Exch $R0 ;string
-    Push $R3
-    Push $R4
-    Push $R5
-    Push $R6
-    Push $R7
-    Push $R8
-    Push $R9
-
-    StrCpy $R3 0
-    StrLen $R4 $R1
-    StrLen $R6 $R0
-    StrLen $R9 $R2
-    loop:
-        StrCpy $R5 $R0 $R4 $R3
-        StrCmp $R5 $R1 found
-        StrCmp $R3 $R6 done
-        IntOp $R3 $R3 + 1 ;move offset by 1 to check the next character
-        Goto loop
-    found:
-        StrCpy $R5 $R0 $R3
-        IntOp $R8 $R3 + $R4
-        StrCpy $R7 $R0 "" $R8
-        StrCpy $R0 $R5$R2$R7
-        StrLen $R6 $R0
-        IntOp $R3 $R3 + $R9 ;move offset by length of the replacement string
-        Goto loop
-    done:
-
-    Pop $R9
-    Pop $R8
-    Pop $R7
-    Pop $R6
-    Pop $R5
-    Pop $R4
-    Pop $R3
-    Push $R0
-    Push $R1
-    Pop $R0
-    Pop $R1
-    Pop $R0
-    Pop $R2
-    Exch $R1
-FunctionEnd
-
-!macro StrRep output string old new
-    Push `${string}`
-    Push `${old}`
-    Push `${new}`
-    Call Func_StrRep
-    Pop ${output}
-!macroend
diff --git a/dev/build/windows/patches_coq/aactactis-86ac28259030649ef51460e4de2441c8a1017751.patch b/dev/build/windows/patches_coq/aactactis-86ac28259030649ef51460e4de2441c8a1017751.patch
new file mode 100644
index 00000000..d9b134b2
--- /dev/null
+++ b/dev/build/windows/patches_coq/aactactis-86ac28259030649ef51460e4de2441c8a1017751.patch
@@ -0,0 +1,21 @@
+--- aac-tactics-v8.8.orig\Tutorial.v	2018-05-30 16:09:06.000000000 +0200
++++ aac-tactics-v8.8\Tutorial.v	2018-08-24 19:47:25.000000000 +0200
+@@ -9,16 +9,14 @@
+ (** * Tutorial for using the [aac_tactics] library.
+ 
+    Depending on your installation, either modify the following two
+    lines, or add them to your .coqrc files, replacing "."  with the
+    path to the [aac_tactics] library. *)
+ 
+-Add Rec LoadPath "." as AAC_tactics.
+-Add ML Path ".".
+-Require Import AAC.
+-Require Instances.
++Require Import AAC_tactics.AAC.
++Require AAC_tactics.Instances.
+ Require Arith ZArith.
+ 
+ (** ** Introductory example 
+ 
+    Here is a first example with relative numbers ([Z]): one can
+    rewrite an universally quantified hypothesis modulo the
diff --git a/dev/build/windows/patches_coq/coq_new.nsi b/dev/build/windows/patches_coq/coq_new.nsi
index b88aa066..9947965c 100644
--- a/dev/build/windows/patches_coq/coq_new.nsi
+++ b/dev/build/windows/patches_coq/coq_new.nsi
@@ -9,13 +9,14 @@
 ; ARCH         The target architecture, either x86_64 or i686
 ; COQ_SRC_PATH path of Coq installation in Windows or MinGW format (either \\ or /, but with drive letter)
 ; COQ_ICON     path of Coq icon file in Windows or MinGW format
+; COQ_ADDONS   list of addons that are shipped
 
 ; Enable compression after debugging.
 ; SetCompress off
 SetCompressor lzma
 
 !define MY_PRODUCT "Coq" ;Define your own software name here
-!define OUTFILE "coq-installer-${VERSION}-${ARCH}.exe"
+!define OUTFILE "coq-${VERSION}-installer-windows-${ARCH}.exe"
 
 !include "MUI2.nsh"
 !include "FileAssociation.nsh"
@@ -37,42 +38,20 @@ Var INSTDIR_DBS       ; INSTDIR with \\ instead of \
 
   ;Folder selection page
   InstallDir "C:\${MY_PRODUCT}"
-  
+
   ;Remember install folder
   InstallDirRegKey HKCU "Software\${MY_PRODUCT}" ""
 
 ;--------------------------------
-;Modern UI Configuration
-  
-  !define MUI_ICON "${COQ_ICON}"
-
-  !insertmacro MUI_PAGE_WELCOME
-  !insertmacro MUI_PAGE_LICENSE "${COQ_SRC_PATH}/license_readme/coq/License.txt"
-  !insertmacro MUI_PAGE_COMPONENTS
-  !define MUI_DIRECTORYPAGE_TEXT_TOP "Select where to install Coq.  The path MUST NOT include spaces."
-  !insertmacro MUI_PAGE_DIRECTORY
-  !insertmacro MUI_PAGE_INSTFILES
-  !insertmacro MUI_PAGE_FINISH
-  
-  !insertmacro MUI_UNPAGE_WELCOME
-  !insertmacro MUI_UNPAGE_CONFIRM
-  !insertmacro MUI_UNPAGE_INSTFILES
-  !insertmacro MUI_UNPAGE_FINISH  
-
-;--------------------------------
-;Languages
- 
-  !insertmacro MUI_LANGUAGE "English"
-  
-;--------------------------------
-;Language Strings
+;Extra license pages
 
-  ;Description
-  LangString DESC_1 ${LANG_ENGLISH} "This package contains Coq and CoqIDE."
-  LangString DESC_2 ${LANG_ENGLISH} "This package contains an OCaml compiler for Coq native compute and plugin development."
-  LangString DESC_3 ${LANG_ENGLISH} "This package contains the development files needed in order to build a plugin for Coq."
-  LangString DESC_4 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for the current user."
-  LangString DESC_5 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for all users."
+!macro MUI_PAGE_LICENSE_EXTRA Licensefile Header Subheader Bottom SelFunc
+  !define MUI_PAGE_HEADER_TEXT "${Header}"
+  !define MUI_PAGE_HEADER_SUBTEXT "${Subheader}"
+  !define MUI_LICENSEPAGE_TEXT_BOTTOM "${Bottom}"
+  !define MUI_PAGE_CUSTOMFUNCTION_PRE ${SelFunc}
+  !insertmacro MUI_PAGE_LICENSE "${Licensefile}"
+!macroend
 
 ;--------------------------------
 ; Check for white spaces
@@ -93,7 +72,6 @@ FunctionEnd
 ;--------------------------------
 ;Installer Sections
 
-
 Section "Coq" Sec1
 
   SetOutPath "$INSTDIR\"
@@ -103,7 +81,7 @@ Section "Coq" Sec1
 
   ;Store install folder
   WriteRegStr HKCU "Software\${MY_PRODUCT}" "" $INSTDIR
-  
+
   ;Create uninstaller
   WriteUninstaller "$INSTDIR\Uninstall.exe"
   WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \
@@ -121,7 +99,7 @@ Section "Coq" Sec1
 
   ; Create start menu entries
   ; SetOutPath is required for the path in the .lnk files
-  SetOutPath "$INSTDIR" 
+  SetOutPath "$INSTDIR"
   CreateDirectory "$SMPROGRAMS\Coq"
   ; The first shortcut set here is treated as main application by Windows 7/8.
   ; Use CoqIDE as main application
@@ -136,20 +114,24 @@ SectionEnd
 ;OCAML Section "Ocaml for native compute and plugin development" Sec2
 ;OCAML   SetOutPath "$INSTDIR\"
 ;OCAML   !include "..\..\..\filelists\ocaml.nsh"
-;OCAML 
+;OCAML
 ;OCAML   ; Create a few slash / backslash variants of the source and install path
 ;OCAML   ; Note: NSIS has variables, written as $VAR and defines, written as ${VAR}
 ;OCAML   !insertmacro StrRep $COQ_SRC_PATH_BS  ${COQ_SRC_PATH} "/" "\"
 ;OCAML   !insertmacro StrRep $COQ_SRC_PATH_DBS ${COQ_SRC_PATH} "/" "\\"
 ;OCAML   !insertmacro StrRep $INSTDIR_DBS      $INSTDIR        "\" "\\"
-;OCAML 
+;OCAML
 ;OCAML   ; Replace absolute paths in some OCaml config files
 ;OCAML   ; These are not all, see ReadMe.txt
 ;OCAML   !insertmacro ReplaceInFile "$INSTDIR\libocaml\ld.conf" "/"  "\"
 ;OCAML   !insertmacro ReplaceInFile "$INSTDIR\libocaml\ld.conf" "$COQ_SRC_PATH_BS"  "$INSTDIR"
 ;OCAML   !insertmacro ReplaceInFile "$INSTDIR\etc\findlib.conf" "$COQ_SRC_PATH_DBS" "$INSTDIR_DBS"
 ;OCAML SectionEnd
- 
+
+SectionGroup "Coq addons" Sec2
+  !include "..\..\..\filelists\addon_sections.nsh"
+SectionGroupEnd
+
 Section "Coq files for plugin developers" Sec3
   SetOutPath "$INSTDIR\"
   !include "..\..\..\filelists\coq_plugindev.nsh"
@@ -172,23 +154,148 @@ SectionEnd
 ;OCAML SectionEnd
 
 ;--------------------------------
+;Section dependencies
+
+; Parameters on the stack:
+; top-0 : section B on which section A dependencies
+; top-1 : section A, which depends on section B
+; top-2 : name of section B
+; top-3 : name of section A
+
+Function CheckSectionDependency
+            ; stack=nameB nameA secB secA rest
+  Exch $R3  ; stack=$R3   nameA secB secA rest; $R3=nameB
+  Exch      ; stack=nameA $R3   secB secA rest
+  Exch $R2  ; stack=$R2   $R3   secB secA rest; $R2=nameA
+  Exch 2    ; stack=secB  $R3   $R2  secA rest
+  Exch $R1  ; stack=$R1   $R3   $R2  secA rest; $R1=secB
+  Exch 3    ; stack=secA  $R3   $R2  $R1  rest;
+  Exch $R0  ; stack=$R0   $R3   $R2  $R1  rest; $R0=secA
+            ; Take care of save order when popping the stack!
+  Push $R4
+  Push $R5
+
+  SectionGetFlags $R0 $R0
+  IntOp $R0 $R0 & ${SF_SELECTED}
+
+  SectionGetFlags $R1 $R4
+  IntOp $R5 $R4 & ${SF_SELECTED}
+
+  ${If} $R0 == ${SF_SELECTED}
+  ${AndIf} $R5 != ${SF_SELECTED}
+
+  IntOp $R5 $R4 | ${SF_SELECTED}
+  SectionSetFlags $R1 $R5
+  MessageBox MB_OK '"$R3" has been selected, because "$R2" depends on it'
+
+  ${EndIf}
+
+  Pop $R5
+  Pop $R4
+  Pop $R0
+  Pop $R3
+  Pop $R2
+  Pop $R1
+FunctionEnd
+
+!macro CheckSectionDependency secA secB nameA nameB
+  Push "${secA}"
+  Push "${secB}"
+  Push "${nameA}"
+  Push "${nameB}"
+  Call CheckSectionDependency
+!macroend
+
+!define CheckSectionDependency "!insertmacro CheckSectionDependency"
+
+Function .onSelChange
+  !include "..\..\..\filelists\addon_dependencies.nsh"
+FunctionEnd
+
+;--------------------------------
+;Modern UI Configuration
+
+; Note: this must be placed after the sections, because below we need to check at compile time
+; if sections exist (by !ifdef <section_index_var>) to decide if the license page must be included.
+; The section index variables are only defined after the section definitions.
+
+  !define MUI_ICON "${COQ_ICON}"
+
+  !insertmacro MUI_PAGE_WELCOME
+  !insertmacro MUI_PAGE_LICENSE "${COQ_SRC_PATH}/license_readme/coq/License.txt"
+  !insertmacro MUI_PAGE_COMPONENTS
+
+  !ifdef Sec_compcert
+    !define LicCompCert_Title "CompCert License Agreement"
+    !define LicCompCert_SubTitle "You selected the CompCert addon. CompCert is not open source. Please review the license terms before installing CompCert!"
+    !define LicCompCert_Bottom "If you accept the terms of the agreement, click I Agree to continue. Otherwise go back and unselect the CompCert addon."
+    !insertmacro MUI_PAGE_LICENSE_EXTRA "${COQ_SRC_PATH}/lib/coq/user-contrib/compcert/LICENSE" "${LicCompCert_Title}" "${LicCompCert_SubTitle}" "${LicCompCert_Bottom}" SelFuncCompCert
+
+    Function SelFuncCompCert
+      ${Unless} ${SectionIsSelected} ${Sec_compcert}
+        Abort
+      ${EndUnless}
+    FunctionEnd
+  !endif
+
+  !ifdef Sec_vst
+    !define LicVST_Title "Princeton VST License Agreement"
+    !define LicVST_SubTitle "You selected the VST addon. VST contains parts of CompCert which are not open source. Please review the license terms before installing VST!"
+    !define LicVST_Bottom "If you accept the terms of the agreement, click I Agree to continue. Otherwise go back and unselect the VST addon."
+    !insertmacro MUI_PAGE_LICENSE_EXTRA "${COQ_SRC_PATH}/lib/coq/user-contrib/VST/LICENSE" "${LicVST_Title}" "${LicVST_SubTitle}" "${LicVST_Bottom}" SelFuncVST
+
+    Function SelFuncVST
+      ${Unless} ${SectionIsSelected} ${Sec_vst}
+        Abort
+      ${EndUnless}
+    FunctionEnd
+  !endif
+
+  !define MUI_DIRECTORYPAGE_TEXT_TOP "Select where to install Coq.  The path MUST NOT include spaces."
+  !insertmacro MUI_PAGE_DIRECTORY
+  !insertmacro MUI_PAGE_INSTFILES
+  !insertmacro MUI_PAGE_FINISH
+
+  !insertmacro MUI_UNPAGE_WELCOME
+  !insertmacro MUI_UNPAGE_CONFIRM
+  !insertmacro MUI_UNPAGE_INSTFILES
+  !insertmacro MUI_UNPAGE_FINISH
+
+;--------------------------------
+;Languages
+
+  !insertmacro MUI_LANGUAGE "English"
+
+;--------------------------------
+;Language Strings
+
+  ;Description
+  LangString DESC_1 ${LANG_ENGLISH} "This package contains Coq and CoqIDE."
+  LangString DESC_2 ${LANG_ENGLISH} "This package contains the following extra Coq packages: ${COQ_ADDONS}"
+  LangString DESC_3 ${LANG_ENGLISH} "This package contains the development files needed in order to build a plugin for Coq."
+  ; LangString DESC_4 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for the current user."
+  ; LangString DESC_5 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for all users."
+  !include "..\..\..\filelists\addon_strings.nsh"
+
+;--------------------------------
 ;Descriptions
 
 !insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN
   !insertmacro MUI_DESCRIPTION_TEXT ${Sec1} $(DESC_1)
-  ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec2} $(DESC_2)
+  !insertmacro MUI_DESCRIPTION_TEXT ${Sec2} $(DESC_2)
   !insertmacro MUI_DESCRIPTION_TEXT ${Sec3} $(DESC_3)
   ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec4} $(DESC_4)
   ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec5} $(DESC_5)
+  !include "..\..\..\filelists\addon_descriptions.nsh"
 !insertmacro MUI_FUNCTION_DESCRIPTION_END
- 
+
 ;--------------------------------
 ;Uninstaller Section
 
 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"
@@ -207,7 +314,7 @@ Section "Uninstall"
   Delete "$SMPROGRAMS\Coq\The Coq HomePage.url"
   Delete "$SMPROGRAMS\Coq\The Coq Standard Library.url"
   Delete "$INSTDIR\Uninstall.exe"
-  
+
   ; Registry keys
   DeleteRegKey HKCU "Software\${MY_PRODUCT}"
   DeleteRegKey HKLM "SOFTWARE\Coq"
diff --git a/dev/build/windows/patches_coq/lablgtk-2.18.3.patch b/dev/build/windows/patches_coq/lablgtk-2.18.3.patch
index 0691c1fc..23c30313 100644
--- a/dev/build/windows/patches_coq/lablgtk-2.18.3.patch
+++ b/dev/build/windows/patches_coq/lablgtk-2.18.3.patch
@@ -1,6 +1,12 @@
-diff -u -r lablgtk-2.18.3/configure lablgtk-2.18.3.patched/configure
---- lablgtk-2.18.3/configure	2014-10-29 08:51:05.000000000 +0100
-+++ lablgtk-2.18.3.patched/configure	2015-10-29 08:58:08.543985500 +0100
+diff/patch file created on Wed, Apr 25, 2018 11:08:05 AM with:
+difftar-folder.sh ../coq-msoegtrop/dev/build/windows/source_cache/lablgtk-2.18.3.tar.gz lablgtk-2.18.3 1
+TARFILE= ../coq-msoegtrop/dev/build/windows/source_cache/lablgtk-2.18.3.tar.gz
+FOLDER= lablgtk-2.18.3
+TARSTRIP= 1
+TARPREFIX= lablgtk-2.18.3/
+ORIGFOLDER= lablgtk-2.18.3.orig
+--- lablgtk-2.18.3.orig/configure	2014-10-29 08:51:05.000000000 +0100
++++ lablgtk-2.18.3/configure	2018-04-25 10:58:54.454501600 +0200
 @@ -2667,7 +2667,7 @@
  fi
  
@@ -10,10 +16,8 @@ diff -u -r lablgtk-2.18.3/configure lablgtk-2.18.3.patched/configure
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ignoring ocamlfind" >&5
  $as_echo "$as_me: WARNING: Ignoring ocamlfind" >&2;}
    OCAMLFIND=no
-
-diff -u -r lablgtk-2.18.3/src/glib.mli lablgtk-2.18.3.patched/src/glib.mli
---- lablgtk-2.18.3/src/glib.mli	2014-10-29 08:51:06.000000000 +0100
-+++ lablgtk-2.18.3.patched/src/glib.mli	2016-01-25 09:50:59.884715200 +0100
+--- lablgtk-2.18.3.orig/src/glib.mli	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/glib.mli	2018-04-25 10:58:54.493555500 +0200
 @@ -75,6 +75,7 @@
    type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI]
    type id
@@ -22,10 +26,8 @@ diff -u -r lablgtk-2.18.3/src/glib.mli lablgtk-2.18.3.patched/src/glib.mli
    val add_watch :
      cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
    val remove : id -> unit
-
-diff -u -r lablgtk-2.18.3/src/glib.ml lablgtk-2.18.3.patched/src/glib.ml
---- lablgtk-2.18.3/src/glib.ml	2014-10-29 08:51:06.000000000 +0100
-+++ lablgtk-2.18.3.patched/src/glib.ml	2016-01-25 09:50:59.891715900 +0100
+--- lablgtk-2.18.3.orig/src/glib.ml	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/glib.ml	2018-04-25 10:58:54.479543500 +0200
 @@ -72,6 +72,8 @@
    type id
    external channel_of_descr : Unix.file_descr -> channel
@@ -35,10 +37,22 @@ diff -u -r lablgtk-2.18.3/src/glib.ml lablgtk-2.18.3.patched/src/glib.ml
    external remove : id -> unit = "ml_g_source_remove"
    external add_watch :
      cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
-
-diff -u -r lablgtk-2.18.3/src/ml_glib.c lablgtk-2.18.3.patched/src/ml_glib.c
---- lablgtk-2.18.3/src/ml_glib.c	2014-10-29 08:51:06.000000000 +0100
-+++ lablgtk-2.18.3.patched/src/ml_glib.c	2016-01-25 09:50:59.898716600 +0100
+--- lablgtk-2.18.3.orig/src/Makefile	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/Makefile	2018-04-25 10:58:54.506522500 +0200
+@@ -461,9 +461,9 @@
+ 	  do rm -f "$(BINDIR)"/$$f; done
+ 
+ lablgtk.cma liblablgtk2$(XA): $(COBJS) $(MLOBJS)
+-	$(LIBRARIAN) -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
++	$(LIBRARIAN) -ldopt "-link -Wl,-s" -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
+ lablgtk.cmxa: $(COBJS) $(MLOBJS:.cmo=.cmx)
+-	$(LIBRARIAN) -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
++	$(LIBRARIAN) -ldopt "-link -Wl,-s" -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
+ lablgtk.cmxs: DYNLINKLIBS=$(GTK_LIBS)
+ 
+ lablgtkgl.cma liblablgtkgl2$(XA): $(GLCOBJS) $(GLMLOBJS)
+--- lablgtk-2.18.3.orig/src/ml_glib.c	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/ml_glib.c	2018-04-25 10:58:54.539535600 +0200
 @@ -25,6 +25,8 @@
  #include <string.h>
  #include <locale.h>
diff --git a/dev/build/windows/patches_coq/lablgtk-2.18.6.patch b/dev/build/windows/patches_coq/lablgtk-2.18.6.patch
new file mode 100644
index 00000000..23c30313
--- /dev/null
+++ b/dev/build/windows/patches_coq/lablgtk-2.18.6.patch
@@ -0,0 +1,101 @@
+diff/patch file created on Wed, Apr 25, 2018 11:08:05 AM with:
+difftar-folder.sh ../coq-msoegtrop/dev/build/windows/source_cache/lablgtk-2.18.3.tar.gz lablgtk-2.18.3 1
+TARFILE= ../coq-msoegtrop/dev/build/windows/source_cache/lablgtk-2.18.3.tar.gz
+FOLDER= lablgtk-2.18.3
+TARSTRIP= 1
+TARPREFIX= lablgtk-2.18.3/
+ORIGFOLDER= lablgtk-2.18.3.orig
+--- lablgtk-2.18.3.orig/configure	2014-10-29 08:51:05.000000000 +0100
++++ lablgtk-2.18.3/configure	2018-04-25 10:58:54.454501600 +0200
+@@ -2667,7 +2667,7 @@
+ fi
+ 
+ 
+-if test "`$OCAMLFIND printconf stdlib`" != "`$CAMLC -where`"; then
++if test "`$OCAMLFIND printconf stdlib | tr '\\' '/'`" != "`$CAMLC -where | tr '\\' '/'`"; then
+   { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ignoring ocamlfind" >&5
+ $as_echo "$as_me: WARNING: Ignoring ocamlfind" >&2;}
+   OCAMLFIND=no
+--- lablgtk-2.18.3.orig/src/glib.mli	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/glib.mli	2018-04-25 10:58:54.493555500 +0200
+@@ -75,6 +75,7 @@
+   type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI]
+   type id
+   val channel_of_descr : Unix.file_descr -> channel
++  val channel_of_descr_socket : Unix.file_descr -> channel
+   val add_watch :
+     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
+   val remove : id -> unit
+--- lablgtk-2.18.3.orig/src/glib.ml	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/glib.ml	2018-04-25 10:58:54.479543500 +0200
+@@ -72,6 +72,8 @@
+   type id
+   external channel_of_descr : Unix.file_descr -> channel
+     = "ml_g_io_channel_unix_new"
++  external channel_of_descr_socket : Unix.file_descr -> channel
++    = "ml_g_io_channel_unix_new_socket"
+   external remove : id -> unit = "ml_g_source_remove"
+   external add_watch :
+     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
+--- lablgtk-2.18.3.orig/src/Makefile	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/Makefile	2018-04-25 10:58:54.506522500 +0200
+@@ -461,9 +461,9 @@
+ 	  do rm -f "$(BINDIR)"/$$f; done
+ 
+ lablgtk.cma liblablgtk2$(XA): $(COBJS) $(MLOBJS)
+-	$(LIBRARIAN) -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
++	$(LIBRARIAN) -ldopt "-link -Wl,-s" -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
+ lablgtk.cmxa: $(COBJS) $(MLOBJS:.cmo=.cmx)
+-	$(LIBRARIAN) -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
++	$(LIBRARIAN) -ldopt "-link -Wl,-s" -o lablgtk -oc lablgtk2 $^ $(GTKLIBS)
+ lablgtk.cmxs: DYNLINKLIBS=$(GTK_LIBS)
+ 
+ lablgtkgl.cma liblablgtkgl2$(XA): $(GLCOBJS) $(GLMLOBJS)
+--- lablgtk-2.18.3.orig/src/ml_glib.c	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3/src/ml_glib.c	2018-04-25 10:58:54.539535600 +0200
+@@ -25,6 +25,8 @@
+ #include <string.h>
+ #include <locale.h>
+ #ifdef _WIN32
++/* to kill a #warning: include winsock2.h before windows.h */
++#include <winsock2.h>
+ #include "win32.h"
+ #include <wtypes.h>
+ #include <io.h>
+@@ -38,6 +40,11 @@
+ #include <caml/callback.h>
+ #include <caml/threads.h>
+ 
++#ifdef _WIN32
++/* for Socket_val */
++#include <caml/unixsupport.h>
++#endif
++
+ #include "wrappers.h"
+ #include "ml_glib.h"
+ #include "glib_tags.h"
+@@ -325,14 +332,23 @@
+ 
+ #ifndef _WIN32
+ ML_1 (g_io_channel_unix_new, Int_val, Val_GIOChannel_noref)
++CAMLprim value ml_g_io_channel_unix_new_socket (value arg1) {
++  return Val_GIOChannel_noref (g_io_channel_unix_new (Int_val (arg1))); 
++}
+ 
+ #else
+ CAMLprim value ml_g_io_channel_unix_new(value wh)
+ {
+   return Val_GIOChannel_noref
+-    (g_io_channel_unix_new
++    (g_io_channel_win32_new_fd
+      (_open_osfhandle((long)*(HANDLE*)Data_custom_val(wh), O_BINARY)));
+ }
++
++CAMLprim value ml_g_io_channel_unix_new_socket(value wh)
++{
++  return Val_GIOChannel_noref
++    (g_io_channel_win32_new_socket(Socket_val(wh)));
++}
+ #endif
+ 
+ static gboolean ml_g_io_channel_watch(GIOChannel *s, GIOCondition c,
diff --git a/dev/build/windows/patches_coq/ln.c b/dev/build/windows/patches_coq/ln.c
index 5e02c72b..41f64f98 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/build/windows/patches_coq/quickchick-v1.0.2.patch b/dev/build/windows/patches_coq/quickchick-v1.0.2.patch
new file mode 100644
index 00000000..d03749ba
--- /dev/null
+++ b/dev/build/windows/patches_coq/quickchick-v1.0.2.patch
@@ -0,0 +1,38 @@
+diff/patch file created on Mon, Aug 27, 2018  9:21:52 AM with:
+difftar-folder.sh tarballs/quickchick-v1.0.2.tar.gz quickchick-v1.0.2 1
+TARFILE= tarballs/quickchick-v1.0.2.tar.gz
+FOLDER= quickchick-v1.0.2
+TARSTRIP= 1
+TARPREFIX= QuickChick-1.0.2/
+ORIGFOLDER= quickchick-v1.0.2.orig
+--- quickchick-v1.0.2.orig/Makefile	2018-08-22 18:21:39.000000000 +0200
++++ quickchick-v1.0.2/Makefile	2018-08-27 09:21:04.710461100 +0200
+@@ -2,7 +2,7 @@
+ .PHONY: plugin install install-plugin clean quickChickTool
+ 
+ QCTOOL_DIR=quickChickTool
+-QCTOOL_EXE=quickChickTool.byte
++QCTOOL_EXE=quickChickTool.native
+ QCTOOL_SRC=$(QCTOOL_DIR)/quickChickTool.ml \
+ 		   $(QCTOOL_DIR)/quickChickToolTypes.ml \
+ 		   $(QCTOOL_DIR)/quickChickToolLexer.mll \
+@@ -32,7 +32,7 @@
+ install: all
+ 	$(V)$(MAKE) -f Makefile.coq install > $(TEMPFILE)
+ # Manually copying the remaining files
+-	$(V)cp $(QCTOOL_EXE) $(shell opam config var bin)/quickChick
++	$(V)cp $(QCTOOL_EXE) "$(COQBIN)/quickChick"
+ #	 $(V)cp src/quickChickLib.cmx $(COQLIB)/user-contrib/QuickChick
+ #	 $(V)cp src/quickChickLib.o $(COQLIB)/user-contrib/QuickChick
+ 
+--- quickchick-v1.0.2.orig/src/Show.v	2018-08-22 18:21:39.000000000 +0200
++++ quickchick-v1.0.2/src/Show.v	2018-08-27 09:21:35.893961900 +0200
+@@ -228,7 +228,7 @@
+       match s with 
+         | EmptyString => (if b then ")" else "", b)
+         | String a s => 
+-          let (s', b) := aux s (orb b (nat_of_ascii a =? 32)) in
++          let (s', b) := aux s (orb b (nat_of_ascii a =? 32)%nat) in
+           (String a s', b)
+       end in
+   let (s', b) := aux s false in
diff --git a/dev/build/windows/patches_coq/sed-4.2.2-3.src.patch b/dev/build/windows/patches_coq/sed-4.2.2-3.src.patch
new file mode 100755
index 00000000..d210a041
--- /dev/null
+++ b/dev/build/windows/patches_coq/sed-4.2.2-3.src.patch
@@ -0,0 +1,1301 @@
+--- origsrc/sed-4.2.2/doc/sed.1	2012-12-22 15:27:13.000000000 +0100
++++ src/sed-4.2.2/doc/sed.1	2013-06-27 18:10:47.974060492 +0200
+@@ -1,5 +1,5 @@
+ .\" DO NOT MODIFY THIS FILE!  It was generated by help2man 1.28.
+-.TH SED "1" "December 2012" "sed 4.2.2" "User Commands"
++.TH SED "1" "June 2013" "sed 4.2.2" "User Commands"
+ .SH NAME
+ sed \- stream editor for filtering and transforming text
+ .SH SYNOPSIS
+@@ -40,6 +40,10 @@ follow symlinks when processing in place
+ .IP
+ edit files in place (makes backup if SUFFIX supplied)
+ .HP
++\fB\-b\fR, \fB\-\-binary\fR
++.IP
++open files in binary mode (CR+LFs are not processed specially)
++.HP
+ \fB\-l\fR N, \fB\-\-line\-length\fR=\fIN\fR
+ .IP
+ specify the desired line-wrap length for the `l' command
+--- origsrc/sed-4.2.2/lib/regcomp.c	2012-12-22 14:21:52.000000000 +0100
++++ src/sed-4.2.2/lib/regcomp.c	2013-06-27 18:05:27.044448044 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ static reg_errcode_t re_compile_internal (regex_t *preg, const char * pattern,
+ 					  size_t length, reg_syntax_t syntax);
+@@ -95,20 +94,20 @@ static reg_errcode_t build_charclass (RE
+ 				      bitset_t sbcset,
+ 				      re_charset_t *mbcset,
+ 				      Idx *char_class_alloc,
+-				      const unsigned char *class_name,
++				      const char *class_name,
+ 				      reg_syntax_t syntax);
+ #else  /* not RE_ENABLE_I18N */
+ static reg_errcode_t build_equiv_class (bitset_t sbcset,
+ 					const unsigned char *name);
+ static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans,
+ 				      bitset_t sbcset,
+-				      const unsigned char *class_name,
++				      const char *class_name,
+ 				      reg_syntax_t syntax);
+ #endif /* not RE_ENABLE_I18N */
+ static bin_tree_t *build_charclass_op (re_dfa_t *dfa,
+ 				       RE_TRANSLATE_TYPE trans,
+-				       const unsigned char *class_name,
+-				       const unsigned char *extra,
++				       const char *class_name,
++				       const char *extra,
+ 				       bool non_match, reg_errcode_t *err);
+ static bin_tree_t *create_tree (re_dfa_t *dfa,
+ 				bin_tree_t *left, bin_tree_t *right,
+@@ -293,7 +292,7 @@ weak_alias (__re_compile_fastmap, re_com
+ #endif
+ 
+ static inline void
+-__attribute ((always_inline))
++__attribute__ ((always_inline))
+ re_set_fastmap (char *fastmap, bool icase, int ch)
+ {
+   fastmap[ch] = 1;
+@@ -587,7 +586,7 @@ weak_alias (__regerror, regerror)
+ static const bitset_t utf8_sb_map =
+ {
+   /* Set the first 128 bits.  */
+-# ifdef __GNUC__
++# if defined __GNUC__ && !defined __STRICT_ANSI__
+   [0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX
+ # else
+ #  if 4 * BITSET_WORD_BITS < ASCII_CHARS
+@@ -664,7 +663,10 @@ regfree (preg)
+ {
+   re_dfa_t *dfa = preg->buffer;
+   if (BE (dfa != NULL, 1))
+-    free_dfa_content (dfa);
++    {
++      lock_fini (dfa->lock);
++      free_dfa_content (dfa);
++    }
+   preg->buffer = NULL;
+   preg->allocated = 0;
+ 
+@@ -785,6 +787,8 @@ re_compile_internal (regex_t *preg, cons
+   preg->used = sizeof (re_dfa_t);
+ 
+   err = init_dfa (dfa, length);
++  if (BE (err == REG_NOERROR && lock_init (dfa->lock) != 0, 0))
++    err = REG_ESPACE;
+   if (BE (err != REG_NOERROR, 0))
+     {
+       free_dfa_content (dfa);
+@@ -798,8 +802,6 @@ re_compile_internal (regex_t *preg, cons
+   strncpy (dfa->re_str, pattern, length + 1);
+ #endif
+ 
+-  __libc_lock_init (dfa->lock);
+-
+   err = re_string_construct (&regexp, pattern, length, preg->translate,
+ 			     (syntax & RE_ICASE) != 0, dfa);
+   if (BE (err != REG_NOERROR, 0))
+@@ -807,6 +809,7 @@ re_compile_internal (regex_t *preg, cons
+     re_compile_internal_free_return:
+       free_workarea_compile (preg);
+       re_string_destruct (&regexp);
++      lock_fini (dfa->lock);
+       free_dfa_content (dfa);
+       preg->buffer = NULL;
+       preg->allocated = 0;
+@@ -839,6 +842,7 @@ re_compile_internal (regex_t *preg, cons
+ 
+   if (BE (err != REG_NOERROR, 0))
+     {
++      lock_fini (dfa->lock);
+       free_dfa_content (dfa);
+       preg->buffer = NULL;
+       preg->allocated = 0;
+@@ -954,10 +958,10 @@ static void
+ internal_function
+ init_word_char (re_dfa_t *dfa)
+ {
+-  dfa->word_ops_used = 1;
+   int i = 0;
+   int j;
+   int ch = 0;
++  dfa->word_ops_used = 1;
+   if (BE (dfa->map_notascii == 0, 1))
+     {
+       bitset_word_t bits0 = 0x00000000;
+@@ -2423,8 +2427,8 @@ parse_expression (re_string_t *regexp, r
+     case OP_WORD:
+     case OP_NOTWORD:
+       tree = build_charclass_op (dfa, regexp->trans,
+-				 (const unsigned char *) "alnum",
+-				 (const unsigned char *) "_",
++				 "alnum",
++				 "_",
+ 				 token->type == OP_NOTWORD, err);
+       if (BE (*err != REG_NOERROR && tree == NULL, 0))
+ 	return NULL;
+@@ -2432,8 +2436,8 @@ parse_expression (re_string_t *regexp, r
+     case OP_SPACE:
+     case OP_NOTSPACE:
+       tree = build_charclass_op (dfa, regexp->trans,
+-				 (const unsigned char *) "space",
+-				 (const unsigned char *) "",
++				 "space",
++				 "",
+ 				 token->type == OP_NOTSPACE, err);
+       if (BE (*err != REG_NOERROR && tree == NULL, 0))
+ 	return NULL;
+@@ -2713,7 +2717,6 @@ build_range_exp (const reg_syntax_t synt
+     wchar_t wc;
+     wint_t start_wc;
+     wint_t end_wc;
+-    wchar_t cmp_buf[6] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
+ 
+     start_ch = ((start_elem->type == SB_CHAR) ? start_elem->opr.ch
+ 		: ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0]
+@@ -2727,11 +2730,7 @@ build_range_exp (const reg_syntax_t synt
+ 	      ? __btowc (end_ch) : end_elem->opr.wch);
+     if (start_wc == WEOF || end_wc == WEOF)
+       return REG_ECOLLATE;
+-    cmp_buf[0] = start_wc;
+-    cmp_buf[4] = end_wc;
+-
+-    if (BE ((syntax & RE_NO_EMPTY_RANGES)
+-            && wcscoll (cmp_buf, cmp_buf + 4) > 0, 0))
++    else if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_wc > end_wc, 0))
+       return REG_ERANGE;
+ 
+     /* Got valid collation sequence values, add them as a new entry.
+@@ -2772,9 +2771,7 @@ build_range_exp (const reg_syntax_t synt
+     /* Build the table for single byte characters.  */
+     for (wc = 0; wc < SBC_MAX; ++wc)
+       {
+-	cmp_buf[2] = wc;
+-	if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
+-	    && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
++	if (start_wc <= wc && wc <= end_wc)
+ 	  bitset_set (sbcset, wc);
+       }
+   }
+@@ -2843,40 +2840,29 @@ parse_bracket_exp (re_string_t *regexp,
+ 
+   /* Local function for parse_bracket_exp used in _LIBC environment.
+      Seek the collating symbol entry corresponding to NAME.
+-     Return the index of the symbol in the SYMB_TABLE.  */
++     Return the index of the symbol in the SYMB_TABLE,
++     or -1 if not found.  */
+ 
+   auto inline int32_t
+-  __attribute ((always_inline))
+-  seek_collating_symbol_entry (name, name_len)
+-	 const unsigned char *name;
+-	 size_t name_len;
+-    {
+-      int32_t hash = elem_hash ((const char *) name, name_len);
+-      int32_t elem = hash % table_size;
+-      if (symb_table[2 * elem] != 0)
+-	{
+-	  int32_t second = hash % (table_size - 2) + 1;
+-
+-	  do
+-	    {
+-	      /* First compare the hashing value.  */
+-	      if (symb_table[2 * elem] == hash
+-		  /* Compare the length of the name.  */
+-		  && name_len == extra[symb_table[2 * elem + 1]]
+-		  /* Compare the name.  */
+-		  && memcmp (name, &extra[symb_table[2 * elem + 1] + 1],
+-			     name_len) == 0)
+-		{
+-		  /* Yep, this is the entry.  */
+-		  break;
+-		}
++  __attribute__ ((always_inline))
++  seek_collating_symbol_entry (const unsigned char *name, size_t name_len)
++    {
++      int32_t elem;
+ 
+-	      /* Next entry.  */
+-	      elem += second;
+-	    }
+-	  while (symb_table[2 * elem] != 0);
+-	}
+-      return elem;
++      for (elem = 0; elem < table_size; elem++)
++	if (symb_table[2 * elem] != 0)
++	  {
++	    int32_t idx = symb_table[2 * elem + 1];
++	    /* Skip the name of collating element name.  */
++	    idx += 1 + extra[idx];
++	    if (/* Compare the length of the name.  */
++		name_len == extra[idx]
++		/* Compare the name.  */
++		&& memcmp (name, &extra[idx + 1], name_len) == 0)
++	      /* Yep, this is the entry.  */
++	      return elem;
++	  }
++      return -1;
+     }
+ 
+   /* Local function for parse_bracket_exp used in _LIBC environment.
+@@ -2884,9 +2870,8 @@ parse_bracket_exp (re_string_t *regexp,
+      Return the value if succeeded, UINT_MAX otherwise.  */
+ 
+   auto inline unsigned int
+-  __attribute ((always_inline))
+-  lookup_collation_sequence_value (br_elem)
+-	 bracket_elem_t *br_elem;
++  __attribute__ ((always_inline))
++  lookup_collation_sequence_value (bracket_elem_t *br_elem)
+     {
+       if (br_elem->type == SB_CHAR)
+ 	{
+@@ -2914,7 +2899,7 @@ parse_bracket_exp (re_string_t *regexp,
+ 	      int32_t elem, idx;
+ 	      elem = seek_collating_symbol_entry (br_elem->opr.name,
+ 						  sym_name_len);
+-	      if (symb_table[2 * elem] != 0)
++	      if (elem != -1)
+ 		{
+ 		  /* We found the entry.  */
+ 		  idx = symb_table[2 * elem + 1];
+@@ -2932,7 +2917,7 @@ parse_bracket_exp (re_string_t *regexp,
+ 		  /* Return the collation sequence value.  */
+ 		  return *(unsigned int *) (extra + idx);
+ 		}
+-	      else if (symb_table[2 * elem] == 0 && sym_name_len == 1)
++	      else if (sym_name_len == 1)
+ 		{
+ 		  /* No valid character.  Match it as a single byte
+ 		     character.  */
+@@ -2953,12 +2938,9 @@ parse_bracket_exp (re_string_t *regexp,
+      update it.  */
+ 
+   auto inline reg_errcode_t
+-  __attribute ((always_inline))
+-  build_range_exp (sbcset, mbcset, range_alloc, start_elem, end_elem)
+-	 re_charset_t *mbcset;
+-	 Idx *range_alloc;
+-	 bitset_t sbcset;
+-	 bracket_elem_t *start_elem, *end_elem;
++  __attribute__ ((always_inline))
++  build_range_exp (bitset_t sbcset, re_charset_t *mbcset, int *range_alloc,
++		   bracket_elem_t *start_elem, bracket_elem_t *end_elem)
+     {
+       unsigned int ch;
+       uint32_t start_collseq;
+@@ -2971,6 +2953,7 @@ parse_bracket_exp (re_string_t *regexp,
+ 	      0))
+ 	return REG_ERANGE;
+ 
++      /* FIXME: Implement rational ranges here, too.  */
+       start_collseq = lookup_collation_sequence_value (start_elem);
+       end_collseq = lookup_collation_sequence_value (end_elem);
+       /* Check start/end collation sequence values.  */
+@@ -3036,26 +3019,23 @@ parse_bracket_exp (re_string_t *regexp,
+      pointer argument since we may update it.  */
+ 
+   auto inline reg_errcode_t
+-  __attribute ((always_inline))
+-  build_collating_symbol (sbcset, mbcset, coll_sym_alloc, name)
+-	 re_charset_t *mbcset;
+-	 Idx *coll_sym_alloc;
+-	 bitset_t sbcset;
+-	 const unsigned char *name;
++  __attribute__ ((always_inline))
++  build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset,
++			  Idx *coll_sym_alloc, const unsigned char *name)
+     {
+       int32_t elem, idx;
+       size_t name_len = strlen ((const char *) name);
+       if (nrules != 0)
+ 	{
+ 	  elem = seek_collating_symbol_entry (name, name_len);
+-	  if (symb_table[2 * elem] != 0)
++	  if (elem != -1)
+ 	    {
+ 	      /* We found the entry.  */
+ 	      idx = symb_table[2 * elem + 1];
+ 	      /* Skip the name of collating element name.  */
+ 	      idx += 1 + extra[idx];
+ 	    }
+-	  else if (symb_table[2 * elem] == 0 && name_len == 1)
++	  else if (name_len == 1)
+ 	    {
+ 	      /* No valid character, treat it as a normal
+ 		 character.  */
+@@ -3298,7 +3278,8 @@ parse_bracket_exp (re_string_t *regexp,
+ #ifdef RE_ENABLE_I18N
+ 				      mbcset, &char_class_alloc,
+ #endif /* RE_ENABLE_I18N */
+-				      start_elem.opr.name, syntax);
++				      (const char *) start_elem.opr.name,
++				      syntax);
+ 	      if (BE (*err != REG_NOERROR, 0))
+ 	       goto parse_bracket_exp_free_return;
+ 	      break;
+@@ -3578,14 +3559,14 @@ static reg_errcode_t
+ #ifdef RE_ENABLE_I18N
+ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
+ 		 re_charset_t *mbcset, Idx *char_class_alloc,
+-		 const unsigned char *class_name, reg_syntax_t syntax)
++		 const char *class_name, reg_syntax_t syntax)
+ #else /* not RE_ENABLE_I18N */
+ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
+-		 const unsigned char *class_name, reg_syntax_t syntax)
++		 const char *class_name, reg_syntax_t syntax)
+ #endif /* not RE_ENABLE_I18N */
+ {
+   int i;
+-  const char *name = (const char *) class_name;
++  const char *name = class_name;
+ 
+   /* In case of REG_ICASE "upper" and "lower" match the both of
+      upper and lower cases.  */
+@@ -3659,8 +3640,8 @@ build_charclass (RE_TRANSLATE_TYPE trans
+ 
+ static bin_tree_t *
+ build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans,
+-		    const unsigned char *class_name,
+-		    const unsigned char *extra, bool non_match,
++		    const char *class_name,
++		    const char *extra, bool non_match,
+ 		    reg_errcode_t *err)
+ {
+   re_bitset_ptr_t sbcset;
+--- origsrc/sed-4.2.2/lib/regex-quote.c	1970-01-01 01:00:00.000000000 +0100
++++ src/sed-4.2.2/lib/regex-quote.c	2013-06-27 18:05:27.081447884 +0200
+@@ -0,0 +1,216 @@
++/* Construct a regular expression from a literal string.
++   Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc.
++   Written by Bruno Haible <haible@clisp.cons.org>, 2010.
++
++   This program is free software: you can redistribute it and/or modify
++   it under the terms of the GNU General Public License as published by
++   the Free Software Foundation; either version 3 of the License, or
++   (at your option) any later version.
++
++   This program is distributed in the hope that it will be useful,
++   but WITHOUT ANY WARRANTY; without even the implied warranty of
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
++   GNU General Public License for more details.
++
++   You should have received a copy of the GNU General Public License
++   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
++
++#include <config.h>
++
++/* Specification.  */
++#include "regex-quote.h"
++
++#include <string.h>
++
++#include "mbuiter.h"
++#include "xalloc.h"
++
++/* Characters that are special in a BRE.  */
++static const char bre_special[] = "$^.*[]\\";
++
++/* Characters that are special in an ERE.  */
++static const char ere_special[] = "$^.*[]\\+?{}()|";
++
++struct regex_quote_spec
++regex_quote_spec_posix (int cflags, bool anchored)
++{
++  struct regex_quote_spec result;
++
++  strcpy (result.special, cflags != 0 ? ere_special : bre_special);
++  result.multibyte = true;
++  result.anchored = anchored;
++
++  return result;
++}
++
++/* Syntax bit values, defined in GNU <regex.h>.  We don't include it here,
++   otherwise this module would need to depend on gnulib module 'regex'.  */
++#define RE_BK_PLUS_QM    0x00000002
++#define RE_INTERVALS     0x00000200
++#define RE_LIMITED_OPS   0x00000400
++#define RE_NEWLINE_ALT   0x00000800
++#define RE_NO_BK_BRACES  0x00001000
++#define RE_NO_BK_PARENS  0x00002000
++#define RE_NO_BK_VBAR    0x00008000
++
++struct regex_quote_spec
++regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored)
++{
++  struct regex_quote_spec result;
++  char *p;
++
++  p = result.special;
++  memcpy (p, bre_special, sizeof (bre_special) - 1);
++  p += sizeof (bre_special) - 1;
++  if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_BK_PLUS_QM) == 0)
++    {
++      *p++ = '+';
++      *p++ = '?';
++    }
++  if ((syntax & RE_INTERVALS) != 0 && (syntax & RE_NO_BK_BRACES) != 0)
++    {
++      *p++ = '{';
++      *p++ = '}';
++    }
++  if ((syntax & RE_NO_BK_PARENS) != 0)
++    {
++      *p++ = '(';
++      *p++ = ')';
++    }
++  if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_NO_BK_VBAR) != 0)
++    *p++ = '|';
++  if ((syntax & RE_NEWLINE_ALT) != 0)
++    *p++ = '\n';
++  *p = '\0';
++
++  result.multibyte = true;
++  result.anchored = anchored;
++
++  return result;
++}
++
++/* Characters that are special in a PCRE.  */
++static const char pcre_special[] = "$^.*[]\\+?{}()|";
++
++/* Options bit values, defined in <pcre.h>.  We don't include it here, because
++   it is not a standard header.  */
++#define PCRE_ANCHORED 0x00000010
++#define PCRE_EXTENDED 0x00000008
++
++struct regex_quote_spec
++regex_quote_spec_pcre (int options, bool anchored)
++{
++  struct regex_quote_spec result;
++  char *p;
++
++  p = result.special;
++  memcpy (p, bre_special, sizeof (pcre_special) - 1);
++  p += sizeof (pcre_special) - 1;
++  if (options & PCRE_EXTENDED)
++    {
++      *p++ = ' ';
++      *p++ = '\t';
++      *p++ = '\n';
++      *p++ = '\v';
++      *p++ = '\f';
++      *p++ = '\r';
++      *p++ = '#';
++    }
++  *p = '\0';
++
++  /* PCRE regular expressions consist of UTF-8 characters of options contains
++     PCRE_UTF8 and of single bytes otherwise.  */
++  result.multibyte = false;
++  /* If options contains PCRE_ANCHORED, the anchoring is implicit.  */
++  result.anchored = (options & PCRE_ANCHORED ? 0 : anchored);
++
++  return result;
++}
++
++size_t
++regex_quote_length (const char *string, const struct regex_quote_spec *spec)
++{
++  const char *special = spec->special;
++  size_t length;
++
++  length = 0;
++  if (spec->anchored)
++    length += 2; /* for '^' at the beginning and '$' at the end */
++  if (spec->multibyte)
++    {
++      mbui_iterator_t iter;
++
++      for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter))
++        {
++          /* We know that special contains only ASCII characters.  */
++          if (mb_len (mbui_cur (iter)) == 1
++              && strchr (special, * mbui_cur_ptr (iter)))
++            length += 1;
++          length += mb_len (mbui_cur (iter));
++        }
++    }
++  else
++    {
++      const char *iter;
++
++      for (iter = string; *iter != '\0'; iter++)
++        {
++          if (strchr (special, *iter))
++            length += 1;
++          length += 1;
++        }
++    }
++
++  return length;
++}
++
++char *
++regex_quote_copy (char *p, const char *string, const struct regex_quote_spec *spec)
++{
++  const char *special = spec->special;
++
++  if (spec->anchored)
++    *p++ = '^';
++  if (spec->multibyte)
++    {
++      mbui_iterator_t iter;
++
++      for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter))
++        {
++          /* We know that special contains only ASCII characters.  */
++          if (mb_len (mbui_cur (iter)) == 1
++              && strchr (special, * mbui_cur_ptr (iter)))
++            *p++ = '\\';
++          memcpy (p, mbui_cur_ptr (iter), mb_len (mbui_cur (iter)));
++          p += mb_len (mbui_cur (iter));
++        }
++    }
++  else
++    {
++      const char *iter;
++
++      for (iter = string; *iter != '\0'; iter++)
++        {
++          if (strchr (special, *iter))
++            *p++ = '\\';
++          *p++ = *iter++;
++        }
++    }
++  if (spec->anchored)
++    *p++ = '$';
++
++  return p;
++}
++
++char *
++regex_quote (const char *string, const struct regex_quote_spec *spec)
++{
++  size_t length = regex_quote_length (string, spec);
++  char *result = XNMALLOC (length + 1, char);
++  char *p;
++
++  p = result;
++  p = regex_quote_copy (p, string, spec);
++  *p = '\0';
++  return result;
++}
+--- origsrc/sed-4.2.2/lib/regex-quote.h	1970-01-01 01:00:00.000000000 +0100
++++ src/sed-4.2.2/lib/regex-quote.h	2013-06-27 18:05:27.112447751 +0200
+@@ -0,0 +1,88 @@
++/* Construct a regular expression from a literal string.
++   Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc.
++   Written by Bruno Haible <haible@clisp.cons.org>, 2010.
++
++   This program is free software: you can redistribute it and/or modify
++   it under the terms of the GNU General Public License as published by
++   the Free Software Foundation; either version 3 of the License, or
++   (at your option) any later version.
++
++   This program is distributed in the hope that it will be useful,
++   but WITHOUT ANY WARRANTY; without even the implied warranty of
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
++   GNU General Public License for more details.
++
++   You should have received a copy of the GNU General Public License
++   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
++
++#ifndef _REGEX_QUOTE_H
++#define _REGEX_QUOTE_H
++
++#include <stddef.h>
++#include <stdbool.h>
++
++
++/* Specifies a quotation task for converting a fixed string to a regular
++   expression pattern.  */
++struct regex_quote_spec
++{
++  /* True if the regular expression pattern consists of multibyte characters
++     (in the encoding given by the LC_CTYPE category of the locale),
++     false if it consists of single bytes or UTF-8 characters.  */
++  unsigned int /*bool*/ multibyte : 1;
++  /* True if the regular expression pattern shall match only entire lines.  */
++  unsigned int /*bool*/ anchored : 1;
++  /* Set of characters that need to be escaped (all ASCII), as a
++     NUL-terminated string.  */
++  char special[30 + 1];
++};
++
++
++/* Creates a quotation task that produces a POSIX regular expression, that is,
++   a pattern that can be compiled with regcomp().
++   CFLAGS can be 0 or REG_EXTENDED.
++   If it is 0, the result is a Basic Regular Expression (BRE)
++   <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_03>.
++   If it is REG_EXTENDED, the result is an Extended Regular Expression (ERE)
++   <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_04>.
++   If ANCHORED is false, the regular expression will match substrings of lines.
++   If ANCHORED is true, it will match only complete lines,  */
++extern struct regex_quote_spec
++       regex_quote_spec_posix (int cflags, bool anchored);
++
++/* Creates a quotation task that produces a regular expression that can be
++   compiled with the GNU API function re_compile_pattern().
++   SYNTAX describes the syntax of the regular expression (such as
++   RE_SYNTAX_POSIX_BASIC, RE_SYNTAX_POSIX_EXTENDED, RE_SYNTAX_EMACS, all
++   defined in <regex.h>).  It must be the same value as 're_syntax_options'
++   at the moment of the re_compile_pattern() call.
++   If ANCHORED is false, the regular expression will match substrings of lines.
++   If ANCHORED is true, it will match only complete lines,  */
++extern struct regex_quote_spec
++       regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored);
++
++/* Creates a quotation task that produces a PCRE regular expression, that is,
++   a pattern that can be compiled with pcre_compile().
++   OPTIONS is the same value as the second argument passed to pcre_compile().
++   If ANCHORED is false, the regular expression will match substrings of lines.
++   If ANCHORED is true, it will match only complete lines,  */
++extern struct regex_quote_spec
++       regex_quote_spec_pcre (int options, bool anchored);
++
++
++/* Returns the number of bytes needed for the quoted string.  */
++extern size_t
++       regex_quote_length (const char *string, const struct regex_quote_spec *spec);
++
++/* Copies the quoted string to p and returns the incremented p.
++   There must be room for regex_quote_length (string, spec) + 1 bytes at p.  */
++extern char *
++       regex_quote_copy (char *p,
++                         const char *string, const struct regex_quote_spec *spec);
++
++/* Returns the freshly allocated quoted string.  */
++extern char *
++       regex_quote (const char *string, const struct regex_quote_spec *spec);
++
++
++#endif /* _REGEX_QUOTE_H */
+--- origsrc/sed-4.2.2/lib/regex.c	2012-12-22 14:21:52.000000000 +0100
++++ src/sed-4.2.2/lib/regex.c	2013-06-27 18:05:27.138447639 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2003, 2005-2006, 2009-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ #ifndef _LIBC
+ # include <config.h>
+@@ -25,6 +24,7 @@
+ #  pragma GCC diagnostic ignored "-Wsuggest-attribute=pure"
+ # endif
+ # if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
++#  pragma GCC diagnostic ignored "-Wold-style-definition"
+ #  pragma GCC diagnostic ignored "-Wtype-limits"
+ # endif
+ #endif
+--- origsrc/sed-4.2.2/lib/regex.h	2012-12-22 14:21:52.000000000 +0100
++++ src/sed-4.2.2/lib/regex.h	2013-06-27 18:05:27.168447509 +0200
+@@ -1,23 +1,22 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Definitions for data structures and routines for the regular
+    expression library.
+-   Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2012
+-   Free Software Foundation, Inc.
++   Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2013 Free Software
++   Foundation, Inc.
+    This file is part of the GNU C Library.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ #ifndef _REGEX_H
+ #define _REGEX_H 1
+--- origsrc/sed-4.2.2/lib/regex_internal.c	2012-12-22 14:21:52.000000000 +0100
++++ src/sed-4.2.2/lib/regex_internal.c	2013-06-27 18:05:27.199447375 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ static void re_string_construct_common (const char *str, Idx len,
+ 					re_string_t *pstr,
+@@ -835,7 +834,7 @@ re_string_reconstruct (re_string_t *pstr
+ }
+ 
+ static unsigned char
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure))
+ re_string_peek_byte_case (const re_string_t *pstr, Idx idx)
+ {
+   int ch;
+@@ -975,7 +974,7 @@ re_node_set_alloc (re_node_set *set, Idx
+   set->alloc = size;
+   set->nelem = 0;
+   set->elems = re_malloc (Idx, size);
+-  if (BE (set->elems == NULL, 0))
++  if (BE (set->elems == NULL, 0) && (MALLOC_0_IS_NONNULL || size != 0))
+     return REG_ESPACE;
+   return REG_NOERROR;
+ }
+@@ -1355,7 +1354,7 @@ re_node_set_insert_last (re_node_set *se
+    Return true if SET1 and SET2 are equivalent.  */
+ 
+ static bool
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure))
+ re_node_set_compare (const re_node_set *set1, const re_node_set *set2)
+ {
+   Idx i;
+@@ -1370,7 +1369,7 @@ re_node_set_compare (const re_node_set *
+ /* Return (idx + 1) if SET contains the element ELEM, return 0 otherwise.  */
+ 
+ static Idx
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure))
+ re_node_set_contains (const re_node_set *set, Idx elem)
+ {
+   __re_size_t idx, right, mid;
+@@ -1444,11 +1443,9 @@ re_dfa_add_node (re_dfa_t *dfa, re_token
+   dfa->nodes[dfa->nodes_len] = token;
+   dfa->nodes[dfa->nodes_len].constraint = 0;
+ #ifdef RE_ENABLE_I18N
+-  {
+-  int type = token.type;
+   dfa->nodes[dfa->nodes_len].accept_mb =
+-    (type == OP_PERIOD && dfa->mb_cur_max > 1) || type == COMPLEX_BRACKET;
+-  }
++    ((token.type == OP_PERIOD && dfa->mb_cur_max > 1)
++     || token.type == COMPLEX_BRACKET);
+ #endif
+   dfa->nexts[dfa->nodes_len] = REG_MISSING;
+   re_node_set_init_empty (dfa->edests + dfa->nodes_len);
+--- origsrc/sed-4.2.2/lib/regex_internal.h	2012-12-22 14:21:52.000000000 +0100
++++ src/sed-4.2.2/lib/regex_internal.h	2013-06-27 18:05:27.230447242 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ #ifndef _REGEX_INTERNAL_H
+ #define _REGEX_INTERNAL_H 1
+@@ -28,21 +27,54 @@
+ #include <string.h>
+ 
+ #include <langinfo.h>
+-#ifndef _LIBC
+-# include "localcharset.h"
+-#endif
+ #include <locale.h>
+ #include <wchar.h>
+ #include <wctype.h>
+ #include <stdbool.h>
+ #include <stdint.h>
+-#if defined _LIBC
++
++#ifdef _LIBC
+ # include <bits/libc-lock.h>
++# define lock_define(name) __libc_lock_define (, name)
++# define lock_init(lock) (__libc_lock_init (lock), 0)
++# define lock_fini(lock) 0
++# define lock_lock(lock) __libc_lock_lock (lock)
++# define lock_unlock(lock) __libc_lock_unlock (lock)
++#elif defined GNULIB_LOCK
++# include "glthread/lock.h"
++  /* Use gl_lock_define if empty macro arguments are known to work.
++     Otherwise, fall back on less-portable substitutes.  */
++# if ((defined __GNUC__ && !defined __STRICT_ANSI__) \
++      || (defined __STDC_VERSION__ && 199901L <= __STDC_VERSION__))
++#  define lock_define(name) gl_lock_define (, name)
++# elif USE_POSIX_THREADS
++#  define lock_define(name) pthread_mutex_t name;
++# elif USE_PTH_THREADS
++#  define lock_define(name) pth_mutex_t name;
++# elif USE_SOLARIS_THREADS
++#  define lock_define(name) mutex_t name;
++# elif USE_WINDOWS_THREADS
++#  define lock_define(name) gl_lock_t name;
++# else
++#  define lock_define(name)
++# endif
++# define lock_init(lock) glthread_lock_init (&(lock))
++# define lock_fini(lock) glthread_lock_destroy (&(lock))
++# define lock_lock(lock) glthread_lock_lock (&(lock))
++# define lock_unlock(lock) glthread_lock_unlock (&(lock))
++#elif defined GNULIB_PTHREAD
++# include <pthread.h>
++# define lock_define(name) pthread_mutex_t name;
++# define lock_init(lock) pthread_mutex_init (&(lock), 0)
++# define lock_fini(lock) pthread_mutex_destroy (&(lock))
++# define lock_lock(lock) pthread_mutex_lock (&(lock))
++# define lock_unlock(lock) pthread_mutex_unlock (&(lock))
+ #else
+-# define __libc_lock_define(CLASS,NAME)
+-# define __libc_lock_init(NAME) do { } while (0)
+-# define __libc_lock_lock(NAME) do { } while (0)
+-# define __libc_lock_unlock(NAME) do { } while (0)
++# define lock_define(name)
++# define lock_init(lock) 0
++# define lock_fini(lock) 0
++# define lock_lock(lock) ((void) 0)
++# define lock_unlock(lock) ((void) 0)
+ #endif
+ 
+ /* In case that the system doesn't have isblank().  */
+@@ -65,7 +97,7 @@
+ # ifdef _LIBC
+ #  undef gettext
+ #  define gettext(msgid) \
+-  INTUSE(__dcgettext) (_libc_intl_domainname, msgid, LC_MESSAGES)
++  __dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES)
+ # endif
+ #else
+ # define gettext(msgid) (msgid)
+@@ -101,6 +133,8 @@
+ 
+ /* Rename to standard API for using out of glibc.  */
+ #ifndef _LIBC
++# undef __wctype
++# undef __iswctype
+ # define __wctype wctype
+ # define __iswctype iswctype
+ # define __btowc btowc
+@@ -110,10 +144,8 @@
+ # define attribute_hidden
+ #endif /* not _LIBC */
+ 
+-#if __GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 1)
+-# define __attribute(arg) __attribute__ (arg)
+-#else
+-# define __attribute(arg)
++#if __GNUC__ < 3 + (__GNUC_MINOR__ < 1)
++# define __attribute__(arg)
+ #endif
+ 
+ typedef __re_idx_t Idx;
+@@ -429,7 +461,7 @@ static void build_upper_buffer (re_strin
+ static void re_string_translate_buffer (re_string_t *pstr) internal_function;
+ static unsigned int re_string_context_at (const re_string_t *input, Idx idx,
+ 					  int eflags)
+-     internal_function __attribute ((pure));
++     internal_function __attribute__ ((pure));
+ #endif
+ #define re_string_peek_byte(pstr, offset) \
+   ((pstr)->mbs[(pstr)->cur_idx + offset])
+@@ -448,7 +480,9 @@ static unsigned int re_string_context_at
+ #define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx))
+ #define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx))
+ 
+-#include <alloca.h>
++#if defined _LIBC || HAVE_ALLOCA
++# include <alloca.h>
++#endif
+ 
+ #ifndef _LIBC
+ # if HAVE_ALLOCA
+@@ -465,6 +499,12 @@ static unsigned int re_string_context_at
+ # endif
+ #endif
+ 
++#ifdef _LIBC
++# define MALLOC_0_IS_NONNULL 1
++#elif !defined MALLOC_0_IS_NONNULL
++# define MALLOC_0_IS_NONNULL 0
++#endif
++
+ #ifndef MAX
+ # define MAX(a,b) ((a) < (b) ? (b) : (a))
+ #endif
+@@ -695,7 +735,7 @@ struct re_dfa_t
+ #ifdef DEBUG
+   char* re_str;
+ #endif
+-  __libc_lock_define (, lock)
++  lock_define (lock)
+ };
+ 
+ #define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set))
+@@ -767,7 +807,7 @@ bitset_copy (bitset_t dest, const bitset
+   memcpy (dest, src, sizeof (bitset_t));
+ }
+ 
+-static void
++static void __attribute__ ((unused))
+ bitset_not (bitset_t set)
+ {
+   int bitset_i;
+@@ -779,7 +819,7 @@ bitset_not (bitset_t set)
+        & ~set[BITSET_WORDS - 1]);
+ }
+ 
+-static void
++static void __attribute__ ((unused))
+ bitset_merge (bitset_t dest, const bitset_t src)
+ {
+   int bitset_i;
+@@ -787,7 +827,7 @@ bitset_merge (bitset_t dest, const bitse
+     dest[bitset_i] |= src[bitset_i];
+ }
+ 
+-static void
++static void __attribute__ ((unused))
+ bitset_mask (bitset_t dest, const bitset_t src)
+ {
+   int bitset_i;
+@@ -798,7 +838,7 @@ bitset_mask (bitset_t dest, const bitset
+ #ifdef RE_ENABLE_I18N
+ /* Functions for re_string.  */
+ static int
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure, unused))
+ re_string_char_size_at (const re_string_t *pstr, Idx idx)
+ {
+   int byte_idx;
+@@ -811,7 +851,7 @@ re_string_char_size_at (const re_string_
+ }
+ 
+ static wint_t
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure, unused))
+ re_string_wchar_at (const re_string_t *pstr, Idx idx)
+ {
+   if (pstr->mb_cur_max == 1)
+@@ -821,7 +861,7 @@ re_string_wchar_at (const re_string_t *p
+ 
+ # ifndef NOT_IN_libc
+ static int
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure, unused))
+ re_string_elem_size_at (const re_string_t *pstr, Idx idx)
+ {
+ #  ifdef _LIBC
+--- origsrc/sed-4.2.2/lib/regexec.c	2012-12-22 14:21:52.000000000 +0100
++++ src/sed-4.2.2/lib/regexec.c	2013-06-27 18:05:27.268447078 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ static reg_errcode_t match_ctx_init (re_match_context_t *cache, int eflags,
+ 				     Idx n) internal_function;
+@@ -200,7 +199,7 @@ static Idx group_nodes_into_DFAstates (c
+ static bool check_node_accept (const re_match_context_t *mctx,
+ 			       const re_token_t *node, Idx idx)
+      internal_function;
+-static reg_errcode_t extend_buffers (re_match_context_t *mctx)
++static reg_errcode_t extend_buffers (re_match_context_t *mctx, int min_len)
+      internal_function;
+ 
+ /* Entry point for POSIX code.  */
+@@ -229,9 +228,7 @@ regexec (preg, string, nmatch, pmatch, e
+ {
+   reg_errcode_t err;
+   Idx start, length;
+-#ifdef _LIBC
+   re_dfa_t *dfa = preg->buffer;
+-#endif
+ 
+   if (eflags & ~(REG_NOTBOL | REG_NOTEOL | REG_STARTEND))
+     return REG_BADPAT;
+@@ -247,14 +244,14 @@ regexec (preg, string, nmatch, pmatch, e
+       length = strlen (string);
+     }
+ 
+-  __libc_lock_lock (dfa->lock);
++  lock_lock (dfa->lock);
+   if (preg->no_sub)
+     err = re_search_internal (preg, string, length, start, length,
+ 			      length, 0, NULL, eflags);
+   else
+     err = re_search_internal (preg, string, length, start, length,
+ 			      length, nmatch, pmatch, eflags);
+-  __libc_lock_unlock (dfa->lock);
++  lock_unlock (dfa->lock);
+   return err != REG_NOERROR;
+ }
+ 
+@@ -422,9 +419,7 @@ re_search_stub (struct re_pattern_buffer
+   Idx nregs;
+   regoff_t rval;
+   int eflags = 0;
+-#ifdef _LIBC
+   re_dfa_t *dfa = bufp->buffer;
+-#endif
+   Idx last_start = start + range;
+ 
+   /* Check for out-of-range.  */
+@@ -435,7 +430,7 @@ re_search_stub (struct re_pattern_buffer
+   else if (BE (last_start < 0 || (range < 0 && start <= last_start), 0))
+     last_start = 0;
+ 
+-  __libc_lock_lock (dfa->lock);
++  lock_lock (dfa->lock);
+ 
+   eflags |= (bufp->not_bol) ? REG_NOTBOL : 0;
+   eflags |= (bufp->not_eol) ? REG_NOTEOL : 0;
+@@ -499,7 +494,7 @@ re_search_stub (struct re_pattern_buffer
+     }
+   re_free (pmatch);
+  out:
+-  __libc_lock_unlock (dfa->lock);
++  lock_unlock (dfa->lock);
+   return rval;
+ }
+ 
+@@ -1065,7 +1060,7 @@ prune_impossible_nodes (re_match_context
+    since initial states may have constraints like "\<", "^", etc..  */
+ 
+ static inline re_dfastate_t *
+-__attribute ((always_inline)) internal_function
++__attribute__ ((always_inline)) internal_function
+ acquire_init_state_context (reg_errcode_t *err, const re_match_context_t *mctx,
+ 			    Idx idx)
+ {
+@@ -1177,7 +1172,7 @@ check_matching (re_match_context_t *mctx
+ 	  || (BE (next_char_idx >= mctx->input.valid_len, 0)
+ 	      && mctx->input.valid_len < mctx->input.len))
+ 	{
+-	  err = extend_buffers (mctx);
++	  err = extend_buffers (mctx, next_char_idx + 1);
+ 	  if (BE (err != REG_NOERROR, 0))
+ 	    {
+ 	      assert (err == REG_ESPACE);
+@@ -1757,7 +1752,7 @@ clean_state_log_if_needed (re_match_cont
+ 	  && mctx->input.valid_len < mctx->input.len))
+     {
+       reg_errcode_t err;
+-      err = extend_buffers (mctx);
++      err = extend_buffers (mctx, next_state_log_idx + 1);
+       if (BE (err != REG_NOERROR, 0))
+ 	return err;
+     }
+@@ -2814,7 +2809,7 @@ get_subexp (re_match_context_t *mctx, Id
+ 		  if (bkref_str_off >= mctx->input.len)
+ 		    break;
+ 
+-		  err = extend_buffers (mctx);
++		  err = extend_buffers (mctx, bkref_str_off + 1);
+ 		  if (BE (err != REG_NOERROR, 0))
+ 		    return err;
+ 
+@@ -3937,6 +3932,7 @@ check_node_accept_bytes (const re_dfa_t
+ 		in_collseq = find_collation_sequence_value (pin, elem_len);
+ 	    }
+ 	  /* match with range expression?  */
++	  /* FIXME: Implement rational ranges here, too.  */
+ 	  for (i = 0; i < cset->nranges; ++i)
+ 	    if (cset->range_starts[i] <= in_collseq
+ 		&& in_collseq <= cset->range_ends[i])
+@@ -3988,18 +3984,9 @@ check_node_accept_bytes (const re_dfa_t
+ # endif /* _LIBC */
+ 	{
+ 	  /* match with range expression?  */
+-#if __GNUC__ >= 2 && ! (__STDC_VERSION__ < 199901L && defined __STRICT_ANSI__)
+-	  wchar_t cmp_buf[] = {L'\0', L'\0', wc, L'\0', L'\0', L'\0'};
+-#else
+-	  wchar_t cmp_buf[] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
+-	  cmp_buf[2] = wc;
+-#endif
+ 	  for (i = 0; i < cset->nranges; ++i)
+ 	    {
+-	      cmp_buf[0] = cset->range_starts[i];
+-	      cmp_buf[4] = cset->range_ends[i];
+-	      if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
+-		  && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
++	      if (cset->range_starts[i] <= wc && wc <= cset->range_ends[i])
+ 		{
+ 		  match_len = char_len;
+ 		  goto check_node_accept_bytes_match;
+@@ -4137,7 +4124,7 @@ check_node_accept (const re_match_contex
+ 
+ static reg_errcode_t
+ internal_function __attribute_warn_unused_result__
+-extend_buffers (re_match_context_t *mctx)
++extend_buffers (re_match_context_t *mctx, int min_len)
+ {
+   reg_errcode_t ret;
+   re_string_t *pstr = &mctx->input;
+@@ -4147,8 +4134,10 @@ extend_buffers (re_match_context_t *mctx
+           <= pstr->bufs_len, 0))
+     return REG_ESPACE;
+ 
+-  /* Double the lengths of the buffers.  */
+-  ret = re_string_realloc_buffers (pstr, MIN (pstr->len, pstr->bufs_len * 2));
++  /* Double the lengths of the buffers, but allocate at least MIN_LEN.  */
++  ret = re_string_realloc_buffers (pstr,
++				   MAX (min_len,
++					MIN (pstr->len, pstr->bufs_len * 2)));
+   if (BE (ret != REG_NOERROR, 0))
+     return ret;
+ 
+--- origsrc/sed-4.2.2/sed/sed.c	2012-03-16 10:13:31.000000000 +0100
++++ src/sed-4.2.2/sed/sed.c	2013-06-27 18:06:25.592195456 +0200
+@@ -57,7 +57,11 @@ bool follow_symlinks = false;
+ char *in_place_extension = NULL;
+ 
+ /* The mode to use to read/write files, either "r"/"w" or "rb"/"wb".  */
++#ifdef HAVE_FOPEN_RT
++char *read_mode = "rt";
++#else
+ char *read_mode = "r";
++#endif
+ char *write_mode = "w";
+ 
+ /* Do we need to be pedantically POSIX compliant? */
diff --git a/dev/build/windows/patches_coq/sed-4.2.2.patch b/dev/build/windows/patches_coq/sed-4.2.2.patch
new file mode 100755
index 00000000..c7ccd53c
--- /dev/null
+++ b/dev/build/windows/patches_coq/sed-4.2.2.patch
@@ -0,0 +1,1301 @@
+--- origsrc/doc/sed.1	2012-12-22 15:27:13.000000000 +0100
++++ src/doc/sed.1	2013-06-27 18:10:47.974060492 +0200
+@@ -1,5 +1,5 @@
+ .\" DO NOT MODIFY THIS FILE!  It was generated by help2man 1.28.
+-.TH SED "1" "December 2012" "sed 4.2.2" "User Commands"
++.TH SED "1" "June 2013" "sed 4.2.2" "User Commands"
+ .SH NAME
+ sed \- stream editor for filtering and transforming text
+ .SH SYNOPSIS
+@@ -40,6 +40,10 @@ follow symlinks when processing in place
+ .IP
+ edit files in place (makes backup if SUFFIX supplied)
+ .HP
++\fB\-b\fR, \fB\-\-binary\fR
++.IP
++open files in binary mode (CR+LFs are not processed specially)
++.HP
+ \fB\-l\fR N, \fB\-\-line\-length\fR=\fIN\fR
+ .IP
+ specify the desired line-wrap length for the `l' command
+--- origsrc/lib/regcomp.c	2012-12-22 14:21:52.000000000 +0100
++++ src/lib/regcomp.c	2013-06-27 18:05:27.044448044 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ static reg_errcode_t re_compile_internal (regex_t *preg, const char * pattern,
+ 					  size_t length, reg_syntax_t syntax);
+@@ -95,20 +94,20 @@ static reg_errcode_t build_charclass (RE
+ 				      bitset_t sbcset,
+ 				      re_charset_t *mbcset,
+ 				      Idx *char_class_alloc,
+-				      const unsigned char *class_name,
++				      const char *class_name,
+ 				      reg_syntax_t syntax);
+ #else  /* not RE_ENABLE_I18N */
+ static reg_errcode_t build_equiv_class (bitset_t sbcset,
+ 					const unsigned char *name);
+ static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans,
+ 				      bitset_t sbcset,
+-				      const unsigned char *class_name,
++				      const char *class_name,
+ 				      reg_syntax_t syntax);
+ #endif /* not RE_ENABLE_I18N */
+ static bin_tree_t *build_charclass_op (re_dfa_t *dfa,
+ 				       RE_TRANSLATE_TYPE trans,
+-				       const unsigned char *class_name,
+-				       const unsigned char *extra,
++				       const char *class_name,
++				       const char *extra,
+ 				       bool non_match, reg_errcode_t *err);
+ static bin_tree_t *create_tree (re_dfa_t *dfa,
+ 				bin_tree_t *left, bin_tree_t *right,
+@@ -293,7 +292,7 @@ weak_alias (__re_compile_fastmap, re_com
+ #endif
+ 
+ static inline void
+-__attribute ((always_inline))
++__attribute__ ((always_inline))
+ re_set_fastmap (char *fastmap, bool icase, int ch)
+ {
+   fastmap[ch] = 1;
+@@ -587,7 +586,7 @@ weak_alias (__regerror, regerror)
+ static const bitset_t utf8_sb_map =
+ {
+   /* Set the first 128 bits.  */
+-# ifdef __GNUC__
++# if defined __GNUC__ && !defined __STRICT_ANSI__
+   [0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX
+ # else
+ #  if 4 * BITSET_WORD_BITS < ASCII_CHARS
+@@ -664,7 +663,10 @@ regfree (preg)
+ {
+   re_dfa_t *dfa = preg->buffer;
+   if (BE (dfa != NULL, 1))
+-    free_dfa_content (dfa);
++    {
++      lock_fini (dfa->lock);
++      free_dfa_content (dfa);
++    }
+   preg->buffer = NULL;
+   preg->allocated = 0;
+ 
+@@ -785,6 +787,8 @@ re_compile_internal (regex_t *preg, cons
+   preg->used = sizeof (re_dfa_t);
+ 
+   err = init_dfa (dfa, length);
++  if (BE (err == REG_NOERROR && lock_init (dfa->lock) != 0, 0))
++    err = REG_ESPACE;
+   if (BE (err != REG_NOERROR, 0))
+     {
+       free_dfa_content (dfa);
+@@ -798,8 +802,6 @@ re_compile_internal (regex_t *preg, cons
+   strncpy (dfa->re_str, pattern, length + 1);
+ #endif
+ 
+-  __libc_lock_init (dfa->lock);
+-
+   err = re_string_construct (&regexp, pattern, length, preg->translate,
+ 			     (syntax & RE_ICASE) != 0, dfa);
+   if (BE (err != REG_NOERROR, 0))
+@@ -807,6 +809,7 @@ re_compile_internal (regex_t *preg, cons
+     re_compile_internal_free_return:
+       free_workarea_compile (preg);
+       re_string_destruct (&regexp);
++      lock_fini (dfa->lock);
+       free_dfa_content (dfa);
+       preg->buffer = NULL;
+       preg->allocated = 0;
+@@ -839,6 +842,7 @@ re_compile_internal (regex_t *preg, cons
+ 
+   if (BE (err != REG_NOERROR, 0))
+     {
++      lock_fini (dfa->lock);
+       free_dfa_content (dfa);
+       preg->buffer = NULL;
+       preg->allocated = 0;
+@@ -954,10 +958,10 @@ static void
+ internal_function
+ init_word_char (re_dfa_t *dfa)
+ {
+-  dfa->word_ops_used = 1;
+   int i = 0;
+   int j;
+   int ch = 0;
++  dfa->word_ops_used = 1;
+   if (BE (dfa->map_notascii == 0, 1))
+     {
+       bitset_word_t bits0 = 0x00000000;
+@@ -2423,8 +2427,8 @@ parse_expression (re_string_t *regexp, r
+     case OP_WORD:
+     case OP_NOTWORD:
+       tree = build_charclass_op (dfa, regexp->trans,
+-				 (const unsigned char *) "alnum",
+-				 (const unsigned char *) "_",
++				 "alnum",
++				 "_",
+ 				 token->type == OP_NOTWORD, err);
+       if (BE (*err != REG_NOERROR && tree == NULL, 0))
+ 	return NULL;
+@@ -2432,8 +2436,8 @@ parse_expression (re_string_t *regexp, r
+     case OP_SPACE:
+     case OP_NOTSPACE:
+       tree = build_charclass_op (dfa, regexp->trans,
+-				 (const unsigned char *) "space",
+-				 (const unsigned char *) "",
++				 "space",
++				 "",
+ 				 token->type == OP_NOTSPACE, err);
+       if (BE (*err != REG_NOERROR && tree == NULL, 0))
+ 	return NULL;
+@@ -2713,7 +2717,6 @@ build_range_exp (const reg_syntax_t synt
+     wchar_t wc;
+     wint_t start_wc;
+     wint_t end_wc;
+-    wchar_t cmp_buf[6] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
+ 
+     start_ch = ((start_elem->type == SB_CHAR) ? start_elem->opr.ch
+ 		: ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0]
+@@ -2727,11 +2730,7 @@ build_range_exp (const reg_syntax_t synt
+ 	      ? __btowc (end_ch) : end_elem->opr.wch);
+     if (start_wc == WEOF || end_wc == WEOF)
+       return REG_ECOLLATE;
+-    cmp_buf[0] = start_wc;
+-    cmp_buf[4] = end_wc;
+-
+-    if (BE ((syntax & RE_NO_EMPTY_RANGES)
+-            && wcscoll (cmp_buf, cmp_buf + 4) > 0, 0))
++    else if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_wc > end_wc, 0))
+       return REG_ERANGE;
+ 
+     /* Got valid collation sequence values, add them as a new entry.
+@@ -2772,9 +2771,7 @@ build_range_exp (const reg_syntax_t synt
+     /* Build the table for single byte characters.  */
+     for (wc = 0; wc < SBC_MAX; ++wc)
+       {
+-	cmp_buf[2] = wc;
+-	if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
+-	    && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
++	if (start_wc <= wc && wc <= end_wc)
+ 	  bitset_set (sbcset, wc);
+       }
+   }
+@@ -2843,40 +2840,29 @@ parse_bracket_exp (re_string_t *regexp,
+ 
+   /* Local function for parse_bracket_exp used in _LIBC environment.
+      Seek the collating symbol entry corresponding to NAME.
+-     Return the index of the symbol in the SYMB_TABLE.  */
++     Return the index of the symbol in the SYMB_TABLE,
++     or -1 if not found.  */
+ 
+   auto inline int32_t
+-  __attribute ((always_inline))
+-  seek_collating_symbol_entry (name, name_len)
+-	 const unsigned char *name;
+-	 size_t name_len;
+-    {
+-      int32_t hash = elem_hash ((const char *) name, name_len);
+-      int32_t elem = hash % table_size;
+-      if (symb_table[2 * elem] != 0)
+-	{
+-	  int32_t second = hash % (table_size - 2) + 1;
+-
+-	  do
+-	    {
+-	      /* First compare the hashing value.  */
+-	      if (symb_table[2 * elem] == hash
+-		  /* Compare the length of the name.  */
+-		  && name_len == extra[symb_table[2 * elem + 1]]
+-		  /* Compare the name.  */
+-		  && memcmp (name, &extra[symb_table[2 * elem + 1] + 1],
+-			     name_len) == 0)
+-		{
+-		  /* Yep, this is the entry.  */
+-		  break;
+-		}
++  __attribute__ ((always_inline))
++  seek_collating_symbol_entry (const unsigned char *name, size_t name_len)
++    {
++      int32_t elem;
+ 
+-	      /* Next entry.  */
+-	      elem += second;
+-	    }
+-	  while (symb_table[2 * elem] != 0);
+-	}
+-      return elem;
++      for (elem = 0; elem < table_size; elem++)
++	if (symb_table[2 * elem] != 0)
++	  {
++	    int32_t idx = symb_table[2 * elem + 1];
++	    /* Skip the name of collating element name.  */
++	    idx += 1 + extra[idx];
++	    if (/* Compare the length of the name.  */
++		name_len == extra[idx]
++		/* Compare the name.  */
++		&& memcmp (name, &extra[idx + 1], name_len) == 0)
++	      /* Yep, this is the entry.  */
++	      return elem;
++	  }
++      return -1;
+     }
+ 
+   /* Local function for parse_bracket_exp used in _LIBC environment.
+@@ -2884,9 +2870,8 @@ parse_bracket_exp (re_string_t *regexp,
+      Return the value if succeeded, UINT_MAX otherwise.  */
+ 
+   auto inline unsigned int
+-  __attribute ((always_inline))
+-  lookup_collation_sequence_value (br_elem)
+-	 bracket_elem_t *br_elem;
++  __attribute__ ((always_inline))
++  lookup_collation_sequence_value (bracket_elem_t *br_elem)
+     {
+       if (br_elem->type == SB_CHAR)
+ 	{
+@@ -2914,7 +2899,7 @@ parse_bracket_exp (re_string_t *regexp,
+ 	      int32_t elem, idx;
+ 	      elem = seek_collating_symbol_entry (br_elem->opr.name,
+ 						  sym_name_len);
+-	      if (symb_table[2 * elem] != 0)
++	      if (elem != -1)
+ 		{
+ 		  /* We found the entry.  */
+ 		  idx = symb_table[2 * elem + 1];
+@@ -2932,7 +2917,7 @@ parse_bracket_exp (re_string_t *regexp,
+ 		  /* Return the collation sequence value.  */
+ 		  return *(unsigned int *) (extra + idx);
+ 		}
+-	      else if (symb_table[2 * elem] == 0 && sym_name_len == 1)
++	      else if (sym_name_len == 1)
+ 		{
+ 		  /* No valid character.  Match it as a single byte
+ 		     character.  */
+@@ -2953,12 +2938,9 @@ parse_bracket_exp (re_string_t *regexp,
+      update it.  */
+ 
+   auto inline reg_errcode_t
+-  __attribute ((always_inline))
+-  build_range_exp (sbcset, mbcset, range_alloc, start_elem, end_elem)
+-	 re_charset_t *mbcset;
+-	 Idx *range_alloc;
+-	 bitset_t sbcset;
+-	 bracket_elem_t *start_elem, *end_elem;
++  __attribute__ ((always_inline))
++  build_range_exp (bitset_t sbcset, re_charset_t *mbcset, int *range_alloc,
++		   bracket_elem_t *start_elem, bracket_elem_t *end_elem)
+     {
+       unsigned int ch;
+       uint32_t start_collseq;
+@@ -2971,6 +2953,7 @@ parse_bracket_exp (re_string_t *regexp,
+ 	      0))
+ 	return REG_ERANGE;
+ 
++      /* FIXME: Implement rational ranges here, too.  */
+       start_collseq = lookup_collation_sequence_value (start_elem);
+       end_collseq = lookup_collation_sequence_value (end_elem);
+       /* Check start/end collation sequence values.  */
+@@ -3036,26 +3019,23 @@ parse_bracket_exp (re_string_t *regexp,
+      pointer argument since we may update it.  */
+ 
+   auto inline reg_errcode_t
+-  __attribute ((always_inline))
+-  build_collating_symbol (sbcset, mbcset, coll_sym_alloc, name)
+-	 re_charset_t *mbcset;
+-	 Idx *coll_sym_alloc;
+-	 bitset_t sbcset;
+-	 const unsigned char *name;
++  __attribute__ ((always_inline))
++  build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset,
++			  Idx *coll_sym_alloc, const unsigned char *name)
+     {
+       int32_t elem, idx;
+       size_t name_len = strlen ((const char *) name);
+       if (nrules != 0)
+ 	{
+ 	  elem = seek_collating_symbol_entry (name, name_len);
+-	  if (symb_table[2 * elem] != 0)
++	  if (elem != -1)
+ 	    {
+ 	      /* We found the entry.  */
+ 	      idx = symb_table[2 * elem + 1];
+ 	      /* Skip the name of collating element name.  */
+ 	      idx += 1 + extra[idx];
+ 	    }
+-	  else if (symb_table[2 * elem] == 0 && name_len == 1)
++	  else if (name_len == 1)
+ 	    {
+ 	      /* No valid character, treat it as a normal
+ 		 character.  */
+@@ -3298,7 +3278,8 @@ parse_bracket_exp (re_string_t *regexp,
+ #ifdef RE_ENABLE_I18N
+ 				      mbcset, &char_class_alloc,
+ #endif /* RE_ENABLE_I18N */
+-				      start_elem.opr.name, syntax);
++				      (const char *) start_elem.opr.name,
++				      syntax);
+ 	      if (BE (*err != REG_NOERROR, 0))
+ 	       goto parse_bracket_exp_free_return;
+ 	      break;
+@@ -3578,14 +3559,14 @@ static reg_errcode_t
+ #ifdef RE_ENABLE_I18N
+ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
+ 		 re_charset_t *mbcset, Idx *char_class_alloc,
+-		 const unsigned char *class_name, reg_syntax_t syntax)
++		 const char *class_name, reg_syntax_t syntax)
+ #else /* not RE_ENABLE_I18N */
+ build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
+-		 const unsigned char *class_name, reg_syntax_t syntax)
++		 const char *class_name, reg_syntax_t syntax)
+ #endif /* not RE_ENABLE_I18N */
+ {
+   int i;
+-  const char *name = (const char *) class_name;
++  const char *name = class_name;
+ 
+   /* In case of REG_ICASE "upper" and "lower" match the both of
+      upper and lower cases.  */
+@@ -3659,8 +3640,8 @@ build_charclass (RE_TRANSLATE_TYPE trans
+ 
+ static bin_tree_t *
+ build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans,
+-		    const unsigned char *class_name,
+-		    const unsigned char *extra, bool non_match,
++		    const char *class_name,
++		    const char *extra, bool non_match,
+ 		    reg_errcode_t *err)
+ {
+   re_bitset_ptr_t sbcset;
+--- origsrc/lib/regex-quote.c	1970-01-01 01:00:00.000000000 +0100
++++ src/lib/regex-quote.c	2013-06-27 18:05:27.081447884 +0200
+@@ -0,0 +1,216 @@
++/* Construct a regular expression from a literal string.
++   Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc.
++   Written by Bruno Haible <haible@clisp.cons.org>, 2010.
++
++   This program is free software: you can redistribute it and/or modify
++   it under the terms of the GNU General Public License as published by
++   the Free Software Foundation; either version 3 of the License, or
++   (at your option) any later version.
++
++   This program is distributed in the hope that it will be useful,
++   but WITHOUT ANY WARRANTY; without even the implied warranty of
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
++   GNU General Public License for more details.
++
++   You should have received a copy of the GNU General Public License
++   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
++
++#include <config.h>
++
++/* Specification.  */
++#include "regex-quote.h"
++
++#include <string.h>
++
++#include "mbuiter.h"
++#include "xalloc.h"
++
++/* Characters that are special in a BRE.  */
++static const char bre_special[] = "$^.*[]\\";
++
++/* Characters that are special in an ERE.  */
++static const char ere_special[] = "$^.*[]\\+?{}()|";
++
++struct regex_quote_spec
++regex_quote_spec_posix (int cflags, bool anchored)
++{
++  struct regex_quote_spec result;
++
++  strcpy (result.special, cflags != 0 ? ere_special : bre_special);
++  result.multibyte = true;
++  result.anchored = anchored;
++
++  return result;
++}
++
++/* Syntax bit values, defined in GNU <regex.h>.  We don't include it here,
++   otherwise this module would need to depend on gnulib module 'regex'.  */
++#define RE_BK_PLUS_QM    0x00000002
++#define RE_INTERVALS     0x00000200
++#define RE_LIMITED_OPS   0x00000400
++#define RE_NEWLINE_ALT   0x00000800
++#define RE_NO_BK_BRACES  0x00001000
++#define RE_NO_BK_PARENS  0x00002000
++#define RE_NO_BK_VBAR    0x00008000
++
++struct regex_quote_spec
++regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored)
++{
++  struct regex_quote_spec result;
++  char *p;
++
++  p = result.special;
++  memcpy (p, bre_special, sizeof (bre_special) - 1);
++  p += sizeof (bre_special) - 1;
++  if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_BK_PLUS_QM) == 0)
++    {
++      *p++ = '+';
++      *p++ = '?';
++    }
++  if ((syntax & RE_INTERVALS) != 0 && (syntax & RE_NO_BK_BRACES) != 0)
++    {
++      *p++ = '{';
++      *p++ = '}';
++    }
++  if ((syntax & RE_NO_BK_PARENS) != 0)
++    {
++      *p++ = '(';
++      *p++ = ')';
++    }
++  if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_NO_BK_VBAR) != 0)
++    *p++ = '|';
++  if ((syntax & RE_NEWLINE_ALT) != 0)
++    *p++ = '\n';
++  *p = '\0';
++
++  result.multibyte = true;
++  result.anchored = anchored;
++
++  return result;
++}
++
++/* Characters that are special in a PCRE.  */
++static const char pcre_special[] = "$^.*[]\\+?{}()|";
++
++/* Options bit values, defined in <pcre.h>.  We don't include it here, because
++   it is not a standard header.  */
++#define PCRE_ANCHORED 0x00000010
++#define PCRE_EXTENDED 0x00000008
++
++struct regex_quote_spec
++regex_quote_spec_pcre (int options, bool anchored)
++{
++  struct regex_quote_spec result;
++  char *p;
++
++  p = result.special;
++  memcpy (p, bre_special, sizeof (pcre_special) - 1);
++  p += sizeof (pcre_special) - 1;
++  if (options & PCRE_EXTENDED)
++    {
++      *p++ = ' ';
++      *p++ = '\t';
++      *p++ = '\n';
++      *p++ = '\v';
++      *p++ = '\f';
++      *p++ = '\r';
++      *p++ = '#';
++    }
++  *p = '\0';
++
++  /* PCRE regular expressions consist of UTF-8 characters of options contains
++     PCRE_UTF8 and of single bytes otherwise.  */
++  result.multibyte = false;
++  /* If options contains PCRE_ANCHORED, the anchoring is implicit.  */
++  result.anchored = (options & PCRE_ANCHORED ? 0 : anchored);
++
++  return result;
++}
++
++size_t
++regex_quote_length (const char *string, const struct regex_quote_spec *spec)
++{
++  const char *special = spec->special;
++  size_t length;
++
++  length = 0;
++  if (spec->anchored)
++    length += 2; /* for '^' at the beginning and '$' at the end */
++  if (spec->multibyte)
++    {
++      mbui_iterator_t iter;
++
++      for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter))
++        {
++          /* We know that special contains only ASCII characters.  */
++          if (mb_len (mbui_cur (iter)) == 1
++              && strchr (special, * mbui_cur_ptr (iter)))
++            length += 1;
++          length += mb_len (mbui_cur (iter));
++        }
++    }
++  else
++    {
++      const char *iter;
++
++      for (iter = string; *iter != '\0'; iter++)
++        {
++          if (strchr (special, *iter))
++            length += 1;
++          length += 1;
++        }
++    }
++
++  return length;
++}
++
++char *
++regex_quote_copy (char *p, const char *string, const struct regex_quote_spec *spec)
++{
++  const char *special = spec->special;
++
++  if (spec->anchored)
++    *p++ = '^';
++  if (spec->multibyte)
++    {
++      mbui_iterator_t iter;
++
++      for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter))
++        {
++          /* We know that special contains only ASCII characters.  */
++          if (mb_len (mbui_cur (iter)) == 1
++              && strchr (special, * mbui_cur_ptr (iter)))
++            *p++ = '\\';
++          memcpy (p, mbui_cur_ptr (iter), mb_len (mbui_cur (iter)));
++          p += mb_len (mbui_cur (iter));
++        }
++    }
++  else
++    {
++      const char *iter;
++
++      for (iter = string; *iter != '\0'; iter++)
++        {
++          if (strchr (special, *iter))
++            *p++ = '\\';
++          *p++ = *iter++;
++        }
++    }
++  if (spec->anchored)
++    *p++ = '$';
++
++  return p;
++}
++
++char *
++regex_quote (const char *string, const struct regex_quote_spec *spec)
++{
++  size_t length = regex_quote_length (string, spec);
++  char *result = XNMALLOC (length + 1, char);
++  char *p;
++
++  p = result;
++  p = regex_quote_copy (p, string, spec);
++  *p = '\0';
++  return result;
++}
+--- origsrc/lib/regex-quote.h	1970-01-01 01:00:00.000000000 +0100
++++ src/lib/regex-quote.h	2013-06-27 18:05:27.112447751 +0200
+@@ -0,0 +1,88 @@
++/* Construct a regular expression from a literal string.
++   Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc.
++   Written by Bruno Haible <haible@clisp.cons.org>, 2010.
++
++   This program is free software: you can redistribute it and/or modify
++   it under the terms of the GNU General Public License as published by
++   the Free Software Foundation; either version 3 of the License, or
++   (at your option) any later version.
++
++   This program is distributed in the hope that it will be useful,
++   but WITHOUT ANY WARRANTY; without even the implied warranty of
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
++   GNU General Public License for more details.
++
++   You should have received a copy of the GNU General Public License
++   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
++
++#ifndef _REGEX_QUOTE_H
++#define _REGEX_QUOTE_H
++
++#include <stddef.h>
++#include <stdbool.h>
++
++
++/* Specifies a quotation task for converting a fixed string to a regular
++   expression pattern.  */
++struct regex_quote_spec
++{
++  /* True if the regular expression pattern consists of multibyte characters
++     (in the encoding given by the LC_CTYPE category of the locale),
++     false if it consists of single bytes or UTF-8 characters.  */
++  unsigned int /*bool*/ multibyte : 1;
++  /* True if the regular expression pattern shall match only entire lines.  */
++  unsigned int /*bool*/ anchored : 1;
++  /* Set of characters that need to be escaped (all ASCII), as a
++     NUL-terminated string.  */
++  char special[30 + 1];
++};
++
++
++/* Creates a quotation task that produces a POSIX regular expression, that is,
++   a pattern that can be compiled with regcomp().
++   CFLAGS can be 0 or REG_EXTENDED.
++   If it is 0, the result is a Basic Regular Expression (BRE)
++   <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_03>.
++   If it is REG_EXTENDED, the result is an Extended Regular Expression (ERE)
++   <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_04>.
++   If ANCHORED is false, the regular expression will match substrings of lines.
++   If ANCHORED is true, it will match only complete lines,  */
++extern struct regex_quote_spec
++       regex_quote_spec_posix (int cflags, bool anchored);
++
++/* Creates a quotation task that produces a regular expression that can be
++   compiled with the GNU API function re_compile_pattern().
++   SYNTAX describes the syntax of the regular expression (such as
++   RE_SYNTAX_POSIX_BASIC, RE_SYNTAX_POSIX_EXTENDED, RE_SYNTAX_EMACS, all
++   defined in <regex.h>).  It must be the same value as 're_syntax_options'
++   at the moment of the re_compile_pattern() call.
++   If ANCHORED is false, the regular expression will match substrings of lines.
++   If ANCHORED is true, it will match only complete lines,  */
++extern struct regex_quote_spec
++       regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored);
++
++/* Creates a quotation task that produces a PCRE regular expression, that is,
++   a pattern that can be compiled with pcre_compile().
++   OPTIONS is the same value as the second argument passed to pcre_compile().
++   If ANCHORED is false, the regular expression will match substrings of lines.
++   If ANCHORED is true, it will match only complete lines,  */
++extern struct regex_quote_spec
++       regex_quote_spec_pcre (int options, bool anchored);
++
++
++/* Returns the number of bytes needed for the quoted string.  */
++extern size_t
++       regex_quote_length (const char *string, const struct regex_quote_spec *spec);
++
++/* Copies the quoted string to p and returns the incremented p.
++   There must be room for regex_quote_length (string, spec) + 1 bytes at p.  */
++extern char *
++       regex_quote_copy (char *p,
++                         const char *string, const struct regex_quote_spec *spec);
++
++/* Returns the freshly allocated quoted string.  */
++extern char *
++       regex_quote (const char *string, const struct regex_quote_spec *spec);
++
++
++#endif /* _REGEX_QUOTE_H */
+--- origsrc/lib/regex.c	2012-12-22 14:21:52.000000000 +0100
++++ src/lib/regex.c	2013-06-27 18:05:27.138447639 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2003, 2005-2006, 2009-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ #ifndef _LIBC
+ # include <config.h>
+@@ -25,6 +24,7 @@
+ #  pragma GCC diagnostic ignored "-Wsuggest-attribute=pure"
+ # endif
+ # if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
++#  pragma GCC diagnostic ignored "-Wold-style-definition"
+ #  pragma GCC diagnostic ignored "-Wtype-limits"
+ # endif
+ #endif
+--- origsrc/lib/regex.h	2012-12-22 14:21:52.000000000 +0100
++++ src/lib/regex.h	2013-06-27 18:05:27.168447509 +0200
+@@ -1,23 +1,22 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Definitions for data structures and routines for the regular
+    expression library.
+-   Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2012
+-   Free Software Foundation, Inc.
++   Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2013 Free Software
++   Foundation, Inc.
+    This file is part of the GNU C Library.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ #ifndef _REGEX_H
+ #define _REGEX_H 1
+--- origsrc/lib/regex_internal.c	2012-12-22 14:21:52.000000000 +0100
++++ src/lib/regex_internal.c	2013-06-27 18:05:27.199447375 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ static void re_string_construct_common (const char *str, Idx len,
+ 					re_string_t *pstr,
+@@ -835,7 +834,7 @@ re_string_reconstruct (re_string_t *pstr
+ }
+ 
+ static unsigned char
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure))
+ re_string_peek_byte_case (const re_string_t *pstr, Idx idx)
+ {
+   int ch;
+@@ -975,7 +974,7 @@ re_node_set_alloc (re_node_set *set, Idx
+   set->alloc = size;
+   set->nelem = 0;
+   set->elems = re_malloc (Idx, size);
+-  if (BE (set->elems == NULL, 0))
++  if (BE (set->elems == NULL, 0) && (MALLOC_0_IS_NONNULL || size != 0))
+     return REG_ESPACE;
+   return REG_NOERROR;
+ }
+@@ -1355,7 +1354,7 @@ re_node_set_insert_last (re_node_set *se
+    Return true if SET1 and SET2 are equivalent.  */
+ 
+ static bool
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure))
+ re_node_set_compare (const re_node_set *set1, const re_node_set *set2)
+ {
+   Idx i;
+@@ -1370,7 +1369,7 @@ re_node_set_compare (const re_node_set *
+ /* Return (idx + 1) if SET contains the element ELEM, return 0 otherwise.  */
+ 
+ static Idx
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure))
+ re_node_set_contains (const re_node_set *set, Idx elem)
+ {
+   __re_size_t idx, right, mid;
+@@ -1444,11 +1443,9 @@ re_dfa_add_node (re_dfa_t *dfa, re_token
+   dfa->nodes[dfa->nodes_len] = token;
+   dfa->nodes[dfa->nodes_len].constraint = 0;
+ #ifdef RE_ENABLE_I18N
+-  {
+-  int type = token.type;
+   dfa->nodes[dfa->nodes_len].accept_mb =
+-    (type == OP_PERIOD && dfa->mb_cur_max > 1) || type == COMPLEX_BRACKET;
+-  }
++    ((token.type == OP_PERIOD && dfa->mb_cur_max > 1)
++     || token.type == COMPLEX_BRACKET);
+ #endif
+   dfa->nexts[dfa->nodes_len] = REG_MISSING;
+   re_node_set_init_empty (dfa->edests + dfa->nodes_len);
+--- origsrc/lib/regex_internal.h	2012-12-22 14:21:52.000000000 +0100
++++ src/lib/regex_internal.h	2013-06-27 18:05:27.230447242 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ #ifndef _REGEX_INTERNAL_H
+ #define _REGEX_INTERNAL_H 1
+@@ -28,21 +27,54 @@
+ #include <string.h>
+ 
+ #include <langinfo.h>
+-#ifndef _LIBC
+-# include "localcharset.h"
+-#endif
+ #include <locale.h>
+ #include <wchar.h>
+ #include <wctype.h>
+ #include <stdbool.h>
+ #include <stdint.h>
+-#if defined _LIBC
++
++#ifdef _LIBC
+ # include <bits/libc-lock.h>
++# define lock_define(name) __libc_lock_define (, name)
++# define lock_init(lock) (__libc_lock_init (lock), 0)
++# define lock_fini(lock) 0
++# define lock_lock(lock) __libc_lock_lock (lock)
++# define lock_unlock(lock) __libc_lock_unlock (lock)
++#elif defined GNULIB_LOCK
++# include "glthread/lock.h"
++  /* Use gl_lock_define if empty macro arguments are known to work.
++     Otherwise, fall back on less-portable substitutes.  */
++# if ((defined __GNUC__ && !defined __STRICT_ANSI__) \
++      || (defined __STDC_VERSION__ && 199901L <= __STDC_VERSION__))
++#  define lock_define(name) gl_lock_define (, name)
++# elif USE_POSIX_THREADS
++#  define lock_define(name) pthread_mutex_t name;
++# elif USE_PTH_THREADS
++#  define lock_define(name) pth_mutex_t name;
++# elif USE_SOLARIS_THREADS
++#  define lock_define(name) mutex_t name;
++# elif USE_WINDOWS_THREADS
++#  define lock_define(name) gl_lock_t name;
++# else
++#  define lock_define(name)
++# endif
++# define lock_init(lock) glthread_lock_init (&(lock))
++# define lock_fini(lock) glthread_lock_destroy (&(lock))
++# define lock_lock(lock) glthread_lock_lock (&(lock))
++# define lock_unlock(lock) glthread_lock_unlock (&(lock))
++#elif defined GNULIB_PTHREAD
++# include <pthread.h>
++# define lock_define(name) pthread_mutex_t name;
++# define lock_init(lock) pthread_mutex_init (&(lock), 0)
++# define lock_fini(lock) pthread_mutex_destroy (&(lock))
++# define lock_lock(lock) pthread_mutex_lock (&(lock))
++# define lock_unlock(lock) pthread_mutex_unlock (&(lock))
+ #else
+-# define __libc_lock_define(CLASS,NAME)
+-# define __libc_lock_init(NAME) do { } while (0)
+-# define __libc_lock_lock(NAME) do { } while (0)
+-# define __libc_lock_unlock(NAME) do { } while (0)
++# define lock_define(name)
++# define lock_init(lock) 0
++# define lock_fini(lock) 0
++# define lock_lock(lock) ((void) 0)
++# define lock_unlock(lock) ((void) 0)
+ #endif
+ 
+ /* In case that the system doesn't have isblank().  */
+@@ -65,7 +97,7 @@
+ # ifdef _LIBC
+ #  undef gettext
+ #  define gettext(msgid) \
+-  INTUSE(__dcgettext) (_libc_intl_domainname, msgid, LC_MESSAGES)
++  __dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES)
+ # endif
+ #else
+ # define gettext(msgid) (msgid)
+@@ -101,6 +133,8 @@
+ 
+ /* Rename to standard API for using out of glibc.  */
+ #ifndef _LIBC
++# undef __wctype
++# undef __iswctype
+ # define __wctype wctype
+ # define __iswctype iswctype
+ # define __btowc btowc
+@@ -110,10 +144,8 @@
+ # define attribute_hidden
+ #endif /* not _LIBC */
+ 
+-#if __GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 1)
+-# define __attribute(arg) __attribute__ (arg)
+-#else
+-# define __attribute(arg)
++#if __GNUC__ < 3 + (__GNUC_MINOR__ < 1)
++# define __attribute__(arg)
+ #endif
+ 
+ typedef __re_idx_t Idx;
+@@ -429,7 +461,7 @@ static void build_upper_buffer (re_strin
+ static void re_string_translate_buffer (re_string_t *pstr) internal_function;
+ static unsigned int re_string_context_at (const re_string_t *input, Idx idx,
+ 					  int eflags)
+-     internal_function __attribute ((pure));
++     internal_function __attribute__ ((pure));
+ #endif
+ #define re_string_peek_byte(pstr, offset) \
+   ((pstr)->mbs[(pstr)->cur_idx + offset])
+@@ -448,7 +480,9 @@ static unsigned int re_string_context_at
+ #define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx))
+ #define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx))
+ 
+-#include <alloca.h>
++#if defined _LIBC || HAVE_ALLOCA
++# include <alloca.h>
++#endif
+ 
+ #ifndef _LIBC
+ # if HAVE_ALLOCA
+@@ -465,6 +499,12 @@ static unsigned int re_string_context_at
+ # endif
+ #endif
+ 
++#ifdef _LIBC
++# define MALLOC_0_IS_NONNULL 1
++#elif !defined MALLOC_0_IS_NONNULL
++# define MALLOC_0_IS_NONNULL 0
++#endif
++
+ #ifndef MAX
+ # define MAX(a,b) ((a) < (b) ? (b) : (a))
+ #endif
+@@ -695,7 +735,7 @@ struct re_dfa_t
+ #ifdef DEBUG
+   char* re_str;
+ #endif
+-  __libc_lock_define (, lock)
++  lock_define (lock)
+ };
+ 
+ #define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set))
+@@ -767,7 +807,7 @@ bitset_copy (bitset_t dest, const bitset
+   memcpy (dest, src, sizeof (bitset_t));
+ }
+ 
+-static void
++static void __attribute__ ((unused))
+ bitset_not (bitset_t set)
+ {
+   int bitset_i;
+@@ -779,7 +819,7 @@ bitset_not (bitset_t set)
+        & ~set[BITSET_WORDS - 1]);
+ }
+ 
+-static void
++static void __attribute__ ((unused))
+ bitset_merge (bitset_t dest, const bitset_t src)
+ {
+   int bitset_i;
+@@ -787,7 +827,7 @@ bitset_merge (bitset_t dest, const bitse
+     dest[bitset_i] |= src[bitset_i];
+ }
+ 
+-static void
++static void __attribute__ ((unused))
+ bitset_mask (bitset_t dest, const bitset_t src)
+ {
+   int bitset_i;
+@@ -798,7 +838,7 @@ bitset_mask (bitset_t dest, const bitset
+ #ifdef RE_ENABLE_I18N
+ /* Functions for re_string.  */
+ static int
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure, unused))
+ re_string_char_size_at (const re_string_t *pstr, Idx idx)
+ {
+   int byte_idx;
+@@ -811,7 +851,7 @@ re_string_char_size_at (const re_string_
+ }
+ 
+ static wint_t
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure, unused))
+ re_string_wchar_at (const re_string_t *pstr, Idx idx)
+ {
+   if (pstr->mb_cur_max == 1)
+@@ -821,7 +861,7 @@ re_string_wchar_at (const re_string_t *p
+ 
+ # ifndef NOT_IN_libc
+ static int
+-internal_function __attribute ((pure))
++internal_function __attribute__ ((pure, unused))
+ re_string_elem_size_at (const re_string_t *pstr, Idx idx)
+ {
+ #  ifdef _LIBC
+--- origsrc/lib/regexec.c	2012-12-22 14:21:52.000000000 +0100
++++ src/lib/regexec.c	2013-06-27 18:05:27.268447078 +0200
+@@ -1,22 +1,21 @@
+-/* -*- buffer-read-only: t -*- vi: set ro: */
+-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */
+ /* Extended regular expression matching and search library.
+-   Copyright (C) 2002-2012 Free Software Foundation, Inc.
++   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+    Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
+ 
+-   This program is free software; you can redistribute it and/or modify
+-   it under the terms of the GNU General Public License as published by
+-   the Free Software Foundation; either version 3, or (at your option)
+-   any later version.
++   The GNU C Library is free software; you can redistribute it and/or
++   modify it under the terms of the GNU Lesser General Public
++   License as published by the Free Software Foundation; either
++   version 2.1 of the License, or (at your option) any later version.
+ 
+-   This program is distributed in the hope that it will be useful,
++   The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-   GNU General Public License for more details.
++   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
++   Lesser General Public License for more details.
+ 
+-   You should have received a copy of the GNU General Public License along
+-   with this program; if not, see <http://www.gnu.org/licenses/>.  */
++   You should have received a copy of the GNU Lesser General Public
++   License along with the GNU C Library; if not, see
++   <http://www.gnu.org/licenses/>.  */
+ 
+ static reg_errcode_t match_ctx_init (re_match_context_t *cache, int eflags,
+ 				     Idx n) internal_function;
+@@ -200,7 +199,7 @@ static Idx group_nodes_into_DFAstates (c
+ static bool check_node_accept (const re_match_context_t *mctx,
+ 			       const re_token_t *node, Idx idx)
+      internal_function;
+-static reg_errcode_t extend_buffers (re_match_context_t *mctx)
++static reg_errcode_t extend_buffers (re_match_context_t *mctx, int min_len)
+      internal_function;
+ 
+ /* Entry point for POSIX code.  */
+@@ -229,9 +228,7 @@ regexec (preg, string, nmatch, pmatch, e
+ {
+   reg_errcode_t err;
+   Idx start, length;
+-#ifdef _LIBC
+   re_dfa_t *dfa = preg->buffer;
+-#endif
+ 
+   if (eflags & ~(REG_NOTBOL | REG_NOTEOL | REG_STARTEND))
+     return REG_BADPAT;
+@@ -247,14 +244,14 @@ regexec (preg, string, nmatch, pmatch, e
+       length = strlen (string);
+     }
+ 
+-  __libc_lock_lock (dfa->lock);
++  lock_lock (dfa->lock);
+   if (preg->no_sub)
+     err = re_search_internal (preg, string, length, start, length,
+ 			      length, 0, NULL, eflags);
+   else
+     err = re_search_internal (preg, string, length, start, length,
+ 			      length, nmatch, pmatch, eflags);
+-  __libc_lock_unlock (dfa->lock);
++  lock_unlock (dfa->lock);
+   return err != REG_NOERROR;
+ }
+ 
+@@ -422,9 +419,7 @@ re_search_stub (struct re_pattern_buffer
+   Idx nregs;
+   regoff_t rval;
+   int eflags = 0;
+-#ifdef _LIBC
+   re_dfa_t *dfa = bufp->buffer;
+-#endif
+   Idx last_start = start + range;
+ 
+   /* Check for out-of-range.  */
+@@ -435,7 +430,7 @@ re_search_stub (struct re_pattern_buffer
+   else if (BE (last_start < 0 || (range < 0 && start <= last_start), 0))
+     last_start = 0;
+ 
+-  __libc_lock_lock (dfa->lock);
++  lock_lock (dfa->lock);
+ 
+   eflags |= (bufp->not_bol) ? REG_NOTBOL : 0;
+   eflags |= (bufp->not_eol) ? REG_NOTEOL : 0;
+@@ -499,7 +494,7 @@ re_search_stub (struct re_pattern_buffer
+     }
+   re_free (pmatch);
+  out:
+-  __libc_lock_unlock (dfa->lock);
++  lock_unlock (dfa->lock);
+   return rval;
+ }
+ 
+@@ -1065,7 +1060,7 @@ prune_impossible_nodes (re_match_context
+    since initial states may have constraints like "\<", "^", etc..  */
+ 
+ static inline re_dfastate_t *
+-__attribute ((always_inline)) internal_function
++__attribute__ ((always_inline)) internal_function
+ acquire_init_state_context (reg_errcode_t *err, const re_match_context_t *mctx,
+ 			    Idx idx)
+ {
+@@ -1177,7 +1172,7 @@ check_matching (re_match_context_t *mctx
+ 	  || (BE (next_char_idx >= mctx->input.valid_len, 0)
+ 	      && mctx->input.valid_len < mctx->input.len))
+ 	{
+-	  err = extend_buffers (mctx);
++	  err = extend_buffers (mctx, next_char_idx + 1);
+ 	  if (BE (err != REG_NOERROR, 0))
+ 	    {
+ 	      assert (err == REG_ESPACE);
+@@ -1757,7 +1752,7 @@ clean_state_log_if_needed (re_match_cont
+ 	  && mctx->input.valid_len < mctx->input.len))
+     {
+       reg_errcode_t err;
+-      err = extend_buffers (mctx);
++      err = extend_buffers (mctx, next_state_log_idx + 1);
+       if (BE (err != REG_NOERROR, 0))
+ 	return err;
+     }
+@@ -2814,7 +2809,7 @@ get_subexp (re_match_context_t *mctx, Id
+ 		  if (bkref_str_off >= mctx->input.len)
+ 		    break;
+ 
+-		  err = extend_buffers (mctx);
++		  err = extend_buffers (mctx, bkref_str_off + 1);
+ 		  if (BE (err != REG_NOERROR, 0))
+ 		    return err;
+ 
+@@ -3937,6 +3932,7 @@ check_node_accept_bytes (const re_dfa_t
+ 		in_collseq = find_collation_sequence_value (pin, elem_len);
+ 	    }
+ 	  /* match with range expression?  */
++	  /* FIXME: Implement rational ranges here, too.  */
+ 	  for (i = 0; i < cset->nranges; ++i)
+ 	    if (cset->range_starts[i] <= in_collseq
+ 		&& in_collseq <= cset->range_ends[i])
+@@ -3988,18 +3984,9 @@ check_node_accept_bytes (const re_dfa_t
+ # endif /* _LIBC */
+ 	{
+ 	  /* match with range expression?  */
+-#if __GNUC__ >= 2 && ! (__STDC_VERSION__ < 199901L && defined __STRICT_ANSI__)
+-	  wchar_t cmp_buf[] = {L'\0', L'\0', wc, L'\0', L'\0', L'\0'};
+-#else
+-	  wchar_t cmp_buf[] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
+-	  cmp_buf[2] = wc;
+-#endif
+ 	  for (i = 0; i < cset->nranges; ++i)
+ 	    {
+-	      cmp_buf[0] = cset->range_starts[i];
+-	      cmp_buf[4] = cset->range_ends[i];
+-	      if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
+-		  && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
++	      if (cset->range_starts[i] <= wc && wc <= cset->range_ends[i])
+ 		{
+ 		  match_len = char_len;
+ 		  goto check_node_accept_bytes_match;
+@@ -4137,7 +4124,7 @@ check_node_accept (const re_match_contex
+ 
+ static reg_errcode_t
+ internal_function __attribute_warn_unused_result__
+-extend_buffers (re_match_context_t *mctx)
++extend_buffers (re_match_context_t *mctx, int min_len)
+ {
+   reg_errcode_t ret;
+   re_string_t *pstr = &mctx->input;
+@@ -4147,8 +4134,10 @@ extend_buffers (re_match_context_t *mctx
+           <= pstr->bufs_len, 0))
+     return REG_ESPACE;
+ 
+-  /* Double the lengths of the buffers.  */
+-  ret = re_string_realloc_buffers (pstr, MIN (pstr->len, pstr->bufs_len * 2));
++  /* Double the lengths of the buffers, but allocate at least MIN_LEN.  */
++  ret = re_string_realloc_buffers (pstr,
++				   MAX (min_len,
++					MIN (pstr->len, pstr->bufs_len * 2)));
+   if (BE (ret != REG_NOERROR, 0))
+     return ret;
+ 
+--- origsrc/sed/sed.c	2012-03-16 10:13:31.000000000 +0100
++++ src/sed/sed.c	2013-06-27 18:06:25.592195456 +0200
+@@ -57,7 +57,11 @@ bool follow_symlinks = false;
+ char *in_place_extension = NULL;
+ 
+ /* The mode to use to read/write files, either "r"/"w" or "rb"/"wb".  */
++#ifdef HAVE_FOPEN_RT
++char *read_mode = "rt";
++#else
+ char *read_mode = "r";
++#endif
+ char *write_mode = "w";
+ 
+ /* Do we need to be pedantically POSIX compliant? */
diff --git a/dev/ci/README.md b/dev/ci/README.md
new file mode 100644
index 00000000..43d680af
--- /dev/null
+++ b/dev/ci/README.md
@@ -0,0 +1,176 @@
+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.
+
+- You maintain a reasonable build time for your development, or you provide
+  a "lite" target that we can use.
+
+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`](.); set the corresponding
+variables in [`ci-basic-overlay.sh`](ci-basic-overlay.sh); add the
+corresponding target to [`Makefile.ci`](../../Makefile.ci) and a new job to
+[`.gitlab-ci.yml`](../../.gitlab-ci.yml) so that this new target is run.
+Have a look at [#7656](https://github.com/coq/coq/pull/7656/files) for an
+example. **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.
+
+We are currently running tests on the following platforms:
+
+- GitLab CI 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.
+
+- Travis CI is used to test the compilation of Coq and run the test-suite on
+  macOS. It also runs a linter that checks whitespace discipline. A
+  [pre-commit hook](../tools/pre-commit) is automatically installed by
+  `./configure`. It should allow complying with this discipline without pain.
+
+- AppVeyor is used to test the compilation of Coq and run the test-suite on
+  Windows.
+
+You can anticipate the results of most of these tests prior to submitting your
+PR by running GitLab CI on your private branches. To do so follow these steps:
+
+1. Log into GitLab CI (the easiest way is to sign in with your GitHub account).
+2. Click on "New Project".
+3. Choose "CI / CD for external repository" then click on "GitHub".
+4. Find your fork of the Coq repository and click on "Connect".
+5. If GitLab did not do so automatically, [enable the Container Registry](https://docs.gitlab.com/ee/user/project/container_registry.html#enable-the-container-registry-for-your-project).
+6. You are encouraged to go to the CI / CD general settings and increase the
+   timeout from 1h to 2h for better reliability.
+
+Now everytime you push (including force-push unless you changed the default
+GitLab setting) to your fork on GitHub, it will be synchronized on GitLab and
+CI will be run. You will receive an e-mail with a report of the failures if
+there are some.
+
+You can also run one CI target locally (using `make ci-somedev`).
+
+See also [`test-suite/README.md`](../../test-suite/README.md) for information about adding new tests to the test-suite.
+
+### Breaking changes
+
+When your PR breaks an external project we test in our CI, you must prepare a
+patch (or ask someone to prepare a patch) to fix the project:
+
+1. Fork the external project, create a new branch, push a commit adapting
+   the project to your changes.
+2. Test your pull request with your adapted version of the external project by
+   adding an overlay file to your pull request (cf.
+   [`dev/ci/user-overlays/README.md`](user-overlays/README.md)).
+3. Fixes to external libraries (pure Coq projects) *must* be backward
+   compatible (i.e. they should also work with the development version of Coq,
+   and the latest stable version). This will allow you to open a PR on the
+   external project repository to have your changes merged *before* your PR on
+   Coq can be integrated.
+
+   On the other hand, patches to plugins (projects linking to the Coq ML API)
+   can very rarely be made backward compatible and plugins we test will
+   generally have a dedicated branch per Coq version.
+   You can still open a pull request but the merging will be requested by the
+   developer who merges the PR on Coq. There are plans to improve this, cf.
+   [#6724](https://github.com/coq/coq/issues/6724).
+
+Moreover your PR must absolutely update the [`CHANGES`](../../CHANGES) file.
+
+Advanced GitLab CI information
+------------------------------
+
+GitLab CI is set up to use the "build artifact" feature to avoid
+rebuilding Coq. In one job, Coq is built with `./configure -prefix _install_ci`
+and `make install` is run, then the `_install_ci` 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, built only in the `build:base` job. When submitting
+  a documentation PR, this can help reviewers checking the rendered result.
+
+As an exception to the above, jobs testing that compilation triggers
+no OCaml warnings build Coq in parallel with other tests.
+
+### GitLab and Windows
+
+If your repository has access to runners tagged `windows`, setting the
+secret variable `WINDOWS` to `enabled` will add jobs building Windows
+versions of Coq (32bit and 64bit).
+
+The Windows jobs are enabled on Coq's repository, where pipelines for
+pull requests run.
+
+### GitLab and Docker
+
+System and opam packages are installed in a Docker image. The image is
+automatically built and uploaded to your GitLab registry, and is
+loaded by subsequent jobs.
+
+**IMPORTANT**: When updating Coq's CI docker image, you must modify
+the `CACHEKEY` variable in [`.gitlab-ci.yml`](../../.gitlab-ci.yml)
+and [`Dockerfile`](docker/bionic_coq/Dockerfile)
+
+The Docker building job reuses the uploaded image if it is available,
+but if you wish to save more time you can skip the job by setting
+`SKIP_DOCKER` to `true`.
+
+This means you will need to change its value when the Docker image
+needs to be updated. You can do so for a single pipeline by starting
+it through the web interface..
+
+See also [`docker/README.md`](docker/README.md).
diff --git a/dev/ci/appveyor.bat b/dev/ci/appveyor.bat
new file mode 100644
index 00000000..85a71baf
--- /dev/null
+++ b/dev/ci/appveyor.bat
@@ -0,0 +1,42 @@
+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% ^
+    -addon=bignums -make=N ^
+    -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/ci/appveyor.sh b/dev/ci/appveyor.sh
new file mode 100644
index 00000000..8f53877f
--- /dev/null
+++ b/dev/ci/appveyor.sh
@@ -0,0 +1,15 @@
+#!/bin/bash
+
+set -e -x
+
+APPVEYOR_OPAM_SWITCH=4.07.0+mingw64c
+
+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 $APPVEYOR_OPAM_SWITCH --switch $APPVEYOR_OPAM_SWITCH
+eval "$(opam config env)"
+opam install -y num 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
new file mode 100755
index 00000000..13367794
--- /dev/null
+++ b/dev/ci/ci-basic-overlay.sh
@@ -0,0 +1,236 @@
+#!/usr/bin/env bash
+
+# This is the basic overlay set for repositories in the CI.
+
+# 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_REF:=mathcomp-1.7.0}"
+: "${mathcomp_CI_GITURL:=https://github.com/math-comp/math-comp}"
+: "${mathcomp_CI_ARCHIVEURL:=${mathcomp_CI_GITURL}/archive}"
+
+: "${oddorder_CI_REF:=master}"
+: "${oddorder_CI_GITURL:=https://github.com/math-comp/odd-order}"
+: "${oddorder_CI_ARCHIVEURL:=${oddorder_CI_GITURL}/archive}"
+
+########################################################################
+# UniMath
+########################################################################
+: "${UniMath_CI_REF:=master}"
+: "${UniMath_CI_GITURL:=https://github.com/UniMath/UniMath}"
+: "${UniMath_CI_ARCHIVEURL:=${UniMath_CI_GITURL}/archive}"
+
+########################################################################
+# Unicoq + Mtac2
+########################################################################
+: "${unicoq_CI_REF:=v1.3-8.8}"
+: "${unicoq_CI_GITURL:=https://github.com/unicoq/unicoq}"
+: "${unicoq_CI_ARCHIVEURL:=${unicoq_CI_GITURL}/archive}"
+
+: "${mtac2_CI_REF:=v1.0.1-coq8.8}"
+: "${mtac2_CI_GITURL:=https://github.com/Mtac2/Mtac2}"
+: "${mtac2_CI_ARCHIVEURL:=${mtac2_CI_GITURL}/archive}"
+
+########################################################################
+# Mathclasses + Corn
+########################################################################
+: "${math_classes_CI_REF:=master}"
+: "${math_classes_CI_GITURL:=https://github.com/coq-community/math-classes}"
+: "${math_classes_CI_ARCHIVEURL:=${math_classes_CI_GITURL}/archive}"
+
+: "${Corn_CI_REF:=master}"
+: "${Corn_CI_GITURL:=https://github.com/coq-community/corn}"
+: "${Corn_CI_ARCHIVEURL:=${Corn_CI_GITURL}/archive}"
+
+########################################################################
+# Iris
+########################################################################
+: "${stdpp_CI_REF:=master}"
+: "${stdpp_CI_GITURL:=https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp}"
+: "${stdpp_CI_ARCHIVEURL:=${stdpp_CI_GITURL}/-/archive}"
+
+: "${Iris_CI_REF:=master}"
+: "${Iris_CI_GITURL:=https://gitlab.mpi-sws.org/FP/iris-coq}"
+: "${Iris_CI_ARCHIVEURL:=${Iris_CI_GITURL}/-/archive}"
+
+: "${lambdaRust_CI_REF:=master}"
+: "${lambdaRust_CI_GITURL:=https://gitlab.mpi-sws.org/FP/LambdaRust-coq}"
+: "${lambdaRust_CI_ARCHIVEURL:=${lambdaRust_CI_GITURL}/-/archive}"
+
+########################################################################
+# HoTT
+########################################################################
+: "${HoTT_CI_REF:=V8.8}"
+: "${HoTT_CI_GITURL:=https://github.com/HoTT/HoTT}"
+: "${HoTT_CI_ARCHIVEURL:=${HoTT_CI_GITURL}/archive}"
+
+########################################################################
+# Ltac2
+########################################################################
+: "${ltac2_CI_REF:=0.1}"
+: "${ltac2_CI_GITURL:=https://github.com/ppedrot/ltac2}"
+: "${ltac2_CI_ARCHIVEURL:=${ltac2_CI_GITURL}/archive}"
+
+########################################################################
+# GeoCoq
+########################################################################
+: "${GeoCoq_CI_REF:=master}"
+: "${GeoCoq_CI_GITURL:=https://github.com/GeoCoq/GeoCoq}"
+: "${GeoCoq_CI_ARCHIVEURL:=${GeoCoq_CI_GITURL}/archive}"
+
+########################################################################
+# Flocq
+########################################################################
+: "${Flocq_CI_REF:=master}"
+: "${Flocq_CI_GITURL:=https://gitlab.inria.fr/flocq/flocq}"
+: "${Flocq_CI_ARCHIVEURL:=${Flocq_CI_GITURL}/-/archive}"
+
+########################################################################
+# Coquelicot
+########################################################################
+# ATTENTION: The archive URL might depend on the version
+: "${Coquelicot_CI_REF:=coquelicot-3.0.2}"
+: "${Coquelicot_CI_GITURL:=https://scm.gforge.inria.fr/anonscm/git/coquelicot/coquelicot}"
+: "${Coquelicot_CI_ARCHIVEURL:=https://gforge.inria.fr/frs/download.php/file/37523}"
+
+########################################################################
+# CompCert
+########################################################################
+# Note: The latest release version of CompCert (3.3) does not compile with Coq 8.8.1
+# This is caused by a compatibility issue with OCaml 4.0.7
+: "${CompCert_CI_REF:=17f9d839df12511a7e327f2840855e70af5ede47}"
+: "${CompCert_CI_GITURL:=https://github.com/AbsInt/CompCert}"
+: "${CompCert_CI_ARCHIVEURL:=${CompCert_CI_GITURL}/archive}"
+
+########################################################################
+# VST
+########################################################################
+# Note: The latest release version of VST (2.2) does not compile with Coq 8.8.1
+# Note: newer versions of VST have issues with buildability and licensing
+: "${VST_CI_REF:=e49605cf1f1e5ae3bbec3d6554122427a94ae986}"
+: "${VST_CI_GITURL:=https://github.com/PrincetonUniversity/VST}"
+: "${VST_CI_ARCHIVEURL:=${VST_CI_GITURL}/archive}"
+
+########################################################################
+# fiat_parsers
+########################################################################
+: "${fiat_parsers_CI_REF:=master}"
+: "${fiat_parsers_CI_GITURL:=https://github.com/mit-plv/fiat}"
+: "${fiat_parsers_CI_ARCHIVEURL:=${fiat_parsers_CI_GITURL}/archive}"
+
+########################################################################
+# fiat_crypto
+########################################################################
+: "${fiat_crypto_CI_REF:=master}"
+: "${fiat_crypto_CI_GITURL:=https://github.com/mit-plv/fiat-crypto}"
+: "${fiat_crypto_CI_ARCHIVEURL:=${fiat_crypto_CI_GITURL}/archive}"
+
+########################################################################
+# formal-topology
+########################################################################
+: "${formal_topology_CI_REF:=ci}"
+: "${formal_topology_CI_GITURL:=https://github.com/bmsherman/topology}"
+: "${formal_topology_CI_ARCHIVEURL:=${formal_topology_CI_GITURL}/archive}"
+
+########################################################################
+# coq-dpdgraph
+########################################################################
+: "${coq_dpdgraph_CI_REF:=coq-v8.8}"
+: "${coq_dpdgraph_CI_GITURL:=https://github.com/Karmaki/coq-dpdgraph}"
+: "${coq_dpdgraph_CI_ARCHIVEURL:=${coq_dpdgraph_CI_GITURL}/archive}"
+
+########################################################################
+# CoLoR
+########################################################################
+: "${CoLoR_CI_REF:=master}"
+: "${CoLoR_CI_GITURL:=https://github.com/fblanqui/color}"
+: "${CoLoR_CI_ARCHIVEURL:=${CoLoR_CI_GITURL}/archive}"
+
+########################################################################
+# 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}"
+
+########################################################################
+# TLC
+########################################################################
+: "${tlc_CI_REF:=master}"
+: "${tlc_CI_GITURL:=https://gforge.inria.fr/git/tlc/tlc}"
+
+########################################################################
+# Bignums
+########################################################################
+: "${bignums_CI_REF:=V8.8.0}"
+: "${bignums_CI_GITURL:=https://github.com/coq/bignums}"
+: "${bignums_CI_ARCHIVEURL:=${bignums_CI_GITURL}/archive}"
+
+########################################################################
+# bedrock2
+########################################################################
+: "${bedrock2_CI_REF:=master}"
+: "${bedrock2_CI_GITURL:=https://github.com/mit-plv/bedrock2}"
+: "${bedrock2_CI_ARCHIVEURL:=${bedrock2_CI_GITURL}/archive}"
+
+########################################################################
+# Equations
+########################################################################
+: "${Equations_CI_REF:=v1.1-8.8}"
+: "${Equations_CI_GITURL:=https://github.com/mattam82/Coq-Equations}"
+: "${Equations_CI_ARCHIVEURL:=${Equations_CI_GITURL}/archive}"
+
+########################################################################
+# Elpi
+########################################################################
+: "${Elpi_CI_REF:=coq-v8.8}"
+: "${Elpi_CI_GITURL:=https://github.com/LPCIC/coq-elpi}"
+: "${Elpi_CI_ARCHIVEURL:=${Elpi_CI_GITURL}/archive}"
+
+########################################################################
+# fcsl-pcm
+########################################################################
+: "${fcsl_pcm_CI_REF:=master}"
+: "${fcsl_pcm_CI_GITURL:=https://github.com/imdea-software/fcsl-pcm}"
+: "${fcsl_pcm_CI_ARCHIVEURL:=${fcsl_pcm_CI_GITURL}/archive}"
+
+########################################################################
+# ext-lib
+########################################################################
+# Note: This is the latest commit of the v8.8 branch as of August 31st 2018
+: "${ext_lib_CI_REF:=5dd9cfa51f96fcb785c7c31d8c6bf55af5d93f27}"
+: "${ext_lib_CI_GITURL:=https://github.com/coq-ext-lib/coq-ext-lib}"
+: "${ext_lib_CI_ARCHIVEURL:=${ext_lib_CI_GITURL}/archive}"
+
+########################################################################
+# simple-io
+########################################################################
+: "${simple_io_CI_REF:=0.2}"
+: "${simple_io_CI_GITURL:=https://github.com/Lysxia/coq-simple-io}"
+: "${simple_io_CI_ARCHIVEURL:=${simple_io_CI_GITURL}/archive}"
+
+########################################################################
+# quickchick
+########################################################################
+: "${quickchick_CI_REF:=v1.0.2}"
+: "${quickchick_CI_GITURL:=https://github.com/QuickChick/QuickChick}"
+: "${quickchick_CI_ARCHIVEURL:=${quickchick_CI_GITURL}/archive}"
+
+########################################################################
+# menhirlib
+########################################################################
+: "${menhirlib_CI_REF:=20180827}"
+: "${menhirlib_CI_GITURL:=https://gitlab.inria.fr/fpottier/coq-menhirlib}"
+: "${menhirlib_CI_ARCHIVEURL:=${menhirlib_CI_GITURL}/-/archive}"
+
+########################################################################
+# aac-tactics
+########################################################################
+# Note: this is the latest commit of the v8.8 branch as of August 31st 2018
+: "${aactactis_CI_REF:=86ac28259030649ef51460e4de2441c8a1017751}"
+: "${aactactis_CI_GITURL:=https://github.com/coq-community/aac-tactics}"
+: "${aactactis_CI_ARCHIVEURL:=${aactactis_CI_GITURL}/archive}"
diff --git a/dev/ci/ci-bedrock2.sh b/dev/ci/ci-bedrock2.sh
new file mode 100755
index 00000000..52059462
--- /dev/null
+++ b/dev/ci/ci-bedrock2.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+FORCE_GIT=1
+git_download bedrock2
+
+( cd "${CI_BUILD_DIR}/bedrock2" && git submodule update --init --recursive && make )
diff --git a/dev/ci/ci-bignums.sh b/dev/ci/ci-bignums.sh
new file mode 100755
index 00000000..756f54df
--- /dev/null
+++ b/dev/ci/ci-bignums.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download bignums
+
+( cd "${CI_BUILD_DIR}/bignums" && make && make install)
diff --git a/dev/ci/ci-color.sh b/dev/ci/ci-color.sh
new file mode 100755
index 00000000..dc696f69
--- /dev/null
+++ b/dev/ci/ci-color.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download CoLoR
+
+( cd "${CI_BUILD_DIR}/CoLoR" && make )
diff --git a/dev/ci/ci-common.sh b/dev/ci/ci-common.sh
new file mode 100644
index 00000000..6fc4293d
--- /dev/null
+++ b/dev/ci/ci-common.sh
@@ -0,0 +1,123 @@
+#!/usr/bin/env bash
+
+set -xe
+
+# default value for NJOBS
+: "${NJOBS:=1}"
+export NJOBS
+
+if [ -n "${GITLAB_CI}" ];
+then
+    export OCAMLPATH="$PWD/_install_ci/lib:$OCAMLPATH"
+    export COQBIN="$PWD/_install_ci/bin"
+    export CI_BRANCH="$CI_COMMIT_REF_NAME"
+    if [[ ${CI_BRANCH#pr-} =~ ^[0-9]*$ ]]
+    then
+        export CI_PULL_REQUEST="${CI_BRANCH#pr-}"
+    fi
+else
+    if [ -n "${TRAVIS}" ];
+    then
+        export CI_PULL_REQUEST="$TRAVIS_PULL_REQUEST"
+        export CI_BRANCH="$TRAVIS_BRANCH"
+    else # assume local
+        CI_BRANCH="$(git rev-parse --abbrev-ref HEAD)"
+        export CI_BRANCH
+    fi
+    export OCAMLPATH="$PWD:$OCAMLPATH"
+    export COQBIN="$PWD/bin"
+fi
+export PATH="$COQBIN:$PATH"
+
+# Coq's tools need an ending slash :S, we should fix them.
+export COQBIN="$COQBIN/"
+
+ls "$COQBIN"
+
+# Where we download and build external developments
+CI_BUILD_DIR="$PWD/_build_ci"
+
+for overlay in "${ci_dir}"/user-overlays/*.sh; do
+    # shellcheck source=/dev/null
+    . "${overlay}"
+done
+# shellcheck source=ci-basic-overlay.sh
+. "${ci_dir}/ci-basic-overlay.sh"
+
+# [git_download project] will download [project] and unpack it
+# in [$CI_BUILD_DIR/project] if the folder does not exist already;
+# if it does, it will do nothing except print a warning (this can be
+# useful when building locally).
+# Note: when $FORCE_GIT is set to 1 or when $CI is unset or empty
+# (local build), it uses git clone to perform the download.
+git_download()
+{
+  local PROJECT=$1
+  local DEST="$CI_BUILD_DIR/$PROJECT"
+
+  if [ -d "$DEST" ]; then
+    echo "Warning: download and unpacking of $PROJECT skipped because $DEST already exists."
+  elif [ "$FORCE_GIT" = "1" ] || [ "$CI" = "" ]; then
+    local GITURL_VAR="${PROJECT}_CI_GITURL"
+    local GITURL="${!GITURL_VAR}"
+    local REF_VAR="${PROJECT}_CI_REF"
+    local REF="${!REF_VAR}"
+    git clone "$GITURL" "$DEST"
+    cd "$DEST"
+    git checkout "$REF"
+  else # When possible, we download tarballs to reduce bandwidth and latency
+    local ARCHIVEURL_VAR="${PROJECT}_CI_ARCHIVEURL"
+    local ARCHIVEURL="${!ARCHIVEURL_VAR}"
+    local REF_VAR="${PROJECT}_CI_REF"
+    local REF="${!REF_VAR}"
+    mkdir -p "$DEST"
+    cd "$DEST"
+    wget "$ARCHIVEURL/$REF.tar.gz"
+    tar xvfz "$REF.tar.gz" --strip-components=1
+    rm -f "$REF.tar.gz"
+  fi
+}
+
+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'
+
+  git_download mathcomp
+
+  ( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" && \
+    make Makefile.coq && \
+    make -f Makefile.coq ssreflect/all_ssreflect.vo && \
+    make -f Makefile.coq install )
+
+  echo -en 'travis_fold:end:ssr.install\\r'
+
+}
+
+# this installs just the ssreflect + algebra library of math-comp
+install_ssralg()
+{
+  echo 'Installing ssralg' && echo -en 'travis_fold:start:ssralg.install\\r'
+
+  git_download mathcomp
+
+  ( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" && \
+    make Makefile.coq && \
+    make -f Makefile.coq algebra/all_algebra.vo && \
+    make -f Makefile.coq install )
+
+  echo -en 'travis_fold:end:ssralg.install\\r'
+
+}
diff --git a/dev/ci/ci-compcert.sh b/dev/ci/ci-compcert.sh
new file mode 100755
index 00000000..01c35ceb
--- /dev/null
+++ b/dev/ci/ci-compcert.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download CompCert
+
+( cd "${CI_BUILD_DIR}/CompCert" && \
+  ./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
new file mode 100755
index 00000000..2373ea6c
--- /dev/null
+++ b/dev/ci/ci-coq-dpdgraph.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download coq_dpdgraph
+
+( cd "${CI_BUILD_DIR}/coq_dpdgraph" && autoconf && ./configure && make && make test-suite )
diff --git a/dev/ci/ci-coquelicot.sh b/dev/ci/ci-coquelicot.sh
new file mode 100755
index 00000000..5d881749
--- /dev/null
+++ b/dev/ci/ci-coquelicot.sh
@@ -0,0 +1,11 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+install_ssreflect
+
+FORCE_GIT=1
+git_download Coquelicot
+
+( cd "${CI_BUILD_DIR}/Coquelicot" && ./autogen.sh && ./configure && ./remake "-j${NJOBS}" )
diff --git a/dev/ci/ci-corn.sh b/dev/ci/ci-corn.sh
new file mode 100755
index 00000000..7d5d70cf
--- /dev/null
+++ b/dev/ci/ci-corn.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download Corn
+
+( cd "${CI_BUILD_DIR}/Corn" && make && make install )
diff --git a/dev/ci/ci-cpdt.sh b/dev/ci/ci-cpdt.sh
new file mode 100755
index 00000000..ca759c7b
--- /dev/null
+++ b/dev/ci/ci-cpdt.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+wget http://adam.chlipala.net/cpdt/cpdt.tgz
+tar xvfz cpdt.tgz
+
+( cd cpdt && make clean && make )
diff --git a/dev/ci/ci-elpi.sh b/dev/ci/ci-elpi.sh
new file mode 100755
index 00000000..7f4ef77d
--- /dev/null
+++ b/dev/ci/ci-elpi.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+FORCE_GIT=1
+git_download Elpi
+
+( cd "${CI_BUILD_DIR}/Elpi" && make && make install )
diff --git a/dev/ci/ci-equations.sh b/dev/ci/ci-equations.sh
new file mode 100755
index 00000000..998d50fa
--- /dev/null
+++ b/dev/ci/ci-equations.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download Equations
+
+( cd "${CI_BUILD_DIR}/Equations" && coq_makefile -f _CoqProject -o Makefile && \
+  make && make test-suite && make examples && make install)
diff --git a/dev/ci/ci-ext-lib.sh b/dev/ci/ci-ext-lib.sh
new file mode 100755
index 00000000..5eb167d9
--- /dev/null
+++ b/dev/ci/ci-ext-lib.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download ext_lib
+
+( cd "${CI_BUILD_DIR}/ext_lib" && make && make install)
diff --git a/dev/ci/ci-fcsl-pcm.sh b/dev/ci/ci-fcsl-pcm.sh
new file mode 100755
index 00000000..cb951630
--- /dev/null
+++ b/dev/ci/ci-fcsl-pcm.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+install_ssreflect
+
+git_download fcsl_pcm
+
+( cd "${CI_BUILD_DIR}/fcsl_pcm" && make )
diff --git a/dev/ci/ci-fiat-crypto-legacy.sh b/dev/ci/ci-fiat-crypto-legacy.sh
new file mode 100755
index 00000000..e0395754
--- /dev/null
+++ b/dev/ci/ci-fiat-crypto-legacy.sh
@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+FORCE_GIT=1
+git_download fiat_crypto
+
+fiat_crypto_legacy_CI_TARGETS1="print-old-pipeline-lite old-pipeline-lite lite-display"
+fiat_crypto_legacy_CI_TARGETS2="print-old-pipeline-nobigmem old-pipeline-nobigmem nonautogenerated-specific nonautogenerated-specific-display"
+
+( cd "${CI_BUILD_DIR}/fiat_crypto" && git submodule update --init --recursive && \
+  make ${fiat_crypto_legacy_CI_TARGETS1} && make -j 1 ${fiat_crypto_legacy_CI_TARGETS2} )
diff --git a/dev/ci/ci-fiat-crypto.sh b/dev/ci/ci-fiat-crypto.sh
new file mode 100755
index 00000000..7e8013be
--- /dev/null
+++ b/dev/ci/ci-fiat-crypto.sh
@@ -0,0 +1,14 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+FORCE_GIT=1
+git_download fiat_crypto
+
+# We need a larger stack size to not overflow ocamlopt+flambda when
+# building the executables.
+# c.f. https://github.com/coq/coq/pull/8313#issuecomment-416650241
+
+( cd "${CI_BUILD_DIR}/fiat_crypto" && git submodule update --init --recursive && \
+  ulimit -s 32768 && make new-pipeline c-files )
diff --git a/dev/ci/ci-fiat-parsers.sh b/dev/ci/ci-fiat-parsers.sh
new file mode 100755
index 00000000..ac74ebf6
--- /dev/null
+++ b/dev/ci/ci-fiat-parsers.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+FORCE_GIT=1
+git_download fiat_parsers
+
+( cd "${CI_BUILD_DIR}/fiat_parsers" && make parsers parsers-examples && make fiat-core )
diff --git a/dev/ci/ci-flocq.sh b/dev/ci/ci-flocq.sh
new file mode 100755
index 00000000..e87483df
--- /dev/null
+++ b/dev/ci/ci-flocq.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download Flocq
+
+( cd "${CI_BUILD_DIR}/Flocq" && ./autogen.sh && ./configure && ./remake "-j${NJOBS}" )
diff --git a/dev/ci/ci-formal-topology.sh b/dev/ci/ci-formal-topology.sh
new file mode 100755
index 00000000..8be5a06e
--- /dev/null
+++ b/dev/ci/ci-formal-topology.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download formal_topology
+
+( cd "${CI_BUILD_DIR}/formal_topology" && make )
diff --git a/dev/ci/ci-geocoq.sh b/dev/ci/ci-geocoq.sh
new file mode 100755
index 00000000..8c573184
--- /dev/null
+++ b/dev/ci/ci-geocoq.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+install_ssralg
+
+git_download GeoCoq
+
+( cd "${CI_BUILD_DIR}/GeoCoq" && ./configure.sh && make )
diff --git a/dev/ci/ci-hott.sh b/dev/ci/ci-hott.sh
new file mode 100755
index 00000000..9a0726a1
--- /dev/null
+++ b/dev/ci/ci-hott.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download HoTT
+
+( cd "${CI_BUILD_DIR}/HoTT" && ./autogen.sh && ./configure && make )
diff --git a/dev/ci/ci-iris-lambda-rust.sh b/dev/ci/ci-iris-lambda-rust.sh
new file mode 100755
index 00000000..6960a8b9
--- /dev/null
+++ b/dev/ci/ci-iris-lambda-rust.sh
@@ -0,0 +1,30 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+install_ssreflect
+
+# Setup lambdaRust first
+git_download lambdaRust
+
+# Extract required version of Iris
+Iris_REF=$(grep -F coq-iris < "${CI_BUILD_DIR}/lambdaRust/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/')
+
+# Setup Iris
+git_download Iris
+
+# Extract required version of std++
+stdpp_REF=$(grep -F coq-stdpp < "${CI_BUILD_DIR}/Iris/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/')
+
+# Setup std++
+git_download stdpp
+
+# Build std++
+( cd "${CI_BUILD_DIR}/stdpp" && make && make install )
+
+# Build and validate Iris
+( cd "${CI_BUILD_DIR}/Iris" && make && make validate && make install )
+
+# Build lambdaRust
+( cd "${CI_BUILD_DIR}/lambdaRust" && make && make install )
diff --git a/dev/ci/ci-ltac2.sh b/dev/ci/ci-ltac2.sh
new file mode 100755
index 00000000..4df22bf2
--- /dev/null
+++ b/dev/ci/ci-ltac2.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download ltac2
+
+( cd "${CI_BUILD_DIR}/ltac2" && make && make tests && make install )
diff --git a/dev/ci/ci-math-classes.sh b/dev/ci/ci-math-classes.sh
new file mode 100755
index 00000000..ae31a8e7
--- /dev/null
+++ b/dev/ci/ci-math-classes.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download math_classes
+
+( cd "${CI_BUILD_DIR}/math_classes" && ./configure.sh && make && make install )
diff --git a/dev/ci/ci-math-comp.sh b/dev/ci/ci-math-comp.sh
new file mode 100755
index 00000000..74f1a627
--- /dev/null
+++ b/dev/ci/ci-math-comp.sh
@@ -0,0 +1,12 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download mathcomp
+
+( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" && make && make install )
+
+git_download oddorder
+
+( cd "${CI_BUILD_DIR}/oddorder" && make )
diff --git a/dev/ci/ci-mtac2.sh b/dev/ci/ci-mtac2.sh
new file mode 100755
index 00000000..7075d4d7
--- /dev/null
+++ b/dev/ci/ci-mtac2.sh
@@ -0,0 +1,12 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download unicoq
+
+( cd "${CI_BUILD_DIR}/unicoq" && coq_makefile -f Make -o Makefile && make && make install )
+
+git_download mtac2
+
+( cd "${CI_BUILD_DIR}/mtac2" && coq_makefile -f _CoqProject -o Makefile && make )
diff --git a/dev/ci/ci-quickchick.sh b/dev/ci/ci-quickchick.sh
new file mode 100755
index 00000000..08686d7c
--- /dev/null
+++ b/dev/ci/ci-quickchick.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+install_ssreflect
+
+git_download quickchick
+
+( cd "${CI_BUILD_DIR}/quickchick" && make && make install)
diff --git a/dev/ci/ci-sf.sh b/dev/ci/ci-sf.sh
new file mode 100755
index 00000000..58bbb722
--- /dev/null
+++ b/dev/ci/ci-sf.sh
@@ -0,0 +1,18 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+mkdir -p "${CI_BUILD_DIR}" && cd "${CI_BUILD_DIR}" || exit 1
+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
+
+( cd lf && make clean && make )
+
+( cd plf && sed -i.bak 's/(K,N)/((K,N))/' LibTactics.v && make clean && make )
+
+( cd vfa && make clean && make )
diff --git a/dev/ci/ci-simple-io.sh b/dev/ci/ci-simple-io.sh
new file mode 100755
index 00000000..ddc1590d
--- /dev/null
+++ b/dev/ci/ci-simple-io.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+
+. "${ci_dir}/ci-common.sh"
+
+git_download simple_io
+
+( cd "${CI_BUILD_DIR}/simple_io" && make build && make install)
diff --git a/dev/ci/ci-tlc.sh b/dev/ci/ci-tlc.sh
new file mode 100755
index 00000000..a2f0bea5
--- /dev/null
+++ b/dev/ci/ci-tlc.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+FORCE_GIT=1
+git_download tlc
+
+( cd "${CI_BUILD_DIR}/tlc" && make )
diff --git a/dev/ci/ci-unimath.sh b/dev/ci/ci-unimath.sh
new file mode 100755
index 00000000..a7644fee
--- /dev/null
+++ b/dev/ci/ci-unimath.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download UniMath
+
+( cd "${CI_BUILD_DIR}/UniMath" && make BUILD_COQ=no )
diff --git a/dev/ci/ci-vst.sh b/dev/ci/ci-vst.sh
new file mode 100755
index 00000000..0fec1920
--- /dev/null
+++ b/dev/ci/ci-vst.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download VST
+
+( cd "${CI_BUILD_DIR}/VST" && make IGNORECOQVERSION=true )
diff --git a/dev/ci/ci-wrapper.sh b/dev/ci/ci-wrapper.sh
new file mode 100755
index 00000000..12a70176
--- /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/docker/bionic_coq/Dockerfile b/dev/ci/docker/bionic_coq/Dockerfile
new file mode 100644
index 00000000..da12f122
--- /dev/null
+++ b/dev/ci/docker/bionic_coq/Dockerfile
@@ -0,0 +1,59 @@
+# CACHEKEY: "bionic_coq-v8.8-V2018-09-20"
+# ^^ Update when modifying this file.
+
+FROM ubuntu:bionic
+LABEL maintainer="e@x80.org"
+
+ENV DEBIAN_FRONTEND="noninteractive"
+
+RUN apt-get update -qq && apt-get install --no-install-recommends -y -qq \
+        # Dependencies of the image, the test-suite and external projects
+        m4 automake autoconf time wget rsync git gcc-multilib opam \
+        # Dependencies of lablgtk (for CoqIDE)
+        libgtk2.0-dev libgtksourceview2.0-dev \
+        texlive-latex-extra texlive-fonts-recommended texlive-xetex latexmk xindy texlive-science tipa hevea \
+        python3-sphinx python3-pexpect python3-sphinx-rtd-theme python3-bs4 python3-sphinxcontrib.bibtex \
+        python3-setuptools python3-wheel python3-pip
+
+RUN pip3 install antlr4-python3-runtime
+
+# Basic OPAM setup
+ENV NJOBS="2" \
+    OPAMROOT=/root/.opamcache \
+    OPAMROOTISOK="true"
+
+# Base opam is the set of base packages required by Coq
+ENV COMPILER="4.02.3"
+
+RUN opam init -a -y -j $NJOBS --compiler="$COMPILER" default https://opam.ocaml.org && eval $(opam config env) && opam update
+
+# Common OPAM packages.
+# `num` does not have a version number as the right version to install varies
+# with the compiler version.
+ENV BASE_OPAM="num ocamlfind.1.8.0" \
+    CI_OPAM="menhir.20180530 ppx_tools_versioned.5.2 ppx_deriving.4.1.5 ocaml-migrate-parsetree.1.0.11 ocamlgraph.1.8.8"
+
+# BASE switch; CI_OPAM contains Coq's CI dependencies.
+ENV CAMLP5_VER="6.14" \
+    COQIDE_OPAM="lablgtk.2.18.5 conf-gtksourceview.2"
+
+RUN opam switch -y -j $NJOBS "$COMPILER" && eval $(opam config env) && \
+    opam install -j $NJOBS $BASE_OPAM && \
+    opam install -j $NJOBS camlp5.$CAMLP5_VER $COQIDE_OPAM $CI_OPAM
+
+# base+32bit switch
+RUN opam switch -y -j $NJOBS "${COMPILER}+32bit" && eval $(opam config env) && \
+    opam install -j $NJOBS $BASE_OPAM camlp5.$CAMLP5_VER
+
+# EDGE switch
+ENV COMPILER_EDGE="4.07.0" \
+    CAMLP5_VER_EDGE="7.06" \
+    COQIDE_OPAM_EDGE="lablgtk.2.18.6 conf-gtksourceview.2"
+
+RUN opam switch -y -j $NJOBS $COMPILER_EDGE && eval $(opam config env) && \
+    opam install -j $NJOBS $BASE_OPAM camlp5.$CAMLP5_VER_EDGE $COQIDE_OPAM_EDGE
+
+# BE+flambda switch
+RUN opam switch -y -j $NJOBS "${COMPILER_EDGE}+flambda" && eval $(opam config env) && \
+    opam install -j $NJOBS $BASE_OPAM && \
+    opam install -j $NJOBS camlp5.$CAMLP5_VER_EDGE $COQIDE_OPAM_EDGE $CI_OPAM
diff --git a/dev/ci/gitlab.bat b/dev/ci/gitlab.bat
new file mode 100755
index 00000000..ee1b17b6
--- /dev/null
+++ b/dev/ci/gitlab.bat
@@ -0,0 +1,131 @@
+@ECHO OFF
+
+REM This script builds and signs the Windows packages on Gitlab
+
+ECHO "Start Time"
+TIME /T
+
+REM List currently used cygwin and target folders for debugging / maintenance purposes
+
+ECHO "Currently used cygwin folders"
+DIR C:\cygwin*
+ECHO "Currently used target folders"
+DIR C:\coq*
+
+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 DESTCOQ=C:\coq%ARCH%_inst
+
+CALL :MakeUniqueFolder %CYGROOT% CYGROOT
+CALL :MakeUniqueFolder %DESTCOQ% DESTCOQ
+
+powershell -Command "(New-Object Net.WebClient).DownloadFile('http://www.cygwin.com/%SETUP%', '%SETUP%')"
+SET CYGCACHE=%CYGROOT%\var\cache\setup
+SET CI_PROJECT_DIR_MFMT=%CI_PROJECT_DIR:\=/%
+SET CI_PROJECT_DIR_CFMT=%CI_PROJECT_DIR_MFMT:C:/=/cygdrive/c/%
+SET COQREGTESTING=Y
+SET PATH=%PATH%;C:\Program Files\7-Zip\;C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin
+
+if exist %CYGROOT%\build\ rd /s /q %CYGROOT%\build
+if exist %DESTCOQ%\ rd /s /q %DESTCOQ%
+
+call %CI_PROJECT_DIR%\dev\build\windows\MakeCoq_MinGW.bat -threads=1 ^
+  -arch=%ARCH% -installer=Y -coqver=%CI_PROJECT_DIR_CFMT% ^
+  -destcyg=%CYGROOT% -destcoq=%DESTCOQ% -cygcache=%CYGCACHE% ^
+  -addon=bignums ^
+  -addon=equations ^
+  -addon=ltac2 ^
+  -addon=mtac2 ^
+  -addon=mathcomp ^
+  -addon=menhir ^
+  -addon=menhirlib ^
+  -addon=compcert ^
+  -addon=vst ^
+  -addon=aactactics ^
+  -addon=extlib ^
+  -addon=quickchick ^
+  -addon=coquelicot ^
+  -make=N ^
+  -setup %CI_PROJECT_DIR%\%SETUP% || GOTO ErrorCopyLogFilesAndExit
+
+ECHO "Start Artifact Creation"
+TIME /T
+
+mkdir artifacts
+
+CALL :CopyLogFiles
+
+copy "%CYGROOT%\build\coq-local\dev\nsis\*.exe" artifacts || GOTO ErrorExit
+REM The open source archive is only required for release builds
+IF DEFINED WIN_CERTIFICATE_PATH (
+  7z a artifacts\coq-opensource-archive-windows-%ARCHLONG%.zip %CYGROOT%\build\tarballs\* || GOTO ErrorExit
+) ELSE (
+  REM In non release builds, create a dummy file
+  ECHO "This is not a release build - open source archive not created / uploaded" > artifacts\coq-opensource-info.txt
+)
+
+REM DO NOT echo the signing command below, as this would leak secrets in the logs
+IF DEFINED WIN_CERTIFICATE_PATH (
+  IF DEFINED WIN_CERTIFICATE_PASSWORD (
+    ECHO Signing package
+    @signtool sign /f %WIN_CERTIFICATE_PATH% /p %WIN_CERTIFICATE_PASSWORD% dev\nsis\*.exe
+    signtool verify /pa dev\nsis\*.exe
+  )
+)
+
+ECHO "Finished Artifact Creation"
+TIME /T
+
+CALL :CleanupFolders
+
+ECHO "Finished Cleanup"
+TIME /T
+
+GOTO :EOF
+
+:CopyLogFiles
+  ECHO Copy log files for artifact upload
+  MKDIR artifacts\buildlogs
+  COPY %CYGROOT%\build\buildlogs\* artifacts\buildlogs
+  MKDIR artifacts\filelists
+  COPY %CYGROOT%\build\filelists\* artifacts\filelists
+  MKDIR artifacts\flagfiles
+  COPY %CYGROOT%\build\flagfiles\* artifacts\flagfiles
+  GOTO :EOF
+
+:CleanupFolders
+  ECHO "Cleaning %CYGROOT%"
+  DEL /S /F /Q "%CYGROOT%" > NUL
+  ECHO "Cleaning %DESTCOQ%"
+  DEL /S /F /Q "%DESTCOQ%" > NUL
+  GOTO :EOF
+
+:MakeUniqueFolder
+  REM Create a uniquely named folder
+  REM This script is safe because folder creation is atomic - either we create it or fail
+  REM %1 = base path or directory (_%RANDOM%_%RANDOM% is appended to this)
+  REM %2 = name of the variable which receives the unique folder name
+  SET "UNIQUENAME=%1_%RANDOM%_%RANDOM%"
+  MKDIR "%UNIQUENAME%"
+  IF ERRORLEVEL 1 GOTO :MakeUniqueFolder
+  SET "%2=%UNIQUENAME%"
+  GOTO :EOF
+
+:ErrorCopyLogFilesAndExit
+  CALL :CopyLogFiles
+  REM fall through
+
+:ErrorExit
+  CALL :CleanupFolders
+  ECHO ERROR %0 failed
+  EXIT /b 1
diff --git a/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh b/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh
new file mode 100644
index 00000000..be0058b6
--- /dev/null
+++ b/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh
@@ -0,0 +1,4 @@
+if [ "$CI_PULL_REQUEST" = "669" ] || [ "$CI_BRANCH" = "ssr-merge" ]; then
+    mathcomp_CI_REF=ssr-merge
+    mathcomp_CI_GITURL=https://github.com/maximedenes/math-comp
+fi
diff --git a/dev/ci/user-overlays/README.md b/dev/ci/user-overlays/README.md
new file mode 100644
index 00000000..b8628979
--- /dev/null
+++ b/dev/ci/user-overlays/README.md
@@ -0,0 +1,31 @@
+# Add overlays for your pull requests in this directory
+
+An overlay is a file containing very simple logic to test whether we are currently building a specific pull request or git branch (useful so that overlays work on your own fork) and which changes some of the variables whose default can be found in [`ci-basic-overlay.sh`](/dev/ci/ci-basic-overlay.sh).
+
+An overlay is a file which defines where to look for the patched version so that
+testing is possible. It redefines some variables from
+[`ci-basic-overlay.sh`](../ci-basic-overlay.sh):
+give the name of your branch / commit using a `_CI_REF` variable and the
+location of your fork using a `_CI_GITURL` variable.
+The `_CI_GITURL` variable should be the URL of the repository without a
+trailing `.git`.
+If the fork is not on the same platform (e.g. GitHub instead of GitLab), it is
+necessary to redefine the `_CI_ARCHIVEURL` variable as well.
+
+Moreover, the file contains very simple logic to test the pull request number
+or branch name and apply it only in this case.
+
+The name of your overlay file should start with a five-digit pull request
+number, followed by a dash, anything (for instance your GitHub nickname
+and the branch name), then a `.sh` extension (`[0-9]{5}-[a-zA-Z0-9-_]+.sh`).
+
+Example: `00669-maximedenes-ssr-merge.sh` containing
+
+```
+if [ "$CI_PULL_REQUEST" = "669" ] || [ "$CI_BRANCH" = "ssr-merge" ]; then
+    mathcomp_CI_REF=ssr-merge
+    mathcomp_CI_GITURL=https://github.com/maximedenes/math-comp
+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
new file mode 100644
index 00000000..57c13690
--- /dev/null
+++ b/dev/core.dbg
@@ -0,0 +1,20 @@
+source camlp5.dbg
+load_printer threads.cma
+load_printer str.cma
+load_printer clib.cma
+load_printer lib.cma
+load_printer dynlink.cma
+load_printer kernel.cma
+load_printer library.cma
+load_printer engine.cma
+load_printer pretyping.cma
+load_printer interp.cma
+load_printer proofs.cma
+load_printer parsing.cma
+load_printer printing.cma
+load_printer tactics.cma
+load_printer vernac.cma
+load_printer stm.cma
+load_printer toplevel.cma
+load_printer intf.cma
+load_printer ltac_plugin.cmo
diff --git a/dev/db b/dev/db
index f226291d..2f8c1348 100644
--- a/dev/db
+++ b/dev/db
@@ -1,60 +1,88 @@
-load_printer "printers.cma"
+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.ppuni
-install_printer Top_printers.ppuniverses
-install_printer Top_printers.ppconstraints
-install_printer Top_printers.pptype
+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.ppenv
-install_printer Top_printers.ppnamedcontextval
+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.ppproofview
 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.ppuni_level
+install_printer Top_printers.ppuniverse_set
+install_printer Top_printers.ppuniverse_instance
+install_printer Top_printers.ppuniverse_context
+install_printer Top_printers.ppuniverse_context_set
+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.ppuniverses
+install_printer Top_printers.ppnamedcontextval
+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/dev/db_printers.ml b/dev/db_printers.ml
deleted file mode 100644
index 50059508..00000000
--- a/dev/db_printers.ml
+++ /dev/null
@@ -1,16 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-open Pp
-open Names
-
-let pp s = pp (hov 0 s)
-
-let prid id = Format.print_string (Id.to_string id)
-let prsp sp = Format.print_string (DirPath.to_string sp)
-
-
diff --git a/COMPATIBILITY b/dev/doc/COMPATIBILITY
index d423e71d..a81afca3 100644
--- a/COMPATIBILITY
+++ b/dev/doc/COMPATIBILITY
@@ -1,3 +1,13 @@
+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
+----------------------------------------------------------------
+
+- Extra superfluous names in introduction patterns may now raise an
+  error rather than a warning when the superfluous name is already in
+  use. The easy fix is to remove the superfluous name.
+
 Potential sources of incompatibilities between Coq V8.5 and V8.6
 ----------------------------------------------------------------
 
diff --git a/dev/doc/build-system.dev.txt b/dev/doc/build-system.dev.txt
index fefcb093..abba1342 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.
@@ -74,25 +74,25 @@ The Makefile is separated in several files :
 - Makefile.doc : specific rules for compiling the documentation.
 
 
-FIND_VCS_CLAUSE
+FIND_SKIP_DIRS
 ---------------
 
-The recommended style of using FIND_VCS_CLAUSE is for example
+The recommended style of using FIND_SKIP_DIRS is for example
 
- find . $(FIND_VCS_CLAUSE) '(' -name '*.example' ')' -print
- find . $(FIND_VCS_CLAUSE) '(' -name '*.example' -or -name '*.foo' ')' -print
+ find . $(FIND_SKIP_DIRS) '(' -name '*.example' ')' -print
+ find . $(FIND_SKIP_DIRS) '(' -name '*.example' -or -name '*.foo' ')' -print
 
 1)
 The parentheses even in the one-criteria case is so that if one adds
 other conditions, e.g. change the first example to the second
 
- find . $(FIND_VCS_CLAUSE) '(' -name '*.example' -and -not -name '*.bak.example' ')' -print
+ find . $(FIND_SKIP_DIRS) '(' -name '*.example' -and -not -name '*.bak.example' ')' -print
 
 one is not tempted to write
 
- find . $(FIND_VCS_CLAUSE) -name '*.example' -and -not -name '*.bak.example' -print
+ find . $(FIND_SKIP_DIRS) -name '*.example' -and -not -name '*.bak.example' -print
 
-because this will not necessarily work as expected; $(FIND_VCS_CLAUSE)
+because this will not necessarily work as expected; $(FIND_SKIP_DIRS)
 ends with an -or, and how it combines with what comes later depends on
 operator precedence and all that. Much safer to override it with
 parentheses.
@@ -105,13 +105,13 @@ As to the -print at the end, yes it is necessary. Here's why.
 You are used to write:
  find . -name '*.example'
 and it works fine. But the following will not:
- find . $(FIND_VCS_CLAUSE) -name '*.example'
-it will also list things directly matched by FIND_VCS_CLAUSE
+ find . $(FIND_SKIP_DIRS) -name '*.example'
+it will also list things directly matched by FIND_SKIP_DIRS
 (directories we want to prune, in which we don't want to find
 anything). C'est subtil... Il y a effectivement un -print implicite à
 la fin, qui fait que la commande habituelle sans print fonctionne
 bien, mais dès que l'on introduit d'autres commandes dans le lot (le
--prune de FIND_VCS_CLAUSE), ça se corse à cause d'histoires de
+-prune de FIND_SKIP_DIRS), ça se corse à cause d'histoires de
 parenthèses du -print implicite par rapport au parenthésage dans la
 forme recommandée d'utilisation:
 
diff --git a/dev/doc/build-system.txt b/dev/doc/build-system.txt
index 873adc1b..fd310161 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 3de938d7..ab78b095 100644
--- a/dev/doc/changes.txt
+++ b/dev/doc/changes.md
@@ -1,28 +1,433 @@
-=========================================
-= CHANGES BETWEEN COQ V8.5 AND COQ V8.6 =
-=========================================
+## Changes between Coq 8.7 and Coq 8.8
 
-** Parsing **
+### Bug tracker
 
-Pcoq.parsable now takes an extra optional filename argument so as to
+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`
+  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`
+
+We changed the type of the following functions:
+
+- `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.
+
+- `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 in the abstract syntax tree:
+
+- 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.
+
+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
+
+- 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".
+
+### STM 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.
+
+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.
+
+### 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
+  constant are visited during the execution of some reduction functions
+  (primarily cbv).
+
+  * `set_reduction_effect`: to declare a constant on which a given effect
+  hook should be called.
+
+- We renamed the following functions:
+
+  ```
+  Context.Rel.Declaration.fold   -> Context.Rel.Declaration.fold_constr
+  Context.Named.Declaration.fold -> Context.Named.Declaration.fold_constr
+  Printer.pr_var_list_decl       -> Printer.pr_compacted_decl
+  Printer.pr_var_decl            -> Printer.pr_named_decl
+  Nameops.lift_subscript         -> Nameops.increment_subscript
+  ```
+
+- We removed the following functions:
+
+  * `Termops.compact_named_context_reverse`: practical substitute is `Termops.compact_named_context`.
+  * `Namegen.to_avoid`: equivalent substitute is `Names.Id.List.mem`.
+
+- We renamed the following modules:
+
+  * `Context.ListNamed` -> `Context.Compacted`
+
+- The following type aliases where removed
+
+  * `Context.section_context`: it was just an alias for `Context.Named.t` which is still available.
+
+- The module `Constrarg` was merged into `Stdarg`.
+
+- The following types have been moved and modified:
+
+  * `local_binder` -> `local_binder_expr`
+  * `glob_binder` merged with `glob_decl`
+
+- The following constructors have been renamed:
+
+  ```
+  LocalRawDef -> CLocalDef
+  LocalRawAssum -> CLocalAssum
+  LocalPattern -> CLocalPattern
+  ```
+
+- 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
+  ones were preserving the original sharing of the type.
+
+- 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"`.
+
+- Location handling and AST attributes:
+
+  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
+  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;
+    ...
+  }
+  ```
+  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:
+
+  ```ocaml
+  | CCase(loc, a1) -> CCase(loc, f a1)
+  ```
+
+  is now done as:
+  ```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:
+
+  ```ocaml
+  | CCase(a1) -> CCase(f a1)
+  ```
+
+  This scheme based on records enables easy extensibility of the AST
+  node type without breaking compatibility.
+
+  Not all objects carrying a location have been converted to the
+  generic node representation, some of them may be converted in the
+  future, for some others the abstraction is not just worth it.
+
+  Thus, we still maintain a `'a Loc.located == Loc.t option * a'`,
+  tuple type which should be treated as private datatype (ok to match
+  against, but forbidden to manually build), and it is mandatory to
+  use it for objects that carry a location. This policy has been
+  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`:
+
+  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:
+
+  We have removed from Coqlib functions returning `constr` from
+  names. Now it is only possible to obtain references, that must be
+  processed wrt the particular needs of the client.
+  We have changed in constrintern the functions returnin `constr` as
+  well to return global references instead.
+
+  Users of `coq_constant/gen_constant` can do
+  `Universes.constr_of_global (find_reference dir r)` _however_ note
+  the warnings in the `Universes.constr_of_global` in the
+  documentation. It is very likely that you were previously suffering
+  from problems with polymorphic universes due to using
+  `Coqlib.coq_constant` that used to do this. You must rather use
+  `pf_constr_of_global` in tactics and `Evarutil.new_global` variants
+  when constructing terms in ML (see univpoly.txt for more information).
+
+### Tactic API
+
+- `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`.
+
+- 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
+  renamed and dualized into typecheck and has been made mandatory.
+
+### Ltac API
+
+Many Ltac specific API has been moved in its own ltac/ folder. Amongst other
+important things:
+
+- `Pcoq.Tactic` -> `Pltac`
+- `Constrarg.wit_tactic` -> `Tacarg.wit_tactic`
+- `Constrarg.wit_ltac` -> `Tacarg.wit_ltac`
+- API below `ltac/` that accepted a *`_tactic_expr` now accept a *`_generic_argument`
+  instead
+- Some printing functions were moved from `Pptactic` to `Pputils`
+- A part of `Tacexpr` has been moved to `Tactypes`
+- 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
+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
+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
+seemingly do not use any Ltac module, as their expansion do.
+
+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.
+
+### Additional changes in tactic extensions
+
+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
+
+- All error functions now take an optional parameter `?loc:Loc.t`. For
+  functions that used to carry a suffix `_loc`, such suffix has been
+  dropped.
+
+- `errorlabstrm` and `error` has been removed in favor of `user_err`.
+
+- The header parameter to `user_err` has been made optional.
+
+### Pretty printing
+
+Some functions have been removed, see pretty printing below for more
+details.
+
+#### Pretty Printing and XML protocol
+
+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:
+
+ - Richpp has been confined to IDE use. Most of previous uses of the
+   `richpp` type should be replaced now by `Pp.std_cmdpps`. Main API
+   has been updated.
+
+ - The XML protocol will send a new message type of `pp`, which should
+   be rendered client-wise.
+
+ - `Set Printing Width` is deprecated, now width is controlled
+   client-side.
+
+ - `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
+   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
+   val pifb  : unit -> std_ppcmds
+   val comment  : int -> std_ppcmds
+   val comments : ((int * int) * string) list ref
+   val eval_ppcmds : std_ppcmds -> std_ppcmds
+   val is_empty : std_ppcmds -> bool
+   val t : std_ppcmds -> std_ppcmds
+   val hb : int -> std_ppcmds
+   val vb : int -> std_ppcmds
+   val hvb : int -> std_ppcmds
+   val hovb : int -> std_ppcmds
+   val tb : unit -> std_ppcmds
+   val close : unit -> std_ppcmds
+   val tclose : unit -> std_ppcmds
+   val open_tag : Tag.t -> std_ppcmds
+   val close_tag : unit -> std_ppcmds
+   val msg_with  : ...
+
+   module Tag
+   ```
+
+### 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
+  over their input stream. As a consequence, their types have been
+  modified.
+
+- The main parsing entry point has also been moved to the
+  `Stm`. Parsing is considered a synchronous operation so it will
+  either succeed or raise an exception.
+
+- `Feedback` is now only emitted for asynchronous operations. As a
+  consequence, it always carries a valid stateid and the type has
+  changed to accommodate that.
+
+- A few unused hooks were removed due to cleanups, no clients known.
+
+### Toplevel and Vernacular API
+
+- The components related to vernacular interpretation have been moved
+  to their own folder `vernac/` whereas toplevel now contains the
+  proper toplevel shell and compiler.
+
+- 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
+
+- 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
+  query with its generated feedback.
+
+## Changes between Coq 8.5 and Coq 8.6
+
+### Parsing
+
+`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
@@ -49,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
@@ -61,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:
@@ -98,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
@@ -143,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
@@ -190,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
+
+- 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".
 
-** Refactoring : more mli interfaces and simpler grammar.cma **
+## 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).
@@ -355,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).
 
@@ -373,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
@@ -412,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
@@ -484,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
@@ -506,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
@@ -526,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
@@ -553,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 *)
@@ -671,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.
  
@@ -688,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
@@ -716,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.
 
@@ -744,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),
@@ -758,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 
@@ -767,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.
@@ -792,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)
@@ -808,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).
@@ -838,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/cic.dtd b/dev/doc/cic.dtd
index f2314e22..cc33efd4 100644
--- a/dev/doc/cic.dtd
+++ b/dev/doc/cic.dtd
@@ -125,7 +125,7 @@
           id     ID     #REQUIRED
           sort   %sort; #REQUIRED>
 
-<!-- The substitutions are ordered by increasing DeBrujin  -->
+<!-- The substitutions are ordered by increasing de Bruijn  -->
 <!-- index. An empty substitution means that that index is -->
 <!-- not accessible.                                       -->
 <!ELEMENT META (substitution*)>
diff --git a/dev/doc/coq-src-description.txt b/dev/doc/coq-src-description.txt
index 00e7f5c5..b3d49b7e 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
new file mode 100644
index 00000000..14a1cc69
--- /dev/null
+++ b/dev/doc/debugging.md
@@ -0,0 +1,106 @@
+Debugging from Coq toplevel using Caml trace mechanism
+======================================================
+
+  1. Launch bytecode version of Coq (coqtop.byte)
+  2. Access Ocaml toplevel using vernacular command 'Drop.'
+  3. Install load paths and pretty printers for terms, idents, ... using
+     Ocaml command '#use "base_include";;' (use '#use "include";;' for 
+     installing the advanced term pretty printers)
+  4. Use #trace to tell which function(s) to trace
+  5. Go back to Coq toplevel with 'go();;'
+  6. Test your Coq command and observe the result of tracing your functions
+  7. Freely switch from Coq to Ocaml toplevels with 'Drop.' and 'go();;'
+
+  You can avoid typing #use "include" (or "base_include") after Drop
+  by adding the following lines in your $HOME/.ocamlinit :
+
+   if Filename.basename Sys.argv.(0) = "coqtop.byte"
+   then ignore (Toploop.use_silently Format.std_formatter "include")
+
+  Hints: To remove high-level pretty-printing features (coercions,
+  notations, ...), use "Set Printing All". It will affect the #trace
+  printers too.
+
+
+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
+   byte-code version of `coqtop` must have been generated with `make byte`.
+
+   1. M-x camldebug
+   2. give the binary name bin/coqtop.byte
+   3. give ../dev/ocamldebug-coq
+   4. source db  (to get pretty-printers)
+   5. add breakpoints with C-x C-a C-b from the buffer displaying the ocaml
+      source
+   6. get more help from ocamldebug manual
+         run
+	 step
+         back
+         start
+	 next
+	 last
+	 print x (abbreviated into p x)
+	 ...
+   7. some hints: 
+
+   - To debug a failure/error/anomaly, add a breakpoint in
+     `Vernac.interp_vernac` (in `toplevel/vernac.ml`) at the with clause of the "try ... interp com
+     with ..." block, then go "back" a few steps to find where the
+     failure/error/anomaly has been raised
+   - Alternatively, for an error or an anomaly, add breakpoints in the middle  
+     of each of error* functions or anomaly* functions in lib/util.ml
+   - If "source db" fails, do a "make printers" and try again (it should build
+     top_printers.cmo and the core cma files).
+   - 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
+============================
+
+   Coq must be configured with option -profile
+
+   1. Run native Coq which must end normally (use Quit or option -batch)
+   2. gprof ./coqtop gmon.out
+
+Per function profiling
+======================
+
+   To profile function foo in file bar.ml, add the following lines, just
+   after the definition of the function:
+
+     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).
+
+   This has the effect to cumulate the time passed in foo under a
+   line of name "foo" which is displayed at the time coqtop exits.
diff --git a/dev/doc/debugging.txt b/dev/doc/debugging.txt
deleted file mode 100644
index f0df2fc3..00000000
--- a/dev/doc/debugging.txt
+++ /dev/null
@@ -1,78 +0,0 @@
-Debugging from Coq toplevel using Caml trace mechanism
-======================================================
-
-  1. Launch bytecode version of Coq (coqtop.byte or coqtop -byte)
-  2. Access Ocaml toplevel using vernacular command 'Drop.'
-  3. Install load paths and pretty printers for terms, idents, ... using
-     Ocaml command '#use "base_include";;' (use '#use "include";;' for 
-     installing the advanced term pretty printers)
-  4. Use #trace to tell which function(s) to trace
-  5. Go back to Coq toplevel with 'go();;'
-  6. Test your Coq command and observe the result of tracing your functions
-  7. Freely switch from Coq to Ocaml toplevels with 'Drop.' and 'go();;'
-
-  You can avoid typing #use "include" (or "base_include") after Drop
-  by adding the following lines in your $HOME/.ocamlinit :
-
-   if Filename.basename Sys.argv.(0) = "coqtop.byte"
-   then ignore (Toploop.use_silently Format.std_formatter "include")
-
-  Hints: To remove high-level pretty-printing features (coercions,
-  notations, ...), use "Set Printing All". It will affect the #trace
-  printers too.
-
-
-Debugging from Caml debugger
-============================
-
-   Needs tuareg mode in Emacs
-   Coq must be configured with -debug and -local (./configure -debug -local)
-
-   1. M-x camldebug
-   2. give the binary name bin/coqtop.byte
-   3. give ../dev/ocamldebug-coq
-   4. source db  (to get pretty-printers)
-   5. add breakpoints with C-x C-a C-b from the buffer displaying the ocaml
-      source
-   6. get more help from ocamldebug manual
-         run
-	 step
-         back
-         start
-	 next
-	 last
-	 print x (abbreviated into p x)
-	 ...
-   7. some hints: 
-
-   - To debug a failure/error/anomaly, add a breakpoint in
-     Vernac.vernac_com at the with clause of the "try ... interp com
-     with ..." block, then go "back" a few steps to find where the
-     failure/error/anomaly has been raised
-   - Alternatively, for an error or an anomaly, add breakpoints in the middle  
-     of each of error* functions or anomaly* functions in lib/util.ml
-   - If "source db" fails, recompile printers.cma with
-     "make dev/printers.cma" and try again
-
-Global gprof-based profiling
-============================
-
-   Coq must be configured with option -profile
-
-   1. Run native Coq which must end normally (use Quit or option -batch)
-   2. gprof ./coqtop gmon.out
-
-Per function profiling
-======================
-
-   1. 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;;
-
-     where foo is assumed to have three arguments (adapt using
-     Profile.profile1, Profile. profile2, etc).
-
-     This has the effect to cumulate the time passed in foo under a
-     line of name "foo" which is displayed at the time coqtop exits.
diff --git a/dev/doc/econstr.md b/dev/doc/econstr.md
new file mode 100644
index 00000000..bb17e8fb
--- /dev/null
+++ b/dev/doc/econstr.md
@@ -0,0 +1,129 @@
+# Evar-insensitive terms (EConstr)
+
+Evar-insensitive terms were introduced in 8.7, following
+[CEP #10](https://github.com/coq/ceps/blob/master/text/010-econstr.md). We will
+not recap the motivations in this document and rather summarize the code changes
+to perform.
+
+## Overview
+
+The essential datastructures are defined in
+[the `EConstr` module](/engine/eConstr.mli) module. It defines
+the tactic counterparts of kernel data structures such as terms
+(`EConstr.constr`), universes (`EConstr.ESorts.t`) and contexts
+(`EConstr.*_context`).
+
+The main difference with kernel-side types is that observing them requires
+an evar-map at hand in order to normalize evars on the fly. The basic primitive
+to observe an `EConstr.t` is the following function:
+```
+val kind : Evd.evar_map -> t -> (t, t, ESorts.t, EInstance.t) Constr.kind_of_term
+(** Same as {!Constr.kind} except that it expands evars and normalizes
+    universes on the fly. *)
+```
+
+Essentially, each time it sees an evar which happens to be defined in the
+provided evar-map, it replaces it with the corresponding body and carries on.
+
+Due to universe unification occuring at the tactic level, the same goes for
+universe instances and sorts. See the `ESort` and `EInstance` modules in
+`EConstr`.
+
+This normalization is critical for the soundness of tactics. Before EConstr, a
+lot of bugs were lurking in the code base, a few still are (most notably in
+meta-based unification) and failure to respect the guidelines thereafter may
+result in nasal demons.
+
+## Transition path
+
+### Types
+
+As a rule of thumb, all functions living at the tactic level should manipulate
+`EConstr.t` instead of `Constr.t`, and similarly for the other data structures.
+
+To ease the transition, the `EConstr` module defines a handful of aliases to
+shadow the type names from the kernel.
+
+It is recommended to perform the following replacement in headers.
+```ocaml
+(** Kernel types. You may remove the two following opens if you want. Beware
+    that [kind_of_term] needs to be in scope if you use [EConstr.kind] so that
+    you may still need to open one of the two. *)
+open Term
+open Constr
+(** Tactic types. Open this after to shadow kernel types. *)
+open EConstr
+```
+
+Note that the `EConstr` module also redefines a `Vars` submodule.
+
+### Evar-map-passing
+
+All functions deconstructing an econstr need to take an evar-map as a parameter.
+Therefore, you need to pass one as an argument virtually everywhere.
+
+In the Coq source code, it is recommended to take the evar-map as a first
+argument called `sigma`, except if the function also takes an environment in
+which case it is passed second. Namely, the two typical instances are:
+```ocaml
+let foo sigma c = mycode
+val foo : Evd.evar_map -> EConstr.t -> Foo.t
+
+let bar env sigma c = mycode
+val bar : Environ.env -> Evd.evar_map -> EConstr.t -> Bar.t
+```
+
+The EConstr API makes the code much more sensitive to evar-maps, because a
+lot of now useless normalizations were removed. Thus one should be cautious of
+**not** dropping the evar-map when it has been updated, and should rather stick
+to a strict state-passing discipline. Unsound primitives like
+`Typing.unsafe_type_of` are also a known source of problems, so you should
+replace them with the corresponding evar-map-returning function and thread it
+properly.
+
+### Functions
+
+Many functions from `Constr` and `Term` are redefined to work on econstr in
+the `EConstr` module, so that it is often enough to perform the `open` as
+described above to replace them. Their type may differ though, because they now
+need access to an evar-map. A lot of econstr-manipulating functions are also
+defined in [`Termops`](/engine/termops.mli).
+
+Functions manipulating tactic terms and kernel terms share the same name if they
+are the equivalent one of the other. Do not hesitate to grep Coq mli files to
+find the equivalent of a function you want to port if it is neither in `EConstr`
+nor in `Termops` (this should be very rare).
+
+### Conversion
+
+Sometimes you do not have any other choice than calling kernel-side functions
+on terms, and conversely to turn a kernel term into a tactic term.
+
+There are two functions to do so.
+* `EConstr.of_constr` turns kernel terms into tactic terms. It is currently
+the physical identity, and thus O(1), but this may change in the future.
+* `EConstr.to_constr` turns tactic terms into kernel terms. It performs a
+full-blown normalization of the given term, which is O(n) and potentially
+costly.
+
+For performance reasons, avoiding to jump back and forth between kernel and
+tactic terms is recommended.
+
+There are also a few unsafe conversion functions that take advantage of the
+fact that `EConstr.t` is internally the same as `Constr.t`. Namely,
+`EConstr.Unsafe.to_constr` is the physical identity. It should **not** be used
+in typical code and is instead provided for efficiency **when you know what you
+are doing**. Either use it to reimplement low-level functions that happen to
+be insensitive externally, or use it to provide backward compatibility with
+broken code that relies on evar-sensitivity. **Do not use it because it is
+easier than stuffing evar-maps everywhere.** You've been warned.
+
+## Notes
+
+The EConstr branch fixed a lot of eisenbugs linked to lack of normalization
+everywhere, most notably in unification. It may also have introduced a few, so
+if you see a change in behaviour *that looks like a bug*, please report it.
+Obviously, unification is not specified, so it's hard to tell apart, but still.
+
+Efficiency has been affected as well. We now pay an overhead when observing a
+term, but at the same time a lot of costly upfront normalizations were removed.
diff --git a/dev/doc/naming-conventions.tex b/dev/doc/naming-conventions.tex
index 34916494..337b9226 100644
--- a/dev/doc/naming-conventions.tex
+++ b/dev/doc/naming-conventions.tex
@@ -267,7 +267,7 @@ If the conclusion is in the other way than listed below, add suffix
 {forall x y:D, op (op' x y) = op' x (op y)}
 
 \itemrule{Idempotency of binary operator {\op} on domain {\D}}{Dop\_idempotent}
-{forall x:D, op x n = x}
+{forall x:D, op x x = x}
 
 \itemrule{Idempotency of unary operator {\op} on domain {\D}}{Dop\_idempotent}
 {forall x:D, op (op x) = op x}
diff --git a/dev/doc/notes-on-conversion b/dev/doc/notes-on-conversion.v
index a81f170c..a81f170c 100644
--- a/dev/doc/notes-on-conversion
+++ b/dev/doc/notes-on-conversion.v
diff --git a/dev/doc/primproj.md b/dev/doc/primproj.md
new file mode 100644
index 00000000..ea76aeea
--- /dev/null
+++ b/dev/doc/primproj.md
@@ -0,0 +1,41 @@
+Primitive Projections
+---------------------
+
+    | Proj of Projection.t * constr
+
+Projections are always applied to a term, which must be of a record
+type (i.e. reducible to an inductive type `I params`). Type-checking,
+reduction and conversion are fast (not as fast as they could be yet)
+because we don't keep parameters around. As you can see, it's
+currently a `constant` that is used here to refer to the projection,
+that will change to an abstract `projection` type in the future.
+Basically a projection constant records which inductive it is a
+projection for, the number of params and the actual position in the
+constructor that must be projected. For compatibility reason, we also
+define an eta-expanded form (accessible from user syntax `@f`). The
+constant_entry of a projection has both informations. Declaring a
+record (under `Set Primitive Projections`) will generate such
+definitions. The API to declare them is not stable at the moment, but
+the inductive type declaration also knows about the projections, i.e.
+a record inductive type decl contains an array of terms representing
+the projections. This is used to implement eta-conversion for record
+types (with at least one field and having all projections definable).
+The canonical value being `Build_R (pn x) ... (pn x)`. Unification and
+conversion work up to this eta rule. The records can also be universe
+polymorphic of course, and we don't need to keep track of the universe
+instance for the projections either. Projections are reduced _eagerly_
+everywhere, and introduce a new `Zproj` constructor in the abstract
+machines that obeys both the delta (for the constant opacity) and iota
+laws (for the actual reduction). Refolding works as well (afaict), but
+there is a slight hack there related to universes (not projections).
+
+For the ML programmer, the biggest change is that pattern-matchings on
+kind_of_term require an additional case, that is handled usually
+exactly like an `App (Const p) arg`.
+
+There are slight hacks related to hints is well, to use the primitive
+projection form of f when one does `Hint Resolve f`. Usually hint
+resolve will typecheck the term, resulting in a partially applied
+projection (disallowed), so we allow it to take
+`constr_or_global_reference` arguments instead and special-case on
+projections. Other tactic extensions might need similar treatment.
diff --git a/dev/doc/profiling.txt b/dev/doc/profiling.txt
index 9d2ebf0d..b5dd8445 100644
--- a/dev/doc/profiling.txt
+++ b/dev/doc/profiling.txt
@@ -7,7 +7,7 @@ want to profile time or memory consumption. AFAIK, this only works for Linux.
 
 In Coq source folder:
 
-opam switch 4.02.1+fp
+opam switch 4.02.3+fp
 ./configure -local -debug
 make
 perf record -g bin/coqtop -compile file.v
diff --git a/dev/doc/proof-engine.md b/dev/doc/proof-engine.md
new file mode 100644
index 00000000..8f96ac22
--- /dev/null
+++ b/dev/doc/proof-engine.md
@@ -0,0 +1,133 @@
+Tutorial on the new proof engine for ML tactic writers
+======================================================
+
+Starting from Coq 8.5, a new proof engine has been introduced, replacing the old
+meta-based engine which had a lot of drawbacks, ranging from expressivity to
+soundness, the major one being that the type of tactics was transparent. This
+was pervasively abused and made virtually impossible to tweak the implementation
+of the engine.
+
+The old engine is deprecated and is slowly getting removed from the source code.
+
+The new engine relies on a monadic API defined in the `Proofview` module. Helper
+functions and higher-level operations are defined in the `Tacmach` and
+`Tacticals` modules, and end-user tactics are defined amongst other in the
+`Tactics` module.
+
+At the root of the engine is a representation of proofs as partial terms that
+can contain typed holes, called evars, short for *existential variable*. An evar
+is essentially defined by its context and return type, that we will write
+`?e : [Γ ⊢ _ : A]`. An evar `?e` must be applied to a substitution `σ` of type
+`Γ` (i.e. a list of terms) to produce a term of type `A`, which is done by
+applying `EConstr.mkEvar`, and which we will write `?e{σ}`.
+
+The engine monad features a notion of global state called `evar_map`, defined in
+the `Evd` module, which is the structure containing the incremental refinement
+of evars. `Evd` is a low-level API and its use is discouraged in favour of the
+`Evarutil` module which provides more abstract primitives.
+
+In addition to this state, the monad also features a goal state, that is
+an ordered list of current holes to be filled. While these holes are referred
+to as goals at a high-enough level, they are actually no more than evars. The
+API provided to deal with these holes can be found in the `Proofview.Goal`
+module. Tactics are naturally operating on several goals at once, so that it is
+usual to use the `Proofview.Goal.enter` function and its variants to dispatch a
+tactic to each of the goals under focus.
+
+Primitive tactics by term refining
+-------------------------------------
+
+A typical low-level tactic will be defined by plugging partial terms in the
+goal holes thanks to the `Refine` module, and in particular to the
+`Refine.refine` primitive.
+
+```ocaml
+val refine : typecheck:bool -> Constr.t Sigma.run -> unit tactic
+(** In [refine typecheck t], [t] is a term with holes under some
+    [evar_map] context. The term [t] is used as a partial solution
+    for the current goal (refine is a goal-dependent tactic), the
+    new holes created by [t] become the new subgoals. Exceptions
+    raised during the interpretation of [t] are caught and result in
+    tactic failures. If [typecheck] is [true] [t] is type-checked beforehand. *)
+```
+
+In a first approximation, we can think of `'a Sigma.run` as
+`evar_map -> 'a * evar_map`. What the function does is first evaluate the
+`Constr.t Sigma.run` argument in the current proof state, and then use the
+resulting term as a filler for the proof under focus. All evars that have been
+created by the invocation of this thunk are then turned into new goals added in
+the order of their creation.
+
+To see how we can use it, let us have a look at an idealized example, the `cut`
+tactic. Assuming `X` is a type, `cut X` fills the current goal `[Γ ⊢ _ : A]`
+with a term `let x : X := ?e2{Γ} in ?e1{Γ} x` where `x` is a fresh variable and
+`?e1 : [Γ ⊢ _ : X -> A]` and `?e2 : [Γ ⊢ _ : X]`. The current goal is solved and
+two new holes `[e1, e2]` are added to the goal state in this order.
+
+```ocaml
+let cut c =
+  let open Sigma in
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
+    (** In this block, we focus on one goal at a time indicated by gl *)
+    let env = Proofview.Goal.env gl in
+    (** Get the context of the goal, essentially [Γ] *)
+    let concl = Proofview.Goal.concl gl in
+    (** Get the conclusion [A] of the goal *)
+    let hyps = Tacmach.New.pf_ids_of_hyps gl in
+    (** List of hypotheses from the context of the goal *)
+    let id = Namegen.next_name_away Anonymous hyps in
+    (** Generate a fresh identifier *)
+    let t = mkArrow c (Vars.lift 1 concl) in
+    (** Build [X -> A]. Note the lifting of [A] due to being on the right hand
+        side of the arrow. *)
+    Refine.refine { run = begin fun sigma ->
+      (** All evars generated by this block will be added as goals *)
+      let Sigma (f, sigma, p) = Evarutil.new_evar env sigma t in
+      (** Generate ?e1 : [Γ ⊢ _ : X -> A], add it to sigma, and return the
+          term [f := Γ ⊢ ?e1{Γ} : X -> A] with the updated sigma. The identity
+          substitution for [Γ] is extracted from the [env] argument, so that
+          one must be careful to pass the correct context here in order for the
+          resulting term to be well-typed. The [p] return value is a proof term
+          used to enforce sigma monotonicity. *)
+      let Sigma (x, sigma, q) = Evarutil.new_evar env sigma c in
+      (** Generate ?e2 : [Γ ⊢ _ : X] in sigma and return
+          [x := Γ ⊢ ?e2{Γ} : X]. *)
+      let r = mkLetIn (Name id, x, c, mkApp (Vars.lift 1 r, [|mkRel 1|])) in
+      (** Build [r := Γ ⊢ let id : X := ?e2{Γ} in ?e1{Γ} id : A] *)
+      Sigma (r, sigma, p +> q)
+      (** Fills the current hole with [r]. The [p +> q] thingy ensures
+          monotonicity of sigma. *)
+    end }
+  end }
+```
+
+The `Evarutil.new_evar` function is the preferred way to generate evars in
+tactics. It returns a ready-to-use term, so that one does not have to call
+the `mkEvar` primitive. There are lower-level variants whose use is dedicated to
+special use cases, *e.g.* whenever one wants a non-identity substitution. One
+should take care to call it with the proper `env` argument so that the evar
+and term it generates make sense in the context they will be plugged in.
+
+For the sake of completeness, the old engine was relying on the `Tacmach.refine`
+function to provide a similar feature. Nonetheless, it was using untyped metas
+instead of evars, so that it had to mangle the argument term to actually produce
+the term that would be put into the hole. For instance, to work around the
+untypedness, some metas had to be coerced with a cast to enforce their type,
+otherwise leading to runtime errors. This was working for very simple
+instances, but was unreliable for everything else.
+
+High-level composition of tactics
+------------------------------------
+
+It is possible to combine low-level refinement tactics to create more powerful
+abstractions. While it was the standard way of doing things in the old engine
+to overcome its technical limitations (namely that one was forced to go through
+a limited set of derivation rules), it is recommended to generate proofs as
+much as possible by refining in ML tactics when it is possible and easy enough.
+Indeed, this prevents dependence on fragile constructions such as unification.
+
+Obviously, it does not forbid the use of tacticals to mimick what one would do
+in Ltac. Each Ltac primitive has a corresponding ML counterpart with simple
+semantics. A list of such tacticals can be found in the `Tacticals` module. Most
+of them are a porting of the tacticals from the old engine to the new one, so
+that if they share the same name they are expected to have the same semantics.
diff --git a/dev/doc/setup.txt b/dev/doc/setup.txt
index 1b016a4e..c48c2d5d 100644
--- a/dev/doc/setup.txt
+++ b/dev/doc/setup.txt
@@ -12,7 +12,7 @@ How to compile Coq
 
 Getting build dependencies:
 
-  sudo apt-get install make opam git mercurial darcs
+  sudo apt-get install make opam git
   opam init --comp 4.02.3
   # Then follow the advice displayed at the end as how to update your ~/.bashrc and ~/.ocamlinit files.
   
@@ -41,17 +41,15 @@ Building coqtop:
   cd ~/git/coq
   git checkout trunk
   make distclean
-  ./configure -annotate -with-doc no -local -debug -usecamlp5
+  ./configure -profile devel
   make clean
   make -j4 coqide printers
 
-The "-annotate" option is essential when one wants to use Merlin.
+The "-profile devel" enables all options recommended for developers (like
+warnings, support for Merlin, etc).  Moreover Coq is configured so that
+it can be run without installing it (i.e. from the current directory).
 
-The "-local" option is useful if one wants to run the coqtop and coqide binaries without running make install
-
-The "-debug" option is essential if one wants to use ocamldebug with the coqtop binary.
-
-Then check if
+Once the compilation is over check if
 - bin/coqtop
 - bin/coqide
 behave as expected.
@@ -60,30 +58,12 @@ behave as expected.
 A note about rlwrap
 -------------------
 
-Running "coqtop" under "rlwrap" is possible, but 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)
@@ -281,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/style.txt b/dev/doc/style.txt
index 27695a09..2ee3dadd 100644
--- a/dev/doc/style.txt
+++ b/dev/doc/style.txt
@@ -1,75 +1,142 @@
-
-<< L'uniformité du style est plus importante que le style lui-même. >>
-(Kernigan & Pike, The Practice of Programming)
-
-Mode Emacs
-==========
-   Tuareg, que l'on trouve ici :  http://www.prism.uvsq.fr/~acohen/tuareg/
-
-   avec le réglage suivant :     (setq tuareg-in-indent 2)
-
-Types récursifs et filtrages
-============================
-   Une barre de séparation y compris sur le premier constructeur
-
-type t =
-  | A 
-  | B of machin
-
-match expr with
-  | A -> ...
-  | B x -> ...
-
-Remarque : à partir de la 8.2 environ, la tendance est à utiliser le
-format suivant qui permet de limiter l'escalade d'indentation tout en
-produisant un aspect visuel intéressant de bloc :
-
-type t =
-| A 
-| B of machin
-
-match expr with
-| A -> ...
-| B x -> ...
-
-let f expr = match expr with
-| A -> ...
-| B x -> ...
-
-let f expr = function
-| A -> ...
-| B x -> ...
-
-Le deuxième cas est obtenu sous tuareg avec les réglages
-
-  (setq tuareg-with-indent 0)
-  (setq tuareg-function-indent 0)
-  (setq tuareg-let-always-indent nil) /// notons que cette dernière est bien 
-                                      /// pour les let mais pas pour les let-in
-
-Conditionnelles
-===============
-  if condition then
-    premier-cas
-  else
-    deuxieme-cas
-
-  Si effets de bord dans les branches, utilisez begin ... end et non des
-  parenthèses i.e.
-
-  if condition then begin
-    instr1;
-    instr2
-  end else begin
-    instr3;
-    instr4
-  end
-    
-  Si la première branche lève une exception, évitez le else i.e.
-
-    if condition then                     if condition then error "machin";
-      error "machin"          ----->      suite
+<< Style uniformity is more important than style itself >>
+   (Kernigan & Pike, The Practice of Programming)
+
+OCaml Style:
+- Spacing and indentation
+  - indent your code (using tuareg default)
+  - no strong constraints in formatting "let in"; possible styles are:
+    "let x = ... in"
+    "let x =
+       ... in"
+    "let
+       x = ...
+     in"
+  - but: no extra indentation before a "in" coming on next line,
+    otherwise, it first shifts further and further on the right,
+    reducing the amount of space available; second, it is not robust to
+    insertion of a new "let"
+  - it is established usage to have space around "|" as in
+    "match c with
+     | [] | [a] -> ...
+     | a::b::l -> ..."
+  - in a one-line "match", it is preferred to have no "|" in front of
+    the first case (this saves spaces for the match to hold in the line)
+  - from about 8.2, the tendency is to use the following format which
+    limit excessive indentation while providing an interesting "block" aspect
+    type t =
+    | A 
+    | B of machin
+
+    let f expr = match expr with
+    | A -> ...
+    | B x -> ...
+
+    let f expr = function
+    | A -> ...
+    | B x -> ...
+  - add spaces around = and == (make the code "breaths")
+  - the common usage is to write "let x,y = ... in ..." rather than
+    "let (x,y) = ... in ..."
+  - parenthesizing with either "(" and ")" or with "begin" and "end" is
+    common practice
+  - preferred layout for conditionals:
+    if condition then
+      premier-cas
     else
-      suite
-
-  
+      deuxieme-cas
+  - in case of effects in branches, use "begin ... end" rather than
+    parentheses
+    if condition then begin
+      instr1;
+      instr2
+    end else begin
+      instr3;
+      instr4
+    end
+  - if the first branch raises an exception, avoid the "else", i.e.:
+    if condition then                     if condition then error "foo";
+      error "foo"          ----->         bar
+    else
+      bar
+  - it is the usage not to use ;; to end OCaml sentences (however,
+    inserting ";;" can be useful for debugging syntax errors crossing
+    the boundary of functions)
+  - relevant options in tuareg:
+    (setq tuareg-in-indent 2)
+    (setq tuareg-with-indent 0)
+    (setq tuareg-function-indent 0)
+    (setq tuareg-let-always-indent nil)
+
+- Coding methodology
+  - no "try ... with _ -> ..." which catches even Sys.Break (Ctrl-C),
+    Out_of_memory, Stack_overflow, etc.
+    at least, use "try with e when Errors.noncritical e -> ..."
+    (to be detailed, Pierre L. ?)
+  - do not abuse of fancy combinators: sometimes what a "let rec" loop
+    does is more readable and simpler to grasp than what a "fold" does
+  - do not break abstractions: if an internal property is hidden
+    behind an interface, do no rely on it in code which uses this
+    interface (e.g. do not use List.map thinking it is left-to-right,
+    use map_left)
+  - in particular, do not use "=" on abstract types: there is no
+    reason a priori that it is the intended equality on this type; use the
+    "equal" function normally provided with the abstract type
+  - avoid polymorphically typed "=" whose implementation is not
+    optimized in OCaml and which has moreover no reason to be the
+    intended implementation of the equality when it comes to be
+    instantiated on a particular type (e.g. use List.mem_f,
+    List.assoc_f, rather than List.mem, List.assoc, etc, unless it is
+    absolutely clear that "=" will implement the intended equality, and
+    with the right complexity)
+  - any new general-purpose enough combinator on list should be put in
+    cList.ml, on type option in cOpt.ml, etc.
+  - unless of a good reason not to so, follow the style of the
+    surrounding code in the same file as much as possible,
+    the general guidelines are otherwise "let spacing breaths" (we
+    have large screen nowadays), "make your code easy to read and
+    to understand"
+  - document what is tricky, but do not overdocument, sometimes the
+    choice of names and the structuration of the code is a better
+    documentation than a long discourse; use of unicode in comments is
+    welcome if it can make comments more readable (then
+    "toggle-enable-multibyte-characters" can help when using the
+    debugger in emacs)
+  - all of initial "open File", or of small-scope File.(...), or
+    per-ident File.foo are common practices
+
+- Choice of variable names
+  - be consistent when naming from one function to another
+  - be consistent with the naming adopted in the functions from the
+    same file, or with the naming used elsewhere by similar functions
+  - use variable names which express meaning
+  - keep "cst" for constants and avoid it for constructors which is
+    otherwise a source of confusion
+  - for constructors, use "cstr" in type constructor (resp. "cstru" in
+    constructor puniverse); avoid "constr" for "constructor" which
+    could be think as the name of an arbitrary Constr.t
+  - for inductive types, use "ind" in the type inductive (resp "indu"
+    in inductive puniverse)
+  - for env, use "env"
+  - for evar_map, use "sigma", with tolerance into "evm" and "evd"
+  - for named_context or rel_context, use "ctxt" or "ctx" (or "sign")
+  - for formal/actual indices of inductive types: "realdecls", "realargs"
+  - for formal/actual parameters of inductive types: "paramdecls", "paramargs"
+  - for terms, use e.g. c, b, a, ...
+  - if a term is known to be a function: f, ...
+  - if a term is known to be a type: t, u, typ, ...
+  - for a declaration, use d or "decl"
+  - for errors, exceptions, use e
+
+- Common OCaml pitfalls
+  - in "match ... with Case1 -> try ... with ... -> ... | Case2 -> ...", or in
+    "match ... with Case1 -> match ... with SubCase -> ... | Case2 -> ...", or in
+    parentheses are needed around the "try" and the inner "match"
+  - even if stream are lazy, the Pp.(++) combinator is strict and
+    forces the evaluation of its arguments (use a "lazy" or a "fun () ->")
+    to make it lazy explicitly
+  - in "if ... then ... else ... ++ ...", the default parenthesizing
+    is somehow counter-intuitive; use "(if ... then ... else ...) ++ ..."
+  - in "let myspecialfun = mygenericfun args", be sure that it does no
+    do side-effect; prefer otherwise "let mygenericfun arg =
+    mygenericfun args arg" to ensure that the function is evaluated at
+    runtime
diff --git a/dev/doc/univpoly.txt b/dev/doc/universes.md
index 6a69c579..c276603e 100644
--- a/dev/doc/univpoly.txt
+++ b/dev/doc/universes.md
@@ -1,44 +1,45 @@
-Notes on universe polymorphism and primitive projections, M. Sozeau
-===================================================================
+Notes on universe polymorphism
+------------------------------
 
-The new implementation of universe polymorphism and primitive
-projections introduces a few changes to the API of Coq. First and
-foremost, the term language changes, as global references now carry a
-universe level substitution:
+The implementation of universe polymorphism introduces a few changes
+to the API of Coq. First and foremost, the term language changes, as
+global references now carry a universe level substitution:
 
+~~~ocaml
 type 'a puniverses = 'a * Univ.Instance.t
 type pconstant = constant puniverses
 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
-
+~~~
 
 Universes
-=========
+---------
 
-  Universe instances (an array of levels) gets substituted when
+Universe instances (an array of levels) gets substituted when
 unfolding definitions, are used to typecheck and are unified according
-to the rules in the ITP'14 paper on universe polymorphism in Coq.  
+to the rules in the ITP'14 paper on universe polymorphism in Coq.
 
+~~~ocaml
 type Level.t = Set | Prop | Level of int * dirpath (* hashconsed *)
 type Instance.t = Level.t array
 type Universe.t = Level.t list (* hashconsed *)
+~~~
 
 The universe module defines modules and abstract types for levels,
 universes etc.. Structures are hashconsed (with a hack to take care
-of the fact that deserialization breaks sharing). 
+of the fact that deserialization breaks sharing).
 
-  Definitions (constants, inductives) now carry around not only 
+  Definitions (constants, inductives) now carry around not only
 constraints but also the universes they introduced (a Univ.UContext.t).
-There is another kind of contexts [Univ.ContextSet.t], the latter has 
+There is another kind of contexts `Univ.ContextSet.t`, the latter has
 a set of universes, while the former has serialized the levels in an
-array, and is used for polymorphic objects. Both have "reified" 
-constraints depending on global and local universes. 
+array, and is used for polymorphic objects. Both have "reified"
+constraints depending on global and local universes.
 
   A polymorphic definition is abstract w.r.t. the variables in this
 context, while a monomorphic one (or template polymorphic) just adds the
@@ -46,18 +47,18 @@ universes and constraints to the global universe context when it is put
 in the environment. No other universes than the global ones and the
 declared local ones are needed to check a declaration, hence the kernel
 does not produce any constraints anymore, apart from module
-subtyping.... There are hence two conversion functions now: [check_conv]
-and [infer_conv]: the former just checks the definition in the current env
+subtyping.... There are hence two conversion functions now: `check_conv`
+and `infer_conv`: the former just checks the definition in the current env
 (in which we usually push_universe_context of the associated context),
-and [infer_conv] which produces constraints that were not implied by the
+and `infer_conv` which produces constraints that were not implied by the
 ambient constraints. Ideally, that one could be put out of the kernel,
-but currently module subtyping needs it. 
+but currently module subtyping needs it.
 
  Inference of universes is now done during refinement, and the evar_map
 carries the incrementally built universe context, starting from the
-global universe constraints (see [Evd.from_env]). [Evd.conversion] is a
-wrapper around [infer_conv] that will do the bookkeeping for you, it
-uses [evar_conv_x]. There is a universe substitution being built
+global universe constraints (see `Evd.from_env`). `Evd.conversion` is a
+wrapper around `infer_conv` that will do the bookkeeping for you, it
+uses `evar_conv_x`. There is a universe substitution being built
 incrementally according to the constraints, so one should normalize at
 the end of a proof (or during a proof) with that substitution just like
 we normalize evars. There are some nf_* functions in
@@ -67,16 +68,16 @@ the universe constraints used in the term. It is heuristic but
 validity-preserving. No user-introduced universe (i.e. coming from a
 user-written anonymous Type) gets touched by this, only the fresh
 universes generated for each global application. Using
-
+~~~ocaml
 val pf_constr_of_global : Globnames.global_reference -> (constr -> tactic) -> tactic
-
+~~~
 Is the way to make a constr out of a global reference in the new API.
 If they constr is polymorphic, it will add the necessary constraints to
 the evar_map. Even if a constr is not polymorphic, we have to take care
 of keeping track of its universes. Typically, using:
-
-  mkApp (coq_id_function, [| A; a |]) 
-
+~~~ocaml
+  mkApp (coq_id_function, [| A; a |])
+~~~
 and putting it in a proof term is not enough now. One has to somehow
 show that A's type is in cumululativity relation with id's type
 argument, incurring a universe constraint. To do this, one can simply
@@ -84,19 +85,19 @@ call Typing.resolve_evars env evdref c which will do some infer_conv to
 produce the right constraints and put them in the evar_map. Of course in
 some cases you might know from an invariant that no new constraint would
 be produced and get rid of it. Anyway the kernel will tell you if you
-forgot some. As a temporary way out, [Universes.constr_of_global] allows
+forgot some. As a temporary way out, `Universes.constr_of_global` allows
 you to make a constr from any non-polymorphic constant, but it will fail
 on polymorphic ones.
 
 Other than that, unification (w_unify and evarconv) now take account of universes and
 produce only well-typed evar_maps.
 
-Some syntactic comparisons like the one used in [change] have to be
-adapted to allow identification up-to-universes (when dealing with 
-polymorphic references), [make_eq_univs_test] is there to help. 
+Some syntactic comparisons like the one used in `change` have to be
+adapted to allow identification up-to-universes (when dealing with
+polymorphic references), `make_eq_univs_test` is there to help.
 In constr, there are actually many new comparison functions to deal with
 that:
- 
+~~~ocaml
 (** [equal a b] is true if [a] equals [b] modulo alpha, casts,
    and application grouping *)
 val equal : constr -> constr -> bool
@@ -105,7 +106,7 @@ val equal : constr -> constr -> bool
    application grouping and the universe equalities in [u]. *)
 val eq_constr_univs : constr Univ.check_function
 
-(** [leq_constr_univs u a b] is [true] if [a] is convertible to [b] modulo 
+(** [leq_constr_univs u a b] is [true] if [a] is convertible to [b] modulo
     alpha, casts, application grouping and the universe inequalities in [u]. *)
 val leq_constr_univs : constr Univ.check_function
 
@@ -120,47 +121,47 @@ val leq_constr_universes : constr -> constr -> bool Univ.universe_constrained
 (** [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
-
-The [_univs] versions are doing checking of universe constraints
-according to a graph, while the [_universes] are producing (non-atomic) 
+~~~
+The `_univs` versions are doing checking of universe constraints
+according to a graph, while the `_universes` are producing (non-atomic)
 universe constraints. The non-atomic universe constraints include the
-[ULub] constructor: when comparing [f (* u1 u2 *) c] and [f (* u1' u2'
-*) c] we add ULub constraints on [u1, u1'] and [u2, u2']. These are
-treated specially: as unfolding [f] might not result in these
+`ULub` constructor: when comparing `f (* u1 u2 *) c` and `f (* u1' u2'
+*) c` we add ULub constraints on `u1, u1'` and `u2, u2'`. These are
+treated specially: as unfolding `f` might not result in these
 unifications, we need to keep track of the fact that failure to satisfy
 them does not mean that the term are actually equal. This is used in
-unification but probably not necessary to the average programmer. 
+unification but probably not necessary to the average programmer.
 
 Another issue for ML programmers is that tables of constrs now usually
-need to take a [constr Univ.in_universe_context_set] instead, and
-properly refresh the universes context when using the constr, e.g. using 
-Clenv.refresh_undefined_univs clenv or: 
-
+need to take a `constr Univ.in_universe_context_set` instead, and
+properly refresh the universes context when using the constr, e.g. using
+Clenv.refresh_undefined_univs clenv or:
+~~~ocaml
 (** 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 -> 
+val fresh_universe_context_set_instance : universe_context_set ->
   universe_level_subst * universe_context_set
-
-The substitution should be applied to the constr(s) under consideration, 
+~~~
+The substitution should be applied to the constr(s) under consideration,
 and the context_set merged with the current evar_map with:
-
+~~~ocaml
 val merge_context_set : rigid -> evar_map -> Univ.universe_context_set -> evar_map
-
-The [rigid] flag here should be [Evd.univ_flexible] most of the
+~~~
+The `rigid` flag here should be `Evd.univ_flexible` most of the
 time. This means the universe levels of polymorphic objects in the
-constr might get instantiated instead of generating equality constraints 
+constr might get instantiated instead of generating equality constraints
 (Evd.univ_rigid does that).
 
-On this issue, I recommend forcing commands to take [global_reference]s
+On this issue, I recommend forcing commands to take `global_reference`s
 only, the user can declare his specialized terms used as hints as
 constants and this is cleaner. Alas, backward-compatibility-wise,
 this is the only solution I found. In the case of global_references
-only, it's just a matter of using [Evd.fresh_global] /
-[pf_constr_of_global] to let the system take care of universes.
+only, it's just a matter of using `Evd.fresh_global` /
+`pf_constr_of_global` to let the system take care of universes.
 
 
 The universe graph
-==================
+------------------
 
 To accomodate universe polymorphic definitions, the graph structure in
 kernel/univ.ml was modified. The new API forces every universe to be
@@ -176,68 +177,14 @@ no universe i can be set lower than Set, so the chain of universes
 always bottoms down at Prop < Set.
 
 Modules
-=======
+-------
 
 One has to think of universes in modules as being globally declared, so
 when including a module (type) which declares a type i (e.g. through a
 parameter), we get back a copy of i and not some fresh universe.
 
-Projections
-===========
-
-  | Proj of constant * constr
-
-Projections are always applied to a term, which must be of a record type
-(i.e. reducible to an inductive type [I params]). Type-checking,
-reduction and conversion are fast (not as fast as they could be yet)
-because we don't keep parameters around. As you can see, it's currently
-a [constant] that is used here to refer to the projection, that will
-change to an abstract [projection] type in the future. Basically a
-projection constant records which inductive it is a projection for, the
-number of params and the actual position in the constructor that must be
-projected. For compatibility reason, we also define an eta-expanded form
-(accessible from user syntax @f). The constant_entry of a projection has
-both informations. Declaring a record (under [Set Primitive
-Projections]) will generate such definitions. The API to declare them is
-not stable at the moment, but the inductive type declaration also knows
-about the projections, i.e. a record inductive type decl contains an
-array of terms representing the projections. This is used to implement
-eta-conversion for record types (with at least one field and having all
-projections definable). The canonical value being [Build_R (pn x)
-... (pn x)]. Unification and conversion work up to this eta rule. The
-records can also be universe polymorphic of course, and we don't need to
-keep track of the universe instance for the projections either.
-Projections are reduced _eagerly_ everywhere, and introduce a new Zproj
-constructor in the abstract machines that obeys both the delta (for the
-constant opacity) and iota laws (for the actual reduction). Refolding
-works as well (afaict), but there is a slight hack there related to
-universes (not projections). 
-
-For the ML programmer, the biggest change is that pattern-matchings on
-kind_of_term require an additional case, that is handled usually exactly
-like an [App (Const p) arg].
-
-There are slight hacks related to hints is well, to use the primitive
-projection form of f when one does [Hint Resolve f]. Usually hint
-resolve will typecheck the term, resulting in a partially applied
-projection (disallowed), so we allow it to take
-[constr_or_global_reference] arguments instead and special-case on
-projections. Other tactic extensions might need similar treatment. 
-
-WIP
-===
-
-- [vm_compute] does not deal with universes and projections correctly,
-except when it goes to a normal form with no projections or polymorphic
-constants left (the most common case). E.g. Ring with Set Universe
-Polymorphism and Set Primitive Projections work (at least it did at some
-point, I didn't recheck yet).  
-
-- [native_compute] works with universes and projections.
-
-
 Incompatibilities
-=================
+-----------------
 
 Old-style universe polymorphic definitions were implemented by taking
 advantage of the fact that elaboration (i.e., pretyping and unification)
@@ -247,33 +194,33 @@ possible, as unification ensures that the substitution is built is
 entirely well-typed, even w.r.t universes. This means that some terms
 that type-checked before no longer do, especially projections of the
 pair:
-
+~~~coq
 @fst ?x ?y : prod ?x ?y : Type (max(Datatypes.i, Datatypes.j)).
-
+~~~
 The "template universe polymorphic" variables i and j appear during
 typing without being refreshed, meaning that they can be lowered (have
 upper constraints) with user-introduced universes. In most cases this
 won't work, so ?x and ?y have to be instantiated earlier, either from
 the type of the actual projected pair term (some t : prod A B) or the
-typing constraint. Adding the correct type annotations will always fix 
+typing constraint. Adding the correct type annotations will always fix
 this.
 
 
 Unification semantics
-=====================
+---------------------
 
 In Ltac, matching with:
 
-- a universe polymorphic constant [c] matches any instance of the
+- a universe polymorphic constant `c` matches any instance of the
   constant.
-- a variable ?x already bound to a term [t] (non-linear pattern) uses 
+- a variable ?x already bound to a term `t` (non-linear pattern) uses
   strict equality of universes (e.g., Type@{i} and Type@{j} are not
   equal).
 
 In tactics:
 
-- [change foo with bar], [pattern foo] will unify all instances of [foo]
-  (and convert them with [bar]). This might incur unifications of
-  universes. [change] uses conversion while [pattern] only does
+- `change foo with bar`, `pattern foo` will unify all instances of `foo`
+  (and convert them with `bar`). This might incur unifications of
+  universes. `change` uses conversion while `pattern` only does
   syntactic matching up-to unification of universes.
-- [apply], [refine] use unification up to universes.
+- `apply`, `refine` use unification up to universes.
diff --git a/dev/doc/universes.txt b/dev/doc/universes.txt
deleted file mode 100644
index a40706e9..00000000
--- a/dev/doc/universes.txt
+++ /dev/null
@@ -1,26 +0,0 @@
-How to debug universes?
-
-1. There is a command Print Universes in Coq toplevel
-
-   Print Universes.
-     prints the graph of universes in the form of constraints
-
-   Print Universes "file".
-     produces the "file" containing universe constraints in the form
-       univ1 # univ2 ;
-     where # can be either > >= or =
-
-   If "file" ends with .gv or .dot, the resulting file will be in
-   dot format.
-
-
-   *) for dot see http://www.research.att.com/sw/tools/graphviz/
-
-
-2. There is a printing option
-
-   {Set,Unset} Printing Universes.
-
-   which, when set, makes all pretty-printed Type's annotated with the
-   name of the universe.
-
diff --git a/dev/doc/versions-history.tex b/dev/doc/versions-history.tex
index 492e75a7..3867d4af 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
new file mode 100644
index 00000000..b35571e9
--- /dev/null
+++ b/dev/doc/xml-protocol.md
@@ -0,0 +1,755 @@
+# Coq XML Protocol
+
+This document is based on documentation originally written by CJ Bell
+for his [vscoq](https://github.com/siegebell/vscoq/) project.
+
+Here, the aim is to provide a "hands on" description of the XML
+protocol that coqtop and IDEs use to communicate. The protocol first appeared 
+with Coq 8.5, and is used by CoqIDE. It will also be used in upcoming 
+versions of Proof General.
+
+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 to the XML protocol are documented as part of [`dev/doc/changes.txt`](/dev/doc/changes.txt).
+
+* [Commands](#commands)
+  - [About](#command-about)
+  - [Add](#command-add)
+  - [EditAt](#command-editAt)
+  - [Init](#command-init)
+  - [Goal](#command-goal)
+  - [Status](#command-status)
+  - [Query](#command-query)
+  - [Evars](#command-evars)
+  - [Hints](#command-hints)
+  - [Search](#command-search)
+  - [GetOptions](#command-getoptions)
+  - [SetOptions](#command-setoptions)
+  - [MkCases](#command-mkcases)
+  - [StopWorker](#command-stopworker)
+  - [PrintAst](#command-printast)
+  - [Annotate](#command-annotate)
+* [Feedback messages](#feedback)
+  - [Added Axiom](#feedback-addedaxiom)
+  - [Processing](#feedback-processing)
+  - [Processed](#feedback-processed)
+  - [Incomplete](#feedback-incomplete)
+  - [Complete](#feedback-complete)
+  - [GlobRef](#feedback-globref)
+  - [Error](#feedback-error)
+  - [InProgress](#feedback-inprogress)
+  - [WorkerStatus](#feedback-workerstatus)
+  - [File Dependencies](#feedback-filedependencies)
+  - [File Loaded](#feedback-fileloaded)
+  - [Message](#feedback-message)
+  - [Custom](#feedback-custom)
+
+Sentences: each command sent to Coqtop is a "sentence"; they are typically terminated by ".\s" (followed by whitespace or EOF).
+Examples: "Lemma a: True.", "(* asdf *) Qed.", "auto; reflexivity."
+In practice, the command sentences sent to Coqtop are terminated at the "." and start with any previous whitespace.
+Each sentence is assigned a unique stateId after being sent to Coq (via Add).
+States:
+  * Processing: has been received by Coq and has no obvious syntax error (that would prevent future parsing)
+  * Processed:
+  * InProgress:
+  * Incomplete: the validity of the sentence cannot be checked due to a prior error
+  * Complete:
+  * Error: the sentence has an error
+
+State ID 0 is reserved as a 'dummy' state.
+
+--------------------------
+
+## <a name="commands">Commands</a>
+
+### <a name="command-about">**About(unit)**</a>
+Returns information about the protocol and build dates for Coqtop.
+```
+<call val="About">
+  <unit/>
+</call>
+```
+#### *Returns*
+```html
+ <value val="good">
+   <coq_info><string>8.6</string>
+     <string>20150913</string>
+     <string>December 2016</string>
+     <string>Dec 23 2016 16:16:30</string>
+   </coq_info>
+</value>
+```
+The string fields are the Coq version, the protocol version, the release date, and the compile time of Coqtop.
+The protocol version is a date in YYYYMMDD format, where "20150913" corresponds to Coq 8.6. An IDE that wishes 
+to support multiple Coq versions can use the protocol version information to know how to handle output from Coqtop.
+
+### <a name="command-add">**Add(stateId: integer, command: string, verbose: boolean)**</a>
+Adds a toplevel command (e.g. vernacular, definition, tactic) to the given state.
+`verbose` controls whether out-of-band messages will be generated for the added command (e.g. "foo is assumed" in response to adding "Axiom foo: nat.").
+```html
+<call val="Add">
+  <pair>
+    <pair>
+      <string>${command}</string>
+      <int>${editId}</int>
+    </pair>
+    <pair>
+      <state_id val="${stateId}"/>
+      <bool val="${verbose}"/>
+    </pair>
+  </pair>
+</call>
+```
+
+#### *Returns*
+* The added command is given a fresh `stateId` and becomes the next "tip".
+```html
+<value val="good">
+  <pair>
+    <state_id val="${newStateId}"/>
+    <pair>
+      <union val="in_l"><unit/></union>
+      <string>${message}</string>
+    </pair>
+  </pair>
+</value>
+```
+* When closing a focused proof (in the middle of a bunch of interpreted commands),
+the `Qed` will be assigned a prior `stateId` and `nextStateId` will be the id of an already-interpreted
+state that should become the next tip. 
+```html
+<value val="good">
+  <pair>
+    <state_id val="${stateId}"/>
+    <pair>
+      <union val="in_r"><state_id val="${nextStateId}"/></union>
+      <string>${message}</string>
+    </pair>
+  </pair>
+</value>
+```
+* Failure:
+  - Syntax error. Error offsets are byte offsets (not character offsets) with respect to the start of the sentence, starting at 0.
+  ```html
+  <value val="fail"
+      loc_s="${startOffsetOfError}"
+      loc_e="${endOffsetOfError}">
+    <state_id val="${stateId}"/>
+    <richpp>${errorMessage}</richpp>
+  </value>
+  ```
+  - Another kind of error, for example, Qed with a pending goal.	
+  ```html
+  <value val="fail"><state_id val="${stateId}"/><richpp>${errorMessage}</richpp></value>
+  ```
+
+-------------------------------
+
+### <a name="command-editAt">**EditAt(stateId: integer)**</a>
+Moves current tip to `${stateId}`, such that commands may be added to the new state ID.
+```html
+<call val="Edit_at"><state_id val="${stateId}"/></call>
+```
+#### *Returns*
+* Simple backtrack; focused stateId becomes the parent state
+```html
+<value val="good">
+  <union val="in_l"><unit/></union>
+</value>
+```
+
+* New focus; focusedQedStateId is the closing Qed of the new focus; senteneces between the two should be cleared
+```html
+<value val="good">
+  <union val="in_r">
+    <pair>
+      <state_id val="${focusedStateId}"/>
+      <pair>
+        <state_id val="${focusedQedStateId}"/>
+        <state_id val="${oldFocusedStateId}"/>
+      </pair>
+    </pair>
+  </union>
+</value>
+```
+* Failure: If `stateId` is in an error-state and cannot be jumped to, `errorFreeStateId` is the parent state of ``stateId` that shopuld be edited instead. 
+```html
+<value val="fail" loc_s="${startOffsetOfError}" loc_e="${endOffsetOfError}">
+  <state_id val="${errorFreeStateId}"/>
+  ${errorMessage}
+</value>
+```
+
+-------------------------------
+
+### <a name="command-init">**Init()**</a>
+* No options.
+```html
+<call val="Init"><option val="none"/></call>
+```
+* With options. Looking at
+  [ide_slave.ml](https://github.com/coq/coq/blob/c5d0aa889fa80404f6c291000938e443d6200e5b/ide/ide_slave.ml#L355),
+  it seems that `options` is just the name of a script file, whose path
+  is added via `Add LoadPath` to the initial state.
+```html
+<call val="Init">
+  <option val="some">
+    <string>${options}</string>
+  </option>
+</call>
+```
+Providing the script file enables Coq to use .aux files created during
+compilation. Those file contain timing information that allow Coq to
+choose smartly between asynchronous and synchronous processing of
+proofs.
+
+#### *Returns*
+* The initial stateId (not associated with a sentence)
+```html
+<value val="good">
+  <state_id val="${initialStateId}"/>
+</value>
+```
+
+-------------------------------
+
+
+### <a name="command-goal">**Goal()**</a>
+```html
+<call val="Goal"><unit/></call>
+```
+#### *Returns*
+* If there is a goal. `shelvedGoals` and `abandonedGoals` have the same structure as the first set of (current/foreground) goals. `backgroundGoals` contains a list of pairs of lists of goals (list ((list Goal)*(list Goal))); it represents a "focus stack" ([see code for reference](https://github.com/coq/coq/blob/trunk/engine/proofview.ml#L113)). Each time a proof is focused, it will add a new pair of lists-of-goals. The first pair is the most nested set of background goals, the last pair is the top level set of background goals. The first list in the pair is in reverse order. Each time you focus the goal (e.g. using `Focus` or a bullet), a new pair will be prefixed to the list.
+```html
+<value val="good">
+  <option val="some">
+  <goals>
+    <!-- current goals -->
+    <list>
+      <goal>
+        <string>3</string>
+        <list>
+          <richpp>${hyp1}</richpp>
+          ...
+          <richpp>${hypN}</richpp>
+        </list>
+        <richpp>${goal}</richpp>
+      </goal>
+      ...
+      ${goalN}
+    </list>
+    <!-- `backgroundGoals` -->
+    <list>
+      <pair>
+        <list><goal />...</list>
+        <list><goal />...</list>
+      </pair>
+      ...
+    </list>
+    ${shelvedGoals}
+    ${abandonedGoals}
+  </goals>
+  </option>
+</value>
+```
+
+For example, this script:
+```coq
+Goal P -> (1=1/\2=2) /\ (3=3 /\ (4=4 /\ 5=5) /\ 6=6) /\ 7=7.
+intros.
+split; split. (* current visible goals are [1=1, 2=2, 3=3/\(4=4/\5=5)/\6=6, 7=7] *)
+Focus 3. (* focus on 3=3/\(4=4/\5=5)/\6=6; bg-before: [1=1, 2=2], bg-after: [7=7] *)
+split; [ | split ]. (* current visible goals are [3=3, 4=4/\5=5, 6=6] *)
+Focus 2. (* focus on 4=4/\5=5; bg-before: [3=3], bg-after: [6=6] *)
+* (* focus again on 4=4/\5=5; bg-before: [], bg-after: [] *)
+split. (* current visible goals are [4=4,5=5] *)
+```
+should generate the following goals structure:
+```
+goals: [ P|-4=4, P|-5=5 ]
+background:
+[
+  ( [], [] ), (* bullet with one goal has no before or after background goals *)
+  ( [ P|-3=3 ], [ P|-6=6 ] ), (* Focus 2 *)
+  ( [ P|-2=2, P|-1=1 ], [ P|-7=7 ] ) (* Focus 3; notice that 1=1 and 2=2 are reversed *)
+]
+```
+Pseudocode for listing all of the goals in order: `rev (flat_map fst background) ++ goals ++ flat_map snd background`.
+
+* No goal:
+```html
+<value val="good"><option val="none"/></value>
+```
+
+-------------------------------
+
+
+### <a name="command-status">**Status(force: bool)**</a>
+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>
+```
+#### *Returns*
+*  
+```html
+<status>
+  <string>${path}</string>
+  <string>${proofName}</string>
+  <string>${allProofs}</string>
+  <string>${proofNumber}</string>
+</status>
+```
+
+-------------------------------
+
+### <a name="command-query">**Query(route_id: integer, query: string, stateId: integer)**</a>
+
+`routeId` can be used to distinguish the result of a particular query,
+`stateId` should be set to the state the query should be run.
+
+```html
+<call val="Query">
+  <pair>
+    <route_id val="${routeId}"/>
+  <pair>
+    <string>${query}</string>
+    <state_id val="${stateId}"/>
+  </pair>
+  </pair>
+</call>
+```
+#### *Returns*
+*
+```html
+<value val="good">
+  <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.
+
+-------------------------------
+
+
+
+### <a name="command-evars">**Evars()**</a>
+```html
+<call val="Evars"><unit/></call>
+```
+#### *Returns*
+*
+```html
+<value val="good">
+  <option val="some">
+    <list>
+      <evar>${evar1}</evar>
+      ...
+      <evar>${evarN}</evar>
+    </list>
+  </option>
+</value>
+```
+
+-------------------------------
+
+
+### <a name="command-hints">**Hints()**</a>
+```html
+<call val="Hints"><unit/></call>
+```
+#### *Returns*
+*
+```html
+<value val="good">
+  <option val="some">
+    <pair>
+      <list/>
+      <list>
+        <pair>
+          <string>${hint1}</string>
+          <string>${hint2}</string>
+        </pair>
+        ...
+        <pair>
+          <string>${hintN-1}</string>
+          <string>${hintN}</string>
+        </pair>
+      </list>
+    </pair>
+  </option>
+</value>
+```
+
+-------------------------------
+
+
+### <a name="command-search">**Search([(constraintTypeN: string, constraintValueN: string, positiveConstraintN: boolean)])**</a>
+Searches for objects that satisfy a list of constraints. If `${positiveConstraint}` is `false`, then the constraint is inverted. 
+```html
+<call val="Search">
+  <list>
+    <pair>
+      <search_cst val="${constraintType1}">
+        ${constraintValue1}
+      </search_cst>
+      <bool val="${positiveConstraint1}"/>
+    </pair>
+    ...
+    <!-- Example: -->
+    <pair>
+      <search_cst val="name_pattern">
+        <string>bool_rect</string>
+      </search_cst>
+      <bool val="true"/>
+    </pair>
+  </list>
+</call>
+```
+#### *Returns*
+*
+```html
+<value val="good">
+  <list>
+      <coq_object>
+          <list>
+              <string>${metaInfo}</string>
+              ...
+          </list>
+          <list>
+              <string>${name}</string>
+          </list>
+          <string>${definition}</string>
+      </coq_object>
+      ...
+  </list>
+</value>
+```
+##### Types of constraints:
+* Name pattern: `${constraintType} = "name_pattern"`; `${constraintValue}` is a regular expression string.
+* Type pattern: `${constraintType} = "type_pattern"`; `${constraintValue}` is a pattern (???: an open gallina term) string.
+* SubType pattern: `${constraintType} = "subtype_pattern"`; `${constraintValue}` is a pattern (???: an open gallina term) string.
+* In module: `${constraintType} = "in_module"`; `${constraintValue}` is a list of strings specifying the module/directory structure.
+* Include blacklist: `${constraintType} = "include_blacklist"`; `${constraintValue}` *is ommitted*.
+
+-------------------------------
+
+
+### <a name="command-getoptions">**GetOptions()**</a>
+```html
+<call val="GetOptions"><unit/></call>
+```
+#### *Returns*
+*
+```html
+<value val="good">
+  <list>
+    <pair>
+      <list><string>${string1}</string>...</list>
+      <option_state>
+        <bool>${sync}</bool>
+        <bool>${deprecated}</bool>
+        <string>${name}</string>
+        ${option_value}
+      </option_state>
+    </pair>
+    ...
+  </list>
+</value>
+```
+
+-------------------------------
+
+
+### <a name="command-setoptions">**SetOptions(options)**</a>
+Sends a list of option settings, where each setting roughly looks like:
+`([optionNamePart1, ..., optionNamePartN], value)`.
+```html
+<call val="SetOptions">
+  <list>
+    <pair>
+      <list>
+        <string>optionNamePart1</string>
+        ...
+        <string>optionNamePartN</string>
+      </list>
+      <option_value val="${typeOfOption}">
+        <option val="some">
+          ${value}
+        </option>
+      </option_value>
+    </pair>
+    ...
+    <!-- Example: -->
+    <pair>
+      <list>
+        <string>Printing</string>
+        <string>Width</string>
+      </list>
+      <option_value val="intvalue">
+        <option val="some"><int>60</int></option>
+      </option_value>
+    </pair>
+  </list>
+</call>
+```
+CoqIDE sends the following settings (defaults in parentheses):
+```
+Printing Width : (<option_value val="intvalue"><int>60</int></option_value>),
+Printing Coercions : (<option_value val="boolvalue"><bool val="false"/></option_value>),
+Printing Matching : (...true...)
+Printing Notations : (...true...)
+Printing Existential Instances : (...false...)
+Printing Implicit : (...false...)
+Printing All : (...false...)
+Printing Universes : (...false...)
+```
+#### *Returns*
+*
+```html
+<value val="good"><unit/></value>
+```
+
+-------------------------------
+
+
+### <a name="command-mkcases">**MkCases(...)**</a>
+```html
+<call val="MkCases"><string>...</string></call>
+```
+#### *Returns*
+*
+```html
+<value val="good">
+  <list>
+    <list><string>${string1}</string>...</list>
+    ...
+  </list>
+</value>
+```
+
+-------------------------------
+
+
+### <a name="command-stopworker">**StopWorker(worker: string)**</a>
+```html
+<call val="StopWorker"><string>${worker}</string></call>
+```
+#### *Returns*
+*
+```html
+<value val="good"><unit/></value>
+```
+
+-------------------------------
+
+
+### <a name="command-printast">**PrintAst(stateId: integer)**</a>
+```html
+<call val="PrintAst"><state_id val="${stateId}"/></call>
+```
+#### *Returns*
+*
+```html
+<value val="good">
+  <gallina begin="${gallina_begin}" end="${gallina_end}">
+    <theorem begin="${theorem_begin}" end="${theorem_end}" type="Theorem" name="${theorem_name}">
+      <apply begin="${apply_begin}" end="${apply_end}">
+        <operator begin="${operator_begin}" end="${operator_end}" name="${operator_name}"/>
+        <typed begin="${typed_begin}" end="${typed_end}">
+          <constant begin="${constant_begin}" end="${constant_end}" name="${constant_name}"/>
+          ...
+          <token begin="${token_begin}" end="token_end">${token}</token>
+          ...
+        </typed>
+        ...
+      </apply>
+    </theorem>
+    ...
+  </gallina>
+</value>
+```
+
+-------------------------------
+
+
+
+### <a name="command-annotate">**Annotate(annotation: string)**</a>
+```html
+<call val="Annotate"><string>${annotation}</string></call>
+```
+#### *Returns*
+*
+
+take `<call val="Annotate"><string>Theorem plus_0_r : forall n : nat, n + 0 = n.</string></call>` as an example.
+
+```html
+<value val="good">
+  <pp startpos="0" endpos="45">
+    <vernac_expr startpos="0" endpos="44">
+      <keyword startpos="0" endpos="7">Theorem</keyword>
+      &nbsp;plus_0_r&nbsp;:&nbsp;
+      <constr_expr startpos="19" endpos="44">
+        <keyword startpos="19" endpos="25">forall</keyword>
+        &nbsp;n&nbsp;:&nbsp;
+        <constr_expr startpos="30" endpos="33">nat</constr_expr>
+        ,&nbsp;
+        <unparsing startpos="35" endpos="44">
+          <unparsing startpos="35" endpos="40">
+            <unparsing startpos="35" endpos="40">
+              <unparsing startpos="35" endpos="36">
+                <constr_expr startpos="35" endpos="36">n</constr_expr>
+              </unparsing>
+              <unparsing startpos="36" endpos="38">&nbsp;+</unparsing>
+              <unparsing startpos="38" endpos="39">&nbsp;</unparsing>
+              <unparsing startpos="39" endpos="40">
+                <constr_expr startpos="39" endpos="40">0</constr_expr>
+              </unparsing>
+            </unparsing>
+          </unparsing>
+          <unparsing startpos="40" endpos="42">&nbsp;=</unparsing>
+          <unparsing startpos="42" endpos="43">&nbsp;</unparsing>
+          <unparsing startpos="43" endpos="44">
+            <constr_expr startpos="43" endpos="44">n</constr_expr>
+          </unparsing>
+        </unparsing>
+      </constr_expr>
+    </vernac_expr>
+    .
+  </pp>
+</value>
+```
+
+-------------------------------
+
+## <a name="feedback">Feedback messages</a>
+
+Feedback messages are issued out-of-band,
+  giving updates on the current state of sentences/stateIds,
+  worker-thread status, etc.
+
+In the descriptions of feedback syntax below, wherever a `state_id`
+tag may occur, there may instead be an `edit_id` tag.
+
+* <a name="feedback-addedaxiom">Added Axiom</a>: in response to `Axiom`, `admit`, `Admitted`, etc.
+```html
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="addedaxiom" />
+</feedback>
+```
+* <a name="feedback-processing">Processing</a>
+```html
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="processingin">
+    <string>${workerName}</string>
+  </feedback_content>
+</feedback>
+```
+* <a name="feedback-processed">Processed</a>
+```html
+<feedback object="state" route="0">
+  <feedback object="state" route="0">
+    <state_id val="${stateId}"/>
+  <feedback_content val="processed"/>
+</feedback>
+```
+* <a name="feedback-incomplete">Incomplete</a>
+```html
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="incomplete" />
+</feedback>
+```
+* <a name="feedback-complete">Complete</a>
+* <a name="feedback-globref">GlobRef</a>
+* <a name="feedback-error">Error</a>. Issued, for example, when a processed tactic has failed or is unknown.
+The error offsets may both be 0 if there is no particular syntax involved.
+* <a name="feedback-inprogress">InProgress</a>
+```html
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="inprogress">
+    <int>1</int>
+  </feedback_content>
+</feedback>
+```
+* <a name="feedback-workerstatus">WorkerStatus</a>
+Ex: `workername = "proofworker:0"`
+Ex: `status = "Idle"` or `status = "proof: myLemmaName"` or `status = "Dead"`
+```html
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="workerstatus">
+    <pair>
+      <string>${workerName}</string>
+      <string>${status}</string>
+    </pair>
+  </feedback_content>
+</feedback>
+```
+* <a name="feedback-filedependencies">File Dependencies</a>. Typically in response to a `Require`. Dependencies are *.vo files.
+  - State `stateId` directly depends on `dependency`:
+  ```html
+  <feedback object="state" route="0">
+    <state_id val="${stateId}"/>
+    <feedback_content val="filedependency">
+      <option val="none"/>
+      <string>${dependency}</string>
+    </feedback_content>
+  </feedback>
+  ```
+  - State `stateId` depends on `dependency` via dependency `sourceDependency`
+  ```xml
+  <feedback object="state" route="0">
+    <state_id val="${stateId}"/>
+    <feedback_content val="filedependency">
+      <option val="some"><string>${sourceDependency}</string></option>
+      <string>${dependency}</string>
+    </feedback_content>
+  </feedback>
+  ```
+* <a name="feedback-fileloaded">File Loaded</a>. For state `stateId`, module `module` is being loaded from `voFileName`
+```xml
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="fileloaded">
+    <string>${module}</string>
+    <string>${voFileName`}</string>
+  </feedback_content>
+</feedback>
+```
+
+* <a name="feedback-message">Message</a>. `level` is one of `{info,warning,notice,error,debug}`. For example, in response to an <a href="#command-add">add</a> `"Axiom foo: nat."` with `verbose=true`, message `foo is assumed` will be emitted in response.
+```xml
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="message">
+    <message>
+      <message_level val="${level}"/>
+      <string>${message}</string>
+    </message>
+  </feedback_content>
+</feedback>
+```
+
+* <a name="feedback-custom">Custom</a>. A feedback message that Coq plugins can use to return structured results, including results from Ltac profiling. Optionally, `startPos` and `stopPos` define a range of offsets in the document that the message refers to; otherwise, they will be 0. `customTag` is intended as a unique string that identifies what kind of payload is contained in `customXML`.
+```xml
+<feedback object="state" route="0">
+  <state_id val="${stateId}"/>
+  <feedback_content val="custom">
+    <loc start="${startPos}" stop="${stopPos}"/>
+    <string>${customTag}</string>
+    ${customXML}
+  </feedback_content>
+</feedback>
+```
+
diff --git a/dev/header b/dev/header
deleted file mode 100644
index 41320517..00000000
--- a/dev/header
+++ /dev/null
@@ -1,7 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
diff --git a/dev/header.c b/dev/header.c
new file mode 100644
index 00000000..663c43b3
--- /dev/null
+++ b/dev/header.c
@@ -0,0 +1,9 @@
+/************************************************************************/
+/*         *   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          */
+/*         *     (see LICENSE file for the text of the license)         */
+/************************************************************************/
diff --git a/dev/header.ml b/dev/header.ml
new file mode 100644
index 00000000..7c3ee600
--- /dev/null
+++ b/dev/header.ml
@@ -0,0 +1,9 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
diff --git a/dev/header.py b/dev/header.py
new file mode 100644
index 00000000..f81c8aa6
--- /dev/null
+++ b/dev/header.py
@@ -0,0 +1,9 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
diff --git a/dev/include b/dev/include
index d82fb74f..b982f4c9 100644
--- a/dev/include
+++ b/dev/include
@@ -31,23 +31,24 @@
 #install_printer  (* glob_constr *) ppglob_constr;;
 #install_printer  (* open constr *) ppopenconstr;;
 #install_printer  (* constr *) ppconstr;;
+#install_printer  (* econstr *) ppeconstr;;
 #install_printer  (* constr_substituted *) ppsconstr;; 
 #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;;
 #install_printer  (* univ context future *) ppuniverse_context_future;;
 #install_printer  (* univ context set *) ppuniverse_context_set;;
+#install_printer  (* cumulativity info *) ppcumulativity_info;;
+#install_printer  (* abstract cumulativity info *) ppabstract_cumulativity_info;;
 #install_printer  (* univ set *) ppuniverse_set;;
 #install_printer  (* univ instance *) ppuniverse_instance;;
 #install_printer  (* univ subst *) ppuniverse_subst;;
 #install_printer  (* univ full subst *) ppuniverse_level_subst;;
 #install_printer  (* univ opt subst *) ppuniverse_opt_subst;;
 #install_printer  (* evar univ ctx *) ppevar_universe_context;;
-#install_printer  (* constraints_map *) ppconstraints_map;;
 #install_printer  (* inductive *) ppind;;
 #install_printer  (* 'a scheme_kind *) ppscheme;;
 #install_printer  (* type_judgement *) pptype;;
@@ -62,7 +63,7 @@
 (*#install_printer  (* hints_path *)  pphintspath;;*)
 #install_printer  (* goal *)  ppgoal;;
 (*#install_printer  (* sigma goal *)  ppsigmagoal;;*)
-(*#install_printer  (* proof *)  pproof;;*)
+#install_printer  (* proof *)  pproof;;
 #install_printer  (* Goal.goal *)  ppgoalgoal;;
 #install_printer  (* proofview *)  ppproofview;;
 #install_printer  (* metaset.t *) ppmetas;;
diff --git a/dev/lint-commits.sh b/dev/lint-commits.sh
new file mode 100755
index 00000000..d8043558
--- /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 00000000..ee9c8777
--- /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
deleted file mode 100644
index b8c1e5ee..00000000
--- a/dev/nsis/FileAssociation.nsh
+++ /dev/null
@@ -1,190 +0,0 @@
-/*
-_____________________________________________________________________________
- 
-                       File Association
-_____________________________________________________________________________
- 
- Based on code taken from http://nsis.sourceforge.net/File_Association 
- 
- Usage in script:
- 1. !include "FileAssociation.nsh"
- 2. [Section|Function]
-      ${FileAssociationFunction} "Param1" "Param2" "..." $var
-    [SectionEnd|FunctionEnd]
- 
- FileAssociationFunction=[RegisterExtension|UnRegisterExtension]
- 
-_____________________________________________________________________________
- 
- ${RegisterExtension} "[executable]" "[extension]" "[description]"
- 
-"[executable]"     ; executable which opens the file format
-                   ;
-"[extension]"      ; extension, which represents the file format to open
-                   ;
-"[description]"    ; description for the extension. This will be display in Windows Explorer.
-                   ;
- 
- 
- ${UnRegisterExtension} "[extension]" "[description]"
- 
-"[extension]"      ; extension, which represents the file format to open
-                   ;
-"[description]"    ; description for the extension. This will be display in Windows Explorer.
-                   ;
- 
-_____________________________________________________________________________
- 
-                         Macros
-_____________________________________________________________________________
- 
- Change log window verbosity (default: 3=no script)
- 
- Example:
- !include "FileAssociation.nsh"
- !insertmacro RegisterExtension
- ${FileAssociation_VERBOSE} 4   # all verbosity
- !insertmacro UnRegisterExtension
- ${FileAssociation_VERBOSE} 3   # no script
-*/
- 
- 
-!ifndef FileAssociation_INCLUDED
-!define FileAssociation_INCLUDED
- 
-!include Util.nsh
- 
-!verbose push
-!verbose 3
-!ifndef _FileAssociation_VERBOSE
-  !define _FileAssociation_VERBOSE 3
-!endif
-!verbose ${_FileAssociation_VERBOSE}
-!define FileAssociation_VERBOSE `!insertmacro FileAssociation_VERBOSE`
-!verbose pop
- 
-!macro FileAssociation_VERBOSE _VERBOSE
-  !verbose push
-  !verbose 3
-  !undef _FileAssociation_VERBOSE
-  !define _FileAssociation_VERBOSE ${_VERBOSE}
-  !verbose pop
-!macroend
- 
- 
- 
-!macro RegisterExtensionCall _EXECUTABLE _EXTENSION _DESCRIPTION
-  !verbose push
-  !verbose ${_FileAssociation_VERBOSE}
-  Push `${_DESCRIPTION}`
-  Push `${_EXTENSION}`
-  Push `${_EXECUTABLE}`
-  ${CallArtificialFunction} RegisterExtension_
-  !verbose pop
-!macroend
- 
-!macro UnRegisterExtensionCall _EXTENSION _DESCRIPTION
-  !verbose push
-  !verbose ${_FileAssociation_VERBOSE}
-  Push `${_EXTENSION}`
-  Push `${_DESCRIPTION}`
-  ${CallArtificialFunction} UnRegisterExtension_
-  !verbose pop
-!macroend
- 
- 
- 
-!define RegisterExtension `!insertmacro RegisterExtensionCall`
-!define un.RegisterExtension `!insertmacro RegisterExtensionCall`
- 
-!macro RegisterExtension
-!macroend
- 
-!macro un.RegisterExtension
-!macroend
- 
-!macro RegisterExtension_
-  !verbose push
-  !verbose ${_FileAssociation_VERBOSE}
- 
-  Exch $R2 ;exe
-  Exch
-  Exch $R1 ;ext
-  Exch
-  Exch 2
-  Exch $R0 ;desc
-  Exch 2
-  Push $0
-  Push $1
- 
-  ReadRegStr $1 HKCR $R1 ""  ; read current file association
-  StrCmp "$1" "" NoBackup  ; is it empty
-  StrCmp "$1" "$R0" NoBackup  ; is it our own
-    WriteRegStr HKCR $R1 "backup_val" "$1"  ; backup current value
-NoBackup:
-  WriteRegStr HKCR $R1 "" "$R0"  ; set our file association
- 
-  ReadRegStr $0 HKCR $R0 ""
-  StrCmp $0 "" 0 Skip
-    WriteRegStr HKCR "$R0" "" "$R0"
-    WriteRegStr HKCR "$R0\shell" "" "open"
-    WriteRegStr HKCR "$R0\DefaultIcon" "" "$R2,0"
-Skip:
-  WriteRegStr HKCR "$R0\shell\open\command" "" '"$R2" "%1"'
-  WriteRegStr HKCR "$R0\shell\edit" "" "Edit $R0"
-  WriteRegStr HKCR "$R0\shell\edit\command" "" '"$R2" "%1"'
- 
-  Pop $1
-  Pop $0
-  Pop $R2
-  Pop $R1
-  Pop $R0
- 
-  !verbose pop
-!macroend
- 
- 
- 
-!define UnRegisterExtension `!insertmacro UnRegisterExtensionCall`
-!define un.UnRegisterExtension `!insertmacro UnRegisterExtensionCall`
- 
-!macro UnRegisterExtension
-!macroend
- 
-!macro un.UnRegisterExtension
-!macroend
- 
-!macro UnRegisterExtension_
-  !verbose push
-  !verbose ${_FileAssociation_VERBOSE}
- 
-  Exch $R1 ;desc
-  Exch
-  Exch $R0 ;ext
-  Exch
-  Push $0
-  Push $1
- 
-  ReadRegStr $1 HKCR $R0 ""
-  StrCmp $1 $R1 0 NoOwn ; only do this if we own it
-  ReadRegStr $1 HKCR $R0 "backup_val"
-  StrCmp $1 "" 0 Restore ; if backup="" then delete the whole key
-  DeleteRegKey HKCR $R0
-  Goto NoOwn
- 
-Restore:
-  WriteRegStr HKCR $R0 "" $1
-  DeleteRegValue HKCR $R0 "backup_val"
-  DeleteRegKey HKCR $R1 ;Delete key with association name settings
- 
-NoOwn:
- 
-  Pop $1
-  Pop $0
-  Pop $R1
-  Pop $R0
- 
-  !verbose pop
-!macroend
- 
-!endif # !FileAssociation_INCLUDED
\ No newline at end of file
diff --git a/dev/nsis/coq.nsi b/dev/nsis/coq.nsi
index 80da8451..f48013cf 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 f9310e07..f3e60ede 100644
--- a/dev/ocamldebug-coq.run
+++ b/dev/ocamldebug-coq.run
@@ -3,22 +3,24 @@
 # 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 $CAMLP5LIB -I +threads \
 	-I $COQTOP \
-	-I $COQTOP/config -I $COQTOP/printing -I $COQTOP/grammar \
-	-I $COQTOP/lib -I $COQTOP/intf -I $COQTOP/kernel \
+	-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/pretyping -I $COQTOP/parsing -I $COQTOP/vernac \
         -I $COQTOP/interp -I $COQTOP/proofs -I $COQTOP/tactics -I $COQTOP/stm \
 	-I $COQTOP/toplevel -I $COQTOP/dev -I $COQTOP/config -I $COQTOP/ltac \
         -I $COQTOP/plugins/cc         -I $COQTOP/plugins/dp \
@@ -30,6 +32,6 @@ exec $OCAMLDEBUG \
         -I $COQTOP/plugins/ring       -I $COQTOP/plugins/romega \
 	-I $COQTOP/plugins/rtauto     -I $COQTOP/plugins/setoid_ring \
         -I $COQTOP/plugins/subtac     -I $COQTOP/plugins/syntax \
-        -I $COQTOP/plugins/xml \
+        -I $COQTOP/plugins/xml        -I $COQTOP/plugins/ltac \
         -I $COQTOP/ide \
 	"$@"
diff --git a/dev/printers.mllib b/dev/printers.mllib
deleted file mode 100644
index 31654954..00000000
--- a/dev/printers.mllib
+++ /dev/null
@@ -1,219 +0,0 @@
-Coq_config
-
-Terminal
-Hook
-Canary
-Hashset
-Hashcons
-CSet
-CMap
-Int
-Dyn
-HMap
-Option
-Store
-Exninfo
-Backtrace
-IStream
-Pp_control
-Loc
-CList
-CString
-Tok
-Compat
-Flags
-Control
-Loc
-Serialize
-Stateid
-CObj
-CArray
-CStack
-Util
-Pp
-Ppstyle
-Richpp
-Feedback
-Segmenttree
-Unicodetable
-Unicode
-CErrors
-CWarnings
-Bigint
-CUnix
-Minisys
-System
-Envars
-Aux_file
-Profile
-Explore
-Predicate
-Rtree
-Heap
-Genarg
-Stateid
-CEphemeron
-Future
-RemoteCounter
-Monad
-
-Names
-Univ
-UGraph
-Esubst
-Uint31
-Sorts
-Evar
-Constr
-Context
-Vars
-Term
-Mod_subst
-Cbytecodes
-Copcodes
-Cemitcodes
-Nativevalues
-Primitives
-Nativeinstr
-Future
-Opaqueproof
-Declareops
-Retroknowledge
-Conv_oracle
-Pre_env
-Nativelambda
-Nativecode
-Nativelib
-Cbytegen
-Environ
-CClosure
-Reduction
-Nativeconv
-Type_errors
-Modops
-Inductive
-Typeops
-Fast_typeops
-Indtypes
-Cooking
-Term_typing
-Subtyping
-Mod_typing
-Nativelibrary
-Safe_typing
-Unionfind
-
-Summary
-Nameops
-Libnames
-Globnames
-Global
-Nametab
-Libobject
-Lib
-Loadpath
-Goptions
-Decls
-Heads
-Keys
-Locusops
-Miscops
-Universes
-Termops
-Namegen
-UState
-Evd
-Sigma
-Glob_ops
-Redops
-Pretype_errors
-Evarutil
-Reductionops
-Inductiveops
-Arguments_renaming
-Nativenorm
-Retyping
-Cbv
-
-Evardefine
-Evarsolve
-Recordops
-Evarconv
-Typing
-Patternops
-Constr_matching
-Find_subterm
-Tacred
-Classops
-Typeclasses_errors
-Logic_monad
-Proofview_monad
-Proofview
-Ftactic
-Geninterp
-Typeclasses
-Detyping
-Indrec
-Program
-Coercion
-Cases
-Pretyping
-Unification
-Declaremods
-Library
-States
-
-Genprint
-CLexer
-Ppextend
-Pputils
-Ppannotation
-Stdarg
-Constrarg
-Constrexpr_ops
-Genintern
-Notation_ops
-Notation
-Dumpglob
-Syntax_def
-Smartlocate
-Topconstr
-Reserve
-Impargs
-Implicit_quantifiers
-Constrintern
-Modintern
-Constrextern
-Goal
-Miscprint
-Logic
-Refiner
-Clenv
-Evar_refiner
-Refine
-Proof
-Proof_global
-Pfedit
-Decl_mode
-Ppconstr
-Pcoq
-Printer
-Pptactic
-Ppdecl_proof
-Egramml
-Egramcoq
-Tacsubst
-Trie
-Dn
-Btermdn
-Hints
-Himsg
-ExplainErr
-Locality
-Assumptions
-Vernacinterp
-Dischargedhypsmap
-Discharge
-Declare
-Ind_tables
-Top_printers
diff --git a/dev/set_raw_db b/dev/set_raw_db
deleted file mode 100644
index 5caff7e5..00000000
--- a/dev/set_raw_db
+++ /dev/null
@@ -1 +0,0 @@
-install_printer Top_printers.ppconstrdb
diff --git a/dev/tools/Makefile.devel b/dev/tools/Makefile.devel
deleted file mode 100644
index 8dcc70cf..00000000
--- a/dev/tools/Makefile.devel
+++ /dev/null
@@ -1,74 +0,0 @@
-# to be linked to makefile (lowercase - takes precedence over Makefile)
-# in main directory
-# make devel in main directory should do this for you.
-
-TOPDIR=.
-BASEDIR=
-
-SOURCEDIRS=lib kernel library pretyping parsing proofs tactics toplevel
-
-default:	usage noargument
-
-usage::
-	@echo Usage: make \<target\>
-	@echo Targets are:
-
-usage::
-	@echo "  setup-devel	-- set the devel makefile"
-setup-devel:
-	@ln -sfv dev/tools/Makefile.devel makefile
-	@(for i in $(SOURCEDIRS); do \
-	    (cd $(TOPDIR)/$$i; ln -sfv ../dev/tools/Makefile.dir Makefile) \
-	done)
-
-
-usage::
-	@echo "  clean-devel	-- clear all devel files"
-clean-devel:
-	echo rm -f makefile .depend.devel
-	echo rm -f $(foreach dir,$(SOURCEDIRS), $(TOPDIR)/$(dir)/Makefile)
-
-
-usage::
-	@echo "  coqtop	-- make until the bytecode executable, make the link"
-coqtop:	bin/coqtop.byte
-	ln -sf bin/coqtop.byte coqtop
-
-
-usage::
-	@echo "  quick		-- make bytecode executable and states"
-quick: 
-	$(MAKE) states BEST=byte
-
-include Makefile
-
-include $(TOPDIR)/dev/tools/Makefile.common
-
-# this file is better described in dev/tools/Makefile.dir
-include .depend.devel
-
-#if dev/tools/Makefile.local exists, it is included
-ifneq ($(wildcard $(TOPDIR)/dev/tools/Makefile.local),)
-include $(TOPDIR)/dev/tools/Makefile.local
-endif
-
-
-usage::
-	@echo "  total		-- runs coqtop with all theories required"
-total:
-	ledit ./bin/coqtop.byte $(foreach th,$(THEORIESVO),-require $(notdir $(basename $(th))))
-
-
-usage::
-	@echo "  run		-- makes and runs bytecode coqtop using ledit and the history file"
-	@echo "		   if you want to pass arguments to coqtop, use make run ARG=<args>"
-run:	$(TOPDIR)/coqtop
-	ledit -h $(TOPDIR)/dev/debug_history -x $(TOPDIR)/coqtop $(ARG) $(ARGS)
-
-
-usage::
-	@echo "  vars		-- echos commands to set COQTOP and COQBIN variables"
-vars:
-	@(cd $(TOPDIR); \
-	echo export COQTOP=`pwd`/ ; \
-	echo export COQBIN=`pwd`/bin/ )
diff --git a/dev/tools/Makefile.dir b/dev/tools/Makefile.dir
deleted file mode 100644
index 1a1bb90b..00000000
--- a/dev/tools/Makefile.dir
+++ /dev/null
@@ -1,131 +0,0 @@
-# make a link to this file if you are working hard in one directory of Coq
-#   ln -s ../dev/tools/Makefile.dir Makefile
-# if you are working in a sub/dir/ make a link to dev/tools/Makefile.subdir instead
-# this Makefile provides many useful facilities to develop Coq
-# it is not completely compatible with .ml4 files unfortunately
-
-ifndef TOPDIR
-TOPDIR=..
-endif
-
-# this complicated thing should work for subsubdirs as well
-BASEDIR=$(shell (dir=`pwd`; cd $(TOPDIR); top=`pwd`; echo $$dir | sed -e "s|$$top/||"))
-
-noargs:	dir
-
-test-dir:
-	@echo TOPDIR=$(TOPDIR)
-	@echo BASEDIR=$(BASEDIR)
-
-include $(TOPDIR)/dev/tools/Makefile.common
-
-# make this directory
-dir:
-	$(MAKE) -C $(TOPDIR) $(notdir $(BASEDIR))
-
-# make all cmo's in this directory. Useful in case the main Makefile is not
-# up-to-date
-all:	
-	@( ( for i in *.ml; do \
-	       echo -n $(BASEDIR)/`basename $$i .ml`.cmo "" ; \
-	     done; \
-	     for i in *.ml4; do \
-	       echo -n $(BASEDIR)/`basename $$i .ml4`.cmo "" ; \
-	     done ) \
-	  | xargs $(MAKE) -C $(TOPDIR) )
-
-# lists all files that should be compiled in this directory
-list:
-	@(for i in *.mli; do \
-	   ls -l `basename $$i .mli`.cmi; \
-	done)
-	@(for i in *.ml; do \
-	   ls -l `basename $$i .ml`.cmo; \
-	done)
-	@(for i in *.ml4; do \
-	   ls -l `basename $$i .ml4`.cmo; \
-	done)
-
-
-clean::  
-	rm -f *.cmi *.cmo *.cmx *.o
-
-
-# if grammar.cmo files cannot be compiled and main .depend cannot be
-# rebuilt, this is quite useful
-depend:
-	(cd $(TOPDIR); ocamldep -I $(BASEDIR) $(BASEDIR)/*.ml $(BASEDIR)/*.mli > .depend.devel)
-
-
-# displays the dependency graph of the current directory (vertically,
-# unlike in doc/)
-graph:
-	(ocamldep *.ml *.mli | ocamldot | dot -Tps | gv -) &
-
-
-# the pretty entry draws a dependency graph marking red those nodes
-# which do not have their .cmo files 
-
-.INTERMEDIATE: depend.dot depend.2.dot
-.PHONY: depend.ps
-
-depend.dot:
-	ocamldep *.ml *.mli | ocamldot > $@
-
-depend.2.dot:	depend.dot
-	(i=`cat $< | wc -l`; i=`expr $$i - 1`; head -n $$i $<) > $@
-	(for ml in *.ml; do \
-	   base=`basename $$ml .ml`; \
-	   fst=`echo $$base | cut -c1 | tr [:lower:] [:upper:]`; \
-	   rest=`echo $$base | cut -c2-`; \
-	   name=`echo $$fst $$rest | tr -d " "`; \
-	   cmo=$$base.cmo; \
-	   if [ ! -e $$cmo ]; then \
-	     echo \"$$name\" [color=red]\; >> $@;\
-	   fi;\
-         done;\
-	 echo } >> $@)
-
-depend.ps:	depend.2.dot
-	dot -Tps $< > $@
-
-clean::
-	rm -f depend.ps
-
-pretty:	depend.ps
-	(gv -spartan $<; rm $<) &
-#	gv -spartan $< &
-
-
-
-# generating file.ml.mli by tricking make to pass -i to ocamlc 
-
-%.ml.mli:	FORCE
-	@(cmo=`basename $@ .ml.mli`.cmo ; \
-	mv -f $$cmo $$cmo.tmp ; \
-	$(MAKE) -s -C $(TOPDIR) $(BASEDIR)/$$cmo CAMLDEBUG=-i > $@ ; \
-	echo Generated interface file $@ ; \
-	mv -f $$cmo.tmp $$cmo)
-
-%.annot:	FORCE
-	@(cmo=`basename $@ .annot`.cmo ; \
-	mv -f $$cmo $$cmo.tmp ; \
-	$(MAKE) -s -C $(TOPDIR) $(BASEDIR)/$$cmo CAMLDEBUG=-dtypes ; \
-	echo Generated annotation file $@ ; \
-	mv -f $$cmo.tmp $$cmo)
-
-FORCE:
-
-clean::
-	rm -f *.ml.mli
-
-# this is not perfect but mostly WORKS! It just calls the main makefile
-
-%.cmi:	FORCE
-	$(MAKE) -C $(TOPDIR) $(BASEDIR)/$@
-
-%.cmo:	FORCE
-	$(MAKE) -C $(TOPDIR) $(BASEDIR)/$@
-
-coqtop:	
-	$(MAKE) -C $(TOPDIR) bin/coqtop.byte
diff --git a/dev/tools/Makefile.subdir b/dev/tools/Makefile.subdir
deleted file mode 100644
index cb914bd1..00000000
--- a/dev/tools/Makefile.subdir
+++ /dev/null
@@ -1,7 +0,0 @@
-# if you work in a sub/sub-rectory of Coq
-# you should make a link to that makefile 
-#    ln -s ../../dev/tools/Makefile.subdir Makefile
-# in order to have all the facilities of dev/tools/Makefile.dir
-
-TOPDIR=../..
-include $(TOPDIR)/dev/tools/Makefile.dir
diff --git a/dev/tools/anomaly-traces-parser.el b/dev/tools/anomaly-traces-parser.el
deleted file mode 100644
index 68f54266..00000000
--- 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 00000000..e4359f70
--- /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 00000000..e244d9ab
--- /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 00000000..62fdaec8
--- /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 00000000..beb26d91
--- /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 00000000..9f24960f
--- /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 00000000..dfa95bac
--- /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.XXXXXX")
+    fixed_index=$(mktemp "git-fix-ws-index-fixed.XXXXXX")
+    tree=$(mktemp "git-fix-ws-tree.XXXXXX")
+    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 --whitespace=nowarn --cached -R "$index"
+    git apply --whitespace=nowarn -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 --whitespace=nowarn -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 00000000..f8bf6bed
--- /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 a3d5cf5c..ba0c5440 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -1,24 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* 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
@@ -26,85 +27,82 @@ open Clenv
 let _ = Detyping.print_evar_arguments := true
 let _ = Detyping.print_universes := true
 let _ = set_bool_option_value ["Printing";"Matching"] false
-let _ = Detyping.set_detype_anonymous (fun _ _ -> raise Not_found)
+let _ = Detyping.set_detype_anonymous (fun ?loc _ -> raise Not_found)
 
 (* std_ppcmds *)
-let pp   x = Pp.pp_with !Pp_control.std_ft x
+let pp   x = Pp.pp_with !Topfmt.std_ft x
 
 (** Future printer *)
 
 let ppfuture kx = pp (Future.print (fun _ -> str "_") kx)
 
 (* name printers *)
-let ppid id = pp (pr_id id)
-let pplab l = pp (pr_lab l)
+let ppid id = pp (Id.print id)
+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 pprecarg = 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 ppconstr x = pp (Termops.print_constr x)
+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 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));;
 
 let prset pr l = str "[" ++ hov 0 (prlist_with_sep spc pr l) ++ str "]"
 let ppintset l = pp (prset int (Int.Set.elements l))
-let ppidset l = pp (prset pr_id (Id.Set.elements l))
+let ppidset l = pp (prset Id.print (Id.Set.elements l))
 
 let prset' pr l = str "[" ++ hov 0 (prlist_with_sep pr_comma pr l) ++ str "]"
 
 let pridmap pr l =
-  let pr (id,b) = pr_id id ++ str "=>" ++ pr id b in
+  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 c ++
+  (Termops.print_constr (EConstr.of_constr c) ++
    (match copt with None -> mt () | Some c -> spc () ++ str "<expanded: " ++
-    Termops.print_constr c ++ str">") ++
+    Termops.print_constr (EConstr.of_constr c) ++ str">") ++
    (if id = id0 then mt ()
-    else spc () ++ str "<canonical: " ++ pr_id id ++ str ">"))))
+    else spc () ++ str "<canonical: " ++ Id.print id ++ str ">"))))
 
-let prididmap = pridmap (fun _ -> pr_id)
-let ppididmap = ppidmap (fun _ -> pr_id)
+let prididmap = pridmap (fun _ -> Id.print)
+let ppididmap = ppidmap (fun _ -> Id.print)
 
 let prconstrunderbindersidmap = pridmap (fun _ (l,c) ->
   hov 1 (str"[" ++  prlist_with_sep spc Id.print l ++ str"]")
@@ -113,10 +111,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() ++
@@ -124,7 +121,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)
@@ -133,40 +130,40 @@ 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(" ++ pr_id id ++ 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"#" ++ pr_kn 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"#" ++ pr_id 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)
 let pp_transparent_state s = pp (pr_transparent_state s)
-let pp_stack_t n = pp (Reductionops.Stack.pr Termops.print_constr n)
+let pp_stack_t n = pp (Reductionops.Stack.pr (EConstr.of_constr %> Termops.print_constr) n)
 let pp_cst_stack_t n = pp (Reductionops.Cst_stack.pr n)
 let pp_state_t n = pp (Reductionops.pr_state n)
 
 (* proof printers *)
 let pr_evar ev = Pp.int (Evar.repr ev)
-let ppmetas metas = pp(pr_metaset metas)
-let ppevm evd = pp(pr_evar_map ~with_univs:!Flags.univ_print (Some 2) evd)
-let ppevmall evd = pp(pr_evar_map ~with_univs:!Flags.univ_print None evd)
+let ppmetas metas = pp(Termops.pr_metaset metas)
+let ppevm evd = pp(Termops.pr_evar_map ~with_univs:!Flags.univ_print (Some 2) evd)
+let ppevmall evd = pp(Termops.pr_evar_map ~with_univs:!Flags.univ_print None evd)
 let pr_existentialset evars =
   prlist_with_sep spc pr_evar (Evar.Set.elements evars)
 let ppexistentialset evars =
@@ -177,14 +174,14 @@ let ppexistentialfilter filter = match Evd.Filter.repr filter with
 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 ++ pr_evar_map None (Refiner.project g))
-let pphintdb db = pp(Hints.pr_hint_db db)
+let ppgoalsigma g = pp(Printer.pr_goal g ++ Termops.pr_evar_map None (Refiner.project g))
+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 () ++ pr_evar_map (Some 1) sigma)
+  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 (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)
 *)
@@ -200,11 +197,11 @@ let pppftreestate p = pp(print_pftreestate p)
 (* let ppsigmagoal g = pp(pr_goal (sig_it g)) *)
 (* let prgls gls = pp(pr_gls gls) *)
 (* let prglls glls = pp(pr_glls glls) *)
-(* let pproof p = pp(print_proof Evd.empty empty_named_context p) *)
 
-let ppuni u = pp(pr_uni u)
+let pproof p = pp(Proof.pr_proof p)
+
+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)
@@ -214,12 +211,14 @@ let ppuniverse_context_set l = pp (pr_universe_context_set prlev l)
 let ppuniverse_subst l = pp (Univ.pr_universe_subst l)
 let ppuniverse_opt_subst l = pp (Universes.pr_universe_opt_subst l)
 let ppuniverse_level_subst l = pp (Univ.pr_universe_level_subst l)
-let ppevar_universe_context l = pp (Evd.pr_evar_universe_context l)
+let ppevar_universe_context l = pp (Termops.pr_evar_universe_context l)
 let ppconstraints c = pp (pr_constraints Level.pr c)
 let ppuniverseconstraints c = pp (Universes.Constraints.pr c)
 let ppuniverse_context_future c = 
   let ctx = Future.force c in
     ppuniverse_context ctx
+let ppcumulativity_info c = pp (Univ.pr_cumulativity_info Univ.Level.pr c)
+let ppabstract_cumulativity_info c = pp (Univ.pr_abstract_cumulativity_info Univ.Level.pr c)
 let ppuniverses u = pp (UGraph.pr_universes Level.pr u)
 let ppnamedcontextval e =
   pp (pr_named_context (Global.env ()) Evd.empty (named_context_of_val e))
@@ -231,9 +230,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(Pptactic.pr_glob_tactic (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)
 
@@ -247,7 +246,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)^")"
@@ -262,14 +261,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)^")"
@@ -316,10 +315,12 @@ let constr_display csr =
   in
   pp (str (term_display csr) ++fnl ())
 
+let econstr_display c = constr_display EConstr.Unsafe.(to_constr c) ;;
+
 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)
@@ -437,7 +438,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 =
@@ -446,7 +447,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
@@ -455,7 +456,7 @@ let print_pure_constr csr =
 	print_string (Printexc.to_string e);print_flush ();
 	raise e
 
-let ppfconstr c = ppconstr (CClosure.term_of_fconstr c)
+let print_pure_econstr c = print_pure_constr EConstr.Unsafe.(to_constr c) ;;
 
 let pploc x = let (l,r) = Loc.unloc x in
   print_string"(";print_int l;print_string",";print_int r;print_string")"
@@ -490,7 +491,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 ]
@@ -500,9 +501,8 @@ VERNAC COMMAND EXTEND PrintConstr
 END
 *)
 
-open Pcoq
 open Genarg
-open Constrarg
+open Stdarg
 open Egramml
 
 let _ =
@@ -511,7 +511,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 econstr_display c; st)
        | _ -> failwith "Vernac extension: cannot occur")
   with
     e -> pp (CErrors.print e)
@@ -519,7 +519,7 @@ let _ =
   extend_vernac_command_grammar ("PrintConstr", 0) None
     [GramTerminal "PrintConstr";
       GramNonTerminal
-        (Loc.ghost,rawwit wit_constr,Extend.Aentry Pcoq.Constr.constr)]
+        (Loc.tag (Some (rawwit wit_constr),Extend.Aentry Pcoq.Constr.constr))]
 
 let _ =
   try
@@ -527,7 +527,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_econstr c; st)
        | _ -> failwith "Vernac extension: cannot occur")
   with
     e -> pp (CErrors.print e)
@@ -535,47 +535,47 @@ let _ =
   extend_vernac_command_grammar ("PrintPureConstr", 0) None
     [GramTerminal "PrintPureConstr";
       GramNonTerminal
-        (Loc.ghost,rawwit wit_constr,Extend.Aentry Pcoq.Constr.constr)]
+        (Loc.tag (Some (rawwit wit_constr),Extend.Aentry Pcoq.Constr.constr))]
 
 (* Setting printer of unbound global reference *)
 open Names
 open Libnames
 
-let encode_path loc prefix mpdir suffix id =
+let encode_path ?loc prefix mpdir suffix id =
   let dir = match mpdir with
     | None -> []
     | Some (mp,dir) ->
-	(DirPath.repr (dirpath_of_string (string_of_mp mp))@
+	(DirPath.repr (dirpath_of_string (ModPath.to_string mp))@
 	DirPath.repr dir) in
-  Qualid (loc, make_qualid
+  CAst.make ?loc @@ Qualid (make_qualid
     (DirPath.make (List.rev (Id.of_string prefix::dir@suffix))) id)
 
-let raw_string_of_ref loc _ = function
+let raw_string_of_ref ?loc _ = function
   | ConstRef cst ->
-      let (mp,dir,id) = repr_con cst in
-      encode_path loc "CST" (Some (mp,dir)) [] (Label.to_id id)
+      let (mp,dir,id) = Constant.repr3 cst in
+      encode_path ?loc "CST" (Some (mp,dir)) [] (Label.to_id id)
   | IndRef (kn,i) ->
-      let (mp,dir,id) = repr_mind kn in
-      encode_path loc "IND" (Some (mp,dir)) [Label.to_id id]
+      let (mp,dir,id) = MutInd.repr3 kn in
+      encode_path ?loc "IND" (Some (mp,dir)) [Label.to_id id]
 	(Id.of_string ("_"^string_of_int i))
   | ConstructRef ((kn,i),j) ->
-      let (mp,dir,id) = repr_mind kn in
-      encode_path loc "CSTR" (Some (mp,dir))
+      let (mp,dir,id) = MutInd.repr3 kn in
+      encode_path ?loc "CSTR" (Some (mp,dir))
 	[Label.to_id id;Id.of_string ("_"^string_of_int i)]
 	(Id.of_string ("_"^string_of_int j))
   | VarRef id ->
-      encode_path loc "SECVAR" None [] id
+      encode_path ?loc "SECVAR" None [] id
 
-let short_string_of_ref loc _ = function
-  | VarRef id -> Ident (loc,id)
-  | ConstRef cst -> Ident (loc,Label.to_id (pi3 (repr_con cst)))
-  | IndRef (kn,0) -> Ident (loc,Label.to_id (pi3 (repr_mind kn)))
+let short_string_of_ref ?loc _ = function
+  | VarRef id -> CAst.make ?loc @@ Ident id
+  | ConstRef cst -> CAst.make ?loc @@ Ident (Label.to_id (pi3 (Constant.repr3 cst)))
+  | IndRef (kn,0) -> CAst.make ?loc @@ Ident (Label.to_id (pi3 (MutInd.repr3 kn)))
   | IndRef (kn,i) ->
-      encode_path loc "IND" None [Label.to_id (pi3 (repr_mind kn))]
+      encode_path ?loc "IND" None [Label.to_id (pi3 (MutInd.repr3 kn))]
         (Id.of_string ("_"^string_of_int i))
   | ConstructRef ((kn,i),j) ->
-      encode_path loc "CSTR" None
-        [Label.to_id (pi3 (repr_mind kn));Id.of_string ("_"^string_of_int i)]
+      encode_path ?loc "CSTR" None
+        [Label.to_id (pi3 (MutInd.repr3 kn));Id.of_string ("_"^string_of_int i)]
         (Id.of_string ("_"^string_of_int j))
 
 (* Anticipate that printers can be used from ocamldebug and that 
diff --git a/dev/top_printers.mli b/dev/top_printers.mli
new file mode 100644
index 00000000..dad6dcc1
--- /dev/null
+++ b/dev/top_printers.mli
@@ -0,0 +1,175 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** 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 : Ltac_plugin.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/v8-syntax/syntax-v8.tex b/dev/v8-syntax/syntax-v8.tex
index 64431ea1..6b7960c9 100644
--- a/dev/v8-syntax/syntax-v8.tex
+++ b/dev/v8-syntax/syntax-v8.tex
@@ -1158,7 +1158,7 @@ $$
 \nlsep \TERM{Abort}~\NT{ident}
 \nlsep \TERM{Existential}~\NT{num}~\KWD{:=}~\NT{constr-body}
 \nlsep \TERM{Qed}
-\nlsep \TERM{Save}~\OPTGR{\NT{thm-token}~\NT{ident}}
+\nlsep \TERM{Save}~\NT{ident}
 \nlsep \TERM{Defined}~\OPT{\NT{ident}}
 \nlsep \TERM{Suspend}
 \nlsep \TERM{Resume}~\OPT{\NT{ident}}
diff --git a/dev/vm_printers.ml b/dev/vm_printers.ml
index afa94a63..2ddf927d 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,10 +32,14 @@ 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
+  | EvarKey evk ->
+    print_string "Evar(";
+    print_int (Evar.repr evk);
+    print_string ")"
 
 let rec ppzipper z =
   match z with
@@ -61,15 +65,14 @@ and ppstack s =
 and ppatom a =
   match a with
   | Aid idk -> print_idkey idk
-  | Atype u -> print_string "Type(...)"
+  | Asort u -> print_string "Sort(...)"
   | 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 ")"
 
 and ppwhd whd =
   match whd with
-  | Vsort s -> ppsort s
   | Vprod _ -> print_string "product"
   | Vfun _ -> print_string "function"
   | Vfix _ -> print_vfix()
diff --git a/doc/LICENSE b/doc/LICENSE
index ada22e66..c223a4e1 100644
--- a/doc/LICENSE
+++ b/doc/LICENSE
@@ -2,11 +2,17 @@ The Coq Reference Manual is a collective work from the Coq Development
 Team whose members are listed in the file CREDITS of the Coq source
 package. All related documents (the LaTeX and BibTeX sources, the
 embedded png files, and the PostScript, PDF and html outputs) are
-copyright (c) INRIA 1999-2006. The material connected to the Reference
-Manual may be distributed only subject to the terms and conditions set
-forth in the Open Publication License, v1.0 or later (the latest
-version is presently available at http://www.opencontent.org/openpub/).
-Options A and B are *not* elected.
+copyright (c) INRIA 1999-2006, with the exception of the Ubuntu font
+file UbuntuMono-B.ttf, which is
+Copyright 2010,2011 Canonical Ltd and licensed under the Ubuntu font
+license, version 1.0
+(https://www.ubuntu.com/legal/terms-and-policies/font-licence), and its
+derivative CoqNotations.ttf distributed under the same license. The
+material connected to the Reference Manual may be distributed only
+subject to the terms and conditions set forth in the Open Publication
+License, v1.0 or later (the latest version is presently available at
+http://www.opencontent.org/openpub/).  Options A and B are *not*
+elected.
 
 The Coq Tutorial is a work by Gérard Huet, Gilles Kahn and Christine
 Paulin-Mohring. All documents (the LaTeX source and the PostScript,
@@ -25,16 +31,6 @@ the PostScript, PDF and html outputs) are copyright (c) INRIA
 distributed under the terms of the Lesser General Public License
 version 2.1 or later. 
 
-The FAQ (Coq for the Clueless) is a work by Pierre Castéran, Hugo
-Herbelin, Florent Kirchner, Benjamin Monate, and Julien Narboux. All
-documents (the LaTeX source and the PostScript, PDF and html outputs)
-are copyright (c) INRIA 2004-2006. The material connected to the FAQ
-(Coq for the Clueless) may be distributed only subject to the terms
-and conditions set forth in the Open Publication License, v1.0 or
-later (the latest version is presently available at
-http://www.opencontent.org/openpub/). Options A and B are *not*
-elected.
-
 The Tutorial on [Co-]Inductive Types in Coq is a work by Pierre
 Castéran and Eduardo Gimenez. All related documents (the LaTeX and
 BibTeX sources and the PostScript, PDF and html outputs) are copyright
diff --git a/doc/Makefile.rt b/doc/Makefile.rt
deleted file mode 100644
index 6c328134..00000000
--- a/doc/Makefile.rt
+++ /dev/null
@@ -1,43 +0,0 @@
-# Makefile for building Coq Technical Reports
-
-# if coqc,coqtop,coq-tex are not in your PATH, you need the environment 
-# variable COQBIN to be correctly set  
-# (COQTOP is autodetected)
-# (some files are preprocessed using Coq and some part of the documentation
-# is automatically built from the theories sources)
-
-# To compile documentation, you need the following tools:
-# Dvi: latex (latex2e), bibtex, makeindex, dviselect (package RPM dviutils)
-# Ps: dvips, psutils (ftp://ftp.dcs.ed.ac.uk/pub/ajcd/psutils.tar.gz)
-# Pdf: pdflatex
-# Html:
-#   - hevea: http://para.inria.fr/~maranget/hevea/
-#   - htmlSplit: http://coq.inria.fr/~delahaye
-# Rapports INRIA: dviselect, rrkit (par Michel Mauny)
-
-include ./Makefile
-
-###################
-# RT
-###################
-# Fabrication d'un RT INRIA (utilise rrkit de Michel Mauny)
-rt/Reference-Manual-RT.dvi: refman/Reference-Manual.dvi rt/RefMan-cover.tex
-	dviselect -i refman/Reference-Manual.dvi -o rt/RefMan-body.dvi 3:
-	(cd rt; $(LATEX) RefMan-cover.tex)
-	set a=`tail -1 refman/Reference-Manual.log`;\
-	set a=expr \("$$a" : '.*(\(.*\) pages.*'\) % 2;\
-	(cd rt; if $(TEST) "$$a = 0";\
-	 then rrkit  RefMan-cover.dvi RefMan-body.dvi Reference-Manual-RT.dvi;\
-	 else rrkit -odd RefMan-cover.dvi RefMan-body.dvi Reference-Manual-RT.dvi;\
-	fi)
-
-# Fabrication d'un RT INRIA (utilise rrkit de Michel Mauny)
-rt/Tutorial-RT.dvi : tutorial/Tutorial.v.dvi rt/Tutorial-cover.tex
-	dviselect -i rt/Tutorial.v.dvi -o rt/Tutorial-body.dvi 3:
-	(cd rt; $(LATEX) Tutorial-cover.tex)
-	set a=`tail -1 tutorial/Tutorial.v.log`;\
-	set a=expr \("$$a" : '.*(\(.*\) pages.*'\) % 2;\
-	(cd rt; if $(TEST) "$$a = 0";\
-	 then rrkit      Tutorial-cover.dvi Tutorial-body.dvi Tutorial-RT.dvi;\
-	 else rrkit -odd Tutorial-cover.dvi Tutorial-body.dvi Tutorial-RT.dvi;\
-	fi)
diff --git a/doc/common/styles/html/simple/style.css b/doc/common/styles/html/simple/style.css
index 0b1e640b..d1b2ce11 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/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template
index 9216c81f..8c09b23a 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
@@ -46,6 +47,7 @@ through the <tt>Require Import</tt> command.</p>
     theories/Logic/ClassicalDescription.v
     theories/Logic/ClassicalEpsilon.v
     theories/Logic/ClassicalUniqueChoice.v
+    theories/Logic/SetoidChoice.v
     theories/Logic/Berardi.v
     theories/Logic/Diaconescu.v
     theories/Logic/Hurkens.v
@@ -55,7 +57,10 @@ through the <tt>Require Import</tt> command.</p>
     theories/Logic/Description.v
     theories/Logic/Epsilon.v
     theories/Logic/IndefiniteDescription.v
+    theories/Logic/PropExtensionality.v
+    theories/Logic/PropExtensionalityFacts.v
     theories/Logic/FunctionalExtensionality.v
+    theories/Logic/ExtensionalFunctionRepresentative.v
     theories/Logic/ExtensionalityFacts.v
     theories/Logic/WeakFan.v
     theories/Logic/WKL.v
@@ -220,8 +225,13 @@ through the <tt>Require Import</tt> command.</p>
     <dd>
     theories/Numbers/BinNums.v
     theories/Numbers/NumPrelude.v
-    theories/Numbers/BigNumPrelude.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>:
@@ -252,16 +262,7 @@ through the <tt>Require Import</tt> command.</p>
     <dd>
     theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
     theories/Numbers/Cyclic/Abstract/NZCyclic.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
-    theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
+    theories/Numbers/Cyclic/Abstract/DoubleType.v
     theories/Numbers/Cyclic/Int31/Cyclic31.v
     theories/Numbers/Cyclic/Int31/Ring31.v
     theories/Numbers/Cyclic/Int31/Int31.v
@@ -294,12 +295,6 @@ through the <tt>Require Import</tt> command.</p>
     theories/Numbers/Natural/Abstract/NProperties.v
     theories/Numbers/Natural/Binary/NBinary.v
     theories/Numbers/Natural/Peano/NPeano.v
-    theories/Numbers/Natural/SpecViaZ/NSig.v
-    theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
-    theories/Numbers/Natural/BigN/BigN.v
-    theories/Numbers/Natural/BigN/Nbasic.v
-    theories/Numbers/Natural/BigN/NMake.v
-    theories/Numbers/Natural/BigN/NMake_gen.v
     </dd>
 
     <dt> <b>&nbsp;&nbsp;Integer</b>:
@@ -327,19 +322,6 @@ through the <tt>Require Import</tt> command.</p>
     theories/Numbers/Integer/Abstract/ZDivTrunc.v
     theories/Numbers/Integer/Binary/ZBinary.v
     theories/Numbers/Integer/NatPairs/ZNatPairs.v
-    theories/Numbers/Integer/SpecViaZ/ZSig.v
-    theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
-    theories/Numbers/Integer/BigZ/BigZ.v
-    theories/Numbers/Integer/BigZ/ZMake.v
-    </dd>
-
-    <dt><b>&nbsp;&nbsp;Rational</b>:
-       Abstract and 31-bits-words-based rational arithmetic
-    </dt>
-    <dd>
-    theories/Numbers/Rational/SpecViaQ/QSig.v
-    theories/Numbers/Rational/BigQ/BigQ.v
-    theories/Numbers/Rational/BigQ/QMake.v
     </dd>
     </dl>
   </dd>
@@ -614,8 +596,8 @@ through the <tt>Require Import</tt> command.</p>
   </dt>
   <dd>
     theories/Compat/AdmitAxiom.v
-    theories/Compat/Coq84.v
-    theories/Compat/Coq85.v
     theories/Compat/Coq86.v
+    theories/Compat/Coq87.v
+    theories/Compat/Coq88.v
   </dd>
 </dl>
diff --git a/doc/tools/coqrst/__init__.py b/doc/tools/coqrst/__init__.py
new file mode 100644
index 00000000..2dda7d92
--- /dev/null
+++ b/doc/tools/coqrst/__init__.py
@@ -0,0 +1,10 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""Utilities for documenting Coq in Sphinx"""
diff --git a/doc/tools/coqrst/checkdeps.py b/doc/tools/coqrst/checkdeps.py
new file mode 100644
index 00000000..11f95c4e
--- /dev/null
+++ b/doc/tools/coqrst/checkdeps.py
@@ -0,0 +1,39 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+from __future__ import print_function
+import sys
+
+def eprint(*args, **kwargs):
+    print(*args, file=sys.stderr, **kwargs)
+
+def missing_dep(dep):
+    eprint('Cannot find %s (needed to build documentation)' % dep)
+    eprint('You can run `pip3 install %s` to install it.' % dep)
+    sys.exit(1)
+
+try:
+    import sphinx_rtd_theme
+except:
+    missing_dep('sphinx_rtd_theme')
+
+try:
+    import pexpect
+except:
+    missing_dep('pexpect')
+
+try:
+    import antlr4
+except:
+    missing_dep('antlr4-python3-runtime')
+
+try:
+    import bs4
+except:
+    missing_dep('beautifulsoup4')
diff --git a/doc/tools/coqrst/coqdoc/__init__.py b/doc/tools/coqrst/coqdoc/__init__.py
new file mode 100644
index 00000000..a89a548e
--- /dev/null
+++ b/doc/tools/coqrst/coqdoc/__init__.py
@@ -0,0 +1,10 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+from .main import *
diff --git a/doc/tools/coqrst/coqdoc/main.py b/doc/tools/coqrst/coqdoc/main.py
new file mode 100644
index 00000000..57adcb28
--- /dev/null
+++ b/doc/tools/coqrst/coqdoc/main.py
@@ -0,0 +1,91 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""
+Use CoqDoc to highlight Coq snippets
+====================================
+
+Pygment's Coq parser isn't the best; instead, use coqdoc to highlight snippets.
+Only works for full, syntactically valid sentences; on shorter snippets, coqdoc
+swallows parts of the input.
+
+Works by reparsing coqdoc's output into the output that Sphinx expects from a
+lexer.
+"""
+
+import os
+import platform
+from tempfile import mkstemp
+from subprocess import check_output
+
+from bs4 import BeautifulSoup
+from bs4.element import NavigableString
+
+COQDOC_OPTIONS = ['--body-only', '--no-glob', '--no-index', '--no-externals',
+                  '-s', '--html', '--stdout', '--utf8']
+
+COQDOC_SYMBOLS = ["->", "<-", "<->", "=>", "<=", ">=", "<>", "~", "/\\", "\\/", "|-", "*", "forall", "exists"]
+COQDOC_HEADER = "".join("(** remove printing {} *)".format(s) for s in COQDOC_SYMBOLS)
+
+def coqdoc(coq_code, coqdoc_bin=None):
+    """Get the output of coqdoc on coq_code."""
+    coqdoc_bin = coqdoc_bin or os.path.join(os.getenv("COQBIN"), "coqdoc")
+    fd, filename = mkstemp(prefix="coqdoc-", suffix=".v")
+    if platform.system().startswith("CYGWIN"):
+        # coqdoc currently doesn't accept cygwin style paths in the form "/cygdrive/c/..."
+        filename = check_output(["cygpath", "-w", filename]).decode("utf-8").strip()
+    try:
+        os.write(fd, COQDOC_HEADER.encode("utf-8"))
+        os.write(fd, coq_code.encode("utf-8"))
+        os.close(fd)
+        return check_output([coqdoc_bin] + COQDOC_OPTIONS + [filename], timeout = 10).decode("utf-8")
+    finally:
+        os.remove(filename)
+
+def is_whitespace_string(elem):
+    return isinstance(elem, NavigableString) and elem.strip() == ""
+
+def strip_soup(soup, pred):
+    """Strip elements maching pred from front and tail of soup."""
+    while soup.contents and pred(soup.contents[-1]):
+        soup.contents.pop()
+
+    skip = 0
+    for elem in soup.contents:
+        if not pred(elem):
+            break
+        skip += 1
+
+    soup.contents[:] = soup.contents[skip:]
+
+def lex(source):
+    """Convert source into a stream of (css_classes, token_string)."""
+    coqdoc_output = coqdoc(source)
+    soup = BeautifulSoup(coqdoc_output, "html.parser")
+    root = soup.find(class_='code')
+    strip_soup(root, is_whitespace_string)
+    for elem in root.children:
+        if isinstance(elem, NavigableString):
+            yield [], elem
+        elif elem.name == "span":
+            cls = "coqdoc-{}".format(elem['title'])
+            yield [cls], elem.string
+        elif elem.name == 'br':
+            pass
+        else:
+            raise ValueError(elem)
+
+def main():
+    """Lex stdin (for testing purposes)"""
+    import sys
+    for classes, text in lex(sys.stdin.read()):
+        print(repr(text) + "\t" ' '.join(classes))
+
+if __name__ == '__main__':
+    main()
diff --git a/doc/tools/coqrst/coqdomain.py b/doc/tools/coqrst/coqdomain.py
new file mode 100644
index 00000000..edf4e6ec
--- /dev/null
+++ b/doc/tools/coqrst/coqdomain.py
@@ -0,0 +1,1201 @@
+# -*- coding: utf-8 -*-
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""A Coq domain for Sphinx.
+
+Currently geared towards Coq's manual, rather than Coq source files, but one
+could imagine extending it.
+"""
+
+# pylint: disable=too-few-public-methods
+
+import re
+from itertools import chain
+from collections import defaultdict
+
+from docutils import nodes, utils
+from docutils.transforms import Transform
+from docutils.parsers.rst import Directive, directives
+from docutils.parsers.rst.roles import code_role #, set_classes
+from docutils.parsers.rst.directives.admonitions import BaseAdmonition
+
+from sphinx import addnodes
+from sphinx.roles import XRefRole
+from sphinx.errors import ExtensionError
+from sphinx.util.nodes import set_source_info, set_role_source_info, make_refnode
+from sphinx.util.logging import getLogger
+from sphinx.directives import ObjectDescription
+from sphinx.domains import Domain, ObjType, Index
+from sphinx.domains.std import token_xrefs
+from sphinx.ext import mathbase
+
+from . import coqdoc
+from .repl import ansicolors
+from .repl.coqtop import CoqTop
+from .notations.sphinx import sphinxify
+from .notations.plain import stringify_with_ellipses
+
+def parse_notation(notation, source, line, rawtext=None):
+    """Parse notation and wrap it in an inline node"""
+    node = nodes.inline(rawtext or notation, '', *sphinxify(notation), classes=['notation'])
+    node.source, node.line = source, line
+    return node
+
+def highlight_using_coqdoc(sentence):
+    """Lex sentence using coqdoc, and yield inline nodes for each token"""
+    tokens = coqdoc.lex(utils.unescape(sentence, 1))
+    for classes, value in tokens:
+        yield nodes.inline(value, value, classes=classes)
+
+def make_target(objtype, targetid):
+    """Create a target to an object of type objtype and id targetid"""
+    return "coq:{}.{}".format(objtype, targetid)
+
+def make_math_node(latex, docname, nowrap):
+    node = mathbase.displaymath()
+    node['latex'] = latex
+    node['label'] = None # Otherwise equations are numbered
+    node['nowrap'] = nowrap
+    node['docname'] = docname
+    node['number'] = None
+    return node
+
+class CoqObject(ObjectDescription):
+    """A generic Coq object for Sphinx; all Coq objects are subclasses of this.
+
+    The fields and methods to override are listed at the top of this class'
+    implementation.  Each object supports the :name: option, which gives an
+    explicit name to link to.
+
+    See the comments and docstrings in CoqObject for more information.
+    """
+
+    # The semantic domain in which this object lives (eg. “tac�, “cmd�, “chm�…).
+    # It matches exactly one of the roles used for cross-referencing.
+    subdomain = None # type: str
+
+    # The suffix to use in indices for objects of this type (eg. “(tac)�)
+    index_suffix = None # type: str
+
+    # The annotation to add to headers of objects of this type
+    # (eg. “Command�, “Theorem�)
+    annotation = None # type: str
+
+    def _name_from_signature(self, signature): # pylint: disable=no-self-use, unused-argument
+        """Convert a signature into a name to link to.
+
+        ‘Signature’ is Sphinx parlance for an object's header (think “type
+        signature�); for example, the signature of the simplest form of the
+        ``exact`` tactic is ``exact @id``.
+
+        Returns None by default, in which case no name will be automatically
+        generated.  This is a convenient way to automatically generate names
+        (link targets) without having to write explicit names everywhere.
+
+        """
+        return None
+
+    def _render_signature(self, signature, signode):
+        """Render a signature, placing resulting nodes into signode."""
+        raise NotImplementedError(self)
+
+    option_spec = {
+        # Explicit object naming
+        'name': directives.unchanged,
+        # Silence warnings produced by report_undocumented_coq_objects
+        'undocumented': directives.flag,
+        # noindex omits this object from its index
+        'noindex': directives.flag
+    }
+
+    def subdomain_data(self):
+        if self.subdomain is None:
+            raise ValueError()
+        return self.env.domaindata['coq']['objects'][self.subdomain]
+
+    def _render_annotation(self, signode):
+        if self.annotation:
+            annot_node = nodes.inline(self.annotation, self.annotation, classes=['sigannot'])
+            signode += addnodes.desc_annotation(self.annotation, '', annot_node)
+            signode += nodes.Text(' ')
+
+    def handle_signature(self, signature, signode):
+        """Prefix signature with the proper annotation, then render it using
+        ``_render_signature`` (for example, add “Command� in front of commands).
+
+        :returns: the name given to the resulting node, if any
+        """
+        self._render_annotation(signode)
+        self._render_signature(signature, signode)
+        name = self._names.get(signature)
+        if name is None:
+            name = self._name_from_signature(signature)
+            # remove trailing ‘.’ found in commands, but not ‘...’ (ellipsis)
+            if name is not None and name.endswith(".") and not name.endswith("..."):
+                name = name[:-1]
+        return name
+
+    def _warn_if_duplicate_name(self, objects, name):
+        """Check that two objects in the same domain don't have the same name."""
+        if name in objects:
+            MSG = 'Duplicate object: {}; other is at {}'
+            msg = MSG.format(name, self.env.doc2path(objects[name][0]))
+            self.state_machine.reporter.warning(msg, line=self.lineno)
+
+    def _warn_if_duplicate_name(self, objects, name):
+        """Check that two objects in the same domain don't have the same name."""
+        if name in objects:
+            MSG = 'Duplicate object: {}; other is at {}'
+            msg = MSG.format(name, self.env.doc2path(objects[name][0]))
+            self.state_machine.reporter.warning(msg, line=self.lineno)
+
+    def _record_name(self, name, target_id):
+        """Record a name, mapping it to target_id
+
+        Warns if another object of the same name already exists.
+        """
+        names_in_subdomain = self.subdomain_data()
+        self._warn_if_duplicate_name(names_in_subdomain, name)
+        names_in_subdomain[name] = (self.env.docname, self.objtype, target_id)
+
+    def _target_id(self, name):
+        return make_target(self.objtype, nodes.make_id(name))
+
+    def _add_target(self, signode, name):
+        """Register a link target ‘name’, pointing to signode."""
+        targetid = self._target_id(name)
+        if targetid not in self.state.document.ids:
+            signode['ids'].append(targetid)
+            signode['names'].append(name)
+            signode['first'] = (not self.names)
+            self.state.document.note_explicit_target(signode)
+            self._record_name(name, targetid)
+        return targetid
+
+    def _add_index_entry(self, name, target):
+        """Add `name` (pointing to `target`) to the main index."""
+        assert isinstance(name, str)
+        if not name.startswith("_"):
+            # remove trailing . , found in commands, but not ... (ellipsis)
+            trim = name.endswith(".") and not name.endswith("...")
+            index_text = name[:-1] if trim else name
+            if self.index_suffix:
+                index_text += " " + self.index_suffix
+            self.indexnode['entries'].append(('single', index_text, target, '', None))
+
+    def add_target_and_index(self, name, _, signode):
+        """Attach a link target to `signode` and an index entry for `name`.
+        This is only called (from ``ObjectDescription.run``) if ``:noindex:`` isn't specified."""
+        if name:
+            target = self._add_target(signode, name)
+            self._add_index_entry(name, target)
+            return target
+
+    def _warn_if_undocumented(self):
+        document = self.state.document
+        config = document.settings.env.config
+        report = config.report_undocumented_coq_objects
+        if report and not self.content and "undocumented" not in self.options:
+            # This is annoyingly convoluted, but we don't want to raise warnings
+            # or interrupt the generation of the current node.  For more details
+            # see https://github.com/sphinx-doc/sphinx/issues/4976.
+            msg = 'No contents in directive {}'.format(self.name)
+            node = document.reporter.info(msg, line=self.lineno)
+            getLogger(__name__).info(node.astext())
+            if report == "warning":
+                raise self.warning(msg)
+
+    def _prepare_names(self):
+        sigs = self.get_signatures()
+        names = self.options.get("name")
+        if names is None:
+            self._names = {}
+        else:
+            names = [n.strip() for n in names.split(";")]
+            if len(names) != len(sigs):
+                ERR = ("Expected {} semicolon-separated names, got {}.  " +
+                       "Please provide one name per signature line.")
+                raise self.error(ERR.format(len(names), len(sigs)))
+            self._names = dict(zip(sigs, names))
+
+    def run(self):
+        self._warn_if_undocumented()
+        self._prepare_names()
+        return super().run()
+
+class PlainObject(CoqObject):
+    """A base class for objects whose signatures should be rendered literally."""
+    def _render_signature(self, signature, signode):
+        signode += addnodes.desc_name(signature, signature)
+
+class NotationObject(CoqObject):
+    """A base class for objects whose signatures should be rendered as nested boxes.
+
+    Objects that inherit from this class can use the notation grammar (“{+ …}�,
+    “@…�, etc.) in their signature.
+    """
+    def _render_signature(self, signature, signode):
+        position = self.state_machine.get_source_and_line(self.lineno)
+        tacn_node = parse_notation(signature, *position)
+        signode += addnodes.desc_name(signature, '', tacn_node)
+
+class GallinaObject(PlainObject):
+    r"""A theorem.
+
+    Example::
+
+       .. thm:: Bound on the ceiling function
+
+          Let :math:`p` be an integer and :math:`c` a rational constant. Then
+          :math:`p \ge c \rightarrow p \ge \lceil{c}\rceil`.
+    """
+    subdomain = "thm"
+    index_suffix = "(thm)"
+    annotation = "Theorem"
+
+class VernacObject(NotationObject):
+    """A Coq command.
+
+    Example::
+
+       .. cmd:: Infix "@symbol" := @term ({+, @modifier}).
+
+          This command is equivalent to :n:`…`.
+    """
+    subdomain = "cmd"
+    index_suffix = "(cmd)"
+    annotation = "Command"
+
+    def _name_from_signature(self, signature):
+        m = re.match(r"[a-zA-Z ]+", signature)
+        if m:
+            return m.group(0).strip()
+
+class VernacVariantObject(VernacObject):
+    """A variant of a Coq command.
+
+    Example::
+
+       .. cmd:: Axiom @ident : @term.
+
+          This command links :token:`term` to the name :token:`term` as its specification in
+          the global context. The fact asserted by :token:`term` is thus assumed as a
+          postulate.
+
+          .. cmdv:: Parameter @ident : @term.
+
+             This is equivalent to :n:`Axiom @ident : @term`.
+    """
+    index_suffix = "(cmdv)"
+    annotation = "Variant"
+
+    def _name_from_signature(self, signature):
+        return None
+
+class TacticNotationObject(NotationObject):
+    """A tactic, or a tactic notation.
+
+    Example::
+
+       .. tacn:: do @num @expr
+
+          :token:`expr` is evaluated to ``v`` which must be a tactic value. …
+    """
+    subdomain = "tacn"
+    index_suffix = "(tacn)"
+    annotation = None
+
+class TacticNotationVariantObject(TacticNotationObject):
+    """A variant of a tactic.
+
+    Example::
+
+       .. tacn:: fail
+
+          This is the always-failing tactic: it does not solve any goal. It is
+          useful for defining other tacticals since it can be caught by
+          :tacn:`try`, :tacn:`repeat`, :tacn:`match goal`, or the branching
+          tacticals. …
+
+          .. tacv:: fail @natural
+
+             The number is the failure level. If no level is specified, it
+             defaults to 0. …
+    """
+    index_suffix = "(tacnv)"
+    annotation = "Variant"
+
+class OptionObject(NotationObject):
+    """A Coq option (a setting with non-boolean value, e.g. a string or numeric value).
+
+    Example::
+
+       .. opt:: Hyps Limit @num
+          :name Hyps Limit
+
+          Controls the maximum number of hypotheses displayed in goals after
+          application of a tactic.
+    """
+    subdomain = "opt"
+    index_suffix = "(opt)"
+    annotation = "Option"
+
+    def _name_from_signature(self, signature):
+        return stringify_with_ellipses(signature)
+
+
+class FlagObject(NotationObject):
+    """A Coq flag (i.e. a boolean setting).
+
+    Example::
+
+       .. flag:: Nonrecursive Elimination Schemes
+
+          Controls whether types declared with the keywords
+          :cmd:`Variant` and :cmd:`Record` get an automatic declaration of
+          induction principles.
+    """
+    subdomain = "flag"
+    index_suffix = "(flag)"
+    annotation = "Flag"
+
+    def _name_from_signature(self, signature):
+        return stringify_with_ellipses(signature)
+
+
+class TableObject(NotationObject):
+    """A Coq table, i.e. a setting that is a set of values.
+
+    Example::
+
+       .. table:: Search Blacklist @string
+          :name: Search Blacklist
+
+          Controls ...
+    """
+    subdomain = "table"
+    index_suffix = "(table)"
+    annotation = "Table"
+
+    def _name_from_signature(self, signature):
+        return stringify_with_ellipses(signature)
+
+class ProductionObject(CoqObject):
+    r"""A grammar production.
+
+    This is useful if you intend to document individual grammar productions.
+    Otherwise, use Sphinx's `production lists
+    <http://www.sphinx-doc.org/en/stable/markup/para.html#directive-productionlist>`_.
+
+    Unlike ``.. productionlist``\ s, this directive accepts notation syntax.
+
+
+    Usage::
+
+       .. prodn:: token += production
+       .. prodn:: token ::= production
+
+    Example::
+
+        .. prodn:: term += let: @pattern := @term in @term
+        .. prodn:: occ_switch ::= { {? + %| - } {* @num } }
+
+    """
+    subdomain = "prodn"
+    #annotation = "Grammar production"
+
+    def _render_signature(self, signature, signode):
+        raise NotImplementedError(self)
+
+    SIG_ERROR = ("Invalid syntax in ``.. prodn::`` directive"
+                 + "\nExpected ``name ::= ...`` or ``name += ...``"
+                 + " (e.g. ``pattern += constr:(@ident)``)")
+
+    def handle_signature(self, signature, signode):
+        nsplits = 2
+        parts = signature.split(maxsplit=nsplits)
+        if len(parts) != 3:
+            raise ExtensionError(ProductionObject.SIG_ERROR)
+
+        lhs, op, rhs = (part.strip() for part in parts)
+        if op not in ["::=", "+="]:
+            raise ExtensionError(ProductionObject.SIG_ERROR)
+
+        self._render_annotation(signode)
+
+        lhs_op = '{} {} '.format(lhs, op)
+        lhs_node = nodes.literal(lhs_op, lhs_op)
+
+        position = self.state_machine.get_source_and_line(self.lineno)
+        rhs_node = parse_notation(rhs, *position)
+        signode += addnodes.desc_name(signature, '', lhs_node, rhs_node)
+
+        return ('token', lhs) if op == '::=' else None
+
+    def _add_index_entry(self, name, target):
+        pass
+
+    def _target_id(self, name):
+        # Use `name[1]` instead of ``nodes.make_id(name[1])`` to work around
+        # https://github.com/sphinx-doc/sphinx/issues/4983
+        return 'grammar-token-{}'.format(name[1])
+
+    def _record_name(self, name, targetid):
+        env = self.state.document.settings.env
+        objects = env.domaindata['std']['objects']
+        self._warn_if_duplicate_name(objects, name)
+        objects[name] = env.docname, targetid
+
+class ExceptionObject(NotationObject):
+    """An error raised by a Coq command or tactic.
+
+    This commonly appears nested in the ``.. tacn::`` that raises the
+    exception.
+
+    Example::
+
+       .. tacv:: assert @form by @tactic
+
+          This tactic applies :n:`@tactic` to solve the subgoals generated by
+          ``assert``.
+
+          .. exn:: Proof is not complete
+
+             Raised if :n:`@tactic` does not fully solve the goal.
+    """
+    subdomain = "exn"
+    index_suffix = "(err)"
+    annotation = "Error"
+    # Uses “exn� since “err� already is a CSS class added by “writer_aux�.
+
+    # Generate names automatically
+    def _name_from_signature(self, signature):
+        return stringify_with_ellipses(signature)
+
+class WarningObject(NotationObject):
+    """An warning raised by a Coq command or tactic..
+
+    Do not mistake this for ``.. warning::``; this directive is for warning
+    messages produced by Coq.
+
+
+    Example::
+
+       .. warn:: Ambiguous path
+
+          When the coercion :token:`qualid` is added to the inheritance graph, non
+          valid coercion paths are ignored.
+    """
+    subdomain = "warn"
+    index_suffix = "(warn)"
+    annotation = "Warning"
+
+    # Generate names automatically
+    def _name_from_signature(self, signature):
+        return stringify_with_ellipses(signature)
+
+def NotationRole(role, rawtext, text, lineno, inliner, options={}, content=[]):
+    #pylint: disable=unused-argument, dangerous-default-value
+    """Any text using the notation syntax (``@id``, ``{+, …}``, etc.).
+
+    Use this to explain tactic equivalences.  For example, you might write
+    this::
+
+       :n:`generalize @term as @ident` is just like :n:`generalize @term`, but
+       it names the introduced hypothesis :token:`ident`.
+
+    Note that this example also uses ``:token:``.  That's because ``ident`` is
+    defined in the Coq manual as a grammar production, and ``:token:``
+    creates a link to that.  When referring to a placeholder that happens to be
+    a grammar production, ``:token:`…``` is typically preferable to ``:n:`@…```.
+    """
+    notation = utils.unescape(text, 1)
+    position = inliner.reporter.get_source_and_line(lineno)
+    return [nodes.literal(rawtext, '', parse_notation(notation, *position, rawtext=rawtext))], []
+
+def coq_code_role(role, rawtext, text, lineno, inliner, options={}, content=[]):
+    #pylint: disable=dangerous-default-value
+    """Coq code.
+
+    Use this for Gallina and Ltac snippets::
+
+       :g:`apply plus_comm; reflexivity`
+       :g:`Set Printing All.`
+       :g:`forall (x: t), P(x)`
+    """
+    options['language'] = 'Coq'
+    return code_role(role, rawtext, text, lineno, inliner, options, content)
+    ## Too heavy:
+    ## Forked from code_role to use our custom tokenizer; this doesn't work for
+    ## snippets though: for example CoqDoc swallows the parentheses around this:
+    ## “(a: A) (b: B)�
+    # set_classes(options)
+    # classes = ['code', 'coq']
+    # code = utils.unescape(text, 1)
+    # node = nodes.literal(rawtext, '', *highlight_using_coqdoc(code), classes=classes)
+    # return [node], []
+
+CoqCodeRole = coq_code_role
+
+class CoqtopDirective(Directive):
+    r"""A reST directive to describe interactions with Coqtop.
+
+    Usage::
+
+       .. coqtop:: options…
+
+          Coq code to send to coqtop
+
+    Example::
+
+       .. coqtop:: in reset undo
+
+          Print nat.
+          Definition a := 1.
+
+    Here is a list of permissible options:
+
+    - Display options
+
+      - ``all``: Display input and output
+      - ``in``: Display only input
+      - ``out``: Display only output
+      - ``none``: Display neither (useful for setup commands)
+
+    - Behavior options
+
+      - ``reset``: Send a ``Reset Initial`` command before running this block
+      - ``undo``: Send an ``Undo n`` (``n`` = number of sentences) command after
+        running all the commands in this block
+
+    ``coqtop``\ 's state is preserved across consecutive ``.. coqtop::`` blocks
+    of the same document (``coqrst`` creates a single ``coqtop`` process per
+    reST source file).  Use the ``reset`` option to reset Coq's state.
+    """
+    has_content = True
+    required_arguments = 0
+    optional_arguments = 1
+    final_argument_whitespace = True
+    option_spec = { 'name': directives.unchanged }
+    directive_name = "coqtop"
+
+    def run(self):
+        # Uses a ‘container’ instead of a ‘literal_block’ to disable
+        # Pygments-based post-processing (we could also set rawsource to '')
+        content = '\n'.join(self.content)
+        args = self.arguments[0].split() if self.arguments else ['in']
+        if 'all' in args:
+            args.extend(['in', 'out'])
+        node = nodes.container(content, coqtop_options = list(set(args)),
+                               classes=['coqtop', 'literal-block'])
+        self.add_name(node)
+        return [node]
+
+class CoqdocDirective(Directive):
+    """A reST directive to display Coqtop-formatted source code.
+
+    Usage::
+
+       .. coqdoc::
+
+          Coq code to highlight
+
+    Example::
+
+       .. coqdoc::
+
+          Definition test := 1.
+    """
+    # TODO implement this as a Pygments highlighter?
+    has_content = True
+    required_arguments = 0
+    optional_arguments = 0
+    final_argument_whitespace = True
+    option_spec = { 'name': directives.unchanged }
+    directive_name = "coqdoc"
+
+    def run(self):
+        # Uses a ‘container’ instead of a ‘literal_block’ to disable
+        # Pygments-based post-processing (we could also set rawsource to '')
+        content = '\n'.join(self.content)
+        node = nodes.inline(content, '', *highlight_using_coqdoc(content))
+        wrapper = nodes.container(content, node, classes=['coqdoc', 'literal-block'])
+        self.add_name(wrapper)
+        return [wrapper]
+
+class ExampleDirective(BaseAdmonition):
+    """A reST directive for examples.
+
+    This behaves like a generic admonition; see
+    http://docutils.sourceforge.net/docs/ref/rst/directives.html#generic-admonition
+    for more details.
+
+    Optionally, any text immediately following the ``.. example::`` header is
+    used as the example's title.
+
+    Example::
+
+       .. example:: Adding a hint to a database
+
+          The following adds ``plus_comm`` to the ``plu`` database:
+
+          .. coqdoc::
+
+             Hint Resolve plus_comm : plu.
+    """
+    node_class = nodes.admonition
+    directive_name = "example"
+    optional_arguments = 1
+
+    def run(self):
+        # ‘BaseAdmonition’ checks whether ‘node_class’ is ‘nodes.admonition’,
+        # and uses arguments[0] as the title in that case (in other cases, the
+        # title is unset, and it is instead set in the HTML visitor).
+        assert len(self.arguments) <= 1
+        self.arguments = [": ".join(['Example'] + self.arguments)]
+        self.options['classes'] = ['admonition', 'note']
+        return super().run()
+
+class PreambleDirective(Directive):
+    r"""A reST directive to include a TeX file.
+
+    Mostly useful to let MathJax know about `\def`s and `\newcommand`s.  The
+    contents of the TeX file are wrapped in a math environment, as MathJax
+    doesn't process LaTeX definitions otherwise.
+
+    Usage::
+
+       .. preamble:: preamble.tex
+    """
+    has_content = False
+    required_arguments = 1
+    optional_arguments = 0
+    final_argument_whitespace = True
+    option_spec = {}
+    directive_name = "preamble"
+
+    def run(self):
+        document = self.state.document
+        env = document.settings.env
+
+        if not document.settings.file_insertion_enabled:
+            msg = 'File insertion disabled'
+            return [document.reporter.warning(msg, line=self.lineno)]
+
+        rel_fname, abs_fname = env.relfn2path(self.arguments[0])
+        env.note_dependency(rel_fname)
+
+        with open(abs_fname, encoding="utf-8") as ltx:
+            latex = ltx.read()
+
+        node = make_math_node(latex, env.docname, nowrap=False)
+        node['classes'] = ["math-preamble"]
+        set_source_info(self, node)
+        return [node]
+
+class InferenceDirective(Directive):
+    r"""A reST directive to format inference rules.
+
+    This also serves as a small illustration of the way to create new Sphinx
+    directives.
+
+    Usage::
+
+       .. inference:: name
+
+          newline-separated premises
+          --------------------------
+          conclusion
+
+    Example::
+
+       .. inference:: Prod-Pro
+
+          \WTEG{T}{s}
+          s \in \Sort
+          \WTE{\Gamma::(x:T)}{U}{\Prop}
+          -----------------------------
+          \WTEG{\forall~x:T,U}{\Prop}
+    """
+    required_arguments = 1
+    optional_arguments = 0
+    has_content = True
+    final_argument_whitespace = True
+    directive_name = "inference"
+
+    @staticmethod
+    def prepare_latex_operand(op):
+        # TODO: Could use a fancier inference class in LaTeX
+        return '%\n\\hspace{3em}%\n'.join(op.strip().splitlines())
+
+    def prepare_latex(self, content):
+        parts = re.split('^ *----+ *$', content, flags=re.MULTILINE)
+        if len(parts) != 2:
+            raise self.error('Expected two parts in ‘inference’ directive, separated by a rule (----).')
+
+        top, bottom = tuple(InferenceDirective.prepare_latex_operand(p) for p in parts)
+        return "%\n".join(("\\frac{", top, "}{", bottom, "}"))
+
+    def run(self):
+        self.assert_has_content()
+
+        title = self.arguments[0]
+        content = '\n'.join(self.content)
+        latex = self.prepare_latex(content)
+        docname = self.state.document.settings.env.docname
+        math_node = make_math_node(latex, docname, nowrap=False)
+
+        tid = nodes.make_id(title)
+        target = nodes.target('', '', ids=['inference-' + tid])
+        self.state.document.note_explicit_target(target)
+
+        term, desc = nodes.term('', title), nodes.description('', math_node)
+        dli = nodes.definition_list_item('', term, desc)
+        dl = nodes.definition_list(content, target, dli)
+        set_source_info(self, dl)
+        return [dl]
+
+class AnsiColorsParser():
+    """Parse ANSI-colored output from Coqtop into Sphinx nodes."""
+
+    # Coqtop's output crashes ansi.py, because it contains a bunch of extended codes
+    # This class is a fork of the original ansi.py, released under a BSD license in sphinx-contribs
+
+    COLOR_PATTERN = re.compile('\x1b\\[([^m]+)m')
+
+    def __init__(self):
+        self.new_nodes, self.pending_nodes = [], []
+
+    def _finalize_pending_nodes(self):
+        self.new_nodes.extend(self.pending_nodes)
+        self.pending_nodes = []
+
+    def _add_text(self, raw, beg, end):
+        if beg < end:
+            text = raw[beg:end]
+            if self.pending_nodes:
+                self.pending_nodes[-1].append(nodes.Text(text))
+            else:
+                self.new_nodes.append(nodes.inline('', text))
+
+    def colorize_str(self, raw):
+        """Parse raw (an ANSI-colored output string from Coqtop) into Sphinx nodes."""
+        last_end = 0
+        for match in AnsiColorsParser.COLOR_PATTERN.finditer(raw):
+            self._add_text(raw, last_end, match.start())
+            last_end = match.end()
+            classes = ansicolors.parse_ansi(match.group(1))
+            if 'ansi-reset' in classes:
+                self._finalize_pending_nodes()
+            else:
+                node = nodes.inline()
+                self.pending_nodes.append(node)
+                node['classes'].extend(classes)
+        self._add_text(raw, last_end, len(raw))
+        self._finalize_pending_nodes()
+        return self.new_nodes
+
+class CoqtopBlocksTransform(Transform):
+    """Filter handling the actual work for the coqtop directive
+
+    Adds coqtop's responses, colorizes input and output, and merges consecutive
+    coqtop directives for better visual rendition.
+    """
+    default_priority = 10
+
+    @staticmethod
+    def is_coqtop_block(node):
+        return isinstance(node, nodes.Element) and 'coqtop_options' in node
+
+    @staticmethod
+    def split_sentences(source):
+        """Split Coq sentences in source. Could be improved."""
+        return re.split(r"(?<=(?<!\.)\.)\s+", source)
+
+    @staticmethod
+    def parse_options(options):
+        """Parse options according to the description in CoqtopDirective."""
+        opt_undo = 'undo' in options
+        opt_reset = 'reset' in options
+        opt_all, opt_none = 'all' in options, 'none' in options
+        opt_input, opt_output = opt_all or 'in' in options, opt_all or 'out' in options
+
+        unexpected_options = list(set(options) - set(('reset', 'undo', 'all', 'none', 'in', 'out')))
+        if unexpected_options:
+            raise ValueError("Unexpected options for .. coqtop:: {}".format(unexpected_options))
+        elif (opt_input or opt_output) and opt_none:
+            raise ValueError("Inconsistent options for .. coqtop:: ‘none’ with ‘in’, ‘out’, or ‘all’")
+        elif opt_reset and opt_undo:
+            raise ValueError("Inconsistent options for .. coqtop:: ‘undo’ with ‘reset’")
+
+        return opt_undo, opt_reset, opt_input and not opt_none, opt_output and not opt_none
+
+    @staticmethod
+    def block_classes(should_show, contents=None):
+        """Compute classes to add to a node containing contents.
+
+        :param should_show: Whether this node should be displayed"""
+        is_empty = contents is not None and re.match(r"^\s*$", contents)
+        if is_empty or not should_show:
+            return ['coqtop-hidden']
+        else:
+            return []
+
+    @staticmethod
+    def make_rawsource(pairs, opt_input, opt_output):
+        blocks = []
+        for sentence, output in pairs:
+            output = AnsiColorsParser.COLOR_PATTERN.sub("", output).strip()
+            if opt_input:
+                blocks.append(sentence)
+            if output and opt_output:
+                blocks.append(re.sub("^", "    ", output, flags=re.MULTILINE) + "\n")
+        return '\n'.join(blocks)
+
+    def add_coqtop_output(self):
+        """Add coqtop's responses to a Sphinx AST
+
+        Finds nodes to process using is_coqtop_block."""
+        with CoqTop(color=True) as repl:
+            for node in self.document.traverse(CoqtopBlocksTransform.is_coqtop_block):
+                options = node['coqtop_options']
+                opt_undo, opt_reset, opt_input, opt_output = self.parse_options(options)
+
+                if opt_reset:
+                    repl.sendone("Reset Initial.")
+                pairs = []
+                for sentence in self.split_sentences(node.rawsource):
+                    pairs.append((sentence, repl.sendone(sentence)))
+                if opt_undo:
+                    repl.sendone("Undo {}.".format(len(pairs)))
+
+                dli = nodes.definition_list_item()
+                for sentence, output in pairs:
+                    # Use Coqdoq to highlight input
+                    in_chunks = highlight_using_coqdoc(sentence)
+                    dli += nodes.term(sentence, '', *in_chunks, classes=self.block_classes(opt_input))
+                    # Parse ANSI sequences to highlight output
+                    out_chunks = AnsiColorsParser().colorize_str(output)
+                    dli += nodes.definition(output, *out_chunks, classes=self.block_classes(opt_output, output))
+                node.clear()
+                node.rawsource = self.make_rawsource(pairs, opt_input, opt_output)
+                node['classes'].extend(self.block_classes(opt_input or opt_output))
+                node += nodes.inline('', '', classes=['coqtop-reset'] * opt_reset)
+                node += nodes.definition_list(node.rawsource, dli)
+
+    @staticmethod
+    def merge_coqtop_classes(kept_node, discarded_node):
+        discarded_classes = discarded_node['classes']
+        if not 'coqtop-hidden' in discarded_classes:
+            kept_node['classes'] = [c for c in kept_node['classes']
+                                    if c != 'coqtop-hidden']
+
+    @staticmethod
+    def merge_consecutive_coqtop_blocks(app, doctree, _):
+        """Merge consecutive divs wrapping lists of Coq sentences; keep ‘dl’s separate."""
+        for node in doctree.traverse(CoqtopBlocksTransform.is_coqtop_block):
+            if node.parent:
+                rawsources, names = [node.rawsource], set(node['names'])
+                for sibling in node.traverse(include_self=False, descend=False,
+                                             siblings=True, ascend=False):
+                    if CoqtopBlocksTransform.is_coqtop_block(sibling):
+                        CoqtopBlocksTransform.merge_coqtop_classes(node, sibling)
+                        rawsources.append(sibling.rawsource)
+                        names.update(sibling['names'])
+                        node.extend(sibling.children)
+                        node.parent.remove(sibling)
+                        sibling.parent = None
+                    else:
+                        break
+                node.rawsource = "\n\n".join(rawsources)
+                node['names'] = list(names)
+
+    def apply(self):
+        self.add_coqtop_output()
+
+class CoqSubdomainsIndex(Index):
+    """Index subclass to provide subdomain-specific indices.
+
+    Just as in the original manual, we want to have separate indices for each
+    Coq subdomain (tactics, commands, options, etc)"""
+
+    name, localname, shortname, subdomains = None, None, None, [] # Must be overwritten
+
+    def generate(self, docnames=None):
+        content = defaultdict(list)
+        items = chain(*(self.domain.data['objects'][subdomain].items()
+                        for subdomain in self.subdomains))
+
+        for itemname, (docname, _, anchor) in sorted(items, key=lambda x: x[0].lower()):
+            if docnames and docname not in docnames:
+                continue
+
+            entries = content[itemname[0].lower()]
+            entries.append([itemname, 0, docname, anchor, '', '', ''])
+
+        collapse = False
+        content = sorted(content.items())
+        return content, collapse
+
+class CoqVernacIndex(CoqSubdomainsIndex):
+    name, localname, shortname, subdomains = "cmdindex", "Command Index", "commands", ["cmd"]
+
+class CoqTacticIndex(CoqSubdomainsIndex):
+    name, localname, shortname, subdomains = "tacindex", "Tactic Index", "tactics", ["tacn"]
+
+class CoqOptionIndex(CoqSubdomainsIndex):
+    name, localname, shortname, subdomains = "optindex", "Flags, options and Tables Index", "options", ["flag", "opt", "table"]
+
+class CoqGallinaIndex(CoqSubdomainsIndex):
+    name, localname, shortname, subdomains = "thmindex", "Gallina Index", "theorems", ["thm"]
+
+class CoqExceptionIndex(CoqSubdomainsIndex):
+    name, localname, shortname, subdomains = "exnindex", "Errors and Warnings Index", "errors", ["exn", "warn"]
+
+class IndexXRefRole(XRefRole):
+    """A link to one of our domain-specific indices."""
+    lowercase = True,
+    innernodeclass = nodes.inline
+    warn_dangling = True
+
+    def process_link(self, env, refnode, has_explicit_title, title, target):
+        if not has_explicit_title:
+            index = CoqDomain.find_index_by_name(target)
+            if index:
+                title = index.localname
+        return title, target
+
+def GrammarProductionRole(typ, rawtext, text, lineno, inliner, options={}, content=[]):
+    """A grammar production not included in a ``productionlist`` directive.
+
+    Useful to informally introduce a production, as part of running text.
+
+    Example::
+
+       :production:`string` indicates a quoted string.
+
+    You're not likely to use this role very commonly; instead, use a
+    `production list
+    <http://www.sphinx-doc.org/en/stable/markup/para.html#directive-productionlist>`_
+    and reference its tokens using ``:token:`…```.
+    """
+    #pylint: disable=dangerous-default-value, unused-argument
+    env = inliner.document.settings.env
+    targetid = 'grammar-token-{}'.format(text)
+    target = nodes.target('', '', ids=[targetid])
+    inliner.document.note_explicit_target(target)
+    code = nodes.literal(rawtext, text, role=typ.lower())
+    node = nodes.inline(rawtext, '', target, code, classes=['inline-grammar-production'])
+    set_role_source_info(inliner, lineno, node)
+    env.domaindata['std']['objects']['token', text] = env.docname, targetid
+    return [node], []
+
+GrammarProductionRole.role_name = "production"
+
+class CoqDomain(Domain):
+    """A domain to document Coq code.
+
+    Sphinx has a notion of “domains�, used to tailor it to a specific language.
+    Domains mostly consist in descriptions of the objects that we wish to
+    describe (for Coq, this includes tactics, tactic notations, options,
+    exceptions, etc.), as well as domain-specific roles and directives.
+
+    Each domain is responsible for tracking its objects, and resolving
+    references to them. In the case of Coq, this leads us to define Coq
+    “subdomains�, which classify objects into categories in which names must be
+    unique. For example, a tactic and a theorem may share a name, but two
+    tactics cannot be named the same.
+    """
+
+    name = 'coq'
+    label = 'Coq'
+
+    object_types = {
+        # ObjType (= directive type) → (Local name, *xref-roles)
+        'cmd': ObjType('cmd', 'cmd'),
+        'cmdv': ObjType('cmdv', 'cmd'),
+        'tacn': ObjType('tacn', 'tacn'),
+        'tacv': ObjType('tacv', 'tacn'),
+        'opt': ObjType('opt', 'opt'),
+        'flag': ObjType('flag', 'flag'),
+        'table': ObjType('table', 'table'),
+        'thm': ObjType('thm', 'thm'),
+        'prodn': ObjType('prodn', 'prodn'),
+        'exn': ObjType('exn', 'exn'),
+        'warn': ObjType('warn', 'exn'),
+        'index': ObjType('index', 'index', searchprio=-1)
+    }
+
+    directives = {
+        # Note that some directives live in the same semantic subdomain; ie
+        # there's one directive per object type, but some object types map to
+        # the same role.
+        'cmd': VernacObject,
+        'cmdv': VernacVariantObject,
+        'tacn': TacticNotationObject,
+        'tacv': TacticNotationVariantObject,
+        'opt': OptionObject,
+        'flag': FlagObject,
+        'table': TableObject,
+        'thm': GallinaObject,
+        'prodn' : ProductionObject,
+        'exn': ExceptionObject,
+        'warn': WarningObject,
+    }
+
+    roles = {
+        # Each of these roles lives in a different semantic “subdomain�
+        'cmd': XRefRole(warn_dangling=True),
+        'tacn': XRefRole(warn_dangling=True),
+        'opt': XRefRole(warn_dangling=True),
+        'flag': XRefRole(warn_dangling=True),
+        'table': XRefRole(warn_dangling=True),
+        'thm': XRefRole(warn_dangling=True),
+        'prodn' : XRefRole(warn_dangling=True),
+        'exn': XRefRole(warn_dangling=True),
+        'warn': XRefRole(warn_dangling=True),
+        # This one is special
+        'index': IndexXRefRole(),
+        # These are used for highlighting
+        'n': NotationRole,
+        'g': CoqCodeRole
+    }
+
+    indices = [CoqVernacIndex, CoqTacticIndex, CoqOptionIndex, CoqGallinaIndex, CoqExceptionIndex]
+
+    data_version = 1
+    initial_data = {
+        # Collect everything under a key that we control, since Sphinx adds
+        # others, such as “version�
+        'objects' : { # subdomain → name → docname, objtype, targetid
+            'cmd': {},
+            'tacn': {},
+            'opt': {},
+            'flag': {},
+            'table': {},
+            'thm': {},
+            'prodn' : {},
+            'exn': {},
+            'warn': {},
+        }
+    }
+
+    @staticmethod
+    def find_index_by_name(targetid):
+        for index in CoqDomain.indices:
+            if index.name == targetid:
+                return index
+
+    def get_objects(self):
+        # Used for searching and object inventories (intersphinx)
+        for _, objects in self.data['objects'].items():
+            for name, (docname, objtype, targetid) in objects.items():
+                yield (name, name, objtype, docname, targetid, self.object_types[objtype].attrs['searchprio'])
+        for index in self.indices:
+            yield (index.name, index.localname, 'index', "coq-" + index.name, '', -1)
+
+    def merge_domaindata(self, docnames, otherdata):
+        DUP = "Duplicate declaration: '{}' also defined in '{}'.\n"
+        for subdomain, their_objects in otherdata['objects'].items():
+            our_objects = self.data['objects'][subdomain]
+            for name, (docname, objtype, targetid) in their_objects.items():
+                if docname in docnames:
+                    if name in our_objects:
+                        self.env.warn(docname, DUP.format(name, our_objects[name][0]))
+                    our_objects[name] = (docname, objtype, targetid)
+
+    def resolve_xref(self, env, fromdocname, builder, role, targetname, node, contnode):
+        # ‘target’ is the name that was written in the document
+        # ‘role’ is where this xref comes from; it's exactly one of our subdomains
+        if role == 'index':
+            index = CoqDomain.find_index_by_name(targetname)
+            if index:
+                return make_refnode(builder, fromdocname, "coq-" + index.name, '', contnode, index.localname)
+        else:
+            resolved = self.data['objects'][role].get(targetname)
+            if resolved:
+                (todocname, _, targetid) = resolved
+                return make_refnode(builder, fromdocname, todocname, targetid, contnode, targetname)
+
+    def clear_doc(self, docname_to_clear):
+        for subdomain_objects in self.data['objects'].values():
+            for name, (docname, _, _) in list(subdomain_objects.items()):
+                if docname == docname_to_clear:
+                    del subdomain_objects[name]
+
+def is_coqtop_or_coqdoc_block(node):
+    return (isinstance(node, nodes.Element) and
+       ('coqtop' in node['classes'] or 'coqdoc' in node['classes']))
+
+def simplify_source_code_blocks_for_latex(app, doctree, fromdocname): # pylint: disable=unused-argument
+    """Simplify coqdoc and coqtop blocks.
+
+    In HTML mode, this does nothing; in other formats, such as LaTeX, it
+    replaces coqdoc and coqtop blocks by plain text sources, which will use
+    pygments if available.  This prevents the LaTeX builder from getting
+    confused.
+    """
+    is_html = app.builder.tags.has("html")
+    for node in doctree.traverse(is_coqtop_or_coqdoc_block):
+        if is_html:
+            node.rawsource = '' # Prevent pygments from kicking in
+        elif 'coqtop-hidden' in node['classes']:
+            node.parent.remove(node)
+        else:
+            node.replace_self(nodes.literal_block(node.rawsource, node.rawsource, language="Coq"))
+
+COQ_ADDITIONAL_DIRECTIVES = [CoqtopDirective,
+                             CoqdocDirective,
+                             ExampleDirective,
+                             InferenceDirective,
+                             PreambleDirective]
+
+COQ_ADDITIONAL_ROLES = [GrammarProductionRole]
+
+def setup(app):
+    """Register the Coq domain"""
+
+    # A few sanity checks:
+    subdomains = set(obj.subdomain for obj in CoqDomain.directives.values())
+    assert subdomains.issuperset(chain(*(idx.subdomains for idx in CoqDomain.indices)))
+    assert subdomains.issubset(CoqDomain.roles.keys())
+
+    # Add domain, directives, and roles
+    app.add_domain(CoqDomain)
+
+    for role in COQ_ADDITIONAL_ROLES:
+        app.add_role(role.role_name, role)
+
+    for directive in COQ_ADDITIONAL_DIRECTIVES:
+        app.add_directive(directive.directive_name, directive)
+
+    app.add_transform(CoqtopBlocksTransform)
+    app.connect('doctree-resolved', simplify_source_code_blocks_for_latex)
+    app.connect('doctree-resolved', CoqtopBlocksTransform.merge_consecutive_coqtop_blocks)
+
+    # Add extra styles
+    app.add_stylesheet("fonts.css")
+    app.add_stylesheet("ansi.css")
+    app.add_stylesheet("coqdoc.css")
+    app.add_javascript("notations.js")
+    app.add_stylesheet("notations.css")
+    app.add_stylesheet("pre-text.css")
+
+    # Tell Sphinx about extra settings
+    app.add_config_value("report_undocumented_coq_objects", None, 'env')
+
+    # ``env_version`` is used by Sphinx to know when to invalidate
+    # coqdomain-specific bits in its caches.  It should be incremented when the
+    # contents of ``env.domaindata['coq']`` change.  See
+    # `https://github.com/sphinx-doc/sphinx/issues/4460`.
+    meta = { "version": "0.1",
+             "env_version": 2,
+             "parallel_read_safe": True }
+    return meta
diff --git a/doc/tools/coqrst/notations/Makefile b/doc/tools/coqrst/notations/Makefile
new file mode 100644
index 00000000..c017aed9
--- /dev/null
+++ b/doc/tools/coqrst/notations/Makefile
@@ -0,0 +1,27 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+# Parsing compact tactic notation syntax in
+
+TEST_INPUT="unfold {+, @qualid|@string at {+, num}}"
+
+python:
+	antlr4 -Dlanguage=Python3 -visitor -no-listener TacticNotations.g
+
+java:
+	antlr4 -Dlanguage=Java TacticNotations.g && javac TacticNotations*.java
+
+test: java
+	grun TacticNotations top -tree <<< "$(TEST_INPUT)"
+
+gui: java
+	grun TacticNotations top -gui <<< "$(TEST_INPUT)"
+
+sample:
+	cd ..; python3 -m coqnotations.driver < ../tests/tactics > ../tests/antlr-notations.html
diff --git a/doc/tools/coqrst/notations/TacticNotations.g b/doc/tools/coqrst/notations/TacticNotations.g
new file mode 100644
index 00000000..a889ebda
--- /dev/null
+++ b/doc/tools/coqrst/notations/TacticNotations.g
@@ -0,0 +1,33 @@
+/************************************************************************/
+/*         *   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          */
+/*         *     (see LICENSE file for the text of the license)         */
+/************************************************************************/
+grammar TacticNotations;
+
+// Terminals are not visited, so we add non-terminals for each terminal that
+// needs rendering (in particular whitespace (kept in output) vs. WHITESPACE
+// (discarded)).
+
+top: blocks EOF;
+blocks: block ((whitespace)? block)*;
+block: atomic | meta | hole | repeat | curlies;
+repeat: LGROUP (ATOM)? WHITESPACE blocks (WHITESPACE)? RBRACE;
+curlies: LBRACE (whitespace)? blocks (whitespace)? RBRACE;
+whitespace: WHITESPACE;
+meta: METACHAR;
+atomic: ATOM (SUB)?;
+hole: ID (SUB)?;
+
+LGROUP: '{' [+*?];
+LBRACE: '{';
+RBRACE: '}';
+METACHAR: '%' [|(){}];
+ATOM: '@' | '_' | ~[@_{} ]+;
+ID: '@' ('_'? [a-zA-Z0-9])+;
+SUB: '_' '_' [a-zA-Z0-9]+;
+WHITESPACE: ' '+;
diff --git a/doc/tools/coqrst/notations/TacticNotations.tokens b/doc/tools/coqrst/notations/TacticNotations.tokens
new file mode 100644
index 00000000..88b38f97
--- /dev/null
+++ b/doc/tools/coqrst/notations/TacticNotations.tokens
@@ -0,0 +1,10 @@
+LGROUP=1
+LBRACE=2
+RBRACE=3
+METACHAR=4
+ATOM=5
+ID=6
+SUB=7
+WHITESPACE=8
+'{'=2
+'}'=3
diff --git a/doc/tools/coqrst/notations/TacticNotationsLexer.py b/doc/tools/coqrst/notations/TacticNotationsLexer.py
new file mode 100644
index 00000000..27293e7e
--- /dev/null
+++ b/doc/tools/coqrst/notations/TacticNotationsLexer.py
@@ -0,0 +1,71 @@
+# Generated from TacticNotations.g by ANTLR 4.7
+from antlr4 import *
+from io import StringIO
+from typing.io import TextIO
+import sys
+
+
+def serializedATN():
+    with StringIO() as buf:
+        buf.write("\3\u608b\ua72a\u8133\ub9ed\u417c\u3be7\u7786\u5964\2\n")
+        buf.write(":\b\1\4\2\t\2\4\3\t\3\4\4\t\4\4\5\t\5\4\6\t\6\4\7\t\7")
+        buf.write("\4\b\t\b\4\t\t\t\3\2\3\2\3\2\3\3\3\3\3\4\3\4\3\5\3\5\3")
+        buf.write("\5\3\6\3\6\6\6 \n\6\r\6\16\6!\5\6$\n\6\3\7\3\7\5\7(\n")
+        buf.write("\7\3\7\6\7+\n\7\r\7\16\7,\3\b\3\b\3\b\6\b\62\n\b\r\b\16")
+        buf.write("\b\63\3\t\6\t\67\n\t\r\t\16\t8\2\2\n\3\3\5\4\7\5\t\6\13")
+        buf.write("\7\r\b\17\t\21\n\3\2\7\4\2,-AA\4\2*+}\177\4\2BBaa\7\2")
+        buf.write("\"\"BBaa}}\177\177\5\2\62;C\\c|\2?\2\3\3\2\2\2\2\5\3\2")
+        buf.write("\2\2\2\7\3\2\2\2\2\t\3\2\2\2\2\13\3\2\2\2\2\r\3\2\2\2")
+        buf.write("\2\17\3\2\2\2\2\21\3\2\2\2\3\23\3\2\2\2\5\26\3\2\2\2\7")
+        buf.write("\30\3\2\2\2\t\32\3\2\2\2\13#\3\2\2\2\r%\3\2\2\2\17.\3")
+        buf.write("\2\2\2\21\66\3\2\2\2\23\24\7}\2\2\24\25\t\2\2\2\25\4\3")
+        buf.write("\2\2\2\26\27\7}\2\2\27\6\3\2\2\2\30\31\7\177\2\2\31\b")
+        buf.write("\3\2\2\2\32\33\7\'\2\2\33\34\t\3\2\2\34\n\3\2\2\2\35$")
+        buf.write("\t\4\2\2\36 \n\5\2\2\37\36\3\2\2\2 !\3\2\2\2!\37\3\2\2")
+        buf.write("\2!\"\3\2\2\2\"$\3\2\2\2#\35\3\2\2\2#\37\3\2\2\2$\f\3")
+        buf.write("\2\2\2%*\7B\2\2&(\7a\2\2\'&\3\2\2\2\'(\3\2\2\2()\3\2\2")
+        buf.write("\2)+\t\6\2\2*\'\3\2\2\2+,\3\2\2\2,*\3\2\2\2,-\3\2\2\2")
+        buf.write("-\16\3\2\2\2./\7a\2\2/\61\7a\2\2\60\62\t\6\2\2\61\60\3")
+        buf.write("\2\2\2\62\63\3\2\2\2\63\61\3\2\2\2\63\64\3\2\2\2\64\20")
+        buf.write("\3\2\2\2\65\67\7\"\2\2\66\65\3\2\2\2\678\3\2\2\28\66\3")
+        buf.write("\2\2\289\3\2\2\29\22\3\2\2\2\t\2!#\',\638\2")
+        return buf.getvalue()
+
+
+class TacticNotationsLexer(Lexer):
+
+    atn = ATNDeserializer().deserialize(serializedATN())
+
+    decisionsToDFA = [ DFA(ds, i) for i, ds in enumerate(atn.decisionToState) ]
+
+    LGROUP = 1
+    LBRACE = 2
+    RBRACE = 3
+    METACHAR = 4
+    ATOM = 5
+    ID = 6
+    SUB = 7
+    WHITESPACE = 8
+
+    channelNames = [ u"DEFAULT_TOKEN_CHANNEL", u"HIDDEN" ]
+
+    modeNames = [ "DEFAULT_MODE" ]
+
+    literalNames = [ "<INVALID>",
+            "'{'", "'}'" ]
+
+    symbolicNames = [ "<INVALID>",
+            "LGROUP", "LBRACE", "RBRACE", "METACHAR", "ATOM", "ID", "SUB",
+            "WHITESPACE" ]
+
+    ruleNames = [ "LGROUP", "LBRACE", "RBRACE", "METACHAR", "ATOM", "ID",
+                  "SUB", "WHITESPACE" ]
+
+    grammarFileName = "TacticNotations.g"
+
+    def __init__(self, input=None, output:TextIO = sys.stdout):
+        super().__init__(input, output)
+        self.checkVersion("4.7")
+        self._interp = LexerATNSimulator(self, self.atn, self.decisionsToDFA, PredictionContextCache())
+        self._actions = None
+        self._predicates = None
diff --git a/doc/tools/coqrst/notations/TacticNotationsLexer.tokens b/doc/tools/coqrst/notations/TacticNotationsLexer.tokens
new file mode 100644
index 00000000..88b38f97
--- /dev/null
+++ b/doc/tools/coqrst/notations/TacticNotationsLexer.tokens
@@ -0,0 +1,10 @@
+LGROUP=1
+LBRACE=2
+RBRACE=3
+METACHAR=4
+ATOM=5
+ID=6
+SUB=7
+WHITESPACE=8
+'{'=2
+'}'=3
diff --git a/doc/tools/coqrst/notations/TacticNotationsParser.py b/doc/tools/coqrst/notations/TacticNotationsParser.py
new file mode 100644
index 00000000..645f0789
--- /dev/null
+++ b/doc/tools/coqrst/notations/TacticNotationsParser.py
@@ -0,0 +1,595 @@
+# Generated from TacticNotations.g by ANTLR 4.7
+# encoding: utf-8
+from antlr4 import *
+from io import StringIO
+from typing.io import TextIO
+import sys
+
+def serializedATN():
+    with StringIO() as buf:
+        buf.write("\3\u608b\ua72a\u8133\ub9ed\u417c\u3be7\u7786\u5964\3\n")
+        buf.write("J\4\2\t\2\4\3\t\3\4\4\t\4\4\5\t\5\4\6\t\6\4\7\t\7\4\b")
+        buf.write("\t\b\4\t\t\t\4\n\t\n\3\2\3\2\3\2\3\3\3\3\5\3\32\n\3\3")
+        buf.write("\3\7\3\35\n\3\f\3\16\3 \13\3\3\4\3\4\3\4\3\4\3\4\5\4\'")
+        buf.write("\n\4\3\5\3\5\5\5+\n\5\3\5\3\5\3\5\5\5\60\n\5\3\5\3\5\3")
+        buf.write("\6\3\6\5\6\66\n\6\3\6\3\6\5\6:\n\6\3\6\3\6\3\7\3\7\3\b")
+        buf.write("\3\b\3\t\3\t\5\tD\n\t\3\n\3\n\5\nH\n\n\3\n\2\2\13\2\4")
+        buf.write("\6\b\n\f\16\20\22\2\2\2L\2\24\3\2\2\2\4\27\3\2\2\2\6&")
+        buf.write("\3\2\2\2\b(\3\2\2\2\n\63\3\2\2\2\f=\3\2\2\2\16?\3\2\2")
+        buf.write("\2\20A\3\2\2\2\22E\3\2\2\2\24\25\5\4\3\2\25\26\7\2\2\3")
+        buf.write("\26\3\3\2\2\2\27\36\5\6\4\2\30\32\5\f\7\2\31\30\3\2\2")
+        buf.write("\2\31\32\3\2\2\2\32\33\3\2\2\2\33\35\5\6\4\2\34\31\3\2")
+        buf.write("\2\2\35 \3\2\2\2\36\34\3\2\2\2\36\37\3\2\2\2\37\5\3\2")
+        buf.write("\2\2 \36\3\2\2\2!\'\5\20\t\2\"\'\5\16\b\2#\'\5\22\n\2")
+        buf.write("$\'\5\b\5\2%\'\5\n\6\2&!\3\2\2\2&\"\3\2\2\2&#\3\2\2\2")
+        buf.write("&$\3\2\2\2&%\3\2\2\2\'\7\3\2\2\2(*\7\3\2\2)+\7\7\2\2*")
+        buf.write(")\3\2\2\2*+\3\2\2\2+,\3\2\2\2,-\7\n\2\2-/\5\4\3\2.\60")
+        buf.write("\7\n\2\2/.\3\2\2\2/\60\3\2\2\2\60\61\3\2\2\2\61\62\7\5")
+        buf.write("\2\2\62\t\3\2\2\2\63\65\7\4\2\2\64\66\5\f\7\2\65\64\3")
+        buf.write("\2\2\2\65\66\3\2\2\2\66\67\3\2\2\2\679\5\4\3\28:\5\f\7")
+        buf.write("\298\3\2\2\29:\3\2\2\2:;\3\2\2\2;<\7\5\2\2<\13\3\2\2\2")
+        buf.write("=>\7\n\2\2>\r\3\2\2\2?@\7\6\2\2@\17\3\2\2\2AC\7\7\2\2")
+        buf.write("BD\7\t\2\2CB\3\2\2\2CD\3\2\2\2D\21\3\2\2\2EG\7\b\2\2F")
+        buf.write("H\7\t\2\2GF\3\2\2\2GH\3\2\2\2H\23\3\2\2\2\13\31\36&*/")
+        buf.write("\659CG")
+        return buf.getvalue()
+
+
+class TacticNotationsParser ( Parser ):
+
+    grammarFileName = "TacticNotations.g"
+
+    atn = ATNDeserializer().deserialize(serializedATN())
+
+    decisionsToDFA = [ DFA(ds, i) for i, ds in enumerate(atn.decisionToState) ]
+
+    sharedContextCache = PredictionContextCache()
+
+    literalNames = [ "<INVALID>", "<INVALID>", "'{'", "'}'" ]
+
+    symbolicNames = [ "<INVALID>", "LGROUP", "LBRACE", "RBRACE", "METACHAR",
+                      "ATOM", "ID", "SUB", "WHITESPACE" ]
+
+    RULE_top = 0
+    RULE_blocks = 1
+    RULE_block = 2
+    RULE_repeat = 3
+    RULE_curlies = 4
+    RULE_whitespace = 5
+    RULE_meta = 6
+    RULE_atomic = 7
+    RULE_hole = 8
+
+    ruleNames =  [ "top", "blocks", "block", "repeat", "curlies", "whitespace",
+                   "meta", "atomic", "hole" ]
+
+    EOF = Token.EOF
+    LGROUP=1
+    LBRACE=2
+    RBRACE=3
+    METACHAR=4
+    ATOM=5
+    ID=6
+    SUB=7
+    WHITESPACE=8
+
+    def __init__(self, input:TokenStream, output:TextIO = sys.stdout):
+        super().__init__(input, output)
+        self.checkVersion("4.7")
+        self._interp = ParserATNSimulator(self, self.atn, self.decisionsToDFA, self.sharedContextCache)
+        self._predicates = None
+
+
+
+    class TopContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def blocks(self):
+            return self.getTypedRuleContext(TacticNotationsParser.BlocksContext,0)
+
+
+        def EOF(self):
+            return self.getToken(TacticNotationsParser.EOF, 0)
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_top
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitTop" ):
+                return visitor.visitTop(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def top(self):
+
+        localctx = TacticNotationsParser.TopContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 0, self.RULE_top)
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 18
+            self.blocks()
+            self.state = 19
+            self.match(TacticNotationsParser.EOF)
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class BlocksContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def block(self, i:int=None):
+            if i is None:
+                return self.getTypedRuleContexts(TacticNotationsParser.BlockContext)
+            else:
+                return self.getTypedRuleContext(TacticNotationsParser.BlockContext,i)
+
+
+        def whitespace(self, i:int=None):
+            if i is None:
+                return self.getTypedRuleContexts(TacticNotationsParser.WhitespaceContext)
+            else:
+                return self.getTypedRuleContext(TacticNotationsParser.WhitespaceContext,i)
+
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_blocks
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitBlocks" ):
+                return visitor.visitBlocks(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def blocks(self):
+
+        localctx = TacticNotationsParser.BlocksContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 2, self.RULE_blocks)
+        self._la = 0 # Token type
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 21
+            self.block()
+            self.state = 28
+            self._errHandler.sync(self)
+            _alt = self._interp.adaptivePredict(self._input,1,self._ctx)
+            while _alt!=2 and _alt!=ATN.INVALID_ALT_NUMBER:
+                if _alt==1:
+                    self.state = 23
+                    self._errHandler.sync(self)
+                    _la = self._input.LA(1)
+                    if _la==TacticNotationsParser.WHITESPACE:
+                        self.state = 22
+                        self.whitespace()
+
+
+                    self.state = 25
+                    self.block()
+                self.state = 30
+                self._errHandler.sync(self)
+                _alt = self._interp.adaptivePredict(self._input,1,self._ctx)
+
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class BlockContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def atomic(self):
+            return self.getTypedRuleContext(TacticNotationsParser.AtomicContext,0)
+
+
+        def meta(self):
+            return self.getTypedRuleContext(TacticNotationsParser.MetaContext,0)
+
+
+        def hole(self):
+            return self.getTypedRuleContext(TacticNotationsParser.HoleContext,0)
+
+
+        def repeat(self):
+            return self.getTypedRuleContext(TacticNotationsParser.RepeatContext,0)
+
+
+        def curlies(self):
+            return self.getTypedRuleContext(TacticNotationsParser.CurliesContext,0)
+
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_block
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitBlock" ):
+                return visitor.visitBlock(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def block(self):
+
+        localctx = TacticNotationsParser.BlockContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 4, self.RULE_block)
+        try:
+            self.state = 36
+            self._errHandler.sync(self)
+            token = self._input.LA(1)
+            if token in [TacticNotationsParser.ATOM]:
+                self.enterOuterAlt(localctx, 1)
+                self.state = 31
+                self.atomic()
+                pass
+            elif token in [TacticNotationsParser.METACHAR]:
+                self.enterOuterAlt(localctx, 2)
+                self.state = 32
+                self.meta()
+                pass
+            elif token in [TacticNotationsParser.ID]:
+                self.enterOuterAlt(localctx, 3)
+                self.state = 33
+                self.hole()
+                pass
+            elif token in [TacticNotationsParser.LGROUP]:
+                self.enterOuterAlt(localctx, 4)
+                self.state = 34
+                self.repeat()
+                pass
+            elif token in [TacticNotationsParser.LBRACE]:
+                self.enterOuterAlt(localctx, 5)
+                self.state = 35
+                self.curlies()
+                pass
+            else:
+                raise NoViableAltException(self)
+
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class RepeatContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def LGROUP(self):
+            return self.getToken(TacticNotationsParser.LGROUP, 0)
+
+        def WHITESPACE(self, i:int=None):
+            if i is None:
+                return self.getTokens(TacticNotationsParser.WHITESPACE)
+            else:
+                return self.getToken(TacticNotationsParser.WHITESPACE, i)
+
+        def blocks(self):
+            return self.getTypedRuleContext(TacticNotationsParser.BlocksContext,0)
+
+
+        def RBRACE(self):
+            return self.getToken(TacticNotationsParser.RBRACE, 0)
+
+        def ATOM(self):
+            return self.getToken(TacticNotationsParser.ATOM, 0)
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_repeat
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitRepeat" ):
+                return visitor.visitRepeat(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def repeat(self):
+
+        localctx = TacticNotationsParser.RepeatContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 6, self.RULE_repeat)
+        self._la = 0 # Token type
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 38
+            self.match(TacticNotationsParser.LGROUP)
+            self.state = 40
+            self._errHandler.sync(self)
+            _la = self._input.LA(1)
+            if _la==TacticNotationsParser.ATOM:
+                self.state = 39
+                self.match(TacticNotationsParser.ATOM)
+
+
+            self.state = 42
+            self.match(TacticNotationsParser.WHITESPACE)
+            self.state = 43
+            self.blocks()
+            self.state = 45
+            self._errHandler.sync(self)
+            _la = self._input.LA(1)
+            if _la==TacticNotationsParser.WHITESPACE:
+                self.state = 44
+                self.match(TacticNotationsParser.WHITESPACE)
+
+
+            self.state = 47
+            self.match(TacticNotationsParser.RBRACE)
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class CurliesContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def LBRACE(self):
+            return self.getToken(TacticNotationsParser.LBRACE, 0)
+
+        def blocks(self):
+            return self.getTypedRuleContext(TacticNotationsParser.BlocksContext,0)
+
+
+        def RBRACE(self):
+            return self.getToken(TacticNotationsParser.RBRACE, 0)
+
+        def whitespace(self, i:int=None):
+            if i is None:
+                return self.getTypedRuleContexts(TacticNotationsParser.WhitespaceContext)
+            else:
+                return self.getTypedRuleContext(TacticNotationsParser.WhitespaceContext,i)
+
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_curlies
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitCurlies" ):
+                return visitor.visitCurlies(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def curlies(self):
+
+        localctx = TacticNotationsParser.CurliesContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 8, self.RULE_curlies)
+        self._la = 0 # Token type
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 49
+            self.match(TacticNotationsParser.LBRACE)
+            self.state = 51
+            self._errHandler.sync(self)
+            _la = self._input.LA(1)
+            if _la==TacticNotationsParser.WHITESPACE:
+                self.state = 50
+                self.whitespace()
+
+
+            self.state = 53
+            self.blocks()
+            self.state = 55
+            self._errHandler.sync(self)
+            _la = self._input.LA(1)
+            if _la==TacticNotationsParser.WHITESPACE:
+                self.state = 54
+                self.whitespace()
+
+
+            self.state = 57
+            self.match(TacticNotationsParser.RBRACE)
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class WhitespaceContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def WHITESPACE(self):
+            return self.getToken(TacticNotationsParser.WHITESPACE, 0)
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_whitespace
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitWhitespace" ):
+                return visitor.visitWhitespace(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def whitespace(self):
+
+        localctx = TacticNotationsParser.WhitespaceContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 10, self.RULE_whitespace)
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 59
+            self.match(TacticNotationsParser.WHITESPACE)
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class MetaContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def METACHAR(self):
+            return self.getToken(TacticNotationsParser.METACHAR, 0)
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_meta
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitMeta" ):
+                return visitor.visitMeta(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def meta(self):
+
+        localctx = TacticNotationsParser.MetaContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 12, self.RULE_meta)
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 61
+            self.match(TacticNotationsParser.METACHAR)
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class AtomicContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def ATOM(self):
+            return self.getToken(TacticNotationsParser.ATOM, 0)
+
+        def SUB(self):
+            return self.getToken(TacticNotationsParser.SUB, 0)
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_atomic
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitAtomic" ):
+                return visitor.visitAtomic(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def atomic(self):
+
+        localctx = TacticNotationsParser.AtomicContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 14, self.RULE_atomic)
+        self._la = 0 # Token type
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 63
+            self.match(TacticNotationsParser.ATOM)
+            self.state = 65
+            self._errHandler.sync(self)
+            _la = self._input.LA(1)
+            if _la==TacticNotationsParser.SUB:
+                self.state = 64
+                self.match(TacticNotationsParser.SUB)
+
+
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
+
+    class HoleContext(ParserRuleContext):
+
+        def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1):
+            super().__init__(parent, invokingState)
+            self.parser = parser
+
+        def ID(self):
+            return self.getToken(TacticNotationsParser.ID, 0)
+
+        def SUB(self):
+            return self.getToken(TacticNotationsParser.SUB, 0)
+
+        def getRuleIndex(self):
+            return TacticNotationsParser.RULE_hole
+
+        def accept(self, visitor:ParseTreeVisitor):
+            if hasattr( visitor, "visitHole" ):
+                return visitor.visitHole(self)
+            else:
+                return visitor.visitChildren(self)
+
+
+
+
+    def hole(self):
+
+        localctx = TacticNotationsParser.HoleContext(self, self._ctx, self.state)
+        self.enterRule(localctx, 16, self.RULE_hole)
+        self._la = 0 # Token type
+        try:
+            self.enterOuterAlt(localctx, 1)
+            self.state = 67
+            self.match(TacticNotationsParser.ID)
+            self.state = 69
+            self._errHandler.sync(self)
+            _la = self._input.LA(1)
+            if _la==TacticNotationsParser.SUB:
+                self.state = 68
+                self.match(TacticNotationsParser.SUB)
+
+
+        except RecognitionException as re:
+            localctx.exception = re
+            self._errHandler.reportError(self, re)
+            self._errHandler.recover(self, re)
+        finally:
+            self.exitRule()
+        return localctx
diff --git a/doc/tools/coqrst/notations/TacticNotationsVisitor.py b/doc/tools/coqrst/notations/TacticNotationsVisitor.py
new file mode 100644
index 00000000..c0bcc4af
--- /dev/null
+++ b/doc/tools/coqrst/notations/TacticNotationsVisitor.py
@@ -0,0 +1,58 @@
+# Generated from TacticNotations.g by ANTLR 4.7
+from antlr4 import *
+if __name__ is not None and "." in __name__:
+    from .TacticNotationsParser import TacticNotationsParser
+else:
+    from TacticNotationsParser import TacticNotationsParser
+
+# This class defines a complete generic visitor for a parse tree produced by TacticNotationsParser.
+
+class TacticNotationsVisitor(ParseTreeVisitor):
+
+    # Visit a parse tree produced by TacticNotationsParser#top.
+    def visitTop(self, ctx:TacticNotationsParser.TopContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#blocks.
+    def visitBlocks(self, ctx:TacticNotationsParser.BlocksContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#block.
+    def visitBlock(self, ctx:TacticNotationsParser.BlockContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#repeat.
+    def visitRepeat(self, ctx:TacticNotationsParser.RepeatContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#curlies.
+    def visitCurlies(self, ctx:TacticNotationsParser.CurliesContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#whitespace.
+    def visitWhitespace(self, ctx:TacticNotationsParser.WhitespaceContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#meta.
+    def visitMeta(self, ctx:TacticNotationsParser.MetaContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#atomic.
+    def visitAtomic(self, ctx:TacticNotationsParser.AtomicContext):
+        return self.visitChildren(ctx)
+
+
+    # Visit a parse tree produced by TacticNotationsParser#hole.
+    def visitHole(self, ctx:TacticNotationsParser.HoleContext):
+        return self.visitChildren(ctx)
+
+
+
+del TacticNotationsParser
diff --git a/ltac/tauto.mli b/doc/tools/coqrst/notations/__init__.py
index e69de29b..e69de29b 100644
--- a/ltac/tauto.mli
+++ b/doc/tools/coqrst/notations/__init__.py
diff --git a/doc/tools/coqrst/notations/fontsupport.py b/doc/tools/coqrst/notations/fontsupport.py
new file mode 100755
index 00000000..a3efd97f
--- /dev/null
+++ b/doc/tools/coqrst/notations/fontsupport.py
@@ -0,0 +1,80 @@
+#!/usr/bin/env python2
+# -*- coding: utf-8 -*-
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""Transform a font to center each of its characters in square bounding boxes.
+
+See https://stackoverflow.com/questions/37377476/ for background information.
+"""
+
+from collections import Counter
+
+try:
+    import fontforge
+    import psMat
+except ImportError:
+    print("This program requires FontForge's python bindings:")
+    print("  git clone https://github.com/fontforge/fontforge")
+    print("  cd fontforge")
+    print("  ./bootstrap")
+    print("  ./configure")
+    print("  make -j8")
+    print("  sudo make install")
+    raise
+
+def glyph_height(glyph):
+    _, ylo, _, yhi = glyph.boundingBox()
+    return yhi - ylo
+
+def scale_single_glyph(glyph, width, height):
+    """Center glyph in a box of size width*height"""
+    # Some glyphs (such as ‘;’) contain references (‘.’ + ‘,’), and moving the
+    # referenced glyphs moves them in all glyphs that reference them.
+    # Unlinking copies references into this glyph
+    glyph.unlinkThisGlyph()
+    # Width
+    deltaw = width - glyph.width
+    glyph.left_side_bearing += deltaw / 2
+    glyph.right_side_bearing += deltaw - glyph.left_side_bearing
+    glyph.width = width
+    # Height
+    ylo = glyph.boundingBox()[1]
+    deltah = height - glyph_height(glyph)
+    glyph.transform(psMat.translate(0, deltah / 2.0 - ylo))
+
+def avg(lst):
+    lst = list(lst)
+    return sum(lst) / float(len(lst))
+
+def trim_font(fnt):
+    """Remove characters codes beyond 191 front fnt"""
+    for g in fnt.glyphs():
+        if g.unicode >= 191:
+            fnt.removeGlyph(g)
+    return fnt
+
+def center_glyphs(src_font_path, dst_font_path, dst_name):
+    fnt = trim_font(fontforge.open(src_font_path))
+
+    size = max(g.width for g in fnt.glyphs())
+    fnt.ascent, fnt.descent = size, 0
+    for glyph in fnt.glyphs():
+        scale_single_glyph(glyph, size, size)
+
+    fnt.sfnt_names = []
+    fnt.fontname = fnt.familyname = fnt.fullname = dst_name
+    fnt.generate(dst_font_path)
+
+if __name__ == '__main__':
+    from os.path import dirname, join, abspath
+    curdir = dirname(abspath(__file__))
+    ubuntumono_path = join(curdir, "UbuntuMono-B.ttf")
+    ubuntumono_mod_path = join(curdir, "CoqNotations.ttf")
+    center_glyphs(ubuntumono_path, ubuntumono_mod_path, "CoqNotations")
diff --git a/doc/tools/coqrst/notations/html.py b/doc/tools/coqrst/notations/html.py
new file mode 100644
index 00000000..87a41cf9
--- /dev/null
+++ b/doc/tools/coqrst/notations/html.py
@@ -0,0 +1,75 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""A visitor for ANTLR notation ASTs, producing raw HTML.
+
+Uses the dominate package.
+"""
+
+from dominate import tags
+
+from .parsing import parse
+from .TacticNotationsParser import TacticNotationsParser
+from .TacticNotationsVisitor import TacticNotationsVisitor
+
+class TacticNotationsToHTMLVisitor(TacticNotationsVisitor):
+    def visitRepeat(self, ctx:TacticNotationsParser.RepeatContext):
+        with tags.span(_class="repeat-wrapper"):
+            with tags.span(_class="repeat"):
+                self.visitChildren(ctx)
+            repeat_marker = ctx.LGROUP().getText()[1]
+            separator = ctx.ATOM()
+            tags.sup(repeat_marker)
+            if separator:
+                tags.sub(separator.getText())
+
+    def visitCurlies(self, ctx:TacticNotationsParser.CurliesContext):
+        sp = tags.span(_class="curlies")
+        sp.add("{")
+        with sp:
+            self.visitChildren(ctx)
+        sp.add("}")
+
+    def visitAtomic(self, ctx:TacticNotationsParser.AtomicContext):
+        tags.span(ctx.ATOM().getText())
+
+    def visitHole(self, ctx:TacticNotationsParser.HoleContext):
+        tags.span(ctx.ID().getText()[1:], _class="hole")
+        sub = ctx.SUB()
+        if sub:
+            tags.sub(sub.getText()[1:])
+
+    def visitMeta(self, ctx:TacticNotationsParser.MetaContext):
+        txt = ctx.METACHAR().getText()[1:]
+        if (txt == "{") or (txt == "}"):
+            tags.span(txt)
+        else:
+            tags.span(txt, _class="meta")
+
+    def visitWhitespace(self, ctx:TacticNotationsParser.WhitespaceContext):
+        tags.span(" ")          # TODO: no need for a <span> here
+
+def htmlize(notation):
+    """Translate notation to a dominate HTML tree"""
+    top = tags.span(_class='notation')
+    with top:
+        TacticNotationsToHTMLVisitor().visit(parse(notation))
+    return top
+
+def htmlize_str(notation):
+    """Translate notation to a raw HTML document"""
+    # ‘pretty=True’ introduces spurious spaces
+    return htmlize(notation).render(pretty=False)
+
+def htmlize_p(notation):
+    """Like `htmlize`, wrapped in a ‘p’.
+    Does not return: instead, must be run in a dominate context.
+    """
+    with tags.p():
+        htmlize(notation)
diff --git a/doc/tools/coqrst/notations/parsing.py b/doc/tools/coqrst/notations/parsing.py
new file mode 100644
index 00000000..506240d9
--- /dev/null
+++ b/doc/tools/coqrst/notations/parsing.py
@@ -0,0 +1,37 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+from .TacticNotationsLexer import TacticNotationsLexer
+from .TacticNotationsParser import TacticNotationsParser
+
+from antlr4 import CommonTokenStream, InputStream
+
+SUBSTITUTIONS = [#("@bindings_list", "{+ (@id := @val) }"),
+                 ("@qualid_or_string", "@id|@string")]
+
+def substitute(notation):
+    """Perform common substitutions in the notation string.
+
+    Nested notations quickly became unwieldy in the original ‘…’-based format,
+    so they were avoided and replaced by pointers to grammar rules.  With the
+    new format, it's usually nicer to remove the indirection.
+    """
+    for (src, dst) in SUBSTITUTIONS:
+        notation = notation.replace(src, dst)
+    return notation
+
+def parse(notation):
+    """Parse a notation string.
+
+    :return: An ANTLR AST. Use one of the supplied visitors (or write your own)
+             to turn it into useful output.
+    """
+    substituted = substitute(notation)
+    lexer = TacticNotationsLexer(InputStream(substituted))
+    return TacticNotationsParser(CommonTokenStream(lexer)).top()
diff --git a/doc/tools/coqrst/notations/plain.py b/doc/tools/coqrst/notations/plain.py
new file mode 100644
index 00000000..f6e82fc6
--- /dev/null
+++ b/doc/tools/coqrst/notations/plain.py
@@ -0,0 +1,53 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""A visitor for ANTLR notation ASTs, producing plain text with ellipses.
+
+Somewhat-closely approximates the rendering of the original manual.
+"""
+
+from io import StringIO
+
+from .parsing import parse
+from .TacticNotationsParser import TacticNotationsParser
+from .TacticNotationsVisitor import TacticNotationsVisitor
+
+class TacticNotationsToDotsVisitor(TacticNotationsVisitor):
+    def __init__(self):
+        self.buffer = StringIO()
+
+    def visitRepeat(self, ctx:TacticNotationsParser.RepeatContext):
+        separator = ctx.ATOM()
+        self.visitChildren(ctx)
+        if ctx.LGROUP().getText()[1] == "+":
+            spacer = (separator.getText() + " " if separator else "")
+            self.buffer.write(spacer + "…" + spacer)
+            self.visitChildren(ctx)
+
+    def visitCurlies(self, ctx:TacticNotationsParser.CurliesContext):
+        self.buffer.write("{")
+        self.visitChildren(ctx)
+        self.buffer.write("}")
+
+    def visitAtomic(self, ctx:TacticNotationsParser.AtomicContext):
+        self.buffer.write(ctx.ATOM().getText())
+
+    def visitHole(self, ctx:TacticNotationsParser.HoleContext):
+        self.buffer.write("‘{}’".format(ctx.ID().getText()[1:]))
+
+    def visitMeta(self, ctx:TacticNotationsParser.MetaContext):
+        self.buffer.write(ctx.METACHAR().getText()[1:])
+
+    def visitWhitespace(self, ctx:TacticNotationsParser.WhitespaceContext):
+        self.buffer.write(" ")
+
+def stringify_with_ellipses(notation):
+    vs = TacticNotationsToDotsVisitor()
+    vs.visit(parse(notation))
+    return vs.buffer.getvalue()
diff --git a/doc/tools/coqrst/notations/regexp.py b/doc/tools/coqrst/notations/regexp.py
new file mode 100644
index 00000000..ea820c71
--- /dev/null
+++ b/doc/tools/coqrst/notations/regexp.py
@@ -0,0 +1,60 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""An experimental visitor for ANTLR notation ASTs, producing regular expressions."""
+
+import re
+from io import StringIO
+
+from .parsing import parse
+from .TacticNotationsParser import TacticNotationsParser
+from .TacticNotationsVisitor import TacticNotationsVisitor
+
+class TacticNotationsToRegexpVisitor(TacticNotationsVisitor):
+    def __init__(self):
+        self.buffer = StringIO()
+
+    def visitRepeat(self, ctx:TacticNotationsParser.RepeatContext):
+        separator = ctx.ATOM()
+        repeat_marker = ctx.LGROUP().getText()[1]
+
+        self.buffer.write("(")
+        self.visitChildren(ctx)
+        self.buffer.write(")")
+
+        if repeat_marker in ["?", "*"]:
+            self.buffer.write("?")
+        elif repeat_marker in ["+", "*"]:
+            self.buffer.write("(")
+            self.buffer.write(r"\s*" + re.escape(separator.getText() if separator else " ") + r"\s*")
+            self.visitChildren(ctx)
+            self.buffer.write(")*")
+
+    def visitCurlies(self, ctx:TacticNotationsParser.CurliesContext):
+        self.buffer.write(r"\{")
+        self.visitChildren(ctx)
+        self.buffer.write(r"\}")
+
+    def visitAtomic(self, ctx:TacticNotationsParser.AtomicContext):
+        self.buffer.write(re.escape(ctx.ATOM().getText()))
+
+    def visitHole(self, ctx:TacticNotationsParser.HoleContext):
+        self.buffer.write("([^();. \n]+)") # FIXME could allow more things
+
+    def visitMeta(self, ctx:TacticNotationsParser.MetaContext):
+        self.buffer.write(re.escape(ctx.METACHAR().getText()[1:]))
+
+    def visitWhitespace(self, ctx:TacticNotationsParser.WhitespaceContext):
+        self.buffer.write(r"\s+")
+
+def regexpify(notation):
+    """Translate notation to a Python regular expression matching it"""
+    vs = TacticNotationsToRegexpVisitor()
+    vs.visit(parse(notation))
+    return vs.buffer.getvalue()
diff --git a/doc/tools/coqrst/notations/sphinx.py b/doc/tools/coqrst/notations/sphinx.py
new file mode 100644
index 00000000..e05b8341
--- /dev/null
+++ b/doc/tools/coqrst/notations/sphinx.py
@@ -0,0 +1,102 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""A visitor for ANTLR notation ASTs, producing Sphinx nodes.
+
+Unlike the HTML visitor, this produces Sphinx-friendly nodes that can be used by
+all backends. If you just want HTML output, use the HTML visitor.
+"""
+
+from .parsing import parse
+from .TacticNotationsParser import TacticNotationsParser
+from .TacticNotationsVisitor import TacticNotationsVisitor
+
+from docutils import nodes
+from sphinx import addnodes
+
+import sys
+
+class TacticNotationsToSphinxVisitor(TacticNotationsVisitor):
+    def defaultResult(self):
+        return []
+
+    def aggregateResult(self, aggregate, nextResult):
+        if nextResult:
+            aggregate.extend(nextResult)
+        return aggregate
+
+    def visitRepeat(self, ctx:TacticNotationsParser.RepeatContext):
+        # Uses inline nodes instead of subscript and superscript to ensure that
+        # we get the right customization hooks at the LaTeX level
+        wrapper = nodes.inline('', '', classes=['repeat-wrapper'])
+        wrapper += nodes.inline('', '', *self.visitChildren(ctx), classes=["repeat"])
+
+        repeat_marker = ctx.LGROUP().getText()[1]
+        wrapper += nodes.inline(repeat_marker, repeat_marker, classes=['notation-sup'])
+
+        separator = ctx.ATOM()
+        if separator:
+            sep = separator.getText()
+            wrapper += nodes.inline(sep, sep, classes=['notation-sub'])
+
+        return [wrapper]
+
+    def visitCurlies(self, ctx:TacticNotationsParser.CurliesContext):
+        sp = nodes.inline('', '', classes=["curlies"])
+        sp += nodes.Text("{")
+        sp.extend(self.visitChildren(ctx))
+        sp += nodes.Text("}")
+        return [sp]
+
+    def visitAtomic(self, ctx:TacticNotationsParser.AtomicContext):
+        atom = ctx.ATOM().getText()
+        sub = ctx.SUB()
+        node = nodes.inline(atom, atom)
+
+        if sub:
+            sub_index = sub.getText()[2:]
+            node += nodes.subscript(sub_index, sub_index)
+
+        return [node]
+
+    def visitHole(self, ctx:TacticNotationsParser.HoleContext):
+        hole = ctx.ID().getText()
+        token_name = hole[1:]
+        node = nodes.inline(hole, token_name, classes=["hole"])
+
+        sub = ctx.SUB()
+        if sub:
+            sub_index = sub.getText()[2:]
+            node += nodes.subscript(sub_index, sub_index)
+
+        return [addnodes.pending_xref(token_name, node, reftype='token', refdomain='std', reftarget=token_name)]
+
+    def visitMeta(self, ctx:TacticNotationsParser.MetaContext):
+        meta = ctx.METACHAR().getText()
+        metachar = meta[1:] # remove escape char
+        token_name = metachar
+        if (metachar == "{") or (metachar == "}"):
+            classes=[]
+        else:
+            classes=["meta"]
+        return [nodes.inline(metachar, token_name, classes=classes)]
+
+    def visitWhitespace(self, ctx:TacticNotationsParser.WhitespaceContext):
+        return [nodes.Text(" ")]
+
+def sphinxify(notation):
+    """Translate notation into a Sphinx document tree"""
+    vs = TacticNotationsToSphinxVisitor()
+    return vs.visit(parse(notation))
+
+def main():
+    print(sphinxify("a := {+, b {+ c}}"))
+
+if __name__ == '__main__':
+    main()
diff --git a/doc/tools/coqrst/repl/__init__.py b/doc/tools/coqrst/repl/__init__.py
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/doc/tools/coqrst/repl/__init__.py
diff --git a/doc/tools/coqrst/repl/ansicolors.py b/doc/tools/coqrst/repl/ansicolors.py
new file mode 100644
index 00000000..495eea91
--- /dev/null
+++ b/doc/tools/coqrst/repl/ansicolors.py
@@ -0,0 +1,99 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""
+Parse Coq's ANSI output.
+========================
+
+Translated to Python from Coq's terminal.ml.
+"""
+
+# pylint: disable=too-many-return-statements, too-many-branches
+
+def parse_color(style, offset):
+    color = style[offset] % 10
+    if color == 0:
+        return ("black", 1)
+    elif color == 1:
+        return ("red", 1)
+    elif color == 2:
+        return ("green", 1)
+    elif color == 3:
+        return ("yellow", 1)
+    elif color == 4:
+        return ("blue", 1)
+    elif color == 5:
+        return ("magenta", 1)
+    elif color == 6:
+        return ("cyan", 1)
+    elif color == 7:
+        return ("white", 1)
+    elif color == 9:
+        return ("default", 1)
+    elif color == 8:
+        nxt = style[offset + 1]
+        if nxt == 5:
+            return ("index-{}".format(style[offset + 1]), 2)
+        elif nxt == 2:
+            return ("rgb-{}-{}-{}".format(*style[offset+1:offset+4]), 4)
+        else:
+            raise ValueError("{}, {}".format(style, offset))
+    else:
+        raise ValueError()
+
+def parse_style(style, offset, acc):
+    offset = 0
+    while offset < len(style):
+        head = style[offset]
+
+        if head == 0:
+            acc.append("reset")
+        elif head == 1:
+            acc.append("bold")
+        elif head == 3:
+            acc.append("italic")
+        elif head == 4:
+            acc.append("underline")
+        elif head == 7:
+            acc.append("negative")
+        elif head == 22:
+            acc.append("no-bold")
+        elif head == 23:
+            acc.append("no-italic")
+        elif head == 24:
+            acc.append("no-underline")
+        elif head == 27:
+            acc.append("no-negative")
+        else:
+            color, suboffset = parse_color(style, offset)
+            offset += suboffset - 1
+            if 30 <= head < 40:
+                acc.append("fg-{}".format(color))
+            elif 40 <= head < 50:
+                acc.append("bg-{}".format(color))
+            elif 90 <= head < 100:
+                acc.append("fg-light-{}".format(color))
+            elif 100 <= head < 110:
+                acc.append("bg-light-{}".format(color))
+
+        offset += 1
+
+def parse_ansi(code):
+    """Parse an ansi code into a collection of CSS classes.
+
+    :param code: A sequence of ‘;’-separated ANSI codes.  Do not include the
+                 leading ‘^[[’ or the final ‘m’
+    """
+    classes = []
+    parse_style([int(c) for c in code.split(';')], 0, classes)
+    return ["ansi-" + cls for cls in classes]
+
+if __name__ == '__main__':
+    # As produced by Coq with ‘Check nat.’
+    print(parse_ansi("92;49;22;23;24;27"))
diff --git a/doc/tools/coqrst/repl/coqtop.py b/doc/tools/coqrst/repl/coqtop.py
new file mode 100644
index 00000000..aeadce4c
--- /dev/null
+++ b/doc/tools/coqrst/repl/coqtop.py
@@ -0,0 +1,103 @@
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
+"""
+Drive coqtop with Python!
+=========================
+
+This module is a simple pexpect-based driver for coqtop, based on the old
+REPL interface.
+"""
+
+import os
+import re
+
+import pexpect
+
+class CoqTop:
+    """Create an instance of coqtop.
+
+    Use this as a context manager: no instance of coqtop is created until
+    you call `__enter__`.  coqtop is terminated when you `__exit__` the
+    context manager.
+
+    Sentence parsing is very basic for now (a "." in a quoted string will
+    confuse it).
+    """
+
+    COQTOP_PROMPT = re.compile("\r\n[^< ]+ < ")
+
+    def __init__(self, coqtop_bin=None, color=False, args=None) -> str:
+        """Configure a coqtop instance (but don't start it yet).
+
+        :param coqtop_bin: The path to coqtop; uses $COQBIN by default, falling back to "coqtop"
+        :param color:      When True, tell coqtop to produce ANSI color codes (see
+                           the ansicolors module)
+        :param args:       Additional arugments to coqtop.
+        """
+        self.coqtop_bin = coqtop_bin or os.path.join(os.getenv('COQBIN', ""), "coqtop")
+        if not pexpect.utils.which(self.coqtop_bin):
+            raise ValueError("coqtop binary not found: '{}'".format(self.coqtop_bin))
+        self.args = (args or []) + ["-boot", "-color", "on"] * color
+        self.coqtop = None
+
+    def __enter__(self):
+        if self.coqtop:
+            raise ValueError("This module isn't re-entrant")
+        self.coqtop = pexpect.spawn(self.coqtop_bin, args=self.args, echo=False, encoding="utf-8")
+        # Disable delays (http://pexpect.readthedocs.io/en/stable/commonissues.html?highlight=delaybeforesend)
+        self.coqtop.delaybeforesend = 0
+        self.next_prompt()
+        return self
+
+    def __exit__(self, type, value, traceback):
+        self.coqtop.kill(9)
+
+    def next_prompt(self):
+        "Wait for the next coqtop prompt, and return the output preceeding it."
+        self.coqtop.expect(CoqTop.COQTOP_PROMPT, timeout = 10)
+        return self.coqtop.before
+
+    def sendone(self, sentence):
+        """Send a single sentence to coqtop.
+
+        :sentence: One Coq sentence (otherwise, Coqtop will produce multiple
+                   prompts and we'll get confused)
+        """
+        # Suppress newlines, but not spaces: they are significant in notations
+        sentence = re.sub(r"[\r\n]+", " ", sentence).strip()
+        self.coqtop.sendline(sentence)
+        try:
+            output = self.next_prompt()
+        except:
+            print("Error while sending the following sentence to coqtop: {}".format(sentence))
+            raise
+        # print("Got {}".format(repr(output)))
+        return output
+
+def sendmany(*sentences):
+    """A small demo: send each sentence in sentences and print the output"""
+    with CoqTop() as coqtop:
+        for sentence in sentences:
+            print("=====================================")
+            print(sentence)
+            print("-------------------------------------")
+            response = coqtop.sendone(sentence)
+            print(response)
+
+def main():
+    """Run a simple performance test and demo `sendmany`"""
+    with CoqTop() as coqtop:
+        for _ in range(200):
+            print(repr(coqtop.sendone("Check nat.")))
+        sendmany("Goal False -> True.", "Proof.", "intros H.",
+                 "Check H.", "Chchc.", "apply I.", "Qed.")
+
+if __name__ == '__main__':
+    main()
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
new file mode 100644
index 00000000..bd47a04f
--- /dev/null
+++ b/engine/eConstr.ml
@@ -0,0 +1,932 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open CErrors
+open Util
+open Names
+open Constr
+open Context
+open Evd
+
+module API :
+sig
+module ESorts :
+sig
+type t
+val make : Sorts.t -> t
+val kind : Evd.evar_map -> t -> Sorts.t
+val unsafe_to_sorts : t -> Sorts.t
+end
+module EInstance :
+sig
+type t
+val make : Univ.Instance.t -> t
+val kind : Evd.evar_map -> t -> Univ.Instance.t
+val empty : t
+val is_empty : t -> bool
+val unsafe_to_instance : t -> Univ.Instance.t
+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) 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
+val to_constr : evar_map -> t -> Constr.t
+val unsafe_to_constr : t -> Constr.t
+val unsafe_eq : (t, Constr.t) eq
+val of_named_decl : (Constr.t, Constr.types) Context.Named.Declaration.pt -> (t, t) Context.Named.Declaration.pt
+val unsafe_to_named_decl : (t, t) Context.Named.Declaration.pt -> (Constr.t, Constr.types) Context.Named.Declaration.pt
+val unsafe_to_rel_decl : (t, t) Context.Rel.Declaration.pt -> (Constr.t, Constr.types) Context.Rel.Declaration.pt
+val of_rel_decl : (Constr.t, Constr.types) Context.Rel.Declaration.pt -> (t, t) Context.Rel.Declaration.pt
+val to_rel_decl : Evd.evar_map -> (t, t) Context.Rel.Declaration.pt -> (Constr.t, Constr.types) Context.Rel.Declaration.pt
+end =
+struct
+
+module ESorts =
+struct
+  type t = Sorts.t
+  let make s = s
+  let kind sigma = function
+  | Sorts.Type u -> Sorts.sort_of_univ (Evd.normalize_universe sigma u)
+  | s -> s
+  let unsafe_to_sorts s = s
+end
+
+module EInstance =
+struct
+  type t = Univ.Instance.t
+  let make i = i
+  let kind sigma i =
+    if Univ.Instance.is_empty i then i
+    else Evd.normalize_universe_instance sigma i
+  let empty = Univ.Instance.empty
+  let is_empty = Univ.Instance.is_empty
+  let unsafe_to_instance t = t
+end
+
+type t = Constr.t
+
+let safe_evar_value sigma ev =
+  try Some (Evd.existential_value sigma ev)
+  with NotInstantiatedEvar | Not_found -> None
+
+let rec whd_evar sigma c =
+  match Constr.kind c with
+  | Evar ev ->
+    begin match safe_evar_value sigma ev with
+    | Some c -> whd_evar sigma c
+    | None -> c
+    end
+  | App (f, args) when isEvar f ->
+    (** Enforce smart constructor invariant on applications *)
+    let ev = destEvar f in
+    begin match safe_evar_value sigma ev with
+    | None -> c
+    | Some f -> whd_evar sigma (mkApp (f, args))
+    end
+  | Cast (c0, k, t) when isEvar c0 ->
+    (** Enforce smart constructor invariant on casts. *)
+    let ev = destEvar c0 in
+    begin match safe_evar_value sigma ev with
+    | None -> c
+    | Some c -> whd_evar sigma (mkCast (c, k, t))
+    end
+  | _ -> c
+
+let kind sigma c = Constr.kind (whd_evar sigma c)
+let kind_upto = kind
+let kind_of_type sigma c = Term.kind_of_type (whd_evar sigma c)
+let of_kind = Constr.of_kind
+let of_constr c = c
+let unsafe_to_constr c = c
+let unsafe_eq = Refl
+
+let rec to_constr sigma c = match Constr.kind c with
+| Evar ev ->
+  begin match safe_evar_value sigma ev with
+  | Some c -> to_constr sigma c
+  | None -> Constr.map (fun c -> to_constr sigma c) c
+  end
+| 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) ->
+  let u' = Evd.normalize_universe_instance sigma u in
+  if u' == u then c else mkConstU (c', u')
+| Ind (i, u) when not (Univ.Instance.is_empty u) ->
+  let u' = Evd.normalize_universe_instance sigma u in
+  if u' == u then c else mkIndU (i, u')
+| Construct (co, u) when not (Univ.Instance.is_empty u) ->
+  let u' = Evd.normalize_universe_instance sigma u in
+  if u' == u then c else mkConstructU (co, u')
+| _ -> Constr.map (fun c -> to_constr sigma c) c
+
+let of_named_decl d = d
+let unsafe_to_named_decl d = d
+let of_rel_decl d = d
+let unsafe_to_rel_decl d = d
+let to_rel_decl sigma d = Context.Rel.Declaration.map_constr (to_constr sigma) d
+
+end
+
+include API
+
+type types = t
+type constr = t
+type existential = t pexistential
+type fixpoint = (t, t) pfixpoint
+type cofixpoint = (t, t) pcofixpoint
+type unsafe_judgment = (constr, types) Environ.punsafe_judgment
+type unsafe_type_judgment = types Environ.punsafe_type_judgment
+type named_declaration = (constr, types) Context.Named.Declaration.pt
+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))
+let mkSet = of_kind (Sort (ESorts.make Sorts.set))
+let mkType u = of_kind (Sort (ESorts.make (Sorts.Type u)))
+let mkRel n = of_kind (Rel n)
+let mkVar id = of_kind (Var id)
+let mkMeta n = of_kind (Meta n)
+let mkEvar e = of_kind (Evar e)
+let mkSort s = of_kind (Sort (ESorts.make s))
+let mkCast (b, k, t) = of_kind (Cast (b, k, t))
+let mkProd (na, t, u) = of_kind (Prod (na, t, u))
+let mkLambda (na, t, c) = of_kind (Lambda (na, t, c))
+let mkLetIn (na, b, t, c) = of_kind (LetIn (na, b, t, c))
+let mkApp (f, arg) = of_kind (App (f, arg))
+let mkConstU pc = of_kind (Const pc)
+let mkConst c = of_kind (Const (in_punivs c))
+let mkIndU pi = of_kind (Ind pi)
+let mkInd i = of_kind (Ind (in_punivs i))
+let mkConstructU pc = of_kind (Construct pc)
+let mkConstruct c = of_kind (Construct (in_punivs c))
+let mkConstructUi ((ind,u),i) = of_kind (Construct ((ind,i),u))
+let mkCase (ci, c, r, p) = of_kind (Case (ci, c, r, p))
+let mkFix f = of_kind (Fix f)
+let mkCoFix f = of_kind (CoFix f)
+let mkProj (p, c) = of_kind (Proj (p, c))
+let mkArrow t1 t2 = of_kind (Prod (Anonymous, t1, t2))
+
+let applist (f, arg) = mkApp (f, Array.of_list arg)
+
+let isRel sigma c = match kind sigma c with Rel _ -> true | _ -> false
+let isVar sigma c = match kind sigma c with Var _ -> true | _ -> false
+let isInd sigma c = match kind sigma c with Ind _ -> true | _ -> false
+let isEvar sigma c = match kind sigma c with Evar _ -> true | _ -> false
+let isMeta sigma c = match kind sigma c with Meta _ -> true | _ -> false
+let isSort sigma c = match kind sigma c with Sort _ -> true | _ -> false
+let isCast sigma c = match kind sigma c with Cast _ -> true | _ -> false
+let isApp sigma c = match kind sigma c with App _ -> true | _ -> false
+let isLambda sigma c = match kind sigma c with Lambda _ -> true | _ -> false
+let isLetIn sigma c = match kind sigma c with LetIn _ -> true | _ -> false
+let isProd sigma c = match kind sigma c with Prod _ -> true | _ -> false
+let isConst sigma c = match kind sigma c with Const _ -> true | _ -> false
+let isConstruct sigma c = match kind sigma c with Construct _ -> true | _ -> false
+let isFix sigma c = match kind sigma c with Fix _ -> true | _ -> false
+let isCoFix sigma c = match kind sigma c with CoFix _ -> true | _ -> false
+let isCase sigma c = match kind sigma c with Case _ -> true | _ -> false
+let isProj sigma c = match kind sigma c with Proj _ -> true | _ -> false
+let isVarId sigma id c =
+  match kind sigma c with Var id' -> Id.equal id id' | _ -> false
+let isRelN sigma n c =
+  match kind sigma c with Rel n' -> Int.equal n n' | _ -> false
+
+let destRel sigma c = match kind sigma c with
+| Rel p -> p
+| _ -> raise DestKO
+
+let destVar sigma c = match kind sigma c with
+| Var p -> p
+| _ -> raise DestKO
+
+let destInd sigma c = match kind sigma c with
+| Ind p -> p
+| _ -> raise DestKO
+
+let destEvar sigma c = match kind sigma c with
+| Evar p -> p
+| _ -> raise DestKO
+
+let destMeta sigma c = match kind sigma c with
+| Meta p -> p
+| _ -> raise DestKO
+
+let destSort sigma c = match kind sigma c with
+| Sort p -> p
+| _ -> raise DestKO
+
+let destCast sigma c = match kind sigma c with
+| Cast (c, k, t) -> (c, k, t)
+| _ -> raise DestKO
+
+let destApp sigma c = match kind sigma c with
+| App (f, a) -> (f, a)
+| _ -> raise DestKO
+
+let destLambda sigma c = match kind sigma c with
+| Lambda (na, t, c) -> (na, t, c)
+| _ -> raise DestKO
+
+let destLetIn sigma c = match kind sigma c with
+| LetIn (na, b, t, c) -> (na, b, t, c)
+| _ -> raise DestKO
+
+let destProd sigma c = match kind sigma c with
+| Prod (na, t, c) -> (na, t, c)
+| _ -> raise DestKO
+
+let destConst sigma c = match kind sigma c with
+| Const p -> p
+| _ -> raise DestKO
+
+let destConstruct sigma c = match kind sigma c with
+| Construct p -> p
+| _ -> raise DestKO
+
+let destFix sigma c = match kind sigma c with
+| Fix p -> p
+| _ -> raise DestKO
+
+let destCoFix sigma c = match kind sigma c with
+| CoFix p -> p
+| _ -> raise DestKO
+
+let destCase sigma c = match kind sigma c with
+| Case (ci, t, c, p) -> (ci, t, c, p)
+| _ -> raise DestKO
+
+let destProj sigma c = match kind sigma c with
+| Proj (p, c) -> (p, c)
+| _ -> raise DestKO
+
+let decompose_app sigma c =
+  match kind sigma c with
+    | App (f,cl) -> (f, Array.to_list cl)
+    | _ -> (c,[])
+
+let decompose_lam sigma c =
+  let rec lamdec_rec l c = match kind sigma c with
+    | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) c
+    | Cast (c,_,_)     -> lamdec_rec l c
+    | _                -> l,c
+  in
+  lamdec_rec [] c
+
+let decompose_lam_assum sigma c =
+  let open Rel.Declaration in
+  let rec lamdec_rec l c =
+    match kind sigma c with
+    | Lambda (x,t,c)  -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) c
+    | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) c
+    | Cast (c,_,_)      -> lamdec_rec l c
+    | _               -> l,c
+  in
+  lamdec_rec Context.Rel.empty c
+
+let decompose_lam_n_assum sigma n c =
+  let open Rel.Declaration in
+  if n < 0 then
+    user_err Pp.(str "decompose_lam_n_assum: integer parameter must be positive");
+  let rec lamdec_rec l n c =
+    if Int.equal n 0 then l,c
+    else
+      match kind sigma c with
+      | Lambda (x,t,c)  -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c
+      | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) n c
+      | Cast (c,_,_)      -> lamdec_rec l n c
+      | c -> user_err Pp.(str "decompose_lam_n_assum: not enough abstractions")
+  in
+  lamdec_rec Context.Rel.empty n c
+
+let decompose_lam_n_decls sigma n =
+  let open Rel.Declaration in
+  if n < 0 then
+    user_err Pp.(str "decompose_lam_n_decls: integer parameter must be positive");
+  let rec lamdec_rec l n c =
+    if Int.equal n 0 then l,c
+    else
+      match kind sigma c with
+      | Lambda (x,t,c)  -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c
+      | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) (n-1) c
+      | Cast (c,_,_)      -> lamdec_rec l n c
+      | c -> user_err Pp.(str "decompose_lam_n_decls: not enough abstractions")
+  in
+  lamdec_rec Context.Rel.empty n
+
+let lamn n env b =
+  let rec lamrec = function
+    | (0, env, b)        -> b
+    | (n, ((v,t)::l), b) -> lamrec (n-1,  l, mkLambda (v,t,b))
+    | _ -> assert false
+  in
+  lamrec (n,env,b)
+
+let compose_lam l b = lamn (List.length l) l b
+
+let rec to_lambda sigma n prod =
+  if Int.equal n 0 then
+    prod
+  else
+    match kind sigma prod with
+      | Prod (na,ty,bd) -> mkLambda (na,ty,to_lambda sigma (n-1) bd)
+      | Cast (c,_,_) -> to_lambda sigma n c
+      | _   -> user_err ~hdr:"to_lambda" (Pp.mt ())
+
+let decompose_prod sigma c =
+  let rec proddec_rec l c = match kind sigma c with
+    | Prod (x,t,c) -> proddec_rec ((x,t)::l) c
+    | Cast (c,_,_)     -> proddec_rec l c
+    | _                -> l,c
+  in
+  proddec_rec [] c
+
+let decompose_prod_assum sigma c =
+  let open Rel.Declaration in
+  let rec proddec_rec l c =
+    match kind sigma c with
+    | Prod (x,t,c)  -> proddec_rec (Context.Rel.add (LocalAssum (x,t)) l) c
+    | LetIn (x,b,t,c) -> proddec_rec (Context.Rel.add (LocalDef (x,b,t)) l) c
+    | Cast (c,_,_)      -> proddec_rec l c
+    | _               -> l,c
+  in
+  proddec_rec Context.Rel.empty c
+
+let decompose_prod_n_assum sigma n c =
+  let open Rel.Declaration in
+  if n < 0 then
+    user_err Pp.(str "decompose_prod_n_assum: integer parameter must be positive");
+  let rec prodec_rec l n c =
+    if Int.equal n 0 then l,c
+    else
+      match kind sigma c with
+      | Prod (x,t,c)    -> prodec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c
+      | LetIn (x,b,t,c) -> prodec_rec (Context.Rel.add (LocalDef (x,b,t)) l) (n-1) c
+      | Cast (c,_,_)      -> prodec_rec l n c
+      | c -> user_err Pp.(str "decompose_prod_n_assum: not enough assumptions")
+  in
+  prodec_rec Context.Rel.empty n c
+
+let existential_type sigma (evk, args) =
+  of_constr (existential_type sigma (evk, Array.map unsafe_to_constr args))
+
+let map sigma f c = match kind sigma c with
+  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
+    | Construct _) -> c
+  | Cast (b,k,t) ->
+      let b' = f b in
+      let t' = f t in
+      if b'==b && t' == t then c
+      else mkCast (b', k, t')
+  | Prod (na,t,b) ->
+      let b' = f b in
+      let t' = f t in
+      if b'==b && t' == t then c
+      else mkProd (na, t', b')
+  | Lambda (na,t,b) ->
+      let b' = f b in
+      let t' = f t in
+      if b'==b && t' == t then c
+      else mkLambda (na, t', b')
+  | LetIn (na,b,t,k) ->
+      let b' = f b in
+      let t' = f t in
+      let k' = f k in
+      if b'==b && t' == t && k'==k then c
+      else mkLetIn (na, b', t', k')
+  | App (b,l) ->
+      let b' = f b in
+      let l' = Array.smartmap f l in
+      if b'==b && l'==l then c
+      else mkApp (b', l')
+  | Proj (p,t) ->
+      let t' = f t in
+      if t' == t then c
+      else mkProj (p, t')
+  | Evar (e,l) ->
+      let l' = Array.smartmap f l in
+      if l'==l then c
+      else mkEvar (e, l')
+  | Case (ci,p,b,bl) ->
+      let b' = f b in
+      let p' = f p in
+      let bl' = Array.smartmap f bl in
+      if b'==b && p'==p && bl'==bl then c
+      else mkCase (ci, p', b', bl')
+  | Fix (ln,(lna,tl,bl)) ->
+      let tl' = Array.smartmap f tl in
+      let bl' = Array.smartmap f bl in
+      if tl'==tl && bl'==bl then c
+      else mkFix (ln,(lna,tl',bl'))
+  | CoFix(ln,(lna,tl,bl)) ->
+      let tl' = Array.smartmap f tl in
+      let bl' = Array.smartmap f bl in
+      if tl'==tl && bl'==bl then c
+      else mkCoFix (ln,(lna,tl',bl'))
+
+let map_with_binders sigma g f l c0 = match kind sigma c0 with
+  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
+    | Construct _) -> c0
+  | Cast (c, k, t) ->
+    let c' = f l c in
+    let t' = f l t in
+    if c' == c && t' == t then c0
+    else mkCast (c', k, t')
+  | Prod (na, t, c) ->
+    let t' = f l t in
+    let c' = f (g l) c in
+    if t' == t && c' == c then c0
+    else mkProd (na, t', c')
+  | Lambda (na, t, c) ->
+    let t' = f l t in
+    let c' = f (g l) c in
+    if t' == t && c' == c then c0
+    else mkLambda (na, t', c')
+  | LetIn (na, b, t, c) ->
+    let b' = f l b in
+    let t' = f l t in
+    let c' = f (g l) c in
+    if b' == b && t' == t && c' == c then c0
+    else mkLetIn (na, b', t', c')
+  | App (c, al) ->
+    let c' = f l c in
+    let al' = CArray.Fun1.smartmap f l al in
+    if c' == c && al' == al then c0
+    else mkApp (c', al')
+  | Proj (p, t) ->
+    let t' = f l t in
+    if t' == t then c0
+    else mkProj (p, t')
+  | Evar (e, al) ->
+    let al' = CArray.Fun1.smartmap f l al in
+    if al' == al then c0
+    else mkEvar (e, al')
+  | Case (ci, p, c, bl) ->
+    let p' = f l p in
+    let c' = f l c in
+    let bl' = CArray.Fun1.smartmap f l bl in
+    if p' == p && c' == c && bl' == bl then c0
+    else mkCase (ci, p', c', bl')
+  | Fix (ln, (lna, tl, bl)) ->
+    let tl' = CArray.Fun1.smartmap f l tl in
+    let l' = iterate g (Array.length tl) l in
+    let bl' = CArray.Fun1.smartmap f l' bl in
+    if tl' == tl && bl' == bl then c0
+    else mkFix (ln,(lna,tl',bl'))
+  | CoFix(ln,(lna,tl,bl)) ->
+    let tl' = CArray.Fun1.smartmap f l tl in
+    let l' = iterate g (Array.length tl) l in
+    let bl' = CArray.Fun1.smartmap f l' bl in
+    mkCoFix (ln,(lna,tl',bl'))
+
+let iter sigma f c = match kind sigma c with
+  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
+    | Construct _) -> ()
+  | Cast (c,_,t) -> f c; f t
+  | Prod (_,t,c) -> f t; f c
+  | Lambda (_,t,c) -> f t; f c
+  | LetIn (_,b,t,c) -> f b; f t; f c
+  | App (c,l) -> f c; Array.iter f l
+  | Proj (p,c) -> f c
+  | Evar (_,l) -> Array.iter f l
+  | Case (_,p,c,bl) -> f p; f c; Array.iter f bl
+  | Fix (_,(_,tl,bl)) -> Array.iter f tl; Array.iter f bl
+  | CoFix (_,(_,tl,bl)) -> Array.iter f tl; Array.iter f bl
+
+let iter_with_full_binders sigma g f n c =
+  let open Context.Rel.Declaration in
+  match kind sigma c with
+  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
+    | Construct _) -> ()
+  | Cast (c,_,t) -> f n c; f n t
+  | Prod (na,t,c) -> f n t; f (g (LocalAssum (na, t)) n) c
+  | Lambda (na,t,c) -> f n t; f (g (LocalAssum (na, t)) n) c
+  | LetIn (na,b,t,c) -> f n b; f n t; f (g (LocalDef (na, b, t)) n) c
+  | App (c,l) -> f n c; CArray.Fun1.iter f n l
+  | Evar (_,l) -> CArray.Fun1.iter f n l
+  | Case (_,p,c,bl) -> f n p; f n c; CArray.Fun1.iter f n bl
+  | Proj (p,c) -> f n c
+  | Fix (_,(lna,tl,bl)) ->
+    Array.iter (f n) tl;
+    let n' = Array.fold_left2 (fun n na t -> g (LocalAssum (na,t)) n) n lna tl in
+    Array.iter (f n') bl
+  | CoFix (_,(lna,tl,bl)) ->
+    Array.iter (f n) tl;
+    let n' = Array.fold_left2 (fun n na t -> g (LocalAssum (na,t)) n) n lna tl in
+    Array.iter (f n') bl
+
+let iter_with_binders sigma g f n c =
+  iter_with_full_binders sigma (fun _ acc -> g acc) f n c
+
+let fold sigma f acc c = match kind sigma c with
+  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
+    | Construct _) -> acc
+  | Cast (c,_,t) -> f (f acc c) t
+  | Prod (_,t,c) -> f (f acc t) c
+  | Lambda (_,t,c) -> f (f acc t) c
+  | LetIn (_,b,t,c) -> f (f (f acc b) t) c
+  | App (c,l) -> Array.fold_left f (f acc c) l
+  | Proj (p,c) -> f acc c
+  | Evar (_,l) -> Array.fold_left f acc l
+  | Case (_,p,c,bl) -> Array.fold_left f (f (f acc p) c) bl
+  | Fix (_,(lna,tl,bl)) ->
+    Array.fold_left2 (fun acc t b -> f (f acc t) b) acc tl bl
+  | CoFix (_,(lna,tl,bl)) ->
+    Array.fold_left2 (fun acc t b -> f (f acc t) b) acc tl bl
+
+let compare_gen k eq_inst eq_sort eq_constr nargs c1 c2 =
+  (c1 == c2) || Constr.compare_head_gen_with k k eq_inst eq_sort eq_constr nargs c1 c2
+
+let eq_constr sigma c1 c2 =
+  let kind c = kind_upto sigma c in
+  let rec eq_constr nargs c1 c2 =
+    compare_gen kind (fun _ _ -> Univ.Instance.equal) Sorts.equal eq_constr nargs c1 c2
+  in
+  eq_constr 0 (unsafe_to_constr c1) (unsafe_to_constr c2)
+
+let eq_constr_nounivs sigma c1 c2 =
+  let kind c = kind_upto sigma c in
+  let rec eq_constr nargs c1 c2 =
+    compare_gen kind (fun _ _ _ _ -> true) (fun _ _ -> true) eq_constr nargs c1 c2
+  in
+  eq_constr 0 (unsafe_to_constr c1) (unsafe_to_constr c2)
+
+let compare_constr sigma cmp c1 c2 =
+  let kind c = kind_upto sigma c in
+  let cmp nargs c1 c2 = cmp (of_constr c1) (of_constr c2) in
+  compare_gen kind (fun _ _ -> Univ.Instance.equal) Sorts.equal cmp 0 (unsafe_to_constr c1) (unsafe_to_constr c2)
+
+let compare_cumulative_instances cv_pb nargs_ok variances u u' cstrs =
+  let open Universes in
+  if not nargs_ok then enforce_eq_instances_univs false u u' cstrs
+  else
+    CArray.fold_left3
+      (fun cstrs v u u' ->
+         let open Univ.Variance in
+         match v with
+         | Irrelevant -> Constraints.add (UWeak (u,u')) cstrs
+         | Covariant ->
+           let u = Univ.Universe.make u in
+           let u' = Univ.Universe.make u' in
+           (match cv_pb with
+            | Reduction.CONV -> Constraints.add (UEq (u,u')) cstrs
+            | Reduction.CUMUL -> Constraints.add (ULe (u,u')) cstrs)
+         | Invariant ->
+           let u = Univ.Universe.make u in
+           let u' = Univ.Universe.make u' in
+           Constraints.add (UEq (u,u')) cstrs)
+      cstrs variances (Univ.Instance.to_array u) (Univ.Instance.to_array u')
+
+let cmp_inductives cv_pb (mind,ind as spec) nargs u1 u2 cstrs =
+  let open Universes in
+  match mind.Declarations.mind_universes with
+  | Declarations.Monomorphic_ind _ ->
+    assert (Univ.Instance.length u1 = 0 && Univ.Instance.length u2 = 0);
+    cstrs
+  | Declarations.Polymorphic_ind _ ->
+     enforce_eq_instances_univs false u1 u2 cstrs
+  | Declarations.Cumulative_ind cumi ->
+    let num_param_arity = Reduction.inductive_cumulativity_arguments spec in
+    let variances = Univ.ACumulativityInfo.variance cumi in
+    compare_cumulative_instances cv_pb (Int.equal num_param_arity nargs) variances u1 u2 cstrs
+
+let cmp_constructors (mind, ind, cns as spec) nargs u1 u2 cstrs =
+  let open Universes in
+  match mind.Declarations.mind_universes with
+  | Declarations.Monomorphic_ind _ ->
+    cstrs
+  | Declarations.Polymorphic_ind _ ->
+    enforce_eq_instances_univs false u1 u2 cstrs
+  | Declarations.Cumulative_ind cumi ->
+    let num_cnstr_args = Reduction.constructor_cumulativity_arguments spec in
+    if not (Int.equal num_cnstr_args nargs)
+    then enforce_eq_instances_univs false u1 u2 cstrs
+    else
+      Array.fold_left2 (fun cstrs u1 u2 -> Universes.(Constraints.add (UWeak (u1,u2)) cstrs))
+        cstrs (Univ.Instance.to_array u1) (Univ.Instance.to_array u2)
+
+let eq_universes env sigma cstrs cv_pb ref nargs l l' =
+  if Univ.Instance.is_empty l then (assert (Univ.Instance.is_empty l'); true)
+  else
+    let l = Evd.normalize_universe_instance sigma l
+    and l' = Evd.normalize_universe_instance sigma l' in
+    let open Universes in
+    match ref with
+    | VarRef _ -> assert false (* variables don't have instances *)
+    | ConstRef _ ->
+      cstrs := enforce_eq_instances_univs true l l' !cstrs; true
+    | IndRef ind ->
+      let mind = Environ.lookup_mind (fst ind) env in
+      cstrs := cmp_inductives cv_pb (mind,snd ind) nargs l l' !cstrs;
+      true
+    | ConstructRef ((mi,ind),ctor) ->
+      let mind = Environ.lookup_mind mi env in
+      cstrs := cmp_constructors (mind,ind,ctor) nargs l l' !cstrs;
+      true
+
+let test_constr_universes env sigma leq m n =
+  let open Universes in
+  let kind c = kind_upto sigma c in
+  if m == n then Some Constraints.empty
+  else
+    let cstrs = ref Constraints.empty in
+    let cv_pb = if leq then Reduction.CUMUL else Reduction.CONV in
+    let eq_universes ref nargs l l' = eq_universes env sigma cstrs Reduction.CONV ref nargs l l'
+    and leq_universes ref nargs l l' = eq_universes env sigma cstrs cv_pb ref nargs l l' 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 
+              (UEq (Sorts.univ_of_sort s1,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 
+           (ULe (Sorts.univ_of_sort s1,Sorts.univ_of_sort s2)) !cstrs;
+	 true)
+    in
+    let rec eq_constr' nargs m n = compare_gen kind eq_universes eq_sorts eq_constr' nargs m n in
+    let res =
+      if leq then
+        let rec compare_leq nargs m n =
+          Constr.compare_head_gen_leq_with kind kind leq_universes leq_sorts
+            eq_constr' leq_constr' nargs m n
+        and leq_constr' nargs m n = m == n || compare_leq nargs m n in
+        compare_leq 0 m n
+      else
+        Constr.compare_head_gen_with kind kind eq_universes eq_sorts eq_constr' 0 m n
+    in
+    if res then Some !cstrs else None
+
+let eq_constr_universes env sigma m n =
+  test_constr_universes env sigma false (unsafe_to_constr m) (unsafe_to_constr n)
+let leq_constr_universes env sigma m n =
+  test_constr_universes env sigma true (unsafe_to_constr m) (unsafe_to_constr n)
+
+let compare_head_gen_proj env sigma equ eqs eqc' nargs m n =
+  let kind c = kind_upto sigma c in
+  match kind_upto sigma m, kind_upto sigma n with
+  | Proj (p, c), App (f, args)
+  | App (f, args), Proj (p, c) -> 
+      (match kind_upto sigma 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
+            eqc' 0 c args.(npars)
+	  else false
+      | _ -> false)
+  | _ -> Constr.compare_head_gen_with kind kind equ eqs eqc' nargs m n
+
+let eq_constr_universes_proj env sigma m n =
+  let open Universes in
+  if m == n then Some Constraints.empty
+  else 
+    let cstrs = ref Constraints.empty in
+    let eq_universes ref l l' = eq_universes env sigma cstrs Reduction.CONV ref l l' in
+    let eq_sorts s1 s2 =
+      if Sorts.equal s1 s2 then true
+      else
+	(cstrs := Constraints.add 
+           (UEq (Sorts.univ_of_sort s1, Sorts.univ_of_sort s2)) !cstrs;
+	 true)
+    in
+    let rec eq_constr' nargs m n =
+      m == n || compare_head_gen_proj env sigma eq_universes eq_sorts eq_constr' nargs m n
+    in
+    let res = eq_constr' 0 (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
+
+let cast_list : type a b. (a,b) eq -> a list -> b list =
+  fun Refl x -> x
+
+let cast_list_snd : type a b. (a,b) eq -> ('c * a) list -> ('c * b) list =
+  fun Refl x -> x
+
+let cast_rel_decl :
+  type a b. (a,b) eq -> (a, a) Rel.Declaration.pt -> (b, b) Rel.Declaration.pt =
+  fun Refl x -> x
+
+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
+
+let cast_named_context :
+  type a b. (a,b) eq -> (a, a) Named.pt -> (b, b) Named.pt =
+  fun Refl x -> x
+
+
+module Vars =
+struct
+exception LocalOccur
+let to_constr = unsafe_to_constr
+let to_rel_decl = unsafe_to_rel_decl
+
+type substl = t list
+
+(** Operations that commute with evar-normalization *)
+let lift n c = of_constr (Vars.lift n (to_constr c))
+let liftn n m c = of_constr (Vars.liftn n m (to_constr c))
+
+let substnl subst n c = of_constr (Vars.substnl (cast_list unsafe_eq subst) n (to_constr c))
+let substl subst c = of_constr (Vars.substl (cast_list unsafe_eq subst) (to_constr c))
+let subst1 c r = of_constr (Vars.subst1 (to_constr c) (to_constr r))
+
+let substnl_decl subst n d = of_rel_decl (Vars.substnl_decl (cast_list unsafe_eq subst) n (to_rel_decl d))
+let substl_decl subst d = of_rel_decl (Vars.substl_decl (cast_list unsafe_eq subst) (to_rel_decl d))
+let subst1_decl c d = of_rel_decl (Vars.subst1_decl (to_constr c) (to_rel_decl d))
+
+let replace_vars subst c =
+  of_constr (Vars.replace_vars (cast_list_snd unsafe_eq subst) (to_constr c))
+let substn_vars n subst c = of_constr (Vars.substn_vars n subst (to_constr c))
+let subst_vars subst c = of_constr (Vars.subst_vars subst (to_constr c))
+let subst_var subst c = of_constr (Vars.subst_var subst (to_constr c))
+
+let subst_univs_level_constr subst c =
+  of_constr (Vars.subst_univs_level_constr subst (to_constr c))
+(** Operations that dot NOT commute with evar-normalization *)
+let noccurn sigma n term =
+  let rec occur_rec n c = match kind sigma c with
+    | Rel m -> if Int.equal m n then raise LocalOccur
+    | _ -> iter_with_binders sigma succ occur_rec n c
+  in
+  try occur_rec n term; true with LocalOccur -> false
+
+let noccur_between sigma n m term =
+  let rec occur_rec n c = match kind sigma c with
+    | Rel p -> if n<=p && p<n+m then raise LocalOccur
+    | _        -> iter_with_binders sigma succ occur_rec n c
+  in
+  try occur_rec n term; true with LocalOccur -> false
+
+let closedn sigma n c =
+  let rec closed_rec n c = match kind sigma c with
+    | Rel m -> if m>n then raise LocalOccur
+    | _ -> iter_with_binders sigma succ closed_rec n c
+  in
+  try closed_rec n c; true with LocalOccur -> false
+
+let closed0 sigma c = closedn sigma 0 c
+
+let subst_of_rel_context_instance ctx subst =
+  cast_list (sym unsafe_eq)
+    (Vars.subst_of_rel_context_instance (cast_rel_context unsafe_eq ctx) (cast_list unsafe_eq subst))
+
+end
+
+let rec isArity sigma c =
+  match kind sigma c with
+  | Prod (_,_,c)    -> isArity sigma c
+  | LetIn (_,b,_,c) -> isArity sigma (Vars.subst1 b c)
+  | Cast (c,_,_)      -> 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
+  | LocalAssum (na,t) -> mkProd (na, t, c)
+  | LocalDef (na,b,t) -> mkLetIn (na, b, t, c)
+
+let mkLambda_or_LetIn decl c =
+  let open Context.Rel.Declaration in
+  match decl with
+  | LocalAssum (na,t) -> mkLambda (na, t, c)
+  | LocalDef (na,b,t) -> mkLetIn (na, b, t, c)
+
+let mkNamedProd id typ c = mkProd (Name id, typ, Vars.subst_var id c)
+let mkNamedLambda id typ c = mkLambda (Name id, typ, Vars.subst_var id c)
+let mkNamedLetIn id c1 t c2 = mkLetIn (Name id, c1, t, Vars.subst_var id c2)
+
+let mkNamedProd_or_LetIn decl c =
+  let open Context.Named.Declaration in
+  match decl with
+    | LocalAssum (id,t) -> mkNamedProd id t c
+    | LocalDef (id,b,t) -> mkNamedLetIn id b t c
+
+let mkNamedLambda_or_LetIn decl c =
+  let open Context.Named.Declaration in
+  match decl with
+    | LocalAssum (id,t) -> mkNamedLambda id t c
+    | LocalDef (id,b,t) -> mkNamedLetIn id b t c
+
+let it_mkProd_or_LetIn t ctx = List.fold_left (fun c d -> mkProd_or_LetIn d c) t ctx
+let it_mkLambda_or_LetIn t ctx = List.fold_left (fun c d -> mkLambda_or_LetIn d c) t ctx
+
+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
+
+let rel_context e = cast_rel_context (sym unsafe_eq) (rel_context e)
+let named_context e = cast_named_context (sym unsafe_eq) (named_context e)
+
+let val_of_named_context e = val_of_named_context (cast_named_context unsafe_eq e)
+let named_context_of_val e = cast_named_context (sym unsafe_eq) (named_context_of_val e)
+
+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
+
+let is_global sigma gr c =
+  Globnames.is_global gr (to_constr sigma c)
+
+module Unsafe =
+struct
+let to_sorts = ESorts.unsafe_to_sorts
+let to_instance = EInstance.unsafe_to_instance
+let to_constr = unsafe_to_constr
+let to_rel_decl = unsafe_to_rel_decl
+let to_named_decl = unsafe_to_named_decl
+let eq = unsafe_eq
+end
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
new file mode 100644
index 00000000..8ee3b905
--- /dev/null
+++ b/engine/eConstr.mli
@@ -0,0 +1,316 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open CSig
+open Names
+open Constr
+open Environ
+
+type t
+(** Type of incomplete terms. Essentially a wrapper around {!Constr.t} ensuring
+    that {!Constr.kind} does not observe defined evars. *)
+
+type types = t
+type constr = t
+type existential = t pexistential
+type fixpoint = (t, t) pfixpoint
+type cofixpoint = (t, t) pcofixpoint
+type unsafe_judgment = (constr, types) Environ.punsafe_judgment
+type unsafe_type_judgment = types Environ.punsafe_type_judgment
+type named_declaration = (constr, types) Context.Named.Declaration.pt
+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
+
+(** {5 Universe variables} *)
+
+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
+
+type 'a puniverses = 'a * EInstance.t
+
+(** {5 Destructors} *)
+
+val kind : Evd.evar_map -> t -> (t, t, ESorts.t, EInstance.t) Constr.kind_of_term
+(** Same as {!Constr.kind} except that it expands evars and normalizes
+    universes on the fly. *)
+
+val kind_upto : Evd.evar_map -> Constr.t -> (Constr.t, Constr.t, Sorts.t, Univ.Instance.t) Constr.kind_of_term
+
+val to_constr : Evd.evar_map -> t -> Constr.t
+(** Returns the evar-normal form of the argument, and cast it as a theoretically
+    evar-free term. In practice this function does not check that the result
+    is actually evar-free, it is currently the duty of the caller to do so.
+    This might change in the future. *)
+
+val kind_of_type : Evd.evar_map -> t -> (t, t) Term.kind_of_type
+
+(** {5 Constructors} *)
+
+val of_kind : (t, t, ESorts.t, EInstance.t) Constr.kind_of_term -> t
+(** Construct a term from a view. *)
+
+val of_constr : Constr.t -> t
+(** Translate a kernel term into an incomplete term in O(1). *)
+
+(** {5 Insensitive primitives}
+
+  Evar-insensitive versions of the corresponding functions. See the {!Constr}
+  module for more information.
+
+*)
+
+(** {6 Constructors} *)
+
+val mkRel : int -> t
+val mkVar : Id.t -> t
+val mkMeta : metavariable -> t
+val mkEvar : t pexistential -> 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 * 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 -> t
+val mkConstU : Constant.t * EInstance.t -> t
+val mkProj : (Projection.t * t) -> t
+val mkInd : inductive -> t
+val mkIndU : inductive * EInstance.t -> t
+val mkConstruct : constructor -> t
+val mkConstructU : constructor * EInstance.t -> t
+val mkConstructUi : (inductive * EInstance.t) * int -> t
+val mkCase : case_info * t * t * t array -> t
+val mkFix : (t, t) pfixpoint -> t
+val mkCoFix : (t, t) pcofixpoint -> t
+val mkArrow : t -> t -> t
+
+val applist : t * t list -> t
+
+val mkProd_or_LetIn : rel_declaration -> t -> t
+val mkLambda_or_LetIn : rel_declaration -> t -> t
+val it_mkProd_or_LetIn : t -> rel_context -> t
+val it_mkLambda_or_LetIn : t -> rel_context -> t
+
+val mkNamedLambda : Id.t -> types -> constr -> constr
+val mkNamedLetIn : Id.t -> constr -> types -> constr -> constr
+val mkNamedProd : Id.t -> types -> types -> types
+val mkNamedLambda_or_LetIn : named_declaration -> types -> types
+val mkNamedProd_or_LetIn : named_declaration -> types -> types
+
+(** {6 Simple case analysis} *)
+
+val isRel  : Evd.evar_map -> t -> bool
+val isVar  : Evd.evar_map -> t -> bool
+val isInd  : Evd.evar_map -> t -> bool
+val isEvar : Evd.evar_map -> t -> bool
+val isMeta : Evd.evar_map -> t -> bool
+val isSort : Evd.evar_map -> t -> bool
+val isCast : Evd.evar_map -> t -> bool
+val isApp : Evd.evar_map -> t -> bool
+val isLambda : Evd.evar_map -> t -> bool
+val isLetIn : Evd.evar_map -> t -> bool
+val isProd : Evd.evar_map -> t -> bool
+val isConst : Evd.evar_map -> t -> bool
+val isConstruct : Evd.evar_map -> t -> bool
+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
+
+val destRel : Evd.evar_map -> t -> int
+val destMeta : Evd.evar_map -> t -> metavariable
+val destVar : Evd.evar_map -> t -> Id.t
+val destSort : Evd.evar_map -> t -> ESorts.t
+val destCast : Evd.evar_map -> t -> t * cast_kind * t
+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.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
+val destCase : Evd.evar_map -> t -> case_info * t * t * t array
+val destProj : Evd.evar_map -> t -> Projection.t * t
+val destFix : Evd.evar_map -> t -> (t, t) pfixpoint
+val destCoFix : Evd.evar_map -> t -> (t, t) pcofixpoint
+
+val decompose_app : Evd.evar_map -> t -> t * t list
+
+val decompose_lam : Evd.evar_map -> t -> (Name.t * t) list * t
+val decompose_lam_assum : Evd.evar_map -> t -> rel_context * t
+val decompose_lam_n_assum : Evd.evar_map -> int -> t -> rel_context * t
+val decompose_lam_n_decls : Evd.evar_map -> int -> t -> rel_context * t
+
+val compose_lam : (Name.t * t) list -> t -> t
+val to_lambda : Evd.evar_map -> int -> t -> t
+
+val decompose_prod : Evd.evar_map -> t -> (Name.t * t) list * t
+val decompose_prod_assum : Evd.evar_map -> t -> rel_context * t
+val decompose_prod_n_assum : Evd.evar_map -> int -> t -> rel_context * t
+
+val existential_type : Evd.evar_map -> existential -> types
+val whd_evar : Evd.evar_map -> constr -> constr
+
+(** {6 Equality} *)
+
+val eq_constr : Evd.evar_map -> t -> t -> bool
+val eq_constr_nounivs : Evd.evar_map -> t -> t -> bool
+val eq_constr_universes : Environ.env -> Evd.evar_map -> t -> t -> Universes.Constraints.t option
+val leq_constr_universes : Environ.env -> Evd.evar_map -> t -> t -> Universes.Constraints.t option
+
+(** [eq_constr_universes_proj] can equate projections and their eta-expanded constant form. *)
+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} *)
+
+val map : Evd.evar_map -> (t -> t) -> t -> t
+val map_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> t) -> 'a -> t -> t
+val iter : Evd.evar_map -> (t -> unit) -> t -> unit
+val iter_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> unit) -> 'a -> t -> unit
+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 :
+sig
+
+(** See vars.mli for the documentation of the functions below *)
+
+type substl = t list
+
+val lift : int -> t -> t
+val liftn : int -> int -> t -> t
+val substnl : substl -> int -> t -> t
+val substl : substl -> t -> t
+val subst1 : t -> t -> t
+
+val substnl_decl : substl -> int -> rel_declaration -> rel_declaration
+val substl_decl : substl -> rel_declaration -> rel_declaration
+val subst1_decl : t -> rel_declaration -> rel_declaration
+
+val replace_vars : (Id.t * t) list -> t -> t
+val substn_vars : int -> Id.t list -> t -> t
+val subst_vars : Id.t list -> t -> t
+val subst_var : Id.t -> t -> t
+
+val noccurn : Evd.evar_map -> int -> t -> bool
+val noccur_between : Evd.evar_map -> int -> int -> t -> bool
+
+val closedn : Evd.evar_map -> int -> t -> bool
+val closed0 : Evd.evar_map -> t -> bool
+
+val subst_univs_level_constr : Univ.universe_level_subst -> t -> t
+val subst_of_rel_context_instance : rel_context -> t list -> t list
+
+
+end
+
+(** {5 Environment handling} *)
+
+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
+val push_named_context_val  : named_declaration -> named_context_val -> named_context_val
+
+val rel_context : env -> rel_context
+val named_context : env -> named_context
+
+val val_of_named_context : named_context -> named_context_val
+val named_context_of_val : named_context_val -> named_context
+
+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 ->
+  Evd.evar_map -> Globnames.global_reference -> Evd.evar_map * t
+
+val is_global : Evd.evar_map -> Globnames.global_reference -> t -> bool
+
+(** {5 Extra} *)
+
+val of_named_decl : (Constr.t, Constr.types) Context.Named.Declaration.pt -> (t, types) Context.Named.Declaration.pt
+val of_rel_decl : (Constr.t, Constr.types) Context.Rel.Declaration.pt -> (t, types) Context.Rel.Declaration.pt
+
+val to_rel_decl : Evd.evar_map -> (t, types) Context.Rel.Declaration.pt -> (Constr.t, Constr.types) Context.Rel.Declaration.pt
+
+(** {5 Unsafe operations} *)
+
+module Unsafe :
+sig
+  val to_constr : t -> Constr.t
+  (** Physical identity. Does not care for defined evars. *)
+
+  val to_rel_decl : (t, types) Context.Rel.Declaration.pt -> (Constr.t, Constr.types) Context.Rel.Declaration.pt
+  (** Physical identity. Does not care for defined evars. *)
+
+  val to_named_decl : (t, types) Context.Named.Declaration.pt -> (Constr.t, Constr.types) Context.Named.Declaration.pt
+  (** Physical identity. Does not care for defined evars. *)
+
+  val to_sorts : ESorts.t -> Sorts.t
+  (** Physical identity. Does not care for normalization. *)
+
+  val to_instance : EInstance.t -> Univ.Instance.t
+  (** Physical identity. Does not care for normalization. *)
+
+  val eq : (t, Constr.t) eq
+  (** Use for transparent cast between types. *)
+end
diff --git a/engine/engine.mllib b/engine/engine.mllib
index 9ce5af81..a3614f6c 100644
--- a/engine/engine.mllib
+++ b/engine/engine.mllib
@@ -1,11 +1,13 @@
-Logic_monad
-Termops
-Namegen
+Universes
+Univops
 UState
+Nameops
 Evd
-Sigma
-Proofview_monad
+EConstr
+Namegen
+Termops
 Evarutil
+Logic_monad
+Proofview_monad
 Proofview
 Ftactic
-Geninterp
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index df170c8d..9cf81ecc 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -1,26 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Names
 open Term
-open Vars
-open Termops
-open Namegen
+open Constr
 open Pre_env
 open Environ
 open Evd
-open Sigma.Notations
+open Termops
+open Namegen
 
-let safe_evar_info sigma evk =
-  try Some (Evd.find sigma evk)
-  with Not_found -> None
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let safe_evar_value sigma ev =
   try Some (Evd.existential_value sigma ev)
@@ -44,10 +44,11 @@ let evd_comb2 f evdref x y =
     z
 
 let e_new_global evdref x = 
-  evd_comb1 (Evd.fresh_global (Global.env())) evdref x
+  EConstr.of_constr (evd_comb1 (Evd.fresh_global (Global.env())) evdref x)
 
 let new_global evd x = 
-  Sigma.fresh_global (Global.env()) evd x
+  let (evd, c) = Evd.fresh_global (Global.env()) evd x in
+  (evd, EConstr.of_constr c)
 
 (****************************************************)
 (* Expanding/testing/exposing existential variables *)
@@ -55,44 +56,25 @@ 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
-
-(* let nf_evar_key = Profile.declare_profile "nf_evar"  *)
-(* let nf_evar = Profile.profile2 nf_evar_key Reductionops.nf_evar *)
-
-let rec whd_evar sigma c =
-  match kind_of_term c with
-    | Evar (evk, args) ->
-      begin match safe_evar_info sigma evk with
-      | Some ({ evar_body = Evar_defined c } as info) ->
-        let args = Array.map (fun c -> whd_evar sigma c) args in
-        let c = instantiate_evar_array info c args in
-        whd_evar sigma c
-      | _ -> c
-      end
-    | Sort (Type u) -> 
-      let u' = Evd.normalize_universe sigma u in
-	if u' == u then c else mkSort (Sorts.sort_of_univ u')
-    | Const (c', u) when not (Univ.Instance.is_empty u) -> 
-      let u' = Evd.normalize_universe_instance sigma u in
-	if u' == u then c else mkConstU (c', u')
-    | Ind (i, u) when not (Univ.Instance.is_empty u) -> 
-      let u' = Evd.normalize_universe_instance sigma u in
-	if u' == u then c else mkIndU (i, u')
-    | Construct (co, u) when not (Univ.Instance.is_empty u) ->
-      let u' = Evd.normalize_universe_instance sigma u in
-	if u' == u then c else mkConstructU (co, u')
-    | _ -> c
-
-let rec nf_evar sigma t = Constr.map (fun t -> nf_evar sigma t) (whd_evar sigma t)
+  | _ -> 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)
+
+(** Term exploration up to instantiation. *)
+let kind_of_term_upto = EConstr.kind_upto
+
+let nf_evar0 sigma t = EConstr.to_constr sigma (EConstr.of_constr t)
+let whd_evar = EConstr.whd_evar
+let nf_evar sigma c = EConstr.of_constr (EConstr.to_constr sigma c)
 
 let j_nf_evar sigma j =
   { uj_val = nf_evar sigma j.uj_val;
@@ -107,33 +89,33 @@ let nf_evars_universes evm =
     (Evd.universe_subst evm)
     
 let nf_evars_and_universes evm =
-  let evm = Evd.nf_constraints evm in
+  let evm = Evd.minimize_universes evm in
     evm, nf_evars_universes evm
 
 let e_nf_evars_and_universes evdref =
-  evdref := Evd.nf_constraints !evdref;
+  evdref := Evd.minimize_universes !evdref;
   nf_evars_universes !evdref, Evd.universe_subst !evdref
 
 let nf_evar_map_universes evm =
-  let evm = Evd.nf_constraints evm in
+  let evm = Evd.minimize_universes evm in
   let subst = Evd.universe_subst evm in
-    if Univ.LMap.is_empty subst then evm, nf_evar evm
+    if Univ.LMap.is_empty subst then evm, nf_evar0 evm
     else
       let f = nf_evars_universes evm in
 	Evd.raw_map (fun _ -> map_evar_info f) evm, f
 
 let nf_named_context_evar sigma ctx =
-  Context.Named.map (nf_evar sigma) ctx
+  Context.Named.map (nf_evar0 sigma) ctx
 
 let nf_rel_context_evar sigma ctx =
   Context.Rel.map (nf_evar sigma) ctx
 
 let nf_env_evar sigma env =
   let nc' = nf_named_context_evar sigma (Environ.named_context env) in
-  let rel' = nf_rel_context_evar sigma (Environ.rel_context env) in
-    push_rel_context rel' (reset_with_named_context (val_of_named_context nc') env)
+  let rel' = nf_rel_context_evar sigma (EConstr.rel_context env) in
+    EConstr.push_rel_context rel' (reset_with_named_context (val_of_named_context nc') env)
 
-let nf_evar_info evc info = map_evar_info (nf_evar evc) info
+let nf_evar_info evc info = map_evar_info (nf_evar0 evc) info
 
 let nf_evar_map evm =
   Evd.raw_map (fun _ evi -> nf_evar_info evm evi) evm
@@ -145,21 +127,11 @@ let nf_evar_map_undefined evm =
 (* Auxiliary functions for the conversion algorithms modulo evars
  *)
 
-(* A probably faster though more approximative variant of
-   [has_undefined (nf_evar c)]: instances are not substituted and
-   maybe an evar occurs in an instance and it would disappear by
-   instantiation *)
-
 let has_undefined_evars evd t =
   let rec has_ev t =
-    match kind_of_term t with
-    | Evar (ev,args) ->
-        (match evar_body (Evd.find evd ev) with
-        | Evar_defined c ->
-            has_ev c; Array.iter has_ev args
-        | Evar_empty ->
-	    raise NotInstantiatedEvar)
-    | _ -> iter_constr has_ev t in
+    match EConstr.kind evd t with
+    | Evar _ -> raise NotInstantiatedEvar
+    | _ -> EConstr.iter evd has_ev t in
   try let _ = has_ev t in false
   with (Not_found | NotInstantiatedEvar) -> true
 
@@ -167,13 +139,11 @@ let is_ground_term evd t =
   not (has_undefined_evars evd t)
 
 let is_ground_env evd env =
-  let open Context.Rel.Declaration in
   let is_ground_rel_decl = function
-    | LocalDef (_,b,_) -> is_ground_term evd b
+    | RelDecl.LocalDef (_,b,_) -> is_ground_term evd (EConstr.of_constr b)
     | _ -> true in
-  let open Context.Named.Declaration in
   let is_ground_named_decl = function
-    | LocalDef (_,b,_) -> is_ground_term evd b
+    | NamedDecl.LocalDef (_,b,_) -> is_ground_term evd (EConstr.of_constr b)
     | _ -> true in
   List.for_all is_ground_rel_decl (rel_context env) &&
   List.for_all is_ground_named_decl (named_context env)
@@ -192,8 +162,10 @@ let is_ground_env = memo is_ground_env
 
 exception NoHeadEvar
 
-let head_evar =
-  let rec hrec c = match kind_of_term c with
+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 c with
     | Evar (evk,_)   -> evk
     | Case (_,_,c,_) -> hrec c
     | App (c,_)      -> hrec c
@@ -201,33 +173,24 @@ let head_evar =
     | Proj (p, c)    -> hrec c
     | _              -> raise NoHeadEvar
   in
-  hrec
+  hrec c
 
 (* Expand head evar if any (currently consider only applications but I
    guess it should consider Case too) *)
 
 let whd_head_evar_stack sigma c =
-  let rec whrec (c, l as s) =
-    match kind_of_term c with
-      | Evar (evk,args as ev) ->
-        let v =
-          try Some (existential_value sigma ev)
-          with NotInstantiatedEvar | Not_found  -> None in
-        begin match v with
-        | None -> s
-        | Some c -> whrec (c, l)
-        end
+  let rec whrec (c, l) =
+    match EConstr.kind sigma c with
       | Cast (c,_,_) -> whrec (c, l)
       | App (f,args) -> whrec (f, args :: l)
-      | _ -> s
+      | c -> (EConstr.of_kind c, l)
   in
   whrec (c, [])
 
 let whd_head_evar sigma c =
+  let open EConstr in
   let (f, args) = whd_head_evar_stack sigma c in
-  (** optim: don't reallocate if empty/singleton *)
   match args with
-  | [] -> f
   | [arg] -> mkApp (f, arg)
   | _ -> mkApp (f, Array.concat args)
 
@@ -238,11 +201,12 @@ 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 mk_new_meta () = mkMeta(new_meta())
+let new_meta () = incr meta_ctr; !meta_ctr
+
+let mk_new_meta () = EConstr.mkMeta(new_meta())
 
 (* The list of non-instantiated existential declarations (order is important) *)
 
@@ -255,12 +219,11 @@ let non_instantiated sigma =
 (************************)
 
 let make_pure_subst evi args =
-  let open Context.Named.Declaration in
   snd (List.fold_right
     (fun decl (args,l) ->
       match args with
-        | a::rest -> (rest, (get_id decl, a)::l)
-        | _ -> anomaly (Pp.str "Instance does not match its signature"))
+        | a::rest -> (rest, (NamedDecl.get_id decl, a)::l)
+        | _ -> anomaly (Pp.str "Instance does not match its signature."))
     (evar_filtered_context evi) (Array.rev_to_list args,[]))
 
 (*------------------------------------*
@@ -296,19 +259,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 =
-  let rec subst n c = match Constr.kind c with
-  | Rel m ->
-    if m <= n then c
-    else if m - n <= k then Int.Map.find (k - m + n) s
-    else mkRel (m - k)
-  | _ -> Constr.map_with_binders succ subst n c
-  in
-  if k = 0 then c else subst 0 c
-
-let subst2 subst vsubst c =
-  csubst_subst subst (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
@@ -318,34 +268,96 @@ 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 * Constr.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 * Constr.constr) list *
-  Id.Set.t * Context.Named.t
-
-let push_var id (n, s) =
-  let s = Int.Map.add n (mkVar id) s in
-  (succ n, s)
-
-let push_rel_decl_to_named_context decl (subst, vsubst, avoid, nc) =
-  let open Context.Named.Declaration in
+  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 =
+    NamedDecl.map_constr f d
+  in
   let replace_var_named_declaration id0 id decl =
-    let id' = get_id decl in
+    let id' = NamedDecl.get_id decl in
     let id' = if Id.equal id0 id' then id else id' in
     let vsubst = [id0 , mkVar id] in
-    decl |> set_id id' |> map_constr (replace_vars vsubst)
+    decl |> NamedDecl.set_id id' |> map_decl (replace_vars vsubst)
   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 open Context.Rel.Declaration in
-  let (na, c, t) = to_tuple decl in
-  let open Context.Named.Declaration in
+  let na = RelDecl.get_name decl in
   let id =
     (* ppedrot: we want to infer nicer names for the refine tactic, but
         keeping at the same time backward compatibility in other code
@@ -356,7 +368,7 @@ let push_rel_decl_to_named_context decl (subst, vsubst, avoid, nc) =
     else
       (** id_of_name_using_hdchar only depends on the rel context which is empty
           here *)
-      next_ident_away (id_of_name_using_hdchar empty_env t na) avoid
+      next_ident_away (id_of_name_using_hdchar empty_env sigma (RelDecl.get_type decl) na) avoid
   in
   match extract_if_neq id na with
   | Some id0 when not (is_section_variable id0) ->
@@ -364,64 +376,66 @@ let push_rel_decl_to_named_context 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 = match c with
-        | None -> LocalAssum (id0, subst2 subst vsubst t)
-        | Some c -> LocalDef (id0, subst2 subst vsubst c, subst2 subst vsubst t)
-      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 = match c with
-        | None -> LocalAssum (id, subst2 subst vsubst t)
-        | Some c -> LocalDef (id, subst2 subst vsubst c, subst2 subst vsubst t)
-      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 typ =
+let push_rel_context_to_named_context env sigma typ =
   (* compute the instances relative to the named context and rel_context *)
   let open Context.Named.Declaration in
+  let open EConstr in
   let ids = List.map get_id (named_context env) in
   let inst_vars = List.map mkVar ids in
   if List.is_empty (Environ.rel_context env) then
-    (named_context_val env, typ, inst_vars, empty_csubst, [])
+    (named_context_val env, typ, inst_vars, empty_csubst)
   else
     let avoid = List.fold_right Id.Set.add ids Id.Set.empty in
     let inst_rels = List.rev (rel_list 0 (nb_rel env)) in
     (* move the rel context to a named context and extend the named instance *)
     (* with vars of the rel context *)
     (* We do keep the instances corresponding to local definition (see above) *)
-    let (subst, vsubst, _, env) =
-      Context.Rel.fold_outside push_rel_decl_to_named_context
-        (rel_context env) ~init:(empty_csubst, [], avoid, named_context env) in
-    (val_of_named_context env, subst2 subst vsubst typ, inst_rels@inst_vars, subst, vsubst)
+    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, csubst_subst subst typ, inst_rels@inst_vars, subst)
 
 (*------------------------------------*
  * Entry points to define new evars   *
  *------------------------------------*)
 
-let default_source = (Loc.ghost,Evar_kinds.InternalHole)
+let default_source = Loc.tag @@ Evar_kinds.InternalHole
 
-let restrict_evar evd evk filter candidates =
-  let evd = Sigma.to_evar_map evd in
-  let evd, evk' = Evd.restrict evk filter ?candidates evd in
-  Sigma.Unsafe.of_pair (evk', Evd.declare_future_goal evk' evd)
+let restrict_evar evd evk filter ?src candidates =
+  let candidates = Option.map (fun l -> List.map EConstr.Unsafe.to_constr l) candidates in
+  let evd, evk' = Evd.restrict evk filter ?candidates ?src evd in
+  Evd.declare_future_goal evk' evd, evk'
 
 let new_pure_evar_full evd evi =
-  let evd = Sigma.to_evar_map evd in
   let (evd, evk) = Evd.new_evar evd evi in
   let evd = Evd.declare_future_goal evk evd in
-  Sigma.Unsafe.of_pair (evk, evd)
+  (evd, evk)
 
 let new_pure_evar sign evd ?(src=default_source) ?(filter = Filter.identity) ?candidates ?(store = Store.empty) ?naming ?(principal=false) typ =
-  let evd = Sigma.to_evar_map evd in
+  let typ = EConstr.Unsafe.to_constr typ in
+  let candidates = Option.map (fun l -> List.map EConstr.Unsafe.to_constr l) candidates in
   let default_naming = Misctypes.IntroAnonymous in
   let naming = Option.default default_naming naming in
+  let name = match naming with
+  | Misctypes.IntroAnonymous -> None
+  | Misctypes.IntroIdentifier id -> Some id
+  | Misctypes.IntroFresh id ->
+    let has_name id = try let _ = Evd.evar_key id evd in true with Not_found -> false in
+    let id = Namegen.next_ident_away_from id has_name in
+    Some id
+  in
   let evi = {
     evar_hyps = sign;
     evar_concl = typ;
@@ -431,70 +445,75 @@ let new_pure_evar sign evd ?(src=default_source) ?(filter = Filter.identity) ?ca
     evar_candidates = candidates;
     evar_extra = store; }
   in
-  let (evd, newevk) = Evd.new_evar evd ~naming evi in
+  let (evd, newevk) = Evd.new_evar evd ?name evi in
   let evd =
     if principal then Evd.declare_principal_goal newevk evd
     else Evd.declare_future_goal newevk evd
   in
-  Sigma.Unsafe.of_pair (newevk, evd)
+  (evd, newevk)
 
 let new_evar_instance sign evd typ ?src ?filter ?candidates ?store ?naming ?principal instance =
+  let open EConstr in
   assert (not !Flags.debug ||
             List.distinct (ids_of_named_context (named_context_of_val sign)));
-  let Sigma (newevk, evd, p) = new_pure_evar sign evd ?src ?filter ?candidates ?store ?naming ?principal typ in
-  Sigma (mkEvar (newevk,Array.of_list instance), evd, p)
+  let (evd, newevk) = new_pure_evar sign evd ?src ?filter ?candidates ?store ?naming ?principal typ in
+  evd, mkEvar (newevk,Array.of_list instance)
+
+let new_evar_from_context sign evd ?src ?filter ?candidates ?store ?naming ?principal typ =
+  let instance = List.map (NamedDecl.get_id %> EConstr.mkVar) (named_context_of_val sign) in
+  let instance =
+    match filter with
+    | None -> instance
+    | Some filter -> Filter.filter_list filter instance in
+  new_evar_instance sign evd typ ?src ?filter ?candidates ?store ?naming ?principal instance
 
 (* [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 typ in
-  let candidates = Option.map (List.map (subst2 subst vsubst)) candidates 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
     | None -> instance
     | Some filter -> Filter.filter_list filter instance in
   new_evar_instance sign evd typ' ?src ?filter ?candidates ?store ?naming ?principal instance
 
-let new_evar_unsafe env evd ?src ?filter ?candidates ?store ?naming ?principal typ =
-  let evd = Sigma.Unsafe.of_evar_map evd in
-  let Sigma (evk, evd, _) = new_evar env evd ?src ?filter ?candidates ?store ?naming ?principal typ in
-  (Sigma.to_evar_map evd, evk)
-
 let new_type_evar env evd ?src ?filter ?naming ?principal rigid =
-  let Sigma (s, evd', p) = Sigma.new_sort_variable rigid evd in
-  let Sigma (e, evd', q) = new_evar env evd' ?src ?filter ?naming ?principal (mkSort s) in
-  Sigma ((e, s), evd', p +> q)
+  let (evd', s) = new_sort_variable rigid evd in
+  let (evd', e) = new_evar env evd' ?src ?filter ?naming ?principal (EConstr.mkSort s) in
+  evd', (e, s)
 
 let e_new_type_evar env evdref ?src ?filter ?naming ?principal rigid =
-  let sigma = Sigma.Unsafe.of_evar_map !evdref in
-  let Sigma (c, sigma, _) = new_type_evar env sigma ?src ?filter ?naming ?principal rigid in
-  let sigma = Sigma.to_evar_map sigma in
-    evdref := sigma;
+  let (evd, c) = new_type_evar env !evdref ?src ?filter ?naming ?principal rigid in
+    evdref := evd;
     c
 
 let new_Type ?(rigid=Evd.univ_flexible) env evd = 
-  let Sigma (s, sigma, p) = Sigma.new_sort_variable rigid evd in
-  Sigma (mkSort s, sigma, p)
+  let open EConstr in
+  let (evd, s) = new_sort_variable rigid evd in
+  (evd, mkSort s)
 
 let e_new_Type ?(rigid=Evd.univ_flexible) env evdref =
   let evd', s = new_sort_variable rigid !evdref in
-    evdref := evd'; mkSort s
+    evdref := evd'; EConstr.mkSort s
 
   (* The same using side-effect *)
 let e_new_evar env evdref ?(src=default_source) ?filter ?candidates ?store ?naming ?principal ty =
-  let (evd',ev) = new_evar_unsafe env !evdref ~src:src ?filter ?candidates ?store ?naming ?principal ty in
+  let (evd',ev) = new_evar env !evdref ~src:src ?filter ?candidates ?store ?naming ?principal ty in
   evdref := evd';
   ev
 
 (* This assumes an evar with identity instance and generalizes it over only
-   the De Bruijn part of the context *)
+   the de Bruijn part of the context *)
 let generalize_evar_over_rels sigma (ev,args) =
+  let open EConstr in
   let evi = Evd.find sigma ev in
   let sign = named_context_of_val evi.evar_hyps in
   List.fold_left2
     (fun (c,inst as x) a d ->
-      if isRel a then (mkNamedProd_or_LetIn d c,a::inst) else x)
-     (evi.evar_concl,[]) (Array.to_list args) sign
+      if isRel sigma a then (mkNamedProd_or_LetIn d c,a::inst) else x)
+     (EConstr.of_constr evi.evar_concl,[]) (Array.to_list args) sign
 
 (************************************)
 (* Removing a dependency in an evar *)
@@ -506,8 +525,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 =
@@ -515,7 +532,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
 
@@ -532,7 +549,7 @@ let rec check_and_clear_in_constr env evdref err ids global c =
       | Evar (evk,l as ev) ->
 	  if Evd.is_defined !evdref evk then
 	    (* If evk is already defined we replace it by its definition *)
-	    let nc = whd_evar !evdref c in
+	    let nc = Evd.existential_value !evdref ev in
 	      (check_and_clear_in_constr env evdref err ids global nc)
 	  else
 	    (* We check for dependencies to elements of ids in the
@@ -542,6 +559,7 @@ let rec check_and_clear_in_constr env evdref err ids global c =
 	       removed *)
 	    let evi = Evd.find_undefined !evdref evk in
 	    let ctxt = Evd.evar_filtered_context evi in
+	    let ctxt = List.map (fun d -> map_named_decl EConstr.of_constr d) ctxt in
 	    let (rids,filter) =
               List.fold_right2
                 (fun h a (ri,filter) ->
@@ -549,19 +567,18 @@ let rec check_and_clear_in_constr env evdref err ids global c =
                   (* Check if some id to clear occurs in the instance
                      a of rid in ev and remember the dependency *)
                     let check id = if Id.Set.mem id ids then raise (Depends id) in
-                    let () = Id.Set.iter check (collect_vars a) in
+                    let () = Id.Set.iter check (collect_vars !evdref (EConstr.of_constr a)) in
                   (* Check if some rid to clear in the context of ev
                      has dependencies in another hyp of the context of ev
                      and transitively remember the dependency *)
                     let check id _ =
-                      if occur_var_in_decl (Global.env ()) id h
+                      if occur_var_in_decl (Global.env ()) !evdref id h
                       then raise (Depends id)
                     in
                     let () = Id.Map.iter check ri in
                   (* No dependency at all, we can keep this ev's context hyp *)
                     (ri, true::filter)
-                  with Depends id -> let open Context.Named.Declaration in
-                                     (Id.Map.add (get_id h) id ri, false::filter))
+                  with Depends id -> (Id.Map.add (NamedDecl.get_id h) id ri, false::filter))
 		ctxt (Array.to_list l) (Id.Map.empty,[]) in
 	    (* Check if some rid to clear in the context of ev has dependencies
 	       in the type of ev and adjust the source of the dependency *)
@@ -577,33 +594,25 @@ let rec check_and_clear_in_constr env evdref err ids global c =
             else
               let origfilter = Evd.evar_filter evi in
               let filter = Evd.Filter.apply_subfilter origfilter filter in
-              let evd = Sigma.Unsafe.of_evar_map !evdref in
-              let Sigma (_, evd, _) = restrict_evar evd evk filter None in
-              let evd = Sigma.to_evar_map evd in
+              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 *)
-              whd_evar !evdref c
+              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
      hypothesis does not depend on a element of ids, and erases ids in
      the contexts of the evars occurring in evi *)
+  let terms = List.map EConstr.Unsafe.to_constr terms in
   let global = Id.Set.exists is_section_variable ids in
   let terms =
     List.map (check_and_clear_in_constr env evdref (OccurHypInSimpleClause None) ids global) terms in
   let nhyps =
-    let open Context.Named.Declaration in
     let check_context decl =
-      let err = OccurHypInSimpleClause (Some (get_id decl)) in
-      map_constr (check_and_clear_in_constr env evdref err ids global) decl
+      let err = OccurHypInSimpleClause (Some (NamedDecl.get_id decl)) in
+      NamedDecl.map_constr (check_and_clear_in_constr env evdref err ids global) decl
     in
     let check_value vk = match force_lazy_val vk with
     | None -> vk
@@ -618,7 +627,7 @@ let clear_hyps_in_evi_main env evdref hyps terms ids =
     in
       remove_hyps ids check_context check_value hyps
   in
-  (nhyps,terms)
+  (nhyps,List.map EConstr.of_constr terms)
 
 let clear_hyps_in_evi env evdref hyps concl ids =
   match clear_hyps_in_evi_main env evdref hyps [concl] ids with
@@ -642,8 +651,8 @@ let process_dependent_evar q acc evm is_dependent e =
      hypotheses), they are all dependent. *)
   queue_term q true evi.evar_concl;
   List.iter begin fun decl ->
-    let open Context.Named.Declaration in
-    queue_term q true (get_type decl);
+    let open NamedDecl in
+    queue_term q true (NamedDecl.get_type decl);
     match decl with
     | LocalAssum _ -> ()
     | LocalDef (_,b,_) -> queue_term q true b
@@ -694,11 +703,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.
@@ -707,42 +714,88 @@ let rec advance sigma evk =
 
 let undefined_evars_of_term evd t =
   let rec evrec acc c =
-    match kind_of_term c with
+    match EConstr.kind evd c with
       | Evar (n, l) ->
-	let acc = Array.fold_left evrec acc l in
-	(try match (Evd.find evd n).evar_body with
-	  | Evar_empty -> Evar.Set.add n acc
-	  | Evar_defined c -> evrec acc c
-	 with Not_found -> anomaly ~label:"undefined_evars_of_term" (Pp.str "evar not found"))
-      | _ -> fold_constr evrec acc c
+        let acc = Evar.Set.add n acc in
+	Array.fold_left evrec acc l
+      | _ -> EConstr.fold evd evrec acc c
   in
   evrec Evar.Set.empty t
 
 let undefined_evars_of_named_context evd nc =
-  let open Context.Named.Declaration in
   Context.Named.fold_outside
-    (fold (fun c s -> Evar.Set.union s (undefined_evars_of_term evd c)))
+    (NamedDecl.fold_constr (fun c s -> Evar.Set.union s (undefined_evars_of_term evd (EConstr.of_constr c))))
     nc
     ~init:Evar.Set.empty
 
 let undefined_evars_of_evar_info evd evi =
-  Evar.Set.union (undefined_evars_of_term evd evi.evar_concl)
+  Evar.Set.union (undefined_evars_of_term evd (EConstr.of_constr evi.evar_concl))
     (Evar.Set.union
        (match evi.evar_body with
 	 | Evar_empty -> Evar.Set.empty
-	 | Evar_defined b -> undefined_evars_of_term evd b)
+	 | Evar_defined b -> undefined_evars_of_term evd (EConstr.of_constr b))
        (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 rec occur_rec c = match kind_of_term c with
+  let c = EConstr.Unsafe.to_constr c in
+  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
 
@@ -750,8 +803,9 @@ let occur_evar_upto sigma n c =
    any type has type Type. May cause some trouble, but not so far... *)
 
 let judge_of_new_Type evd =
-  let Sigma (s, evd', p) = Sigma.new_univ_variable univ_rigid evd in
-  Sigma ({ uj_val = mkSort (Type s); uj_type = mkSort (Type (Univ.super s)) }, evd', p)
+  let open EConstr in
+  let (evd', s) = new_univ_variable univ_rigid evd in
+  (evd', { uj_val = mkSort (Type s); uj_type = mkSort (Type (Univ.super s)) })
 
 let subterm_source evk (loc,k) =
   let evk = match k with
@@ -759,10 +813,33 @@ let subterm_source evk (loc,k) =
     | _ -> evk in
   (loc,Evar_kinds.SubEvar evk)
 
-
-(** Term exploration up to instantiation. *)
-let kind_of_term_upto sigma t =
-  Constr.kind (whd_evar sigma t)
+(* Add equality constraints for covariant/invariant positions. For
+   irrelevant positions, unify universes when flexible. *)
+let compare_cumulative_instances cv_pb variances u u' sigma =
+  let open Universes in
+  let cstrs = Univ.Constraint.empty in
+  let soft = Constraints.empty in
+  let cstrs, soft = Array.fold_left3 (fun (cstrs, soft) v u u' ->
+      let open Univ.Variance in
+      match v with
+      | Irrelevant -> cstrs, Constraints.add (UWeak (u,u')) soft
+      | Covariant when cv_pb == Reduction.CUMUL ->
+        Univ.Constraint.add (u,Univ.Le,u') cstrs, soft
+      | Covariant | Invariant -> Univ.Constraint.add (u,Univ.Eq,u') cstrs, soft)
+      (cstrs,soft) variances (Univ.Instance.to_array u) (Univ.Instance.to_array u')
+  in
+  match Evd.add_constraints sigma cstrs with
+  | sigma ->
+    Inl (Evd.add_universe_constraints sigma soft)
+  | exception Univ.UniverseInconsistency p -> Inr p
+
+let compare_constructor_instances evd u u' =
+  let open Universes in
+  let soft =
+    Array.fold_left2 (fun cs u u' -> Constraints.add (UWeak (u,u')) cs)
+      Constraints.empty (Univ.Instance.to_array u) (Univ.Instance.to_array u')
+  in
+  Evd.add_universe_constraints evd soft
 
 (** [eq_constr_univs_test sigma1 sigma2 t u] tests equality of [t] and
     [u] up to existential variable instantiation and equalisable
@@ -784,5 +861,5 @@ let eq_constr_univs_test sigma1 sigma2 t u =
   in
   match ans with None -> false | Some _ -> true
 
-type type_constraint = types option
-type val_constraint = constr option
+type type_constraint = EConstr.types option
+type val_constraint = EConstr.constr option
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 7fdc7aac..e289ca16 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -1,15 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Evd
 open Environ
+open EConstr
 
 (** This module provides useful higher-level functions for evar manipulation. *)
 
@@ -20,23 +23,30 @@ val new_meta : unit -> metavariable
 val mk_new_meta : unit -> constr
 
 (** {6 Creating a fresh evar given their type and context} *)
+
+val new_evar_from_context :
+  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 * EConstr.t
+
 val new_evar :
-  env -> 'r Sigma.t -> ?src:Loc.t * Evar_kinds.t -> ?filter:Filter.t ->
+  env -> 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 -> (constr, 'r) Sigma.sigma
+  ?principal:bool -> types -> evar_map * EConstr.t
 
 val new_pure_evar :
-  named_context_val -> 'r Sigma.t -> ?src:Loc.t * Evar_kinds.t -> ?filter:Filter.t ->
+  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, 'r) Sigma.sigma
+  ?principal:bool -> types -> evar_map * Evar.t
 
-val new_pure_evar_full : 'r Sigma.t -> evar_info -> (evar, 'r) Sigma.sigma
+val new_pure_evar_full : evar_map -> evar_info -> evar_map * Evar.t
 
 (** the same with side-effects *)
 val e_new_evar :
-  env -> evar_map ref -> ?src:Loc.t * Evar_kinds.t -> ?filter:Filter.t ->
+  env -> evar_map ref -> ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
   ?candidates:constr list -> ?store:Store.t ->
   ?naming:Misctypes.intro_pattern_naming_expr ->
   ?principal:bool -> types -> constr
@@ -44,23 +54,23 @@ val e_new_evar :
 (** Create a new Type existential variable, as we keep track of 
     them during type-checking and unification. *)
 val new_type_evar :
-  env -> 'r Sigma.t -> ?src:Loc.t * Evar_kinds.t -> ?filter:Filter.t ->
+  env -> evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
   ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> rigid ->
-  (constr * sorts, 'r) Sigma.sigma
+  evar_map * (constr * Sorts.t)
 
 val e_new_type_evar : env -> evar_map ref ->
-  ?src:Loc.t * Evar_kinds.t -> ?filter:Filter.t ->
-  ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> rigid -> constr * sorts
+  ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
+  ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> rigid -> constr * Sorts.t
 
-val new_Type : ?rigid:rigid -> env -> 'r Sigma.t -> (constr, 'r) Sigma.sigma
+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 : 'r Sigma.t -> existential_key -> Filter.t ->
-  constr list option -> (existential_key, 'r) Sigma.sigma
+val restrict_evar : evar_map -> Evar.t -> Filter.t ->
+  ?src:Evar_kinds.t Loc.located -> constr list option -> evar_map * Evar.t
 
 (** Polymorphic constants *)
 
-val new_global : 'r Sigma.t -> Globnames.global_reference -> (constr, 'r) Sigma.sigma
+val new_global : evar_map -> Globnames.global_reference -> evar_map * constr
 val e_new_global : evar_map ref -> Globnames.global_reference -> constr
 
 (** Create a fresh evar in a context different from its definition context:
@@ -70,15 +80,15 @@ val e_new_global : evar_map ref -> Globnames.global_reference -> constr
    of [inst] are typed in the occurrence context and their type (seen
    as a telescope) is [sign] *)
 val new_evar_instance :
- named_context_val -> 'r Sigma.t -> types -> 
-  ?src:Loc.t * Evar_kinds.t -> ?filter:Filter.t -> ?candidates:constr list ->
+ named_context_val -> evar_map -> types -> 
+  ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t -> ?candidates:constr list ->
   ?store:Store.t -> ?naming:Misctypes.intro_pattern_naming_expr ->
   ?principal:bool ->
-  constr list -> (constr, 'r) Sigma.sigma
+  constr list -> evar_map * constr
 
-val make_pure_subst : evar_info -> constr array -> (Id.t * constr) list
+val make_pure_subst : evar_info -> 'a array -> (Id.t * 'a) list
 
-val safe_evar_value : evar_map -> existential -> constr option
+val safe_evar_value : evar_map -> Constr.existential -> Constr.constr option
 
 (** {6 Evars/Metas switching...} *)
 
@@ -88,7 +98,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 : 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
@@ -108,13 +118,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.
@@ -125,14 +135,20 @@ 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. *)
-val occur_evar_upto : evar_map -> Evar.t -> Constr.t -> bool
+val occur_evar_upto : evar_map -> Evar.t -> constr -> bool
 
 (** {6 Value/Type constraints} *)
 
-val judge_of_new_Type : 'r Sigma.t -> (unsafe_judgment, 'r) Sigma.sigma
+val judge_of_new_Type : evar_map -> evar_map * unsafe_judgment
 
 (***********************************************************)
 
@@ -150,7 +166,7 @@ val tj_nf_evar :
    evar_map -> unsafe_type_judgment -> unsafe_type_judgment
 
 val nf_named_context_evar : evar_map -> Context.Named.t -> Context.Named.t
-val nf_rel_context_evar : evar_map -> Context.Rel.t -> Context.Rel.t
+val nf_rel_context_evar : evar_map -> rel_context -> rel_context
 val nf_env_evar : evar_map -> env -> env
 
 val nf_evar_info : evar_map -> evar_info -> evar_info
@@ -159,46 +175,57 @@ val nf_evar_map_undefined : evar_map -> evar_map
 
 (** Presenting terms without solved evars *)
 
-val nf_evars_universes : evar_map -> constr -> constr
+val nf_evars_universes : evar_map -> Constr.constr -> Constr.constr
 
-val nf_evars_and_universes : evar_map -> evar_map * (constr -> constr)
-val e_nf_evars_and_universes : evar_map ref -> (constr -> constr) * Universes.universe_opt_subst
+val nf_evars_and_universes : evar_map -> evar_map * (Constr.constr -> Constr.constr)
+val e_nf_evars_and_universes : evar_map ref -> (Constr.constr -> Constr.constr) * Universes.universe_opt_subst
 
 (** Normalize the evar map w.r.t. universes, after simplification of constraints.
     Return the substitution function for constrs as well. *)
-val nf_evar_map_universes : evar_map -> evar_map * (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
-val flush_and_check_evars :  evar_map -> constr -> constr
+exception Uninstantiated_evar of Evar.t
+val flush_and_check_evars :  evar_map -> constr -> Constr.constr
 
 (** {6 Term manipulation up to instantiation} *)
 
 (** Like {!Constr.kind} except that [kind_of_term sigma t] exposes [t]
     as an evar [e] only if [e] is uninstantiated in [sigma]. Otherwise the
     value of [e] in [sigma] is (recursively) used. *)
-val kind_of_term_upto : evar_map -> constr -> (constr,types) kind_of_term
+val kind_of_term_upto : evar_map -> Constr.constr ->
+  (Constr.constr, Constr.types, Sorts.t, Univ.Instance.t) kind_of_term
 
 (** [eq_constr_univs_test sigma1 sigma2 t u] tests equality of [t] and
     [u] up to existential variable instantiation and equalisable
     universes. The term [t] is interpreted in [sigma1] while [u] is
     interpreted in [sigma2]. The universe constraints in [sigma2] are
     assumed to be an extention of those in [sigma1]. *)
-val eq_constr_univs_test : evar_map -> evar_map -> constr -> constr -> bool
+val eq_constr_univs_test : evar_map -> evar_map -> Constr.constr -> Constr.constr -> bool
+
+(** [compare_cumulative_instances cv_pb variance u1 u2 sigma] Returns
+   [Inl sigma'] where [sigma'] is [sigma] augmented with universe
+   constraints such that [u1 cv_pb? u2] according to [variance].
+   Additionally flexible universes in irrelevant positions are unified
+   if possible. Returns [Inr p] when the former is impossible. *)
+val compare_cumulative_instances : Reduction.conv_pb -> Univ.Variance.t array ->
+  Univ.Instance.t -> Univ.Instance.t -> evar_map ->
+  (evar_map, Univ.univ_inconsistency) Util.union
+
+(** We should only compare constructors at convertible types, so this
+   is only an opportunity to unify universes. *)
+val compare_constructor_instances : evar_map ->
+  Univ.Instance.t -> Univ.Instance.t -> evar_map
 
 (** {6 Removing hyps in evars'context}
 raise OccurHypInSimpleClause if the removal breaks dependencies *)
 
 type clear_dependency_error =
 | OccurHypInSimpleClause of Id.t option
-| EvarTypingBreak of existential
+| EvarTypingBreak of Constr.existential
 
 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
 
@@ -208,17 +235,16 @@ val clear_hyps2_in_evi : env -> evar_map ref -> named_context_val -> types -> ty
 type csubst
 
 val empty_csubst : csubst
-val csubst_subst : csubst -> Constr.t -> Constr.t
+val csubst_subst : csubst -> constr -> constr
 
 type ext_named_context =
-  csubst * (Id.t * Constr.constr) list *
-  Id.Set.t * Context.Named.t
+  csubst * Id.Set.t * named_context
 
 val push_rel_decl_to_named_context :
-  Context.Rel.Declaration.t -> ext_named_context -> ext_named_context
+  evar_map -> rel_declaration -> ext_named_context -> ext_named_context
 
-val push_rel_context_to_named_context : Environ.env -> types ->
-  named_context_val * types * constr list * csubst * (identifier*constr) list
+val push_rel_context_to_named_context : Environ.env -> evar_map -> types ->
+  named_context_val * types * constr list * csubst
 
 val generalize_evar_over_rels : evar_map -> existential -> types * constr list
 
@@ -228,12 +254,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 a6b6f742..f6e13e1f 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1,22 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
+open Sorts
 open Util
 open Names
 open Nameops
-open Term
+open Constr
 open Vars
-open Termops
 open Environ
-open Globnames
-open Context.Named.Declaration
+
+(* module RelDecl = Context.Rel.Declaration *)
+module NamedDecl = Context.Named.Declaration
 
 (** Generic filters *)
 module Filter :
@@ -124,10 +127,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)
 
@@ -149,13 +151,13 @@ let make_evar hyps ccl = {
   evar_hyps = hyps;
   evar_body = Evar_empty;
   evar_filter = Filter.identity;
-  evar_source = (Loc.ghost,Evar_kinds.InternalHole);
+  evar_source = Loc.tag @@ Evar_kinds.InternalHole;
   evar_candidates = None;
   evar_extra = Store.empty
 }
 
 let instance_mismatch () =
-  anomaly (Pp.str "Signature and its instance do not match")
+  anomaly (Pp.str "Signature and its instance do not match.")
 
 let evar_concl evi = evi.evar_concl
 
@@ -226,7 +228,7 @@ let evar_instance_array test_id info args =
     if i < len then
       let c = Array.unsafe_get args i in
       if test_id d c then instrec filter ctxt (succ i)
-      else (get_id d, c) :: instrec filter ctxt (succ i)
+      else (NamedDecl.get_id d, c) :: instrec filter ctxt (succ i)
     else instance_mismatch ()
   | _ -> instance_mismatch ()
   in
@@ -235,7 +237,7 @@ let evar_instance_array test_id info args =
      let map i d =
       if (i < len) then
         let c = Array.unsafe_get args i in
-        if test_id d c then None else Some (get_id d, c)
+        if test_id d c then None else Some (NamedDecl.get_id d, c)
       else instance_mismatch ()
     in
     List.map_filter_i map (evar_context info)
@@ -243,7 +245,7 @@ let evar_instance_array test_id info args =
     instrec filter (evar_context info) 0
 
 let make_evar_instance_array info args =
-  evar_instance_array (isVarId % get_id) info args
+  evar_instance_array (NamedDecl.get_id %> isVarId) info args
 
 let instantiate_evar_array info c args =
   let inst = make_evar_instance_array info args in
@@ -251,22 +253,8 @@ let instantiate_evar_array info c args =
   | [] -> c
   | _ -> replace_vars inst c
 
-type evar_universe_context = UState.t
-
-type 'a in_evar_universe_context = 'a * evar_universe_context
 
-let empty_evar_universe_context = UState.empty
-let is_empty_evar_universe_context = UState.is_empty
-let union_evar_universe_context = UState.union
-let evar_universe_context_set = UState.context_set
-let evar_universe_context_constraints = UState.constraints
-let evar_context_universe_context = UState.context
-let evar_universe_context_of = UState.of_context_set
-let evar_universe_context_subst = UState.subst
-let add_constraints_context = UState.add_constraints
-let add_universe_constraints_context = UState.add_universe_constraints
-let constrain_variables = UState.constrain_variables 
-let evar_universe_context_of_binders = UState.of_binders
+type 'a in_evar_universe_context = 'a * UState.t
 
 (*******************************************************************)
 (* Metamaps *)
@@ -282,9 +270,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
-      | _         -> fold_constr collrec acc c
+      | _         -> Constr.fold collrec acc c
   in
   collrec Int.Set.empty c
 
@@ -359,12 +347,10 @@ module EvMap = Evar.Map
 module EvNames :
 sig
 
-open Misctypes
-
 type t
 
 val empty : t
-val add_name_undefined : intro_pattern_naming_expr -> Evar.t -> evar_info -> t -> t
+val add_name_undefined : Id.t option -> Evar.t -> evar_info -> t -> t
 val remove_name_defined : Evar.t -> t -> t
 val rename : Evar.t -> Id.t -> t -> t
 val reassign_name_defined : Evar.t -> Evar.t -> t -> t
@@ -374,25 +360,17 @@ val key : Id.t -> t -> Evar.t
 end =
 struct
 
-type t = Id.t EvMap.t * existential_key Idmap.t
-
-let empty = (EvMap.empty, Idmap.empty)
-
-let add_name_newly_undefined naming evk evi (evtoid, idtoev as names) =
-  let id = match naming with
-  | Misctypes.IntroAnonymous -> None
-  | Misctypes.IntroIdentifier id ->
-    if Idmap.mem id idtoev then
-    user_err_loc
-      (Loc.ghost,"",str "Already an existential evar of name " ++ pr_id id);
-    Some id
-  | Misctypes.IntroFresh id ->
-    let id = Namegen.next_ident_away_from id (fun id -> Idmap.mem id idtoev) in
-    Some id
-  in
+type t = Id.t EvMap.t * Evar.t Id.Map.t
+
+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 -> (EvMap.add evk id evtoid, Idmap.add id evk idtoev)
+  | Some id ->
+    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
@@ -404,15 +382,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
@@ -420,23 +398,25 @@ 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
 
+type goal_kind = ToShelve | ToGiveUp
+
 type evar_map = {
   (** Existential variables *)
   defn_evars : evar_info EvMap.t;
   undf_evars : evar_info EvMap.t;
   evar_names : EvNames.t;
   (** Universes *)
-  universes  : evar_universe_context;
+  universes  : UState.t;
   (** Conversion problems *)
   conv_pbs   : evar_constraint list;
   last_mods  : Evar.Set.t;
@@ -454,6 +434,7 @@ type evar_map = {
                                              name) of the evar which
                                              will be instantiated with
                                              a term containing [e]. *)
+  future_goals_status : goal_kind EvMap.t;
   extras : Store.t;
 }
 
@@ -462,9 +443,9 @@ type evar_map = {
 let rename evk id evd =
   { evd with evar_names = EvNames.rename evk id evd.evar_names }
 
-let add_with_name ?(naming = Misctypes.IntroAnonymous) d e i = match i.evar_body with
+let add_with_name ?name d e i = match i.evar_body with
 | Evar_empty ->
-  let evar_names = EvNames.add_name_undefined naming e i d.evar_names in
+  let evar_names = EvNames.add_name_undefined name e i d.evar_names in
   { d with undf_evars = EvMap.add e i d.undf_evars; evar_names }
 | Evar_defined _ ->
   let evar_names = EvNames.remove_name_defined e d.evar_names in
@@ -477,13 +458,12 @@ 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 ?naming evi =
+let new_evar evd ?name evi =
   let evk = new_untyped_evar () in
-  let evd = add_with_name evd ?naming evk evi in
+  let evd = add_with_name evd ?name evk evi in
   (evd, evk)
 
 let remove d e =
@@ -494,7 +474,8 @@ let remove d e =
   | Some e' -> if Evar.equal e e' then None else d.principal_future_goal
   in
   let future_goals = List.filter (fun e' -> not (Evar.equal e e')) d.future_goals in
-  { d with undf_evars; defn_evars; principal_future_goal; future_goals }
+  let future_goals_status = EvMap.remove e d.future_goals_status in
+  { d with undf_evars; defn_evars; principal_future_goal; future_goals; future_goals_status }
 
 let find d e =
   try EvMap.find e d.undf_evars
@@ -504,15 +485,6 @@ let find_undefined d e = EvMap.find e d.undf_evars
 
 let mem d e = EvMap.mem e d.undf_evars || EvMap.mem e d.defn_evars
 
-(* spiwack: this function loses information from the original evar_map
-   it might be an idea not to export it. *)
-let to_list d =
-  (* Workaround for change in Map.fold behavior in ocaml 3.08.4 *)
-  let l = ref [] in
-  EvMap.iter (fun evk x -> l := (evk,x)::!l) d.defn_evars;
-  EvMap.iter (fun evk x -> l := (evk,x)::!l) d.undf_evars;
-  !l
-
 let undefined_map d = d.undf_evars
 
 let drop_all_defined d = { d with defn_evars = EvMap.empty }
@@ -573,14 +545,14 @@ let existential_type d (n, args) =
   let info =
     try find d n
     with Not_found ->
-      anomaly (str "Evar " ++ str (string_of_existential n) ++ str " was not declared") in
+      anomaly (str "Evar " ++ str (string_of_existential n) ++ str " was not declared.") in
   instantiate_evar_array info info.evar_concl args
 
 let add_constraints d c =
-  { d with universes = add_constraints_context d.universes c }
+  { d with universes = UState.add_constraints d.universes c }
 
 let add_universe_constraints d c = 
-  { d with universes = add_universe_constraints_context d.universes c }
+  { d with universes = UState.add_universe_constraints d.universes c }
 
 (*** /Lifting... ***)
 
@@ -605,7 +577,7 @@ let create_evar_defs sigma = { sigma with
 let empty = {
   defn_evars = EvMap.empty;
   undf_evars = EvMap.empty;
-  universes  = empty_evar_universe_context;
+  universes  = UState.empty;
   conv_pbs   = [];
   last_mods  = Evar.Set.empty;
   metas      = Metamap.empty;
@@ -613,6 +585,7 @@ let empty = {
   evar_names = EvNames.empty; (* id<->key for undefined evars *)
   future_goals = [];
   principal_future_goal = None;
+  future_goals_status = EvMap.empty;
   extras = Store.empty;
 }
 
@@ -628,14 +601,14 @@ let evars_reset_evd ?(with_conv_pbs=false) ?(with_univs=true) evd d =
   let last_mods = if with_conv_pbs then evd.last_mods else d.last_mods in
   let universes = 
     if not with_univs then evd.universes
-    else union_evar_universe_context evd.universes d.universes
+    else UState.union evd.universes d.universes
   in
   { evd with
     metas = d.metas;
     last_mods; conv_pbs; universes }
 
 let merge_universe_context evd uctx' =
-  { evd with universes = union_evar_universe_context evd.universes uctx' }
+  { evd with universes = UState.union evd.universes uctx' }
 
 let set_universe_context evd uctx' =
   { evd with universes = uctx' }
@@ -650,17 +623,22 @@ 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 ->
       if EvMap.mem evk def then
-        anomaly ~label:"Evd.define" (Pp.str "cannot define an evar twice")
+        anomaly ~label:"Evd.define" (Pp.str "cannot define an evar twice.")
       else
-        anomaly ~label:"Evd.define" (Pp.str "cannot define undeclared evar")
+        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 *)
@@ -673,20 +651,26 @@ 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 restrict evk filter ?candidates evd =
+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
   let evar_info' =
     { evar_info with evar_filter = filter;
       evar_candidates = candidates;
-      evar_extra = Store.empty } in
+      evar_source = (match src with None -> evar_info.evar_source | Some src -> src) } in
+  let last_mods = match evd.conv_pbs with
+  | [] ->  evd.last_mods
+  | _ -> Evar.Set.add evk evd.last_mods in
   let evar_names = EvNames.reassign_name_defined evk evk' evd.evar_names in
   let ctxt = Filter.filter_list filter (evar_context evar_info) in
-  let id_inst = Array.map_of_list (mkVar % get_id) ctxt in
+  let id_inst = Array.map_of_list (NamedDecl.get_id %> mkVar) ctxt in
   let body = mkEvar(evk',id_inst) in
-  let (defn_evars, undf_evars) = define_aux evd.defn_evars evd.undf_evars evk body in
+  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; evar_names }, evk'
+    defn_evars; last_mods; evar_names }, evk'
 
 let downcast evk ccl evd =
   let evar_info = EvMap.find evk evd.undf_evars in
@@ -716,39 +700,31 @@ 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)
-  | _ -> Loc.ghost
+  | _             -> None
 
 (** The following functions return the set of evars immediately
     contained in the object *)
 
 (* excluding defined evars *)
 
-let evar_list c =
-  let rec evrec acc c =
-    match kind_of_term c with
-    | Evar (evk, _ as ev) -> ev :: acc
-    | _ -> fold_constr evrec acc c in
-  evrec [] c
-
 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)
-    | _ -> fold_constr evrec acc c
+    | _ -> Constr.fold evrec acc c
   in
   evrec Evar.Set.empty c
 
 let evars_of_named_context nc =
-  List.fold_right (fun decl s ->
-    Option.fold_left (fun s t ->
-      Evar.Set.union s (evars_of_term t))
-      (Evar.Set.union s (evars_of_term (get_type decl))) (get_value decl))
-    nc Evar.Set.empty
+  Context.Named.fold_outside
+    (NamedDecl.fold_constr (fun constr s -> Evar.Set.union s (evars_of_term constr)))
+    nc
+    ~init:Evar.Set.empty
 
 let evars_of_filtered_evar_info evi =
   Evar.Set.union (evars_of_term evi.evar_concl)
@@ -773,8 +749,12 @@ let evar_universe_context d = d.universes
 
 let universe_context_set d = UState.context_set d.universes
 
-let pr_uctx_level = UState.pr_uctx_level
-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 }
@@ -806,18 +786,9 @@ let new_sort_variable ?loc ?name rigid d =
 let add_global_univ d u =
   { d with universes = UState.add_global_univ d.universes u }
 
-let make_flexible_variable evd b u =
-  { evd with universes = UState.make_flexible_variable evd.universes b u }
-
-let make_evar_universe_context e l =
-  let uctx = UState.make (Environ.universes e) in
-  match l with
-  | 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))
-        uctx us
+let make_flexible_variable evd ~algebraic u =
+  { evd with universes =
+      UState.make_flexible_variable evd.universes ~algebraic u }
 
 (****************************************)
 (* Operations on constants              *)
@@ -868,7 +839,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 =
@@ -886,15 +857,10 @@ let set_eq_sort env d s1 s2 =
   | Some (u1, u2) ->
     if not (type_in_type env) then
       add_universe_constraints d
-        (Universes.Constraints.singleton (u1,Universes.UEq,u2))
+        (Universes.Constraints.singleton (Universes.UEq (u1,u2)))
     else
       d
 
-let has_lub evd u1 u2 =
-  if Univ.Universe.equal u1 u2 then evd
-  else add_universe_constraints evd
-    (Universes.Constraints.singleton (u1,Universes.ULub,u2))
-
 let set_eq_level d u1 u2 =
   add_constraints d (Univ.enforce_eq_level u1 u2 Univ.Constraint.empty)
 
@@ -912,7 +878,7 @@ let set_leq_sort env evd s1 s2 =
   | None -> evd
   | Some (u1, u2) ->
      if not (type_in_type env) then
-       add_universe_constraints evd (Universes.Constraints.singleton (u1,Universes.ULe,u2))
+       add_universe_constraints evd (Universes.Constraints.singleton (Universes.ULe (u1,u2)))
      else evd
 	    
 let check_eq evd s s' =
@@ -921,10 +887,6 @@ let check_eq evd s s' =
 let check_leq evd s s' =
   UGraph.check_leq (UState.ugraph evd.universes) s s'
 
-let normalize_evar_universe_context_variables = UState.normalize_variables
-
-let abstract_undefined_variables = UState.abstract_undefined_variables
-
 let fix_undefined_variables evd =
   { evd with universes = UState.fix_undefined_variables evd.universes }
 
@@ -933,59 +895,27 @@ let refresh_undefined_universes evd =
   let evd' = cmap (subst_univs_level_constr subst) {evd with universes = uctx'} in
     evd', subst
 
-let normalize_evar_universe_context = UState.normalize
-
-let nf_univ_variables evd = 
-  let subst, uctx' = normalize_evar_universe_context_variables evd.universes in
+let nf_univ_variables evd =
+  let subst, uctx' = UState.normalize_variables evd.universes in
   let evd' = {evd with universes = uctx'} in
     evd', subst
 
-let nf_constraints evd =
-  let subst, uctx' = normalize_evar_universe_context_variables evd.universes in
-  let uctx' = normalize_evar_universe_context uctx' in
+let minimize_universes evd =
+  let subst, uctx' = UState.normalize_variables evd.universes in
+  let uctx' = UState.minimize uctx' in
     {evd with universes = uctx'}
 
 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
 
 let update_sigma_env evd env =
   { evd with universes = UState.update_sigma_env evd.universes env }
 
-(* Conversion w.r.t. an evar map and its local universes. *)
-
-let test_conversion_gen env evd pb t u =
-  match pb with 
-  | Reduction.CONV -> 
-    Reduction.conv env
-      ~evars:((existential_opt_value evd), (UState.ugraph evd.universes))
-      t u
-  | Reduction.CUMUL -> Reduction.conv_leq env
-      ~evars:((existential_opt_value evd), (UState.ugraph evd.universes))
-      t u
-
-let test_conversion env d pb t u =
-  try test_conversion_gen env d pb t u; true
-  with _ -> false
-
 exception UniversesDiffer = UState.UniversesDiffer
 
-let eq_constr_univs evd t u =
-  let fold cstr sigma =
-    try Some (add_universe_constraints sigma cstr)
-    with Univ.UniverseInconsistency _ | UniversesDiffer -> None
-  in
-  match Universes.eq_constr_univs_infer (UState.ugraph evd.universes) fold t u evd with
-  | None -> evd, false
-  | Some evd -> evd, true
-
-let e_eq_constr_univs evdref t u =
-  let evd, b = eq_constr_univs !evdref t u in
-    evdref := evd; b
-
 (**********************************************************)
 (* Side effects *)
 
@@ -999,25 +929,72 @@ let drop_side_effects evd =
 let eval_side_effects evd = evd.effects
 
 (* Future goals *)
-let declare_future_goal evk evd =
-  { evd with future_goals = evk::evd.future_goals }
+let declare_future_goal ?tag evk evd =
+  { evd with future_goals = evk::evd.future_goals;
+             future_goals_status = Option.fold_right (EvMap.add evk) tag evd.future_goals_status }
 
-let declare_principal_goal evk evd =
+let declare_principal_goal ?tag evk evd =
   match evd.principal_future_goal with
   | None -> { evd with
     future_goals = evk::evd.future_goals;
-    principal_future_goal=Some evk; }
-  | Some _ -> CErrors.error "Only one main subgoal per instantiation."
+    principal_future_goal=Some evk;
+    future_goals_status = Option.fold_right (EvMap.add evk) tag evd.future_goals_status;
+    }
+  | Some _ -> CErrors.user_err Pp.(str "Only one main subgoal per instantiation.")
+
+type future_goals = Evar.t list * Evar.t option * goal_kind EvMap.t
 
 let future_goals evd = evd.future_goals
 
 let principal_future_goal evd = evd.principal_future_goal
 
-let reset_future_goals evd =
-  { evd with future_goals = [] ; principal_future_goal=None }
+let save_future_goals evd =
+  (evd.future_goals, evd.principal_future_goal, evd.future_goals_status)
 
-let restore_future_goals evd gls pgl =
-  { evd with future_goals = gls ; principal_future_goal = pgl }
+let reset_future_goals evd =
+  { evd with future_goals = [] ; principal_future_goal = None;
+             future_goals_status = EvMap.empty }
+
+let restore_future_goals evd (gls,pgl,map) =
+  { evd with future_goals = gls ; principal_future_goal = pgl;
+             future_goals_status = map }
+
+let fold_future_goals f sigma (gls,pgl,map) =
+  List.fold_left f sigma gls
+
+let map_filter_future_goals f (gls,pgl,map) =
+  (* Note: map is now a superset of filtered evs, but its size should
+    not be too big, so that's probably ok not to update it *)
+  (List.map_filter f gls,Option.bind pgl f,map)
+
+let filter_future_goals f (gls,pgl,map) =
+  (List.filter f gls,Option.bind pgl (fun a -> if f a then Some a else None),map)
+
+let dispatch_future_goals_gen distinguish_shelf (gls,pgl,map) =
+  let rec aux (comb,shelf,givenup as acc) = function
+    | [] -> acc
+    | evk :: gls ->
+       let acc =
+        try match EvMap.find evk map with
+        | ToGiveUp -> (comb,shelf,evk::givenup)
+        | ToShelve ->
+           if distinguish_shelf then (comb,evk::shelf,givenup)
+           else raise Not_found
+        with Not_found -> (evk::comb,shelf,givenup) in
+       aux acc gls in
+  (* Note: this reverses the order of initial list on purpose *)
+  let (comb,shelf,givenup) = aux ([],[],[]) gls in
+  (comb,shelf,givenup,pgl)
+
+let dispatch_future_goals =
+  dispatch_future_goals_gen true
+
+let extract_given_up_future_goals goals =
+  let (comb,_,givenup,_) = dispatch_future_goals_gen false goals in
+  (comb,givenup)
+
+let shelve_on_future_goals shelved (gls,pgl,map) =
+  (shelved @ gls, pgl, List.fold_right (fun evk -> EvMap.add evk ToShelve) shelved map)
 
 (**********************************************************)
 (* Accessing metas *)
@@ -1034,6 +1011,7 @@ let set_metas evd metas = {
   effects = evd.effects;
   evar_names = evd.evar_names;
   future_goals = evd.future_goals;
+  future_goals_status = evd.future_goals_status;
   principal_future_goal = evd.principal_future_goal;
   extras = evd.extras;
 }
@@ -1076,7 +1054,7 @@ let try_meta_fvalue evd mv =
 
 let meta_fvalue evd mv =
   try try_meta_fvalue evd mv
-  with Not_found -> anomaly ~label:"meta_fvalue" (Pp.str "meta has no value")
+  with Not_found -> anomaly ~label:"meta_fvalue" (Pp.str "meta has no value.")
 
 let meta_value evd mv =
   (fst (try_meta_fvalue evd mv)).rebus
@@ -1095,7 +1073,7 @@ let meta_declare mv v ?(name=Anonymous) evd =
 let meta_assign mv (v, pb) evd =
   let modify _ = function
   | Cltyp (na, ty) -> Clval (na, (mk_freelisted v, pb), ty)
-  | _ -> anomaly ~label:"meta_assign" (Pp.str "already defined")
+  | _ -> anomaly ~label:"meta_assign" (Pp.str "already defined.")
   in
   let metas = Metamap.modify mv modify evd.metas in
   set_metas evd metas
@@ -1103,7 +1081,7 @@ let meta_assign mv (v, pb) evd =
 let meta_reassign mv (v, pb) evd =
   let modify _ = function
   | Clval(na, _, ty) -> Clval (na, (mk_freelisted v, pb), ty)
-  | _ -> anomaly ~label:"meta_reassign" (Pp.str "not yet defined")
+  | _ -> anomaly ~label:"meta_reassign" (Pp.str "not yet defined.")
   in
   let metas = Metamap.modify mv modify evd.metas in
   set_metas evd metas
@@ -1117,7 +1095,7 @@ let clear_metas evd = {evd with metas = Metamap.empty}
 let meta_merge ?(with_univs = true) evd1 evd2 =
   let metas = Metamap.fold Metamap.add evd1.metas evd2.metas in
   let universes =
-    if with_univs then union_evar_universe_context evd2.universes evd1.universes
+    if with_univs then UState.union evd2.universes evd1.universes
     else evd2.universes
   in
   {evd2 with universes; metas; }
@@ -1137,14 +1115,14 @@ let retract_coercible_metas evd =
 
 let evar_source_of_meta mv evd =
   match meta_name evd mv with
-  | Anonymous -> (Loc.ghost,Evar_kinds.GoalEvar)
-  | Name id -> (Loc.ghost,Evar_kinds.VarInstance id)
+  | Anonymous -> Loc.tag Evar_kinds.GoalEvar
+  | Name id   -> Loc.tag @@ Evar_kinds.VarInstance id
 
 let dependent_evar_ident ev evd =
   let evi = find evd ev in
   match evi.evar_source with
   | (_,Evar_kinds.VarInstance id) -> id
-  | _ -> anomaly (str "Not an evar resulting of a dependent binding")
+  | _ -> anomaly (str "Not an evar resulting of a dependent binding.")
 
 (**********************************************************)
 (* Extra data *)
@@ -1154,10 +1132,6 @@ let set_extra_data extras evd = { evd with extras }
 
 (*******************************************************************)
 
-type pending = (* before: *) evar_map * (* after: *) evar_map
-
-type pending_constr = pending * constr
-
 type open_constr = evar_map * constr
 
 (*******************************************************************)
@@ -1222,279 +1196,24 @@ module Monad =
 
 type unsolvability_explanation = SeveralInstancesFound of int
 
-(**********************************************************)
-(* Pretty-printing *)
-
-let pr_evar_suggested_name evk sigma =
-  let base_id evk' evi =
-  match evar_ident evk' sigma with
-  | Some id -> id
-  | None -> match evi.evar_source with
-  | _,Evar_kinds.ImplicitArg (c,(n,Some id),b) -> id
-  | _,Evar_kinds.VarInstance id -> id
-  | _,Evar_kinds.GoalEvar -> Id.of_string "Goal"
-  | _ ->
-      let env = reset_with_named_context evi.evar_hyps (Global.env()) in
-      Namegen.id_of_name_using_hdchar env evi.evar_concl Anonymous
-  in
-  let names = EvMap.mapi base_id sigma.undf_evars in
-  let id = EvMap.find evk names in
-  let fold evk' id' (seen, n) =
-    if seen then (seen, n)
-    else if Evar.equal evk evk' then (true, n)
-    else if Id.equal id id' then (seen, succ n)
-    else (seen, n)
-  in
-  let (_, n) = EvMap.fold fold names (false, 0) in
-  if n = 0 then id else Nameops.add_suffix id (string_of_int (pred n))
-
-let pr_existential_key sigma evk = match evar_ident evk sigma with
-| None ->
-  str "?" ++ pr_id (pr_evar_suggested_name evk sigma)
-| Some id ->
-  str "?" ++ pr_id id
-
-let pr_instance_status (sc,typ) =
-  begin match sc with
-  | IsSubType -> str " [or a subtype of it]"
-  | IsSuperType -> str " [or a supertype of it]"
-  | Conv -> mt ()
-  end ++
-  begin match typ with
-  | CoerceToType -> str " [up to coercion]"
-  | TypeNotProcessed -> mt ()
-  | TypeProcessed -> str " [type is checked]"
-  end
-
-let protect f x =
-  try f x
-  with e -> str "EXCEPTION: " ++ str (Printexc.to_string e)
-
-let print_constr a = protect print_constr a
-
-let pr_meta_map mmap =
-  let pr_name = function
-      Name id -> str"[" ++ pr_id id ++ str"]"
-    | _ -> mt() in
-  let pr_meta_binding = function
-    | (mv,Cltyp (na,b)) ->
-      	hov 0
-	  (pr_meta mv ++ pr_name na ++ str " : " ++
-           print_constr b.rebus ++ fnl ())
-    | (mv,Clval(na,(b,s),t)) ->
-      	hov 0
-	  (pr_meta mv ++ pr_name na ++ str " := " ++
-           print_constr b.rebus ++
-	   str " : " ++ print_constr t.rebus ++
-	   spc () ++ pr_instance_status s ++ fnl ())
-  in
-  prlist pr_meta_binding (metamap_to_list mmap)
-
-let pr_decl (decl,ok) =
-  let id = get_id decl in
-  match get_value decl with
-  | None -> if ok then pr_id id else (str "{" ++ pr_id id ++ str "}")
-  | Some c -> str (if ok then "(" else "{") ++ pr_id id ++ str ":=" ++
-      print_constr c ++ str (if ok then ")" else "}")
-
-let pr_evar_source = function
-  | 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 Anonymous -> str "type of anonymous binder"
-  | Evar_kinds.ImplicitArg (c,(n,ido),b) ->
-      let id = Option.get ido in
-      str "parameter " ++ pr_id id ++ spc () ++ str "of" ++
-      spc () ++ print_constr (printable_constr_of_global c)
-  | Evar_kinds.InternalHole -> str "internal placeholder"
-  | Evar_kinds.TomatchTypeParameter (ind,n) ->
-      pr_nth n ++ str " argument of type " ++ print_constr (mkInd ind)
-  | 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.SubEvar evk ->
-      str "subterm of " ++ str (string_of_existential evk)
-
-let pr_evar_info evi =
-  let phyps =
-    try
-      let decls = match Filter.repr (evar_filter evi) with
-      | None -> List.map (fun c -> (c, true)) (evar_context evi)
-      | Some filter -> List.combine (evar_context evi) filter
-      in
-      prlist_with_sep spc pr_decl (List.rev decls)
-    with Invalid_argument _ -> str "Ill-formed filtered context" in
-  let pty = print_constr evi.evar_concl in
-  let pb =
-    match evi.evar_body with
-      | Evar_empty -> mt ()
-      | Evar_defined c -> spc() ++ str"=> "  ++ print_constr c
-  in
-  let candidates =
-    match evi.evar_body, evi.evar_candidates with
-      | Evar_empty, Some l ->
-           spc () ++ str "{" ++
-           prlist_with_sep (fun () -> str "|") print_constr l ++ str "}"
-      | _ ->
-          mt ()
-  in
-  let src = str "(" ++ pr_evar_source (snd evi.evar_source) ++ str ")" in
-  hov 2
-    (str"["  ++ phyps ++ spc () ++ str"|- "  ++ pty ++ pb ++ str"]" ++
-       candidates ++ spc() ++ src)
-
-let compute_evar_dependency_graph (sigma : evar_map) =
-  (* Compute the map binding ev to the evars whose body depends on ev *)
-  let fold evk evi acc =
-    let fold_ev evk' acc =
-      let tab =
-        try EvMap.find evk' acc
-        with Not_found -> Evar.Set.empty
-      in
-      EvMap.add evk' (Evar.Set.add evk tab) acc
-    in
-    match evar_body evi with
-    | Evar_empty -> assert false
-    | Evar_defined c -> Evar.Set.fold fold_ev (evars_of_term c) acc
-  in
-  EvMap.fold fold sigma.defn_evars EvMap.empty
-
-let evar_dependency_closure n sigma =
-  (** Create the DAG of depth [n] representing the recursive dependencies of
-      undefined evars. *)
-  let graph = compute_evar_dependency_graph sigma in
-  let rec aux n curr accu =
-    if Int.equal n 0 then Evar.Set.union curr accu
-    else
-      let fold evk accu =
-        try
-          let deps = EvMap.find evk graph in
-          Evar.Set.union deps accu
-        with Not_found -> accu
-      in
-      (** Consider only the newly added evars *)
-      let ncurr = Evar.Set.fold fold curr Evar.Set.empty in
-      (** Merge the others *)
-      let accu = Evar.Set.union curr accu in
-      aux (n - 1) ncurr accu
-  in
-  let undef = EvMap.domain (undefined_map sigma) in
-  aux n undef Evar.Set.empty
-
-let evar_dependency_closure n sigma =
-  let deps = evar_dependency_closure n sigma in
-  let map = EvMap.bind (fun ev -> find sigma ev) deps in
-  EvMap.bindings map
-
-let has_no_evar sigma =
-  EvMap.is_empty sigma.defn_evars && EvMap.is_empty sigma.undf_evars
-
-let pr_evd_level evd = pr_uctx_level evd.universes
-
-let pr_evar_universe_context ctx =
-  let prl = pr_uctx_level ctx in
-  if is_empty_evar_universe_context ctx then mt ()
-  else
-    (str"UNIVERSES:"++brk(0,1)++ 
-       h 0 (Univ.pr_universe_context_set prl (evar_universe_context_set ctx)) ++ fnl () ++
-     str"ALGEBRAIC UNIVERSES:"++brk(0,1)++
-     h 0 (Univ.LSet.pr prl (UState.algebraics ctx)) ++ fnl() ++
-     str"UNDEFINED UNIVERSES:"++brk(0,1)++
-       h 0 (Universes.pr_universe_opt_subst (UState.subst ctx)) ++ fnl())
-
-let print_env_short env =
-  let pr_body n = function
-  | None -> pr_name n
-  | Some b -> str "(" ++ pr_name n ++ str " := " ++ print_constr b ++ str ")" in
-  let pr_named_decl decl = pr_body (Name (get_id decl)) (get_value decl) in
-  let pr_rel_decl decl = let open Context.Rel.Declaration in
-                         pr_body (get_name decl) (get_value decl) in
-  let nc = List.rev (named_context env) in
-  let rc = List.rev (rel_context env) in
-    str "[" ++ pr_sequence pr_named_decl nc ++ str "]" ++ spc () ++
-    str "[" ++ pr_sequence pr_rel_decl rc ++ str "]"
-
-let pr_evar_constraints pbs =
-  let pr_evconstr (pbty, env, t1, t2) =
-    let env =
-      (** We currently allow evar instances to refer to anonymous de
-          Bruijn indices, so we protect the error printing code in this
-          case by giving names to every de Bruijn variable in the
-          rel_context of the conversion problem. MS: we should rather
-          stop depending on anonymous variables, they can be used to
-          indicate independency. Also, this depends on a strategy for
-          naming/renaming. *)
-      Namegen.make_all_name_different env
-    in
-    print_env_short env ++ spc () ++ str "|-" ++ spc () ++
-      print_constr_env env t1 ++ spc () ++
-      str (match pbty with
-            | Reduction.CONV -> "=="
-            | Reduction.CUMUL -> "<=") ++
-      spc () ++ print_constr_env env t2
-  in
-  prlist_with_sep fnl pr_evconstr pbs
-
-let pr_evar_map_gen with_univs pr_evars sigma =
-  let { universes = uvs } = sigma in
-  let evs = if has_no_evar sigma then mt () else pr_evars sigma ++ fnl ()
-  and svs = if with_univs then pr_evar_universe_context uvs else mt ()
-  and cstrs =
-    if List.is_empty sigma.conv_pbs then mt ()
-    else
-    str "CONSTRAINTS:" ++ brk (0, 1) ++
-      pr_evar_constraints sigma.conv_pbs ++ fnl ()
-  and metas =
-    if Metamap.is_empty sigma.metas then mt ()
-    else
-      str "METAS:" ++ brk (0, 1) ++ pr_meta_map sigma.metas
-  in
-  evs ++ svs ++ cstrs ++ metas
-
-let pr_evar_list sigma l =
-  let pr (ev, evi) =
-    h 0 (str (string_of_existential ev) ++
-      str "==" ++ pr_evar_info evi ++
-      (if evi.evar_body == Evar_empty
-       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 *)
-  str"EVARS:"++brk(0,1)++pr_evar_list sigma (to_list sigma)++fnl()
-| Some n ->
-  (* Print all 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()
-
-let pr_evar_by_filter filter sigma =
-  let defined = Evar.Map.filter filter sigma.defn_evars in
-  let undefined = Evar.Map.filter filter sigma.undf_evars in
-  let prdef =
-    if Evar.Map.is_empty defined then mt ()
-    else str "DEFINED EVARS:" ++ brk (0, 1) ++
-      pr_evar_list sigma (Evar.Map.bindings defined)
-  in
-  let prundef =
-    if Evar.Map.is_empty undefined then mt ()
-    else str "UNDEFINED EVARS:" ++ brk (0, 1) ++
-      pr_evar_list sigma (Evar.Map.bindings undefined)
-  in
-  prdef ++ prundef
-
-let pr_evar_map ?(with_univs=true) depth sigma =
-  pr_evar_map_gen with_univs (fun sigma -> pr_evar_by_depth depth sigma) sigma
-
-let pr_evar_map_filter ?(with_univs=true) filter sigma =
-  pr_evar_map_gen with_univs (fun sigma -> pr_evar_by_filter filter sigma) sigma
-
-let pr_metaset metas =
-  str "[" ++ pr_sequence pr_meta (Metaset.elements metas) ++ str "]"
+(** Deprecated *)
+type evar_universe_context = UState.t
+let empty_evar_universe_context = UState.empty
+let union_evar_universe_context = UState.union
+let evar_universe_context_set = UState.context_set
+let evar_universe_context_constraints = UState.constraints
+let evar_context_universe_context = UState.context
+let evar_universe_context_of = UState.of_context_set
+let evar_universe_context_subst = UState.subst
+let add_constraints_context = UState.add_constraints
+let constrain_variables = UState.constrain_variables
+let evar_universe_context_of_binders = UState.of_binders
+let make_evar_universe_context e l =
+  let g = Environ.universes e in
+  match l with
+  | None -> UState.make g
+  | Some l -> UState.make_with_initial_binders g l
+let normalize_evar_universe_context_variables = UState.normalize_variables
+let abstract_undefined_variables = UState.abstract_undefined_variables
+let normalize_evar_universe_context = UState.minimize
+let nf_constraints = minimize_universes
diff --git a/engine/evd.mli b/engine/evd.mli
index 86887f3d..911799c4 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 +30,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 +128,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 +142,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 +153,44 @@ val has_undefined : evar_map -> bool
     there are uninstantiated evars in [sigma]. *)
 
 val new_evar : evar_map ->
-  ?naming:Misctypes.intro_pattern_naming_expr -> 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 +201,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 +243,31 @@ val evars_reset_evd  : ?with_conv_pbs:bool -> ?with_univs:bool ->
 
 (** {6 Misc} *)
 
-val restrict : evar -> Filter.t -> ?candidates:constr list ->
-  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} *)
 
@@ -275,11 +282,13 @@ val drop_side_effects : evar_map -> evar_map
 
 (** {5 Future goals} *)
 
-val declare_future_goal : Evar.t -> evar_map -> evar_map
+type goal_kind = ToShelve | ToGiveUp
+
+val declare_future_goal : ?tag:goal_kind -> Evar.t -> evar_map -> evar_map
 (** Adds an existential variable to the list of future goals. For
     internal uses only. *)
 
-val declare_principal_goal : Evar.t -> evar_map -> evar_map
+val declare_principal_goal : ?tag:goal_kind -> Evar.t -> evar_map -> evar_map
 (** Adds an existential variable to the list of future goals and make
     it principal. Only one existential variable can be made principal, an
     error is raised otherwise. For internal uses only. *)
@@ -292,16 +301,41 @@ val principal_future_goal : evar_map -> Evar.t option
 (** Retrieves the name of the principal existential variable if there
     is one. Used by the [refine] primitive of the tactic engine. *)
 
+type future_goals
+
+val save_future_goals : evar_map -> future_goals
+(** Retrieves the list of future goals including the principal future
+    goal. Used by the [refine] primitive of the tactic engine. *)
+
 val reset_future_goals : evar_map -> evar_map
 (** Clears the list of future goals (as well as the principal future
     goal). Used by the [refine] primitive of the tactic engine. *)
 
-val restore_future_goals : evar_map -> Evar.t list -> Evar.t option -> evar_map
+val restore_future_goals : evar_map -> future_goals -> evar_map
 (** Sets the future goals (including the principal future goal) to a
     previous value. Intended to be used after a local list of future
     goals has been consumed. Used by the [refine] primitive of the
     tactic engine. *)
 
+val fold_future_goals : (evar_map -> Evar.t -> evar_map) -> evar_map -> future_goals -> evar_map
+(** Fold future goals *)
+
+val map_filter_future_goals : (Evar.t -> Evar.t option) -> future_goals -> future_goals
+(** Applies a function on the future goals *)
+
+val filter_future_goals : (Evar.t -> bool) -> future_goals -> future_goals
+(** Applies a filter on the future goals *)
+
+val dispatch_future_goals : future_goals -> Evar.t list * Evar.t list * Evar.t list * Evar.t option
+(** Returns the future_goals dispatched into regular, shelved, given_up
+   goals; last argument is the goal tagged as principal if any *)
+
+val extract_given_up_future_goals : future_goals -> Evar.t list * Evar.t list
+(** An ad hoc variant for Proof.proof; not for general use *)
+
+val shelve_on_future_goals : Evar.t list -> future_goals -> future_goals
+(** Push goals on the shelve of future goals *)
+
 (** {5 Sort variables}
 
     Evar maps also keep track of the universe constraints defined at a given
@@ -311,10 +345,10 @@ 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
+    @raise UniversesDiffer in case a first-order unification fails.
+    @raise UniverseInconsistency .
 *)
 
 (** {5 Extra data}
@@ -414,16 +448,12 @@ val extract_changed_conv_pbs : evar_map ->
       (Evar.Set.t -> evar_constraint -> bool) ->
       evar_map * evar_constraint list
 val extract_all_conv_pbs : evar_map -> evar_map * evar_constraint list
-val loc_of_conv_pb : evar_map -> evar_constraint -> Loc.t
+val loc_of_conv_pb : evar_map -> evar_constraint -> Loc.t option
 
 (** The following functions return the set of evars immediately
     contained in the object; need the term to be evar-normal otherwise
     defined evars are returned too. *)
 
-val evar_list : constr -> existential list
-  (** excluding evars in instances of evars and collected with
-     redundancies from right to left (used by tactic "instantiate") *)
-
 val evars_of_term : constr -> Evar.Set.t
   (** including evars in instances of evars *)
 
@@ -487,124 +517,134 @@ 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
+[@@ocaml.deprecated "Alias of UState.context_set"]
+val evar_universe_context_constraints : UState.t -> Univ.Constraint.t
+[@@ocaml.deprecated "Alias of UState.constraints"]
+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
+[@@ocaml.deprecated "Alias of UState.of_context_set"]
+val empty_evar_universe_context : UState.t
+[@@ocaml.deprecated "Alias of UState.empty"]
+val union_evar_universe_context : UState.t -> UState.t ->
+  UState.t
+[@@ocaml.deprecated "Alias of UState.union"]
+val evar_universe_context_subst : UState.t -> Universes.universe_opt_subst
+[@@ocaml.deprecated "Alias of UState.subst"]
+val constrain_variables : Univ.LSet.t -> UState.t -> UState.t
+[@@ocaml.deprecated "Alias of UState.constrain_variables"]
 
 
 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
+[@@ocaml.deprecated "Alias of UState.of_binders"]
+
+val make_evar_universe_context : env -> Misctypes.lident list option -> UState.t
+[@@ocaml.deprecated "Use UState.make or UState.make_with_initial_binders"]
+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
+[@@ocaml.deprecated "Alias of UState.add_constraints"]
 
 
-val normalize_evar_universe_context_variables : evar_universe_context -> 
+val normalize_evar_universe_context_variables : UState.t -> 
   Univ.universe_subst in_evar_universe_context
+[@@ocaml.deprecated "Alias of UState.normalize_variables"]
 
-val normalize_evar_universe_context : evar_universe_context -> 
-  evar_universe_context
+val normalize_evar_universe_context : UState.t -> UState.t
+[@@ocaml.deprecated "Alias of UState.minimize"]
 
-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 -> bool -> Univ.universe_level -> evar_map
-val is_sort_variable : evar_map -> sorts -> Univ.universe_level option 
+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.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 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
+
+(** NB: [ind_univ_entry] cannot create cumulative entries. *)
+val ind_univ_entry : poly:bool -> evar_map -> Entries.inductive_universes
+
+val check_univ_decl : poly:bool -> evar_map -> UState.universe_decl -> 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
+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.universe_context_set -> 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
+[@@ocaml.deprecated "Alias of UState.abstract_undefined_variables"]
 
 val fix_undefined_variables : evar_map -> evar_map
 
 val refresh_undefined_universes : evar_map -> evar_map * Univ.universe_level_subst
 
+(** Universe minimization *)
+val minimize_universes : evar_map -> evar_map
 val nf_constraints : evar_map -> evar_map
+[@@ocaml.deprecated "Alias of Evd.minimize_universes"]
 
 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
 
 val fresh_global : ?loc:Loc.t -> ?rigid:rigid -> ?names:Univ.Instance.t -> env ->
   evar_map -> Globnames.global_reference -> evar_map * constr
 
-(********************************************************************
-  Conversion w.r.t. an evar map, not unifying universes. See 
-  [Reductionops.infer_conv] for conversion up-to universes. *)
-
-val test_conversion : env -> evar_map -> conv_pb -> constr -> constr -> bool
-(** WARNING: This does not allow unification of universes *)
-
-val eq_constr_univs : evar_map -> constr -> constr -> evar_map * bool
-(** Syntactic equality up to universes, recording the associated constraints *)
-
-val e_eq_constr_univs : evar_map ref -> constr -> constr -> bool
-(** Syntactic equality up to universes. *)
-
 (********************************************************************)
 (* constr with holes and pending resolution of classes, conversion  *)
 (* problems, candidates, etc.                                       *)
 
-type pending = (* before: *) evar_map * (* after: *) evar_map
-
-type pending_constr = pending * constr
-
 type open_constr = evar_map * constr (* Special case when before is empty *)
 
 (** Partially constructed constrs. *)
@@ -612,26 +652,16 @@ type open_constr = evar_map * constr (* Special case when before is empty *)
 type unsolvability_explanation = SeveralInstancesFound of int
 (** Failure explanation. *)
 
-val pr_existential_key : evar_map -> evar -> Pp.std_ppcmds
-
-val pr_evar_suggested_name : existential_key -> evar_map -> Id.t
-
-(** {5 Debug pretty-printers} *)
+(** {5 Summary names} *)
 
-val pr_evar_info : evar_info -> Pp.std_ppcmds
-val pr_evar_constraints : evar_constraint list -> Pp.std_ppcmds
-val pr_evar_map : ?with_univs:bool -> int option -> evar_map -> Pp.std_ppcmds
-val pr_evar_map_filter : ?with_univs:bool -> (Evar.t -> evar_info -> bool) ->
-  evar_map -> Pp.std_ppcmds
-val pr_metaset : Metaset.t -> Pp.std_ppcmds
-val pr_evar_universe_context : evar_universe_context -> Pp.std_ppcmds
-val pr_evd_level : evar_map -> Univ.Level.t -> Pp.std_ppcmds
+(* 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.ml b/engine/ftactic.ml
index aeaaea7e..e23a03c0 100644
--- a/engine/ftactic.ml
+++ b/engine/ftactic.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Proofview.Notations
@@ -53,31 +55,17 @@ let bind (type a) (type b) (m : a t) (f : a -> b t) : b t = m >>= function
   Proofview.tclUNIT (Depends filtered)
 
 let goals = Proofview.Goal.goals >>= fun l -> Proofview.tclUNIT (Depends l)
-let set_sigma r =
-  let Sigma.Sigma (ans, sigma, _) = r in
-  Proofview.Unsafe.tclEVARS (Sigma.to_evar_map sigma) >>= fun () -> ans
 
 let nf_enter f =
   bind goals
     (fun gl ->
       gl >>= fun gl ->
       Proofview.Goal.normalize gl >>= fun nfgl ->
-      Proofview.V82.wrap_exceptions (fun () -> f.enter nfgl))
-
-let nf_s_enter f =
-  bind goals
-    (fun gl ->
-      gl >>= fun gl ->
-      Proofview.Goal.normalize gl >>= fun nfgl ->
-      Proofview.V82.wrap_exceptions (fun () -> set_sigma (f.s_enter nfgl)))
+      Proofview.V82.wrap_exceptions (fun () -> f nfgl))
 
 let enter f =
   bind goals
-    (fun gl -> gl >>= fun gl -> Proofview.V82.wrap_exceptions (fun () -> f.enter gl))
-
-let s_enter f =
-  bind goals
-    (fun gl -> gl >>= fun gl -> Proofview.V82.wrap_exceptions (fun () -> set_sigma (f.s_enter gl)))
+    (fun gl -> gl >>= fun gl -> Proofview.V82.wrap_exceptions (fun () -> f gl))
 
 let with_env t =
   t >>= function
diff --git a/engine/ftactic.mli b/engine/ftactic.mli
index 5db37319..6c389b2d 100644
--- a/engine/ftactic.mli
+++ b/engine/ftactic.mli
@@ -1,13 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Proofview.Notations
-
 (** This module defines potentially focussing tactics. They are used by Ltac to
     emulate the historical behaviour of always-focussed tactics while still
     allowing to remain global when the goal is not needed. *)
@@ -41,20 +41,13 @@ val run : 'a t -> ('a -> unit Proofview.tactic) -> unit Proofview.tactic
 
 (** {5 Focussing} *)
 
-val nf_enter : ([ `NF ], 'a t) enter -> 'a t
+val nf_enter : (Proofview.Goal.t -> 'a t) -> 'a t
 (** Enter a goal. The resulting tactic is focussed. *)
 
-val enter : ([ `LZ ], 'a t) enter -> 'a t
+val enter : (Proofview.Goal.t -> 'a t) -> 'a t
 (** Enter a goal, without evar normalization. The resulting tactic is
     focussed. *)
 
-val s_enter : ([ `LZ ], 'a t) s_enter -> 'a t
-(** Enter a goal and put back an evarmap. The resulting tactic is focussed. *)
-
-val nf_s_enter : ([ `NF ], 'a t) s_enter -> 'a t
-(** Enter a goal, without evar normalization and put back an evarmap. The
-    resulting tactic is focussed. *)
-
 val with_env : 'a t -> (Environ.env*'a) t
 (** [with_env t] returns, in addition to the return type of [t], an
     environment, which is the global environment if [t] does not focus on
diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 17ff898b..4afa817b 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines the low-level monadic operations used by the
@@ -34,7 +36,7 @@ exception Timeout
 exception TacticFailure of exn
 
 let _ = CErrors.register_handler begin function
-  | Timeout -> CErrors.errorlabstrm "Some timeout function" (Pp.str"Timeout!")
+  | Timeout -> CErrors.user_err ~hdr:"Some timeout function" (Pp.str"Timeout!")
   | Exception e -> CErrors.print e
   | TacticFailure e -> CErrors.print e
   | _ -> Pervasives.raise CErrors.Unhandled
@@ -95,7 +97,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 +109,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 dd122cca..545334ce 100644
--- a/engine/logic_monad.mli
+++ b/engine/logic_monad.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file implements the low-level monadic operations used by the
@@ -57,11 +59,10 @@ module NonLogical : sig
   val print_char : char -> unit t
 
   (** Loggers. The buffer is also flushed. *)
-  val print_debug : Pp.std_ppcmds -> unit t
-  val print_warning : Pp.std_ppcmds -> unit t
-  val print_notice : Pp.std_ppcmds -> unit t
-  val print_info : Pp.std_ppcmds -> unit t
-  val print_error : Pp.std_ppcmds -> 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
 
   (** [Pervasives.raise]. Except that exceptions are wrapped with
       {!Exception}. *)
diff --git a/engine/namegen.ml b/engine/namegen.ml
index 84eb9868..d66b77b5 100644
--- a/engine/namegen.ml
+++ b/engine/namegen.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created from contents that was formerly in termops.ml and
@@ -15,15 +17,17 @@
 open Util
 open Names
 open Term
+open Environ
+open EConstr
 open Vars
 open Nametab
 open Nameops
 open Libnames
 open Globnames
-open Environ
-open Termops
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (**********************************************************************)
 (* Conventional names *)
 
@@ -41,6 +45,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 *)
 
@@ -57,9 +63,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
@@ -76,16 +82,27 @@ let is_constructor id =
   with Not_found ->
     false
 
+let is_section_variable id =
+  try let _ = Global.lookup_named id in true
+  with Not_found -> false
+
 (**********************************************************************)
 (* Generating "intuitive" names from its type *)
 
-let head_name c = (* Find the head constant of a constr if any *)
+let global_of_constr = function
+| Const (c, _) -> ConstRef c
+| Ind (i, _) -> IndRef i
+| Construct (c, _) -> ConstructRef c
+| Var id -> VarRef id
+| _ -> assert false
+
+let head_name sigma c = (* Find the head constant of a constr if any *)
   let rec hdrec c =
-    match kind_of_term c with
+    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)))
-    | Const _ | Ind _ | Construct _ | Var _ ->
+    | 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,_,_)) ->
 	Some (match lna.(i) with Name id -> id | _ -> assert false)
@@ -94,29 +111,39 @@ let head_name 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"
   | Type(_) -> "T"
 
-let hdchar env c =
+let hdchar env sigma c =
   let rec hdrec k c =
-    match kind_of_term c with
+    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 s
+    | Sort s -> sort_hdchar (ESorts.kind sigma s)
     | Rel n ->
 	(if n<=k then "p" (* the initial term is flexible product/function *)
 	 else
-	   try match Environ.lookup_rel (n-k) env |> to_tuple with
-	     | (Name id,_,_)   -> lowercase_first_char id
-	     | (Anonymous,_,t) -> hdrec 0 (lift (n-k) t)
+	   try match lookup_rel (n-k) env with
+	     | LocalAssum (Name id,_)   | LocalDef (Name id,_,_) -> lowercase_first_char id
+	     | LocalAssum (Anonymous,t) | LocalDef (Anonymous,_,t) -> hdrec 0 (lift (n-k) t)
 	   with Not_found -> "y")
     | Fix ((_,i),(lna,_,_)) | CoFix (i,(lna,_,_)) ->
 	let id = match lna.(i) with Name id -> id | _ -> assert false in
@@ -126,49 +153,85 @@ let hdchar env c =
   in
   hdrec 0 c
 
-let id_of_name_using_hdchar env a = function
-  | Anonymous -> Id.of_string (hdchar env a)
+let id_of_name_using_hdchar env sigma a = function
+  | Anonymous -> Id.of_string (hdchar env sigma a)
   | Name id   -> id
 
-let named_hd env a = function
-  | Anonymous -> Name (Id.of_string (hdchar env a))
+let named_hd env sigma a = function
+  | Anonymous -> Name (Id.of_string (hdchar env sigma a))
   | x         -> x
 
-let mkProd_name   env (n,a,b) = mkProd (named_hd env a n, a, b)
-let mkLambda_name env (n,a,b) = mkLambda (named_hd env a n, a, b)
+let mkProd_name   env sigma (n,a,b) = mkProd (named_hd env sigma a n, a, b)
+let mkLambda_name env sigma (n,a,b) = mkLambda (named_hd env sigma a n, a, b)
 
 let lambda_name = mkLambda_name
 let prod_name = mkProd_name
 
-let prod_create   env (a,b) = mkProd (named_hd env a Anonymous, a, b)
-let lambda_create env (a,b) =  mkLambda (named_hd env a Anonymous, a, b)
+let prod_create   env sigma (a,b) = mkProd (named_hd env sigma a Anonymous, a, b)
+let lambda_create env sigma (a,b) =  mkLambda (named_hd env sigma a Anonymous, a, b)
 
-let name_assumption env = function
-    | LocalAssum (na,t) -> LocalAssum (named_hd env t na, t)
-    | LocalDef (na,c,t) -> LocalDef (named_hd env c na, c, t)
+let name_assumption env sigma = function
+    | LocalAssum (na,t) -> LocalAssum (named_hd env sigma t na, t)
+    | LocalDef (na,c,t) -> LocalDef (named_hd env sigma c na, c, t)
 
-let name_context env hyps =
+let name_context env sigma hyps =
   snd
     (List.fold_left
        (fun (env,hyps) d ->
-	  let d' = name_assumption env d in (push_rel d' env, d' :: hyps))
+	  let d' = name_assumption env sigma d in (push_rel d' env, d' :: hyps))
        (env,[]) (List.rev hyps))
 
-let mkProd_or_LetIn_name env b d = mkProd_or_LetIn (name_assumption env d) b
-let mkLambda_or_LetIn_name env b d = mkLambda_or_LetIn (name_assumption env d)b
+let mkProd_or_LetIn_name env sigma b d = mkProd_or_LetIn (name_assumption env sigma d) b
+let mkLambda_or_LetIn_name env sigma b d = mkLambda_or_LetIn (name_assumption env sigma d) b
 
-let it_mkProd_or_LetIn_name env b hyps =
-  it_mkProd_or_LetIn b (name_context env hyps)
-let it_mkLambda_or_LetIn_name env b hyps =
-  it_mkLambda_or_LetIn b (name_context env hyps)
+let it_mkProd_or_LetIn_name env sigma b hyps =
+  it_mkProd_or_LetIn b (name_context env sigma hyps)
+let it_mkLambda_or_LetIn_name env sigma b hyps =
+  it_mkLambda_or_LetIn b (name_context env sigma hyps)
 
 (**********************************************************************)
 (* Fresh names *)
 
+(* Introduce a mode where auto-generated names are mangled
+   to test dependence of scripts on auto-generated names *)
+
+let mangle_names = ref false
+
+let _ = Goptions.(
+    declare_bool_option
+      { optdepr  = false;
+        optname  = "mangle auto-generated names";
+        optkey   = ["Mangle";"Names"];
+        optread  = (fun () -> !mangle_names);
+        optwrite = (:=) mangle_names; })
+
+let mangle_names_prefix = ref (Id.of_string "_0")
+let set_prefix x = mangle_names_prefix := forget_subscript x
+
+let set_mangle_names_mode x = begin
+    set_prefix x;
+    mangle_names := true
+  end
+
+let _ = Goptions.(
+    declare_string_option
+      { optdepr  = false;
+        optname  = "mangled names prefix";
+        optkey   = ["Mangle";"Names";"Prefix"];
+        optread  = (fun () -> Id.to_string !mangle_names_prefix);
+        optwrite = begin fun x ->
+                   set_prefix
+                     (try Id.of_string x
+                      with CErrors.UserError _ -> CErrors.user_err Pp.(str ("Not a valid identifier: \"" ^ x ^ "\".")))
+                   end })
+
+let mangle_id id = if !mangle_names then !mangle_names_prefix else id
+
 (* Looks for next "good" name by lifting subscript *)
 
 let next_ident_away_from id bad =
-  let rec name_rec id = if bad id then name_rec (lift_subscript id) else id in
+  let id = mangle_id id in
+  let rec name_rec id = if bad id then name_rec (increment_subscript id) else id in
   name_rec id
 
 (* Restart subscript from x0 if name starts with xN, or x00 if name
@@ -180,14 +243,10 @@ let restart_subscript id =
      *** make_ident id (Some 0) *** but compatibility would be lost... *)
     forget_subscript id
 
-let rec to_avoid id = function
-| [] -> false
-| id' :: avoid -> Id.equal id id' || to_avoid id avoid
-
-let visible_ids (nenv, c) =
+let visible_ids sigma (nenv, c) =
   let accu = ref (Refset_env.empty, Int.Set.empty, Id.Set.empty) in
-  let rec visible_ids n c = match kind_of_term c with
-  | Const _ | Ind _ | Construct _ | Var _ ->
+  let rec visible_ids n c = match EConstr.kind sigma c with
+  | Const _ | Ind _ | Construct _ | Var _ as c ->
     let (gseen, vseen, ids) = !accu in
     let g = global_of_constr c in
     if not (Refset_env.mem g gseen) then
@@ -205,8 +264,8 @@ let visible_ids (nenv, c) =
     if p > n && not (Int.Set.mem p vseen) then
       let vseen = Int.Set.add p vseen in
       let name =
-        try Some (lookup_name_of_rel (p - n) nenv)
-        with Not_found ->
+        try Some (List.nth nenv (p - n - 1))
+        with Invalid_argument _ | Failure _ ->
           (* Unbound index: may happen in debug and actually also
              while computing temporary implicit arguments of an
              inductive type *)
@@ -217,7 +276,7 @@ let visible_ids (nenv, c) =
       | _ -> ids
       in
       accu := (gseen, vseen, ids)
-  | _ -> Constr.iter_with_binders succ visible_ids n c
+  | _ -> EConstr.iter_with_binders sigma succ visible_ids n c
   in
   let () = visible_ids 1 c in
   let (_, _, ids) = !accu in
@@ -227,11 +286,11 @@ let visible_ids (nenv, c) =
 
 (* 1- Looks for a fresh name for printing in cases pattern *)
 
-let next_name_away_in_cases_pattern env_t na avoid =
+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 env_t in
-  let bad id = to_avoid id avoid || is_constructor id
-                                 || Id.Set.mem id visible in
+  let visible = visible_ids sigma env_t in
+  let bad id = Id.Set.mem id avoid || is_constructor id
+                                    || Id.Set.mem id visible in
   next_ident_away_from id bad
 
 (* 2- Looks for a fresh name for introduction in goal *)
@@ -244,8 +303,8 @@ let next_name_away_in_cases_pattern env_t na avoid =
      name is taken by finding a free subscript starting from 0 *)
 
 let next_ident_away_in_goal id avoid =
-  let id = if to_avoid id avoid then restart_subscript id else id in
-  let bad id = to_avoid id avoid || (is_global id && not (is_section_variable id)) in
+  let id = if Id.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 =
@@ -262,16 +321,17 @@ let next_name_away_in_goal na avoid =
    beyond the current subscript *)
 
 let next_global_ident_away id avoid =
-  let id = if to_avoid id avoid then restart_subscript id else id in
-  let bad id = to_avoid id avoid || is_global id in
+  let id = if Id.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 to_avoid id avoid then
-    next_ident_away_from (restart_subscript id) (fun id -> to_avoid id avoid)
+  let id = mangle_id id in
+  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 =
@@ -291,28 +351,31 @@ let next_name_away_with_default_using_types default na avoid t =
 
 let next_name_away = next_name_away_with_default default_non_dependent_string
 
-let make_all_name_different env =
-  let avoid = ref (ids_of_named_context (named_context env)) in
-  process_rel_context
+let make_all_name_different env sigma =
+  (** FIXME: this is inefficient, but only used in printing *)
+  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
+  Context.Rel.fold_outside
     (fun decl newenv ->
-       let (na,_,t) = to_tuple decl in
-       let na = named_hd newenv t na in
+       let na = named_hd newenv sigma (RelDecl.get_type decl) (RelDecl.get_name decl) in
        let id = next_name_away na !avoid in
-       avoid := id::!avoid;
-       push_rel (set_name (Name id) decl) newenv)
-    env
+       avoid := Id.Set.add id !avoid;
+       push_rel (RelDecl.set_name (Name id) decl) newenv)
+    rels ~init:env0
 
 (* 5- Looks for next fresh name outside a list; avoids also to use names that
    would clash with short name of global references; if name is already used,
    looks for name of same base with lower available subscript beyond current
    subscript *)
 
-let next_ident_away_for_default_printing env_t id avoid =
-  let visible = visible_ids env_t in
-  let bad id = to_avoid id avoid || Id.Set.mem id visible in
+let next_ident_away_for_default_printing sigma env_t id avoid =
+  let visible = visible_ids sigma env_t 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 env_t na avoid =
+let next_name_away_for_default_printing sigma env_t na avoid =
   let id = match na with
   | Name id   -> id
   | Anonymous ->
@@ -320,7 +383,7 @@ let next_name_away_for_default_printing env_t na avoid =
       (* taken into account by the function compute_displayed_name_in; *)
       (* just in case, invent a valid name *)
       default_non_dependent_ident in
-  next_ident_away_for_default_printing env_t id avoid
+  next_ident_away_for_default_printing sigma env_t id avoid
 
 (**********************************************************************)
 (* Displaying terms avoiding bound variables clashes *)
@@ -345,70 +408,55 @@ type renaming_flags =
   | RenamingForGoal
   | RenamingElsewhereFor of (Name.t list * constr)
 
-let next_name_for_display flags =
+let next_name_for_display sigma flags =
   match flags with
-  | RenamingForCasesPattern env_t -> next_name_away_in_cases_pattern env_t
+  | RenamingForCasesPattern env_t -> next_name_away_in_cases_pattern sigma env_t
   | RenamingForGoal -> next_name_away_in_goal
-  | RenamingElsewhereFor env_t -> next_name_away_for_default_printing env_t
+  | 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 flags avoid na c =
+let compute_displayed_name_in_gen_poly noccurn_fun sigma flags avoid na c =
   match na with
-  | Anonymous when noccurn 1 c ->
+  | Anonymous when noccurn_fun sigma 1 c ->
     (Anonymous,avoid)
   | _ ->
-    let fresh_id = next_name_for_display flags na avoid in
-    let idopt = if noccurn 1 c then Anonymous else Name fresh_id in
-    (idopt, fresh_id::avoid)
+    let fresh_id = next_name_for_display sigma flags na avoid in
+    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_and_force_displayed_name_in flags avoid na c =
+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
-  | Anonymous when noccurn 1 c ->
+  | Anonymous when noccurn sigma 1 c ->
     (Anonymous,avoid)
   | _ ->
-    let fresh_id = next_name_for_display flags na avoid in
-    (Name fresh_id, fresh_id::avoid)
+    let fresh_id = next_name_for_display sigma flags na avoid in
+    (Name fresh_id, Id.Set.add fresh_id avoid)
 
-let compute_displayed_let_name_in flags avoid na c =
-  let fresh_id = next_name_for_display flags na avoid in
-  (Name fresh_id, 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, Id.Set.add fresh_id avoid)
 
-let rename_bound_vars_as_displayed avoid env c =
+let rename_bound_vars_as_displayed sigma avoid env c =
   let rec rename avoid env c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Prod (na,c1,c2)  ->
 	let na',avoid' =
-          compute_displayed_name_in
+          compute_displayed_name_in sigma
             (RenamingElsewhereFor (env,c2)) avoid na c2 in
-	mkProd (na', c1, rename avoid' (add_name na' env) c2)
+	mkProd (na', c1, rename avoid' (na' :: env) c2)
     | LetIn (na,c1,t,c2) ->
 	let na',avoid' =
-          compute_displayed_let_name_in
+          compute_displayed_let_name_in sigma
             (RenamingElsewhereFor (env,c2)) avoid na c2 in
-	mkLetIn (na',c1,t, rename avoid' (add_name na' env) c2)
+	mkLetIn (na',c1,t, rename avoid' (na' :: env) c2)
     | Cast (c,k,t) -> mkCast (rename avoid env c, k,t)
     | _ -> c
   in
   rename avoid env c
-
-(**********************************************************************)
-(* "H"-based naming strategy introduced June 2014 for hypotheses in
-   Prop produced by case/elim/destruct/induction, in place of the
-   strategy that was using the first letter of the type, leading to
-   inelegant "n:~A", "e:t=u", etc. when eliminating sumbool or similar
-   types *)
-
-let h_based_elimination_names = ref false
-
-let use_h_based_elimination_names () =
-  !h_based_elimination_names && Flags.version_strictly_greater Flags.V8_4
-
-open Goptions
-
-let _ = declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
-	    optname  = "use of \"H\"-based proposition names in elimination tactics";
-	    optkey   = ["Standard";"Proposition";"Elimination";"Names"];
-	    optread  = (fun () -> !h_based_elimination_names);
-	    optwrite = (:=) h_based_elimination_names }
diff --git a/engine/namegen.mli b/engine/namegen.mli
index 97c7c34a..1b70ef68 100644
--- a/engine/namegen.mli
+++ b/engine/namegen.mli
@@ -1,16 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file features facilities to generate fresh names. *)
 
 open Names
-open Term
 open Environ
+open Evd
+open EConstr
 
 (*********************************************************************
    Conventional default names *)
@@ -25,28 +28,28 @@ 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 hdchar : env -> types -> string
-val id_of_name_using_hdchar : env -> types -> Name.t -> Id.t
-val named_hd : env -> types -> Name.t -> Name.t
-val head_name : types -> Id.t option
+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
+val head_name : evar_map -> types -> Id.t option
 
-val mkProd_name : env -> Name.t * types * types -> types
-val mkLambda_name : env -> Name.t * types * constr -> constr
+val mkProd_name : env -> evar_map -> Name.t * types * types -> types
+val mkLambda_name : env -> evar_map -> Name.t * types * constr -> constr
 
 (** Deprecated synonyms of [mkProd_name] and [mkLambda_name] *)
-val prod_name : env -> Name.t * types * types -> types
-val lambda_name : env -> Name.t * types * constr -> constr
+val prod_name : env -> evar_map -> Name.t * types * types -> types
+val lambda_name : env -> evar_map -> Name.t * types * constr -> constr
 
-val prod_create : env -> types * types -> constr
-val lambda_create : env -> types * constr -> constr
-val name_assumption : env -> Context.Rel.Declaration.t -> Context.Rel.Declaration.t
-val name_context : env -> Context.Rel.t -> Context.Rel.t
+val prod_create : env -> evar_map -> types * types -> constr
+val lambda_create : env -> evar_map -> types * constr -> constr
+val name_assumption : env -> evar_map -> rel_declaration -> rel_declaration
+val name_context : env -> evar_map -> rel_context -> rel_context
 
-val mkProd_or_LetIn_name : env -> types -> Context.Rel.Declaration.t -> types
-val mkLambda_or_LetIn_name : env -> constr -> Context.Rel.Declaration.t -> constr
-val it_mkProd_or_LetIn_name   : env -> types -> Context.Rel.t -> types
-val it_mkLambda_or_LetIn_name : env -> constr -> Context.Rel.t -> constr
+val mkProd_or_LetIn_name : env -> evar_map -> types -> rel_declaration -> types
+val mkLambda_or_LetIn_name : env -> evar_map -> constr -> rel_declaration -> constr
+val it_mkProd_or_LetIn_name   : env -> evar_map -> types -> rel_context -> types
+val it_mkLambda_or_LetIn_name : env -> evar_map -> constr -> rel_context -> constr
 
 (*********************************************************************
    Fresh names *)
@@ -54,24 +57,38 @@ val it_mkLambda_or_LetIn_name : env -> constr -> Context.Rel.t -> constr
 (** Avoid clashing with a name satisfying some predicate *)
 val next_ident_away_from : Id.t -> (Id.t -> bool) -> Id.t
 
-(** Avoid clashing with a name of the given list *)
-val next_ident_away : Id.t -> Id.t list -> Id.t
+(** [next_ident_away original_id unwanted_ids] returns a new identifier as close as possible
+    to the [original_id] while avoiding all [unwanted_ids].
+
+    In particular:
+    {ul {- if [original_id] does not appear in the list of [unwanted_ids], then [original_id] is returned.}
+        {- if [original_id] appears in the list of [unwanted_ids],
+           then this function returns a new id that:
+           {ul {- has the same {i root} as the [original_id],}
+               {- does not occur in the list of [unwanted_ids],}
+               {- has the smallest possible {i subscript}.}}}}
+
+    where by {i subscript} of some identifier we mean last part of it that is composed
+    only from (decimal) digits and by {i root} of some identifier we mean
+    the whole identifier except for the {i subscript}.
+
+    E.g. if we take [foo42], then [42] is the {i subscript}, and [foo] is the root. *)
+val next_ident_away : Id.t -> Id.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
 
@@ -83,18 +100,22 @@ type renaming_flags =
   | RenamingForGoal (** avoid all globals (as in intro) *)
   | RenamingElsewhereFor of (Name.t list * constr)
 
-val make_all_name_different : env -> env
+val make_all_name_different : env -> evar_map -> env
 
 val compute_displayed_name_in :
-  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 :
-  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 :
-  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 :
-  Id.t list -> Name.t list -> types -> types
+  evar_map -> Id.Set.t -> Name.t list -> types -> types
 
-(**********************************************************************)
-(* Naming strategy for arguments in Prop when eliminating inductive 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
 
-val use_h_based_elimination_names : unit -> bool
+val set_mangle_names_mode : Id.t -> unit
+(** Turn on mangled names mode and with the given prefix.
+    @raise UserError if the argument is invalid as an identifier. *)
diff --git a/engine/nameops.ml b/engine/nameops.ml
new file mode 100644
index 00000000..53969caf
--- /dev/null
+++ b/engine/nameops.ml
@@ -0,0 +1,218 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Util
+open Names
+
+(* Identifiers *)
+
+let pr_id id = Id.print id
+
+(* Utilities *)
+
+let code_of_0 = Char.code '0'
+let code_of_9 = Char.code '9'
+
+let cut_ident skip_quote s =
+  let s = Id.to_string s in
+  let slen = String.length s in
+  (* [n'] is the position of the first non nullary digit *)
+  let rec numpart n n' =
+    if Int.equal n 0 then
+      (* ident made of _ and digits only [and ' if skip_quote]: don't cut it *)
+      slen
+    else
+      let c = Char.code (String.get s (n-1)) in
+      if Int.equal c code_of_0 && not (Int.equal n slen) then
+	numpart (n-1) n'
+      else if code_of_0 <= c && c <= code_of_9 then
+	numpart (n-1) (n-1)
+      else if skip_quote && (Int.equal c (Char.code '\'') || Int.equal c (Char.code '_')) then
+	numpart (n-1) (n-1)
+      else
+	n'
+  in
+  numpart slen slen
+
+let repr_ident s =
+  let numstart = cut_ident false s in
+  let s = Id.to_string s in
+  let slen = String.length s in
+  if Int.equal numstart slen then
+    (s, None)
+  else
+    (String.sub s 0 numstart,
+     Some (int_of_string (String.sub s numstart (slen - numstart))))
+
+let make_ident sa = function
+  | Some n ->
+      let c = Char.code (String.get sa (String.length sa -1)) in
+      let s =
+        if c < code_of_0 || c > code_of_9 then sa ^ (string_of_int n)
+        else sa ^ "_" ^ (string_of_int n) in
+      Id.of_string s
+  | None -> Id.of_string sa
+
+let root_of_id id =
+  let suffixstart = cut_ident true id in
+  Id.of_string (String.sub (Id.to_string id) 0 suffixstart)
+
+(* Return the same identifier as the original one but whose {i subscript} is incremented.
+   If the original identifier does not have a suffix, [0] is appended to it.
+
+   Example mappings:
+
+   [bar]   ↦ [bar0]
+   [bar0]  ↦ [bar1]
+   [bar00] ↦ [bar01]
+   [bar1]  ↦ [bar2]
+   [bar01] ↦ [bar01]
+   [bar9]  ↦ [bar10]
+   [bar09] ↦ [bar10]
+   [bar99] ↦ [bar100]
+*)
+let increment_subscript id =
+  let id = Id.to_string id in
+  let len = String.length id in
+  let rec add carrypos =
+    let c = id.[carrypos] in
+    if is_digit c then
+      if Int.equal (Char.code c) (Char.code '9') then begin
+	assert (carrypos>0);
+	add (carrypos-1)
+      end
+      else begin
+	let newid = Bytes.of_string id in
+	Bytes.fill newid (carrypos+1) (len-1-carrypos) '0';
+	Bytes.set newid carrypos (Char.chr (Char.code c + 1));
+	newid
+      end
+    else begin
+      let newid = Bytes.of_string (id^"0") in
+      if carrypos < len-1 then begin
+	Bytes.fill newid (carrypos+1) (len-1-carrypos) '0';
+	Bytes.set newid (carrypos+1) '1'
+      end;
+      newid
+    end
+  in Id.of_bytes (add (len-1))
+
+let has_subscript id =
+  let id = Id.to_string id in
+  is_digit (id.[String.length id - 1])
+
+let forget_subscript id =
+  let numstart = cut_ident false id in
+  let newid = Bytes.make (numstart+1) '0' in
+  String.blit (Id.to_string id) 0 newid 0 numstart;
+  (Id.of_bytes newid)
+
+let add_suffix id s = Id.of_string (Id.to_string id ^ s)
+let add_prefix s id = Id.of_string (s ^ Id.to_string id)
+
+let atompart_of_id id = fst (repr_ident id)
+
+(* Names *)
+
+module type ExtName =
+sig
+
+  include module type of struct include Names.Name end
+
+  exception IsAnonymous
+
+  val fold_left : ('a -> Id.t -> 'a) -> 'a -> t -> 'a
+  val fold_right : (Id.t -> 'a -> 'a) -> t -> 'a -> 'a
+  val iter : (Id.t -> unit) -> t -> unit
+  val map : (Id.t -> Id.t) -> t -> t
+  val fold_left_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> t -> 'a * t
+  val fold_right_map : (Id.t -> 'a -> Id.t * 'a) -> Name.t -> 'a -> Name.t * 'a
+  val get_id : t -> Id.t
+  val pick : t -> t -> t
+  val cons : t -> Id.t list -> Id.t list
+  val to_option : Name.t -> Id.t option
+
+end
+
+module Name : ExtName =
+struct
+
+  include Names.Name
+
+  exception IsAnonymous
+
+  let fold_left f a = function
+    | Name id -> f a id
+    | Anonymous -> a
+
+  let fold_right f na a =
+    match na with
+    | Name id -> f id a
+    | Anonymous -> a
+
+  let iter f na = fold_right (fun x () -> f x) na ()
+
+  let map f = function
+    | Name id -> Name (f id)
+    | Anonymous -> Anonymous
+
+  let fold_left_map f a = function
+    | Name id -> let (a, id) = f a id in (a, Name id)
+    | Anonymous -> a, Anonymous
+
+  let fold_right_map f na a = match na with
+    | Name id -> let (id, a) = f id a in (Name id, a)
+    | Anonymous -> Anonymous, a
+
+  let get_id = function
+    | Name id -> id
+    | Anonymous -> raise IsAnonymous
+
+  let pick na1 na2 =
+    match na1 with
+    | Name _ -> na1
+    | Anonymous -> na2
+
+  let cons na l =
+    match na with
+    | Anonymous -> l
+    | Name id -> id::l
+
+  let to_option = function
+    | Anonymous -> None
+    | Name id -> Some id
+
+end
+
+open Name
+
+(* Compatibility *)
+let out_name = get_id
+let name_fold = fold_right
+let name_iter = iter
+let name_app = map
+let name_fold_map = fold_left_map
+let name_cons = cons
+let name_max = pick
+let pr_name = print
+
+let pr_lab l = Label.print l
+
+(* 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/engine/nameops.mli b/engine/nameops.mli
new file mode 100644
index 00000000..96842dfb
--- /dev/null
+++ b/engine/nameops.mli
@@ -0,0 +1,140 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+
+(** Identifiers and names *)
+
+val make_ident : string -> int option -> Id.t
+val repr_ident : Id.t -> string * int option
+
+val atompart_of_id : Id.t -> string  (** remove trailing digits *)
+val root_of_id : Id.t -> Id.t (** remove trailing digits, ' and _ *)
+
+val add_suffix : Id.t -> string -> Id.t
+val add_prefix : string -> Id.t -> Id.t
+
+(** Below, by {i subscript} we mean a suffix composed solely from (decimal) digits. *)
+
+val has_subscript       : Id.t -> bool
+
+val increment_subscript : Id.t -> Id.t
+(** Return the same identifier as the original one but whose {i subscript} is incremented.
+    If the original identifier does not have a suffix, [0] is appended to it.
+
+    Example mappings:
+
+    [bar]   ↦ [bar0]
+
+    [bar0]  ↦ [bar1]
+
+    [bar00] ↦ [bar01]
+
+    [bar1]  ↦ [bar2]
+
+    [bar01] ↦ [bar01]
+
+    [bar9]  ↦ [bar10]
+
+    [bar09] ↦ [bar10]
+
+    [bar99] ↦ [bar100]
+*)
+
+val forget_subscript    : Id.t -> Id.t
+
+module Name : sig
+
+  include module type of struct include Names.Name end
+
+  exception IsAnonymous
+
+  val fold_left : ('a -> Id.t -> 'a) -> 'a -> Name.t -> 'a
+  (** [fold_left f na a] is [f id a] if [na] is [Name id], and [a] otherwise. *)
+
+  val fold_right : (Id.t -> 'a -> 'a) -> Name.t -> 'a -> 'a
+  (** [fold_right f a na] is [f a id] if [na] is [Name id], and [a] otherwise. *)
+
+  val iter : (Id.t -> unit) -> Name.t -> unit
+  (** [iter f na] does [f id] if [na] equals [Name id], nothing otherwise. *)
+
+  val map : (Id.t -> Id.t) -> Name.t -> t
+  (** [map f na] is [Anonymous] if [na] is [Anonymous] and [Name (f id)] if [na] is [Name id]. *)
+
+  val fold_left_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> Name.t -> 'a * Name.t
+  (** [fold_left_map f a na] is [a',Name id'] when [na] is [Name id] and [f a id] is [(a',id')].
+      It is [a,Anonymous] otherwise. *)
+
+  val fold_right_map : (Id.t -> 'a -> Id.t * 'a) -> Name.t -> 'a -> Name.t * 'a
+  (** [fold_right_map f na a] is [Name id',a'] when [na] is [Name id] and [f id a] is [(id',a')].
+      It is [Anonymous,a] otherwise. *)
+
+  val get_id : Name.t -> Id.t
+  (** [get_id] associates [id] to [Name id]. @raise IsAnonymous otherwise. *)
+
+  val pick : Name.t -> Name.t -> Name.t
+  (** [pick na na'] returns [Anonymous] if both names are [Anonymous].
+      Pick one of [na] or [na'] otherwise. *)
+
+  val cons : Name.t -> Id.t list -> Id.t list
+  (** [cons na l] returns [id::l] if [na] is [Name id] and [l] otherwise. *)
+
+  val to_option : Name.t -> Id.t option
+  (** [to_option Anonymous] is [None] and [to_option (Name id)] is [Some id] *)
+
+end
+
+(** Metavariables *)
+val pr_meta : Constr.metavariable -> Pp.t
+val string_of_meta : Constr.metavariable -> string
+
+val out_name : Name.t -> Id.t
+[@@ocaml.deprecated "Same as [Name.get_id]"]
+
+val name_fold : (Id.t -> 'a -> 'a) -> Name.t -> 'a -> 'a
+[@@ocaml.deprecated "Same as [Name.fold_right]"]
+
+val name_iter : (Id.t -> unit) -> Name.t -> unit
+[@@ocaml.deprecated "Same as [Name.iter]"]
+
+val name_app : (Id.t -> Id.t) -> Name.t -> Name.t
+[@@ocaml.deprecated "Same as [Name.map]"]
+
+val name_fold_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> Name.t -> 'a * Name.t
+[@@ocaml.deprecated "Same as [Name.fold_left_map]"]
+
+val name_max : Name.t -> Name.t -> Name.t
+[@@ocaml.deprecated "Same as [Name.pick]"]
+
+val name_cons : Name.t -> Id.t list -> Id.t list
+[@@ocaml.deprecated "Same as [Name.cons]"]
+
+val pr_name : Name.t -> Pp.t
+[@@ocaml.deprecated "Same as [Name.print]"]
+
+val pr_id : Id.t -> Pp.t
+[@@ocaml.deprecated "Same as [Names.Id.print]"]
+
+val pr_lab : Label.t -> Pp.t
+[@@ocaml.deprecated "Same as [Names.Label.print]"]
+
+(** Deprecated stuff to libnames *)
+val default_library : DirPath.t
+[@@ocaml.deprecated "Same as [Libnames.default_library]"]
+
+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]"]
+
+val default_root_prefix : DirPath.t
+[@@ocaml.deprecated "Same as [Libnames.default_root_prefix]"]
+
diff --git a/engine/proofview.ml b/engine/proofview.ml
index c0187976..22271dd0 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
@@ -16,13 +18,14 @@
 open Pp
 open Util
 open Proofview_monad
-open Sigma.Notations
 open Context.Named.Declaration
 
 (** Main state of tactics *)
 type proofview = Proofview_monad.proofview
 
-type entry = (Term.constr * Term.types) list
+(* The first items in pairs below are proofs (under construction).
+   The second items in the pairs below are statements that are being proved. *)
+type entry = (EConstr.constr * EConstr.types) list
 
 (** Returns a stylised view of a proofview for use by, for instance,
     ide-s. *)
@@ -32,18 +35,19 @@ type entry = (Term.constr * Term.types) list
 (* In this version: returns the list of focused goals together with
    the [evar_map] context. *)
 let proofview p =
-  p.comb , p.solution
+  List.map drop_state p.comb , p.solution
 
 let compact el ({ solution } as pv) =
-  let nf = Evarutil.nf_evar solution in
+  let nf c = Evarutil.nf_evar solution c in
+  let nf0 c = EConstr.Unsafe.to_constr (Evarutil.nf_evar solution (EConstr.of_constr c)) in
   let size = Evd.fold (fun _ _ i -> i+1) solution 0 in
   let new_el = List.map (fun (t,ty) -> nf t, nf ty) el in
   let pruned_solution = Evd.drop_all_defined solution in
   let apply_subst_einfo _ ei =
     Evd.({ ei with
-       evar_concl =  nf ei.evar_concl;
-       evar_hyps = Environ.map_named_val nf ei.evar_hyps;
-       evar_candidates = Option.map (List.map nf) ei.evar_candidates }) in
+       evar_concl =  nf0 ei.evar_concl;
+       evar_hyps = Environ.map_named_val nf0 ei.evar_hyps;
+       evar_candidates = Option.map (List.map nf0) ei.evar_candidates }) in
   let new_solution = Evd.raw_map_undefined apply_subst_einfo pruned_solution in
   let new_size = Evd.fold (fun _ _ i -> i+1) new_solution 0 in
   Feedback.msg_info (Pp.str (Printf.sprintf "Evars: %d -> %d\n" size new_size));
@@ -54,7 +58,7 @@ let compact el ({ solution } as pv) =
 
 type telescope =
   | TNil of Evd.evar_map
-  | TCons of Environ.env * Evd.evar_map * Term.types * (Evd.evar_map -> Term.constr -> telescope)
+  | TCons of Environ.env * Evd.evar_map * EConstr.types * (Evd.evar_map -> EConstr.constr -> telescope)
 
 let typeclass_resolvable = Evd.Store.field ()
 
@@ -63,18 +67,16 @@ let dependent_init =
      for type classes. *)
   let store = Evd.Store.set Evd.Store.empty typeclass_resolvable () in
   (* Goals don't have a source location. *)
-  let src = (Loc.ghost,Evar_kinds.GoalEvar) in
+  let src = Loc.tag @@ Evar_kinds.GoalEvar in
   (* Main routine *)
   let rec aux = function
   | TNil sigma -> [], { solution = sigma; comb = []; shelf = [] }
   | TCons (env, sigma, typ, t) ->
-    let sigma = Sigma.Unsafe.of_evar_map sigma in
-    let Sigma (econstr, sigma, _) = Evarutil.new_evar env sigma ~src ~store typ in
-    let sigma = Sigma.to_evar_map sigma in
+    let (sigma, econstr) = Evarutil.new_evar env sigma ~src ~store typ in
+    let (gl, _) = EConstr.destEvar sigma econstr in
     let ret, { solution = sol; comb = comb } = aux (t sigma econstr) in
-    let (gl, _) = Term.destEvar econstr in
     let entry = (econstr, typ) :: ret in
-    entry, { solution = sol; comb = gl :: comb; shelf = [] }
+    entry, { solution = sol; comb = with_empty_state gl :: comb; shelf = [] }
   in
   fun t ->
     let entry, v = aux t in
@@ -110,7 +112,7 @@ let partial_proof entry pv = CList.map (return_constr pv) (CList.map fst entry)
 (* First component is a reverse list of the goals which come before
    and second component is the list of the goals which go after (in
    the expected order). *)
-type focus_context = Evar.t list * Evar.t list
+type focus_context = goal_with_state list * goal_with_state list
 
 
 (** Returns a stylised view of a focus_context for use by, for
@@ -120,11 +122,12 @@ type focus_context = Evar.t list * Evar.t list
    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). *)
-let focus_context f = f
+let focus_context (left,right) =
+  (List.map drop_state left, List.map drop_state right)
 
 (** This (internal) function extracts a sublist between two indices,
     and returns this sublist together with its context: if it returns
-    [(a,(b,c))] then [a] is the sublist and (rev b)@a@c is the
+    [(a,(b,c))] then [a] is the sublist and [(rev b) @ a @ c] is the
     original list.  The focused list has lenght [j-i-1] and contains
     the goals from number [i] to number [j] (both included) the first
     goal of the list being numbered [1].  [focus_sublist i j l] raises
@@ -149,17 +152,35 @@ let unfocus_sublist (left,right) s =
     proofview.  It returns the focused proofview, and a context for
     the focus stack. *)
 let focus i j sp =
-  let (new_comb, context) = focus_sublist i j sp.comb in
-  ( { sp with comb = new_comb } , context )
+  let (new_comb, (left, right)) = focus_sublist i j sp.comb in
+  ( { sp with comb = new_comb } , (left, right) )
+
+let cleared_alias evd g =
+  let evk = drop_state g in
+  let state = get_state g in
+  Option.map (fun g -> goal_with_state g state) (Evarutil.advance evd evk)
 
 (** [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_evars 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 []
+let goal_with_state_equal x y = Evar.equal (drop_state x) (drop_state y)
+let undefined defs l =
+  List.fold_right (fun evk l ->
+      match cleared_alias defs evk with
+      | Some evk -> List.add_set goal_with_state_equal evk l
+      | None -> l) l []
 
 (** Unfocuses a proofview with respect to a context. *)
-let unfocus c sp =
-  { sp with comb = undefined sp.solution (unfocus_sublist c sp.comb) }
+let unfocus (left, right) sp =
+  { sp with comb = undefined sp.solution (unfocus_sublist (left, right) sp.comb) }
 
+let with_empty_state = Proofview_monad.with_empty_state
+let drop_state = Proofview_monad.drop_state
+let goal_with_state = Proofview_monad.goal_with_state
 
 (** {6 The tactic monad} *)
 
@@ -286,7 +307,7 @@ let tclONCE = Proof.once
 
 exception MoreThanOneSuccess
 let _ = CErrors.register_handler begin function
-  | MoreThanOneSuccess -> CErrors.error "This tactic has more than one success."
+  | MoreThanOneSuccess -> CErrors.user_err Pp.(str "This tactic has more than one success.")
   | _ -> raise CErrors.Unhandled
 end
 
@@ -332,7 +353,7 @@ exception NoSuchGoals of int
 (* This hook returns a string to be appended to the usual message.
    Primarily used to add a suggestion about the right bullet to use to
    focus the next goal, if applicable. *)
-let nosuchgoals_hook:(int -> std_ppcmds) ref = ref (fun n -> mt ())
+let nosuchgoals_hook:(int -> Pp.t) ref = ref (fun n -> mt ())
 let set_nosuchgoals_hook f = nosuchgoals_hook := f
 
 
@@ -341,7 +362,7 @@ let set_nosuchgoals_hook f = nosuchgoals_hook := f
 let _ = CErrors.register_handler begin function
   | NoSuchGoals n ->
     let suffix = !nosuchgoals_hook n in
-    CErrors.errorlabstrm ""
+    CErrors.user_err 
       (str "No such " ++ str (String.plural n "goal") ++ str "." ++
        pr_non_empty_arg (fun x -> x) suffix)
       | _ -> raise CErrors.Unhandled
@@ -402,7 +423,8 @@ let tclFOCUSID id t =
   try
     let ev = Evd.evar_key id initial.solution in
     try
-      let n = CList.index Evar.equal ev initial.comb in
+      let comb = CList.map drop_state initial.comb in
+      let n = CList.index Evar.equal ev comb in
       (* goal is already under focus *)
       let (focused,context) = focus n n initial in
       Pv.set focused >>
@@ -411,7 +433,7 @@ let tclFOCUSID id t =
         return result
     with Not_found ->
       (* otherwise, save current focus and work purely on the shelve *)
-      Comb.set [ev] >>
+      Comb.set [with_empty_state ev] >>
         t >>= fun result ->
       Comb.set initial.comb  >>
         return result
@@ -421,13 +443,13 @@ let tclFOCUSID id t =
 
 exception SizeMismatch of int*int
 let _ = CErrors.register_handler begin function
-  | SizeMismatch (i,_) ->
+  | SizeMismatch (i,j) ->
       let open Pp in
       let errmsg =
         str"Incorrect number of goals" ++ spc() ++
-        str"(expected "++int i++str(String.plural i " tactic") ++ str")."
+        str"(expected "++int i++str(String.plural i " tactic") ++ str", was given "++ int j++str")."
       in
-      CErrors.errorlabstrm "" errmsg
+      CErrors.user_err  errmsg
   | _ -> raise CErrors.Unhandled
 end
 
@@ -441,7 +463,7 @@ let iter_goal i =
   Comb.get >>= fun initial ->
   Proof.List.fold_left begin fun (subgoals as cur) goal ->
     Solution.get >>= fun step ->
-    match Evarutil.advance step goal with
+    match cleared_alias step goal with
     | None -> return cur
     | Some goal ->
         Comb.set [goal] >>
@@ -451,6 +473,25 @@ let iter_goal i =
   Solution.get >>= fun evd ->
   Comb.set CList.(undefined evd (flatten (rev subgoals)))
 
+(** List iter but allocates a list of results *)
+let map_goal i =
+  let rev = List.rev in (* hem... Proof masks List... *)
+  let open Proof in
+  Comb.get >>= fun initial ->
+  Proof.List.fold_left begin fun (acc, subgoals as cur) goal ->
+    Solution.get >>= fun step ->
+    match cleared_alias step goal with
+    | None -> return cur
+    | Some goal ->
+        Comb.set [goal] >>
+        i goal >>= fun res ->
+        Proof.map (fun comb -> comb :: subgoals) Comb.get >>= fun x ->
+        return (res :: acc, x)
+  end ([],[]) initial >>= fun (results_rev, subgoals) ->
+  Solution.get >>= fun evd ->
+  Comb.set CList.(undefined evd (flatten (rev subgoals))) >>
+  return (rev results_rev)
+
 (** A variant of [Monad.List.fold_left2] where the first list is the
     list of focused goals. The argument tactic is executed in a focus
     comprising only of the current goal, a goal which has been solved
@@ -465,7 +506,7 @@ let fold_left2_goal i s l =
   in 
   Proof.List.fold_left2 err begin fun ((r,subgoals) as cur) goal a ->
     Solution.get >>= fun step ->
-    match Evarutil.advance step goal with
+    match cleared_alias step goal with
     | None -> return cur
     | Some goal ->
         Comb.set [goal] >>
@@ -509,7 +550,7 @@ let tclDISPATCHGEN0 join tacs =
         let open Proof in
         Pv.get >>= function
         | { comb=[goal] ; solution } ->
-            begin match Evarutil.advance solution goal with
+            begin match cleared_alias solution goal with
             | None -> tclUNIT (join [])
             | Some _ -> Proof.map (fun res -> join [res]) tac
             end
@@ -531,8 +572,8 @@ let tclDISPATCHL tacs = tclDISPATCHGEN CList.rev tacs
 
 
 (** [extend_to_list startxs rx endxs l] builds a list
-    [startxs@[rx,...,rx]@endxs] of the same length as [l]. Raises
-    [SizeMismatch] if [startxs@endxs] is already longer than [l]. *)
+    [startxs @ [rx,...,rx] @ endxs] of the same length as [l]. Raises
+    [SizeMismatch] if [startxs @ endxs] is already longer than [l]. *)
 let extend_to_list startxs rx endxs l =
   (* spiwack: I use [l] essentially as a natural number *)
   let rec duplicate acc = function
@@ -583,7 +624,15 @@ let tclINDEPENDENT tac =
       let tac = InfoL.tag (Info.DBranch) tac in
       InfoL.tag (Info.Dispatch) (iter_goal (fun _ -> tac))
 
-
+let tclINDEPENDENTL tac =
+  let open Proof in
+  Pv.get >>= fun initial ->
+  match initial.comb with
+  | [] -> tclUNIT []
+  | [_] -> tac >>= fun x -> return [x]
+  | _ ->
+      let tac = InfoL.tag (Info.DBranch) tac in
+      InfoL.tag (Info.Dispatch) (map_goal (fun _ -> tac))
 
 (** {7 Goal manipulation} *)
 
@@ -593,42 +642,70 @@ let shelve =
   Comb.get >>= fun initial ->
   Comb.set [] >>
   InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve")) >>
-  Shelf.modify (fun gls -> gls @ initial)
+  Shelf.modify (fun gls -> gls @ CList.map drop_state initial)
 
 let shelve_goals l =
   let open Proof in
   Comb.get >>= fun initial ->
-  let comb = CList.filter (fun g -> not (CList.mem g l)) initial in
+  let comb = CList.filter (fun g -> not (CList.mem (drop_state g) l)) initial in
   Comb.set comb >>
   InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_goals")) >>
   Shelf.modify (fun gls -> gls @ l)
 
-(** [contained_in_info e evi] checks whether the evar [e] appears in
-    the hypotheses, the conclusion or the body of the evar_info
-    [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
+
+let free_evars_with_state 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 ev = drop_state ev in
+    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_delayed_with_state sigma g l =
+  let g = drop_state g in
+  unifiable_delayed g l
+
 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_with_state sigma l in
+  CList.partition (fun g -> unifiable_delayed_with_state sigma 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
@@ -639,7 +716,7 @@ let shelve_unifiable =
   let (u,n) = partition_unifiable initial.solution initial.comb in
   Comb.set n >>
   InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_unifiable")) >>
-  Shelf.modify (fun gls -> gls @ u)
+  Shelf.modify (fun gls -> gls @ CList.map drop_state u)
 
 (** [guard_no_unifiable] returns the list of unifiable goals if some
     goals are unifiable (see {!shelve_unifiable}) in the current focus. *)
@@ -650,13 +727,14 @@ let guard_no_unifiable =
   match u with
   | [] -> tclUNIT None
   | gls ->
-      let l = CList.map (fun g -> Evd.dependent_evar_ident g initial.solution) gls in
+      let l = CList.map (fun g -> Evd.dependent_evar_ident (drop_state g) initial.solution) gls in
       let l = CList.map (fun id -> Names.Name id) l in
       tclUNIT (Some l)
 
 (** [unshelve l p] adds all the goals in [l] at the end of the focused
     goals of p *)
 let unshelve l p =
+  let l = List.map with_empty_state l in
   (* advance the goals in case of clear *)
   let l = undefined p.solution l in
   { p with comb = p.comb@l }
@@ -666,6 +744,12 @@ let mark_in_evm ~goal evd content =
   let info =
     if goal then
       { info with Evd.evar_source = match info.Evd.evar_source with
+            (* Two kinds for goal evars:
+               - GoalEvar (morally not dependent)
+               - VarInstance (morally dependent of some name).
+               This is a heuristic for naming these evars. *)
+            | loc, (Evar_kinds.QuestionMark (_,Names.Name id) |
+                    Evar_kinds.ImplicitArg (_,(_,Some id),_)) -> loc, Evar_kinds.VarInstance id
             | _, (Evar_kinds.VarInstance _ | Evar_kinds.GoalEvar) as x -> x
             | loc,_ -> loc,Evar_kinds.GoalEvar }
     else info
@@ -684,12 +768,13 @@ let with_shelf tac =
   tac >>= fun ans ->
   Pv.get >>= fun npv ->
   let { shelf = gls; solution = sigma } = npv in
+  (* The pending future goals are necessarily coming from V82.tactic *)
+  (* and thus considered as to shelve, as in Proof.run_tactic *)
   let gls' = Evd.future_goals sigma in
-  let fgoals = Evd.future_goals solution in
-  let pgoal = Evd.principal_future_goal solution in
-  let sigma = Evd.restore_future_goals sigma fgoals pgoal in
+  let fgoals = Evd.save_future_goals solution in
+  let sigma = Evd.restore_future_goals sigma fgoals in
   (* Ensure we mark and return only unsolved goals *)
-  let gls' = undefined sigma (CList.rev_append gls' gls) in
+  let gls' = undefined_evars sigma (CList.rev_append gls' gls) in
   let sigma = CList.fold_left (mark_in_evm ~goal:false) sigma gls' in
   let npv = { npv with shelf; solution = sigma } in
   Pv.set npv >> tclUNIT (gls', ans)
@@ -771,7 +856,7 @@ let give_up =
   Comb.set [] >>
   mark_as_unsafe >>
   InfoL.leaf (Info.Tactic (fun () -> Pp.str"give_up")) >>
-  Giveup.put initial
+  Giveup.put (CList.map drop_state initial)
 
 
 
@@ -812,8 +897,8 @@ module Progress = struct
 
   (** Equality function on goals *)
   let goal_equal evars1 gl1 evars2 gl2 =
-    let evi1 = Evd.find evars1 gl1 in
-    let evi2 = Evd.find evars2 gl2 in
+    let evi1 = Evd.find evars1 (drop_state gl1) in
+    let evi2 = Evd.find evars2 (drop_state gl2) in
     eq_evar_info evars1 evars2 evi1 evi2
 
 end
@@ -828,22 +913,20 @@ let tclPROGRESS t =
   let quick_test =
     initial.solution == final.solution && initial.comb == final.comb
   in
-  let exhaustive_test =
+  let test =
+    quick_test ||
     Util.List.for_all2eq begin fun i f ->
       Progress.goal_equal initial.solution i final.solution f
     end initial.comb final.comb
   in
-  let test =
-    quick_test || exhaustive_test
-  in
   if not test then
     tclUNIT res
   else
-    tclZERO (CErrors.UserError ("Proofview.tclPROGRESS" , Pp.str"Failed to progress."))
+    tclZERO (CErrors.UserError (Some "Proofview.tclPROGRESS" , Pp.str"Failed to progress."))
 
 exception Timeout
 let _ = CErrors.register_handler begin function
-  | Timeout -> CErrors.errorlabstrm "Proofview.tclTIMEOUT" (Pp.str"Tactic timeout!")
+  | Timeout -> CErrors.user_err ~hdr:"Proofview.tclTIMEOUT" (Pp.str"Tactic timeout!")
   | _ -> Pervasives.raise CErrors.Unhandled
 end
 
@@ -929,6 +1012,15 @@ module Unsafe = struct
 
   let tclSETGOALS = Comb.set
 
+  let tclGETSHELF = Shelf.get
+
+  let tclSETSHELF = Shelf.set
+
+  let tclPUTSHELF to_shelve =
+    tclBIND tclGETSHELF (fun shelf -> tclSETSHELF (to_shelve@shelf))
+
+  let tclPUTGIVENUP = Giveup.put
+
   let tclEVARSADVANCE evd =
     Pv.modify (fun ps -> { ps with solution = evd; comb = undefined evd ps.comb })
 
@@ -978,64 +1070,68 @@ let catchable_exception = function
 
 module Goal = struct
 
-  type ('a, 'r) t = {
+  type t = {
     env : Environ.env;
     sigma : Evd.evar_map;
-    concl : Term.constr ;
+    concl : EConstr.constr ;
+    state : StateStore.t;
     self : Evar.t ; (* for compatibility with old-style definitions *)
   }
 
-  type ('a, 'b) enter =
-    { enter : 'r. ('a, 'r) t -> 'b }
-
-  let assume (gl : ('a, 'r) t) = (gl :> ([ `NF ], 'r) t)
+  let assume (gl : t) = (gl : t)
 
-  let env { env=env } = env
-  let sigma { sigma=sigma } = Sigma.Unsafe.of_evar_map sigma
-  let hyps { env=env } = Environ.named_context env
-  let concl { concl=concl } = concl
-  let extra { sigma=sigma; self=self } = goal_extra sigma self
+  let print { sigma; self } = { Evd.it = self; sigma }
 
-  let raw_concl { concl=concl } = concl
+  let state { state=state } = state
 
+  let env {env} = env
+  let sigma {sigma} = sigma
+  let hyps {env} = EConstr.named_context env
+  let concl {concl} = concl
+  let extra {sigma; self} = goal_extra sigma self
 
-  let gmake_with info env sigma goal = 
+  let gmake_with info env sigma goal state =
     { env = Environ.reset_with_named_context (Evd.evar_filtered_hyps info) env ;
       sigma = sigma ;
-      concl = Evd.evar_concl info ;
+      concl = EConstr.of_constr (Evd.evar_concl info);
+      state = state ;
       self = goal }
 
   let nf_gmake env sigma goal =
+    let state = get_state goal in
+    let goal = drop_state goal in
     let info = Evarutil.nf_evar_info sigma (Evd.find sigma goal) in
     let sigma = Evd.add sigma goal info in
-    gmake_with info env sigma goal , sigma
+    gmake_with info env sigma goal state , sigma
 
   let nf_enter f =
     InfoL.tag (Info.Dispatch) begin
     iter_goal begin fun goal ->
-      Env.get >>= fun env ->
+      tclENV >>= fun env ->
       tclEVARMAP >>= fun sigma ->
       try
         let (gl, sigma) = nf_gmake env sigma goal in
-        tclTHEN (Unsafe.tclEVARS sigma) (InfoL.tag (Info.DBranch) (f.enter gl))
+        tclTHEN (Unsafe.tclEVARS sigma) (InfoL.tag (Info.DBranch) (f gl))
       with e when catchable_exception e ->
         let (e, info) = CErrors.push e in
         tclZERO ~info e
     end
     end
 
-  let normalize { self } =
+  let normalize { self; state } =
     Env.get >>= fun env ->
     tclEVARMAP >>= fun sigma ->
-    let (gl,sigma) = nf_gmake env sigma self in
+    let (gl,sigma) = nf_gmake env sigma (goal_with_state self state) in
     tclTHEN (Unsafe.tclEVARS sigma) (tclUNIT gl)
 
   let gmake env sigma goal =
+    let state = get_state goal in
+    let goal = drop_state goal in
     let info = Evd.find sigma goal in
-    gmake_with info env sigma goal
+    gmake_with info env sigma goal state
 
   let enter f =
-    let f gl = InfoL.tag (Info.DBranch) (f.enter gl) in
+    let f gl = InfoL.tag (Info.DBranch) (f gl) in
     InfoL.tag (Info.Dispatch) begin
     iter_goal begin fun goal ->
       Env.get >>= fun env ->
@@ -1047,66 +1143,25 @@ module Goal = struct
     end
     end
 
-  exception NotExactlyOneSubgoal
-  let _ = CErrors.register_handler begin function
-  | NotExactlyOneSubgoal ->
-      CErrors.errorlabstrm "" (Pp.str"Not exactly one subgoal.")
-  | _ -> raise CErrors.Unhandled
-  end
-
-  let enter_one f =
+  let enter_one ?(__LOC__=__LOC__) f =
     let open Proof in
     Comb.get >>= function
     | [goal] -> begin
        Env.get >>= fun env ->
        tclEVARMAP >>= fun sigma ->
-       try f.enter (gmake env sigma goal)
+       try f (gmake env sigma goal)
        with e when catchable_exception e ->
          let (e, info) = CErrors.push e in
          tclZERO ~info e
       end
-    | _ -> tclZERO NotExactlyOneSubgoal
-
-  type ('a, 'b) s_enter =
-    { s_enter : 'r. ('a, 'r) t -> ('b, 'r) Sigma.sigma }
-
-  let s_enter f =
-    InfoL.tag (Info.Dispatch) begin
-    iter_goal begin fun goal ->
-      Env.get >>= fun env ->
-      tclEVARMAP >>= fun sigma ->
-      try
-        let gl = gmake env sigma goal in
-        let Sigma (tac, sigma, _) = f.s_enter gl in
-        let sigma = Sigma.to_evar_map sigma in
-        tclTHEN (Unsafe.tclEVARS sigma) (InfoL.tag (Info.DBranch) tac)
-      with e when catchable_exception e ->
-        let (e, info) = CErrors.push e in
-        tclZERO ~info e
-    end
-    end
-
-  let nf_s_enter f =
-    InfoL.tag (Info.Dispatch) begin
-    iter_goal begin fun goal ->
-      Env.get >>= fun env ->
-      tclEVARMAP >>= fun sigma ->
-      try
-        let (gl, sigma) = nf_gmake env sigma goal in
-        let Sigma (tac, sigma, _) = f.s_enter gl in
-        let sigma = Sigma.to_evar_map sigma in
-        tclTHEN (Unsafe.tclEVARS sigma) (InfoL.tag (Info.DBranch) tac)
-      with e when catchable_exception e ->
-        let (e, info) = CErrors.push e in
-        tclZERO ~info e
-    end
-    end
+    | _ ->
+       CErrors.anomaly Pp.(str __LOC__ ++ str " enter_one")
 
   let goals =
     Pv.get >>= fun step ->
     let sigma = step.solution in
     let map goal =
-      match Evarutil.advance sigma goal with
+      match cleared_alias sigma goal with
       | None -> None (** ppedrot: Is this check really necessary? *)
       | Some goal ->
         let gl =
@@ -1125,8 +1180,6 @@ module Goal = struct
   (* compatibility *)
   let goal { self=self } = self
 
-  let lift (gl : ('a, 'r) t) _ = (gl :> ('a, 's) t)
-
 end
 
 
@@ -1161,25 +1214,29 @@ let tclCHECKINTERRUPT =
 module V82 = struct
   type tac = Evar.t Evd.sigma -> Evar.t list Evd.sigma
 
-  let tactic tac =
+  let tactic ?(nf_evars=true) tac =
     (* spiwack: we ignore the dependencies between goals here,
        expectingly preserving the semantics of <= 8.2 tactics *)
     (* spiwack: convenience notations, waiting for ocaml 3.12 *)
     let open Proof in
     Pv.get >>= fun ps ->
     try
-      let tac gl evd = 
+      let tac g_w_s evd =
+        let g, w = drop_state g_w_s, get_state g_w_s in
         let glsigma  =
-          tac { Evd.it = gl ; sigma = evd; }  in
+          tac { Evd.it = g ; sigma = evd; }  in
         let sigma = glsigma.Evd.sigma in
-        let g = glsigma.Evd.it in
+        let g = CList.map (fun g -> goal_with_state g w) glsigma.Evd.it in
         ( g, sigma )
       in
         (* Old style tactics expect the goals normalized with respect to evars. *)
-      let (initgoals,initevd) =
-        Evd.Monad.List.map (fun g s -> goal_nf_evar s g) ps.comb ps.solution
+      let (initgoals_w_state, initevd) =
+        Evd.Monad.List.map (fun g_w_s s ->
+          let g, w = drop_state g_w_s, get_state g_w_s in
+          let g, s = if nf_evars then goal_nf_evar s g else g, s in
+          goal_with_state g w, s) ps.comb ps.solution
       in
-      let (goalss,evd) = Evd.Monad.List.map tac initgoals initevd in
+      let (goalss,evd) = Evd.Monad.List.map tac initgoals_w_state initevd in
       let sgs = CList.flatten goalss in
       let sgs = undefined evd sgs in
       InfoL.leaf (Info.Tactic (fun () -> Pp.str"<unknown>")) >>
@@ -1194,8 +1251,9 @@ module V82 = struct
   let nf_evar_goals =
     Pv.modify begin fun ps ->
     let map g s = goal_nf_evar s g in
-    let (goals,evd) = Evd.Monad.List.map map ps.comb ps.solution in
-    { ps with solution = evd; comb = goals; }
+    let comb = CList.map drop_state ps.comb in
+    let (_goals,evd) = Evd.Monad.List.map map comb ps.solution in
+    { ps with solution = evd; }
     end
       
   let has_unresolved_evar pv =
@@ -1205,30 +1263,30 @@ module V82 = struct
   let grab pv =
     let undef = Evd.undefined_map pv.solution in
     let goals = CList.rev_map fst (Evar.Map.bindings undef) in
-    { pv with comb = goals }
+    { pv with comb = List.map with_empty_state goals }
       
     
 
   (* Returns the open goals of the proofview together with the evar_map to 
      interpret them. *)
   let goals { comb = comb ; solution = solution; } =
-   { Evd.it = comb ; sigma = solution }
+   { Evd.it = List.map drop_state comb ; sigma = solution }
 
   let top_goals initial { solution=solution; } =
-    let goals = CList.map (fun (t,_) -> fst (Term.destEvar 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 =
     let evars_of_initial (c,_) =
-      Evar.Set.elements (Evd.evars_of_term c)
+      Evar.Set.elements (Evd.evars_of_term (EConstr.Unsafe.to_constr c))
     in
     CList.flatten (CList.map evars_of_initial initial)
 
   let of_tactic t gls =
     try
-      let init = { shelf = []; solution = gls.Evd.sigma ; comb = [gls.Evd.it] } in
+      let init = { shelf = []; solution = gls.Evd.sigma ; comb = [with_empty_state gls.Evd.it] } in
       let (_,final,_,_) = apply (goal_env gls.Evd.sigma gls.Evd.it) t init in
-      { Evd.sigma = final.solution ; it = final.comb }
+      { Evd.sigma = final.solution ; it = CList.map drop_state final.comb }
     with Logic_monad.TacticFailure e as src ->
       let (_, info) = CErrors.push src in
       iraise (e, info)
@@ -1250,8 +1308,4 @@ module Notations = struct
   let (>>=) = tclBIND
   let (<*>) = tclTHEN
   let (<+>) t1 t2 = tclOR t1 (fun _ -> t2)
-  type ('a, 'b) enter = ('a, 'b) Goal.enter =
-    { enter : 'r. ('a, 'r) Goal.t -> 'b }
-  type ('a, 'b) s_enter = ('a, 'b) Goal.s_enter =
-    { s_enter : 'r. ('a, 'r) Goal.t -> ('b, 'r) Sigma.sigma }
 end
diff --git a/engine/proofview.mli b/engine/proofview.mli
index 90be2f90..e7be6655 100644
--- a/engine/proofview.mli
+++ b/engine/proofview.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This files defines the basic mechanism of proofs: the [proofview]
@@ -13,7 +15,7 @@
     state and returning a value of type ['a]. *)
 
 open Util
-open Term
+open EConstr
 
 (** Main state of tactics *)
 type proofview
@@ -25,7 +27,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 -> Goal.goal list * Evd.evar_map
+val proofview : proofview -> Evar.t list * Evd.evar_map
 
 
 (** {6 Starting and querying a proof view} *)
@@ -43,7 +45,7 @@ val compact : entry -> proofview -> entry * proofview
     empty [evar_map] (indeed a proof can be triggered by an incomplete
     pretyping), [init] takes an additional argument to represent the
     initial [evar_map]. *)
-val init : Evd.evar_map -> (Environ.env * Term.types) list -> entry * proofview
+val init : Evd.evar_map -> (Environ.env * types) list -> entry * proofview
 
 (** A [telescope] is a list of environment and conclusion like in
     {!init}, except that each element may depend on the previous
@@ -52,7 +54,7 @@ val init : Evd.evar_map -> (Environ.env * Term.types) list -> entry * proofview
     [evar_map] is threaded in state passing style. *)
 type telescope =
   | TNil of Evd.evar_map
-  | TCons of Environ.env * Evd.evar_map * Term.types * (Evd.evar_map -> Term.constr -> telescope)
+  | TCons of Environ.env * Evd.evar_map * types * (Evd.evar_map -> constr -> telescope)
 
 (** Like {!init}, but goals are allowed to be dependent on one
     another. Dependencies between goals is represented with the type
@@ -72,7 +74,15 @@ val return : proofview -> Evd.evar_map
 val partial_proof : entry -> proofview -> constr list
 val initial_goals : entry -> (constr * types) list
 
+(** goal <-> goal_with_state *)
 
+val with_empty_state :
+  Proofview_monad.goal ->  Proofview_monad.goal_with_state
+val drop_state :
+  Proofview_monad.goal_with_state -> Proofview_monad.goal
+val goal_with_state :
+  Proofview_monad.goal -> Proofview_monad.StateStore.t ->
+    Proofview_monad.goal_with_state
 
 (** {6 Focusing commands} *)
 
@@ -88,7 +98,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 -> Goal.goal list * Goal.goal 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 +158,7 @@ type +'a tactic
     {!Logic_monad.TacticFailure}*)
 val apply : Environ.env -> 'a tactic -> proofview -> 'a
                                                    * proofview
-                                                   * (bool*Goal.goal list*Goal.goal list)
+                                                   * (bool*Evar.t list*Evar.t list)
                                                    * Proofview_monad.Info.tree
 
 (** {7 Monadic primitives} *)
@@ -235,7 +245,7 @@ val tclBREAK : (iexn -> iexn option) -> 'a tactic -> 'a tactic
     This hook is used to add a suggestion about bullets when
     applicable. *)
 exception NoSuchGoals of int
-val set_nosuchgoals_hook: (int -> Pp.std_ppcmds) -> unit
+val set_nosuchgoals_hook: (int -> Pp.t) -> unit
 
 val tclFOCUS : int -> int -> 'a tactic -> 'a tactic
 
@@ -292,6 +302,7 @@ val tclEXTEND : unit tactic list -> unit tactic -> unit tactic list -> unit tact
     independent of backtracking in another. It is equivalent to
     [tclEXTEND [] tac []]. *)
 val tclINDEPENDENT : unit tactic -> unit tactic
+val tclINDEPENDENTL: 'a tactic -> 'a list tactic
 
 
 (** {7 Goal manipulation} *)
@@ -303,12 +314,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 : Goal.goal 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 -> Goal.goal -> Goal.goal 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
@@ -321,15 +332,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 : Goal.goal 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 -> Goal.goal -> Goal.goal -> 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 -> (Goal.goal 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.*)
@@ -415,17 +426,29 @@ 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 : Goal.goal list -> unit tactic
+  val tclNEWGOALS : Proofview_monad.goal_with_state 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 : Goal.goal list -> unit tactic
+  val tclSETGOALS : Proofview_monad.goal_with_state list -> unit tactic
 
   (** [tclGETGOALS] returns the list of goals under focus. *)
-  val tclGETGOALS : Goal.goal list tactic
+  val tclGETGOALS : Proofview_monad.goal_with_state list tactic
+
+  (** [tclSETSHELF gls] sets goals [gls] as the current shelf. *)
+  val tclSETSHELF : Evar.t list -> unit tactic
+
+  (** [tclGETSHELF] returns the list of goals on the shelf. *)
+  val tclGETSHELF : Evar.t list tactic
+
+  (** [tclPUTSHELF] appends goals to the shelf. *)
+  val tclPUTSHELF : Evar.t list -> unit tactic
+
+  (** [tclPUTGIVENUP] add an given up goal. *)
+  val tclPUTGIVENUP : Evar.t list -> unit 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
@@ -460,79 +483,51 @@ 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.
-
-      The second parameter is a stage indicating where the goal belongs. See
-      module {!Sigma}.
-  *)
-  type ('a, 'r) t
+  (** Type of goals. *)
+  type t
 
   (** Assume that you do not need the goal to be normalized. *)
-  val assume : ('a, 'r) t -> ([ `NF ], 'r) t
+  val assume : t -> t
+  [@@ocaml.deprecated "Normalization is enforced by EConstr, [assume] is not needed anymore"]
 
   (** Normalises the argument goal. *)
-  val normalize : ('a, 'r) t -> ([ `NF ], 'r) 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 : ([ `NF ], 'r) t -> Term.constr
-  val hyps : ([ `NF ], 'r) t -> Context.Named.t
-  val env : ('a, 'r) t -> Environ.env
-  val sigma : ('a, 'r) t -> 'r Sigma.t
-  val extra : ('a, 'r) t -> Evd.Store.t
-
-  (** Returns the goal's conclusion even if the goal is not
-      normalised. *)
-  val raw_concl : ('a, 'r) t -> Term.constr
-
-  type ('a, 'b) enter =
-    { enter : 'r. ('a, 'r) t -> 'b }
+  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
+  val state : t -> Proofview_monad.StateStore.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 ], unit tactic) enter -> unit tactic
+  val nf_enter : (t -> unit tactic) -> unit tactic
 
   (** Like {!nf_enter}, but does not normalize the goal beforehand. *)
-  val enter : ([ `LZ ], unit tactic) enter -> unit tactic
+  val enter : (t -> unit tactic) -> unit tactic
 
   (** Like {!enter}, but assumes exactly one goal under focus, raising *)
-  (** an error otherwise. *)
-  val enter_one : ([ `LZ ], 'a tactic) enter -> 'a tactic
-
-  type ('a, 'b) s_enter =
-    { s_enter : 'r. ('a, 'r) t -> ('b, 'r) Sigma.sigma }
-
-  (** A variant of {!enter} allows to work with a monotonic state. The evarmap
-      returned by the argument is put back into the current state before firing
-      the returned tactic. *)
-  val s_enter : ([ `LZ ], unit tactic) s_enter -> unit tactic
-
-  (** Like {!s_enter}, but normalizes the goal beforehand. *)
-  val nf_s_enter : ([ `NF ], unit tactic) s_enter -> unit tactic
+  (** a fatal error otherwise. *)
+  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 ], 'r) 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, 'r) t -> bool tactic
+  val unsolved : t -> bool tactic
 
   (** Compatibility: avoid if possible *)
-  val goal : ([ `NF ], 'r) t -> Evar.t
-
-  (** Every goal is valid at a later stage. FIXME: take a later evarmap *)
-  val lift : ('a, 'r) t -> ('r, 's) Sigma.le -> ('a, 's) t
+  val goal : t -> Evar.t
+  val print : t -> Goal.goal Evd.sigma
 
 end
 
@@ -548,7 +543,7 @@ module Trace : sig
   val log : Proofview_monad.lazy_msg -> unit tactic
   val name_tactic : Proofview_monad.lazy_msg -> 'a tactic -> 'a tactic
 
-  val pr_info : ?lvl:int -> Proofview_monad.Info.tree -> Pp.std_ppcmds
+  val pr_info : ?lvl:int -> Proofview_monad.Info.tree -> Pp.t
 
 end
 
@@ -569,7 +564,10 @@ val tclLIFT : 'a NonLogical.t -> 'a tactic
 (*** Compatibility layer with <= 8.2 tactics ***)
 module V82 : sig
   type tac = Evar.t Evd.sigma -> Evar.t list Evd.sigma
-  val tactic : tac -> unit tactic
+
+  (* [nf_evars=true] applies the evar (assignment) map to the goals
+   * (conclusion and context) before calling the tactic *)
+  val tactic : ?nf_evars:bool -> tac -> unit tactic
 
   (* normalises the evars in the goals, and stores the result in
      solution. *)
@@ -585,11 +583,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
@@ -619,8 +618,4 @@ module Notations : sig
   (** {!tclOR}: [t1+t2] = [tclOR t1 (fun _ -> t2)]. *)
   val (<+>) : 'a tactic -> 'a tactic -> 'a tactic
 
-  type ('a, 'b) enter = ('a, 'b) Goal.enter =
-    { enter : 'r. ('a, 'r) Goal.t -> 'b }
-  type ('a, 'b) s_enter = ('a, 'b) Goal.s_enter =
-    { s_enter : 'r. ('a, 'r) Goal.t -> ('b, 'r) Sigma.sigma }
 end
diff --git a/engine/proofview_monad.ml b/engine/proofview_monad.ml
index 6f52b3ee..52bcabf9 100644
--- a/engine/proofview_monad.ml
+++ b/engine/proofview_monad.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines the datatypes used as internal states by the
@@ -62,7 +64,7 @@ end
 
 (** We typically label nodes of [Trace.tree] with messages to
     print. But we don't want to compute the result. *)
-type lazy_msg = unit -> Pp.std_ppcmds
+type lazy_msg = unit -> Pp.t
 let pr_lazy_msg msg = msg ()
 
 (** Info trace. *)
@@ -149,13 +151,25 @@ module Info = struct
     CList.map_append (collapse_tree n) f
 end
 
+module StateStore = Store.Make(struct end)
+
+(* let (set_state, get_state) = StateDyn.Easy.make_dyn "goal_state" *)
+
+type goal = Evar.t
+type goal_with_state = Evar.t * StateStore.t
+
+let drop_state = fst
+let get_state = snd
+let goal_with_state g s = (g, s)
+let with_empty_state g = (g, StateStore.empty)
+let map_goal_with_state f (g, s) = (f g, s)
 
 (** Type of proof views: current [evar_map] together with the list of
     focused goals. *)
 type proofview = {
   solution : Evd.evar_map;
-  comb : Evar.t list;
-  shelf : Evar.t list;
+  comb : goal_with_state list;
+  shelf : goal list;
 }
 
 (** {6 Instantiation of the logic monad} *)
@@ -169,7 +183,7 @@ module P = struct
   type e = bool
 
   (** Status (safe/unsafe) * shelved goals * given up *)
-  type w = bool * Evar.t list
+  type w = bool * goal list
 
   let wunit = true , []
   let wprod (b1, g1) (b2, g2) = b1 && b2 , g1@g2
@@ -209,9 +223,9 @@ module Solution : State with type t := Evd.evar_map = struct
   let modify f = Pv.modify (fun pv -> { pv with solution = f pv.solution })
 end
 
-module Comb : State with type t = Evar.t list = struct
+module Comb : State with type t = goal_with_state list = struct
     (* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *)
-  type t = Evar.t list
+  type t = goal_with_state list
   let get = Logical.map (fun {comb} -> comb) Pv.get
   let set c = Pv.modify (fun pv -> { pv with comb = c })
   let modify f = Pv.modify (fun pv -> { pv with comb = f pv.comb })
@@ -227,17 +241,17 @@ module Status : Writer with type t := bool = struct
   let put s = Logical.put (s, [])
 end
 
-module Shelf : State with type t = Evar.t list = struct
+module Shelf : State with type t = goal list = struct
     (* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *)
-  type t = Evar.t list
+  type t = goal list
   let get = Logical.map (fun {shelf} -> shelf) Pv.get
   let set c = Pv.modify (fun pv -> { pv with shelf = c })
   let modify f = Pv.modify (fun pv -> { pv with shelf = f pv.shelf })
 end
 
-module Giveup : Writer with type t = Evar.t list = struct
+module Giveup : Writer with type t = goal list = struct
     (* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *)
-  type t = Evar.t list
+  type t = goal list
   let put gs = Logical.put (true, gs)
 end
 
diff --git a/engine/proofview_monad.mli b/engine/proofview_monad.mli
index 637414cc..9d752421 100644
--- a/engine/proofview_monad.mli
+++ b/engine/proofview_monad.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines the datatypes used as internal states by the
@@ -43,7 +45,7 @@ end
 
 (** We typically label nodes of [Trace.tree] with messages to
     print. But we don't want to compute the result. *)
-type lazy_msg = unit -> Pp.std_ppcmds
+type lazy_msg = unit -> Pp.t
 
 (** Info trace. *)
 module Info : sig
@@ -58,7 +60,7 @@ module Info : sig
   type state = tag Trace.incr
   type tree = tag Trace.forest
 
-  val print : tree -> Pp.std_ppcmds
+  val print : tree -> Pp.t
 
   (** [collapse n t] flattens the first [n] levels of [Tactic] in an
       info trace, effectively forgetting about the [n] top level of
@@ -67,12 +69,21 @@ module Info : sig
 
 end
 
+module StateStore : Store.S
+type goal = Evar.t
+type goal_with_state
+val drop_state : goal_with_state -> goal
+val get_state : goal_with_state -> StateStore.t
+val goal_with_state : goal -> StateStore.t -> goal_with_state
+val with_empty_state : goal -> goal_with_state
+val map_goal_with_state : (goal -> goal) -> goal_with_state -> goal_with_state
+
 (** Type of proof views: current [evar_map] together with the list of
     focused goals. *)
 type proofview = {
   solution : Evd.evar_map;
-  comb : Evar.t list;
-  shelf : Evar.t list;
+  comb : goal_with_state list;
+  shelf : goal list;
 }
 
 (** {6 Instantiation of the logic monad} *)
@@ -81,7 +92,7 @@ module P : sig
   type s = proofview * Environ.env
 
   (** Status (safe/unsafe) * given up *)
-  type w = bool * Evar.t list
+  type w = bool * goal list
 
   val wunit : w
   val wprod : w -> w -> w
@@ -118,7 +129,7 @@ module Pv : State with type t := proofview
 module Solution : State with type t := Evd.evar_map
 
 (** Lens to the list of focused goals. *)
-module Comb : State with type t = Evar.t list
+module Comb : State with type t = goal_with_state list
 
 (** Lens to the global environment. *)
 module Env : State with type t := Environ.env
@@ -128,11 +139,11 @@ module Status : Writer with type t := bool
 
 (** Lens to the list of goals which have been shelved during the
     execution of the tactic. *)
-module Shelf : State with type t = Evar.t list
+module Shelf : State with type t = goal list
 
 (** Lens to the list of goals which were given up during the execution
     of the tactic. *)
-module Giveup : Writer with type t = Evar.t list
+module Giveup : Writer with type t = goal list
 
 (** Lens and utilies pertaining to the info trace *)
 module InfoL : sig
diff --git a/engine/sigma.ml b/engine/sigma.ml
deleted file mode 100644
index 9381a33a..00000000
--- a/engine/sigma.ml
+++ /dev/null
@@ -1,117 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-type 'a t = Evd.evar_map
-
-type ('a, 'b) le = unit
-
-let refl = ()
-let cons _ _  = ()
-let (+>) = fun _ _ -> ()
-
-type ('a, 'r) sigma = Sigma : 'a * 's t * ('r, 's) le -> ('a, 'r) sigma
-
-type 'a evar = Evar.t
-
-let lift_evar evk () = evk
-
-let to_evar_map evd = evd
-let to_evar evk = evk
-
-let here x s = Sigma (x, s, ())
-
-(** API *)
-
-type 'r fresh = Fresh : 's evar * 's t * ('r, 's) le -> 'r fresh
-
-let new_evar sigma ?naming info =
-  let (sigma, evk) = Evd.new_evar sigma ?naming info in
-  Fresh (evk, sigma, ())
-
-let define evk c sigma =
-  Sigma ((), Evd.define evk c sigma, ())
-
-let new_univ_level_variable ?loc ?name rigid sigma =
-  let (sigma, u) = Evd.new_univ_level_variable ?loc ?name rigid sigma in
-  Sigma (u, sigma, ())
-
-let new_univ_variable ?loc ?name rigid sigma =
-  let (sigma, u) = Evd.new_univ_variable ?loc ?name rigid sigma in
-  Sigma (u, sigma, ())
-
-let new_sort_variable ?loc ?name rigid sigma =
-  let (sigma, u) = Evd.new_sort_variable ?loc ?name rigid sigma in
-  Sigma (u, sigma, ())
-
-let fresh_sort_in_family ?loc ?rigid env sigma s =
-  let (sigma, s) = Evd.fresh_sort_in_family ?loc ?rigid env sigma s in
-  Sigma (s, sigma, ())
-
-let fresh_constant_instance ?loc env sigma cst =
-  let (sigma, cst) = Evd.fresh_constant_instance ?loc env sigma cst in
-  Sigma (cst, sigma, ())
-
-let fresh_inductive_instance ?loc env sigma ind =
-  let (sigma, ind) = Evd.fresh_inductive_instance ?loc env sigma ind in
-  Sigma (ind, sigma, ())
-
-let fresh_constructor_instance ?loc env sigma pc =
-  let (sigma, c) = Evd.fresh_constructor_instance ?loc env sigma pc in
-  Sigma (c, sigma, ())
-
-let fresh_global ?loc ?rigid ?names env sigma r =
-  let (sigma, c) = Evd.fresh_global ?loc ?rigid ?names env sigma r in
-  Sigma (c, sigma, ())
-
-(** Run *)
-
-type 'a run = { run : 'r. 'r t -> ('a, 'r) sigma }
-
-let run sigma f : 'a * Evd.evar_map =
-  let Sigma (x, sigma, ()) = f.run sigma in
-  (x, sigma)
-
-(** Monotonic references *)
-
-type evdref = Evd.evar_map ref
-
-let apply evdref f =
-  let Sigma (x, sigma, ()) = f.run !evdref in
-  evdref := sigma;
-  x
-
-let purify f =
-  let f (sigma : Evd.evar_map) =
-    let evdref = ref sigma in
-    let ans = f evdref in
-    Sigma (ans, !evdref, ())
-  in
-  { run = f }
-
-(** Unsafe primitives *)
-
-module Unsafe =
-struct
-
-let le = ()
-let of_evar_map sigma = sigma
-let of_evar evk = evk
-let of_ref ref = ref
-let of_pair (x, sigma) = Sigma (x, sigma, ())
-
-end
-
-module Notations =
-struct
-  type ('a, 'r) sigma_ = ('a, 'r) sigma =
-    Sigma : 'a * 's t * ('r, 's) le -> ('a, 'r) sigma_
-
-  let (+>) = fun _ _ -> ()
-
-  type 'a run_ = 'a run = { run : 'r. 'r t -> ('a, 'r) sigma }
-end
diff --git a/engine/sigma.mli b/engine/sigma.mli
deleted file mode 100644
index 7473a251..00000000
--- a/engine/sigma.mli
+++ /dev/null
@@ -1,131 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Constr
-
-(** Monotonous state enforced by typing.
-
-    This module allows to constrain uses of evarmaps in a monotonous fashion,
-    and in particular statically suppress evar leaks and the like. To this
-    ends, it defines a type of indexed evarmaps whose phantom typing ensures
-    monotonous use.
-*)
-
-(** {5 Stages} *)
-
-type ('a, 'b) le
-(** Relationship stating that stage ['a] is anterior to stage ['b] *)
-
-val refl : ('a, 'a) le
-(** Reflexivity of anteriority *)
-
-val cons : ('a, 'b) le -> ('b, 'c) le -> ('a, 'c) le
-(** Transitivity of anteriority *)
-
-val (+>) : ('a, 'b) le -> ('b, 'c) le -> ('a, 'c) le
-(** Alias for {!cons} *)
-
-(** {5 Monotonous evarmaps} *)
-
-type 'r t
-(** Stage-indexed evarmaps. This is just a plain evarmap with a phantom type. *)
-
-type ('a, 'r) sigma = Sigma : 'a * 's t * ('r, 's) le -> ('a, 'r) sigma
-(** Return values at a later stage *)
-
-type 'r evar
-(** Stage-indexed evars *)
-
-(** {5 Constructors} *)
-
-val here : 'a -> 'r t -> ('a, 'r) sigma
-(** [here x s] is a shorthand for [Sigma (x, s, refl)] *)
-
-(** {5 Postponing} *)
-
-val lift_evar : 'r evar -> ('r, 's) le -> 's evar
-(** Any evar existing at stage ['r] is also valid at any later stage. *)
-
-(** {5 Downcasting} *)
-
-val to_evar_map : 'r t -> Evd.evar_map
-val to_evar : 'r evar -> Evar.t
-
-(** {5 Monotonous API} *)
-
-type 'r fresh = Fresh : 's evar * 's t * ('r, 's) le -> 'r fresh
-
-val new_evar : 'r t -> ?naming:Misctypes.intro_pattern_naming_expr ->
-  Evd.evar_info -> 'r fresh
-
-val define : 'r evar -> Constr.t -> 'r t -> (unit, 'r) sigma
-
-(** Polymorphic universes *)
-
-val new_univ_level_variable : ?loc:Loc.t -> ?name:string ->
-  Evd.rigid -> 'r t -> (Univ.universe_level, 'r) sigma
-val new_univ_variable : ?loc:Loc.t -> ?name:string ->
-  Evd.rigid -> 'r t -> (Univ.universe, 'r) sigma
-val new_sort_variable : ?loc:Loc.t -> ?name:string ->
-  Evd.rigid -> 'r t -> (Sorts.t, 'r) sigma
-
-val fresh_sort_in_family : ?loc:Loc.t -> ?rigid:Evd.rigid -> Environ.env ->
-  'r t -> Term.sorts_family -> (Term.sorts, 'r) sigma
-val fresh_constant_instance :
-  ?loc:Loc.t -> Environ.env -> 'r t -> constant -> (pconstant, 'r) sigma
-val fresh_inductive_instance :
-  ?loc:Loc.t -> Environ.env -> 'r t -> inductive -> (pinductive, 'r) sigma
-val fresh_constructor_instance : ?loc:Loc.t -> Environ.env -> 'r t -> constructor ->
-  (pconstructor, 'r) sigma
-
-val fresh_global : ?loc:Loc.t -> ?rigid:Evd.rigid -> ?names:Univ.Instance.t -> Environ.env ->
-  'r t -> Globnames.global_reference -> (constr, 'r) sigma
-
-(** FILLME *)
-
-(** {5 Run} *)
-
-type 'a run = { run : 'r. 'r t -> ('a, 'r) sigma }
-
-val run : Evd.evar_map -> 'a run -> 'a * Evd.evar_map
-
-(** {5 Imperative monotonic functions} *)
-
-type evdref
-(** Monotonic references over evarmaps *)
-
-val apply : evdref -> 'a run -> 'a
-(** Apply a monotonic function on a reference. *)
-
-val purify : (evdref -> 'a) -> 'a run
-(** Converse of {!apply}. *)
-
-(** {5 Unsafe primitives} *)
-
-module Unsafe :
-sig
-  val le : ('a, 'b) le
-  val of_evar_map : Evd.evar_map -> 'r t
-  val of_evar : Evd.evar -> 'r evar
-  val of_ref : Evd.evar_map ref -> evdref
-  val of_pair : ('a * Evd.evar_map) -> ('a, 'r) sigma
-end
-
-(** {5 Notations} *)
-
-module Notations :
-sig
-  type ('a, 'r) sigma_ = ('a, 'r) sigma =
-    Sigma : 'a * 's t * ('r, 's) le -> ('a, 'r) sigma_
-
-  type 'a run_ = 'a run = { run : 'r. 'r t -> ('a, 'r) sigma }
-
-  val (+>) : ('a, 'b) le -> ('b, 'c) le -> ('a, 'c) le
-  (** Alias for {!cons} *)
-end
diff --git a/engine/termops.ml b/engine/termops.ml
index 697b9a5f..3dfb0c34 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -12,11 +14,13 @@ open Util
 open Names
 open Nameops
 open Term
+open Constr
 open Vars
 open Environ
 
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
+module CompactedDecl = Context.Compacted.Declaration
 
 (* Sorts and sort family *)
 
@@ -30,18 +34,14 @@ let pr_sort_family = function
   | InProp -> (str "Prop")
   | InType -> (str "Type")
 
-let pr_name = function
-  | Name id -> pr_id id
-  | Anonymous -> str "_"
-
-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
   hov 1
       (str"fix " ++ int i ++ spc() ++  str"{" ++
          v 0 (prlist_with_sep spc (fun (na,i,ty,bd) ->
-           pr_name na ++ str"/" ++ int i ++ str":" ++ pr_constr ty ++
+           Name.print na ++ str"/" ++ int i ++ str":" ++ pr_constr ty ++
 	   cut() ++ str":=" ++ pr_constr bd) (Array.to_list fixl)) ++
          str"}")
 
@@ -49,25 +49,25 @@ 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() ++
        pr_constr c ++ str")")
   | Lambda (na,t,c) -> hov 1
-      (str"fun " ++ pr_name na ++ str":" ++
+      (str"fun " ++ Name.print na ++ str":" ++
        pr_constr t ++ str" =>" ++ spc() ++ pr_constr c)
   | LetIn (na,b,t,c) -> hov 0
-      (str"let " ++ pr_name na ++ str":=" ++ pr_constr b ++
+      (str"let " ++ Name.print na ++ str":=" ++ pr_constr b ++
        str":" ++ brk(1,2) ++ pr_constr t ++ cut() ++
        pr_constr c)
   | App (c,l) ->  hov 1
@@ -77,9 +77,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 " ++
@@ -92,26 +92,353 @@ let rec pr_constr c = match kind_of_term c with
       hov 1
         (str"cofix " ++ int i ++ spc() ++  str"{" ++
          v 0 (prlist_with_sep spc (fun (na,ty,bd) ->
-           pr_name na ++ str":" ++ pr_constr ty ++
+           Name.print na ++ str":" ++ pr_constr ty ++
            cut() ++ str":=" ++ pr_constr bd) (Array.to_list fixl)) ++
          str"}")
 
-let term_printer = ref (fun _ -> pr_constr)
-let print_constr_env t = !term_printer t
-let print_constr t = !term_printer (Global.env()) t
+let term_printer = ref (fun _env _sigma c -> pr_constr (EConstr.Unsafe.to_constr c))
+let print_constr_env env sigma t = !term_printer env sigma t
+let print_constr t = !term_printer (Global.env()) Evd.empty t
 let set_print_constr f = term_printer := f
 
+module EvMap = Evar.Map
+
+let pr_evar_suggested_name evk sigma =
+  let open Evd in
+  let base_id evk' evi =
+  match evar_ident evk' sigma with
+  | Some id -> id
+  | None -> match evi.evar_source with
+  | _,Evar_kinds.ImplicitArg (c,(n,Some id),b) -> id
+  | _,Evar_kinds.VarInstance id -> id
+  | _,Evar_kinds.QuestionMark (_,Name id) -> id
+  | _,Evar_kinds.GoalEvar -> Id.of_string "Goal"
+  | _ ->
+      let env = reset_with_named_context evi.evar_hyps (Global.env()) in
+      Namegen.id_of_name_using_hdchar env sigma (EConstr.of_constr evi.evar_concl) Anonymous
+  in
+  let names = EvMap.mapi base_id (undefined_map sigma) in
+  let id = EvMap.find evk names in
+  let fold evk' id' (seen, n) =
+    if seen then (seen, n)
+    else if Evar.equal evk evk' then (true, n)
+    else if Id.equal id id' then (seen, succ n)
+    else (seen, n)
+  in
+  let (_, n) = EvMap.fold fold names (false, 0) in
+  if n = 0 then id else Nameops.add_suffix id (string_of_int (pred n))
+
+let pr_existential_key sigma evk =
+let open Evd in
+match evar_ident evk sigma with
+| None ->
+  str "?" ++ Id.print (pr_evar_suggested_name evk sigma)
+| Some id ->
+  str "?" ++ Id.print id
+
+let pr_instance_status (sc,typ) =
+  let open Evd in
+  begin match sc with
+  | IsSubType -> str " [or a subtype of it]"
+  | IsSuperType -> str " [or a supertype of it]"
+  | Conv -> mt ()
+  end ++
+  begin match typ with
+  | CoerceToType -> str " [up to coercion]"
+  | TypeNotProcessed -> mt ()
+  | TypeProcessed -> str " [type is checked]"
+  end
+
+let protect f x =
+  try f x
+  with e -> str "EXCEPTION: " ++ str (Printexc.to_string e)
+
+let print_kconstr a =
+  protect (fun c -> print_constr (EConstr.of_constr c)) a
+
+let pr_meta_map evd =
+  let open Evd in
+  let print_constr = print_kconstr in
+  let pr_name = function
+      Name id -> str"[" ++ Id.print id ++ str"]"
+    | _ -> mt() in
+  let pr_meta_binding = function
+    | (mv,Cltyp (na,b)) ->
+      	hov 0
+	  (pr_meta mv ++ pr_name na ++ str " : " ++
+           print_constr b.rebus ++ fnl ())
+    | (mv,Clval(na,(b,s),t)) ->
+      	hov 0
+	  (pr_meta mv ++ pr_name na ++ str " := " ++
+           print_constr b.rebus ++
+	   str " : " ++ print_constr t.rebus ++
+	   spc () ++ pr_instance_status s ++ fnl ())
+  in
+  prlist pr_meta_binding (meta_list evd)
+
+let pr_decl (decl,ok) =
+  let open NamedDecl in
+  let print_constr = print_kconstr in
+  match decl with
+  | 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 -> 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 " ++ 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 " ++ 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) ->
+      let print_constr = print_kconstr in
+      pr_nth n ++ str " argument of type " ++ print_constr (mkInd ind)
+  | 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 " ++ Id.print id
+  | Evar_kinds.SubEvar evk ->
+    str "subterm of " ++ Evar.print evk
+
+let pr_evar_info evi =
+  let open Evd in
+  let print_constr = print_kconstr in
+  let phyps =
+    try
+      let decls = match Filter.repr (evar_filter evi) with
+      | None -> List.map (fun c -> (c, true)) (evar_context evi)
+      | Some filter -> List.combine (evar_context evi) filter
+      in
+      prlist_with_sep spc pr_decl (List.rev decls)
+    with Invalid_argument _ -> str "Ill-formed filtered context" in
+  let pty = print_constr evi.evar_concl in
+  let pb =
+    match evi.evar_body with
+      | Evar_empty -> mt ()
+      | Evar_defined c -> spc() ++ str"=> "  ++ print_constr c
+  in
+  let candidates =
+    match evi.evar_body, evi.evar_candidates with
+      | Evar_empty, Some l ->
+           spc () ++ str "{" ++
+           prlist_with_sep (fun () -> str "|") print_constr l ++ str "}"
+      | _ ->
+          mt ()
+  in
+  let src = str "(" ++ pr_evar_source (snd evi.evar_source) ++ str ")" in
+  hov 2
+    (str"["  ++ phyps ++ spc () ++ str"|- "  ++ pty ++ pb ++ str"]" ++
+       candidates ++ spc() ++ src)
+
+let compute_evar_dependency_graph sigma =
+  let open Evd in
+  (* Compute the map binding ev to the evars whose body depends on ev *)
+  let fold evk evi acc =
+    let fold_ev evk' acc =
+      let tab =
+        try EvMap.find evk' acc
+        with Not_found -> Evar.Set.empty
+      in
+      EvMap.add evk' (Evar.Set.add evk tab) acc
+    in
+    match evar_body evi with
+    | Evar_empty -> acc
+    | Evar_defined c -> Evar.Set.fold fold_ev (evars_of_term c) acc
+  in
+  Evd.fold fold sigma EvMap.empty
+
+let evar_dependency_closure n sigma =
+  let open Evd in
+  (** Create the DAG of depth [n] representing the recursive dependencies of
+      undefined evars. *)
+  let graph = compute_evar_dependency_graph sigma in
+  let rec aux n curr accu =
+    if Int.equal n 0 then Evar.Set.union curr accu
+    else
+      let fold evk accu =
+        try
+          let deps = EvMap.find evk graph in
+          Evar.Set.union deps accu
+        with Not_found -> accu
+      in
+      (** Consider only the newly added evars *)
+      let ncurr = Evar.Set.fold fold curr Evar.Set.empty in
+      (** Merge the others *)
+      let accu = Evar.Set.union curr accu in
+      aux (n - 1) ncurr accu
+  in
+  let undef = EvMap.domain (undefined_map sigma) in
+  aux n undef Evar.Set.empty
+
+let evar_dependency_closure n sigma =
+  let open Evd in
+  let deps = evar_dependency_closure n sigma in
+  let map = EvMap.bind (fun ev -> find sigma ev) deps in
+  EvMap.bindings map
+
+let has_no_evar sigma =
+  try let () = Evd.fold (fun _ _ () -> raise Exit) sigma () in true
+  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
+  let prl = pr_uctx_level ctx in
+  if UState.is_empty ctx then mt ()
+  else
+    (str"UNIVERSES:"++brk(0,1)++ 
+       h 0 (Univ.pr_universe_context_set prl (UState.context_set ctx)) ++ fnl () ++
+     str"ALGEBRAIC UNIVERSES:"++brk(0,1)++
+     h 0 (Univ.LSet.pr prl (UState.algebraics ctx)) ++ fnl() ++
+     str"UNDEFINED UNIVERSES:"++brk(0,1)++
+     h 0 (Universes.pr_universe_opt_subst (UState.subst ctx)) ++ fnl() ++
+     str "WEAK CONSTRAINTS:"++brk(0,1)++
+     h 0 (UState.pr_weak prl ctx) ++ fnl ())
+
+let print_env_short env =
+  let print_constr = print_kconstr in
+  let pr_rel_decl = function
+    | RelDecl.LocalAssum (n,_) -> Name.print n
+    | RelDecl.LocalDef (n,b,_) -> str "(" ++ Name.print n ++ str " := " ++ print_constr b ++ str ")"
+  in
+  let pr_named_decl = NamedDecl.to_rel_decl %> pr_rel_decl in
+  let nc = List.rev (named_context env) in
+  let rc = List.rev (rel_context env) in
+    str "[" ++ pr_sequence pr_named_decl nc ++ str "]" ++ spc () ++
+    str "[" ++ pr_sequence pr_rel_decl rc ++ str "]"
+
+let pr_evar_constraints sigma pbs =
+  let pr_evconstr (pbty, env, t1, t2) =
+    let env =
+      (** We currently allow evar instances to refer to anonymous de
+          Bruijn indices, so we protect the error printing code in this
+          case by giving names to every de Bruijn variable in the
+          rel_context of the conversion problem. MS: we should rather
+          stop depending on anonymous variables, they can be used to
+          indicate independency. Also, this depends on a strategy for
+          naming/renaming. *)
+      Namegen.make_all_name_different env sigma
+    in
+    print_env_short env ++ spc () ++ str "|-" ++ spc () ++
+      protect (print_constr_env env sigma) (EConstr.of_constr t1) ++ spc () ++
+      str (match pbty with
+            | Reduction.CONV -> "=="
+            | Reduction.CUMUL -> "<=") ++
+      spc () ++ protect (print_constr_env env Evd.empty) (EConstr.of_constr t2)
+  in
+  prlist_with_sep fnl pr_evconstr pbs
+
+let pr_evar_map_gen with_univs pr_evars sigma =
+  let uvs = Evd.evar_universe_context sigma in
+  let (_, conv_pbs) = Evd.extract_all_conv_pbs sigma in
+  let evs = if has_no_evar sigma then mt () else pr_evars sigma ++ fnl ()
+  and svs = if with_univs then pr_evar_universe_context uvs else mt ()
+  and cstrs =
+    if List.is_empty conv_pbs then mt ()
+    else
+    str "CONSTRAINTS:" ++ brk (0, 1) ++
+      pr_evar_constraints sigma conv_pbs ++ fnl ()
+  and metas =
+    if List.is_empty (Evd.meta_list sigma) then mt ()
+    else
+      str "METAS:" ++ brk (0, 1) ++ pr_meta_map sigma
+  in
+  evs ++ svs ++ cstrs ++ metas
+
+let pr_evar_list sigma l =
+  let open Evd in
+  let pr (ev, evi) =
+    h 0 (Evar.print ev ++
+      str "==" ++ pr_evar_info evi ++
+      (if evi.evar_body == Evar_empty
+       then str " {" ++ pr_existential_key sigma ev ++ str "}"
+       else mt ()))
+  in
+  h 0 (prlist_with_sep fnl pr l)
+
+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
+    | Evar_empty -> l := (evk, evi) :: !l
+    | Evar_defined _ -> ()
+  in
+  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()
+
+let pr_evar_by_filter filter sigma =
+  let open Evd in
+  let elts = Evd.fold (fun evk evi accu -> (evk, evi) :: accu) sigma [] in
+  let elts = List.rev elts in
+  let is_def (_, evi) = match evi.evar_body with
+  | Evar_defined _ -> true
+  | Evar_empty -> false
+  in
+  let (defined, undefined) = List.partition is_def elts in
+  let filter (evk, evi) = filter evk evi in
+  let defined = List.filter filter defined in
+  let undefined = List.filter filter undefined in
+  let prdef =
+    if List.is_empty defined then mt ()
+    else str "DEFINED EVARS:" ++ brk (0, 1) ++
+      pr_evar_list sigma defined
+  in
+  let prundef =
+    if List.is_empty undefined then mt ()
+    else str "UNDEFINED EVARS:" ++ brk (0, 1) ++
+      pr_evar_list sigma undefined
+  in
+  prdef ++ prundef
+
+let pr_evar_map ?(with_univs=true) depth sigma =
+  pr_evar_map_gen with_univs (fun sigma -> pr_evar_by_depth depth sigma) sigma
+
+let pr_evar_map_filter ?(with_univs=true) filter sigma =
+  pr_evar_map_gen with_univs (fun sigma -> pr_evar_by_filter filter sigma) sigma
+
+let pr_metaset metas =
+  str "[" ++ pr_sequence pr_meta (Evd.Metaset.elements metas) ++ str "]"
+
 let pr_var_decl env decl =
   let open NamedDecl in
   let pbody = match decl with
     | LocalAssum _ ->  mt ()
     | LocalDef (_,c,_) ->
 	(* Force evaluation *)
-	let pb = print_constr_env env c in
+	let c = EConstr.of_constr c in
+	let pb = print_constr_env env Evd.empty c in
 	  (str" := " ++ pb ++ cut () ) in
-  let pt = print_constr_env env (get_type decl) 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
@@ -119,12 +446,13 @@ let pr_rel_decl env decl =
     | LocalAssum _ -> mt ()
     | LocalDef (_,c,_) ->
 	(* Force evaluation *)
-	let pb = print_constr_env env c in
+	let c = EConstr.of_constr c in
+	let pb = print_constr_env env Evd.empty c in
 	  (str":=" ++ spc () ++ pb ++ spc ()) in
-  let ptyp = print_constr_env env (get_type decl) in
+  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
@@ -157,6 +485,7 @@ let print_env env =
 let rel_vect n m = Array.init m (fun i -> mkRel(n+m-i))
 
 let rel_list n m =
+  let open EConstr in
   let rec reln l p =
     if p>m then l else reln (mkRel(n+p)::l) (p+1)
   in
@@ -164,6 +493,7 @@ let rel_list n m =
 
 let push_rel_assum (x,t) env =
   let open RelDecl in
+  let open EConstr in
   push_rel (LocalAssum (x,t)) env
 
 let push_rels_assum assums =
@@ -177,7 +507,7 @@ let push_named_rec_types (lna,typarray,_) env =
       (fun i na t ->
 	 match na with
 	   | Name id -> LocalAssum (id, lift i t)
-	   | Anonymous -> anomaly (Pp.str "Fix declarations must be named"))
+	   | Anonymous -> anomaly (Pp.str "Fix declarations must be named."))
       lna typarray in
   Array.fold_left
     (fun e assum -> push_named assum e) env ctxt
@@ -197,21 +527,17 @@ let lookup_rel_id id sign =
   lookrec 1 sign
 
 (* Constructs either [forall x:t, c] or [let x:=b:t in c] *)
-let mkProd_or_LetIn decl c =
-  let open RelDecl in
-  match decl with
-    | LocalAssum (na,t) -> mkProd (na, t, c)
-    | LocalDef (na,b,t) -> mkLetIn (na, b, t, c)
-
+let mkProd_or_LetIn = EConstr.mkProd_or_LetIn
 (* Constructs either [forall x:t, c] or [c] in which [x] is replaced by [b] *)
 let mkProd_wo_LetIn decl c =
+  let open EConstr in
   let open RelDecl in
   match decl with
     | LocalAssum (na,t) -> mkProd (na, t, c)
-    | LocalDef (_,b,_) -> subst1 b c
+    | LocalDef (_,b,_) -> Vars.subst1 b c
 
-let it_mkProd init = List.fold_left (fun c (n,t)  -> mkProd (n, t, c)) init
-let it_mkLambda init = List.fold_left (fun c (n,t)  -> mkLambda (n, t, c)) init
+let it_mkProd init = List.fold_left (fun c (n,t)  -> EConstr.mkProd (n, t, c)) init
+let it_mkLambda init = List.fold_left (fun c (n,t)  -> EConstr.mkLambda (n, t, c)) init
 
 let it_named_context_quantifier f ~init =
   List.fold_left (fun c d -> f d c) init
@@ -219,9 +545,9 @@ let it_named_context_quantifier f ~init =
 let it_mkProd_or_LetIn init = it_named_context_quantifier mkProd_or_LetIn ~init
 let it_mkProd_wo_LetIn init = it_named_context_quantifier mkProd_wo_LetIn ~init
 let it_mkLambda_or_LetIn init = it_named_context_quantifier mkLambda_or_LetIn ~init
-let it_mkNamedProd_or_LetIn init = it_named_context_quantifier mkNamedProd_or_LetIn ~init
+let it_mkNamedProd_or_LetIn init = it_named_context_quantifier EConstr.mkNamedProd_or_LetIn ~init
 let it_mkNamedProd_wo_LetIn init = it_named_context_quantifier mkNamedProd_wo_LetIn ~init
-let it_mkNamedLambda_or_LetIn init = it_named_context_quantifier mkNamedLambda_or_LetIn ~init
+let it_mkNamedLambda_or_LetIn init = it_named_context_quantifier EConstr.mkNamedLambda_or_LetIn ~init
 
 let it_mkLambda_or_LetIn_from_no_LetIn c decls =
   let open RelDecl in
@@ -234,37 +560,39 @@ let it_mkLambda_or_LetIn_from_no_LetIn c decls =
 (* *)
 
 (* strips head casts and flattens head applications *)
-let rec strip_head_cast c = match kind_of_term c with
+let rec strip_head_cast sigma c = match EConstr.kind sigma c with
   | App (f,cl) ->
-      let rec collapse_rec f cl2 = match kind_of_term f with
+      let rec collapse_rec f cl2 = match EConstr.kind sigma f with
 	| App (g,cl1) -> collapse_rec g (Array.append cl1 cl2)
 	| Cast (c,_,_) -> collapse_rec c cl2
-	| _ -> if Int.equal (Array.length cl2) 0 then f else mkApp (f,cl2)
+	| _ -> if Int.equal (Array.length cl2) 0 then f else EConstr.mkApp (f,cl2)
       in
       collapse_rec f cl
-  | Cast (c,_,_) -> strip_head_cast c
+  | Cast (c,_,_) -> strip_head_cast sigma c
   | _ -> c
 
-let rec drop_extra_implicit_args c = match kind_of_term c with
+let rec drop_extra_implicit_args sigma c = match EConstr.kind sigma c with
   (* Removed trailing extra implicit arguments, what improves compatibility
      for constants with recently added maximal implicit arguments *)
-  | App (f,args) when isEvar (Array.last args) ->
-      drop_extra_implicit_args
+  | App (f,args) when EConstr.isEvar sigma (Array.last args) ->
+      let open EConstr in
+      drop_extra_implicit_args sigma
 	(mkApp (f,fst (Array.chop (Array.length args - 1) args)))
   | _ -> c
 
 (* Get the last arg of an application *)
-let last_arg c = match kind_of_term c with
+let last_arg sigma c = match EConstr.kind sigma c with
   | App (f,cl) -> Array.last cl
-  | _ -> anomaly (Pp.str "last_arg")
+  | _ -> anomaly (Pp.str "last_arg.")
 
 (* Get the last arg of an application *)
-let decompose_app_vect c =
-  match kind_of_term c with
+let decompose_app_vect sigma c =
+  match EConstr.kind sigma c with
   | App (f,cl) -> (f, cl)
   | _ -> (c,[||])
 
 let adjust_app_list_size f1 l1 f2 l2 =
+  let open EConstr in
   let len1 = List.length l1 and len2 = List.length l2 in
   if Int.equal len1 len2 then (f1,l1,f2,l2)
   else if len1 < len2 then
@@ -275,38 +603,15 @@ let adjust_app_list_size f1 l1 f2 l2 =
     (applist (f1,extras), restl1, f2, l2)
 
 let adjust_app_array_size f1 l1 f2 l2 =
+  let open EConstr in
   let len1 = Array.length l1 and len2 = Array.length l2 in
   if Int.equal len1 len2 then (f1,l1,f2,l2)
   else if len1 < len2 then
     let extras,restl2 = Array.chop (len2-len1) l2 in
-    (f1, l1, appvect (f2,extras), restl2)
+    (f1, l1, mkApp (f2,extras), restl2)
   else
     let extras,restl1 = Array.chop (len1-len2) l1 in
-    (appvect (f1,extras), restl1, f2, l2)
-
-(* [map_constr_with_named_binders g f l c] maps [f l] on the immediate
-   subterms of [c]; it carries an extra data [l] (typically a name
-   list) which is processed by [g na] (which typically cons [na] to
-   [l]) at each binder traversal (with name [na]); it is not recursive
-   and the order with which subterms are processed is not specified *)
-
-let map_constr_with_named_binders g f l c = match kind_of_term c with
-  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
-    | Construct _) -> c
-  | Cast (c,k,t) -> mkCast (f l c, k, f l t)
-  | Prod (na,t,c) -> mkProd (na, f l t, f (g na l) c)
-  | Lambda (na,t,c) -> mkLambda (na, f l t, f (g na l) c)
-  | LetIn (na,b,t,c) -> mkLetIn (na, f l b, f l t, f (g na l) c)
-  | App (c,al) -> mkApp (f l c, Array.map (f l) al)
-  | Proj (p,c) -> mkProj (p, f l c)
-  | Evar (e,al) -> mkEvar (e, Array.map (f l) al)
-  | Case (ci,p,c,bl) -> mkCase (ci, f l p, f l c, Array.map (f l) bl)
-  | Fix (ln,(lna,tl,bl)) ->
-      let l' = Array.fold_left (fun l na -> g na l) l lna in
-      mkFix (ln,(lna,Array.map (f l) tl,Array.map (f l') bl))
-  | CoFix(ln,(lna,tl,bl)) ->
-      let l' = Array.fold_left (fun l na -> g na l) l lna in
-      mkCoFix (ln,(lna,Array.map (f l) tl,Array.map (f l') bl))
+    (mkApp (f1,extras), restl1, f2, l2)
 
 (* [map_constr_with_binders_left_to_right g f n c] maps [f n] on the
    immediate subterms of [c]; it carries an extra data [n] (typically
@@ -319,6 +624,8 @@ let map_constr_with_named_binders g f l c = match kind_of_term c with
    (co-)fixpoint) *)
 
 let fold_rec_types g (lna,typarray,_) e =
+  let open EConstr in
+  let open Vars in
   let ctxt = Array.map2_i (fun i na t -> RelDecl.LocalAssum (na, lift i t)) lna typarray in
   Array.fold_left (fun e assum -> g assum e) e ctxt
 
@@ -334,9 +641,10 @@ let map_left2 f a g b =
     r, s
   end
 
-let map_constr_with_binders_left_to_right g f l c =
+let map_constr_with_binders_left_to_right sigma g f l c =
   let open RelDecl in
-  match kind_of_term c with
+  let open EConstr in
+  match EConstr.kind sigma c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> c
   | Cast (b,k,t) -> 
@@ -398,9 +706,10 @@ let map_constr_with_binders_left_to_right g f l c =
 	else mkCoFix (ln,(lna,tl',bl'))
 
 (* strong *)
-let map_constr_with_full_binders g f l cstr =
+let map_constr_with_full_binders sigma g f l cstr =
+  let open EConstr in
   let open RelDecl in
-  match kind_of_term cstr with
+  match EConstr.kind sigma cstr with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> cstr
   | Cast (c,k, t) ->
@@ -409,16 +718,16 @@ let map_constr_with_full_binders g f l cstr =
       if c==c' && t==t' then cstr else mkCast (c', k, t')
   | Prod (na,t,c) ->
       let t' = f l t in
-      let c' = f (g (LocalAssum (na,t)) l) c in
+      let c' = f (g (LocalAssum (na, t)) l) c in
       if t==t' && c==c' then cstr else mkProd (na, t', c')
   | Lambda (na,t,c) ->
       let t' = f l t in
-      let c' = f (g (LocalAssum (na,t)) l) c in
+      let c' = f (g (LocalAssum (na, t)) l) c in
       if t==t' && c==c' then cstr else  mkLambda (na, t', c')
   | LetIn (na,b,t,c) ->
       let b' = f l b in
       let t' = f l t in
-      let c' = f (g (LocalDef (na,b,t)) l) c in
+      let c' = f (g (LocalDef (na, b, t)) l) c in
       if b==b' && t==t' && c==c' then cstr else mkLetIn (na, b', t', c')
   | App (c,al) ->
       let c' = f l c in
@@ -439,7 +748,7 @@ let map_constr_with_full_binders g f l cstr =
   | Fix (ln,(lna,tl,bl)) ->
       let tl' = Array.map (f l) tl in
       let l' =
-        Array.fold_left2 (fun l na t -> g (LocalAssum (na,t)) l) l lna tl in
+        Array.fold_left2 (fun l na t -> g (LocalAssum (na, t)) l) l lna tl in
       let bl' = Array.map (f l') bl in
       if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl'
       then cstr
@@ -447,7 +756,7 @@ let map_constr_with_full_binders g f l cstr =
   | CoFix(ln,(lna,tl,bl)) ->
       let tl' = Array.map (f l) tl in
       let l' =
-        Array.fold_left2 (fun l na t -> g (LocalAssum (na,t)) l) l lna tl in
+        Array.fold_left2 (fun l na t -> g (LocalAssum (na, t)) l) l lna tl in
       let bl' = Array.map (f l') bl in
       if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl'
       then cstr
@@ -460,39 +769,40 @@ let map_constr_with_full_binders g f l cstr =
    index) which is processed by [g] (which typically add 1 to [n]) at
    each binder traversal; it is not recursive *)
 
-let fold_constr_with_full_binders g f n acc c =
+let fold_constr_with_full_binders sigma g f n acc c =
   let open RelDecl in
-  match kind_of_term c with
+  let inj c = EConstr.Unsafe.to_constr c in
+  match EConstr.kind sigma 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
-  | Lambda (na,t,c) -> f (g (LocalAssum (na,t)) n) (f n acc t) c
-  | LetIn (na,b,t,c) -> f (g (LocalDef (na,b,t)) n) (f n (f n acc b) t) c
+  | Prod (na,t,c) -> f (g (LocalAssum (na, inj t)) n) (f n acc t) c
+  | Lambda (na,t,c) -> f (g (LocalAssum (na, inj t)) n) (f n acc t) c
+  | LetIn (na,b,t,c) -> f (g (LocalDef (na, inj b, inj t)) n) (f n (f n acc b) t) c
   | App (c,l) -> Array.fold_left (f n) (f n acc c) l
   | Proj (p,c) -> f n acc c
   | Evar (_,l) -> Array.fold_left (f n) acc l
   | Case (_,p,c,bl) -> Array.fold_left (f n) (f n (f n acc p) c) bl
   | Fix (_,(lna,tl,bl)) ->
-      let n' = CArray.fold_left2 (fun c n t -> g (LocalAssum (n,t)) c) n lna tl in
+      let n' = CArray.fold_left2 (fun c n t -> g (LocalAssum (n, inj t)) c) n lna tl in
       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
   | CoFix (_,(lna,tl,bl)) ->
-      let n' = CArray.fold_left2 (fun c n t -> g (LocalAssum (n,t)) c) n lna tl in
+      let n' = CArray.fold_left2 (fun c n t -> g (LocalAssum (n, inj t)) c) n lna tl in
       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 fold_constr_with_binders g f n acc c =
-  fold_constr_with_full_binders (fun _ x -> g x) f n acc c
+let fold_constr_with_binders sigma g f n acc c =
+  fold_constr_with_full_binders sigma (fun _ x -> g x) f n acc c
 
 (* [iter_constr_with_full_binders g f acc c] iters [f acc] on the immediate
    subterms of [c]; it carries an extra data [acc] which is processed by [g] at
    each binder traversal; it is not recursive and the order with which
    subterms are processed is not specified *)
 
-let iter_constr_with_full_binders g f l c =
+let iter_constr_with_full_binders sigma g f l c =
   let open RelDecl in
-  match kind_of_term c with
+  match EConstr.kind sigma c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> ()
   | Cast (c,_, t) -> f l c; f l t
@@ -518,29 +828,29 @@ let iter_constr_with_full_binders g f l c =
 
 exception Occur
 
-let occur_meta c =
-  let rec occrec c = match kind_of_term c with
+let occur_meta sigma c =
+  let rec occrec c = match EConstr.kind sigma c with
     | Meta _ -> raise Occur
-    | _ -> iter_constr occrec c
+    | _ -> EConstr.iter sigma occrec c
   in try occrec c; false with Occur -> true
 
-let occur_existential c =
-  let rec occrec c = match kind_of_term c with
+let occur_existential sigma c =
+  let rec occrec c = match EConstr.kind sigma c with
     | Evar _ -> raise Occur
-    | _ -> iter_constr occrec c
+    | _ -> EConstr.iter sigma occrec c
   in try occrec c; false with Occur -> true
 
-let occur_meta_or_existential c =
-  let rec occrec c = match kind_of_term c with
+let occur_meta_or_existential sigma c =
+  let rec occrec c = match EConstr.kind sigma c with
     | Evar _ -> raise Occur
     | Meta _ -> raise Occur
-    | _ -> iter_constr occrec c
+    | _ -> EConstr.iter sigma occrec c
   in try occrec c; false with Occur -> true
 
-let occur_evar n c =
-  let rec occur_rec c = match kind_of_term c with
+let occur_evar sigma n c =
+  let rec occur_rec c = match EConstr.kind sigma c with
     | Evar (sp,_) when Evar.equal sp n -> raise Occur
-    | _ -> iter_constr occur_rec c
+    | _ -> EConstr.iter sigma occur_rec c
   in
   try occur_rec c; false with Occur -> true
 
@@ -548,109 +858,108 @@ let occur_in_global env id constr =
   let vars = vars_of_global env constr in
   if Id.Set.mem id vars then raise Occur
 
-let occur_var env id c =
+let occur_var env sigma id c =
   let rec occur_rec c =
-    match kind_of_term c with
-    | Var _ | Const _ | Ind _ | Construct _ -> occur_in_global env id c
-    | _ -> iter_constr occur_rec c
+    match EConstr.kind sigma c with
+    | Var _ | Const _ | Ind _ | Construct _ -> occur_in_global env id (EConstr.to_constr sigma c)
+    | _ -> EConstr.iter sigma occur_rec c
   in
   try occur_rec c; false with Occur -> true
 
-let occur_var_in_decl env hyp decl =
+let occur_var_in_decl env sigma hyp decl =
   let open NamedDecl in
   match decl with
-    | LocalAssum (_,typ) -> occur_var env hyp typ
+    | LocalAssum (_,typ) -> occur_var env sigma hyp typ
     | LocalDef (_, body, typ) ->
-        occur_var env hyp typ ||
-        occur_var env hyp body
+        occur_var env sigma hyp typ ||
+        occur_var env sigma hyp body
 
-let local_occur_var id c =
-  let rec occur c = match kind_of_term c with
+let local_occur_var sigma id c =
+  let rec occur c = match EConstr.kind sigma c with
   | Var id' -> if Id.equal id id' then raise Occur
-  | _ -> Constr.iter occur c
+  | _ -> EConstr.iter sigma occur c
   in
   try occur c; false with Occur -> true
 
   (* returns the list of free debruijn indices in a term *)
 
-let free_rels m =
-  let rec frec depth acc c = match kind_of_term c with
+let free_rels sigma m =
+  let rec frec depth acc c = match EConstr.kind sigma c with
     | Rel n       -> if n >= depth then Int.Set.add (n-depth+1) acc else acc
-    | _ -> fold_constr_with_binders succ frec depth acc c
+    | _ -> fold_constr_with_binders sigma succ frec depth acc c
   in
   frec 1 Int.Set.empty m
 
 (* collects all metavar occurrences, in left-to-right order, preserving
  * repetitions and all. *)
 
-let collect_metas c =
+let collect_metas sigma c =
   let rec collrec acc c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
       | Meta mv -> List.add_set Int.equal mv acc
-      | _       -> fold_constr collrec acc c
+      | _       -> EConstr.fold sigma collrec acc c
   in
   List.rev (collrec [] c)
 
 (* collects all vars; warning: this is only visible vars, not dependencies in
    all section variables; for the latter, use global_vars_set *)
-let collect_vars c =
-  let rec aux vars c = match kind_of_term c with
+let collect_vars sigma c =
+  let rec aux vars c = match EConstr.kind sigma c with
   | Var id -> Id.Set.add id vars
-  | _ -> fold_constr aux vars c in
+  | _ -> EConstr.fold sigma aux vars c in
   aux Id.Set.empty c
 
 let vars_of_global_reference env gr =
-  let c, _ = Universes.unsafe_constr_of_global gr in
+  let c, _ = Global.constr_of_global_in_context env gr in
   vars_of_global (Global.env ()) c
 
 (* Tests whether [m] is a subterm of [t]:
    [m] is appropriately lifted through abstractions of [t] *)
 
-let dependent_main noevar univs m t =
-  let eqc x y = if univs then fst (Universes.eq_constr_universes x y) else eq_constr_nounivs x y in
+let dependent_main noevar sigma m t =
+  let open EConstr in
+  let eqc x y = eq_constr_nounivs sigma x y in
   let rec deprec m t =
     if eqc m t then
       raise Occur
     else
-      match kind_of_term m, kind_of_term t with
+      match EConstr.kind sigma m, EConstr.kind sigma t with
 	| App (fm,lm), App (ft,lt) when Array.length lm < Array.length lt ->
 	    deprec m (mkApp (ft,Array.sub lt 0 (Array.length lm)));
 	    CArray.Fun1.iter deprec m
 	      (Array.sub lt
 		(Array.length lm) ((Array.length lt) - (Array.length lm)))
-	| _, Cast (c,_,_) when noevar && isMeta c -> ()
+	| _, Cast (c,_,_) when noevar && isMeta sigma c -> ()
 	| _, Evar _ when noevar -> ()
-	| _ -> iter_constr_with_binders (fun c -> lift 1 c) deprec m t
+	| _ -> EConstr.iter_with_binders sigma (fun c -> Vars.lift 1 c) deprec m t
   in
   try deprec m t; false with Occur -> true
 
-let dependent = dependent_main false false
-let dependent_no_evar = dependent_main true false
-
-let dependent_univs = dependent_main false true
-let dependent_univs_no_evar = dependent_main true true
+let dependent sigma c t = dependent_main false sigma c t
+let dependent_no_evar sigma c t = dependent_main true sigma c t
 
-let dependent_in_decl a decl =
+let dependent_in_decl sigma a decl =
   let open NamedDecl in
   match decl with
-    | LocalAssum (_,t) -> dependent a t
-    | LocalDef (_, body, t) -> dependent a body || dependent a t
+    | LocalAssum (_,t) -> dependent sigma a t
+    | LocalDef (_, body, t) -> dependent sigma a body || dependent sigma a t
 
-let count_occurrences m t =
+let count_occurrences sigma m t =
+  let open EConstr in
   let n = ref 0 in
   let rec countrec m t =
-    if eq_constr m t then
+    if EConstr.eq_constr sigma m t then
       incr n
     else
-      match kind_of_term m, kind_of_term t with
+      match EConstr.kind sigma m, EConstr.kind sigma t with
 	| App (fm,lm), App (ft,lt) when Array.length lm < Array.length lt ->
 	    countrec m (mkApp (ft,Array.sub lt 0 (Array.length lm)));
 	    Array.iter (countrec m)
 	      (Array.sub lt
 		(Array.length lm) ((Array.length lt) - (Array.length lm)))
-	| _, Cast (c,_,_) when isMeta c -> ()
+	| _, Cast (c,_,_) when isMeta sigma c -> ()
 	| _, Evar _ -> ()
-	| _ -> iter_constr_with_binders (lift 1) countrec m t
+	| _ -> EConstr.iter_with_binders sigma (Vars.lift 1) countrec m t
   in
   countrec m t;
   !n
@@ -658,7 +967,7 @@ let count_occurrences m t =
 (* Synonymous *)
 let occur_term = dependent
 
-let pop t = lift (-1) t
+let pop t = EConstr.Vars.lift (-1) t
 
 (***************************)
 (*  bindings functions *)
@@ -668,35 +977,57 @@ type meta_type_map = (metavariable * types) list
 
 type meta_value_map = (metavariable * constr) list
 
+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
+  | _ -> c
+
+(* flattens application lists throwing casts in-between *)
+let collapse_appl sigma c = match EConstr.kind sigma c with
+  | App (f,cl) ->
+    if EConstr.isCast sigma f then
+      let rec collapse_rec f cl2 =
+        match EConstr.kind sigma (strip_outer_cast sigma f) with
+        | App (g,cl1) -> collapse_rec g (Array.append cl1 cl2)
+        | _ -> EConstr.mkApp (f,cl2)
+      in
+      collapse_rec f cl
+    else c
+  | _ -> c
 
 (* First utilities for avoiding telescope computation for subst_term *)
 
-let prefix_application eq_fun (k,c) (t : constr) =
-  let c' = collapse_appl c and t' = collapse_appl t in
-  match kind_of_term c', kind_of_term t' with
+let prefix_application sigma eq_fun (k,c) t =
+  let open EConstr in
+  let c' = collapse_appl sigma c and t' = collapse_appl sigma t in
+  match EConstr.kind sigma c', EConstr.kind sigma t' with
     | App (f1,cl1), App (f2,cl2) ->
 	let l1 = Array.length cl1
 	and l2 = Array.length cl2 in
 	if l1 <= l2
-	   && eq_fun c' (mkApp (f2, Array.sub cl2 0 l1)) then
+	   && eq_fun sigma c' (mkApp (f2, Array.sub cl2 0 l1)) then
 	  Some (mkApp (mkRel k, Array.sub cl2 l1 (l2 - l1)))
 	else
 	  None
     | _ -> None
 
-let my_prefix_application eq_fun (k,c) (by_c : constr) (t : constr) =
-  let c' = collapse_appl c and t' = collapse_appl t in
-  match kind_of_term c', kind_of_term t' with
+let my_prefix_application sigma eq_fun (k,c) by_c t =
+  let open EConstr in
+  let c' = collapse_appl sigma c and t' = collapse_appl sigma t in
+  match EConstr.kind sigma c', EConstr.kind sigma t' with
     | App (f1,cl1), App (f2,cl2) ->
 	let l1 = Array.length cl1
 	and l2 = Array.length cl2 in
 	if l1 <= l2
-	   && eq_fun c' (mkApp (f2, Array.sub cl2 0 l1)) then
-	  Some (mkApp ((lift k by_c), Array.sub cl2 l1 (l2 - l1)))
+	   && eq_fun sigma c' (mkApp (f2, Array.sub cl2 0 l1)) then
+	  Some (mkApp ((Vars.lift k by_c), Array.sub cl2 l1 (l2 - l1)))
 	else
 	  None
     | _ -> None
@@ -705,40 +1036,42 @@ let my_prefix_application eq_fun (k,c) (by_c : constr) (t : constr) =
    substitutes [(Rel 1)] for all occurrences of term [c] in a term [t];
    works if [c] has rels *)
 
-let subst_term_gen eq_fun c t =
+let subst_term_gen sigma eq_fun c t =
+  let open EConstr in
+  let open Vars in
   let rec substrec (k,c as kc) t =
-    match prefix_application eq_fun kc t with
+    match prefix_application sigma eq_fun kc t with
       | Some x -> x
       | None ->
-    if eq_fun c t then mkRel k
+    if eq_fun sigma c t then mkRel k
     else
-      map_constr_with_binders (fun (k,c) -> (k+1,lift 1 c)) substrec kc t
+      EConstr.map_with_binders sigma (fun (k,c) -> (k+1,lift 1 c)) substrec kc t
   in
   substrec (1,c) t
 
-let subst_term = subst_term_gen eq_constr
+let subst_term sigma c t = subst_term_gen sigma EConstr.eq_constr c t
 
 (* Recognizing occurrences of a given subterm in a term :
    [replace_term c1 c2 t] substitutes [c2] for all occurrences of
    term [c1] in a term [t]; works if [c1] and [c2] have rels *)
 
-let replace_term_gen eq_fun c by_c in_t =
+let replace_term_gen sigma eq_fun c by_c in_t =
   let rec substrec (k,c as kc) t =
-    match my_prefix_application eq_fun kc by_c t with
+    match my_prefix_application sigma eq_fun kc by_c t with
       | Some x -> x
       | None ->
-    (if eq_fun c t then (lift k by_c) else
-      map_constr_with_binders (fun (k,c) -> (k+1,lift 1 c))
+    (if eq_fun sigma c t then (EConstr.Vars.lift k by_c) else
+      EConstr.map_with_binders sigma (fun (k,c) -> (k+1,EConstr.Vars.lift 1 c))
 	substrec kc t)
   in
   substrec (0,c) in_t
 
-let replace_term = replace_term_gen eq_constr
+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
@@ -784,15 +1117,34 @@ let is_section_variable id =
   try let _ = Global.lookup_named id in true
   with Not_found -> false
 
-let isGlobalRef c =
-  match kind_of_term c with
+let global_of_constr sigma c =
+  let open Globnames in
+  match EConstr.kind sigma c with
+  | Const (c, u) -> ConstRef c, u
+  | Ind (i, u) -> IndRef i, u
+  | Construct (c, u) -> ConstructRef c, u
+  | Var id -> VarRef id, EConstr.EInstance.empty
+  | _ -> raise Not_found
+
+let is_global sigma c t =
+  let open Globnames in
+  match c, EConstr.kind sigma 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.equal id id'
+  | _ -> false
+
+let isGlobalRef sigma c =
+  match EConstr.kind sigma c with
   | Const _ | Ind _ | Construct _ | Var _ -> true
   | _ -> false
 
-let is_template_polymorphic env f =
-  match kind_of_term f with
-  | Ind ind -> Environ.template_polymorphic_pind ind env
-  | Const c -> Environ.template_polymorphic_pconstant c env
+let is_template_polymorphic env sigma f =
+  match EConstr.kind sigma f with
+  | Ind (ind, u) ->
+    if not (EConstr.EInstance.is_empty u) then false
+    else Environ.template_polymorphic_ind ind env
   | _ -> false
 
 let base_sort_cmp pb s0 s1 =
@@ -802,21 +1154,54 @@ let base_sort_cmp pb s0 s1 =
     | (Type u1, Type u2) -> true
     | _ -> false
 
+let rec is_Prop sigma c = match EConstr.kind sigma c with
+  | Sort u ->
+    begin match EConstr.ESorts.kind sigma u with
+    | Prop Null -> true
+    | _ -> false
+    end
+  | 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 f cv_pb t1 t2 =
-  match kind_of_term t1, kind_of_term t2 with
-      Sort s1, Sort s2 -> base_sort_cmp cv_pb s1 s2
+let compare_constr_univ sigma f cv_pb t1 t2 =
+  let open EConstr in
+  match EConstr.kind sigma t1, EConstr.kind sigma t2 with
+      Sort s1, Sort s2 -> base_sort_cmp cv_pb (ESorts.kind sigma s1) (ESorts.kind sigma s2)
     | Prod (_,t1,c1), Prod (_,t2,c2) ->
 	f Reduction.CONV t1 t2 && f cv_pb c1 c2
-    | _ -> compare_constr (fun t1 t2 -> f Reduction.CONV t1 t2) t1 t2
+    | Const (c, u), Const (c', u') -> Constant.equal c c'
+    | Ind (i, _), Ind (i', _) -> eq_ind i i'
+    | Construct (i, _), Construct (i', _) -> eq_constructor i i'
+    | _ -> EConstr.compare_constr sigma (fun t1 t2 -> f Reduction.CONV t1 t2) t1 t2
 
-let rec constr_cmp cv_pb t1 t2 = compare_constr_univ constr_cmp cv_pb t1 t2
+let constr_cmp sigma cv_pb t1 t2 =
+  let rec compare cv_pb t1 t2 = compare_constr_univ sigma compare cv_pb t1 t2 in
+  compare cv_pb t1 t2
 
-let eq_constr t1 t2 = constr_cmp Reduction.CONV t1 t2
+let eq_constr sigma t1 t2 = constr_cmp sigma Reduction.CONV t1 t2
 
 (* App(c,[t1,...tn]) -> ([c,t1,...,tn-1],tn)
    App(c,[||]) -> ([],c) *)
-let split_app c = match kind_of_term c with
+let split_app sigma c = match EConstr.kind sigma c with
     App(c,l) ->
       let len = Array.length l in
       if Int.equal len 0 then ([],c) else
@@ -825,28 +1210,30 @@ let split_app c = match kind_of_term c with
 	c::(Array.to_list prev), last
   | _ -> assert false
 
-type subst = (Context.Rel.t * constr) Evar.Map.t
+type subst = (EConstr.rel_context * EConstr.constr) Evar.Map.t
 
 exception CannotFilter
 
-let filtering env cv_pb c1 c2 =
+let filtering sigma env cv_pb c1 c2 =
+  let open EConstr in
+  let open Vars in
   let evm = ref Evar.Map.empty in
   let define cv_pb e1 ev c1 =
     try let (e2,c2) = Evar.Map.find ev !evm in
     let shift = List.length e1 - List.length e2 in
-    if constr_cmp cv_pb c1 (lift shift c2) then () else raise CannotFilter
+    if constr_cmp sigma cv_pb c1 (lift shift c2) then () else raise CannotFilter
     with Not_found ->
       evm := Evar.Map.add ev (e1,c1) !evm
   in
   let rec aux env cv_pb c1 c2 =
-    match kind_of_term c1, kind_of_term c2 with
+    match EConstr.kind sigma c1, EConstr.kind sigma c2 with
       | App _, App _ ->
-        let ((p1,l1),(p2,l2)) = (split_app c1),(split_app c2) in
+        let ((p1,l1),(p2,l2)) = (split_app sigma c1),(split_app sigma c2) in
         let () = aux env cv_pb l1 l2 in
         begin match p1, p2 with
         | [], [] -> ()
         | (h1 :: p1), (h2 :: p2) ->
-          aux env cv_pb (applistc h1 p1) (applistc h2 p2)
+          aux env cv_pb (applist (h1, p1)) (applist (h2, p2))
         | _ -> assert false
         end
       | Prod (n,t1,c1), Prod (_,t2,c2) ->
@@ -855,52 +1242,52 @@ let filtering env cv_pb c1 c2 =
       | _, Evar (ev,_) -> define cv_pb env ev c1
       | Evar (ev,_), _ -> define cv_pb env ev c2
       | _ ->
-	  if compare_constr_univ
+	  if compare_constr_univ sigma
 	  (fun pb c1 c2 -> aux env pb c1 c2; true) cv_pb c1 c2 then ()
 	  else raise CannotFilter
 	  (* TODO: le reste des binders *)
   in
   aux env cv_pb c1 c2; !evm
 
-let decompose_prod_letin : constr -> int * Context.Rel.t * constr =
-  let rec prodec_rec i l c = match kind_of_term c with
+let decompose_prod_letin sigma c =
+  let rec prodec_rec i l c = match EConstr.kind sigma c with
     | Prod (n,t,c)    -> prodec_rec (succ i) (RelDecl.LocalAssum (n,t)::l) c
     | LetIn (n,d,t,c) -> prodec_rec (succ i) (RelDecl.LocalDef (n,d,t)::l) c
     | Cast (c,_,_)    -> prodec_rec i l c
     | _               -> i,l,c in
-  prodec_rec 0 []
+  prodec_rec 0 [] c
 
 (* (nb_lam [na1:T1]...[nan:Tan]c) where c is not an abstraction
  * gives n (casts are ignored) *)
-let nb_lam =
-  let rec nbrec n c = match kind_of_term c with
+let nb_lam sigma c =
+  let rec nbrec n c = match EConstr.kind sigma c with
     | Lambda (_,_,c) -> nbrec (n+1) c
     | Cast (c,_,_) -> nbrec n c
     | _ -> n
   in
-  nbrec 0
+  nbrec 0 c
 
 (* similar to nb_lam, but gives the number of products instead *)
-let nb_prod =
-  let rec nbrec n c = match kind_of_term c with
+let nb_prod sigma c =
+  let rec nbrec n c = match EConstr.kind sigma c with
     | Prod (_,_,c) -> nbrec (n+1) c
     | Cast (c,_,_) -> nbrec n c
     | _ -> n
   in
-  nbrec 0
+  nbrec 0 c
 
-let nb_prod_modulo_zeta x =
+let nb_prod_modulo_zeta sigma x =
   let rec count n c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
         Prod(_,_,t) -> count (n+1) t
-      | LetIn(_,a,_,t) -> count n (subst1 a t)
+      | LetIn(_,a,_,t) -> count n (EConstr.Vars.subst1 a t)
       | Cast(c,_,_) -> count n c
       | _ -> n
   in count 0 x
 
-let align_prod_letin c a : Context.Rel.t * constr =
-  let (lc,_,_) = decompose_prod_letin c in
-  let (la,l,a) = decompose_prod_letin a in
+let align_prod_letin sigma c a =
+  let (lc,_,_) = decompose_prod_letin sigma c in
+  let (la,l,a) = decompose_prod_letin sigma a in
   if not (la >= lc) then invalid_arg "align_prod_letin";
   let (l1,l2) = Util.List.chop lc l in
   l2,it_mkProd_or_LetIn a l1
@@ -909,21 +1296,23 @@ let align_prod_letin c a : Context.Rel.t * constr =
 (* [x1:c1;...;xn:cn]@(f;a1...an;x1;...;xn) --> @(f;a1...an) *)
 (* Remplace 2 earlier buggish versions                      *)
 
-let rec eta_reduce_head c =
-  match kind_of_term c with
+let rec eta_reduce_head sigma c =
+  let open EConstr in
+  let open Vars in
+  match EConstr.kind sigma c with
     | Lambda (_,c1,c') ->
-	(match kind_of_term (eta_reduce_head c') with
+	(match EConstr.kind sigma (eta_reduce_head sigma c') with
            | App (f,cl) ->
                let lastn = (Array.length cl) - 1 in
-               if lastn < 0 then anomaly (Pp.str "application without arguments")
+               if lastn < 0 then anomaly (Pp.str "application without arguments.")
                else
-                 (match kind_of_term cl.(lastn) with
+                 (match EConstr.kind sigma cl.(lastn) with
                     | Rel 1 ->
 			let c' =
                           if Int.equal lastn 0 then f
 			  else mkApp (f, Array.sub cl 0 lastn)
 			in
-			if noccurn 1 c'
+			if noccurn sigma 1 c'
                         then lift (-1) c'
                         else c
                     | _   -> c)
@@ -934,7 +1323,7 @@ let rec eta_reduce_head c =
 (* iterator on rel context *)
 let process_rel_context f env =
   let sign = named_context_val env in
-  let rels = rel_context env in
+  let rels = EConstr.rel_context env in
   let env0 = reset_with_named_context sign env in
   Context.Rel.fold_outside f rels ~init:env0
 
@@ -982,18 +1371,35 @@ let fold_named_context_both_sides f l ~init = List.fold_right_and_left f l init
 let mem_named_context_val id ctxt =
   try ignore(Environ.lookup_named_val id ctxt); true with Not_found -> false
 
-let compact_named_context_reverse sign =
-  let compact l decl =
-    let (i1,c1,t1) = NamedDecl.to_tuple decl in
-    match l with
-    | [] -> [[i1],c1,t1]
-    | (l2,c2,t2)::q ->
-       if Option.equal Constr.equal c1 c2 && Constr.equal t1 t2
-       then (i1::l2,c2,t2)::q
-       else ([i1],c1,t1)::l
-  in Context.Named.fold_inside compact ~init:[] sign
+let map_rel_decl f = function
+| RelDecl.LocalAssum (id, t) -> RelDecl.LocalAssum (id, f t)
+| RelDecl.LocalDef (id, b, t) -> RelDecl.LocalDef (id, f b, f t)
+
+let map_named_decl f = function
+| NamedDecl.LocalAssum (id, t) -> NamedDecl.LocalAssum (id, f t)
+| NamedDecl.LocalDef (id, b, t) -> NamedDecl.LocalDef (id, f b, f t)
 
-let compact_named_context sign = List.rev (compact_named_context_reverse sign)
+let compact_named_context sign =
+  let compact l decl =
+    match decl, l with
+    | NamedDecl.LocalAssum (i,t), [] ->
+       [CompactedDecl.LocalAssum ([i],t)]
+    | NamedDecl.LocalDef (i,c,t), [] ->
+       [CompactedDecl.LocalDef ([i],c,t)]
+    | NamedDecl.LocalAssum (i1,t1), CompactedDecl.LocalAssum (li,t2) :: q ->
+       if Constr.equal t1 t2
+       then CompactedDecl.LocalAssum (i1::li, t2) :: q
+       else CompactedDecl.LocalAssum ([i1],t1) :: CompactedDecl.LocalAssum (li,t2) :: q
+    | NamedDecl.LocalDef (i1,c1,t1), CompactedDecl.LocalDef (li,c2,t2) :: q ->
+       if Constr.equal c1 c2 && Constr.equal t1 t2
+       then CompactedDecl.LocalDef (i1::li, c2, t2) :: q
+       else CompactedDecl.LocalDef ([i1],c1,t1) :: CompactedDecl.LocalDef (li,c2,t2) :: q
+    | NamedDecl.LocalAssum (i,t), q ->
+       CompactedDecl.LocalAssum ([i],t) :: q
+    | NamedDecl.LocalDef (i,c,t), q ->
+       CompactedDecl.LocalDef ([i],c,t) :: q
+  in
+  sign |> Context.Named.fold_inside compact ~init:[] |> List.rev
 
 let clear_named_body id env =
   let open NamedDecl in
@@ -1002,28 +1408,70 @@ let clear_named_body id env =
   | d -> push_named d in
   fold_named_context aux env ~init:(reset_context env)
 
-let global_vars env ids = Id.Set.elements (global_vars_set env ids)
+let global_vars_set env sigma constr =
+  let rec filtrec acc c =
+    let acc = match EConstr.kind sigma c with
+    | Var _ | Const _ | Ind _ | Construct _ ->
+      Id.Set.union (vars_of_global env (EConstr.to_constr sigma c)) acc
+    | _ -> acc
+    in
+    EConstr.fold sigma filtrec acc c
+  in
+  filtrec Id.Set.empty constr
+
+let global_vars env sigma ids = Id.Set.elements (global_vars_set env sigma ids)
 
-let global_vars_set_of_decl env = function
-  | NamedDecl.LocalAssum (_,t) -> global_vars_set env t
+let global_vars_set_of_decl env sigma = function
+  | NamedDecl.LocalAssum (_,t) -> global_vars_set env sigma t
   | NamedDecl.LocalDef (_,c,t) ->
-      Id.Set.union (global_vars_set env t)
-        (global_vars_set env c)
+      Id.Set.union (global_vars_set env sigma t)
+        (global_vars_set env sigma c)
 
-let dependency_closure env sign hyps =
+let dependency_closure env sigma sign hyps =
   if Id.Set.is_empty hyps then [] else
     let (_,lh) =
       Context.Named.fold_inside
         (fun (hs,hl) d ->
           let x = NamedDecl.get_id d in
           if Id.Set.mem x hs then
-            (Id.Set.union (global_vars_set_of_decl env d) (Id.Set.remove x hs),
+            (Id.Set.union (global_vars_set_of_decl env sigma d) (Id.Set.remove x hs),
             x::hl)
           else (hs,hl))
         ~init:(hyps,[])
         sign in
     List.rev lh
 
+let global_app_of_constr sigma c =
+  let open Globnames in
+  match EConstr.kind sigma c with
+  | Const (c, u) -> (ConstRef c, u), None
+  | Ind (i, u) -> (IndRef i, u), None
+  | Construct (c, u) -> (ConstructRef c, u), None
+  | Var id -> (VarRef id, EConstr.EInstance.empty), None
+  | Proj (p, c) -> (ConstRef (Projection.constant p), EConstr.EInstance.empty), Some c
+  | _ -> raise Not_found
+
+let prod_applist sigma c l =
+  let open EConstr in
+  let rec app subst c l =
+    match EConstr.kind sigma c, l with
+    | Prod(_,_,c), arg::l -> app (arg::subst) c l
+    | _, [] -> Vars.substl subst c
+    | _ -> 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 }
@@ -1037,33 +1485,13 @@ let context_chop k ctx =
     | (0, l2) -> (List.rev acc, l2)
     | (n, (RelDecl.LocalDef _ as h)::t) -> chop_aux (h::acc) (n, t)
     | (n, (h::t)) -> chop_aux (h::acc) (pred n, t)
-    | (_, []) -> anomaly (Pp.str "context_chop")
+    | (_, []) -> anomaly (Pp.str "context_chop.")
   in chop_aux [] (k,ctx)
 
 (* Do not skip let-in's *)
 let env_rel_context_chop k env =
+  let open EConstr in
   let rels = rel_context env in
   let ctx1,ctx2 = List.chop k rels in
   push_rel_context ctx2 (reset_with_named_context (named_context_val env) env),
   ctx1
-
-(*******************************************)
-(* Functions to deal with impossible cases *)
-(*******************************************)
-let impossible_default_case = ref None
-
-let set_impossible_default_clause c = impossible_default_case := Some c
-
-let coq_unit_judge =
-  let na1 = Name (Id.of_string "A") in
-  let na2 = Name (Id.of_string "H") in
-  fun () ->
-    match !impossible_default_case with
-    | Some fn -> 
-        let (id,type_of_id), ctx = fn () in
-	  make_judge id type_of_id, ctx
-    | None ->
-	(* In case the constants id/ID are not defined *)
-	make_judge (mkLambda (na1,mkProp,mkLambda(na2,mkRel 1,mkRel 1)))
-                 (mkProd (na1,mkProp,mkArrow (mkRel 1) (mkRel 2))), 
-       Univ.ContextSet.empty
diff --git a/engine/termops.mli b/engine/termops.mli
index fd8edafb..3b0c4bba 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -1,75 +1,67 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines various utilities for term manipulation that are not
     needed in the kernel. *)
 
-open Pp
 open Names
-open Term
+open Constr
 open Environ
+open EConstr
 
 (** printers *)
-val print_sort : sorts -> std_ppcmds
-val pr_sort_family : sorts_family -> std_ppcmds
-val pr_fix : (constr -> std_ppcmds) -> fixpoint -> std_ppcmds
-
-(** debug printer: do not use to display terms to the casual user... *)
-val set_print_constr : (env -> constr -> std_ppcmds) -> unit
-val print_constr     : constr -> std_ppcmds
-val print_constr_env : env -> constr -> std_ppcmds
-val print_named_context : env -> std_ppcmds
-val pr_rel_decl : env -> Context.Rel.Declaration.t -> std_ppcmds
-val print_rel_context : env -> std_ppcmds
-val print_env : env -> std_ppcmds
+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 *)
 val push_rel_assum : Name.t * types -> env -> env
-val push_rels_assum : (Name.t * types) list -> env -> env
-val push_named_rec_types : Name.t array * types array * 'a -> env -> env
+val push_rels_assum : (Name.t * Constr.types) list -> env -> env
+val push_named_rec_types : Name.t array * Constr.types array * 'a -> env -> env
 
-val lookup_rel_id : Id.t -> Context.Rel.t -> int * constr option * types
+val lookup_rel_id : Id.t -> ('c, 't) Context.Rel.pt -> int * 'c option * 't
 (** Associates the contents of an identifier in a [rel_context]. Raise
     [Not_found] if there is no such identifier. *)
 
 (** Functions that build argument lists matching a block of binders or a context.
     [rel_vect n m] builds [|Rel (n+m);...;Rel(n+1)|]
 *)
-val rel_vect : int -> int -> constr array
+val rel_vect : int -> int -> Constr.constr array
 val rel_list : int -> int -> constr list
 
 (** iterators/destructors on terms *)
-val mkProd_or_LetIn : Context.Rel.Declaration.t -> types -> types
-val mkProd_wo_LetIn : Context.Rel.Declaration.t -> types -> types
+val mkProd_or_LetIn : rel_declaration -> types -> types
+val mkProd_wo_LetIn : rel_declaration -> types -> types
 val it_mkProd : types -> (Name.t * types) list -> types
 val it_mkLambda : constr -> (Name.t * types) list -> constr
-val it_mkProd_or_LetIn : types -> Context.Rel.t -> types
-val it_mkProd_wo_LetIn : types -> Context.Rel.t -> types
-val it_mkLambda_or_LetIn : constr -> Context.Rel.t -> constr
-val it_mkNamedProd_or_LetIn : types -> Context.Named.t -> types
-val it_mkNamedProd_wo_LetIn : types -> Context.Named.t -> types
-val it_mkNamedLambda_or_LetIn : constr -> Context.Named.t -> constr
+val it_mkProd_or_LetIn : types -> rel_context -> types
+val it_mkProd_wo_LetIn : types -> rel_context -> types
+val it_mkLambda_or_LetIn : Constr.constr -> Context.Rel.t -> Constr.constr
+val it_mkNamedProd_or_LetIn : types -> named_context -> types
+val it_mkNamedProd_wo_LetIn : Constr.types -> Context.Named.t -> Constr.types
+val it_mkNamedLambda_or_LetIn : constr -> named_context -> constr
 
 (* Ad hoc version reinserting letin, assuming the body is defined in
    the context where the letins are expanded *)
-val it_mkLambda_or_LetIn_from_no_LetIn : constr -> Context.Rel.t -> constr
+val it_mkLambda_or_LetIn_from_no_LetIn : Constr.constr -> Context.Rel.t -> Constr.constr
 
 (** {6 Generic iterators on constr} *)
 
-val map_constr_with_named_binders :
-  (Name.t -> 'a -> 'a) ->
-  ('a -> constr -> constr) -> 'a -> constr -> constr
 val map_constr_with_binders_left_to_right :
-  (Context.Rel.Declaration.t -> 'a -> 'a) ->
+  Evd.evar_map ->
+  (rel_declaration -> 'a -> 'a) ->
   ('a -> constr -> constr) ->
     'a -> constr -> constr
 val map_constr_with_full_binders :
-  (Context.Rel.Declaration.t -> 'a -> 'a) ->
+  Evd.evar_map ->
+  (rel_declaration -> 'a -> 'a) ->
   ('a -> constr -> constr) -> 'a -> constr -> constr
 
 (** [fold_constr_with_binders g f n acc c] folds [f n] on the immediate
@@ -79,57 +71,58 @@ val map_constr_with_full_binders :
    index) which is processed by [g] (which typically add 1 to [n]) at
    each binder traversal; it is not recursive *)
 
-val fold_constr_with_binders :
+val fold_constr_with_binders : Evd.evar_map ->
   ('a -> 'a) -> ('a -> 'b -> constr -> 'b) -> 'a -> 'b -> constr -> 'b
 
-val fold_constr_with_full_binders :
+val fold_constr_with_full_binders : Evd.evar_map ->
   (Context.Rel.Declaration.t -> 'a -> 'a) -> ('a -> 'b -> constr -> 'b) ->
     'a -> 'b -> constr -> 'b
 
-val iter_constr_with_full_binders :
-  (Context.Rel.Declaration.t -> 'a -> 'a) -> ('a -> constr -> unit) -> 'a ->
-    constr -> unit
+val iter_constr_with_full_binders : Evd.evar_map ->
+  (rel_declaration -> 'a -> 'a) ->
+  ('a -> constr -> unit) -> 'a ->
+  constr -> unit
 
 (**********************************************************************)
 
-val strip_head_cast : constr -> constr
-val drop_extra_implicit_args : constr -> constr
+val strip_head_cast : Evd.evar_map -> constr -> constr
+val drop_extra_implicit_args : Evd.evar_map -> constr -> constr
 
 (** occur checks *)
 
 exception Occur
-val occur_meta : types -> bool
-val occur_existential : types -> bool
-val occur_meta_or_existential : types -> bool
-val occur_evar : existential_key -> types -> bool
-val occur_var : env -> Id.t -> types -> bool
+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 -> Evar.t -> constr -> bool
+val occur_var : env -> Evd.evar_map -> Id.t -> constr -> bool
 val occur_var_in_decl :
-  env ->
-  Id.t -> Context.Named.Declaration.t -> bool
+  env -> Evd.evar_map ->
+  Id.t -> named_declaration -> bool
 
 (** As {!occur_var} but assume the identifier not to be a section variable *)
-val local_occur_var : Id.t -> types -> bool
+val local_occur_var : Evd.evar_map -> Id.t -> constr -> bool
 
-val free_rels : constr -> Int.Set.t
+val free_rels : Evd.evar_map -> constr -> Int.Set.t
 
 (** [dependent m t] tests whether [m] is a subterm of [t] *)
-val dependent : constr -> constr -> bool
-val dependent_no_evar : constr -> constr -> bool
-val dependent_univs : constr -> constr -> bool
-val dependent_univs_no_evar : constr -> constr -> bool
-val dependent_in_decl : constr -> Context.Named.Declaration.t -> bool
-val count_occurrences : constr -> constr -> int
-val collect_metas : constr -> int list
-val collect_vars : constr -> Id.Set.t (** for visible vars only *)
+val dependent : Evd.evar_map -> constr -> constr -> bool
+val dependent_no_evar : Evd.evar_map -> constr -> constr -> bool
+val dependent_in_decl : Evd.evar_map -> constr -> named_declaration -> bool
+val count_occurrences : Evd.evar_map -> constr -> constr -> int
+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 : constr -> constr -> bool (** Synonymous
- of dependent 
-   Substitution of metavariables *)
-type meta_value_map = (metavariable * constr) list
-val subst_meta : meta_value_map -> constr -> constr
+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
+val subst_meta : meta_value_map -> Constr.constr -> Constr.constr
+val isMetaOf : Evd.evar_map -> metavariable -> constr -> bool
 
 (** Type assignment for metavariables *)
-type meta_type_map = (metavariable * types) list
+type meta_type_map = (metavariable * Constr.types) list
 
 (** [pop c] lifts by -1 the positive indexes in [c] *)
 val pop : constr -> constr
@@ -140,29 +133,48 @@ val pop : constr -> constr
 
 (** [subst_term_gen eq d c] replaces [d] by [Rel 1] in [c] using [eq]
    as equality *)
-val subst_term_gen :
-  (constr -> constr -> bool) -> constr -> constr -> constr
+val subst_term_gen : Evd.evar_map ->
+  (Evd.evar_map -> constr -> constr -> bool) -> constr -> constr -> constr
 
 (** [replace_term_gen eq d e c] replaces [d] by [e] in [c] using [eq]
    as equality *)
 val replace_term_gen :
-  (constr -> constr -> bool) ->
+  Evd.evar_map -> (Evd.evar_map -> constr -> constr -> bool) ->
     constr -> constr -> constr -> constr
 
 (** [subst_term d c] replaces [d] by [Rel 1] in [c] *)
-val subst_term : constr -> constr -> constr
+val subst_term : Evd.evar_map -> constr -> constr -> constr
 
 (** [replace_term d e c] replaces [d] by [e] in [c] *)
-val replace_term : constr -> 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 compare_constr_univ : (Reduction.conv_pb -> constr -> constr -> 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 : Reduction.conv_pb -> constr -> constr -> bool
-val eq_constr : constr -> constr -> bool (* FIXME rename: erases universes*)
+val constr_cmp : Evd.evar_map -> Reduction.conv_pb -> constr -> constr -> bool
+val eq_constr : Evd.evar_map -> constr -> constr -> bool (* FIXME rename: erases universes*)
+
+val eta_reduce_head : Evd.evar_map -> constr -> constr
 
-val eta_reduce_head : 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
 
 exception CannotFilter
 
@@ -172,27 +184,27 @@ exception CannotFilter
    (context,term), or raises [CannotFilter].
    Warning: Outer-kernel sort subtyping are taken into account: c1 has
    to be smaller than c2 wrt. sorts. *)
-type subst = (Context.Rel.t * constr) Evar.Map.t
-val filtering : Context.Rel.t -> Reduction.conv_pb -> constr -> constr -> subst
+type subst = (rel_context * constr) Evar.Map.t
+val filtering : Evd.evar_map -> rel_context -> Reduction.conv_pb -> constr -> constr -> subst
 
-val decompose_prod_letin : constr -> int * Context.Rel.t * constr
-val align_prod_letin : constr -> constr -> Context.Rel.t * constr
+val decompose_prod_letin : Evd.evar_map -> constr -> int * rel_context * constr
+val align_prod_letin : Evd.evar_map -> constr -> constr -> rel_context * constr
 
 (** [nb_lam] {% $ %}[x_1:T_1]...[x_n:T_n]c{% $ %} where {% $ %}c{% $ %} is not an abstraction
    gives {% $ %}n{% $ %} (casts are ignored) *)
-val nb_lam : constr -> int
+val nb_lam : Evd.evar_map -> constr -> int
 
 (** Similar to [nb_lam], but gives the number of products instead *)
-val nb_prod : constr -> int
+val nb_prod : Evd.evar_map -> constr -> int
 
 (** Similar to [nb_prod], but zeta-contracts let-in on the way *)
-val nb_prod_modulo_zeta : constr -> int
+val nb_prod_modulo_zeta : Evd.evar_map -> constr -> int
 
 (** Get the last arg of a constr intended to be an application *)
-val last_arg : constr -> constr
+val last_arg : Evd.evar_map -> constr -> constr
 
 (** Force the decomposition of a term as an applicative one *)
-val decompose_app_vect : constr -> constr * constr array
+val decompose_app_vect : Evd.evar_map -> constr -> constr * constr array
 
 val adjust_app_list_size : constr -> constr list -> constr -> constr list ->
   (constr * constr list * constr * constr list)
@@ -205,8 +217,8 @@ val add_name : Name.t -> names_context -> names_context
 val lookup_name_of_rel : int -> names_context -> Name.t
 val lookup_rel_of_name : Id.t -> names_context -> int
 val empty_names_context : names_context
-val ids_of_rel_context : Context.Rel.t -> Id.t list
-val ids_of_named_context : Context.Named.t -> Id.t list
+val ids_of_rel_context : ('c, 't) Context.Rel.pt -> Id.t list
+val ids_of_named_context : ('c, 't) Context.Named.pt -> Id.t list
 val ids_of_context : env -> Id.t list
 val names_of_rel_context : env -> names_context
 
@@ -218,52 +230,89 @@ val context_chop : int -> Context.Rel.t -> Context.Rel.t * Context.Rel.t
 (* [env_rel_context_chop n env] extracts out the [n] top declarations
    of the rel_context part of [env], counting both local definitions and
    hypotheses *)
-val env_rel_context_chop : int -> env -> env * Context.Rel.t
+val env_rel_context_chop : int -> env -> env * rel_context
 
 (** Set of local names *)
 val vars_of_env: env -> Id.Set.t
 val add_vname : Id.Set.t -> Name.t -> Id.Set.t
 
 (** other signature iterators *)
-val process_rel_context : (Context.Rel.Declaration.t -> env -> env) -> env -> env
-val assums_of_rel_context : Context.Rel.t -> (Name.t * constr) list
+val process_rel_context : (rel_declaration -> env -> env) -> env -> env
+val assums_of_rel_context : ('c, 't) Context.Rel.pt -> (Name.t * 't) list
 val lift_rel_context : int -> Context.Rel.t -> Context.Rel.t
-val substl_rel_context : constr list -> Context.Rel.t -> Context.Rel.t
+val substl_rel_context : Constr.constr list -> Context.Rel.t -> Context.Rel.t
 val smash_rel_context : Context.Rel.t -> Context.Rel.t (** expand lets in context *)
 
 val map_rel_context_in_env :
-  (env -> constr -> constr) -> env -> Context.Rel.t -> Context.Rel.t
+  (env -> Constr.constr -> Constr.constr) -> env -> Context.Rel.t -> Context.Rel.t
 val map_rel_context_with_binders :
-  (int -> constr -> constr) -> Context.Rel.t -> Context.Rel.t
+  (int -> 'c -> 'c) -> ('c, 'c) Context.Rel.pt -> ('c, 'c) Context.Rel.pt
 val fold_named_context_both_sides :
   ('a -> Context.Named.Declaration.t -> Context.Named.Declaration.t list -> 'a) ->
     Context.Named.t -> init:'a -> 'a
 val mem_named_context_val : Id.t -> named_context_val -> bool
-val compact_named_context : Context.Named.t -> Context.NamedList.t
-val compact_named_context_reverse : Context.Named.t -> Context.NamedList.t
+val compact_named_context : Context.Named.t -> Context.Compacted.t
+
+val map_rel_decl : ('a -> 'b) -> ('a, 'a) Context.Rel.Declaration.pt -> ('b, 'b) Context.Rel.Declaration.pt
+val map_named_decl : ('a -> 'b) -> ('a, 'a) Context.Named.Declaration.pt -> ('b, 'b) Context.Named.Declaration.pt
 
 val clear_named_body : Id.t -> env -> env
 
-val global_vars : env -> constr -> Id.t list
-val global_vars_set_of_decl : env -> Context.Named.Declaration.t -> Id.Set.t
+val global_vars : env -> Evd.evar_map -> constr -> Id.t list
+val global_vars_set : env -> Evd.evar_map -> constr -> Id.Set.t
+val global_vars_set_of_decl : env -> Evd.evar_map -> named_declaration -> Id.Set.t
+val global_app_of_constr : Evd.evar_map -> constr -> (Globnames.global_reference * EInstance.t) * constr option
 
 (** Gives an ordered list of hypotheses, closed by dependencies,
    containing a given set *)
-val dependency_closure : env -> Context.Named.t -> Id.Set.t -> Id.t list
+val dependency_closure : env -> Evd.evar_map -> named_context -> Id.Set.t -> Id.t list
 
 (** Test if an identifier is the basename of a global reference *)
 val is_section_variable : Id.t -> bool
 
-val isGlobalRef : constr -> bool
+val global_of_constr : Evd.evar_map -> constr -> Globnames.global_reference * EInstance.t
+
+val is_global : Evd.evar_map -> Globnames.global_reference -> constr -> bool
 
-val is_template_polymorphic : env -> constr -> bool
+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 *)
 
-val on_judgment       : (types -> types) -> unsafe_judgment -> unsafe_judgment
-val on_judgment_value : (types -> types) -> unsafe_judgment -> unsafe_judgment
-val on_judgment_type  : (types -> types) -> unsafe_judgment -> unsafe_judgment
+val on_judgment       : ('a -> 'b) -> ('a, 'a) punsafe_judgment -> ('b, 'b) punsafe_judgment
+val on_judgment_value : ('c -> 'c) -> ('c, 't) punsafe_judgment -> ('c, 't) punsafe_judgment
+val on_judgment_type  : ('t -> 't) -> ('c, 't) punsafe_judgment -> ('c, 't) punsafe_judgment
+
+(** {5 Debug pretty-printers} *)
+
+open Evd
+
+val pr_existential_key : evar_map -> Evar.t -> Pp.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
+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 : 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... *)
 
-(** {6 Functions to deal with impossible cases } *)
-val set_impossible_default_clause : (unit -> (constr * types) Univ.in_universe_context_set) -> unit
-val coq_unit_judge : unit -> unsafe_judgment Univ.in_universe_context_set
+val set_print_constr : (env -> Evd.evar_map -> constr -> Pp.t) -> unit
+val print_constr     : constr -> Pp.t
+val print_constr_env : env -> Evd.evar_map -> constr -> Pp.t
+val print_named_context : env -> Pp.t
+val pr_rel_decl : env -> Context.Rel.Declaration.t -> Pp.t
+val print_rel_context : env -> Pp.t
+val print_env : env -> Pp.t
diff --git a/engine/uState.ml b/engine/uState.ml
index c35f97b2..6c8dbe3f 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,45 +13,39 @@ 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;
 }
 
+module UPairSet = Universes.UPairSet
+
 (* 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 *)
    uctx_initial_universes : UGraph.t; (** The graph at the creation of the evar_map *)
+   uctx_weak_constraints : UPairSet.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;
-    uctx_initial_universes = UGraph.initial_universes; }
+    uctx_initial_universes = UGraph.initial_universes;
+    uctx_weak_constraints = UPairSet.empty; }
 
 let make u =
     { empty with 
@@ -59,31 +55,43 @@ 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
+    let weak = UPairSet.union ctx.uctx_weak_constraints ctx'.uctx_weak_constraints in
     let declarenew g =
       Univ.LSet.fold (fun u g -> UGraph.add_universe u false g) newus g
     in
     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 = 
           Univ.LSet.union ctx.uctx_univ_algebraic ctx'.uctx_univ_algebraic;
         uctx_initial_universes = declarenew ctx.uctx_initial_universes;
         uctx_universes = 
-          if local == ctx.uctx_local then ctx.uctx_universes
-          else
-            let cstrsr = Univ.ContextSet.constraints ctx'.uctx_local in
-            UGraph.merge_constraints cstrsr (declarenew ctx.uctx_universes) }
+          (if local == ctx.uctx_local then ctx.uctx_universes
+           else
+             let cstrsr = Univ.ContextSet.constraints ctx'.uctx_local in
+             UGraph.merge_constraints cstrsr (declarenew ctx.uctx_universes));
+        uctx_weak_constraints = weak}
 
 let context_set ctx = ctx.uctx_local
 
@@ -91,25 +99,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,171 +133,283 @@ 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
 
+let drop_weak_constraints = ref false
+
 let process_universe_constraints ctx cstrs =
+  let open Univ in
+  let open Universes in
   let univs = ctx.uctx_universes in
   let vars = ref ctx.uctx_univ_variables in
-  let normalize = Universes.normalize_universe_opt_subst vars in
-  let rec unify_universes fo l d r local =
-    let l = normalize l and r = normalize r in
-      if Univ.Universe.equal l r then local
+  let weak = ref ctx.uctx_weak_constraints in
+  let normalize = normalize_univ_variable_opt_subst vars in
+  let nf_constraint = function
+    | ULub (u, v) -> ULub (level_subst_of normalize u, level_subst_of normalize v)
+    | UWeak (u, v) -> UWeak (level_subst_of normalize u, level_subst_of normalize v)
+    | UEq (u, v) -> UEq (subst_univs_universe normalize u, subst_univs_universe normalize v)
+    | ULe (u, v) -> ULe (subst_univs_universe normalize u, subst_univs_universe normalize v)
+  in
+  let is_local l = Univ.LMap.mem l !vars in
+  let varinfo x =
+    match Univ.Universe.level x with
+    | None -> Inl x
+    | Some l -> Inr l
+  in
+  let equalize_variables fo l l' r r' local =
+    (** Assumes l = [l',0] and r = [r',0] *)
+    let () =
+      if is_local l' then
+        instantiate_variable l' r vars
+      else if is_local r' then
+        instantiate_variable r' l vars
+      else if not (UGraph.check_eq_level univs l' r') then
+        (* Two rigid/global levels, none of them being local,
+            one of them being Prop/Set, disallow *)
+        if Univ.Level.is_small l' || Univ.Level.is_small r' then
+          raise (Univ.UniverseInconsistency (Univ.Eq, l, r, None))
+        else if fo then
+          raise UniversesDiffer
+    in
+    Univ.enforce_eq_level l' r' local
+  in
+  let equalize_universes l r local = match varinfo l, varinfo r with
+  | Inr l', Inr r' -> equalize_variables false l l' r r' local
+  | Inr l, Inl r | Inl r, Inr l ->
+    let alg = Univ.LSet.mem l ctx.uctx_univ_algebraic in
+    let inst = Univ.univ_level_rem l r r in
+      if alg then (instantiate_variable l inst vars; local)
+      else
+        let lu = Univ.Universe.make l in
+        if Univ.univ_level_mem l r then
+          Univ.enforce_leq inst lu local
+        else raise (Univ.UniverseInconsistency (Univ.Eq, lu, r, None))
+  | Inl _, Inl _ (* both are algebraic *) ->
+    if UGraph.check_eq univs l r then local
+    else raise (Univ.UniverseInconsistency (Univ.Eq, l, r, None))
+  in
+  let unify_universes cst local =
+    let cst = nf_constraint cst in
+      if Constraints.is_trivial cst then local
       else 
-        let varinfo x = 
-          match Univ.Universe.level x with
-          | None -> Inl x
-          | Some l -> Inr (l, Univ.LMap.mem l !vars, Univ.LSet.mem l ctx.uctx_univ_algebraic)
-        in
-          if d == Universes.ULe then
+          match cst with
+          | ULe (l, r) ->
             if UGraph.check_leq univs l r then
               (** Keep Prop/Set <= var around if var might be instantiated by prop or set
                   later. *)
-              if Univ.Universe.is_level l then 
-                match Univ.Universe.level r with
-                | Some r ->
-                  Univ.Constraint.add (Option.get (Univ.Universe.level l),Univ.Le,r) local
-                | _ -> local
-              else local
+              match Univ.Universe.level l, Univ.Universe.level r with
+              | Some l, Some r ->
+                Univ.Constraint.add (l, Univ.Le, r) local
+              | _ -> local
             else
-              match Univ.Universe.level r with
-              | None -> error ("Algebraic universe on the right")
-              | Some rl ->
-                if Univ.Level.is_small rl then
-                  let levels = Univ.Universe.levels l in
-                    Univ.LSet.fold (fun l local ->
-                      if Univ.Level.is_small l || Univ.LMap.mem l !vars then
-                        unify_universes fo (Univ.Universe.make l) Universes.UEq r local
-                      else raise (Univ.UniverseInconsistency (Univ.Le, Univ.Universe.make l, r, None)))
-                      levels local
+              begin match Univ.Universe.level r with
+              | None -> user_err Pp.(str "Algebraic universe on the right")
+              | Some r' ->
+                if Univ.Level.is_small r' then
+                  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
-          else if d == Universes.ULub then
-            match varinfo l, varinfo r with
-            | (Inr (l, true, _), Inr (r, _, _)) 
-            | (Inr (r, _, _), Inr (l, true, _)) -> 
-              instantiate_variable l (Univ.Universe.make r) vars; 
-              Univ.enforce_eq_level l r local
-            | Inr (_, _, _), Inr (_, _, _) ->
-              unify_universes true l Universes.UEq r local
-            | _, _ -> assert false
-          else (* d = Universes.UEq *)
-            match varinfo l, varinfo r with
-            | Inr (l', lloc, _), Inr (r', rloc, _) ->
-              let () = 
-                if lloc then
-                  instantiate_variable l' r vars
-                else if rloc then 
-                  instantiate_variable r' l vars
-                else if not (UGraph.check_eq univs l r) then
-                  (* Two rigid/global levels, none of them being local,
-                     one of them being Prop/Set, disallow *)
-                  if Univ.Level.is_small l' || Univ.Level.is_small r' then
-                    raise (Univ.UniverseInconsistency (Univ.Eq, l, r, None))
-                  else
-                    if fo then 
-                      raise UniversesDiffer
-              in
-                Univ.enforce_eq_level l' r' local
-            | Inr (l, loc, alg), Inl r
-            | Inl r, Inr (l, loc, alg) ->
-               let inst = Univ.univ_level_rem l r r in
-                 if alg then (instantiate_variable l inst vars; local)
-                 else
-                   let lu = Univ.Universe.make l in
-                   if Univ.univ_level_mem l r then
-                     Univ.enforce_leq inst lu local
-                   else raise (Univ.UniverseInconsistency (Univ.Eq, lu, r, None))
-            | _, _ (* One of the two is algebraic or global *) -> 
-             if UGraph.check_eq univs l r then local
-             else raise (Univ.UniverseInconsistency (Univ.Eq, l, r, None))
+              end
+          | ULub (l, r) ->
+              equalize_variables true (Universe.make l) l (Universe.make r) r local
+          | UWeak (l, r) ->
+            if not !drop_weak_constraints then weak := UPairSet.add (l,r) !weak; local
+          | UEq (l, r) -> equalize_universes l r local
   in
   let local = 
-    Universes.Constraints.fold (fun (l,d,r) local -> unify_universes false l d r local)
-      cstrs Univ.Constraint.empty
+    Constraints.fold unify_universes cstrs Univ.Constraint.empty
   in
-    !vars, local
+    !vars, !weak, local
 
 let add_constraints ctx cstrs =
   let univs, local = ctx.uctx_local in
   let cstrs' = Univ.Constraint.fold (fun (l,d,r) acc -> 
     let l = Univ.Universe.make l and r = Univ.Universe.make r in
-    let cstr' = 
-      if d == Univ.Lt then (Univ.Universe.super l, Universes.ULe, r)
-      else (l, (if d == Univ.Le then Universes.ULe else Universes.UEq), r)
+    let cstr' = match d with
+      | Univ.Lt ->
+        Universes.ULe (Univ.Universe.super l, r)
+      | Univ.Le -> Universes.ULe (l, r)
+      | Univ.Eq -> Universes.UEq (l, r)
     in Universes.Constraints.add cstr' acc)
     cstrs Universes.Constraints.empty
   in
-  let vars, local' = process_universe_constraints ctx cstrs' in
-    { ctx with uctx_local = (univs, Univ.Constraint.union local local');
-      uctx_univ_variables = vars;
-      uctx_universes = UGraph.merge_constraints local' ctx.uctx_universes }
+  let vars, weak, local' = process_universe_constraints ctx cstrs' in
+  { ctx with
+    uctx_local = (univs, Univ.Constraint.union local local');
+    uctx_univ_variables = vars;
+    uctx_universes = UGraph.merge_constraints local' ctx.uctx_universes;
+    uctx_weak_constraints = weak; }
 
-(* 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
-  let vars, local' = process_universe_constraints ctx cstrs in
-    { ctx with uctx_local = (univs, Univ.Constraint.union local local');
-      uctx_univ_variables = vars;
-      uctx_universes = UGraph.merge_constraints local' ctx.uctx_universes }
+  let vars, weak, local' = process_universe_constraints ctx cstrs in
+  { ctx with
+    uctx_local = (univs, Univ.Constraint.union local local');
+    uctx_univ_variables = vars;
+    uctx_universes = UGraph.merge_constraints local' ctx.uctx_universes;
+    uctx_weak_constraints = weak; }
 
-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 CAst.make @@ Libnames.Ident (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 (loc, "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
-             Option.default Loc.ghost info.uloc
-           with Not_found -> Loc.ghost
-         in
-           user_err_loc (loc, "universe_context",
-			(str(CString.plural n "Universe") ++ spc () ++
-			     Univ.LSet.pr (pr_uctx_level ctx) left ++
-			   spc () ++ str (CString.conjugate_verb_to_be n) ++
-                           str" unbound."))
-      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 uctx' = Universes.restrict_universe_context ctx.uctx_local vars in
+  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? *)
@@ -345,7 +471,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
@@ -370,6 +496,13 @@ let new_univ_variable ?loc rigid name
                 uctx_initial_universes = initial}
   in uctx', u
 
+let make_with_initial_binders e us =
+  let uctx = make e in
+  List.fold_left
+    (fun uctx { CAst.loc; v = id } ->
+       fst (new_univ_variable ?loc univ_rigid (Some id) uctx))
+    uctx us
+
 let add_global_univ uctx u =
   let initial =
     UGraph.add_universe u true uctx.uctx_initial_universes
@@ -381,22 +514,30 @@ let add_global_univ uctx u =
                                      uctx_initial_universes = initial;
                                      uctx_universes = univs }
 
-let make_flexible_variable ctx b u =
-  let {uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in
+let make_flexible_variable ctx ~algebraic u =
+  let {uctx_local = cstrs; uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in
   let uvars' = Univ.LMap.add u None uvars in
   let avars' = 
-    if b then
+    if algebraic then
       let uu = Univ.Universe.make u in
       let substu_not_alg u' v =
         Option.cata (fun vu -> Univ.Universe.equal uu vu && not (Univ.LSet.mem u' avars)) false v
       in
-        if not (Univ.LMap.exists substu_not_alg uvars)
+      let has_upper_constraint () =
+        Univ.Constraint.exists
+          (fun (l,d,r) -> d == Univ.Lt && Univ.Level.equal l u)
+          (Univ.ContextSet.constraints cstrs)
+      in
+        if not (Univ.LMap.exists substu_not_alg uvars || has_upper_constraint ())
         then Univ.LSet.add u avars else avars 
     else avars 
   in
   {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 -> 
@@ -408,7 +549,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 = 
@@ -442,51 +583,54 @@ let fix_undefined_variables uctx =
 
 let refresh_undefined_univ_variables uctx =
   let subst, ctx' = Universes.fresh_universe_context_set_instance uctx.uctx_local in
-  let alg = Univ.LSet.fold (fun u acc -> Univ.LSet.add (Univ.subst_univs_level_level subst u) acc) 
+  let subst_fn u = Univ.subst_univs_level_level subst u in
+  let alg = Univ.LSet.fold (fun u acc -> Univ.LSet.add (subst_fn u) acc)
     uctx.uctx_univ_algebraic Univ.LSet.empty 
   in
   let vars = 
     Univ.LMap.fold
       (fun u v acc ->
-        Univ.LMap.add (Univ.subst_univs_level_level subst u) 
+        Univ.LMap.add (subst_fn u)
           (Option.map (Univ.subst_univs_level_universe subst) v) acc)
       uctx.uctx_univ_variables Univ.LMap.empty
   in
+  let weak = UPairSet.fold (fun (u,v) acc -> UPairSet.add (subst_fn u, subst_fn v) acc) uctx.uctx_weak_constraints UPairSet.empty in
   let declare g = Univ.LSet.fold (fun u g -> UGraph.add_universe u false g)
                                    (Univ.ContextSet.levels ctx') g in
   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
+               uctx_initial_universes = initial;
+               uctx_weak_constraints = weak; } in
     uctx', subst
 
-let normalize uctx = 
-  let ((vars',algs'), us') = 
-    Universes.normalize_context_set uctx.uctx_local uctx.uctx_univ_variables
-				    uctx.uctx_univ_algebraic
+let minimize uctx =
+  let open Universes in
+  let ((vars',algs'), us') =
+    normalize_context_set uctx.uctx_universes uctx.uctx_local uctx.uctx_univ_variables
+      uctx.uctx_univ_algebraic uctx.uctx_weak_constraints
   in
   if Univ.ContextSet.equal us' uctx.uctx_local then uctx
   else
     let us', universes =
-      Universes.refresh_constraints uctx.uctx_initial_universes us'
+      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;
-        uctx_initial_universes = uctx.uctx_initial_universes }
+        uctx_initial_universes = uctx.uctx_initial_universes;
+        uctx_weak_constraints = UPairSet.empty; (* weak constraints are consumed *) }
 
 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 =
@@ -494,3 +638,10 @@ let update_sigma_env uctx env =
                          uctx_universes = univs }
   in
   merge true univ_rigid eunivs eunivs.uctx_local
+
+let pr_weak prl {uctx_weak_constraints=weak} =
+  let open Pp in
+  prlist_with_sep fnl (fun (u,v) -> prl u ++ str " ~ " ++ prl v) (UPairSet.elements weak)
+
+(** Deprecated *)
+let normalize = minimize
diff --git a/engine/uState.mli b/engine/uState.mli
index 0cdc6277..48c38faf 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines universe unification states which are part of evarmaps.
@@ -24,17 +26,21 @@ val empty : t
 
 val make : UGraph.t -> t
 
+val make_with_initial_binders : UGraph.t -> Misctypes.lident list -> t
+
 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 +50,50 @@ 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 drop_weak_constraints : bool ref
+
+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,19 +103,31 @@ 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
-val make_flexible_variable : t -> bool -> Univ.Level.t -> t
+
+(** [make_flexible_variable g algebraic l]
+
+  Turn the variable [l] flexible, and algebraic if [algebraic] is true
+  and [l] can be. That is if there are no strict upper constraints on
+  [l] and and it does not appear in the instance of any non-algebraic
+  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
 
@@ -106,14 +135,36 @@ val fix_undefined_variables : t -> t
 
 val refresh_undefined_univ_variables : t -> t * Univ.universe_level_subst
 
+(** Universe minimization *)
+val minimize : t -> t
 val normalize : t -> t
+[@@ocaml.deprecated "Alias of UState.minimize"]
 
-(** {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.std_ppcmds
+val pr_uctx_level : t -> Univ.Level.t -> Pp.t
+val reference_of_level : t -> Univ.Level.t -> Libnames.reference
+
+val pr_weak : (Univ.Level.t -> Pp.t) -> t -> Pp.t
diff --git a/library/universes.ml b/engine/universes.ml
index 112b20a4..fb64a642 100644
--- a/library/universes.ml
+++ b/engine/universes.ml
@@ -1,101 +1,176 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+open Sorts
 open Util
 open Pp
 open Names
-open Term
+open Constr
 open Environ
 open Univ
 open Globnames
-open Decl_kinds
-
-(** 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 pr_with_global_universes l = 
-  try Nameops.pr_id (LMap.find l (snd !global_universes))
-  with Not_found -> Level.pr l
+open Nametab
+
+module UPairs = OrderedType.UnorderedPair(Univ.Level)
+module UPairSet = Set.Make (UPairs)
+
+let reference_of_level l = CAst.make @@
+  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 qid
+  | None -> Libnames.Ident 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
 let is_set_minimization () = !set_minimization
 			    
-type universe_constraint_type = ULe | UEq | ULub
-
-type universe_constraint = universe * universe_constraint_type * universe
+type universe_constraint =
+  | ULe of Universe.t * Universe.t
+  | UEq of Universe.t * Universe.t
+  | ULub of Level.t * Level.t
+  | UWeak of Level.t * Level.t
 
 module Constraints = struct
   module S = Set.Make(
   struct 
     type t = universe_constraint
 
-    let compare_type c c' =
-      match c, c' with
-      | ULe, ULe -> 0
-      | ULe, _ -> -1
-      | _, ULe -> 1
-      | UEq, UEq -> 0
-      | UEq, _ -> -1
-      | ULub, ULub -> 0
-      | ULub, _ -> 1
-      
-    let compare (u,c,v) (u',c',v') =
-      let i = compare_type c c' in
-	if Int.equal i 0 then
-	  let i' = Universe.compare u u' in
-	    if Int.equal i' 0 then Universe.compare v v'
-	    else 
-	      if c != ULe && Universe.compare u v' = 0 && Universe.compare v u' = 0 then 0
-	      else i'
-	else i
+    let compare x y =
+      match x, y with
+      | ULe (u, v), ULe (u', v') ->
+        let i = Universe.compare u u' in
+        if Int.equal i 0 then Universe.compare v v'
+        else i
+      | UEq (u, v), UEq (u', v') ->
+        let i = Universe.compare u u' in
+        if Int.equal i 0 then Universe.compare v v'
+        else if Universe.equal u v' && Universe.equal v u' then 0
+        else i
+      | ULub (u, v), ULub (u', v') | UWeak (u, v), UWeak (u', v') ->
+        let i = Level.compare u u' in
+        if Int.equal i 0 then Level.compare v v'
+        else if Level.equal u v' && Level.equal v u' then 0
+        else i
+      | ULe _, _ -> -1
+      | _, ULe _ -> 1
+      | UEq _, _ -> -1
+      | _, UEq _ -> 1
+      | ULub _, _ -> -1
+      | _, ULub _ -> 1
   end)
   
   include S
-  
-  let add (l,d,r as cst) s = 
-    if Universe.equal l r then s
-    else add cst s
 
-  let tr_dir = function
-    | ULe -> Le
-    | UEq -> Eq
-    | ULub -> Eq
+  let is_trivial = function
+    | ULe (u, v) | UEq (u, v) -> Universe.equal u v
+    | ULub (u, v) | UWeak (u, v) -> Level.equal u v
+
+  let add cst s =
+    if is_trivial cst then s
+    else add cst s
 
-  let op_str = function ULe -> " <= " | UEq -> " = " | ULub -> " /\\ "
+  let pr_one = function
+    | ULe (u, v) -> Universe.pr u ++ str " <= " ++ Universe.pr v
+    | UEq (u, v) -> Universe.pr u ++ str " = " ++ Universe.pr v
+    | ULub (u, v) -> Level.pr u ++ str " /\\ " ++ Level.pr v
+    | UWeak (u, v) -> Level.pr u ++ str " ~ " ++ Level.pr v
 
   let pr c =
-    fold (fun (u1,op,u2) pp_std ->
-	pp_std ++ Universe.pr u1 ++ str (op_str op) ++
-	Universe.pr u2 ++ fnl ()) c (str "")
+    fold (fun cst pp_std ->
+        pp_std ++ pr_one cst ++ fnl ()) c (str "")
 
   let equal x y = 
     x == y || equal x y
@@ -109,58 +184,98 @@ type 'a universe_constrained = 'a * universe_constraints
 type 'a universe_constraint_function = 'a -> 'a -> universe_constraints -> universe_constraints
 
 let enforce_eq_instances_univs strict x y c = 
-  let d = if strict then ULub else UEq in
+  let mk u v = if strict then ULub (u, v) else UEq (Universe.make u, Universe.make v) in
   let ax = Instance.to_array x and ay = Instance.to_array y in
     if Array.length ax != Array.length ay then
       CErrors.anomaly (Pp.str "Invalid argument: enforce_eq_instances_univs called with" ++
-	       Pp.str " instances of different lengths");
+	       Pp.str " instances of different lengths.");
     CArray.fold_right2
-      (fun x y -> Constraints.add (Universe.make x, d, Universe.make y))
+      (fun x y -> Constraints.add (mk x y))
       ax ay c
 
-let subst_univs_universe_constraint fn (u,d,v) =
-  let u' = subst_univs_universe fn u and v' = subst_univs_universe fn v in
+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 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_universe_constraint fn = function
+  | ULe (u, v) ->
+    let u' = subst_univs_universe fn u and v' = subst_univs_universe fn v in
+    if Universe.equal u' v' then None
+    else Some (ULe (u',v'))
+  | UEq (u, v) ->
+    let u' = subst_univs_universe fn u and v' = subst_univs_universe fn v in
     if Universe.equal u' v' then None
-    else Some (u',d,v')
+    else Some (ULe (u',v'))
+  | ULub (u, v) ->
+    let u' = level_subst_of fn u and v' = level_subst_of fn v in
+    if Level.equal u' v' then None
+    else Some (ULub (u',v'))
+  | UWeak (u, v) ->
+    let u' = level_subst_of fn u and v' = level_subst_of fn v in
+    if Level.equal u' v' then None
+    else Some (UWeak (u',v'))
 
 let subst_univs_universe_constraints subst csts =
   Constraints.fold 
     (fun c -> Option.fold_right Constraints.add (subst_univs_universe_constraint subst c))
     csts Constraints.empty 
 
-
-let to_constraints g s = 
-  let tr (x,d,y) acc =
-    let add l d l' acc = Constraint.add (l,Constraints.tr_dir d,l') acc in
-      match Universe.level x, d, Universe.level y with
-      | Some l, (ULe | UEq | ULub), Some l' -> add l d l' acc
-      | _, ULe, Some l' -> enforce_leq x y acc
-      | _, ULub, _ -> acc
-      | _, d, _ -> 
-	let f = if d == ULe then UGraph.check_leq else UGraph.check_eq in
-	  if f g x y then acc else 
-	    raise (Invalid_argument 
-		   "to_constraints: non-trivial algebraic constraint between universes")
-  in Constraints.fold tr s Constraint.empty
-
-let eq_constr_univs_infer univs fold m n accu =
-  if m == n then Some accu
-  else 
-    let cstrs = ref accu in
-    let eq_universes strict = UGraph.check_eq_instances univs 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 rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let res = Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n in
-    if res then Some !cstrs else None
+let to_constraints ~force_weak g s =
+  let invalid () =
+    raise (Invalid_argument "to_constraints: non-trivial algebraic constraint between universes")
+  in
+  let tr cst acc =
+    match cst with
+    | ULub (l, l') -> Constraint.add (l, Eq, l') acc
+    | UWeak (l, l') when force_weak -> Constraint.add (l, Eq, l') acc
+    | UWeak  _-> acc
+    | ULe (l, l') ->
+      begin match Universe.level l, Universe.level l' with
+        | Some l, Some l' -> Constraint.add (l, Le, l') acc
+        | None, Some _ -> enforce_leq l l' acc
+        | _, None ->
+          if UGraph.check_leq g l l'
+          then acc
+          else invalid ()
+      end
+    | UEq (l, l') ->
+      begin match Universe.level l, Universe.level l' with
+        | Some l, Some l' -> Constraint.add (l, Eq, l') acc
+        | None, _ | _, None ->
+          if UGraph.check_eq g l l'
+          then acc
+          else invalid ()
+      end
+  in
+  Constraints.fold tr s Constraint.empty
 
 (** Variant of [eq_constr_univs_infer] taking kind-of-term functions,
     to expose subterms of [m] and [n], arguments. *)
@@ -172,141 +287,33 @@ let eq_constr_univs_infer_with kind1 kind2 univs fold m n accu =
      [kind1,kind2], because [kind1] and [kind2] may be different,
      typically evaluating [m] and [n] in different evar maps. *)
   let cstrs = ref accu in
-  let eq_universes strict = UGraph.check_eq_instances univs in
+  let eq_universes _ _ = UGraph.check_eq_instances univs 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
+      match fold (Constraints.singleton (UEq (u1, u2))) !cstrs with
       | None -> false
       | Some accu -> cstrs := accu; true
   in
-  let rec eq_constr' m n = 
-    Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq_constr' m n
+  let rec eq_constr' nargs m n =
+    Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq_constr' nargs m n
   in
-  let res = Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq_constr' m n in
+  let res = Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq_constr' 0 m n in
   if res then Some !cstrs else None
 
-let leq_constr_univs_infer univs fold m n accu =
-  if m == n then Some accu
-  else 
-    let cstrs = ref accu in
-    let eq_universes strict l l' = UGraph.check_eq_instances univs l l' in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-	match fold (Constraints.singleton (u1, UEq, u2)) !cstrs with
-	| None -> false
-	| Some accu -> cstrs := accu; true
-    in
-    let leq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else 
-	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-	match fold (Constraints.singleton (u1, ULe, u2)) !cstrs with
-	| None -> false
-	| Some accu -> cstrs := accu; true
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let rec compare_leq m n =
-      Constr.compare_head_gen_leq eq_universes leq_sorts 
-	eq_constr' leq_constr' m n
-    and leq_constr' m n = m == n || compare_leq m n in
-    let res = compare_leq m n in
-    if res then Some !cstrs else None
-
-let eq_constr_universes m n =
-  if m == n then true, Constraints.empty
-  else 
-    let cstrs = ref Constraints.empty in
-    let eq_universes strict l l' = 
-      cstrs := enforce_eq_instances_univs strict l l' !cstrs; true in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	(cstrs := Constraints.add 
-	   (Sorts.univ_of_sort s1, UEq, Sorts.univ_of_sort s2) !cstrs;
-	 true)
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let res = Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n in
-    res, !cstrs
-
-let leq_constr_universes m n =
-  if m == n then true, Constraints.empty
-  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 rec compare_leq m n =
-      Constr.compare_head_gen_leq eq_universes leq_sorts eq_constr' leq_constr' m n
-    and leq_constr' m n = m == n || compare_leq m n in
-    let res = compare_leq m n in
-    res, !cstrs
-
-let compare_head_gen_proj env equ eqs eqc' m n =
-  match kind_of_term m, kind_of_term 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' -> 
-          let pb = Environ.lookup_projection p env in
-          let npars = pb.Declarations.proj_npars in
-	  if Array.length args == npars + 1 then
-	    eqc' c args.(npars)
-	  else false
-      | _ -> false)
-  | _ -> Constr.compare_head_gen equ eqs eqc' m n
-      
-let eq_constr_universes_proj env m n =
-  if m == n then true, Constraints.empty
-  else 
-    let cstrs = ref Constraints.empty in
-    let eq_universes strict l l' = 
-      cstrs := enforce_eq_instances_univs strict l l' !cstrs; true in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	(cstrs := Constraints.add 
-	   (Sorts.univ_of_sort s1, UEq, Sorts.univ_of_sort s2) !cstrs;
-	 true)
-    in
-    let rec eq_constr' m n = 
-      m == n ||	compare_head_gen_proj env eq_universes eq_sorts eq_constr' m n
-    in
-    let res = eq_constr' m n in
-    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)
@@ -314,30 +321,29 @@ let new_Type dp = mkType (new_univ dp)
 let new_Type_sort dp = Type (new_univ dp)
 
 let fresh_universe_instance ctx =
-  Instance.subst_fn (fun _ -> new_univ_level (Global.current_dirpath ())) 
-    (UContext.instance ctx)
+  let init _ = new_univ_level () in
+  Instance.of_array (Array.init (AUContext.size ctx) init)
 
 let fresh_instance_from_context ctx =
   let inst = fresh_universe_instance ctx in
-  let constraints = instantiate_univ_constraints inst ctx in
+  let constraints = AUContext.instantiate inst ctx in
     inst, constraints
 
 let fresh_instance ctx =
   let ctx' = ref LSet.empty in
-  let inst = 
-    Instance.subst_fn (fun v -> 
-      let u = new_univ_level (Global.current_dirpath ()) in
-	ctx' := LSet.add u !ctx'; u) 
-      (UContext.instance ctx)
+  let init _ =
+    let u = new_univ_level () in
+    ctx' := LSet.add u !ctx'; u
+  in
+  let inst = Instance.of_array (Array.init (AUContext.size ctx) init)
   in !ctx', inst
 
 let existing_instance ctx inst = 
   let () = 
-    let a1 = Instance.to_array inst 
-    and a2 = Instance.to_array (UContext.instance ctx) in
-    let len1 = Array.length a1 and len2 = Array.length a2 in 
+    let len1 = Array.length (Instance.to_array inst)
+    and len2 = AUContext.size ctx in
       if not (len1 == len2) then
-	CErrors.errorlabstrm "Universes"
+	CErrors.user_err ~hdr:"Universes"
 	  (str "Polymorphic constant expected " ++ int len2 ++ 
 	     str" levels but was given " ++ int len1)
       else ()
@@ -349,59 +355,44 @@ let fresh_instance_from ctx inst =
     | Some inst -> existing_instance ctx inst
     | None -> fresh_instance ctx 
   in
-  let constraints = instantiate_univ_constraints inst ctx in
+  let constraints = AUContext.instantiate inst ctx in
     inst, (ctx', constraints)
 
-let unsafe_instance_from ctx =
-  (Univ.UContext.instance ctx, ctx)
-    
 (** Fresh universe polymorphic construction *)
 
 let fresh_constant_instance env c inst =
   let cb = lookup_constant c env in
-    if cb.Declarations.const_polymorphic then
-      let inst, ctx =
-        fresh_instance_from
-          (Declareops.universes_of_constant (Environ.opaque_tables env) cb) inst
-      in
-	((c, inst), ctx)
-    else ((c,Instance.empty), ContextSet.empty)
+  match cb.Declarations.const_universes with
+  | Declarations.Monomorphic_const _ -> ((c,Instance.empty), ContextSet.empty)
+  | Declarations.Polymorphic_const auctx -> 
+    let inst, ctx =
+      fresh_instance_from auctx inst
+    in
+    ((c, inst), ctx)
 
 let fresh_inductive_instance env ind inst = 
   let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = fresh_instance_from mib.Declarations.mind_universes inst in
-	((ind,inst), ctx)
-    else ((ind,Instance.empty), ContextSet.empty)
+  match mib.Declarations.mind_universes with
+  | Declarations.Monomorphic_ind _ ->
+    ((ind,Instance.empty), ContextSet.empty)
+  | Declarations.Polymorphic_ind uactx ->
+    let inst, ctx = (fresh_instance_from uactx) inst in 
+     ((ind,inst), ctx)
+  | Declarations.Cumulative_ind acumi ->
+    let inst, ctx = 
+      fresh_instance_from (Univ.ACumulativityInfo.univ_context acumi) inst
+    in ((ind,inst), ctx)
 
 let fresh_constructor_instance env (ind,i) inst = 
   let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = fresh_instance_from mib.Declarations.mind_universes inst in
-	(((ind,i),inst), ctx)
-    else (((ind,i),Instance.empty), ContextSet.empty)
-
-let unsafe_constant_instance env c =
-  let cb = lookup_constant c env in
-    if cb.Declarations.const_polymorphic then
-      let inst, ctx = unsafe_instance_from
-        (Declareops.universes_of_constant (Environ.opaque_tables env) cb) in
-	((c, inst), ctx)
-    else ((c,Instance.empty), UContext.empty)
-
-let unsafe_inductive_instance env ind = 
-  let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = unsafe_instance_from mib.Declarations.mind_universes in
-	((ind,inst), ctx)
-    else ((ind,Instance.empty), UContext.empty)
-
-let unsafe_constructor_instance env (ind,i) = 
-  let mib, mip = Inductive.lookup_mind_specif env ind in
-    if mib.Declarations.mind_polymorphic then
-      let inst, ctx = unsafe_instance_from mib.Declarations.mind_universes in
+  match mib.Declarations.mind_universes with
+  | Declarations.Monomorphic_ind _ -> (((ind,i),Instance.empty), ContextSet.empty)
+  | Declarations.Polymorphic_ind auctx ->
+    let inst, ctx = fresh_instance_from auctx  inst in
 	(((ind,i),inst), ctx)
-    else (((ind,i),Instance.empty), UContext.empty)
+  | Declarations.Cumulative_ind acumi ->
+    let inst, ctx = fresh_instance_from (ACumulativityInfo.univ_context acumi) inst in
+    (((ind,i),inst), ctx)
 
 open Globnames
 
@@ -427,19 +418,6 @@ let fresh_inductive_instance env sp =
 let fresh_constructor_instance env sp = 
   fresh_constructor_instance env sp None
 
-let unsafe_global_instance env gr =
-  match gr with
-  | VarRef id -> mkVar id, UContext.empty
-  | ConstRef sp -> 
-     let c, ctx = unsafe_constant_instance env sp in
-       mkConstU c, ctx
-  | ConstructRef sp ->
-     let c, ctx = unsafe_constructor_instance env sp in
-       mkConstructU c, ctx
-  | IndRef sp -> 
-     let c, ctx = unsafe_inductive_instance env sp in
-       mkIndU c, ctx
-
 let constr_of_global gr =
   let c, ctx = fresh_global_instance (Global.env ()) gr in
     if not (Univ.ContextSet.is_empty ctx) then
@@ -447,17 +425,13 @@ let constr_of_global gr =
 	(* Should be an error as we might forget constraints, allow for now
 	   to make firstorder work with "using" clauses *)
 	c
-      else raise (Invalid_argument 
-		    ("constr_of_global: globalization of polymorphic reference " ^ 
-			Pp.string_of_ppcmds (Nametab.pr_global_env Id.Set.empty gr) ^
-			" would forget universes."))
+      else CErrors.user_err ~hdr:"constr_of_global"
+          Pp.(str "globalization of polymorphic reference " ++ Nametab.pr_global_env Id.Set.empty gr ++
+	      str " would forget universes.")
     else c
 
 let constr_of_reference = constr_of_global
 
-let unsafe_constr_of_global gr =
-  unsafe_global_instance (Global.env ()) gr
-
 let constr_of_global_univ (gr,u) =
   match gr with
   | VarRef id -> mkVar id
@@ -470,22 +444,13 @@ 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
   | Var id -> VarRef id, Instance.empty
   | _ -> raise Not_found
 
-let global_app_of_constr c =
-  match kind_of_term c with
-  | Const (c, u) -> (ConstRef c, u), None
-  | Ind (i, u) -> (IndRef i, u), None
-  | Construct (c, u) -> (ConstructRef c, u), None
-  | Var id -> (VarRef id, Instance.empty), None
-  | Proj (p, c) -> (ConstRef (Projection.constant p), Instance.empty), Some c
-  | _ -> raise Not_found
-
 open Declarations
 
 let type_of_reference env r =
@@ -493,52 +458,56 @@ let type_of_reference env r =
   | VarRef id -> Environ.named_type id env, ContextSet.empty
   | ConstRef c ->
      let cb = Environ.lookup_constant c env in
-     let ty = Typeops.type_of_constant_type env cb.const_type in
-       if cb.const_polymorphic then
-	 let inst, ctx = fresh_instance_from (Declareops.universes_of_constant (Environ.opaque_tables env) cb) None in
-	   Vars.subst_instance_constr inst ty, ctx
-       else ty, ContextSet.empty
-
+     let ty = cb.const_type in
+     begin
+       match cb.const_universes with
+       | Monomorphic_const _ -> ty, ContextSet.empty
+       | Polymorphic_const auctx ->
+         let inst, ctx = fresh_instance_from auctx None in
+         Vars.subst_instance_constr inst ty, ctx
+     end
   | IndRef ind ->
      let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-       if mib.mind_polymorphic then
-	 let inst, ctx = fresh_instance_from mib.mind_universes None in
+     begin
+       match mib.mind_universes with
+       | Monomorphic_ind _ ->
+         let ty = Inductive.type_of_inductive env (specif, Univ.Instance.empty) in
+	 ty, ContextSet.empty
+       | Polymorphic_ind auctx ->
+         let inst, ctx = fresh_instance_from auctx  None in
 	 let ty = Inductive.type_of_inductive env (specif, inst) in
-	   ty, ctx
-       else
-	 let ty = Inductive.type_of_inductive env (specif, Univ.Instance.empty) in
-	   ty, ContextSet.empty
+         ty, ctx
+       | Cumulative_ind cumi ->
+         let inst, ctx = 
+           fresh_instance_from (ACumulativityInfo.univ_context cumi) None
+         in
+         let ty = Inductive.type_of_inductive env (specif, inst) in
+         ty, ctx
+     end
+	 
   | ConstructRef cstr ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-       if mib.mind_polymorphic then
-	 let inst, ctx = fresh_instance_from mib.mind_universes None in
-	   Inductive.type_of_constructor (cstr,inst) specif, ctx
-       else Inductive.type_of_constructor (cstr,Instance.empty) specif, ContextSet.empty
+    let (mib,oib as specif) = 
+      Inductive.lookup_mind_specif env (inductive_of_constructor cstr) 
+    in
+    begin
+       match mib.mind_universes with
+       | Monomorphic_ind _ ->
+         Inductive.type_of_constructor (cstr,Instance.empty) specif, ContextSet.empty
+       | Polymorphic_ind auctx ->
+         let inst, ctx = fresh_instance_from auctx None in
+	 Inductive.type_of_constructor (cstr,inst) specif, ctx
+       | Cumulative_ind cumi ->
+         let inst, ctx = 
+           fresh_instance_from (ACumulativityInfo.univ_context cumi) None 
+         in
+	 Inductive.type_of_constructor (cstr,inst) specif, ctx
+     end
 
 let type_of_global t = type_of_reference (Global.env ()) t
 
-let unsafe_type_of_reference env r =
-  match r with
-  | VarRef id -> Environ.named_type id env
-  | ConstRef c ->
-     let cb = Environ.lookup_constant c env in
-       Typeops.type_of_constant_type env cb.const_type
-
-  | IndRef ind ->
-     let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-     let (_, inst), _ = unsafe_inductive_instance env ind in
-       Inductive.type_of_inductive env (specif, inst)
-
-  | ConstructRef (ind, _ as cstr) ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-     let (_, inst), _ = unsafe_inductive_instance env ind in
-       Inductive.type_of_constructor (cstr,inst) specif
-
-let unsafe_type_of_global t = unsafe_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
@@ -560,7 +529,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
 
@@ -588,34 +557,44 @@ let choose_canonical ctx flexible algs s =
 	      let canon = LSet.choose algs in
 		canon, (global, rigid, LSet.remove canon flexible)
 
-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 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 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 rec aux c =
-    match kind_of_term c with
-    | Evar (evk, args) ->
-      let args = Array.map aux args in
-      (match try f (evk, args) with Not_found -> None with
-      | None -> c
-      | Some c -> aux c)
-    | Const pu -> 
-      let pu' = subst_univs_fn_puniverses lsubst pu in
-	if pu' == pu then c else mkConstU pu'
-    | Ind pu ->
-      let pu' = subst_univs_fn_puniverses lsubst pu in
-	if pu' == pu then c else mkIndU pu'
-    | Construct pu ->
-      let pu' = subst_univs_fn_puniverses lsubst pu in
-	if pu' == pu then c else mkConstructU pu'
-    | 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
-  in aux
+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 fresh_universe_context_set_instance ctx =
   if ContextSet.is_empty ctx then LMap.empty, ctx
@@ -653,7 +632,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 =
@@ -673,8 +652,37 @@ 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 subst_univs_fn_puniverses f (c, u as cu) =
+  let u' = Instance.subst_fn f u in
+    if u' == u then cu else (c, u')
+
+let nf_evars_and_universes_opt_subst f subst =
+  let subst = normalize_univ_variable_opt_subst (ref subst) in
+  let lsubst = level_subst_of subst in
+  let rec aux c =
+    match kind c with
+    | Evar (evk, args) ->
+      let args = Array.map aux args in
+      (match try f (evk, args) with Not_found -> None with
+      | None -> mkEvar (evk, args)
+      | Some c -> aux c)
+    | Const pu ->
+      let pu' = subst_univs_fn_puniverses lsubst pu in
+        if pu' == pu then c else mkConstU pu'
+    | Ind pu ->
+      let pu' = subst_univs_fn_puniverses lsubst pu in
+        if pu' == pu then c else mkIndU pu'
+    | Construct pu ->
+      let pu' = subst_univs_fn_puniverses lsubst pu in
+        if pu' == pu then c else mkConstructU pu'
+    | Sort (Type u) ->
+      let u' = Univ.subst_univs_universe subst u in
+        if u' == u then c else mkSort (sort_of_univ u')
+    | _ -> Constr.map aux c
+  in aux
+
 let make_opt_subst s = 
   fun x -> 
     (match Univ.LMap.find x s with
@@ -683,8 +691,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
@@ -773,7 +780,7 @@ let instantiate_with_lbound u lbound lower alg enforce (ctx, us, algs, insts, cs
 
 type constraints_map = (Univ.constraint_type * Univ.LMap.key) list Univ.LMap.t
 
-let pr_constraints_map cmap =
+let _pr_constraints_map (cmap:constraints_map) =
   LMap.fold (fun l cstrs acc -> 
     Level.pr l ++ str " => " ++ 
       prlist_with_sep spc (fun (d,r) -> pr_constraint_type d ++ Level.pr r) cstrs ++
@@ -911,7 +918,7 @@ let minimize_univ_variables ctx us algs left right cstrs =
       else LSet.remove u ctx', us, LSet.remove u algs, seen, cstrs)
       us (ctx, us, algs, lbounds, cstrs)
 
-let normalize_context_set ctx us algs = 
+let normalize_context_set g ctx us algs weak =
   let (ctx, csts) = ContextSet.levels ctx, ContextSet.constraints ctx in
   let uf = UF.create () in
   (** Keep the Prop/Set <= i constraints separate for minimization *)
@@ -931,11 +938,11 @@ let normalize_context_set ctx us algs =
 	else (smallles, Constraint.add cstr noneqs))
     csts (Constraint.empty, Constraint.empty)
   in
-  let csts = 
+  let csts =
     (* 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
@@ -969,7 +976,7 @@ let normalize_context_set ctx us algs =
   let noneqs = Constraint.union noneqs smallles in
   let partition = UF.partition uf in
   let flex x = LMap.mem x us in
-  let ctx, subst, us, eqs = List.fold_left (fun (ctx, subst, us, cstrs) s -> 
+  let ctx, us, eqs = List.fold_left (fun (ctx, us, cstrs) s ->
     let canon, (global, rigid, flexible) = choose_canonical ctx flex algs s in
     (* Add equalities for globals which can't be merged anymore. *)
     let cstrs = LSet.fold (fun g cst -> 
@@ -981,16 +988,41 @@ let normalize_context_set ctx us algs =
       Constraint.add (canon, Univ.Eq, g) cst) rigid
       cstrs
     in
-    let subst = LSet.fold (fun f -> LMap.add f canon) rigid subst in
-    let subst = LSet.fold (fun f -> LMap.add f canon) flexible subst in
     let canonu = Some (Universe.make canon) in
     let us = LSet.fold (fun f -> LMap.add f canonu) flexible us in
-      (LSet.diff ctx flexible, subst, us, cstrs))
-    (ctx, LMap.empty, us, Constraint.empty) partition
+      (LSet.diff ctx flexible, us, cstrs))
+    (ctx, us, Constraint.empty) partition
   in
+  (* Process weak constraints: when one side is flexible and the 2
+     universes are unrelated unify them. *)
+  let ctx, us, g = UPairSet.fold (fun (u,v) (ctx, us, g as acc) ->
+      let norm = let us = ref us in level_subst_of (normalize_univ_variable_opt_subst us) in
+      let u = norm u and v = norm v in
+      let set_to a b =
+        (LSet.remove a ctx,
+         LMap.add a (Some (Universe.make b)) us,
+         UGraph.enforce_constraint (a,Eq,b) g)
+      in
+      if UGraph.check_constraint g (u,Le,v) || UGraph.check_constraint g (v,Le,u)
+      then acc
+      else
+      if LMap.mem u us
+      then set_to u v
+      else if LMap.mem v us
+      then set_to v u
+      else acc)
+      weak (ctx, us, g)  in
   (* Noneqs is now in canonical form w.r.t. equality constraints, 
      and contains only inequality constraints. *)
-  let noneqs = subst_univs_level_constraints subst noneqs in
+  let noneqs =
+    let us = ref us in
+    let norm = level_subst_of (normalize_univ_variable_opt_subst us) in
+    Constraint.fold (fun (u,d,v) noneqs ->
+        let u = norm u and v = norm v in
+        if d != Lt && Level.equal u v then noneqs
+        else Constraint.add (u,d,v) noneqs)
+      noneqs Constraint.empty
+  in
   (* Compute the left and right set of flexible variables, constraints
      mentionning other variables remain in noneqs. *)
   let noneqs, ucstrsl, ucstrsr = 
@@ -1015,66 +1047,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 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
-
-let simplify_universe_context (univs,csts) =
-  let uf = UF.create () in
-  let noneqs =
-    Constraint.fold (fun (l,d,r) noneqs ->
-      if d == Eq && (LSet.mem l univs || LSet.mem r univs) then 
-	(UF.union l r uf; noneqs)
-      else Constraint.add (l,d,r) noneqs)
-      csts Constraint.empty
-  in
-  let partition = UF.partition uf in
-  let flex x = LSet.mem x univs in
-  let subst, univs', csts' = List.fold_left (fun (subst, univs, cstrs) s -> 
-    let canon, (global, rigid, flexible) = choose_canonical univs flex LSet.empty s in
-    (* Add equalities for globals which can't be merged anymore. *)
-    let cstrs = LSet.fold (fun g cst -> 
-      Constraint.add (canon, Univ.Eq, g) cst) (LSet.union global rigid)
-      cstrs 
-    in
-    let subst = LSet.fold (fun f -> LMap.add f canon)
-      flexible subst
-    in (subst, LSet.diff univs flexible, cstrs))
-    (LMap.empty, univs, noneqs) partition
-  in
-  (* Noneqs is now in canonical form w.r.t. equality constraints, 
-     and contains only inequality constraints. *)
-  let csts' = subst_univs_level_constraints subst csts' in
-    (univs', csts'), subst
+(* 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))
diff --git a/engine/universes.mli b/engine/universes.mli
new file mode 100644
index 00000000..4823c574
--- /dev/null
+++ b/engine/universes.mli
@@ -0,0 +1,234 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Util
+open Names
+open Constr
+open Environ
+open Univ
+
+(** Unordered pairs of universe levels (ie (u,v) = (v,u)) *)
+module UPairSet : CSet.S with type elt = (Level.t * Level.t)
+
+val set_minimization : bool ref
+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 = 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 *)
+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_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.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.
+
+    UWeak constraints come from irrelevant universes in cumulative polymorphism.
+*)
+
+type universe_constraint =
+  | ULe of Universe.t * Universe.t
+  | UEq of Universe.t * Universe.t
+  | ULub of Level.t * Level.t
+  | UWeak of Level.t * Level.t
+
+module Constraints : sig
+  include Set.S with type elt = universe_constraint
+
+  val is_trivial : universe_constraint -> bool
+
+  val pr : t -> Pp.t
+end
+
+type universe_constraints = Constraints.t
+[@@ocaml.deprecated "Use Constraints.t"]
+
+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 subst_univs_universe_constraints : universe_subst_fn -> 
+  Constraints.t -> Constraints.t
+
+val enforce_eq_instances_univs : bool -> Instance.t universe_constraint_function
+
+(** With [force_weak] UWeak constraints are turned into equalities,
+   otherwise they're forgotten. *)
+val to_constraints : force_weak:bool -> 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
+    subterms of [m] and [n], arguments. *)
+val eq_constr_univs_infer_with :
+  (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) ->
+  (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) ->
+  UGraph.t -> 'a constraint_accumulator -> constr -> constr -> 'a -> 'a option
+
+(** Build a fresh instance for a given context, its associated substitution and 
+    the instantiated constraints. *)
+
+val fresh_instance_from_context : AUContext.t -> 
+  Instance.t constrained
+
+val fresh_instance_from : AUContext.t -> Instance.t option ->
+  Instance.t in_universe_context_set
+
+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
+val fresh_constructor_instance : env -> constructor ->
+  pconstructor in_universe_context_set
+
+val fresh_global_instance : ?names:Univ.Instance.t -> env -> Globnames.global_reference -> 
+  constr in_universe_context_set
+
+val fresh_global_or_constr_instance : env -> Globnames.global_reference_or_constr -> 
+  constr in_universe_context_set
+
+(** Get fresh variables for the universe context.
+    Useful to make tactics that manipulate constrs in universe contexts polymorphic. *)
+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 -> ContextSet.t -> 
+  'a in_universe_context_set
+
+(** Simplification and pruning of constraints:
+    [normalize_context_set ctx us]
+
+    - Instantiate the variables in [us] with their most precise
+    universe levels respecting the constraints.
+
+    - Normalizes the context [ctx] w.r.t. equality constraints, 
+    choosing a canonical universe in each equivalence class 
+    (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 = 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.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 : UGraph.t -> ContextSet.t ->
+  universe_opt_subst (* The defined and undefined variables *) ->
+  LSet.t (* univ variables that can be substituted by algebraics *) ->
+  UPairSet.t (* weak equality constraints *) ->
+  (universe_opt_subst * LSet.t) in_universe_context_set
+
+val normalize_univ_variables : universe_opt_subst -> 
+  universe_opt_subst * LSet.t * LSet.t * universe_subst
+
+val normalize_univ_variable : 
+  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 ->
+  (Level.t -> Universe.t)
+
+val normalize_univ_variable_subst : universe_subst ref ->
+  (Level.t -> Universe.t)
+
+val normalize_universe_opt_subst : universe_opt_subst ref ->
+  (Universe.t -> Universe.t)
+
+val normalize_universe_subst : universe_subst ref ->
+  (Universe.t -> Universe.t)
+
+(** Create a fresh global in the global environment, without side effects.
+    BEWARE: this raises an ANOMALY on polymorphic constants/inductives: 
+    the constraints should be properly added to an evd. 
+    See Evd.fresh_global, Evarutil.new_global, and pf_constr_of_global for
+    the proper way to get a fresh copy of a global reference. *)
+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
+    universe counter, use with care). *)
+val type_of_global : Globnames.global_reference -> types in_universe_context_set
+
+(** Full universes substitutions into terms *)
+
+val nf_evars_and_universes_opt_subst : (existential -> constr option) -> 
+  universe_opt_subst -> constr -> constr
+
+val refresh_constraints : UGraph.t -> ContextSet.t -> ContextSet.t * UGraph.t
+
+(** Pretty-printing *)
+
+val pr_universe_opt_subst : universe_opt_subst -> Pp.t
+
+(** {6 Support for template polymorphism } *)
+
+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 00000000..76dbaa25
--- /dev/null
+++ b/engine/univops.ml
@@ -0,0 +1,113 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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/engine/univops.mli b/engine/univops.mli
new file mode 100644
index 00000000..d1585414
--- /dev/null
+++ b/engine/univops.mli
@@ -0,0 +1,18 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Constr
+open Univ
+
+(** The universes of monomorphic constants appear. *)
+val universes_of_constr : Environ.env -> constr -> LSet.t
+
+(** 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 d0ab5d80..9c25dcfa 100644
--- a/grammar/argextend.mlp
+++ b/grammar/argextend.mlp
@@ -1,16 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Q_util
-open GramCompat
 
-let loc = CompatLoc.ghost
-let default_loc = <:expr< Loc.ghost >>
+let loc = Ploc.dummy
+
+IFDEF STRICT THEN
+  let ploc_vala x = Ploc.VaVal x
+ELSE
+  let ploc_vala x = x
+END
+
+let declare_str_items loc l =
+  MLast.StDcl (loc, ploc_vala l) (* correspond to <:str_item< declare $list:l'$ end >> *)
 
 let mk_extraarg loc s = <:expr< $lid:"wit_"^s$ >>
 
@@ -32,7 +41,8 @@ let make_topwit loc arg = <:expr< Genarg.topwit $make_wit loc arg$ >>
 let make_act loc act pil =
   let rec make = function
     | [] -> <:expr< (fun loc -> $act$) >>
-    | ExtNonTerminal (_, p) :: tl -> <:expr< (fun $lid:p$ -> $make tl$) >>
+    | ExtNonTerminal (_, None) :: tl -> <:expr< (fun $lid:"_"$ -> $make tl$) >>
+    | ExtNonTerminal (_, Some p) :: tl -> <:expr< (fun $lid:p$ -> $make tl$) >>
     | ExtTerminal _ :: tl ->
 	<:expr< (fun _ -> $make tl$) >> in
   make (List.rev pil)
@@ -55,7 +65,7 @@ let is_ident x = function
 | _ -> false
 
 let make_extend loc s cl wit = match cl with
-| [[ExtNonTerminal (Uentry e, id)], act] when is_ident id act ->
+| [[ExtNonTerminal (Uentry e, Some id)], act] when is_ident id act ->
   (** Special handling of identity arguments by not redeclaring an entry *)
   <:str_item<
     value $lid:s$ =
@@ -129,11 +139,11 @@ let declare_tactic_argument loc s (typ, f, g, h) cl =
       let typ = match globtyp with None -> ExtraArgType s | Some typ -> typ in
       <:expr<
         let f = $lid:f$ in
-        fun ist v -> Ftactic.nf_s_enter { Proofview.Goal.s_enter = fun gl ->
+        fun ist v -> Ftactic.enter (fun gl ->
           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
-          Sigma.Unsafe.of_pair (Ftactic.return v, sigma)
-        }
+          Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) (Ftactic.return v)
+        )
       >> in
   let subst = match h with
     | None ->
@@ -170,22 +180,16 @@ let declare_vernac_argument loc s pr cl =
   let se = mlexpr_of_string s in
   let wit = <:expr< $lid:"wit_"^s$ >> in
   let pr_rules = match pr with
-    | None -> <:expr< fun _ _ _ _ -> str $str:"[No printer for "^s^"]"$ >>
+    | None -> <:expr< fun _ _ _ _ -> Pp.str $str:"[No printer for "^s^"]"$ >>
     | Some pr -> <:expr< fun _ _ _ -> $lid:pr$ >> in
   declare_str_items loc
    [ <:str_item<
       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
-open PcamlSig (* necessary for camlp4 *)
 
 EXTEND
   GLOBAL: str_item;
@@ -239,10 +243,13 @@ EXTEND
   genarg:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
         let e = parse_user_entry e "" in
-        ExtNonTerminal (e, s)
+        ExtNonTerminal (e, Some s)
       | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
         let e = parse_user_entry e sep in
-        ExtNonTerminal (e, s)
+        ExtNonTerminal (e, Some s)
+      | e = LIDENT ->
+        let e = parse_user_entry e "" in
+        ExtNonTerminal (e, None)
       | s = STRING -> ExtTerminal s
     ] ]
   ;
diff --git a/grammar/compat5.ml b/grammar/compat5.ml
deleted file mode 100644
index 33c1cd60..00000000
--- a/grammar/compat5.ml
+++ /dev/null
@@ -1,13 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* This file is meant for camlp5, for which there is nothing to
-   add to gain camlp5 compatibility :-).
-
-   See [compat5.mlp] for the [camlp4] counterpart
-*)
diff --git a/grammar/compat5.mlp b/grammar/compat5.mlp
deleted file mode 100644
index 8473a1fb..00000000
--- a/grammar/compat5.mlp
+++ /dev/null
@@ -1,23 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Adding a bit of camlp5 syntax to camlp4 for compatibility:
-    - GEXTEND ... becomes EXTEND ...
-*)
-
-open Camlp4.PreCast
-
-let rec my_token_filter = parser
-  | [< '(KEYWORD "GEXTEND", loc); s >] ->
-    [< '(KEYWORD "EXTEND", loc); my_token_filter s >]
-  | [< 'tokloc; s >] -> [< 'tokloc; my_token_filter s >]
-  | [< >] -> [< >]
-
-let _ =
-  Token.Filter.define_filter (Gram.get_filter())
-    (fun prev strm -> prev (my_token_filter strm))
diff --git a/grammar/compat5b.mlp b/grammar/compat5b.mlp
deleted file mode 100644
index 46802a82..00000000
--- a/grammar/compat5b.mlp
+++ /dev/null
@@ -1,23 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Adding a bit of camlp5 syntax to camlp4 for compatibility:
-    - EXTEND ... becomes EXTEND Gram ...
-*)
-
-open Camlp4.PreCast
-
-let rec my_token_filter = parser
-  | [< '(KEYWORD "EXTEND",_ as t); s >] ->
-    [< 't; '(UIDENT "Gram", Loc.ghost); my_token_filter s >]
-  | [< 'tokloc; s >] -> [< 'tokloc; my_token_filter s >]
-  | [< >] -> [< >]
-
-let _ =
-  Token.Filter.define_filter (Gram.get_filter())
-    (fun prev strm -> prev (my_token_filter strm))
diff --git a/grammar/gramCompat.mlp b/grammar/gramCompat.mlp
deleted file mode 100644
index 6246da7b..00000000
--- a/grammar/gramCompat.mlp
+++ /dev/null
@@ -1,86 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Compatibility file depending on ocaml/camlp4 version *)
-
-(** Misc module emulation *)
-
-IFDEF CAMLP5 THEN
-
-module CompatLoc = struct
-  include Ploc
-  let ghost = dummy
-  let merge = encl
-end
-
-ELSE
-
-module CompatLoc = Camlp4.PreCast.Loc
-
-END
-
-IFDEF CAMLP5 THEN
-
-module PcamlSig = struct end
-
-ELSE
-
-module PcamlSig = Camlp4.Sig
-module Ast = Camlp4.PreCast.Ast
-module Pcaml = Camlp4.PreCast.Syntax
-module MLast = Ast
-
-END
-
-(** Compatibility with camlp5 strict mode *)
-IFDEF CAMLP5 THEN
-  IFDEF STRICT THEN
-    let vala x = Ploc.VaVal x
-  ELSE
-    let vala x = x
-  END
-ELSE
-  let vala x = x
-END
-
-(** Fix a quotation difference in [str_item] *)
-
-let declare_str_items loc l =
-IFDEF CAMLP5 THEN
-  MLast.StDcl (loc, vala l) (* correspond to <:str_item< declare $list:l'$ end >> *)
-ELSE
-  Ast.stSem_of_list l
-END
-
-(** Quotation difference for match clauses *)
-
-let default_patt loc =
-  (<:patt< _ >>, vala None, <:expr< failwith "Extension: cannot occur" >>)
-
-IFDEF CAMLP5 THEN
-
-let make_fun loc cl =
-  let l = cl @ [default_patt loc] in
-  MLast.ExFun (loc, vala l)  (* correspond to <:expr< fun [ $list:l$ ] >> *)
-
-ELSE
-
-let make_fun loc cl =
-  let mk_when = function
-    | Some w -> w
-    | None -> Ast.ExNil loc
-  in
-  let mk_clause (patt,optwhen,expr) =
-    (* correspond to <:match_case< ... when ... -> ... >> *)
-    Ast.McArr (loc, patt, mk_when optwhen, expr) in
-  let init = mk_clause (default_patt loc) in
-  let add_clause x acc = Ast.McOr (loc, mk_clause x, acc) in
-  let l = List.fold_right add_clause cl init in
-  Ast.ExFun (loc,l) (* correspond to <:expr< fun [ $l$ ] >> *)
-
-END
diff --git a/grammar/q_util.mli b/grammar/q_util.mli
index a5e36e47..323a1235 100644
--- a/grammar/q_util.mli
+++ b/grammar/q_util.mli
@@ -1,13 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open GramCompat (* necessary for camlp4 *)
-
 type argument_type =
 | ListArgType of argument_type
 | OptArgType of argument_type
@@ -25,7 +25,7 @@ type user_symbol =
 
 type extend_token =
 | ExtTerminal of string
-| ExtNonTerminal of user_symbol * string
+| ExtNonTerminal of user_symbol * string option
 
 val mlexpr_of_list :  ('a -> MLast.expr) -> 'a list -> MLast.expr
 
@@ -41,6 +41,8 @@ val mlexpr_of_string : string -> MLast.expr
 
 val mlexpr_of_option : ('a -> MLast.expr) -> 'a option -> MLast.expr
 
+val mlexpr_of_name : ('a -> MLast.expr) -> 'a option -> MLast.expr
+
 val mlexpr_of_prod_entry_key : (string -> MLast.expr) -> user_symbol -> MLast.expr
 
 val type_of_user_symbol : user_symbol -> argument_type
diff --git a/grammar/q_util.mlp b/grammar/q_util.mlp
index 2d5c4089..6cdd2ec1 100644
--- a/grammar/q_util.mlp
+++ b/grammar/q_util.mlp
@@ -1,15 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file defines standard combinators to build ml expressions *)
 
-open GramCompat
-
 type argument_type =
 | ListArgType of argument_type
 | OptArgType of argument_type
@@ -27,23 +27,23 @@ type user_symbol =
 
 type extend_token =
 | ExtTerminal of string
-| ExtNonTerminal of user_symbol * string
+| ExtNonTerminal of user_symbol * string option
 
 let mlexpr_of_list f l =
   List.fold_right
     (fun e1 e2 ->
       let e1 = f e1 in
-       let loc = CompatLoc.merge (MLast.loc_of_expr e1) (MLast.loc_of_expr e2) in
+       let loc = Ploc.encl (MLast.loc_of_expr e1) (MLast.loc_of_expr e2) in
        <:expr< [$e1$ :: $e2$] >>)
-    l (let loc = CompatLoc.ghost in <:expr< [] >>)
+    l (let loc = Ploc.dummy in <:expr< [] >>)
 
 let mlexpr_of_pair m1 m2 (a1,a2) =
   let e1 = m1 a1 and e2 = m2 a2 in
-  let loc = CompatLoc.merge (MLast.loc_of_expr e1) (MLast.loc_of_expr e2) in
+  let loc = Ploc.encl (MLast.loc_of_expr e1) (MLast.loc_of_expr e2) in
   <:expr< ($e1$, $e2$) >>
 
 (* We don't give location for tactic quotation! *)
-let loc = CompatLoc.ghost
+let loc = Ploc.dummy
 
 
 let mlexpr_of_bool = function
@@ -58,6 +58,10 @@ let mlexpr_of_option f = function
   | None -> <:expr< None >>
   | Some e -> <:expr< Some $f e$ >>
 
+let mlexpr_of_name f = function
+  | None -> <:expr< Names.Name.Anonymous >>
+  | Some e -> <:expr< Names.Name.Name $f e$ >>
+
 let symbol_of_string s = <:expr< Extend.Atoken (CLexer.terminal $str:s$) >>
 
 let rec mlexpr_of_prod_entry_key f = function
@@ -66,12 +70,12 @@ let rec mlexpr_of_prod_entry_key f = function
   | Ulist0 s -> <:expr< Extend.Alist0 $mlexpr_of_prod_entry_key f s$ >>
   | Ulist0sep (s,sep) -> <:expr< Extend.Alist0sep $mlexpr_of_prod_entry_key f s$ $symbol_of_string sep$ >>
   | Uopt s -> <:expr< Extend.Aopt $mlexpr_of_prod_entry_key f s$ >>
-  | Uentry e -> <:expr< Extend.Aentry $f e$ >>
+  | Uentry e -> <:expr< Extend.Aentry ($f e$) >>
   | Uentryl (e, l) ->
     (** Keep in sync with Pcoq! *)
     assert (e = "tactic");
-    if l = 5 then <:expr< Extend.Aentry (Pcoq.Tactic.binder_tactic) >>
-    else <:expr< Extend.Aentryl (Pcoq.Tactic.tactic_expr) $mlexpr_of_int l$ >>
+    if l = 5 then <:expr< Extend.Aentry Pltac.binder_tactic >>
+    else <:expr< Extend.Aentryl (Pltac.tactic_expr) $mlexpr_of_int l$ >>
 
 let rec type_of_user_symbol = function
 | Ulist1 s | Ulist1sep (s, _) | Ulist0 s | Ulist0sep (s, _) ->
@@ -92,10 +96,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
@@ -103,16 +111,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 683a7e2f..525be643 100644
--- a/grammar/tacextend.mlp
+++ b/grammar/tacextend.mlp
@@ -1,18 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Implementation of the TACTIC EXTEND macro. *)
 
 open Q_util
 open Argextend
-open GramCompat
-
-let dloc = <:expr< Loc.ghost >>
 
 let plugin_name = <:expr< __coq_plugin_name >>
 
@@ -21,142 +20,65 @@ let mlexpr_of_ident id =
   let id = "$" ^ id in
   <:expr< Names.Id.of_string_soft $str:id$ >>
 
-let rec make_patt = function
-  | [] -> <:patt< [] >>
-  | ExtNonTerminal (_, p) :: l ->
-      <:patt< [ $lid:p$ :: $make_patt l$ ] >>
-  | _::l -> make_patt l
-
-let rec make_let raw e = function
-  | [] -> <:expr< fun $lid:"ist"$ -> $e$ >>
-  | ExtNonTerminal (g, p) :: l ->
-      let t = type_of_user_symbol g in
-      let loc = MLast.loc_of_expr e in
-      let e = make_let raw e l in
-      let v =
-        if raw then <:expr< Genarg.out_gen $make_rawwit loc t$ $lid:p$ >>
-               else <:expr< Tacinterp.Value.cast $make_topwit    loc t$ $lid:p$ >> in
-      <:expr< let $lid:p$ = $v$ in $e$ >>
-  | _::l -> make_let raw e l
-
-let make_clause (pt,_,e) =
-  (make_patt pt,
-   vala None,
-   make_let false e pt)
-
-let make_fun_clauses loc s l =
-  let map c = GramCompat.make_fun loc [make_clause c] in
-  mlexpr_of_list map l
-
-let get_argt e = <:expr< (fun e -> match e with [ Genarg.ExtraArg tag -> tag | _ -> assert False ]) $e$ >>
-
 let rec mlexpr_of_symbol = function
-| Ulist1 s -> <:expr< Extend.Ulist1 $mlexpr_of_symbol s$ >>
-| Ulist1sep (s,sep) -> <:expr< Extend.Ulist1sep $mlexpr_of_symbol s$ $str:sep$ >>
-| Ulist0 s -> <:expr< Extend.Ulist0 $mlexpr_of_symbol s$ >>
-| Ulist0sep (s,sep) -> <:expr< Extend.Ulist0sep $mlexpr_of_symbol s$ $str:sep$ >>
-| Uopt s -> <:expr< Extend.Uopt $mlexpr_of_symbol s$ >>
+| Ulist1 s -> <:expr< Extend.TUlist1 $mlexpr_of_symbol s$ >>
+| Ulist1sep (s,sep) -> <:expr< Extend.TUlist1sep $mlexpr_of_symbol s$ $str:sep$ >>
+| Ulist0 s -> <:expr< Extend.TUlist0 $mlexpr_of_symbol s$ >>
+| Ulist0sep (s,sep) -> <:expr< Extend.TUlist0sep $mlexpr_of_symbol s$ $str:sep$ >>
+| Uopt s -> <:expr< Extend.TUopt $mlexpr_of_symbol s$ >>
 | Uentry e ->
-  let arg = get_argt <:expr< $lid:"wit_"^e$ >> in
-  <:expr< Extend.Uentry (Genarg.ArgT.Any $arg$) >>
+  let wit = <:expr< $lid:"wit_"^e$ >> in
+  <:expr< Extend.TUentry (Genarg.get_arg_tag $wit$) >>
 | Uentryl (e, l) ->
   assert (e = "tactic");
-  let arg = get_argt <:expr< Constrarg.wit_tactic >> in
-  <:expr< Extend.Uentryl (Genarg.ArgT.Any $arg$) $mlexpr_of_int l$>>
-
-let make_prod_item = function
-  | ExtTerminal s -> <:expr< Tacentries.TacTerm $str:s$ >>
-  | ExtNonTerminal (g, id) ->
-    <:expr< Tacentries.TacNonTerm $default_loc$ $mlexpr_of_symbol g$ $mlexpr_of_ident id$ >>
-
-let mlexpr_of_clause cl =
-  mlexpr_of_list (fun (a,_,_) -> mlexpr_of_list make_prod_item a) cl
-
-(** Special treatment of constr entries *)
-let is_constr_gram = function
-| ExtTerminal _ -> false
-| ExtNonTerminal (Uentry "constr", _) -> true
-| _ -> false
-
-let make_var = function
-  | ExtNonTerminal (_, p) -> Some p
-  | _ -> assert false
-
-let declare_tactic loc s c cl = match cl 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
-  let vars = List.map make_var rem in
-  let vars = mlexpr_of_list (mlexpr_of_option mlexpr_of_ident) vars in
-  let entry = mlexpr_of_string s in
-  let se = <:expr< { Tacexpr.mltac_tactic = $entry$; Tacexpr.mltac_plugin = $plugin_name$ } >> in
-  let ml = <:expr< { Tacexpr.mltac_name = $se$; Tacexpr.mltac_index = 0 } >> in
-  let name = mlexpr_of_string name in
-  let tac = match rem with
-  | [] ->
-    (** Special handling of tactics without arguments: such tactics do not do
-        a Proofview.Goal.nf_enter to compute their arguments. It matters for some
-        whole-prof tactics like [shelve_unifiable]. *)
-      <:expr< fun _ $lid:"ist"$ -> $tac$ >>
-  | _ ->
-      let f = GramCompat.make_fun loc [patt, vala None, <:expr< fun $lid:"ist"$ -> $tac$ >>] in
-      <:expr< Tacinterp.lift_constr_tac_to_ml_tac $vars$ $f$ >>
-  in
-  (** Arguments are not passed directly to the ML tactic in the TacML node,
-      the ML tactic retrieves its arguments in the [ist] environment instead.
-      This is the rôle of the [lift_constr_tac_to_ml_tac] function. *)
-  let body = <:expr< Tacexpr.TacFun ($vars$, Tacexpr.TacML ($dloc$, $ml$, [])) >> in
-  let name = <:expr< Names.Id.of_string $name$ >> in
-  declare_str_items loc
-    [ <:str_item< do {
-      let obj () = Tacenv.register_ltac True False $name$ $body$ in
-      let () = Tacenv.register_ml_tactic $se$ [|$tac$|] in
-      Mltop.declare_cache_obj obj $plugin_name$ } >>
-    ]
-| _ ->
-  (** Otherwise we add parsing and printing rules to generate a call to a
-      TacML tactic. *)
-  let entry = mlexpr_of_string s in
-  let se = <:expr< { Tacexpr.mltac_tactic = $entry$; Tacexpr.mltac_plugin = $plugin_name$ } >> in
-  let gl = mlexpr_of_clause cl in
-  let obj = <:expr< fun () -> Tacentries.add_ml_tactic_notation $se$ $gl$ >> in
-  declare_str_items loc
-    [ <:str_item< do {
-        Tacenv.register_ml_tactic $se$ (Array.of_list $make_fun_clauses loc s cl$);
-        Mltop.declare_cache_obj $obj$ $plugin_name$; } >>
-    ]
+  let wit = <:expr< $lid:"wit_"^e$ >> in
+  <:expr< Extend.TUentryl (Genarg.get_arg_tag $wit$) $mlexpr_of_int l$>>
+
+let rec mlexpr_of_clause = function
+| [] -> <:expr< TyNil >>
+| ExtTerminal s :: cl -> <:expr< TyIdent($str:s$, $mlexpr_of_clause cl$) >>
+| ExtNonTerminal(g,None) :: cl ->
+  <:expr< TyAnonArg(Loc.tag($mlexpr_of_symbol g$), $mlexpr_of_clause cl$) >>
+| ExtNonTerminal(g,Some id) :: cl ->
+  <:expr< TyArg(Loc.tag($mlexpr_of_symbol g$, $mlexpr_of_ident id$), $mlexpr_of_clause cl$) >>
+
+let rec binders_of_clause e = function
+| [] -> <:expr< fun ist -> $e$ >>
+| ExtNonTerminal(_,None) :: cl -> binders_of_clause e cl
+| ExtNonTerminal(_,Some id) :: cl -> <:expr< fun $lid:id$ -> $binders_of_clause e cl$ >>
+| _ :: cl -> binders_of_clause e cl
 
 open Pcaml
-open PcamlSig (* necessary for camlp4 *)
 
 EXTEND
   GLOBAL: str_item;
   str_item:
     [ [ "TACTIC"; "EXTEND"; s = tac_name;
-        c = OPT [ "CLASSIFIED"; "BY"; c = LIDENT -> <:expr< $lid:c$ >> ];
+        level = OPT [ "AT"; UIDENT "LEVEL"; level = INT -> level ];
         OPT "|"; l = LIST1 tacrule SEP "|";
         "END" ->
-         declare_tactic loc s c l ] ]
+        let level = match level with Some i -> int_of_string i | None -> 0 in
+        let level = mlexpr_of_int level in
+        let l = <:expr< Tacentries.($mlexpr_of_list (fun x -> x) l$) >> in
+        declare_str_items loc [ <:str_item< Tacentries.tactic_extend $plugin_name$ $str:s$ ~{ level = $level$ } $l$ >> ] ] ]
   ;
   tacrule:
     [ [ "["; l = LIST1 tacargs; "]";
-        c = OPT [ "=>"; "["; c = Pcaml.expr; "]" -> c ];
         "->"; "["; e = Pcaml.expr; "]" ->
-	(match l with
-	  | ExtNonTerminal _ :: _ ->
-	    (* En attendant la syntaxe de tacticielles *)
-	    failwith "Tactic syntax must start with an identifier"
-	  | _ -> (l,c,e))
+         <:expr< TyML($mlexpr_of_clause l$, $binders_of_clause e l$) >>
     ] ]
   ;
+
   tacargs:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
         let e = parse_user_entry e "" in
-        ExtNonTerminal (e, s)
+        ExtNonTerminal (e, Some s)
       | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
         let e = parse_user_entry e sep in
-        ExtNonTerminal (e, s)
+        ExtNonTerminal (e, Some s)
+      | e = LIDENT ->
+        let e = parse_user_entry e "" in
+        ExtNonTerminal (e, None)
       | s = STRING ->
 	let () = if s = "" then failwith "Empty terminal." in
         ExtTerminal s
diff --git a/grammar/vernacextend.mlp b/grammar/vernacextend.mlp
index 04b117fb..a2872d07 100644
--- a/grammar/vernacextend.mlp
+++ b/grammar/vernacextend.mlp
@@ -1,17 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Implementation of the VERNAC EXTEND macro. *)
 
 open Q_util
 open Argextend
-open Tacextend
-open GramCompat
 
 type rule = {
   r_head : string option;
@@ -26,9 +26,24 @@ type rule = {
   (** Whether this entry is deprecated *)
 }
 
+(** Quotation difference for match clauses *)
+
+let default_patt loc =
+  (<:patt< _ >>, ploc_vala None, <:expr< failwith "Extension: cannot occur" >>)
+
+let make_fun loc cl =
+  let l = cl @ [default_patt loc] in
+  MLast.ExFun (loc, ploc_vala l)  (* correspond to <:expr< fun [ $list:l$ ] >> *)
+
+let rec make_patt = function
+  | [] -> <:patt< [] >>
+  | ExtNonTerminal (_, Some p) :: l ->
+      <:patt< [ $lid:p$ :: $make_patt l$ ] >>
+  | _::l -> make_patt l
+
 let rec make_let e = function
   | [] -> e
-  | ExtNonTerminal (g, p) :: l ->
+  | ExtNonTerminal (g, Some p) :: l ->
       let t = type_of_user_symbol g in
       let loc = MLast.loc_of_expr e in
       let e = make_let e l in
@@ -37,13 +52,13 @@ let rec make_let e = function
 
 let make_clause { r_patt = pt; r_branch = e; } =
   (make_patt pt,
-   vala None,
+   ploc_vala None,
    make_let e pt)
 
 (* To avoid warnings *)
 let mk_ignore c pt =
   let fold accu = function
-  | ExtNonTerminal (_, p) -> p :: accu
+  | ExtNonTerminal (_, Some p) -> p :: accu
   | _ -> accu
   in
   let names = List.fold_left fold [] pt in
@@ -55,12 +70,12 @@ let make_clause_classifier cg s { r_patt = pt; r_class = c; } =
   match c ,cg with
   | Some c, _ ->
      (make_patt pt,
-      vala None,
+      ploc_vala None,
       make_let (mk_ignore c pt) pt)
   | None, Some cg ->
      (make_patt pt,
-      vala None,
-      <:expr< fun () -> $cg$ $str:s$ >>)
+      ploc_vala None,
+      <: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,8 +97,8 @@ let make_clause_classifier cg s { r_patt = pt; r_class = c; } =
        ("Specific classifiers have precedence over global "^
          "classifiers. Only one classifier is called.") ^ "\n");
     (make_patt pt,
-      vala None,
-      <:expr< fun () -> (Vernacexpr.VtUnknown, Vernacexpr.VtNow) >>)
+      ploc_vala None,
+      <:expr< fun () -> ( CErrors.anomaly (Pp.str "No classification given for command " ^ s ) ) >>)
 
 let make_fun_clauses loc s l =
   let map c =
@@ -91,22 +106,23 @@ let make_fun_clauses loc s l =
     | None -> false
     | Some () -> true
     in
-    let cl = GramCompat.make_fun loc [make_clause c] in
+    let cl = make_fun loc [make_clause c] in
     <:expr< ($mlexpr_of_bool depr$, $cl$)>>
   in
   mlexpr_of_list map l
 
 let make_fun_classifiers loc s c l =
-  let cl = List.map (fun x -> GramCompat.make_fun loc [make_clause_classifier c s x]) l in
+  let cl = List.map (fun x -> make_fun loc [make_clause_classifier c s x]) l in
   mlexpr_of_list (fun x -> x) cl
 
 let make_prod_item = function
   | ExtTerminal s -> <:expr< Egramml.GramTerminal $str:s$ >>
-  | ExtNonTerminal (g, id) ->
+  | ExtNonTerminal (g, ido) ->
     let nt = type_of_user_symbol g in
     let base s = <:expr< Pcoq.genarg_grammar ($mk_extraarg loc s$) >> in
-      <:expr< Egramml.GramNonTerminal $default_loc$ $make_rawwit loc nt$
-      $mlexpr_of_prod_entry_key base g$ >>
+    let typ = match ido with None -> None | Some _ -> Some nt in
+      <:expr< Egramml.GramNonTerminal ( Loc.tag ( $mlexpr_of_option (make_rawwit loc) typ$ ,
+      $mlexpr_of_prod_entry_key base g$ ) ) >>
 
 let mlexpr_of_clause cl =
   let mkexpr { r_head = a; r_patt = b; } = match a with
@@ -128,7 +144,6 @@ let declare_command loc s c nt cl =
       } >> ]
 
 open Pcaml
-open PcamlSig (* necessary for camlp4 *)
 
 EXTEND
   GLOBAL: str_item;
@@ -137,6 +152,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" ->
@@ -144,7 +163,7 @@ EXTEND
       | "DECLARE"; "PLUGIN"; name = STRING ->
         declare_str_items loc [
           <:str_item< value __coq_plugin_name = $str:name$ >>;
-          <:str_item< value _ = Mltop.add_known_module $str:name$ >>;
+          <:str_item< value _ = Mltop.add_known_module __coq_plugin_name >>;
         ]
       ] ]
   ;
@@ -159,31 +178,47 @@ 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; ")" ->
         let e = parse_user_entry e "" in
-        ExtNonTerminal (e, s)
+        ExtNonTerminal (e, Some s)
       | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
         let e = parse_user_entry e sep in
-        ExtNonTerminal (e, s)
+        ExtNonTerminal (e, Some s)
+      | e = LIDENT ->
+        let e = parse_user_entry e "" in
+        ExtNonTerminal (e, None)
       | s = STRING ->
         ExtTerminal s
     ] ]
diff --git a/ide/config_lexer.mli b/ide/config_lexer.mli
new file mode 100644
index 00000000..4719612c
--- /dev/null
+++ b/ide/config_lexer.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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/config_lexer.mll b/ide/config_lexer.mll
index ac9cc57b..55d8d969 100644
--- a/ide/config_lexer.mll
+++ b/ide/config_lexer.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/ide/coq-ssreflect.lang b/ide/coq-ssreflect.lang
index 7cfc1670..bd9cb4bf 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 484264ec..e9eab48d 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 6d44ca59..65456d68 100644
--- a/ide/coq.ml
+++ b/ide/coq.ml
@@ -1,14 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Ideutils
 open Preferences
 
+let ideslave_coqtop_flags = ref None
+
 (** * Version and date *)
 
 let get_version_date () =
@@ -205,7 +209,7 @@ type handle = {
   proc : CoqTop.process;
   xml_oc : Xml_printer.t;
   mutable alive : bool;
-  mutable waiting_for : (ccb * logger) option; (* last call + callback + log *)
+  mutable waiting_for : ccb option; (* last call + callback *)
 }
 
 (** Coqtop process status :
@@ -290,18 +294,6 @@ let rec check_errors = function
 | `NVAL :: _ -> raise (TubeError "NVAL")
 | `OUT :: _ -> raise (TubeError "OUT")
 
-let handle_intermediate_message handle level content =
-  let logger  = match handle.waiting_for with
-    | Some (_, l) -> l
-    | None -> function
-        | Feedback.Error   -> fun s -> Minilib.log ~level:`ERROR   (xml_to_string s)
-        | Feedback.Info    -> fun s -> Minilib.log ~level:`INFO    (xml_to_string s)
-        | Feedback.Notice  -> fun s -> Minilib.log ~level:`NOTICE  (xml_to_string s)
-        | Feedback.Warning -> fun s -> Minilib.log ~level:`WARNING (xml_to_string s)
-        | Feedback.Debug   -> fun s -> Minilib.log ~level:`DEBUG   (xml_to_string s)
-  in
-  logger level content
-
 let handle_feedback feedback_processor xml =
   let feedback = Xmlprotocol.to_feedback xml in
   feedback_processor feedback
@@ -310,7 +302,7 @@ let handle_final_answer handle xml =
   let () = Minilib.log "Handling coqtop answer" in
   let ccb = match handle.waiting_for with
     | None -> raise (AnswerWithoutRequest (Xml_printer.to_string_fmt xml))
-    | Some (c, _) -> c in
+    | Some c -> c in
   let () = handle.waiting_for <- None in
   with_ccb ccb { bind_ccb = fun (c, f) -> f (Xmlprotocol.to_answer c xml) }
 
@@ -332,18 +324,13 @@ let unsafe_handle_input handle feedback_processor state conds ~read_all =
     let l_end = Lexing.lexeme_end lex in
     state.fragment <- String.sub s l_end (String.length s - l_end);
     state.lexerror <- None;
-    match Xmlprotocol.is_message xml with
-    | Some (lvl, _loc, msg) ->
-      handle_intermediate_message handle lvl msg;
+    if Xmlprotocol.is_feedback xml then begin
+      handle_feedback feedback_processor xml;
       loop ()
-    | None ->
-      if Xmlprotocol.is_feedback xml then begin
-        handle_feedback feedback_processor xml;
-        loop ()
-      end else
-        begin
-          ignore (handle_final_answer handle xml)
-        end
+    end else
+      begin
+        ignore (handle_final_answer handle xml)
+      end
   in
   try loop ()
   with Xml_parser.Error _ as e ->
@@ -383,9 +370,16 @@ let bind_self_as f =
 (** This launches a fresh handle from its command line arguments. *)
 let spawn_handle args respawner feedback_processor =
   let prog = coqtop_path () in
-  let args = Array.of_list ("-async-proofs" :: "on" :: "-ideslave" :: args) in
+  let async_default =
+    (* disable async processing by default in Windows *)
+    if List.mem Sys.os_type ["Win32"; "Cygwin"] then
+      "off"
+    else
+      "on"
+  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
@@ -420,8 +414,19 @@ let clear_handle h =
 let mkready coqtop =
   fun () -> coqtop.status <- Ready; Void
 
+let save_all = ref (fun () -> assert false)
+
 let rec respawn_coqtop ?(why=Unexpected) coqtop =
-  if why = Unexpected then warning "Coqtop died badly. Resetting.";
+  let () = match why with
+  | Unexpected ->
+    let title = "Warning" in
+    let icon = (warn_image ())#coerce in
+    let buttons = ["Reset"; "Save all and quit"; "Quit without saving"] in
+    let ans = GToolbox.question_box ~title ~buttons ~icon "Coqtop died badly." in
+    if ans = 2 then (!save_all (); GtkMain.Main.quit ())
+    else if ans = 3 then GtkMain.Main.quit ()
+  | Planned -> ()
+  in
   clear_handle coqtop.handle;
   ignore_error (fun () ->
      coqtop.handle <-
@@ -493,20 +498,20 @@ let init_coqtop coqtop task =
 
 type 'a query = 'a Interface.value task
 
-let eval_call ?(logger=default_logger) call handle k =
+let eval_call call handle k =
   (** Send messages to coqtop and prepare the decoding of the answer *)
   Minilib.log ("Start eval_call " ^ Xmlprotocol.pr_call call);
   assert (handle.alive && handle.waiting_for = None);
-  handle.waiting_for <- Some (mk_ccb (call,k), logger);
+  handle.waiting_for <- Some (mk_ccb (call,k));
   Xml_printer.print handle.xml_oc (Xmlprotocol.of_call call);
   Minilib.log "End eval_call";
   Void
 
-let add ?(logger=default_logger) x = eval_call ~logger (Xmlprotocol.add x)
+let add x = eval_call (Xmlprotocol.add x)
 let edit_at i = eval_call (Xmlprotocol.edit_at i)
-let query ?(logger=default_logger) x = eval_call ~logger (Xmlprotocol.query x)
+let query x = eval_call (Xmlprotocol.query x)
 let mkcases s = eval_call (Xmlprotocol.mkcases s)
-let status ?logger force = eval_call ?logger (Xmlprotocol.status force)
+let status force = eval_call (Xmlprotocol.status force)
 let hints x = eval_call (Xmlprotocol.hints x)
 let search flags = eval_call (Xmlprotocol.search flags)
 let init x = eval_call (Xmlprotocol.init x)
@@ -536,6 +541,7 @@ struct
   let all_basic = ["Printing"; "All"]
   let existential = ["Printing"; "Existential"; "Instances"]
   let universes = ["Printing"; "Universes"]
+  let unfocused = ["Printing"; "Unfocused"]
 
   type bool_descr = { opts : t list; init : bool; label : string }
 
@@ -551,7 +557,8 @@ struct
       label = "Display _existential variable instances" };
     { opts = [universes]; init = false; label = "Display _universe levels" };
     { opts = [all_basic;existential;universes]; init = false;
-      label = "Display all _low-level contents" }
+      label = "Display all _low-level contents" };
+    { opts = [unfocused]; init = false; label = "Display _unfocused goals" }
   ]
 
   (** The current status of the boolean options *)
@@ -566,18 +573,13 @@ struct
 
   let _ = reset ()
 
-  (** Integer option *)
-
-  let width = ["Printing"; "Width"]
-  let width_state = ref None
-  let set_printing_width w = width_state := Some w
+  let printing_unfocused () = Hashtbl.find current_state unfocused
 
   (** Transmitting options to coqtop *)
 
   let enforce h k =
     let mkopt o v acc = (o, Interface.BoolValue v) :: acc in
     let opts = Hashtbl.fold mkopt current_state [] in
-    let opts = (width, Interface.IntValue !width_state) :: opts in
     eval_call (Xmlprotocol.set_options opts) h
       (function
 	| Interface.Good () -> k ()
@@ -585,8 +587,8 @@ struct
 
 end
 
-let goals ?logger x h k =
-  PrintOpt.enforce h (fun () -> eval_call ?logger (Xmlprotocol.goals x) h k)
+let goals x h k =
+  PrintOpt.enforce h (fun () -> eval_call (Xmlprotocol.goals x) h k)
 
 let evars x h k =
   PrintOpt.enforce h (fun () -> eval_call (Xmlprotocol.evars x) h k)
diff --git a/ide/coq.mli b/ide/coq.mli
index 8a1fa3ed..40a6dea8 100644
--- a/ide/coq.mli
+++ b/ide/coq.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Coq : Interaction with the Coq toplevel *)
@@ -115,15 +117,11 @@ val try_grab : coqtop -> unit task -> (unit -> unit) -> unit
 type 'a query = 'a Interface.value task
 (** A type abbreviation for coqtop specific answers *)
 
-val add        : ?logger:Ideutils.logger ->
-                 Interface.add_sty        -> Interface.add_rty query
+val add        : Interface.add_sty        -> Interface.add_rty query
 val edit_at    : Interface.edit_at_sty    -> Interface.edit_at_rty query
-val query      : ?logger:Ideutils.logger ->
-                 Interface.query_sty      -> Interface.query_rty query
-val status     : ?logger:Ideutils.logger ->
-                 Interface.status_sty     -> Interface.status_rty query
-val goals      : ?logger:Ideutils.logger ->
-                 Interface.goals_sty      -> Interface.goals_rty query
+val query      : Interface.query_sty      -> Interface.query_rty query
+val status     : Interface.status_sty     -> Interface.status_rty query
+val goals      : Interface.goals_sty      -> Interface.goals_rty query
 val evars      : Interface.evars_sty      -> Interface.evars_rty query
 val hints      : Interface.hints_sty      -> Interface.hints_rty query
 val mkcases    : Interface.mkcases_sty    -> Interface.mkcases_rty query
@@ -143,7 +141,8 @@ sig
   val bool_items : bool_descr list
 
   val set : t -> bool -> unit
-  val set_printing_width : int -> unit
+
+  val printing_unfocused: unit -> bool
 
   (** [enforce] transmits to coq the current option values.
       It is also called by [goals] and [evars] above. *)
@@ -173,3 +172,7 @@ val check_connection : string list -> unit
     may terminate coqide in case of trouble *)
 
 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 1563c7ff..6c3438a4 100644
--- a/ide/coqOps.ml
+++ b/ide/coqOps.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -14,7 +16,7 @@ open Feedback
 
 let b2c = byte_offset_to_char_offset
 
-type flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR of Loc.t * string | `WARNING of Loc.t * string ]
+type flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR of string Loc.located | `WARNING of string Loc.located ]
 type mem_flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR | `WARNING ]
 let mem_flag_of_flag : flag -> mem_flag = function
   | `ERROR _ -> `ERROR
@@ -58,7 +60,7 @@ module SentenceId : sig
   val connect : sentence -> signals
 
   val dbg_to_string :
-    GText.buffer -> bool -> Stateid.t option -> sentence -> Pp.std_ppcmds
+    GText.buffer -> bool -> Stateid.t option -> sentence -> Pp.t
 
 end = struct
 
@@ -117,7 +119,7 @@ end = struct
       (b#get_iter_at_mark s.start)#offset
       (b#get_iter_at_mark s.stop)#offset
       (ellipsize
-        ((b#get_iter_at_mark s.start)#get_slice (b#get_iter_at_mark s.stop)))
+        ((b#get_iter_at_mark s.start)#get_slice ~stop:(b#get_iter_at_mark s.stop)))
       (String.concat "," (List.map str_of_flag s.flags))
       (ellipsize
         (String.concat ","
@@ -139,7 +141,8 @@ object
   method process_next_phrase : unit task
   method process_until_end_or_error : unit task
   method handle_reset_initial : unit task
-  method raw_coq_query : string -> unit task
+  method raw_coq_query :
+    route_id:int -> next:(query_rty value -> unit task) -> string -> unit task
   method show_goals : unit task
   method backtrack_last_phrase : unit task
   method initialize : unit task
@@ -162,14 +165,6 @@ let flags_to_color f =
   else if List.mem `INCOMPLETE f then `NAME "gray"
   else `NAME Preferences.processed_color#get
 
-let validate s =
-  let open Xml_datatype in
-  let rec validate = function
-  | PCData s -> Glib.Utf8.validate s
-  | Element (_, _, children) -> List.for_all validate children
-  in
-  validate (Richpp.repr s)
-
 module Doc = Document
 
 let segment_model (doc : sentence Doc.document) : Wg_Segment.model =
@@ -201,7 +196,7 @@ object (self)
     in
     List.iter (fun s -> set_index s (s.index + 1)) after;
     set_index s (document_length - List.length after);
-    ignore ((SentenceId.connect s)#changed self#on_changed);
+    ignore ((SentenceId.connect s)#changed ~callback:self#on_changed);
     document_length <- document_length + 1;
     List.iter (fun f -> f `INSERT) cbs
 
@@ -215,8 +210,8 @@ object (self)
     List.iter (fun f -> f `REMOVE) cbs
 
   initializer
-    let _ = (Doc.connect doc)#pushed self#on_push in
-    let _ = (Doc.connect doc)#popped self#on_pop in
+    let _ = (Doc.connect doc)#pushed ~callback:self#on_push in
+    let _ = (Doc.connect doc)#popped ~callback:self#on_pop in
     ()
 
 end
@@ -224,7 +219,7 @@ end
 class coqops
   (_script:Wg_ScriptView.script_view)
   (_pv:Wg_ProofView.proof_view)
-  (_mv:Wg_MessageView.message_view)
+  (_mv:Wg_RoutedMessageViews.message_views_router)
   (_sg:Wg_Segment.segment)
   (_ct:Coq.coqtop)
   get_filename =
@@ -267,15 +262,15 @@ object(self)
         else iter
       in
       let iter = sentence_start iter in
-      script#buffer#place_cursor iter;
+      script#buffer#place_cursor ~where:iter;
       ignore (script#scroll_to_iter ~use_align:true ~yalign:0. iter)
     in
-    let _ = segment#connect#clicked on_click in
+    let _ = segment#connect#clicked ~callback:on_click in
     ()
 
   method private tooltip_callback ~x ~y ~kbd tooltip =
-    let x, y = script#window_to_buffer_coords `WIDGET x y in
-    let iter = script#get_iter_at_location x y in
+    let x, y = script#window_to_buffer_coords ~tag:`WIDGET ~x ~y in
+    let iter = script#get_iter_at_location ~x ~y in
     if iter#has_tag Tags.Script.tooltip then begin
       let s =
         let rec aux iter =
@@ -305,7 +300,7 @@ object(self)
 
   method private print_stack =
     Minilib.log "document:";
-    Minilib.log (Pp.string_of_ppcmds (Doc.print document (dbg_to_string buffer)))
+    Minilib.log_pp (Doc.print document (dbg_to_string buffer))
 
   method private enter_focus start stop =
     let at id id' _ = Stateid.equal id' id in
@@ -337,7 +332,6 @@ object(self)
     buffer#get_iter_at_mark `INSERT
 
   method private show_goals_aux ?(move_insert=false) () =
-    Coq.PrintOpt.set_printing_width proof#width;
     if move_insert then begin
       let dest = self#get_start_of_input in
       if (buffer#get_iter_at_mark `INSERT)#compare dest <= 0 then begin
@@ -345,7 +339,7 @@ object(self)
         script#recenter_insert
       end
     end;
-    Coq.bind (Coq.goals ~logger:messages#push ()) (function
+    Coq.bind (Coq.goals ()) (function
     | Fail x -> self#handle_failure_aux ~move_insert x
     | Good goals ->
       Coq.bind (Coq.evars ()) (function
@@ -353,32 +347,28 @@ object(self)
         | Good evs ->
           proof#set_goals goals;
           proof#set_evars evs;
-          proof#refresh ();
+          proof#refresh ~force:true;
           Coq.return ()
         )
       )
   method show_goals = self#show_goals_aux ()
 
   (* This method is intended to perform stateless commands *)
-  method raw_coq_query phrase =
-    let action = log "raw_coq_query starting now" in
-    let display_error s =
-      if not (validate s) then
-        flash_info "This error is so nasty that I can't even display it."
-      else messages#add s;
-    in
-    let query =
-      Coq.query ~logger:messages#push (phrase,Stateid.dummy) in
-    let next = function
-    | Fail (_, _, err) -> display_error err; Coq.return ()
-    | Good msg ->
-      messages#add_string msg; Coq.return ()
+  method raw_coq_query ~route_id ~next phrase : unit Coq.task =
+    let sid = try Document.tip document
+              with Document.Empty -> Stateid.initial
     in
+    let action = log "raw_coq_query starting now" in
+    let query = Coq.query (route_id,(phrase,sid)) in
     Coq.bind (Coq.seq action query) next
 
+  method private still_valid { edit_id = id } =
+    try ignore(Doc.find_id document (fun _ { edit_id = id1 } -> id = id1)); true
+    with Not_found -> false
+
   method private mark_as_needed sentence =
-    Minilib.log("Marking " ^
-      Pp.string_of_ppcmds (dbg_to_string buffer false None sentence));
+   if self#still_valid sentence then begin
+    Minilib.log_pp Pp.(str "Marking " ++ dbg_to_string buffer false None sentence);
     let start = buffer#get_iter_at_mark sentence.start in
     let stop = buffer#get_iter_at_mark sentence.stop in
     let to_process = Tags.Script.to_process in
@@ -398,11 +388,11 @@ object(self)
     in
     List.iter (fun t -> buffer#remove_tag t ~start ~stop) all_tags;
     List.iter (fun t -> buffer#apply_tag t ~start ~stop) tags
+   end
 
-  method private attach_tooltip sentence loc text =
+  method private attach_tooltip ?loc sentence text =
     let start_sentence, stop_sentence, phrase = self#get_sentence sentence in
-    let pre_chars, post_chars =
-      if Loc.is_ghost loc then 0, String.length phrase else Loc.unloc loc in
+    let pre_chars, post_chars = Option.cata Loc.unloc (0, String.length phrase) loc in
     let pre = b2c phrase pre_chars in
     let post = b2c phrase post_chars in
     let start = start_sentence#forward_chars pre in
@@ -411,95 +401,93 @@ object(self)
     buffer#apply_tag Tags.Script.tooltip ~start ~stop;
     add_tooltip sentence pre post markup
 
-  method private is_dummy_id id =
-    match id with
-    | Edit 0 -> true
-    | State id when Stateid.equal id Stateid.dummy -> true
-    | _ -> false
-
   method private enqueue_feedback msg =
-    let id = msg.id in
-    if self#is_dummy_id id then () else Queue.add msg feedbacks
-    
+    (* Minilib.log ("Feedback received: " ^ Xml_printer.to_string_fmt Xmlprotocol.(of_feedback Ppcmds msg)); *)
+    Queue.add msg feedbacks
+
   method private process_feedback () =
     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
-          | Some id', State id when Stateid.equal id id' -> Some (state_id, s)
-          | _, Edit id when id = s.edit_id -> Some (state_id, s)
+          | Some id', id when Stateid.equal id id' -> Some (state_id, s)
           | _ -> None in
         try Some (Doc.find_map document finder)
         with Not_found -> None in
-      let log s state_id =
-        Minilib.log ("Feedback " ^ s ^ " on " ^ Stateid.to_string
-          (Option.default Stateid.dummy state_id)) in
+      let log_pp ?id s=
+        Minilib.log_pp Pp.(seq
+                [str "Feedback "; s; pr_opt (fun id -> str " on " ++ str (Stateid.to_string id)) id])
+      in
+      let log ?id s = log_pp ?id (Pp.str s) in
       begin match msg.contents, sentence with
       | AddedAxiom, Some (id,sentence) ->
-          log "AddedAxiom" id;
+          log ?id "AddedAxiom";
           remove_flag sentence `PROCESSING;
           remove_flag sentence `ERROR;
           add_flag sentence `UNSAFE;
           self#mark_as_needed sentence
       | Processed, Some (id,sentence) ->
-          log "Processed" id;
+          log ?id "Processed" ;
           remove_flag sentence `PROCESSING;
           self#mark_as_needed sentence
       | ProcessingIn _,  Some (id,sentence) ->
-          log "ProcessingIn" id;
+          log ?id "ProcessingIn";
           add_flag sentence `PROCESSING;
           self#mark_as_needed sentence
       | Incomplete, Some (id, sentence) ->
-          log "Incomplete" id;
+          log ?id "Incomplete";
           add_flag sentence `INCOMPLETE;
           self#mark_as_needed sentence
       | Complete, Some (id, sentence) ->
-          log "Complete" id;
+          log ?id "Complete";
           remove_flag sentence `INCOMPLETE;
           self#mark_as_needed sentence
       | GlobRef(loc, filepath, modpath, ident, ty), Some (id,sentence) ->
-          log "GlobRef" id;
-          self#attach_tooltip sentence loc
+          log ?id "GlobRef";
+          self#attach_tooltip ~loc sentence
             (Printf.sprintf "%s %s %s" filepath ident ty)
       | Message(Error, loc, msg), Some (id,sentence) ->
-          let loc = Option.default Loc.ghost loc in
-          let msg = Richpp.raw_print msg         in
-          log "ErrorMsg" id;
+          log_pp ?id Pp.(str "ErrorMsg " ++ msg);
           remove_flag sentence `PROCESSING;
-          add_flag sentence (`ERROR (loc, msg));
+          let rmsg = Pp.string_of_ppcmds msg in
+          add_flag sentence (`ERROR (loc, rmsg));
           self#mark_as_needed sentence;
-          self#attach_tooltip sentence loc msg;
-          if not (Loc.is_ghost loc) then
-            self#position_error_tag_at_sentence sentence (Some (Loc.unloc loc))
-      | Message(Warning, loc, msg), Some (id,sentence) ->
-          let loc = Option.default Loc.ghost loc in
-          let msg = Richpp.raw_print msg         in
-          log "WarningMsg" id;
-          add_flag sentence (`WARNING (loc, msg));
-          self#attach_tooltip sentence loc msg;
-          self#position_warning_tag_at_sentence sentence loc
-      | Message((Info|Notice|Debug as lvl), _, msg), _ ->
-          messages#push lvl msg
+          self#attach_tooltip ?loc sentence rmsg;
+          self#position_tag_at_sentence ?loc Tags.Script.error sentence
+      | Message(Warning, loc, message), Some (id,sentence) ->
+          log_pp ?id Pp.(str "WarningMsg " ++ message);
+          let rmsg = Pp.string_of_ppcmds message in
+          add_flag sentence (`WARNING (loc, rmsg));
+          self#attach_tooltip ?loc sentence rmsg;
+          self#position_tag_at_sentence ?loc Tags.Script.warning sentence;
+          (messages#route msg.route)#push Warning message
+      | Message(lvl, loc, message), Some (id,sentence) ->
+          log_pp ?id Pp.(str "Msg " ++ message);
+          (messages#route msg.route)#push lvl message
+      (* 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, message), None ->
+          log_pp Pp.(str "Msg without a sentence " ++ message);
+          (messages#route msg.route)#push lvl message
       | InProgress n, _ ->
           if n < 0 then processed <- processed + abs n
           else to_process <- to_process + n
       | WorkerStatus(id,status), _ ->
-          log "WorkerStatus" None;
+          log "WorkerStatus";
           slaves_status <- CString.Map.add id status slaves_status
-
       | _ ->
           if sentence <> None then Minilib.log "Unsupported feedback message"
           else if Doc.is_empty document then ()
           else
             try
               match id, Doc.tip document with
-              | Edit _, _ -> ()
-              | State id1, id2 when Stateid.newer_than id2 id1 -> ()
+              | id1, id2 when Stateid.newer_than id2 id1 -> ()
               | _ -> Queue.add msg feedbacks
-            with Doc.Empty | Invalid_argument _ -> Queue.add msg feedbacks 
+            with Doc.Empty | Invalid_argument _ -> Queue.add msg feedbacks
       end;
         eat_feedback (n-1)
     in
@@ -513,40 +501,30 @@ object(self)
     let stop = buffer#get_iter_at_mark sentence.stop in
     buffer#move_mark ~where:stop (`NAME "start_of_input");
 
-  method private position_error_tag_at_iter iter phrase = function
-    | None -> ()
-    | Some (start, stop) ->
-        buffer#apply_tag Tags.Script.error
-          ~start:(iter#forward_chars (b2c phrase start))
-          ~stop:(iter#forward_chars (b2c phrase stop))
-
-  method private position_error_tag_at_sentence sentence loc =
-    let start, _, phrase = self#get_sentence sentence in
-    self#position_error_tag_at_iter start phrase loc
-
-  method private position_warning_tag_at_iter iter_start iter_stop phrase loc =
-    if Loc.is_ghost loc then
-        buffer#apply_tag Tags.Script.warning ~start:iter_start ~stop:iter_stop
-    else
-      buffer#apply_tag Tags.Script.warning
-	  ~start:(iter_start#forward_chars (b2c phrase loc.Loc.bp))
-          ~stop:(iter_stop#forward_chars (b2c phrase loc.Loc.ep))
+  method private position_tag_at_iter ?loc iter_start iter_stop tag phrase = match loc with
+    | None ->
+      buffer#apply_tag tag ~start:iter_start ~stop:iter_stop
+    | Some loc ->
+      let start, stop = Loc.unloc loc in
+      buffer#apply_tag tag
+        ~start:(iter_start#forward_chars (b2c phrase start))
+        ~stop:(iter_start#forward_chars (b2c phrase stop))
 
-  method private position_warning_tag_at_sentence sentence loc =
+  method private position_tag_at_sentence ?loc tag sentence =
     let start, stop, phrase = self#get_sentence sentence in
-    self#position_warning_tag_at_iter start stop phrase loc
+    self#position_tag_at_iter ?loc start stop tag phrase
 
-  method private process_interp_error queue sentence loc msg tip id =
+  method private process_interp_error ?loc queue sentence msg tip id =
     Coq.bind (Coq.return ()) (function () ->
     let start, stop, phrase = self#get_sentence sentence in
     buffer#remove_tag Tags.Script.to_process ~start ~stop;
     self#discard_command_queue queue;
     pop_info ();
     if Stateid.equal id tip || Stateid.equal id Stateid.dummy then begin
-      self#position_error_tag_at_iter start phrase loc;
+      self#position_tag_at_iter ?loc start stop Tags.Script.error phrase;
       buffer#place_cursor ~where:stop;
-      messages#clear;
-      messages#push Feedback.Error msg;
+      messages#default_route#clear;
+      messages#default_route#push Feedback.Error msg;
       self#show_goals
     end else
       self#show_goals_aux ~move_insert:true ()
@@ -604,12 +582,12 @@ object(self)
 
   (** Compute the phrases until [until] returns [true]. *)
   method private process_until ?move_insert until verbose =
-    let logger lvl msg = if verbose then messages#push lvl msg in
+    let logger lvl msg = if verbose then messages#default_route#push lvl msg in
     let fill_queue = Coq.lift (fun () ->
       let queue = Queue.create () in
       (* Lock everything and fill the waiting queue *)
       push_info "Coq is computing";
-      messages#clear;
+      messages#default_route#clear;
       script#set_editable false;
       self#fill_command_queue until queue;
       (* Now unlock and process asynchronously. Since [until]
@@ -628,10 +606,9 @@ object(self)
         if Queue.is_empty queue then conclude topstack else
         match Queue.pop queue, topstack with
         | `Skip(start,stop), [] ->
-
-            logger Feedback.Error (Richpp.richpp_of_string "You must close the proof with Qed or Admitted");
+            logger Feedback.Error (Pp.str "You must close the proof with Qed or Admitted");
             self#discard_command_queue queue;
-            conclude [] 
+            conclude []
         | `Skip(start,stop), (_,s) :: topstack ->
             assert(start#equal (buffer#get_iter_at_mark s.start));
             assert(stop#equal (buffer#get_iter_at_mark s.stop));
@@ -641,11 +618,11 @@ object(self)
             add_flag sentence `PROCESSING;
             Doc.push document sentence;
             let _, _, phrase = self#get_sentence sentence in
-            let coq_query = Coq.add ~logger ((phrase,edit_id),(tip,verbose)) in
+            let coq_query = Coq.add ((phrase,edit_id),(tip,verbose)) in
             let handle_answer = function
               | Good (id, (Util.Inl (* NewTip *) (), msg)) ->
                   Doc.assign_tip_id document id;
-                  logger Feedback.Notice (Richpp.richpp_of_string msg);
+                  logger Feedback.Notice (Pp.str msg);
                   self#commit_queue_transaction sentence;
                   loop id []
               | Good (id, (Util.Inr (* Unfocus *) tip, msg)) ->
@@ -653,13 +630,14 @@ object(self)
                   let topstack, _ = Doc.context document in
                   self#exit_focus;
                   self#cleanup (Doc.cut_at document tip);
-                  logger Feedback.Notice (Richpp.richpp_of_string msg);
+                  logger Feedback.Notice (Pp.str msg);
                   self#mark_as_needed sentence;
                   if Queue.is_empty queue then loop tip []
                   else loop tip (List.rev topstack)
               | Fail (id, loc, msg) ->
+                  let loc = Option.map Loc.make_loc loc in
                   let sentence = Doc.pop document in
-                  self#process_interp_error queue sentence loc msg tip id in
+                  self#process_interp_error ?loc queue sentence msg tip id in
             Coq.bind coq_query handle_answer
       in
       let tip =
@@ -667,15 +645,16 @@ 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 _ ->
-         messages#clear;
-         messages#push Feedback.Info (Richpp.richpp_of_string "All proof terms checked by the kernel");
+         messages#default_route#clear;
+         messages#default_route#push
+           Feedback.Info (Pp.str "All proof terms checked by the kernel");
          Coq.return ()
      | Fail x -> self#handle_failure x in
-   Coq.bind (Coq.status ~logger:messages#push true) next
+   Coq.bind (Coq.status true) next
 
   method stop_worker n =
     Coq.bind (Coq.stop_worker n) (fun _ -> Coq.return ())
@@ -689,14 +668,13 @@ object(self)
     let extract_error s =
       match List.find (function `ERROR _ -> true | _ -> false) s.flags with
       | `ERROR (loc, msg) ->
-         let iter =
-           if Loc.is_ghost loc then
-             buffer#get_iter_at_mark s.start
-           else
+         let iter = begin match loc with
+           | None      -> buffer#get_iter_at_mark s.start
+           | Some loc ->
              let (iter, _, phrase) = self#get_sentence s in
              let (start, _) = Loc.unloc loc in
-             iter#forward_chars (b2c phrase start) in
-         iter#line + 1, msg
+             iter#forward_chars (b2c phrase start)
+         end in iter#line + 1, msg
       | _ -> assert false in
     List.rev
       (Doc.fold_all document [] (fun acc _ _ s ->
@@ -775,7 +753,7 @@ object(self)
           conclusion ()
       | Fail (safe_id, loc, msg) ->
 (*           if loc <> None then messages#push Feedback.Error (Richpp.richpp_of_string "Fixme LOC"); *)
-          messages#push Feedback.Error msg;
+          messages#default_route#push Feedback.Error msg;
           if Stateid.equal safe_id Stateid.dummy then self#show_goals
           else undo safe_id
                  (Doc.focused document && Doc.is_in_focus document safe_id))
@@ -792,7 +770,7 @@ object(self)
   method private handle_failure_aux
     ?(move_insert=false) (safe_id, (loc : (int * int) option), msg)
   =
-    messages#push Feedback.Error msg;
+    messages#default_route#push Feedback.Error msg;
     ignore(self#process_feedback ());
     if Stateid.equal safe_id Stateid.dummy then Coq.lift (fun () -> ())
     else
@@ -804,7 +782,7 @@ object(self)
   method handle_failure f = self#handle_failure_aux f
 
   method backtrack_last_phrase =
-    messages#clear;
+    messages#default_route#clear;
     try 
       let tgt = Doc.before_tip document in
       self#backtrack_to_id tgt
@@ -812,7 +790,7 @@ object(self)
 
   method go_to_insert =
     Coq.bind (Coq.return ()) (fun () ->
-    messages#clear;
+    messages#default_route#clear;
     let point = self#get_insert in
     if point#compare self#get_start_of_input >= 0
     then self#process_until_iter point
@@ -820,7 +798,7 @@ object(self)
 
   method go_to_mark m =
     Coq.bind (Coq.return ()) (fun () ->
-    messages#clear;
+    messages#default_route#clear;
     let point = buffer#get_iter_at_mark m in
     if point#compare self#get_start_of_input >= 0
     then Coq.seq (self#process_until_iter point)
@@ -845,25 +823,21 @@ object(self)
           ~stop:(`MARK (buffer#create_mark stop))
           [] in
       Doc.push document sentence;
-      messages#clear;
+      messages#default_route#clear;
       self#show_goals
     in
     let display_error (loc, s) =
-      if not (validate s) then
-        flash_info "This error is so nasty that I can't even display it."
-      else messages#add s
-    in
+      messages#default_route#add (Ideutils.validate s) in
     let try_phrase phrase stop more =
       let action = log "Sending to coq now" in
-      let query = Coq.query (phrase,Stateid.dummy) in
+      let route_id = 0 in
+      let query = Coq.query (route_id,(phrase,Stateid.dummy)) in
       let next = function
       | Fail (_, l, str) -> (* FIXME: check *)
         display_error (l, str);
-        messages#add (Richpp.richpp_of_string ("Unsuccessfully tried: "^phrase));
+        messages#default_route#add (Pp.str ("Unsuccessfully tried: "^phrase));
         more
-      | Good msg ->
-        messages#add_string msg;
-        stop Tags.Script.processed
+      | Good () -> stop Tags.Script.processed
       in
       Coq.bind (Coq.seq action query) next
     in
@@ -891,7 +865,7 @@ object(self)
       buffer#move_mark ~where:buffer#end_iter (`NAME "stop_of_input");
       Sentence.tag_all buffer;
       (* clear the views *)
-      messages#clear;
+      messages#default_route#clear;
       proof#clear ();
       clear_info ();
       processed <- 0;
@@ -905,7 +879,7 @@ object(self)
     let get_initial_state =
       let next = function
       | Fail (_, _, message) ->
-        let message = "Couldn't initialize coqtop\n\n" ^ (Richpp.raw_print message) in
+        let message = "Couldn't initialize coqtop\n\n" ^ (Pp.string_of_ppcmds message) in
         let popup = GWindow.message_dialog ~buttons:GWindow.Buttons.ok ~message_type:`ERROR ~message () in
         ignore (popup#run ()); exit 1
       | Good id -> initial_state <- id; Coq.return () in
diff --git a/ide/coqOps.mli b/ide/coqOps.mli
index 332c18f2..3685fea9 100644
--- a/ide/coqOps.mli
+++ b/ide/coqOps.mli
@@ -1,12 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Coq
+open Interface
 
 class type ops =
 object
@@ -16,7 +19,8 @@ object
   method process_next_phrase : unit task
   method process_until_end_or_error : unit task
   method handle_reset_initial : unit task
-  method raw_coq_query : string -> unit task
+  method raw_coq_query :
+    route_id:int -> next:(query_rty value -> unit task) -> string -> unit task
   method show_goals : unit task
   method backtrack_last_phrase : unit task
   method initialize : unit task
@@ -28,7 +32,7 @@ object
   method get_slaves_status : int * int * string CString.Map.t
 
 
-  method handle_failure : Interface.handle_exn_rty -> unit task
+  method handle_failure : handle_exn_rty -> unit task
   
   method destroy : unit -> unit
 end
@@ -36,7 +40,7 @@ end
 class coqops :
   Wg_ScriptView.script_view ->
   Wg_ProofView.proof_view ->
-  Wg_MessageView.message_view ->
+  Wg_RoutedMessageViews.message_views_router ->
   Wg_Segment.segment ->
   coqtop ->
   (unit -> string option) ->
diff --git a/ide/coq_commands.ml b/ide/coq_commands.ml
index d55e7f9d..f5dba208 100644
--- a/ide/coq_commands.ml
+++ b/ide/coq_commands.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 let commands = [
@@ -105,8 +107,7 @@ let commands = [
    "Reset Extraction Inline";
    "Restore State";
    ];
-  [  "Save.";
-     "Scheme";
+  [  "Scheme";
      "Section";
      "Set Extraction AutoInline";
      "Set Extraction Optimize";
diff --git a/ide/coq_commands.mli b/ide/coq_commands.mli
new file mode 100644
index 00000000..259d790e
--- /dev/null
+++ b/ide/coq_commands.mli
@@ -0,0 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 00000000..10041193
--- /dev/null
+++ b/ide/coq_lex.mli
@@ -0,0 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val delimit_sentences : (int -> GText.tag -> unit) -> string -> unit
+
+exception Unterminated
diff --git a/ide/coq_lex.mll b/ide/coq_lex.mll
index b6286c49..1fdd7317 100644
--- a/ide/coq_lex.mll
+++ b/ide/coq_lex.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 {
@@ -17,7 +19,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 +73,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 450bfcdf..f5ff0899 100644
--- a/ide/coqide.ml
+++ b/ide/coqide.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Preferences
@@ -46,7 +48,7 @@ open Session
 
 (** The arguments that will be passed to coqtop. No quoting here, since
     no /bin/sh when using create_process instead of open_process. *)
-let custom_project_files = ref []
+let custom_project_file = ref None
 let sup_args = ref []
 
 let logfile = ref None
@@ -81,17 +83,27 @@ let pr_exit_status = function
   | Unix.WEXITED 0 -> " succeeded"
   | _ -> " failed"
 
-let make_coqtop_args = function
-  |None -> "", !sup_args
-  |Some the_file ->
-    let get_args f = Project_file.args_from_project f
-      !custom_project_files project_file_name#get
-    in
-    match read_project#get with
-      |Ignore_args -> "", !sup_args
-      |Append_args ->
-         let fname, args = get_args the_file in fname, args @ !sup_args
-      |Subst_args -> get_args the_file
+let make_coqtop_args fname =
+  let open CoqProject_file in
+  let base_args = match read_project#get with
+    | Ignore_args -> !sup_args
+    | Append_args -> !sup_args
+    | Subst_args -> [] in
+  if read_project#get = Ignore_args then "", base_args
+  else
+    match !custom_project_file, fname with
+    | Some (d,proj), _ -> d, coqtop_args_from_project proj @ base_args
+    | None, None -> "", base_args
+    | None, Some the_file ->
+       match
+         CoqProject_file.find_project_file
+           ~from:(Filename.dirname the_file)
+           ~projfile_name:project_file_name#get
+       with
+       | None -> "", base_args
+       | Some proj -> 
+           proj, coqtop_args_from_project (read_project_file proj) @ base_args
+;;
 
 (** Setting drag & drop on widgets *)
 
@@ -274,6 +286,8 @@ let saveall _ =
       | Some f -> ignore (sn.fileops#save f))
     notebook#pages
 
+let () = Coq.save_all := saveall
+
 let revert_all _ =
   List.iter
     (fun sn -> if sn.fileops#changed_on_disk then sn.fileops#revert)
@@ -318,10 +332,10 @@ let export kind sn =
         local_cd f ^ cmd_coqdoc#get ^ " --" ^ kind ^ " -o " ^
         (Filename.quote output) ^ " " ^ (Filename.quote basef) ^ " 2>&1"
       in
-      sn.messages#set (Richpp.richpp_of_string ("Running: "^cmd));
+      sn.messages#default_route#set (Pp.str ("Running: "^cmd));
       let finally st = flash_info (cmd ^ pr_exit_status st)
       in
-      run_command (fun msg -> sn.messages#add_string msg) finally cmd
+      run_command (fun msg -> sn.messages#default_route#add_string msg) finally cmd
 
 let export kind = cb_on_current_term (export kind)
 
@@ -427,13 +441,15 @@ 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
-      sn.messages#set (Richpp.richpp_of_string ("Running: "^cmd));
+      sn.messages#default_route#set (Pp.str ("Running: "^cmd));
       let display s =
-        sn.messages#add_string s;
+        sn.messages#default_route#add_string s;
         Buffer.add_string buf s
       in
       let finally st =
@@ -441,8 +457,8 @@ let compile sn =
           flash_info (f ^ " successfully compiled")
         else begin
           flash_info (f ^ " failed to compile");
-          sn.messages#set (Richpp.richpp_of_string "Compilation output:\n");
-          sn.messages#add (Richpp.richpp_of_string (Buffer.contents buf));
+          sn.messages#default_route#set (Pp.str "Compilation output:\n");
+          sn.messages#default_route#add (Pp.str (Buffer.contents buf));
         end
       in
       run_command display finally cmd
@@ -464,13 +480,13 @@ let make sn =
     |Some f ->
       File.saveall ();
       let cmd = local_cd f ^ cmd_make#get ^ " 2>&1" in
-      sn.messages#set (Richpp.richpp_of_string "Compilation output:\n");
+      sn.messages#default_route#set (Pp.str "Compilation output:\n");
       Buffer.reset last_make_buf;
       last_make := "";
       last_make_index := 0;
       last_make_dir := Filename.dirname f;
       let display s =
-        sn.messages#add_string s;
+        sn.messages#default_route#add_string s;
         Buffer.add_string last_make_buf s
       in
       let finally st = flash_info (cmd_make#get ^ pr_exit_status st)
@@ -508,11 +524,11 @@ let next_error sn =
     let stopi = b#get_iter_at_byte ~line:(line-1) stop in
     b#apply_tag Tags.Script.error ~start:starti ~stop:stopi;
     b#place_cursor ~where:starti;
-    sn.messages#set (Richpp.richpp_of_string error_msg);
+    sn.messages#default_route#set (Pp.str error_msg);
     sn.script#misc#grab_focus ()
   with Not_found ->
     last_make_index := 0;
-    sn.messages#set (Richpp.richpp_of_string "No more errors.\n")
+    sn.messages#default_route#set (Pp.str "No more errors.\n")
 
 let next_error = cb_on_current_term next_error
 
@@ -536,7 +552,7 @@ let update_status sn =
     display ("Ready"^ (if nanoPG#get then ", [μPG]" else "") ^ path ^ name);
     Coq.return ()
   in
-  Coq.bind (Coq.status ~logger:sn.messages#push false) next
+  Coq.bind (Coq.status false) next
 
 let find_next_occurrence ~backward sn =
   (** go to the next occurrence of the current word, forward or backward *)
@@ -593,16 +609,14 @@ let get_current_word term =
   (** Then look at the current selected word *)
   let buf1 = term.script#buffer in
   let buf2 = term.proof#buffer in
-  let buf3 = term.messages#buffer in
   if buf1#has_selection then
     let (start, stop) = buf1#selection_bounds in
     buf1#get_text ~slice:true ~start ~stop ()
   else if buf2#has_selection then
     let (start, stop) = buf2#selection_bounds in
     buf2#get_text ~slice:true ~start ~stop ()
-  else if buf3#has_selection then
-    let (start, stop) = buf3#selection_bounds in
-    buf3#get_text ~slice:true ~start ~stop ()
+  else if term.messages#has_selection then
+    term.messages#get_selected_text
   (** Otherwise try to find the word around the cursor *)
   else
     let it = term.script#buffer#get_iter_at_mark `INSERT in
@@ -652,36 +666,18 @@ let match_callback = cb_on_current_term match_callback
 
 module Query = struct
 
-let searchabout sn =
-  let word = get_current_word sn in
-  let buf = sn.messages#buffer in
-  let insert result =
-    let qualid = result.Interface.coq_object_qualid in
-    let name = String.concat "." qualid in
-    let tpe = result.Interface.coq_object_object in
-    buf#insert ~tags:[Tags.Message.item] name;
-    buf#insert "\n";
-    buf#insert tpe;
-    buf#insert "\n";
-  in
-  let display_results r =
-    sn.messages#clear;
-    List.iter insert (match r with Interface.Good l -> l | _ -> []);
-    Coq.return ()
-  in
-  let launch_query =
-    let search = Coq.search [Interface.SubType_Pattern word, true] in
-    Coq.bind search display_results
-  in
-  Coq.try_grab sn.coqtop launch_query ignore
-
-let searchabout () = on_current_term searchabout
-
 let doquery query sn =
-  sn.messages#clear;
-  Coq.try_grab sn.coqtop (sn.coqops#raw_coq_query query) ignore
-
-let otherquery command sn =
+  sn.messages#default_route#clear;
+  Coq.try_grab sn.coqtop (sn.coqops#raw_coq_query query ~route_id:0
+    ~next:(function
+        | Interface.Fail (_, _, err) ->
+            let err = Ideutils.validate err in
+            sn.messages#default_route#add err;
+            Coq.return ()
+        | Interface.Good () -> Coq.return ()))
+  ignore
+
+let queryif command sn =
   Option.iter (fun query -> doquery (query ^ ".") sn)
     begin try
       let i = CString.string_index_from command 0 "..." in
@@ -690,12 +686,7 @@ let otherquery command sn =
       else Some (CString.sub command 0 i ^ " " ^ word)
     with Not_found -> Some command end
 
-let otherquery command = cb_on_current_term (otherquery command)
-
-let query command _ =
-  if command = "Search" || command = "SearchAbout"
-  then searchabout ()
-  else otherquery command ()
+let query command _ = cb_on_current_term (queryif command) ()
 
 end
 
@@ -724,7 +715,7 @@ let initial_about () =
     else ""
   in
   let msg = initial_string ^ version_info ^ log_file_message () in
-  on_current_term (fun term -> term.messages#add_string msg)
+  on_current_term (fun term -> term.messages#default_route#add_string msg)
 
 let coq_icon () =
   (* May raise Nof_found *)
@@ -788,15 +779,15 @@ let coqtop_arguments sn =
       | args ->
         let args = String.concat " " args in
         let msg = Printf.sprintf "Invalid arguments: %s" args in
-        let () = sn.messages#clear in
-        sn.messages#push Feedback.Error (Richpp.richpp_of_string msg)
+        let () = sn.messages#default_route#clear in
+        sn.messages#default_route#push Feedback.Error (Pp.str msg)
     else dialog#destroy ()
   in
-  let _ = entry#connect#activate ok_cb in
-  let _ = ok#connect#clicked ok_cb in
+  let _ = entry#connect#activate ~callback:ok_cb in
+  let _ = ok#connect#clicked ~callback:ok_cb in
   let cancel = GButton.button ~stock:`CANCEL ~packing:box#add () in
   let cancel_cb () = dialog#destroy () in
-  let _ = cancel#connect#clicked cancel_cb in
+  let _ = cancel#connect#clicked ~callback:cancel_cb in
   dialog#show ()
 
 let coqtop_arguments = cb_on_current_term coqtop_arguments
@@ -887,8 +878,8 @@ let alpha_items menu_name item_name l =
     | [] -> ()
     | [s] -> mk_item s
     | s::_ as ll ->
-      let name = item_name^" "^(String.make 1 s.[0]) in
-      let label = "_@..." in label.[1] <- s.[0];
+      let name = Printf.sprintf "%s %c" item_name s.[0] in
+      let label = Printf.sprintf "_%c..." s.[0] in
       item name ~label menu_name;
       List.iter mk_item ll
   in
@@ -1103,8 +1094,8 @@ let build_ui () =
 
   menu templates_menu [
     item "Templates" ~label:"Te_mplates";
-    template_item ("Lemma new_lemma : .\nProof.\n\nSave.\n", 6,9, "J");
-    template_item ("Theorem new_theorem : .\nProof.\n\nSave.\n", 8,11, "T");
+    template_item ("Lemma new_lemma : .\nProof.\n\nQed.\n", 6,9, "J");
+    template_item ("Theorem new_theorem : .\nProof.\n\nQed.\n", 8,11, "T");
     template_item ("Definition ident := .\n", 11,5, "E");
     template_item ("Inductive ident : :=\n  | : .\n", 10,5, "I");
     template_item ("Fixpoint ident (_ : _) {struct _} : _ :=\n.\n", 9,5, "F");
@@ -1115,15 +1106,15 @@ let build_ui () =
   ];
   alpha_items templates_menu "Template" Coq_commands.commands;
 
-  let qitem s sc ?(dots = true) =
-    let query = if dots then s ^ "..." else s in
+  let qitem s sc =
+    let query = s ^ "..." in
     item s ~label:("_"^s)
       ~accel:(modifier_for_queries#get^sc)
       ~callback:(Query.query query)
   in
   menu queries_menu [
     item "Queries" ~label:"_Queries";
-    qitem "Search" "K" ~dots:false;
+    qitem "Search" "K";
     qitem "Check" "C";
     qitem "Print" "P";
     qitem "About" "A";
@@ -1161,17 +1152,17 @@ let build_ui () =
     item "Help" ~label:"_Help";
     item "Browse Coq Manual" ~label:"Browse Coq _Manual"
       ~callback:(fun _ ->
-        browse notebook#current_term.messages#add_string (doc_url ()));
+        browse notebook#current_term.messages#default_route#add_string (doc_url ()));
     item "Browse Coq Library" ~label:"Browse Coq _Library"
       ~callback:(fun _ ->
-        browse notebook#current_term.messages#add_string library_url#get);
+        browse notebook#current_term.messages#default_route#add_string library_url#get);
     item "Help for keyword" ~label:"Help for _keyword" ~stock:`HELP
       ~callback:(fun _ -> on_current_term (fun sn ->
-        browse_keyword sn.messages#add_string (get_current_word sn)));
+        browse_keyword sn.messages#default_route#add_string (get_current_word sn)));
     item "Help for μPG mode" ~label:"Help for μPG mode"
       ~callback:(fun _ -> on_current_term (fun sn ->
-         sn.messages#clear;
-         sn.messages#add_string (NanoPG.get_documentation ())));
+         sn.messages#default_route#clear;
+         sn.messages#default_route#add_string (NanoPG.get_documentation ())));
     item "About Coq" ~label:"_About" ~stock:`ABOUT
       ~callback:MiscMenu.about
   ];
@@ -1207,9 +1198,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 *)
@@ -1274,8 +1270,8 @@ let build_ui () =
     if b then toolbar#misc#show () else toolbar#misc#hide ()
   in
   stick show_toolbar toolbar refresh_toolbar;
-  let _ = source_style#connect#changed refresh_style in
-  let _ = source_language#connect#changed refresh_language in
+  let _ = source_style#connect#changed ~callback:refresh_style in
+  let _ = source_language#connect#changed ~callback:refresh_language in
 
   (* Color configuration *)
   Tags.Script.incomplete#set_property
@@ -1311,25 +1307,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
@@ -1345,9 +1322,11 @@ let read_coqide_args argv =
       if coqtop = None then filter_coqtop (Some prog) project_files out args
       else (output_string stderr "Error: multiple -coqtop options"; exit 1)
     |"-f" :: file :: args ->
+      if project_files <> None then
+        (output_string stderr "Error: multiple -f options"; exit 1);
       let d = CUnix.canonical_path_name (Filename.dirname file) in
-      let p = Project_file.read_project_file file in
-      filter_coqtop coqtop ((d,p) :: project_files) out args
+      let p = CoqProject_file.read_project_file file in
+      filter_coqtop coqtop (Some (d,p)) out args
     |"-f" :: [] ->
       output_string stderr "Error: missing project file name"; exit 1
     |"-coqtop" :: [] ->
@@ -1358,17 +1337,17 @@ 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 *)
       filter_coqtop coqtop project_files out args
     |arg::args -> filter_coqtop coqtop project_files (arg::out) args
-    |[] -> (coqtop,List.rev project_files,List.rev out)
+    |[] -> (coqtop,project_files,List.rev out)
   in
-  let coqtop,project_files,argv = filter_coqtop None [] [] argv in
+  let coqtop,project_files,argv = filter_coqtop None None [] argv in
   Ideutils.custom_coqtop := coqtop;
-  custom_project_files := project_files;
+  custom_project_file := project_files;
   argv
 
 
diff --git a/ide/coqide.mli b/ide/coqide.mli
index 744b974f..03e85453 100644
--- a/ide/coqide.mli
+++ b/ide/coqide.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * The CoqIde main module *)
@@ -40,5 +42,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 534a3f17..3a92e1bc 100644
--- a/ide/coqide_main.ml4
+++ b/ide/coqide_main.ml4
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 let _ = Coqide.set_signal_handlers ()
@@ -55,6 +57,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 +90,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 +145,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 00000000..9db9ecd1
--- /dev/null
+++ b/ide/coqide_main.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* 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.ml b/ide/coqide_ui.ml
index 2ae18593..717c4000 100644
--- a/ide/coqide_ui.ml
+++ b/ide/coqide_ui.ml
@@ -28,148 +28,149 @@ let list_queries menu li =
   res_buf
 
 let init () =
-  let theui = Printf.sprintf "<ui>
-<menubar name='CoqIde MenuBar'>
-  <menu action='File'>
-    <menuitem action='New' />
-    <menuitem action='Open' />
-    <menuitem action='Save' />
-    <menuitem action='Save as' />
-    <menuitem action='Save all' />
-    <menuitem action='Revert all buffers' />
-    <menuitem action='Close buffer' />
-    <menuitem action='Print...' />
-    <menu action='Export to'>
-      <menuitem action='Html' />
-      <menuitem action='Latex' />
-      <menuitem action='Dvi' />
-      <menuitem action='Pdf' />
-      <menuitem action='Ps' />
-    </menu>
-    <menuitem action='Rehighlight' />
-    %s
-  </menu>
-  <menu name='Edit' action='Edit'>
-    <menuitem action='Undo' />
-    <menuitem action='Redo' />
-    <separator />
-    <menuitem action='Cut' />
-    <menuitem action='Copy' />
-    <menuitem action='Paste' />
-    <separator />
-    <menuitem action='Find' />
-    <menuitem action='Find Next' />
-    <menuitem action='Find Previous' />
-    <menuitem action='Complete Word' />
-    <separator />
-    <menuitem action='External editor' />
-    <separator />
-    <menuitem name='Prefs' action='Preferences' />
-  </menu>
-  <menu name='View' action='View'>
-    <menuitem action='Previous tab' />
-    <menuitem action='Next tab' />
-    <separator/>
-    <menuitem action='Zoom in' />
-    <menuitem action='Zoom out' />
-    <menuitem action='Zoom fit' />
-    <separator/>
-    <menuitem action='Show Toolbar' />
-    <menuitem action='Query Pane' />
-    <separator/>
-    <menuitem action='Display implicit arguments' />
-    <menuitem action='Display coercions' />
-    <menuitem action='Display raw matching expressions' />
-    <menuitem action='Display notations' />
-    <menuitem action='Display all basic low-level contents' />
-    <menuitem action='Display existential variable instances' />
-    <menuitem action='Display universe levels' />
-    <menuitem action='Display all low-level contents' />
-  </menu>
-  <menu action='Navigation'>
-    <menuitem action='Forward' />
-    <menuitem action='Backward' />
-    <menuitem action='Go to' />
-    <menuitem action='Start' />
-    <menuitem action='End' />
-    <menuitem action='Interrupt' />
-    <menuitem action='Previous' />
-    <menuitem action='Next' />
-  </menu>
-  <menu action='Try Tactics'>
-    <menuitem action='auto' />
-    <menuitem action='auto with *' />
-    <menuitem action='eauto' />
-    <menuitem action='eauto with *' />
-    <menuitem action='intuition' />
-    <menuitem action='omega' />
-    <menuitem action='simpl' />
-    <menuitem action='tauto' />
-    <menuitem action='trivial' />
-    <menuitem action='Wizard' />
-    <separator />
-    %s
-  </menu>
-  <menu action='Templates'>
-    <menuitem action='Lemma' />
-    <menuitem action='Theorem' />
-    <menuitem action='Definition' />
-    <menuitem action='Inductive' />
-    <menuitem action='Fixpoint' />
-    <menuitem action='Scheme' />
-    <menuitem action='match' />
-    <separator />
-    %s
-  </menu>
-  <menu action='Queries'>
-    <menuitem action='Search' />
-    <menuitem action='Check' />
-    <menuitem action='Print' />
-    <menuitem action='About' />
-    <menuitem action='Locate' />
-    <menuitem action='Print Assumptions' />
-    <separator />
-    %s
-  </menu>
-  <menu name='Tools' action='Tools'>
-    <menuitem action='Comment' />
-    <menuitem action='Uncomment' />
-    <separator />
-    <menuitem action='Coqtop arguments' />
-  </menu>
-  <menu action='Compile'>
-    <menuitem action='Compile buffer' />
-    <menuitem action='Make' />
-    <menuitem action='Next error' />
-    <menuitem action='Make makefile' />
-  </menu>
-  <menu action='Windows'>
-    <menuitem action='Detach View' />
-  </menu>
-  <menu name='Help' action='Help'>
-    <menuitem action='Browse Coq Manual' />
-    <menuitem action='Browse Coq Library' />
-    <menuitem action='Help for keyword' />
-    <menuitem action='Help for μPG mode' />
-    <separator />
-    <menuitem name='Abt' action='About Coq' />
-  </menu>
-</menubar>
-<toolbar name='CoqIde ToolBar'>
-  <toolitem action='Save' />
-  <toolitem action='Close buffer' />
-  <toolitem action='Forward' />
-  <toolitem action='Backward' />
-  <toolitem action='Go to' />
-  <toolitem action='Start' />
-  <toolitem action='End' />
-  <toolitem action='Force' />
-  <toolitem action='Interrupt' />
-  <toolitem action='Previous' />
-  <toolitem action='Next' />
-  <toolitem action='Wizard' />
-</toolbar>
-</ui>"
+  let theui = Printf.sprintf "<ui>\
+\n<menubar name='CoqIde MenuBar'>\
+\n  <menu action='File'>\
+\n    <menuitem action='New' />\
+\n    <menuitem action='Open' />\
+\n    <menuitem action='Save' />\
+\n    <menuitem action='Save as' />\
+\n    <menuitem action='Save all' />\
+\n    <menuitem action='Revert all buffers' />\
+\n    <menuitem action='Close buffer' />\
+\n    <menuitem action='Print...' />\
+\n    <menu action='Export to'>\
+\n      <menuitem action='Html' />\
+\n      <menuitem action='Latex' />\
+\n      <menuitem action='Dvi' />\
+\n      <menuitem action='Pdf' />\
+\n      <menuitem action='Ps' />\
+\n    </menu>\
+\n    <menuitem action='Rehighlight' />\
+\n    %s\
+\n  </menu>\
+\n  <menu name='Edit' action='Edit'>\
+\n    <menuitem action='Undo' />\
+\n    <menuitem action='Redo' />\
+\n    <separator />\
+\n    <menuitem action='Cut' />\
+\n    <menuitem action='Copy' />\
+\n    <menuitem action='Paste' />\
+\n    <separator />\
+\n    <menuitem action='Find' />\
+\n    <menuitem action='Find Next' />\
+\n    <menuitem action='Find Previous' />\
+\n    <menuitem action='Complete Word' />\
+\n    <separator />\
+\n    <menuitem action='External editor' />\
+\n    <separator />\
+\n    <menuitem name='Prefs' action='Preferences' />\
+\n  </menu>\
+\n  <menu name='View' action='View'>\
+\n    <menuitem action='Previous tab' />\
+\n    <menuitem action='Next tab' />\
+\n    <separator/>\
+\n    <menuitem action='Zoom in' />\
+\n    <menuitem action='Zoom out' />\
+\n    <menuitem action='Zoom fit' />\
+\n    <separator/>\
+\n    <menuitem action='Show Toolbar' />\
+\n    <menuitem action='Query Pane' />\
+\n    <separator/>\
+\n    <menuitem action='Display implicit arguments' />\
+\n    <menuitem action='Display coercions' />\
+\n    <menuitem action='Display raw matching expressions' />\
+\n    <menuitem action='Display notations' />\
+\n    <menuitem action='Display all basic low-level contents' />\
+\n    <menuitem action='Display existential variable instances' />\
+\n    <menuitem action='Display universe levels' />\
+\n    <menuitem action='Display all low-level contents' />\
+\n    <menuitem action='Display unfocused goals' />\
+\n  </menu>\
+\n  <menu action='Navigation'>\
+\n    <menuitem action='Forward' />\
+\n    <menuitem action='Backward' />\
+\n    <menuitem action='Go to' />\
+\n    <menuitem action='Start' />\
+\n    <menuitem action='End' />\
+\n    <menuitem action='Interrupt' />\
+\n    <menuitem action='Previous' />\
+\n    <menuitem action='Next' />\
+\n  </menu>\
+\n  <menu action='Try Tactics'>\
+\n    <menuitem action='auto' />\
+\n    <menuitem action='auto with *' />\
+\n    <menuitem action='eauto' />\
+\n    <menuitem action='eauto with *' />\
+\n    <menuitem action='intuition' />\
+\n    <menuitem action='omega' />\
+\n    <menuitem action='simpl' />\
+\n    <menuitem action='tauto' />\
+\n    <menuitem action='trivial' />\
+\n    <menuitem action='Wizard' />\
+\n    <separator />\
+\n    %s\
+\n  </menu>\
+\n  <menu action='Templates'>\
+\n    <menuitem action='Lemma' />\
+\n    <menuitem action='Theorem' />\
+\n    <menuitem action='Definition' />\
+\n    <menuitem action='Inductive' />\
+\n    <menuitem action='Fixpoint' />\
+\n    <menuitem action='Scheme' />\
+\n    <menuitem action='match' />\
+\n    <separator />\
+\n    %s\
+\n  </menu>\
+\n  <menu action='Queries'>\
+\n    <menuitem action='Search' />\
+\n    <menuitem action='Check' />\
+\n    <menuitem action='Print' />\
+\n    <menuitem action='About' />\
+\n    <menuitem action='Locate' />\
+\n    <menuitem action='Print Assumptions' />\
+\n    <separator />\
+\n    %s\
+\n  </menu>\
+\n  <menu name='Tools' action='Tools'>\
+\n    <menuitem action='Comment' />\
+\n    <menuitem action='Uncomment' />\
+\n    <separator />\
+\n    <menuitem action='Coqtop arguments' />\
+\n  </menu>\
+\n  <menu action='Compile'>\
+\n    <menuitem action='Compile buffer' />\
+\n    <menuitem action='Make' />\
+\n    <menuitem action='Next error' />\
+\n    <menuitem action='Make makefile' />\
+\n  </menu>\
+\n  <menu action='Windows'>\
+\n    <menuitem action='Detach View' />\
+\n  </menu>\
+\n  <menu name='Help' action='Help'>\
+\n    <menuitem action='Browse Coq Manual' />\
+\n    <menuitem action='Browse Coq Library' />\
+\n    <menuitem action='Help for keyword' />\
+\n    <menuitem action='Help for μPG mode' />\
+\n    <separator />\
+\n    <menuitem name='Abt' action='About Coq' />\
+\n  </menu>\
+\n</menubar>\
+\n<toolbar name='CoqIde ToolBar'>\
+\n  <toolitem action='Save' />\
+\n  <toolitem action='Close buffer' />\
+\n  <toolitem action='Forward' />\
+\n  <toolitem action='Backward' />\
+\n  <toolitem action='Go to' />\
+\n  <toolitem action='Start' />\
+\n  <toolitem action='End' />\
+\n  <toolitem action='Force' />\
+\n  <toolitem action='Interrupt' />\
+\n  <toolitem action='Previous' />\
+\n  <toolitem action='Next' />\
+\n  <toolitem action='Wizard' />\
+\n</toolbar>\
+\n</ui>"
     (if Coq_config.gtk_platform <> `QUARTZ then "<menuitem action='Quit' />" else "")
     (Buffer.contents (list_items "Tactic" Coq_commands.tactics))
     (Buffer.contents (list_items "Template" Coq_commands.commands))
diff --git a/ide/coqide_ui.mli b/ide/coqide_ui.mli
new file mode 100644
index 00000000..afc5447a
--- /dev/null
+++ b/ide/coqide_ui.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val init : unit -> unit
+val ui_m : GAction.ui_manager
diff --git a/ide/coqidetop.mllib b/ide/coqidetop.mllib
index ed1fa465..df988d8f 100644
--- a/ide/coqidetop.mllib
+++ b/ide/coqidetop.mllib
@@ -2,8 +2,7 @@ Xml_lexer
 Xml_parser
 Xml_printer
 Serialize
-Richprinter
+Richpp
 Xmlprotocol
-Texmacspp
 Document
 Ide_slave
diff --git a/ide/document.ml b/ide/document.ml
index 62457fe5..0d3b36a7 100644
--- a/ide/document.ml
+++ b/ide/document.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
 exception Empty
diff --git a/ide/document.mli b/ide/document.mli
index fb96cb6d..2f460e6d 100644
--- a/ide/document.mli
+++ b/ide/document.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* An 'a document is a structure to hold and manipulate list of sentences.
@@ -102,7 +104,7 @@ val context : 'a document -> (id * 'a) list * (id * 'a) list
 
 (** debug print *)
 val print :
-  'a document -> (bool -> id option -> 'a ->  Pp.std_ppcmds) -> Pp.std_ppcmds
+  'a document -> (bool -> id option -> 'a ->  Pp.t) -> Pp.t
 
 (** Callbacks on documents *)
 
diff --git a/ide/fileOps.ml b/ide/fileOps.ml
index 7be1bdb9..7acd2c37 100644
--- a/ide/fileOps.ml
+++ b/ide/fileOps.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Ideutils
diff --git a/ide/fileOps.mli b/ide/fileOps.mli
index 9f0b75ac..9a1f0cb7 100644
--- a/ide/fileOps.mli
+++ b/ide/fileOps.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val revert_timer : Ideutils.timer
diff --git a/ide/gtk_parsing.ml b/ide/gtk_parsing.ml
index f905053d..9f5c9924 100644
--- a/ide/gtk_parsing.ml
+++ b/ide/gtk_parsing.ml
@@ -1,17 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 +28,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 +59,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 00000000..a9f3e122
--- /dev/null
+++ b/ide/gtk_parsing.mli
@@ -0,0 +1,28 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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.mllib b/ide/ide.mllib
index b2f32fcf..96ea8c41 100644
--- a/ide/ide.mllib
+++ b/ide/ide.mllib
@@ -1,12 +1,7 @@
 Minilib
-Okey
-Config_file
-Configwin_keys
-Configwin_types
 Configwin_messages
 Configwin_ihm
 Configwin
-Editable_cells
 Config_parser
 Tags
 Wg_Notebook
@@ -19,6 +14,9 @@ Richprinter
 Xml_lexer
 Xml_parser
 Xml_printer
+Serialize
+Richpp
+Topfmt
 Xmlprotocol
 Ideutils
 Coq
@@ -28,15 +26,16 @@ Gtk_parsing
 Wg_Segment
 Wg_ProofView
 Wg_MessageView
+Wg_RoutedMessageViews
 Wg_Detachable
 Wg_Find
 Wg_Completion
 Wg_ScriptView
 Coq_commands
-Wg_Command
 FileOps
 Document
 CoqOps
+Wg_Command
 Session
 Coqide_ui
 NanoPG
diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml
index 5b07d3ec..6b7efc83 100644
--- a/ide/ide_slave.ml
+++ b/ide/ide_slave.ml
@@ -1,23 +1,27 @@
 (************************************************************************)
-
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Vernacexpr
+open Vernacprop
 open CErrors
 open Util
 open Pp
 open Printer
 
+module NamedDecl = Context.Named.Declaration
+module CompactedDecl = Context.Compacted.Declaration
+
 (** Ide_slave : an implementation of [Interface], i.e. mainly an interp
     function and a rewind function. This specialized loop is triggered
-    when the -ideslave option is passed to Coqtop. Currently CoqIDE is
-    the only one using this mode, but we try here to be as generic as
-    possible, so this may change in the future... *)
+    when the -ideslave option is passed to Coqtop. *)
+
 
 (** Signal handling: we postpone ^C during input and output phases,
     but make it directly raise a Sys.Break during evaluation of the request. *)
@@ -28,24 +32,6 @@ let init_signal_handler () =
   let f _ = if !catch_break then raise Sys.Break else Control.interrupt := true in
   Sys.set_signal Sys.sigint (Sys.Signal_handle f)
 
-
-(** Redirection of standard output to a printable buffer *)
-
-let init_stdout, read_stdout =
-  let out_buff = Buffer.create 100 in
-  let out_ft = Format.formatter_of_buffer out_buff in
-  let deep_out_ft = Format.formatter_of_buffer out_buff in
-  let _ = Pp_control.set_gp deep_out_ft Pp_control.deep_gp in
-  (fun () ->
-     flush_all ();
-     Pp_control.std_ft := out_ft;
-     Pp_control.err_ft := out_ft;
-     Pp_control.deep_ft := deep_out_ft;
-  ),
-  (fun () -> Format.pp_print_flush out_ft ();
-             let r = Buffer.contents out_buff in
-             Buffer.clear out_buff; r)
-
 let pr_with_pid s = Printf.eprintf "[pid %d] %s\n%!" (Unix.getpid ()) s
 
 let pr_error s = pr_with_pid s
@@ -67,73 +53,85 @@ let coqide_known_option table = List.mem table [
   ["Printing";"All"];
   ["Printing";"Records"];
   ["Printing";"Existential";"Instances"];
-  ["Printing";"Universes"]]
-
-let is_known_option cmd = match cmd with
-  | VernacSetOption (o,BoolValue true)
-  | VernacUnsetOption o -> coqide_known_option o
-  | _ -> false
-
-let is_debug cmd = match 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
+  ["Printing";"Universes"];
+  ["Printing";"Unfocused"]]
 
-let is_undo cmd = match cmd with
-  | VernacUndo _ | VernacUndoTo _ -> true
+let is_known_option cmd = match Vernacprop.under_control cmd with
+  | VernacSetOption (_, o, BoolValue true)
+  | VernacUnsetOption (_, o) -> coqide_known_option o
   | _ -> false
 
-(** Check whether a command is forbidden by CoqIDE *)
+(** Check whether a command is forbidden in the IDE *)
 
-let coqide_cmd_checks (loc,ast) =
-  let user_error s = CErrors.user_err_loc (loc, "CoqIde", str s) in
+let ide_cmd_checks ~id {CAst.loc;v=ast} =
+  let user_error s = CErrors.user_err ?loc ~hdr:"IDE" (str s) in
+  let warn msg = Feedback.(feedback ~id (Message (Warning, loc, strbrk msg))) in
   if is_debug ast then
-    user_error "Debug mode not available within CoqIDE";
+    user_error "Debug mode not available in the IDE";
   if is_known_option ast then
-    Feedback.msg_warning (strbrk"This will not work. Use CoqIDE view menu instead");
-  if Vernac.is_navigation_vernac ast || is_undo ast then
-    Feedback.msg_warning (strbrk "Rather use CoqIDE navigation instead");
-  if is_query ast then
-    Feedback.msg_warning (strbrk "Query commands should not be inserted in scripts")
+    warn "Set this option from the IDE menu instead";
+  if is_navigation_vernac ast || is_undo ast then
+    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 newid, rc = Stm.add ~ontop:sid verbose ~check:coqide_cmd_checks eid s in
+  let doc = get_doc () in
+  let pa = Pcoq.Gram.parsable (Stream.of_string s) 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
-  newid, (rc, read_stdout ())
+  ide_cmd_checks ~id:newid loc_ast;
+  (* TODO: the "" parameter is a leftover of the times the protocol
+   * used to include stderr/stdout output.
+   *
+   * Currently, we force all the output meant for the to go via the
+   * feedback mechanism, and we don't manipulate stderr/stdout, which
+   * are left to the client's discrection. The parameter is still there
+   * as not to break the core protocol for this minor change, but it should
+   * be removed in the next version of the protocol.
+   *)
+  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 query (s,id) = Stm.query ~at:id s; read_stdout ()
+  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.
+ *
+ * Currently, we force all the output meant for the to go via the
+ * feedback mechanism, and we don't manipulate stderr/stdout, which
+ * are left to the client's discrection. The parameter is still there
+ * as not to break the core protocol for this minor change, but it should
+ * be removed in the next version of the protocol.
+ *)
+let query (route, (s,id)) =
+  let pa = Pcoq.Gram.parsable (Stream.of_string s) in
+  let doc = get_doc () in
+  Stm.query ~at:id ~doc ~route pa
 
 let annotate phrase =
-  let (loc, ast) =
+  let doc = get_doc () in
+  let {CAst.loc;v=ast} =
     let pa = Pcoq.Gram.parsable (Stream.of_string phrase) in
-    Vernac.parse_sentence (pa,None)
+    Stm.parse_sentence ~doc (Stm.get_current_state ~doc) pa
   in
-  let (_, xml) =
-    Richprinter.richpp_vernac ast
-  in
-  xml
+  (* XXX: Width should be a parameter of annotate... *)
+  Richpp.richpp_of_pp 78 (Ppvernac.pr_vernac ast)
 
 (** Goal display *)
 
 let hyp_next_tac sigma env decl =
-  let (id,_,ast) = Context.Named.Declaration.to_tuple decl in
+  let id = NamedDecl.get_id decl in
+  let ast = NamedDecl.get_type decl in
   let id_s = Names.Id.to_string id in
   let type_s = string_of_ppcmds (pr_ltype_env env sigma ast) in
   [
@@ -186,20 +184,14 @@ let process_goal sigma g =
   let min_env = Environ.reset_context env in
   let id = Goal.uid g in
   let ccl =
-    let norm_constr = Reductionops.nf_evar sigma (Goal.V82.concl sigma g) in
-    Richpp.richpp_of_pp (pr_goal_concl_style_env env sigma norm_constr)
+    pr_goal_concl_style_env env sigma (Goal.V82.concl sigma g)
   in
   let process_hyp d (env,l) =
-    let d = Context.NamedList.Declaration.map_constr (Reductionops.nf_evar sigma) d in
-    let d' = List.map (fun name -> let open Context.Named.Declaration in
-                                   match pi2 d with
-                                   | None -> LocalAssum (name, pi3 d)
-                                   | Some value -> LocalDef (name, value, pi3 d))
-                      (pi1 d) in
+    let d' = CompactedDecl.to_named_context d in
       (List.fold_right Environ.push_named d' env,
-       (Richpp.richpp_of_pp (pr_var_list_decl env sigma d)) :: l) in
+       (pr_compacted_decl env sigma d) :: l) in
   let (_env, hyps) =
-    Context.NamedList.fold process_hyp
+    Context.Compacted.fold process_hyp
       (Termops.compact_named_context (Environ.named_context env)) ~init:(min_env,[]) in
   { Interface.goal_hyp = List.rev hyps; Interface.goal_ccl = ccl; Interface.goal_id = id; }
 
@@ -212,9 +204,8 @@ let export_pre_goals pgs =
   }
 
 let goals () =
-  Stm.finish ();
-  let s = read_stdout () in
-  if not (String.is_empty s) then Feedback.msg_info (str s);
+  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))
@@ -222,12 +213,11 @@ let goals () =
 
 let evars () =
   try
-    Stm.finish ();
-    let s = read_stdout () in
-    if not (String.is_empty s) then Feedback.msg_info (str s);
+    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 exl = Evar.Map.bindings (Evarutil.non_instantiated sigma) 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
     Some el
@@ -236,7 +226,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 :: _ ->
@@ -250,14 +240,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 ();
-  let s = read_stdout () in
-  if not (String.is_empty s) then Feedback.msg_info (str s);
+  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
@@ -274,13 +267,13 @@ 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 = {
   Interface.coq_object_prefix = t.Search.coq_object_prefix;
   Interface.coq_object_qualid = t.Search.coq_object_qualid;
-  Interface.coq_object_object = t.Search.coq_object_object
+  Interface.coq_object_object = Pp.string_of_ppcmds (pr_lconstr_env (Global.env ()) Evd.empty t.Search.coq_object_object)
 }
 
 let pattern_of_string ?env s =
@@ -290,17 +283,17 @@ let pattern_of_string ?env s =
     | Some e -> e
   in
   let constr = Pcoq.parse_string Pcoq.Constr.lconstr_pattern s in
-  let (_, pat) = Constrintern.intern_constr_pattern env constr in
+  let (_, pat) = Constrintern.intern_constr_pattern env Evd.empty constr in
   pat
 
 let dirpath_of_string_list s =
   let path = String.concat "." s in
   let m = Pcoq.parse_string Pcoq.Constr.global path in
-  let (_, qid) = Libnames.qualid_of_reference m in
+  let {CAst.v=qid} = Libnames.qualid_of_reference m in
   let id =
     try Nametab.full_name_module qid
     with Not_found ->
-      CErrors.errorlabstrm "Search.interface_search"
+      CErrors.user_err ~hdr:"Search.interface_search"
         (str "Module " ++ str path ++ str " not found.")
   in
   id
@@ -330,7 +323,7 @@ let import_option_value = function
   | Interface.StringOptValue s -> Goptions.StringOptValue s
 
 let export_option_state s = {
-  Interface.opt_sync  = s.Goptions.opt_sync;
+  Interface.opt_sync  = true;
   Interface.opt_depr  = s.Goptions.opt_depr;
   Interface.opt_name  = s.Goptions.opt_name;
   Interface.opt_value = export_option_value s.Goptions.opt_value;
@@ -347,7 +340,7 @@ let set_options options =
   | IntValue i -> Goptions.set_int_option_value name i
   | StringValue s -> Goptions.set_string_option_value name s
   | StringOptValue (Some s) -> Goptions.set_string_option_value name s
-  | StringOptValue None -> Goptions.unset_option_value_gen None name
+  | StringOptValue None -> Goptions.unset_option_value_gen name
   in
   List.iter iter options
 
@@ -359,18 +352,15 @@ let about () = {
 }
 
 let handle_exn (e, info) =
+  let (e, info) = ExplainErr.process_vernac_interp_error (e, info) in
   let dummy = Stateid.dummy in
   let loc_of e = match Loc.get_loc e with
-    | Some loc when not (Loc.is_ghost loc) -> Some (Loc.unloc loc)
-    | _ -> None in
-  let mk_msg () =
-    let msg = read_stdout () in
-    let msg = str msg ++ fnl () ++ CErrors.print ~info e in
-    Richpp.richpp_of_pp msg
-  in
+    | Some loc -> Some (Loc.unloc loc)
+    | _        -> None in
+  let mk_msg () = CErrors.print ~info e in
   match e with
-  | CErrors.Drop -> dummy, None, Richpp.richpp_of_string "Drop is not allowed by coqide!"
-  | CErrors.Quit -> dummy, None, Richpp.richpp_of_string "Quit is not allowed by coqide!"
+  | CErrors.Drop -> dummy, None, Pp.str "Drop is not allowed by coqide!"
+  | CErrors.Quit -> dummy, None, Pp.str "Quit is not allowed by coqide!"
   | e ->
       match Stateid.get info with
       | Some (valid, _) -> valid, loc_of info, mk_msg ()
@@ -379,35 +369,24 @@ let handle_exn (e, info) =
 let init =
   let initialized = ref false in
   fun file ->
-   if !initialized then anomaly (str "Already initialized")
+   if !initialized then anomaly (str "Already initialized.")
    else begin
+     let init_sid = Stm.get_current_state ~doc:(get_doc ()) in
      initialized := true;
      match file with
-     | None -> Stm.get_current_state ()
+     | 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
-             Stm.add false ~ontop:(Stm.get_current_state ())
-               0 (Printf.sprintf "Add LoadPath \"%s\". " dir)
-           else Stm.get_current_state (), `NewTip in
-         Stm.set_compilation_hints file;
-         Stm.finish ();
+         let doc, initial_id, _ =
+           get_doc (), init_sid, `NewTip in
+         if Filename.check_suffix file ".v" then
+           Stm.set_compilation_hints file;
+         set_doc (Stm.finish ~doc);
          initial_id
    end
 
-(* Retrocompatibility stuff *)
+(* Retrocompatibility stuff, disabled since 8.7 *)
 let interp ((_raw, verbose), s) =
-  let vernac_parse s =
-    let pa = Pcoq.Gram.parsable (Stream.of_string s) in
-    Flags.with_option Flags.we_are_parsing (fun () ->
-      match Pcoq.Gram.entry_parse Pcoq.main_entry pa with
-      | None -> raise (Invalid_argument "vernac_parse")
-      | Some ast -> ast)
-    () in
-  Stm.interp verbose (vernac_parse s);
-  Stm.get_current_state (), CSig.Inl (read_stdout ())
+  Stateid.dummy, CSig.Inr "The interp call has been disabled, please use Add."
 
 (** When receiving the Quit call, we don't directly do an [exit 0],
     but rather set this reference, in order to send a final answer
@@ -415,25 +394,17 @@ let interp ((_raw, verbose), s) =
 
 let quit = ref false
 
-(** Serializes the output of Stm.get_ast  *)
-let print_ast id =
-  match Stm.get_ast id with
-  | Some (expr, loc) -> begin
-      try  Texmacspp.tmpp expr loc
-      with e -> Xml_datatype.PCData ("ERROR " ^ Printexc.to_string e)
-    end
-  | None     -> Xml_datatype.PCData "ERROR"
+(** Disabled *)
+let print_ast id = Xml_datatype.PCData "ERROR"
 
 (** Grouping all call handlers together + error handling *)
 
-let eval_call xml_oc log c =
+let eval_call c =
   let interruptible f x =
     catch_break := true;
     Control.check_for_interrupt ();
     let r = f x in
     catch_break := false;
-    let out = read_stdout () in
-    if not (String.is_empty out) then log (str out);
     r
   in
   let handler = {
@@ -451,6 +422,7 @@ let eval_call xml_oc log 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;
@@ -471,16 +443,8 @@ let print_xml =
     try Xml_printer.print oc xml; Mutex.unlock m
     with e -> let e = CErrors.push e in Mutex.unlock m; iraise e
 
-
-let slave_logger xml_oc ?loc level message =
-  (* convert the message into XML *)
-  let msg = hov 0 message in
-  let () = pr_debug (Printf.sprintf "-> %S" (string_of_ppcmds msg))         in
-  let xml = Xmlprotocol.of_message level loc (Richpp.richpp_of_pp message) in
-  print_xml xml_oc xml
-
-let slave_feeder xml_oc msg =
-  let xml = Xmlprotocol.of_feedback msg in
+let slave_feeder fmt xml_oc msg =
+  let xml = Xmlprotocol.(of_feedback fmt msg) in
   print_xml xml_oc xml
 
 (** The main loop *)
@@ -489,30 +453,36 @@ let slave_feeder xml_oc msg =
     messages by [handle_exn] above. Otherwise, we die badly, without
     trying to answer malformed requests. *)
 
-let loop () =
+let msg_format = ref (fun () ->
+    let margin = Option.default 72 (Topfmt.get_margin ()) in
+    Xmlprotocol.Richpp margin
+  )
+
+(* 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
-  let xml_oc = Xml_printer.make (Xml_printer.TChannel out_ch) in
-  let in_lb = Lexing.from_function (fun s len ->
-    CThread.thread_friendly_read in_ch s ~off:0 ~len) in
-  let xml_ic = Xml_parser.make (Xml_parser.SLexbuf in_lb) in
+  let in_ch, out_ch = Spawned.get_channels ()                        in
+  let xml_oc        = Xml_printer.make (Xml_printer.TChannel out_ch) in
+  let in_lb         = Lexing.from_function (fun s len ->
+                      CThread.thread_friendly_read in_ch s ~off:0 ~len) in
+  (* SEXP parser make *)
+  let xml_ic        = Xml_parser.make (Xml_parser.SLexbuf in_lb) in
   let () = Xml_parser.check_eof xml_ic false in
-  Feedback.set_logger (slave_logger xml_oc);
-  Feedback.add_feeder (slave_feeder xml_oc);
-  (* We'll handle goal fetching and display in our own way *)
-  Vernacentries.enable_goal_printing := false;
-  Vernacentries.qed_display_script := false;
+  ignore (Feedback.add_feeder (slave_feeder (!msg_format ()) xml_oc));
   while not !quit do
     try
       let xml_query = Xml_parser.parse xml_ic in
 (*       pr_with_pid (Xml_printer.to_string_fmt xml_query); *)
       let Xmlprotocol.Unknown q = Xmlprotocol.to_call xml_query in
       let () = pr_debug_call q in
-      let r = eval_call xml_oc (slave_logger xml_oc Feedback.Notice) q in
+      let r  = eval_call q in
       let () = pr_debug_answer q r in
 (*       pr_with_pid (Xml_printer.to_string_fmt (Xmlprotocol.of_answer q r)); *)
-      print_xml xml_oc (Xmlprotocol.of_answer q r);
+      print_xml xml_oc Xmlprotocol.(of_answer (!msg_format ()) q r);
       flush out_ch
     with
       | Xml_parser.Error (Xml_parser.Empty, _) ->
@@ -534,16 +504,19 @@ let loop () =
 let rec parse = function
   | "--help-XML-protocol" :: rest ->
         Xmlprotocol.document Xml_printer.to_string_fmt; exit 0
+  | "--xml_format=Ppcmds" :: rest ->
+        msg_format := (fun () -> Xmlprotocol.Ppcmds); parse rest
   | x :: rest -> x :: parse rest
   | [] -> []
 
-let () = Coqtop.toploop_init := (fun args ->
-        let args = parse args in
-        Flags.make_silent true;
-        init_stdout ();
-        CoqworkmgrApi.(init Flags.High);
+let () = Coqtop.toploop_init := (fun coq_args extra_args ->
+        let args = parse extra_args in
+        Flags.quiet := true;
+        CoqworkmgrApi.(init High);
         args)
 
 let () = Coqtop.toploop_run := loop
 
-let () = Usage.add_to_usage "coqidetop" "  --help-XML-protocol    print the documentation of the XML protocol used by CoqIDE\n"
+let () = Usage.add_to_usage "coqidetop"
+"  --xml_format=Ppcmds    serialize pretty printing messages using the std_ppcmds format\
+\n  --help-XML-protocol    print documentation of the Coq XML protocol\n"
diff --git a/ide/ide_slave.mli b/ide/ide_slave.mli
new file mode 100644
index 00000000..9db9ecd1
--- /dev/null
+++ b/ide/ide_slave.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* 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 06a13273..bdb39e94 100644
--- a/ide/ideutils.ml
+++ b/ide/ideutils.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
@@ -35,17 +37,6 @@ let flash_info =
   let flash_context = status#new_context ~name:"Flash" in
     (fun ?(delay=5000) s -> flash_context#flash ~delay s)
 
-let xml_to_string xml =
-  let open Xml_datatype in
-  let buf = Buffer.create 1024 in
-  let rec iter = function
-  | PCData s -> Buffer.add_string buf s
-  | Element (_, _, children) ->
-    List.iter iter children
-  in
-  let () = iter (Richpp.repr xml) in
-  Buffer.contents buf
-
 let insert_with_tags (buf : #GText.buffer_skel) mark rmark tags text =
   (** FIXME: LablGTK2 does not export the C insert_with_tags function, so that
       it has to reimplement its own helper function. Unluckily, it relies on
@@ -58,7 +49,7 @@ let insert_with_tags (buf : #GText.buffer_skel) mark rmark tags text =
     let () = buf#insert ~iter:(buf#get_iter_at_mark mark) text in
     let start = buf#get_iter_at_mark mark in
     let stop = buf#get_iter_at_mark rmark in
-    let iter tag = buf#apply_tag tag start stop in
+    let iter tag = buf#apply_tag tag ~start ~stop in
     List.iter iter tags
 
 let insert_xml ?(mark = `INSERT) ?(tags = []) (buf : #GText.buffer_skel) msg =
@@ -75,11 +66,17 @@ let insert_xml ?(mark = `INSERT) ?(tags = []) (buf : #GText.buffer_skel) msg =
     let tags = try tag t :: tags with Not_found -> tags in
     List.iter (fun xml -> insert tags xml) children
   in
-  let () = try insert tags (Richpp.repr msg) with _ -> () in
+  let () = try insert tags msg with _ -> () in
   buf#delete_mark rmark
 
 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) *)
 
@@ -294,18 +291,20 @@ let coqtop_path () =
       match cmd_coqtop#get with
 	| Some s -> s
 	| None ->
-	  let prog = String.copy Sys.executable_name in
 	  try
-	    let pos = String.length prog - 6 in
-	    let i = Str.search_backward (Str.regexp_string "coqide") prog pos
+            let old_prog = Sys.executable_name in
+            let pos = String.length old_prog - 6 in
+            let i = Str.search_backward (Str.regexp_string "coqide") old_prog pos
             in
-	    String.blit "coqtop" 0 prog i 6;
-	    if Sys.file_exists prog then prog
+            let new_prog = Bytes.of_string old_prog in
+            Bytes.blit_string "coqtop" 0 new_prog i 6;
+            let new_prog = Bytes.to_string new_prog in
+            if Sys.file_exists new_prog then new_prog
 	    else
 	      let in_macos_bundle =
 		Filename.concat
-		  (Filename.dirname prog)
-		  (Filename.concat "../Resources/bin" (Filename.basename prog))
+		  (Filename.dirname new_prog)
+		  (Filename.concat "../Resources/bin" (Filename.basename new_prog))
 	      in if Sys.file_exists in_macos_bundle then in_macos_bundle
 		 else "coqtop"
 	  with Not_found -> "coqtop"
@@ -325,7 +324,7 @@ let textview_width (view : #GText.view_skel) =
   let char_width = GPango.to_pixels metrics#approx_char_width in
   pixel_width / char_width
 
-type logger = Feedback.level -> Richpp.richpp -> unit
+type logger = Feedback.level -> Pp.t -> unit
 
 let default_logger level message =
   let level = match level with
@@ -335,7 +334,7 @@ let default_logger level message =
   | Feedback.Warning -> `WARNING
   | Feedback.Error -> `ERROR
   in
-  Minilib.log ~level (xml_to_string message)
+  Minilib.log_pp ~level message
 
 
 (** {6 File operations} *)
@@ -357,7 +356,7 @@ let stat f =
 
 let maxread = 4096
 
-let read_string = String.create maxread
+let read_string = Bytes.create maxread
 let read_buffer = Buffer.create maxread
 
 (** Read the content of file [f] and add it to buffer [b].
@@ -368,7 +367,7 @@ let read_file name buf =
   let len = ref 0 in
   try
     while len := input ic read_string 0 maxread; !len > 0 do
-      Buffer.add_substring buf read_string 0 !len
+      Buffer.add_subbytes buf read_string 0 !len
     done;
     close_in ic
   with e -> close_in ic; raise e
@@ -382,7 +381,7 @@ let io_read_all chan =
   Buffer.clear read_buffer;
   let read_once () =
     let len = Glib.Io.read_chars ~buf:read_string ~pos:0 ~len:maxread chan in
-    Buffer.add_substring read_buffer read_string 0 len
+    Buffer.add_subbytes read_buffer read_string 0 len
   in
   begin
     try while true do read_once () done
@@ -430,7 +429,7 @@ let browse prerr url =
 let doc_url () =
   if doc_url#get = use_default_doc_url || doc_url#get = ""
   then
-    let addr = List.fold_left Filename.concat (Coq_config.docdir)
+    let addr = List.fold_left Filename.concat (Envars.docdir ())
       ["html";"refman";"index.html"]
     in
     if Sys.file_exists addr then "file://"^addr else Coq_config.wwwrefman
@@ -475,3 +474,14 @@ let browse_keyword prerr text =
     browse prerr (doc_url() ^ u)
   with Not_found -> prerr ("No documentation found for \""^text^"\".\n")
 
+let rec is_valid (s : Pp.t) = match Pp.repr s with
+  | Pp.Ppcmd_empty
+  | Pp.Ppcmd_print_break _
+  | Pp.Ppcmd_force_newline  -> true
+  | Pp.Ppcmd_glue l    -> List.for_all is_valid l
+  | Pp.Ppcmd_string s  -> Glib.Utf8.validate s
+  | Pp.Ppcmd_box (_,s)
+  | Pp.Ppcmd_tag (_,s) -> is_valid s
+  | Pp.Ppcmd_comment s -> List.for_all Glib.Utf8.validate s
+let validate s =
+  if is_valid s then s else Pp.str "This error massage can't be printed."
diff --git a/ide/ideutils.mli b/ide/ideutils.mli
index e32a4d9e..0031c59c 100644
--- a/ide/ideutils.mli
+++ b/ide/ideutils.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val warn_image : unit -> GMisc.image
@@ -52,12 +54,11 @@ val pop_info : unit -> unit
 val clear_info : unit -> unit
 val flash_info : ?delay:int -> string -> unit
 
-val xml_to_string : Richpp.richpp -> string
-
 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
@@ -69,7 +70,7 @@ val requote : string -> string
 val textview_width : #GText.view_skel -> int
 (** Returns an approximate value of the character width of a textview *)
 
-type logger = Feedback.level -> Richpp.richpp -> unit
+type logger = Feedback.level -> Pp.t -> unit
 
 val default_logger : logger
 (** Default logger. It logs messages that the casual user should not see. *)
@@ -98,3 +99,6 @@ val io_read_all : Glib.Io.channel -> string
 val run_command :
   (string -> unit) -> (Unix.process_status -> unit) -> string -> unit
 
+(* Checks if an error message is printable, it not replaces it with
+ * a printable error *)
+val validate : Pp.t -> Pp.t
diff --git a/ide/interface.mli b/ide/interface.mli
index 2a9b8b24..debbc830 100644
--- a/ide/interface.mli
+++ b/ide/interface.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Declarative part of the interface of CoqIde calls to Coq *)
@@ -12,15 +14,14 @@
 
 type raw = bool
 type verbose = bool
-type richpp = Richpp.richpp
 
 (** The type of coqtop goals *)
 type goal = {
   goal_id : string;
   (** Unique goal identifier *)
-  goal_hyp : richpp list;
+  goal_hyp : Pp.t list;
   (** List of hypotheses *)
-  goal_ccl : richpp;
+  goal_ccl : Pp.t;
   (** Goal conclusion *)
 }
 
@@ -112,14 +113,17 @@ type coq_info = {
 (** Calls result *)
 
 type location = (int * int) option (* start and end of the error *)
-type state_id = Feedback.state_id
-type edit_id = Feedback.edit_id
+type state_id = Stateid.t
+type route_id = Feedback.route_id
+
+(* Obsolete *)
+type edit_id  = int
 
 (* The fail case carries the current state_id of the prover, the GUI
    should probably retract to that point *)
 type 'a value =
   | Good of 'a
-  | Fail of (state_id * location * richpp)
+  | Fail of (state_id * location * Pp.t)
 
 type ('a, 'b) union = ('a, 'b) Util.union
 
@@ -128,9 +132,13 @@ type ('a, 'b) union = ('a, 'b) Util.union
 (**  [add ((s,eid),(sid,v))] adds the phrase [s] with edit id [eid]
      on top of the current edit position (that is asserted to be [sid])
      verbosely if [v] is true.  The response [(id,(rc,s)] is the new state
-     [id] assigned to the phrase, some output [s].  [rc] is [Inl] if the new
+     [id] assigned to the phrase. [rc] is [Inl] if the new
      state id is the tip of the edit point, or [Inr tip] if the new phrase
-     closes a focus and [tip] is the new edit tip *)
+     closes a focus and [tip] is the new edit tip
+
+     [s] used to contain Coq's console output and has been deprecated
+     in favor of sending feedback, it will be removed in a future
+     version of the protocol.  *)
 type add_sty = (string * edit_id) * (state_id * verbose)
 type add_rty = state_id * ((unit, state_id) union * string)
 
@@ -139,21 +147,25 @@ type add_rty = state_id * ((unit, state_id) union * string)
     [Inr (start,(stop,tip))] if [id] is in a zone that can be focused.
     In that case the zone is delimited by [start] and [stop] while [tip]
     is the new document [tip].  Edits made by subsequent [add] are always
-    performend on top of [id]. *)
+    performed on top of [id]. *)
 type edit_at_sty = state_id
 type edit_at_rty = (unit, state_id * (state_id * state_id)) union
 
-(** [query s id] executes [s] at state [id] and does not record any state
-    change but for the printings that are sent in response *)
-type query_sty = string * state_id
-type query_rty = string
+(** [query s id] executes [s] at state [id].
+
+    query used to reply with the contents of Coq's console output, and
+    has been deprecated in favor of sending the query answers as
+    feedback. It will be removed in a future version of the protocol.
+*)
+type query_sty = route_id * (string * state_id)
+type query_rty = unit
 
 (** Fetching the list of current goals. Return [None] if no proof is in
     progress, [Some gl] otherwise. *)
 type goals_sty = unit
 type goals_rty = goals option
 
-(** Retrieve the list of unintantiated evars in the current proof. [None] if no
+(** Retrieve the list of uninstantiated evars in the current proof. [None] if no
     proof is in progress. *)
 type evars_sty = unit
 type evars_rty = evar list option
@@ -203,7 +215,7 @@ type about_sty = unit
 type about_rty = coq_info
 
 type handle_exn_sty = Exninfo.iexn
-type handle_exn_rty = state_id * location * richpp
+type handle_exn_rty = state_id * location * Pp.t
 
 (* Retrocompatibility stuff *)
 type interp_sty = (raw * verbose) * string
@@ -219,6 +231,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;
@@ -238,6 +253,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 00000000..9db9ecd1
--- /dev/null
+++ b/ide/macos_prehook.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* 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 d11e8c56..39183e00 100644
--- a/ide/minilib.ml
+++ b/ide/minilib.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 let rec print_list print fmt = function
   | [] -> ()
@@ -20,7 +22,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
 
@@ -30,7 +32,7 @@ let debug = ref false
    print in the response buffer.
 *)
 
-let log ?(level = `DEBUG) msg =
+let log_pp ?(level = `DEBUG) msg =
   let prefix = match level with
   | `DEBUG -> "DEBUG"
   | `INFO -> "INFO"
@@ -40,10 +42,12 @@ let log ?(level = `DEBUG) msg =
   | `FATAL -> "FATAL"
   in
   if !debug then begin
-    try Printf.eprintf "[%s] %s\n%!" prefix msg
+    try Format.eprintf "[%s] @[%a@]\n%!" prefix Pp.pp_with msg
     with _ -> ()
   end
 
+let log ?level str = log_pp ?level (Pp.str str)
+
 let coqify d = Filename.concat d "coq"
 
 let coqide_config_home () =
@@ -52,12 +56,12 @@ let coqide_config_home () =
 let coqide_data_dirs () =
   coqify (Glib.get_user_data_dir ())
   :: List.map coqify (Glib.get_system_data_dirs ())
-  @ Option.List.cons Coq_config.datadir []
+  @ [Envars.datadir ()]
 
 let coqide_config_dirs () =
   coqide_config_home ()
   :: List.map coqify (Glib.get_system_config_dirs ())
-  @ Option.List.cons Coq_config.configdir []
+  @ [Envars.configdir ()]
 
 let is_prefix_of pre s =
   let i = ref 0 in
diff --git a/ide/minilib.mli b/ide/minilib.mli
index b7672c90..6cc36f5f 100644
--- a/ide/minilib.mli
+++ b/ide/minilib.mli
@@ -1,13 +1,15 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** 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
 
@@ -22,7 +24,8 @@ type level = [
 (** debug printing *)
 val debug : bool ref
 
-val log : ?level:level -> string -> unit
+val log_pp : ?level:level -> Pp.t -> unit
+val log    : ?level:level -> string        -> unit
 
 val coqide_config_home : unit -> string
 val coqide_config_dirs : unit -> string list
diff --git a/ide/nanoPG.ml b/ide/nanoPG.ml
index 93bdeb32..2be5dce4 100644
--- a/ide/nanoPG.ml
+++ b/ide/nanoPG.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Ideutils
diff --git a/ide/nanoPG.mli b/ide/nanoPG.mli
new file mode 100644
index 00000000..bc9b39d8
--- /dev/null
+++ b/ide/nanoPG.mli
@@ -0,0 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val get_documentation : unit -> string
+val init : GWindow.window -> Session.session Wg_Notebook.typed_notebook ->
+           GAction.action_group list -> unit
diff --git a/ide/preferences.ml b/ide/preferences.ml
index f0fd45d7..11aaf6e8 100644
--- a/ide/preferences.ml
+++ b/ide/preferences.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Configwin
@@ -73,8 +75,8 @@ end
 let stick (pref : 'a preference) (obj : #GObj.widget as 'obj)
   (cb : 'a -> unit) =
   let _ = cb pref#get in
-  let p_id = pref#connect#changed (fun v -> cb v) in
-  let _ = obj#misc#connect#destroy (fun () -> pref#connect#disconnect p_id) in
+  let p_id = pref#connect#changed ~callback:(fun v -> cb v) in
+  let _ = obj#misc#connect#destroy ~callback:(fun () -> pref#connect#disconnect p_id) in
   ()
 
 (** Useful marshallers *)
@@ -314,7 +316,7 @@ let attach_modifiers (pref : string preference) prefix =
     in
     GtkData.AccelMap.foreach change
   in
-  pref#connect#changed cb
+  pref#connect#changed ~callback:cb
 
 let modifier_for_navigation =
   new preference ~name:["modifier_for_navigation"] ~init:"<Control>" ~repr:Repr.(string)
@@ -360,7 +362,7 @@ object
     ~name:["doc_url"] ~init:Coq_config.wwwrefman ~repr:Repr.(string)
     as super
 
-  method set v =
+  method! set v =
     if not (Flags.is_standard_doc_url v) &&
       v <> use_default_doc_url &&
       (* Extra hack to support links to last released doc version *)
@@ -407,11 +409,15 @@ let opposite_tabs =
 let background_color =
   new preference ~name:["background_color"] ~init:"cornsilk" ~repr:Repr.(string)
 
+let attach_tag (pref : string preference) (tag : GText.tag) f =
+  tag#set_property (f pref#get);
+  pref#connect#changed ~callback:(fun c -> tag#set_property (f c))
+
 let attach_bg (pref : string preference) (tag : GText.tag) =
-  pref#connect#changed (fun c -> tag#set_property (`BACKGROUND c))
+  attach_tag pref tag (fun c -> `BACKGROUND c)
 
 let attach_fg (pref : string preference) (tag : GText.tag) =
-  pref#connect#changed (fun c -> tag#set_property (`FOREGROUND c))
+  attach_tag pref tag (fun c -> `FOREGROUND c)
 
 let processing_color =
   new preference ~name:["processing_color"] ~init:"light blue" ~repr:Repr.(string)
@@ -468,7 +474,7 @@ let create_tag name default =
   let iter table =
     let tag = GText.tag ~name () in
     table#add tag#as_tag;
-    ignore (pref#connect#changed (fun _ -> set_tag tag));
+    ignore (pref#connect#changed ~callback:(fun _ -> set_tag tag));
     set_tag tag;
   in
   List.iter iter [Tags.Script.table; Tags.Proof.table; Tags.Message.table];
@@ -601,8 +607,8 @@ object (self)
     box#pack italic#coerce;
     box#pack underline#coerce;
     let cb but obj = obj#set_sensitive (not but#active) in
-    let _ = fg_unset#connect#toggled (fun () -> cb fg_unset fg_color#misc) in
-    let _ = bg_unset#connect#toggled (fun () -> cb bg_unset bg_color#misc) in
+    let _ = fg_unset#connect#toggled ~callback:(fun () -> cb fg_unset fg_color#misc) in
+    let _ = bg_unset#connect#toggled ~callback:(fun () -> cb bg_unset bg_color#misc) in
     ()
 
 end
@@ -643,6 +649,10 @@ let pmodifiers ?(all = false) name p = modifiers
   name
   (str_to_mod_list p#get)
 
+[@@@ocaml.warning "-3"]       (* String.uppercase_ascii since 4.03.0 GPR#124 *)
+let uppercase = String.uppercase
+[@@@ocaml.warning "+3"]
+
 let configure ?(apply=(fun () -> ())) () =
   let cmd_coqtop =
     string
@@ -692,7 +702,7 @@ let configure ?(apply=(fun () -> ())) () =
         ~color:(Tags.color_of_string pref#get)
         ~packing:(table#attach ~left:1 ~top:i) ()
       in
-      let _ = button#connect#color_set begin fun () ->
+      let _ = button#connect#color_set ~callback:begin fun () ->
         pref#set (Tags.string_of_color button#color)
       end in
       let reset _ =
@@ -754,7 +764,7 @@ let configure ?(apply=(fun () -> ())) () =
     let button text (pref : bool preference) =
       let active = pref#get in
       let but = GButton.check_button ~label:text ~active ~packing:box#pack () in
-      ignore (but#connect#toggled (fun () -> pref#set but#active))
+      ignore (but#connect#toggled ~callback:(fun () -> pref#set but#active))
     in
     let () = button "Dynamic word wrap" dynamic_word_wrap in
     let () = button "Show line number" show_line_number in
@@ -918,7 +928,7 @@ let configure ?(apply=(fun () -> ())) () =
   in
   let doc_url =
     let predefined = [
-      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["refman";"html"]);
+      "file://"^(List.fold_left Filename.concat (Envars.docdir ()) ["refman";"html"]);
       Coq_config.wwwrefman;
       use_default_doc_url
     ] in
@@ -931,7 +941,7 @@ let configure ?(apply=(fun () -> ())) () =
       doc_url#get in
   let library_url =
     let predefined = [
-      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["stdlib";"html"]);
+      "file://"^(List.fold_left Filename.concat (Envars.docdir ()) ["stdlib";"html"]);
       Coq_config.wwwstdlib
     ] in
     combo
@@ -969,7 +979,7 @@ let configure ?(apply=(fun () -> ())) () =
     let k =
       if Int.equal (CString.length k) 1 && Util.is_letter k.[0] then k
       else "" in
-    let k = CString.uppercase k in
+    let k = uppercase k in
       [q, k]
   in
 
diff --git a/ide/preferences.mli b/ide/preferences.mli
index 801869d1..ccf028ae 100644
--- a/ide/preferences.mli
+++ b/ide/preferences.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val lang_manager : GSourceView2.source_language_manager
diff --git a/ide/project_file.ml4 b/ide/project_file.ml4
deleted file mode 100644
index de0720e0..00000000
--- a/ide/project_file.ml4
+++ /dev/null
@@ -1,202 +0,0 @@
-type target =
-  | ML of string (* ML file : foo.ml -> (ML "foo.ml") *)
-  | MLI of string (* MLI file : foo.mli -> (MLI "foo.mli") *)
-  | ML4 of string (* ML4 file : foo.ml4 -> (ML4 "foo.ml4") *)
-  | MLLIB of string (* MLLIB file : foo.mllib -> (MLLIB "foo.mllib") *)
-  | MLPACK of string (* MLLIB file : foo.mlpack -> (MLLIB "foo.mlpack") *)
-  | V of string  (* V file : foo.v -> (V "foo") *)
-  | Arg of string
-  | Special of string * string * bool * string
-    (* file, dependencies, is_phony, command *)
-  | Subdir of string
-  | Def of string * string (* X=foo -> Def ("X","foo") *)
-  | MLInclude of string (* -I physicalpath *)
-  | Include of string * string (* -Q physicalpath logicalpath *)
-  | RInclude of string * string (* -R physicalpath logicalpath *)
-
-type install =
-  | NoInstall
-  | TraditionalInstall
-  | UserInstall
-  | UnspecInstall
-
-exception Parsing_error
-let rec parse_string = parser
-  | [< '' ' | '\n' | '\t' >] -> ""
-  | [< 'c; s >] -> (String.make 1 c)^(parse_string s)
-  | [< >] -> ""
-and parse_string2 = parser
-  | [< ''"' >] -> ""
-  | [< 'c; s >] -> (String.make 1 c)^(parse_string2 s)
-  | [< >] -> raise Parsing_error
-and parse_skip_comment = parser
-  | [< ''\n'; s >] -> s
-  | [< 'c; s >] -> parse_skip_comment s
-  | [< >] -> [< >]
-and parse_args = parser
-  | [< '' ' | '\n' | '\t'; s >] -> parse_args s
-  | [< ''#'; s >] -> parse_args (parse_skip_comment s)
-  | [< ''"'; str = parse_string2; s >] -> ("" ^ str) :: parse_args s
-  | [< 'c; str = parse_string; s >] -> ((String.make 1 c) ^ str) :: (parse_args s)
-  | [< >] -> []
-
-
-let parse f =
-  let c = open_in f in
-  let res = parse_args (Stream.of_channel c) in
-    close_in c;
-    res
-
-let rec process_cmd_line orig_dir ((project_file,makefile,install,opt) as opts) l = function
-  | [] -> opts, l
-  | ("-h"|"--help") :: _ ->
-    raise Parsing_error
-  | ("-no-opt"|"-byte") :: r ->
-    process_cmd_line orig_dir (project_file,makefile,install,false) l r
-  | ("-full"|"-opt") :: r ->
-    process_cmd_line orig_dir (project_file,makefile,install,true) l r
-  | "-impredicative-set" :: r ->
-    Feedback.msg_warning (Pp.str "Please now use \"-arg -impredicative-set\" instead of \"-impredicative-set\" alone to be more uniform.");
-    process_cmd_line orig_dir opts (Arg "-impredicative-set" :: l) r
-  | "-no-install" :: r ->
-    Feedback.msg_warning (Pp.(++) (Pp.str "Option -no-install is deprecated.") (Pp.(++) (Pp.spc ()) (Pp.str "Use \"-install none\" instead")));
-    process_cmd_line orig_dir (project_file,makefile,NoInstall,opt) l r
-  | "-install" :: d :: r ->
-    if install <> UnspecInstall then Feedback.msg_warning (Pp.str "-install sets more than once.");
-    let install =
-      match d with
-	| "user" -> UserInstall
-	| "none" -> NoInstall
-	| "global" -> TraditionalInstall
-	| _ -> Feedback.msg_warning (Pp.(++) (Pp.str "invalid option '") (Pp.(++) (Pp.str d) (Pp.str "' passed to -install.")));
-          install
-    in
-    process_cmd_line orig_dir (project_file,makefile,install,opt) l r
-  | "-custom" :: com :: dependencies :: file :: r ->
-    Feedback.msg_warning (Pp.app
-    (Pp.str "Please now use \"-extra[-phony] result deps command\" instead of \"-custom command deps result\".")
-    (Pp.pr_arg Pp.str "It follows makefile target declaration order and has a clearer semantic.")
-    );
-    process_cmd_line orig_dir opts (Special (file,dependencies,false,com) :: l) r
-  | "-extra" :: file :: dependencies :: com :: r ->
-    process_cmd_line orig_dir opts (Special (file,dependencies,false,com) :: l) r
-  | "-extra-phony" :: target :: dependencies :: com :: r ->
-    process_cmd_line orig_dir opts (Special (target,dependencies,true,com) :: l) r
-  | "-Q" :: d :: lp :: r ->
-    process_cmd_line orig_dir opts ((Include (CUnix.correct_path d orig_dir, lp)) :: l) r
-  | "-I" :: d :: r ->
-    process_cmd_line orig_dir opts ((MLInclude (CUnix.correct_path d orig_dir)) :: l) r
-  | "-R" :: p :: lp :: r ->
-    process_cmd_line orig_dir opts (RInclude (CUnix.correct_path p orig_dir,lp) :: l) r
-  | ("-Q"|"-R"|"-I"|"-custom"|"-extra"|"-extra-phony") :: _ ->
-    raise Parsing_error
-  | "-f" :: file :: r ->
-    let file = CUnix.remove_path_dot (CUnix.correct_path file orig_dir) in
-    let () = match project_file with
-      | None -> ()
-      | Some _ -> Feedback.msg_warning (Pp.str
-	"Several features will not work with multiple project files.")
-    in
-    let (opts',l') = process_cmd_line (Filename.dirname file) (Some file,makefile,install,opt) l (parse file) in
-      process_cmd_line orig_dir opts' l' r
-  | ["-f"] ->
-    raise Parsing_error
-  | "-o" :: file :: r ->
-      begin try
-	let _ = String.index file '/' in
-	  raise Parsing_error
-      with Not_found ->
-	let () = match makefile with
-	  |None -> ()
-	  |Some f ->
-	     Feedback.msg_warning (Pp.(++) (Pp.str "Only one output file is genererated. ") (Pp.(++) (Pp.str f) (Pp.str " will not be.")))
-	in process_cmd_line orig_dir (project_file,Some file,install,opt) l r
-      end
-  | v :: "=" :: def :: r ->
-    process_cmd_line orig_dir opts (Def (v,def) :: l) r
-  | "-arg" :: a :: r ->
-    process_cmd_line orig_dir opts (Arg a :: l) r
-  | f :: r ->
-      let f = CUnix.correct_path f orig_dir in
-	process_cmd_line orig_dir opts ((
-          if Filename.check_suffix f ".v" then V f
-	  else if (Filename.check_suffix f ".ml") then ML f
-	  else if (Filename.check_suffix f ".ml4") then ML4 f
-	  else if (Filename.check_suffix f ".mli") then MLI f
-	  else if (Filename.check_suffix f ".mllib") then MLLIB f
-	  else if (Filename.check_suffix f ".mlpack") then MLPACK f
-	  else Subdir f) :: l) r
-
-let process_cmd_line orig_dir opts l args =
-  let (opts, l) = process_cmd_line orig_dir opts l args in
-  opts, List.rev l
-
-let rec post_canonize f =
-  if Filename.basename f = Filename.current_dir_name
-  then let dir = Filename.dirname f in
-    if dir = Filename.current_dir_name then f else post_canonize dir
-  else f
-
-(* Return: ((v,(mli,ml4,ml,mllib,mlpack),special,subdir),(ml_inc,q_inc,r_inc),(args,defs)) *)
-let split_arguments args =
-  List.fold_right
-    (fun a ((v,(mli,ml4,ml,mllib,mlpack as m),o,s as t),
-            (ml_inc,q_inc,r_inc as i),(args,defs as d)) ->
-     match a with
-     | V n ->
-        ((CUnix.remove_path_dot n::v,m,o,s),i,d)
-     | ML n ->
-        ((v,(mli,ml4,CUnix.remove_path_dot n::ml,mllib,mlpack),o,s),i,d)
-     | MLI n ->
-        ((v,(CUnix.remove_path_dot n::mli,ml4,ml,mllib,mlpack),o,s),i,d)
-     | ML4 n ->
-        ((v,(mli,CUnix.remove_path_dot n::ml4,ml,mllib,mlpack),o,s),i,d)
-     | MLLIB n ->
-        ((v,(mli,ml4,ml,CUnix.remove_path_dot n::mllib,mlpack),o,s),i,d)
-     | MLPACK n ->
-        ((v,(mli,ml4,ml,mllib,CUnix.remove_path_dot n::mlpack),o,s),i,d)
-     | Special (n,dep,is_phony,c) ->
-        ((v,m,(n,dep,is_phony,c)::o,s),i,d)
-     | Subdir n ->
-        ((v,m,o,n::s),i,d)
-     | MLInclude p ->
-        let ml_new = (CUnix.remove_path_dot (post_canonize p),
-                      CUnix.canonical_path_name p) in
-        (t,(ml_new::ml_inc,q_inc,r_inc),d)
-     | Include (p,l) ->
-        let q_new = (CUnix.remove_path_dot (post_canonize p),l,
-		     CUnix.canonical_path_name p) in
-        (t,(ml_inc,q_new::q_inc,r_inc),d)
-     | RInclude (p,l) ->
-        let r_new = (CUnix.remove_path_dot (post_canonize p),l,
-		     CUnix.canonical_path_name p) in
-        (t,(ml_inc,q_inc,r_new::r_inc),d)
-     | Def (v,def) ->
-        (t,i,(args,(v,def)::defs))
-     | Arg a ->
-        (t,i,(a::args,defs)))
-    args (([],([],[],[],[],[]),[],[]),([],[],[]),([],[]))
-
-let read_project_file f =
-  split_arguments
-    (snd (process_cmd_line (Filename.dirname f) (Some f, None, NoInstall, true) [] (parse f)))
-
-let args_from_project file project_files default_name =
-  let build_cmd_line ml_inc i_inc r_inc args =
-    List.fold_right (fun (_,i) o -> "-I" :: i :: o) ml_inc
-      (List.fold_right (fun (_,l,i) o -> "-Q" :: i :: l :: o) i_inc
-        (List.fold_right (fun (_,l,p) o -> "-R" :: p :: l :: o) r_inc
-	  (List.fold_right (fun a o -> parse_args (Stream.of_string a) @ o) args [])))
-  in try
-      let (fname,(_,(ml_inc,i_inc,r_inc),(args,_))) = List.hd project_files in
-	fname, build_cmd_line ml_inc i_inc r_inc args
-    with Failure _ ->
-      let rec find_project_file dir = try
-	let fname = Filename.concat dir default_name in
-	let ((v_files,_,_,_),(ml_inc,i_inc,r_inc),(args,_)) =
-          read_project_file fname in
-	fname, build_cmd_line ml_inc i_inc r_inc args
-      with Sys_error s ->
-	let newdir = Filename.dirname dir in
-	  if dir = newdir then "",[] else find_project_file newdir
-      in find_project_file (Filename.dirname file)
diff --git a/lib/richpp.ml b/ide/richpp.ml
index a98273ed..19e9799c 100644
--- a/lib/richpp.ml
+++ b/ide/richpp.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -24,10 +26,6 @@ type 'a context = {
   (** Pending opened nodes *)
   mutable offset : int;
   (** Quantity of characters printed so far *)
-  mutable annotations : 'a option Int.Map.t;
-  (** Map associating annotations to indexes *)
-  mutable index : int;
-  (** Current index of annotations *)
 }
 
 (** We use Format to introduce tags inside the pretty-printed document.
@@ -38,24 +36,14 @@ type 'a context = {
     marking functions. As those functions are called when actually writing to
     the device, the resulting tree is correct.
 *)
-let rich_pp annotate ppcmds =
+let rich_pp width ppcmds =
 
   let context = {
     stack = Leaf;
     offset = 0;
-    annotations = Int.Map.empty;
-    index = (-1);
   } in
 
-  let pp_tag obj =
-    let index = context.index + 1 in
-    let () = context.index <- index in
-    let obj = annotate obj in
-    let () = context.annotations <- Int.Map.add index obj context.annotations in
-    string_of_int index
-  in
-
-  let pp_buffer = Buffer.create 13 in
+  let pp_buffer = Buffer.create 180 in
 
   let push_pcdata () =
     (** Push the optional PCData on the above node *)
@@ -81,12 +69,8 @@ let rich_pp annotate ppcmds =
     | Leaf -> assert false
     | Node (node, child, pos, ctx) ->
       let () = assert (String.equal tag node) in
-      let annotation =
-        try Int.Map.find (int_of_string node) context.annotations
-        with _ -> None
-      in
       let annotation = {
-        annotation = annotation;
+        annotation = Some tag;
         startpos = pos;
         endpos = context.offset;
       } in
@@ -113,11 +97,20 @@ let rich_pp annotate ppcmds =
   pp_set_formatter_tag_functions ft tag_functions;
   pp_set_mark_tags ft true;
 
+  (* Setting the formatter *)
+  pp_set_margin ft width;
+  let m = max (64 * width / 100) (width-30) in
+  pp_set_max_indent ft m;
+  pp_set_max_boxes ft 50 ;
+  pp_set_ellipsis_text ft "...";
+
   (** The whole output must be a valid document. To that
       end, we nest the document inside <pp> tags. *)
+  pp_open_box ft 0;
   pp_open_tag ft "pp";
-  Pp.(pp_with ~pp_tag ft ppcmds);
+  Pp.(pp_with ft ppcmds);
   pp_close_tag ft ();
+  pp_close_box ft ();
 
   (** Get the resulting XML tree. *)
   let () = pp_print_flush ft () in
@@ -165,32 +158,14 @@ let xml_of_rich_pp tag_of_annotation attributes_of_annotation xml =
 
 type richpp = xml
 
-let repr xml = xml
-let richpp_of_xml xml = xml
-let richpp_of_string s = PCData s
-
-let richpp_of_pp pp =
-  let annotate t = match Pp.Tag.prj t Ppstyle.tag with
-  | None -> None
-  | Some key -> Some (Ppstyle.repr key)
-  in
+let richpp_of_pp width pp =
   let rec drop = function
   | PCData s -> [PCData s]
   | Element (_, annotation, cs) ->
     let cs = List.concat (List.map drop cs) in
     match annotation.annotation with
     | None -> cs
-    | Some s -> [Element (String.concat "." s, [], cs)]
+    | Some s -> [Element (s, [], cs)]
   in
-  let xml = rich_pp annotate pp in
+  let xml = rich_pp width pp in
   Element ("_", [], drop xml)
-
-let raw_print xml =
-  let buf = Buffer.create 1024 in
-  let rec print = function
-  | PCData s -> Buffer.add_string buf s
-  | Element (_, _, cs) -> List.iter print cs
-  in
-  let () = print xml in
-  Buffer.contents buf
-
diff --git a/lib/richpp.mli b/ide/richpp.mli
index 287d265a..31fc7b56 100644
--- a/lib/richpp.mli
+++ b/ide/richpp.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module offers semi-structured pretty-printing. *)
@@ -16,14 +18,15 @@ type 'annotation located = {
   endpos     : int
 }
 
-(** [rich_pp get_annotations ppcmds] returns the interpretation
+(* XXX: The width parameter should be moved to a `formatter_property`
+   record shared with Topfmt *)
+
+(** [rich_pp width ppcmds] returns the interpretation
     of [ppcmds] as a semi-structured document
     that represents (located) annotations of this string.
     The [get_annotations] function is used to convert tags into the desired
-    annotation. *)
-val rich_pp :
-  (Pp.Tag.t -> 'annotation option) -> Pp.std_ppcmds ->
-  'annotation located Xml_datatype.gxml
+    annotation. [width] sets the printing witdh of the formatter. *)
+val rich_pp : int -> Pp.t -> Pp.pp_tag located Xml_datatype.gxml
 
 (** [annotations_positions ssdoc] returns a list associating each
     annotations with its position in the string from which [ssdoc] is
@@ -42,23 +45,9 @@ val xml_of_rich_pp :
 
 (** {5 Enriched text} *)
 
-type richpp
+type richpp = Xml_datatype.xml
+
 (** Type of text with style annotations *)
 
-val richpp_of_pp : Pp.std_ppcmds -> richpp
+val richpp_of_pp : int -> Pp.t -> richpp
 (** Extract style information from formatted text *)
-
-val richpp_of_xml : Xml_datatype.xml -> richpp
-(** Do not use outside of dedicated areas *)
-
-val richpp_of_string : string -> richpp
-(** Make a styled text out of a normal string *)
-
-val repr : richpp -> Xml_datatype.xml
-(** Observe the styled text as XML *)
-
-(** {5 Debug/Compat} *)
-
-(** Represent the semi-structured document as a string, dropping any additional
-    information. *)
-val raw_print : richpp -> string
diff --git a/ide/richprinter.ml b/ide/richprinter.ml
deleted file mode 100644
index 5f39f36e..00000000
--- a/ide/richprinter.ml
+++ /dev/null
@@ -1,24 +0,0 @@
-open Richpp
-
-module RichppConstr = Ppconstr.Richpp
-module RichppVernac = Ppvernac.Richpp
-module RichppTactic = Pptactic.Richpp
-
-type rich_pp =
-    Ppannotation.t Richpp.located Xml_datatype.gxml
-    * Xml_datatype.xml
-
-let get_annotations obj = Pp.Tag.prj obj Ppannotation.tag
-
-let make_richpp pr ast =
-  let rich_pp =
-    rich_pp get_annotations (pr ast)
-  in
-  let xml = Ppannotation.(
-    xml_of_rich_pp tag_of_annotation attributes_of_annotation rich_pp
-  )
-  in
-  (rich_pp, xml)
-
-let richpp_vernac = make_richpp RichppVernac.pr_vernac
-let richpp_constr = make_richpp RichppConstr.pr_constr_expr
diff --git a/ide/richprinter.mli b/ide/richprinter.mli
deleted file mode 100644
index c9e84e3e..00000000
--- a/ide/richprinter.mli
+++ /dev/null
@@ -1,36 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** This module provides an entry point to "rich" pretty-printers that
-    produce pretty-printing as done by {!Printer} but with additional
-    annotations represented as a semi-structured document.
-
-    To understand what are these annotations and how they are represented
-    as standard XML attributes, please refer to {!Ppannotation}.
-
-    In addition to these annotations, each node of the semi-structured
-    document contains a [startpos] and an [endpos] attribute that
-    relate this node to the raw pretty-printing.
-    Please refer to {!Richpp} for more details. *)
-
-(** A rich pretty-print is composed of: *)
-type rich_pp =
-
-    (** - a generalized semi-structured document whose attributes are
-        annotations ; *)
-    Ppannotation.t Richpp.located Xml_datatype.gxml
-
-    (** - an XML document, representing annotations as usual textual
-        XML attributes. *)
-    * Xml_datatype.xml
-
-(** [richpp_vernac phrase] produces a rich pretty-printing of [phrase]. *)
-val richpp_vernac : Vernacexpr.vernac_expr -> rich_pp
-
-(** [richpp_constr constr] produces a rich pretty-printing of [constr]. *)
-val richpp_constr : Constrexpr.constr_expr -> rich_pp
diff --git a/ide/sentence.ml b/ide/sentence.ml
index e332682d..2f7820a7 100644
--- a/ide/sentence.ml
+++ b/ide/sentence.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {1 Sentences in coqide buffers } *)
diff --git a/ide/sentence.mli b/ide/sentence.mli
index feb3c0ac..75c815c5 100644
--- a/ide/sentence.mli
+++ b/ide/sentence.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Retag the ends of sentences around an inserted zone *)
diff --git a/ide/serialize.ml b/ide/serialize.ml
index 7b568501..86074d44 100644
--- a/ide/serialize.ml
+++ b/ide/serialize.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Xml_datatype
diff --git a/ide/serialize.mli b/ide/serialize.mli
index bf9e184e..af082f25 100644
--- a/ide/serialize.mli
+++ b/ide/serialize.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Xml_datatype
diff --git a/ide/session.ml b/ide/session.ml
index fc6340d2..be2bfe06 100644
--- a/ide/session.ml
+++ b/ide/session.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Preferences
@@ -31,7 +33,7 @@ type session = {
   buffer : GText.buffer;
   script : Wg_ScriptView.script_view;
   proof : Wg_ProofView.proof_view;
-  messages : Wg_MessageView.message_view;
+  messages : Wg_RoutedMessageViews.message_views_router;
   segment : Wg_Segment.segment;
   fileops : FileOps.ops;
   coqops : CoqOps.ops;
@@ -209,10 +211,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")
@@ -249,8 +248,8 @@ let make_table_widget ?sort cd cb =
   let () = data#set_headers_visible true in
   let () = data#set_headers_clickable true in
   let refresh clr = data#misc#modify_base [`NORMAL, `NAME clr] in
-  let _ = background_color#connect#changed refresh in
-  let _ = data#misc#connect#realize (fun () -> refresh background_color#get) in
+  let _ = background_color#connect#changed ~callback:refresh in
+  let _ = data#misc#connect#realize ~callback:(fun () -> refresh background_color#get) in
   let mk_rend c = GTree.cell_renderer_text [], ["text",c] in
   let cols =
     List.map2 (fun (_,c) (_,n,v) ->
@@ -308,8 +307,8 @@ let create_errpage (script : Wg_ScriptView.script_view) : errpage =
         !callback errs;
 	List.iter (fun (lno, msg) -> access (fun columns store ->
           let line = store#append () in
-          store#set line (find_int_col "Line" columns) lno;
-          store#set line (find_string_col "Error message" columns) msg))
+          store#set ~row:line ~column:(find_int_col "Line" columns) lno;
+          store#set ~row:line ~column:(find_string_col "Error message" columns) msg))
           errs
       end
     method on_update ~callback:cb = callback := cb
@@ -348,8 +347,8 @@ let create_jobpage coqtop coqops : jobpage =
               else false)
           else
             let line = store#append () in
-            store#set line column id;
-            store#set line (find_string_col "Job name" columns) job))
+            store#set ~row:line ~column id;
+            store#set ~row:line ~column:(find_string_col "Job name" columns) job))
           jobs
       end
     method on_update ~callback:cb = callback := cb
@@ -367,7 +366,7 @@ let create_proof () =
 let create_messages () =
   let messages = Wg_MessageView.message_view () in
   let _ = messages#misc#set_can_focus true in
-  messages
+  Wg_RoutedMessageViews.message_views ~route_0:messages
 
 let dummy_control : control =
   object
@@ -386,12 +385,12 @@ let create file coqtop_args =
   let proof = create_proof () in
   let messages = create_messages () in
   let segment = new Wg_Segment.segment () in
-  let command = new Wg_Command.command_window basename coqtop in
   let finder = new Wg_Find.finder basename (script :> GText.view) in
   let fops = new FileOps.fileops (buffer :> GText.buffer) file reset in
   let _ = fops#update_stats in
   let cops =
     new CoqOps.coqops script proof messages segment coqtop (fun () -> fops#filename) in
+  let command = new Wg_Command.command_window basename coqtop cops messages in
   let errpage = create_errpage script in
   let jobpage = create_jobpage coqtop cops in
   let _ = set_buffer_handlers (buffer :> GText.buffer) script cops coqtop in
@@ -512,12 +511,12 @@ let build_layout (sn:session) =
   sn.command#pack_in (session_paned#pack2 ~shrink:false ~resize:false);
   script_scroll#add sn.script#coerce;
   proof_scroll#add sn.proof#coerce;
-  let detach, _ = add_msg_page 0 sn.tab_label#text "Messages" sn.messages#coerce in
+  let detach, _ = add_msg_page 0 sn.tab_label#text "Messages" sn.messages#default_route#coerce in
   let _, label = add_msg_page 1 sn.tab_label#text "Errors" sn.errpage#coerce in
   let _, _ = add_msg_page 2 sn.tab_label#text "Jobs" sn.jobpage#coerce in
   (** When a message is received, focus on the message pane *)
   let _ =
-    sn.messages#connect#pushed ~callback:(fun _ _ ->
+    sn.messages#default_route#connect#pushed ~callback:(fun _ _ ->
       let num = message_frame#page_num detach#coerce in
       if 0 <= num then message_frame#goto_page num
     )
diff --git a/ide/session.mli b/ide/session.mli
index 028a1f9d..bb381690 100644
--- a/ide/session.mli
+++ b/ide/session.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** A session is a script buffer + proof + messages,
@@ -29,7 +31,7 @@ type session = {
   buffer : GText.buffer;
   script : Wg_ScriptView.script_view;
   proof : Wg_ProofView.proof_view;
-  messages : Wg_MessageView.message_view;
+  messages : Wg_RoutedMessageViews.message_views_router;
   segment : Wg_Segment.segment;
   fileops : FileOps.ops;
   coqops : CoqOps.ops;
diff --git a/ide/tags.ml b/ide/tags.ml
index e4510e7a..60195e8a 100644
--- a/ide/tags.ml
+++ b/ide/tags.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
@@ -15,33 +17,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 02e15a5a..3194f879 100644
--- a/ide/tags.mli
+++ b/ide/tags.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module Script :
@@ -17,7 +19,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/texmacspp.ml b/ide/texmacspp.ml
deleted file mode 100644
index 680da7f5..00000000
--- a/ide/texmacspp.ml
+++ /dev/null
@@ -1,768 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Xml_datatype
-open Vernacexpr
-open Constrexpr
-open Names
-open Misctypes
-open Bigint
-open Decl_kinds
-open Extend
-open Libnames
-
-let unlock loc =
-  let start, stop = Loc.unloc loc in
-  (string_of_int start, string_of_int stop)
-
-let xmlWithLoc loc ename attr xml =
-  let start, stop = unlock loc in
-  Element(ename, [ "begin", start; "end", stop ] @ attr, xml)
-
-let get_fst_attr_in_xml_list attr xml_list =
-  let attrs_list =
-    List.map (function
-      | Element (_, attrs, _) -> (List.filter (fun (a,_) -> a = attr) attrs)
-      | _ -> [])
-    xml_list in
-  match List.flatten attrs_list with
-  | [] -> (attr, "")
-  | l  -> (List.hd l)
-
-let backstep_loc xmllist =
-  let start_att = get_fst_attr_in_xml_list "begin" xmllist in
-  let stop_att =  get_fst_attr_in_xml_list "end" (List.rev xmllist) in
-  [start_att ; stop_att]
-
-let compare_begin_att xml1 xml2 =
-  let att1 = get_fst_attr_in_xml_list "begin" [xml1] in
-  let att2 = get_fst_attr_in_xml_list "begin" [xml2] in
-  match att1, att2 with
-  | (_, s1), (_, s2) when s1 == "" || s2 == "" -> 0
-  | (_, s1), (_, s2) when int_of_string s1 > int_of_string s2 -> 1
-  | (_, s1), (_, s2) when int_of_string s1 < int_of_string s2 -> -1
-  | _ -> 0
-
-let xmlBeginSection loc name = xmlWithLoc loc "beginsection" ["name", name] []
-
-let xmlEndSegment loc name = xmlWithLoc loc "endsegment" ["name", name] []
-
-let xmlThm typ name loc xml =
-  xmlWithLoc loc "theorem" ["type", typ; "name", name] xml
-
-let xmlDef typ name loc xml =
-  xmlWithLoc loc "definition" ["type", typ; "name", name] xml
-
-let xmlNotation attr name loc xml =
-  xmlWithLoc loc "notation" (("name", name) :: attr) xml
-
-let xmlReservedNotation attr name loc =
-  xmlWithLoc loc "reservednotation" (("name", name) :: attr) []
-
-let xmlCst name ?(attr=[]) loc =
-  xmlWithLoc loc "constant" (("name", name) :: attr) []
-
-let xmlOperator name ?(attr=[]) ?(pprules=[]) loc =
-  xmlWithLoc loc "operator"
-    (("name", name) :: List.map (fun (a,b) -> "format"^a,b) pprules @ attr) []
-
-let xmlApply loc ?(attr=[]) xml = xmlWithLoc loc "apply" attr xml
-
-let xmlToken loc ?(attr=[]) xml = xmlWithLoc loc "token" attr xml
-
-let xmlTyped xml = Element("typed", (backstep_loc xml), xml)
-
-let xmlReturn ?(attr=[]) xml = Element("return", attr, xml)
-
-let xmlCase xml = Element("case", [], xml)
-
-let xmlScrutinee ?(attr=[]) xml = Element("scrutinee", attr, xml)
-
-let xmlWith xml = Element("with", [], xml)
-
-let xmlAssign id xml = Element("assign", ["target",string_of_id id], [xml])
-
-let xmlInductive kind loc xml = xmlWithLoc loc "inductive" ["kind",kind] xml
-
-let xmlCoFixpoint xml = Element("cofixpoint", [], xml)
-
-let xmlFixpoint xml = Element("fixpoint", [], xml)
-
-let xmlCheck loc xml = xmlWithLoc loc "check" [] xml
-
-let xmlAssumption kind loc xml = xmlWithLoc loc "assumption" ["kind",kind] xml
-
-let xmlComment loc xml = xmlWithLoc loc "comment" [] xml
-
-let xmlCanonicalStructure attr loc = xmlWithLoc loc "canonicalstructure" attr []
-
-let xmlQed ?(attr=[]) loc = xmlWithLoc loc "qed" attr []
-
-let xmlPatvar id loc = xmlWithLoc loc "patvar" ["id", id] []
-
-let xmlReference ref =
-  let name = Libnames.string_of_reference ref in
-  let i, j = Loc.unloc (Libnames.loc_of_reference ref) in
-  let b, e = string_of_int i, string_of_int j in
-  Element("reference",["name", name; "begin", b; "end", e] ,[])
-
-let xmlRequire loc ?(attr=[]) xml = xmlWithLoc loc "require" attr xml
-let xmlImport loc ?(attr=[]) xml = xmlWithLoc loc "import" attr xml
-
-let xmlAddLoadPath loc ?(attr=[]) xml = xmlWithLoc loc "addloadpath" attr xml
-let xmlRemoveLoadPath loc ?(attr=[]) = xmlWithLoc loc "removeloadpath" attr
-let xmlAddMLPath loc ?(attr=[]) = xmlWithLoc loc "addmlpath" attr
-
-let xmlExtend loc xml = xmlWithLoc loc "extend" [] xml
-
-let xmlScope loc action ?(attr=[]) name xml =
-  xmlWithLoc loc "scope" (["name",name;"action",action] @ attr) xml
-
-let xmlProofMode loc name = xmlWithLoc loc "proofmode" ["name",name] []
-
-let xmlProof loc xml = xmlWithLoc loc "proof" [] xml
-
-let xmlRawTactic name rtac =
-  Element("rawtactic", ["name",name],
-    [PCData (Pp.string_of_ppcmds (Pptactic.pr_raw_tactic rtac))])
-
-let xmlSectionSubsetDescr name ssd =
-  Element("sectionsubsetdescr",["name",name],
-    [PCData (Proof_using.to_string ssd)])
-
-let xmlDeclareMLModule loc s =
-  xmlWithLoc loc "declarexmlmodule" []
-    (List.map (fun x -> Element("path",["value",x],[])) s)
-
-(* tactics *)
-let xmlLtac loc xml = xmlWithLoc loc "ltac" [] xml
-
-(* toplevel commands *)
-let xmlGallina loc xml = xmlWithLoc loc "gallina" [] xml
-
-let xmlTODO loc x =
-  xmlWithLoc loc "todo" [] [PCData (Pp.string_of_ppcmds (Ppvernac.pr_vernac x))]
-
-let string_of_name n =
-  match n with
-  | Anonymous -> "_"
-  | Name id -> Id.to_string id
-
-let string_of_glob_sort s =
-  match s with
-  | GProp -> "Prop"
-  | GSet -> "Set"
-  | GType _ -> "Type"
-
-let string_of_cast_sort c =
-  match c with
-  | CastConv _ -> "CastConv"
-  | CastVM _ -> "CastVM"
-  | CastNative _ -> "CastNative"
-  | CastCoerce -> "CastCoerce"
-
-let string_of_case_style s =
-  match s with
-  | LetStyle -> "Let"
-  | IfStyle -> "If"
-  | LetPatternStyle -> "LetPattern"
-  | MatchStyle -> "Match"
-  | RegularStyle -> "Regular"
-
-let attribute_of_syntax_modifier sm =
-match sm with
-  | SetItemLevel (sl, NumLevel n) ->
-      List.map (fun s -> ("itemlevel", s)) sl @ ["level", string_of_int n]
-  | SetItemLevel (sl, NextLevel) ->
-      List.map (fun s -> ("itemlevel", s)) sl @ ["level", "next"]
-  | SetLevel i -> ["level", string_of_int i]
-  | SetAssoc a ->
-      begin match a with
-      | NonA -> ["",""]
-      | RightA -> ["associativity", "right"]
-      | LeftA -> ["associativity", "left"]
-      end
-  | SetEntryType (s, _) -> ["entrytype", s]
-  | SetOnlyPrinting -> ["onlyprinting", ""]
-  | SetOnlyParsing -> ["onlyparsing", ""]
-  | SetCompatVersion v -> ["compat", Flags.pr_version v]
-  | SetFormat (system, (loc, s)) ->
-      let start, stop = unlock loc in
-      ["format-"^system, s; "begin", start; "end", stop]
-
-let string_of_assumption_kind l a many =
-  match l, a, many with
-  | (Discharge, Logical,      true)  -> "Hypotheses"
-  | (Discharge, Logical,      false) -> "Hypothesis"
-  | (Discharge, Definitional, true)  -> "Variables"
-  | (Discharge, Definitional, false) -> "Variable"
-  | (Global,    Logical,      true)  -> "Axioms"
-  | (Global,    Logical,      false) -> "Axiom"
-  | (Global,    Definitional, true)  -> "Parameters"
-  | (Global,    Definitional, false) -> "Parameter"
-  | (Local,     Logical,      true)  -> "Local Axioms"
-  | (Local,     Logical,      false) -> "Local Axiom"
-  | (Local,     Definitional, true)  -> "Local Parameters"
-  | (Local,     Definitional, false) -> "Local Parameter"
-  | (Global,    Conjectural, _)      -> "Conjecture"
-  | ((Discharge | Local), Conjectural, _) -> assert false
-
-let rec pp_bindlist bl =
-  let tlist =
-    List.flatten
-        (List.map
-          (fun (loc_names, _, e) ->
-            let names =
-              (List.map
-                (fun (loc, name) ->
-                  xmlCst (string_of_name name) loc) loc_names) in
-            match e with
-              | CHole _ -> names
-              | _ -> names @ [pp_expr e])
-          bl) in
-  match tlist with
-    | [e] -> e
-    | l -> xmlTyped l
-and pp_decl_notation ((_, s), ce, sc) = (* don't know what it is for now *)
-  Element ("decl_notation", ["name", s], [pp_expr ce])
-and pp_local_binder lb = (* don't know what it is for now *)
-  match lb with
-  | LocalRawDef ((_, nam), ce) ->
-      let attrs = ["name", string_of_name nam] in
-      pp_expr ~attr:attrs ce
-  | LocalRawAssum (namll, _, ce) ->
-      let ppl =
-        List.map (fun (loc, nam) -> (xmlCst (string_of_name nam) loc)) namll in
-      xmlTyped (ppl @ [pp_expr ce])
-  | LocalPattern _ ->
-      assert false
-and pp_local_decl_expr lde = (* don't know what it is for now *)
-  match lde with
-  | AssumExpr (_, ce) -> pp_expr ce
-  | DefExpr (_, ce, _) -> pp_expr ce
-and pp_inductive_expr ((_, ((l, id),_)), lbl, ceo, _, cl_or_rdexpr) =
-  (* inductive_expr *)
-  let b,e = Loc.unloc l in
-  let location = ["begin", string_of_int b; "end", string_of_int e] in
-  [Element ("lident", ["name", Id.to_string id] @ location, [])] @ (* inductive name *)
-  begin match cl_or_rdexpr with
-  | Constructors coel -> List.map (fun (_, (_, ce)) -> pp_expr ce) coel
-  | RecordDecl (_, ldewwwl) ->
-      List.map (fun (((_, x), _), _) -> pp_local_decl_expr x) ldewwwl
-  end @
-  begin match ceo with (* don't know what it is for now *)
-  | Some ce -> [pp_expr ce]
-  | None -> []
-  end @
-  (List.map pp_local_binder lbl)
-and pp_recursion_order_expr optid roe = (* don't know what it is for now *)
-  let attrs =
-    match optid with
-    | None -> []
-    | Some (loc, id) ->
-        let start, stop = unlock loc in
-        ["begin", start; "end", stop ; "name", Id.to_string id] in
-  let kind, expr =
-    match roe with
-    | CStructRec -> "struct", []
-    | CWfRec e -> "rec", [pp_expr e]
-    | CMeasureRec (e, None) -> "mesrec", [pp_expr e]
-    | CMeasureRec (e, Some rel) -> "mesrec", [pp_expr e] @ [pp_expr rel] in
-  Element ("recursion_order", ["kind", kind] @ attrs, expr)
-and pp_fixpoint_expr (((loc, id), pl), (optid, roe), lbl, ce, ceo) =
-  (* fixpoint_expr *)
-  let start, stop = unlock loc in
-  let id = Id.to_string id in
-  [Element ("lident", ["begin", start; "end", stop ; "name", id], [])] @
-  (* fixpoint name *)
-  [pp_recursion_order_expr optid roe] @
-  (List.map pp_local_binder lbl) @
-  [pp_expr ce] @
-  begin match ceo with (* don't know what it is for now *)
-  | Some ce -> [pp_expr ce]
-  | None -> []
-  end
-and pp_cofixpoint_expr (((loc, id), pl), lbl, ce, ceo) = (* cofixpoint_expr *)
-  (* Nota: it is like fixpoint_expr without (optid, roe)
-   * so could be merged if there is no more differences *)
-  let start, stop = unlock loc in
-  let id = Id.to_string id in
-  [Element ("lident", ["begin", start; "end", stop ; "name", id], [])] @
-  (* cofixpoint name *)
-  (List.map pp_local_binder lbl) @
-  [pp_expr ce] @
-  begin match ceo with (* don't know what it is for now *)
-  | Some ce -> [pp_expr ce]
-  | None -> []
-  end
-and pp_lident (loc, id) = xmlCst (Id.to_string id) loc
-and pp_simple_binder (idl, ce) = List.map pp_lident idl @ [pp_expr ce]
-and pp_cases_pattern_expr cpe =
-  match cpe with
-  | CPatAlias (loc, cpe, id) ->
-      xmlApply loc
-        (xmlOperator "alias" ~attr:["name", string_of_id id] loc ::
-          [pp_cases_pattern_expr cpe])
-  | CPatCstr (loc, ref, None, cpel2) ->
-      xmlApply loc
-        (xmlOperator "reference"
-           ~attr:["name", Libnames.string_of_reference ref] loc ::
-         [Element ("impargs", [], []);
-          Element ("args", [], (List.map pp_cases_pattern_expr cpel2))])
-  | CPatCstr (loc, ref, Some cpel1, cpel2) ->
-      xmlApply loc
-        (xmlOperator "reference"
-           ~attr:["name", Libnames.string_of_reference ref] loc ::
-         [Element ("impargs", [], (List.map pp_cases_pattern_expr cpel1));
-          Element ("args", [], (List.map pp_cases_pattern_expr cpel2))])
-  | CPatAtom (loc, optr) ->
-      let attrs = match optr with
-        | None -> []
-        | Some r -> ["name", Libnames.string_of_reference r] in
-      xmlApply loc (xmlOperator "atom" ~attr:attrs loc :: [])
-  | CPatOr (loc, cpel) ->
-      xmlApply loc (xmlOperator "or" loc :: List.map pp_cases_pattern_expr cpel)
-  | CPatNotation (loc, n, (subst_constr, subst_rec), cpel) ->
-      xmlApply loc
-        (xmlOperator "notation" loc ::
-          [xmlOperator n loc;
-           Element ("subst", [],
-             [Element ("subterms", [],
-                List.map pp_cases_pattern_expr subst_constr);
-              Element ("recsubterms", [],
-                List.map
-                  (fun (cpel) ->
-                     Element ("recsubterm", [],
-                       List.map pp_cases_pattern_expr cpel))
-                subst_rec)]);
-           Element ("args", [], (List.map pp_cases_pattern_expr cpel))])
-  | CPatPrim (loc, tok) -> pp_token loc tok
-  | CPatRecord (loc, rcl) ->
-      xmlApply loc
-        (xmlOperator "record" loc ::
-           List.map (fun (r, cpe) ->
-             Element ("field",
-               ["reference", Libnames.string_of_reference r],
-               [pp_cases_pattern_expr cpe]))
-           rcl)
-  | CPatDelimiters (loc, delim, cpe) ->
-      xmlApply loc
-        (xmlOperator "delimiter" ~attr:["name", delim] loc ::
-          [pp_cases_pattern_expr cpe])
-  | CPatCast _ -> assert false
-and pp_case_expr (e, name, pat) =
-  match name, pat with
-  | None, None -> xmlScrutinee [pp_expr e]
-  | Some (loc, name), None ->
-      let start, stop= unlock loc in
-      xmlScrutinee ~attr:["name", string_of_name name;
-                          "begin", start; "end", stop] [pp_expr e]
-  | Some (loc, name), Some p ->
-      let start, stop= unlock loc in
-      xmlScrutinee ~attr:["name", string_of_name name;
-                          "begin", start; "end", stop]
-        [Element ("in", [], [pp_cases_pattern_expr p]) ; pp_expr e]
-  | None, Some p ->
-      xmlScrutinee [Element ("in", [], [pp_cases_pattern_expr p]) ; pp_expr e]
-and pp_branch_expr_list bel =
-  xmlWith
-    (List.map
-      (fun (_, cpel, e) ->
-        let ppcepl =
-          List.map pp_cases_pattern_expr (List.flatten (List.map snd cpel)) in
-        let ppe = [pp_expr e] in
-        xmlCase (ppcepl @ ppe))
-     bel)
-and pp_token loc tok =
-  let tokstr =
-    match tok with
-    | String s -> PCData s
-    | Numeral n -> PCData (to_string n) in
-  xmlToken loc [tokstr]
-and pp_local_binder_list lbl =
-  let l = (List.map pp_local_binder lbl) in
-  Element ("recurse", (backstep_loc l), l)
-and pp_const_expr_list cel =
-  let l = List.map pp_expr cel in
-  Element ("recurse", (backstep_loc l), l)
-and pp_expr ?(attr=[]) e =
-  match e with
-  | CRef (r, _) ->
-      xmlCst ~attr
-        (Libnames.string_of_reference r) (Libnames.loc_of_reference r)
-  | CProdN (loc, bl, e) ->
-      xmlApply loc
-        (xmlOperator "forall" loc :: [pp_bindlist bl] @ [pp_expr e])
-  | CApp (loc, (_, hd), args) ->
-       xmlApply ~attr loc (pp_expr hd :: List.map (fun (e,_) -> pp_expr e) args)
-  | CAppExpl (loc, (_, r, _), args) ->
-       xmlApply ~attr loc
-         (xmlCst (Libnames.string_of_reference r)
-                 (Libnames.loc_of_reference r) :: List.map pp_expr args)
-  | CNotation (loc, notation,  ([],[],[])) ->
-       xmlOperator notation loc
-  | CNotation (loc, notation,  (args, cell, lbll)) ->
-      let fmts = Notation.find_notation_extra_printing_rules notation in
-      let oper = xmlOperator notation loc ~pprules:fmts in
-      let cels = List.map pp_const_expr_list cell in
-      let lbls = List.map pp_local_binder_list lbll in
-      let args = List.map pp_expr args in
-      xmlApply loc (oper :: (List.sort compare_begin_att (args @ cels @ lbls)))
-  | CSort(loc, s) ->
-      xmlOperator (string_of_glob_sort s) loc
-  | CDelimiters (loc, scope, ce) ->
-      xmlApply loc (xmlOperator "delimiter" ~attr:["name", scope] loc ::
-        [pp_expr ce])
-  | CPrim (loc, tok) -> pp_token loc tok
-  | CGeneralization (loc, kind, _, e) ->
-      let kind= match kind with
-      | Explicit -> "explicit"
-      | Implicit -> "implicit" in
-      xmlApply loc
-        (xmlOperator "generalization" ~attr:["kind", kind] loc :: [pp_expr e])
-  | CCast (loc, e, tc) ->
-      begin match tc with
-      | CastConv t | CastVM t |CastNative t ->
-          xmlApply loc
-            (xmlOperator ":" loc ~attr:["kind", (string_of_cast_sort tc)] ::
-             [pp_expr e; pp_expr t])
-      | CastCoerce   ->
-          xmlApply loc
-            (xmlOperator ":" loc ~attr:["kind", "CastCoerce"] ::
-             [pp_expr e])
-      end
-  | CEvar (loc, ek, cel) ->
-      let ppcel = List.map (fun (id,e) -> xmlAssign id (pp_expr e)) cel in
-      xmlApply loc
-        (xmlOperator "evar" loc ~attr:["id", string_of_id ek] ::
-          ppcel)
-  | CPatVar (loc, id) -> xmlPatvar (string_of_id id) loc
-  | CHole (loc, _, _, _) -> xmlCst ~attr  "_" loc
-  | CIf (loc, test, (_, ret), th, el) ->
-      let return = match ret with
-      | None -> []
-      | Some r -> [xmlReturn [pp_expr r]] in
-      xmlApply loc
-        (xmlOperator "if" loc ::
-          return @ [pp_expr th] @ [pp_expr el])
-  | CLetTuple (loc, names, (_, ret), value, body) ->
-      let return = match ret with
-      | None -> []
-      | Some r -> [xmlReturn [pp_expr r]] in
-      xmlApply loc
-        (xmlOperator "lettuple" loc ::
-          return @
-          (List.map (fun (loc, var) -> xmlCst (string_of_name var) loc) names) @
-          [pp_expr value; pp_expr body])
-  | CCases (loc, sty, ret, cel, bel) ->
-      let return = match ret with
-      | None -> []
-      | Some r -> [xmlReturn [pp_expr r]] in
-      xmlApply loc
-        (xmlOperator "match" loc  ~attr:["style", (string_of_case_style sty)] ::
-          (return @
-           [Element ("scrutinees", [], List.map pp_case_expr cel)] @
-           [pp_branch_expr_list bel]))
-  | CRecord (_, _) -> assert false
-  | CLetIn (loc, (varloc, var), value, body) ->
-      xmlApply loc
-        (xmlOperator "let" loc ::
-         [xmlCst (string_of_name var) varloc; pp_expr value; pp_expr body])
-  | CLambdaN (loc, bl, e) ->
-      xmlApply loc
-        (xmlOperator "lambda" loc :: [pp_bindlist bl] @ [pp_expr e])
-  | CCoFix (_, _, _) -> assert false
-  | CFix (loc, lid, fel) ->
-      xmlApply loc
-        (xmlOperator "fix" loc ::
-           List.flatten (List.map
-             (fun (a,b,cl,c,d) -> pp_fixpoint_expr ((a,None),b,cl,c,Some d))
-             fel))
-
-let pp_comment (c) =
-  match c with
-  | CommentConstr e -> [pp_expr e]
-  | CommentString s -> [Element ("string", [], [PCData s])]
-  | CommentInt i -> [PCData (string_of_int i)]
-
-let rec tmpp v loc =
-  match v with
-  (* Control *)
-  | VernacLoad (verbose,f) ->
-      xmlWithLoc loc "load" ["verbose",string_of_bool verbose;"file",f] []
-  | VernacTime (loc,e) ->
-      xmlApply loc (Element("time",[],[]) ::
-                    [tmpp e loc])
-  | VernacRedirect (s, (loc,e)) ->
-      xmlApply loc (Element("redirect",["path", s],[]) ::
-                    [tmpp e loc])
-  | VernacTimeout (s,e) ->
-      xmlApply loc (Element("timeout",["val",string_of_int s],[]) ::
-                    [tmpp e loc])
-  | VernacFail e -> xmlApply loc (Element("fail",[],[]) :: [tmpp e loc])
-  | VernacError _ -> xmlWithLoc loc "error" [] []
-
-  (* Syntax *)
-  | VernacSyntaxExtension (_, ((_, name), sml)) ->
-      let attrs = List.flatten (List.map attribute_of_syntax_modifier sml) in
-      xmlReservedNotation attrs name loc
-
-  | VernacOpenCloseScope (_,(true,name)) -> xmlScope loc "open" name []
-  | VernacOpenCloseScope (_,(false,name)) -> xmlScope loc "close" name []
-  | VernacDelimiters (name,Some tag) ->
-      xmlScope loc "delimit" name ~attr:["delimiter",tag] []
-  | VernacDelimiters (name,None) ->
-      xmlScope loc "undelimit" name ~attr:[] []
-  | VernacInfix (_,((_,name),sml),ce,sn) ->
-      let attrs = List.flatten (List.map attribute_of_syntax_modifier sml) in
-      let sc_attr =
-        match sn with
-        | Some scope -> ["scope", scope]
-        | None -> [] in
-      xmlNotation (sc_attr @ attrs) name loc [pp_expr ce]
-  | VernacNotation (_, ce, (lstr, sml), sn) ->
-      let name = snd lstr in
-      let attrs = List.flatten (List.map attribute_of_syntax_modifier sml) in
-      let sc_attr =
-        match sn with
-        | Some scope -> ["scope", scope]
-        | None -> [] in
-      xmlNotation (sc_attr @ attrs) name loc [pp_expr ce]
-  | VernacBindScope _ as x -> xmlTODO loc x
-  | VernacNotationAddFormat _ as x -> xmlTODO loc x
-  | VernacUniverse _
-  | VernacConstraint _
-  | VernacPolymorphic (_, _) as x -> xmlTODO loc x
-  (* Gallina *)
-  | VernacDefinition (ldk, ((_,id),_), de) ->
-      let l, dk =
-        match ldk with
-        | Some l, dk -> (l, dk)
-        | None, dk -> (Global, dk) in (* Like in ppvernac.ml, l 585 *)
-      let e =
-        match de with
-        | ProveBody (_, ce) -> ce
-        | DefineBody (_, Some _, ce, None) -> ce
-        | DefineBody (_, None  , ce, None) -> ce
-        | DefineBody (_, Some _, ce, Some _) -> ce
-        | DefineBody (_, None  , ce, Some _) -> ce in
-      let str_dk = Kindops.string_of_definition_kind (l, false, dk) in
-      let str_id = Id.to_string id in
-      (xmlDef str_dk str_id loc [pp_expr e])
-  | VernacStartTheoremProof (tk, [ Some ((_,id),_), ([], statement, None) ], b) ->
-      let str_tk = Kindops.string_of_theorem_kind tk in
-      let str_id = Id.to_string id in
-      (xmlThm str_tk str_id loc [pp_expr statement])
-  | VernacStartTheoremProof _ as x -> xmlTODO loc x
-  | VernacEndProof pe ->
-      begin
-        match pe with
-        | Admitted -> xmlQed loc
-        | Proved (_, Some ((_, id), Some tk)) ->
-            let nam = Id.to_string id in
-            let typ = Kindops.string_of_theorem_kind tk in
-            xmlQed ~attr:["name", nam; "type", typ] loc
-        | Proved (_, Some ((_, id), None)) ->
-            let nam = Id.to_string id in
-            xmlQed ~attr:["name", nam] loc
-        | Proved _ -> xmlQed loc
-      end
-  | VernacExactProof _ as x -> xmlTODO loc x
-  | VernacAssumption ((l, a), _, sbwcl) ->
-      let binders = List.map (fun (_, (id, c)) -> (List.map fst id, c)) sbwcl in
-      let many =
-        List.length (List.flatten (List.map fst binders)) > 1 in
-      let exprs =
-        List.flatten (List.map pp_simple_binder binders) in
-      let l = match l with Some x -> x | None -> Decl_kinds.Global in
-      let kind = string_of_assumption_kind l a many in
-      xmlAssumption kind loc exprs
-  | VernacInductive (_, _, iednll) ->
-      let kind =
-        let (_, _, _, k, _),_ = List.hd iednll in
-	  begin
-            match k with
-            | Record -> "Record"
-            | Structure -> "Structure"
-            | Inductive_kw -> "Inductive"
-            | CoInductive -> "CoInductive"
-            | Class _ -> "Class"
-            | Variant -> "Variant"
-          end in
-      let exprs =
-        List.flatten (* should probably not be flattened *)
-          (List.map
-            (fun (ie, dnl) -> (pp_inductive_expr ie) @
-                              (List.map pp_decl_notation dnl)) iednll) in
-      xmlInductive kind loc exprs
-  | VernacFixpoint (_, fednll) ->
-      let exprs =
-        List.flatten (* should probably not be flattened *)
-          (List.map
-            (fun (fe, dnl) -> (pp_fixpoint_expr fe) @
-                              (List.map pp_decl_notation dnl)) fednll) in
-      xmlFixpoint exprs
-  | VernacCoFixpoint (_, cfednll) ->
-      (* Nota: it is like VernacFixpoint without so could be merged *)
-      let exprs =
-        List.flatten (* should probably not be flattened *)
-          (List.map
-            (fun (cfe, dnl) -> (pp_cofixpoint_expr cfe) @
-                              (List.map pp_decl_notation dnl)) cfednll) in
-      xmlCoFixpoint exprs
-  | VernacScheme _ as x -> xmlTODO loc x
-  | VernacCombinedScheme _ as x -> xmlTODO loc x
-
-  (* Gallina extensions *)
-  | VernacBeginSection (_, id) -> xmlBeginSection loc (Id.to_string id)
-  | VernacEndSegment (_, id) -> xmlEndSegment loc (Id.to_string id)
-  | VernacNameSectionHypSet _ as x -> xmlTODO loc x
-  | VernacRequire (from, import, l) ->
-      let import = match import with
-      | None -> []
-      | Some true -> ["export","true"]
-      | Some false -> ["import","true"]
-      in
-      let from = match from with
-      | None -> []
-      | Some r -> ["from", Libnames.string_of_reference r]
-      in
-      xmlRequire loc ~attr:(from @ import) (List.map (fun ref ->
-        xmlReference ref) l)
-  | VernacImport (true,l) ->
-      xmlImport loc ~attr:["export","true"] (List.map (fun ref ->
-        xmlReference ref) l)
-  | VernacImport (false,l) ->
-      xmlImport loc (List.map (fun ref ->
-        xmlReference ref) l)
-  | VernacCanonical r ->
-      let attr =
-        match r with
-        | AN (Qualid (_, q)) -> ["qualid", string_of_qualid q]
-        | AN (Ident (_, id)) -> ["id", Id.to_string id]
-        | ByNotation (_, s, _) -> ["notation", s] in
-      xmlCanonicalStructure attr loc
-  | VernacCoercion _ as x -> xmlTODO loc x
-  | VernacIdentityCoercion _ as x -> xmlTODO loc x
-
-  (* Type classes *)
-  | VernacInstance _ as x -> xmlTODO loc x
-
-  | VernacContext _ as x -> xmlTODO loc x
-
-  | VernacDeclareInstances _ as x -> xmlTODO loc x
-
-  | VernacDeclareClass _ as x -> xmlTODO loc x
-
-  (* Modules and Module Types *)
-  | VernacDeclareModule _ as x -> xmlTODO loc x
-  | VernacDefineModule _ as x -> xmlTODO loc x
-  | VernacDeclareModuleType _ as x -> xmlTODO loc x
-  | VernacInclude _ as x -> xmlTODO loc x
-
-  (* Solving *)
-
-  | (VernacSolveExistential _) as x ->
-      xmlLtac loc [PCData (Pp.string_of_ppcmds (Ppvernac.pr_vernac x))]
-
-  (* Auxiliary file and library management *)
-  | VernacAddLoadPath (recf,name,None) ->
-      xmlAddLoadPath loc ~attr:["rec",string_of_bool recf;"path",name] []
-  | VernacAddLoadPath (recf,name,Some dp) ->
-      xmlAddLoadPath loc ~attr:["rec",string_of_bool recf;"path",name]
-        [PCData (Names.DirPath.to_string dp)]
-  | VernacRemoveLoadPath name -> xmlRemoveLoadPath loc ~attr:["path",name] []
-  | VernacAddMLPath (recf,name) ->
-      xmlAddMLPath loc ~attr:["rec",string_of_bool recf;"path",name] []
-  | VernacDeclareMLModule sl -> xmlDeclareMLModule loc sl
-  | VernacChdir _ as x -> xmlTODO loc x
-
-  (* State management *)
-  | VernacWriteState _ as x -> xmlTODO loc x
-  | VernacRestoreState _ as x -> xmlTODO loc x
-
-  (* Resetting *)
-  | VernacResetName _ as x -> xmlTODO loc x
-  | VernacResetInitial as x -> xmlTODO loc x
-  | VernacBack _ as x -> xmlTODO loc x
-  | VernacBackTo _ -> PCData "VernacBackTo"
-
-  (* Commands *)
-  | VernacCreateHintDb _ as x -> xmlTODO loc x
-  | VernacRemoveHints _ as x -> xmlTODO loc x
-  | VernacHints _ as x -> xmlTODO loc x
-  | VernacSyntacticDefinition ((_, name), (idl, ce), _, _) ->
-      let name = Id.to_string name in
-      let attrs = List.map (fun id -> ("id", Id.to_string id)) idl in
-      xmlNotation attrs name loc [pp_expr ce]
-  | VernacDeclareImplicits _ as x -> xmlTODO loc x
-  | VernacArguments _ as x -> xmlTODO loc x
-  | VernacArgumentsScope _ as x -> xmlTODO loc x
-  | VernacReserve _ as x -> xmlTODO loc x
-  | VernacGeneralizable _ as x -> xmlTODO loc x
-  | VernacSetOpacity _ as x -> xmlTODO loc x
-  | VernacSetStrategy _ as x -> xmlTODO loc x
-  | VernacUnsetOption _ as x -> xmlTODO loc x
-  | VernacSetOption _ as x -> xmlTODO loc x
-  | VernacSetAppendOption _ as x -> xmlTODO loc x
-  | VernacAddOption _ as x -> xmlTODO loc x
-  | VernacRemoveOption _ as x -> xmlTODO loc x
-  | VernacMemOption _ as x -> xmlTODO loc x
-  | VernacPrintOption _ as x -> xmlTODO loc x
-  | VernacCheckMayEval (_,_,e) -> xmlCheck loc [pp_expr e]
-  | VernacGlobalCheck _ as x -> xmlTODO loc x
-  | VernacDeclareReduction _ as x -> xmlTODO loc x
-  | VernacPrint _ as x -> xmlTODO loc x
-  | VernacSearch _ as x -> xmlTODO loc x
-  | VernacLocate _ as x -> xmlTODO loc x
-  | VernacRegister _ as x -> xmlTODO loc x
-  | VernacComments (cl) ->
-      xmlComment loc (List.flatten (List.map pp_comment cl))
-
-  (* Stm backdoor *)
-  | VernacStm _ as x -> xmlTODO loc x
-
-  (* Proof management *)
-  | VernacGoal _ as x -> xmlTODO loc x
-  | VernacAbort _ as x -> xmlTODO loc x
-  | VernacAbortAll -> PCData "VernacAbortAll"
-  | VernacRestart as x -> xmlTODO loc x
-  | VernacUndo _ as x -> xmlTODO loc x
-  | VernacUndoTo _ as x -> xmlTODO loc x
-  | VernacBacktrack _ as x -> xmlTODO loc x
-  | VernacFocus _ as x -> xmlTODO loc x
-  | VernacUnfocus as x -> xmlTODO loc x
-  | VernacUnfocused as x -> xmlTODO loc x
-  | VernacBullet _ as x -> xmlTODO loc x
-  | VernacSubproof _ as x -> xmlTODO loc x
-  | VernacEndSubproof as x -> xmlTODO loc x
-  | VernacShow _ as x -> xmlTODO loc x
-  | VernacCheckGuard as x -> xmlTODO loc x
-  | VernacProof (tac,using) ->
-      let tac = Option.map (xmlRawTactic "closingtactic") tac in
-      let using = Option.map (xmlSectionSubsetDescr "using") using in
-      xmlProof loc (Option.List.(cons tac (cons using [])))
-  | VernacProofMode name -> xmlProofMode loc name
-
-  (* Toplevel control *)
-  | VernacToplevelControl _ as x -> xmlTODO loc x
-
-  (* For extension *)
-  | VernacExtend _ as x ->
-      xmlExtend loc [PCData (Pp.string_of_ppcmds (Ppvernac.pr_vernac x))]
-
-  (* Flags *)
-  | VernacProgram e -> xmlApply loc (Element("program",[],[]) :: [tmpp e loc])
-  | VernacLocal (b,e) ->
-      xmlApply loc (Element("local",["flag",string_of_bool b],[]) ::
-                    [tmpp e loc])
-
-let tmpp v loc =
-  match tmpp v loc with
-  | Element("ltac",_,_) as x -> x
-  | xml -> xmlGallina loc [xml]
diff --git a/ide/texmacspp.mli b/ide/texmacspp.mli
deleted file mode 100644
index 858847fb..00000000
--- a/ide/texmacspp.mli
+++ /dev/null
@@ -1,12 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Xml_datatype
-open Vernacexpr
-
-val tmpp : vernac_expr -> Loc.t -> xml
diff --git a/ide/utf8_convert.mli b/ide/utf8_convert.mli
new file mode 100644
index 00000000..9b3db5fd
--- /dev/null
+++ b/ide/utf8_convert.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val f : string -> string
diff --git a/ide/utf8_convert.mll b/ide/utf8_convert.mll
index 5cc8cbc0..6e36ae1c 100644
--- a/ide/utf8_convert.mll
+++ b/ide/utf8_convert.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/ide/utils/config_file.ml b/ide/utils/config_file.ml
deleted file mode 100644
index 4d0aabeb..00000000
--- a/ide/utils/config_file.ml
+++ /dev/null
@@ -1,640 +0,0 @@
-(*********************************************************************************)
-(*                Cameleon                                                       *)
-(*                                                                               *)
-(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
-(*    en Automatique. All rights reserved.                                       *)
-(*                                                                               *)
-(*    This program is free software; you can redistribute it and/or modify       *)
-(*    it under the terms of the GNU Library General Public License as            *)
-(*    published by the Free Software Foundation; either version 2 of the         *)
-(*    License, or  any later version.                                            *)
-(*                                                                               *)
-(*    This program is distributed in the hope that it will be useful,            *)
-(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
-(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
-(*    GNU Library General Public License for more details.                       *)
-(*                                                                               *)
-(*    You should have received a copy of the GNU Library General Public          *)
-(*    License along with this program; if not, write to the Free Software        *)
-(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
-(*    02111-1307  USA                                                            *)
-(*                                                                               *)
-(*    Contact: Maxence.Guesdon@inria.fr                                          *)
-(*                                                                               *)
-(*********************************************************************************)
-
-(* TODO *)
-(* section comments *)
-(* better obsoletes: no "{}", line cuts *)
-
-(* possible improvements: *)
-(* use lex/yacc instead of genlex to be more robust, efficient, allow arrays and other types, read comments. *)
-(* description and help, level (beginner/advanced/...) for each cp *)
-(* find an option from its name and group *)
-(* class hooks *)
-(* get the sections of a group / of a file *)
-(* read file format from inifiles and ConfigParser *)
-
-
-(* Read the mli before reading this file! *)
-
-
-(* ******************************************************************************** *)
-(* ******************************** misc utilities ******************************** *)
-(* ******************************************************************************** *)
-(* This code is intended to be usable without any dependencies. *)
-
-(* pipeline style, see for instance Raw.of_channel. *)
-let (|>) x f  = f x
-
-(* as List.assoc, but applies f to the element matching [key] and returns the list
-where this element has been replaced by the result of f. *)
-let rec list_assoc_remove key f = function
-  | [] -> raise Not_found
-  | (key',value) as elt :: tail ->
-      if key <> key'
-      then elt :: list_assoc_remove key f tail
-      else match f value with
-        | None -> tail
-        | Some a -> (key',a) :: tail
-
-(* reminiscent of String.concat. Same as [Queue.iter f1 queue]
-   but calls [f2 ()] between each calls to f1.
-   Does not call f2 before the first call nor after the last call to f2.
-   Could be more efficient with a richer module interface of Queue.
-*)
-let queue_iter_between f1 f2 queue =
-(*   let f flag elt = if flag then f2 (); (f1 elt:unit); true in *)
-  let f flag elt = if flag then f2 (); f1 elt; true in
-  ignore (Queue.fold f false queue)
-
-let list_iter_between f1 f2 = function
-    [] -> ()
-  | a::[] -> f1 a
-  | a::tail -> f1 a; List.iter (fun elt -> (f2 ():unit); f1 elt) tail
-(*   | a::tail -> f1 a; List.iter (fun elt -> f2 (); f1 elt) tail *)
-(* !! types ??? *)
-
-(* to ensure that strings will be parsed correctly by Genlex.
-It's more comfortable not to have quotes around the string, but sometimes it's necessary. *)
-exception Unsafe_string
-let safe_string s =
-  if s = ""
-  then "\"\""
-  else if (
-    try match s.[0] with
-      | 'a'..'z' | 'A'..'Z' ->
-          for i = 1 to String.length s - 1 do
-            match s.[i] with
-                'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> ()
-              | _ -> raise Unsafe_string
-          done;
-        false
-      | _ ->
-          try
-            string_of_int (int_of_string s) <> s ||
-            string_of_float (float_of_string s) <> s
-          with Failure "int_of_string" | Failure "float_of_string" -> true
-    with Unsafe_string -> true)
-  then Printf.sprintf "\"%s\"" (String.escaped s)
-  else s
-
-
-(* ******************************************************************************** *)
-(* ************************************* core ************************************* *)
-(* ******************************************************************************** *)
-
-module Raw = struct
-  type cp =
-    | String of string
-    | Int of int
-    | Float of float
-    | List of cp list
-    | Tuple of cp list
-    | Section of (string * cp) list
-
-(* code generated by
-camlp4 pa_o.cmo pa_op.cmo pr_o.cmo -- -o config_file_parser.ml -impl config_file_parser.ml4
-Unreadable on purpose, edit the file config_file_parser.ml4 rather than editing this (huge) lines. Then manually copy-paste here the content of config_file_parser.ml.
-Could be one day rewritten with ocamllex/yacc to be more robust, efficient, allow arrays, read comments...*)
-  module Parse = struct
-    let lexer = Genlex.make_lexer ["="; "{"; "}"; "["; "]"; ";"; "("; ")"; ","]
-    let rec file l (strm__ : _ Stream.t) = match try Some (ident strm__) with Stream.Failure -> None with Some id -> begin match Stream.peek strm__ with Some (Genlex.Kwd "=") -> Stream.junk strm__; let v = try value strm__ with Stream.Failure -> raise (Stream.Error "") in begin try file ((id, v) :: l) strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> raise (Stream.Error "") end | _ -> List.rev l
-    and value (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Kwd "{") -> Stream.junk strm__; let v = try file [] strm__ with Stream.Failure -> raise (Stream.Error "") in begin match Stream.peek strm__ with Some (Genlex.Kwd "}") -> Stream.junk strm__; Section v | _ -> raise (Stream.Error "") end | Some (Genlex.Ident s) -> Stream.junk strm__; String s | Some (Genlex.String s) -> Stream.junk strm__; String s | Some (Genlex.Int i) -> Stream.junk strm__; Int i | Some (Genlex.Float f) -> Stream.junk strm__; Float f | Some (Genlex.Char c) -> Stream.junk strm__; String (String.make 1 c) | Some (Genlex.Kwd "[") -> Stream.junk strm__; let v = try list [] strm__ with Stream.Failure -> raise (Stream.Error "") in List v | Some (Genlex.Kwd "(") -> Stream.junk strm__; let v = try list [] strm__ with Stream.Failure -> raise (Stream.Error "") in Tuple v | _ -> raise Stream.Failure
-    and ident (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Ident s) -> Stream.junk strm__; s | Some (Genlex.String s) -> Stream.junk strm__; s | _ -> raise Stream.Failure
-    and list l (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Kwd ";") -> Stream.junk strm__; begin try list l strm__ with Stream.Failure -> raise (Stream.Error "") end | Some (Genlex.Kwd ",") -> Stream.junk strm__; begin try list l strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> match try Some (value strm__) with Stream.Failure -> None with Some v -> begin try list (v :: l) strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> match Stream.peek strm__ with Some (Genlex.Kwd "]") -> Stream.junk strm__; List.rev l | Some (Genlex.Kwd ")") -> Stream.junk strm__; List.rev l | _ -> raise Stream.Failure
-  end
-
-  open Format
-  (* formating convention: the caller has to open the box, close it and flush the output *)
-  (* remarks on Format:
-     set_margin forces a call to set_max_indent
-     sprintf et bprintf are flushed at each call*)
-
-  (* pretty print a Raw.cp *)
-  let rec save formatter = function
-    | String s -> fprintf formatter "%s" (safe_string s) (* How can I cut lines and *)
-    | Int i -> fprintf formatter "%d" i             (* print backslashes just before the \n? *)
-    | Float f -> fprintf formatter "%g" f
-    | List l ->
-        fprintf formatter "[@[<b0>";
-        list_iter_between
-          (fun v -> fprintf formatter "@[<b2>"; save formatter v; fprintf formatter "@]")
-          (fun () -> fprintf formatter ";@ ")
-          l;
-        fprintf formatter "@]]"
-    | Tuple l ->
-        fprintf formatter "(@[<b0>";
-        list_iter_between
-          (fun v -> fprintf formatter "@[<b2>"; save formatter v; fprintf formatter "@]")
-          (fun () -> fprintf formatter ",@ ")
-          l;
-        fprintf formatter "@])"
-    | Section l ->
-        fprintf formatter "{@;<0 2>@[<hv0>";
-        list_iter_between
-          (fun (name,value) ->
-             fprintf formatter "@[<hov2>%s =@ @[<b2>" name;
-             save formatter value;
-             fprintf formatter "@]@]";)
-          (fun () -> fprintf formatter "@;<2 0>")
-          l;
-        fprintf formatter "@]}"
-
-(*   let to_string r = save str_formatter r; flush_str_formatter () *)
-  let to_channel out_channel r =
-    let f = formatter_of_out_channel out_channel in
-    fprintf f "@[<b2>"; save f r; fprintf f "@]@?"
-
-  let of_string s = s |> Stream.of_string |> Parse.lexer |> Parse.value
-
-  let of_channel in_channel =
-    let result = in_channel |> Stream.of_channel |> Parse.lexer |> Parse.file [] in
-    close_in in_channel;
-    result
-end
-
-(* print the given string in a way compatible with Format.
-   Truncate the lines when needed, indent the newlines.*)
-let print_help formatter =
-  String.iter (function
-   | ' ' -> Format.pp_print_space formatter ()
-   | '\n' -> Format.pp_force_newline formatter ()
-   | c -> Format.pp_print_char formatter c)
-
-type 'a wrappers = {
- to_raw : 'a -> Raw.cp;
- of_raw : Raw.cp -> 'a}
-
-class type ['a] cp = object
-(*   method private to_raw = wrappers.to_raw *)
-(*   method private of_raw = wrappers.of_raw *)
-(*   method private set_string s = s |> Raw.of_string |> self#of_raw |> self#set *)
-  method add_hook : ('a -> 'a -> unit) -> unit
-  method get : 'a
-  method get_default : 'a
-  method set : 'a -> unit
-  method reset : unit
-
-  method get_formatted : Format.formatter -> unit
-  method get_default_formatted : Format.formatter -> unit
-  method get_help_formatted : Format.formatter -> unit
-
-  method get_name : string list
-  method get_short_name : string option
-  method set_short_name : string -> unit
-  method get_help : string
-  method get_spec : Arg.spec
-
-  method set_raw : Raw.cp -> unit
-end
-
-type groupable_cp = <
-  get_name : string list;
-  get_short_name : string option;
-  get_help : string;
-
-  get_formatted : Format.formatter -> unit;
-  get_default_formatted : Format.formatter -> unit;
-  get_help_formatted : Format.formatter -> unit;
-  get_spec : Arg.spec;
-
-  reset : unit;
-  set_raw : Raw.cp -> unit; >
-
-exception Double_name
-exception Missing_cp of groupable_cp
-exception Wrong_type of (out_channel -> unit)
-
-(* Two exceptions to stop the iteration on queues. *)
-exception Found
-exception Found_cp of groupable_cp
-
-(* The data structure to store the cps.
-It's a tree, each node is a section, and a queue of sons with their name.
-Each leaf contains a cp. *)
-type 'a nametree =
-  | Immediate of 'a
-  | Subsection of ((string * 'a nametree) Queue.t)
-      (* this Queue must be nonempty for group.read.choose *)
-
-class group = object (self)
-  val mutable cps = Queue.create () (* hold all the added cps, in a nametree. *)
-
-  method add : 'a. 'a cp -> unit = fun original_cp ->
-    let cp = (original_cp :> groupable_cp) in
-    (* function called when we reach the end of the list cp#get_name. *)
-    let add_immediate name cp queue =
-      Queue.iter (fun (name',_) -> if name = name' then raise Double_name) queue;
-      Queue.push (name, Immediate cp) queue in
-    (* adds the cp with name [first_name::last_name] in section [section]. *)
-    let rec add_in_section section first_name last_name cp queue =
-      let sub_add = match last_name with (* what to do once we have find the correct section *)
-        | [] -> add_immediate first_name
-        | middle_name :: last_name -> add_in_section first_name middle_name last_name in
-      try
-        Queue.iter
-          (function
-             | name, Subsection subsection when name = section ->
-                 sub_add cp subsection; raise Found
-             | _ -> ())
-          queue;
-        let sub_queue = Queue.create () in
-        sub_add cp sub_queue;
-        Queue.push (section, Subsection sub_queue) queue
-      with Found -> () in
-    (match cp#get_name with
-      | [] -> failwith "empty name"
-      | first_name :: [] -> add_immediate first_name cp cps
-      | first_name :: middle_name :: last_name ->
-          add_in_section first_name middle_name last_name cp cps)
-
-  method write ?(with_help=true) filename =
-    let out_channel = open_out filename in
-    let formatter = Format.formatter_of_out_channel out_channel in
-    let print = Format.fprintf formatter in
-    print "@[<v>";
-    let rec save_queue formatter =
-      queue_iter_between
-        (fun (name,nametree) -> save_nametree name nametree)
-        (Format.pp_print_cut formatter)
-    and save_nametree name = function
-      | Immediate cp ->
-          if with_help && cp#get_help <> "" then
-            (print "@[<hov3>(* "; cp#get_help_formatted formatter;
-             print "@ *)@]@,");
-          Format.fprintf formatter "@[<hov2>%s =@ @[<b2>" (safe_string name);
-          cp#get_formatted formatter;
-          print "@]@]"
-      | Subsection queue ->
-          Format.fprintf formatter "%s = {@;<0 2>@[<v>" (safe_string name);
-          save_queue formatter queue;
-          print "@]@,}" in
-    save_queue formatter cps;
-    print "@]@."; close_out out_channel
-
-  method read ?obsoletes ?(no_default=false)
-      ?(on_type_error = fun groupable_cp raw_cp output filename in_channel ->
-          close_in in_channel;
-          Printf.eprintf
-            "Type error while loading configuration parameter %s from file %s.\n%!"
-            (String.concat "." groupable_cp#get_name) filename;
-          output stderr;
-          exit 1)
-      filename =
-    (* [filename] is created if it doesn't exist. In this case there is no need to read it. *)
-    match Sys.file_exists filename with false -> self#write filename | true ->
-    let in_channel = open_in filename in
-    (* what to do when a cp is missing: *)
-    let missing cp default = if no_default then raise (Missing_cp cp) else default in
-    (* returns a cp contained in the nametree queue, which must be nonempty *)
-    let choose queue =
-      let rec iter q = Queue.iter (function
-        | _, Immediate cp -> raise (Found_cp cp)
-        | _, Subsection q -> iter q) q in
-      try iter queue; failwith "choose" with Found_cp cp -> cp in
-    (* [set_and_remove raw_cps nametree] sets the cp of [nametree] to their value
-       defined in [raw_cps] and returns the remaining raw_cps. *)
-    let set_cp cp value =
-      try cp#set_raw value
-      with Wrong_type output -> on_type_error cp value output filename in_channel in
-    let rec set_and_remove raw_cps = function
-      | name, Immediate cp ->
-          (try list_assoc_remove name (fun value -> set_cp cp value; None) raw_cps
-           with Not_found -> missing cp raw_cps)
-      | name, Subsection queue ->
-          (try list_assoc_remove name
-             (function
-                | Raw.Section l ->
-                    (match remainings l queue with
-                       | [] -> None
-                       | l -> Some (Raw.Section l))
-                | r -> missing (choose queue) (Some r))
-             raw_cps
-           with Not_found -> missing (choose queue) raw_cps)
-    and remainings raw_cps queue = Queue.fold set_and_remove raw_cps queue in
-    let remainings = remainings (Raw.of_channel in_channel) cps in
-    (* Handling of cps defined in filename but not belonging to self. *)
-    if remainings <> [] then match obsoletes with
-      | Some filename ->
-          let out_channel =
-            open_out filename in
-(*             open_out_gen [Open_wronly; Open_creat; Open_append; Open_text] 0o666 filename in *)
-          let formatter = Format.formatter_of_out_channel out_channel in
-          Format.fprintf formatter "@[<v>";
-          Raw.save formatter (Raw.Section remainings);
-          Format.fprintf formatter "@]@.";
-          close_out out_channel
-      | None -> ()
-
-  method command_line_args ~section_separator =
-    let print = Format.fprintf Format.str_formatter in (* shortcut *)
-    let result = ref [] in let push x = result := x :: !result in
-    let rec iter = function
-      | _, Immediate cp ->
-          let key = "-" ^ String.concat section_separator cp#get_name in
-          let spec = cp#get_spec in
-          let doc = (
-            print "@[<hv5>";
-            Format.pp_print_as Format.str_formatter (String.length key +3) "";
-            if cp#get_help <> ""
-            then (print "@,@[<b2>"; cp#get_help_formatted Format.str_formatter; print "@]@ ")
-            else print "@,";
-            print "@[<hv>@[current:@;<1 2>@[<hov1>"; cp#get_formatted Format.str_formatter;
-            print "@]@],@ @[default:@;<1 2>@[<b2>"; cp#get_default_formatted Format.str_formatter;
-            print "@]@]@]@]";
-            Format.flush_str_formatter ()) in
-          (match cp#get_short_name with
-            | None -> ()
-            | Some short_name -> push ("-" ^ short_name,spec,""));
-          push (key,spec,doc)
-      | _, Subsection queue -> Queue.iter iter queue in
-    Queue.iter iter cps;
-    List.rev !result
-end
-
-
-(* Given wrappers for the type 'a, cp_custom_type defines a class 'a cp. *)
-class ['a] cp_custom_type wrappers
-  ?group:(group:group option) name ?short_name default help =
-object (self)
-  method private to_raw = wrappers.to_raw
-  method private of_raw = wrappers.of_raw
-
-  val mutable value = default
-    (* output *)
-  method get = value
-  method get_default = default
-  method get_formatted formatter = self#get |> self#to_raw |> Raw.save formatter
-  method get_default_formatted formatter = self#get_default |> self#to_raw |> Raw.save formatter
-    (* input *)
-  method set v = let v' = value in value <- v; self#exec_hooks v' v
-  method set_raw v = self#of_raw v |> self#set
-  method private set_string s = s |> Raw.of_string |> self#of_raw |> self#set
-  method reset = self#set self#get_default
-
-  (* name *)
-  val mutable shortname = short_name
-  method get_name = name
-  method get_short_name = shortname
-  method set_short_name s = shortname <- Some s
-
-  (* help *)
-  method get_help = help
-  method get_help_formatted formatter = print_help formatter self#get_help
-  method get_spec = Arg.String self#set_string
-
-  (* hooks *)
-  val mutable hooks = []
-  method add_hook f = hooks <- (f:'a->'a->unit) :: hooks
-  method private exec_hooks v' v = List.iter (fun f -> f v' v) hooks
-
-  initializer match group with Some g -> g#add (self :> 'a cp) | None -> ()
-end
-
-
-(* ******************************************************************************** *)
-(* ****************************** predefined classes ****************************** *)
-(* ******************************************************************************** *)
-
-let int_wrappers = {
-  to_raw = (fun v -> Raw.Int v);
-  of_raw = function
-    | Raw.Int v -> v
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.Int expected, got %a\n%!" Raw.to_channel r))}
-class int_cp ?group name ?short_name default help = object (self)
-  inherit [int] cp_custom_type int_wrappers ?group name ?short_name default help
-  method get_spec = Arg.Int self#set
-end
-
-let float_wrappers = {
-  to_raw = (fun v -> Raw.Float v);
-  of_raw = function
-    | Raw.Float v -> v
-    | Raw.Int v -> float v
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.Float expected, got %a\n%!" Raw.to_channel r))
-}
-class float_cp ?group name ?short_name default help = object (self)
-  inherit [float] cp_custom_type float_wrappers ?group name ?short_name default help
-  method get_spec = Arg.Float self#set
-end
-
-(* The Pervasives version is too restrictive *)
-let bool_of_string s =
-  match String.lowercase s with
-    | "false" | "no" | "n" | "0" -> false (* "0" and "1" aren't used. *)
-    | "true" | "yes" | "y" | "1" -> true
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.Bool expected, got %s\n%!" r))
-let bool_wrappers = {
-  to_raw = (fun v -> Raw.String (string_of_bool v));
-  of_raw = function
-    | Raw.String v -> bool_of_string v
-    | Raw.Int v -> v <> 0
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.Bool expected, got %a\n%!" Raw.to_channel r))
-}
-class bool_cp ?group name ?short_name default help = object (self)
-  inherit [bool] cp_custom_type bool_wrappers ?group name ?short_name default help
-  method get_spec = Arg.Bool self#set
-end
-
-let string_wrappers = {
-  to_raw = (fun v -> Raw.String v);
-  of_raw = function
-    | Raw.String v -> v
-    | Raw.Int v -> string_of_int v
-    | Raw.Float v -> string_of_float v
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.String expected, got %a\n%!" Raw.to_channel r))
-}
-class string_cp ?group name ?short_name default help = object (self)
-  inherit [string] cp_custom_type string_wrappers ?group name ?short_name default help
-  method private of_string s = s
-  method get_spec = Arg.String self#set
-end
-
-let list_wrappers wrappers = {
-  to_raw = (fun l -> Raw.List (List.map wrappers.to_raw l));
-  of_raw = function
-    | Raw.List l -> List.map wrappers.of_raw l
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.List expected, got %a\n%!" Raw.to_channel r))
-}
-class ['a] list_cp wrappers = ['a list] cp_custom_type (list_wrappers wrappers)
-
-let option_wrappers wrappers = {
-  to_raw = (function
-    | Some v -> wrappers.to_raw v
-    | None -> Raw.String "");
-  of_raw = function
-    | Raw.String s as v -> (
-        if s = "" || s = "None" then None
-        else if String.length s >= 5 && String.sub s 0 5 = "Some "
-        then Some (wrappers.of_raw (Raw.String (String.sub s 5 (String.length s -5))))
-        else Some (wrappers.of_raw v))
-    | r -> Some (wrappers.of_raw r)}
-class ['a] option_cp wrappers = ['a option] cp_custom_type (option_wrappers wrappers)
-
-let enumeration_wrappers enum =
-  let switched = List.map (fun (string,cons) -> cons,string) enum in
-  {to_raw = (fun v -> Raw.String (List.assq v switched));
-   of_raw = function
-     | Raw.String s ->
-         (try List.assoc s enum
-          with Not_found -> failwith (Printf.sprintf "%s isn't a known constructor" s))
-     | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw enumeration expected, got %a\n%!" Raw.to_channel r))
-}
-class ['a] enumeration_cp enum ?group name ?short_name default help = object (self)
-  inherit ['a] cp_custom_type (enumeration_wrappers enum)
-    ?group name ?short_name default help
-  method get_spec = Arg.Symbol (List.map fst enum, (fun s -> self#set (List.assoc s enum)))
-end
-
-let tuple2_wrappers wrapa wrapb = {
-  to_raw = (fun (a,b) -> Raw.Tuple [wrapa.to_raw a; wrapb.to_raw b]);
-  of_raw = function
-    | Raw.Tuple [a;b] -> wrapa.of_raw a, wrapb.of_raw b
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.Tuple 2 expected, got %a\n%!" Raw.to_channel r))
-}
-class ['a, 'b] tuple2_cp wrapa wrapb = ['a*'b] cp_custom_type (tuple2_wrappers wrapa wrapb)
-
-let tuple3_wrappers wrapa wrapb wrapc = {
-  to_raw = (fun (a,b,c) -> Raw.Tuple[wrapa.to_raw a; wrapb.to_raw b; wrapc.to_raw c]);
-  of_raw = function
-    | Raw.Tuple [a;b;c] -> wrapa.of_raw a, wrapb.of_raw b, wrapc.of_raw c
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.Tuple 3 expected, got %a\n%!" Raw.to_channel r))
-}
-class ['a,'b,'c] tuple3_cp wrapa wrapb wrapc =
-  ['a*'b*'c] cp_custom_type (tuple3_wrappers wrapa wrapb wrapc)
-
-let tuple4_wrappers wrapa wrapb wrapc wrapd = {
-  to_raw=(fun (a,b,c,d)->Raw.Tuple[wrapa.to_raw a;wrapb.to_raw b;wrapc.to_raw c;wrapd.to_raw d]);
-  of_raw = function
-    | Raw.Tuple [a;b;c;d] -> wrapa.of_raw a, wrapb.of_raw b, wrapc.of_raw c, wrapd.of_raw d
-    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
-                                "Raw.Tuple 4 expected, got %a\n%!" Raw.to_channel r))
-}
-class ['a,'b,'c,'d] tuple4_cp wrapa wrapb wrapc wrapd =
-  ['a*'b*'c*'d] cp_custom_type (tuple4_wrappers wrapa wrapb wrapc wrapd)
-
-class string2_cp = [string,string] tuple2_cp string_wrappers string_wrappers
-(* class color_cp = string_cp *)
-class font_cp = string_cp
-class filename_cp = string_cp
-
-
-(* ******************************************************************************** *)
-(******************** Backward compatibility with module Flags.****************** *)
-(* ******************************************************************************** *)
-
-type 'a option_class = 'a wrappers
-type 'a option_record = 'a cp
-type options_file = {mutable filename:string; group:group}
-
-let create_options_file filename = {filename = filename; group = new group}
-let set_options_file options_file filename = options_file.filename <- filename
-let load {filename=f; group = g} = g#read f
-let append {group=g} filename = g#read filename
-let save {filename=f; group = g} = g#write ~with_help:false f
-let save_with_help {filename=f; group = g} = g#write ~with_help:true f
-let define_option {group=group} name help option_class default =
-  (new cp_custom_type option_class ~group name default help)
-let option_hook cp f = cp#add_hook (fun _ _ -> f ())
-
-let  string_option = string_wrappers
-let   color_option = string_wrappers
-let    font_option = string_wrappers
-let     int_option =    int_wrappers
-let    bool_option =   bool_wrappers
-let   float_option =  float_wrappers
-let string2_option = tuple2_wrappers string_wrappers string_wrappers
-
-let option_option = option_wrappers
-let list_option = list_wrappers
-let sum_option = enumeration_wrappers
-let tuple2_option (a,b) = tuple2_wrappers a b
-let tuple3_option (a,b,c) = tuple3_wrappers a b c
-let tuple4_option (a,b,c,d) = tuple4_wrappers a b c d
-
-let ( !! ) cp = cp#get
-let ( =:= ) cp value = cp#set value
-
-let shortname cp = String.concat ":" cp#get_name
-let get_help cp = cp#get_help
-
-type option_value =
-  Module of option_module
-| StringValue of  string
-| IntValue of int
-| FloatValue of float
-| List of option_value list
-| SmallList of option_value list
-and option_module = (string * option_value) list
-
-let rec value_to_raw = function
-  | Module a -> Raw.Section (List.map (fun (name,value) -> name, value_to_raw value) a)
-  | StringValue a -> Raw.String a
-  | IntValue a -> Raw.Int a
-  | FloatValue a -> Raw.Float a
-  | List a -> Raw.List (List.map value_to_raw a)
-  | SmallList a -> Raw.Tuple (List.map value_to_raw a)
-let rec raw_to_value = function
-  | Raw.String a -> StringValue a
-  | Raw.Int a -> IntValue a
-  | Raw.Float a -> FloatValue a
-  | Raw.List a -> List (List.map raw_to_value a)
-  | Raw.Tuple a -> SmallList (List.map raw_to_value a)
-  | Raw.Section a -> Module (List.map (fun (name,value) -> name, raw_to_value value) a)
-
-let define_option_class _ of_option_value to_option_value =
-  {to_raw = (fun a -> a |> to_option_value |> value_to_raw);
-   of_raw = (fun a -> a |> raw_to_value |> of_option_value)}
-
-let to_value {to_raw = to_raw} a = a |> to_raw |> raw_to_value
-let from_value {of_raw = of_raw} a = a |> value_to_raw |> of_raw
-
-let of_value_w wrappers a = a |> value_to_raw |> wrappers.of_raw
-let to_value_w wrappers a = a |> wrappers.to_raw |> raw_to_value
-(* fancy indentation when finishing this stub code, not good style :-) *)
-let value_to_string : option_value -> string = of_value_w string_option
-let  string_to_value = to_value_w  string_option
-let value_to_int     = of_value_w     int_option
-let     int_to_value = to_value_w     int_option
-let value_to_bool    = of_value_w    bool_option
-let    bool_to_value = to_value_w    bool_option
-let value_to_float   = of_value_w   float_option
-let   float_to_value = to_value_w   float_option
-let value_to_string2 = of_value_w string2_option
-let string2_to_value = to_value_w string2_option
-let value_to_list of_value =
-  let wrapper = define_option_class "" of_value (fun _ -> failwith "value_to_list") in
-  of_value_w (list_option wrapper)
-let list_to_value to_value =
-  let wrapper = define_option_class "" (fun _ -> failwith "value_to_list") to_value in
-  to_value_w (list_option wrapper)
diff --git a/ide/utils/config_file.mli b/ide/utils/config_file.mli
deleted file mode 100644
index 22328e7f..00000000
--- a/ide/utils/config_file.mli
+++ /dev/null
@@ -1,352 +0,0 @@
-(*********************************************************************************)
-(*                Cameleon                                                       *)
-(*                                                                               *)
-(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
-(*    en Automatique. All rights reserved.                                       *)
-(*                                                                               *)
-(*    This program is free software; you can redistribute it and/or modify       *)
-(*    it under the terms of the GNU Library General Public License as            *)
-(*    published by the Free Software Foundation; either version 2 of the         *)
-(*    License, or  any later version.                                            *)
-(*                                                                               *)
-(*    This program is distributed in the hope that it will be useful,            *)
-(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
-(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
-(*    GNU Library General Public License for more details.                       *)
-(*                                                                               *)
-(*    You should have received a copy of the GNU Library General Public          *)
-(*    License along with this program; if not, write to the Free Software        *)
-(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
-(*    02111-1307  USA                                                            *)
-(*                                                                               *)
-(*    Contact: Maxence.Guesdon@inria.fr                                          *)
-(*                                                                               *)
-(*********************************************************************************)
-
-(**
-  This module implements a mechanism to handle configuration files.
-  A configuration file is defined as a set of [variable = value] lines,
-  where value can be
-    a simple string (types int, string, bool...),
-    a list of values between brackets (lists) or parentheses (tuples),
-    or a set of [variable = value] lines between braces.
-  The configuration file is automatically loaded and saved,
-  and configuration parameters are manipulated inside the program as easily as references.
-
-  Object implementation by Jean-Baptiste Rouquier.
-*)
-
-(** {1:lowlevelinterface Low level interface} *)
-(** Skip this section on a first reading... *)
-
-(** The type of cp freshly parsed from configuration file,
-not yet wrapped in their proper type. *)
-module Raw : sig
-  type cp =
-    | String of string (** base types, reproducing the tokens of Genlex *)
-    | Int of int
-    | Float of float
-    | List of cp list (** compound types *)
-    | Tuple of cp list
-    | Section of (string * cp) list
-
-  (** A parser. *)
-  val of_string : string -> cp
-
-  (** Used to print the values into a log file for instance. *)
-  val to_channel : out_channel -> cp -> unit
-end
-
-(** A type used to specialize polymorphics classes and define new classes.
-  {!Config_file.predefinedwrappers} are provided.
- *)
-type 'a wrappers = { to_raw : 'a -> Raw.cp; of_raw : Raw.cp -> 'a; }
-
-(** An exception raised by {!Config_file.cp.set_raw}
-  when the argument doesn't have a suitable {!Config_file.Raw.cp} type.
-  The function explains the problem and flush the output.*)
-exception Wrong_type of (out_channel -> unit)
-
-(* (\** {2 Miscellaneous functions} *\) *)
-
-(* val bool_of_string : string -> bool *)
-
-(** {1 High level interface} *)
-(** {2 The two main classes} *)
-
-(** A Configuration Parameter, in short cp, ie
-  a value we can store in and read from a configuration file. *)
-class type ['a] cp = object
-  (** {1 Accessing methods} *)
-
-  method get : 'a
-  method set : 'a -> unit
-  method get_default : 'a
-  method get_help : string
-  method get_name : string list
-
-  (** Resets to the default value. *)
-  method reset : unit
-
-  (** {1 Miscellaneous} *)
-
-  (** All the hooks are executed each time the method set is called,
-    just after setting the new value.*)
-  method add_hook : ('a -> 'a -> unit) -> unit
-
-  (** Used to generate command line arguments in {!Config_file.group.command_line_args} *)
-  method set_short_name : string -> unit
-
-  (** [None] if no optional short_name was provided during object creation
-    and [set_short_name] was never called.*)
-  method get_short_name : string option
-
-  (** {1 Methods for internal use} *)
-
-  method get_formatted : Format.formatter -> unit
-  method get_default_formatted : Format.formatter -> unit
-  method get_help_formatted : Format.formatter -> unit
-
-  method get_spec : Arg.spec
-  method set_raw : Raw.cp -> unit
-end
-
-(** Unification over all possible ['a cp]:
-  contains the main methods of ['a cp] except the methods using the type ['a].
-  A [group] manipulates only [groupable_cp] for homogeneity. *)
-type groupable_cp = <
-  get_name : string list;
-  get_short_name : string option;
-  get_help : string;
-
-  get_formatted : Format.formatter -> unit;
-  get_default_formatted : Format.formatter -> unit;
-  get_help_formatted : Format.formatter -> unit;
-  get_spec : Arg.spec;
-
-  reset : unit;
-  set_raw : Raw.cp -> unit; >
-
-(** Raised in case a name is already used.
-  See {!Config_file.group.add} *)
-exception Double_name
-
-(** An exception possibly raised if we want to check that
-  every cp is defined in a configuration file.
-  See {!Config_file.group.read}.
-*)
-exception Missing_cp of groupable_cp
-
-(** A group of cps, that can be loaded and saved,
-or used to generate command line arguments.
-
-The basic usage is to have only one group and one configuration file,
-but this mechanism allows having more,
-for instance having another smaller group for the options to pass on the command line.
-*)
-class group : object
-  (** Adds a cp to the group.
-    Note that the type ['a] must be lost
-    to allow cps of different types to belong to the same group.
-    @raise Double_name if [cp#get_name] is already used. *)
-(*     method add : 'a cp -> 'a cp *)
-    method add : 'a cp -> unit
-
-    (**[write filename] saves all the cps into the configuration file [filename].*)
-    method write : ?with_help:bool -> string -> unit
-
-    (** [read filename] reads [filename]
-      and stores the values it specifies into the cps belonging to this group.
-      The file is created (and not read) if it doesn't exists.
-      In the default behaviour, no warning is issued
-      if not all cps are updated or if some values of [filename] aren't used.
-
-      If [obsoletes] is specified,
-      then prints in this file all the values that are
-      in [filename] but not in this group.
-      Those cps are likely to be erroneous or obsolete.
-      Opens this file only if there is something to write in it.
-
-      If [no_default] is [true], then raises [Missing_cp foo] if
-      the cp [foo] isn't defined in [filename] but belongs to this group.
-
-      [on_type_error groupable_cp value output filename in_channel]
-      is called if the file doesn't give suitable value
-      (string instead of int for instance, or a string not belonging to the expected enumeration)
-      for the cp [groupable_cp].
-      [value] is the value read from the file,
-      [output] is the argument of {!Config_file.Wrong_type},
-      [filename] is the same argument as the one given to read,
-      and [in_channel] refers to [filename] to allow a function to close it if needed.
-      Default behaviour is to print an error message and call [exit 1].
-*)
-    method read : ?obsoletes:string -> ?no_default:bool ->
-      ?on_type_error : (groupable_cp -> Raw.cp -> (out_channel -> unit) ->
-                          string -> in_channel -> unit) ->
-      string -> unit
-
-    (** Interface with module Arg.
-      @param section_separator the string used to concatenate the name of a cp,
-      to get the command line option name.
-      ["-"] is a good default.
-      @return a list that can be used with [Arg.parse] and [Arg.usage].*)
-    method command_line_args : section_separator:string -> (string * Arg.spec * string) list
-  end
-
-(** {2 Predefined cp classes} *)
-
-(** The last three non-optional arguments are always
-  [name] (of type string list), [default_value] and [help] (of type string).
-
-  [name] is the path to the cp: [["section";"subsection"; ...; "foo"]].
-  It can consists of a single element but must not be empty.
-
-  [short_name] will be added a "-" and used in
-  {!Config_file.group.command_line_args}.
-
-  [group], if provided, adds the freshly defined option to it
-  (something like [initializer group#add self]).
-
-  [help] needs not contain newlines, it will be automatically truncated where needed.
-  It is mandatory but can be [""].
-*)
-
-class int_cp : ?group:group -> string list -> ?short_name:string -> int -> string -> [int] cp
-class float_cp : ?group:group -> string list -> ?short_name:string -> float -> string -> [float] cp
-class bool_cp : ?group:group -> string list -> ?short_name:string -> bool -> string -> [bool] cp
-class string_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> [string] cp
-class ['a] list_cp : 'a wrappers -> ?group:group -> string list -> ?short_name:string -> 'a list -> string -> ['a list] cp
-class ['a] option_cp : 'a wrappers -> ?group:group -> string list -> ?short_name:string -> 'a option -> string -> ['a option] cp
-class ['a] enumeration_cp : (string * 'a) list -> ?group:group -> string list -> ?short_name:string -> 'a -> string -> ['a] cp
-class ['a, 'b] tuple2_cp : 'a wrappers -> 'b wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b -> string -> ['a * 'b] cp
-class ['a, 'b, 'c] tuple3_cp : 'a wrappers -> 'b wrappers -> 'c wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b * 'c -> string -> ['a * 'b * 'c] cp
-class ['a, 'b, 'c, 'd] tuple4_cp : 'a wrappers -> 'b wrappers -> 'c wrappers -> 'd wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b * 'c * 'd -> string -> ['a * 'b * 'c * 'd] cp
-class string2_cp : ?group:group -> string list -> ?short_name:string -> string * string -> string -> [string, string] tuple2_cp
-(* class color_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp *)
-class font_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp
-class filename_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp
-
-(** {2:predefinedwrappers Predefined wrappers} *)
-
-val int_wrappers : int wrappers
-val float_wrappers : float wrappers
-val bool_wrappers : bool wrappers
-val string_wrappers : string wrappers
-val list_wrappers : 'a wrappers -> 'a list wrappers
-val option_wrappers : 'a wrappers -> 'a option wrappers
-
-(** If you have a [type suit = Spades | Hearts | Diamond | Clubs], then
-{[enumeration_wrappers ["spades",Spades; "hearts",Hearts; "diamond",Diamond; "clubs",Clubs]]}
-will allow you to use cp of this type.
-For sum types with not only constant constructors,
-you will need to define your own cp class. *)
-val enumeration_wrappers : (string * 'a) list -> 'a wrappers
-val tuple2_wrappers : 'a wrappers -> 'b wrappers -> ('a * 'b) wrappers
-val tuple3_wrappers : 'a wrappers -> 'b wrappers -> 'c wrappers -> ('a * 'b * 'c) wrappers
-val tuple4_wrappers : 'a wrappers -> 'b wrappers -> 'c wrappers -> 'd wrappers -> ('a * 'b * 'c * 'd) wrappers
-
-(** {2 Defining new cp classes} *)
-
-(** To define a new cp class, you just have to provide an implementation for the wrappers
-between your type [foo] and the type [Raw.cp].
-Once you have your wrappers [w], write
-{[class foo_cp = [foo] cp_custom_type w]}
-
-For further details, have a look at the commented .ml file,
-section "predefined cp classes".
-*)
-class ['a] cp_custom_type : 'a wrappers ->
-  ?group:group -> string list -> ?short_name:string -> 'a -> string -> ['a] cp
-
-
-(** {1 Backward compatibility}
-
-Deprecated.
-
-All the functions from the module Options are available, except:
-
-- [prune_file]: use [group#write ?obsoletes:"foo.ml"].
-- [smalllist_to_value], [smalllist_option]: use lists or tuples.
-- [get_class].
-- [class_hook]: hooks are local to a cp.
-  If you want hooks global to a class,
-  define a new class that inherit from {!Config_file.cp_custom_type}.
-- [set_simple_option], [get_simple_option], [simple_options], [simple_args]:
-  use {!Config_file.group.write}.
-- [set_option_hook]: use {!Config_file.cp.add_hook}.
-- [set_string_wrappers]: define a new class with {!Config_file.cp_custom_type}.
-
-The old configurations files are readable by this module.
-*)
-
-
-
-
-
-(**/**)
-type 'a option_class
-type 'a option_record
-type options_file
-
-val create_options_file : string -> options_file
-val set_options_file : options_file -> string -> unit
-val load : options_file -> unit
-val append : options_file -> string -> unit
-val save : options_file -> unit
-val save_with_help : options_file -> unit
-(* val define_option : options_file -> *)
-(*   string list ->  string -> 'a option_class -> 'a -> 'a option_record *)
-val option_hook : 'a option_record -> (unit -> unit) -> unit
-
-val string_option : string option_class
-val color_option : string option_class
-val font_option : string option_class
-val int_option : int option_class
-val bool_option : bool option_class
-val float_option : float option_class
-val string2_option : (string * string) option_class
-
-val option_option : 'a option_class -> 'a option option_class
-val list_option : 'a option_class -> 'a list option_class
-val sum_option : (string * 'a) list -> 'a option_class
-val tuple2_option :
-  'a option_class * 'b option_class -> ('a * 'b) option_class
-val tuple3_option : 'a option_class * 'b option_class * 'c option_class ->
-  ('a * 'b * 'c) option_class
-val tuple4_option :
-    'a option_class * 'b option_class * 'c option_class * 'd option_class ->
-  ('a * 'b * 'c * 'd) option_class
-
-val ( !! ) : 'a option_record -> 'a
-val ( =:= ) : 'a option_record -> 'a -> unit
-val shortname : 'a option_record -> string
-val get_help : 'a option_record -> string
-
-type option_value =
-  Module of option_module
-| StringValue of  string
-| IntValue of int
-| FloatValue of float
-| List of option_value list
-| SmallList of option_value list
-and option_module = (string * option_value) list
-
-val define_option_class :
-  string -> (option_value -> 'a) -> ('a -> option_value) -> 'a option_class
-
-val to_value : 'a option_class -> 'a -> option_value
-val from_value : 'a option_class -> option_value -> 'a
-
-val value_to_string : option_value -> string
-val string_to_value : string -> option_value
-val value_to_int : option_value -> int
-val int_to_value : int -> option_value
-val bool_of_string : string -> bool
-val value_to_bool : option_value -> bool
-val bool_to_value : bool -> option_value
-val value_to_float : option_value -> float
-val float_to_value : float -> option_value
-val value_to_string2 : option_value -> string * string
-val string2_to_value : string * string -> option_value
-val value_to_list : (option_value -> 'a) -> option_value -> 'a list
-val list_to_value : ('a -> option_value) -> 'a list -> option_value
diff --git a/ide/utils/configwin.ml b/ide/utils/configwin.ml
index 4606ef29..69e8b647 100644
--- a/ide/utils/configwin.ml
+++ b/ide/utils/configwin.ml
@@ -36,44 +36,16 @@ type return_button =
   | Return_ok
   | Return_cancel
 
-let string_to_key = Configwin_types.string_to_key
-let key_to_string = Configwin_types.key_to_string
-let key_cp_wrapper = Configwin_types.key_cp_wrapper
-class key_cp = Configwin_types.key_cp
-
-
 let string = Configwin_ihm.string
-let text = Configwin_ihm.text
 let strings = Configwin_ihm.strings
 let list = Configwin_ihm.list
 let bool = Configwin_ihm.bool
-let filename = Configwin_ihm.filename
-let filenames = Configwin_ihm.filenames
-let color = Configwin_ihm.color
-let font = Configwin_ihm.font
 let combo = Configwin_ihm.combo
 let custom = Configwin_ihm.custom
-let date = Configwin_ihm.date
-let hotkey = Configwin_ihm.hotkey
 let modifiers = Configwin_ihm.modifiers
-let html = Configwin_ihm.html
 
 let edit
     ?(apply=(fun () -> ()))
     title ?width ?height
     conf_struct_list =
   Configwin_ihm.edit ~with_apply: true ~apply title ?width ?height conf_struct_list
-
-let get = Configwin_ihm.edit ~with_apply: false ~apply: (fun () -> ())
-
-let simple_edit
-    ?(apply=(fun () -> ()))
-    title ?width ?height
-    param_list = Configwin_ihm.simple_edit ~with_apply: true ~apply title ?width ?height param_list
-
-let simple_get = Configwin_ihm.simple_edit
-    ~with_apply: false ~apply: (fun () -> ())
-
-let box = Configwin_ihm.box
-
-let tabbed_box = Configwin_ihm.tabbed_box
diff --git a/ide/utils/configwin.mli b/ide/utils/configwin.mli
index c5fbf39a..7616e471 100644
--- a/ide/utils/configwin.mli
+++ b/ide/utils/configwin.mli
@@ -50,22 +50,6 @@ type return_button =
 	 button or the window manager but never clicked
 	 on the apply button.*)
 
-
-(** {2 The key option class (to use with the {!Config_file} library)} *)
-
-val string_to_key : string -> Gdk.Tags.modifier list * int
-
-val key_to_string : Gdk.Tags.modifier list * int -> string
-
-val key_cp_wrapper : (Gdk.Tags.modifier list * int) Config_file.wrappers
-
-class key_cp :
-  ?group:Config_file.group ->
-  string list ->
-  ?short_name:string ->
-  Gdk.Tags.modifier list * int ->
-  string -> [Gdk.Tags.modifier list * int] Config_file.cp_custom_type
-
 (** {2 Functions to create parameters} *)
 
 (** [string label value] creates a string parameter.
@@ -136,24 +120,6 @@ val list : ?editable: bool -> ?help: string ->
 		  'a list ->
 		    parameter_kind
 
-(** [color label value] creates a color parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-*)
-val color : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
-(** [font label value] creates a font parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-*)
-val font : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
 (** [combo label choices value] creates a combo parameter.
    @param editable indicate if the value is editable (default is [true]).
    @param expand indicate if the entry widget must expand or not (default is [true]).
@@ -169,69 +135,6 @@ val combo : ?editable: bool -> ?expand: bool -> ?help: string ->
     ?new_allowed: bool -> ?blank_allowed: bool ->
       string -> string list -> string -> parameter_kind
 
-(** [text label value] creates a text parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the box for the text must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-*)
-val text : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
-(** Same as {!Configwin.text} but html bindings are available
-   in the text widget. Use the [configwin_html_config] utility
-   to edit your bindings.
-*)
-val html : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
-(** [filename label value] creates a filename parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-*)
-val filename : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
-(** [filenames label value] creates a filename list parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-   @param eq the comparison function, used not to have doubles in list. Default
-   is [Pervasives.(=)]. If you want to allow doubles in the list, give a function
-   always returning false.
-*)
-val filenames : ?editable: bool -> ?help: string ->
-  ?f: (string list -> unit) ->
-    ?eq: (string -> string -> bool) ->
-      string -> string list -> parameter_kind
-
-(** [date label value] creates a date parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-   @param f_string the function used to display the date as a string. The parameter
-   is a tupe [(day,month,year)], where [month] is between [0] and [11]. The default
-   function creates the string [year/month/day].
-*)
-val date : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: ((int * int * int) -> unit) ->
-    ?f_string: ((int * int * int -> string)) ->
-      string -> (int * int * int) -> parameter_kind
-
-(** [hotkey label value] creates a hot key parameter.
-   A hot key is defined by a list of modifiers and a key code.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-*)
-val hotkey : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: ((Gdk.Tags.modifier list * int) -> unit) ->
-    string -> (Gdk.Tags.modifier list * int) -> parameter_kind
-
 val modifiers : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?allow:(Gdk.Tags.modifier list) ->
   ?f: (Gdk.Tags.modifier list -> unit) ->
@@ -259,46 +162,3 @@ val edit :
   ?height:int ->
   configuration_structure list ->
   return_button
-
-(** This function takes a configuration structure and creates a window used
-   to get the various parameters from the user. It is the same window as edit but
-   there is no apply button.*)
-val get :
-  string ->
-  ?width:int ->
-  ?height:int ->
-  configuration_structure list ->
-  return_button
-
-(** This function takes a list of parameter specifications and
-   creates a window to configure the various parameters.
-   @param apply this function is called when the apply button is clicked, after
-   giving new values to parameters.*)
-val simple_edit :
-  ?apply: (unit -> unit) ->
-  string ->
-  ?width:int ->
-  ?height:int ->
-  parameter_kind list -> return_button
-
-(** This function takes a list of parameter specifications and
-   creates a window to configure the various parameters,
-   without Apply button.*)
-val simple_get :
-  string ->
-  ?width:int ->
-  ?height:int ->
-  parameter_kind list -> return_button
-
-(** Create a [GPack.box] with the list of given parameters,
-   Return the box and the function to call to apply new values to parameters.
-*)
-val box : parameter_kind list -> GData.tooltips -> GPack.box * (unit -> unit)
-
-(** Create a [GPack.box] with the list of given configuration structure list,
-   and the given list of buttons (defined by their label and callback).
-   Before calling the callback of a button, the [apply] function
-   of each parameter is called.
-*)
-val tabbed_box : configuration_structure list ->
-  (string * (unit -> unit)) list -> GData.tooltips -> GPack.box
diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml
index c1062a9d..d16efa60 100644
--- a/ide/utils/configwin_ihm.ml
+++ b/ide/utils/configwin_ihm.ml
@@ -27,7 +27,25 @@
 
 open Configwin_types
 
-module O = Config_file
+let modifiers_to_string m =
+  let rec iter m s =
+    match m with
+        [] -> s
+      | c :: m ->
+          iter m ((
+                    match c with
+			`CONTROL -> "<ctrl>"
+		      | `SHIFT -> "<shft>"
+		      | `LOCK -> "<lock>"
+		      | `MOD1 -> "<alt>"
+		      | `MOD2 -> "<mod2>"
+		      | `MOD3 -> "<mod3>"
+		      | `MOD4 -> "<mod4>"
+		      | `MOD5 -> "<mod5>"
+		      | _  -> raise Not_found
+                  ) ^ s)
+  in
+    iter m ""
 
 class type widget =
   object
@@ -35,112 +53,9 @@ class type widget =
     method apply : unit -> unit
   end
 
-let file_html_config = Filename.concat Configwin_messages.home ".configwin_html"
-
 let debug = false
 let dbg s = if debug then Minilib.log s else ()
 
-(** Return the config group for the html config file,
-   and the option for bindings. *)
-let html_config_file_and_option () =
-  let ini = new O.group in
-  let bindings = new O.list_cp
-      Configwin_types.htmlbinding_cp_wrapper
-      ~group: ini
-      ["bindings"]
-      ~short_name: "bd"
-      [ { html_key = Configwin_types.string_to_key "A-b" ;
-	  html_begin = "<b>";
-	  html_end = "</b>" ;
-	} ;
-	{ html_key = Configwin_types.string_to_key "A-i" ;
-	  html_begin = "<i>";
-	  html_end = "</i>" ;
-	}
-      ]
-      ""
-  in
-  ini#read file_html_config ;
-  (ini, bindings)
-
-(** This variable contains the last directory where the user selected a file.*)
-let last_dir = ref "";;
-
-(** This function allows the user to select a file and returns the
-   selected file name. An optional function allows changing the
-   behaviour of the ok button.
-   A VOIR : mutli-selection ? *)
-let select_files ?dir
-    ?(fok : (string -> unit) option)
-    the_title =
-  let files = ref ([] : string list) in
-  let fs = GWindow.file_selection ~modal:true
-      ~title: the_title () in
-  (* we set the previous directory, if no directory is given *)
-  (
-   match dir with
-     None ->
-       if !last_dir <> "" then
-         let _ = fs#set_filename !last_dir in
-         ()
-       else
-         ()
-  | Some dir ->
-      let _ = fs#set_filename !last_dir in
-      ()
-  );
-
-  let _ = fs # connect#destroy ~callback: GMain.Main.quit in
-  let _ = fs # ok_button # connect#clicked ~callback:
-      (match fok with
-        None ->
-          (fun () -> files := [fs#filename] ; fs#destroy ())
-      | Some f ->
-          (fun () -> f fs#filename)
-      )
-  in
-  let _ = fs # cancel_button # connect#clicked ~callback:fs#destroy in
-  fs # show ();
-  GMain.Main.main ();
-  match !files with
-  | [] ->
-      []
-  | [""] ->
-      []
-  | l ->
-      (* we keep the directory in last_dir *)
-      last_dir := Filename.dirname (List.hd l);
-      l
-;;
-
-(** Make the user select a date. *)
-let select_date title (day,mon,year) =
-  let v_opt = ref None in
-  let window = GWindow.dialog ~modal:true ~title () in
-  let hbox = GPack.hbox ~border_width:10 ~packing:window#vbox#add () in
-  let cal = GMisc.calendar ~packing: (hbox#pack ~expand: true) () in
-  cal#select_month ~month: mon ~year: year ;
-  cal#select_day day;
-  let bbox = window#action_area in
-
-  let bok = GButton.button ~label: Configwin_messages.mOk
-      ~packing:(bbox#pack ~expand:true ~padding:4) ()
-  in
-  let bcancel = GButton.button ~label: Configwin_messages.mCancel
-      ~packing:(bbox#pack ~expand:true ~padding:4) ()
-  in
-  ignore (bok#connect#clicked ~callback:
-	    (fun () -> v_opt := Some (cal#date); window#destroy ()));
-  ignore(bcancel#connect#clicked ~callback: window#destroy);
-
-  bok#grab_default ();
-  ignore(window#connect#destroy ~callback: GMain.Main.quit);
-  window#set_position `CENTER;
-  window#show ();
-  GMain.Main.main ();
-  !v_opt
-
-
 (** This class builds a frame with a clist and two buttons :
    one to add items and one to remove the selected items.
    The class takes in parameter a function used to add items and
@@ -460,164 +375,6 @@ class custom_param_box param (tt:GData.tooltips) =
     method apply = param.custom_f_apply ()
   end
 
-(** This class is used to build a box for a color parameter.*)
-class color_param_box param (tt:GData.tooltips) =
-  let _ = dbg "color_param_box" in
-  let v = ref param.color_value in
-  let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.color_label
-      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
-  in
-  let w_test = GMisc.arrow
-      ~kind: `RIGHT
-      ~shadow: `OUT
-      ~width: 20
-      ~height: 20
-      ~packing: (hbox#pack ~expand: false ~padding: 2 )
-      ()
-  in
-  let we = GEdit.entry
-      ~editable: param.color_editable
-      ~packing: (hbox#pack ~expand: param.color_expand ~padding: 2)
-      ()
-  in
-  let _ =
-    match param.color_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wb#coerce
-  in
-  let set_color s =
-    let style = w_test#misc#style#copy in
-    (
-     try style#set_fg [ (`NORMAL, `NAME s) ; ]
-     with _ -> ()
-    );
-    w_test#misc#set_style style;
-  in
-  let _ = set_color !v in
-  let _ = we#set_text !v in
-  let f_sel () =
-    let dialog = GWindow.color_selection_dialog
-	~title: param.color_label
-	~modal: true
-	~show: true
-	()
-    in
-    let wb_ok = dialog#ok_button in
-    let wb_cancel = dialog#cancel_button in
-    let _ = dialog#connect#destroy ~callback:GMain.Main.quit in
-    let _ = wb_ok#connect#clicked
-	~callback:(fun () ->
-(*	  let color = dialog#colorsel#color in
-	  let r = (Gdk.Color.red color) in
-	  let g = (Gdk.Color.green color)in
-	  let b = (Gdk.Color.blue color) in
-	  let s = Printf.sprintf "#%4X%4X%4X" r g b in
-	  let _ =
-	    for i = 1 to (String.length s) - 1 do
-	      if s.[i] = ' ' then s.[i] <- '0'
-	    done
-	  in
-	  we#set_text s ; *)
-	  dialog#destroy ()
-	)
-    in
-    let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in
-    GMain.Main.main ()
-  in
-  let _ =
-    if param.color_editable then ignore (wb#connect#clicked ~callback:f_sel)
-  in
-
-  object (self)
-    (** This method returns the main box ready to be packed. *)
-    method box = hbox#coerce
-    (** This method applies the new value of the parameter. *)
-    method apply =
-      let new_value = we#text in
-      if new_value <> param.color_value then
-	let _ = param.color_f_apply new_value in
-	param.color_value <- new_value
-      else
-	()
-
-    initializer
-      ignore (we#connect#changed ~callback:(fun () -> set_color we#text));
-
-  end ;;
-
-(** This class is used to build a box for a font parameter.*)
-class font_param_box param (tt:GData.tooltips) =
-  let _ = dbg "font_param_box" in
-  let v = ref param.font_value in
-  let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.font_label
-      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
-  in
-  let we = GEdit.entry
-      ~editable: false
-      ~packing: (hbox#pack ~expand: param.font_expand ~padding: 2)
-      ()
-  in
-  let _ =
-    match param.font_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wb#coerce
-  in
-  let set_entry_font font_opt =
-    match font_opt with
-      None -> ()
-    | Some s ->
-	let style = we#misc#style#copy in
-	(
-	 try
-	   let font = Gdk.Font.load_fontset s in
-	   style#set_font font
-	 with _ -> ()
-	);
-	we#misc#set_style style
-  in
-  let _ = set_entry_font (Some !v) in
-  let _ = we#set_text !v in
-  let f_sel () =
-    let dialog = GWindow.font_selection_dialog
-	~title: param.font_label
-	~modal: true
-	~show: true
-	()
-    in
-    dialog#selection#set_font_name !v;
-    let wb_ok = dialog#ok_button in
-    let wb_cancel = dialog#cancel_button in
-    let _ = dialog#connect#destroy ~callback:GMain.Main.quit in
-    let _ = wb_ok#connect#clicked
-	~callback:(fun () ->
-	  let font = dialog#selection#font_name in
-	  we#set_text font ;
-	  set_entry_font (Some font);
-	  dialog#destroy ()
-	)
-    in
-    let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in
-    GMain.Main.main ()
-  in
-  let _ = if param.font_editable then ignore (wb#connect#clicked ~callback:f_sel) in
-
-  object (self)
-    (** This method returns the main box ready to be packed. *)
-    method box = hbox#coerce
-    (** This method applies the new value of the parameter. *)
-    method apply =
-      let new_value = we#text in
-      if new_value <> param.font_value then
-	let _ = param.font_f_apply new_value in
-	param.font_value <- new_value
-      else
-	()
-  end ;;
-
 (** This class is used to build a box for a text parameter.*)
 class text_param_box param (tt:GData.tooltips) =
   let _ = dbg "text_param_box" in
@@ -654,7 +411,7 @@ class text_param_box param (tt:GData.tooltips) =
       let v = param.string_of_string (buffer#get_text ()) in
       if v <> param.string_value then
 	(
-	 dbg "apply new value !";
+	 dbg "apply new value!";
 	 let _ = param.string_f_apply v in
 	 param.string_value <- v
 	)
@@ -662,35 +419,6 @@ class text_param_box param (tt:GData.tooltips) =
 	()
   end ;;
 
-(** This class is used to build a box a html parameter. *)
-class html_param_box param (tt:GData.tooltips) =
-  let _ = dbg "html_param_box" in
-  object (self)
-    inherit text_param_box param tt
-
-    method private exec html_start html_end () =
-      let (i1,i2) = wview#buffer#selection_bounds in
-      let s = i1#get_text ~stop: i2 in
-      match s with
-	"" ->
-	  wview#buffer#insert (html_start^html_end)
-      |	_ ->
-	  ignore (wview#buffer#insert ~iter: i2 html_end);
-	  ignore (wview#buffer#insert ~iter: i1 html_start);
-	  wview#buffer#place_cursor ~where: i2
-
-    initializer
-      dbg "html_param_box:initializer";
-      let (_,html_bindings) = html_config_file_and_option () in
-      dbg "html_param_box:connecting key press events";
-      let add_shortcut hb =
-	let (mods, k) = hb.html_key in
-	Okey.add wview ~mods k (self#exec hb.html_begin hb.html_end)
-      in
-      List.iter add_shortcut html_bindings#get;
-      dbg "html_param_box:end"
-  end
-
 (** This class is used to build a box for a boolean parameter.*)
 class bool_param_box param (tt:GData.tooltips) =
   let _ = dbg "bool_param_box" in
@@ -719,105 +447,6 @@ class bool_param_box param (tt:GData.tooltips) =
 	()
   end ;;
 
-(** This class is used to build a box for a file name parameter.*)
-class filename_param_box param (tt:GData.tooltips) =
-  let _ = dbg "filename_param_box" in
-  let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.string_label
-      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
-  in
-  let we = GEdit.entry
-      ~editable: param.string_editable
-      ~packing: (hbox#pack ~expand: param.string_expand ~padding: 2)
-      ()
-  in
-  let _ =
-    match param.string_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wb#coerce
-  in
-  let _ = we#set_text (param.string_to_string param.string_value) in
-
-  let f_click () =
-    match select_files param.string_label with
-      [] ->
-        ()
-    | f :: _ ->
-        we#set_text f
-  in
-  let _ =
-    if param.string_editable then
-      let _ = wb#connect#clicked ~callback:f_click in
-      ()
-    else
-      ()
-  in
-
-  object (self)
-    (** This method returns the main box ready to be packed. *)
-    method box = hbox#coerce
-    (** This method applies the new value of the parameter. *)
-    method apply =
-      let new_value = param.string_of_string we#text in
-      if new_value <> param.string_value then
-	let _ = param.string_f_apply new_value in
-	param.string_value <- new_value
-      else
-	()
-  end ;;
-
-(** This class is used to build a box for a hot key parameter.*)
-class hotkey_param_box param (tt:GData.tooltips) =
-  let _ = dbg "hotkey_param_box" in
-  let hbox = GPack.hbox () in
-  let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in
-  let _wl = GMisc.label ~text: param.hk_label ~packing: wev#add () in
-  let we = GEdit.entry
-      ~editable: false
-      ~packing: (hbox#pack ~expand: param.hk_expand ~padding: 2)
-      ()
-  in
-  let value = ref param.hk_value in
-  let _ =
-    match param.hk_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wev#coerce
-  in
-  let _ = we#set_text (Configwin_types.key_to_string param.hk_value) in
-  let mods_we_dont_care = [`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] in
-  let capture ev =
-    let key = GdkEvent.Key.keyval ev in
-    let modifiers = GdkEvent.Key.state ev in
-    let mods = List.filter
-	(fun m -> not (List.mem m mods_we_dont_care))
-	modifiers
-    in
-    value := (mods, key);
-    we#set_text (Glib.Convert.locale_to_utf8 (Configwin_types.key_to_string !value));
-    false
-  in
-  let _ =
-    if param.hk_editable then
-      ignore (we#event#connect#key_press ~callback:capture)
-    else
-      ()
-  in
-
-  object (self)
-    (** This method returns the main box ready to be packed. *)
-    method box = hbox#coerce
-    (** This method applies the new value of the parameter. *)
-    method apply =
-      let new_value = !value in
-      if new_value <> param.hk_value then
-	let _ = param.hk_f_apply new_value in
-	param.hk_value <- new_value
-      else
-	()
-  end ;;
-
 class modifiers_param_box param =
   let hbox = GPack.hbox () in
   let wev = GBin.event_box ~packing: (hbox#pack ~expand:true ~fill:true ~padding: 2) () in
@@ -825,7 +454,7 @@ class modifiers_param_box param =
   let value = ref param.md_value in
   let _ = List.map (fun modifier ->
                       let but = GButton.toggle_button
-                                  ~label:(Configwin_types.modifiers_to_string [modifier])
+                                  ~label:(modifiers_to_string [modifier])
                                   ~active:(List.mem modifier param.md_value)
                                   ~packing:(hbox#pack ~expand:false) () in
                       ignore (but#connect#toggled
@@ -854,55 +483,6 @@ class modifiers_param_box param =
 	()
   end ;;
 
-(** This class is used to build a box for a date parameter.*)
-class date_param_box param (tt:GData.tooltips) =
-  let _ = dbg "date_param_box" in
-  let v = ref param.date_value in
-  let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.date_label
-      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
-  in
-  let we = GEdit.entry
-      ~editable: false
-      ~packing: (hbox#pack ~expand: param.date_expand ~padding: 2)
-      ()
-  in
-
-  let _ =
-    match param.date_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wb#coerce
-  in
-
-  let _ = we#set_text (param.date_f_string param.date_value) in
-  let f_click () =
-    match select_date param.date_label !v with
-      None -> ()
-    | Some (y,m,d) ->
-	v := (d,m,y) ;
-	we#set_text (param.date_f_string (d,m,y))
-  in
-  let _ =
-    if param.date_editable then
-      let _ = wb#connect#clicked ~callback:f_click in
-      ()
-    else
-      ()
-  in
-
-  object (self)
-    (** This method returns the main box ready to be packed. *)
-    method box = hbox#coerce
-    (** This method applies the new value of the parameter. *)
-    method apply =
-      if !v <> param.date_value then
-	let _ = param.date_f_apply !v in
-	param.date_value <- !v
-      else
-	()
-  end ;;
-
 (** This class is used to build a box for a parameter whose values are a list.*)
 class ['a] list_param_box (param : 'a list_param) (tt:GData.tooltips) =
   let _ = dbg "list_param_box" in
@@ -975,10 +555,6 @@ class configuration_box (tt : GData.tooltips) conf_struct =
     let box = new bool_param_box p tt in
     let _ = main_box#pack ~expand: false ~padding: 2 box#box in
     box
-  | Filename_param p ->
-    let box = new filename_param_box p tt in
-    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-    box
   | List_param f ->
     let box = f tt in
     let _ = main_box#pack ~expand: true ~padding: 2 box#box in
@@ -987,30 +563,10 @@ class configuration_box (tt : GData.tooltips) conf_struct =
     let box = new custom_param_box p tt in
     let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in
     box
-  | Color_param p ->
-    let box = new color_param_box p tt in
-    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-    box
-  | Font_param p ->
-    let box = new font_param_box p tt in
-    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-    box
-  | Date_param p ->
-    let box = new date_param_box p tt in
-    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-    box
-  | Hotkey_param p ->
-    let box = new hotkey_param_box p tt in
-    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-    box
   | Modifiers_param p ->
     let box = new modifiers_param_box p in
     let _ = main_box#pack ~expand: false ~padding: 2 box#box in
     box
-  | Html_param p ->
-    let box = new html_param_box p tt in
-    let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
-    box
   in
 
   let set_icon iter = function
@@ -1102,36 +658,6 @@ class configuration_box (tt : GData.tooltips) conf_struct =
 
   end
 
-(** Create a vbox with the list of given configuration structure list,
-   and the given list of buttons (defined by their label and callback).
-   Before calling the callback of a button, the [apply] function
-   of each parameter is called.
-*)
-let tabbed_box conf_struct_list buttons tooltips =
-  let param_box =
-       new configuration_box tooltips conf_struct_list
-  in
-  let f_apply () = param_box#apply
-  in
-  let hbox_buttons = GPack.hbox ~packing: (param_box#box#pack ~expand: false ~padding: 4) () in
-  let rec iter_buttons ?(grab=false) = function
-      [] ->
-        ()
-    | (label, callb) :: q ->
-        let b = GButton.button ~label: label
-            ~packing:(hbox_buttons#pack ~expand:true ~fill: true ~padding:4) ()
-        in
-        ignore (b#connect#clicked ~callback:
-		  (fun () -> f_apply (); callb ()));
-        (* If it's the first button then give it the focus *)
-        if grab then b#grab_default ();
-
-        iter_buttons q
-  in
-  iter_buttons ~grab: true buttons;
-
-  param_box#box
-
 (** This function takes a configuration structure list and creates a window
    to configure the various parameters. *)
 let edit ?(with_apply=true)
@@ -1174,110 +700,6 @@ let edit ?(with_apply=true)
   in
     iter Return_cancel
 
-(** Create a vbox with the list of given parameters. *)
-let box param_list tt =
-  let main_box = GPack.vbox  () in
-  let f parameter =
-    match parameter with
-      String_param p ->
-	let box = new string_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Combo_param p ->
-	let box = new combo_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Text_param p ->
-	let box = new text_param_box p tt in
-	let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
-	box
-    | Bool_param p ->
-	let box = new bool_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Filename_param p ->
-	let box = new filename_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | List_param f ->
-	let box = f tt in
-	let _ = main_box#pack ~expand: true ~padding: 2 box#box in
-	box
-    | Custom_param p ->
-	let box = new custom_param_box p tt in
-	let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in
-	box
-    | Color_param p ->
-	let box = new color_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Font_param p ->
-	let box = new font_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Date_param p ->
-	let box = new date_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Hotkey_param p ->
-	let box = new hotkey_param_box p tt in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Modifiers_param p ->
-	let box = new modifiers_param_box p in
-	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	box
-    | Html_param p ->
-	let box = new html_param_box p tt in
-	let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
-	box
-  in
-  let list_param_box = List.map f param_list in
-  let f_apply () =
-    List.iter (fun param_box -> param_box#apply) list_param_box
-  in
-  (main_box, f_apply)
-
-(** This function takes a list of parameter specifications and
-   creates a window to configure the various parameters.*)
-let simple_edit ?(with_apply=true)
-    ?(apply=(fun () -> ()))
-    title ?width ?height
-    param_list =
-  let dialog = GWindow.dialog
-      ~modal: true ~title: title
-      ?height ?width
-      ()
-  in
-  let tooltips = GData.tooltips () in
-  if with_apply then
-    dialog#add_button Configwin_messages.mApply `APPLY;
-
-  dialog#add_button Configwin_messages.mOk `OK;
-  dialog#add_button Configwin_messages.mCancel `CANCEL;
-
-  let (box, f_apply) = box param_list tooltips in
-  dialog#vbox#pack ~expand: true ~fill: true box#coerce;
-
-  let destroy () =
-    tooltips#destroy () ;
-    dialog#destroy ();
-  in
-  let rec iter rep =
-    try
-      match dialog#run () with
-      | `APPLY  -> f_apply (); apply (); iter Return_apply
-      | `OK -> f_apply () ; destroy () ; Return_ok
-      | _ -> destroy (); rep
-    with
-      Failure s ->
-	GToolbox.message_box ~title:"Error" s; iter rep
-    | e ->
-	GToolbox.message_box ~title:"Error" (Printexc.to_string e); iter rep
-  in
-  iter Return_cancel
-
-
 let edit_string l s =
   match GToolbox.input_string ~title: l ~text: s Configwin_messages.mValue with
     None -> s
@@ -1342,30 +764,6 @@ let strings ?(editable=true) ?help
     ?(add=(fun () -> [])) label v =
   list ~editable ?help ~f ~eq ~edit: (edit_string label) ~add label (fun s -> [s]) v
 
-(** Create a color param. *)
-let color ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Color_param
-    {
-      color_label = label ;
-      color_help = help ;
-      color_value = v ;
-      color_editable = editable ;
-      color_f_apply = f ;
-      color_expand = expand ;
-    }
-
-(** Create a font param. *)
-let font ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Font_param
-    {
-      font_label = label ;
-      font_help = help ;
-      font_value = v ;
-      font_editable = editable ;
-      font_f_apply = f ;
-      font_expand = expand ;
-    }
-
 (** Create a combo param. *)
 let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
     ?(new_allowed=false)
@@ -1383,82 +781,6 @@ let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
       combo_expand = expand ;
     }
 
-(** Create a text param. *)
-let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Text_param
-    {
-      string_label = label ;
-      string_help = help ;
-      string_value = v ;
-      string_editable = editable ;
-      string_f_apply = f ;
-      string_expand = expand ;
-      string_to_string = (fun x -> x) ;
-      string_of_string = (fun x -> x) ;
-    }
-
-(** Create a html param. *)
-let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Html_param
-    {
-      string_label = label ;
-      string_help = help ;
-      string_value = v ;
-      string_editable = editable ;
-      string_f_apply = f ;
-      string_expand = expand ;
-      string_to_string = (fun x -> x) ;
-      string_of_string = (fun x -> x) ;
-    }
-
-(** Create a filename param. *)
-let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label v =
-  Filename_param
-    {
-      string_label = label ;
-      string_help = help ;
-      string_value = v ;
-      string_editable = editable ;
-      string_f_apply = f ;
-      string_expand = expand ;
-      string_to_string = (fun x -> x) ;
-      string_of_string = (fun x -> x) ;
-    }
-
-(** Create a filenames param.*)
-let filenames ?(editable=true) ?help ?(f=(fun _ -> ()))
-    ?(eq=Pervasives.(=))
-    label v =
-  let add () = select_files label in
-  list ~editable ?help ~f ~eq ~add label (fun s -> [Glib.Convert.locale_to_utf8 s]) v
-
-(** Create a date param. *)
-let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
-    ?(f_string=(fun(d,m,y)-> Printf.sprintf "%d/%d/%d" y (m+1) d))
-    label v =
-  Date_param
-    {
-      date_label = label ;
-      date_help = help ;
-      date_value = v ;
-      date_editable = editable ;
-      date_f_string = f_string ;
-      date_f_apply = f ;
-      date_expand = expand ;
-    }
-
-(** Create a hot key param. *)
-let hotkey ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Hotkey_param
-    {
-      hk_label = label ;
-      hk_help = help ;
-      hk_value = v ;
-      hk_editable = editable ;
-      hk_f_apply = f ;
-      hk_expand = expand ;
-    }
-
 let modifiers
   ?(editable=true)
   ?(expand=true)
diff --git a/ide/utils/configwin_ihm.mli b/ide/utils/configwin_ihm.mli
new file mode 100644
index 00000000..c867ad91
--- /dev/null
+++ b/ide/utils/configwin_ihm.mli
@@ -0,0 +1,66 @@
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
+
+open Configwin_types
+
+val string : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: (string -> unit) -> string -> string -> parameter_kind
+val bool : ?editable: bool -> ?help: string ->
+  ?f: (bool -> unit) -> string -> bool -> parameter_kind
+val strings : ?editable: bool -> ?help: string ->
+  ?f: (string list -> unit) ->
+    ?eq: (string -> string -> bool) ->
+      ?add: (unit -> string list) ->
+        string -> string list -> parameter_kind
+val list : ?editable: bool -> ?help: string ->
+  ?f: ('a list -> unit) ->
+    ?eq: ('a -> 'a -> bool) ->
+      ?edit: ('a -> 'a) ->
+        ?add: (unit -> 'a list) ->
+          ?titles: string list ->
+            ?color: ('a -> string option) ->
+              string ->
+                ('a -> string list) ->
+                  'a list ->
+                    parameter_kind
+val combo : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: (string -> unit) ->
+    ?new_allowed: bool -> ?blank_allowed: bool ->
+      string -> string list -> string -> parameter_kind
+
+val modifiers : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?allow:(Gdk.Tags.modifier list) ->
+  ?f: (Gdk.Tags.modifier list -> unit) ->
+    string -> Gdk.Tags.modifier list -> parameter_kind
+val custom : ?label: string -> GPack.box -> (unit -> unit) -> bool -> parameter_kind
+
+val edit :
+  ?with_apply:bool ->
+  ?apply:(unit -> unit) ->
+  string ->
+  ?width:int ->
+  ?height:int ->
+  configuration_structure list ->
+  return_button
diff --git a/ide/utils/configwin_keys.ml b/ide/utils/configwin_keys.ml
deleted file mode 100644
index e9b19da6..00000000
--- a/ide/utils/configwin_keys.ml
+++ /dev/null
@@ -1,4176 +0,0 @@
-(*********************************************************************************)
-(*                Cameleon                                                       *)
-(*                                                                               *)
-(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
-(*    en Automatique. All rights reserved.                                       *)
-(*                                                                               *)
-(*    This program is free software; you can redistribute it and/or modify       *)
-(*    it under the terms of the GNU Library General Public License as            *)
-(*    published by the Free Software Foundation; either version 2 of the         *)
-(*    License, or  any later version.                                            *)
-(*                                                                               *)
-(*    This program is distributed in the hope that it will be useful,            *)
-(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
-(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
-(*    GNU Library General Public License for more details.                       *)
-(*                                                                               *)
-(*    You should have received a copy of the GNU Library General Public          *)
-(*    License along with this program; if not, write to the Free Software        *)
-(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
-(*    02111-1307  USA                                                            *)
-(*                                                                               *)
-(*    Contact: Maxence.Guesdon@inria.fr                                          *)
-(*                                                                               *)
-(*********************************************************************************)
-
-(** Key codes
-
-   Ce fichier provient de X11/keysymdef.h
-   les noms des symboles deviennent : XK_ -> xk_
-
-   Thanks to Fabrice Le Fessant.
-*)
-
-let xk_VoidSymbol		= 0xFFFFFF	(** void symbol *)
-
-
-(** TTY Functions, cleverly chosen to map to ascii, for convenience of
-  programming, but could have been arbitrary (at the cost of lookup
-  tables in client code.
-*)
-
-let xk_BackSpace		= 0xFF08	(** back space, back char *)
-let xk_Tab			= 0xFF09
-let xk_Linefeed		= 0xFF0A	(** Linefeed, LF *)
-let xk_Clear		= 0xFF0B
-let xk_Return		= 0xFF0D	(** Return, enter *)
-let xk_Pause		= 0xFF13	(** Pause, hold *)
-let xk_Scroll_Lock		= 0xFF14
-let xk_Sys_Req		= 0xFF15
-let xk_Escape		= 0xFF1B
-let xk_Delete		= 0xFFFF	(** Delete, rubout *)
-
-
-
-(** International & multi-key character composition *)
-
-let xk_Multi_key		= 0xFF20  (** Multi-key character compose *)
-
-(** Japanese keyboard support *)
-
-let xk_Kanji		= 0xFF21	(** Kanji, Kanji convert *)
-let xk_Muhenkan		= 0xFF22  (** Cancel Conversion *)
-let xk_Henkan_Mode		= 0xFF23  (** Start/Stop Conversion *)
-let xk_Henkan		= 0xFF23  (** Alias for Henkan_Mode *)
-let xk_Romaji		= 0xFF24  (** to Romaji *)
-let xk_Hiragana		= 0xFF25  (** to Hiragana *)
-let xk_Katakana		= 0xFF26  (** to Katakana *)
-let xk_Hiragana_Katakana	= 0xFF27  (** Hiragana/Katakana toggle *)
-let xk_Zenkaku		= 0xFF28  (** to Zenkaku *)
-let xk_Hankaku		= 0xFF29  (** to Hankaku *)
-let xk_Zenkaku_Hankaku	= 0xFF2A  (** Zenkaku/Hankaku toggle *)
-let xk_Touroku		= 0xFF2B  (** Add to Dictionary *)
-let xk_Massyo		= 0xFF2C  (** Delete from Dictionary *)
-let xk_Kana_Lock		= 0xFF2D  (** Kana Lock *)
-let xk_Kana_Shift		= 0xFF2E  (** Kana Shift *)
-let xk_Eisu_Shift		= 0xFF2F  (** Alphanumeric Shift *)
-let xk_Eisu_toggle		= 0xFF30  (** Alphanumeric toggle *)
-
-(** = 0xFF31 thru = 0xFF3F are under xk_KOREAN *)
-
-(** Cursor control & motion *)
-
-let xk_Home			= 0xFF50
-let xk_Left			= 0xFF51	(** Move left, left arrow *)
-let xk_Up			= 0xFF52	(** Move up, up arrow *)
-let xk_Right		= 0xFF53	(** Move right, right arrow *)
-let xk_Down			= 0xFF54	(** Move down, down arrow *)
-let xk_Prior		= 0xFF55	(** Prior, previous *)
-let xk_Page_Up		= 0xFF55
-let xk_Next			= 0xFF56	(** Next *)
-let xk_Page_Down		= 0xFF56
-let xk_End			= 0xFF57	(** EOL *)
-let xk_Begin		= 0xFF58	(** BOL *)
-
-
-(** Misc Functions *)
-
-let xk_Select		= 0xFF60	(** Select, mark *)
-let xk_Print		= 0xFF61
-let xk_Execute		= 0xFF62	(** Execute, run, do *)
-let xk_Insert		= 0xFF63	(** Insert, insert here *)
-let xk_Undo			= 0xFF65	(** Undo, oops *)
-let xk_Redo			= 0xFF66	(** redo, again *)
-let xk_Menu			= 0xFF67
-let xk_Find			= 0xFF68	(** Find, search *)
-let xk_Cancel		= 0xFF69	(** Cancel, stop, abort, exit *)
-let xk_Help			= 0xFF6A	(** Help *)
-let xk_Break		= 0xFF6B
-let xk_Mode_switch		= 0xFF7E	(** Character set switch *)
-let xk_script_switch        = 0xFF7E  (** Alias for mode_switch *)
-let xk_Num_Lock		= 0xFF7F
-
-(** Keypad Functions, keypad numbers cleverly chosen to map to ascii *)
-
-let xk_KP_Space		= 0xFF80	(** space *)
-let xk_KP_Tab		= 0xFF89
-let xk_KP_Enter		= 0xFF8D	(** enter *)
-let xk_KP_F1		= 0xFF91	(** PF1, KP_A, ... *)
-let xk_KP_F2		= 0xFF92
-let xk_KP_F3		= 0xFF93
-let xk_KP_F4		= 0xFF94
-let xk_KP_Home		= 0xFF95
-let xk_KP_Left		= 0xFF96
-let xk_KP_Up		= 0xFF97
-let xk_KP_Right		= 0xFF98
-let xk_KP_Down		= 0xFF99
-let xk_KP_Prior		= 0xFF9A
-let xk_KP_Page_Up		= 0xFF9A
-let xk_KP_Next		= 0xFF9B
-let xk_KP_Page_Down		= 0xFF9B
-let xk_KP_End		= 0xFF9C
-let xk_KP_Begin		= 0xFF9D
-let xk_KP_Insert		= 0xFF9E
-let xk_KP_Delete		= 0xFF9F
-let xk_KP_Equal		= 0xFFBD	(** equals *)
-let xk_KP_Multiply		= 0xFFAA
-let xk_KP_Add		= 0xFFAB
-let xk_KP_Separator		= 0xFFAC	(** separator, often comma *)
-let xk_KP_Subtract		= 0xFFAD
-let xk_KP_Decimal		= 0xFFAE
-let xk_KP_Divide		= 0xFFAF
-
-let xk_KP_0			= 0xFFB0
-let xk_KP_1			= 0xFFB1
-let xk_KP_2			= 0xFFB2
-let xk_KP_3			= 0xFFB3
-let xk_KP_4			= 0xFFB4
-let xk_KP_5			= 0xFFB5
-let xk_KP_6			= 0xFFB6
-let xk_KP_7			= 0xFFB7
-let xk_KP_8			= 0xFFB8
-let xk_KP_9			= 0xFFB9
-
-
-
-(*
- * Auxiliary Functions; note the duplicate definitions for left and right
- * function keys;  Sun keyboards and a few other manufactures have such
- * function key groups on the left and/or right sides of the keyboard.
- * We've not found a keyboard with more than 35 function keys total.
- *)
-
-let xk_F1			= 0xFFBE
-let xk_F2			= 0xFFBF
-let xk_F3			= 0xFFC0
-let xk_F4			= 0xFFC1
-let xk_F5			= 0xFFC2
-let xk_F6			= 0xFFC3
-let xk_F7			= 0xFFC4
-let xk_F8			= 0xFFC5
-let xk_F9			= 0xFFC6
-let xk_F10			= 0xFFC7
-let xk_F11			= 0xFFC8
-let xk_L1			= 0xFFC8
-let xk_F12			= 0xFFC9
-let xk_L2			= 0xFFC9
-let xk_F13			= 0xFFCA
-let xk_L3			= 0xFFCA
-let xk_F14			= 0xFFCB
-let xk_L4			= 0xFFCB
-let xk_F15			= 0xFFCC
-let xk_L5			= 0xFFCC
-let xk_F16			= 0xFFCD
-let xk_L6			= 0xFFCD
-let xk_F17			= 0xFFCE
-let xk_L7			= 0xFFCE
-let xk_F18			= 0xFFCF
-let xk_L8			= 0xFFCF
-let xk_F19			= 0xFFD0
-let xk_L9			= 0xFFD0
-let xk_F20			= 0xFFD1
-let xk_L10			= 0xFFD1
-let xk_F21			= 0xFFD2
-let xk_R1			= 0xFFD2
-let xk_F22			= 0xFFD3
-let xk_R2			= 0xFFD3
-let xk_F23			= 0xFFD4
-let xk_R3			= 0xFFD4
-let xk_F24			= 0xFFD5
-let xk_R4			= 0xFFD5
-let xk_F25			= 0xFFD6
-let xk_R5			= 0xFFD6
-let xk_F26			= 0xFFD7
-let xk_R6			= 0xFFD7
-let xk_F27			= 0xFFD8
-let xk_R7			= 0xFFD8
-let xk_F28			= 0xFFD9
-let xk_R8			= 0xFFD9
-let xk_F29			= 0xFFDA
-let xk_R9			= 0xFFDA
-let xk_F30			= 0xFFDB
-let xk_R10			= 0xFFDB
-let xk_F31			= 0xFFDC
-let xk_R11			= 0xFFDC
-let xk_F32			= 0xFFDD
-let xk_R12			= 0xFFDD
-let xk_F33			= 0xFFDE
-let xk_R13			= 0xFFDE
-let xk_F34			= 0xFFDF
-let xk_R14			= 0xFFDF
-let xk_F35			= 0xFFE0
-let xk_R15			= 0xFFE0
-
-(** Modifiers *)
-
-let xk_Shift_L		= 0xFFE1	(** Left shift *)
-let xk_Shift_R		= 0xFFE2	(** Right shift *)
-let xk_Control_L		= 0xFFE3	(** Left control *)
-let xk_Control_R		= 0xFFE4	(** Right control *)
-let xk_Caps_Lock		= 0xFFE5	(** Caps lock *)
-let xk_Shift_Lock		= 0xFFE6	(** Shift lock *)
-
-let xk_Meta_L		= 0xFFE7	(** Left meta *)
-let xk_Meta_R		= 0xFFE8	(** Right meta *)
-let xk_Alt_L		= 0xFFE9	(** Left alt *)
-let xk_Alt_R		= 0xFFEA	(** Right alt *)
-let xk_Super_L		= 0xFFEB	(** Left super *)
-let xk_Super_R		= 0xFFEC	(** Right super *)
-let xk_Hyper_L		= 0xFFED	(** Left hyper *)
-let xk_Hyper_R		= 0xFFEE	(** Right hyper *)
-
-
-(*
- * ISO 9995 Function and Modifier Keys
- * Byte 3 = = 0xFE
- *)
-
-
-let	xk_ISO_Lock					= 0xFE01
-let	xk_ISO_Level2_Latch				= 0xFE02
-let	xk_ISO_Level3_Shift				= 0xFE03
-let	xk_ISO_Level3_Latch				= 0xFE04
-let	xk_ISO_Level3_Lock				= 0xFE05
-let	xk_ISO_Group_Shift		= 0xFF7E	(** Alias for mode_switch *)
-let	xk_ISO_Group_Latch				= 0xFE06
-let	xk_ISO_Group_Lock				= 0xFE07
-let	xk_ISO_Next_Group				= 0xFE08
-let	xk_ISO_Next_Group_Lock				= 0xFE09
-let	xk_ISO_Prev_Group				= 0xFE0A
-let	xk_ISO_Prev_Group_Lock				= 0xFE0B
-let	xk_ISO_First_Group				= 0xFE0C
-let	xk_ISO_First_Group_Lock				= 0xFE0D
-let	xk_ISO_Last_Group				= 0xFE0E
-let	xk_ISO_Last_Group_Lock				= 0xFE0F
-
-let	xk_ISO_Left_Tab					= 0xFE20
-let	xk_ISO_Move_Line_Up				= 0xFE21
-let	xk_ISO_Move_Line_Down				= 0xFE22
-let	xk_ISO_Partial_Line_Up				= 0xFE23
-let	xk_ISO_Partial_Line_Down			= 0xFE24
-let	xk_ISO_Partial_Space_Left			= 0xFE25
-let	xk_ISO_Partial_Space_Right			= 0xFE26
-let	xk_ISO_Set_Margin_Left				= 0xFE27
-let	xk_ISO_Set_Margin_Right				= 0xFE28
-let	xk_ISO_Release_Margin_Left			= 0xFE29
-let	xk_ISO_Release_Margin_Right			= 0xFE2A
-let	xk_ISO_Release_Both_Margins			= 0xFE2B
-let	xk_ISO_Fast_Cursor_Left				= 0xFE2C
-let	xk_ISO_Fast_Cursor_Right			= 0xFE2D
-let	xk_ISO_Fast_Cursor_Up				= 0xFE2E
-let	xk_ISO_Fast_Cursor_Down				= 0xFE2F
-let	xk_ISO_Continuous_Underline			= 0xFE30
-let	xk_ISO_Discontinuous_Underline			= 0xFE31
-let	xk_ISO_Emphasize				= 0xFE32
-let	xk_ISO_Center_Object				= 0xFE33
-let	xk_ISO_Enter					= 0xFE34
-
-let	xk_dead_grave					= 0xFE50
-let	xk_dead_acute					= 0xFE51
-let	xk_dead_circumflex				= 0xFE52
-let	xk_dead_tilde					= 0xFE53
-let	xk_dead_macron					= 0xFE54
-let	xk_dead_breve					= 0xFE55
-let	xk_dead_abovedot				= 0xFE56
-let	xk_dead_diaeresis				= 0xFE57
-let	xk_dead_abovering				= 0xFE58
-let	xk_dead_doubleacute				= 0xFE59
-let	xk_dead_caron					= 0xFE5A
-let	xk_dead_cedilla					= 0xFE5B
-let	xk_dead_ogonek					= 0xFE5C
-let	xk_dead_iota					= 0xFE5D
-let	xk_dead_voiced_sound				= 0xFE5E
-let	xk_dead_semivoiced_sound			= 0xFE5F
-let	xk_dead_belowdot				= 0xFE60
-
-let	xk_First_Virtual_Screen				= 0xFED0
-let	xk_Prev_Virtual_Screen				= 0xFED1
-let	xk_Next_Virtual_Screen				= 0xFED2
-let	xk_Last_Virtual_Screen				= 0xFED4
-let	xk_Terminate_Server				= 0xFED5
-
-let	xk_AccessX_Enable				= 0xFE70
-let	xk_AccessX_Feedback_Enable			= 0xFE71
-let	xk_RepeatKeys_Enable				= 0xFE72
-let	xk_SlowKeys_Enable				= 0xFE73
-let	xk_BounceKeys_Enable				= 0xFE74
-let	xk_StickyKeys_Enable				= 0xFE75
-let	xk_MouseKeys_Enable				= 0xFE76
-let	xk_MouseKeys_Accel_Enable			= 0xFE77
-let	xk_Overlay1_Enable				= 0xFE78
-let	xk_Overlay2_Enable				= 0xFE79
-let	xk_AudibleBell_Enable				= 0xFE7A
-
-let	xk_Pointer_Left					= 0xFEE0
-let	xk_Pointer_Right				= 0xFEE1
-let	xk_Pointer_Up					= 0xFEE2
-let	xk_Pointer_Down					= 0xFEE3
-let	xk_Pointer_UpLeft				= 0xFEE4
-let	xk_Pointer_UpRight				= 0xFEE5
-let	xk_Pointer_DownLeft				= 0xFEE6
-let	xk_Pointer_DownRight				= 0xFEE7
-let	xk_Pointer_Button_Dflt				= 0xFEE8
-let	xk_Pointer_Button1				= 0xFEE9
-let	xk_Pointer_Button2				= 0xFEEA
-let	xk_Pointer_Button3				= 0xFEEB
-let	xk_Pointer_Button4				= 0xFEEC
-let	xk_Pointer_Button5				= 0xFEED
-let	xk_Pointer_DblClick_Dflt			= 0xFEEE
-let	xk_Pointer_DblClick1				= 0xFEEF
-let	xk_Pointer_DblClick2				= 0xFEF0
-let	xk_Pointer_DblClick3				= 0xFEF1
-let	xk_Pointer_DblClick4				= 0xFEF2
-let	xk_Pointer_DblClick5				= 0xFEF3
-let	xk_Pointer_Drag_Dflt				= 0xFEF4
-let	xk_Pointer_Drag1				= 0xFEF5
-let	xk_Pointer_Drag2				= 0xFEF6
-let	xk_Pointer_Drag3				= 0xFEF7
-let	xk_Pointer_Drag4				= 0xFEF8
-let	xk_Pointer_Drag5				= 0xFEFD
-
-let	xk_Pointer_EnableKeys				= 0xFEF9
-let	xk_Pointer_Accelerate				= 0xFEFA
-let	xk_Pointer_DfltBtnNext				= 0xFEFB
-let	xk_Pointer_DfltBtnPrev				= 0xFEFC
-
-
-
-(*
- * 3270 Terminal Keys
- * Byte 3 = = 0xFD
- *)
-
-
-let xk_3270_Duplicate      = 0xFD01
-let xk_3270_FieldMark      = 0xFD02
-let xk_3270_Right2         = 0xFD03
-let xk_3270_Left2          = 0xFD04
-let xk_3270_BackTab        = 0xFD05
-let xk_3270_EraseEOF       = 0xFD06
-let xk_3270_EraseInput     = 0xFD07
-let xk_3270_Reset          = 0xFD08
-let xk_3270_Quit           = 0xFD09
-let xk_3270_PA1            = 0xFD0A
-let xk_3270_PA2            = 0xFD0B
-let xk_3270_PA3            = 0xFD0C
-let xk_3270_Test           = 0xFD0D
-let xk_3270_Attn           = 0xFD0E
-let xk_3270_CursorBlink    = 0xFD0F
-let xk_3270_AltCursor      = 0xFD10
-let xk_3270_KeyClick       = 0xFD11
-let xk_3270_Jump           = 0xFD12
-let xk_3270_Ident          = 0xFD13
-let xk_3270_Rule           = 0xFD14
-let xk_3270_Copy           = 0xFD15
-let xk_3270_Play           = 0xFD16
-let xk_3270_Setup          = 0xFD17
-let xk_3270_Record         = 0xFD18
-let xk_3270_ChangeScreen   = 0xFD19
-let xk_3270_DeleteWord     = 0xFD1A
-let xk_3270_ExSelect       = 0xFD1B
-let xk_3270_CursorSelect   = 0xFD1C
-let xk_3270_PrintScreen    = 0xFD1D
-let xk_3270_Enter          = 0xFD1E
-
-
-(*
- *  Latin 1
- *  Byte 3 = 0
- *)
-
-let xk_space               = 0x020
-let xk_exclam              = 0x021
-let xk_quotedbl            = 0x022
-let xk_numbersign          = 0x023
-let xk_dollar              = 0x024
-let xk_percent             = 0x025
-let xk_ampersand           = 0x026
-let xk_apostrophe          = 0x027
-let xk_quoteright          = 0x027	(** deprecated *)
-let xk_parenleft           = 0x028
-let xk_parenright          = 0x029
-let xk_asterisk            = 0x02a
-let xk_plus                = 0x02b
-let xk_comma               = 0x02c
-let xk_minus               = 0x02d
-let xk_period              = 0x02e
-let xk_slash               = 0x02f
-let xk_0                   = 0x030
-let xk_1                   = 0x031
-let xk_2                   = 0x032
-let xk_3                   = 0x033
-let xk_4                   = 0x034
-let xk_5                   = 0x035
-let xk_6                   = 0x036
-let xk_7                   = 0x037
-let xk_8                   = 0x038
-let xk_9                   = 0x039
-let xk_colon               = 0x03a
-let xk_semicolon           = 0x03b
-let xk_less                = 0x03c
-let xk_equal               = 0x03d
-let xk_greater             = 0x03e
-let xk_question            = 0x03f
-let xk_at                  = 0x040
-let xk_A                   = 0x041
-let xk_B                   = 0x042
-let xk_C                   = 0x043
-let xk_D                   = 0x044
-let xk_E                   = 0x045
-let xk_F                   = 0x046
-let xk_G                   = 0x047
-let xk_H                   = 0x048
-let xk_I                   = 0x049
-let xk_J                   = 0x04a
-let xk_K                   = 0x04b
-let xk_L                   = 0x04c
-let xk_M                   = 0x04d
-let xk_N                   = 0x04e
-let xk_O                   = 0x04f
-let xk_P                   = 0x050
-let xk_Q                   = 0x051
-let xk_R                   = 0x052
-let xk_S                   = 0x053
-let xk_T                   = 0x054
-let xk_U                   = 0x055
-let xk_V                   = 0x056
-let xk_W                   = 0x057
-let xk_X                   = 0x058
-let xk_Y                   = 0x059
-let xk_Z                   = 0x05a
-let xk_bracketleft         = 0x05b
-let xk_backslash           = 0x05c
-let xk_bracketright        = 0x05d
-let xk_asciicircum         = 0x05e
-let xk_underscore          = 0x05f
-let xk_grave               = 0x060
-let xk_quoteleft           = 0x060	(** deprecated *)
-let xk_a                   = 0x061
-let xk_b                   = 0x062
-let xk_c                   = 0x063
-let xk_d                   = 0x064
-let xk_e                   = 0x065
-let xk_f                   = 0x066
-let xk_g                   = 0x067
-let xk_h                   = 0x068
-let xk_i                   = 0x069
-let xk_j                   = 0x06a
-let xk_k                   = 0x06b
-let xk_l                   = 0x06c
-let xk_m                   = 0x06d
-let xk_n                   = 0x06e
-let xk_o                   = 0x06f
-let xk_p                   = 0x070
-let xk_q                   = 0x071
-let xk_r                   = 0x072
-let xk_s                   = 0x073
-let xk_t                   = 0x074
-let xk_u                   = 0x075
-let xk_v                   = 0x076
-let xk_w                   = 0x077
-let xk_x                   = 0x078
-let xk_y                   = 0x079
-let xk_z                   = 0x07a
-let xk_braceleft           = 0x07b
-let xk_bar                 = 0x07c
-let xk_braceright          = 0x07d
-let xk_asciitilde          = 0x07e
-
-let xk_nobreakspace        = 0x0a0
-let xk_exclamdown          = 0x0a1
-let xk_cent        	       = 0x0a2
-let xk_sterling            = 0x0a3
-let xk_currency            = 0x0a4
-let xk_yen                 = 0x0a5
-let xk_brokenbar           = 0x0a6
-let xk_section             = 0x0a7
-let xk_diaeresis           = 0x0a8
-let xk_copyright           = 0x0a9
-let xk_ordfeminine         = 0x0aa
-let xk_guillemotleft       = 0x0ab	(** left angle quotation mark *)
-let xk_notsign             = 0x0ac
-let xk_hyphen              = 0x0ad
-let xk_registered          = 0x0ae
-let xk_macron              = 0x0af
-let xk_degree              = 0x0b0
-let xk_plusminus           = 0x0b1
-let xk_twosuperior         = 0x0b2
-let xk_threesuperior       = 0x0b3
-let xk_acute               = 0x0b4
-let xk_mu                  = 0x0b5
-let xk_paragraph           = 0x0b6
-let xk_periodcentered      = 0x0b7
-let xk_cedilla             = 0x0b8
-let xk_onesuperior         = 0x0b9
-let xk_masculine           = 0x0ba
-let xk_guillemotright      = 0x0bb	(** right angle quotation mark *)
-let xk_onequarter          = 0x0bc
-let xk_onehalf             = 0x0bd
-let xk_threequarters       = 0x0be
-let xk_questiondown        = 0x0bf
-let xk_Agrave              = 0x0c0
-let xk_Aacute              = 0x0c1
-let xk_Acircumflex         = 0x0c2
-let xk_Atilde              = 0x0c3
-let xk_Adiaeresis          = 0x0c4
-let xk_Aring               = 0x0c5
-let xk_AE                  = 0x0c6
-let xk_Ccedilla            = 0x0c7
-let xk_Egrave              = 0x0c8
-let xk_Eacute              = 0x0c9
-let xk_Ecircumflex         = 0x0ca
-let xk_Ediaeresis          = 0x0cb
-let xk_Igrave              = 0x0cc
-let xk_Iacute              = 0x0cd
-let xk_Icircumflex         = 0x0ce
-let xk_Idiaeresis          = 0x0cf
-let xk_ETH                 = 0x0d0
-let xk_Eth                 = 0x0d0	(** deprecated *)
-let xk_Ntilde              = 0x0d1
-let xk_Ograve              = 0x0d2
-let xk_Oacute              = 0x0d3
-let xk_Ocircumflex         = 0x0d4
-let xk_Otilde              = 0x0d5
-let xk_Odiaeresis          = 0x0d6
-let xk_multiply            = 0x0d7
-let xk_Ooblique            = 0x0d8
-let xk_Ugrave              = 0x0d9
-let xk_Uacute              = 0x0da
-let xk_Ucircumflex         = 0x0db
-let xk_Udiaeresis          = 0x0dc
-let xk_Yacute              = 0x0dd
-let xk_THORN               = 0x0de
-let xk_Thorn               = 0x0de	(** deprecated *)
-let xk_ssharp              = 0x0df
-let xk_agrave              = 0x0e0
-let xk_aacute              = 0x0e1
-let xk_acircumflex         = 0x0e2
-let xk_atilde              = 0x0e3
-let xk_adiaeresis          = 0x0e4
-let xk_aring               = 0x0e5
-let xk_ae                  = 0x0e6
-let xk_ccedilla            = 0x0e7
-let xk_egrave              = 0x0e8
-let xk_eacute              = 0x0e9
-let xk_ecircumflex         = 0x0ea
-let xk_ediaeresis          = 0x0eb
-let xk_igrave              = 0x0ec
-let xk_iacute              = 0x0ed
-let xk_icircumflex         = 0x0ee
-let xk_idiaeresis          = 0x0ef
-let xk_eth                 = 0x0f0
-let xk_ntilde              = 0x0f1
-let xk_ograve              = 0x0f2
-let xk_oacute              = 0x0f3
-let xk_ocircumflex         = 0x0f4
-let xk_otilde              = 0x0f5
-let xk_odiaeresis          = 0x0f6
-let xk_division            = 0x0f7
-let xk_oslash              = 0x0f8
-let xk_ugrave              = 0x0f9
-let xk_uacute              = 0x0fa
-let xk_ucircumflex         = 0x0fb
-let xk_udiaeresis          = 0x0fc
-let xk_yacute              = 0x0fd
-let xk_thorn               = 0x0fe
-let xk_ydiaeresis          = 0x0ff
-
-
-(*
- *   Latin 2
- *   Byte 3 = 1
- *)
-
-
-let xk_Aogonek             = 0x1a1
-let xk_breve               = 0x1a2
-let xk_Lstroke             = 0x1a3
-let xk_Lcaron              = 0x1a5
-let xk_Sacute              = 0x1a6
-let xk_Scaron              = 0x1a9
-let xk_Scedilla            = 0x1aa
-let xk_Tcaron              = 0x1ab
-let xk_Zacute              = 0x1ac
-let xk_Zcaron              = 0x1ae
-let xk_Zabovedot           = 0x1af
-let xk_aogonek             = 0x1b1
-let xk_ogonek              = 0x1b2
-let xk_lstroke             = 0x1b3
-let xk_lcaron              = 0x1b5
-let xk_sacute              = 0x1b6
-let xk_caron               = 0x1b7
-let xk_scaron              = 0x1b9
-let xk_scedilla            = 0x1ba
-let xk_tcaron              = 0x1bb
-let xk_zacute              = 0x1bc
-let xk_doubleacute         = 0x1bd
-let xk_zcaron              = 0x1be
-let xk_zabovedot           = 0x1bf
-let xk_Racute              = 0x1c0
-let xk_Abreve              = 0x1c3
-let xk_Lacute              = 0x1c5
-let xk_Cacute              = 0x1c6
-let xk_Ccaron              = 0x1c8
-let xk_Eogonek             = 0x1ca
-let xk_Ecaron              = 0x1cc
-let xk_Dcaron              = 0x1cf
-let xk_Dstroke             = 0x1d0
-let xk_Nacute              = 0x1d1
-let xk_Ncaron              = 0x1d2
-let xk_Odoubleacute        = 0x1d5
-let xk_Rcaron              = 0x1d8
-let xk_Uring               = 0x1d9
-let xk_Udoubleacute        = 0x1db
-let xk_Tcedilla            = 0x1de
-let xk_racute              = 0x1e0
-let xk_abreve              = 0x1e3
-let xk_lacute              = 0x1e5
-let xk_cacute              = 0x1e6
-let xk_ccaron              = 0x1e8
-let xk_eogonek             = 0x1ea
-let xk_ecaron              = 0x1ec
-let xk_dcaron              = 0x1ef
-let xk_dstroke             = 0x1f0
-let xk_nacute              = 0x1f1
-let xk_ncaron              = 0x1f2
-let xk_odoubleacute        = 0x1f5
-let xk_udoubleacute        = 0x1fb
-let xk_rcaron              = 0x1f8
-let xk_uring               = 0x1f9
-let xk_tcedilla            = 0x1fe
-let xk_abovedot            = 0x1ff
-
-
-(*
- *   Latin 3
- *   Byte 3 = 2
- *)
-
-
-let xk_Hstroke             = 0x2a1
-let xk_Hcircumflex         = 0x2a6
-let xk_Iabovedot           = 0x2a9
-let xk_Gbreve              = 0x2ab
-let xk_Jcircumflex         = 0x2ac
-let xk_hstroke             = 0x2b1
-let xk_hcircumflex         = 0x2b6
-let xk_idotless            = 0x2b9
-let xk_gbreve              = 0x2bb
-let xk_jcircumflex         = 0x2bc
-let xk_Cabovedot           = 0x2c5
-let xk_Ccircumflex         = 0x2c6
-let xk_Gabovedot           = 0x2d5
-let xk_Gcircumflex         = 0x2d8
-let xk_Ubreve              = 0x2dd
-let xk_Scircumflex         = 0x2de
-let xk_cabovedot           = 0x2e5
-let xk_ccircumflex         = 0x2e6
-let xk_gabovedot           = 0x2f5
-let xk_gcircumflex         = 0x2f8
-let xk_ubreve              = 0x2fd
-let xk_scircumflex         = 0x2fe
-
-
-
-(*
- *   Latin 4
- *   Byte 3 = 3
- *)
-
-
-let xk_kra                 = 0x3a2
-let xk_kappa               = 0x3a2	(** deprecated *)
-let xk_Rcedilla            = 0x3a3
-let xk_Itilde              = 0x3a5
-let xk_Lcedilla            = 0x3a6
-let xk_Emacron             = 0x3aa
-let xk_Gcedilla            = 0x3ab
-let xk_Tslash              = 0x3ac
-let xk_rcedilla            = 0x3b3
-let xk_itilde              = 0x3b5
-let xk_lcedilla            = 0x3b6
-let xk_emacron             = 0x3ba
-let xk_gcedilla            = 0x3bb
-let xk_tslash              = 0x3bc
-let xk_ENG                 = 0x3bd
-let xk_eng                 = 0x3bf
-let xk_Amacron             = 0x3c0
-let xk_Iogonek             = 0x3c7
-let xk_Eabovedot           = 0x3cc
-let xk_Imacron             = 0x3cf
-let xk_Ncedilla            = 0x3d1
-let xk_Omacron             = 0x3d2
-let xk_Kcedilla            = 0x3d3
-let xk_Uogonek             = 0x3d9
-let xk_Utilde              = 0x3dd
-let xk_Umacron             = 0x3de
-let xk_amacron             = 0x3e0
-let xk_iogonek             = 0x3e7
-let xk_eabovedot           = 0x3ec
-let xk_imacron             = 0x3ef
-let xk_ncedilla            = 0x3f1
-let xk_omacron             = 0x3f2
-let xk_kcedilla            = 0x3f3
-let xk_uogonek             = 0x3f9
-let xk_utilde              = 0x3fd
-let xk_umacron             = 0x3fe
-
-
-(*
- * Katakana
- * Byte 3 = 4
- *)
-
-
-let xk_overline				       = 0x47e
-let xk_kana_fullstop                               = 0x4a1
-let xk_kana_openingbracket                         = 0x4a2
-let xk_kana_closingbracket                         = 0x4a3
-let xk_kana_comma                                  = 0x4a4
-let xk_kana_conjunctive                            = 0x4a5
-let xk_kana_middledot                              = 0x4a5  (** deprecated *)
-let xk_kana_WO                                     = 0x4a6
-let xk_kana_a                                      = 0x4a7
-let xk_kana_i                                      = 0x4a8
-let xk_kana_u                                      = 0x4a9
-let xk_kana_e                                      = 0x4aa
-let xk_kana_o                                      = 0x4ab
-let xk_kana_ya                                     = 0x4ac
-let xk_kana_yu                                     = 0x4ad
-let xk_kana_yo                                     = 0x4ae
-let xk_kana_tsu                                    = 0x4af
-let xk_kana_tu                                     = 0x4af  (** deprecated *)
-let xk_prolongedsound                              = 0x4b0
-let xk_kana_A                                      = 0x4b1
-let xk_kana_I                                      = 0x4b2
-let xk_kana_U                                      = 0x4b3
-let xk_kana_E                                      = 0x4b4
-let xk_kana_O                                      = 0x4b5
-let xk_kana_KA                                     = 0x4b6
-let xk_kana_KI                                     = 0x4b7
-let xk_kana_KU                                     = 0x4b8
-let xk_kana_KE                                     = 0x4b9
-let xk_kana_KO                                     = 0x4ba
-let xk_kana_SA                                     = 0x4bb
-let xk_kana_SHI                                    = 0x4bc
-let xk_kana_SU                                     = 0x4bd
-let xk_kana_SE                                     = 0x4be
-let xk_kana_SO                                     = 0x4bf
-let xk_kana_TA                                     = 0x4c0
-let xk_kana_CHI                                    = 0x4c1
-let xk_kana_TI                                     = 0x4c1  (** deprecated *)
-let xk_kana_TSU                                    = 0x4c2
-let xk_kana_TU                                     = 0x4c2  (** deprecated *)
-let xk_kana_TE                                     = 0x4c3
-let xk_kana_TO                                     = 0x4c4
-let xk_kana_NA                                     = 0x4c5
-let xk_kana_NI                                     = 0x4c6
-let xk_kana_NU                                     = 0x4c7
-let xk_kana_NE                                     = 0x4c8
-let xk_kana_NO                                     = 0x4c9
-let xk_kana_HA                                     = 0x4ca
-let xk_kana_HI                                     = 0x4cb
-let xk_kana_FU                                     = 0x4cc
-let xk_kana_HU                                     = 0x4cc  (** deprecated *)
-let xk_kana_HE                                     = 0x4cd
-let xk_kana_HO                                     = 0x4ce
-let xk_kana_MA                                     = 0x4cf
-let xk_kana_MI                                     = 0x4d0
-let xk_kana_MU                                     = 0x4d1
-let xk_kana_ME                                     = 0x4d2
-let xk_kana_MO                                     = 0x4d3
-let xk_kana_YA                                     = 0x4d4
-let xk_kana_YU                                     = 0x4d5
-let xk_kana_YO                                     = 0x4d6
-let xk_kana_RA                                     = 0x4d7
-let xk_kana_RI                                     = 0x4d8
-let xk_kana_RU                                     = 0x4d9
-let xk_kana_RE                                     = 0x4da
-let xk_kana_RO                                     = 0x4db
-let xk_kana_WA                                     = 0x4dc
-let xk_kana_N                                      = 0x4dd
-let xk_voicedsound                                 = 0x4de
-let xk_semivoicedsound                             = 0x4df
-let xk_kana_switch          = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- *  Arabic
- *  Byte 3 = 5
- *)
-
-
-let xk_Arabic_comma                                = 0x5ac
-let xk_Arabic_semicolon                            = 0x5bb
-let xk_Arabic_question_mark                        = 0x5bf
-let xk_Arabic_hamza                                = 0x5c1
-let xk_Arabic_maddaonalef                          = 0x5c2
-let xk_Arabic_hamzaonalef                          = 0x5c3
-let xk_Arabic_hamzaonwaw                           = 0x5c4
-let xk_Arabic_hamzaunderalef                       = 0x5c5
-let xk_Arabic_hamzaonyeh                           = 0x5c6
-let xk_Arabic_alef                                 = 0x5c7
-let xk_Arabic_beh                                  = 0x5c8
-let xk_Arabic_tehmarbuta                           = 0x5c9
-let xk_Arabic_teh                                  = 0x5ca
-let xk_Arabic_theh                                 = 0x5cb
-let xk_Arabic_jeem                                 = 0x5cc
-let xk_Arabic_hah                                  = 0x5cd
-let xk_Arabic_khah                                 = 0x5ce
-let xk_Arabic_dal                                  = 0x5cf
-let xk_Arabic_thal                                 = 0x5d0
-let xk_Arabic_ra                                   = 0x5d1
-let xk_Arabic_zain                                 = 0x5d2
-let xk_Arabic_seen                                 = 0x5d3
-let xk_Arabic_sheen                                = 0x5d4
-let xk_Arabic_sad                                  = 0x5d5
-let xk_Arabic_dad                                  = 0x5d6
-let xk_Arabic_tah                                  = 0x5d7
-let xk_Arabic_zah                                  = 0x5d8
-let xk_Arabic_ain                                  = 0x5d9
-let xk_Arabic_ghain                                = 0x5da
-let xk_Arabic_tatweel                              = 0x5e0
-let xk_Arabic_feh                                  = 0x5e1
-let xk_Arabic_qaf                                  = 0x5e2
-let xk_Arabic_kaf                                  = 0x5e3
-let xk_Arabic_lam                                  = 0x5e4
-let xk_Arabic_meem                                 = 0x5e5
-let xk_Arabic_noon                                 = 0x5e6
-let xk_Arabic_ha                                   = 0x5e7
-let xk_Arabic_heh                                  = 0x5e7  (** deprecated *)
-let xk_Arabic_waw                                  = 0x5e8
-let xk_Arabic_alefmaksura                          = 0x5e9
-let xk_Arabic_yeh                                  = 0x5ea
-let xk_Arabic_fathatan                             = 0x5eb
-let xk_Arabic_dammatan                             = 0x5ec
-let xk_Arabic_kasratan                             = 0x5ed
-let xk_Arabic_fatha                                = 0x5ee
-let xk_Arabic_damma                                = 0x5ef
-let xk_Arabic_kasra                                = 0x5f0
-let xk_Arabic_shadda                               = 0x5f1
-let xk_Arabic_sukun                                = 0x5f2
-let xk_Arabic_switch        = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- * Cyrillic
- * Byte 3 = 6
- *)
-
-let xk_Serbian_dje                                 = 0x6a1
-let xk_Macedonia_gje                               = 0x6a2
-let xk_Cyrillic_io                                 = 0x6a3
-let xk_Ukrainian_ie                                = 0x6a4
-let xk_Ukranian_je                                 = 0x6a4  (** deprecated *)
-let xk_Macedonia_dse                               = 0x6a5
-let xk_Ukrainian_i                                 = 0x6a6
-let xk_Ukranian_i                                  = 0x6a6  (** deprecated *)
-let xk_Ukrainian_yi                                = 0x6a7
-let xk_Ukranian_yi                                 = 0x6a7  (** deprecated *)
-let xk_Cyrillic_je                                 = 0x6a8
-let xk_Serbian_je                                  = 0x6a8  (** deprecated *)
-let xk_Cyrillic_lje                                = 0x6a9
-let xk_Serbian_lje                                 = 0x6a9  (** deprecated *)
-let xk_Cyrillic_nje                                = 0x6aa
-let xk_Serbian_nje                                 = 0x6aa  (** deprecated *)
-let xk_Serbian_tshe                                = 0x6ab
-let xk_Macedonia_kje                               = 0x6ac
-let xk_Byelorussian_shortu                         = 0x6ae
-let xk_Cyrillic_dzhe                               = 0x6af
-let xk_Serbian_dze                                 = 0x6af  (** deprecated *)
-let xk_numerosign                                  = 0x6b0
-let xk_Serbian_DJE                                 = 0x6b1
-let xk_Macedonia_GJE                               = 0x6b2
-let xk_Cyrillic_IO                                 = 0x6b3
-let xk_Ukrainian_IE                                = 0x6b4
-let xk_Ukranian_JE                                 = 0x6b4  (** deprecated *)
-let xk_Macedonia_DSE                               = 0x6b5
-let xk_Ukrainian_I                                 = 0x6b6
-let xk_Ukranian_I                                  = 0x6b6  (** deprecated *)
-let xk_Ukrainian_YI                                = 0x6b7
-let xk_Ukranian_YI                                 = 0x6b7  (** deprecated *)
-let xk_Cyrillic_JE                                 = 0x6b8
-let xk_Serbian_JE                                  = 0x6b8  (** deprecated *)
-let xk_Cyrillic_LJE                                = 0x6b9
-let xk_Serbian_LJE                                 = 0x6b9  (** deprecated *)
-let xk_Cyrillic_NJE                                = 0x6ba
-let xk_Serbian_NJE                                 = 0x6ba  (** deprecated *)
-let xk_Serbian_TSHE                                = 0x6bb
-let xk_Macedonia_KJE                               = 0x6bc
-let xk_Byelorussian_SHORTU                         = 0x6be
-let xk_Cyrillic_DZHE                               = 0x6bf
-let xk_Serbian_DZE                                 = 0x6bf  (** deprecated *)
-let xk_Cyrillic_yu                                 = 0x6c0
-let xk_Cyrillic_a                                  = 0x6c1
-let xk_Cyrillic_be                                 = 0x6c2
-let xk_Cyrillic_tse                                = 0x6c3
-let xk_Cyrillic_de                                 = 0x6c4
-let xk_Cyrillic_ie                                 = 0x6c5
-let xk_Cyrillic_ef                                 = 0x6c6
-let xk_Cyrillic_ghe                                = 0x6c7
-let xk_Cyrillic_ha                                 = 0x6c8
-let xk_Cyrillic_i                                  = 0x6c9
-let xk_Cyrillic_shorti                             = 0x6ca
-let xk_Cyrillic_ka                                 = 0x6cb
-let xk_Cyrillic_el                                 = 0x6cc
-let xk_Cyrillic_em                                 = 0x6cd
-let xk_Cyrillic_en                                 = 0x6ce
-let xk_Cyrillic_o                                  = 0x6cf
-let xk_Cyrillic_pe                                 = 0x6d0
-let xk_Cyrillic_ya                                 = 0x6d1
-let xk_Cyrillic_er                                 = 0x6d2
-let xk_Cyrillic_es                                 = 0x6d3
-let xk_Cyrillic_te                                 = 0x6d4
-let xk_Cyrillic_u                                  = 0x6d5
-let xk_Cyrillic_zhe                                = 0x6d6
-let xk_Cyrillic_ve                                 = 0x6d7
-let xk_Cyrillic_softsign                           = 0x6d8
-let xk_Cyrillic_yeru                               = 0x6d9
-let xk_Cyrillic_ze                                 = 0x6da
-let xk_Cyrillic_sha                                = 0x6db
-let xk_Cyrillic_e                                  = 0x6dc
-let xk_Cyrillic_shcha                              = 0x6dd
-let xk_Cyrillic_che                                = 0x6de
-let xk_Cyrillic_hardsign                           = 0x6df
-let xk_Cyrillic_YU                                 = 0x6e0
-let xk_Cyrillic_A                                  = 0x6e1
-let xk_Cyrillic_BE                                 = 0x6e2
-let xk_Cyrillic_TSE                                = 0x6e3
-let xk_Cyrillic_DE                                 = 0x6e4
-let xk_Cyrillic_IE                                 = 0x6e5
-let xk_Cyrillic_EF                                 = 0x6e6
-let xk_Cyrillic_GHE                                = 0x6e7
-let xk_Cyrillic_HA                                 = 0x6e8
-let xk_Cyrillic_I                                  = 0x6e9
-let xk_Cyrillic_SHORTI                             = 0x6ea
-let xk_Cyrillic_KA                                 = 0x6eb
-let xk_Cyrillic_EL                                 = 0x6ec
-let xk_Cyrillic_EM                                 = 0x6ed
-let xk_Cyrillic_EN                                 = 0x6ee
-let xk_Cyrillic_O                                  = 0x6ef
-let xk_Cyrillic_PE                                 = 0x6f0
-let xk_Cyrillic_YA                                 = 0x6f1
-let xk_Cyrillic_ER                                 = 0x6f2
-let xk_Cyrillic_ES                                 = 0x6f3
-let xk_Cyrillic_TE                                 = 0x6f4
-let xk_Cyrillic_U                                  = 0x6f5
-let xk_Cyrillic_ZHE                                = 0x6f6
-let xk_Cyrillic_VE                                 = 0x6f7
-let xk_Cyrillic_SOFTSIGN                           = 0x6f8
-let xk_Cyrillic_YERU                               = 0x6f9
-let xk_Cyrillic_ZE                                 = 0x6fa
-let xk_Cyrillic_SHA                                = 0x6fb
-let xk_Cyrillic_E                                  = 0x6fc
-let xk_Cyrillic_SHCHA                              = 0x6fd
-let xk_Cyrillic_CHE                                = 0x6fe
-let xk_Cyrillic_HARDSIGN                           = 0x6ff
-
-
-(*
- * Greek
- * Byte 3 = 7
- *)
-
-
-let xk_Greek_ALPHAaccent                           = 0x7a1
-let xk_Greek_EPSILONaccent                         = 0x7a2
-let xk_Greek_ETAaccent                             = 0x7a3
-let xk_Greek_IOTAaccent                            = 0x7a4
-let xk_Greek_IOTAdiaeresis                         = 0x7a5
-let xk_Greek_OMICRONaccent                         = 0x7a7
-let xk_Greek_UPSILONaccent                         = 0x7a8
-let xk_Greek_UPSILONdieresis                       = 0x7a9
-let xk_Greek_OMEGAaccent                           = 0x7ab
-let xk_Greek_accentdieresis                        = 0x7ae
-let xk_Greek_horizbar                              = 0x7af
-let xk_Greek_alphaaccent                           = 0x7b1
-let xk_Greek_epsilonaccent                         = 0x7b2
-let xk_Greek_etaaccent                             = 0x7b3
-let xk_Greek_iotaaccent                            = 0x7b4
-let xk_Greek_iotadieresis                          = 0x7b5
-let xk_Greek_iotaaccentdieresis                    = 0x7b6
-let xk_Greek_omicronaccent                         = 0x7b7
-let xk_Greek_upsilonaccent                         = 0x7b8
-let xk_Greek_upsilondieresis                       = 0x7b9
-let xk_Greek_upsilonaccentdieresis                 = 0x7ba
-let xk_Greek_omegaaccent                           = 0x7bb
-let xk_Greek_ALPHA                                 = 0x7c1
-let xk_Greek_BETA                                  = 0x7c2
-let xk_Greek_GAMMA                                 = 0x7c3
-let xk_Greek_DELTA                                 = 0x7c4
-let xk_Greek_EPSILON                               = 0x7c5
-let xk_Greek_ZETA                                  = 0x7c6
-let xk_Greek_ETA                                   = 0x7c7
-let xk_Greek_THETA                                 = 0x7c8
-let xk_Greek_IOTA                                  = 0x7c9
-let xk_Greek_KAPPA                                 = 0x7ca
-let xk_Greek_LAMDA                                 = 0x7cb
-let xk_Greek_LAMBDA                                = 0x7cb
-let xk_Greek_MU                                    = 0x7cc
-let xk_Greek_NU                                    = 0x7cd
-let xk_Greek_XI                                    = 0x7ce
-let xk_Greek_OMICRON                               = 0x7cf
-let xk_Greek_PI                                    = 0x7d0
-let xk_Greek_RHO                                   = 0x7d1
-let xk_Greek_SIGMA                                 = 0x7d2
-let xk_Greek_TAU                                   = 0x7d4
-let xk_Greek_UPSILON                               = 0x7d5
-let xk_Greek_PHI                                   = 0x7d6
-let xk_Greek_CHI                                   = 0x7d7
-let xk_Greek_PSI                                   = 0x7d8
-let xk_Greek_OMEGA                                 = 0x7d9
-let xk_Greek_alpha                                 = 0x7e1
-let xk_Greek_beta                                  = 0x7e2
-let xk_Greek_gamma                                 = 0x7e3
-let xk_Greek_delta                                 = 0x7e4
-let xk_Greek_epsilon                               = 0x7e5
-let xk_Greek_zeta                                  = 0x7e6
-let xk_Greek_eta                                   = 0x7e7
-let xk_Greek_theta                                 = 0x7e8
-let xk_Greek_iota                                  = 0x7e9
-let xk_Greek_kappa                                 = 0x7ea
-let xk_Greek_lamda                                 = 0x7eb
-let xk_Greek_lambda                                = 0x7eb
-let xk_Greek_mu                                    = 0x7ec
-let xk_Greek_nu                                    = 0x7ed
-let xk_Greek_xi                                    = 0x7ee
-let xk_Greek_omicron                               = 0x7ef
-let xk_Greek_pi                                    = 0x7f0
-let xk_Greek_rho                                   = 0x7f1
-let xk_Greek_sigma                                 = 0x7f2
-let xk_Greek_finalsmallsigma                       = 0x7f3
-let xk_Greek_tau                                   = 0x7f4
-let xk_Greek_upsilon                               = 0x7f5
-let xk_Greek_phi                                   = 0x7f6
-let xk_Greek_chi                                   = 0x7f7
-let xk_Greek_psi                                   = 0x7f8
-let xk_Greek_omega                                 = 0x7f9
-let xk_Greek_switch         = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- * Technical
- * Byte 3 = 8
- *)
-
-
-let xk_leftradical                                 = 0x8a1
-let xk_topleftradical                              = 0x8a2
-let xk_horizconnector                              = 0x8a3
-let xk_topintegral                                 = 0x8a4
-let xk_botintegral                                 = 0x8a5
-let xk_vertconnector                               = 0x8a6
-let xk_topleftsqbracket                            = 0x8a7
-let xk_botleftsqbracket                            = 0x8a8
-let xk_toprightsqbracket                           = 0x8a9
-let xk_botrightsqbracket                           = 0x8aa
-let xk_topleftparens                               = 0x8ab
-let xk_botleftparens                               = 0x8ac
-let xk_toprightparens                              = 0x8ad
-let xk_botrightparens                              = 0x8ae
-let xk_leftmiddlecurlybrace                        = 0x8af
-let xk_rightmiddlecurlybrace                       = 0x8b0
-let xk_topleftsummation                            = 0x8b1
-let xk_botleftsummation                            = 0x8b2
-let xk_topvertsummationconnector                   = 0x8b3
-let xk_botvertsummationconnector                   = 0x8b4
-let xk_toprightsummation                           = 0x8b5
-let xk_botrightsummation                           = 0x8b6
-let xk_rightmiddlesummation                        = 0x8b7
-let xk_lessthanequal                               = 0x8bc
-let xk_notequal                                    = 0x8bd
-let xk_greaterthanequal                            = 0x8be
-let xk_integral                                    = 0x8bf
-let xk_therefore                                   = 0x8c0
-let xk_variation                                   = 0x8c1
-let xk_infinity                                    = 0x8c2
-let xk_nabla                                       = 0x8c5
-let xk_approximate                                 = 0x8c8
-let xk_similarequal                                = 0x8c9
-let xk_ifonlyif                                    = 0x8cd
-let xk_implies                                     = 0x8ce
-let xk_identical                                   = 0x8cf
-let xk_radical                                     = 0x8d6
-let xk_includedin                                  = 0x8da
-let xk_includes                                    = 0x8db
-let xk_intersection                                = 0x8dc
-let xk_union                                       = 0x8dd
-let xk_logicaland                                  = 0x8de
-let xk_logicalor                                   = 0x8df
-let xk_partialderivative                           = 0x8ef
-let xk_function                                    = 0x8f6
-let xk_leftarrow                                   = 0x8fb
-let xk_uparrow                                     = 0x8fc
-let xk_rightarrow                                  = 0x8fd
-let xk_downarrow                                   = 0x8fe
-
-
-(*
- *  Special
- *  Byte 3 = 9
- *)
-
-
-let xk_blank                                       = 0x9df
-let xk_soliddiamond                                = 0x9e0
-let xk_checkerboard                                = 0x9e1
-let xk_ht                                          = 0x9e2
-let xk_ff                                          = 0x9e3
-let xk_cr                                          = 0x9e4
-let xk_lf                                          = 0x9e5
-let xk_nl                                          = 0x9e8
-let xk_vt                                          = 0x9e9
-let xk_lowrightcorner                              = 0x9ea
-let xk_uprightcorner                               = 0x9eb
-let xk_upleftcorner                                = 0x9ec
-let xk_lowleftcorner                               = 0x9ed
-let xk_crossinglines                               = 0x9ee
-let xk_horizlinescan1                              = 0x9ef
-let xk_horizlinescan3                              = 0x9f0
-let xk_horizlinescan5                              = 0x9f1
-let xk_horizlinescan7                              = 0x9f2
-let xk_horizlinescan9                              = 0x9f3
-let xk_leftt                                       = 0x9f4
-let xk_rightt                                      = 0x9f5
-let xk_bott                                        = 0x9f6
-let xk_topt                                        = 0x9f7
-let xk_vertbar                                     = 0x9f8
-
-
-(*
- *  Publishing
- *  Byte 3 = a
- *)
-
-
-let xk_emspace                                     = 0xaa1
-let xk_enspace                                     = 0xaa2
-let xk_em3space                                    = 0xaa3
-let xk_em4space                                    = 0xaa4
-let xk_digitspace                                  = 0xaa5
-let xk_punctspace                                  = 0xaa6
-let xk_thinspace                                   = 0xaa7
-let xk_hairspace                                   = 0xaa8
-let xk_emdash                                      = 0xaa9
-let xk_endash                                      = 0xaaa
-let xk_signifblank                                 = 0xaac
-let xk_ellipsis                                    = 0xaae
-let xk_doubbaselinedot                             = 0xaaf
-let xk_onethird                                    = 0xab0
-let xk_twothirds                                   = 0xab1
-let xk_onefifth                                    = 0xab2
-let xk_twofifths                                   = 0xab3
-let xk_threefifths                                 = 0xab4
-let xk_fourfifths                                  = 0xab5
-let xk_onesixth                                    = 0xab6
-let xk_fivesixths                                  = 0xab7
-let xk_careof                                      = 0xab8
-let xk_figdash                                     = 0xabb
-let xk_leftanglebracket                            = 0xabc
-let xk_decimalpoint                                = 0xabd
-let xk_rightanglebracket                           = 0xabe
-let xk_marker                                      = 0xabf
-let xk_oneeighth                                   = 0xac3
-let xk_threeeighths                                = 0xac4
-let xk_fiveeighths                                 = 0xac5
-let xk_seveneighths                                = 0xac6
-let xk_trademark                                   = 0xac9
-let xk_signaturemark                               = 0xaca
-let xk_trademarkincircle                           = 0xacb
-let xk_leftopentriangle                            = 0xacc
-let xk_rightopentriangle                           = 0xacd
-let xk_emopencircle                                = 0xace
-let xk_emopenrectangle                             = 0xacf
-let xk_leftsinglequotemark                         = 0xad0
-let xk_rightsinglequotemark                        = 0xad1
-let xk_leftdoublequotemark                         = 0xad2
-let xk_rightdoublequotemark                        = 0xad3
-let xk_prescription                                = 0xad4
-let xk_minutes                                     = 0xad6
-let xk_seconds                                     = 0xad7
-let xk_latincross                                  = 0xad9
-let xk_hexagram                                    = 0xada
-let xk_filledrectbullet                            = 0xadb
-let xk_filledlefttribullet                         = 0xadc
-let xk_filledrighttribullet                        = 0xadd
-let xk_emfilledcircle                              = 0xade
-let xk_emfilledrect                                = 0xadf
-let xk_enopencircbullet                            = 0xae0
-let xk_enopensquarebullet                          = 0xae1
-let xk_openrectbullet                              = 0xae2
-let xk_opentribulletup                             = 0xae3
-let xk_opentribulletdown                           = 0xae4
-let xk_openstar                                    = 0xae5
-let xk_enfilledcircbullet                          = 0xae6
-let xk_enfilledsqbullet                            = 0xae7
-let xk_filledtribulletup                           = 0xae8
-let xk_filledtribulletdown                         = 0xae9
-let xk_leftpointer                                 = 0xaea
-let xk_rightpointer                                = 0xaeb
-let xk_club                                        = 0xaec
-let xk_diamond                                     = 0xaed
-let xk_heart                                       = 0xaee
-let xk_maltesecross                                = 0xaf0
-let xk_dagger                                      = 0xaf1
-let xk_doubledagger                                = 0xaf2
-let xk_checkmark                                   = 0xaf3
-let xk_ballotcross                                 = 0xaf4
-let xk_musicalsharp                                = 0xaf5
-let xk_musicalflat                                 = 0xaf6
-let xk_malesymbol                                  = 0xaf7
-let xk_femalesymbol                                = 0xaf8
-let xk_telephone                                   = 0xaf9
-let xk_telephonerecorder                           = 0xafa
-let xk_phonographcopyright                         = 0xafb
-let xk_caret                                       = 0xafc
-let xk_singlelowquotemark                          = 0xafd
-let xk_doublelowquotemark                          = 0xafe
-let xk_cursor                                      = 0xaff
-
-
-(*
- *  APL
- *  Byte 3 = b
- *)
-
-
-let xk_leftcaret                                   = 0xba3
-let xk_rightcaret                                  = 0xba6
-let xk_downcaret                                   = 0xba8
-let xk_upcaret                                     = 0xba9
-let xk_overbar                                     = 0xbc0
-let xk_downtack                                    = 0xbc2
-let xk_upshoe                                      = 0xbc3
-let xk_downstile                                   = 0xbc4
-let xk_underbar                                    = 0xbc6
-let xk_jot                                         = 0xbca
-let xk_quad                                        = 0xbcc
-let xk_uptack                                      = 0xbce
-let xk_circle                                      = 0xbcf
-let xk_upstile                                     = 0xbd3
-let xk_downshoe                                    = 0xbd6
-let xk_rightshoe                                   = 0xbd8
-let xk_leftshoe                                    = 0xbda
-let xk_lefttack                                    = 0xbdc
-let xk_righttack                                   = 0xbfc
-
-
-(*
- * Hebrew
- * Byte 3 = c
- *)
-
-
-let xk_hebrew_doublelowline                        = 0xcdf
-let xk_hebrew_aleph                                = 0xce0
-let xk_hebrew_bet                                  = 0xce1
-let xk_hebrew_beth                                 = 0xce1  (** deprecated *)
-let xk_hebrew_gimel                                = 0xce2
-let xk_hebrew_gimmel                               = 0xce2  (** deprecated *)
-let xk_hebrew_dalet                                = 0xce3
-let xk_hebrew_daleth                               = 0xce3  (** deprecated *)
-let xk_hebrew_he                                   = 0xce4
-let xk_hebrew_waw                                  = 0xce5
-let xk_hebrew_zain                                 = 0xce6
-let xk_hebrew_zayin                                = 0xce6  (** deprecated *)
-let xk_hebrew_chet                                 = 0xce7
-let xk_hebrew_het                                  = 0xce7  (** deprecated *)
-let xk_hebrew_tet                                  = 0xce8
-let xk_hebrew_teth                                 = 0xce8  (** deprecated *)
-let xk_hebrew_yod                                  = 0xce9
-let xk_hebrew_finalkaph                            = 0xcea
-let xk_hebrew_kaph                                 = 0xceb
-let xk_hebrew_lamed                                = 0xcec
-let xk_hebrew_finalmem                             = 0xced
-let xk_hebrew_mem                                  = 0xcee
-let xk_hebrew_finalnun                             = 0xcef
-let xk_hebrew_nun                                  = 0xcf0
-let xk_hebrew_samech                               = 0xcf1
-let xk_hebrew_samekh                               = 0xcf1  (** deprecated *)
-let xk_hebrew_ayin                                 = 0xcf2
-let xk_hebrew_finalpe                              = 0xcf3
-let xk_hebrew_pe                                   = 0xcf4
-let xk_hebrew_finalzade                            = 0xcf5
-let xk_hebrew_finalzadi                            = 0xcf5  (** deprecated *)
-let xk_hebrew_zade                                 = 0xcf6
-let xk_hebrew_zadi                                 = 0xcf6  (** deprecated *)
-let xk_hebrew_qoph                                 = 0xcf7
-let xk_hebrew_kuf                                  = 0xcf7  (** deprecated *)
-let xk_hebrew_resh                                 = 0xcf8
-let xk_hebrew_shin                                 = 0xcf9
-let xk_hebrew_taw                                  = 0xcfa
-let xk_hebrew_taf                                  = 0xcfa  (** deprecated *)
-let xk_Hebrew_switch        = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- * Thai
- * Byte 3 = d
- *)
-
-
-let xk_Thai_kokai					= 0xda1
-let xk_Thai_khokhai					= 0xda2
-let xk_Thai_khokhuat				= 0xda3
-let xk_Thai_khokhwai				= 0xda4
-let xk_Thai_khokhon					= 0xda5
-let xk_Thai_khorakhang			        = 0xda6
-let xk_Thai_ngongu					= 0xda7
-let xk_Thai_chochan					= 0xda8
-let xk_Thai_choching				= 0xda9
-let xk_Thai_chochang				= 0xdaa
-let xk_Thai_soso					= 0xdab
-let xk_Thai_chochoe					= 0xdac
-let xk_Thai_yoying					= 0xdad
-let xk_Thai_dochada					= 0xdae
-let xk_Thai_topatak					= 0xdaf
-let xk_Thai_thothan					= 0xdb0
-let xk_Thai_thonangmontho			        = 0xdb1
-let xk_Thai_thophuthao			        = 0xdb2
-let xk_Thai_nonen					= 0xdb3
-let xk_Thai_dodek					= 0xdb4
-let xk_Thai_totao					= 0xdb5
-let xk_Thai_thothung				= 0xdb6
-let xk_Thai_thothahan				= 0xdb7
-let xk_Thai_thothong	 			= 0xdb8
-let xk_Thai_nonu					= 0xdb9
-let xk_Thai_bobaimai				= 0xdba
-let xk_Thai_popla					= 0xdbb
-let xk_Thai_phophung				= 0xdbc
-let xk_Thai_fofa					= 0xdbd
-let xk_Thai_phophan					= 0xdbe
-let xk_Thai_fofan					= 0xdbf
-let xk_Thai_phosamphao			        = 0xdc0
-let xk_Thai_moma					= 0xdc1
-let xk_Thai_yoyak					= 0xdc2
-let xk_Thai_rorua					= 0xdc3
-let xk_Thai_ru					= 0xdc4
-let xk_Thai_loling					= 0xdc5
-let xk_Thai_lu					= 0xdc6
-let xk_Thai_wowaen					= 0xdc7
-let xk_Thai_sosala					= 0xdc8
-let xk_Thai_sorusi					= 0xdc9
-let xk_Thai_sosua					= 0xdca
-let xk_Thai_hohip					= 0xdcb
-let xk_Thai_lochula					= 0xdcc
-let xk_Thai_oang					= 0xdcd
-let xk_Thai_honokhuk				= 0xdce
-let xk_Thai_paiyannoi				= 0xdcf
-let xk_Thai_saraa					= 0xdd0
-let xk_Thai_maihanakat				= 0xdd1
-let xk_Thai_saraaa					= 0xdd2
-let xk_Thai_saraam					= 0xdd3
-let xk_Thai_sarai					= 0xdd4
-let xk_Thai_saraii					= 0xdd5
-let xk_Thai_saraue					= 0xdd6
-let xk_Thai_sarauee					= 0xdd7
-let xk_Thai_sarau					= 0xdd8
-let xk_Thai_sarauu					= 0xdd9
-let xk_Thai_phinthu					= 0xdda
-let xk_Thai_maihanakat_maitho   			= 0xdde
-let xk_Thai_baht					= 0xddf
-let xk_Thai_sarae					= 0xde0
-let xk_Thai_saraae					= 0xde1
-let xk_Thai_sarao					= 0xde2
-let xk_Thai_saraaimaimuan				= 0xde3
-let xk_Thai_saraaimaimalai				= 0xde4
-let xk_Thai_lakkhangyao				= 0xde5
-let xk_Thai_maiyamok				= 0xde6
-let xk_Thai_maitaikhu				= 0xde7
-let xk_Thai_maiek					= 0xde8
-let xk_Thai_maitho					= 0xde9
-let xk_Thai_maitri					= 0xdea
-let xk_Thai_maichattawa				= 0xdeb
-let xk_Thai_thanthakhat				= 0xdec
-let xk_Thai_nikhahit				= 0xded
-let xk_Thai_leksun					= 0xdf0
-let xk_Thai_leknung					= 0xdf1
-let xk_Thai_leksong					= 0xdf2
-let xk_Thai_leksam					= 0xdf3
-let xk_Thai_leksi					= 0xdf4
-let xk_Thai_lekha					= 0xdf5
-let xk_Thai_lekhok					= 0xdf6
-let xk_Thai_lekchet					= 0xdf7
-let xk_Thai_lekpaet					= 0xdf8
-let xk_Thai_lekkao					= 0xdf9
-
-
-(*
- *   Korean
- *   Byte 3 = e
- *)
-
-
-
-let xk_Hangul		= 0xff31    (** Hangul start/stop(toggle) *)
-let xk_Hangul_Start		= 0xff32    (** Hangul start *)
-let xk_Hangul_End		= 0xff33    (** Hangul end, English start *)
-let xk_Hangul_Hanja		= 0xff34    (** Start Hangul->Hanja Conversion *)
-let xk_Hangul_Jamo		= 0xff35    (** Hangul Jamo mode *)
-let xk_Hangul_Romaja	= 0xff36    (** Hangul Romaja mode *)
-let xk_Hangul_Codeinput	= 0xff37    (** Hangul code input mode *)
-let xk_Hangul_Jeonja	= 0xff38    (** Jeonja mode *)
-let xk_Hangul_Banja		= 0xff39    (** Banja mode *)
-let xk_Hangul_PreHanja	= 0xff3a    (** Pre Hanja conversion *)
-let xk_Hangul_PostHanja	= 0xff3b    (** Post Hanja conversion *)
-let xk_Hangul_SingleCandidate	= 0xff3c    (** Single candidate *)
-let xk_Hangul_MultipleCandidate	= 0xff3d    (** Multiple candidate *)
-let xk_Hangul_PreviousCandidate	= 0xff3e    (** Previous candidate *)
-let xk_Hangul_Special	= 0xff3f    (** Special symbols *)
-let xk_Hangul_switch	= 0xFF7E    (** Alias for mode_switch *)
-
-(** Hangul Consonant Characters *)
-let xk_Hangul_Kiyeog				= 0xea1
-let xk_Hangul_SsangKiyeog				= 0xea2
-let xk_Hangul_KiyeogSios				= 0xea3
-let xk_Hangul_Nieun					= 0xea4
-let xk_Hangul_NieunJieuj				= 0xea5
-let xk_Hangul_NieunHieuh				= 0xea6
-let xk_Hangul_Dikeud				= 0xea7
-let xk_Hangul_SsangDikeud				= 0xea8
-let xk_Hangul_Rieul					= 0xea9
-let xk_Hangul_RieulKiyeog				= 0xeaa
-let xk_Hangul_RieulMieum				= 0xeab
-let xk_Hangul_RieulPieub				= 0xeac
-let xk_Hangul_RieulSios				= 0xead
-let xk_Hangul_RieulTieut				= 0xeae
-let xk_Hangul_RieulPhieuf				= 0xeaf
-let xk_Hangul_RieulHieuh				= 0xeb0
-let xk_Hangul_Mieum					= 0xeb1
-let xk_Hangul_Pieub					= 0xeb2
-let xk_Hangul_SsangPieub				= 0xeb3
-let xk_Hangul_PieubSios				= 0xeb4
-let xk_Hangul_Sios					= 0xeb5
-let xk_Hangul_SsangSios				= 0xeb6
-let xk_Hangul_Ieung					= 0xeb7
-let xk_Hangul_Jieuj					= 0xeb8
-let xk_Hangul_SsangJieuj				= 0xeb9
-let xk_Hangul_Cieuc					= 0xeba
-let xk_Hangul_Khieuq				= 0xebb
-let xk_Hangul_Tieut					= 0xebc
-let xk_Hangul_Phieuf				= 0xebd
-let xk_Hangul_Hieuh					= 0xebe
-
-(** Hangul Vowel Characters *)
-let xk_Hangul_A					= 0xebf
-let xk_Hangul_AE					= 0xec0
-let xk_Hangul_YA					= 0xec1
-let xk_Hangul_YAE					= 0xec2
-let xk_Hangul_EO					= 0xec3
-let xk_Hangul_E					= 0xec4
-let xk_Hangul_YEO					= 0xec5
-let xk_Hangul_YE					= 0xec6
-let xk_Hangul_O					= 0xec7
-let xk_Hangul_WA					= 0xec8
-let xk_Hangul_WAE					= 0xec9
-let xk_Hangul_OE					= 0xeca
-let xk_Hangul_YO					= 0xecb
-let xk_Hangul_U					= 0xecc
-let xk_Hangul_WEO					= 0xecd
-let xk_Hangul_WE					= 0xece
-let xk_Hangul_WI					= 0xecf
-let xk_Hangul_YU					= 0xed0
-let xk_Hangul_EU					= 0xed1
-let xk_Hangul_YI					= 0xed2
-let xk_Hangul_I					= 0xed3
-
-(** Hangul syllable-final (JongSeong) Characters *)
-let xk_Hangul_J_Kiyeog				= 0xed4
-let xk_Hangul_J_SsangKiyeog				= 0xed5
-let xk_Hangul_J_KiyeogSios				= 0xed6
-let xk_Hangul_J_Nieun				= 0xed7
-let xk_Hangul_J_NieunJieuj				= 0xed8
-let xk_Hangul_J_NieunHieuh				= 0xed9
-let xk_Hangul_J_Dikeud				= 0xeda
-let xk_Hangul_J_Rieul				= 0xedb
-let xk_Hangul_J_RieulKiyeog				= 0xedc
-let xk_Hangul_J_RieulMieum				= 0xedd
-let xk_Hangul_J_RieulPieub				= 0xede
-let xk_Hangul_J_RieulSios				= 0xedf
-let xk_Hangul_J_RieulTieut				= 0xee0
-let xk_Hangul_J_RieulPhieuf				= 0xee1
-let xk_Hangul_J_RieulHieuh				= 0xee2
-let xk_Hangul_J_Mieum				= 0xee3
-let xk_Hangul_J_Pieub				= 0xee4
-let xk_Hangul_J_PieubSios				= 0xee5
-let xk_Hangul_J_Sios				= 0xee6
-let xk_Hangul_J_SsangSios				= 0xee7
-let xk_Hangul_J_Ieung				= 0xee8
-let xk_Hangul_J_Jieuj				= 0xee9
-let xk_Hangul_J_Cieuc				= 0xeea
-let xk_Hangul_J_Khieuq				= 0xeeb
-let xk_Hangul_J_Tieut				= 0xeec
-let xk_Hangul_J_Phieuf				= 0xeed
-let xk_Hangul_J_Hieuh				= 0xeee
-
-(** Ancient Hangul Consonant Characters *)
-let xk_Hangul_RieulYeorinHieuh			= 0xeef
-let xk_Hangul_SunkyeongeumMieum			= 0xef0
-let xk_Hangul_SunkyeongeumPieub			= 0xef1
-let xk_Hangul_PanSios				= 0xef2
-let xk_Hangul_KkogjiDalrinIeung			= 0xef3
-let xk_Hangul_SunkyeongeumPhieuf			= 0xef4
-let xk_Hangul_YeorinHieuh				= 0xef5
-
-(** Ancient Hangul Vowel Characters *)
-let xk_Hangul_AraeA					= 0xef6
-let xk_Hangul_AraeAE				= 0xef7
-
-(** Ancient Hangul syllable-final (JongSeong) Characters *)
-let xk_Hangul_J_PanSios				= 0xef8
-let xk_Hangul_J_KkogjiDalrinIeung			= 0xef9
-let xk_Hangul_J_YeorinHieuh				= 0xefa
-
-(** Korean currency symbol *)
-let xk_Korean_Won					= 0xeff
-
-
-
-let name_to_keysym = [
-"VoidSymbol",0xFFFFFF;
-"BackSpace",0xFF08;
-"Tab",0xFF09;
-"Linefeed",0xFF0A;
-"Clear",0xFF0B;
-"Return",0xFF0D;
-"Pause",0xFF13;
-"Scroll_Lock",0xFF14;
-"Sys_Req",0xFF15;
-"Escape",0xFF1B;
-"Delete",0xFFFF;
-"Multi_key",0xFF20;
-"Kanji",0xFF21;
-"Muhenkan",0xFF22;
-"Henkan_Mode",0xFF23;
-"Henkan",0xFF23;
-"Romaji",0xFF24;
-"Hiragana",0xFF25;
-"Katakana",0xFF26;
-"Hiragana_Katakana",0xFF27;
-"Zenkaku",0xFF28;
-"Hankaku",0xFF29;
-"Zenkaku_Hankaku",0xFF2A;
-"Touroku",0xFF2B;
-"Massyo",0xFF2C;
-"Kana_Lock",0xFF2D;
-"Kana_Shift",0xFF2E;
-"Eisu_Shift",0xFF2F;
-"Eisu_toggle",0xFF30;
-"Home",0xFF50;
-"Left",0xFF51;
-"Up",0xFF52;
-"Right",0xFF53;
-"Down",0xFF54;
-"Prior",0xFF55;
-"Page_Up",0xFF55;
-"Next",0xFF56;
-"Page_Down",0xFF56;
-"End",0xFF57;
-"Begin",0xFF58;
-"Select",0xFF60;
-"Print",0xFF61;
-"Execute",0xFF62;
-"Insert",0xFF63;
-"Undo",0xFF65;
-"Redo",0xFF66;
-"Menu",0xFF67;
-"Find",0xFF68;
-"Cancel",0xFF69;
-"Help",0xFF6A;
-"Break",0xFF6B;
-"Mode_switch",0xFF7E;
-"script_switch",0xFF7E;
-"Num_Lock",0xFF7F;
-"KP_Space",0xFF80;
-"KP_Tab",0xFF89;
-"KP_Enter",0xFF8D;
-"KP_F1",0xFF91;
-"KP_F2",0xFF92;
-"KP_F3",0xFF93;
-"KP_F4",0xFF94;
-"KP_Home",0xFF95;
-"KP_Left",0xFF96;
-"KP_Up",0xFF97;
-"KP_Right",0xFF98;
-"KP_Down",0xFF99;
-"KP_Prior",0xFF9A;
-"KP_Page_Up",0xFF9A;
-"KP_Next",0xFF9B;
-"KP_Page_Down",0xFF9B;
-"KP_End",0xFF9C;
-"KP_Begin",0xFF9D;
-"KP_Insert",0xFF9E;
-"KP_Delete",0xFF9F;
-"KP_Equal",0xFFBD;
-"KP_Multiply",0xFFAA;
-"KP_Add",0xFFAB;
-"KP_Separator",0xFFAC;
-"KP_Subtract",0xFFAD;
-"KP_Decimal",0xFFAE;
-"KP_Divide",0xFFAF;
-"KP_0",0xFFB0;
-"KP_1",0xFFB1;
-"KP_2",0xFFB2;
-"KP_3",0xFFB3;
-"KP_4",0xFFB4;
-"KP_5",0xFFB5;
-"KP_6",0xFFB6;
-"KP_7",0xFFB7;
-"KP_8",0xFFB8;
-"KP_9",0xFFB9;
-"F1",0xFFBE;
-"F2",0xFFBF;
-"F3",0xFFC0;
-"F4",0xFFC1;
-"F5",0xFFC2;
-"F6",0xFFC3;
-"F7",0xFFC4;
-"F8",0xFFC5;
-"F9",0xFFC6;
-"F10",0xFFC7;
-"F11",0xFFC8;
-"L1",0xFFC8;
-"F12",0xFFC9;
-"L2",0xFFC9;
-"F13",0xFFCA;
-"L3",0xFFCA;
-"F14",0xFFCB;
-"L4",0xFFCB;
-"F15",0xFFCC;
-"L5",0xFFCC;
-"F16",0xFFCD;
-"L6",0xFFCD;
-"F17",0xFFCE;
-"L7",0xFFCE;
-"F18",0xFFCF;
-"L8",0xFFCF;
-"F19",0xFFD0;
-"L9",0xFFD0;
-"F20",0xFFD1;
-"L10",0xFFD1;
-"F21",0xFFD2;
-"R1",0xFFD2;
-"F22",0xFFD3;
-"R2",0xFFD3;
-"F23",0xFFD4;
-"R3",0xFFD4;
-"F24",0xFFD5;
-"R4",0xFFD5;
-"F25",0xFFD6;
-"R5",0xFFD6;
-"F26",0xFFD7;
-"R6",0xFFD7;
-"F27",0xFFD8;
-"R7",0xFFD8;
-"F28",0xFFD9;
-"R8",0xFFD9;
-"F29",0xFFDA;
-"R9",0xFFDA;
-"F30",0xFFDB;
-"R10",0xFFDB;
-"F31",0xFFDC;
-"R11",0xFFDC;
-"F32",0xFFDD;
-"R12",0xFFDD;
-"F33",0xFFDE;
-"R13",0xFFDE;
-"F34",0xFFDF;
-"R14",0xFFDF;
-"F35",0xFFE0;
-"R15",0xFFE0;
-"Shift_L",0xFFE1;
-"Shift_R",0xFFE2;
-"Control_L",0xFFE3;
-"Control_R",0xFFE4;
-"Caps_Lock",0xFFE5;
-"Shift_Lock",0xFFE6;
-"Meta_L",0xFFE7;
-"Meta_R",0xFFE8;
-"Alt_L",0xFFE9;
-"Alt_R",0xFFEA;
-"Super_L",0xFFEB;
-"Super_R",0xFFEC;
-"Hyper_L",0xFFED;
-"Hyper_R",0xFFEE;
-"ISO_Lock",0xFE01;
-"ISO_Level2_Latch",0xFE02;
-"ISO_Level3_Shift",0xFE03;
-"ISO_Level3_Latch",0xFE04;
-"ISO_Level3_Lock",0xFE05;
-"ISO_Group_Shift",0xFF7E;
-"ISO_Group_Latch",0xFE06;
-"ISO_Group_Lock",0xFE07;
-"ISO_Next_Group",0xFE08;
-"ISO_Next_Group_Lock",0xFE09;
-"ISO_Prev_Group",0xFE0A;
-"ISO_Prev_Group_Lock",0xFE0B;
-"ISO_First_Group",0xFE0C;
-"ISO_First_Group_Lock",0xFE0D;
-"ISO_Last_Group",0xFE0E;
-"ISO_Last_Group_Lock",0xFE0F;
-"ISO_Left_Tab",0xFE20;
-"ISO_Move_Line_Up",0xFE21;
-"ISO_Move_Line_Down",0xFE22;
-"ISO_Partial_Line_Up",0xFE23;
-"ISO_Partial_Line_Down",0xFE24;
-"ISO_Partial_Space_Left",0xFE25;
-"ISO_Partial_Space_Right",0xFE26;
-"ISO_Set_Margin_Left",0xFE27;
-"ISO_Set_Margin_Right",0xFE28;
-"ISO_Release_Margin_Left",0xFE29;
-"ISO_Release_Margin_Right",0xFE2A;
-"ISO_Release_Both_Margins",0xFE2B;
-"ISO_Fast_Cursor_Left",0xFE2C;
-"ISO_Fast_Cursor_Right",0xFE2D;
-"ISO_Fast_Cursor_Up",0xFE2E;
-"ISO_Fast_Cursor_Down",0xFE2F;
-"ISO_Continuous_Underline",0xFE30;
-"ISO_Discontinuous_Underline",0xFE31;
-"ISO_Emphasize",0xFE32;
-"ISO_Center_Object",0xFE33;
-"ISO_Enter",0xFE34;
-"dead_grave",0xFE50;
-"dead_acute",0xFE51;
-"dead_circumflex",0xFE52;
-"dead_tilde",0xFE53;
-"dead_macron",0xFE54;
-"dead_breve",0xFE55;
-"dead_abovedot",0xFE56;
-"dead_diaeresis",0xFE57;
-"dead_abovering",0xFE58;
-"dead_doubleacute",0xFE59;
-"dead_caron",0xFE5A;
-"dead_cedilla",0xFE5B;
-"dead_ogonek",0xFE5C;
-"dead_iota",0xFE5D;
-"dead_voiced_sound",0xFE5E;
-"dead_semivoiced_sound",0xFE5F;
-"dead_belowdot",0xFE60;
-"First_Virtual_Screen",0xFED0;
-"Prev_Virtual_Screen",0xFED1;
-"Next_Virtual_Screen",0xFED2;
-"Last_Virtual_Screen",0xFED4;
-"Terminate_Server",0xFED5;
-"AccessX_Enable",0xFE70;
-"AccessX_Feedback_Enable",0xFE71;
-"RepeatKeys_Enable",0xFE72;
-"SlowKeys_Enable",0xFE73;
-"BounceKeys_Enable",0xFE74;
-"StickyKeys_Enable",0xFE75;
-"MouseKeys_Enable",0xFE76;
-"MouseKeys_Accel_Enable",0xFE77;
-"Overlay1_Enable",0xFE78;
-"Overlay2_Enable",0xFE79;
-"AudibleBell_Enable",0xFE7A;
-"Pointer_Left",0xFEE0;
-"Pointer_Right",0xFEE1;
-"Pointer_Up",0xFEE2;
-"Pointer_Down",0xFEE3;
-"Pointer_UpLeft",0xFEE4;
-"Pointer_UpRight",0xFEE5;
-"Pointer_DownLeft",0xFEE6;
-"Pointer_DownRight",0xFEE7;
-"Pointer_Button_Dflt",0xFEE8;
-"Pointer_Button1",0xFEE9;
-"Pointer_Button2",0xFEEA;
-"Pointer_Button3",0xFEEB;
-"Pointer_Button4",0xFEEC;
-"Pointer_Button5",0xFEED;
-"Pointer_DblClick_Dflt",0xFEEE;
-"Pointer_DblClick1",0xFEEF;
-"Pointer_DblClick2",0xFEF0;
-"Pointer_DblClick3",0xFEF1;
-"Pointer_DblClick4",0xFEF2;
-"Pointer_DblClick5",0xFEF3;
-"Pointer_Drag_Dflt",0xFEF4;
-"Pointer_Drag1",0xFEF5;
-"Pointer_Drag2",0xFEF6;
-"Pointer_Drag3",0xFEF7;
-"Pointer_Drag4",0xFEF8;
-"Pointer_Drag5",0xFEFD;
-"Pointer_EnableKeys",0xFEF9;
-"Pointer_Accelerate",0xFEFA;
-"Pointer_DfltBtnNext",0xFEFB;
-"Pointer_DfltBtnPrev",0xFEFC;
-"3270_Duplicate",0xFD01;
-"3270_FieldMark",0xFD02;
-"3270_Right2",0xFD03;
-"3270_Left2",0xFD04;
-"3270_BackTab",0xFD05;
-"3270_EraseEOF",0xFD06;
-"3270_EraseInput",0xFD07;
-"3270_Reset",0xFD08;
-"3270_Quit",0xFD09;
-"3270_PA1",0xFD0A;
-"3270_PA2",0xFD0B;
-"3270_PA3",0xFD0C;
-"3270_Test",0xFD0D;
-"3270_Attn",0xFD0E;
-"3270_CursorBlink",0xFD0F;
-"3270_AltCursor",0xFD10;
-"3270_KeyClick",0xFD11;
-"3270_Jump",0xFD12;
-"3270_Ident",0xFD13;
-"3270_Rule",0xFD14;
-"3270_Copy",0xFD15;
-"3270_Play",0xFD16;
-"3270_Setup",0xFD17;
-"3270_Record",0xFD18;
-"3270_ChangeScreen",0xFD19;
-"3270_DeleteWord",0xFD1A;
-"3270_ExSelect",0xFD1B;
-"3270_CursorSelect",0xFD1C;
-"3270_PrintScreen",0xFD1D;
-"3270_Enter",0xFD1E;
-"space",0x020;
-"exclam",0x021;
-"quotedbl",0x022;
-"numbersign",0x023;
-"dollar",0x024;
-"percent",0x025;
-"ampersand",0x026;
-"apostrophe",0x027;
-"quoteright",0x027;
-"parenleft",0x028;
-"parenright",0x029;
-"asterisk",0x02a;
-"plus",0x02b;
-"comma",0x02c;
-"minus",0x02d;
-"period",0x02e;
-"slash",0x02f;
-"0",0x030;
-"1",0x031;
-"2",0x032;
-"3",0x033;
-"4",0x034;
-"5",0x035;
-"6",0x036;
-"7",0x037;
-"8",0x038;
-"9",0x039;
-"colon",0x03a;
-"semicolon",0x03b;
-"less",0x03c;
-"equal",0x03d;
-"greater",0x03e;
-"question",0x03f;
-"at",0x040;
-"A",0x041;
-"B",0x042;
-"C",0x043;
-"D",0x044;
-"E",0x045;
-"F",0x046;
-"G",0x047;
-"H",0x048;
-"I",0x049;
-"J",0x04a;
-"K",0x04b;
-"L",0x04c;
-"M",0x04d;
-"N",0x04e;
-"O",0x04f;
-"P",0x050;
-"Q",0x051;
-"R",0x052;
-"S",0x053;
-"T",0x054;
-"U",0x055;
-"V",0x056;
-"W",0x057;
-"X",0x058;
-"Y",0x059;
-"Z",0x05a;
-"bracketleft",0x05b;
-"backslash",0x05c;
-"bracketright",0x05d;
-"asciicircum",0x05e;
-"underscore",0x05f;
-"grave",0x060;
-"quoteleft",0x060;
-"a",0x061;
-"b",0x062;
-"c",0x063;
-"d",0x064;
-"e",0x065;
-"f",0x066;
-"g",0x067;
-"h",0x068;
-"i",0x069;
-"j",0x06a;
-"k",0x06b;
-"l",0x06c;
-"m",0x06d;
-"n",0x06e;
-"o",0x06f;
-"p",0x070;
-"q",0x071;
-"r",0x072;
-"s",0x073;
-"t",0x074;
-"u",0x075;
-"v",0x076;
-"w",0x077;
-"x",0x078;
-"y",0x079;
-"z",0x07a;
-"braceleft",0x07b;
-"bar",0x07c;
-"braceright",0x07d;
-"asciitilde",0x07e;
-"nobreakspace",0x0a0;
-"exclamdown",0x0a1;
-"cent",0x0a2;
-"sterling",0x0a3;
-"currency",0x0a4;
-"yen",0x0a5;
-"brokenbar",0x0a6;
-"section",0x0a7;
-"diaeresis",0x0a8;
-"copyright",0x0a9;
-"ordfeminine",0x0aa;
-"guillemotleft",0x0ab;
-"notsign",0x0ac;
-"hyphen",0x0ad;
-"registered",0x0ae;
-"macron",0x0af;
-"degree",0x0b0;
-"plusminus",0x0b1;
-"twosuperior",0x0b2;
-"threesuperior",0x0b3;
-"acute",0x0b4;
-"mu",0x0b5;
-"paragraph",0x0b6;
-"periodcentered",0x0b7;
-"cedilla",0x0b8;
-"onesuperior",0x0b9;
-"masculine",0x0ba;
-"guillemotright",0x0bb;
-"onequarter",0x0bc;
-"onehalf",0x0bd;
-"threequarters",0x0be;
-"questiondown",0x0bf;
-"Agrave",0x0c0;
-"Aacute",0x0c1;
-"Acircumflex",0x0c2;
-"Atilde",0x0c3;
-"Adiaeresis",0x0c4;
-"Aring",0x0c5;
-"AE",0x0c6;
-"Ccedilla",0x0c7;
-"Egrave",0x0c8;
-"Eacute",0x0c9;
-"Ecircumflex",0x0ca;
-"Ediaeresis",0x0cb;
-"Igrave",0x0cc;
-"Iacute",0x0cd;
-"Icircumflex",0x0ce;
-"Idiaeresis",0x0cf;
-"ETH",0x0d0;
-"Eth",0x0d0;
-"Ntilde",0x0d1;
-"Ograve",0x0d2;
-"Oacute",0x0d3;
-"Ocircumflex",0x0d4;
-"Otilde",0x0d5;
-"Odiaeresis",0x0d6;
-"multiply",0x0d7;
-"Ooblique",0x0d8;
-"Ugrave",0x0d9;
-"Uacute",0x0da;
-"Ucircumflex",0x0db;
-"Udiaeresis",0x0dc;
-"Yacute",0x0dd;
-"THORN",0x0de;
-"Thorn",0x0de;
-"ssharp",0x0df;
-"agrave",0x0e0;
-"aacute",0x0e1;
-"acircumflex",0x0e2;
-"atilde",0x0e3;
-"adiaeresis",0x0e4;
-"aring",0x0e5;
-"ae",0x0e6;
-"ccedilla",0x0e7;
-"egrave",0x0e8;
-"eacute",0x0e9;
-"ecircumflex",0x0ea;
-"ediaeresis",0x0eb;
-"igrave",0x0ec;
-"iacute",0x0ed;
-"icircumflex",0x0ee;
-"idiaeresis",0x0ef;
-"eth",0x0f0;
-"ntilde",0x0f1;
-"ograve",0x0f2;
-"oacute",0x0f3;
-"ocircumflex",0x0f4;
-"otilde",0x0f5;
-"odiaeresis",0x0f6;
-"division",0x0f7;
-"oslash",0x0f8;
-"ugrave",0x0f9;
-"uacute",0x0fa;
-"ucircumflex",0x0fb;
-"udiaeresis",0x0fc;
-"yacute",0x0fd;
-"thorn",0x0fe;
-"ydiaeresis",0x0ff;
-"Aogonek",0x1a1;
-"breve",0x1a2;
-"Lstroke",0x1a3;
-"Lcaron",0x1a5;
-"Sacute",0x1a6;
-"Scaron",0x1a9;
-"Scedilla",0x1aa;
-"Tcaron",0x1ab;
-"Zacute",0x1ac;
-"Zcaron",0x1ae;
-"Zabovedot",0x1af;
-"aogonek",0x1b1;
-"ogonek",0x1b2;
-"lstroke",0x1b3;
-"lcaron",0x1b5;
-"sacute",0x1b6;
-"caron",0x1b7;
-"scaron",0x1b9;
-"scedilla",0x1ba;
-"tcaron",0x1bb;
-"zacute",0x1bc;
-"doubleacute",0x1bd;
-"zcaron",0x1be;
-"zabovedot",0x1bf;
-"Racute",0x1c0;
-"Abreve",0x1c3;
-"Lacute",0x1c5;
-"Cacute",0x1c6;
-"Ccaron",0x1c8;
-"Eogonek",0x1ca;
-"Ecaron",0x1cc;
-"Dcaron",0x1cf;
-"Dstroke",0x1d0;
-"Nacute",0x1d1;
-"Ncaron",0x1d2;
-"Odoubleacute",0x1d5;
-"Rcaron",0x1d8;
-"Uring",0x1d9;
-"Udoubleacute",0x1db;
-"Tcedilla",0x1de;
-"racute",0x1e0;
-"abreve",0x1e3;
-"lacute",0x1e5;
-"cacute",0x1e6;
-"ccaron",0x1e8;
-"eogonek",0x1ea;
-"ecaron",0x1ec;
-"dcaron",0x1ef;
-"dstroke",0x1f0;
-"nacute",0x1f1;
-"ncaron",0x1f2;
-"odoubleacute",0x1f5;
-"udoubleacute",0x1fb;
-"rcaron",0x1f8;
-"uring",0x1f9;
-"tcedilla",0x1fe;
-"abovedot",0x1ff;
-"Hstroke",0x2a1;
-"Hcircumflex",0x2a6;
-"Iabovedot",0x2a9;
-"Gbreve",0x2ab;
-"Jcircumflex",0x2ac;
-"hstroke",0x2b1;
-"hcircumflex",0x2b6;
-"idotless",0x2b9;
-"gbreve",0x2bb;
-"jcircumflex",0x2bc;
-"Cabovedot",0x2c5;
-"Ccircumflex",0x2c6;
-"Gabovedot",0x2d5;
-"Gcircumflex",0x2d8;
-"Ubreve",0x2dd;
-"Scircumflex",0x2de;
-"cabovedot",0x2e5;
-"ccircumflex",0x2e6;
-"gabovedot",0x2f5;
-"gcircumflex",0x2f8;
-"ubreve",0x2fd;
-"scircumflex",0x2fe;
-"kra",0x3a2;
-"kappa",0x3a2;
-"Rcedilla",0x3a3;
-"Itilde",0x3a5;
-"Lcedilla",0x3a6;
-"Emacron",0x3aa;
-"Gcedilla",0x3ab;
-"Tslash",0x3ac;
-"rcedilla",0x3b3;
-"itilde",0x3b5;
-"lcedilla",0x3b6;
-"emacron",0x3ba;
-"gcedilla",0x3bb;
-"tslash",0x3bc;
-"ENG",0x3bd;
-"eng",0x3bf;
-"Amacron",0x3c0;
-"Iogonek",0x3c7;
-"Eabovedot",0x3cc;
-"Imacron",0x3cf;
-"Ncedilla",0x3d1;
-"Omacron",0x3d2;
-"Kcedilla",0x3d3;
-"Uogonek",0x3d9;
-"Utilde",0x3dd;
-"Umacron",0x3de;
-"amacron",0x3e0;
-"iogonek",0x3e7;
-"eabovedot",0x3ec;
-"imacron",0x3ef;
-"ncedilla",0x3f1;
-"omacron",0x3f2;
-"kcedilla",0x3f3;
-"uogonek",0x3f9;
-"utilde",0x3fd;
-"umacron",0x3fe;
-"overline",0x47e;
-"kana_fullstop",0x4a1;
-"kana_openingbracket",0x4a2;
-"kana_closingbracket",0x4a3;
-"kana_comma",0x4a4;
-"kana_conjunctive",0x4a5;
-"kana_middledot",0x4a5;
-"kana_WO",0x4a6;
-"kana_a",0x4a7;
-"kana_i",0x4a8;
-"kana_u",0x4a9;
-"kana_e",0x4aa;
-"kana_o",0x4ab;
-"kana_ya",0x4ac;
-"kana_yu",0x4ad;
-"kana_yo",0x4ae;
-"kana_tsu",0x4af;
-"kana_tu",0x4af;
-"prolongedsound",0x4b0;
-"kana_A",0x4b1;
-"kana_I",0x4b2;
-"kana_U",0x4b3;
-"kana_E",0x4b4;
-"kana_O",0x4b5;
-"kana_KA",0x4b6;
-"kana_KI",0x4b7;
-"kana_KU",0x4b8;
-"kana_KE",0x4b9;
-"kana_KO",0x4ba;
-"kana_SA",0x4bb;
-"kana_SHI",0x4bc;
-"kana_SU",0x4bd;
-"kana_SE",0x4be;
-"kana_SO",0x4bf;
-"kana_TA",0x4c0;
-"kana_CHI",0x4c1;
-"kana_TI",0x4c1;
-"kana_TSU",0x4c2;
-"kana_TU",0x4c2;
-"kana_TE",0x4c3;
-"kana_TO",0x4c4;
-"kana_NA",0x4c5;
-"kana_NI",0x4c6;
-"kana_NU",0x4c7;
-"kana_NE",0x4c8;
-"kana_NO",0x4c9;
-"kana_HA",0x4ca;
-"kana_HI",0x4cb;
-"kana_FU",0x4cc;
-"kana_HU",0x4cc;
-"kana_HE",0x4cd;
-"kana_HO",0x4ce;
-"kana_MA",0x4cf;
-"kana_MI",0x4d0;
-"kana_MU",0x4d1;
-"kana_ME",0x4d2;
-"kana_MO",0x4d3;
-"kana_YA",0x4d4;
-"kana_YU",0x4d5;
-"kana_YO",0x4d6;
-"kana_RA",0x4d7;
-"kana_RI",0x4d8;
-"kana_RU",0x4d9;
-"kana_RE",0x4da;
-"kana_RO",0x4db;
-"kana_WA",0x4dc;
-"kana_N",0x4dd;
-"voicedsound",0x4de;
-"semivoicedsound",0x4df;
-"kana_switch",0xFF7E;
-"Arabic_comma",0x5ac;
-"Arabic_semicolon",0x5bb;
-"Arabic_question_mark",0x5bf;
-"Arabic_hamza",0x5c1;
-"Arabic_maddaonalef",0x5c2;
-"Arabic_hamzaonalef",0x5c3;
-"Arabic_hamzaonwaw",0x5c4;
-"Arabic_hamzaunderalef",0x5c5;
-"Arabic_hamzaonyeh",0x5c6;
-"Arabic_alef",0x5c7;
-"Arabic_beh",0x5c8;
-"Arabic_tehmarbuta",0x5c9;
-"Arabic_teh",0x5ca;
-"Arabic_theh",0x5cb;
-"Arabic_jeem",0x5cc;
-"Arabic_hah",0x5cd;
-"Arabic_khah",0x5ce;
-"Arabic_dal",0x5cf;
-"Arabic_thal",0x5d0;
-"Arabic_ra",0x5d1;
-"Arabic_zain",0x5d2;
-"Arabic_seen",0x5d3;
-"Arabic_sheen",0x5d4;
-"Arabic_sad",0x5d5;
-"Arabic_dad",0x5d6;
-"Arabic_tah",0x5d7;
-"Arabic_zah",0x5d8;
-"Arabic_ain",0x5d9;
-"Arabic_ghain",0x5da;
-"Arabic_tatweel",0x5e0;
-"Arabic_feh",0x5e1;
-"Arabic_qaf",0x5e2;
-"Arabic_kaf",0x5e3;
-"Arabic_lam",0x5e4;
-"Arabic_meem",0x5e5;
-"Arabic_noon",0x5e6;
-"Arabic_ha",0x5e7;
-"Arabic_heh",0x5e7;
-"Arabic_waw",0x5e8;
-"Arabic_alefmaksura",0x5e9;
-"Arabic_yeh",0x5ea;
-"Arabic_fathatan",0x5eb;
-"Arabic_dammatan",0x5ec;
-"Arabic_kasratan",0x5ed;
-"Arabic_fatha",0x5ee;
-"Arabic_damma",0x5ef;
-"Arabic_kasra",0x5f0;
-"Arabic_shadda",0x5f1;
-"Arabic_sukun",0x5f2;
-"Arabic_switch",0xFF7E;
-"Serbian_dje",0x6a1;
-"Macedonia_gje",0x6a2;
-"Cyrillic_io",0x6a3;
-"Ukrainian_ie",0x6a4;
-"Ukranian_je",0x6a4;
-"Macedonia_dse",0x6a5;
-"Ukrainian_i",0x6a6;
-"Ukranian_i",0x6a6;
-"Ukrainian_yi",0x6a7;
-"Ukranian_yi",0x6a7;
-"Cyrillic_je",0x6a8;
-"Serbian_je",0x6a8;
-"Cyrillic_lje",0x6a9;
-"Serbian_lje",0x6a9;
-"Cyrillic_nje",0x6aa;
-"Serbian_nje",0x6aa;
-"Serbian_tshe",0x6ab;
-"Macedonia_kje",0x6ac;
-"Byelorussian_shortu",0x6ae;
-"Cyrillic_dzhe",0x6af;
-"Serbian_dze",0x6af;
-"numerosign",0x6b0;
-"Serbian_DJE",0x6b1;
-"Macedonia_GJE",0x6b2;
-"Cyrillic_IO",0x6b3;
-"Ukrainian_IE",0x6b4;
-"Ukranian_JE",0x6b4;
-"Macedonia_DSE",0x6b5;
-"Ukrainian_I",0x6b6;
-"Ukranian_I",0x6b6;
-"Ukrainian_YI",0x6b7;
-"Ukranian_YI",0x6b7;
-"Cyrillic_JE",0x6b8;
-"Serbian_JE",0x6b8;
-"Cyrillic_LJE",0x6b9;
-"Serbian_LJE",0x6b9;
-"Cyrillic_NJE",0x6ba;
-"Serbian_NJE",0x6ba;
-"Serbian_TSHE",0x6bb;
-"Macedonia_KJE",0x6bc;
-"Byelorussian_SHORTU",0x6be;
-"Cyrillic_DZHE",0x6bf;
-"Serbian_DZE",0x6bf;
-"Cyrillic_yu",0x6c0;
-"Cyrillic_a",0x6c1;
-"Cyrillic_be",0x6c2;
-"Cyrillic_tse",0x6c3;
-"Cyrillic_de",0x6c4;
-"Cyrillic_ie",0x6c5;
-"Cyrillic_ef",0x6c6;
-"Cyrillic_ghe",0x6c7;
-"Cyrillic_ha",0x6c8;
-"Cyrillic_i",0x6c9;
-"Cyrillic_shorti",0x6ca;
-"Cyrillic_ka",0x6cb;
-"Cyrillic_el",0x6cc;
-"Cyrillic_em",0x6cd;
-"Cyrillic_en",0x6ce;
-"Cyrillic_o",0x6cf;
-"Cyrillic_pe",0x6d0;
-"Cyrillic_ya",0x6d1;
-"Cyrillic_er",0x6d2;
-"Cyrillic_es",0x6d3;
-"Cyrillic_te",0x6d4;
-"Cyrillic_u",0x6d5;
-"Cyrillic_zhe",0x6d6;
-"Cyrillic_ve",0x6d7;
-"Cyrillic_softsign",0x6d8;
-"Cyrillic_yeru",0x6d9;
-"Cyrillic_ze",0x6da;
-"Cyrillic_sha",0x6db;
-"Cyrillic_e",0x6dc;
-"Cyrillic_shcha",0x6dd;
-"Cyrillic_che",0x6de;
-"Cyrillic_hardsign",0x6df;
-"Cyrillic_YU",0x6e0;
-"Cyrillic_A",0x6e1;
-"Cyrillic_BE",0x6e2;
-"Cyrillic_TSE",0x6e3;
-"Cyrillic_DE",0x6e4;
-"Cyrillic_IE",0x6e5;
-"Cyrillic_EF",0x6e6;
-"Cyrillic_GHE",0x6e7;
-"Cyrillic_HA",0x6e8;
-"Cyrillic_I",0x6e9;
-"Cyrillic_SHORTI",0x6ea;
-"Cyrillic_KA",0x6eb;
-"Cyrillic_EL",0x6ec;
-"Cyrillic_EM",0x6ed;
-"Cyrillic_EN",0x6ee;
-"Cyrillic_O",0x6ef;
-"Cyrillic_PE",0x6f0;
-"Cyrillic_YA",0x6f1;
-"Cyrillic_ER",0x6f2;
-"Cyrillic_ES",0x6f3;
-"Cyrillic_TE",0x6f4;
-"Cyrillic_U",0x6f5;
-"Cyrillic_ZHE",0x6f6;
-"Cyrillic_VE",0x6f7;
-"Cyrillic_SOFTSIGN",0x6f8;
-"Cyrillic_YERU",0x6f9;
-"Cyrillic_ZE",0x6fa;
-"Cyrillic_SHA",0x6fb;
-"Cyrillic_E",0x6fc;
-"Cyrillic_SHCHA",0x6fd;
-"Cyrillic_CHE",0x6fe;
-"Cyrillic_HARDSIGN",0x6ff;
-"Greek_ALPHAaccent",0x7a1;
-"Greek_EPSILONaccent",0x7a2;
-"Greek_ETAaccent",0x7a3;
-"Greek_IOTAaccent",0x7a4;
-"Greek_IOTAdiaeresis",0x7a5;
-"Greek_OMICRONaccent",0x7a7;
-"Greek_UPSILONaccent",0x7a8;
-"Greek_UPSILONdieresis",0x7a9;
-"Greek_OMEGAaccent",0x7ab;
-"Greek_accentdieresis",0x7ae;
-"Greek_horizbar",0x7af;
-"Greek_alphaaccent",0x7b1;
-"Greek_epsilonaccent",0x7b2;
-"Greek_etaaccent",0x7b3;
-"Greek_iotaaccent",0x7b4;
-"Greek_iotadieresis",0x7b5;
-"Greek_iotaaccentdieresis",0x7b6;
-"Greek_omicronaccent",0x7b7;
-"Greek_upsilonaccent",0x7b8;
-"Greek_upsilondieresis",0x7b9;
-"Greek_upsilonaccentdieresis",0x7ba;
-"Greek_omegaaccent",0x7bb;
-"Greek_ALPHA",0x7c1;
-"Greek_BETA",0x7c2;
-"Greek_GAMMA",0x7c3;
-"Greek_DELTA",0x7c4;
-"Greek_EPSILON",0x7c5;
-"Greek_ZETA",0x7c6;
-"Greek_ETA",0x7c7;
-"Greek_THETA",0x7c8;
-"Greek_IOTA",0x7c9;
-"Greek_KAPPA",0x7ca;
-"Greek_LAMDA",0x7cb;
-"Greek_LAMBDA",0x7cb;
-"Greek_MU",0x7cc;
-"Greek_NU",0x7cd;
-"Greek_XI",0x7ce;
-"Greek_OMICRON",0x7cf;
-"Greek_PI",0x7d0;
-"Greek_RHO",0x7d1;
-"Greek_SIGMA",0x7d2;
-"Greek_TAU",0x7d4;
-"Greek_UPSILON",0x7d5;
-"Greek_PHI",0x7d6;
-"Greek_CHI",0x7d7;
-"Greek_PSI",0x7d8;
-"Greek_OMEGA",0x7d9;
-"Greek_alpha",0x7e1;
-"Greek_beta",0x7e2;
-"Greek_gamma",0x7e3;
-"Greek_delta",0x7e4;
-"Greek_epsilon",0x7e5;
-"Greek_zeta",0x7e6;
-"Greek_eta",0x7e7;
-"Greek_theta",0x7e8;
-"Greek_iota",0x7e9;
-"Greek_kappa",0x7ea;
-"Greek_lamda",0x7eb;
-"Greek_lambda",0x7eb;
-"Greek_mu",0x7ec;
-"Greek_nu",0x7ed;
-"Greek_xi",0x7ee;
-"Greek_omicron",0x7ef;
-"Greek_pi",0x7f0;
-"Greek_rho",0x7f1;
-"Greek_sigma",0x7f2;
-"Greek_finalsmallsigma",0x7f3;
-"Greek_tau",0x7f4;
-"Greek_upsilon",0x7f5;
-"Greek_phi",0x7f6;
-"Greek_chi",0x7f7;
-"Greek_psi",0x7f8;
-"Greek_omega",0x7f9;
-"Greek_switch",0xFF7E;
-"leftradical",0x8a1;
-"topleftradical",0x8a2;
-"horizconnector",0x8a3;
-"topintegral",0x8a4;
-"botintegral",0x8a5;
-"vertconnector",0x8a6;
-"topleftsqbracket",0x8a7;
-"botleftsqbracket",0x8a8;
-"toprightsqbracket",0x8a9;
-"botrightsqbracket",0x8aa;
-"topleftparens",0x8ab;
-"botleftparens",0x8ac;
-"toprightparens",0x8ad;
-"botrightparens",0x8ae;
-"leftmiddlecurlybrace",0x8af;
-"rightmiddlecurlybrace",0x8b0;
-"topleftsummation",0x8b1;
-"botleftsummation",0x8b2;
-"topvertsummationconnector",0x8b3;
-"botvertsummationconnector",0x8b4;
-"toprightsummation",0x8b5;
-"botrightsummation",0x8b6;
-"rightmiddlesummation",0x8b7;
-"lessthanequal",0x8bc;
-"notequal",0x8bd;
-"greaterthanequal",0x8be;
-"integral",0x8bf;
-"therefore",0x8c0;
-"variation",0x8c1;
-"infinity",0x8c2;
-"nabla",0x8c5;
-"approximate",0x8c8;
-"similarequal",0x8c9;
-"ifonlyif",0x8cd;
-"implies",0x8ce;
-"identical",0x8cf;
-"radical",0x8d6;
-"includedin",0x8da;
-"includes",0x8db;
-"intersection",0x8dc;
-"union",0x8dd;
-"logicaland",0x8de;
-"logicalor",0x8df;
-"partialderivative",0x8ef;
-"function",0x8f6;
-"leftarrow",0x8fb;
-"uparrow",0x8fc;
-"rightarrow",0x8fd;
-"downarrow",0x8fe;
-"blank",0x9df;
-"soliddiamond",0x9e0;
-"checkerboard",0x9e1;
-"ht",0x9e2;
-"ff",0x9e3;
-"cr",0x9e4;
-"lf",0x9e5;
-"nl",0x9e8;
-"vt",0x9e9;
-"lowrightcorner",0x9ea;
-"uprightcorner",0x9eb;
-"upleftcorner",0x9ec;
-"lowleftcorner",0x9ed;
-"crossinglines",0x9ee;
-"horizlinescan1",0x9ef;
-"horizlinescan3",0x9f0;
-"horizlinescan5",0x9f1;
-"horizlinescan7",0x9f2;
-"horizlinescan9",0x9f3;
-"leftt",0x9f4;
-"rightt",0x9f5;
-"bott",0x9f6;
-"topt",0x9f7;
-"vertbar",0x9f8;
-"emspace",0xaa1;
-"enspace",0xaa2;
-"em3space",0xaa3;
-"em4space",0xaa4;
-"digitspace",0xaa5;
-"punctspace",0xaa6;
-"thinspace",0xaa7;
-"hairspace",0xaa8;
-"emdash",0xaa9;
-"endash",0xaaa;
-"signifblank",0xaac;
-"ellipsis",0xaae;
-"doubbaselinedot",0xaaf;
-"onethird",0xab0;
-"twothirds",0xab1;
-"onefifth",0xab2;
-"twofifths",0xab3;
-"threefifths",0xab4;
-"fourfifths",0xab5;
-"onesixth",0xab6;
-"fivesixths",0xab7;
-"careof",0xab8;
-"figdash",0xabb;
-"leftanglebracket",0xabc;
-"decimalpoint",0xabd;
-"rightanglebracket",0xabe;
-"marker",0xabf;
-"oneeighth",0xac3;
-"threeeighths",0xac4;
-"fiveeighths",0xac5;
-"seveneighths",0xac6;
-"trademark",0xac9;
-"signaturemark",0xaca;
-"trademarkincircle",0xacb;
-"leftopentriangle",0xacc;
-"rightopentriangle",0xacd;
-"emopencircle",0xace;
-"emopenrectangle",0xacf;
-"leftsinglequotemark",0xad0;
-"rightsinglequotemark",0xad1;
-"leftdoublequotemark",0xad2;
-"rightdoublequotemark",0xad3;
-"prescription",0xad4;
-"minutes",0xad6;
-"seconds",0xad7;
-"latincross",0xad9;
-"hexagram",0xada;
-"filledrectbullet",0xadb;
-"filledlefttribullet",0xadc;
-"filledrighttribullet",0xadd;
-"emfilledcircle",0xade;
-"emfilledrect",0xadf;
-"enopencircbullet",0xae0;
-"enopensquarebullet",0xae1;
-"openrectbullet",0xae2;
-"opentribulletup",0xae3;
-"opentribulletdown",0xae4;
-"openstar",0xae5;
-"enfilledcircbullet",0xae6;
-"enfilledsqbullet",0xae7;
-"filledtribulletup",0xae8;
-"filledtribulletdown",0xae9;
-"leftpointer",0xaea;
-"rightpointer",0xaeb;
-"club",0xaec;
-"diamond",0xaed;
-"heart",0xaee;
-"maltesecross",0xaf0;
-"dagger",0xaf1;
-"doubledagger",0xaf2;
-"checkmark",0xaf3;
-"ballotcross",0xaf4;
-"musicalsharp",0xaf5;
-"musicalflat",0xaf6;
-"malesymbol",0xaf7;
-"femalesymbol",0xaf8;
-"telephone",0xaf9;
-"telephonerecorder",0xafa;
-"phonographcopyright",0xafb;
-"caret",0xafc;
-"singlelowquotemark",0xafd;
-"doublelowquotemark",0xafe;
-"cursor",0xaff;
-"leftcaret",0xba3;
-"rightcaret",0xba6;
-"downcaret",0xba8;
-"upcaret",0xba9;
-"overbar",0xbc0;
-"downtack",0xbc2;
-"upshoe",0xbc3;
-"downstile",0xbc4;
-"underbar",0xbc6;
-"jot",0xbca;
-"quad",0xbcc;
-"uptack",0xbce;
-"circle",0xbcf;
-"upstile",0xbd3;
-"downshoe",0xbd6;
-"rightshoe",0xbd8;
-"leftshoe",0xbda;
-"lefttack",0xbdc;
-"righttack",0xbfc;
-"hebrew_doublelowline",0xcdf;
-"hebrew_aleph",0xce0;
-"hebrew_bet",0xce1;
-"hebrew_beth",0xce1;
-"hebrew_gimel",0xce2;
-"hebrew_gimmel",0xce2;
-"hebrew_dalet",0xce3;
-"hebrew_daleth",0xce3;
-"hebrew_he",0xce4;
-"hebrew_waw",0xce5;
-"hebrew_zain",0xce6;
-"hebrew_zayin",0xce6;
-"hebrew_chet",0xce7;
-"hebrew_het",0xce7;
-"hebrew_tet",0xce8;
-"hebrew_teth",0xce8;
-"hebrew_yod",0xce9;
-"hebrew_finalkaph",0xcea;
-"hebrew_kaph",0xceb;
-"hebrew_lamed",0xcec;
-"hebrew_finalmem",0xced;
-"hebrew_mem",0xcee;
-"hebrew_finalnun",0xcef;
-"hebrew_nun",0xcf0;
-"hebrew_samech",0xcf1;
-"hebrew_samekh",0xcf1;
-"hebrew_ayin",0xcf2;
-"hebrew_finalpe",0xcf3;
-"hebrew_pe",0xcf4;
-"hebrew_finalzade",0xcf5;
-"hebrew_finalzadi",0xcf5;
-"hebrew_zade",0xcf6;
-"hebrew_zadi",0xcf6;
-"hebrew_qoph",0xcf7;
-"hebrew_kuf",0xcf7;
-"hebrew_resh",0xcf8;
-"hebrew_shin",0xcf9;
-"hebrew_taw",0xcfa;
-"hebrew_taf",0xcfa;
-"Hebrew_switch",0xFF7E;
-"Thai_kokai",0xda1;
-"Thai_khokhai",0xda2;
-"Thai_khokhuat",0xda3;
-"Thai_khokhwai",0xda4;
-"Thai_khokhon",0xda5;
-"Thai_khorakhang",0xda6;
-"Thai_ngongu",0xda7;
-"Thai_chochan",0xda8;
-"Thai_choching",0xda9;
-"Thai_chochang",0xdaa;
-"Thai_soso",0xdab;
-"Thai_chochoe",0xdac;
-"Thai_yoying",0xdad;
-"Thai_dochada",0xdae;
-"Thai_topatak",0xdaf;
-"Thai_thothan",0xdb0;
-"Thai_thonangmontho",0xdb1;
-"Thai_thophuthao",0xdb2;
-"Thai_nonen",0xdb3;
-"Thai_dodek",0xdb4;
-"Thai_totao",0xdb5;
-"Thai_thothung",0xdb6;
-"Thai_thothahan",0xdb7;
-"Thai_thothong",0xdb8;
-"Thai_nonu",0xdb9;
-"Thai_bobaimai",0xdba;
-"Thai_popla",0xdbb;
-"Thai_phophung",0xdbc;
-"Thai_fofa",0xdbd;
-"Thai_phophan",0xdbe;
-"Thai_fofan",0xdbf;
-"Thai_phosamphao",0xdc0;
-"Thai_moma",0xdc1;
-"Thai_yoyak",0xdc2;
-"Thai_rorua",0xdc3;
-"Thai_ru",0xdc4;
-"Thai_loling",0xdc5;
-"Thai_lu",0xdc6;
-"Thai_wowaen",0xdc7;
-"Thai_sosala",0xdc8;
-"Thai_sorusi",0xdc9;
-"Thai_sosua",0xdca;
-"Thai_hohip",0xdcb;
-"Thai_lochula",0xdcc;
-"Thai_oang",0xdcd;
-"Thai_honokhuk",0xdce;
-"Thai_paiyannoi",0xdcf;
-"Thai_saraa",0xdd0;
-"Thai_maihanakat",0xdd1;
-"Thai_saraaa",0xdd2;
-"Thai_saraam",0xdd3;
-"Thai_sarai",0xdd4;
-"Thai_saraii",0xdd5;
-"Thai_saraue",0xdd6;
-"Thai_sarauee",0xdd7;
-"Thai_sarau",0xdd8;
-"Thai_sarauu",0xdd9;
-"Thai_phinthu",0xdda;
-"Thai_maihanakat_maitho",0xdde;
-"Thai_baht",0xddf;
-"Thai_sarae",0xde0;
-"Thai_saraae",0xde1;
-"Thai_sarao",0xde2;
-"Thai_saraaimaimuan",0xde3;
-"Thai_saraaimaimalai",0xde4;
-"Thai_lakkhangyao",0xde5;
-"Thai_maiyamok",0xde6;
-"Thai_maitaikhu",0xde7;
-"Thai_maiek",0xde8;
-"Thai_maitho",0xde9;
-"Thai_maitri",0xdea;
-"Thai_maichattawa",0xdeb;
-"Thai_thanthakhat",0xdec;
-"Thai_nikhahit",0xded;
-"Thai_leksun",0xdf0;
-"Thai_leknung",0xdf1;
-"Thai_leksong",0xdf2;
-"Thai_leksam",0xdf3;
-"Thai_leksi",0xdf4;
-"Thai_lekha",0xdf5;
-"Thai_lekhok",0xdf6;
-"Thai_lekchet",0xdf7;
-"Thai_lekpaet",0xdf8;
-"Thai_lekkao",0xdf9;
-"Hangul",0xff31;
-"Hangul_Start",0xff32;
-"Hangul_End",0xff33;
-"Hangul_Hanja",0xff34;
-"Hangul_Jamo",0xff35;
-"Hangul_Romaja",0xff36;
-"Hangul_Codeinput",0xff37;
-"Hangul_Jeonja",0xff38;
-"Hangul_Banja",0xff39;
-"Hangul_PreHanja",0xff3a;
-"Hangul_PostHanja",0xff3b;
-"Hangul_SingleCandidate",0xff3c;
-"Hangul_MultipleCandidate",0xff3d;
-"Hangul_PreviousCandidate",0xff3e;
-"Hangul_Special",0xff3f;
-"Hangul_switch",0xFF7E;
-"Hangul_Kiyeog",0xea1;
-"Hangul_SsangKiyeog",0xea2;
-"Hangul_KiyeogSios",0xea3;
-"Hangul_Nieun",0xea4;
-"Hangul_NieunJieuj",0xea5;
-"Hangul_NieunHieuh",0xea6;
-"Hangul_Dikeud",0xea7;
-"Hangul_SsangDikeud",0xea8;
-"Hangul_Rieul",0xea9;
-"Hangul_RieulKiyeog",0xeaa;
-"Hangul_RieulMieum",0xeab;
-"Hangul_RieulPieub",0xeac;
-"Hangul_RieulSios",0xead;
-"Hangul_RieulTieut",0xeae;
-"Hangul_RieulPhieuf",0xeaf;
-"Hangul_RieulHieuh",0xeb0;
-"Hangul_Mieum",0xeb1;
-"Hangul_Pieub",0xeb2;
-"Hangul_SsangPieub",0xeb3;
-"Hangul_PieubSios",0xeb4;
-"Hangul_Sios",0xeb5;
-"Hangul_SsangSios",0xeb6;
-"Hangul_Ieung",0xeb7;
-"Hangul_Jieuj",0xeb8;
-"Hangul_SsangJieuj",0xeb9;
-"Hangul_Cieuc",0xeba;
-"Hangul_Khieuq",0xebb;
-"Hangul_Tieut",0xebc;
-"Hangul_Phieuf",0xebd;
-"Hangul_Hieuh",0xebe;
-"Hangul_A",0xebf;
-"Hangul_AE",0xec0;
-"Hangul_YA",0xec1;
-"Hangul_YAE",0xec2;
-"Hangul_EO",0xec3;
-"Hangul_E",0xec4;
-"Hangul_YEO",0xec5;
-"Hangul_YE",0xec6;
-"Hangul_O",0xec7;
-"Hangul_WA",0xec8;
-"Hangul_WAE",0xec9;
-"Hangul_OE",0xeca;
-"Hangul_YO",0xecb;
-"Hangul_U",0xecc;
-"Hangul_WEO",0xecd;
-"Hangul_WE",0xece;
-"Hangul_WI",0xecf;
-"Hangul_YU",0xed0;
-"Hangul_EU",0xed1;
-"Hangul_YI",0xed2;
-"Hangul_I",0xed3;
-"Hangul_J_Kiyeog",0xed4;
-"Hangul_J_SsangKiyeog",0xed5;
-"Hangul_J_KiyeogSios",0xed6;
-"Hangul_J_Nieun",0xed7;
-"Hangul_J_NieunJieuj",0xed8;
-"Hangul_J_NieunHieuh",0xed9;
-"Hangul_J_Dikeud",0xeda;
-"Hangul_J_Rieul",0xedb;
-"Hangul_J_RieulKiyeog",0xedc;
-"Hangul_J_RieulMieum",0xedd;
-"Hangul_J_RieulPieub",0xede;
-"Hangul_J_RieulSios",0xedf;
-"Hangul_J_RieulTieut",0xee0;
-"Hangul_J_RieulPhieuf",0xee1;
-"Hangul_J_RieulHieuh",0xee2;
-"Hangul_J_Mieum",0xee3;
-"Hangul_J_Pieub",0xee4;
-"Hangul_J_PieubSios",0xee5;
-"Hangul_J_Sios",0xee6;
-"Hangul_J_SsangSios",0xee7;
-"Hangul_J_Ieung",0xee8;
-"Hangul_J_Jieuj",0xee9;
-"Hangul_J_Cieuc",0xeea;
-"Hangul_J_Khieuq",0xeeb;
-"Hangul_J_Tieut",0xeec;
-"Hangul_J_Phieuf",0xeed;
-"Hangul_J_Hieuh",0xeee;
-"Hangul_RieulYeorinHieuh",0xeef;
-"Hangul_SunkyeongeumMieum",0xef0;
-"Hangul_SunkyeongeumPieub",0xef1;
-"Hangul_PanSios",0xef2;
-"Hangul_KkogjiDalrinIeung",0xef3;
-"Hangul_SunkyeongeumPhieuf",0xef4;
-"Hangul_YeorinHieuh",0xef5;
-"Hangul_AraeA",0xef6;
-"Hangul_AraeAE",0xef7;
-"Hangul_J_PanSios",0xef8;
-"Hangul_J_KkogjiDalrinIeung",0xef9;
-"Hangul_J_YeorinHieuh",0xefa;
-"Korean_Won",0xeff;
-]
-let keysym_to_name = [
-0xFFFFFF,"VoidSymbol";
-0xFF08,"BackSpace";
-0xFF09,"Tab";
-0xFF0A,"Linefeed";
-0xFF0B,"Clear";
-0xFF0D,"Return";
-0xFF13,"Pause";
-0xFF14,"Scroll_Lock";
-0xFF15,"Sys_Req";
-0xFF1B,"Escape";
-0xFFFF,"Delete";
-0xFF20,"Multi_key";
-0xFF21,"Kanji";
-0xFF22,"Muhenkan";
-0xFF23,"Henkan_Mode";
-0xFF23,"Henkan";
-0xFF24,"Romaji";
-0xFF25,"Hiragana";
-0xFF26,"Katakana";
-0xFF27,"Hiragana_Katakana";
-0xFF28,"Zenkaku";
-0xFF29,"Hankaku";
-0xFF2A,"Zenkaku_Hankaku";
-0xFF2B,"Touroku";
-0xFF2C,"Massyo";
-0xFF2D,"Kana_Lock";
-0xFF2E,"Kana_Shift";
-0xFF2F,"Eisu_Shift";
-0xFF30,"Eisu_toggle";
-0xFF50,"Home";
-0xFF51,"Left";
-0xFF52,"Up";
-0xFF53,"Right";
-0xFF54,"Down";
-0xFF55,"Prior";
-0xFF55,"Page_Up";
-0xFF56,"Next";
-0xFF56,"Page_Down";
-0xFF57,"End";
-0xFF58,"Begin";
-0xFF60,"Select";
-0xFF61,"Print";
-0xFF62,"Execute";
-0xFF63,"Insert";
-0xFF65,"Undo";
-0xFF66,"Redo";
-0xFF67,"Menu";
-0xFF68,"Find";
-0xFF69,"Cancel";
-0xFF6A,"Help";
-0xFF6B,"Break";
-0xFF7E,"Mode_switch";
-0xFF7E,"script_switch";
-0xFF7F,"Num_Lock";
-0xFF80,"KP_Space";
-0xFF89,"KP_Tab";
-0xFF8D,"KP_Enter";
-0xFF91,"KP_F1";
-0xFF92,"KP_F2";
-0xFF93,"KP_F3";
-0xFF94,"KP_F4";
-0xFF95,"KP_Home";
-0xFF96,"KP_Left";
-0xFF97,"KP_Up";
-0xFF98,"KP_Right";
-0xFF99,"KP_Down";
-0xFF9A,"KP_Prior";
-0xFF9A,"KP_Page_Up";
-0xFF9B,"KP_Next";
-0xFF9B,"KP_Page_Down";
-0xFF9C,"KP_End";
-0xFF9D,"KP_Begin";
-0xFF9E,"KP_Insert";
-0xFF9F,"KP_Delete";
-0xFFBD,"KP_Equal";
-0xFFAA,"KP_Multiply";
-0xFFAB,"KP_Add";
-0xFFAC,"KP_Separator";
-0xFFAD,"KP_Subtract";
-0xFFAE,"KP_Decimal";
-0xFFAF,"KP_Divide";
-0xFFB0,"KP_0";
-0xFFB1,"KP_1";
-0xFFB2,"KP_2";
-0xFFB3,"KP_3";
-0xFFB4,"KP_4";
-0xFFB5,"KP_5";
-0xFFB6,"KP_6";
-0xFFB7,"KP_7";
-0xFFB8,"KP_8";
-0xFFB9,"KP_9";
-0xFFBE,"F1";
-0xFFBF,"F2";
-0xFFC0,"F3";
-0xFFC1,"F4";
-0xFFC2,"F5";
-0xFFC3,"F6";
-0xFFC4,"F7";
-0xFFC5,"F8";
-0xFFC6,"F9";
-0xFFC7,"F10";
-0xFFC8,"F11";
-0xFFC8,"L1";
-0xFFC9,"F12";
-0xFFC9,"L2";
-0xFFCA,"F13";
-0xFFCA,"L3";
-0xFFCB,"F14";
-0xFFCB,"L4";
-0xFFCC,"F15";
-0xFFCC,"L5";
-0xFFCD,"F16";
-0xFFCD,"L6";
-0xFFCE,"F17";
-0xFFCE,"L7";
-0xFFCF,"F18";
-0xFFCF,"L8";
-0xFFD0,"F19";
-0xFFD0,"L9";
-0xFFD1,"F20";
-0xFFD1,"L10";
-0xFFD2,"F21";
-0xFFD2,"R1";
-0xFFD3,"F22";
-0xFFD3,"R2";
-0xFFD4,"F23";
-0xFFD4,"R3";
-0xFFD5,"F24";
-0xFFD5,"R4";
-0xFFD6,"F25";
-0xFFD6,"R5";
-0xFFD7,"F26";
-0xFFD7,"R6";
-0xFFD8,"F27";
-0xFFD8,"R7";
-0xFFD9,"F28";
-0xFFD9,"R8";
-0xFFDA,"F29";
-0xFFDA,"R9";
-0xFFDB,"F30";
-0xFFDB,"R10";
-0xFFDC,"F31";
-0xFFDC,"R11";
-0xFFDD,"F32";
-0xFFDD,"R12";
-0xFFDE,"F33";
-0xFFDE,"R13";
-0xFFDF,"F34";
-0xFFDF,"R14";
-0xFFE0,"F35";
-0xFFE0,"R15";
-0xFFE1,"Shift_L";
-0xFFE2,"Shift_R";
-0xFFE3,"Control_L";
-0xFFE4,"Control_R";
-0xFFE5,"Caps_Lock";
-0xFFE6,"Shift_Lock";
-0xFFE7,"Meta_L";
-0xFFE8,"Meta_R";
-0xFFE9,"Alt_L";
-0xFFEA,"Alt_R";
-0xFFEB,"Super_L";
-0xFFEC,"Super_R";
-0xFFED,"Hyper_L";
-0xFFEE,"Hyper_R";
-0xFE01,"ISO_Lock";
-0xFE02,"ISO_Level2_Latch";
-0xFE03,"ISO_Level3_Shift";
-0xFE04,"ISO_Level3_Latch";
-0xFE05,"ISO_Level3_Lock";
-0xFF7E,"ISO_Group_Shift";
-0xFE06,"ISO_Group_Latch";
-0xFE07,"ISO_Group_Lock";
-0xFE08,"ISO_Next_Group";
-0xFE09,"ISO_Next_Group_Lock";
-0xFE0A,"ISO_Prev_Group";
-0xFE0B,"ISO_Prev_Group_Lock";
-0xFE0C,"ISO_First_Group";
-0xFE0D,"ISO_First_Group_Lock";
-0xFE0E,"ISO_Last_Group";
-0xFE0F,"ISO_Last_Group_Lock";
-0xFE20,"ISO_Left_Tab";
-0xFE21,"ISO_Move_Line_Up";
-0xFE22,"ISO_Move_Line_Down";
-0xFE23,"ISO_Partial_Line_Up";
-0xFE24,"ISO_Partial_Line_Down";
-0xFE25,"ISO_Partial_Space_Left";
-0xFE26,"ISO_Partial_Space_Right";
-0xFE27,"ISO_Set_Margin_Left";
-0xFE28,"ISO_Set_Margin_Right";
-0xFE29,"ISO_Release_Margin_Left";
-0xFE2A,"ISO_Release_Margin_Right";
-0xFE2B,"ISO_Release_Both_Margins";
-0xFE2C,"ISO_Fast_Cursor_Left";
-0xFE2D,"ISO_Fast_Cursor_Right";
-0xFE2E,"ISO_Fast_Cursor_Up";
-0xFE2F,"ISO_Fast_Cursor_Down";
-0xFE30,"ISO_Continuous_Underline";
-0xFE31,"ISO_Discontinuous_Underline";
-0xFE32,"ISO_Emphasize";
-0xFE33,"ISO_Center_Object";
-0xFE34,"ISO_Enter";
-0xFE50,"dead_grave";
-0xFE51,"dead_acute";
-0xFE52,"dead_circumflex";
-0xFE53,"dead_tilde";
-0xFE54,"dead_macron";
-0xFE55,"dead_breve";
-0xFE56,"dead_abovedot";
-0xFE57,"dead_diaeresis";
-0xFE58,"dead_abovering";
-0xFE59,"dead_doubleacute";
-0xFE5A,"dead_caron";
-0xFE5B,"dead_cedilla";
-0xFE5C,"dead_ogonek";
-0xFE5D,"dead_iota";
-0xFE5E,"dead_voiced_sound";
-0xFE5F,"dead_semivoiced_sound";
-0xFE60,"dead_belowdot";
-0xFED0,"First_Virtual_Screen";
-0xFED1,"Prev_Virtual_Screen";
-0xFED2,"Next_Virtual_Screen";
-0xFED4,"Last_Virtual_Screen";
-0xFED5,"Terminate_Server";
-0xFE70,"AccessX_Enable";
-0xFE71,"AccessX_Feedback_Enable";
-0xFE72,"RepeatKeys_Enable";
-0xFE73,"SlowKeys_Enable";
-0xFE74,"BounceKeys_Enable";
-0xFE75,"StickyKeys_Enable";
-0xFE76,"MouseKeys_Enable";
-0xFE77,"MouseKeys_Accel_Enable";
-0xFE78,"Overlay1_Enable";
-0xFE79,"Overlay2_Enable";
-0xFE7A,"AudibleBell_Enable";
-0xFEE0,"Pointer_Left";
-0xFEE1,"Pointer_Right";
-0xFEE2,"Pointer_Up";
-0xFEE3,"Pointer_Down";
-0xFEE4,"Pointer_UpLeft";
-0xFEE5,"Pointer_UpRight";
-0xFEE6,"Pointer_DownLeft";
-0xFEE7,"Pointer_DownRight";
-0xFEE8,"Pointer_Button_Dflt";
-0xFEE9,"Pointer_Button1";
-0xFEEA,"Pointer_Button2";
-0xFEEB,"Pointer_Button3";
-0xFEEC,"Pointer_Button4";
-0xFEED,"Pointer_Button5";
-0xFEEE,"Pointer_DblClick_Dflt";
-0xFEEF,"Pointer_DblClick1";
-0xFEF0,"Pointer_DblClick2";
-0xFEF1,"Pointer_DblClick3";
-0xFEF2,"Pointer_DblClick4";
-0xFEF3,"Pointer_DblClick5";
-0xFEF4,"Pointer_Drag_Dflt";
-0xFEF5,"Pointer_Drag1";
-0xFEF6,"Pointer_Drag2";
-0xFEF7,"Pointer_Drag3";
-0xFEF8,"Pointer_Drag4";
-0xFEFD,"Pointer_Drag5";
-0xFEF9,"Pointer_EnableKeys";
-0xFEFA,"Pointer_Accelerate";
-0xFEFB,"Pointer_DfltBtnNext";
-0xFEFC,"Pointer_DfltBtnPrev";
-0xFD01,"3270_Duplicate";
-0xFD02,"3270_FieldMark";
-0xFD03,"3270_Right2";
-0xFD04,"3270_Left2";
-0xFD05,"3270_BackTab";
-0xFD06,"3270_EraseEOF";
-0xFD07,"3270_EraseInput";
-0xFD08,"3270_Reset";
-0xFD09,"3270_Quit";
-0xFD0A,"3270_PA1";
-0xFD0B,"3270_PA2";
-0xFD0C,"3270_PA3";
-0xFD0D,"3270_Test";
-0xFD0E,"3270_Attn";
-0xFD0F,"3270_CursorBlink";
-0xFD10,"3270_AltCursor";
-0xFD11,"3270_KeyClick";
-0xFD12,"3270_Jump";
-0xFD13,"3270_Ident";
-0xFD14,"3270_Rule";
-0xFD15,"3270_Copy";
-0xFD16,"3270_Play";
-0xFD17,"3270_Setup";
-0xFD18,"3270_Record";
-0xFD19,"3270_ChangeScreen";
-0xFD1A,"3270_DeleteWord";
-0xFD1B,"3270_ExSelect";
-0xFD1C,"3270_CursorSelect";
-0xFD1D,"3270_PrintScreen";
-0xFD1E,"3270_Enter";
-0x020,"space";
-0x021,"exclam";
-0x022,"quotedbl";
-0x023,"numbersign";
-0x024,"dollar";
-0x025,"percent";
-0x026,"ampersand";
-0x027,"apostrophe";
-0x027,"quoteright";
-0x028,"parenleft";
-0x029,"parenright";
-0x02a,"asterisk";
-0x02b,"plus";
-0x02c,"comma";
-0x02d,"minus";
-0x02e,"period";
-0x02f,"slash";
-0x030,"0";
-0x031,"1";
-0x032,"2";
-0x033,"3";
-0x034,"4";
-0x035,"5";
-0x036,"6";
-0x037,"7";
-0x038,"8";
-0x039,"9";
-0x03a,"colon";
-0x03b,"semicolon";
-0x03c,"less";
-0x03d,"equal";
-0x03e,"greater";
-0x03f,"question";
-0x040,"at";
-0x041,"A";
-0x042,"B";
-0x043,"C";
-0x044,"D";
-0x045,"E";
-0x046,"F";
-0x047,"G";
-0x048,"H";
-0x049,"I";
-0x04a,"J";
-0x04b,"K";
-0x04c,"L";
-0x04d,"M";
-0x04e,"N";
-0x04f,"O";
-0x050,"P";
-0x051,"Q";
-0x052,"R";
-0x053,"S";
-0x054,"T";
-0x055,"U";
-0x056,"V";
-0x057,"W";
-0x058,"X";
-0x059,"Y";
-0x05a,"Z";
-0x05b,"bracketleft";
-0x05c,"backslash";
-0x05d,"bracketright";
-0x05e,"asciicircum";
-0x05f,"underscore";
-0x060,"grave";
-0x060,"quoteleft";
-0x061,"a";
-0x062,"b";
-0x063,"c";
-0x064,"d";
-0x065,"e";
-0x066,"f";
-0x067,"g";
-0x068,"h";
-0x069,"i";
-0x06a,"j";
-0x06b,"k";
-0x06c,"l";
-0x06d,"m";
-0x06e,"n";
-0x06f,"o";
-0x070,"p";
-0x071,"q";
-0x072,"r";
-0x073,"s";
-0x074,"t";
-0x075,"u";
-0x076,"v";
-0x077,"w";
-0x078,"x";
-0x079,"y";
-0x07a,"z";
-0x07b,"braceleft";
-0x07c,"bar";
-0x07d,"braceright";
-0x07e,"asciitilde";
-0x0a0,"nobreakspace";
-0x0a1,"exclamdown";
-0x0a2,"cent";
-0x0a3,"sterling";
-0x0a4,"currency";
-0x0a5,"yen";
-0x0a6,"brokenbar";
-0x0a7,"section";
-0x0a8,"diaeresis";
-0x0a9,"copyright";
-0x0aa,"ordfeminine";
-0x0ab,"guillemotleft";
-0x0ac,"notsign";
-0x0ad,"hyphen";
-0x0ae,"registered";
-0x0af,"macron";
-0x0b0,"degree";
-0x0b1,"plusminus";
-0x0b2,"twosuperior";
-0x0b3,"threesuperior";
-0x0b4,"acute";
-0x0b5,"mu";
-0x0b6,"paragraph";
-0x0b7,"periodcentered";
-0x0b8,"cedilla";
-0x0b9,"onesuperior";
-0x0ba,"masculine";
-0x0bb,"guillemotright";
-0x0bc,"onequarter";
-0x0bd,"onehalf";
-0x0be,"threequarters";
-0x0bf,"questiondown";
-0x0c0,"Agrave";
-0x0c1,"Aacute";
-0x0c2,"Acircumflex";
-0x0c3,"Atilde";
-0x0c4,"Adiaeresis";
-0x0c5,"Aring";
-0x0c6,"AE";
-0x0c7,"Ccedilla";
-0x0c8,"Egrave";
-0x0c9,"Eacute";
-0x0ca,"Ecircumflex";
-0x0cb,"Ediaeresis";
-0x0cc,"Igrave";
-0x0cd,"Iacute";
-0x0ce,"Icircumflex";
-0x0cf,"Idiaeresis";
-0x0d0,"ETH";
-0x0d0,"Eth";
-0x0d1,"Ntilde";
-0x0d2,"Ograve";
-0x0d3,"Oacute";
-0x0d4,"Ocircumflex";
-0x0d5,"Otilde";
-0x0d6,"Odiaeresis";
-0x0d7,"multiply";
-0x0d8,"Ooblique";
-0x0d9,"Ugrave";
-0x0da,"Uacute";
-0x0db,"Ucircumflex";
-0x0dc,"Udiaeresis";
-0x0dd,"Yacute";
-0x0de,"THORN";
-0x0de,"Thorn";
-0x0df,"ssharp";
-0x0e0,"agrave";
-0x0e1,"aacute";
-0x0e2,"acircumflex";
-0x0e3,"atilde";
-0x0e4,"adiaeresis";
-0x0e5,"aring";
-0x0e6,"ae";
-0x0e7,"ccedilla";
-0x0e8,"egrave";
-0x0e9,"eacute";
-0x0ea,"ecircumflex";
-0x0eb,"ediaeresis";
-0x0ec,"igrave";
-0x0ed,"iacute";
-0x0ee,"icircumflex";
-0x0ef,"idiaeresis";
-0x0f0,"eth";
-0x0f1,"ntilde";
-0x0f2,"ograve";
-0x0f3,"oacute";
-0x0f4,"ocircumflex";
-0x0f5,"otilde";
-0x0f6,"odiaeresis";
-0x0f7,"division";
-0x0f8,"oslash";
-0x0f9,"ugrave";
-0x0fa,"uacute";
-0x0fb,"ucircumflex";
-0x0fc,"udiaeresis";
-0x0fd,"yacute";
-0x0fe,"thorn";
-0x0ff,"ydiaeresis";
-0x1a1,"Aogonek";
-0x1a2,"breve";
-0x1a3,"Lstroke";
-0x1a5,"Lcaron";
-0x1a6,"Sacute";
-0x1a9,"Scaron";
-0x1aa,"Scedilla";
-0x1ab,"Tcaron";
-0x1ac,"Zacute";
-0x1ae,"Zcaron";
-0x1af,"Zabovedot";
-0x1b1,"aogonek";
-0x1b2,"ogonek";
-0x1b3,"lstroke";
-0x1b5,"lcaron";
-0x1b6,"sacute";
-0x1b7,"caron";
-0x1b9,"scaron";
-0x1ba,"scedilla";
-0x1bb,"tcaron";
-0x1bc,"zacute";
-0x1bd,"doubleacute";
-0x1be,"zcaron";
-0x1bf,"zabovedot";
-0x1c0,"Racute";
-0x1c3,"Abreve";
-0x1c5,"Lacute";
-0x1c6,"Cacute";
-0x1c8,"Ccaron";
-0x1ca,"Eogonek";
-0x1cc,"Ecaron";
-0x1cf,"Dcaron";
-0x1d0,"Dstroke";
-0x1d1,"Nacute";
-0x1d2,"Ncaron";
-0x1d5,"Odoubleacute";
-0x1d8,"Rcaron";
-0x1d9,"Uring";
-0x1db,"Udoubleacute";
-0x1de,"Tcedilla";
-0x1e0,"racute";
-0x1e3,"abreve";
-0x1e5,"lacute";
-0x1e6,"cacute";
-0x1e8,"ccaron";
-0x1ea,"eogonek";
-0x1ec,"ecaron";
-0x1ef,"dcaron";
-0x1f0,"dstroke";
-0x1f1,"nacute";
-0x1f2,"ncaron";
-0x1f5,"odoubleacute";
-0x1fb,"udoubleacute";
-0x1f8,"rcaron";
-0x1f9,"uring";
-0x1fe,"tcedilla";
-0x1ff,"abovedot";
-0x2a1,"Hstroke";
-0x2a6,"Hcircumflex";
-0x2a9,"Iabovedot";
-0x2ab,"Gbreve";
-0x2ac,"Jcircumflex";
-0x2b1,"hstroke";
-0x2b6,"hcircumflex";
-0x2b9,"idotless";
-0x2bb,"gbreve";
-0x2bc,"jcircumflex";
-0x2c5,"Cabovedot";
-0x2c6,"Ccircumflex";
-0x2d5,"Gabovedot";
-0x2d8,"Gcircumflex";
-0x2dd,"Ubreve";
-0x2de,"Scircumflex";
-0x2e5,"cabovedot";
-0x2e6,"ccircumflex";
-0x2f5,"gabovedot";
-0x2f8,"gcircumflex";
-0x2fd,"ubreve";
-0x2fe,"scircumflex";
-0x3a2,"kra";
-0x3a2,"kappa";
-0x3a3,"Rcedilla";
-0x3a5,"Itilde";
-0x3a6,"Lcedilla";
-0x3aa,"Emacron";
-0x3ab,"Gcedilla";
-0x3ac,"Tslash";
-0x3b3,"rcedilla";
-0x3b5,"itilde";
-0x3b6,"lcedilla";
-0x3ba,"emacron";
-0x3bb,"gcedilla";
-0x3bc,"tslash";
-0x3bd,"ENG";
-0x3bf,"eng";
-0x3c0,"Amacron";
-0x3c7,"Iogonek";
-0x3cc,"Eabovedot";
-0x3cf,"Imacron";
-0x3d1,"Ncedilla";
-0x3d2,"Omacron";
-0x3d3,"Kcedilla";
-0x3d9,"Uogonek";
-0x3dd,"Utilde";
-0x3de,"Umacron";
-0x3e0,"amacron";
-0x3e7,"iogonek";
-0x3ec,"eabovedot";
-0x3ef,"imacron";
-0x3f1,"ncedilla";
-0x3f2,"omacron";
-0x3f3,"kcedilla";
-0x3f9,"uogonek";
-0x3fd,"utilde";
-0x3fe,"umacron";
-0x47e,"overline";
-0x4a1,"kana_fullstop";
-0x4a2,"kana_openingbracket";
-0x4a3,"kana_closingbracket";
-0x4a4,"kana_comma";
-0x4a5,"kana_conjunctive";
-0x4a5,"kana_middledot";
-0x4a6,"kana_WO";
-0x4a7,"kana_a";
-0x4a8,"kana_i";
-0x4a9,"kana_u";
-0x4aa,"kana_e";
-0x4ab,"kana_o";
-0x4ac,"kana_ya";
-0x4ad,"kana_yu";
-0x4ae,"kana_yo";
-0x4af,"kana_tsu";
-0x4af,"kana_tu";
-0x4b0,"prolongedsound";
-0x4b1,"kana_A";
-0x4b2,"kana_I";
-0x4b3,"kana_U";
-0x4b4,"kana_E";
-0x4b5,"kana_O";
-0x4b6,"kana_KA";
-0x4b7,"kana_KI";
-0x4b8,"kana_KU";
-0x4b9,"kana_KE";
-0x4ba,"kana_KO";
-0x4bb,"kana_SA";
-0x4bc,"kana_SHI";
-0x4bd,"kana_SU";
-0x4be,"kana_SE";
-0x4bf,"kana_SO";
-0x4c0,"kana_TA";
-0x4c1,"kana_CHI";
-0x4c1,"kana_TI";
-0x4c2,"kana_TSU";
-0x4c2,"kana_TU";
-0x4c3,"kana_TE";
-0x4c4,"kana_TO";
-0x4c5,"kana_NA";
-0x4c6,"kana_NI";
-0x4c7,"kana_NU";
-0x4c8,"kana_NE";
-0x4c9,"kana_NO";
-0x4ca,"kana_HA";
-0x4cb,"kana_HI";
-0x4cc,"kana_FU";
-0x4cc,"kana_HU";
-0x4cd,"kana_HE";
-0x4ce,"kana_HO";
-0x4cf,"kana_MA";
-0x4d0,"kana_MI";
-0x4d1,"kana_MU";
-0x4d2,"kana_ME";
-0x4d3,"kana_MO";
-0x4d4,"kana_YA";
-0x4d5,"kana_YU";
-0x4d6,"kana_YO";
-0x4d7,"kana_RA";
-0x4d8,"kana_RI";
-0x4d9,"kana_RU";
-0x4da,"kana_RE";
-0x4db,"kana_RO";
-0x4dc,"kana_WA";
-0x4dd,"kana_N";
-0x4de,"voicedsound";
-0x4df,"semivoicedsound";
-0xFF7E,"kana_switch";
-0x5ac,"Arabic_comma";
-0x5bb,"Arabic_semicolon";
-0x5bf,"Arabic_question_mark";
-0x5c1,"Arabic_hamza";
-0x5c2,"Arabic_maddaonalef";
-0x5c3,"Arabic_hamzaonalef";
-0x5c4,"Arabic_hamzaonwaw";
-0x5c5,"Arabic_hamzaunderalef";
-0x5c6,"Arabic_hamzaonyeh";
-0x5c7,"Arabic_alef";
-0x5c8,"Arabic_beh";
-0x5c9,"Arabic_tehmarbuta";
-0x5ca,"Arabic_teh";
-0x5cb,"Arabic_theh";
-0x5cc,"Arabic_jeem";
-0x5cd,"Arabic_hah";
-0x5ce,"Arabic_khah";
-0x5cf,"Arabic_dal";
-0x5d0,"Arabic_thal";
-0x5d1,"Arabic_ra";
-0x5d2,"Arabic_zain";
-0x5d3,"Arabic_seen";
-0x5d4,"Arabic_sheen";
-0x5d5,"Arabic_sad";
-0x5d6,"Arabic_dad";
-0x5d7,"Arabic_tah";
-0x5d8,"Arabic_zah";
-0x5d9,"Arabic_ain";
-0x5da,"Arabic_ghain";
-0x5e0,"Arabic_tatweel";
-0x5e1,"Arabic_feh";
-0x5e2,"Arabic_qaf";
-0x5e3,"Arabic_kaf";
-0x5e4,"Arabic_lam";
-0x5e5,"Arabic_meem";
-0x5e6,"Arabic_noon";
-0x5e7,"Arabic_ha";
-0x5e7,"Arabic_heh";
-0x5e8,"Arabic_waw";
-0x5e9,"Arabic_alefmaksura";
-0x5ea,"Arabic_yeh";
-0x5eb,"Arabic_fathatan";
-0x5ec,"Arabic_dammatan";
-0x5ed,"Arabic_kasratan";
-0x5ee,"Arabic_fatha";
-0x5ef,"Arabic_damma";
-0x5f0,"Arabic_kasra";
-0x5f1,"Arabic_shadda";
-0x5f2,"Arabic_sukun";
-0xFF7E,"Arabic_switch";
-0x6a1,"Serbian_dje";
-0x6a2,"Macedonia_gje";
-0x6a3,"Cyrillic_io";
-0x6a4,"Ukrainian_ie";
-0x6a4,"Ukranian_je";
-0x6a5,"Macedonia_dse";
-0x6a6,"Ukrainian_i";
-0x6a6,"Ukranian_i";
-0x6a7,"Ukrainian_yi";
-0x6a7,"Ukranian_yi";
-0x6a8,"Cyrillic_je";
-0x6a8,"Serbian_je";
-0x6a9,"Cyrillic_lje";
-0x6a9,"Serbian_lje";
-0x6aa,"Cyrillic_nje";
-0x6aa,"Serbian_nje";
-0x6ab,"Serbian_tshe";
-0x6ac,"Macedonia_kje";
-0x6ae,"Byelorussian_shortu";
-0x6af,"Cyrillic_dzhe";
-0x6af,"Serbian_dze";
-0x6b0,"numerosign";
-0x6b1,"Serbian_DJE";
-0x6b2,"Macedonia_GJE";
-0x6b3,"Cyrillic_IO";
-0x6b4,"Ukrainian_IE";
-0x6b4,"Ukranian_JE";
-0x6b5,"Macedonia_DSE";
-0x6b6,"Ukrainian_I";
-0x6b6,"Ukranian_I";
-0x6b7,"Ukrainian_YI";
-0x6b7,"Ukranian_YI";
-0x6b8,"Cyrillic_JE";
-0x6b8,"Serbian_JE";
-0x6b9,"Cyrillic_LJE";
-0x6b9,"Serbian_LJE";
-0x6ba,"Cyrillic_NJE";
-0x6ba,"Serbian_NJE";
-0x6bb,"Serbian_TSHE";
-0x6bc,"Macedonia_KJE";
-0x6be,"Byelorussian_SHORTU";
-0x6bf,"Cyrillic_DZHE";
-0x6bf,"Serbian_DZE";
-0x6c0,"Cyrillic_yu";
-0x6c1,"Cyrillic_a";
-0x6c2,"Cyrillic_be";
-0x6c3,"Cyrillic_tse";
-0x6c4,"Cyrillic_de";
-0x6c5,"Cyrillic_ie";
-0x6c6,"Cyrillic_ef";
-0x6c7,"Cyrillic_ghe";
-0x6c8,"Cyrillic_ha";
-0x6c9,"Cyrillic_i";
-0x6ca,"Cyrillic_shorti";
-0x6cb,"Cyrillic_ka";
-0x6cc,"Cyrillic_el";
-0x6cd,"Cyrillic_em";
-0x6ce,"Cyrillic_en";
-0x6cf,"Cyrillic_o";
-0x6d0,"Cyrillic_pe";
-0x6d1,"Cyrillic_ya";
-0x6d2,"Cyrillic_er";
-0x6d3,"Cyrillic_es";
-0x6d4,"Cyrillic_te";
-0x6d5,"Cyrillic_u";
-0x6d6,"Cyrillic_zhe";
-0x6d7,"Cyrillic_ve";
-0x6d8,"Cyrillic_softsign";
-0x6d9,"Cyrillic_yeru";
-0x6da,"Cyrillic_ze";
-0x6db,"Cyrillic_sha";
-0x6dc,"Cyrillic_e";
-0x6dd,"Cyrillic_shcha";
-0x6de,"Cyrillic_che";
-0x6df,"Cyrillic_hardsign";
-0x6e0,"Cyrillic_YU";
-0x6e1,"Cyrillic_A";
-0x6e2,"Cyrillic_BE";
-0x6e3,"Cyrillic_TSE";
-0x6e4,"Cyrillic_DE";
-0x6e5,"Cyrillic_IE";
-0x6e6,"Cyrillic_EF";
-0x6e7,"Cyrillic_GHE";
-0x6e8,"Cyrillic_HA";
-0x6e9,"Cyrillic_I";
-0x6ea,"Cyrillic_SHORTI";
-0x6eb,"Cyrillic_KA";
-0x6ec,"Cyrillic_EL";
-0x6ed,"Cyrillic_EM";
-0x6ee,"Cyrillic_EN";
-0x6ef,"Cyrillic_O";
-0x6f0,"Cyrillic_PE";
-0x6f1,"Cyrillic_YA";
-0x6f2,"Cyrillic_ER";
-0x6f3,"Cyrillic_ES";
-0x6f4,"Cyrillic_TE";
-0x6f5,"Cyrillic_U";
-0x6f6,"Cyrillic_ZHE";
-0x6f7,"Cyrillic_VE";
-0x6f8,"Cyrillic_SOFTSIGN";
-0x6f9,"Cyrillic_YERU";
-0x6fa,"Cyrillic_ZE";
-0x6fb,"Cyrillic_SHA";
-0x6fc,"Cyrillic_E";
-0x6fd,"Cyrillic_SHCHA";
-0x6fe,"Cyrillic_CHE";
-0x6ff,"Cyrillic_HARDSIGN";
-0x7a1,"Greek_ALPHAaccent";
-0x7a2,"Greek_EPSILONaccent";
-0x7a3,"Greek_ETAaccent";
-0x7a4,"Greek_IOTAaccent";
-0x7a5,"Greek_IOTAdiaeresis";
-0x7a7,"Greek_OMICRONaccent";
-0x7a8,"Greek_UPSILONaccent";
-0x7a9,"Greek_UPSILONdieresis";
-0x7ab,"Greek_OMEGAaccent";
-0x7ae,"Greek_accentdieresis";
-0x7af,"Greek_horizbar";
-0x7b1,"Greek_alphaaccent";
-0x7b2,"Greek_epsilonaccent";
-0x7b3,"Greek_etaaccent";
-0x7b4,"Greek_iotaaccent";
-0x7b5,"Greek_iotadieresis";
-0x7b6,"Greek_iotaaccentdieresis";
-0x7b7,"Greek_omicronaccent";
-0x7b8,"Greek_upsilonaccent";
-0x7b9,"Greek_upsilondieresis";
-0x7ba,"Greek_upsilonaccentdieresis";
-0x7bb,"Greek_omegaaccent";
-0x7c1,"Greek_ALPHA";
-0x7c2,"Greek_BETA";
-0x7c3,"Greek_GAMMA";
-0x7c4,"Greek_DELTA";
-0x7c5,"Greek_EPSILON";
-0x7c6,"Greek_ZETA";
-0x7c7,"Greek_ETA";
-0x7c8,"Greek_THETA";
-0x7c9,"Greek_IOTA";
-0x7ca,"Greek_KAPPA";
-0x7cb,"Greek_LAMDA";
-0x7cb,"Greek_LAMBDA";
-0x7cc,"Greek_MU";
-0x7cd,"Greek_NU";
-0x7ce,"Greek_XI";
-0x7cf,"Greek_OMICRON";
-0x7d0,"Greek_PI";
-0x7d1,"Greek_RHO";
-0x7d2,"Greek_SIGMA";
-0x7d4,"Greek_TAU";
-0x7d5,"Greek_UPSILON";
-0x7d6,"Greek_PHI";
-0x7d7,"Greek_CHI";
-0x7d8,"Greek_PSI";
-0x7d9,"Greek_OMEGA";
-0x7e1,"Greek_alpha";
-0x7e2,"Greek_beta";
-0x7e3,"Greek_gamma";
-0x7e4,"Greek_delta";
-0x7e5,"Greek_epsilon";
-0x7e6,"Greek_zeta";
-0x7e7,"Greek_eta";
-0x7e8,"Greek_theta";
-0x7e9,"Greek_iota";
-0x7ea,"Greek_kappa";
-0x7eb,"Greek_lamda";
-0x7eb,"Greek_lambda";
-0x7ec,"Greek_mu";
-0x7ed,"Greek_nu";
-0x7ee,"Greek_xi";
-0x7ef,"Greek_omicron";
-0x7f0,"Greek_pi";
-0x7f1,"Greek_rho";
-0x7f2,"Greek_sigma";
-0x7f3,"Greek_finalsmallsigma";
-0x7f4,"Greek_tau";
-0x7f5,"Greek_upsilon";
-0x7f6,"Greek_phi";
-0x7f7,"Greek_chi";
-0x7f8,"Greek_psi";
-0x7f9,"Greek_omega";
-0xFF7E,"Greek_switch";
-0x8a1,"leftradical";
-0x8a2,"topleftradical";
-0x8a3,"horizconnector";
-0x8a4,"topintegral";
-0x8a5,"botintegral";
-0x8a6,"vertconnector";
-0x8a7,"topleftsqbracket";
-0x8a8,"botleftsqbracket";
-0x8a9,"toprightsqbracket";
-0x8aa,"botrightsqbracket";
-0x8ab,"topleftparens";
-0x8ac,"botleftparens";
-0x8ad,"toprightparens";
-0x8ae,"botrightparens";
-0x8af,"leftmiddlecurlybrace";
-0x8b0,"rightmiddlecurlybrace";
-0x8b1,"topleftsummation";
-0x8b2,"botleftsummation";
-0x8b3,"topvertsummationconnector";
-0x8b4,"botvertsummationconnector";
-0x8b5,"toprightsummation";
-0x8b6,"botrightsummation";
-0x8b7,"rightmiddlesummation";
-0x8bc,"lessthanequal";
-0x8bd,"notequal";
-0x8be,"greaterthanequal";
-0x8bf,"integral";
-0x8c0,"therefore";
-0x8c1,"variation";
-0x8c2,"infinity";
-0x8c5,"nabla";
-0x8c8,"approximate";
-0x8c9,"similarequal";
-0x8cd,"ifonlyif";
-0x8ce,"implies";
-0x8cf,"identical";
-0x8d6,"radical";
-0x8da,"includedin";
-0x8db,"includes";
-0x8dc,"intersection";
-0x8dd,"union";
-0x8de,"logicaland";
-0x8df,"logicalor";
-0x8ef,"partialderivative";
-0x8f6,"function";
-0x8fb,"leftarrow";
-0x8fc,"uparrow";
-0x8fd,"rightarrow";
-0x8fe,"downarrow";
-0x9df,"blank";
-0x9e0,"soliddiamond";
-0x9e1,"checkerboard";
-0x9e2,"ht";
-0x9e3,"ff";
-0x9e4,"cr";
-0x9e5,"lf";
-0x9e8,"nl";
-0x9e9,"vt";
-0x9ea,"lowrightcorner";
-0x9eb,"uprightcorner";
-0x9ec,"upleftcorner";
-0x9ed,"lowleftcorner";
-0x9ee,"crossinglines";
-0x9ef,"horizlinescan1";
-0x9f0,"horizlinescan3";
-0x9f1,"horizlinescan5";
-0x9f2,"horizlinescan7";
-0x9f3,"horizlinescan9";
-0x9f4,"leftt";
-0x9f5,"rightt";
-0x9f6,"bott";
-0x9f7,"topt";
-0x9f8,"vertbar";
-0xaa1,"emspace";
-0xaa2,"enspace";
-0xaa3,"em3space";
-0xaa4,"em4space";
-0xaa5,"digitspace";
-0xaa6,"punctspace";
-0xaa7,"thinspace";
-0xaa8,"hairspace";
-0xaa9,"emdash";
-0xaaa,"endash";
-0xaac,"signifblank";
-0xaae,"ellipsis";
-0xaaf,"doubbaselinedot";
-0xab0,"onethird";
-0xab1,"twothirds";
-0xab2,"onefifth";
-0xab3,"twofifths";
-0xab4,"threefifths";
-0xab5,"fourfifths";
-0xab6,"onesixth";
-0xab7,"fivesixths";
-0xab8,"careof";
-0xabb,"figdash";
-0xabc,"leftanglebracket";
-0xabd,"decimalpoint";
-0xabe,"rightanglebracket";
-0xabf,"marker";
-0xac3,"oneeighth";
-0xac4,"threeeighths";
-0xac5,"fiveeighths";
-0xac6,"seveneighths";
-0xac9,"trademark";
-0xaca,"signaturemark";
-0xacb,"trademarkincircle";
-0xacc,"leftopentriangle";
-0xacd,"rightopentriangle";
-0xace,"emopencircle";
-0xacf,"emopenrectangle";
-0xad0,"leftsinglequotemark";
-0xad1,"rightsinglequotemark";
-0xad2,"leftdoublequotemark";
-0xad3,"rightdoublequotemark";
-0xad4,"prescription";
-0xad6,"minutes";
-0xad7,"seconds";
-0xad9,"latincross";
-0xada,"hexagram";
-0xadb,"filledrectbullet";
-0xadc,"filledlefttribullet";
-0xadd,"filledrighttribullet";
-0xade,"emfilledcircle";
-0xadf,"emfilledrect";
-0xae0,"enopencircbullet";
-0xae1,"enopensquarebullet";
-0xae2,"openrectbullet";
-0xae3,"opentribulletup";
-0xae4,"opentribulletdown";
-0xae5,"openstar";
-0xae6,"enfilledcircbullet";
-0xae7,"enfilledsqbullet";
-0xae8,"filledtribulletup";
-0xae9,"filledtribulletdown";
-0xaea,"leftpointer";
-0xaeb,"rightpointer";
-0xaec,"club";
-0xaed,"diamond";
-0xaee,"heart";
-0xaf0,"maltesecross";
-0xaf1,"dagger";
-0xaf2,"doubledagger";
-0xaf3,"checkmark";
-0xaf4,"ballotcross";
-0xaf5,"musicalsharp";
-0xaf6,"musicalflat";
-0xaf7,"malesymbol";
-0xaf8,"femalesymbol";
-0xaf9,"telephone";
-0xafa,"telephonerecorder";
-0xafb,"phonographcopyright";
-0xafc,"caret";
-0xafd,"singlelowquotemark";
-0xafe,"doublelowquotemark";
-0xaff,"cursor";
-0xba3,"leftcaret";
-0xba6,"rightcaret";
-0xba8,"downcaret";
-0xba9,"upcaret";
-0xbc0,"overbar";
-0xbc2,"downtack";
-0xbc3,"upshoe";
-0xbc4,"downstile";
-0xbc6,"underbar";
-0xbca,"jot";
-0xbcc,"quad";
-0xbce,"uptack";
-0xbcf,"circle";
-0xbd3,"upstile";
-0xbd6,"downshoe";
-0xbd8,"rightshoe";
-0xbda,"leftshoe";
-0xbdc,"lefttack";
-0xbfc,"righttack";
-0xcdf,"hebrew_doublelowline";
-0xce0,"hebrew_aleph";
-0xce1,"hebrew_bet";
-0xce1,"hebrew_beth";
-0xce2,"hebrew_gimel";
-0xce2,"hebrew_gimmel";
-0xce3,"hebrew_dalet";
-0xce3,"hebrew_daleth";
-0xce4,"hebrew_he";
-0xce5,"hebrew_waw";
-0xce6,"hebrew_zain";
-0xce6,"hebrew_zayin";
-0xce7,"hebrew_chet";
-0xce7,"hebrew_het";
-0xce8,"hebrew_tet";
-0xce8,"hebrew_teth";
-0xce9,"hebrew_yod";
-0xcea,"hebrew_finalkaph";
-0xceb,"hebrew_kaph";
-0xcec,"hebrew_lamed";
-0xced,"hebrew_finalmem";
-0xcee,"hebrew_mem";
-0xcef,"hebrew_finalnun";
-0xcf0,"hebrew_nun";
-0xcf1,"hebrew_samech";
-0xcf1,"hebrew_samekh";
-0xcf2,"hebrew_ayin";
-0xcf3,"hebrew_finalpe";
-0xcf4,"hebrew_pe";
-0xcf5,"hebrew_finalzade";
-0xcf5,"hebrew_finalzadi";
-0xcf6,"hebrew_zade";
-0xcf6,"hebrew_zadi";
-0xcf7,"hebrew_qoph";
-0xcf7,"hebrew_kuf";
-0xcf8,"hebrew_resh";
-0xcf9,"hebrew_shin";
-0xcfa,"hebrew_taw";
-0xcfa,"hebrew_taf";
-0xFF7E,"Hebrew_switch";
-0xda1,"Thai_kokai";
-0xda2,"Thai_khokhai";
-0xda3,"Thai_khokhuat";
-0xda4,"Thai_khokhwai";
-0xda5,"Thai_khokhon";
-0xda6,"Thai_khorakhang";
-0xda7,"Thai_ngongu";
-0xda8,"Thai_chochan";
-0xda9,"Thai_choching";
-0xdaa,"Thai_chochang";
-0xdab,"Thai_soso";
-0xdac,"Thai_chochoe";
-0xdad,"Thai_yoying";
-0xdae,"Thai_dochada";
-0xdaf,"Thai_topatak";
-0xdb0,"Thai_thothan";
-0xdb1,"Thai_thonangmontho";
-0xdb2,"Thai_thophuthao";
-0xdb3,"Thai_nonen";
-0xdb4,"Thai_dodek";
-0xdb5,"Thai_totao";
-0xdb6,"Thai_thothung";
-0xdb7,"Thai_thothahan";
-0xdb8,"Thai_thothong";
-0xdb9,"Thai_nonu";
-0xdba,"Thai_bobaimai";
-0xdbb,"Thai_popla";
-0xdbc,"Thai_phophung";
-0xdbd,"Thai_fofa";
-0xdbe,"Thai_phophan";
-0xdbf,"Thai_fofan";
-0xdc0,"Thai_phosamphao";
-0xdc1,"Thai_moma";
-0xdc2,"Thai_yoyak";
-0xdc3,"Thai_rorua";
-0xdc4,"Thai_ru";
-0xdc5,"Thai_loling";
-0xdc6,"Thai_lu";
-0xdc7,"Thai_wowaen";
-0xdc8,"Thai_sosala";
-0xdc9,"Thai_sorusi";
-0xdca,"Thai_sosua";
-0xdcb,"Thai_hohip";
-0xdcc,"Thai_lochula";
-0xdcd,"Thai_oang";
-0xdce,"Thai_honokhuk";
-0xdcf,"Thai_paiyannoi";
-0xdd0,"Thai_saraa";
-0xdd1,"Thai_maihanakat";
-0xdd2,"Thai_saraaa";
-0xdd3,"Thai_saraam";
-0xdd4,"Thai_sarai";
-0xdd5,"Thai_saraii";
-0xdd6,"Thai_saraue";
-0xdd7,"Thai_sarauee";
-0xdd8,"Thai_sarau";
-0xdd9,"Thai_sarauu";
-0xdda,"Thai_phinthu";
-0xdde,"Thai_maihanakat_maitho";
-0xddf,"Thai_baht";
-0xde0,"Thai_sarae";
-0xde1,"Thai_saraae";
-0xde2,"Thai_sarao";
-0xde3,"Thai_saraaimaimuan";
-0xde4,"Thai_saraaimaimalai";
-0xde5,"Thai_lakkhangyao";
-0xde6,"Thai_maiyamok";
-0xde7,"Thai_maitaikhu";
-0xde8,"Thai_maiek";
-0xde9,"Thai_maitho";
-0xdea,"Thai_maitri";
-0xdeb,"Thai_maichattawa";
-0xdec,"Thai_thanthakhat";
-0xded,"Thai_nikhahit";
-0xdf0,"Thai_leksun";
-0xdf1,"Thai_leknung";
-0xdf2,"Thai_leksong";
-0xdf3,"Thai_leksam";
-0xdf4,"Thai_leksi";
-0xdf5,"Thai_lekha";
-0xdf6,"Thai_lekhok";
-0xdf7,"Thai_lekchet";
-0xdf8,"Thai_lekpaet";
-0xdf9,"Thai_lekkao";
-0xff31,"Hangul";
-0xff32,"Hangul_Start";
-0xff33,"Hangul_End";
-0xff34,"Hangul_Hanja";
-0xff35,"Hangul_Jamo";
-0xff36,"Hangul_Romaja";
-0xff37,"Hangul_Codeinput";
-0xff38,"Hangul_Jeonja";
-0xff39,"Hangul_Banja";
-0xff3a,"Hangul_PreHanja";
-0xff3b,"Hangul_PostHanja";
-0xff3c,"Hangul_SingleCandidate";
-0xff3d,"Hangul_MultipleCandidate";
-0xff3e,"Hangul_PreviousCandidate";
-0xff3f,"Hangul_Special";
-0xFF7E,"Hangul_switch";
-0xea1,"Hangul_Kiyeog";
-0xea2,"Hangul_SsangKiyeog";
-0xea3,"Hangul_KiyeogSios";
-0xea4,"Hangul_Nieun";
-0xea5,"Hangul_NieunJieuj";
-0xea6,"Hangul_NieunHieuh";
-0xea7,"Hangul_Dikeud";
-0xea8,"Hangul_SsangDikeud";
-0xea9,"Hangul_Rieul";
-0xeaa,"Hangul_RieulKiyeog";
-0xeab,"Hangul_RieulMieum";
-0xeac,"Hangul_RieulPieub";
-0xead,"Hangul_RieulSios";
-0xeae,"Hangul_RieulTieut";
-0xeaf,"Hangul_RieulPhieuf";
-0xeb0,"Hangul_RieulHieuh";
-0xeb1,"Hangul_Mieum";
-0xeb2,"Hangul_Pieub";
-0xeb3,"Hangul_SsangPieub";
-0xeb4,"Hangul_PieubSios";
-0xeb5,"Hangul_Sios";
-0xeb6,"Hangul_SsangSios";
-0xeb7,"Hangul_Ieung";
-0xeb8,"Hangul_Jieuj";
-0xeb9,"Hangul_SsangJieuj";
-0xeba,"Hangul_Cieuc";
-0xebb,"Hangul_Khieuq";
-0xebc,"Hangul_Tieut";
-0xebd,"Hangul_Phieuf";
-0xebe,"Hangul_Hieuh";
-0xebf,"Hangul_A";
-0xec0,"Hangul_AE";
-0xec1,"Hangul_YA";
-0xec2,"Hangul_YAE";
-0xec3,"Hangul_EO";
-0xec4,"Hangul_E";
-0xec5,"Hangul_YEO";
-0xec6,"Hangul_YE";
-0xec7,"Hangul_O";
-0xec8,"Hangul_WA";
-0xec9,"Hangul_WAE";
-0xeca,"Hangul_OE";
-0xecb,"Hangul_YO";
-0xecc,"Hangul_U";
-0xecd,"Hangul_WEO";
-0xece,"Hangul_WE";
-0xecf,"Hangul_WI";
-0xed0,"Hangul_YU";
-0xed1,"Hangul_EU";
-0xed2,"Hangul_YI";
-0xed3,"Hangul_I";
-0xed4,"Hangul_J_Kiyeog";
-0xed5,"Hangul_J_SsangKiyeog";
-0xed6,"Hangul_J_KiyeogSios";
-0xed7,"Hangul_J_Nieun";
-0xed8,"Hangul_J_NieunJieuj";
-0xed9,"Hangul_J_NieunHieuh";
-0xeda,"Hangul_J_Dikeud";
-0xedb,"Hangul_J_Rieul";
-0xedc,"Hangul_J_RieulKiyeog";
-0xedd,"Hangul_J_RieulMieum";
-0xede,"Hangul_J_RieulPieub";
-0xedf,"Hangul_J_RieulSios";
-0xee0,"Hangul_J_RieulTieut";
-0xee1,"Hangul_J_RieulPhieuf";
-0xee2,"Hangul_J_RieulHieuh";
-0xee3,"Hangul_J_Mieum";
-0xee4,"Hangul_J_Pieub";
-0xee5,"Hangul_J_PieubSios";
-0xee6,"Hangul_J_Sios";
-0xee7,"Hangul_J_SsangSios";
-0xee8,"Hangul_J_Ieung";
-0xee9,"Hangul_J_Jieuj";
-0xeea,"Hangul_J_Cieuc";
-0xeeb,"Hangul_J_Khieuq";
-0xeec,"Hangul_J_Tieut";
-0xeed,"Hangul_J_Phieuf";
-0xeee,"Hangul_J_Hieuh";
-0xeef,"Hangul_RieulYeorinHieuh";
-0xef0,"Hangul_SunkyeongeumMieum";
-0xef1,"Hangul_SunkyeongeumPieub";
-0xef2,"Hangul_PanSios";
-0xef3,"Hangul_KkogjiDalrinIeung";
-0xef4,"Hangul_SunkyeongeumPhieuf";
-0xef5,"Hangul_YeorinHieuh";
-0xef6,"Hangul_AraeA";
-0xef7,"Hangul_AraeAE";
-0xef8,"Hangul_J_PanSios";
-0xef9,"Hangul_J_KkogjiDalrinIeung";
-0xefa,"Hangul_J_YeorinHieuh";
-0xeff,"Korean_Won";
-]
diff --git a/ide/utils/configwin_types.ml b/ide/utils/configwin_types.mli
index ace751c6..9e339d13 100644
--- a/ide/utils/configwin_types.ml
+++ b/ide/utils/configwin_types.mli
@@ -25,113 +25,6 @@
 
 (** This module contains the types used in Configwin. *)
 
-open Config_file
-
-let name_to_keysym =
-  ("Button1", Configwin_keys.xk_Pointer_Button1) ::
-  ("Button2", Configwin_keys.xk_Pointer_Button2) ::
-  ("Button3", Configwin_keys.xk_Pointer_Button3) ::
-  ("Button4", Configwin_keys.xk_Pointer_Button4) ::
-  ("Button5", Configwin_keys.xk_Pointer_Button5) ::
-  Configwin_keys.name_to_keysym
-
-let string_to_key s =
-  let mask = ref [] in
-  let key = try
-    let pos = String.rindex s '-' in
-    for i = 0 to pos - 1 do
-      let m = match s.[i] with
-        'C' -> `CONTROL
-      | 'S' -> `SHIFT
-      | 'L' -> `LOCK
-      | 'M' -> `MOD1
-      | 'A' -> `MOD1
-      | '1' -> `MOD1
-      | '2' -> `MOD2
-      | '3' -> `MOD3
-      | '4' -> `MOD4
-      | '5' -> `MOD5
-      | _ ->
-	  Minilib.log s;
-	  raise Not_found
-      in
-      mask := m :: !mask
-    done;
-    String.sub s (pos+1) (String.length s - pos - 1)
-  with _ ->
-    s
-  in
-  try
-    !mask, List.assoc key name_to_keysym
-  with
-    e ->
-      Minilib.log s;
-      raise e
-
-let key_to_string (m, k) =
-  let s = List.assoc k Configwin_keys.keysym_to_name in
-  match m with
-    [] -> s
-  | _ ->
-      let rec iter m s =
-        match m with
-          [] -> s
-        | c :: m ->
-            iter m ((
-                    match c with
-		      `CONTROL -> "C"
-                    | `SHIFT -> "S"
-                    | `LOCK -> "L"
-                    | `MOD1 -> "A"
-                    | `MOD2 -> "2"
-                    | `MOD3 -> "3"
-                    | `MOD4 -> "4"
-                    | `MOD5 -> "5"
-                    | _  -> raise Not_found
-                   ) ^ s)
-      in
-      iter m ("-" ^ s)
-
-let modifiers_to_string m =
-  let rec iter m s =
-    match m with
-        [] -> s
-      | c :: m ->
-          iter m ((
-                    match c with
-			`CONTROL -> "<ctrl>"
-		      | `SHIFT -> "<shft>"
-		      | `LOCK -> "<lock>"
-		      | `MOD1 -> "<alt>"
-		      | `MOD2 -> "<mod2>"
-		      | `MOD3 -> "<mod3>"
-		      | `MOD4 -> "<mod4>"
-		      | `MOD5 -> "<mod5>"
-		      | _  -> raise Not_found
-                  ) ^ s)
-  in
-    iter m ""
-
-let value_to_key v =
-  match v with
-    Raw.String s -> string_to_key s
-  | _ ->
-      Minilib.log "value_to_key";
-      raise Not_found
-
-let key_to_value k =
-  Raw.String (key_to_string k)
-
-let key_cp_wrapper =
-  {
-    to_raw = key_to_value ;
-    of_raw = value_to_key ;
-  }
-
-(** A class to define key options, with the {!Config_file} module. *)
-class key_cp =
-  [(Gdk.Tags.modifier list * int)] Config_file.cp_custom_type key_cp_wrapper
-
 (** This type represents a string or filename parameter, or
    any other type, depending on the given conversion functions. *)
 type 'a string_param = {
@@ -188,49 +81,6 @@ type custom_param = {
     custom_framed : string option ; (** optional label for an optional frame *)
   } ;;
 
-type color_param = {
-    color_label : string; (** the label of the parameter *)
-    mutable color_value : string; (** the current value of the parameter *)
-    color_editable : bool ; (** indicates if the value can be changed *)
-    color_f_apply : (string -> unit) ; (** the function to call to apply the new value of the parameter *)
-    color_help : string option ; (** optional help string *)
-    color_expand : bool ; (** expand the entry widget or not *)
-  } ;;
-
-type date_param = {
-    date_label : string ; (** the label of the parameter *)
-    mutable date_value : int * int * int ; (** day, month, year *)
-    date_editable : bool ; (** indicates if the value can be changed *)
-    date_f_string : (int * int * int) -> string ;
-      (** the function used to display the current value (day, month, year) *)
-    date_f_apply : ((int * int * int) -> unit) ;
-      (** the function to call to apply the new value (day, month, year) of the parameter *)
-    date_help : string option ; (** optional help string *)
-    date_expand : bool ; (** expand the entry widget or not *)
-  } ;;
-
-type font_param = {
-    font_label : string ; (** the label of the parameter *)
-    mutable font_value : string ; (** the font name *)
-    font_editable : bool ; (** indicates if the value can be changed *)
-    font_f_apply : (string -> unit) ;
-      (** the function to call to apply the new value of the parameter *)
-    font_help : string option ; (** optional help string *)
-    font_expand : bool ; (** expand the entry widget or not *)
-  } ;;
-
-
-type hotkey_param = {
-    hk_label : string ; (** the label of the parameter *)
-    mutable hk_value : (Gdk.Tags.modifier list * int) ;
-             (** The value, as a list of modifiers and a key code *)
-    hk_editable : bool ; (** indicates if the value can be changed *)
-    hk_f_apply : ((Gdk.Tags.modifier list * int) -> unit) ;
-             (** the function to call to apply the new value of the paramter *)
-    hk_help : string option ; (** optional help string *)
-    hk_expand : bool ; (** expand or not *)
-  }
-
 type modifiers_param = {
     md_label : string ; (** the label of the parameter *)
     mutable md_value : Gdk.Tags.modifier list ;
@@ -248,17 +98,11 @@ type modifiers_param = {
 type parameter_kind =
     String_param of string string_param
   | List_param of (GData.tooltips -> <box: GObj.widget ; apply : unit>)
-  | Filename_param of string string_param
   | Bool_param of bool_param
   | Text_param of string string_param
   | Combo_param of combo_param
   | Custom_param of custom_param
-  | Color_param of color_param
-  | Date_param of date_param
-  | Font_param of font_param
-  | Hotkey_param of hotkey_param
   | Modifiers_param of modifiers_param
-  | Html_param of string string_param
 ;;
 
 (** This type represents the structure of the configuration window. *)
@@ -275,28 +119,3 @@ type return_button =
   | Return_cancel (** The user closed the window with the cancel
 		     button or the window manager but never clicked
 		     on the apply button.*)
-
-(** {2 Bindings in the html editor} *)
-
-type html_binding = {
-    mutable html_key :  (Gdk.Tags.modifier list * int) ;
-    mutable html_begin : string ;
-    mutable html_end : string ;
-  }
-
-let htmlbinding_cp_wrapper =
-  let w = Config_file.tuple3_wrappers
-      key_cp_wrapper
-      Config_file.string_wrappers
-      Config_file.string_wrappers
-  in
-  {
-    to_raw = (fun v -> w.to_raw (v.html_key, v.html_begin, v.html_end)) ;
-    of_raw =
-      (fun r -> let (k,b,e) = w.of_raw r in
-       { html_key = k ; html_begin = b ; html_end = e }
-      ) ;
-  }
-
-class htmlbinding_cp =
-  [html_binding] Config_file.option_cp htmlbinding_cp_wrapper
diff --git a/ide/utils/editable_cells.ml b/ide/utils/editable_cells.ml
deleted file mode 100644
index 33968b8d..00000000
--- a/ide/utils/editable_cells.ml
+++ /dev/null
@@ -1,113 +0,0 @@
-open Gobject
-
-let create l =
-  let hbox = GPack.hbox () in
-  let scw = GBin.scrolled_window
-	      ~hpolicy:`AUTOMATIC
-	      ~vpolicy:`AUTOMATIC
-	      ~packing:(hbox#pack ~expand:true) () in
-
-  let columns = new GTree.column_list in
-  let command_col =  columns#add Data.string in
-  let coq_col = columns#add Data.string in
-  let store = GTree.list_store columns
-  in
-
-(* populate the store *)
-  let _ = List.iter (fun (x,y) ->
-		       let row = store#append () in
-		       store#set ~row ~column:command_col x;
-		       store#set ~row ~column:coq_col y)
-	    l
-  in
-  let view = GTree.view ~model:store ~packing:scw#add_with_viewport () in
-
-  (* Alternate colors for the rows *)
-  view#set_rules_hint true;
-
-  let renderer_comm = GTree.cell_renderer_text [`EDITABLE true]  in
-  ignore (renderer_comm#connect#edited
-    ~callback:(fun (path:Gtk.tree_path) (s:string) ->
-		 store#set
-		 ~row:(store#get_iter path)
-		 ~column:command_col s));
-  let first =
-    GTree.view_column ~title:"Coq Command to try"
-      ~renderer:(renderer_comm,["text",command_col])
-      ()
-  in ignore (view#append_column first);
-
-  let renderer_coq = GTree.cell_renderer_text [`EDITABLE true] in
-  ignore(renderer_coq#connect#edited
-	   ~callback:(fun (path:Gtk.tree_path) (s:string) ->
-			store#set
-			~row:(store#get_iter path)
-			~column:coq_col s));
-  let second =
-    GTree.view_column ~title:"Coq Command to insert"
-      ~renderer:(renderer_coq,["text",coq_col])
-      ()
-  in ignore (view#append_column second);
-
-  let vbox = GPack.button_box `VERTICAL ~packing:hbox#pack ~layout:`SPREAD ()
-  in
-  let up = GButton.button  ~stock:`GO_UP ~label:"Up" ~packing:(vbox#pack ~expand:true ~fill:false) () in
-  let down = GButton.button
-	       ~stock:`GO_DOWN
-	       ~label:"Down"
-	       ~packing:(vbox#pack ~expand:true ~fill:false) ()
-  in
-  let add = GButton.button ~stock:`ADD
-	      ~label:"Add"
-	      ~packing:(vbox#pack ~expand:true ~fill:false)
-	      ()
-  in
-  let remove = GButton.button ~stock:`REMOVE
-		 ~label:"Remove"
-		 ~packing:(vbox#pack ~expand:true ~fill:false) ()
-  in
-
-  ignore (add#connect#clicked
-	    ~callback:(fun b ->
-			 let n = store#append () in
-			 view#selection#select_iter n));
-  ignore (remove#connect#clicked
-	    ~callback:(fun b -> match view#selection#get_selected_rows with
-			 | [] -> ()
-			 | path::_ ->
-			     let iter = store#get_iter path in
-		       	     ignore (store#remove iter);
-		      ));
-  ignore (up#connect#clicked
-	    ~callback:(fun b ->
-			 match view#selection#get_selected_rows with
-			   | [] -> ()
-			   | path::_ ->
-			       let iter = store#get_iter path in
-			       ignore (GtkTree.TreePath.prev path);
-			       let upiter = store#get_iter path in
-			       ignore (store#swap iter upiter);
-		      ));
-  ignore (down#connect#clicked
-	    ~callback:(fun b ->
-			 match view#selection#get_selected_rows with
-			   | [] -> ()
-			   | path::_ ->
-			       let iter = store#get_iter path in
-			       GtkTree.TreePath.next path;
-			       try let upiter = store#get_iter path in
-			       ignore (store#swap iter upiter)
-			       with _ -> ()
-		      ));
-  let get_data () =
-    let start_path = GtkTree.TreePath.from_string "0" in
-    let start_iter = store#get_iter start_path in
-    let rec all acc =
-      let new_acc = (store#get ~row:start_iter ~column:command_col,
-		     store#get ~row:start_iter ~column:coq_col)::acc
-      in
-      if store#iter_next start_iter then all new_acc else List.rev new_acc
-    in all []
-  in
-  (hbox,get_data)
-
diff --git a/ide/utils/okey.ml b/ide/utils/okey.ml
deleted file mode 100644
index 8f6cb382..00000000
--- a/ide/utils/okey.ml
+++ /dev/null
@@ -1,169 +0,0 @@
-(*********************************************************************************)
-(*                Cameleon                                                       *)
-(*                                                                               *)
-(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
-(*    en Automatique. All rights reserved.                                       *)
-(*                                                                               *)
-(*    This program is free software; you can redistribute it and/or modify       *)
-(*    it under the terms of the GNU Library General Public License as            *)
-(*    published by the Free Software Foundation; either version 2 of the         *)
-(*    License, or  any later version.                                            *)
-(*                                                                               *)
-(*    This program is distributed in the hope that it will be useful,            *)
-(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
-(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
-(*    GNU Library General Public License for more details.                       *)
-(*                                                                               *)
-(*    You should have received a copy of the GNU Library General Public          *)
-(*    License along with this program; if not, write to the Free Software        *)
-(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
-(*    02111-1307  USA                                                            *)
-(*                                                                               *)
-(*    Contact: Maxence.Guesdon@inria.fr                                          *)
-(*                                                                               *)
-(*********************************************************************************)
-
-type modifier = Gdk.Tags.modifier
-
-type handler = {
-    cond : (unit -> bool) ;
-    cback : (unit -> unit) ;
-  }
-
-type handler_spec = int * int * Gdk.keysym
-      (** mods * mask * key *)
-
-let int_of_modifier = function
-    `SHIFT -> 1
-  | `LOCK -> 2
-  | `CONTROL -> 4
-  | `MOD1 -> 8
-  | `MOD2 -> 16
-  | `MOD3 -> 32
-  | `MOD4 -> 64
-  | `MOD5 -> 128
-  | `BUTTON1 -> 256
-  | `BUTTON2 -> 512
-  | `BUTTON3 -> 1024
-  | `BUTTON4 -> 2048
-  | `BUTTON5 -> 4096
-  | `HYPER -> 1 lsl 22
-  | `META -> 1 lsl 20
-  | `RELEASE -> 1 lsl 30
-  | `SUPER -> 1 lsl 21
-
-let int_of_modifiers l =
-  List.fold_left (fun acc -> fun m -> acc + (int_of_modifier m)) 0 l
-
-module H =
-  struct
-    type t = handler_spec * handler
-    let equal (m,k) (mods, mask, key) =
-      (k = key) && ((m land mask) = mods)
-
-    let filter_with_mask mods mask key l =
-      List.filter (fun a -> (fst a) <> (mods, mask, key)) l
-
-    let find_handlers mods key l =
-      List.map snd
-        (List.filter
-	   (fun ((m,ma,k),_) -> equal (mods,key) (m,ma,k))
-	   l
-	)
-
-  end
-
-let (table : (int, H.t list ref) Hashtbl.t) = Hashtbl.create 13
-
-let key_press w ev =
-  let key = GdkEvent.Key.keyval ev in
-  let modifiers = GdkEvent.Key.state ev in
-  try
-    let (r : H.t list ref) = Hashtbl.find table (Oo.id w) in
-    let l = H.find_handlers (int_of_modifiers modifiers) key !r in
-    match l with
-      [] -> false
-    | _ ->
-	List.iter
-	  (fun h ->
-	    if h.cond () then
-	      try h.cback ()
-	      with e -> Minilib.log (Printexc.to_string e)
-	    else ()
-	  )
-	  l;
-	true
-  with
-    Not_found ->
-      false
-
-let associate_key_press w =
-  ignore ((w#event#connect#key_press ~callback: (key_press w)) : GtkSignal.id)
-
-let default_modifiers = ref ([] : modifier list)
-let default_mask = ref ([`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] : modifier list)
-
-let set_default_modifiers l = default_modifiers := l
-let set_default_mask l = default_mask := l
-
-let remove_widget  (w : < event : GObj.event_ops ; ..>) () =
-  try
-    let r = Hashtbl.find table (Oo.id w) in
-    r := []
-  with
-    Not_found ->
-      ()
-
-let add1 ?(remove=false) w
-    ?(cond=(fun () -> true))
-    ?(mods= !default_modifiers)
-    ?(mask= !default_mask)
-    k callback =
-
-  let r =
-    try Hashtbl.find table (Oo.id w)
-    with Not_found ->
-      let r = ref [] in
-      Hashtbl.add table (Oo.id w) r;
-      ignore (w#connect#destroy ~callback: (remove_widget w));
-      associate_key_press w;
-      r
-  in
-  let n_mods = int_of_modifiers mods in
-  let n_mask = lnot (int_of_modifiers mask) in
-  let new_h = { cond = cond ; cback = callback } in
-  if remove then
-    (
-     let l = H.filter_with_mask n_mods n_mask k !r in
-     r := ((n_mods, n_mask, k), new_h) :: l
-    )
-  else
-    r := ((n_mods, n_mask, k), new_h) :: !r
-
-let add w
-    ?(cond=(fun () -> true))
-    ?(mods= !default_modifiers)
-    ?(mask= !default_mask)
-    k callback =
-  add1 w ~cond ~mods ~mask k callback
-
-let add_list w
-    ?(cond=(fun () -> true))
-    ?(mods= !default_modifiers)
-    ?(mask= !default_mask)
-    k_list callback =
-  List.iter (fun k -> add w ~cond ~mods ~mask k callback) k_list
-
-let set w
-    ?(cond=(fun () -> true))
-    ?(mods= !default_modifiers)
-    ?(mask= !default_mask)
-    k callback =
-  add1 ~remove: true w ~cond ~mods ~mask k callback
-
-let set_list w
-    ?(cond=(fun () -> true))
-    ?(mods= !default_modifiers)
-    ?(mask= !default_mask)
-    k_list callback =
-  List.iter (fun k -> set w ~cond ~mods ~mask k callback) k_list
diff --git a/ide/utils/okey.mli b/ide/utils/okey.mli
deleted file mode 100644
index 84ea4df4..00000000
--- a/ide/utils/okey.mli
+++ /dev/null
@@ -1,115 +0,0 @@
-(*********************************************************************************)
-(*                Cameleon                                                       *)
-(*                                                                               *)
-(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
-(*    en Automatique. All rights reserved.                                       *)
-(*                                                                               *)
-(*    This program is free software; you can redistribute it and/or modify       *)
-(*    it under the terms of the GNU Library General Public License as            *)
-(*    published by the Free Software Foundation; either version 2 of the         *)
-(*    License, or  any later version.                                            *)
-(*                                                                               *)
-(*    This program is distributed in the hope that it will be useful,            *)
-(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
-(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
-(*    GNU Library General Public License for more details.                       *)
-(*                                                                               *)
-(*    You should have received a copy of the GNU Library General Public          *)
-(*    License along with this program; if not, write to the Free Software        *)
-(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
-(*    02111-1307  USA                                                            *)
-(*                                                                               *)
-(*    Contact: Maxence.Guesdon@inria.fr                                          *)
-(*                                                                               *)
-(*********************************************************************************)
-
-(** Okey interface.
-
-   Once the lib is compiled and installed, you can use it by referencing
-   it with the [Okey] module. You must add [okey.cmo] or [okey.cmx]
-   on the commande line when you link.
-*)
-
-type modifier = Gdk.Tags.modifier
-
-(** Set the default modifier list. The first default value is [[]].*)
-val set_default_modifiers : modifier list -> unit
-
-(** Set the default modifier mask. The first default value is
-   [[`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK]].
-   The mask defines the modifiers not taken into account
-   when looking for the handler of a key press event.
-*)
-val set_default_mask : modifier list -> unit
-
-(** [add widget key callback] associates the [callback] function to the event
-   "key_press" with the given [key] for the given [widget].
-
-   @param remove when true, the previous handlers for the given key and modifier
-   list are not kept.
-   @param cond this function is a guard: the [callback] function is not called
-   if the [cond] function returns [false].
-   The default [cond] function always returns [true].
-
-   @param mods the list of modifiers. If not given, the default modifiers
-   are used.
-   You can set the default modifiers with function {!Okey.set_default_modifiers}.
-
-   @param mask the list of modifiers which must not be taken
-   into account to trigger the given handler. [mods]
-   and [mask] must not have common modifiers. If not given, the default mask
-   is used.
-   You can set the default modifiers mask with function {!Okey.set_default_mask}.
-*)
-val add :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym ->
-		(unit -> unit) ->
-		  unit
-
-(** It calls {!Okey.add} for each given key.*)
-val add_list :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym list ->
-		(unit -> unit) ->
-		  unit
-
-(** Like {!Okey.add} but the previous handlers for the
-   given modifiers and key are not kept.*)
-val set :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym ->
-		(unit -> unit) ->
-		  unit
-
-(** It calls {!Okey.set} for each given key.*)
-val set_list :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym list ->
-		(unit -> unit) ->
-		  unit
-
-(** Remove the handlers associated to the given widget.
-   This is automatically done when a widget is destroyed but
-   you can do it yourself. *)
-val remove_widget :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	unit ->
-	  unit
diff --git a/ide/wg_Command.ml b/ide/wg_Command.ml
index 946aaf01..8eddfb31 100644
--- a/ide/wg_Command.ml
+++ b/ide/wg_Command.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Preferences
 
-class command_window name coqtop =
+class command_window name coqtop coqops router =
   let frame = Wg_Detachable.detachable
     ~title:(Printf.sprintf "Query pane (%s)" name) () in
   let _ = frame#hide in
@@ -21,11 +23,20 @@ class command_window name coqtop =
     notebook#misc#set_size_request ~width:600 ~height:500 ();
     notebook#misc#grab_focus ()) in
 
+  let route_id =
+    let r = ref 0 in
+    fun () -> incr r; !r in
+
 object(self)
   val frame = frame
 
   val notebook = notebook
 
+  (* We need access to coqops in order to place queries in the proper
+     document stint. This should remove access from this module to the
+     low-level Coq one. *)
+  val coqops = coqops
+
   method pack_in (f : GObj.widget -> unit) = f frame#coerce
 
   val mutable new_page : GObj.widget = (GMisc.label ())#coerce
@@ -47,11 +58,13 @@ object(self)
   method private new_query_aux ?command ?term ?(grab_now=true) () =
     let frame = GBin.frame ~shadow_type:`NONE () in
     ignore(notebook#insert_page ~pos:(notebook#page_num new_page) frame#coerce);
+    let route_id = route_id () in
     let new_tab_lbl text =
       let hbox = GPack.hbox ~homogeneous:false () in
       ignore(GMisc.label ~width:100 ~ellipsize:`END ~text ~packing:hbox#pack());
       let b = GButton.button ~packing:hbox#pack () in
       ignore(b#connect#clicked ~callback:(fun () ->
+        router#delete_route route_id;
         views <-
           List.filter (fun (f,_,_) -> f#get_oid <> frame#coerce#get_oid) views;
         notebook#remove_page (notebook#page_num frame#coerce)));
@@ -83,15 +96,16 @@ object(self)
 	~vpolicy:`AUTOMATIC
 	~hpolicy:`AUTOMATIC
 	~packing:(vbox#pack ~fill:true ~expand:true) () in
-    let result = GText.view ~packing:r_bin#add () in
+    let result = Wg_MessageView.message_view () in
+    router#register_route route_id result;
+    r_bin#add (result :> GObj.widget);
     views <- (frame#coerce, result, combo#entry) :: views;
     let cb clr = result#misc#modify_base [`NORMAL, `NAME clr] in
-    let _ = background_color#connect#changed cb in
-    let _ = result#misc#connect#realize (fun () -> cb background_color#get) in
+    let _ = background_color#connect#changed ~callback:cb in
+    let _ = result#misc#connect#realize ~callback:(fun () -> cb background_color#get) in
     let cb ft = result#misc#modify_font (Pango.Font.from_string ft) in
     stick text_font result cb;
     result#misc#set_can_focus true; (* false causes problems for selection *)
-    result#set_editable false;
     let callback () =
       let com = combo#entry#text in
       let arg = entry#text in
@@ -100,22 +114,20 @@ object(self)
         if Str.string_match (Str.regexp "\\. *$") com 0 then com
         else com ^ " " ^ arg ^" . "
       in
-      let log level message =
-        Ideutils.insert_xml result#buffer message;
-        result#buffer#insert "\n";
-      in
       let process =
-	Coq.bind (Coq.query ~logger:log (phrase,Stateid.dummy)) (function
-          | Interface.Fail (_,l,str) ->
-            Ideutils.insert_xml result#buffer str;
+        let next = function
+        | Interface.Fail (_, _, err) ->
+            let err = Ideutils.validate err in
+            result#set err;
             notebook#set_page ~tab_label:(new_tab_lbl "Error") frame#coerce;
-	    Coq.return ()
-          | Interface.Good res ->
-            result#buffer#insert res; 
+            Coq.return ()
+        | Interface.Good () ->
             notebook#set_page ~tab_label:(new_tab_lbl arg) frame#coerce;
-	    Coq.return ())
+            Coq.return ()
+        in
+        coqops#raw_coq_query ~route_id ~next phrase
       in
-      result#buffer#set_text ("Result for command " ^ phrase ^ ":\n");
+      result#set (Pp.str ("Result for command " ^ phrase ^ ":\n"));
       Coq.try_grab coqtop process ignore
     in
     ignore (combo#entry#connect#activate ~callback);
@@ -159,7 +171,7 @@ object(self)
     self#new_page_maker;
     self#new_query_aux ~grab_now:false ();
     frame#misc#hide ();
-    let _ = background_color#connect#changed self#refresh_color in
+    let _ = background_color#connect#changed ~callback:self#refresh_color in
     self#refresh_color background_color#get;
     ignore(notebook#event#connect#key_press ~callback:(fun ev ->
       if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then (self#hide; true)
diff --git a/ide/wg_Command.mli b/ide/wg_Command.mli
index fa50ba5f..1e0eb675 100644
--- a/ide/wg_Command.mli
+++ b/ide/wg_Command.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-class command_window : string -> Coq.coqtop ->
+class command_window : string -> Coq.coqtop -> CoqOps.coqops -> Wg_RoutedMessageViews.message_views_router ->
   object
     method new_query : ?command:string -> ?term:string -> unit -> unit
     method pack_in : (GObj.widget -> unit) -> unit
diff --git a/ide/wg_Completion.ml b/ide/wg_Completion.ml
index aeae3e1f..6a9317bc 100644
--- a/ide/wg_Completion.ml
+++ b/ide/wg_Completion.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module StringOrd =
@@ -154,7 +156,7 @@ object (self)
     let () = store#clear () in
     let iter prop =
       let iter = store#append () in
-      store#set iter column prop
+      store#set ~row:iter ~column prop
     in
     let () = current_completion <- (pref, props) in
     Proposals.iter iter props
@@ -267,7 +269,7 @@ object (self)
     (** Position of view w.r.t. window *)
     let (ux, uy) = Gdk.Window.get_position view#misc#window in
     (** Relative buffer position to view *)
-    let (dx, dy) = view#window_to_buffer_coords `WIDGET 0 0 in
+    let (dx, dy) = view#window_to_buffer_coords ~tag:`WIDGET ~x:0 ~y:0 in
     (** Iter position *)
     let iter = view#buffer#get_iter pos in
     let coords = view#get_iter_location iter in
@@ -397,11 +399,11 @@ object (self)
     let () = self#select_first () in
     let () = obj#misc#show () in
     let () = self#manage_scrollbar () in
-    obj#resize 1 1
+    obj#resize ~width:1 ~height:1
 
   method private start_callback off =
     let (x, y, w, h) = self#coordinates (`OFFSET off) in
-    let () = obj#move x (y + 3 * h / 2) in
+    let () = obj#move ~x ~y:(y + 3 * h / 2) in
     ()
 
   method private update_callback (off, word, props) =
@@ -433,21 +435,21 @@ object (self)
       else false
     in
     (** Style handling *)
-    let _ = view#misc#connect#style_set self#refresh_style in
+    let _ = view#misc#connect#style_set ~callback:self#refresh_style in
     let _ = self#refresh_style () in
     let _ = data#set_resize_mode `PARENT in
     let _ = frame#set_resize_mode `PARENT in
     (** Callback to model *)
-    let _ = model#connect#start_completion self#start_callback in
-    let _ = model#connect#update_completion self#update_callback in
-    let _ = model#connect#end_completion self#end_callback in
+    let _ = model#connect#start_completion ~callback:self#start_callback in
+    let _ = model#connect#update_completion ~callback:self#update_callback in
+    let _ = model#connect#end_completion ~callback:self#end_callback in
     (** Popup interaction *)
-    let _ = view#event#connect#key_press key_cb in
+    let _ = view#event#connect#key_press ~callback:key_cb in
     (** Hiding the popup when necessary*)
-    let _ = view#misc#connect#hide obj#misc#hide in
-    let _ = view#event#connect#button_press (fun _ -> self#hide (); false) in
-    let _ = view#connect#move_cursor move_cb in
-    let _ = view#event#connect#focus_out (fun _ -> self#hide (); false) in
+    let _ = view#misc#connect#hide ~callback:obj#misc#hide in
+    let _ = view#event#connect#button_press ~callback:(fun _ -> self#hide (); false) in
+    let _ = view#connect#move_cursor ~callback:move_cb in
+    let _ = view#event#connect#focus_out ~callback:(fun _ -> self#hide (); false) in
     ()
 
 end
diff --git a/ide/wg_Completion.mli b/ide/wg_Completion.mli
index dd496aa5..aa2f36a5 100644
--- a/ide/wg_Completion.mli
+++ b/ide/wg_Completion.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module Proposals : sig type t end
diff --git a/ide/wg_Detachable.ml b/ide/wg_Detachable.ml
index 3d1b63df..d7536870 100644
--- a/ide/wg_Detachable.ml
+++ b/ide/wg_Detachable.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 class type detachable_signals =
@@ -19,15 +21,15 @@ class detachable (obj : ([> Gtk.box] as 'a) Gobject.obj) =
     inherit GPack.box_skel (obj :> Gtk.box Gobject.obj) as super
 
     val but = GButton.button ()
-    val win = GWindow.window ()
+    val win = GWindow.window ~type_hint:`DIALOG ()
     val frame = GBin.frame ~shadow_type:`NONE ()
     val mutable detached = false
     val mutable detached_cb = (fun _ -> ())
     val mutable attached_cb = (fun _ -> ())
 
     method child = frame#child
-    method add = frame#add
-    method pack ?from ?expand ?fill ?padding w =
+    method! add = frame#add
+    method! pack ?from ?expand ?fill ?padding w =
       if frame#all_children = [] then self#add w
       else raise (Invalid_argument "detachable#pack")
 
diff --git a/ide/wg_Detachable.mli b/ide/wg_Detachable.mli
index a7e8f467..9588cf18 100644
--- a/ide/wg_Detachable.mli
+++ b/ide/wg_Detachable.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 class type detachable_signals =
diff --git a/ide/wg_Find.ml b/ide/wg_Find.ml
index 3d847ddc..296a9423 100644
--- a/ide/wg_Find.ml
+++ b/ide/wg_Find.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 let b2c = Ideutils.byte_offset_to_char_offset
@@ -84,8 +86,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 +105,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 +143,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 () =
@@ -186,8 +229,8 @@ class finder name (view : GText.view) =
       in
       let find_cb = generic_cb self#hide self#find_forward in
       let replace_cb = generic_cb self#hide self#replace in
-      let _ = find_entry#event#connect#key_press find_cb in
-      let _ = replace_entry#event#connect#key_press replace_cb in
+      let _ = find_entry#event#connect#key_press ~callback:find_cb in
+      let _ = replace_entry#event#connect#key_press ~callback:replace_cb in
 
       (** TextView interaction *)
       let view_cb ev =
@@ -197,7 +240,7 @@ class finder name (view : GText.view) =
           else false
         else false
       in
-      let _ = view#event#connect#key_press view_cb in
+      let _ = view#event#connect#key_press ~callback:view_cb in
       ()
 
   end
diff --git a/ide/wg_Find.mli b/ide/wg_Find.mli
index 1ef1c4d4..b4c1a40e 100644
--- a/ide/wg_Find.mli
+++ b/ide/wg_Find.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 class finder : string -> GText.view ->
diff --git a/ide/wg_MessageView.ml b/ide/wg_MessageView.ml
index 0330b8ef..a79a093e 100644
--- a/ide/wg_MessageView.ml
+++ b/ide/wg_MessageView.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Preferences
@@ -28,13 +30,14 @@ class type message_view =
     inherit GObj.widget
     method connect : message_view_signals
     method clear : unit
-    method add : Richpp.richpp -> unit
+    method add : Pp.t -> unit
     method add_string : string -> unit
-    method set : Richpp.richpp -> unit
+    method set : Pp.t -> unit
+    method refresh : bool -> unit
     method push : Ideutils.logger
       (** same as [add], but with an explicit level instead of [Notice] *)
-    method buffer : GText.buffer
-      (** for more advanced text edition *)
+    method has_selection : bool
+    method get_selected_text : string
   end
 
 let message_view () : message_view =
@@ -42,7 +45,6 @@ let message_view () : message_view =
     ~highlight_matching_brackets:true
     ~tag_table:Tags.Message.table ()
   in
-  let text_buffer = new GText.buffer buffer#as_buffer in
   let mark = buffer#create_mark ~left_gravity:false buffer#start_iter in
   let box = GPack.vbox () in
   let scroll = GBin.scrolled_window
@@ -57,46 +59,76 @@ let message_view () : message_view =
   let () = view#set_left_margin 2 in
   view#misc#show ();
   let cb clr = view#misc#modify_base [`NORMAL, `NAME clr] in
-  let _ = background_color#connect#changed cb in
-  let _ = view#misc#connect#realize (fun () -> cb background_color#get) in
+  let _ = background_color#connect#changed ~callback:cb in
+  let _ = view#misc#connect#realize ~callback:(fun () -> cb background_color#get) in
   let cb ft = view#misc#modify_font (Pango.Font.from_string ft) in
   stick text_font view cb;
-  object (self)
+
+  (* Inserts at point, advances the mark *)
+  let insert_msg (level, msg) =
+    let tags = match level with
+      | Feedback.Error   -> [Tags.Message.error]
+      | Feedback.Warning -> [Tags.Message.warning]
+      | _ -> []
+    in
+    let mark = `MARK mark in
+    let width = Ideutils.textview_width view in
+    Ideutils.insert_xml ~mark buffer ~tags (Richpp.richpp_of_pp width msg);
+    buffer#insert ~iter:(buffer#get_iter_at_mark mark) "\n"
+  in
+
+  let mv = object (self)
     inherit GObj.widget box#as_widget
 
+    (* List of displayed messages *)
+    val mutable last_width = -1
+    val mutable msgs = []
+
     val push = new GUtil.signal ()
 
     method connect =
       new message_view_signals_impl box#as_widget push
 
+    method refresh force =
+      (* We need to block updates here due to the following race:
+         insertion of messages may create a vertical scrollbar, this
+         will trigger a width change, calling refresh again and
+         going into an infinite loop. *)
+      let width = Ideutils.textview_width view  in
+      (* Could still this method race if the scrollbar changes the
+         textview_width ?? *)
+      let needed = force || last_width <> width in
+      if needed then begin
+        last_width <- width;
+        buffer#set_text "";
+        buffer#move_mark (`MARK mark) ~where:buffer#start_iter;
+        List.(iter insert_msg (rev msgs))
+      end
+
     method clear =
-      buffer#set_text "";
-      buffer#move_mark (`MARK mark) ~where:buffer#start_iter
+      msgs <- []; self#refresh true
 
     method push level msg =
-      let tags = match level with
-      | Feedback.Error -> [Tags.Message.error]
-      | Feedback.Warning -> [Tags.Message.warning]
-      | _ -> []
-      in
-      let rec non_empty = function
-      | Xml_datatype.PCData "" -> false
-      | Xml_datatype.PCData _ -> true
-      | Xml_datatype.Element (_, _, children) -> List.exists non_empty children
-      in
-      if non_empty (Richpp.repr msg) then begin
-        let mark = `MARK mark in
-        Ideutils.insert_xml ~mark buffer ~tags msg;
-        buffer#insert ~iter:(buffer#get_iter_at_mark mark) "\n";
-        push#call (level, msg)
-      end
+      msgs <- (level, msg) :: msgs;
+      insert_msg (level, msg);
+      push#call (level, msg)
 
     method add msg = self#push Feedback.Notice msg
 
-    method add_string s = self#add (Richpp.richpp_of_string s)
+    method add_string s = self#add (Pp.str s)
 
     method set msg = self#clear; self#add msg
 
-    method buffer = text_buffer
+    method has_selection = buffer#has_selection
+    method get_selected_text =
+      if buffer#has_selection then
+        let start, stop = buffer#selection_bounds in
+        buffer#get_text ~slice:true ~start ~stop ()
+      else ""
 
   end
+  in
+  (* Is there a better way to connect the signal ? *)
+  let w_cb (_ : Gtk.rectangle) = mv#refresh false in
+  ignore (view#misc#connect#size_allocate ~callback:w_cb);
+  mv
diff --git a/ide/wg_MessageView.mli b/ide/wg_MessageView.mli
index 2d34533d..472aaf5e 100644
--- a/ide/wg_MessageView.mli
+++ b/ide/wg_MessageView.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 class type message_view_signals =
@@ -18,13 +20,14 @@ class type message_view =
     inherit GObj.widget
     method connect : message_view_signals
     method clear : unit
-    method add : Richpp.richpp -> unit
+    method add : Pp.t -> unit
     method add_string : string -> unit
-    method set : Richpp.richpp -> unit
+    method set : Pp.t -> unit
+    method refresh : bool -> unit
     method push : Ideutils.logger
       (** same as [add], but with an explicit level instead of [Notice] *)
-    method buffer : GText.buffer
-      (** for more advanced text edition *)
+    method has_selection : bool
+    method get_selected_text : string
   end
 
 val message_view : unit -> message_view
diff --git a/ide/wg_Notebook.ml b/ide/wg_Notebook.ml
index 08d7d198..424979d8 100644
--- a/ide/wg_Notebook.ml
+++ b/ide/wg_Notebook.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 class ['a] typed_notebook make_page kill_page nb =
@@ -50,7 +52,7 @@ object(self)
 
   method pages = term_list
 
-  method remove_page index =
+  method! remove_page index =
     term_list <- Util.List.filteri (fun i x -> if i = index then kill_page x; i <> index) term_list;
     super#remove_page index
 
diff --git a/ide/wg_Notebook.mli b/ide/wg_Notebook.mli
index 34eb1d11..85ecdf6c 100644
--- a/ide/wg_Notebook.mli
+++ b/ide/wg_Notebook.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 class ['a] typed_notebook :
diff --git a/ide/wg_ProofView.ml b/ide/wg_ProofView.ml
index 47c86045..9be562d3 100644
--- a/ide/wg_ProofView.ml
+++ b/ide/wg_ProofView.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -14,11 +16,10 @@ class type proof_view =
   object
     inherit GObj.widget
     method buffer : GText.buffer
-    method refresh : unit -> unit
+    method refresh : force:bool -> unit
     method clear : unit -> unit
     method set_goals : Interface.goals option -> unit
     method set_evars : Interface.evar list option -> unit
-    method width : int
   end
 
 (* tag is the tag to be hooked, item is the item covered by this tag, make_menu
@@ -48,7 +49,7 @@ let hook_tag_cb tag menu_content sel_cb hover_cb =
                      hover_cb start stop; false
                  | _ -> false))
 
-let mode_tactic sel_cb (proof : #GText.view_skel) goals hints = match goals with
+let mode_tactic sel_cb (proof : #GText.view_skel) goals ~unfoc_goals hints = match goals with
   | [] -> assert false
   | { Interface.goal_hyp = hyps; Interface.goal_ccl = cur_goal; } :: rem_goals ->
       let on_hover sel_start sel_stop =
@@ -66,14 +67,18 @@ let mode_tactic sel_cb (proof : #GText.view_skel) goals hints = match goals with
       let head_str = Printf.sprintf
         "%d subgoal%s\n" goals_cnt (if 1 < goals_cnt then "s" else "")
       in
-      let goal_str index total = Printf.sprintf
-        "______________________________________(%d/%d)\n" index total
+      let goal_str ?(shownum=false) index total =
+        if shownum then Printf.sprintf
+                          "______________________________________(%d/%d)\n" index total
+        else Printf.sprintf
+               "______________________________________\n"
       in
       (* Insert current goal and its hypotheses *)
       let hyps_hints, goal_hints = match hints with
       | None -> [], []
       | Some (hl, h) -> (hl, h)
       in
+      let width = Ideutils.textview_width proof in
       let rec insert_hyp hints hs = match hs with
       | [] -> ()
       | hyp :: hs ->
@@ -84,7 +89,7 @@ let mode_tactic sel_cb (proof : #GText.view_skel) goals hints = match goals with
           let () = hook_tag_cb tag hint sel_cb on_hover in
           [tag], hints
         in
-        let () = insert_xml ~tags proof#buffer hyp in
+        let () = insert_xml ~tags proof#buffer (Richpp.richpp_of_pp width hyp) in
         proof#buffer#insert "\n";
         insert_hyp rem_hints hs
       in
@@ -97,22 +102,33 @@ let mode_tactic sel_cb (proof : #GText.view_skel) goals hints = match goals with
           [tag]
           else []
         in
-        proof#buffer#insert (goal_str 1 goals_cnt);
-        insert_xml proof#buffer cur_goal;
+        proof#buffer#insert (goal_str ~shownum:true 1 goals_cnt);
+        insert_xml ~tags:[Tags.Proof.goal] proof#buffer (Richpp.richpp_of_pp width cur_goal);
         proof#buffer#insert "\n"
       in
       (* Insert remaining goals (no hypotheses) *)
-      let fold_goal i _ { Interface.goal_ccl = g } =
-        proof#buffer#insert (goal_str i goals_cnt);
-        insert_xml proof#buffer g;
+      let fold_goal ?(shownum=false) i _ { Interface.goal_ccl = g } =
+        proof#buffer#insert (goal_str ~shownum i goals_cnt);
+        insert_xml proof#buffer (Richpp.richpp_of_pp width g);
         proof#buffer#insert "\n"
       in
-      let () = Util.List.fold_left_i fold_goal 2 () rem_goals in
-
+      let () = Util.List.fold_left_i (fold_goal ~shownum:true) 2 () rem_goals in
+      (* show unfocused goal if option set *)
+      (* Insert remaining goals (no hypotheses) *)
+      if Coq.PrintOpt.printing_unfocused () then
+        begin
+          ignore(proof#buffer#place_cursor ~where:(proof#buffer#end_iter));
+          let unfoc = List.flatten (List.rev (List.map (fun (x,y) -> x@y) unfoc_goals)) in
+          if unfoc<>[] then
+            begin
+              proof#buffer#insert "\nUnfocused Goals:\n";
+              Util.List.fold_left_i (fold_goal ~shownum:false) 0 () unfoc
+            end
+        end;
       ignore(proof#buffer#place_cursor
                ~where:(proof#buffer#end_iter#backward_to_tag_toggle
                          (Some Tags.Proof.goal)));
-      ignore(proof#scroll_to_mark ~use_align:true ~yalign:0.95 `INSERT)
+      ignore(proof#scroll_to_mark `INSERT)
 
 let rec flatten = function
 | [] -> []
@@ -122,6 +138,7 @@ let rec flatten = function
 
 let display mode (view : #GText.view_skel) goals hints evars =
   let () = view#buffer#set_text "" in
+  let width = Ideutils.textview_width view in
   match goals with
   | None -> ()
     (* No proof in progress *)
@@ -144,7 +161,7 @@ let display mode (view : #GText.view_skel) goals hints evars =
       (* The proof is finished, with the exception of given up goals. *)
       view#buffer#insert "No more subgoals, but there are some goals you gave up:\n\n";
       let iter goal =
-        insert_xml view#buffer goal.Interface.goal_ccl;
+        insert_xml view#buffer (Richpp.richpp_of_pp width goal.Interface.goal_ccl);
         view#buffer#insert "\n"
       in
       List.iter iter given_up_goals;
@@ -153,7 +170,7 @@ let display mode (view : #GText.view_skel) goals hints evars =
       (* All the goals have been resolved but those on the shelf. *)
       view#buffer#insert "All the remaining goals are on the shelf:\n\n";
       let iter goal =
-        insert_xml view#buffer goal.Interface.goal_ccl;
+        insert_xml view#buffer (Richpp.richpp_of_pp width goal.Interface.goal_ccl);
         view#buffer#insert "\n"
       in
       List.iter iter shelved_goals
@@ -166,13 +183,14 @@ let display mode (view : #GText.view_skel) goals hints evars =
       view#buffer#insert "This subproof is complete, but there are some unfocused goals:\n\n";
       let iter i goal =
         let () = view#buffer#insert (goal_str (succ i)) in
-        insert_xml view#buffer goal.Interface.goal_ccl;
+        insert_xml view#buffer (Richpp.richpp_of_pp width goal.Interface.goal_ccl);
         view#buffer#insert "\n"
       in
       List.iteri iter bg
     end
-  | Some { Interface.fg_goals = fg } ->
-    mode view fg hints
+  | Some { Interface.fg_goals = fg; bg_goals = bg } ->
+    mode view fg ~unfoc_goals:bg hints
+
 
 let proof_view () =
   let buffer = GSourceView2.source_buffer
@@ -187,15 +205,16 @@ let proof_view () =
   let default_clipboard = GData.clipboard Gdk.Atom.primary in
   let _ = buffer#add_selection_clipboard default_clipboard in
   let cb clr = view#misc#modify_base [`NORMAL, `NAME clr] in
-  let _ = background_color#connect#changed cb in
-  let _ = view#misc#connect#realize (fun () -> cb background_color#get) in
+  let _ = background_color#connect#changed ~callback:cb in
+  let _ = view#misc#connect#realize ~callback:(fun () -> cb background_color#get) in
   let cb ft = view#misc#modify_font (Pango.Font.from_string ft) in
   stick text_font view cb;
 
-  object
+  let pf = object
     inherit GObj.widget view#as_widget
     val mutable goals = None
     val mutable evars = None
+    val mutable last_width = -1
 
     method buffer = text_buffer
 
@@ -205,11 +224,24 @@ let proof_view () =
 
     method set_evars evs = evars <- evs
 
-    method refresh () =
-      let dummy _ () = () in
-      display (mode_tactic dummy) (view :> GText.view_skel) goals None evars
-
-    method width = Ideutils.textview_width (view :> GText.view_skel)
+    method refresh ~force =
+      (* We need to block updates here due to the following race:
+         insertion of messages may create a vertical scrollbar, this
+         will trigger a width change, calling refresh again and
+         going into an infinite loop. *)
+      let width = Ideutils.textview_width view  in
+      (* Could still this method race if the scrollbar changes the
+         textview_width ?? *)
+      let needed = force || last_width <> width in
+      if needed then begin
+        last_width <- width;
+        let dummy _ () = () in
+        display (mode_tactic dummy) view goals None evars
+      end
   end
-
-(*     ignore (proof_buffer#add_selection_clipboard cb); *)
+  in
+  (* Is there a better way to connect the signal ? *)
+  (* Can this be done in the object constructor? *)
+  let w_cb _ = pf#refresh ~force:false in
+  ignore (view#misc#connect#size_allocate ~callback:w_cb);
+  pf
diff --git a/ide/wg_ProofView.mli b/ide/wg_ProofView.mli
index b6eae48b..922f5a69 100644
--- a/ide/wg_ProofView.mli
+++ b/ide/wg_ProofView.mli
@@ -1,20 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 class type proof_view =
   object
     inherit GObj.widget
     method buffer : GText.buffer
-    method refresh : unit -> unit
+    method refresh : force:bool -> unit
     method clear : unit -> unit
     method set_goals : Interface.goals option -> unit
     method set_evars : Interface.evar list option -> unit
-    method width : int
   end
 
 val proof_view : unit -> proof_view
diff --git a/ide/wg_RoutedMessageViews.ml b/ide/wg_RoutedMessageViews.ml
new file mode 100644
index 00000000..4bd30352
--- /dev/null
+++ b/ide/wg_RoutedMessageViews.ml
@@ -0,0 +1,47 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+class type message_views_router = object
+  method route : int -> Wg_MessageView.message_view
+  method default_route : Wg_MessageView.message_view
+
+  method has_selection : bool
+  method get_selected_text : string
+
+  method register_route : int -> Wg_MessageView.message_view -> unit
+  method delete_route : int -> unit
+end
+
+let message_views ~route_0 : message_views_router =
+  let route_table = Hashtbl.create 17 in
+  let () = Hashtbl.add route_table 0 route_0 in
+object
+  method route i =
+    try Hashtbl.find route_table i
+    with Not_found ->
+      (* at least the message will be printed somewhere*)
+      Hashtbl.find route_table 0
+
+  method default_route = route_0
+
+  method register_route i mv = Hashtbl.add route_table i mv
+
+  method delete_route i = Hashtbl.remove route_table i
+
+  method has_selection =
+    Hashtbl.fold (fun _ v -> (||) v#has_selection) route_table false
+
+  method get_selected_text =
+    Option.default ""
+      (Hashtbl.fold (fun _ v acc ->
+         if v#has_selection then Some v#get_selected_text else acc)
+      route_table None)
+
+end
diff --git a/ide/wg_RoutedMessageViews.mli b/ide/wg_RoutedMessageViews.mli
new file mode 100644
index 00000000..cca43d55
--- /dev/null
+++ b/ide/wg_RoutedMessageViews.mli
@@ -0,0 +1,23 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+class type message_views_router = object
+  method route : int -> Wg_MessageView.message_view
+  method default_route : Wg_MessageView.message_view
+
+  method has_selection : bool
+  method get_selected_text : string
+
+  method register_route : int -> Wg_MessageView.message_view -> unit
+  method delete_route : int -> unit
+end
+
+val message_views :
+  route_0:Wg_MessageView.message_view -> message_views_router
diff --git a/ide/wg_ScriptView.ml b/ide/wg_ScriptView.ml
index 218cedb3..74bc0b8d 100644
--- a/ide/wg_ScriptView.ml
+++ b/ide/wg_ScriptView.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Preferences
@@ -301,28 +303,28 @@ object (self)
       ~use_align:false ~yalign:0.75 ~within_margin:0.25 `INSERT
 
   (* HACK: missing gtksourceview features *)
-  method right_margin_position =
+  method! right_margin_position =
     let prop = {
       Gobject.name = "right-margin-position";
       conv = Gobject.Data.int;
     } in
     Gobject.get prop obj
 
-  method set_right_margin_position pos =
+  method! set_right_margin_position pos =
     let prop = {
       Gobject.name = "right-margin-position";
       conv = Gobject.Data.int;
     } in
     Gobject.set prop obj pos
 
-  method show_right_margin =
+  method! show_right_margin =
     let prop = {
       Gobject.name = "show-right-margin";
       conv = Gobject.Data.boolean;
     } in
     Gobject.get prop obj
 
-  method set_show_right_margin show =
+  method! set_show_right_margin show =
     let prop = {
       Gobject.name = "show-right-margin";
       conv = Gobject.Data.boolean;
@@ -460,8 +462,8 @@ object (self)
     let _ = GtkSignal.connect ~sgn:move_line_signal ~callback obj in
     (** Plug on preferences *)
     let cb clr = self#misc#modify_base [`NORMAL, `NAME clr] in
-    let _ = background_color#connect#changed cb in
-    let _ = self#misc#connect#realize (fun () -> cb background_color#get) in
+    let _ = background_color#connect#changed ~callback:cb in
+    let _ = self#misc#connect#realize ~callback:(fun () -> cb background_color#get) in
 
     let cb b = self#set_wrap_mode (if b then `WORD else `NONE) in
     stick dynamic_word_wrap self cb;
diff --git a/ide/wg_ScriptView.mli b/ide/wg_ScriptView.mli
index 6cce5e5b..be6510db 100644
--- a/ide/wg_ScriptView.mli
+++ b/ide/wg_ScriptView.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* An undoable view class *)
diff --git a/ide/wg_Segment.ml b/ide/wg_Segment.ml
index dbc1740e..0f5ed8d8 100644
--- a/ide/wg_Segment.ml
+++ b/ide/wg_Segment.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -75,7 +77,7 @@ object (self)
         self#redraw ();
       end
     in
-    let _ = box#misc#connect#size_allocate cb in
+    let _ = box#misc#connect#size_allocate ~callback:cb in
     let clicked_cb ev = match model with
     | None -> true
     | Some md ->
@@ -86,7 +88,7 @@ object (self)
       let () = clicked#call idx in
       true
     in
-    let _ = eventbox#event#connect#button_press clicked_cb in
+    let _ = eventbox#event#connect#button_press ~callback:clicked_cb in
     let cb show = if show then self#misc#show () else self#misc#hide () in
     stick show_progress_bar self cb;
     (** Initial pixmap *)
@@ -102,7 +104,7 @@ object (self)
     | `SET (i, color) ->
       if self#misc#visible then self#fill_range color i (i + 1)
     in
-    md#changed changed_cb
+    md#changed ~callback:changed_cb
 
   method private fill_range color i j = match model with
   | None -> ()
diff --git a/ide/wg_Segment.mli b/ide/wg_Segment.mli
index 29cbbeda..07f545fe 100644
--- a/ide/wg_Segment.mli
+++ b/ide/wg_Segment.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type color = GDraw.color
diff --git a/ide/xml_lexer.mll b/ide/xml_lexer.mll
index 290f2c89..4a52147e 100644
--- a/ide/xml_lexer.mll
+++ b/ide/xml_lexer.mll
@@ -83,6 +83,9 @@ let error lexbuf e =
         last_pos := lexeme_start lexbuf;
         raise (Error e)
 
+[@@@ocaml.warning "-3"]       (* String.lowercase_ascii since 4.03.0 GPR#124 *)
+let lowercase = String.lowercase
+[@@@ocaml.warning "+3"]
 }
 
 let newline = ['\n']
@@ -219,7 +222,7 @@ and entity = parse
                 {
                         let ident = lexeme lexbuf in
                         try
-                                Hashtbl.find idents (String.lowercase ident)
+                                Hashtbl.find idents (lowercase ident)
                         with
                                 Not_found -> "&" ^ ident
                 }
diff --git a/ide/xml_printer.ml b/ide/xml_printer.ml
index 40ab4ce9..488ef7bf 100644
--- a/ide/xml_printer.ml
+++ b/ide/xml_printer.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Xml_datatype
diff --git a/ide/xml_printer.mli b/ide/xml_printer.mli
index f24f51ff..178f7c80 100644
--- a/ide/xml_printer.mli
+++ b/ide/xml_printer.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type xml = Xml_datatype.xml
diff --git a/ide/xmlprotocol.ml b/ide/xmlprotocol.ml
index aecb317b..e1821921 100644
--- a/ide/xmlprotocol.ml
+++ b/ide/xmlprotocol.ml
@@ -1,16 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Protocol version of this file. This is the date of the last modification. *)
 
 (** WARNING: TO BE UPDATED WHEN MODIFIED! *)
 
-let protocol_version = "20150913"
+let protocol_version = "20170413"
+
+type msg_format = Richpp of int | Ppcmds
+let msg_format = ref (Richpp 72)
 
 (** * Interface of calls to Coq by CoqIde *)
 
@@ -92,10 +97,64 @@ let to_stateid = function
 
 let of_stateid i = Element ("state_id",["val",string_of_int (Stateid.to_int i)],[])
 
-let of_richpp x = Element ("richpp", [], [Richpp.repr x])
-let to_richpp xml = match xml with
-  | Element ("richpp", [], [x]) -> Richpp.richpp_of_xml x
-  | x -> raise Serialize.(Marshal_error("richpp",x))
+let to_routeid = function
+  | Element ("route_id",["val",i],[]) ->
+      let id = int_of_string i in id
+  | _ -> raise (Invalid_argument "to_route_id")
+
+let of_routeid i = Element ("route_id",["val",string_of_int i],[])
+
+let of_box (ppb : Pp.block_type) = let open Pp in match ppb with
+  | Pp_hbox   i -> constructor "ppbox" "hbox"   [of_int i]
+  | Pp_vbox   i -> constructor "ppbox" "vbox"   [of_int i]
+  | Pp_hvbox  i -> constructor "ppbox" "hvbox"  [of_int i]
+  | Pp_hovbox i -> constructor "ppbox" "hovbox" [of_int i]
+
+let to_box = let open Pp in
+  do_match "ppbox" (fun s args -> match s with
+      | "hbox"   -> Pp_hbox   (to_int (singleton args))
+      | "vbox"   -> Pp_vbox   (to_int (singleton args))
+      | "hvbox"  -> Pp_hvbox  (to_int (singleton args))
+      | "hovbox" -> Pp_hovbox (to_int (singleton args))
+      | x        -> raise (Marshal_error("*ppbox",PCData x))
+    )
+
+let rec of_pp (pp : Pp.t) = let open Pp in match Pp.repr pp with
+    | Ppcmd_empty         -> constructor "ppdoc" "empty"  []
+    | Ppcmd_string s      -> constructor "ppdoc" "string" [of_string s]
+    | Ppcmd_glue sl       -> constructor "ppdoc" "glue"   [of_list of_pp sl]
+    | Ppcmd_box (bt,s)    -> constructor "ppdoc" "box"    [of_pair of_box of_pp (bt,s)]
+    | Ppcmd_tag (t,s)     -> constructor "ppdoc" "tag"    [of_pair of_string of_pp (t,s)]
+    | Ppcmd_print_break (i,j)
+                          -> constructor "ppdoc" "break"     [of_pair of_int of_int (i,j)]
+    | Ppcmd_force_newline -> constructor "ppdoc" "newline"   []
+    | Ppcmd_comment cmd   -> constructor "ppdoc" "comment" [of_list of_string cmd]
+
+
+let rec to_pp xpp = let open Pp in
+  Pp.unrepr @@
+  do_match "ppdoc" (fun s args -> match s with
+    | "empty"     -> Ppcmd_empty
+    | "string"    -> Ppcmd_string (to_string (singleton args))
+    | "glue"      -> Ppcmd_glue (to_list to_pp (singleton args))
+    | "box"       -> let (bt,s) = to_pair to_box to_pp (singleton args) in
+                     Ppcmd_box(bt,s)
+    | "tag"       -> let (tg,s) = to_pair to_string to_pp (singleton args) in
+                     Ppcmd_tag(tg,s)
+    | "break"     -> let (i,j)   = to_pair to_int to_int (singleton args) in
+                     Ppcmd_print_break(i, j)
+    | "newline"   -> Ppcmd_force_newline
+    | "comment"   -> Ppcmd_comment (to_list to_string (singleton args))
+    | x           -> raise (Marshal_error("*ppdoc",PCData x))
+  ) xpp
+
+let of_richpp x = Element ("richpp", [], [x])
+
+(* Run-time Selectable *)
+let of_pp (pp : Pp.t) =
+  match !msg_format with
+  | Richpp margin -> of_richpp (Richpp.richpp_of_pp margin pp)
+  | Ppcmds        -> of_pp pp
 
 let of_value f = function
 | Good x -> Element ("value", ["val", "good"], [f x])
@@ -104,7 +163,7 @@ let of_value f = function
   | None -> []
   | Some (s, e) -> [("loc_s", string_of_int s); ("loc_e", string_of_int e)] in
   let id = of_stateid id in
-  Element ("value", ["val", "fail"] @ loc, [id; of_richpp msg])
+  Element ("value", ["val", "fail"] @ loc, [id; of_pp msg])
 
 let to_value f = function
 | Element ("value", attrs, l) ->
@@ -120,7 +179,7 @@ let to_value f = function
     in
     let (id, msg) = match l with [id; msg] -> (id, msg) | _ -> raise (Marshal_error("val",PCData "no id attribute")) in
     let id = to_stateid id in
-    let msg = to_richpp msg in
+    let msg = to_pp msg    in
     Fail (id, loc, msg)
   else raise (Marshal_error("good or fail",PCData ans))
 | x -> raise (Marshal_error("value",x))
@@ -147,15 +206,15 @@ let to_evar = function
   | x -> raise (Marshal_error("evar",x))
 
 let of_goal g =
-  let hyp = of_list of_richpp g.goal_hyp in
-  let ccl = of_richpp g.goal_ccl in
+  let hyp = of_list of_pp g.goal_hyp in
+  let ccl = of_pp g.goal_ccl in
   let id = of_string g.goal_id in
   Element ("goal", [], [id; hyp; ccl])
 let to_goal = function
   | Element ("goal", [], [id; hyp; ccl]) ->
-    let hyp = to_list to_richpp hyp in
-    let ccl = to_richpp ccl in
-    let id = to_string id in
+    let hyp = to_list to_pp hyp in
+    let ccl = to_pp ccl         in
+    let id  = to_string id      in
     { goal_hyp = hyp; goal_ccl = ccl; goal_id = id; }
   | x -> raise (Marshal_error("goal",x))
 
@@ -219,6 +278,7 @@ module ReifType : sig
   val coq_info_t     : coq_info val_t
   val coq_object_t   : 'a val_t -> 'a coq_object val_t
   val state_id_t     : state_id val_t
+  val route_id_t     : route_id val_t
   val search_cst_t   : search_constraint val_t
 
   val of_value_type : 'a val_t -> 'a -> xml
@@ -254,6 +314,7 @@ end = struct
     | Coq_info : coq_info val_t
     | Coq_object : 'a val_t -> 'a coq_object val_t
     | State_id : state_id val_t
+    | Route_id : route_id val_t
     | Search_cst : search_constraint val_t
 
   type value_type = Value_type : 'a val_t -> value_type
@@ -279,6 +340,7 @@ end = struct
   let coq_info_t     = Coq_info
   let coq_object_t x = Coq_object x
   let state_id_t     = State_id
+  let route_id_t     = Route_id
   let search_cst_t   = Search_cst
 
   let of_value_type (ty : 'a val_t) : 'a -> xml =
@@ -300,6 +362,7 @@ end = struct
       | Pair (t1,t2)  -> (of_pair (convert t1) (convert t2))
       | Union (t1,t2) -> (of_union (convert t1) (convert t2))
       | State_id      -> of_stateid
+      | Route_id      -> of_routeid
       | Search_cst    -> of_search_cst
     in
       convert ty
@@ -323,6 +386,7 @@ end = struct
       | Pair (t1,t2)  -> (to_pair (convert t1) (convert t2))
       | Union (t1,t2) -> (to_union (convert t1) (convert t2))
       | State_id      -> to_stateid
+      | Route_id      -> to_routeid
       | Search_cst    -> to_search_cst
     in
       convert ty
@@ -344,8 +408,8 @@ end = struct
         Printf.sprintf "Still focussed: [%a]." pr_focus g.bg_goals
     else
       let pr_goal { goal_hyp = hyps; goal_ccl = goal } =
-        "[" ^ String.concat "; " (List.map Richpp.raw_print hyps) ^ " |- " ^
-            Richpp.raw_print goal ^ "]" in
+        "[" ^ String.concat "; " (List.map Pp.string_of_ppcmds hyps) ^ " |- " ^
+            Pp.string_of_ppcmds goal ^ "]" in
       String.concat " " (List.map pr_goal g.fg_goals)
   let pr_evar (e : evar) = "[" ^ e.evar_info ^ "]"
   let pr_status (s : status) =
@@ -400,6 +464,7 @@ end = struct
   | Pair (t1,t2)  -> (pr_pair (print t1) (print t2))
   | Union (t1,t2) -> (pr_union (print t1) (print t2))
   | State_id      -> pr_state_id
+  | Route_id      -> pr_int
 
   (* This is to break if a rename/refactoring makes the strings below outdated *)
   type 'a exists = bool
@@ -425,6 +490,7 @@ end = struct
   | Union (t1,t2) -> assert(true : ('a,'b) CSig.union exists);
                      Printf.sprintf "((%s, %s) CSig.union)" (print_val_t t1) (print_val_t t2)
   | State_id      -> assert(true : Stateid.t exists); "Stateid.t"
+  | Route_id      -> assert(true : route_id exists); "route_id"
 
   let print_type = function Value_type ty -> print_val_t ty
 
@@ -456,7 +522,7 @@ open ReifType
 let add_sty_t : add_sty val_t =
   pair_t (pair_t string_t int_t) (pair_t state_id_t bool_t)
 let edit_at_sty_t : edit_at_sty val_t = state_id_t
-let query_sty_t : query_sty val_t = pair_t string_t state_id_t
+let query_sty_t : query_sty val_t = pair_t route_id_t (pair_t string_t state_id_t)
 let goals_sty_t : goals_sty val_t = unit_t
 let evars_sty_t : evars_sty val_t = unit_t
 let hints_sty_t : hints_sty val_t = unit_t
@@ -467,6 +533,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
@@ -478,7 +545,7 @@ let add_rty_t : add_rty val_t =
   pair_t state_id_t (pair_t (union_t unit_t state_id_t) string_t)
 let edit_at_rty_t : edit_at_rty val_t =
   union_t unit_t (pair_t state_id_t (pair_t state_id_t state_id_t))
-let query_rty_t : query_rty val_t = string_t
+let query_rty_t : query_rty val_t = unit_t
 let goals_rty_t : goals_rty val_t = option_t goals_t
 let evars_rty_t : evars_rty val_t = option_t (list_t evar_t)
 let hints_rty_t : hints_rty val_t =
@@ -491,6 +558,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)
@@ -512,6 +580,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;
@@ -536,6 +605,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
@@ -554,12 +625,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)
 
@@ -579,6 +651,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
@@ -600,6 +673,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)
@@ -624,6 +698,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     )
@@ -631,6 +706,9 @@ let of_answer : type a. a call -> a value -> xml = function
   | PrintAst _   -> of_value (of_value_type print_ast_rty_t  )
   | Annotate _   -> of_value (of_value_type annotate_rty_t   )
 
+let of_answer msg_fmt =
+  msg_format := msg_fmt; of_answer
+
 let to_answer : type a. a call -> xml -> a value = function
   | Add _        -> to_value (to_value_type add_rty_t        )
   | Edit_at _    -> to_value (to_value_type edit_at_rty_t    )
@@ -644,6 +722,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     )
@@ -666,6 +745,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)
@@ -689,6 +769,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))
@@ -701,10 +782,10 @@ let to_call : xml -> unknown_call =
 
 let pr_value_gen pr = function
   | Good v -> "GOOD " ^ pr v
-  | Fail (id,None,str) -> "FAIL "^Stateid.to_string id^" ["^Richpp.raw_print str^"]"
+  | Fail (id,None,str) -> "FAIL "^Stateid.to_string id^" ["^ Pp.string_of_ppcmds str ^ "]"
   | Fail (id,Some(i,j),str) ->
       "FAIL "^Stateid.to_string id^
-        " ("^string_of_int i^","^string_of_int j^")["^Richpp.raw_print str^"]"
+        " ("^string_of_int i^","^string_of_int j^")["^Pp.string_of_ppcmds str^"]"
 let pr_value v = pr_value_gen (fun _ -> "FIXME") v
 let pr_full_value : type a. a call -> a value -> string = fun call value -> match call with
   | Add _        -> pr_value_gen (print add_rty_t        ) value
@@ -719,6 +800,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
@@ -740,6 +822,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
@@ -760,7 +843,7 @@ let document to_string_fmt =
     (to_string_fmt (of_value (fun _ -> PCData "b") (Good ())));
   Printf.printf "or:\n\n%s\n\nwhere the attributes loc_s and loc_c are optional.\n"
     (to_string_fmt (of_value (fun _ -> PCData "b")
-      (Fail (Stateid.initial,Some (15,34),Richpp.richpp_of_string "error message"))));
+      (Fail (Stateid.initial,Some (15,34), Pp.str "error message"))));
   document_type_encoding to_string_fmt
 
 (* Moved from feedback.mli : This is IDE specific and we don't want to
@@ -787,20 +870,14 @@ let to_message_level =
 let of_message lvl loc msg =
   let lvl     = of_message_level lvl in
   let xloc    = of_option of_loc loc in
-  let content = of_richpp msg        in
+  let content = of_pp msg            in
   Xml_datatype.Element ("message", [], [lvl; xloc; content])
 
 let to_message xml = match xml with
   | Xml_datatype.Element ("message", [], [lvl; xloc; content]) ->
-      Message(to_message_level lvl, to_option to_loc xloc, to_richpp content)
+      Message(to_message_level lvl, to_option to_loc xloc, to_pp content)
   | x -> raise (Marshal_error("message",x))
 
-let is_message xml =
-  try begin match to_message xml with
-    | Message(l,c,m) -> Some (l,c,m)
-    | _              -> None
-  end with | Marshal_error _ -> None
-
 let to_feedback_content = do_match "feedback_content" (fun s a -> match s,a with
   | "addedaxiom", _ -> AddedAxiom
   | "processed", _ -> Processed
@@ -816,8 +893,7 @@ let to_feedback_content = do_match "feedback_content" (fun s a -> match s,a with
   | "workerstatus", [ns] ->
        let n, s = to_pair to_string to_string ns in
        WorkerStatus(n,s)
-  | "goals", [loc;s] -> Goals (to_loc loc, to_string s)
-  | "custom", [loc;name;x]-> Custom (to_loc loc, to_string name, x)
+  | "custom", [loc;name;x]-> Custom (to_option to_loc loc, to_string name, x)
   | "filedependency", [from; dep] ->
       FileDependency (to_option to_string from, to_string dep)
   | "fileloaded", [dirpath; filename] ->
@@ -849,10 +925,8 @@ let of_feedback_content = function
   | WorkerStatus(n,s) ->
       constructor "feedback_content" "workerstatus"
         [of_pair of_string of_string (n,s)]
-  | Goals (loc,s) ->
-      constructor "feedback_content" "goals" [of_loc loc;of_string s]
   | Custom (loc, name, x) ->
-      constructor "feedback_content" "custom" [of_loc loc; of_string name; x]
+      constructor "feedback_content" "custom" [of_option of_loc loc; of_string name; x]
   | FileDependency (from, depends_on) ->
       constructor "feedback_content" "filedependency" [
         of_option of_string from;
@@ -863,23 +937,21 @@ let of_feedback_content = function
         of_string filename ]
   | Message (l,loc,m) -> constructor "feedback_content" "message" [ of_message l loc m ]
 
-let of_edit_or_state_id = function
-  | Edit id -> ["object","edit"], of_edit_id id
-  | State id -> ["object","state"], of_stateid id
+let of_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])
 
+let of_feedback msg_fmt =
+  msg_format := msg_fmt; of_feedback
+
 let to_feedback xml = match xml with
-  | Element ("feedback", ["object","edit";"route",route], [id;content]) -> {
-      id = Edit(to_edit_id id);
-      route = int_of_string route;
-      contents = to_feedback_content content }
-  | Element ("feedback", ["object","state";"route",route], [id;content]) -> { 
-      id = State(to_stateid id);
+  | 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 1bb99897..ba6000f0 100644
--- a/ide/xmlprotocol.mli
+++ b/ide/xmlprotocol.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Applicative part of the interface of CoqIde calls to Coq *)
@@ -29,6 +31,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
@@ -40,12 +44,17 @@ val abstract_eval_call : handler -> 'a call -> 'a value
 
 val protocol_version : string
 
+(** By default, we still output messages in Richpp so we are
+    compatible with 8.6, however, 8.7 aware clients will want to
+    set this to Ppcmds *)
+type msg_format = Richpp of int | Ppcmds
+
 (** * XML data marshalling *)
 
 val of_call : 'a call -> xml
 val to_call : xml -> unknown_call
 
-val of_answer : 'a call -> 'a value -> xml
+val of_answer : msg_format -> 'a call -> 'a value -> xml
 val to_answer : 'a call -> xml -> 'a value
 
 (* Prints the documentation of this module *)
@@ -57,16 +66,8 @@ val pr_call : 'a call -> string
 val pr_value : 'a value -> string
 val pr_full_value : 'a call -> 'a value -> string
 
-(** * Serialization of rich documents *)
-val of_richpp : Richpp.richpp -> Xml_datatype.xml
-val to_richpp : Xml_datatype.xml -> Richpp.richpp
-
 (** * Serializaiton of feedback  *)
-val of_feedback : Feedback.feedback -> xml
+val of_feedback : msg_format -> Feedback.feedback -> xml
 val to_feedback : xml -> Feedback.feedback
-val is_feedback : xml -> bool
-
-val is_message : xml -> (Feedback.level * Loc.t option * Richpp.richpp) option
-val of_message : Feedback.level -> Loc.t option -> Richpp.richpp -> xml
-(* val to_message : xml -> Feedback.message *)
 
+val is_feedback : xml -> bool
diff --git a/install.sh b/install.sh
index c5835b01..4f60080a 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) 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/constrarg.ml b/interp/constrarg.ml
deleted file mode 100644
index ca828102..00000000
--- a/interp/constrarg.ml
+++ /dev/null
@@ -1,74 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Loc
-open Tacexpr
-open Misctypes
-open Genarg
-open Geninterp
-
-let make0 ?dyn name =
-  let wit = Genarg.make0 name in
-  let () = Geninterp.register_val0 wit dyn in
-  wit
-
-(** This is a hack for now, to break the dependency of Genarg on constr-related
-    types. We should use dedicated functions someday. *)
-
-let loc_of_or_by_notation f = function
-  | AN c -> f c
-  | ByNotation (loc,s,_) -> loc
-
-let wit_int_or_var =
-  make0 ~dyn:(val_tag (topwit Stdarg.wit_int)) "int_or_var"
-
-let wit_intro_pattern : (Constrexpr.constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type =
-  make0 "intropattern"
-
-let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
-  make0 "tactic"
-
-let wit_ltac = make0 ~dyn:(val_tag (topwit Stdarg.wit_unit)) "ltac"
-
-let wit_ident =
-  make0 "ident"
-
-let wit_var =
-  make0 ~dyn:(val_tag (topwit wit_ident)) "var"
-
-let wit_ref = make0 "ref"
-
-let wit_quant_hyp = make0 "quant_hyp"
-
-let wit_constr =
-  make0 "constr"
-
-let wit_uconstr = make0 "uconstr"
-
-let wit_open_constr = make0 ~dyn:(val_tag (topwit wit_constr)) "open_constr"
-
-let wit_constr_with_bindings = make0 "constr_with_bindings"
-
-let wit_bindings = make0 "bindings"
-
-let wit_red_expr = make0 "redexpr"
-
-let wit_clause_dft_concl  =
-  make0 "clause_dft_concl"
-
-let wit_destruction_arg =
-  make0 "destruction_arg"
-
-(** Aliases *)
-
-let wit_reference = wit_ref
-let wit_global = wit_ref
-let wit_clause = wit_clause_dft_concl
-let wit_quantified_hypothesis = wit_quant_hyp
-let wit_intropattern = wit_intro_pattern
-let wit_redexpr = wit_red_expr
diff --git a/interp/constrarg.mli b/interp/constrarg.mli
deleted file mode 100644
index 6ccd944d..00000000
--- a/interp/constrarg.mli
+++ /dev/null
@@ -1,87 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Generic arguments based on [constr]. We put them here to avoid a dependency
-    of Genarg in [constr]-related interfaces. *)
-
-open Loc
-open Names
-open Term
-open Libnames
-open Globnames
-open Genredexpr
-open Pattern
-open Constrexpr
-open Tacexpr
-open Misctypes
-open Genarg
-
-(** FIXME: nothing to do there. *)
-val loc_of_or_by_notation : ('a -> Loc.t) -> 'a or_by_notation -> Loc.t
-
-(** {5 Additional generic arguments} *)
-
-val wit_int_or_var : (int or_var, int or_var, int) genarg_type
-
-val wit_intro_pattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type
-
-val wit_ident : Id.t uniform_genarg_type
-
-val wit_var : (Id.t located, Id.t located, Id.t) genarg_type
-
-val wit_ref : (reference, global_reference located or_var, global_reference) genarg_type
-
-val wit_quant_hyp : quantified_hypothesis uniform_genarg_type
-
-val wit_constr : (constr_expr, glob_constr_and_expr, constr) genarg_type
-
-val wit_uconstr : (constr_expr , glob_constr_and_expr, Glob_term.closed_glob_constr) genarg_type
-
-val wit_open_constr :
-  (constr_expr, glob_constr_and_expr, constr) genarg_type
-
-val wit_constr_with_bindings :
-  (constr_expr with_bindings,
-  glob_constr_and_expr with_bindings,
-  constr with_bindings delayed_open) genarg_type
-
-val wit_bindings :
-  (constr_expr bindings,
-  glob_constr_and_expr bindings,
-  constr bindings delayed_open) genarg_type
-
-val wit_red_expr :
-  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
-  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
-  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
-
-val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Geninterp.Val.t) genarg_type
-
-(** [wit_ltac] is subtly different from [wit_tactic]: they only change for their
-    toplevel interpretation. The one of [wit_ltac] forces the tactic and
-    discards the result. *)
-val wit_ltac : (raw_tactic_expr, glob_tactic_expr, unit) genarg_type
-
-val wit_clause_dft_concl :  (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) genarg_type
-
-val wit_destruction_arg :
-  (constr_expr with_bindings destruction_arg,
-   glob_constr_and_expr with_bindings destruction_arg,
-   delayed_open_constr_with_bindings destruction_arg) genarg_type
-
-(** Aliases for compatibility *)
-
-val wit_reference : (reference, global_reference located or_var, global_reference) genarg_type
-val wit_global : (reference, global_reference located or_var, global_reference) genarg_type
-val wit_clause :  (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) genarg_type
-val wit_quantified_hypothesis : quantified_hypothesis uniform_genarg_type
-val wit_intropattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type
-val wit_redexpr :
-  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
-  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
-  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml
index 04429851..004c9356 100644
--- a/interp/constrexpr_ops.ml
+++ b/interp/constrexpr_ops.ml
@@ -1,14 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open Util
+open CAst
 open Names
+open Nameops
 open Libnames
 open Constrexpr
 open Misctypes
@@ -37,16 +41,19 @@ let binder_kind_eq b1 b2 = match b1, b2 with
 let default_binder_kind = Default Explicit
 
 let names_of_local_assums bl =
-  List.flatten (List.map (function LocalRawAssum(l,_,_)->l|_->[]) bl)
+  List.flatten (List.map (function CLocalAssum(l,_,_)->l|_->[]) bl)
 
 let names_of_local_binders bl =
-  List.flatten (List.map (function LocalRawAssum(l,_,_)->l|LocalRawDef(l,_)->[l]|LocalPattern _ -> assert false) bl)
+  List.flatten (List.map (function CLocalAssum(l,_,_)->l|CLocalDef(l,_,_)->[l]|CLocalPattern _ -> assert false) bl)
 
 (**********************************************************************)
 (* Functions on constr_expr *)
 
+(* Note: redundant Numeral representations such as -0 and +0 (or different
+   numbers of leading zeros) are considered different here. *)
+
 let prim_token_eq t1 t2 = match t1, t2 with
-| Numeral i1, Numeral i2 -> Bigint.equal i1 i2
+| Numeral (n1,s1), Numeral (n2,s2) -> String.equal n1 n2 && s1 == s2
 | String s1, String s2 -> String.equal s1 s2
 | _ -> false
 
@@ -57,34 +64,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 p1 == p2 then true
-  else match p1, p2 with
-  | CPatAlias(_,a1,i1), CPatAlias(_,a2,i2) ->
-      Id.equal i1 i2 && cases_pattern_expr_eq a1 a2
-  | CPatCstr(_,c1,a1,b1), CPatCstr(_,c2,a2,b2) ->
+  if CAst.(p1.v == p2.v) then true
+  else match CAst.(p1.v, p2.v) with
+  | CPatAlias(a1,i1), CPatAlias(a2,i2) ->
+      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
-  | CPatOr (_, a1), CPatOr (_, a2) ->
-      List.equal cases_pattern_expr_eq a1 a2
-  | CPatNotation (_, n1, s1, l1), CPatNotation (_, n2, s2, l2) ->
+  | CPatAtom(r1), CPatAtom(r2) ->
+    Option.equal eq_reference r1 r2
+  | CPatOr a1, CPatOr 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
-  | 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
-  | CPatDelimiters(_,s1,e1), CPatDelimiters(_,s2,e2) ->
-      String.equal s1 s2 && cases_pattern_expr_eq e1 e2
+  | CPatPrim i1, CPatPrim 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
+  | CPatDelimiters(s1,e1), CPatDelimiters(s2,e2) ->
+    String.equal s1 s2 && cases_pattern_expr_eq e1 e2
   | _ -> false
 
 and cases_pattern_notation_substitution_eq (s1, n1) (s2, n2) =
@@ -98,302 +105,497 @@ let eq_universes u1 u2 =
   | _, _ -> false
 
 let rec constr_expr_eq e1 e2 =
-  if e1 == e2 then true
-  else match e1, e2 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 &&
+  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_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,b1), CLetIn(_,(_,na2),a2,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
+  | (CRef _ | CFix _ | CCoFix _ | CProdN _ | CLambdaN _ | CLetIn _ | CAppExpl _
+     | CApp _ | CRecord _ | CCases _ | CLetTuple _ | CIf _ | CHole _
+     | CPatVar _ | CEvar _ | CSort _ | CCast _ | CNotation _ | CPrim _
+     | CGeneralization _ | CDelimiters _), _ -> 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
-| LocalRawDef (n1, e1), LocalRawDef (n2, e2) ->
-  eq_located Name.equal n1 n2 && constr_expr_eq e1 e2
-| LocalRawAssum (n1, _, e1), LocalRawAssum (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
 
-let constr_loc = function
-  | CRef (Ident (loc,_),_) -> loc
-  | CRef (Qualid (loc,_),_) -> loc
-  | CFix (loc,_,_) -> loc
-  | CCoFix (loc,_,_) -> loc
-  | CProdN (loc,_,_) -> loc
-  | CLambdaN (loc,_,_) -> loc
-  | CLetIn (loc,_,_,_) -> loc
-  | CAppExpl (loc,_,_) -> loc
-  | CApp (loc,_,_) -> loc
-  | CRecord (loc,_) -> loc
-  | CCases (loc,_,_,_,_) -> loc
-  | CLetTuple (loc,_,_,_,_) -> loc
-  | CIf (loc,_,_,_,_) -> loc
-  | CHole (loc,_,_,_) -> loc
-  | CPatVar (loc,_) -> loc
-  | CEvar (loc,_,_) -> loc
-  | CSort (loc,_) -> loc
-  | CCast (loc,_,_) -> loc
-  | CNotation (loc,_,_) -> loc
-  | CGeneralization (loc,_,_,_) -> loc
-  | CPrim (loc,_) -> loc
-  | CDelimiters (loc,_,_) -> loc
-
-let cases_pattern_expr_loc = function
-  | CPatAlias (loc,_,_) -> loc
-  | CPatCstr (loc,_,_,_) -> loc
-  | CPatAtom (loc,_) -> loc
-  | CPatOr (loc,_) -> loc
-  | CPatNotation (loc,_,_,_) -> loc
-  | CPatRecord (loc, _) -> loc
-  | CPatPrim (loc,_) -> loc
-  | CPatDelimiters (loc,_,_) -> loc
-  | CPatCast(loc,_,_) -> loc
-
-let raw_cases_pattern_expr_loc = function
-  | RCPatAlias (loc,_,_) -> loc
-  | RCPatCstr (loc,_,_,_) -> loc
-  | RCPatAtom (loc,_) -> loc
-  | RCPatOr (loc,_) -> loc
-
-let local_binder_loc = function
-  | LocalRawAssum ((loc,_)::_,_,t)
-  | LocalRawDef ((loc,_),t) -> Loc.merge loc (constr_loc t)
-  | LocalRawAssum ([],_,_) -> assert false
-  | LocalPattern (loc,_,_) -> loc
+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 = 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
 
 let local_binders_loc bll = match bll with
-  | [] -> Loc.ghost
-  | h :: l ->
-    Loc.merge (local_binder_loc h) (local_binder_loc (List.last bll))
+  | []     -> 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 {v=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
+  )
+
+let free_vars_of_constr_expr c =
+  let rec aux bdvars l = function
+    | { CAst.v = CRef ({v=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)
+  )
+
+(* Used in constrintern *)
+let rec replace_vars_constr_expr l = function
+  | { CAst.loc; v = CRef ({v=Ident id},us) } as x ->
+    (try CAst.make ?loc @@ CRef (make ?loc @@ Ident (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  = CRef (Ident (Loc.ghost, id),None)
-let mkRefC r     = CRef (r,None)
-let mkCastC (a,k)  = CCast (Loc.ghost,a,k)
-let mkLambdaC (idl,bk,a,b) = CLambdaN (Loc.ghost,[idl,bk,a],b)
-let mkLetInC (id,a,b)   = CLetIn (Loc.ghost,id,a,b)
-let mkProdC (idl,bk,a,b)   = CProdN (Loc.ghost,[idl,bk,a],b)
+let mkIdentC id   = CAst.make @@ CRef (make @@ Ident 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 ([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 ([CLocalAssum (idl,bk,a)],b)
 
 let mkAppC (f,l) =
   let l = List.map (fun x -> (x,None)) l in
-  match f with
-  | CApp (_,g,l') -> CApp (Loc.ghost, g, l' @ l)
-  | _ -> CApp (Loc.ghost, (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_pattern_binders mkC bl c =
-  let rec loop bl c =
-    match bl with
-    | [] -> ([], [], c)
-    | b :: bl ->
-        let (env, bl, c) = loop bl c in
-        match b with
-        | LocalRawDef (n, _) ->
-            let env = add_name_in_env env n in
-            (env, b :: bl, c)
-        | LocalRawAssum (nl, _, _) ->
-            let env = List.fold_left add_name_in_env env nl in
-            (env, b :: bl, c)
-        | LocalPattern (loc, p, ty) ->
-            let ni = Hook.get fresh_var env c in
-            let id = (loc, Name ni) in
-            let b =
-              LocalRawAssum
-                ([id], Default Explicit,
-                 match ty with
-                 | Some ty -> ty
-                 | None -> CHole (loc, None, IntroAnonymous, None))
-            in
-            let e = CRef (Libnames.Ident (loc, ni), None) in
-            let c =
-              CCases
-                (loc, LetPatternStyle, None, [(e,None,None)],
-                 [(loc, [(loc,[p])], mkC loc bl c)])
-            in
-            (ni :: env, [b], c)
-  in
-  let (_, bl, c) = loop bl c in
-  (bl, c)
-
-let mkCProdN loc bll c =
-  let rec loop loc bll c =
-    match bll with
-    | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
-        CProdN (loc,[idl,bk,t],loop (Loc.merge loc1 loc) bll c)
-    | LocalRawDef ((loc1,_) as id,b) :: bll ->
-        CLetIn (loc,id,b,loop (Loc.merge loc1 loc) bll c)
-    | [] -> c
-    | LocalRawAssum ([],_,_) :: bll -> loop loc bll c
-    | LocalPattern (loc,p,ty) :: bll -> assert false
-  in
-  let (bll, c) = expand_pattern_binders loop bll c in
-  loop loc bll c
-
-let mkCLambdaN loc bll c =
-  let rec loop loc bll c =
-    match bll with
-    | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
-        CLambdaN (loc,[idl,bk,t],loop (Loc.merge loc1 loc) bll c)
-    | LocalRawDef ((loc1,_) as id,b) :: bll ->
-        CLetIn (loc,id,b,loop (Loc.merge loc1 loc) bll c)
-    | [] -> c
-    | LocalRawAssum ([],_,_) :: bll -> loop loc bll c
-    | LocalPattern (loc,p,ty) :: bll -> assert false
-  in
-  let (bll, c) = expand_pattern_binders loop bll c in
-  loop loc bll c
-
-let rec abstract_constr_expr c = function
-  | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,abstract_constr_expr c bl)
-  | LocalRawAssum (idl,bk,t)::bl ->
-      List.fold_right (fun x b -> mkLambdaC([x],bk,t,b)) idl
-      (abstract_constr_expr c bl)
-  | LocalPattern _::_ -> assert false
-
-let rec prod_constr_expr c = function
-  | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,prod_constr_expr c bl)
-  | LocalRawAssum (idl,bk,t)::bl ->
-      List.fold_right (fun x b -> mkProdC([x],bk,t,b)) idl
-      (prod_constr_expr c bl)
-  | LocalPattern _::_ -> assert false
-
-let coerce_reference_to_id = function
-  | Ident (_,id) -> id
-  | Qualid (loc,_) ->
-      CErrors.user_err_loc (loc, "coerce_reference_to_id",
-        str "This expression should be a simple identifier.")
+  match CAst.(f.v) with
+  | CApp (g,l') -> CAst.make @@ CApp (g, l' @ l)
+  | _           -> CAst.make @@ CApp ((None, f), l)
+
+let mkCProdN ?loc bll c =
+  CAst.make ?loc @@ CProdN (bll,c)
+
+let mkCLambdaN ?loc bll c =
+  CAst.make ?loc @@ CLambdaN (bll,c)
+
+let coerce_reference_to_id = CAst.with_loc_val (fun ?loc -> function
+  | Ident id -> id
+  | Qualid _ ->
+    CErrors.user_err ?loc ~hdr:"coerce_reference_to_id"
+      (str "This expression should be a simple identifier."))
 
 let coerce_to_id = function
-  | CRef (Ident (loc,id),_) -> (loc,id)
-  | a -> CErrors.user_err_loc
-        (constr_loc a,"coerce_to_id",
-         str "This expression should be a simple identifier.")
+  | { CAst.loc; v = CRef ({v=Ident id},None) } -> CAst.make ?loc id
+  | { CAst.loc; _ } -> CErrors.user_err ?loc
+                         ~hdr:"coerce_to_id"
+                         (str "This expression should be a simple identifier.")
 
 let coerce_to_name = function
-  | CRef (Ident (loc,id),_) -> (loc,Name id)
-  | CHole (loc,_,_,_) -> (loc,Anonymous)
-  | a -> CErrors.user_err_loc
-        (constr_loc a,"coerce_to_name",
-         str "This expression should be a name.")
+  | { CAst.loc; v = CRef ({v=Ident id},None) } -> CAst.make ?loc @@ Name id
+  | { CAst.loc; 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 ({v=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 a92da035..d038bd71 100644
--- a/interp/constrexpr_ops.mli
+++ b/interp/constrexpr_ops.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Loc
 open Names
 open Libnames
 open Misctypes
@@ -23,8 +24,8 @@ val constr_expr_eq : constr_expr -> constr_expr -> bool
 (** Equality on [constr_expr]. This is a syntactical one, which is oblivious to
     some parsing details, including locations. *)
 
-val local_binder_eq : local_binder -> local_binder -> bool
-(** Equality on [local_binder]. Same properties as [constr_expr_eq]. *)
+val local_binder_eq : local_binder_expr -> local_binder_expr -> bool
+(** Equality on [local_binder_expr]. Same properties as [constr_expr_eq]. *)
 
 val binding_kind_eq : Decl_kinds.binding_kind -> Decl_kinds.binding_kind -> bool
 (** Equality on [binding_kind] *)
@@ -34,10 +35,9 @@ val binder_kind_eq : binder_kind -> binder_kind -> bool
 
 (** {6 Retrieving locations} *)
 
-val constr_loc : constr_expr -> Loc.t
-val cases_pattern_expr_loc : cases_pattern_expr -> Loc.t
-val raw_cases_pattern_expr_loc : raw_cases_pattern_expr -> Loc.t
-val local_binders_loc : local_binder list -> Loc.t
+val constr_loc : constr_expr -> Loc.t option
+val cases_pattern_expr_loc : cases_pattern_expr -> Loc.t option
+val local_binders_loc : local_binder_expr list -> Loc.t option
 
 (** {6 Constructors}*)
 
@@ -45,42 +45,82 @@ 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 -> 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 abstract_constr_expr : constr_expr -> local_binder list -> constr_expr
-val prod_constr_expr : constr_expr -> local_binder list -> constr_expr
-
-val mkCLambdaN : Loc.t -> local_binder list -> constr_expr -> constr_expr
+val mkCLambdaN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr
 (** Same as [abstract_constr_expr], with location *)
 
-val mkCProdN : Loc.t -> local_binder list -> constr_expr -> constr_expr
+val mkCProdN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr
 (** Same as [prod_constr_expr], with location *)
 
-val fresh_var_hook : (Names.Id.t list -> Constrexpr.constr_expr -> Names.Id.t) Hook.t
-val expand_pattern_binders :
-  (Loc.t -> local_binder list -> constr_expr -> constr_expr) ->
-  local_binder list -> constr_expr -> local_binder list * constr_expr
+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
+[@@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 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 list -> Name.t located list
-(** Same as [names_of_local_binders], but does not take the [let] bindings into
+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 dd8a48b8..af44921e 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -12,15 +14,15 @@ open CErrors
 open Util
 open Names
 open Nameops
-open Term
+open Constr
 open Termops
 open Libnames
 open Globnames
 open Impargs
+open CAst
 open Constrexpr
 open Constrexpr_ops
 open Notation_ops
-open Topconstr
 open Glob_term
 open Glob_ops
 open Pattern
@@ -65,26 +67,145 @@ let print_universes = Detyping.print_universes
 (* This suppresses printing of primitive tokens (e.g. numeral) and notations *)
 let print_no_symbol = ref false
 
-(* This tells which notations still not to used if print_no_symbol is true *)
-let print_non_active_notations = ref ([] : interp_rule list)
+(**********************************************************************)
+(* Turning notations and scopes on and off for printing *)
+module IRuleSet = Set.Make(struct
+    type t = interp_rule
+    let compare x y = Pervasives.compare x y
+  end)
+
+let inactive_notations_table =
+  Summary.ref ~name:"inactive_notations_table" (IRuleSet.empty)
+let inactive_scopes_table    =
+  Summary.ref ~name:"inactive_scopes_table" CString.Set.empty
+
+let show_scope scopt =
+  match scopt with
+  | None -> str ""
+  | Some sc -> spc () ++ str "in scope" ++ spc () ++ str sc
+
+let _show_inactive_notations () =
+  begin
+    if CString.Set.is_empty !inactive_scopes_table
+    then
+      Feedback.msg_notice (str "No inactive notation scopes.")
+    else
+      let _ = Feedback.msg_notice (str "Inactive notation scopes:") in
+      CString.Set.iter (fun sc -> Feedback.msg_notice (str "  " ++ str sc))
+        !inactive_scopes_table
+  end;
+  if IRuleSet.is_empty !inactive_notations_table
+  then
+    Feedback.msg_notice (str "No individual inactive notations.")
+  else
+    let _ = Feedback.msg_notice (str "Inactive notations:") in
+    IRuleSet.iter
+      (function
+       | NotationRule (scopt, ntn) ->
+         Feedback.msg_notice (str ntn ++ show_scope scopt)
+       | SynDefRule kn -> Feedback.msg_notice (str (Names.KerName.to_string kn)))
+      !inactive_notations_table
+
+let deactivate_notation nr =
+  match nr with
+  | SynDefRule kn ->
+     (* shouldn't we check wether it is well defined? *)
+     inactive_notations_table := IRuleSet.add nr !inactive_notations_table
+  | NotationRule (scopt, ntn) ->
+     match availability_of_notation (scopt, ntn) (scopt, []) with
+     | None -> user_err ~hdr:"Notation"
+                        (str ntn ++ spc () ++ str "does not exist"
+                         ++ (match scopt with
+                             | None -> spc () ++ str "in the empty scope."
+                             | Some _ -> show_scope scopt ++ str "."))
+     | Some _ ->
+        if IRuleSet.mem nr !inactive_notations_table then
+          Feedback.msg_warning
+            (str "Notation" ++ spc () ++ str ntn ++ spc ()
+             ++ str "is already inactive" ++ show_scope scopt ++ str ".")
+        else inactive_notations_table := IRuleSet.add nr !inactive_notations_table
+
+let reactivate_notation nr =
+  try
+    inactive_notations_table :=
+      IRuleSet.remove nr !inactive_notations_table
+  with Not_found ->
+    match nr with
+    | NotationRule (scopt, ntn) ->
+       Feedback.msg_warning (str "Notation" ++ spc () ++ str ntn ++ spc ()
+                             ++ str "is already active" ++ show_scope scopt ++
+  str ".")
+    | SynDefRule kn ->
+       Feedback.msg_warning
+         (str "Notation" ++ spc () ++ str (Names.KerName.to_string kn)
+          ++ spc () ++ str "is already active.")
+
+
+let deactivate_scope sc =
+  ignore (find_scope sc); (* ensures that the scope exists *)
+  if CString.Set.mem sc !inactive_scopes_table
+  then
+    Feedback.msg_warning (str "Notation Scope" ++ spc () ++ str sc ++ spc ()
+                          ++ str "is already inactive.")
+  else
+    inactive_scopes_table := CString.Set.add sc !inactive_scopes_table
+
+let reactivate_scope sc =
+  try
+    inactive_scopes_table := CString.Set.remove sc !inactive_scopes_table
+  with Not_found ->
+    Feedback.msg_warning (str "Notation Scope" ++ spc () ++ str sc ++ spc ()
+                          ++ str "is already active.")
+
+let is_inactive_rule nr =
+  IRuleSet.mem nr !inactive_notations_table ||
+  match nr with
+    | NotationRule (Some sc, ntn) -> CString.Set.mem sc !inactive_scopes_table
+    | NotationRule (None, ntn) -> false
+    | SynDefRule _ -> false
+
+(* args: notation, scope, activate/deactivate *)
+let toggle_scope_printing ~scope ~activate =
+  if activate then
+    reactivate_scope scope
+  else
+    deactivate_scope scope
+
+let toggle_notation_printing ?scope ~notation ~activate =
+  if activate then
+    reactivate_notation (NotationRule (scope, notation))
+  else
+    deactivate_notation (NotationRule (scope, notation))
 
 (* This governs printing of projections using the dot notation symbols *)
 let print_projections = ref false
 
 let print_meta_as_hole = ref false
 
-let with_arguments f = Flags.with_option print_arguments f
-let with_implicits f = Flags.with_option print_implicits f
-let with_coercions f = Flags.with_option print_coercions f
 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
-let without_specific_symbols l f =
-  Flags.with_extra_values print_non_active_notations l f
+
+let without_specific_symbols l =
+  Flags.with_modified_ref inactive_notations_table
+    (fun tbl -> IRuleSet.(union (of_list l) tbl))
 
 (**********************************************************************)
 (* Control printing of records *)
 
+(* Set Record Printing flag *)
+let record_print = ref true
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "record printing";
+      optkey   = ["Printing";"Records"];
+      optread  = (fun () -> !record_print);
+      optwrite = (fun b -> record_print := b) }
+
+
 let is_record indsp =
   try
     let _ = Recordops.lookup_structure indsp in
@@ -94,8 +215,8 @@ let is_record indsp =
 let encode_record r =
   let indsp = global_inductive r in
   if not (is_record indsp) then
-    user_err_loc (loc_of_reference r,"encode_record",
-    str "This type is not a structure type.");
+    user_err ?loc:r.CAst.loc ~hdr:"encode_record"
+      (str "This type is not a structure type.");
   indsp
 
 module PrintingRecordRecord =
@@ -130,45 +251,45 @@ module PrintingConstructor = Goptions.MakeRefTable(PrintingRecordConstructor)
 
 let insert_delimiters e = function
   | None -> e
-  | Some sc -> CDelimiters (Loc.ghost,sc,e)
+  | Some sc -> CAst.make @@ CDelimiters (sc,e)
 
-let insert_pat_delimiters loc p = function
+let insert_pat_delimiters ?loc p = function
   | None -> p
-  | Some sc -> CPatDelimiters (loc,sc,p)
+  | Some sc -> CAst.make ?loc @@ CPatDelimiters (sc,p)
 
-let insert_pat_alias loc p = function
+let insert_pat_alias ?loc p = function
   | Anonymous -> p
-  | Name id -> CPatAlias (loc,p,id)
+  | Name _ as na -> CAst.make ?loc @@ CPatAlias (p,(CAst.make ?loc na))
 
 (**********************************************************************)
 (* conversion of references                                           *)
 
-let extern_evar loc n l = CEvar (loc,n,l)
+let extern_evar n l = CEvar (n,l)
 
 (** We allow customization of the global_reference printer.
     For instance, in the debugger the tables of global references
     may be inaccurate *)
 
-let default_extern_reference loc vars r =
-  Qualid (loc,shortest_qualid_of_global vars r)
+let default_extern_reference ?loc vars r =
+  make @@ Qualid (shortest_qualid_of_global vars r)
 
 let my_extern_reference = ref default_extern_reference
 
 let set_extern_reference f = my_extern_reference := f
 let get_extern_reference () = !my_extern_reference
 
-let extern_reference loc vars l = !my_extern_reference loc vars l
+let extern_reference ?loc vars l = !my_extern_reference vars l
 
 (**********************************************************************)
 (* mapping patterns to cases_pattern_expr                                *)
 
 let add_patt_for_params ind l =
   if !Flags.in_debugger then l else
-    Util.List.addn (Inductiveops.inductive_nparamdecls ind) (CPatAtom (Loc.ghost,None)) l
+    Util.List.addn (Inductiveops.inductive_nparamdecls ind) (CAst.make @@ CPatAtom None) l
 
 let add_cpatt_for_params ind l =
   if !Flags.in_debugger then l else
-    Util.List.addn  (Inductiveops.inductive_nparamdecls ind) (PatVar (Loc.ghost,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
@@ -176,7 +297,7 @@ let drop_implicits_in_patt cst nb_expl args =
   let rec impls_fit l = function
     |[],t -> Some (List.rev_append l t)
     |_,[] -> None
-    |h::t,CPatAtom(_,None)::tt when is_status_implicit h -> impls_fit l (t,tt)
+    |h::t, { CAst.v = CPatAtom None }::tt when is_status_implicit h -> impls_fit l (t,tt)
     |h::_,_ when is_status_implicit h -> None
     |_::t,hh::tt -> impls_fit (hh::l) (t,tt)
   in let rec aux = function
@@ -190,78 +311,53 @@ let drop_implicits_in_patt cst nb_expl args =
        let imps = List.skipn_at_least nb_expl (select_stronger_impargs impl_st) in
        impls_fit [] (imps,args)
 
-let has_curly_brackets ntn =
-  String.length ntn >= 6 && (String.is_sub "{ _ } " ntn 0 ||
-    String.is_sub " { _ }" ntn (String.length ntn - 6) ||
-    String.string_contains ~where:ntn ~what:" { _ } ")
-
-let rec wildcards ntn n =
-  if Int.equal n (String.length ntn) then []
-  else let l = spaces ntn (n+1) in if ntn.[n] == '_' then n::l else l
-and spaces ntn n =
-  if Int.equal n (String.length ntn) then []
-  else if ntn.[n] == ' ' then wildcards ntn (n+1) else spaces ntn (n+1)
-
-let expand_curly_brackets loc mknot ntn l =
-  let ntn' = ref ntn in
-  let rec expand_ntn i =
-    function
-    | [] -> []
-    | a::l ->
-        let a' =
-          let p = List.nth (wildcards !ntn' 0) i - 2 in
-          if p>=0 && p+5 <= String.length !ntn' && String.is_sub "{ _ }" !ntn' p
-          then begin
-            ntn' :=
-              String.sub !ntn' 0 p ^ "_" ^
-              String.sub !ntn' (p+5) (String.length !ntn' -p-5);
-            mknot (loc,"{ _ }",[a]) end
-          else a in
-        a' :: expand_ntn (i+1) l in
-  let l = expand_ntn 0 l in
-  (* side effect *)
-  mknot (loc,!ntn',l)
-
-let destPrim = function CPrim(_,t) -> Some t | _ -> None
-let destPatPrim = function CPatPrim(_,t) -> Some t | _ -> None
-
-let make_notation_gen loc ntn mknot mkprim destprim l =
-  if has_curly_brackets ntn
-  then expand_curly_brackets loc mknot ntn l
-  else match ntn,List.map destprim l with
+let destPrim = function { CAst.v = CPrim t } -> Some t | _ -> None
+let destPatPrim = function { CAst.v = CPatPrim t } -> Some t | _ -> None
+
+let is_number s =
+  let rec aux i =
+    Int.equal (String.length s) i ||
+    match s.[i] with '0'..'9' -> aux (i+1) | _ -> false
+  in aux 0
+
+let is_zero s =
+  let rec aux i =
+    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 bl =
+  match ntn,List.map destprim l with
     (* Special case to avoid writing "- 3" for e.g. (Z.opp 3) *)
-    | "- _", [Some (Numeral p)] when Bigint.is_strictly_pos p ->
-        mknot (loc,ntn,([mknot (loc,"( _ )",l)]))
+    | "- _", [Some (Numeral (p,true))] when not (is_zero p) ->
+        assert (bl=[]);
+        mknot (loc,ntn,([mknot (loc,"( _ )",l,[])]),[])
     | _ ->
 	match decompose_notation_key ntn, l with
-	| [Terminal "-"; Terminal x], [] ->
-	    (try mkprim (loc, Numeral (Bigint.neg (Bigint.of_string x)))
-	     with Failure _ -> mknot (loc,ntn,[]))
-	| [Terminal x], [] ->
-	    (try mkprim (loc, Numeral (Bigint.of_string x))
-	     with Failure _ -> mknot (loc,ntn,[]))
-	| _ ->
-	    mknot (loc,ntn,l)
-
-let make_notation loc ntn (terms,termlists,binders as subst) =
-  if not (List.is_empty termlists) || not (List.is_empty binders) then
-    CNotation (loc,ntn,subst)
+	| [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,bl)
+
+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) -> CNotation (loc,ntn,(l,[],[])))
-      (fun (loc,p) -> CPrim (loc,p))
-      destPrim terms
+      (fun (loc,ntn,l,bl) -> CAst.make ?loc @@ CNotation (ntn,(l,[],bl,[])))
+      (fun (loc,p) -> CAst.make ?loc @@ CPrim p)
+      destPrim terms binders
 
-let make_pat_notation loc ntn (terms,termlists as subst) args =
-  if not (List.is_empty termlists) then CPatNotation (loc,ntn,subst,args) else
+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) -> CPatNotation (loc,ntn,(l,[]),args))
-    (fun (loc,p) -> CPatPrim (loc,p))
-    destPatPrim terms
+    (fun (loc,ntn,l,_) -> CAst.make ?loc @@ CPatNotation (ntn,(l,[]),args))
+    (fun (loc,p)     -> CAst.make ?loc @@ CPatPrim p)
+    destPatPrim terms []
 
-let mkPat loc qid l =
+let mkPat ?loc qid l = CAst.make ?loc @@
   (* Normally irrelevant test with v8 syntax, but let's do it anyway *)
-  if List.is_empty l then CPatAtom (loc,Some qid) else CPatCstr (loc,qid,None,l)
+  if List.is_empty l then CPatAtom (Some qid) else CPatCstr (qid,None,l)
 
 let pattern_printable_in_both_syntax (ind,_ as c) =
   let impl_st = extract_impargs_data (implicits_of_global (ConstructRef c)) in
@@ -272,67 +368,66 @@ 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 =
-  (* pboutill: There are letins in pat which is incompatible with notations and
-     not explicit application. *)
-  match pat with
-    | PatCstr(loc,cstrsp,args,na)
-	when !Flags.in_debugger||Inductiveops.constructor_has_local_defs cstrsp ->
-      let c = extern_reference loc Id.Set.empty (ConstructRef cstrsp) in
-      let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
-      CPatCstr (loc, c, Some (add_patt_for_params (fst cstrsp) args), [])
-    | _ ->
   try
-    if !Flags.raw_print || !print_no_symbol then raise No_match;
+    if !Flags.in_debugger || !Flags.raw_print || !print_no_symbol then raise No_match;
     let (na,sc,p) = uninterp_prim_token_cases_pattern pat in
     match availability_of_prim_token p sc scopes with
       | None -> raise No_match
       | Some key ->
 	let loc = cases_pattern_loc pat in
-	insert_pat_alias loc (insert_pat_delimiters loc (CPatPrim(loc,p)) key) na
+	insert_pat_alias ?loc (insert_pat_delimiters ?loc (CAst.make ?loc @@ CPatPrim p) key) na
   with No_match ->
     try
-      if !Flags.raw_print || !print_no_symbol then raise No_match;
+      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 pat)
     with No_match ->
-      match pat with
-	| PatVar (loc,Name id) -> CPatAtom (loc,Some (Ident (loc,id)))
-	| PatVar (loc,Anonymous) -> CPatAtom (loc, None)
-	| PatCstr(loc,cstrsp,args,na) ->
+      lift (fun ?loc -> function
+        | PatVar (Name id) -> CPatAtom (Some (make ?loc @@ Ident id))
+	| PatVar (Anonymous) -> CPatAtom None
+	| PatCstr(cstrsp,args,na) ->
 	  let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
 	  let p =
 	    try
               if !Flags.raw_print then raise Exit;
 	      let projs = Recordops.lookup_projections (fst cstrsp) in
 	      let rec ip projs args acc =
-		match projs with
-		  | [] -> acc
-		  | None :: q -> ip q args acc
-		  | Some c :: q ->
-		    match args with
-		      | [] -> raise No_match
-		      | CPatAtom(_, None) :: tail -> ip q tail acc
-		    (* we don't want to have 'x = _' in our patterns *)
-		      | head :: tail -> ip q tail
-		        ((extern_reference loc Id.Set.empty (ConstRef c), head) :: acc)
+		match projs, args with
+		  | [], [] -> acc
+		  | proj :: q, pat :: tail ->
+                     let acc =
+                       match proj, pat with
+		       | _, { CAst.v = CPatAtom None } ->
+		          (* we don't want to have 'x := _' in our patterns *)
+                          acc
+		       | Some c, _ ->
+                          ((extern_reference ?loc Id.Set.empty (ConstRef c), pat) :: acc)
+                       | _ -> raise No_match in
+                     ip q tail acc
+	          | _ -> assert false
 	      in
-	      CPatRecord(loc, List.rev (ip projs args []))
+	      CPatRecord(List.rev (ip projs args []))
 	    with
 		Not_found | No_match | Exit ->
-                  let c = extern_reference loc Id.Set.empty (ConstructRef cstrsp) in
-		  if !Topconstr.asymmetric_patterns then
+                  let c = extern_reference Id.Set.empty (ConstructRef cstrsp) in
+                  if !asymmetric_patterns then
 		    if pattern_printable_in_both_syntax cstrsp
-		    then CPatCstr (loc, c, None, args)
-		    else CPatCstr (loc, c, Some (add_patt_for_params (fst cstrsp) args), [])
+		    then CPatCstr (c, None, args)
+		    else CPatCstr (c, Some (add_patt_for_params (fst cstrsp) args), [])
 		  else
 		    let full_args = add_patt_for_params (fst cstrsp) args in
 		    match drop_implicits_in_patt (ConstructRef cstrsp) 0 full_args with
-		      |Some true_args -> CPatCstr (loc, c, None, true_args)
-		      |None -> CPatCstr (loc, c, Some full_args, [])
-	  in insert_pat_alias loc p na
-and apply_notation_to_pattern loc gr ((subst,substlist),(nb_to_drop,more_args))
+		      | Some true_args -> CPatCstr (c, None, true_args)
+		      | None           -> CPatCstr (c, Some full_args, [])
+	  in (insert_pat_alias ?loc (CAst.make ?loc p) na).v
+        ) pat
+and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args))
     (tmp_scope, scopes as allscopes) vars =
   function
     | NotationRule (sc,ntn) ->
@@ -353,42 +448,44 @@ 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
 		  |None -> raise No_match
 	    in
-	    insert_pat_delimiters loc
-	      (make_pat_notation loc ntn (l,ll) l2') key
+	    insert_pat_delimiters ?loc
+	      (make_pat_notation ?loc ntn (l,ll) l2') key
       end
     | SynDefRule kn ->
-      let qid = Qualid (loc, shortest_qualid_of_syndef vars kn) in
+      let qid = make ?loc @@ Qualid (shortest_qualid_of_syndef vars kn) in
       let l1 =
 	List.rev_map (fun (c,(scopt,scl)) ->
           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
 	    |None -> raise No_match
       in
       assert (List.is_empty substlist);
-      mkPat loc qid (List.rev_append l1 l2')
+      mkPat ?loc qid (List.rev_append l1 l2')
 and extern_notation_pattern (tmp_scope,scopes as allscopes) vars t = function
   | [] -> raise No_match
   | (keyrule,pat,n as _rule)::rules ->
     try
-      if List.mem keyrule !print_non_active_notations then raise No_match;
-      match t with
-	| PatCstr (loc,cstr,_,na) ->
-	  let p = apply_notation_to_pattern loc (ConstructRef cstr)
+      if is_inactive_rule keyrule then raise No_match;
+      let loc = t.loc in
+      match DAst.get t with
+        | PatCstr (cstr,args,na) ->
+          let t = if na = Anonymous then t else DAst.make ?loc (PatCstr (cstr,args,Anonymous)) in
+	  let p = apply_notation_to_pattern ?loc (ConstructRef cstr)
 	    (match_notation_constr_cases_pattern t pat) allscopes vars keyrule in
-	  insert_pat_alias loc p na
-	| PatVar (loc,Anonymous) -> CPatAtom (loc, None)
-	| PatVar (loc,Name id) -> CPatAtom (loc, Some (Ident (loc,id)))
+	  insert_pat_alias ?loc p na
+	| PatVar Anonymous -> CAst.make ?loc @@ CPatAtom None
+        | PatVar (Name id) -> CAst.make ?loc @@ CPatAtom (Some (make ?loc @@ Ident id))
     with
 	No_match -> extern_notation_pattern allscopes vars t rules
 
@@ -396,8 +493,8 @@ let rec extern_notation_ind_pattern allscopes vars ind args = function
   | [] -> raise No_match
   | (keyrule,pat,n as _rule)::rules ->
     try
-      if List.mem keyrule !print_non_active_notations then raise No_match;
-      apply_notation_to_pattern Loc.ghost (IndRef ind)
+      if is_inactive_rule keyrule then raise No_match;
+      apply_notation_to_pattern (IndRef ind)
 	(match_notation_constr_ind_pattern ind args pat) allscopes vars keyrule
     with
 	No_match -> extern_notation_ind_pattern allscopes vars ind args rules
@@ -406,9 +503,9 @@ let extern_ind_pattern_in_scope (scopes:local_scopes) vars ind args =
   (* pboutill: There are letins in pat which is incompatible with notations and
      not explicit application. *)
   if !Flags.in_debugger||Inductiveops.inductive_has_local_defs ind then
-    let c = extern_reference Loc.ghost vars (IndRef ind) in
+    let c = extern_reference vars (IndRef ind) in
     let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
-    CPatCstr (Loc.ghost, c, Some (add_patt_for_params ind args), [])
+    CAst.make @@ CPatCstr (c, Some (add_patt_for_params ind args), [])
   else
     try
       if !Flags.raw_print || !print_no_symbol then raise No_match;
@@ -416,18 +513,18 @@ let extern_ind_pattern_in_scope (scopes:local_scopes) vars ind args =
       match availability_of_prim_token p sc scopes with
 	| None -> raise No_match
 	| Some key ->
-	  insert_pat_delimiters Loc.ghost (CPatPrim(Loc.ghost,p)) key
+	  insert_pat_delimiters (CAst.make @@ CPatPrim p) key
     with No_match ->
       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 ind)
     with No_match ->
-      let c = extern_reference Loc.ghost vars (IndRef ind) in
+      let c = extern_reference vars (IndRef ind) in
       let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
       match drop_implicits_in_patt (IndRef ind) 0 args with
-	   |Some true_args -> CPatCstr (Loc.ghost, c, None, true_args)
-	   |None -> CPatCstr (Loc.ghost, c, Some args, [])
+	   |Some true_args -> CAst.make @@ CPatCstr (c, None, true_args)
+	   |None           -> CAst.make @@ CPatCstr (c, Some args, [])
 
 let extern_cases_pattern vars p =
   extern_cases_pattern_in_scope (None,[]) vars p
@@ -440,6 +537,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
@@ -448,11 +549,11 @@ let is_projection nargs = function
 	 else None
      with Not_found -> None)
   | _ -> None
-	
+
 let is_hole = function CHole _ | CEvar _ -> true | _ -> false
 
 let is_significant_implicit a =
-  not (is_hole a)
+  not (is_hole (a.CAst.v))
 
 let is_needed_for_correct_partial_application tail imp =
   List.is_empty tail && not (maximal_insertion_of imp)
@@ -461,7 +562,7 @@ exception Expl
 
 (* Implicit args indexes are in ascending order *)
 (* inctx is useful only if there is a last argument to be deduced from ctxt *)
-let explicitize loc inctx impl (cf,f) args =
+let explicitize inctx impl (cf,f) args =
   let impl = if !Constrintern.parsing_explicit then [] else impl in
   let n = List.length args in
   let rec exprec q = function
@@ -476,7 +577,7 @@ let explicitize loc inctx impl (cf,f) args =
 	   is_significant_implicit (Lazy.force a))
 	in
         if visible then
-	  (Lazy.force a,Some (Loc.ghost, 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)
@@ -490,49 +591,55 @@ let explicitize loc inctx impl (cf,f) args =
   let expl () = 
     match ip with
     | Some i ->
-      if not (List.is_empty impl) && is_status_implicit (List.nth impl (i-1)) then
-	raise Expl
+      (* Careful: It is possible to have declared implicits ending
+         before the principal argument *)
+      let is_impl =
+        try is_status_implicit (List.nth impl (i-1))
+        with Failure _ -> false
+      in
+      if is_impl
+      then raise Expl
       else
 	let (args1,args2) = List.chop i args in
-	let (impl1,impl2) = if List.is_empty impl then [],[] else List.chop i impl in
+        let (impl1,impl2) = try List.chop i impl with Failure _ -> impl, [] in
 	let args1 = exprec 1 (args1,impl1) in
 	let args2 = exprec (i+1) (args2,impl2) in
 	let ip = Some (List.length args1) in
-	  CApp (loc,(ip,f),args1@args2)
+	  CApp ((ip,f),args1@args2)
     | None ->
       let args = exprec 1 (args,impl) in
-	if List.is_empty args then f else CApp (loc, (None, f), args)
+	if List.is_empty args then f.CAst.v else CApp ((None, f), args)
   in
     try expl ()
     with Expl -> 
-      let f',us = match f with CRef (f,us) -> f,us | _ -> assert false in
+      let f',us = match f with { CAst.v = CRef (f,us) } -> f,us | _ -> assert false in
       let ip = if !print_projections then ip else None in
-	CAppExpl (loc, (ip, f', us), List.map Lazy.force args)
+	CAppExpl ((ip, f', us), List.map Lazy.force args)
 
 let is_start_implicit = function
   | imp :: _ -> is_status_implicit imp && maximal_insertion_of imp
   | [] -> false
 
-let extern_global loc impl f us =
+let extern_global impl f us =
   if not !Constrintern.parsing_explicit && is_start_implicit impl
   then
-    CAppExpl (loc, (None, f, us), [])
+    CAppExpl ((None, f, us), [])
   else
     CRef (f,us)
 
-let extern_app loc inctx impl (cf,f) us args =
+let extern_app inctx impl (cf,f) us args =
   if List.is_empty args then
     (* If coming from a notation "Notation a := @b" *)
-    CAppExpl (loc, (None, f, us), [])
+    CAppExpl ((None, f, us), [])
   else if not !Constrintern.parsing_explicit &&
     ((!Flags.raw_print ||
       (!print_implicits && not !print_implicits_explicit_args)) &&
      List.exists is_status_implicit impl)
   then
     let args = List.map Lazy.force args in
-    CAppExpl (loc, (is_projection (List.length args) cf,f,us), args)
+    CAppExpl ((is_projection (List.length args) cf,f,us), args)
   else
-    explicitize loc inctx impl (cf,CRef (f,us)) args
+    explicitize inctx impl (cf, CAst.make @@ CRef (f,us)) args
 
 let rec fill_arg_scopes args subscopes scopes = match args, subscopes with
 | [], _ -> []
@@ -545,8 +652,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
-  | GApp (loc,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 =
@@ -568,14 +679,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 GApp (loc,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
-  | GApp (loc,GApp(_,a,l'),l) -> flatten_application (GApp (loc,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 *)
@@ -586,7 +703,7 @@ let extern_possible_prim_token scopes r =
     let (sc,n) = uninterp_prim_token r in
     match availability_of_prim_token n sc scopes with
     | None -> None
-    | Some key -> Some (insert_delimiters (CPrim (loc_of_glob_constr r,n)) key)
+    | Some key -> Some (insert_delimiters (CAst.make ?loc:(loc_of_glob_constr r) @@ CPrim n) key)
   with No_match ->
     None
 
@@ -594,10 +711,22 @@ let extern_optimal_prim_token scopes r r' =
   let c = extern_possible_prim_token scopes r in
   let c' = if r==r' then None else extern_possible_prim_token scopes r' in
   match c,c' with
-  | Some n, (Some (CDelimiters _) | None) | _, Some n -> n
+  | Some n, (Some ({ CAst.v = CDelimiters _}) | None) | _, Some n -> n
   | _ -> raise No_match
 
 (**********************************************************************)
+(* mapping decl                                                       *)
+
+let extended_glob_local_binder_of_decl loc = function
+  | (p,bk,None,t) -> GLocalAssum (p,bk,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 = DAst.make ?loc (extended_glob_local_binder_of_decl loc u)
+
+(**********************************************************************)
 (* mapping glob_constr to constr_expr                                    *)
 
 let extern_glob_sort = function
@@ -620,25 +749,27 @@ let rec extern inctx scopes vars r =
     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 -> match r' with
-  | GRef (loc,ref,us) ->
-      extern_global loc (select_stronger_impargs (implicits_of_global ref))
-        (extern_reference loc vars ref) (extern_universes us)
+  with No_match -> lift (fun ?loc -> function
+  | GRef (ref,us) ->
+      extern_global (select_stronger_impargs (implicits_of_global ref))
+        (extern_reference vars ref) (extern_universes us)
 
-  | GVar (loc,id) -> CRef (Ident (loc,id),None)
+  | GVar id -> CRef (make ?loc @@ Ident id,None)
 
-  | GEvar (loc,n,[]) when !print_meta_as_hole -> CHole (loc, None, Misctypes.IntroAnonymous, None)
+  | GEvar (n,[]) when !print_meta_as_hole -> CHole (None, Misctypes.IntroAnonymous, None)
 
-  | GEvar (loc,n,l) ->
-      extern_evar loc n (List.map (on_snd (extern false scopes vars)) l)
+  | GEvar (n,l) ->
+      extern_evar n (List.map (on_snd (extern false scopes vars)) l)
 
-  | GPatVar (loc,(b,n)) ->
-      if !print_meta_as_hole then CHole (loc, None, Misctypes.IntroAnonymous, None) else
-        if b then CPatVar (loc,n) else CEvar (loc,n,[])
+  | GPatVar kind ->
+      if !print_meta_as_hole then CHole (None, Misctypes.IntroAnonymous, None) else
+       (match kind with
+         | Evar_kinds.SecondOrderPatVar n -> CPatVar n
+         | Evar_kinds.FirstOrderPatVar n -> CEvar (n,[]))
 
-  | GApp (loc,f,args) ->
-      (match f with
-	 | GRef (rloc,ref,us) ->
+  | GApp (f,args) ->
+      (match DAst.get f with
+	 | GRef (ref,us) ->
 	     let subscopes = find_arguments_scope ref in
 	     let args = fill_arg_scopes args subscopes (snd scopes) in
 	     begin
@@ -650,7 +781,7 @@ let rec extern inctx scopes vars r =
                    ()
                  else if PrintingConstructor.active (fst cstrsp) then
                    raise Exit
-                 else if not !Flags.record_print then
+                 else if not !record_print then
                    raise Exit;
 		 let projs = struc.Recordops.s_PROJ in
 		 let locals = struc.Recordops.s_PROJKIND in
@@ -667,7 +798,7 @@ let rec extern inctx scopes vars r =
 		     | None :: q -> raise No_match
 		     | Some c :: q ->
 		         match locs with
-			   | [] -> anomaly (Pp.str "projections corruption [Constrextern.extern]")
+			   | [] -> anomaly (Pp.str "projections corruption [Constrextern.extern].")
 			   | (_, false) :: locs' ->
 			       (* we don't want to print locals *)
 			       ip q locs' args acc
@@ -677,118 +808,118 @@ let rec extern inctx scopes vars r =
 				     (* we give up since the constructor is not complete *)
 				 | (arg, scopes) :: tail ->
                                      let head = extern true scopes vars arg in
-				     ip q locs' tail ((extern_reference loc Id.Set.empty (ConstRef c), head) :: acc)
+                                     ip q locs' tail ((extern_reference ?loc Id.Set.empty (ConstRef c), head) :: acc)
 		   in
-		 CRecord (loc, List.rev (ip projs locals args []))
+		 CRecord (List.rev (ip projs locals args []))
 	       with
 		 | Not_found | No_match | Exit ->
                     let args = extern_args (extern true) vars args in
-		     extern_app loc inctx
+		     extern_app inctx
 		       (select_stronger_impargs (implicits_of_global ref))
-		       (Some ref,extern_reference rloc vars ref) (extern_universes us) args
+                       (Some ref,extern_reference ?loc vars ref) (extern_universes us) args
 	     end
-	       
+
 	 | _       ->
-	   explicitize loc inctx [] (None,sub_extern false scopes vars f)
+	   explicitize inctx [] (None,sub_extern false scopes vars f)
              (List.map (fun c -> lazy (sub_extern true scopes vars c)) args))
 
-  | GLetIn (loc,na,t,c) ->
-      CLetIn (loc,(loc,na),sub_extern false scopes vars t,
+  | GLetIn (na,b,t,c) ->
+      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 (loc,na,bk,t,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,[(Loc.ghost,na)::idl,Default bk,t],c)
+      factorize_prod scopes (add_vname vars na) na bk t c
 
-  | GLambda (loc,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,[(Loc.ghost,na)::idl,Default bk,t],c)
+      factorize_lambda inctx scopes (add_vname vars na) na bk t c
 
-  | GCases (loc,sty,rtntypopt,tml,eqns) ->
+  | GCases (sty,rtntypopt,tml,eqns) ->
     let vars' =
-      List.fold_right (name_fold Id.Set.add)
+      List.fold_right (Name.fold_right Id.Set.add)
 	(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, 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.ghost, Anonymous)
+                                 Some (CAst.make Anonymous)
                                else None
                       end
                    | Anonymous, _ -> None
-                   | Name id, GVar (_,id') when Id.equal id id' -> None
-                   | Name _, _ -> Some (Loc.ghost,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 -> PatVar (Loc.ghost, x)) nal in
+                  Option.map (fun {CAst.loc;v=(ind,nal)} ->
+                              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
-    CCases (loc,sty,rtntypopt',tml,eqns)
+    let eqns = List.map (extern_eqn inctx scopes vars) (factorize_eqns eqns) in
+    CCases (sty,rtntypopt',tml,eqns)
 
-  | GLetTuple (loc,nal,(na,typopt),tm,b) ->
-      CLetTuple (loc,List.map (fun na -> (Loc.ghost,na)) nal,
-        (Option.map (fun _ -> (Loc.ghost,na)) typopt,
+  | GLetTuple (nal,(na,typopt),tm,b) ->
+    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 (loc,c,(na,typopt),b1,b2) ->
-      CIf (loc,sub_extern false scopes vars c,
-        (Option.map (fun _ -> (Loc.ghost,na)) typopt,
+  | GIf (c,(na,typopt),b1,b2) ->
+      CIf (sub_extern false scopes vars c,
+        (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)
 
-  | GRec (loc,fk,idv,blv,tyv,bv) ->
+  | GRec (fk,idv,blv,tyv,bv) ->
       let vars' = Array.fold_right Id.Set.add idv vars in
       (match fk with
 	 | GFix (nv,n) ->
 	     let listdecl =
 	       Array.mapi (fun i fi ->
                  let (bl,ty,def) = blv.(i), tyv.(i), bv.(i) in
-                 let bl = List.map (fun (p,bk,x,t) -> (Inl p,bk,x,t)) bl in
+                 let bl = List.map (extended_glob_local_binder_of_decl ?loc) bl in
                  let (assums,ids,bl) = extern_local_binder scopes vars bl in
-                 let vars0 = List.fold_right (name_fold Id.Set.add) ids vars in
-                 let vars1 = List.fold_right (name_fold Id.Set.add) ids vars' in
+                 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
 		 let n =
 		   match fst nv.(i) with
 		     | None -> None
-		     | Some x -> Some (Loc.ghost, out_name (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.ghost, 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,(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 ->
-                 let bl = List.map (fun (p,bk,x,t) -> (Inl p,bk,x,t)) blv.(i) in
+                 let bl = List.map (extended_glob_local_binder_of_decl ?loc) blv.(i) in
                  let (_,ids,bl) = extern_local_binder scopes vars bl in
-                 let vars0 = List.fold_right (name_fold Id.Set.add) ids vars in
-                 let vars1 = List.fold_right (name_fold Id.Set.add) ids vars' in
-		 ((Loc.ghost, fi),bl,extern_typ scopes vars0 tyv.(i),
+                 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
+                 ((CAst.make fi),bl,extern_typ scopes vars0 tyv.(i),
                   sub_extern false scopes vars1 bv.(i))) idv
 	     in
-	     CCoFix (loc,(loc,idv.(n)),Array.to_list listdecl))
+             CCoFix (CAst.(make ?loc idv.(n)),Array.to_list listdecl))
 
-  | GSort (loc,s) -> CSort (loc,extern_glob_sort s)
+  | GSort s -> CSort (extern_glob_sort s)
 
-  | GHole (loc,e,naming,_) -> CHole (loc, Some e, naming, None) (** TODO: extern tactics. *)
+  | GHole (e,naming,_) -> CHole (Some e, naming, None) (** TODO: extern tactics. *)
 
-  | GCast (loc,c, c') ->
-      CCast (loc,sub_extern true scopes vars c,
+  | GCast (c, c') ->
+      CCast (sub_extern true scopes vars c,
 	     Miscops.map_cast_type (extern_typ scopes vars) c')
+  ) r'
 
 and extern_typ (_,scopes) =
   extern true (Notation.current_type_scope_name (),scopes)
@@ -796,73 +927,110 @@ 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, CProdN (loc,[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
+     | [{CAst.v=(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
-  | CLambdaN (loc,[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
+     | [{CAst.v=(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
     [] -> ([],[],[])
-  | (Inl na,bk,Some 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 Id.Set.add na vars) l in
+        extern_local_binder scopes (Name.fold_right Id.Set.add na vars) l in
       (assums,na::ids,
-       LocalRawDef((Loc.ghost,na), extern false scopes vars bd) :: l)
+       CLocalDef(CAst.make na, extern false scopes vars bd,
+                   Option.map (extern false scopes vars) ty) :: l)
 
-  | (Inl na,bk,None,ty)::l ->
+    | GLocalAssum (na,bk,ty) ->
       let ty = extern_typ scopes vars ty in
-      (match extern_local_binder scopes (name_fold Id.Set.add na vars) l with
-          (assums,ids,LocalRawAssum(nal,k,ty')::l)
+      (match extern_local_binder scopes (Name.fold_right Id.Set.add na vars) l with
+          (assums,ids,CLocalAssum(nal,k,ty')::l)
             when constr_expr_eq ty ty' &&
               match na with Name id -> not (occur_var_constr_expr id ty')
                 | _ -> true ->
               (na::assums,na::ids,
-               LocalRawAssum((Loc.ghost,na)::nal,k,ty')::l)
+               CLocalAssum(CAst.make na::nal,k,ty')::l)
         | (assums,ids,l) ->
             (na::assums,na::ids,
-             LocalRawAssum([(Loc.ghost,na)],Default bk,ty) :: l))
+             CLocalAssum([CAst.make na],Default bk,ty) :: l))
 
-  | (Inr p,bk,Some bd,ty)::l -> assert false
-
-  | (Inr p,bk,None,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, LocalPattern(Loc.ghost,p,ty) :: l)
+      (assums,ids, CLocalPattern(CAst.make @@ (p,ty)) :: l)
 
-and extern_eqn inctx scopes vars (loc,ids,pl,c) =
-  (loc,[loc,List.map (extern_cases_pattern_in_scope scopes vars) pl],
-   extern inctx scopes vars c)
+and extern_eqn inctx scopes vars {CAst.loc;v=(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
   | (keyrule,pat,n as _rule)::rules ->
       let loc = Glob_ops.loc_of_glob_constr t in
       try
-        if List.mem keyrule !print_non_active_notations then raise No_match;
+        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,n with
-	  | GApp (_,f,args), Some n
+	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 with
-                | GRef (_,ref,us) ->
+                match DAst.get f with
+                | GRef (ref,us) ->
 	          let subscopes =
 		    try List.skipn n (find_arguments_scope ref)
                     with Failure _ -> [] in
@@ -874,19 +1042,23 @@ and extern_notation (tmp_scope,scopes as allscopes) vars t = function
                   subscopes,impls
                 | _ ->
                   [], [] in
-	      (if Int.equal n 0 then f else GApp (Loc.ghost,f,args1)),
+	      (if Int.equal n 0 then f else DAst.make @@ GApp (f,args1)),
 	      args2, subscopes, impls
-	  | GApp (_,(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 -> GApp (Loc.ghost,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 =
@@ -907,23 +1079,27 @@ 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)) ->
 		  extern true (scopt,scl@scopes) vars c, None)
 		  terms in
-              let a = CRef (Qualid (loc, shortest_qualid_of_syndef vars kn),None) in
-	      if List.is_empty l then a else CApp (loc,(None,a),l) in
+              let a = CRef (make ?loc @@ Qualid (shortest_qualid_of_syndef vars kn),None) in
+	      CAst.make ?loc @@ if List.is_empty l then a else CApp ((None, CAst.make a),l) in
  	if List.is_empty args then e
 	else
 	  let args = fill_arg_scopes args argsscopes scopes in
 	  let args = extern_args (extern true) vars args in
-	  explicitize loc false argsimpls (None,e) args
+	  CAst.make ?loc @@ explicitize false argsimpls (None,e) args
       with
 	  No_match -> extern_notation allscopes vars t rules
 
@@ -943,8 +1119,6 @@ let extern_glob_type vars c =
 (******************************************************************)
 (* Main translation function from constr -> constr_expr *)
 
-let loc = Loc.ghost (* for constr and pattern, locations are lost *)
-
 let extern_constr_gen lax goal_concl_style scopt env sigma t =
   (* "goal_concl_style" means do alpha-conversion using the "goal" convention *)
   (* i.e.: avoid using the names of goal/section/rel variables and the short *)
@@ -953,8 +1127,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
 
@@ -965,14 +1139,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
@@ -984,11 +1158,15 @@ let extern_closed_glob ?lax goal_concl_style env sigma t =
 
 let any_any_branch =
   (* | _ => _ *)
-  (loc,[],[PatVar (loc,Anonymous)],GHole (loc,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None))
+  CAst.make ([],[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 = function
-  | PRef ref -> GRef (loc,ref,None)
-  | PVar id -> GVar (loc,id)
+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) ->
       let test decl = function PVar id' -> Id.equal (NamedDecl.get_id decl) id' | _ -> false in
       let l = Evd.evar_instance_array test (Evd.find sigma evk) l in
@@ -996,61 +1174,68 @@ let rec glob_of_pat env sigma = function
       | None -> Id.of_string "__"
       | Some id -> id
       in
-      GEvar (loc,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
 	| Anonymous ->
-	    anomaly ~label:"glob_constr_of_pattern" (Pp.str "index to an anonymous variable")
+	    anomaly ~label:"glob_constr_of_pattern" (Pp.str "index to an anonymous variable.")
       with Not_found -> Id.of_string ("_UNBOUND_REL_"^(string_of_int n)) in
-      GVar (loc,id)
-  | PMeta None -> GHole (loc,Evar_kinds.InternalHole, Misctypes.IntroAnonymous,None)
-  | PMeta (Some n) -> GPatVar (loc,(false,n))
-  | PProj (p,c) -> GApp (loc,GRef (loc, ConstRef (Projection.constant p),None),
-			 [glob_of_pat env sigma c])
+      GVar id
+  | PMeta None -> GHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous,None)
+  | PMeta (Some n) -> GPatVar (Evar_kinds.FirstOrderPatVar n)
+  | PProj (p,c) -> GApp (DAst.make @@ GRef (ConstRef (Projection.constant p),None),
+			 [glob_of_pat avoid env sigma c])
   | PApp (f,args) ->
-      GApp (loc,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 (loc,GPatVar (loc,(true,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 (loc,na,Explicit,glob_of_pat env sigma t,glob_of_pat (na::env) sigma c)
-  | PLetIn (na,t,c) ->
-      GLetIn (loc,na,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) ->
+      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 (loc,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 (loc, 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 (loc,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")
+	| _, None -> anomaly (Pp.str "PCase with some branches but unknown inductive.")
       in
       let mat = if info.cip_extensible then mat @ [any_any_branch] else mat
       in
       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)
-	| _ -> anomaly (Pp.str "PCase with non-trivial predicate but unknown inductive")
+	  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 (loc,RegularStyle,rtn,[glob_of_pat env sigma tm,indnames],mat)
-  | PFix f -> Detyping.detype_names false [] env (Global.env()) sigma (mkFix f) (** FIXME bad env *)
-  | PCoFix c -> Detyping.detype_names false [] env (Global.env()) sigma (mkCoFix c)
-  | PSort s -> GSort (loc,s)
+      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 (fun (p,bk,x,t) -> (Inl p,bk,x,t)) a 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 f617faa3..8ab70283 100644
--- a/interp/constrextern.mli
+++ b/interp/constrextern.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
 open Termops
+open EConstr
 open Environ
 open Libnames
 open Globnames
@@ -18,13 +20,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
@@ -37,11 +40,11 @@ val extern_closed_glob : ?lax:bool -> bool -> env -> Evd.evar_map -> closed_glob
 
 val extern_constr : ?lax:bool -> bool -> env -> Evd.evar_map -> constr -> constr_expr
 val extern_constr_in_scope : bool -> scope_name -> env -> Evd.evar_map -> constr -> constr_expr
-val extern_reference : Loc.t -> Id.Set.t -> global_reference -> reference
+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 ->
-  Context.Rel.t -> local_binder list
+  rel_context -> local_binder_expr list
 
 (** Printing options *)
 val print_implicits : bool ref
@@ -55,19 +58,22 @@ val print_projections : bool ref
 
 (** Customization of the global_reference printer *)
 val set_extern_reference :
-  (Loc.t -> Id.Set.t -> global_reference -> reference) -> unit
+  (?loc:Loc.t -> Id.Set.t -> global_reference -> reference) -> unit
 val get_extern_reference :
-  unit -> (Loc.t -> Id.Set.t -> global_reference -> reference)
+  unit -> (?loc:Loc.t -> Id.Set.t -> global_reference -> reference)
 
-(** This governs printing of implicit arguments. If [with_implicits] is
-   on and not [with_arguments] then implicit args are printed prefixed
-   by "!"; if [with_implicits] and [with_arguments] are both on the
-   function and not the arguments is prefixed by "!" *)
-val with_implicits : ('a -> 'b) -> 'a -> 'b
-val with_arguments : ('a -> 'b) -> 'a -> 'b
+(** WARNING: The following functions are evil due to
+    side-effects. Think of the following case as used in the printer:
 
-(** This forces printing of coercions *)
-val with_coercions : ('a -> 'b) -> 'a -> 'b
+    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
@@ -80,3 +86,13 @@ val without_specific_symbols : interp_rule list -> ('a -> 'b) -> 'a -> 'b
 
 (** This prints metas as anonymous holes *)
 val with_meta_as_hole : ('a -> 'b) -> 'a -> 'b
+
+(** Fine-grained activation and deactivation of notation printing.
+ *)
+val toggle_scope_printing :
+  scope:Notation_term.scope_name -> activate:bool -> unit
+
+val toggle_notation_printing :
+  ?scope:Notation_term.scope_name -> notation:Constrexpr.notation -> activate:bool -> unit
+
+
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index e6340646..83ace93c 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -1,14 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
+open CAst
 open Names
 open Nameops
 open Namegen
@@ -24,7 +27,6 @@ open Constrexpr
 open Constrexpr_ops
 open Notation_term
 open Notation_ops
-open Topconstr
 open Nametab
 open Notation
 open Inductiveops
@@ -45,7 +47,7 @@ open Context.Rel.Declaration
    types and recursive definitions and of projection names in records *)
 
 type var_internalization_type =
-  | Inductive of Id.t list (* list of params *)
+  | Inductive of Id.t list (* list of params *) * bool (* true = check for possible capture *)
   | Recursive
   | Method
   | Variable
@@ -65,11 +67,10 @@ type var_internalization_data =
 type internalization_env =
     (var_internalization_data) Id.Map.t
 
-type glob_binder = (Name.t * binding_kind * glob_constr option * glob_constr)
-
 type ltac_sign = {
   ltac_vars : Id.Set.t;
   ltac_bound : Id.Set.t;
+  ltac_extra : Genintern.Store.t;
 }
 
 let interning_grammar = ref false
@@ -95,19 +96,19 @@ let is_global id =
     false
 
 let global_reference_of_reference ref =
-  locate_reference (snd (qualid_of_reference ref))
+  locate_reference (qualid_of_reference ref).CAst.v
 
 let global_reference id =
-  Universes.constr_of_global (locate_reference (qualid_of_ident id))
+  locate_reference (qualid_of_ident id)
 
 let construct_reference ctx id =
   try
-    Term.mkVar (let _ = Context.Named.lookup id ctx in id)
+    VarRef (let _ = Context.Named.lookup id ctx in id)
   with Not_found ->
     global_reference id
 
 let global_reference_in_absolute_module dir id =
-  Universes.constr_of_global (Nametab.global_of_path (Libnames.make_path dir id))
+  Nametab.global_of_path (Libnames.make_path dir id)
 
 (**********************************************************************)
 (* Internalization errors                                             *)
@@ -120,10 +121,10 @@ type internalization_error =
   | NonLinearPattern of Id.t
   | BadPatternsNumber of int * int
 
-exception InternalizationError of Loc.t * 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 +134,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") ++
@@ -154,17 +155,17 @@ let explain_internalization_error e =
   | BadPatternsNumber (n1,n2) -> explain_bad_patterns_number n1 n2
   in pp ++ str "."
 
-let error_bad_inductive_type loc =
-  user_err_loc (loc,"",str
+let error_bad_inductive_type ?loc =
+  user_err ?loc  (str
     "This should be an inductive type applied to patterns.")
 
-let error_parameter_not_implicit loc =
-  user_err_loc (loc,"", str
+let error_parameter_not_implicit ?loc =
+  user_err ?loc  (str
    "The parameters do not bind in patterns;" ++ spc () ++ str
     "they must be replaced by '_'.")
 
-let error_ldots_var loc =
-  user_err_loc (loc,"",str "Special token " ++ pr_id ldots_var ++
+let error_ldots_var ?loc =
+  user_err ?loc  (str "Special token " ++ Id.print ldots_var ++
     str " is for use in the Notation command.")
 
 (**********************************************************************)
@@ -176,7 +177,7 @@ let parsing_explicit = ref false
 let empty_internalization_env = Id.Map.empty
 
 let compute_explicitable_implicit imps = function
-  | Inductive params ->
+  | Inductive (params,_) ->
       (* In inductive types, the parameters are fixed implicit arguments *)
       let sub_impl,_ = List.chop (List.length params) imps in
       let sub_impl' = List.filter is_status_implicit sub_impl in
@@ -185,15 +186,15 @@ let compute_explicitable_implicit imps = function
       (* Unable to know in advance what the implicit arguments will be *)
       []
 
-let compute_internalization_data env ty typ impl =
-  let impl = compute_implicits_with_manual env typ (is_implicit_args()) impl in
+let compute_internalization_data env sigma ty typ impl =
+  let impl = compute_implicits_with_manual env sigma typ (is_implicit_args()) impl in
   let expls_impl = compute_explicitable_implicit impl ty in
-  (ty, expls_impl, impl, compute_arguments_scope typ)
+  (ty, expls_impl, impl, compute_arguments_scope sigma typ)
 
-let compute_internalization_env env ty =
+let compute_internalization_env env sigma ?(impls=empty_internalization_env) ty =
   List.fold_left3
-    (fun map id typ impl -> Id.Map.add id (compute_internalization_data env ty typ impl) map)
-    empty_internalization_env
+    (fun map id typ impl -> Id.Map.add id (compute_internalization_data env sigma ty typ impl) map)
+    impls
 
 (**********************************************************************)
 (* Contracting "{ _ }" in notations *)
@@ -215,24 +216,24 @@ 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
     | [] -> []
-    | 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
     | [] -> []
-    | CPatNotation (_,"{ _ }",([a],[]),[]) :: l ->
+    | { CAst.v = CPatNotation ("{ _ }",([a],[]),[]) } :: l ->
         ntn' := expand_notation_string !ntn' n;
         contract_squash n (a::l)
     | a :: l ->
@@ -262,40 +263,35 @@ let pr_scope_stack = function
   | l -> str "scope stack " ++
       str "[" ++ prlist_with_sep pr_comma str l ++ str "]"
 
-let error_inconsistent_scope loc id scopes1 scopes2 =
-  user_err_loc (loc,"set_var_scope",
-    pr_id id ++ str " is here used in " ++
+let error_inconsistent_scope ?loc id scopes1 scopes2 =
+  user_err ?loc ~hdr:"set_var_scope"
+   (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 (loc,"",
-    pr_id id ++
+let error_expect_binder_notation_type ?loc id =
+  user_err ?loc 
+   (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 ->
-	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.NtnInternTypeOnlyBinder ->
+	if istermvar then error_expect_binder_notation_type ?loc id
+    | Notation_term.NtnInternTypeAny -> ()
   with Not_found ->
     (* Not in a notation *)
     ()
@@ -304,15 +300,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 loc2 env body =
-  match env with
-      (loc1, (na, bk, _, t)) :: tl -> it_mkGProd loc2 tl (GProd (Loc.merge loc1 loc2, 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 loc2 env body =
-  match env with
-      (loc1, (na, bk, _, t)) :: tl -> it_mkGLambda loc2 tl (GLambda (Loc.merge loc1 loc2, 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 +315,15 @@ let build_impls = function
   |Explicit -> fun _ -> None
 
 let impls_type_list ?(args = []) =
-  let rec aux acc = function
-    |GProd (_,na,bk,_,c) -> aux ((build_impls bk na)::acc) c
-    |_ -> (Variable,[],List.append args (List.rev acc),[])
+  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
-    |GLambda (_,na,bk,_,c) -> aux ((build_impls bk na)::acc) c
-    |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,53 +331,55 @@ 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
-  | 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
+	| Name id -> glob_constr_of_notation_constr ?loc
 	               (Reserve.find_reserved_type id)
 	| Anonymous -> raise Not_found
-      with Not_found -> GHole (loc, 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
-         | (Inductive _,b,c,d) -> (Inductive [],b,c,d)
+         | (Inductive (params,_),b,c,d) -> (Inductive (params,false),b,c,d)
          | x -> x) env.impls }
 
-let check_hidden_implicit_parameters id impls =
+let check_hidden_implicit_parameters ?loc id impls =
   if Id.Map.exists (fun _ -> function
-    | (Inductive indparams,_,_,_) -> Id.List.mem id indparams
+    | (Inductive (indparams,check),_,_,_) when check -> Id.List.mem id indparams
     | _ -> false) impls
   then
-    errorlabstrm "" (strbrk "A parameter of an inductive type " ++
-    pr_id id ++ strbrk " is not allowed to be used as a bound variable in the type of its constructor.")
+    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 (loc,"", str "Anonymous variables not allowed");
+	user_err ?loc (str "Anonymous variables not allowed");
       env
-  | loc,Name id ->
-      check_hidden_implicit_parameters id env.impls ;
+  | { 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"
-      else Dumpglob.dump_binding loc id;
+        then error_ldots_var ?loc;
+      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
@@ -395,11 +389,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 (x, l) -> 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 (id, loc) ->
-      (loc, (Name id, b, None, GHole (loc, 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
@@ -409,14 +403,14 @@ let intern_generalized_binder ?(global_level=false) intern_type lvar
 	  let name =
 	    let id =
 	      match ty with
-	      | CApp (_, (_, CRef (Ident (loc,id),_)), _) -> id
+              | { v = CApp ((_, { v = CRef ({v=Ident id},_) } ), _) } -> id
 	      | _ -> default_non_dependent_ident
 	    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',None,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 ->
@@ -424,82 +418,68 @@ 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,(na,k,None,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 rec free_vars_of_pat il =
-  function
-  | CPatCstr (loc, c, l1, l2) ->
-      let il = List.fold_left free_vars_of_pat il (Option.default [] l1) in
-      List.fold_left free_vars_of_pat il l2
-  | CPatAtom (loc, ro) ->
-      begin match ro with
-      | Some (Ident (loc, i)) -> (loc, i) :: il
-      | Some _ | None -> il
-      end
-  | CPatNotation (loc, n, l1, l2) ->
-      let il = List.fold_left free_vars_of_pat il (fst l1) in
-      List.fold_left (List.fold_left free_vars_of_pat) il (snd l1)
-  | _ -> anomaly (str "free_vars_of_pat")
-
-let intern_local_pattern intern lvar env p =
-  List.fold_left
-    (fun env (loc, i) ->
-       let bk = Default Implicit in
-       let ty = CHole (loc, None, Misctypes.IntroAnonymous, None) in
-       let n = Name i in
-       let env, _ = intern_assumption intern lvar env [(loc, n)] bk ty in
-       env)
-    env (free_vars_of_pat [] p)
-
-type binder_data =
-  | BDRawDef of (Loc.t * glob_binder)
-  | BDPattern of
-      (Loc.t * (cases_pattern * Id.t list) *
-         (bool ref *
-          (Notation_term.tmp_scope_name option *
-           Notation_term.tmp_scope_name list)
-          option ref * Notation_term.notation_var_internalization_type)
-         Names.Id.Map.t *
-       intern_env * constr_expr)
+let 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 = 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")
+  )
 
 let intern_cases_pattern_fwd = ref (fun _ -> failwith "intern_cases_pattern_fwd")
 
-let intern_local_binder_aux ?(global_level=false) intern lvar (env,bl) = function
-  | LocalRawAssum(nal,bk,ty) ->
-      let env, bl' = intern_assumption intern lvar env nal bk ty in
-      let bl' = List.map (fun a -> BDRawDef a) bl' in
+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 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
-  | LocalRawDef((loc,na as locna),def) ->
-     let indef = intern env def in
-     let term, ty =
-       match indef with
-       | GCast (loc, b, Misctypes.CastConv t) -> b, t
-       | _ -> indef, GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None)
-     in
-      (push_name_env lvar (impls_term_list indef) env locna,
-       (BDRawDef ((loc,(na,Explicit,Some(term),ty))))::bl)
-  | LocalPattern (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 -> CHole(loc,None,Misctypes.IntroAnonymous,None)
-      in
-      let env = intern_local_pattern intern lvar env p in
-      let cp =
-        match !intern_cases_pattern_fwd (None,env.scopes) p with
-        | (_, [(_, cp)]) -> cp
-        | _ -> assert false
+        | None -> CAst.make ?loc @@ CHole(None,Misctypes.IntroAnonymous,None)
       in
-      let il = List.map snd (free_vars_of_pat [] p) in
-      (env, BDPattern(loc,(cp,il),lvar,env,tyc) :: bl)
+      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 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' =
@@ -519,17 +499,35 @@ let intern_generalization intern env lvar loc bk ak c =
           | None -> false
       in
 	if pi then
-	  (fun (id, loc') acc ->
-	    GProd (Loc.merge loc' loc, Name id, bk, GHole (loc', 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 (id, loc') acc ->
-	    GLambda (Loc.merge loc' loc, Name id, bk, GHole (loc', 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 (id, loc 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 -> CAst.make ?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                                                  *)
 
@@ -537,7 +535,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
@@ -550,13 +548,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.v with
+  | CPatAtom (Some ({v=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
+    (* 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
-    (* 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 Id.Set.add na env.ids}), na
+    (* 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) *)
@@ -564,92 +602,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 =
-  | LPLetIn of Loc.t * (Name.t * glob_constr)
-  | LPCases of Loc.t * (cases_pattern * Id.t list) * Id.t
-
-let make_letins =
-  List.fold_right
-    (fun a c ->
-     match a with
-     | LPLetIn (loc,(na,b)) ->
-         GLetIn(loc,na,b,c)
-     | LPCases (loc,(cp,il),id) ->
-         let tt = (GVar(loc,id),(Name id,None)) in
-         GCases(loc,Misctypes.LetPatternStyle,None,[tt],[(loc,il,[cp],c)]))
-
-let rec subordinate_letins intern letins = function
-  (* binders come in reverse order; the non-let are returned in reverse order together *)
-  (* with the subordinated let-in in writing order *)
-  | BDRawDef (loc,(na,_,Some b,t))::l ->
-      subordinate_letins intern (LPLetIn (loc,(na,b))::letins) l
-  | BDRawDef (loc,(na,bk,None,t))::l ->
-      let letins',rest = subordinate_letins intern [] l in
-      letins',((loc,(na,bk,t)),letins)::rest
-  | BDPattern (loc,u,lvar,env,tyc) :: l ->
-      let ienv = Id.Set.elements env.ids in
-      let id = Namegen.next_ident_away (Id.of_string "pat") ienv in
-      let na = (loc, Name id) in
-      let bk = Default Explicit in
-      let _, bl' = intern_assumption intern lvar env [na] bk tyc in
-      let bl' = List.map (fun a -> BDRawDef a) bl' in
-      subordinate_letins intern (LPCases (loc,u,id)::letins) (bl'@ l)
-  | [] ->
-      letins,[]
+    (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 = function
-    | PatVar (loc,Name id) -> CRef (Ident (loc,id), None)
-    | PatVar (loc,Anonymous) -> error "Cannot turn \"_\" into a term."
-    | PatCstr (loc,c,l,_) ->
-       let r = Qualid (loc,qualid_of_path (path_of_global (ConstructRef c))) in
-       let hole = CHole (loc,None,Misctypes.IntroAnonymous,None) in
+  let rec term_of_pat pt = dmap_with_loc (fun ?loc -> function
+    | PatVar (Name id)   -> CRef (make @@ Ident id, None)
+    | PatVar (Anonymous) -> error_cannot_coerce_wildcard_term ?loc ()
+    | PatCstr (c,l,_) ->
+       let r = make ?loc @@ Qualid (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 (loc,(None,r,None),params @ List.map term_of_pat l) in
-  let rec extract_variables = function
-    | BDRawDef (loc,(Name id,_,None,_))::l -> CRef (Ident (loc,id), None) :: extract_variables l
-    | BDRawDef (loc,(Name id,_,Some _,_))::l -> extract_variables l
-    | BDRawDef (loc,(Anonymous,_,_,_))::l -> error "Cannot turn \"_\" into a term."
-    | BDPattern (loc,(u,_),lvar,env,tyc) :: l -> term_of_pat u :: extract_variables l
+       CAppExpl ((None,r,None),params @ List.map term_of_pat l)) pt in
+  let rec extract_variables l = match l with
+    | bnd :: l ->
+      let loc = bnd.loc in
+      begin match DAst.get bnd with
+      | GLocalAssum (Name id,_,_) -> (CAst.make ?loc @@ CRef (make ?loc @@ Ident 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
+          anomaly (Pp.str "Inconsistent substitution of recursive notation.") in
+      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
@@ -660,62 +707,62 @@ let instantiate_notation_constr loc intern ntnvars subst infos c =
       let arg = match arg with
       | None -> None
       | Some arg ->
-        let open Tacexpr in
-        let open Genarg in
-        let wit = glbwit Constrarg.wit_tactic in
-        let body =
-          if has_type arg wit then out_gen wit arg
-          else assert false (** FIXME *)
-        in
-        let mk_env id (c, (tmp_scope, subscopes)) accu =
+        let mk_env (c, (tmp_scope, subscopes)) =
           let nenv = {env with tmp_scope; scopes = subscopes @ env.scopes} in
           let gc = intern nenv c in
-          let c = ConstrMayEval (Genredexpr.ConstrTerm (gc, Some c)) in
-          ((loc, id), c) :: accu
+          (gc, Some c)
+        in
+        let 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.loc ()
         in
-        let bindings = Id.Map.fold mk_env terms [] in
-        let tac = TacLetIn (false, bindings, body) in
-        let arg = in_gen wit tac in
-        Some arg
+        let 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
-      GHole (loc, 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 intern [] 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"))
+          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
-        GProd (loc,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
-        GLambda (loc,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 = GHole (loc,Evar_kinds.BinderType na,naming,arg) in
-	GProd (loc,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 = GHole (loc,Evar_kinds.BinderType na,naming,arg) in
-	GLambda (loc,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 =
+      glob_constr_of_notation_constr_with_binders ?loc
+        (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
@@ -724,33 +771,109 @@ let instantiate_notation_constr loc intern ntnvars subst infos c =
                 scopes = subscopes @ env.scopes} a
     with Not_found ->
     try
-      GVar (loc, Id.Map.find id renaming)
+      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 ->
       (* Happens for local notation joint with inductive/fixpoint defs *)
-      GVar (loc,id)
+      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 (make ?loc @@ Ident 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 | NtnTypeOnlyBinder -> ((x,scl)::l1,l2,l3)
-    | NtnTypeConstrList -> (l1,(x,scl)::l2,l3)
-    | NtnTypeBinderList -> (l1,l2,(x,scl)::l3)) ids ([],[],[])
+    | 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 | 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 ((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
+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;
+  (* 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       *)
@@ -762,38 +885,41 @@ let string_of_ty = function
   | Variable -> "var"
 
 let gvar (loc, id) us = match us with
-| None -> GVar (loc, id)
+| None -> DAst.make ?loc @@ GVar id
 | Some _ ->
-  user_err_loc (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 -> CRef (Ident (loc,id),None), Some (loc,ExplByName id)) expl_impls in
+      (fun id -> CAst.make ?loc @@ CRef (make ?loc @@ Ident 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;
+    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
+    then error_ldots_var ?loc
     else gvar (loc,id) us, [], [], []
   else if Id.Set.mem id ltacvars.ltac_bound then
     (* Is [id] bound to a free name in ltac (this is an ltac error message) *)
-    user_err_loc (loc,"intern_var",
-      str "variable " ++ pr_id id ++ str " should be bound to a term.")
+    user_err ?loc ~hdr:"intern_var"
+     (str "variable " ++ 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
@@ -803,29 +929,32 @@ let intern_var genv (ltacvars,ntnvars) namedctx loc id us =
 	let ref = VarRef id in
 	let impls = implicits_of_global ref in
 	let scopes = find_arguments_scope ref in
-	Dumpglob.dump_reference loc "<>" (string_of_qualid (Decls.variable_secpath id)) "var";
-	GRef (loc, ref, us), impls, scopes, []
+	Dumpglob.dump_reference ?loc "<>" (string_of_qualid (Decls.variable_secpath id)) "var";
+	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 with
-  | GRef (loc,ref,_) as x -> 
+  match DAst.get c with
+  | GRef (ref,_) ->
     let impls = implicits_of_global ref in
     let scopes = find_arguments_scope ref in
-      x, impls, scopes, []
-  | GApp (_,GRef (_,ref,_),l) as x
-      when l != [] && Flags.version_strictly_greater Flags.V8_2 ->
+      c, impls, scopes, []
+  | 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
-	x, List.map (drop_first_implicits n) impls,
+	c, List.map (drop_first_implicits n) impls,
 	List.skipn_at_least n scopes,[]
-  | x -> x,[],[],[]
+    | _ -> c,[],[],[]
+    end
+  | _ -> c,[],[],[]
 
-let error_not_enough_arguments loc =
-  user_err_loc (loc,"",str "Abbreviation is not applied enough.")
+let error_not_enough_arguments ?loc =
+  user_err ?loc  (str "Abbreviation is not applied enough.")
 
 let check_no_explicitation l =
   let is_unset (a, b) = match b with None -> false | Some _ -> true in
@@ -833,82 +962,106 @@ let check_no_explicitation l =
   match l with
   | [] -> ()
   | (_, None) :: _ -> assert false
-  | (_, Some (loc, _)) :: _ ->
-    user_err_loc (loc,"",str"Unexpected explicitation of the argument of an abbreviation.")
+  | (_, Some {loc}) :: _ ->
+    user_err ?loc  (str"Unexpected explicitation of the argument of an abbreviation.")
 
 let dump_extended_global loc = function
-  | TrueGlobal ref -> (*feedback_global loc ref;*) Dumpglob.add_glob loc ref
-  | SynDef sp -> Dumpglob.add_glob_kn loc sp
+  | TrueGlobal ref -> (*feedback_global loc ref;*) Dumpglob.add_glob ?loc ref
+  | SynDef sp -> Dumpglob.add_glob_kn ?loc sp
 
-let intern_extended_global_of_qualid (loc,qid) =
+let intern_extended_global_of_qualid {loc;v=qid} =
   let r = Nametab.locate_extended qid in dump_extended_global loc r; r
 
 let intern_reference ref =
   let qid = qualid_of_reference ref in
   let r =
     try intern_extended_global_of_qualid qid
-    with Not_found -> error_global_not_found_loc (fst qid) (snd qid)
+    with Not_found -> error_global_not_found qid
   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 =
-  match intern_extended_global_of_qualid (loc,qid) with
-  | TrueGlobal ref -> GRef (loc, ref, us), true, args
+let intern_qualid ?(no_secvar=false) qid intern env ntnvars us args =
+  let loc = qid.loc in
+  match intern_extended_global_of_qualid qid with
+  | TrueGlobal (VarRef _) when no_secvar ->
+      (* Rule out section vars since these should have been found by intern_var *)
+      raise Not_found
+  | TrueGlobal ref -> (DAst.make ?loc @@ GRef (ref, us)), true, args
   | SynDef sp ->
-      let (ids,c) = Syntax_def.search_syntactic_definition sp in
+      let (ids,c) = Syntax_def.search_syntactic_definition ?loc sp in
       let nids = List.length ids in
-      if List.length args < nids then error_not_enough_arguments loc;
+      if List.length args < nids then error_not_enough_arguments ?loc;
       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
+      let c = instantiate_notation_constr loc intern intern_cases_pattern_as_binder ntnvars subst infos c in
+      let loc = c.loc in
+      let err () =
+        user_err ?loc  (str "Notation " ++ pr_qualid qid.v
+                  ++ 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 (loc, ref, None) -> GRef (loc, ref, us)
-      | Some _, GApp (loc, GRef (loc', ref, None), arg) ->
-         GApp (loc, GRef (loc', ref, us), arg)
-      | Some _, _ ->
-        user_err_loc (loc, "", str "Notation " ++ pr_qualid qid ++
-          str " cannot have a universe instance, its expanded head
-               does not start with a reference")
+      | 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.v)
+      | 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
-    | GRef (_, VarRef _, _),_,_ -> raise Not_found
-    | r -> r
-
-let intern_applied_reference intern env namedctx (_, ntnvars as lvar) us args = function
-  | Qualid (loc, qid) ->
+let intern_applied_reference intern env namedctx (_, ntnvars as lvar) us args =
+function
+  | {loc; v=Qualid qid} ->
+      let qid = make ?loc qid in
       let r,projapp,args2 =
-	try intern_qualid loc qid intern env ntnvars us args
-	with Not_found -> error_global_not_found_loc loc qid
+        try intern_qualid qid intern env ntnvars us args
+        with Not_found -> error_global_not_found qid
       in
       let x, imp, scopes, l = find_appl_head_data r in
 	(x,imp,scopes,l), args2
-  | Ident (loc, id) ->
+  | {loc; v=Ident id} ->
       try intern_var env lvar namedctx loc id us, args
       with Not_found ->
-      let qid = qualid_of_ident id in
+      let qid = make ?loc @@ qualid_of_ident id in
       try
-	let r, projapp, args2 = intern_non_secvar_qualid loc qid intern env ntnvars us args in
+        let r, projapp, args2 = intern_qualid ~no_secvar:true qid intern env ntnvars us args in
 	let x, imp, scopes, l = find_appl_head_data r in
 	  (x,imp,scopes,l), args2
       with Not_found ->
 	(* Extra allowance for non globalizing functions *)
 	if !interning_grammar || env.unb then
 	  (gvar (loc,id) us, [], [], []), args
-	else error_global_not_found_loc loc qid
+        else error_global_not_found qid
 
 let interp_reference vars r =
   let (r,_,_,_),_ =
-    intern_applied_reference (fun _ -> error_not_enough_arguments Loc.ghost)
+    intern_applied_reference (fun _ -> error_not_enough_arguments ?loc:None)
       {ids = Id.Set.empty; unb = false ;
        tmp_scope = None; scopes = []; impls = empty_internalization_env} []
       (vars, Id.Map.empty) None [] r
@@ -917,7 +1070,17 @@ let interp_reference vars r =
 (**********************************************************************)
 (** {5 Cases }                                                        *)
 
-(** {6 Elemtary bricks } *)
+(** Private internalization patterns *)
+type 'a raw_cases_pattern_expr_r =
+  | RCPatAlias of 'a raw_cases_pattern_expr * Misctypes.lname
+  | RCPatCstr  of Globnames.global_reference
+    * 'a raw_cases_pattern_expr list * 'a raw_cases_pattern_expr list
+  (** [RCPatCstr (loc, c, l1, l2)] represents [((@ c l1) l2)] *)
+  | 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
   | [] -> {env with tmp_scope = None}, []
   | sc::scl -> {env with tmp_scope = sc}, scl
@@ -947,17 +1110,6 @@ let find_remaining_scopes pl1 pl2 ref =
   in ((try List.firstn len_pl1 allscs with Failure _ -> simple_adjust_scopes len_pl1 allscs),
       simple_adjust_scopes len_pl2 (aux (impl_list,scope_list)))
 
-let merge_subst s1 s2 = Id.Map.fold Id.Map.add s1 s2
-
-let product_of_cases_patterns ids idspl =
-  List.fold_right (fun (ids,pl) (ids',ptaill) ->
-    (ids @ ids',
-     (* Cartesian prod of the or-pats for the nth arg and the tail args *)
-     List.flatten (
-       List.map (fun (subst,p) ->
-	 List.map (fun (subst',ptail) -> (merge_subst subst subst',p::ptail)) ptaill) pl)))
-    idspl (ids,[Id.Map.empty,[]])
-
 (* @return the first variable that occurs twice in a pattern
 
 naive n^2 algo *)
@@ -965,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 (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
@@ -981,9 +1136,18 @@ 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
-    user_err_loc (loc, "", str
-    "The components of this disjunctive pattern must bind the same variables.")
+  let eq_id {v=id} {v=id'} = Id.equal id id' in
+  (* Collect remaining patterns which do not have the same variables as the first pattern *)
+  let idsl = List.filter (fun ids' -> not (List.eq_set eq_id ids ids')) idsl in
+  match idsl with
+  | ids'::_ ->
+    (* Look for an [id] which is either in [ids] and not in [ids'] or in [ids'] and not in [ids] *)
+    let ids'' = List.subtract eq_id ids ids' in
+    let ids'' = if ids'' = [] then List.subtract eq_id ids' ids else ids'' in
+    user_err ?loc
+      (strbrk "The components of this disjunctive pattern must bind the same variables (" ++
+       Id.print (List.hd ids'').v ++ strbrk " is not bound in all patterns).")
+  | [] -> ()
 
 (** Use only when params were NOT asked to the user.
     @return if letin are included *)
@@ -991,9 +1155,48 @@ let check_constructor_length env loc cstr len_pl pl0 =
   let n = len_pl + List.length pl0 in
   if Int.equal n (Inductiveops.constructor_nallargs cstr) then false else
     (Int.equal n (Inductiveops.constructor_nalldecls cstr) ||
-      (error_wrong_numarg_constructor_loc loc env cstr
+      (error_wrong_numarg_constructor ?loc env cstr
          (Inductiveops.constructor_nrealargs cstr)))
 
+open Term
+open Declarations
+
+(* Similar to Cases.adjust_local_defs but on RCPat *)
+let insert_local_defs_in_pattern (ind,j) l =
+  let (mib,mip) = Global.lookup_inductive ind in
+  if mip.mind_consnrealdecls.(j-1) = mip.mind_consnrealargs.(j-1) then
+    (* Optimisation *) l
+  else
+    let typi = mip.mind_nf_lc.(j-1) in
+    let (_,typi) = decompose_prod_n_assum (Context.Rel.length mib.mind_params_ctxt) typi in
+    let (decls,_) = decompose_prod_assum typi in
+    let rec aux decls args =
+      match decls, args with
+      | 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
+    aux (List.rev decls) l
+
+let add_local_defs_and_check_length loc env g pl args = match g with
+  | ConstructRef cstr ->
+     (* We consider that no variables corresponding to local binders
+        have been given in the "explicit" arguments, which come from a
+        "@C args" notation or from a custom user notation *)
+     let pl' = insert_local_defs_in_pattern cstr pl in
+     let maxargs = Inductiveops.constructor_nalldecls cstr in
+     if List.length pl' + List.length args > maxargs then
+       error_wrong_numarg_constructor ?loc env cstr (Inductiveops.constructor_nrealargs cstr);
+     (* Two possibilities: either the args are given with explict
+     variables for local definitions, then we give the explicit args
+     extended with local defs, so that there is nothing more to be
+     added later on; or the args are not enough to have all arguments,
+     which a priori means local defs to add in the [args] part, so we
+     postpone the insertion of local defs in the explicit args *)
+     (* Note: further checks done later by check_constructor_length *)
+     if List.length pl' + List.length args = maxargs then pl' else pl
+  | _ -> pl
+
 let add_implicits_check_length fail nargs nargs_with_letin impls_st len_pl1 pl2 =
   let impl_list = if Int.equal len_pl1 0
     then select_impargs_size (List.length pl2) impls_st
@@ -1005,10 +1208,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,RCPatAtom(Loc.ghost,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,RCPatAtom(Loc.ghost,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)
 
@@ -1016,14 +1219,14 @@ let add_implicits_check_constructor_length env loc c len_pl1 pl2 =
   let nargs = Inductiveops.constructor_nallargs c in
   let nargs' = Inductiveops.constructor_nalldecls c in
   let impls_st = implicits_of_global (ConstructRef c) in
-  add_implicits_check_length (error_wrong_numarg_constructor_loc loc env c)
+  add_implicits_check_length (error_wrong_numarg_constructor ?loc env c)
     nargs nargs' impls_st len_pl1 pl2
 
 let add_implicits_check_ind_length env loc c len_pl1 pl2 =
   let nallargs = inductive_nallargs_env env c in
   let nalldecls = inductive_nalldecls_env env c in
   let impls_st = implicits_of_global (IndRef c) in
-  add_implicits_check_length (error_wrong_numarg_inductive_loc loc env c)
+  add_implicits_check_length (error_wrong_numarg_inductive ?loc env c)
     nallargs nalldecls impls_st len_pl1 pl2
 
 (** Do not raise NotEnoughArguments thanks to preconditions*)
@@ -1033,8 +1236,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 PatVar(_,Anonymous) -> ()
-    | PatVar (loc',_) | PatCstr(loc',_,_,_) -> 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 =
@@ -1042,10 +1246,10 @@ let find_constructor loc add_params ref =
   | ConstructRef cstr -> cstr
   | IndRef _ ->
     let error = str "There is an inductive name deep in a \"in\" clause." in
-    user_err_loc (loc, "find_constructor", error)
+    user_err ?loc ~hdr:"find_constructor" error
   | ConstRef _ | VarRef _ ->
     let error = str "This reference is not a constructor." in
-    user_err_loc (loc, "find_constructor", error)
+    user_err ?loc ~hdr:"find_constructor" error
   in
   cstr, match add_params with
     | Some nb_args ->
@@ -1054,12 +1258,12 @@ let find_constructor loc add_params ref =
           then Inductiveops.inductive_nparamdecls ind
           else Inductiveops.inductive_nparams ind
       in
-      List.make nb ([], [(Id.Map.empty, PatVar(Loc.ghost,Anonymous))])
+      List.make nb ([], [(Id.Map.empty, DAst.make @@ PatVar Anonymous)])
     | None -> []
 
 let find_pattern_variable = function
-  | Ident (loc,id) -> id
-  | Qualid (loc,_) as x -> raise (InternalizationError(loc,NotAConstructor x))
+  | {v=Ident id} -> id
+  | {loc;v=Qualid _} as x -> raise (InternalizationError(loc,NotAConstructor x))
 
 let check_duplicate loc fields =
   let eq (ref1, _) (ref2, _) = eq_reference ref1 ref2 in
@@ -1067,7 +1271,7 @@ let check_duplicate loc fields =
   match dups with
   | [] -> ()
   | (r, _) :: _ ->
-    user_err_loc (loc, "", str "This record defines several times the field " ++
+    user_err ?loc (str "This record defines several times the field " ++
       pr_reference r ++ str ".")
 
 (** [sort_fields ~complete loc fields completer] expects a list
@@ -1092,17 +1296,17 @@ let sort_fields ~complete loc fields completer =
             let gr = global_reference_of_reference first_field_ref in
             (gr, Recordops.find_projection gr)
           with Not_found ->
-            user_err_loc (loc_of_reference first_field_ref, "intern",
-                          pr_reference first_field_ref ++ str": Not a projection")
+            user_err ?loc ~hdr:"intern"
+                         (pr_reference first_field_ref ++ str": Not a projection")
         in
         (* the number of parameters *)
         let nparams = record.Recordops.s_EXPECTEDPARAM in
         (* the reference constructor of the record *)
         let base_constructor =
           let global_record_id = ConstructRef record.Recordops.s_CONST in
-          try Qualid (loc, shortest_qualid_of_global Id.Set.empty global_record_id)
+          try make ?loc @@ Qualid (shortest_qualid_of_global Id.Set.empty global_record_id)
           with Not_found ->
-            anomaly (str "Environment corruption for records") in
+            anomaly (str "Environment corruption for records.") in
         let () = check_duplicate loc fields in
         let (end_index,    (* one past the last field index *)
              first_field_index,  (* index of the first field of the record *)
@@ -1113,17 +1317,17 @@ let sort_fields ~complete loc fields completer =
           let rec build_proj_list projs proj_kinds idx ~acc_first_idx acc =
             match projs with
               | [] -> (idx, acc_first_idx, acc)
-              | (Some name) :: projs ->
-                 let field_glob_ref = ConstRef name in
+              | (Some field_glob_id) :: projs ->
+                 let field_glob_ref = ConstRef field_glob_id in
                  let first_field = eq_gr field_glob_ref first_field_glob_ref in
                  begin match proj_kinds with
-                    | [] -> anomaly (Pp.str "Number of projections mismatch")
+                    | [] -> anomaly (Pp.str "Number of projections mismatch.")
                     | (_, regular) :: proj_kinds ->
                        (* "regular" is false when the field is defined
                            by a let-in in the record declaration
                            (its value is fixed from other fields). *)
                        if first_field && not regular && complete then
-                         user_err_loc (loc, "", str "No local fields allowed in a record construction.")
+                         user_err ?loc  (str "No local fields allowed in a record construction.")
                        else if first_field then
                          build_proj_list projs proj_kinds (idx+1) ~acc_first_idx:idx acc
                        else if not regular && complete then
@@ -1131,12 +1335,12 @@ let sort_fields ~complete loc fields completer =
                          build_proj_list projs proj_kinds idx ~acc_first_idx acc
                        else
                          build_proj_list projs proj_kinds (idx+1) ~acc_first_idx
-                                         ((idx, field_glob_ref) :: acc)
+                                         ((idx, field_glob_id) :: acc)
                  end
               | None :: projs ->
                  if complete then
                    (* we don't want anonymous fields *)
-                   user_err_loc (loc, "", str "This record contains anonymous fields.")
+                   user_err ?loc  (str "This record contains anonymous fields.")
                  else
                    (* anonymous arguments don't appear in proj_kinds *)
                    build_proj_list projs proj_kinds (idx+1) ~acc_first_idx acc
@@ -1150,15 +1354,14 @@ let sort_fields ~complete loc fields completer =
             | (field_ref, field_value) :: fields ->
                let field_glob_ref = try global_reference_of_reference field_ref
                with Not_found ->
-                 user_err_loc (loc_of_reference field_ref, "intern",
-                               str "The field \"" ++ pr_reference field_ref ++ str "\" does not exist.") in
+                 user_err ?loc ~hdr:"intern"
+                               (str "The field \"" ++ pr_reference field_ref ++ str "\" does not exist.") in
                let remaining_projs, (field_index, _) =
-                 let the_proj (idx, glob_ref) = eq_gr field_glob_ref glob_ref in
+                 let the_proj (idx, glob_id) = eq_gr field_glob_ref (ConstRef glob_id) in
                  try CList.extract_first the_proj remaining_projs
                  with Not_found ->
-                   user_err_loc
-                     (loc, "",
-                      str "This record contains fields of different records.")
+                   user_err ?loc 
+                     (str "This record contains fields of different records.")
                in
                index_fields fields remaining_projs ((field_index, field_value) :: acc)
             | [] ->
@@ -1181,7 +1384,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;
 }
 
@@ -1192,17 +1395,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 }
 
@@ -1212,16 +1418,42 @@ let alias_of als = match als.alias_ids with
 
 *)
 
-let rec subst_pat_iterator y t p = match p with
-  | RCPatAtom (_,id) ->
-    begin match id with Some x when Id.equal x y -> t | _ -> p end
-  | RCPatCstr (loc,id,l1,l2) ->
-     RCPatCstr (loc,id,List.map (subst_pat_iterator y t) l1,
-	       List.map (subst_pat_iterator y t) l2)
-  | RCPatAlias (l,p,a) -> RCPatAlias (l,subst_pat_iterator y t p,a)
-  | RCPatOr (l,pl) -> RCPatOr (l,List.map (subst_pat_iterator y t) pl)
+let is_zero s =
+  let rec aux i =
+    Int.equal (String.length s) i || (s.[i] == '0' && aux (i+1))
+  in aux 0
 
-let drop_notations_pattern looked_for =
+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 *)
+     List.flatten (
+       List.map (fun (subst,p) ->
+	 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 = DAst.(map (function
+  | RCPatAtom id as p ->
+    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 *)
   let ensure_kind top loc g =
@@ -1229,15 +1461,31 @@ let drop_notations_pattern looked_for =
       if top then looked_for g else
       match g with ConstructRef _ -> () | _ -> raise Not_found
     with Not_found ->
-      error_invalid_pattern_notation loc
+      error_invalid_pattern_notation ?loc ()
   in
   let test_kind top =
     if top then looked_for else function ConstructRef _ -> () | _ -> raise Not_found
   in
+  (** [rcp_of_glob] : from [glob_constr] to [raw_cases_pattern_expr] *)
+  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 (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 =
-    let (loc,qid) = qualid_of_reference re in
+    let qid = qualid_of_reference re in
     try
-      match locate_extended qid with
+      match locate_extended qid.v with
       | SynDef sp ->
 	let (vars,a) = Syntax_def.search_syntactic_definition sp in
 	(match a with
@@ -1255,80 +1503,96 @@ let drop_notations_pattern looked_for =
               (* Convention: do not deactivate implicit arguments and scopes for further arguments *)
 	      test_kind top g;
 	      let nvars = List.length vars in
-	      if List.length pats < nvars then error_not_enough_arguments loc;
+              if List.length pats < nvars then error_not_enough_arguments ?loc:qid.loc;
 	      let pats1,pats2 = List.chop nvars pats in
 	      let subst = make_subst vars pats1 in
-	      let idspl1 = List.map (in_not false loc scopes (subst, Id.Map.empty) []) args in
+              let idspl1 = List.map (in_not false qid.loc scopes (subst, Id.Map.empty) []) args in
 	      let (_,argscs) = find_remaining_scopes pats1 pats2 g in
 	      Some (g, idspl1, List.map2 (in_pat_sc scopes) argscs pats2)
 	| _ -> raise Not_found)
       | TrueGlobal g ->
 	  test_kind top g;
-	  Dumpglob.add_glob loc g;
+          Dumpglob.add_glob ?loc:qid.loc g;
 	  let (_,argscs) = find_remaining_scopes [] pats g in
 	  Some (g,[],List.map2 (fun x -> in_pat false (x,snd scopes)) argscs pats)
     with Not_found -> None
-  and in_pat top scopes = function
-    | CPatAlias (loc, p, id) -> RCPatAlias (loc, in_pat top scopes p, id)
-    | CPatRecord (loc, l) ->
+  and in_pat top scopes pt =
+    let open CAst in
+    let loc = pt.loc in
+    match pt.v with
+    | 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 -> (CPatAtom (loc, None))) in
+	sort_fields ~complete:false loc l (fun _idx -> CAst.make ?loc @@ CPatAtom None) in
       begin match sorted_fields with
-	| None -> RCPatAtom (loc, None)
+	| None -> DAst.make ?loc @@ RCPatAtom None
 	| Some (n, head, pl) ->
           let pl =
             if !asymmetric_patterns then pl else
-            let pars = List.make n (CPatAtom (loc, None)) in
+            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) -> RCPatCstr(loc, a, b, c)
-	    |None -> raise (InternalizationError (loc,NotAConstructor head))
+	    | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr(a, b, c)
+	    | None -> raise (InternalizationError (loc,NotAConstructor head))
       end
-    | CPatCstr (loc, head, None, pl) ->
+    | CPatCstr (head, None, pl) ->
       begin
 	match drop_syndef top scopes head pl with
-	  | Some (a,b,c) -> RCPatCstr(loc, a, b, c)
+	  | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr(a, b, c)
 	  | None -> raise (InternalizationError (loc,NotAConstructor head))
       end
-     | CPatCstr (loc, r, Some expl_pl, pl) ->
-      let g = try locate (snd (qualid_of_reference r))
+     | CPatCstr (r, Some expl_pl, pl) ->
+      let g = try locate (qualid_of_reference r).v
 	      with Not_found ->
  	      raise (InternalizationError (loc,NotAConstructor r)) in
       if expl_pl == [] then
         (* Convention: (@r) deactivates all further implicit arguments and scopes *)
-        RCPatCstr (loc, 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
-        RCPatCstr (loc, g, List.map2 (in_pat_sc scopes) argscs1 expl_pl @ List.map (in_pat false scopes) pl, [])
-    | CPatNotation (loc,"- _",([CPatPrim(_,Numeral p)],[]),[])
-	when Bigint.is_strictly_pos p ->
-      fst (Notation.interp_prim_token_cases_pattern_expr loc (ensure_kind false loc) (Numeral (Bigint.neg p)) scopes)
-    | CPatNotation (_,"( _ )",([a],[]),[]) ->
+        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 scopes pat
+    | CPatNotation ("( _ )",([a],[]),[]) ->
       in_pat top scopes a
-    | CPatNotation (loc, ntn, fullargs,extrargs) ->
-      let ntn,(args,argsl as fullargs) = contract_pat_notation ntn fullargs in
-      let ((ids',c),df) = Notation.interp_notation loc ntn scopes in
-      let (ids',idsl',_) = split_by_type ids' 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
-    | CPatDelimiters (loc, key, e) ->
-      in_pat top (None,find_delimiters_scope loc key::snd scopes) e
-    | CPatPrim (loc,p) -> fst (Notation.interp_prim_token_cases_pattern_expr loc (test_kind false) p scopes)
-    | CPatAtom (loc, Some id) ->
+    | 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 (terms,termlists) = split_by_type_pat ?loc ids' (terms,termlists) in
+      Dumpglob.dump_notation_location (patntn_loc ?loc fullargs ntn) ntn df;
+      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 scopes pat
+    | CPatAtom (Some id) ->
       begin
 	match drop_syndef top scopes id [] with
-	  |Some (a,b,c) -> RCPatCstr (loc, a, b, c)
-	  |None -> RCPatAtom (loc, 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 (loc,None) -> RCPatAtom (loc,None)
-    | CPatOr (loc, pl) ->
-      RCPatOr (loc,List.map (in_pat top scopes) pl)
-    | CPatCast _ ->
-      assert false
+    | 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
+         are supportted only in local binders and only at top
+         level. In fact, they are currently eliminated by the
+         parser. The only reason why they are in the
+         [cases_pattern_expr] type is that the parser needs to factor
+         the "(c : t)" notation with user defined notations (such as
+         the pair). In the long term, we will try to support such
+         casts everywhere, and use them to print the domains of
+         lambdas in the encoding of match in constr. This check is
+         here and not in the parser because it would require
+         duplicating the levels of the [pattern] rule. *)
+      CErrors.user_err ?loc ~hdr:"drop_notations_pattern"
+                            (Pp.strbrk "Casts are not supported in this pattern.")
   and in_pat_sc scopes x = in_pat false (x,snd scopes)
   and in_not top loc scopes (subst,substlist as fullsubst) args = function
     | NVar id ->
@@ -1340,22 +1604,22 @@ let drop_notations_pattern looked_for =
 	  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 RCPatAtom (loc,Some id) else
-	    anomaly (str "Unbound pattern notation variable: " ++ Id.print id)
+          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
-      RCPatCstr (loc, 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
-      RCPatCstr (loc, g,
-		 List.map2 (fun x -> in_not false loc (x,snd scopes) fullsubst []) argscs1 pl @
-		 List.map (in_pat false scopes) args, [])
-    | NList (x,y,iter,terminator,lassoc) ->
-      if not (List.is_empty args) then user_err_loc
-        (loc,"",strbrk "Application of arguments to a recursive notation not supported in patterns.");
+      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
+      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
          (* All elements of the list are in scopes (scopt,subscopes) *)
 	 let (l,(scopt,subscopes)) = Id.Map.find x substlist in
@@ -1364,27 +1628,28 @@ let drop_notations_pattern looked_for =
            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"))
+         anomaly (Pp.str "Inconsistent substitution of recursive notation."))
     | NHole _ ->
       let () = assert (List.is_empty args) in
-      RCPatAtom (loc, None)
-    | t -> error_invalid_pattern_notation loc
+      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 (ids',pll) = product_of_cases_patterns aliases.alias_ids (idslpl1@idslpl2) 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, PatCstr (loc,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
-  match pat with
-    | RCPatAlias (loc, p, id) ->
+  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
-    | RCPatCstr (loc, head, expl_pl, pl) ->
+      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
 	let c,idslpl1 = find_constructor loc len head in
@@ -1396,92 +1661,59 @@ 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 (loc, Some id) ->
-      let aliases = merge_aliases aliases id in
-      (aliases.alias_ids,[aliases.alias_map, PatVar (loc, alias_of aliases)])
-    | RCPatAtom (loc, None) ->
+    | 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, PatVar (loc, alias_of aliases)])
-    | RCPatOr (loc, pl) ->
+      (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')
 
-(* [check_no_patcast p] raises an error if [p] contains a cast. This code is a
-   bit ad-hoc, and is due to current restrictions on casts in patterns. We
-   support them only in local binders and only at top level. In fact, they are
-   currently eliminated by the parser. The only reason why they are in the
-   [cases_pattern_expr] type is that the parser needs to factor the "(c : t)"
-   notation with user defined notations (such as the pair). In the long term, we
-   will try to support such casts everywhere, and use them to print the domains
-   of lambdas in the encoding of match in constr. We put this check here and not
-   in the parser because it would require to duplicate the levels of the
-   [pattern] rule. *)
-let rec check_no_patcast = function
-  | CPatCast (loc,_,_) ->
-     CErrors.user_err_loc (loc, "check_no_patcast",
-                           Pp.strbrk "Casts are not supported here.")
-  | CPatDelimiters(_,_,p)
-  | CPatAlias(_,p,_) -> check_no_patcast p
-  | CPatCstr(_,_,opl,pl) ->
-     Option.iter (List.iter check_no_patcast) opl;
-     List.iter check_no_patcast pl
-  | CPatOr(_,pl) ->
-     List.iter check_no_patcast pl
-  | CPatNotation(_,_,subst,pl) ->
-     check_no_patcast_subst subst;
-     List.iter check_no_patcast pl
-  | CPatRecord(_,prl) ->
-     List.iter (fun (_,p) -> check_no_patcast p) prl
-  | CPatAtom _ | CPatPrim _ -> ()
-
-and check_no_patcast_subst (pl,pll) =
-  List.iter check_no_patcast pl;
-  List.iter (List.iter check_no_patcast) pll
-
-let intern_cases_pattern genv scopes aliases pat =
-  check_no_patcast pat;
-  intern_pat genv aliases
-    (drop_notations_pattern (function ConstructRef _ -> () | _ -> raise Not_found) scopes pat)
+let intern_cases_pattern 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 =
-  check_no_patcast pat;
+let intern_ind_pattern genv ntnvars scopes pat =
   let no_not =
     try
-      drop_notations_pattern (function (IndRef _ | ConstructRef _) -> () | _ -> raise Not_found) scopes pat
-    with InternalizationError(loc,NotAConstructor _) -> error_bad_inductive_type loc
+      drop_notations_pattern (function (IndRef _ | ConstructRef _) -> () | _ -> raise Not_found) genv scopes pat
+    with InternalizationError(loc,NotAConstructor _) -> error_bad_inductive_type ?loc
   in
-  match no_not with
-    | RCPatCstr (loc, head, expl_pl, pl) ->
-      let c = (function IndRef ind -> ind | _ -> error_bad_inductive_type loc) head in
+  let loc = no_not.CAst.loc in
+  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 [] (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 (raw_cases_pattern_expr_loc x)
+       | _ -> error_bad_inductive_type ?loc)
+    | x -> error_bad_inductive_type ?loc
 
 (**********************************************************************)
 (* Utilities for application                                          *)
 
 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
@@ -1489,10 +1721,19 @@ 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
-  | GRef (loc,r,_) | GApp (_,GRef (loc,r,_),_) -> (loc,Evar_kinds.ImplicitArg (r,i,b),Misctypes.IntroAnonymous,None)
-  | GVar (loc,id) -> (loc,Evar_kinds.ImplicitArg (VarRef id,i,b),Misctypes.IntroAnonymous,None)
-  | _ -> anomaly (Pp.str "Only refs have implicits")
+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 =
   List.exists (fun imp -> is_status_implicit imp && Id.equal id (name_of_implicit imp))
@@ -1504,14 +1745,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
-		  (loc,"",str "Wrong argument name: " ++ pr_id id ++ str ".");
+		user_err ?loc 
+		  (str "Wrong argument name: " ++ Id.print id ++ str ".");
 	      if Id.Map.mem id eargs then
-		user_err_loc (loc,"",str "Argument name " ++ pr_id id
+		user_err ?loc  (str "Argument name " ++ Id.print id
 		++ str " occurs more than once.");
 	      id
 	  | ExplByPos (p,_id) ->
@@ -1521,11 +1762,11 @@ let extract_explicit_arg imps args =
 		  if not (is_status_implicit imp) then failwith "imp";
 		  name_of_implicit imp
 		with Failure _ (* "nth" | "imp" *) ->
-		  user_err_loc
-		    (loc,"",str"Wrong argument position: " ++ int p ++ str ".")
+		  user_err ?loc 
+		    (str"Wrong argument position: " ++ int p ++ str ".")
 	      in
 	      if Id.Map.mem id eargs then
-		user_err_loc (loc,"",str"Argument at position " ++ int p ++
+		user_err ?loc  (str"Argument at position " ++ int p ++
 		  str " is mentioned more than once.");
 	      id in
 	  (Id.Map.add id (loc, a) eargs, rargs)
@@ -1534,17 +1775,17 @@ let extract_explicit_arg imps args =
 (**********************************************************************)
 (* Main loop                                                          *)
 
-let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
-  let rec intern env = function
-    | CRef (ref,us) as x ->
+let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
+  let rec intern env = CAst.with_loc_val (fun ?loc -> function
+    | CRef (ref,us) ->
 	let (c,imp,subscopes,l),_ =
-	  intern_applied_reference intern env (Environ.named_context globalenv) 
-	    lvar us [] ref 
+	  intern_applied_reference intern env (Environ.named_context globalenv)
+	    lvar us [] ref
 	in
-	  apply_impargs c env imp subscopes l (constr_loc x)
+	  apply_impargs c env imp subscopes l loc
 
-    | CFix (loc, (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
@@ -1556,10 +1797,11 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
 	     let intern_ro_arg f =
 	       let before, after = split_at_annot bl n in
 	       let (env',rbefore) = List.fold_left intern_local_binder (env,[]) before in
-               let rbefore = List.map (function BDRawDef a -> a | BDPattern _ -> assert false) rbefore in
 	       let ro = f (intern env') in
-	       let n' = Option.map (fun _ -> List.count (fun (_,(_,_,b,_)) -> (* remove let-ins *) b = None) rbefore) n in
-               let rbefore = List.map (fun a -> BDRawDef a) rbefore in
+	       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
 	     in
 	     let n, ro, (env',rbl) =
@@ -1571,28 +1813,24 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
 	       | CMeasureRec (m,r) ->
 		   intern_ro_arg (fun f -> GMeasureRec (f m, Option.map f r))
 	     in
-	     let bl =
-               List.rev_map
-                 (function
-                  | BDRawDef a -> a
-                  | BDPattern (loc,_,_,_,_) ->
-                      Loc.raise loc (Stream.Error "pattern with quote not allowed after fix")) rbl in
-	       ((n, ro), bl, intern_type env' ty, env')) dl in
+	     let bl = List.rev (List.map glob_local_binder_of_extended rbl) in
+             ((n, ro), bl, intern_type env' ty, env')) dl in
         let idl = Array.map2 (fun (_,_,_,_,bd) (a,b,c,env') ->
 	     let env'' = List.fold_left_i (fun i en name -> 
 					     let (_,bli,tyi,_) = idl_temp.(i) in
-					     let fix_args = (List.map (fun (_,(na, bk, _, _)) -> (build_impls bk na)) bli) in
+					     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.ghost, 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
-	GRec (loc,GFix
+	DAst.make ?loc @@
+          GRec (GFix
 	      (Array.map (fun (ro,_,_,_) -> ro) idl,n),
               Array.of_list lf,
-              Array.map (fun (_,bl,_,_) -> List.map snd bl) idl,
+              Array.map (fun (_,bl,_,_) -> bl) idl,
               Array.map (fun (_,_,ty,_) -> ty) idl,
               Array.map (fun (_,_,_,bd) -> bd) idl)
-    | CCoFix (loc, (locid,iddef), dl) ->
-        let lf = List.map (fun ((_, id),_,_,_) -> id) dl in
+    | 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
@@ -1600,96 +1838,100 @@ let internalize globalenv env allow_patvar (_, 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
-            let rbl = List.map (function BDRawDef a -> a | BDPattern _ -> assert false) rbl in
-            (List.rev rbl,
+            (List.rev (List.map glob_local_binder_of_extended rbl),
              intern_type env' ty,env')) dl in
 	let idl = Array.map2 (fun (_,_,_,bd) (b,c,env') ->
 	     let env'' = List.fold_left_i (fun i en name ->
 					     let (bli,tyi,_) = idl_tmp.(i) in
-					     let cofix_args =  List.map (fun (_, (na, bk, _, _)) -> (build_impls bk na)) bli in
+					     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.ghost, 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
-	GRec (loc,GCoFix n,
+	DAst.make ?loc @@
+	GRec (GCoFix n,
               Array.of_list lf,
-              Array.map (fun (bl,_,_) -> List.map snd bl) idl,
+              Array.map (fun (bl,_,_) -> bl) idl,
               Array.map (fun (_,ty,_) -> ty) idl,
               Array.map (fun (_,_,bd) -> bd) idl)
-    | CProdN (loc,[],c2) ->
-        intern_type env c2
-    | CProdN (loc,(nal,bk,ty)::bll,c2) ->
-        iterate_prod loc env bk ty (CProdN (loc, bll, c2)) nal
-    | CLambdaN (loc,[],c2) ->
+    | 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 (loc,(nal,bk,ty)::bll,c2) ->
-	iterate_lam loc (reset_tmp_scope env) bk ty (CLambdaN (loc, bll, c2)) nal
-    | CLetIn (loc,na,c1,c2) ->
+    | 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
-	GLetIn (loc, snd na, inc1,
+	let int = Option.map (intern_type env) t in
+	DAst.make ?loc @@
+        GLetIn (na.CAst.v, inc1, int,
           intern (push_name_env ntnvars (impls_term_list inc1) env na) c2)
-    | CNotation (loc,"- _",([CPrim (_,Numeral p)],[],[]))
-	when Bigint.is_strictly_pos p ->
-	intern env (CPrim (loc,Numeral (Bigint.neg p)))
-    | CNotation (_,"( _ )",([a],[],[])) -> intern env a
-    | CNotation (loc,ntn,args) ->
+    | 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 (ntn,args) ->
         intern_notation intern env ntnvars loc ntn args
-    | CGeneralization (loc,b,a,c) ->
+    | CGeneralization (b,a,c) ->
         intern_generalization intern env ntnvars loc b a c
-    | CPrim (loc, p) ->
-	fst (Notation.interp_prim_token loc p (env.tmp_scope,env.scopes))
-    | CDelimiters (loc, key, e) ->
+    | CPrim p ->
+	fst (Notation.interp_prim_token ?loc p (env.tmp_scope,env.scopes))
+    | CDelimiters (key, e) ->
 	intern {env with tmp_scope = None;
-		  scopes = find_delimiters_scope loc key :: env.scopes} e
-    | CAppExpl (loc, (isproj,ref,us), args) ->
+		  scopes = find_delimiters_scope ?loc key :: env.scopes} e
+    | CAppExpl ((isproj,ref,us), args) ->
         let (f,_,args_scopes,_),args =
 	  let args = List.map (fun a -> (a,None)) args in
 	  intern_applied_reference intern env (Environ.named_context globalenv) 
 	    lvar us args ref 
 	in
 	  (* Rem: GApp(_,f,[]) stands for @f *)
-	  GApp (loc, f, intern_args env args_scopes (List.map fst args))
+	DAst.make ?loc @@
+	  GApp (f, intern_args env args_scopes (List.map fst args))
 
-    | CApp (loc, (isproj,f), args) ->
-        let f,args = match f with
+    | CApp ((isproj,f), args) ->
+        let f,args = match f.CAst.v with
           (* Compact notations like "t.(f args') args" *)
-          | 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
 	let (c,impargs,args_scopes,l),args =
-          match f with
+          match f.CAst.v with
             | CRef (ref,us) -> 
 	       intern_applied_reference intern env
 		 (Environ.named_context globalenv) lvar us args ref
-            | CNotation (loc,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
-            | x -> (intern env f,[],[],[]), args in
-          apply_impargs c env impargs args_scopes 
+            | _ -> (intern env f,[],[],[]), args in
+          apply_impargs c env impargs args_scopes
 	    (merge_impargs l args) loc
 
-    | CRecord (loc, fs) ->
+    | CRecord fs ->
        let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in
        let fields =
 	 sort_fields ~complete:true loc fs
-	             (fun _idx -> CHole (loc, Some (Evar_kinds.QuestionMark st),
-                                                 Misctypes.IntroAnonymous, None))
+	             (fun _idx -> CAst.make ?loc @@ CHole (Some (Evar_kinds.QuestionMark (st,Anonymous)),
+                                                           Misctypes.IntroAnonymous, None))
        in
        begin
 	  match fields with
-	    | None -> user_err_loc (loc, "intern", str"No constructor inference.")
+	    | None -> user_err ?loc ~hdr:"intern" (str"No constructor inference.")
 	    | Some (n, constrname, args) ->
-		let pars = List.make n (CHole (loc, None, Misctypes.IntroAnonymous, None)) in
-                let app = CAppExpl (loc, (None, constrname,None), List.rev_append pars args) in
+		let pars = List.make n (CAst.make ?loc @@ CHole (None, Misctypes.IntroAnonymous, None)) in
+                let app = CAst.make ?loc @@ CAppExpl ((None, constrname,None), List.rev_append pars args) in
 	  intern env app
 	end
-    | CCases (loc, sty, rtnpo, tms, eqns) ->
+    | 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 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
@@ -1699,103 +1941,123 @@ let internalize globalenv env allow_patvar (_, 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.ghost,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
 	    | [] -> []
-	    | (_,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
 	  | [] -> Option.map (intern_type env') rtnpo (* Only PatVar in "in" clauses *)
 	  | l ->
              (* Build a return predicate by expansion of the patterns of the "in" clause *)
-             let thevars,thepats = List.split l in
+             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 -> GVar (Loc.ghost,id),(Name id,None)) thevars (* "match v1,..,vn" *) in
-             let main_sub_eqn =
-               (Loc.ghost,[],thepats, (* "|p1,..,pn" *)
+             let sub_tms = List.map (fun id -> (DAst.make @@ GVar id),(Name id,None)) thevars (* "match v1,..,vn" *) in
+             let main_sub_eqn = CAst.make @@
+               ([],thepats, (* "|p1,..,pn" *)
 		Option.cata (intern_type env')
-                  (GHole(Loc.ghost,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.ghost,[],List.make (List.length thepats) (PatVar(Loc.ghost,Anonymous)), (* "|_,..,_" *)
-		  GHole(Loc.ghost,Evar_kinds.ImpossibleCase,Misctypes.IntroAnonymous,None)]   (* "=> _" *) in
-             Some (GCases(Loc.ghost,Term.RegularStyle,sub_rtn,sub_tms,main_sub_eqn::catch_all_sub_eqn))
+                  [CAst.make @@ ([],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
-	GCases (loc, sty, rtnpo, tms, List.flatten eqns')
-    | CLetTuple (loc, nal, (na,po), b, c) ->
+	DAst.make ?loc @@
+	GCases (sty, rtnpo, tms, List.flatten eqns')
+    | CLetTuple (nal, (na,po), b, c) ->
 	let env' = reset_tmp_scope env in
 	(* "in" is None so no match to add *)
         let ((b',(na',_)),_,_) = intern_case_item env' Id.Set.empty (b,na,None) in
         let p' = Option.map (fun u ->
 	  let env'' = push_name_env ntnvars (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env')
-	    (Loc.ghost,na') in
+            (CAst.make na') in
 	  intern_type env'' u) po in
-        GLetTuple (loc, 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 (loc, c, (na,po), b1, b2) ->
+    | 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.ghost,na') in
+            (CAst.make na') in
 	  intern_type env'' p) po in
-        GIf (loc, c', (na', p'), intern env b1, intern env b2)
-    | CHole (loc, k, naming, solve) ->
+	DAst.make ?loc @@
+        GIf (c', (na', p'), intern env b1, intern env b2)
+    | CHole (k, naming, solve) ->
         let k = match k with
         | None ->
            let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in
-           Evar_kinds.QuestionMark st
+           (match naming with
+           | Misctypes.IntroIdentifier id -> Evar_kinds.NamedHole id
+           | _ -> Evar_kinds.QuestionMark (st,Anonymous))
         | Some k -> k
         in
         let solve = match solve with
         | 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
           let lvars = Id.Set.union lvars ntnvars in
-          let lvars = Id.Set.union lvars env.ids in
+          let ltacvars = Id.Set.union lvars env.ids in
           let ist = {
-            Genintern.ltacvars = lvars;
-            genv = globalenv;
+            Genintern.genv = globalenv;
+            ltacvars;
+            extra;
           } in
           let (_, glb) = Genintern.generic_intern ist gen in
           Some glb
         in
-	GHole (loc, k, naming, solve)
+	DAst.make ?loc @@
+	GHole (k, naming, solve)
     (* Parsing pattern variables *)
-    | CPatVar (loc, n) when allow_patvar ->
-	GPatVar (loc, (true,n))
-    | CEvar (loc, n, []) when allow_patvar ->
-	GPatVar (loc, (false,n))
+    | CPatVar n when pattern_mode ->
+	DAst.make ?loc @@
+	GPatVar (Evar_kinds.SecondOrderPatVar n)
+    | CEvar (n, []) when pattern_mode ->
+	DAst.make ?loc @@
+	GPatVar (Evar_kinds.FirstOrderPatVar n)
     (* end *)
     (* Parsing existential variables *)
-    | CEvar (loc, n, l) ->
-	GEvar (loc, n, List.map (on_snd (intern env)) l)
-    | CPatVar (loc, _) ->
+    | CEvar (n, l) ->
+	DAst.make ?loc @@
+	GEvar (n, List.map (on_snd (intern env)) l)
+    | CPatVar _ ->
         raise (InternalizationError (loc,IllegalMetavariable))
     (* end *)
-    | CSort (loc, s) ->
-	GSort(loc,s)
-    | CCast (loc, c1, c2) ->
-        GCast (loc,intern env c1, Miscops.map_cast_type (intern_type env) c2)
-
+    | CSort s ->
+	DAst.make ?loc @@
+	GSort s
+    | CCast (c1, c2) ->
+	DAst.make ?loc @@
+        GCast (intern env c1, Miscops.map_cast_type (intern_type env) c2)
+  )
   and intern_type env = intern (set_type_scope env)
 
-  and intern_local_binder env bind =
+  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 [] idsl_pll
+    product_of_cases_patterns empty_alias idsl_pll
 
   (* Expands a disjunction of multiple pattern *)
   and intern_disjunctive_multiple_pattern env loc n mpl =
@@ -1807,29 +2069,32 @@ let internalize globalenv env allow_patvar (_, 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) ->
       let rhs = replace_vars_constr_expr asubst rhs in
       let rhs' = intern {env with ids = env_ids} rhs in
-      (loc,eqn_ids,pl,rhs')) pll
+      CAst.make ?loc (eqn_ids,pl,rhs')) pll
 
   and intern_case_item env forbidden_names_for_gen (tm,na,t) =
     (* the "match" part *)
     let tm' = intern env tm in
     (* the "as" part *)
-    let extra_id,na = match tm', na with
-      | GVar (loc,id), None when not (Id.Map.mem id (snd lvar)) -> Some id,(loc,Name id)
-      | GRef (loc, VarRef id, _), None -> Some id,(loc,Name id)
-      | _, None -> None,(Loc.ghost,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")])
@@ -1841,44 +2106,40 @@ let internalize globalenv env allow_patvar (_, 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,PatVar(loc,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.ghost,Anonymous)::var_acc)
+                canonize_args t l forbidden_names match_acc ((CAst.make Anonymous)::var_acc)
 	      | [],[] ->
 		(add_name match_acc na, var_acc)
-	      | _::t,PatVar (loc,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 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)) (CAst.make ?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) ((CAst.make ?loc:(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
-	match_to_do, Some (cases_pattern_expr_loc t,ind,List.rev_map snd nal)
+	  canonize_args args_rel l forbidden_names_for_gen [] [] in
+        match_to_do, Some (CAst.make ?loc:(cases_pattern_expr_loc t) (ind,List.rev_map (fun x -> x.v) nal))
     | None ->
       [], None in
-    (tm',(snd na,typ)), extra_id, match_td
-
-  and iterate_prod loc2 env bk ty body nal =
-    let env, bl = intern_assumption intern ntnvars env nal bk ty in
-    it_mkGProd loc2 bl (intern_type env body)
-
-  and iterate_lam loc2 env bk ty body nal =
-    let env, bl = intern_assumption intern ntnvars env nal bk ty in
-    it_mkGLambda loc2 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
     if !parsing_explicit then
       if Id.Map.is_empty eargs then intern_args env subscopes rargs
-      else error "Arguments given by name or position not supported in explicit mode."
+      else user_err Pp.(str "Arguments given by name or position not supported in explicit mode.")
     else
     let rec aux n impl subscopes eargs rargs =
       let (enva,subscopes') = apply_scope_env env subscopes in
@@ -1895,34 +2156,37 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
             (* with implicit arguments if maximal insertion is set *)
 	    []
 	  else
-	    GHole (set_hole_implicit (n,get_implicit_name n l) (force_inference_of imp) c) ::
-	      aux (n+1) impl' subscopes' eargs rargs
+              (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
       | (imp::impl', a::rargs') ->
 	  intern enva a :: aux (n+1) impl' subscopes' eargs rargs'
       | (imp::impl', []) ->
 	  if not (Id.Map.is_empty eargs) then
 	    (let (id,(loc,_)) = Id.Map.choose eargs in
-	       user_err_loc (loc,"",str "Not enough non implicit \
+               user_err ?loc (str "Not enough non implicit \
 	    arguments to accept the argument bound to " ++
-		 pr_id id ++ str"."));
+		 Id.print id ++ str"."));
 	  []
       | ([], rargs) ->
 	  assert (Id.Map.is_empty eargs);
 	  intern_args env subscopes rargs
     in aux 1 l subscopes eargs rargs
 
-  and apply_impargs c env imp subscopes l loc = 
+  and apply_impargs c env imp subscopes l loc =
     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 
-      | GApp (loc', g, args) -> GApp (Loc.merge loc' loc, g, args@l)
-      | _ -> GApp (Loc.merge (loc_of_glob_constr f) loc, 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
     | [] -> []
     | a::args ->
@@ -1934,8 +2198,8 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
     intern env c
   with
       InternalizationError (loc,e) ->
-	user_err_loc (loc,"internalize",
-	  explain_internalization_error e)
+	user_err ?loc ~hdr:"internalize"
+	  (explain_internalization_error e)
 
 (**************************************************************************)
 (* Functions to translate constr_expr into glob_constr                    *)
@@ -1946,35 +2210,34 @@ let extract_ids env =
     (Termops.ids_of_rel_context (Environ.rel_context env))
     Id.Set.empty
 
-let scope_of_type_kind = function
+let scope_of_type_kind sigma = function
   | IsType -> Notation.current_type_scope_name ()
-  | OfType typ -> compute_type_scope typ
+  | OfType typ -> compute_type_scope sigma typ
   | WithoutTypeConstraint -> None
 
 let empty_ltac_sign = {
   ltac_vars = Id.Set.empty;
   ltac_bound = Id.Set.empty;
+  ltac_extra = Genintern.Store.empty;
 }
 
-let intern_gen kind env
-               ?(impls=empty_internalization_env) ?(allow_patvar=false) ?(ltacvars=empty_ltac_sign)
+let intern_gen kind env sigma
+               ?(impls=empty_internalization_env) ?(pattern_mode=false) ?(ltacvars=empty_ltac_sign)
                c =
-  let tmp_scope = scope_of_type_kind kind in
+  let tmp_scope = scope_of_type_kind sigma kind in
   internalize env {ids = extract_ids env; unb = false;
 		         tmp_scope = tmp_scope; scopes = [];
 			 impls = impls}
-    allow_patvar (ltacvars, Id.Map.empty) c
-
-let intern_constr env c = intern_gen WithoutTypeConstraint env c
-
-let intern_type env c = intern_gen IsType env c
+    pattern_mode (ltacvars, Id.Map.empty) c
 
+let intern_constr env sigma c = intern_gen WithoutTypeConstraint env sigma c
+let intern_type env sigma c = intern_gen IsType env sigma 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 (loc,"internalize",explain_internalization_error e)
+	user_err ?loc ~hdr:"internalize" (explain_internalization_error e)
 
 
 (*********************************************************************)
@@ -1983,7 +2246,7 @@ let intern_pattern globalenv patt =
 (* All evars resolved *)
 
 let interp_gen kind env sigma ?(impls=empty_internalization_env) c =
-  let c = intern_gen kind ~impls env c in
+  let c = intern_gen kind ~impls env sigma c in
   understand ~expected_type:kind env sigma c
 
 let interp_constr env sigma ?(impls=empty_internalization_env) c =
@@ -1998,51 +2261,52 @@ let interp_casted_constr env sigma ?(impls=empty_internalization_env) c typ =
 (* Not all evars expected to be resolved *)
 
 let interp_open_constr env sigma c =
-  understand_tcc env sigma (intern_constr env c)
+  understand_tcc env sigma (intern_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 c = intern_gen expected_type ~impls env sigma c in
   let imps = Implicit_quantifiers.implicits_of_glob_constr ~with_products:(expected_type == IsType) c in
-    understand_tcc_evars env evdref ~expected_type 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 c = intern_gen expected_type ~impls env c in
-  understand_tcc_evars env evdref ~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 sigma c in
+  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 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 *)
 
-let intern_constr_pattern env ?(as_type=false) ?(ltacvars=empty_ltac_sign) c =
+let intern_constr_pattern env sigma ?(as_type=false) ?(ltacvars=empty_ltac_sign) c =
   let c = intern_gen (if as_type then IsType else WithoutTypeConstraint)
-            ~allow_patvar:true ~ltacvars env c in
+            ~pattern_mode:true ~ltacvars env sigma 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
@@ -2051,24 +2315,23 @@ 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
 
 (* Interpret binders and contexts  *)
 
 let interp_binder env sigma na t =
-  let t = intern_gen IsType env t in
-  let t' = locate_if_hole (loc_of_glob_constr t) na t in
+  let t = intern_gen IsType env sigma t in
+  let t' = locate_if_hole ?loc:(loc_of_glob_constr t) na t in
   understand ~expected_type:IsType env sigma t'
 
-let interp_binder_evars env evdref na t =
-  let t = intern_gen IsType env t in
-  let t' = locate_if_hole (loc_of_glob_constr t) na t in
-  understand_tcc_evars env evdref ~expected_type:IsType t'
-
-open Environ
+let interp_binder_evars env sigma na t =
+  let t = intern_gen IsType env sigma t in
+  let t' = locate_if_hole ?loc:(loc_of_glob_constr t) na t in
+  understand_tcc env sigma ~expected_type:IsType t'
 
 let my_intern_constr env lvar acc c =
   internalize env acc false lvar c
@@ -2078,30 +2341,24 @@ let intern_context global_level env impl_env binders =
   let lvar = (empty_ltac_sign, Id.Map.empty) in
   let lenv, bl = List.fold_left
 	    (fun (lenv, bl) b ->
-               let bl = List.map (fun a -> BDRawDef a) bl in
 	       let (env, bl) = intern_local_binder_aux ~global_level (my_intern_constr env lvar) Id.Map.empty (lenv, bl) b in
-               let bl =
-                 List.map
-                   (function
-                    | BDRawDef a -> a
-                    | BDPattern (loc,_,_,_,_) ->
-                        Loc.raise loc (Stream.Error "pattern with quote not allowed here")) bl in
 	       (env, bl))
 	    ({ids = extract_ids env; unb = false;
 	      tmp_scope = None; scopes = []; impls = impl_env}, []) binders in
-  (lenv.impls, List.map snd bl)
+  (lenv.impls, List.map glob_local_binder_of_extended bl)
   with InternalizationError (loc,e) ->
-    user_err_loc (loc,"internalize", explain_internalization_error e)
+    user_err ?loc ~hdr:"internalize" (explain_internalization_error e)
 
-let interp_rawcontext_evars env evdref k bl =
-  let (env, par, _, impls) =
+let interp_glob_context_evars env sigma k bl =
+  let open EConstr in
+  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_of_glob_constr t) na t
+	 if Option.is_empty b then locate_if_hole ?loc:(loc_of_glob_constr t) na t
 	 else t
        in
-       let t = understand_tcc_evars env evdref ~expected_type:IsType t' in
+       let sigma, t = understand_tcc env sigma ~expected_type:IsType t' in
 	match b with
 	    None ->
 	      let d = LocalAssum (na,t) in
@@ -2111,16 +2368,15 @@ let interp_rawcontext_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 c = understand_tcc_evars env evdref ~expected_type:(OfType t) b in
+              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_rawcontext_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 61e7c6f5..f5e32dc4 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -1,24 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
 open Evd
 open Environ
+open Misctypes
 open Libnames
 open Globnames
 open Glob_term
 open Pattern
+open EConstr
 open Constrexpr
 open Notation_term
 open Pretyping
-open Misctypes
-open Decl_kinds
 
 (** Translation from front abstract syntax of term to untyped terms (glob_constr) *)
 
@@ -39,7 +40,7 @@ open Decl_kinds
    of [env] *)
 
 type var_internalization_type =
-  | Inductive of Id.t list (* list of params *)
+  | Inductive of Id.t list (* list of params *) * bool (* true = check for possible capture *)
   | Recursive
   | Method
   | Variable
@@ -59,10 +60,10 @@ type internalization_env = var_internalization_data Id.Map.t
 
 val empty_internalization_env : internalization_env
 
-val compute_internalization_data : env -> var_internalization_type ->
+val compute_internalization_data : env -> evar_map -> var_internalization_type ->
   types -> Impargs.manual_explicitation list -> var_internalization_data
 
-val compute_internalization_env : env -> var_internalization_type ->
+val compute_internalization_env : env -> evar_map -> ?impls:internalization_env -> var_internalization_type ->
   Id.t list -> types list -> Impargs.manual_explicitation list list ->
   internalization_env
 
@@ -71,26 +72,25 @@ type ltac_sign = {
   (** Variables of Ltac which may be bound to a term *)
   ltac_bound : Id.Set.t;
   (** Other variables of Ltac *)
+  ltac_extra : Genintern.Store.t;
+  (** Arbitrary payload *)
 }
 
 val empty_ltac_sign : ltac_sign
 
-type glob_binder = (Name.t * binding_kind * glob_constr option * glob_constr)
-
 (** {6 Internalization performs interpretation of global names and notations } *)
 
-val intern_constr : env -> constr_expr -> glob_constr
-
-val intern_type : env -> constr_expr -> glob_constr
+val intern_constr : env -> evar_map -> constr_expr -> glob_constr
+val intern_type : env -> evar_map -> constr_expr -> glob_constr
 
-val intern_gen : typing_constraint -> env ->
-  ?impls:internalization_env -> ?allow_patvar:bool -> ?ltacvars:ltac_sign ->
+val intern_gen : typing_constraint -> env -> evar_map ->
+  ?impls:internalization_env -> ?pattern_mode:bool -> ?ltacvars:ltac_sign ->
   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 list -> internalization_env * glob_binder list
+val intern_context : bool -> env -> internalization_env -> local_binder_expr list -> internalization_env * glob_decl list
 
 (** {6 Composing internalization with type inference (pretyping) } *)
 
@@ -113,33 +113,33 @@ val interp_open_constr : env -> evar_map -> constr_expr -> evar_map * constr
 
 (** Accepting unresolved evars *)
 
-val interp_constr_evars : env -> evar_map ref ->
-  ?impls:internalization_env -> constr_expr -> constr
+val interp_constr_evars : env -> evar_map ->
+  ?impls:internalization_env -> constr_expr -> evar_map * constr
 
-val interp_casted_constr_evars : env -> evar_map ref ->
-  ?impls:internalization_env -> constr_expr -> types -> constr
+val interp_casted_constr_evars : env -> evar_map ->
+  ?impls:internalization_env -> constr_expr -> types -> evar_map * constr
 
-val interp_type_evars : env -> evar_map ref ->
-  ?impls:internalization_env -> constr_expr -> types
+val interp_type_evars : env -> evar_map ->
+  ?impls:internalization_env -> constr_expr -> evar_map * 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 ->
-  constr * Impargs.manual_implicits
+  evar_map * (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 -> types ->
-  constr * Impargs.manual_implicits
+  evar_map * (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 ->
-  types * Impargs.manual_implicits
+  evar_map * (types * Impargs.manual_implicits)
 
 (** Interprets constr patterns *)
 
 val intern_constr_pattern :
-  env -> ?as_type:bool -> ?ltacvars:ltac_sign ->
+  env -> evar_map -> ?as_type:bool -> ?ltacvars:ltac_sign ->
     constr_pattern_expr -> patvar list * constr_pattern
 
 (** Raise Not_found if syndef not bound to a name and error if unexisting ref *)
@@ -153,22 +153,22 @@ val interp_reference : ltac_sign -> reference -> glob_constr
 val interp_binder  : env -> evar_map -> Name.t -> constr_expr -> 
   types Evd.in_evar_universe_context
 
-val interp_binder_evars : env -> evar_map ref -> Name.t -> constr_expr -> types
+val interp_binder_evars : env -> evar_map -> Name.t -> constr_expr -> evar_map * types
 
 (** Interpret contexts: returns extended env and context *)
 
 val interp_context_evars :
   ?global_level:bool -> ?impl_env:internalization_env -> ?shift:int ->
-  env -> evar_map ref -> local_binder list ->
-  internalization_env * ((env * Context.Rel.t) * Impargs.manual_implicits)
+  env -> evar_map -> local_binder_expr list ->
+  evar_map * (internalization_env * ((env * 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) -> *)
 (*   ?global_level:bool -> ?impl_env:internalization_env -> *)
-(*   env -> evar_map -> local_binder list -> internalization_env * ((env * Evd.evar_universe_context * rel_context * sorts list) * Impargs.manual_implicits) *)
+(*   env -> evar_map -> local_binder_expr list -> internalization_env * ((env * Evd.evar_universe_context * rel_context * sorts list) * Impargs.manual_implicits) *)
   
 (* val interp_context : ?global_level:bool -> ?impl_env:internalization_env -> *)
-(*   env -> evar_map -> local_binder list ->  *)
+(*   env -> evar_map -> local_binder_expr list ->  *)
 (*   internalization_env *  *)
 (*   ((env * Evd.evar_universe_context * rel_context * sorts list) * Impargs.manual_implicits) *)
 
@@ -177,16 +177,15 @@ val interp_context_evars :
 
 val locate_reference :  Libnames.qualid -> Globnames.global_reference
 val is_global : Id.t -> bool
-val construct_reference : Context.Named.t -> Id.t -> constr
-val global_reference : Id.t -> constr
-val global_reference_in_absolute_module : DirPath.t -> Id.t -> constr
+val construct_reference : ('c, 't) Context.Named.pt -> Id.t -> Globnames.global_reference
+val global_reference : Id.t -> Globnames.global_reference
+val global_reference_in_absolute_module : DirPath.t -> Id.t -> Globnames.global_reference
 
 (** 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/library/declare.ml b/interp/declare.ml
index c9992fff..c55a6c69 100644
--- a/library/declare.ml
+++ b/interp/declare.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module is about the low-level declaration of logical objects *)
@@ -14,8 +16,7 @@ open Util
 open Names
 open Libnames
 open Globnames
-open Nameops
-open Term
+open Constr
 open Declarations
 open Entries
 open Libobject
@@ -32,80 +33,15 @@ type internal_flag =
   | InternalTacticRequest  (* kernel action, no message is displayed *)
   | UserIndividualRequest   (* user action, a message is displayed *)
 
-(** XML output hooks *)
-
-let (f_xml_declare_variable, xml_declare_variable) = Hook.make ~default:ignore ()
-let (f_xml_declare_constant, xml_declare_constant) = Hook.make ~default:ignore ()
-let (f_xml_declare_inductive, xml_declare_inductive) = Hook.make ~default:ignore ()
-
-let if_xml f x = if !Flags.xml_export then f x else ()
-
-(** 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
-      Explicit, de.const_entry_opaque,
-      de.const_entry_polymorphic, 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);
-  if_xml (Hook.get f_xml_declare_variable) oname;
-  oname
-
-
 (** Declaration of constants and parameters *)
 
 type constant_obj = {
-  cst_decl : global_declaration;
+  cst_decl : global_declaration option;
+  (** [None] when the declaration is a side-effect and has already been defined
+      in the global environment. *)
   cst_hyps : Dischargedhypsmap.discharged_hyps;
   cst_kind : logical_kind;
   cst_locl : bool;
-  mutable cst_exported : Safe_typing.exported_private_constant list;
-  (* mutable: to avoid change the libobject API, since cache_function
-   * does not return an updated object *)
-  mutable cst_was_seff : bool
 }
 
 type constant_declaration = Safe_typing.private_constants constant_entry * logical_kind
@@ -114,7 +50,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
@@ -139,62 +75,55 @@ 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' =
-    if obj.cst_was_seff then begin
-      obj.cst_was_seff <- false;  
+    match obj.cst_decl with
+    | None ->
       if Global.exists_objlabel (Label.of_id (basename sp))
-      then constant_of_kn kn
-      else CErrors.anomaly Pp.(str"Ex seff not found: " ++ Id.print(basename sp))
-    end else
+      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
-      let kn', exported = Global.add_constant dir id obj.cst_decl in
-      obj.cst_exported <- exported;
-      kn' in
-  assert (eq_constant kn' (constant_of_kn kn));
-  Nametab.push (Nametab.Until 1) sp (ConstRef (constant_of_kn kn));
+      Global.add_constant dir id decl
+  in
+  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 cst.const_polymorphic kn' cst.const_hyps;
+  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
-  Some { obj with cst_hyps = new_hyps; cst_decl = new_decl; }
+  Some { obj with cst_hyps = new_hyps; cst_decl = Some new_decl; }
 
 (* Hack to reduce the size of .vo: we keep only what load/open needs *)
-let dummy_constant_entry = 
-  ConstantEntry
-    (false, ParameterEntry (None,false,(mkProp,Univ.UContext.empty),None))
-
 let dummy_constant cst = {
-  cst_decl = dummy_constant_entry;
+  cst_decl = None;
   cst_hyps = [];
   cst_kind = cst.cst_kind;
   cst_locl = cst.cst_locl;
-  cst_exported = [];
-  cst_was_seff = cst.cst_was_seff;
 }
 
 let classify_constant cst = Substitute (dummy_constant cst)
 
-let (inConstant, outConstant : (constant_obj -> obj) * (obj -> constant_obj)) =
-  declare_object_full { (default_object "CONSTANT") with
+let (inConstant : constant_obj -> obj) =
+  declare_object { (default_object "CONSTANT") with
     cache_function = cache_constant;
     load_function = load_constant;
     open_function = open_constant;
@@ -205,87 +134,160 @@ let (inConstant, outConstant : (constant_obj -> obj) * (obj -> constant_obj)) =
 let declare_scheme = ref (fun _ _ -> assert false)
 let set_declare_scheme f = declare_scheme := f
 
+let update_tables c =
+  declare_constant_implicits c;
+  Heads.declare_head (EvalConstRef c);
+  Notation.declare_ref_arguments_scope Evd.empty (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 update_tables c =
-(*  Printf.eprintf "tables: %s\n%!" (Names.Constant.to_string c); *)
-    declare_constant_implicits c;
-    Heads.declare_head (EvalConstRef c);
-    Notation.declare_ref_arguments_scope (ConstRef c) in
   let o = inConstant cst in
   let _, kn as oname = add_leaf id o in
-  List.iter (fun (c,ce,role) ->
-      (* handling of private_constants just exported *)
-      let o = inConstant {
-        cst_decl = ConstantEntry (false, ce);
-        cst_hyps = [] ;
-        cst_kind = IsProof Theorem;
-        cst_locl = false;
-        cst_exported = [];
-        cst_was_seff = true; } in
-      let id = Label.to_id (pi3 (Constant.repr3 c)) in
-      ignore(add_leaf id o);
-      update_tables c;
-      let () = if_xml (Hook.get f_xml_declare_constant) (InternalTacticRequest, c) in
-      match role with
-      | Safe_typing.Subproof -> ()
-      | Safe_typing.Schema (ind, kind) -> !declare_scheme kind [|ind,c|])
-    (outConstant o).cst_exported;
   pull_to_head oname;
   let c = Global.constant_of_delta_kn kn in
   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 =
+    ?(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;
-    const_entry_polymorphic = poly;
     const_entry_universes = univs;
     const_entry_opaque = opaque;
     const_entry_feedback = None;
     const_entry_inline_code = inline}
 
 let declare_constant ?(internal = UserIndividualRequest) ?(local = false) id ?(export_seff=false) (cd, kind) =
-  let export = (* We deal with side effects *)
+  let is_poly de = match de.const_entry_universes with
+  | Monomorphic_const_entry _ -> false
+  | Polymorphic_const_entry _ -> true
+  in
+  let in_section = Lib.sections_are_opened () in
+  let export, decl = (* We deal with side effects *)
     match cd with
     | DefinitionEntry de when
         export_seff ||
         not de.const_entry_opaque ||
-        de.const_entry_polymorphic ->
-          let bo = de.const_entry_body in
-          let _, seff = Future.force bo in
-          Safe_typing.empty_private_constants <> seff
-    | _ -> false
+        is_poly de ->
+      (** 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 de, export = Global.export_private_constants ~in_section de in
+      export, ConstantEntry (PureEntry, DefinitionEntry de)
+    | _ -> [], ConstantEntry (EffectEntry, cd)
   in
+  let () = List.iter register_side_effect export in
   let cst = {
-    cst_decl = ConstantEntry (export,cd);
+    cst_decl = Some decl;
     cst_hyps = [] ;
     cst_kind = kind;
     cst_locl = local;
-    cst_exported = [];
-    cst_was_seff = false;
   } in
-  let kn = declare_constant_common id cst in
-  let () = if_xml (Hook.get f_xml_declare_constant) (internal, kn) in
-  kn
+  declare_constant_common id cst
 
 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 Evd.empty (VarRef id);
+  Heads.declare_head (EvalVarRef id);
+  oname
+
 (** Declaration of inductive blocks *)
 
 let declare_inductive_argument_scopes kn mie =
   List.iteri (fun i {mind_entry_consnames=lc} ->
-    Notation.declare_ref_arguments_scope (IndRef (kn,i));
+    Notation.declare_ref_arguments_scope Evd.empty (IndRef (kn,i));
     for j=1 to List.length lc do
-      Notation.declare_ref_arguments_scope (ConstructRef ((kn,i),j));
+      Notation.declare_ref_arguments_scope Evd.empty (ConstructRef ((kn,i),j));
     done) mie.mind_entry_inds
 
 let inductive_names sp kn mie =
@@ -321,11 +323,11 @@ 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 mind.mind_polymorphic kn' mind.mind_hyps;
+  add_section_kn (Declareops.inductive_is_polymorphic mind) kn' mind.mind_hyps;
   Dischargedhypsmap.set_discharged_hyps sp dhyps;
   List.iter (fun (sp, ref) -> Nametab.push (Nametab.Until 1) sp ref) names
 
@@ -333,9 +335,10 @@ 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,usubst,uctx = 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 (named_of_variable_context sechyps,uctx) repl mie)
+        Discharge.process_inductive info repl mie)
 
 let dummy_one_inductive_entry mie = {
   mind_entry_typename = mie.mind_entry_typename;
@@ -349,13 +352,24 @@ 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_polymorphic = false;
-  mind_entry_universes = Univ.UContext.empty;
+  mind_entry_universes = Monomorphic_ind_entry Univ.ContextSet.empty;
   mind_entry_private = None;
 })
 
+(* reinfer subtyping constraints for inductive after section is dischared. *)
+let infer_inductive_subtyping (pth, mind_ent) =
+  match mind_ent.mind_entry_universes with
+  | Monomorphic_ind_entry _ | Polymorphic_ind_entry _ ->
+    (pth, mind_ent)
+  | Cumulative_ind_entry cumi ->
+    begin
+      let env = Global.env () in
+      (* let (env'', typed_params) = Typeops.infer_local_decls env' (mind_ent.mind_entry_params) in *)
+        (pth, InferCumulativity.infer_inductive env mind_ent)
+    end
+
 type inductive_obj = Dischargedhypsmap.discharged_hyps * mutual_inductive_entry
 
 let inInductive : inductive_obj -> obj =
@@ -365,7 +379,8 @@ let inInductive : inductive_obj -> obj =
     open_function = open_inductive;
     classify_function = (fun a -> Substitute (dummy_inductive_entry a));
     subst_function = ident_subst_function;
-    discharge_function = discharge_inductive }
+    discharge_function = discharge_inductive;
+    rebuild_function = infer_inductive_subtyping }
 
 let declare_projections mind =
   let spec,_ = Inductive.lookup_mind_specif (Global.env ()) (mind,0) in
@@ -377,7 +392,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
 
@@ -385,13 +400,12 @@ let declare_projections mind =
 let declare_mind mie =
   let id = match mie.mind_entry_inds with
     | ind::_ -> ind.mind_entry_typename
-    | [] -> anomaly (Pp.str "cannot declare an empty list of inductives") in
+    | [] -> anomaly (Pp.str "cannot declare an empty list of inductives.") in
   let (sp,kn as oname) = add_leaf id (inInductive ([],mie)) in
   let mind = Global.mind_of_delta_kn kn in
   let isrecord,isprim = declare_projections mind in
   declare_mib_implicits mind;
   declare_inductive_argument_scopes mind mie;
-  if_xml (Hook.get f_xml_declare_inductive) (isrecord,oname);
   oname, isprim
 
 (* Declaration messages *)
@@ -400,12 +414,12 @@ 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" ++
+  | [] -> anomaly (Pp.str "no recursive definition.")
+  | [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 " ++
@@ -416,25 +430,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;
@@ -451,44 +465,114 @@ 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 = Universes.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);
-  Universes.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
   let () =
     if poly && not in_section then
-      user_err_loc (Loc.ghost, "Constraint",
-                    str"Cannot declare polymorphic universes outside sections")
+      user_err ~hdr:"Constraint"
+                   (str"Cannot declare polymorphic universes outside sections")
   in
   let l =
-    List.map (fun (l, id) ->
-	      let lev = Universes.new_univ_level (Global.current_dirpath ()) in
-	      (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 =
@@ -509,39 +593,27 @@ let input_constraints : constraint_decl -> Libobject.obj =
       classify_function = (fun a -> Keep a) }
 
 let do_constraint poly l =
-  let open Misctypes in
   let u_of_id x =
-    match x with
-    | GProp -> Loc.dummy_loc, (false, Univ.Level.prop)
-    | GSet -> Loc.dummy_loc, (false, Univ.Level.set)
-    | GType None ->
-       user_err_loc (Loc.dummy_loc, "Constraint",
-                     str "Cannot declare constraints on anonymous universes")
-    | GType (Some (loc, id)) ->
-       let id = Id.of_string id in
-       let names, _ = Universes.global_universe_names () in
-       try loc, Idmap.find id names
-       with Not_found ->
-         user_err_loc (loc, "Constraint", str "Undeclared universe " ++ pr_id id)
+    let level = Pretyping.interp_known_glob_level (Evd.from_env (Global.env ())) x in
+    Universes.is_polymorphic level, level
   in
   let in_section = Lib.sections_are_opened () in
   let () =
     if poly && not in_section then
-      user_err_loc (Loc.ghost, "Constraint",
-                    str"Cannot declare polymorphic constraints outside sections")
+      user_err ~hdr:"Constraint"
+                    (str"Cannot declare polymorphic constraints outside sections")
   in
-  let check_poly loc p loc' p' =
+  let check_poly p p' =
     if poly then ()
     else if p || p' then
-      let loc = if p then loc else loc' in
-      user_err_loc (loc, "Constraint",
-                    str "Cannot declare a global constraint on " ++
+      user_err ~hdr:"Constraint"
+                    (str "Cannot declare a global constraint on " ++
                     str "a polymorphic universe, use "
                     ++ str "Polymorphic Constraint instead")
   in
   let constraints = List.fold_left (fun acc (l, d, r) ->
-     let ploc, (p, lu) = u_of_id l and rloc, (p', ru) = u_of_id r in
-     check_poly ploc p rloc p';
+     let p, lu = u_of_id l and p', ru = u_of_id r in
+     check_poly p p';
      Univ.Constraint.add (lu, d, ru) acc)
     Univ.Constraint.empty l
   in
diff --git a/library/declare.mli b/interp/declare.mli
index f70d594d..084d746e 100644
--- a/library/declare.mli
+++ b/interp/declare.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Libnames
-open Term
+open Constr
 open Entries
 open Decl_kinds
 
@@ -42,7 +44,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,28 +54,23 @@ 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
    the whole block and a boolean indicating if it is a primitive record. *)
 val declare_mind : mutual_inductive_entry -> object_name * bool
 
-(** Hooks for XML output *)
-val xml_declare_variable : (object_name -> unit) Hook.t
-val xml_declare_constant : (internal_flag * constant -> unit) Hook.t
-val xml_declare_inductive : (bool * object_name -> unit) Hook.t
-
 (** Declaration messages *)
 
 val definition_message : Id.t -> unit
@@ -85,13 +82,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/toplevel/discharge.ml b/interp/discharge.ml
index e24d5e74..e16a955d 100644
--- a/toplevel/discharge.ml
+++ b/interp/discharge.ml
@@ -1,15 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open CErrors
 open Util
 open Term
+open Constr
 open Vars
 open Declarations
 open Cooking
@@ -23,7 +26,7 @@ let detype_param =
   function
   | LocalAssum (Name id, p) -> id, LocalAssumEntry p
   | LocalDef (Name id, p,_) -> id, LocalDefEntry p
-  | _ -> anomaly (Pp.str "Unnamed inductive local variable")
+  | _ -> anomaly (Pp.str "Unnamed inductive local variable.")
 
 (* Replace
 
@@ -36,32 +39,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 (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,34 +80,36 @@ 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,abs_ctx) modlist mib =
-  let nparams = mib.mind_nparams in
-  let subst, univs = 
-    if mib.mind_polymorphic then 
-      let inst = Univ.UContext.instance mib.mind_universes in
-      let cstrs = Univ.UContext.constraints mib.mind_universes in
-	inst, Univ.UContext.make (inst, Univ.subst_instance_constraints inst cstrs)
-    else Univ.Instance.empty, mib.mind_universes
+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
+    | Polymorphic_ind auctx ->
+      let subst, auctx = Lib.discharge_abstract_universe_context info auctx in
+      let auctx = Univ.AUContext.repr auctx in
+      subst, Polymorphic_ind_entry auctx
+    | Cumulative_ind cumi ->
+      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 (Univ.CumulativityInfo.from_universe_context auctx)
   in
+  let discharge c = Vars.subst_univs_level_constr subst (expmod_constr modlist c) in
   let inds =
     Array.map_to_list
       (fun mip ->
 	let ty, template = refresh_polymorphic_type_of_inductive (mib,mip) in
-	let arity = expmod_constr modlist ty in
-	let arity = Vars.subst_instance_constr subst arity in
-	let lc = Array.map 
-	  (fun c -> Vars.subst_instance_constr subst (expmod_constr modlist c))
-	  mip.mind_user_lc 
-	in
+        let arity = discharge ty in
+        let lc = Array.map discharge mip.mind_user_lc  in
 	  (mip.mind_typename,
 	   arity, template,
 	   Array.to_list mip.mind_consnames,
 	   Array.to_list lc))
       mib.mind_packets in
-  let sechyps' = Context.Named.map (expmod_constr modlist) sechyps in
-  let (params',inds') = abstract_inductive sechyps' nparams inds in
-  let abs_ctx = Univ.instantiate_univ_context abs_ctx in
-  let univs = Univ.UContext.union abs_ctx univs 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
@@ -114,7 +119,7 @@ let process_inductive (sechyps,abs_ctx) modlist mib =
     mind_entry_finite = mib.mind_finite;
     mind_entry_params = params';
     mind_entry_inds = inds';
-    mind_entry_polymorphic = mib.mind_polymorphic;
     mind_entry_private = mib.mind_private;
-    mind_entry_universes = univs;
+    mind_entry_universes = ind_univs
   }
+
diff --git a/interp/discharge.mli b/interp/discharge.mli
new file mode 100644
index 00000000..f7408937
--- /dev/null
+++ b/interp/discharge.mli
@@ -0,0 +1,16 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Declarations
+open Entries
+open Opaqueproof
+
+val process_inductive :
+  Lib.abstr_info -> work_list -> mutual_inductive_body -> mutual_inductive_entry
diff --git a/interp/doc.tex b/interp/doc.tex
deleted file mode 100644
index 4ce5811d..00000000
--- a/interp/doc.tex
+++ /dev/null
@@ -1,14 +0,0 @@
-
-\newpage
-\section*{The interpretation of Coq front abstract syntax of terms}
-
-\ocwsection \label{interp}
-This chapter describes the translation from \Coq\ context-dependent
-front abstract syntax of terms (\verb=front=) to and from the
-context-free, untyped, globalized form of constructions (\verb=glob_constr=).
-
-The modules translating back and forth the front abstract syntax are
-organized as follows.
-
-\bigskip
-\begin{center}\epsfig{file=interp.dep.ps}\end{center}
diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml
index b020f894..bc6a1ef3 100644
--- a/interp/dumpglob.ml
+++ b/interp/dumpglob.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -68,11 +70,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 +114,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"
@@ -139,30 +140,32 @@ let interval loc =
   let loc1,loc2 = Loc.unloc loc in
   loc1, loc2-1
 
-let dump_ref loc filepath modpath ident ty =
+let dump_ref ?loc filepath modpath ident ty =
   match !glob_output with
   | Feedback ->
-    Feedback.feedback (Feedback.GlobRef (loc, filepath, modpath, ident, ty))
+    Option.iter (fun loc ->
+        Feedback.feedback (Feedback.GlobRef (loc, filepath, modpath, ident, ty))
+      ) loc
   | NoGlob -> ()
-  | _ when not (Loc.is_ghost loc) ->
+  | _ -> Option.iter (fun loc ->
     let bl,el = interval loc in
     dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n"
 		  bl el filepath modpath ident ty)
-  | _ -> ()
+    ) loc
 
-let dump_reference loc modpath ident ty =
+let dump_reference ?loc modpath ident ty =
   let filepath = Names.DirPath.to_string (Lib.library_dp ()) in
-  dump_ref loc filepath modpath ident ty
+  dump_ref ?loc filepath modpath ident ty
 
-let dump_modref loc mp ty =
+let dump_modref ?loc mp ty =
   let (dp, l) = Lib.split_modpath mp in
   let filepath = Names.DirPath.to_string dp in
   let modpath = Names.DirPath.to_string (Names.DirPath.make l) in
   let ident = "<>" in
-  dump_ref loc filepath modpath ident ty
+  dump_ref ?loc filepath modpath ident ty
 
-let dump_libref loc dp ty =
-  dump_ref loc (Names.DirPath.to_string dp) "<>" "<>" ty
+let dump_libref ?loc dp ty =
+  dump_ref ?loc (Names.DirPath.to_string dp) "<>" "<>" ty
 
 let cook_notation df sc =
   (* We encode notations so that they are space-free and still human-readable *)
@@ -173,32 +176,33 @@ let cook_notation df sc =
   (* - all single quotes in terminal tokens are doubled                       *)
   (* - characters < 32 are represented by '^A, '^B, '^C, etc                  *)
   (* The output is decoded in function Index.prepare_entry of coqdoc          *)
-  let ntn = String.make (String.length df * 5) '_' in
+  let ntn = Bytes.make (String.length df * 5) '_' in
   let j = ref 0 in
   let l = String.length df - 1 in
   let i = ref 0 in
+  let open Bytes in             (* Bytes.set *)
   while !i <= l do
     assert (df.[!i] != ' ');
     if df.[!i] == '_' && (Int.equal !i l || df.[!i+1] == ' ') then
       (* Next token is a non-terminal *)
-      (ntn.[!j] <- 'x'; incr j; incr i)
+      (set ntn !j 'x'; incr j; incr i)
     else begin
       (* Next token is a terminal *)
-      ntn.[!j] <- '\''; incr j;
+      set ntn !j '\''; incr j;
       while !i <= l && df.[!i] != ' ' do
 	if df.[!i] < ' ' then
 	  let c = char_of_int (int_of_char 'A' + int_of_char df.[!i] - 1) in
 	  (String.blit ("'^" ^ String.make 1 c) 0 ntn !j 3; j := !j+3; incr i)
 	else begin
-	  if df.[!i] == '\'' then (ntn.[!j] <- '\''; incr j);
-	  ntn.[!j] <- df.[!i]; incr j; incr i
+	  if df.[!i] == '\'' then (set ntn !j '\''; incr j);
+	  set ntn !j df.[!i]; incr j; incr i
 	end
       done;
-      ntn.[!j] <- '\''; incr j
+      set ntn !j '\''; incr j
     end;
-    if !i <= l then (ntn.[!j] <- '_'; incr j; incr i)
+    if !i <= l then (set ntn !j '_'; incr j; incr i)
   done;
-  let df = String.sub ntn 0 !j in
+  let df = Bytes.sub_string ntn 0 !j in
   match sc with Some sc -> ":" ^ sc ^ ":" ^ df | _ -> "::" ^ df
 
 let dump_notation_location posl df (((path,secpath),_),sc) =
@@ -207,10 +211,10 @@ let dump_notation_location posl df (((path,secpath),_),sc) =
     let secpath = Names.DirPath.to_string secpath in
     let df = cook_notation df sc in
     List.iter (fun l ->
-      dump_ref (Loc.make_loc l) path secpath df "not")
+      dump_ref ~loc:(Loc.make_loc l) path secpath df "not")
       posl
 
-let add_glob_gen loc sp lib_dp ty =
+let add_glob_gen ?loc sp lib_dp ty =
   if dump () then
     let mod_dp,id = Libnames.repr_path sp in
     let mod_dp = remove_sections mod_dp in
@@ -218,50 +222,51 @@ let add_glob_gen loc sp lib_dp ty =
     let filepath = Names.DirPath.to_string lib_dp in
     let modpath = Names.DirPath.to_string mod_dp_trunc in
     let ident = Names.Id.to_string id in
-      dump_ref loc filepath modpath ident ty
+      dump_ref ?loc filepath modpath ident ty
 
-let add_glob loc ref =
-  if dump () && not (Loc.is_ghost loc) then
+let add_glob ?loc ref =
+  if dump () then
     let sp = Nametab.path_of_global ref in
     let lib_dp = Lib.library_part ref in
     let ty = type_of_global_ref ref in
-      add_glob_gen loc sp lib_dp ty
+    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 =
-  if dump () && not (Loc.is_ghost loc) then
+let add_glob_kn ?loc kn =
+  if dump () then
     let sp = Nametab.path_of_syndef kn in
     let lib_dp = Lib.dp_of_mp (mp_of_kn kn) in
-      add_glob_gen loc sp lib_dp "syndef"
+    add_glob_gen ?loc sp lib_dp "syndef"
 
-let dump_binding loc id = ()
+let dump_binding ?loc id = ()
 
-let dump_def ty loc secpath id =
+let dump_def ?loc ty secpath id = Option.iter (fun loc ->
   if !glob_output = Feedback then
     Feedback.feedback (Feedback.GlobDef (loc, id, secpath, ty))
   else
     let bl,el = interval loc in
     dump_string (Printf.sprintf "%s %d:%d %s %s\n" ty bl el secpath id)
+  ) loc
 
-let dump_definition (loc, id) sec s =
-  dump_def s loc (Names.DirPath.to_string (Lib.current_dirpath sec)) (Names.Id.to_string id)
+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 =
+let dump_moddef ?loc mp ty =
   let (dp, l) = Lib.split_modpath mp in
   let mp = Names.DirPath.to_string (Names.DirPath.make l) in
-  dump_def ty loc "<>" mp
+  dump_def ?loc ty "<>" mp
 
-let dump_notation (loc,(df,_)) sc sec =
+let dump_notation (loc,(df,_)) sc sec = Option.iter (fun loc ->
   (* We dump the location of the opening '"' *)
   let i = fst (Loc.unloc loc) in
   let location = (Loc.make_loc (i, i+1)) in
-  dump_def "not" location (Names.DirPath.to_string (Lib.current_dirpath sec)) (cook_notation df sc)
-
+  dump_def ~loc:location "not" (Names.DirPath.to_string (Lib.current_dirpath sec)) (cook_notation df sc)
+  ) loc
diff --git a/interp/dumpglob.mli b/interp/dumpglob.mli
index e84a6405..43c10000 100644
--- a/interp/dumpglob.mli
+++ b/interp/dumpglob.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val open_glob_file : string -> unit
@@ -22,22 +24,22 @@ val feedback_glob : unit -> unit
 val pause : unit -> unit
 val continue : unit -> unit
 
-val add_glob : Loc.t -> Globnames.global_reference -> unit
-val add_glob_kn : Loc.t -> Names.kernel_name -> unit
+val add_glob : ?loc:Loc.t -> Globnames.global_reference -> unit
+val add_glob_kn : ?loc:Loc.t -> Names.KerName.t -> unit
 
-val dump_definition : Loc.t * Names.Id.t -> bool -> string -> unit
-val dump_moddef : Loc.t -> Names.module_path -> string -> unit
-val dump_modref  : Loc.t -> Names.module_path -> string -> unit
-val dump_reference  : Loc.t -> string -> string -> string -> unit
-val dump_libref : Loc.t -> Names.DirPath.t -> 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 ->
   (Notation.notation_location * Notation_term.scope_name option) -> unit
-val dump_binding : Loc.t -> Names.Id.Set.elt -> unit
+val dump_binding : ?loc:Loc.t -> Names.Id.Set.elt -> unit
 val dump_notation :
-  Loc.t * (Constrexpr.notation * Notation.notation_location) ->
+  (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 d6bfd347..161201c4 100644
--- a/interp/genintern.ml
+++ b/interp/genintern.ml
@@ -1,21 +1,34 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Mod_subst
 open Genarg
 
+module Store = Store.Make ()
+
 type glob_sign = {
   ltacvars : Id.Set.t;
-  genv : Environ.env }
+  genv : Environ.env;
+  extra : Store.t;
+}
+
+let empty_glob_sign env = {
+  ltacvars = Id.Set.empty;
+  genv = env;
+  extra = Store.empty;
+}
 
 type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb
 type 'glb subst_fun = substitution -> 'glb -> 'glb
+type 'glb ntn_subst_fun = Tactypes.glob_constr_and_expr Id.Map.t -> 'glb -> 'glb
 
 module InternObj =
 struct
@@ -31,8 +44,16 @@ struct
   let default _ = None
 end
 
+module NtnSubstObj =
+struct
+  type ('raw, 'glb, 'top) obj = 'glb ntn_subst_fun
+  let name = "notation_subst"
+  let default _ = None
+end
+
 module Intern = Register (InternObj)
 module Subst = Register (SubstObj)
+module NtnSubst = Register (NtnSubstObj)
 
 let intern = Intern.obj
 let register_intern0 = Intern.register0
@@ -50,3 +71,12 @@ let generic_substitute subs (GenArg (Glbwit wit, v)) =
   in_gen (glbwit wit) (substitute wit subs v)
 
 let () = Hook.set Detyping.subst_genarg_hook generic_substitute
+
+(** Notation substitution *)
+
+let substitute_notation = NtnSubst.obj
+let register_ntn_subst0 = NtnSubst.register0
+
+let generic_substitute_notation env (GenArg (Glbwit wit, v)) =
+  let v = substitute_notation wit env v in
+  in_gen (glbwit wit) v
diff --git a/interp/genintern.mli b/interp/genintern.mli
index 4b244b38..d818713f 100644
--- a/interp/genintern.mli
+++ b/interp/genintern.mli
@@ -1,18 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Mod_subst
 open Genarg
 
+module Store : Store.S
+
 type glob_sign = {
   ltacvars : Id.Set.t;
-  genv : Environ.env }
+  genv : Environ.env;
+  extra : Store.t;
+}
+
+val empty_glob_sign : Environ.env -> glob_sign
 
 (** {5 Internalization functions} *)
 
@@ -32,6 +40,14 @@ val substitute : ('raw, 'glb, 'top) genarg_type -> 'glb subst_fun
 
 val generic_substitute : glob_generic_argument subst_fun
 
+(** {5 Notation functions} *)
+
+type 'glb ntn_subst_fun = Tactypes.glob_constr_and_expr Id.Map.t -> 'glb -> 'glb
+
+val substitute_notation : ('raw, 'glb, 'top) genarg_type -> 'glb ntn_subst_fun
+
+val generic_substitute_notation : glob_generic_argument ntn_subst_fun
+
 (** Registering functions *)
 
 val register_intern0 : ('raw, 'glb, 'top) genarg_type ->
@@ -39,3 +55,6 @@ val register_intern0 : ('raw, 'glb, 'top) genarg_type ->
 
 val register_subst0 : ('raw, 'glb, 'top) genarg_type ->
   'glb subst_fun -> unit
+
+val register_ntn_subst0 : ('raw, 'glb, 'top) genarg_type ->
+  'glb ntn_subst_fun -> unit
diff --git a/library/impargs.ml b/interp/impargs.ml
index 828d652c..9ad62c0d 100644
--- a/library/impargs.ml
+++ b/interp/impargs.ml
@@ -1,27 +1,30 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
+open Pp
 open Util
 open Names
+open Constr
 open Globnames
-open Nameops
-open Term
-open Reduction
 open Declarations
-open Environ
-open Libobject
+open Decl_kinds
 open Lib
-open Pp
-open Constrexpr
+open Libobject
+open EConstr
 open Termops
+open Reductionops
+open Constrexpr
 open Namegen
-open Decl_kinds
+
+module NamedDecl = Context.Named.Declaration
 
 (*s Flags governing the computation of implicit arguments *)
 
@@ -163,9 +166,8 @@ let update pos rig (na,st) =
   in na, Some e
 
 (* modified is_rigid_reference with a truncated env *)
-let is_flexible_reference env bound depth f =
-  let open Context.Named.Declaration in
-  match kind_of_term f with
+let is_flexible_reference env sigma bound depth f =
+  match kind sigma 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
@@ -173,100 +175,101 @@ let is_flexible_reference env bound depth f =
         let cb = Environ.lookup_constant kn env in
 	(match cb.const_body with Def _ -> true | _ -> false)
     | Var id ->
-        Environ.lookup_named id env |> is_local_def
+        env |> Environ.lookup_named id |> NamedDecl.is_local_def
     | Ind _ | Construct _ -> false
     |  _ -> true
 
 let push_lift d (e,n) = (push_rel d e,n+1)
 
-let is_reversible_pattern bound depth f l =
-  isRel f && let n = destRel f in (n < bound+depth) && (n >= depth) &&
-  Array.for_all (fun c -> isRel c && destRel c < depth) l &&
+let is_reversible_pattern sigma bound depth f l =
+  isRel sigma f && let n = destRel sigma f in (n < bound+depth) && (n >= depth) &&
+  Array.for_all (fun c -> isRel sigma c && destRel sigma c < depth) l &&
   Array.distinct l
 
 (* Precondition: rels in env are for inductive types only *)
-let add_free_rels_until strict strongly_strict revpat bound env m pos acc =
+let add_free_rels_until strict strongly_strict revpat bound env sigma 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 hd = if strict then whd_all env sigma c else c in
     let c = if strongly_strict then hd else c in
-    match kind_of_term hd with
+    match kind sigma hd with
     | Rel n when (n < bound+depth) && (n >= depth) ->
 	let i = bound + depth - n - 1 in
         acc.(i) <- update pos rig acc.(i)
-    | App (f,l) when revpat && is_reversible_pattern bound depth f l ->
-	let i = bound + depth - destRel f - 1 in
+    | App (f,l) when revpat && is_reversible_pattern sigma bound depth f l ->
+        let i = bound + depth - EConstr.destRel sigma f - 1 in
 	acc.(i) <- update pos rig acc.(i)
-    | App (f,_) when rig && is_flexible_reference env bound depth f ->
+    | App (f,_) when rig && is_flexible_reference env sigma bound depth f ->
 	if strict then () else
-          iter_constr_with_full_binders push_lift (frec false) ed c
+          iter_constr_with_full_binders sigma push_lift (frec false) ed c
     | Proj (p,c) when rig ->
       if strict then () else
-        iter_constr_with_full_binders push_lift (frec false) ed c	  
+        iter_constr_with_full_binders sigma push_lift (frec false) ed c
     | Case _ when rig ->
 	if strict then () else
-          iter_constr_with_full_binders push_lift (frec false) ed c
+          iter_constr_with_full_binders sigma push_lift (frec false) ed c
     | Evar _ -> ()
     | _ ->
-        iter_constr_with_full_binders push_lift (frec rig) ed c
+        iter_constr_with_full_binders sigma push_lift (frec rig) ed c
   in
-  let () = if not (Vars.noccur_between 1 bound m) then frec true (env,1) m in
+  let () = if not (Vars.noccur_between sigma 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 sigma t = match kind sigma t with
   | Rel _ | Evar _ -> false
   | Ind _ | Const _ | Var _ | Sort _ -> true
-  | Case (_,_,f,_) -> is_rigid_head f
+  | Case (_,_,f,_) -> is_rigid_head sigma f
   | Proj (p,c) -> true
   | App (f,args) ->
-      (match kind_of_term f with
-	| Fix ((fi,i),_) -> is_rigid_head (args.(fi.(i)))
-	| _ -> is_rigid_head f)
+      (match kind sigma f with
+        | Fix ((fi,i),_) -> is_rigid_head sigma (args.(fi.(i)))
+        | _ -> is_rigid_head sigma f)
   | Lambda _ | LetIn _ | Construct _ | CoFix _ | Fix _
   | Prod _ | Meta _ | Cast _ -> assert false
 
 (* calcule la liste des arguments implicites *)
 
-let find_displayed_name_in all avoid na (_,b as envnames_b) =
+let find_displayed_name_in all avoid na (env, b) =
+  let envnames_b = (env, b) in
   let flag = RenamingElsewhereFor envnames_b in
-  if all then compute_and_force_displayed_name_in flag avoid na b
-  else compute_displayed_name_in flag avoid na b
+  if all then compute_and_force_displayed_name_in Evd.empty flag avoid na b
+  else compute_displayed_name_in Evd.empty flag avoid na b
 
-let compute_implicits_gen strict strongly_strict revpat contextual all env t =
+let compute_implicits_gen strict strongly_strict revpat contextual all env sigma (t : EConstr.t) =
   let rigid = ref true in
   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
+  let rec aux env avoid n names (t : EConstr.t) =
+    let t = whd_all env sigma t in
+    match kind sigma 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))
+          add_free_rels_until strict strongly_strict revpat n env sigma a (Hyp (n+1))
             (aux (push_rel (LocalAssum (na',a)) env) avoid' (n+1) (na'::names) b)
       | _ ->
-	  rigid := is_rigid_head t;
+          rigid := is_rigid_head sigma t;
 	  let names = List.rev names in
 	  let v = Array.map (fun na -> na,None) (Array.of_list names) in
 	  if contextual then
-	    add_free_rels_until strict strongly_strict revpat n env t Conclusion v
+            add_free_rels_until strict strongly_strict revpat n env sigma t Conclusion v
 	  else v
   in
-  match kind_of_term (whd_all env t) with
+  match kind sigma (whd_all env sigma 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, []
 
-let compute_implicits_flags env f all t =
+let compute_implicits_flags env sigma f all t =
   compute_implicits_gen
     (f.strict || f.strongly_strict) f.strongly_strict
-    f.reversible_pattern f.contextual all env t
+    f.reversible_pattern f.contextual all env sigma t
 
-let compute_auto_implicits env flags enriching t =
-  if enriching then compute_implicits_flags env flags true t
-  else compute_implicits_gen false false false true true env t
+let compute_auto_implicits env sigma flags enriching t =
+  if enriching then compute_implicits_flags env sigma flags true t
+  else compute_implicits_gen false false false true true env sigma t
 
-let compute_implicits_names env t =
-  let _, impls = compute_implicits_gen false false false false true env t in
+let compute_implicits_names env sigma t =
+  let _, impls = compute_implicits_gen false false false false true env sigma t in
   List.map fst impls
 
 (* Extra information about implicit arguments *)
@@ -287,16 +290,16 @@ let is_status_implicit = function
   | _ -> true
 
 let name_of_implicit = function
-  | None -> anomaly (Pp.str "Not an implicit argument")
+  | None -> anomaly (Pp.str "Not an implicit argument.")
   | Some (id,_,_) -> id
 
 let maximal_insertion_of = function
   | Some (_,_,(b,_)) -> b
-  | None -> anomaly (Pp.str "Not an implicit argument")
+  | None -> anomaly (Pp.str "Not an implicit argument.")
 
 let force_inference_of = function
   | Some (_, _, (_, b)) -> b
-  | None -> anomaly (Pp.str "Not an implicit argument")
+  | None -> anomaly (Pp.str "Not an implicit argument.")
 
 (* [in_ctx] means we know the expected type, [n] is the index of the argument *)
 let is_inferable_implicit in_ctx n = function
@@ -320,7 +323,7 @@ let positions_of_implicits (_,impls) =
 
 let rec prepare_implicits f = function
   | [] -> []
-  | (Anonymous, Some _)::_ -> anomaly (Pp.str "Unnamed implicit")
+  | (Anonymous, Some _)::_ -> anomaly (Pp.str "Unnamed implicit.")
   | (Name id, Some imp)::imps ->
       let imps' = prepare_implicits f imps in
       Some (id,imp,(set_maximality imps' f.maximal,true)) :: imps'
@@ -338,14 +341,14 @@ let check_correct_manual_implicits autoimps l =
   List.iter (function
     | ExplByName id,(b,fi,forced) ->
 	if not forced then
-	  errorlabstrm ""
-            (str "Wrong or non-dependent implicit argument name: " ++ pr_id id ++ str ".")
+	  user_err 
+            (str "Wrong or non-dependent implicit argument name: " ++ Id.print id ++ str ".")
     | ExplByPos (i,_id),_t ->
 	if i<1 || i>List.length autoimps then
-	  errorlabstrm ""
+	  user_err 
             (str "Bad implicit argument number: " ++ int i ++ str ".")
 	else
-	  errorlabstrm ""
+	  user_err 
 	    (str "Cannot set implicit argument number " ++ int i ++
 	      str ": it has no name.")) l
 
@@ -360,7 +363,7 @@ let set_manual_implicits env flags enriching autoimps l =
     with Not_found -> l, None
   in
   if not (List.distinct l) then
-    error ("Some parameters are referred more than once.");
+    user_err Pp.(str "Some parameters are referred more than once.");
   (* Compare with automatic implicits to recover printing data and names *)
   let rec merge k l = function
   | (Name id,imp)::imps ->
@@ -395,24 +398,25 @@ let set_manual_implicits env flags enriching autoimps l =
   in
   merge 1 l autoimps
 
-let compute_semi_auto_implicits env f manual t =
+let compute_semi_auto_implicits env sigma f manual t =
   match manual with
   | [] ->
       if not f.auto then [DefaultImpArgs, []]
-      else let _,l = compute_implicits_flags env f false t in
+      else let _,l = compute_implicits_flags env sigma f false t in
 	     [DefaultImpArgs, prepare_implicits f l]
   | _ ->
-      let _,autoimpls = compute_auto_implicits env f f.auto t in
+      let _,autoimpls = compute_auto_implicits env sigma f f.auto t in
       [DefaultImpArgs, set_manual_implicits env f f.auto autoimpls manual]
 
 (*s Constants. *)
 
 let compute_constant_implicits flags manual cst =
   let env = Global.env () in
+  let sigma = Evd.from_env env in
   let cb = Environ.lookup_constant cst env in
-  let ty = Typeops.type_of_constant_type env cb.const_type in
-  let impls = compute_semi_auto_implicits env flags manual ty in
-    impls
+  let ty = of_constr cb.const_type in
+  let impls = compute_semi_auto_implicits env sigma flags manual ty in
+  impls
 
 (*s Inductives and constructors. Their implicit arguments are stored
    in an array, indexed by the inductive number, of pairs $(i,v)$ where
@@ -421,22 +425,24 @@ let compute_constant_implicits flags manual cst =
 
 let compute_mib_implicits flags manual kn =
   let env = Global.env () in
-  let mib = lookup_mind kn env in
+  let sigma = Evd.from_env env in
+  let mib = Environ.lookup_mind kn env in
   let ar =
     Array.to_list
       (Array.mapi  (* No need to lift, arities contain no de Bruijn *)
         (fun i mip ->
 	  (** No need to care about constraints here *)
-	  Context.Rel.Declaration.LocalAssum (Name mip.mind_typename, Global.type_of_global_unsafe (IndRef (kn,i))))
+	  let ty, _ = Global.type_of_global_in_context env (IndRef (kn,i)) in
+	  Context.Rel.Declaration.LocalAssum (Name mip.mind_typename, ty))
         mib.mind_packets) in
-  let env_ar = push_rel_context ar env in
+  let env_ar = Environ.push_rel_context ar env in
   let imps_one_inductive i mip =
     let ind = (kn,i) in
-    let ar = Global.type_of_global_unsafe (IndRef ind) in
-    ((IndRef ind,compute_semi_auto_implicits env flags manual ar),
+    let ar, _ = Global.type_of_global_in_context env (IndRef ind) in
+    ((IndRef ind,compute_semi_auto_implicits env sigma flags manual (of_constr ar)),
      Array.mapi (fun j c ->
-       (ConstructRef (ind,j+1),compute_semi_auto_implicits env_ar flags manual c))
-       mip.mind_nf_lc)
+       (ConstructRef (ind,j+1),compute_semi_auto_implicits env_ar sigma flags manual c))
+       (Array.map of_constr mip.mind_nf_lc))
   in
   Array.mapi imps_one_inductive mib.mind_packets
 
@@ -449,8 +455,8 @@ let compute_all_mib_implicits flags manual kn =
 
 let compute_var_implicits flags manual id =
   let env = Global.env () in
-  let open Context.Named.Declaration in
-  compute_semi_auto_implicits env flags manual (get_type (lookup_named id env))
+  let sigma = Evd.from_env env in
+  compute_semi_auto_implicits env sigma flags manual (NamedDecl.get_type (lookup_named id env))
 
 (* Implicits of a global reference. *)
 
@@ -479,8 +485,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
 
@@ -517,15 +523,11 @@ let subst_implicits (subst,(req,l)) =
   (ImplLocal,List.smartmap (subst_implicits_decl subst) l)
 
 let impls_of_context ctx =
-  let map (id, impl, _, _) = match impl with
-  | Implicit -> Some (id, Manual, (true, true))
+  let map (decl, impl) = match impl with
+  | Implicit -> Some (NamedDecl.get_id decl, Manual, (true, true))
   | _ -> None
   in
-  let is_set (_, _, b, _) = match b with
-  | None -> true
-  | Some _ -> false
-  in
-  List.rev_map map (List.filter is_set ctx)
+  List.rev_map map (List.filter (fst %> NamedDecl.is_local_assum) ctx)
 
 let adjust_side_condition p = function
   | LessArgsThan n -> LessArgsThan (n+p)
@@ -549,7 +551,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
@@ -650,8 +652,8 @@ type manual_explicitation = Constrexpr.explicitation * (bool * bool * bool)
 
 type manual_implicits = manual_explicitation list
 
-let compute_implicits_with_manual env typ enriching l =
-  let _,autoimpls = compute_auto_implicits env !implicit_args enriching typ in
+let compute_implicits_with_manual env sigma typ enriching l =
+  let _,autoimpls = compute_auto_implicits env sigma !implicit_args enriching typ in
   set_manual_implicits env !implicit_args enriching autoimpls l
 
 let check_inclusion l =
@@ -659,14 +661,14 @@ let check_inclusion l =
   let rec aux = function
     | n1::(n2::_ as nl) ->
 	if n1 <= n2 then
-	  error "Sequences of implicit arguments must be of different lengths.";
+	  user_err Pp.(str "Sequences of implicit arguments must be of different lengths.");
 	aux nl
     | _ -> () in
   aux (List.map (fun (imps,_) -> List.length imps) l)
 
 let check_rigidity isrigid =
   if not isrigid then
-    errorlabstrm "" (strbrk "Multiple sequences of implicit arguments available only for references that cannot be applied to an arbitrarily large number of arguments.")
+    user_err  (strbrk "Multiple sequences of implicit arguments available only for references that cannot be applied to an arbitrarily large number of arguments.")
 
 let projection_implicits env p impls = 
   let pb = Environ.lookup_projection p env in
@@ -675,9 +677,10 @@ let projection_implicits env p impls =
 let declare_manual_implicits local ref ?enriching l =
   let flags = !implicit_args in
   let env = Global.env () in
-  let t = Global.type_of_global_unsafe ref in
+  let sigma = Evd.from_env env in
+  let t, _ = Global.type_of_global_in_context env ref in
   let enriching = Option.default flags.auto enriching in
-  let isrigid,autoimpls = compute_auto_implicits env flags enriching t in
+  let isrigid,autoimpls = compute_auto_implicits env sigma flags enriching (of_constr t) in
   let l' = match l with
     | [] -> assert false
     | [l] ->
diff --git a/library/impargs.mli b/interp/impargs.mli
index 3919a519..103a4f9e 100644
--- a/library/impargs.mli
+++ b/interp/impargs.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
+open EConstr
 open Globnames
-open Term
 open Environ
 
 (** {6 Implicit Arguments } *)
@@ -90,16 +92,16 @@ type manual_explicitation = Constrexpr.explicitation *
 
 type manual_implicits = manual_explicitation list
 
-val compute_implicits_with_manual : env -> types -> bool ->
+val compute_implicits_with_manual : env -> Evd.evar_map -> types -> bool ->
   manual_implicits -> implicit_status list
 
-val compute_implicits_names : env -> types -> Name.t list
+val compute_implicits_names : env -> Evd.evar_map -> 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
 
@@ -128,7 +130,7 @@ val make_implicits_list : implicit_status list -> implicits_list list
 
 val drop_first_implicits : int -> implicits_list -> implicits_list
 
-val projection_implicits : env -> projection -> implicit_status list -> 
+val projection_implicits : env -> Projection.t -> implicit_status list ->
   implicit_status list
 
 val select_impargs_size : int -> implicits_list list -> implicit_status list
diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml
index 10cfbe58..58df9abc 100644
--- a/interp/implicit_quantifiers.ml
+++ b/interp/implicit_quantifiers.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -19,20 +21,21 @@ open Typeclasses_errors
 open Pp
 open Libobject
 open Nameops
-open Misctypes
 open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 (*i*)
 
 let generalizable_table = Summary.ref Id.Pred.empty ~name:"generalizable-ident"
 
-let declare_generalizable_ident table (loc,id) =
+let declare_generalizable_ident table {CAst.loc;v=id} =
   if not (Id.equal id (root_of_id id)) then
-    user_err_loc(loc,"declare_generalizable_ident",
-    (pr_id id ++ str
+    user_err ?loc ~hdr:"declare_generalizable_ident"
+    ((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(loc,"declare_generalizable_ident",
-		(pr_id id++str" is already declared as a generalizable identifier"))
+    user_err ?loc ~hdr:"declare_generalizable_ident"
+		((Id.print id++str" is already declared as a generalizable identifier"))
   else Id.Pred.add id table
 
 let add_generalizable gen table =
@@ -48,7 +51,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;
@@ -78,8 +81,8 @@ let is_freevar ids env x =
 (* Auxiliary functions for the inference of implicitly quantified variables. *)
 
 let ungeneralizable loc id =
-  user_err_loc (loc, "Generalization", 
-	       str "Unbound and ungeneralizable variable " ++ pr_id id)
+  user_err ?loc ~hdr:"Generalization"
+	       (str "Unbound and ungeneralizable variable " ++ Id.print id)
 
 let free_vars_of_constr_expr c ?(bound=Id.Set.empty) l =
   let found loc id bdvars l =
@@ -90,103 +93,51 @@ let free_vars_of_constr_expr c ?(bound=Id.Set.empty) l =
       else ungeneralizable loc id
     else l
   in
-  let rec aux bdvars l c = match c with
-    | CRef (Ident (loc,id),_) -> found loc id bdvars l
-    | CNotation (_, "{ _ : _ | _ }", (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
-    | c -> Topconstr.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux bdvars l c
+  let rec aux bdvars l c = match CAst.(c.v) with
+    | CRef ({CAst.v=Ident id},_) -> found c.CAst.loc id bdvars l
+    | CNotation ("{ _ : _ | _ }", ({ CAst.v = CRef ({CAst.v=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 list) =
+let free_vars_of_binders ?(bound=Id.Set.empty) l (binders : local_binder_expr list) =
   let rec aux bdvars l c = match c with
-      ((LocalRawAssum (n, _, c)) :: tl) ->
+      ((CLocalAssum (n, _, c)) :: tl) ->
 	let bound = ids_of_names n in
 	let l' = free_vars_of_constr_expr c ~bound:bdvars l in
 	  aux (Id.Set.union (ids_of_list bound) bdvars) l' tl
 
-    | ((LocalRawDef (n, c)) :: tl) ->
-	let bound = match snd n with Anonymous -> [] | Name n -> [n] in
+    | ((CLocalDef (n, c, t)) :: tl) ->
+        let bound = match n.CAst.v with Anonymous -> [] | Name n -> [n] in
 	let l' = free_vars_of_constr_expr c ~bound:bdvars l in
-	  aux (Id.Set.union (ids_of_list bound) bdvars) l' tl
+	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
 
-    | LocalPattern _ :: tl -> assert false
+    | CLocalPattern _ :: tl -> assert false
     | [] -> bdvars, l
   in aux bound l binders
 
-let add_name_to_ids set na =
-  match na with
-  | Anonymous -> set
-  | Name id -> Id.Set.add id set
-
 let generalizable_vars_of_glob_constr ?(bound=Id.Set.empty) ?(allowed=Id.Set.empty) =
-  let rec vars bound vs = function
-    | GVar (loc,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 id vs then vs
-	  else (id, loc) :: vs
+          if List.exists (fun {CAst.v} -> Id.equal v id) vs then vs
+          else CAst.(make ?loc id) :: vs
 	else vs
-    | GApp (loc,f,args) -> List.fold_left (vars bound) vs (f::args)
-    | GLambda (loc,na,_,ty,c) | GProd (loc,na,_,ty,c) | GLetIn (loc,na,ty,c) ->
-	let vs' = vars bound vs ty in
-	let bound' = add_name_to_ids bound na in
-	vars bound' vs' c
-    | GCases (loc,sty,rtntypopt,tml,pl) ->
-	let vs1 = vars_option bound vs rtntypopt in
-	let vs2 = List.fold_left (fun vs (tm,_) -> vars bound vs tm) vs1 tml in
-	List.fold_left (vars_pattern bound) vs2 pl
-    | GLetTuple (loc,nal,rtntyp,b,c) ->
-	let vs1 = vars_return_type bound vs rtntyp in
-	let vs2 = vars bound vs1 b in
-	let bound' = List.fold_left add_name_to_ids bound nal in
-	vars bound' vs2 c
-    | GIf (loc,c,rtntyp,b1,b2) ->
-	let vs1 = vars_return_type bound vs rtntyp in
-	let vs2 = vars bound vs1 c in
-	let vs3 = vars bound vs2 b1 in
-	vars bound vs3 b2
-    | GRec (loc,fk,idl,bl,tyl,bv) ->
-	let bound' = Array.fold_right Id.Set.add idl bound in
-	let vars_fix i vs fid =
-	  let vs1,bound1 =
-	    List.fold_left
-	      (fun (vs,bound) (na,k,bbd,bty) ->
-		 let vs' = vars_option bound vs bbd in
-		 let vs'' = vars bound vs' bty in
-		 let bound' = add_name_to_ids bound na in
-		 (vs'',bound')
-	      )
-	      (vs,bound')
-	      bl.(i)
-	  in
-	  let vs2 = vars bound1 vs1 tyl.(i) in
-	  vars bound1 vs2 bv.(i)
-	in
-	Array.fold_left_i vars_fix vs idl
-    | GCast (loc,c,k) -> let v = vars bound vs c in
-	(match k with CastConv t | CastVM t -> vars bound v t | _ -> v)
-    | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> vs
-
-  and vars_pattern bound vs (loc,idl,p,c) =
-    let bound' = List.fold_right Id.Set.add idl bound  in
-    vars bound' vs c
-
-  and vars_option bound vs = function None -> vs | Some p -> vars bound vs p
-
-  and vars_return_type bound vs (na,tyopt) =
-    let bound' = add_name_to_ids bound na in
-    vars_option bound' vs tyopt
+    | _ -> 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 (id, loc) ->
+      List.iter (fun {CAst.loc;v=id} ->
 	if not (Id.Set.mem id allowed || find_generalizable_ident id) then 
 	  ungeneralizable loc id) vars;
       vars
 
 let rec make_fresh ids env x =
-  if is_freevar ids env x then x else make_fresh ids env (Nameops.lift_subscript x)
+  if is_freevar ids env x then x else make_fresh ids env (Nameops.increment_subscript x)
 
 let next_name_away_from na avoid =
   match na with
@@ -197,18 +148,18 @@ let combine_params avoid fn applied needed =
   let named, applied =
     List.partition
       (function
-	  (t, Some (loc, ExplByName id)) ->
-            let is_id (_, decl) = match get_name decl with
+          (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 (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
@@ -237,39 +188,43 @@ let combine_params avoid fn applied needed =
 	    aux (t' :: ids) avoid' app need
 
       | (x,_) :: _, [] ->
-	  user_err_loc (Constrexpr_ops.constr_loc x,"",str "Typeclass does not expect more arguments")
+	  user_err ?loc:(Constrexpr_ops.constr_loc x) (str "Typeclass does not expect more arguments")
   in aux [] avoid applied needed
 
 let combine_params_freevar =
   fun avoid (_, decl) ->
-    let id' = next_name_away_from (get_name decl) avoid in
-      (CRef (Ident (Loc.ghost, id'),None), Id.Set.add id' avoid)
+    let id' = next_name_away_from (RelDecl.get_name decl) avoid in
+      (CAst.make @@ CRef (CAst.make @@ Ident id',None), Id.Set.add id' avoid)
 
 let destClassApp cl =
-  match cl with
-    | CApp (loc, (None, CRef (ref, inst)), l) -> loc, ref, List.map fst l, inst
-    | CAppExpl (loc, (None, ref, inst), l) -> loc, ref, l, inst
-    | CRef (ref, inst) -> loc_of_reference ref, ref, [], inst
+  let open CAst in
+  let loc = cl.loc in
+  match cl.v with
+    | 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:cl.loc (ref, [], inst)
     | _ -> raise Not_found
 
 let destClassAppExpl cl =
-  match cl with
-    | CApp (loc, (None, CRef (ref, inst)), l) -> loc, ref, l, inst
-    | CRef (ref, inst) -> loc_of_reference ref, ref, [], inst
+  let open CAst in
+  let loc = cl.loc in
+  match cl.v with
+    | CApp ((None, { v = CRef (ref, inst) } ), l) -> CAst.make ?loc (ref, l, inst)
+    | CRef (ref, inst) -> CAst.make ?loc:cl.loc (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 (loc, qid) = qualid_of_reference r in
-      let gr = Nametab.locate qid in
+      let ({CAst.v=(r, _, _)} as clapp) = destClassAppExpl ty in
+      let qid = qualid_of_reference r in
+      let gr = Nametab.locate qid.CAst.v in
 	if Typeclasses.is_class gr then Some (clapp, gr) else None
     with Not_found -> None
   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
@@ -287,9 +242,15 @@ let implicit_application env ?(allow_partial=true) f ty =
 	    end;
 	  let pars = List.rev (List.combine ci rd) in
 	  let args, avoid = combine_params avoid f par pars in
-	    CAppExpl (loc, (None, id, inst), args), avoid
+	    CAst.make ?loc @@ CAppExpl ((None, id, inst), args), avoid
 	in c, avoid
 
+let warn_ignoring_implicit_status =
+  CWarnings.create ~name:"ignoring_implicit_status" ~category:"implicits"
+    (fun na ->
+       strbrk "Ignoring implicit status of product binder " ++
+       Name.print na ++ strbrk " and following binders")
+
 let implicits_of_glob_constr ?(with_products=true) l =
   let add_impl i na bk l = match bk with
   | Implicit ->
@@ -305,20 +266,18 @@ let implicits_of_glob_constr ?(with_products=true) l =
     let abs na bk b =
       add_impl i na bk (aux (succ i) b)
     in
-      match c with
-      | GProd (loc, na, bk, t, b) ->
-	  if with_products then abs na bk b
-	  else
-            let () = match bk with
-            | Implicit ->
-	       Feedback.msg_warning (strbrk "Ignoring implicit status of product binder " ++ 
-			      pr_name na ++ strbrk " and following binders")
-            | _ -> ()
-            in []
-      | GLambda (loc, na, bk, t, b) -> abs na bk b
-      | GLetIn (loc, na, t, b) -> aux i b
-      | GRec (_, fix_kind, nas, args, tys, bds) ->
-       let nb = match fix_kind with |GFix (_, n) -> n | GCoFix n -> n in
-       List.fold_left_i (fun i l (na,bk,_,_) -> add_impl i na bk l) i (aux (List.length args.(nb) + i) bds.(nb)) args.(nb)
-      | _ -> []
+    match DAst.get c with
+    | GProd (na, bk, t, b) ->
+      if with_products then abs na bk b
+      else
+        let () = match bk with
+          | Implicit -> warn_ignoring_implicit_status na ?loc:c.CAst.loc
+          | _ -> ()
+        in []
+    | GLambda (na, bk, t, b) -> abs na bk b
+    | GLetIn (na, b, t, c) -> aux i b
+    | GRec (fix_kind, nas, args, tys, bds) ->
+      let nb = match fix_kind with |GFix (_, n) -> n | GCoFix n -> n in
+      List.fold_left_i (fun i l (na,bk,_,_) -> add_impl i na bk l) i (aux (List.length args.(nb) + i) bds.(nb)) args.(nb)
+    | _ -> []
   in aux 1 l
diff --git a/interp/implicit_quantifiers.mli b/interp/implicit_quantifiers.mli
index d0327e50..b9815f34 100644
--- a/interp/implicit_quantifiers.mli
+++ b/interp/implicit_quantifiers.mli
@@ -1,23 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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 -> Loc.t * reference * constr_expr list * instance_expr option
-val destClassAppExpl : constr_expr -> Loc.t * reference * (constr_expr * explicitation located option) list * instance_expr option
+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 *)
 
@@ -25,23 +26,23 @@ val free_vars_of_constr_expr : constr_expr -> ?bound:Id.Set.t ->
   Id.t list -> Id.t list
 
 val free_vars_of_binders :
-  ?bound:Id.Set.t -> Id.t list -> local_binder list -> Id.Set.t * Id.t list
+  ?bound:Id.Set.t -> Id.t list -> local_binder_expr list -> Id.Set.t * Id.t list
 
 (** Returns the generalizable free ids in left-to-right
    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 * Loc.t) 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 96b52959..bb22cf46 100644
--- a/interp/interp.mllib
+++ b/interp/interp.mllib
@@ -1,13 +1,13 @@
+Tactypes
 Stdarg
-Constrarg
 Genintern
-Constrexpr_ops
 Notation_ops
-Ppextend
 Notation
-Dumpglob
 Syntax_def
 Smartlocate
+Constrexpr_ops
+Ppextend
+Dumpglob
 Topconstr
 Reserve
 Impargs
@@ -15,6 +15,5 @@ Implicit_quantifiers
 Constrintern
 Modintern
 Constrextern
-Coqlib
 Discharge
 Declare
diff --git a/interp/modintern.ml b/interp/modintern.ml
index e5dce5cc..dc93d8dc 100644
--- a/interp/modintern.ml
+++ b/interp/modintern.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Declarations
@@ -26,16 +28,16 @@ let error_not_a_module_loc kind loc qid =
     | ModType -> Modops.ModuleTypingError (Modops.NotAModuleType s)
     | ModAny -> ModuleInternalizationError (NotAModuleNorModtype s)
   in
-  Loc.raise loc e
+  Loc.raise ?loc e
 
 let error_application_to_not_path loc me =
-  Loc.raise loc (Modops.ModuleTypingError (Modops.ApplicationToNotPath me))
+  Loc.raise ?loc (Modops.ModuleTypingError (Modops.ApplicationToNotPath me))
 
 let error_incorrect_with_in_module loc =
-  Loc.raise loc (ModuleInternalizationError IncorrectWithInModule)
+  Loc.raise ?loc (ModuleInternalizationError IncorrectWithInModule)
 
 let error_application_to_module_type loc =
-  Loc.raise loc (ModuleInternalizationError IncorrectModuleApplication)
+  Loc.raise ?loc (ModuleInternalizationError IncorrectModuleApplication)
 
 (** Searching for a module name in the Nametab.
 
@@ -43,50 +45,62 @@ let error_application_to_module_type loc =
     or both are searched. The returned kind is never ModAny, and
     it is equal to the input kind when this one isn't ModAny. *)
 
-let lookup_module_or_modtype kind (loc,qid) =
+let lookup_module_or_modtype kind {CAst.loc;v=qid} =
   try
     if kind == ModType then raise Not_found;
     let mp = Nametab.locate_module qid in
-    Dumpglob.dump_modref loc mp "modtype"; (mp,Module)
+    Dumpglob.dump_modref ?loc mp "modtype"; (mp,Module)
   with Not_found ->
     try
       if kind == Module then raise Not_found;
       let mp = Nametab.locate_modtype qid in
-      Dumpglob.dump_modref loc mp "mod"; (mp,ModType)
+      Dumpglob.dump_modref ?loc mp "mod"; (mp,ModType)
     with Not_found -> error_not_a_module_loc kind loc qid
 
 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)
-  | 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))
+  | CWith_Module ({CAst.v=fqid},qid) ->
+      WithMod (fqid,lookup_module qid), Univ.ContextSet.empty
+  | CWith_Definition ({CAst.v=fqid},udecl,c) ->
+    let sigma, udecl = Univdecls.interp_univ_decl_opt env udecl in
+    let c, ectx = interp_constr env sigma c in
+    begin match UState.check_univ_decl ~poly:(Flags.is_universe_polymorphism()) ectx udecl with
+      | Entries.Polymorphic_const_entry ctx ->
+        let inst, ctx = Univ.abstract_universes ctx in
+        let c = EConstr.Vars.subst_univs_level_constr (Univ.make_instance_subst inst) c in
+        let c = EConstr.to_constr sigma c in
+        WithDef (fqid,(c, Some ctx)), Univ.ContextSet.empty
+      | Entries.Monomorphic_const_entry ctx ->
+        let c = EConstr.to_constr sigma c in
+        WithDef (fqid,(c, None)), ctx
+    end
 
-let loc_of_module = function
-  | CMident (loc,_) | CMapply (loc,_,_) | CMwith (loc,_,_) -> loc
+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 = function
-  | CMident qid ->
-      let (mp,kind) = lookup_module_or_modtype kind qid in
-      (MEident mp, kind)
-  | CMapply (_,me1,me2) ->
-      let me1',kind1 = interp_module_ast env kind me1 in
-      let me2',kind2 = interp_module_ast env ModAny me2 in
+let rec interp_module_ast env kind m cst = match m with
+  | {CAst.loc;v=CMident qid} ->
+      let (mp,kind) = lookup_module_or_modtype kind CAst.(make ?loc qid) in
+      (MEident mp, kind, cst)
+  | {CAst.loc;v=CMapply (me1,me2)} ->
+      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)
-  | CMwith (loc,me,decl) ->
-      let me,kind = interp_module_ast env kind me in
-      if kind == Module then error_incorrect_with_in_module loc;
-      let decl = transl_with_decl env decl in
-      (MEwith(me,decl), kind)
+      (MEapply (me1',mp2), kind1, cst)
+  | {CAst.loc;v=CMwith (me,decl)} ->
+      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, 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 1e04ada1..ef37aead 100644
--- a/interp/modintern.mli
+++ b/interp/modintern.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Environ
@@ -28,4 +30,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 389a1c9d..bb58f00c 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -1,18 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
 open CErrors
 open Util
 open Pp
-open Bigint
 open Names
-open Term
+open Constr
 open Libnames
 open Globnames
 open Constrexpr
@@ -20,6 +21,8 @@ open Notation_term
 open Glob_term
 open Glob_ops
 open Ppextend
+open Context.Named.Declaration
+
 (*i*)
 
 (*s A scope is a set of notations; it includes
@@ -40,14 +43,12 @@ open Ppextend
 (**********************************************************************)
 (* Scope of symbols *)
 
-type level = precedence * tolerability list
 type delimiters = string
 type notation_location = (DirPath.t * DirPath.t) * string
 
 type notation_data = {
   not_interp : interpretation;
   not_location : notation_location;
-  not_onlyprinting : bool;
 }
 
 type scope = {
@@ -82,11 +83,35 @@ let parenRelation_eq t1 t2 = match t1, t2 with
 | Prec l1, Prec l2 -> Int.equal l1 l2
 | _ -> false
 
-let level_eq (l1, t1) (l2, t2) =
-  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 (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 ()
@@ -95,7 +120,7 @@ let declare_scope scope =
     scope_map := String.Map.add scope empty_scope !scope_map
 
 let error_unknown_scope sc =
-  errorlabstrm "Notation"
+  user_err ~hdr:"Notation"
     (str "Scope " ++ str sc ++ str " is not declared.")
 
 let find_scope scope =
@@ -208,7 +233,7 @@ let remove_delimiters scope =
   let sc = find_scope scope in
   let newsc = { sc with delimiters = None } in
   match sc.delimiters with
-    | None -> CErrors.errorlabstrm "" (str "No bound key for scope " ++ str scope ++ str ".")
+    | None -> CErrors.user_err  (str "No bound key for scope " ++ str scope ++ str ".")
     | Some key ->
        scope_map := String.Map.add scope newsc !scope_map;
        try
@@ -217,17 +242,17 @@ let remove_delimiters scope =
        with Not_found ->
          assert false (* A delimiter for scope [scope] should exist *)
 
-let find_delimiters_scope loc key =
+let find_delimiters_scope ?loc key =
   try String.Map.find key !delimiters_map
   with Not_found ->
-    user_err_loc
-    (loc, "find_delimiters", str "Unknown scope delimiting key " ++ str key ++ str ".")
+    user_err ?loc ~hdr:"find_delimiters"
+      (str "Unknown scope delimiting key " ++ str key ++ str ".")
 
 (* Uninterpretation tables *)
 
 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) *)
@@ -258,25 +283,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
-  | GApp (_,GRef (_,ref,_),_) | 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
-  | GApp (_,GRef (_,ref,_),_) -> [RefKey (canonical_gr ref); Oth]
-  | 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
-  | 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)
@@ -288,15 +322,15 @@ let notation_constr_key = function (* Rem: NApp(NRef ref,[]) stands for @ref *)
 type required_module = full_path * string list
 
 type 'a prim_token_interpreter =
-    Loc.t -> 'a -> glob_constr
+    ?loc:Loc.t -> 'a -> glob_constr
 
 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.t -> prim_token -> required_module * (unit -> glob_constr)
+    ?loc:Loc.t -> prim_token -> required_module * (unit -> glob_constr)
 
 let prim_token_interpreter_tab =
   (Hashtbl.create 7 : (scope_name, internal_prim_token_interpreter) Hashtbl.t)
@@ -306,7 +340,7 @@ let add_prim_token_interpreter sc interp =
     let cont = Hashtbl.find prim_token_interpreter_tab sc in
     Hashtbl.replace prim_token_interpreter_tab sc (interp cont)
   with Not_found ->
-    let cont = (fun _loc _p -> raise Not_found) in
+    let cont = (fun ?loc _p -> raise Not_found) in
     Hashtbl.add prim_token_interpreter_tab sc (interp cont)
 
 let declare_prim_token_interpreter sc interp (patl,uninterp,b) =
@@ -317,28 +351,46 @@ let declare_prim_token_interpreter sc interp (patl,uninterp,b) =
         (glob_prim_constr_key pat) (sc,uninterp,b) !prim_token_key_table)
     patl
 
-let mkNumeral n = Numeral n
+let mkNumeral n =
+  if Bigint.is_pos_or_zero n then Numeral (Bigint.to_string n, true)
+  else Numeral (Bigint.to_string (Bigint.neg n), false)
+
+let ofNumeral n s =
+  if s then Bigint.of_string n else Bigint.neg (Bigint.of_string n)
+
 let mkString = function
 | None -> None
 | Some s -> if Unicode.is_utf8 s then Some (String s) else None
 
-let delay dir int loc x = (dir, (fun () -> int loc x))
+let delay dir int ?loc x = (dir, (fun () -> int ?loc x))
+
+type rawnum = Constrexpr.raw_natural_number * Constrexpr.sign
+
+let declare_rawnumeral_interpreter sc dir interp (patl,uninterp,inpat) =
+  declare_prim_token_interpreter sc
+    (fun cont ?loc -> function Numeral (n,s) -> delay dir interp ?loc (n,s)
+                            | p -> cont ?loc p)
+    (patl, (fun r -> match uninterp r with
+                     | None -> None
+                     | Some (n,s) -> Some (Numeral (n,s))), inpat)
 
 let declare_numeral_interpreter sc dir interp (patl,uninterp,inpat) =
+  let interp' ?loc (n,s) = interp ?loc (ofNumeral n s) in
   declare_prim_token_interpreter sc
-    (fun cont loc -> function Numeral n-> delay dir interp loc n | p -> cont loc p)
+    (fun cont ?loc -> function Numeral (n,s) -> delay dir interp' ?loc (n,s)
+                            | p -> cont ?loc p)
     (patl, (fun r -> Option.map mkNumeral (uninterp r)), inpat)
 
 let declare_string_interpreter sc dir interp (patl,uninterp,inpat) =
   declare_prim_token_interpreter sc
-    (fun cont loc -> function String s -> delay dir interp loc s | p -> cont loc p)
+    (fun cont ?loc -> function String s -> delay dir interp ?loc s | p -> cont ?loc p)
     (patl, (fun r -> mkString (uninterp r)), inpat)
 
-let check_required_module loc sc (sp,d) =
+let check_required_module ?loc sc (sp,d) =
   try let _ = Nametab.global_of_path sp in ()
   with Not_found ->
-    user_err_loc (loc,"prim_token_interpreter",
-    str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".")
+    user_err ?loc ~hdr:"prim_token_interpreter"
+    (str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".")
 
 (* Look if some notation or numeral printer in [scope] can be used in
    the scope stack [scopes], and if yes, using delimiters or not *)
@@ -377,13 +429,15 @@ let rec find_without_delimiters find (ntn_scope,ntn) = function
 
 (* Uninterpreted notation levels *)
 
-let declare_notation_level ntn level =
+let declare_notation_level ?(onlyprint=false) ntn level =
   if String.Map.mem ntn !notation_level_map then
-    anomaly (str "Notation " ++ str ntn ++ str " is already assigned a level");
-  notation_level_map := String.Map.add ntn level !notation_level_map
+    anomaly (str "Notation " ++ str ntn ++ str " is already assigned a level.");
+  notation_level_map := String.Map.add ntn (level,onlyprint) !notation_level_map
 
-let level_of_notation ntn =
-  String.Map.find ntn !notation_level_map
+let level_of_notation ?(onlyprint=false) ntn =
+  let (level,onlyprint') = String.Map.find ntn !notation_level_map in
+  if onlyprint' && not onlyprint then raise Not_found;
+  level
 
 (* The mapping between notations and their interpretation *)
 
@@ -391,25 +445,26 @@ 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
   let sc = find_scope scope in
-  let () =
-    if String.Map.mem ntn sc.notations then
-    let which_scope = match scopt with
-    | None -> mt ()
-    | Some _ -> spc () ++ strbrk "in scope" ++ spc () ++ str scope in
-    warn_notation_overridden (ntn,which_scope)
-  in
-  let notdata = {
-    not_interp = pat;
-    not_location = df;
-    not_onlyprinting = onlyprint;
-  } in
-  let sc = { sc with notations = String.Map.add ntn notdata sc.notations } in
-  let () = scope_map := String.Map.add scope sc !scope_map in
+  if not onlyprint then begin
+    let () =
+      if String.Map.mem ntn sc.notations then
+      let which_scope = match scopt with
+      | None -> mt ()
+      | Some _ -> spc () ++ strbrk "in scope" ++ spc () ++ str scope in
+      warn_notation_overridden (ntn,which_scope)
+    in
+    let notdata = {
+      not_interp = pat;
+      not_location = df;
+    } in
+    let sc = { sc with notations = String.Map.add ntn notdata sc.notations } in
+    scope_map := String.Map.add scope sc !scope_map
+  end;
   begin match scopt with
   | None -> scope_stack := SingleNotation ntn :: !scope_stack
   | Some _ -> ()
@@ -434,57 +489,62 @@ let rec find_interpretation ntn find = function
 
 let find_notation ntn sc =
   let n = String.Map.find ntn (find_scope sc).notations in
-  let () = if n.not_onlyprinting then raise Not_found in
   (n.not_interp, n.not_location)
 
 let notation_of_prim_token = function
-  | Numeral n when is_pos_or_zero n -> to_string n
-  | Numeral n -> "- "^(to_string (neg n))
+  | Numeral (n,true) -> n
+  | Numeral (n,false) -> "- "^n
   | String _ -> raise Not_found
 
-let find_prim_token g loc p sc =
+let find_prim_token check_allowed ?loc p sc =
   (* Try for a user-defined numerical notation *)
   try
     let (_,c),df = find_notation (notation_of_prim_token p) sc in
-    g (Notation_ops.glob_constr_of_notation_constr loc c),df
+    let pat = Notation_ops.glob_constr_of_notation_constr ?loc c in
+    check_allowed pat;
+    pat, df
   with Not_found ->
   (* Try for a primitive numerical notation *)
-  let (spdir,interp) = Hashtbl.find prim_token_interpreter_tab sc loc p in
-  check_required_module loc sc spdir;
-  g (interp ()), ((dirpath (fst spdir),DirPath.empty),"")
+  let (spdir,interp) = Hashtbl.find prim_token_interpreter_tab sc ?loc p in
+  check_required_module ?loc sc spdir;
+  let pat = interp () in
+  check_allowed pat;
+  pat, ((dirpath (fst spdir),DirPath.empty),"")
 
-let interp_prim_token_gen g loc p local_scopes =
+let interp_prim_token_gen ?loc g p local_scopes =
   let scopes = make_current_scopes local_scopes in
   let p_as_ntn = try notation_of_prim_token p with Not_found -> "" in
-  try find_interpretation p_as_ntn (find_prim_token g loc p) scopes
+  try find_interpretation p_as_ntn (find_prim_token ?loc g p) scopes
   with Not_found ->
-    user_err_loc (loc,"interp_prim_token",
-    (match p with
-      | Numeral n -> str "No interpretation for numeral " ++ str (to_string n)
+    user_err ?loc ~hdr:"interp_prim_token"
+    ((match p with
+      | Numeral _ ->
+         str "No interpretation for numeral " ++ str (notation_of_prim_token p)
       | String s -> str "No interpretation for string " ++ qs s) ++ str ".")
 
-let interp_prim_token =
-  interp_prim_token_gen (fun x -> x)
-
-(** [rcp_of_glob] : from [glob_constr] to [raw_cases_pattern_expr] *)
-
-let rec rcp_of_glob looked_for = function
-  | GVar (loc,id) -> RCPatAtom (loc,Some id)
-  | GHole (loc,_,_,_) -> RCPatAtom (loc,None)
-  | GRef (loc,g,_) -> looked_for g; RCPatCstr (loc, g,[],[])
-  | GApp (loc,GRef (_,g,_),l) ->
-    looked_for g; RCPatCstr (loc, g, List.map (rcp_of_glob looked_for) l,[])
-  | _ -> raise Not_found
+let interp_prim_token ?loc =
+  interp_prim_token_gen ?loc (fun _ -> ())
+
+let rec check_allowed_ref_in_pat looked_for = DAst.(with_val (function
+  | GVar _ | GHole _ -> ()
+  | GRef (g,_) -> looked_for g
+  | 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 =
-  interp_prim_token_gen (rcp_of_glob looked_for) loc p
+let interp_prim_token_cases_pattern_expr ?loc looked_for p =
+  interp_prim_token_gen ?loc (check_allowed_ref_in_pat looked_for) p
 
-let interp_notation loc ntn local_scopes =
+let interp_notation ?loc ntn local_scopes =
   let scopes = make_current_scopes local_scopes in
   try find_interpretation ntn (find_notation ntn) scopes
   with Not_found ->
-    user_err_loc
-    (loc,"",str "Unknown interpretation for notation \"" ++ str ntn ++ str "\".")
+    user_err ?loc 
+    (str "Unknown interpretation for notation \"" ++ str ntn ++ str "\".")
 
 let uninterp_notations c =
   List.map_append (fun key -> keymap_find key !notations_key_table)
@@ -505,7 +565,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
@@ -518,8 +578,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 = GRef (Loc.ghost,ref,None) in
-    match numpr (GApp (Loc.ghost,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
@@ -530,14 +590,14 @@ 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
 
 let availability_of_prim_token n printer_scope local_scopes =
   let f scope =
-    try ignore (Hashtbl.find prim_token_interpreter_tab scope Loc.ghost n); true
+    try ignore ((Hashtbl.find prim_token_interpreter_tab scope) n); true
     with Not_found -> false in
   let scopes = make_current_scopes local_scopes in
   Option.map snd (find_without_delimiters f (Some printer_scope,None) scopes)
@@ -546,12 +606,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 &&
@@ -561,7 +627,7 @@ let interpretation_eq (vars1, t1) (vars2, t2) =
   List.equal var_attributes_eq vars1 vars2 &&
   Notation_ops.eq_notation_constr (List.map fst vars1, List.map fst vars2) t1 t2
 
-let exists_notation_in_scope scopt ntn r =
+let exists_notation_in_scope scopt ntn onlyprint r =
   let scope = match scopt with Some s -> s | None -> default_scope in
   try
     let sc = String.Map.find scope !scope_map in
@@ -581,8 +647,8 @@ type scope_class = cl_typ
 let scope_class_compare : scope_class -> scope_class -> int =
   cl_typ_ord
 
-let compute_scope_class t =
-  let (cl,_,_) = find_class_type Evd.empty t in
+let compute_scope_class sigma t =
+  let (cl,_,_) = find_class_type sigma t in
   cl
 
 module ScopeClassOrd =
@@ -611,22 +677,22 @@ 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 (Reductionops.whd_betaiotazeta Evd.empty t) with
+let rec compute_arguments_classes sigma t =
+  match EConstr.kind sigma (Reductionops.whd_betaiotazeta sigma t) with
     | Prod (_,t,u) ->
-	let cl = try Some (compute_scope_class t) with Not_found -> None in
-	cl :: compute_arguments_classes u
+        let cl = try Some (compute_scope_class sigma t) with Not_found -> None in
+        cl :: compute_arguments_classes sigma u
     | _ -> []
 
-let compute_arguments_scope_full t =
-  let cls = compute_arguments_classes t in
+let compute_arguments_scope_full sigma t =
+  let cls = compute_arguments_classes sigma t in
   let scs = List.map find_scope_class_opt cls in
   scs, cls
 
-let compute_arguments_scope t = fst (compute_arguments_scope_full t)
+let compute_arguments_scope sigma t = fst (compute_arguments_scope_full sigma t)
 
-let compute_type_scope t =
-  find_scope_class_opt (try Some (compute_scope_class t) with Not_found -> None)
+let compute_type_scope sigma t =
+  find_scope_class_opt (try Some (compute_scope_class sigma t) with Not_found -> None)
 
 let current_type_scope_name () =
    find_scope_class_opt (Some CL_SORT)
@@ -684,7 +750,7 @@ let discharge_arguments_scope (_,(req,r,n,l,_)) =
     let n =
       try
         let vars = Lib.variable_section_segment_of_reference r in
-        List.length (List.filter (fun (_,_,b,_) -> b = None) vars)
+        vars |> List.map fst |> List.filter is_local_assum |> List.length
       with
         Not_found (* Not a ref defined in this section *) -> 0 in
     Some (req,Lib.discharge_global r,n,l,[])
@@ -692,20 +758,24 @@ let discharge_arguments_scope (_,(req,r,n,l,_)) =
 let classify_arguments_scope (req,_,_,_,_ as obj) =
   if req == ArgsScopeNoDischarge then Dispose else Substitute obj
 
-let rebuild_arguments_scope (req,r,n,l,_) =
+let rebuild_arguments_scope sigma (req,r,n,l,_) =
   match req with
     | ArgsScopeNoDischarge -> assert false
     | ArgsScopeAuto ->
-        let scs,cls = compute_arguments_scope_full (fst(Universes.type_of_global r)(*FIXME?*)) in
-	(req,r,List.length scs,scs,cls)
+      let env = Global.env () in (*FIXME?*)
+      let typ = EConstr.of_constr @@ fst (Global.type_of_global_in_context env r) in
+      let scs,cls = compute_arguments_scope_full sigma typ in
+      (req,r,List.length scs,scs,cls)
     | ArgsScopeManual ->
-	(* Add to the manually given scopes the one found automatically
-           for the extra parameters of the section. Discard the classes
-           of the manually given scopes to avoid further re-computations. *)
-        let l',cls = compute_arguments_scope_full (Global.type_of_global_unsafe r) in
-	let l1 = List.firstn n l' in
-        let cls1 = List.firstn n cls in
-	(req,r,0,l1@l,cls1)
+      (* Add to the manually given scopes the one found automatically
+         for the extra parameters of the section. Discard the classes
+         of the manually given scopes to avoid further re-computations. *)
+      let env = Global.env () in (*FIXME?*)
+      let typ = EConstr.of_constr @@ fst (Global.type_of_global_in_context env r) in
+      let l',cls = compute_arguments_scope_full sigma typ in
+      let l1 = List.firstn n l' in
+      let cls1 = List.firstn n cls in
+      (req,r,0,l1@l,cls1)
 
 type arguments_scope_obj =
     arguments_scope_discharge_request * global_reference *
@@ -720,7 +790,8 @@ let inArgumentsScope : arguments_scope_obj -> obj =
       subst_function = subst_arguments_scope;
       classify_function = classify_arguments_scope;
       discharge_function = discharge_arguments_scope;
-      rebuild_function = rebuild_arguments_scope }
+      (* XXX: Should we pass the sigma here or not, see @herbelin's comment in 6511 *)
+      rebuild_function = rebuild_arguments_scope Evd.empty }
 
 let is_local local ref = local || isVarRef ref && Lib.is_in_section ref
 
@@ -732,7 +803,7 @@ let declare_arguments_scope local r scl =
   (* We empty the list of argument classes to disable further scope
      re-computations and keep these manually given scopes. *)
   declare_arguments_scope_gen req r 0 (scl,[])
-                              
+
 let find_arguments_scope r =
   try
     let (scl,cls,stamp) = Refmap.find r !arguments_scope in
@@ -745,12 +816,12 @@ let find_arguments_scope r =
       scl'
   with Not_found -> []
 
-let declare_ref_arguments_scope ref =
-  let t = Global.type_of_global_unsafe ref in
-  let (scs,cls as o) = compute_arguments_scope_full t in
+let declare_ref_arguments_scope sigma ref =
+  let env = Global.env () in (* FIXME? *)
+  let typ = EConstr.of_constr @@ fst @@ Global.type_of_global_in_context env ref in
+  let (scs,cls as o) = compute_arguments_scope_full sigma typ in
   declare_arguments_scope_gen ArgsScopeAuto ref (List.length scs) o
 
-
 (********************************)
 (* Encoding notations as string *)
 
@@ -819,7 +890,7 @@ let pr_scope_classes sc =
 
 let pr_notation_info prglob ntn c =
   str "\"" ++ str ntn ++ str "\" := " ++
-  prglob (Notation_ops.glob_constr_of_notation_constr Loc.ghost c)
+  prglob (Notation_ops.glob_constr_of_notation_constr c)
 
 let pr_named_scope prglob scope sc =
  (if String.equal scope default_scope then
@@ -862,8 +933,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
@@ -876,7 +1002,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
 
@@ -887,25 +1013,25 @@ let global_reference_of_notation test (ntn,(sc,c,_)) =
       Some (ntn,sc,ref)
   | _ -> None
 
-let error_ambiguous_notation loc _ntn =
-  user_err_loc (loc,"",str "Ambiguous notation.")
+let error_ambiguous_notation ?loc _ntn =
+  user_err ?loc (str "Ambiguous notation.")
 
-let error_notation_not_reference loc ntn =
-  user_err_loc (loc,"",
-    str "Unable to interpret " ++ quote (str ntn) ++
+let error_notation_not_reference ?loc ntn =
+  user_err ?loc 
+   (str "Unable to interpret " ++ quote (str ntn) ++
     str " as a reference.")
 
-let interp_notation_as_global_reference loc test ntn sc =
+let interp_notation_as_global_reference ?loc test ntn sc =
   let scopes = match sc with
   | Some sc ->
-      let scope = find_scope (find_delimiters_scope Loc.ghost sc) in
+      let scope = find_scope (find_delimiters_scope sc) in
       String.Map.add sc scope String.Map.empty
   | None -> !scope_map in
   let ntns = browse_notation true ntn scopes in
   let refs = List.map (global_reference_of_notation test) ntns in
   match Option.List.flatten refs with
   | [_,_,ref] -> ref
-  | [] -> error_notation_not_reference loc ntn
+  | [] -> error_notation_not_reference ?loc ntn
   | refs ->
       let f (ntn,sc,ref) =
         let def = find_default ntn !scope_stack in
@@ -915,8 +1041,8 @@ let interp_notation_as_global_reference loc test ntn sc =
       in
       match List.filter f refs with
       | [_,_,ref] -> ref
-      | [] -> error_notation_not_reference loc ntn
-      | _ -> error_ambiguous_notation loc ntn
+      | [] -> error_notation_not_reference ?loc ntn
+      | _ -> error_ambiguous_notation ?loc ntn
 
 let locate_notation prglob ntn scope =
   let ntns = factorize_entries (browse_notation false ntn !scope_map) in
@@ -924,19 +1050,18 @@ let locate_notation prglob ntn scope =
   match ntns with
   | [] -> str "Unknown notation"
   | _ ->
-    t (str "Notation            " ++
-    tab () ++ str "Scope     " ++ tab () ++ fnl () ++
-    prlist (fun (ntn,l) ->
+    str "Notation" ++ fnl () ++
+    prlist_with_sep fnl (fun (ntn,l) ->
       let scope = find_default ntn scopes in
       prlist
 	(fun (sc,r,(_,df)) ->
 	  hov 0 (
-	    pr_notation_info prglob df r ++ tbrk (1,2) ++
-	    (if String.equal sc default_scope then mt () else (str ": " ++ str sc)) ++
-	    tbrk (1,2) ++
-	    (if Option.equal String.equal (Some sc) scope then str "(default interpretation)" else mt ())
-	    ++ fnl ()))
-	l) ntns)
+	    pr_notation_info prglob df r ++
+	    (if String.equal sc default_scope then mt ()
+             else (spc () ++ str ": " ++ str sc)) ++
+	    (if Option.equal String.equal (Some sc) scope
+             then spc () ++ str "(default interpretation)" else mt ())))
+	l) ntns
 
 let collect_notation_in_scope scope sc known =
   assert (not (String.equal scope default_scope));
@@ -1001,13 +1126,13 @@ let declare_notation_rule ntn ~extra unpl gram =
 
 let find_notation_printing_rule ntn =
   try pi1 (String.Map.find ntn !notation_rules)
-  with Not_found -> anomaly (str "No printing rule found for " ++ str ntn)
+  with Not_found -> anomaly (str "No printing rule found for " ++ str ntn ++ str ".")
 let find_notation_extra_printing_rules ntn =
   try pi2 (String.Map.find ntn !notation_rules)
   with Not_found -> []
 let find_notation_parsing_rules ntn =
   try pi3 (String.Map.find ntn !notation_rules)
-  with Not_found -> anomaly (str "No parsing rule found for " ++ str ntn)
+  with Not_found -> anomaly (str "No parsing rule found for " ++ str ntn ++ str ".")
 
 let get_defined_notations () =
   String.Set.elements @@ String.Map.domain !notation_rules
@@ -1018,8 +1143,8 @@ let add_notation_extra_printing_rule ntn k v =
       let p, pp, gr = String.Map.find ntn !notation_rules in
       String.Map.add ntn (p, (k,v) :: pp, gr) !notation_rules
   with Not_found ->
-    user_err_loc (Loc.ghost,"add_notation_extra_printing_rule",
-      str "No such Notation.")
+    user_err ~hdr:"add_notation_extra_printing_rule"
+      (str "No such Notation.")
 
 (**********************************************************************)
 (* Synchronisation with reset *)
diff --git a/interp/notation.mli b/interp/notation.mli
index 2e92a00a..18671feb 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open Bigint
 open Names
 open Libnames
@@ -22,7 +23,6 @@ open Ppextend
 (** A scope is a set of interpreters for symbols + optional
    interpreter and printers for integers + optional delimiters *)
 
-type level = precedence * tolerability list
 type delimiters = string
 type scope
 type scopes (** = [scope_name list] *)
@@ -55,7 +55,7 @@ val find_scope : scope_name -> scope
 
 val declare_delimiters : scope_name -> delimiters -> unit
 val remove_delimiters : scope_name -> unit
-val find_delimiters_scope : Loc.t -> delimiters -> scope_name
+val find_delimiters_scope : ?loc:Loc.t -> delimiters -> scope_name
 
 (** {6 Declare and uses back and forth an interpretation of primitive token } *)
 
@@ -69,10 +69,15 @@ type required_module = full_path * string list
 type cases_pattern_status = bool (** true = use prim token in patterns *)
 
 type 'a prim_token_interpreter =
-    Loc.t -> 'a -> glob_constr
+    ?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
+
+val declare_rawnumeral_interpreter : scope_name -> required_module ->
+  rawnum prim_token_interpreter -> rawnum prim_token_uninterpreter -> unit
 
 val declare_numeral_interpreter : scope_name -> required_module ->
   bigint prim_token_interpreter -> bigint prim_token_uninterpreter -> unit
@@ -83,18 +88,19 @@ val declare_string_interpreter : scope_name -> required_module ->
 (** Return the [term]/[cases_pattern] bound to a primitive token in a
    given scope context*)
 
-val interp_prim_token : Loc.t -> prim_token -> local_scopes ->
+val interp_prim_token : ?loc:Loc.t -> prim_token -> local_scopes ->
   glob_constr * (notation_location * scope_name option)
-val interp_prim_token_cases_pattern_expr : Loc.t -> (global_reference -> unit) -> prim_token ->
-  local_scopes -> raw_cases_pattern_expr * (notation_location * scope_name option)
+(* This function returns a glob_const representing a pattern *)
+val interp_prim_token_cases_pattern_expr : ?loc:Loc.t -> (global_reference -> unit) -> prim_token ->
+  local_scopes -> glob_constr * (notation_location * scope_name option)
 
 (** Return the primitive token associated to a [term]/[cases_pattern];
    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
 
@@ -106,7 +112,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
@@ -114,14 +120,14 @@ val declare_notation_interpretation : notation -> scope_name option ->
 val declare_uninterpretation : interp_rule -> interpretation -> unit
 
 (** Return the interpretation bound to a notation *)
-val interp_notation : Loc.t -> notation -> local_scopes ->
+val interp_notation : ?loc:Loc.t -> notation -> local_scopes ->
       interpretation * (notation_location * scope_name option)
 
 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_notations : 'a glob_constr_g -> notation_rule list
+val uninterp_cases_pattern_notations : 'a cases_pattern_g -> notation_rule list
 val uninterp_ind_pattern_notations : inductive -> notation_rule list
 
 (** Test if a notation is available in the scopes 
@@ -132,17 +138,17 @@ val availability_of_notation : scope_name option * notation -> local_scopes ->
 
 (** {6 Declare and test the level of a (possibly uninterpreted) notation } *)
 
-val declare_notation_level : notation -> level -> unit
-val level_of_notation : notation -> level (** raise [Not_found] if no level *)
+val declare_notation_level : ?onlyprint:bool -> notation -> level -> unit
+val level_of_notation : ?onlyprint:bool -> notation -> level (** raise [Not_found] if no level or not respecting onlyprint *)
 
 (** {6 Miscellaneous} *)
 
-val interp_notation_as_global_reference : Loc.t -> (global_reference -> bool) ->
+val interp_notation_as_global_reference : ?loc:Loc.t -> (global_reference -> bool) ->
       notation -> delimiters option -> global_reference
 
 (** Checks for already existing notations *)
 val exists_notation_in_scope : scope_name option -> notation ->
-      interpretation -> bool
+      bool -> interpretation -> bool
 
 (** Declares and looks for scopes associated to arguments of a global ref *)
 val declare_arguments_scope :
@@ -159,10 +165,10 @@ val subst_scope_class :
   Mod_subst.substitution -> scope_class -> scope_class option
 
 val declare_scope_class : scope_name -> scope_class -> unit
-val declare_ref_arguments_scope : global_reference -> unit
+val declare_ref_arguments_scope : Evd.evar_map -> 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 : Evd.evar_map -> EConstr.types -> scope_name option list
+val compute_type_scope : Evd.evar_map -> EConstr.types -> scope_name option
 
 (** Get the current scope bound to Sortclass, if it exists *)
 val current_type_scope_name : unit -> scope_name option
@@ -172,24 +178,28 @@ 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 -> std_ppcmds
-val pr_scope : (glob_constr -> std_ppcmds) -> scope_name -> std_ppcmds
-val pr_scopes : (glob_constr -> std_ppcmds) -> std_ppcmds
-val locate_notation : (glob_constr -> std_ppcmds) -> notation ->
-      scope_name option -> std_ppcmds
+val pr_scope_class : scope_class -> Pp.t
+val pr_scope : (glob_constr -> Pp.t) -> scope_name -> Pp.t
+val pr_scopes : (glob_constr -> Pp.t) -> Pp.t
+val locate_notation : (glob_constr -> Pp.t) -> notation ->
+      scope_name option -> Pp.t
 
-val pr_visibility: (glob_constr -> std_ppcmds) -> scope_name option -> std_ppcmds
+val pr_visibility: (glob_constr -> Pp.t) -> scope_name option -> Pp.t
 
 (** {6 Printing rules for notations} *)
 
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml
index 0c5393cf..55e532dc 100644
--- a/interp/notation_ops.ml
+++ b/interp/notation_ops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -22,34 +24,16 @@ open Notation_term
 (**********************************************************************)
 (* Utilities                                                          *)
 
-let on_true_do b f c = if b then (f c; b) else b
-
-let compare_glob_constr f add t1 t2 = match t1,t2 with
-  | GRef (_,r1,_), GRef (_,r2,_) -> eq_gr r1 r2
-  | GVar (_,v1), GVar (_,v2) -> on_true_do (Id.equal v1 v2) add (Name v1)
-  | GApp (_,f1,l1), GApp (_,f2,l2) -> f f1 f2 && List.for_all2eq f l1 l2
-  | GLambda (_,na1,bk1,ty1,c1), GLambda (_,na2,bk2,ty2,c2)
-    when Name.equal na1 na2 && Constrexpr_ops.binding_kind_eq bk1 bk2 ->
-    on_true_do (f ty1 ty2 && f c1 c2) add na1
-  | GProd (_,na1,bk1,ty1,c1), GProd (_,na2,bk2,ty2,c2)
-    when Name.equal na1 na2 && Constrexpr_ops.binding_kind_eq bk1 bk2 ->
-      on_true_do (f ty1 ty2 && f c1 c2) add na1
-  | GHole _, GHole _ -> true
-  | GSort (_,s1), GSort (_,s2) -> Miscops.glob_sort_eq s1 s2
-  | GLetIn (_,na1,b1,c1), GLetIn (_,na2,b2,c2) when Name.equal na1 na2 ->
-      on_true_do (f b1 b2 && f c1 c2) add na1
-  | (GCases _ | GRec _
-    | GPatVar _ | GEvar _ | GLetTuple _ | GIf _ | GCast _),_
-  | _,(GCases _ | GRec _
-      | GPatVar _ | GEvar _ | GLetTuple _ | GIf _ | GCast _)
-      -> error "Unsupported construction in recursive notations."
-  | (GRef _ | GVar _ | GApp _ | GLambda _ | GProd _
-    | GHole _ | GSort _ | GLetIn _), _
-      -> false
+(* helper for NVar, NVar case in eq_notation_constr *)
+let get_var_ndx id vs = try Some (List.index Id.equal id vs) with Not_found -> None
 
 let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with
 | NRef gr1, NRef gr2 -> eq_gr gr1 gr2
-| NVar id1, NVar id2 -> Int.equal (List.index Id.equal id1 vars1) (List.index Id.equal id2 vars2)
+| NVar id1, NVar id2 -> (
+   match (get_var_ndx id1 vars1,get_var_ndx id2 vars2) with
+   | Some n,Some m -> Int.equal n m
+   | None  ,None   -> Id.equal id1 id2
+   | _             -> false)
 | NApp (t1, a1), NApp (t2, a2) ->
   (eq_notation_constr vars) t1 t2 && List.equal (eq_notation_constr vars) a1 a2
 | NHole (_, _, _), NHole (_, _, _) -> true (** FIXME? *)
@@ -60,11 +44,12 @@ 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
-| NLetIn (na1, t1, u1), NLetIn (na2, t2, u2) ->
-  Name.equal na1 na2 && (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
 | NCases (_, o1, r1, p1), NCases (_, o2, r2, p2) -> (** FIXME? *)
   let eqpat (p1, t1) (p2, t2) =
     List.equal cases_pattern_eq p1 p2 &&
@@ -111,282 +96,357 @@ let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with
 (* Re-interpret a notation as a glob_constr, taking care of binders   *)
 
 let name_to_ident = function
-  | Anonymous -> CErrors.error "This expression should be a simple identifier."
+  | Anonymous -> CErrors.user_err Pp.(str "This expression should be a simple identifier.")
   | Name id -> id
 
 let to_id g e id = let e,na = g e (Name id) in e,name_to_ident na
 
-let rec cases_pattern_fold_map loc g e = function
-  | PatVar (_,na) ->
-      let e',na' = g e na in e', PatVar (loc,na')
-  | PatCstr (_,cstr,patl,na) ->
-      let e',na' = g e na in
-      let e',patl' = List.fold_map (cases_pattern_fold_map loc g) e patl in
-      e', PatCstr (loc,cstr,patl',na')
+let 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',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',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
+      (* 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 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 = function
-  | GVar (_,id) as r -> (try Id.List.assoc id l with Not_found -> r)
-  | GProd (loc,Name id,bk,t,c) ->
+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 GVar(_,id') -> id' | _ -> id
+	try match DAst.get (Id.List.assoc id l) with GVar id' -> id' | _ -> id
 	with Not_found -> id in
-      GProd (loc,Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
-  | GLambda (loc,Name id,bk,t,c) ->
+      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 GVar(_,id') -> id' | _ -> id
+	try match DAst.get (Id.List.assoc id l) with GVar id' -> id' | _ -> id
 	with Not_found -> id in
-      GLambda (loc,Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
-  | GHole (loc,x,naming,arg) -> GHole (loc,subst_binder_type_vars l x,naming,arg)
-  | r -> map_glob_constr (subst_glob_vars l) r (* assume: id is not binding *)
+      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)
+  | _ -> DAst.get (map_glob_constr (subst_glob_vars l) gc) (* assume: id is not binding *)
+  ) gc
 
 let ldots_var = Id.of_string ".."
 
-let glob_constr_of_notation_constr_with_binders loc g f e = function
-  | NVar id -> GVar (loc,id)
-  | NApp (a,args) -> GApp (loc,f e a, List.map (f e) args)
+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 -> (CAst.make ?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 = 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) ->
       let t = f e tail in let it = f e iter in
-      let innerl = (ldots_var,t)::(if swap then [] else [x,GVar(loc,y)]) in
-      let inner = GApp (loc,GVar (loc,ldots_var),[subst_glob_vars innerl it]) in
-      let outerl = (ldots_var,inner)::(if swap then [x,GVar(loc,y)] else []) in
-      subst_glob_vars outerl it
-  | NBinderList (x,y,iter,tail) ->
+      let innerl = (ldots_var,t)::(if swap then [y, lt @@ GVar x] else []) in
+      let inner  = lt @@ GApp (lt @@ GVar (ldots_var),[subst_glob_vars innerl it]) in
+      let outerl = (ldots_var,inner)::(if swap then [] else [y, lt @@ GVar x]) in
+      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,GVar(loc,y))] in
-      let inner = GApp (loc,GVar (loc,ldots_var),[subst_glob_vars innerl it]) in
-      let outerl = [(ldots_var,inner)] in
-      subst_glob_vars outerl it
+      let innerl = (ldots_var,t)::(if swap then [y, lt @@ GVar x] else []) in
+      let inner  = lt @@ GApp (lt @@ GVar ldots_var,[subst_glob_vars innerl it]) in
+      let outerl = (ldots_var,inner)::(if swap then [] else [y, lt @@ GVar x]) in
+      DAst.get (subst_glob_vars outerl it)
   | NLambda (na,ty,c) ->
-      let e',na = g e na in GLambda (loc,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 (loc,na,Explicit,f e ty,f e' c)
-  | NLetIn (na,b,c) ->
-      let e',na = g e na in GLetIn (loc,na,f e b,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',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,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 (CAst.make ?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_map (cases_pattern_fold_map loc fold) ([],e) patl in
-	(loc,idl,patl,f e rhs)) eqnl in
-      GCases (loc,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 -> CAst.make (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_map g e nal in
-      let e'',na = g e na in
-      GLetTuple (loc,nal,(na,Option.map (f e'') po),f e b,f e' c)
+      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
-      GIf (loc,f e c,(na,Option.map (f e') po),f e b1,f e b2)
+      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_map (List.fold_map (fun e (na,oc,b) ->
-	  let e,na = g e na in
+      let e,dll = Array.fold_left_map (List.fold_left_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_map (to_id g) e idl in
-      GRec (loc,fk,idl,dll,Array.map (f e) tl,Array.map (f e') bl)
-  | NCast (c,k) -> GCast (loc,f e c,Miscops.map_cast_type (f e) k)
-  | NSort x -> GSort (loc,x)
-  | NHole (x, naming, arg)  -> GHole (loc, x, naming, arg)
-  | NRef x -> GRef (loc,x,None)
-
-let glob_constr_of_notation_constr loc x =
+      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)
+
+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 rec aux = function
-  | GApp (loc0,GVar(loc,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
-        | [] -> GVar (loc, ldots_var)
-        | _ :: _ -> GApp (loc0, GVar (loc, 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 with
-  | GVar (_,v) when Id.equal v ldots_var -> (* Not enough context *) raise Not_found
+  match DAst.get outer_iterator with
+  | GVar v when Id.equal v ldots_var -> (* Not enough context *) raise Not_found
   | _ -> outer_iterator, c
 
-let subtract_loc loc1 loc2 = Loc.make_loc (fst (Loc.unloc loc1),fst (Loc.unloc loc2)-1)
+let subtract_loc loc1 loc2 =
+  let l1 = fst (Option.cata Loc.unloc (0,0) loc1) in
+  let l2 = fst (Option.cata Loc.unloc (0,0) loc2) in
+  Some (Loc.make_loc (l1,l2-1))
 
-let check_is_hole id = function GHole _ -> () | t ->
-  user_err_loc (loc_of_glob_constr t,"",
-    strbrk "In recursive notation with binders, " ++ pr_id id ++
+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, " ++ 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 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,c2 with
-  | GVar(_,v), term when Id.equal v ldots_var ->
+  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 term;
+      terminator := Some c2;
       true
-  | GApp (_,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) ->
+  | 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 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
   | _ ->
-      compare_glob_constr aux (add_name found) c1 c2 in
+      mk_glob_constr_eq aux c1 c2 in
   if aux iterator subc then
     match !diff with
     | 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,"",
-          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,GVar(Loc.ghost,y)] iterator) in
-	(* found have been collected by compare_constr *)
-	found := newfound;
-	NList (x,y,iterator,f (Option.get !terminator),lassoc)
-    | Some (x,y,RecursiveBinders (t_x,t_y)) ->
-	let newfound = (pi1 !found, pi2 !found, (x,y) :: pi3 !found) in
-	let iterator = f' (subst_glob_vars [x,GVar(Loc.ghost,y)] iterator) in
-	(* found have been collected by compare_constr *)
-	found := newfound;
-	check_is_hole x t_x;
-	check_is_hole y t_y;
-	NBinderList (x,y,iterator,f (Option.get !terminator))
+        (* 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 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 with
-    | GApp (_,GVar (loc,f),[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 *)
-	user_err_loc (loc,"",
-	str "Cannot find where the recursive pattern starts.")
-    | c ->
+        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' = function
-  | GVar (_,id) -> 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)
-  | GLetIn (_,na,b,c) -> add_name found na; NLetIn (na,aux b,aux c)
-  | GCases (_,sty,rtntypopt,tml,eqnl) ->
-      let f (_,idl,pat,rhs) = List.iter (add_id found) idl; (pat,aux rhs) in
+  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)
+  | GLetIn (na,b,t,c) -> add_name found na; NLetIn (na,aux b,Option.map aux t, aux c)
+  | GCases (sty,rtntypopt,tml,eqnl) ->
+      let f {CAst.v=(idl,pat,rhs)} = List.iter (add_id found) idl; (pat,aux rhs) in
       NCases (sty,Option.map aux rtntypopt,
         List.map (fun (tm,(na,x)) ->
 	  add_name found na;
 	  Option.iter
-	    (fun (_,_,nl) -> List.iter (add_name found) nl) x;
-          (aux tm,(na,Option.map (fun (_,ind,nal) -> (ind,nal)) x))) tml,
+            (fun {CAst.v=(_,nl)} -> List.iter (add_name found) nl) x;
+          (aux tm,(na,Option.map (fun {CAst.v=(ind,nal)} -> (ind,nal)) x))) tml,
         List.map f eqnl)
-  | GLetTuple (loc,nal,(na,po),b,c) ->
+  | GLetTuple (nal,(na,po),b,c) ->
       add_name found na;
       List.iter (add_name found) nal;
       NLetTuple (nal,(na,Option.map aux po),aux b,aux c)
-  | GIf (loc,c,(na,po),b1,b2) ->
+  | GIf (c,(na,po),b1,b2) ->
       add_name found na;
       NIf (aux c,(na,Option.map aux po),aux b1,aux b2)
-  | GRec (_,fk,idl,dll,tl,bl) ->
+  | GRec (fk,idl,dll,tl,bl) ->
       Array.iter (add_id found) idl;
       let dll = Array.map (List.map (fun (na,bk,oc,b) ->
 	 if bk != Explicit then
-	   error "Binders marked as implicit not allowed in notations.";
+	   user_err Pp.(str "Binders marked as implicit not allowed in notations.");
 	 add_name found na; (na,Option.map aux oc,aux b))) dll in
       NRec (fk,idl,dll,Array.map aux tl,Array.map aux bl)
-  | GCast (_,c,k) -> NCast (aux c,Miscops.map_cast_type aux k)
-  | GSort (_,s) -> NSort s
-  | GHole (_,w,naming,arg) ->
+  | GCast (c,k) -> NCast (aux c,Miscops.map_cast_type aux k)
+  | GSort s -> NSort s
+  | GHole (w,naming,arg) ->
      if arg != None then has_ltac := true;
      NHole (w, naming, arg)
-  | GRef (_,r,_) -> NRef r
+  | GRef (r,_) -> NRef r
   | GEvar _ | GPatVar _ ->
-      error "Existential variables not allowed in notations."
-
+      user_err Pp.(str "Existential variables not allowed in notations.")
+  ) x
   in
   let t = aux a in
   (* 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
@@ -394,7 +454,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
-      errorlabstrm "" (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
@@ -406,42 +466,46 @@ let check_variables_and_reversibility nenv (found,foundrec,foundrecbinding) =
          Id.List.mem_assoc_sym x foundrec ||
          Id.List.mem_assoc_sym x foundrecbinding
       then
-	error
+	user_err Pp.(str
           (Id.to_string x ^
-          " should not be bound in a recursive pattern of the right-hand side.")
-      else injective := false
+          " should not be bound in a recursive pattern of the right-hand side."))
+      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
-      errorlabstrm "" (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 = Detyping.detype false avoiding (Global.env()) Evd.empty t in
+  let t = EConstr.of_constr 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;
@@ -449,13 +513,13 @@ let notation_constr_of_constr avoiding t =
   notation_constr_of_glob_constr nenv t
 
 let rec subst_pat subst pat =
-  match pat with
+  match DAst.get pat with
   | PatVar _ -> pat
-  | PatCstr (loc,((kn,i),j),cpl,n) ->
+  | 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
-          PatCstr (loc,((kn',i),j),cpl',n)
+      if kn' == kn && cpl' == cpl then pat else
+        DAst.make ?loc:pat.CAst.loc @@ PatCstr (((kn',i),j),cpl',n)
 
 let rec subst_notation_constr subst bound raw =
   match raw with
@@ -490,17 +554,18 @@ 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,r2) ->
-      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
-	  NLetIn (n,r1',r2')
+  | NLetIn (n,r1,t,r2) ->
+      let r1' = subst_notation_constr subst bound r1 in
+      let t' = Option.smartmap (subst_notation_constr subst bound) t in
+      let r2' = subst_notation_constr subst bound r2 in
+	if r1' == r1 && t == t' && r2' == r2 then raw else
+	  NLetIn (n,r1',t',r2')
 
   | NCases (sty,rtntypopt,rl,branches) ->
       let rtntypopt' = Option.smartmap (subst_notation_constr subst bound) rtntypopt
@@ -569,7 +634,7 @@ let rec subst_notation_constr subst bound raw =
       if r1' == r1 && k' == k then raw else NCast(r1',k')
 
 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)
 
 (**********************************************************************)
@@ -583,21 +648,33 @@ let abstract_return_type_context pi mklam tml rtno =
     List.fold_right mklam nal rtn)
     rtno
 
-let abstract_return_type_context_glob_constr =
-  abstract_return_type_context (fun (_,_,nal) -> nal)
-    (fun na c ->
-      GLambda(Loc.ghost,na,Explicit,GHole(Loc.ghost,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None),c))
+let abstract_return_type_context_glob_constr tml rtn =
+  abstract_return_type_context (fun {CAst.v=(_,nal)} -> nal)
+    (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 =
@@ -616,7 +693,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
@@ -644,199 +721,225 @@ 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,termlists,binders,binderlists) x bl =
+  (terms,termlists,binders,(x,bl)::binderlists)
+
+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 add_bindinglist_env (terms,onlybinders,termlists,binderlists) x bl =
-  (terms,onlybinders,termlists,(x,bl)::binderlists)
+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 = function
-  | GVar (loc, id) -> PatVar (loc, Name id)
-  | GApp (loc, GRef (_,ConstructRef cstr,_), l) ->
+let rec pat_binder_of_term t = DAst.map (function
+  | GVar id -> PatVar (Name id)
+  | 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 (loc, cstr, List.map pat_binder_of_term l, Anonymous)
+     PatCstr (cstr, List.map pat_binder_of_term l, Anonymous)
+    | _ -> raise No_match
+    end
+  | _ -> raise No_match
+  ) t
+
+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 bind_term_env alp (terms,onlybinders,termlists,binderlists as sigma) var v =
+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 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 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
-    | 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")
+    | _ -> anomaly (str "A term which can be a binder has to be a variable.")
   with Not_found ->
     (* The matching against a term allowing to find the instance has not been found yet *)
     (* If it will be a different name, we shall unfortunately fail *)
     (* TODO: look at the consequences for alp *)
-    alp, add_env alp sigma var (GVar (Loc.ghost,id))
+    alp, add_env alp sigma var (DAst.make @@ GVar id)
 
-let bind_binding_as_term_env alp (terms,onlybinders,termlists,binderlists as sigma) var id =
+let force_cases_pattern c =
+  DAst.make ?loc:c.CAst.loc (DAst.get c)
+
+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 = function
-  | PatVar (loc,na) -> PatVar (loc,f na)
-  | PatCstr (loc,c,l,na) -> PatCstr (loc,c,List.map_left (map_cases_pattern_name_left f) l,f na)
-
-let rec fold_cases_pattern_eq f x p p' = match p, p' with
-  | PatVar (loc,na), PatVar (_,na') -> let x,na = f x na na' in x, PatVar (loc,na)
-  | PatCstr (loc,c,l,na), PatCstr (_,c',l',na') when eq_constructor c c' ->
-     let x,l = fold_cases_pattern_list_eq f x l l' in
-     let x,na = f x na na' in
-     x, PatCstr (loc,c,l,na)
-  | _ -> failwith "Not equal"
-
-and fold_cases_pattern_list_eq f x pl pl' = match pl, pl' with
-  | [], [] -> x, []
-  | p::pl, p'::pl' ->
-     let x, p = fold_cases_pattern_eq f x p p' in
-     let x, pl = fold_cases_pattern_list_eq f x pl pl' in
-     x, p :: pl
-  | _ -> assert false
-
-let rec cases_pattern_eq p1 p2 = match p1, p2 with
-| PatVar (_, na1), PatVar (_, na2) -> Name.equal na1 na2
-| PatCstr (_, c1, pl1, na1), PatCstr (_, c2, pl2, na2) ->
-  eq_constructor c1 c2 && List.equal cases_pattern_eq pl1 pl2 &&
-  Name.equal na1 na2
-| _ -> false
-
-let bind_bindinglist_env alp (terms,onlybinders,termlists,binderlists as sigma) var bl =
+    (* 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 v, v' with
-      | GHole _, _ -> v'
-      | _, GHole _ -> v
-      | _, _ -> if glob_constr_eq (alpha_rename (snd alp) v) v' then v else raise No_match in
-    let unify_binding_kind bk bk' = if bk == bk' then bk' else raise No_match in
-    let unify_binder alp b b' =
-      match b, b' with
-      | (Inl na, bk, None, t), (Inl na', bk', None, t') (* assum *) ->
-         let alp, na = unify_name alp na na' in
-         alp, (Inl na, unify_binding_kind bk bk', None, unify_term alp t t')
-      | (Inl na, bk, Some c, t), (Inl na', bk', Some c', t') (* let *) ->
-         let alp, na = unify_name alp na na' in
-         alp, (Inl na, unify_binding_kind bk bk', Some (unify_term alp c c'), unify_term alp t t')
-      | (Inr p, bk, None, t), (Inr p', bk', None, t') (* pattern *) ->
-         let alp, p = unify_pat alp p p' in
-         alp, (Inr p, unify_binding_kind bk bk', None, unify_term alp t t')
-      | _ -> raise No_match in
-    let rec unify alp bl bl' =
-    match bl, bl' with
-    | [], [] -> alp, []
-    | b :: bl, b' :: bl' ->
-       let alp,b = unify_binder alp b b' in
-       let alp,bl = unify alp bl bl' in
-       alp, b :: bl
-    | _ -> raise No_match in
-    let alp, bl = unify alp bl bl' in
-    let sigma = (terms,Id.List.remove_assoc var onlybinders,termlists,binderlists) in
+    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 b' =
-      match c, b' with
-      | GVar (_, id), (Inl na', bk', None, t') (* assum *) ->
-         (Inl (unify_id id na'), bk', None, t')
-      | c, (Inr p', bk', None, t') (* pattern *) ->
-         let p = pat_binder_of_term c in
-         (Inr (unify_pat p p'), bk', None, t')
-      | _ -> raise No_match in
-    let rec unify cl bl' =
-    match cl, bl' with
-    | [], [] -> []
-    | c :: cl, (Inl _, _, Some _,t) :: bl' -> unify cl bl'
-    | c :: cl, b' :: bl' -> unify_term_binder c b' :: unify cl bl'
-    | _ -> raise No_match in
-    let bl = unify cl bl' in
-    let sigma = (terms,onlybinders,termlists,Id.List.remove_assoc var binderlists) in
+    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")
+    anomaly (str "There should be a binder list bindings this list of terms.")
 
 let match_fix_kind fk1 fk2 =
   match (fk1,fk2) with
@@ -857,8 +960,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)) *)
@@ -870,45 +975,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 (pat1,pat2) with
-  | PatVar (_,na1), PatVar (_,na2) -> match_names metas acc na1 na2
-  | PatCstr (_,c1,patl1,na1), PatCstr (_,c2,patl2,na2)
+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 = function
-  | GLambda (_,Name p,bk,t,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b)]))
-      when islambda && Id.equal p e ->
-      match_iterated_binders islambda ((Inr cp,bk,None,t)::decls) b
-  | GLambda (_,na,bk,t,b) when islambda ->
-      match_iterated_binders islambda ((Inl na,bk,None,t)::decls) b
-  | GProd (_,Name p,bk,t,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b)]))
-      when not islambda && Id.equal p e ->
-      match_iterated_binders islambda ((Inr cp,bk,None,t)::decls) b
-  | GProd (_,(Name _ as na),bk,t,b) when not islambda ->
-      match_iterated_binders islambda ((Inl na,bk,None,t)::decls) b
-  | GLetIn (loc,na,c,b) when glue_letin_with_decls ->
-      match_iterated_binders islambda
-	((Inl na,Explicit (*?*), Some c,GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None))::decls) b
-  | b -> (decls,b)
-
-let remove_sigma x (terms,onlybinders,termlists,binderlists) =
-  (Id.List.remove_assoc x terms,onlybinders,termlists,binderlists)
-
-let remove_bindinglist_sigma x (terms,onlybinders,termlists,binderlists) =
-  (terms,onlybinders,termlists,Id.List.remove_assoc x binderlists)
+let 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
@@ -917,16 +1019,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
@@ -937,16 +1055,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 *)
@@ -956,90 +1087,54 @@ 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 GVar _ -> false | _ -> true
+  match DAst.get glob with GVar _ -> false | _ -> true
 
 let rec match_ inner u alp metas sigma a1 a2 =
-  match (a1,a2) with
-
+  let open CAst in
+  let loc = a1.loc in
+  match DAst.get a1, a2 with
   (* Matching notation variable *)
-  | r1, NVar id2 when is_term_meta id2 metas -> bind_term_env alp sigma id2 r1
-  | GVar (_,id1), NVar id2 when is_onlybinding_meta id2 metas -> bind_binding_as_term_env alp sigma id2 id1
-  | r1, NVar id2 when is_bindinglist_meta id2 metas -> bind_term_env alp sigma id2 r1
+  | r1, NVar id2 when is_term_meta id2 metas -> bind_term_env alp sigma id2 a1
+  | 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 r1 x y iter termin lassoc
-
-  (* "λ p, let 'cp = p in t" -> "λ 'cp, t" *)
-  | GLambda (_,Name p,bk,t1,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b1)])),
-    NBinderList (x,_,NLambda (Name _id2,_,b2),termin) when Id.equal p e ->
-      let (decls,b) = match_iterated_binders true [(Inr cp,bk,None,t1)] b1 in
-      let alp,sigma = bind_bindinglist_env alp sigma x decls in
-      match_in u alp metas sigma b termin
-
-  (* Matching recursive notations for binders: ad hoc cases supporting let-in *)
-  | GLambda (_,na1,bk,t1,b1), NBinderList (x,_,NLambda (Name _id2,_,b2),termin)->
-      let (decls,b) = match_iterated_binders true [(Inl na1,bk,None,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,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b1)])),
-    NBinderList (x,_,NProd (Name _id2,_,b2),(NVar v as termin)) when Id.equal p e ->
-      let (decls,b) = match_iterated_binders true [(Inr cp,bk,None,t1)] b1 in
-      let alp,sigma = bind_bindinglist_env alp sigma x decls in
-      match_in u alp metas sigma b termin
-
-  | GProd (_,na1,bk,t1,b1), NBinderList (x,_,NProd (Name _id2,_,b2),termin)
-      when na1 != Anonymous ->
-      let (decls,b) = match_iterated_binders false [(Inl na1,bk,None,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 r 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,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b1)])),
-    NLambda (Name id,_,b2)
-      when is_bindinglist_meta id metas ->
-      let alp,sigma = bind_bindinglist_env alp sigma id [(Inr cp,bk,None,t)] in
-      match_in u alp metas sigma b1 b2
-  | GLambda (_,na,bk,t,b1), NLambda (Name id,_,b2)
-      when is_bindinglist_meta id metas ->
-      let alp,sigma = bind_bindinglist_env alp sigma id [(Inl na,bk,None,t)] in
-      match_in u alp metas sigma b1 b2
-  | GProd (_,na,bk,t,b1), NProd (Name id,_,b2)
-      when is_bindinglist_meta id metas && na != Anonymous ->
-      let alp,sigma = bind_bindinglist_env alp sigma id [(Inl na,bk,None,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
-  | GRef (_,r1,_), NRef r2 when (eq_gr r1 r2) -> sigma
-  | GApp (loc,f1,l1), NApp (f2,l2) ->
+  | GVar id1, NVar id2 when alpha_var id1 id2 (fst alp) -> sigma
+  | GRef (r1,_), NRef r2 when (eq_gr r1 r2) -> sigma
+  | GApp (f1,l1), NApp (f2,l2) ->
       let n1 = List.length l1 and n2 = List.length l2 in
       let f1,l1,f2,l2 =
 	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 GApp (loc,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
-  | GLetIn (_,na1,t1,b1), NLetIn (na2,t2,b2) ->
-     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
-  | 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) ->
+        (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
+  | GLetIn (na1,b1,Some t1,c1), NLetIn (na2,b2,Some t2,c2) ->
+     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) ->
       let rtno1' = abstract_return_type_context_glob_constr tml1 rtno1 in
       let rtno2' = abstract_return_type_context_notation_constr tml2 rtno2 in
       let sigma =
@@ -1049,18 +1144,25 @@ 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
-  | GLetTuple (_,nal1,(na1,to1),b1,c1), NLetTuple (nal2,(na2,to2),b2,c2)
+      (* 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
       let sigma = match_in u alp metas sigma b1 b2 in
       let (alp,sigma) =
 	List.fold_left2 (match_names metas) (alp,sigma) nal1 nal2 in
       match_in u alp metas sigma c1 c2
-  | GIf (_,a1,(na1,to1),b1,c1), NIf (a2,(na2,to2),b2,c2) ->
+  | GIf (a1,(na1,to1),b1,c1), NIf (a2,(na2,to2),b2,c2) ->
       let sigma = match_opt (match_binders u alp metas na1 na2) sigma to1 to2 in
       List.fold_left2 (match_in u alp metas) sigma [a1;b1;c1] [a2;b2;c2]
-  | GRec (_,fk1,idl1,dll1,tl1,bl1), NRec (fk2,idl2,dll2,tl2,bl2)
+  | GRec (fk1,idl1,dll1,tl1,bl1), NRec (fk2,idl2,dll2,tl2,bl2)
       when match_fix_kind fk1 fk2 && Int.equal (Array.length idl1) (Array.length idl2) &&
 	Array.for_all2 (fun l1 l2 -> Int.equal (List.length l1) (List.length l2)) dll1 dll2
 	->
@@ -1074,13 +1176,10 @@ 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
-  | GSort (_,GType _), NSort (GType _) when not u -> sigma
-  | GSort (_,s1), NSort s2 when Miscops.glob_sort_eq s1 s2 -> sigma
+  | 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
   | a, NHole _ -> sigma
 
@@ -1090,78 +1189,110 @@ let rec match_ inner u alp metas sigma a1 a2 =
      otherwise how to ensure it corresponds to a well-typed eta-expansion;
      we make an exception for types which are metavariables: this is useful e.g.
      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 ->
+  | _b1, NLambda (Name id as na,(NHole _ | NVar _ as t2),b2) when inner ->
       let avoid =
-        free_glob_vars b1 @ (* as in Namegen: *) glob_visible_short_qualid b1 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 = GHole(Loc.ghost,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 [(Inl (Name id'),Explicit,None,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 Loc.ghost b1 (GVar (Loc.ghost,id'))) b2
+      match_in u alp metas sigma (mkGApp a1 (DAst.make @@ GVar id')) b2
 
-  | (GRec _ | GEvar _), _
-  | _,_ -> raise No_match
+  | (GRef _ | GVar _ | GEvar _ | GPatVar _ | GApp _ | GLambda _ | GProd _
+     | GLetIn _ | GCases _ | GLetTuple _ | GIf _ | GRec _ | GSort _ | GHole _
+     | GCast _), _ -> 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
+     | [{CAst.v=(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
+     | [{CAst.v=(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 {CAst.v=(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 = function
-  | Name id -> GVar (Loc.ghost,id)
-  | Anonymous -> GHole (Loc.ghost,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None)
-
-type glob_decl2 =
-    (name, cases_pattern) Util.union * Decl_kinds.binding_kind *
-      glob_constr option * glob_constr
+and match_disjunctive_equations u alp metas sigma {CAst.v=(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... *)
-      GVar (Loc.ghost,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 *)
-let add_patterns_for_params ind l =
-  let mib,_ = Global.lookup_inductive ind in
-  let nparams = mib.Declarations.mind_nparams in
-    Util.List.addn nparams (PatVar (Loc.ghost,Anonymous)) l
 
 let bind_env_cases_pattern (terms,x,termlists,y as sigma) var v =
   try
@@ -1171,7 +1302,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
@@ -1182,28 +1313,29 @@ 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 rec match_cases_pattern metas (terms,(),termlists,() as sigma) a1 a2 =
- match (a1,a2) with
-  | r1, NVar id2 when Id.List.mem_assoc id2 metas -> (bind_env_cases_pattern sigma id2 r1),(0,[])
-  | PatVar (_,Anonymous), NHole _ -> sigma,(0,[])
-  | PatCstr (loc,(ind,_ as r1),largs,_), NRef (ConstructRef r2) when eq_constructor r1 r2 ->
-      sigma,(0,add_patterns_for_params (fst r1) largs)
-  | PatCstr (loc,(ind,_ as r1),args1,_), NApp (NRef (ConstructRef r2),l2)
+  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 =
+ 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,Anonymous), NRef (ConstructRef r2) when eq_constructor r1 r2 ->
+      let l = try add_patterns_for_params_remove_local_defs r1 largs with Not_found -> raise No_match in
+      sigma,(0,l)
+  | PatCstr ((ind,_ as r1),args1,Anonymous), NApp (NRef (ConstructRef r2),l2)
       when eq_constructor r1 r2 ->
-      let l1 = add_patterns_for_params (fst r1) args1 in
+      let l1 = try add_patterns_for_params_remove_local_defs r1 args1 with Not_found -> raise No_match in
       let le2 = List.length l2 in
       if Int.equal le2 0 (* Special case of a notation for a @Cstr *) || le2 > List.length l1
       then
 	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,()) r1 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 =
@@ -1230,15 +1362,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 c8fcbf74..f038b5be 100644
--- a/interp/notation_ops.mli
+++ b/interp/notation_ops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -29,16 +31,19 @@ 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 glob_constr_of_notation_constr_with_binders : Loc.t ->
-  ('a -> Name.t -> 'a * Name.t) ->
+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 * ((Id.t list * cases_pattern_disjunction) * Id.t) option * Name.t) ->
   ('a -> notation_constr -> glob_constr) ->
   'a -> notation_constr -> glob_constr
 
-val glob_constr_of_notation_constr : Loc.t -> notation_constr -> glob_constr
+val glob_constr_of_notation_constr : ?loc:Loc.t -> notation_constr -> glob_constr
 
 (** {5 Matching a notation pattern against a [glob_constr]} *)
 
@@ -47,22 +52,20 @@ val glob_constr_of_notation_constr : Loc.t -> notation_constr -> glob_constr
 
 exception No_match
 
-type glob_decl2 =
-    (name, cases_pattern) Util.union * Decl_kinds.binding_kind *
-      glob_constr option * glob_constr
-val match_notation_constr : bool -> glob_constr -> interpretation ->
-      (glob_constr * subscopes) list * (glob_constr list * subscopes) list *
-      (glob_decl2 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 37bbe0ce..c75d9e12 100644
--- a/interp/ppextend.ml
+++ b/interp/ppextend.ml
@@ -1,34 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
+open Notation_term
 
 (*s Pretty-print. *)
 
-(* Dealing with precedences *)
-
-type precedence = int
-
-type parenRelation = L | E | Any | Prec of precedence
-
-type tolerability = precedence * parenRelation
-
 type ppbox =
   | PpHB of int
   | PpHOVB of int
   | PpHVB of int
   | PpVB of int
-  | PpTB
 
 type ppcut =
   | PpBrk of int * int
-  | PpTbrk of int * int
-  | PpTab
   | PpFnl
 
 let ppcmd_of_box = function
@@ -36,18 +28,16 @@ let ppcmd_of_box = function
   | PpHOVB n -> hov n
   | PpHVB n -> hv n
   | PpVB n -> v n
-  | PpTB   -> t
 
 let ppcmd_of_cut = function
-  | PpTab -> tab ()
   | PpFnl -> fnl ()
   | PpBrk(n1,n2) -> brk(n1,n2)
-  | PpTbrk(n1,n2) -> tbrk(n1,n2)
 
 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 de7a42ee..c81058e7 100644
--- a/interp/ppextend.mli
+++ b/interp/ppextend.mli
@@ -1,44 +1,36 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
+open Notation_term
 
 (** {6 Pretty-print. } *)
 
-(** Dealing with precedences *)
-
-type precedence = int
-
-type parenRelation = L | E | Any | Prec of precedence
-
-type tolerability = precedence * parenRelation
-
 type ppbox =
   | PpHB of int
   | PpHOVB of int
   | PpHVB of int
   | PpVB of int
-  | PpTB
 
 type ppcut =
   | PpBrk of int * int
-  | PpTbrk of int * int
-  | PpTab
   | PpFnl
 
-val ppcmd_of_box : ppbox -> std_ppcmds -> std_ppcmds
+val ppcmd_of_box : ppbox -> Pp.t -> Pp.t
 
-val ppcmd_of_cut : ppcut -> std_ppcmds
+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 388ca080..36005121 100644
--- a/interp/reserve.ml
+++ b/interp/reserve.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Reserved names *)
@@ -71,7 +73,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 +86,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(loc,"declare_reserved_type",
-    (pr_id id ++ str
+    user_err ?loc ~hdr:"declare_reserved_type"
+      ((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(loc,"declare_reserved_type",
-    (pr_id id++str" is already bound to a type"))
+    user_err ?loc ~hdr:"declare_reserved_type"
+    ((Id.print id++str" is already bound to a type"))
   with Not_found -> () end;
   add_anonymous_leaf (in_reserved (id,t))
 
@@ -102,13 +104,15 @@ 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 =
   try
+    let t = EConstr.Unsafe.to_constr t in
     let reserved = KeyMap.find (constr_key t) !reserve_revtable in
-    let t = Detyping.detype false [] (Global.env()) Evd.empty t in
+    let t = EConstr.of_constr 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 9c77400d..daee5863 100644
--- a/interp/reserve.mli
+++ b/interp/reserve.mli
@@ -1,14 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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/smartlocate.ml b/interp/smartlocate.ml
index 47877421..1f4a93a6 100644
--- a/interp/smartlocate.ml
+++ b/interp/smartlocate.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Hugo Herbelin from code formerly dispatched in
@@ -28,7 +30,7 @@ let global_of_extended_global_head = function
         | NRef ref -> ref
         | NApp (rc, _) -> head_of rc
         | NCast (rc, _) -> head_of rc
-        | NLetIn (_, _, rc) -> head_of rc
+        | NLetIn (_, _, _, rc) -> head_of rc
         | _ -> raise Not_found in
       head_of syn_def
 
@@ -40,42 +42,38 @@ let global_of_extended_global = function
   | [],NApp (NRef ref,[]) -> ref
   | _ -> raise Not_found
 
-let locate_global_with_alias ?(head=false) (loc,qid) =
+let locate_global_with_alias ?(head=false) {CAst.loc; v=qid} =
   let ref = Nametab.locate_extended qid in
   try
     if head then global_of_extended_global_head ref
     else global_of_extended_global ref
   with Not_found ->
-    user_err_loc (loc,"",pr_qualid qid ++
+    user_err ?loc (pr_qualid qid ++
       str " is bound to a notation that does not denote a reference.")
 
-let global_inductive_with_alias r =
-  let (loc,qid as lqid) = qualid_of_reference r in
-  try match locate_global_with_alias lqid with
+let global_inductive_with_alias ({CAst.loc} as lr)  =
+  let qid = qualid_of_reference lr in
+  try match locate_global_with_alias qid with
   | IndRef ind -> ind
   | ref ->
-      user_err_loc (loc_of_reference r,"global_inductive",
-        pr_reference r ++ spc () ++ str "is not an inductive type.")
-  with Not_found -> Nametab.error_global_not_found_loc loc qid
+      user_err ?loc ~hdr:"global_inductive"
+        (pr_reference lr ++ spc () ++ str "is not an inductive type.")
+  with Not_found -> Nametab.error_global_not_found qid
 
 let global_with_alias ?head r =
-  let (loc,qid as lqid) = qualid_of_reference r in
-  try locate_global_with_alias ?head lqid
-  with Not_found -> Nametab.error_global_not_found_loc loc qid
+  let qid = qualid_of_reference r in
+  try locate_global_with_alias ?head qid
+  with Not_found -> Nametab.error_global_not_found qid
 
-let smart_global ?head = function
+let smart_global ?head = CAst.with_loc_val (fun ?loc -> function
   | AN r ->
-      global_with_alias ?head r
-  | ByNotation (loc,ntn,sc) ->
-      Notation.interp_notation_as_global_reference loc (fun _ -> true) ntn sc
+    global_with_alias ?head r
+  | ByNotation (ntn,sc) ->
+    Notation.interp_notation_as_global_reference ?loc (fun _ -> true) ntn sc)
 
-let smart_global_inductive = function
+let smart_global_inductive = CAst.with_loc_val (fun ?loc -> function
   | AN r ->
-      global_inductive_with_alias r
-  | ByNotation (loc,ntn,sc) ->
-      destIndRef
-        (Notation.interp_notation_as_global_reference loc isIndRef ntn sc)
-
-let loc_of_smart_reference = function
-  | AN r -> loc_of_reference r
-  | ByNotation (loc,_,_) -> loc
+    global_inductive_with_alias r
+  | ByNotation (ntn,sc) ->
+    destIndRef
+      (Notation.interp_notation_as_global_reference ?loc isIndRef ntn sc))
diff --git a/interp/smartlocate.mli b/interp/smartlocate.mli
index 0749ca57..7ff7e899 100644
--- a/interp/smartlocate.mli
+++ b/interp/smartlocate.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Loc
 open Names
 open Libnames
 open Globnames
@@ -17,7 +18,7 @@ open Misctypes
    if not bound in the global env; raise a [UserError] if bound to a
    syntactic def that does not denote a reference *)
 
-val locate_global_with_alias : ?head:bool -> qualid located -> global_reference
+val locate_global_with_alias : ?head:bool -> qualid CAst.t -> global_reference
 
 (** Extract a global_reference from a reference that can be an "alias" *)
 val global_of_extended_global : extended_global_reference -> global_reference
@@ -36,6 +37,3 @@ val smart_global : ?head:bool -> reference or_by_notation -> global_reference
 
 (** The same for inductive types *)
 val smart_global_inductive : reference or_by_notation -> inductive
-
-(** Return the loc of a smart reference *)
-val loc_of_smart_reference : reference or_by_notation -> Loc.t
diff --git a/interp/stdarg.ml b/interp/stdarg.ml
index 2a7d52e3..e5ed58be 100644
--- a/interp/stdarg.ml
+++ b/interp/stdarg.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Genarg
@@ -27,9 +29,51 @@ 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 wit_int_or_var =
+  make0 ~dyn:(val_tag (topwit wit_int)) "int_or_var"
+
+let wit_intro_pattern =
+  make0 "intropattern"
+
+let wit_ident =
+  make0 "ident"
+
+let wit_var =
+  make0 ~dyn:(val_tag (topwit wit_ident)) "var"
+
+let wit_ref = make0 "ref"
+
+let wit_quant_hyp = make0 "quant_hyp"
+
+let wit_sort_family = make0 "sort_family"
+
+let wit_constr =
+  make0 "constr"
+
+let wit_uconstr = make0 "uconstr"
+
+let wit_open_constr = make0 ~dyn:(val_tag (topwit wit_constr)) "open_constr"
+
+let wit_constr_with_bindings = make0 "constr_with_bindings"
+
+let wit_open_constr_with_bindings = make0 "open_constr_with_bindings"
+
+let wit_bindings = make0 "bindings"
+
+let wit_red_expr = make0 "redexpr"
+
+let wit_clause_dft_concl  =
+  make0 "clause_dft_concl"
 
 (** Aliases for compatibility *)
 
 let wit_integer = wit_int
 let wit_preident = wit_pre_ident
+let wit_reference = wit_ref
+let wit_global = wit_ref
+let wit_clause = wit_clause_dft_concl
+let wit_quantified_hypothesis = wit_quant_hyp
+let wit_intropattern = wit_intro_pattern
+let wit_redexpr = wit_red_expr
diff --git a/interp/stdarg.mli b/interp/stdarg.mli
index e1f648d7..53d1a522 100644
--- a/interp/stdarg.mli
+++ b/interp/stdarg.mli
@@ -1,13 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Basic generic arguments. *)
 
+open Loc
+open Names
+open EConstr
+open Libnames
+open Globnames
+open Genredexpr
+open Pattern
+open Constrexpr
+open Misctypes
+open Tactypes
 open Genarg
 
 val wit_unit : unit uniform_genarg_type
@@ -20,7 +32,61 @@ val wit_string : string uniform_genarg_type
 
 val wit_pre_ident : string uniform_genarg_type
 
+(** {5 Additional generic arguments} *)
+
+val wit_int_or_var : (int or_var, int or_var, int) genarg_type
+
+val wit_intro_pattern : (constr_expr intro_pattern_expr CAst.t, glob_constr_and_expr intro_pattern_expr CAst.t, intro_pattern) genarg_type
+
+val wit_ident : Id.t uniform_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, Ltac_pretype.closed_glob_constr) genarg_type
+
+val wit_open_constr :
+  (constr_expr, glob_constr_and_expr, constr) genarg_type
+
+val wit_constr_with_bindings :
+  (constr_expr with_bindings,
+  glob_constr_and_expr with_bindings,
+  constr with_bindings delayed_open) genarg_type
+
+val wit_open_constr_with_bindings :
+  (constr_expr with_bindings,
+  glob_constr_and_expr with_bindings,
+  constr with_bindings delayed_open) genarg_type
+
+val wit_bindings :
+  (constr_expr bindings,
+  glob_constr_and_expr bindings,
+  constr bindings delayed_open) genarg_type
+
+val wit_red_expr :
+  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
+  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
+  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
+
+val wit_clause_dft_concl :  (lident Locus.clause_expr, lident Locus.clause_expr, Names.Id.t Locus.clause_expr) genarg_type
+
 (** Aliases for compatibility *)
 
 val wit_integer : int uniform_genarg_type
 val wit_preident : string uniform_genarg_type
+val wit_reference : (reference, global_reference located or_var, global_reference) genarg_type
+val wit_global : (reference, global_reference located or_var, global_reference) genarg_type
+val wit_clause :  (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 CAst.t, glob_constr_and_expr intro_pattern_expr CAst.t, intro_pattern) genarg_type
+val wit_redexpr :
+  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
+  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
+  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml
index 2523063e..a4f20fd7 100644
--- a/interp/syntax_def.ml
+++ b/interp/syntax_def.ml
@@ -1,21 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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. *)
 
@@ -30,8 +31,8 @@ let add_syntax_constant kn c onlyparse =
 
 let load_syntax_constant i ((sp,kn),(_,pat,onlyparse)) =
   if Nametab.exists_cci sp then
-    errorlabstrm "cache_syntax_constant"
-      (pr_id (basename sp) ++ str " already exists");
+    user_err ~hdr:"cache_syntax_constant"
+      (Id.print (basename sp) ++ str " already exists");
   add_syntax_constant kn pat onlyparse;
   Nametab.push_syndef (Nametab.Until i) sp kn
 
@@ -89,22 +90,19 @@ let pr_compat_warning (kn, def, v) =
     | [], NRef r -> spc () ++ str "is" ++ spc () ++ pr_global_env Id.Set.empty r
     | _ -> strbrk " is a compatibility notation"
   in
-  let since = strbrk " since Coq > " ++ str (Flags.pr_version v) ++ str "." in
-  pr_syndef kn ++ pp_def ++ since
+  pr_syndef kn ++ pp_def
 
 let warn_compatibility_notation =
   CWarnings.(create ~name:"compatibility-notation"
-                    ~category:"deprecated" ~default:Disabled pr_compat_warning)
+                    ~category:"deprecated" ~default:Enabled pr_compat_warning)
 
-let verbose_compat kn def = function
+let verbose_compat ?loc kn def = function
   | Some v when Flags.version_strictly_greater v ->
-     warn_compatibility_notation (kn, def, v)
+     warn_compatibility_notation ?loc (kn, def, v)
   | _ -> ()
 
-let search_syntactic_definition kn =
+let search_syntactic_definition ?loc kn =
   let pat,v = KNmap.find kn !syntax_table in
   let def = out_pat pat in
-  verbose_compat kn def v;
+  verbose_compat ?loc kn def v;
   def
-
-open Goptions
diff --git a/interp/syntax_def.mli b/interp/syntax_def.mli
index 55e2848e..c5b6655f 100644
--- a/interp/syntax_def.mli
+++ b/interp/syntax_def.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -16,4 +18,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 : ?loc:Loc.t -> KerName.t -> syndef_interpretation
diff --git a/interp/tactypes.ml b/interp/tactypes.ml
new file mode 100644
index 00000000..83e42be8
--- /dev/null
+++ b/interp/tactypes.ml
@@ -0,0 +1,34 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Tactic-related types that are not totally Ltac specific and still used in
+    lower API. It's not clear whether this is a temporary API or if this is
+    meant to stay. *)
+
+open Names
+open Constrexpr
+open Pattern
+open Misctypes
+
+(** In globalize tactics, we need to keep the initial [constr_expr] to recompute
+   in the environment by the effective calls to Intro, Inversion, etc 
+   The [constr_expr] field is [None] in TacDef though *)
+type glob_constr_and_expr = Glob_term.glob_constr * constr_expr option
+type glob_constr_pattern_and_expr = Id.Set.t * glob_constr_and_expr * constr_pattern
+
+type 'a delayed_open = 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 with_bindings delayed_open
+
+type intro_pattern = delayed_open_constr intro_pattern_expr CAst.t
+type intro_patterns = delayed_open_constr intro_pattern_expr CAst.t list
+type or_and_intro_pattern = delayed_open_constr or_and_intro_pattern_expr CAst.t
+type intro_pattern_naming = intro_pattern_naming_expr CAst.t
diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index 79eeacf3..7d2d75d9 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -1,277 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*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.optsync = true; 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 (loc,"",str "Invalid notation for pattern.")
-
-(**********************************************************************)
-(* 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 = function
-  | 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 _ -> assert false
-
-let ids_of_pattern_list =
-  List.fold_left
-    (Loc.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 (Loc.down_located (name_fold 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 g) nal n in
-      f n (fold_constr_expr_binders g f n' acc b l) t
-  | [] ->
-      f n acc b
-
-let rec fold_local_binders g f n acc b = function
-  | LocalRawAssum (nal,bk,t)::l ->
-      let nal = snd (List.split nal) in
-      let n' = List.fold_right (name_fold g) nal n in
-      f n (fold_local_binders g f n' acc b l) t
-  | LocalRawDef ((_,na),t)::l ->
-      f n (fold_local_binders g f (name_fold g na n) acc b l) t
-  | LocalPattern _::l ->
-      assert false
-  | [] ->
-      f n acc b
-
-let fold_constr_expr_with_binders g f n acc = function
-  | CAppExpl (loc,(_,_,_),l) -> List.fold_left (f n) acc l
-  | CApp (loc,(_,t),l) -> List.fold_left (f n) (f n acc t) (List.map fst l)
-  | CProdN (_,l,b) | CLambdaN (_,l,b) -> fold_constr_expr_binders g f n acc b l
-  | CLetIn (_,na,a,b) -> fold_constr_expr_binders g f n acc b [[na],default_binder_kind,a]
-  | CCast (loc,a,(CastConv b|CastVM b|CastNative b)) -> f n (f n acc a) b
-  | CCast (loc,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 (CHole (Loc.ghost,None,IntroAnonymous,None)) bl) acc bll
-  | CGeneralization (_,_,_,c) -> f n acc c
-  | CDelimiters (loc,_,a) -> f n acc a
-  | CHole _ | CEvar _ | CPatVar _ | CSort _ | CPrim _ | CRef _ ->
-      acc
-  | CRecord (loc,l) -> List.fold_left (fun acc (id, c) -> f n acc c) acc l
-  | CCases (loc,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 (loc,nal,(ona,po),b,c) ->
-      let n' = List.fold_right (Loc.down_located (name_fold g)) nal n in
-      f (Option.fold_right (Loc.down_located (name_fold g)) ona n') (f n acc b) c
-  | CIf (_,c,(ona,po),b1,b2) ->
-      let acc = f n (f n (f n acc b1) b2) c in
-      Option.fold_left
-	(f (Option.fold_right (Loc.down_located (name_fold g)) ona n)) acc po
-  | CFix (loc,_,l) ->
-      let n' = List.fold_right (fun ((_,id),_,_,_,_) -> g id) l n in
-      List.fold_right (fun (_,(_,o),lb,t,c) acc ->
-	fold_local_binders g f n'
-	  (fold_local_binders g f n acc t lb) c lb) l acc
-  | CCoFix (loc,_,_) ->
-      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
-  | 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
-      | [] -> error "A fixpoint needs at least one parameter."
-      | _ -> ([], bl)
-      end
-  | Some (loc, id) ->
-      let rec aux acc = function
-	| LocalRawAssum (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
-              | _ -> LocalRawAssum (l, k, t) :: acc
-              in
-              (List.rev ans, LocalRawAssum (r, k, t) :: rest)
-            end
-	| LocalRawDef _ as x :: rest -> aux (x :: acc) rest
-        | LocalPattern _ :: rest -> assert false
-	| [] ->
-            user_err_loc(loc,"",
-			 str "No parameter named " ++ Nameops.pr_id id ++ str".")
-      in aux [] bl
-
-(* Used in correctness and interface *)
-
-let map_binder g e nal = List.fold_right (Loc.down_located (name_fold 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
-      LocalRawAssum(nal,k,ty) ->
-        (map_binder g e nal, LocalRawAssum(nal,k,f e ty)::bl)
-    | LocalRawDef((loc,na),ty) ->
-        (name_fold g na e, LocalRawDef((loc,na),f e ty)::bl)
-    | LocalPattern _ ->
-        assert false in
-  let (e,rbl) = List.fold_left h (e,[]) bl in
-  (e, List.rev rbl)
-
-let map_constr_expr_with_binders g f e = function
-  | CAppExpl (loc,r,l) -> CAppExpl (loc,r,List.map (f e) l)
-  | CApp (loc,(p,a),l) ->
-      CApp (loc,(p,f e a),List.map (fun (a,i) -> (f e a,i)) l)
-  | CProdN (loc,bl,b) ->
-      let (e,bl) = map_binders f g e bl in CProdN (loc,bl,f e b)
-  | CLambdaN (loc,bl,b) ->
-      let (e,bl) = map_binders f g e bl in CLambdaN (loc,bl,f e b)
-  | CLetIn (loc,na,a,b) -> CLetIn (loc,na,f e a,f (name_fold g (snd na) e) b)
-  | CCast (loc,a,c) -> CCast (loc,f e a, Miscops.map_cast_type (f e) c)
-  | CNotation (loc,n,(l,ll,bll)) ->
-      (* This is an approximation because we don't know what binds what *)
-      CNotation (loc,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 (loc,b,a,c) -> CGeneralization (loc,b,a,f e c)
-  | CDelimiters (loc,s,a) -> CDelimiters (loc,s,f e a)
-  | CHole _ | CEvar _ | CPatVar _ | CSort _
-  | CPrim _ | CRef _ as x -> x
-  | CRecord (loc,l) -> CRecord (loc,List.map (fun (id, c) -> (id, f e c)) l)
-  | CCases (loc,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 (loc, sty, po, List.map (fun (tm,x,y) -> f e tm,x,y) a,bl)
-  | CLetTuple (loc,nal,(ona,po),b,c) ->
-      let e' = List.fold_right (Loc.down_located (name_fold g)) nal e in
-      let e'' = Option.fold_right (Loc.down_located (name_fold g)) ona e in
-      CLetTuple (loc,nal,(ona,Option.map (f e'') po),f e b,f e' c)
-  | CIf (loc,c,(ona,po),b1,b2) ->
-      let e' = Option.fold_right (Loc.down_located (name_fold g)) ona e in
-      CIf (loc,f e c,(ona,Option.map (f e') po),f e b1,f e b2)
-  | CFix (loc,id,dl) ->
-      CFix (loc,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 (loc,id,dl) ->
-      CCoFix (loc,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
-  | CRef (Ident (loc,id),us) as x ->
-      (try CRef (Ident (loc,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 (bl, el) = Loc.unloc loc in
-  let locs =  List.map Loc.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 58edd4dd..c8650201 100644
--- a/interp/topconstr.mli
+++ b/interp/topconstr.mli
@@ -1,49 +1,53 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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"]
+
+(** 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
+(*************************************************************************)
+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 list -> Id.t located option -> local_binder list * local_binder 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.t -> constr_notation_substitution -> string -> (int * int) list
-val patntn_loc :
-  Loc.t -> cases_pattern_notation_substitution -> string -> (int * int) list
-
-(** For cases pattern parsing errors *)
-
-val error_invalid_pattern_notation : Loc.t -> 'a
+[@@ocaml.deprecated "use Constrexpr_ops.map_constr_expr_with_binders"]
diff --git a/intf/constrexpr.ml b/intf/constrexpr.ml
new file mode 100644
index 00000000..542eb38a
--- /dev/null
+++ b/intf/constrexpr.ml
@@ -0,0 +1,152 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Libnames
+open Misctypes
+open Decl_kinds
+
+(** {6 Concrete syntax for terms } *)
+
+(** [constr_expr] is the abstract syntax tree produced by the parser *)
+
+type universe_decl_expr = (lident list, glob_constraint list) gen_universe_decl
+
+type ident_decl = lident * universe_decl_expr option
+type name_decl = lname * universe_decl_expr option
+
+type notation = string
+
+type explicitation =
+  | ExplByPos of int * Id.t option (* a reference to the n-th product starting from left *)
+  | ExplByName of Id.t
+
+type binder_kind =
+  | Default of binding_kind
+  | Generalized of binding_kind * binding_kind * bool
+      (** Inner binding, outer bindings, typeclass-specific flag
+	 for implicit generalization of superclasses *)
+
+type abstraction_kind = AbsLambda | AbsPi
+
+type proj_flag = int option (** [Some n] = proj of the n-th visible argument *)
+
+(** Representation of integer literals that appear in Coq scripts.
+    We now use raw strings of digits in base 10 (big-endian), and a separate
+    sign flag. Note that this representation is not unique, due to possible
+    multiple leading zeros, and -0 = +0 *)
+
+type sign = bool
+type raw_natural_number = string
+
+type prim_token =
+  | Numeral of raw_natural_number * sign
+  | String of string
+
+type instance_expr = Misctypes.glob_level list
+
+type cases_pattern_expr_r =
+  | 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] *)
+  | CPatAtom of reference option
+  | CPatOr   of cases_pattern_expr list
+  | CPatNotation of notation * cases_pattern_notation_substitution
+    * cases_pattern_expr list (** CPatNotation (_, n, l1 ,l2) represents
+				  (notation n applied with substitution l1)
+				  applied to arguments l2 *)
+  | CPatPrim   of prim_token
+  | CPatRecord of (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 *     (** for constr subterms *)
+    cases_pattern_expr list list  (** for recursive notations *)
+
+and constr_expr_r =
+  | CRef     of reference * instance_expr option
+  | 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 CAst.t option) list
+  | CRecord  of (reference * constr_expr) list
+
+  (* representation of the "let" and "match" constructs *)
+  | 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 lname list * (lname option * constr_expr option) *
+                 constr_expr * constr_expr
+  | 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
+  | CEvar   of Glob_term.existential_name * (Id.t * constr_expr) list
+  | CSort   of glob_sort
+  | CCast   of constr_expr * constr_expr cast_type
+  | CNotation of notation * constr_notation_substitution
+  | CGeneralization of 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                 (* expression that is being matched *)
+              * lname option                (* as-clause *)
+	      * cases_pattern_expr option   (* in-clause *)
+
+and branch_expr =
+  (cases_pattern_expr list list * constr_expr) CAst.t
+
+and fix_expr =
+    lident * (lident option * recursion_order_expr) *
+      local_binder_expr list * constr_expr * constr_expr
+
+and cofix_expr =
+    lident * local_binder_expr list * constr_expr * constr_expr
+
+and recursion_order_expr =
+  | CStructRec
+  | CWfRec of constr_expr
+  | CMeasureRec of constr_expr * constr_expr option (** measure, relation *)
+
+(* Anonymous defs allowed ?? *)
+and local_binder_expr =
+  | 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 *)
+    cases_pattern_expr list *   (** for binders *)
+    local_binder_expr list list (** for binder lists (recursive notations) *)
+
+type constr_pattern_expr = constr_expr
+
+(** Concrete syntax for modules and module types *)
+
+type with_declaration_ast =
+  | CWith_Module of Id.t list CAst.t * qualid CAst.t
+  | CWith_Definition of Id.t list CAst.t * universe_decl_expr option * constr_expr
+
+type module_ast_r =
+  | CMident of qualid
+  | CMapply of module_ast * module_ast
+  | CMwith  of module_ast * with_declaration_ast
+and module_ast = module_ast_r CAst.t
diff --git a/intf/constrexpr.mli b/intf/constrexpr.mli
deleted file mode 100644
index 0cbb2957..00000000
--- a/intf/constrexpr.mli
+++ /dev/null
@@ -1,150 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Loc
-open Names
-open Libnames
-open Misctypes
-open Decl_kinds
-
-(** {6 Concrete syntax for terms } *)
-
-(** [constr_expr] is the abstract syntax tree produced by the parser *)
-
-type notation = string
-
-type explicitation =
-  | ExplByPos of int * Id.t option
-  | ExplByName of Id.t
-
-type binder_kind =
-  | Default of binding_kind
-  | Generalized of binding_kind * binding_kind * bool
-      (** Inner binding, outer bindings, typeclass-specific flag
-	 for implicit generalization of superclasses *)
-
-type abstraction_kind = AbsLambda | AbsPi
-
-type proj_flag = int option (** [Some n] = proj of the n-th visible argument *)
-
-type prim_token =
-  | Numeral of Bigint.bigint (** representation of integer literals that appear in Coq scripts. *)
-  | String of string
-
-type raw_cases_pattern_expr =
-  | RCPatAlias of Loc.t * raw_cases_pattern_expr * Id.t
-  | RCPatCstr of Loc.t * Globnames.global_reference
-    * raw_cases_pattern_expr list * raw_cases_pattern_expr list
-  (** [CPatCstr (_, c, l1, l2)] represents ((@c l1) l2) *)
-  | RCPatAtom of Loc.t * Id.t option
-  | RCPatOr of Loc.t * raw_cases_pattern_expr list
-
-type instance_expr = Misctypes.glob_level list
-
-type cases_pattern_expr =
-  | CPatAlias of Loc.t * cases_pattern_expr * Id.t
-  | CPatCstr of Loc.t * reference
-    * cases_pattern_expr list option * cases_pattern_expr list
-  (** [CPatCstr (_, c, Some l1, l2)] represents (@c l1) l2 *)
-  | CPatAtom of Loc.t * reference option
-  | CPatOr of Loc.t * cases_pattern_expr list
-  | CPatNotation of Loc.t * notation * cases_pattern_notation_substitution
-    * cases_pattern_expr list (** CPatNotation (_, n, l1 ,l2) represents
-				  (notation n applied with substitution l1)
-				  applied to arguments l2 *)
-  | CPatPrim of Loc.t * prim_token
-  | CPatRecord of Loc.t * (reference * cases_pattern_expr) list
-  | CPatDelimiters of Loc.t * string * cases_pattern_expr
-  | CPatCast of Loc.t * cases_pattern_expr * constr_expr
-
-and cases_pattern_notation_substitution =
-    cases_pattern_expr list *     (** for constr subterms *)
-    cases_pattern_expr list list  (** for recursive notations *)
-
-and constr_expr =
-  | CRef of reference * instance_expr option
-  | CFix of Loc.t * Id.t located * fix_expr list
-  | CCoFix of Loc.t * Id.t located * cofix_expr list
-  | CProdN of Loc.t * binder_expr list * constr_expr
-  | CLambdaN of Loc.t * binder_expr list * constr_expr
-  | CLetIn of Loc.t * Name.t located * constr_expr * constr_expr
-  | CAppExpl of Loc.t * (proj_flag * reference * instance_expr option) * constr_expr list
-  | CApp of Loc.t * (proj_flag * constr_expr) *
-      (constr_expr * explicitation located option) list
-  | CRecord of Loc.t * (reference * constr_expr) list
-
-  (* representation of the "let" and "match" constructs *)
-  | CCases of Loc.t                 (* position of the "match" keyword *)
-	      * 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 Loc.t * Name.t located list * (Name.t located option * constr_expr option) *
-      constr_expr * constr_expr
-  | CIf of Loc.t * constr_expr * (Name.t located option * constr_expr option)
-      * constr_expr * constr_expr
-  | CHole of Loc.t * Evar_kinds.t option * intro_pattern_naming_expr * Genarg.raw_generic_argument option
-  | CPatVar of Loc.t * patvar
-  | CEvar of Loc.t * Glob_term.existential_name * (Id.t * constr_expr) list
-  | CSort of Loc.t * glob_sort
-  | CCast of Loc.t * constr_expr * constr_expr cast_type
-  | CNotation of Loc.t * notation * constr_notation_substitution
-  | CGeneralization of Loc.t * binding_kind * abstraction_kind option * constr_expr
-  | CPrim of Loc.t * prim_token
-  | CDelimiters of Loc.t * string * constr_expr
-
-and case_expr = constr_expr                 (* expression that is being matched *)
-	      * Name.t located option       (* as-clause *)
-	      * cases_pattern_expr option   (* in-clause *)
-
-and branch_expr =
-  Loc.t * cases_pattern_expr list located list * constr_expr
-
-and binder_expr =
-  Name.t located list * binder_kind * constr_expr
-
-and fix_expr =
-    Id.t located * (Id.t located option * recursion_order_expr) *
-      local_binder list * constr_expr * constr_expr
-
-and cofix_expr =
-    Id.t located * local_binder list * constr_expr * constr_expr
-
-and recursion_order_expr =
-  | CStructRec
-  | CWfRec of constr_expr
-  | CMeasureRec of constr_expr * constr_expr option (** measure, relation *)
-
-(** Anonymous defs allowed ?? *)
-and local_binder =
-  | LocalRawDef of Name.t located * constr_expr
-  | LocalRawAssum of Name.t located list * binder_kind * constr_expr
-  | LocalPattern of Loc.t * cases_pattern_expr * constr_expr option
-
-and constr_notation_substitution =
-    constr_expr list *      (** for constr subterms *)
-    constr_expr list list * (** for recursive notations *)
-    local_binder list list (** for binders subexpressions *)
-
-type typeclass_constraint = (Name.t located * Id.t located list option) * binding_kind * constr_expr
-
-and typeclass_context = typeclass_constraint list
-
-type constr_pattern_expr = constr_expr
-
-(** Concrete syntax for modules and module types *)
-
-type with_declaration_ast =
-  | CWith_Module of Id.t list located * qualid located
-  | CWith_Definition of Id.t list located * constr_expr
-
-type module_ast =
-  | CMident of qualid located
-  | CMapply of Loc.t * module_ast * module_ast
-  | CMwith of Loc.t * module_ast * with_declaration_ast
diff --git a/intf/decl_kinds.mli b/intf/decl_kinds.ml
index 6a4e1883..0d328531 100644
--- a/intf/decl_kinds.mli
+++ b/intf/decl_kinds.ml
@@ -1,20 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Informal mathematical status of declarations *)
 
+type discharge = DoDischarge | NoDischarge
+
 type locality = Discharge | Local | Global
 
 type binding_kind = Explicit | Implicit
 
 type polymorphic = bool
 
-type private_flag = bool 
+type private_flag = bool
+
+type cumulative_inductive_flag = bool
 
 type theorem_kind =
   | Theorem
@@ -38,10 +44,11 @@ type definition_object_kind =
   | IdentityCoercion
   | Instance
   | Method
+  | Let
 
 type assumption_object_kind = Definitional | Logical | Conjectural
 
-(** [assumption_kind]
+(* [assumption_kind]
 
                 |  Local      | Global
    ------------------------------------
@@ -70,7 +77,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.mli b/intf/evar_kinds.ml
index afc5e3ba..c5de383b 100644
--- a/intf/evar_kinds.mli
+++ b/intf/evar_kinds.ml
@@ -1,13 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Globnames
+open Misctypes
 
 (** The kinds of existential variable *)
 
@@ -16,16 +19,19 @@ open Globnames
 
 type obligation_definition_status = Define of bool | Expand
 
+type matching_var_kind = FirstOrderPatVar of patvar | SecondOrderPatVar of patvar
+
 type t =
   | ImplicitArg of global_reference * (int * Id.t option)
      * bool (** Force inference *)
   | BinderType of Name.t
-  | QuestionMark of obligation_definition_status
+  | NamedHole of Id.t (* coming from some ?[id] syntax *)
+  | QuestionMark of obligation_definition_status * Name.t
   | CasesType of bool (* true = a subterm of the type *)
   | InternalHole
   | TomatchTypeParameter of inductive * int
   | GoalEvar
   | ImpossibleCase
-  | MatchingVar of bool * Id.t
+  | 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
new file mode 100644
index 00000000..734b859f
--- /dev/null
+++ b/intf/extend.ml
@@ -0,0 +1,134 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Entry keys for constr notations *)
+
+type 'a entry = 'a Grammar.GMake(CLexer).Entry.e
+
+type side = Left | Right
+
+type gram_assoc = NonA | RightA | LeftA
+
+type gram_position =
+  | First
+  | Last
+  | Before of string
+  | After of string
+  | Level of string
+
+type production_position =
+  | BorderProd of side * gram_assoc option
+  | InternalProd
+
+type production_level =
+  | NextLevel
+  | NumLevel of int
+
+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
+
+(** Entries level (left-hand side of grammar rules) *)
+
+type constr_entry_key =
+    (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 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} *)
+
+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 ('a,'b,'c) ty_user_symbol =
+| TUlist1 : ('a,'b,'c) ty_user_symbol -> ('a list,'b list,'c list) ty_user_symbol
+| TUlist1sep : ('a,'b,'c) ty_user_symbol * string -> ('a list,'b list,'c list) ty_user_symbol
+| TUlist0 : ('a,'b,'c) ty_user_symbol -> ('a list,'b list,'c list) ty_user_symbol
+| TUlist0sep : ('a,'b,'c) ty_user_symbol * string -> ('a list,'b list,'c list) ty_user_symbol
+| TUopt : ('a,'b,'c) ty_user_symbol -> ('a option, 'b option, 'c option) ty_user_symbol
+| TUentry : ('a, 'b, 'c) Genarg.ArgT.tag -> ('a,'b,'c) ty_user_symbol
+| TUentryl : ('a, 'b, 'c) Genarg.ArgT.tag * int -> ('a,'b,'c) ty_user_symbol
+
+(** {5 Type-safe grammar extension} *)
+
+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 '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
diff --git a/intf/extend.mli b/intf/extend.mli
deleted file mode 100644
index 7ba332f7..00000000
--- a/intf/extend.mli
+++ /dev/null
@@ -1,104 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Entry keys for constr notations *)
-
-type 'a entry = 'a Compat.GrammarMake(CLexer).entry
-
-type side = Left | Right
-
-type gram_assoc = NonA | RightA | LeftA
-
-type gram_position =
-  | First
-  | Last
-  | Before of string
-  | After of string
-  | Level of string
-
-type production_position =
-  | BorderProd of side * gram_assoc option
-  | InternalProd
-
-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
-  | 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) *)
-
-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
-
-(** 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
-
-(** {5 AST for user-provided entries} *)
-
-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
-
-(** {5 Type-safe grammar extension} *)
-
-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 '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
diff --git a/intf/genredexpr.mli b/intf/genredexpr.ml
index 2df79673..80697461 100644
--- a/intf/genredexpr.mli
+++ b/intf/genredexpr.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Reduction expressions *)
@@ -50,5 +52,15 @@ type ('a,'b,'c) red_expr_gen =
 type ('a,'b,'c) may_eval =
   | ConstrTerm of 'a
   | ConstrEval of ('a,'b,'c) red_expr_gen * 'a
-  | ConstrContext of (Loc.t * Names.Id.t) * 'a
+  | ConstrContext of Misctypes.lident * 'a
   | ConstrTypeOf of 'a
+
+open Libnames
+open Constrexpr
+open Misctypes
+
+type r_trm = constr_expr
+type r_pat = constr_pattern_expr
+type r_cst = reference or_by_notation
+
+type raw_red_expr = (r_trm, r_cst, r_pat) red_expr_gen
diff --git a/intf/glob_term.ml b/intf/glob_term.ml
new file mode 100644
index 00000000..655dd20c
--- /dev/null
+++ b/intf/glob_term.ml
@@ -0,0 +1,112 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Untyped intermediate terms *)
+
+(** [glob_constr] comes after [constr_expr] and before [constr].
+
+   Resolution of names, insertion of implicit arguments placeholder,
+   and notations are done, but coercions, inference of implicit
+   arguments and pattern-matching compilation are not. *)
+
+open Names
+open Globnames
+open Decl_kinds
+open Misctypes
+
+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 'a cases_pattern_r =
+  | PatVar  of Name.t
+  | PatCstr of constructor * 'a cases_pattern_g list * Name.t
+      (** [PatCstr(p,C,l,x)] = "|'C' 'l' as 'x'" *)
+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 '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 * 'a glob_constr_g) list
+  | GPatVar of Evar_kinds.matching_var_kind (** Used for patterns only *)
+  | 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 * '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 'a glob_constr_g * 'a glob_constr_g cast_type
+and 'a glob_constr_g = ('a glob_constr_r, 'a) DAst.t
+
+and 'a glob_decl_g = Name.t * binding_kind * 'a glob_constr_g option * 'a glob_constr_g
+
+and 'a fix_recursion_order_g =
+  | GStructRec
+  | GWfRec of 'a glob_constr_g
+  | GMeasureRec of 'a glob_constr_g * 'a glob_constr_g option
+
+and 'a fix_kind_g =
+  | GFix of ((int option * 'a fix_recursion_order_g) array * int)
+  | GCoFix of int
+
+and 'a predicate_pattern_g =
+    Name.t * (inductive * Name.t list) CAst.t option
+      (** [(na,id)] = "as 'na' in 'id'" where if [id] is [Some(l,I,k,args)]. *)
+
+and 'a tomatch_tuple_g = ('a glob_constr_g * 'a predicate_pattern_g)
+
+and 'a tomatch_tuples_g = 'a tomatch_tuple_g list
+
+and 'a cases_clause_g = (Id.t list * 'a cases_pattern_g list * 'a glob_constr_g) CAst.t
+(** [(p,il,cl,t)] = "|'cl' => 't'". Precondition: the free variables
+    of [t] are members of [il]. *)
+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) CAst.t
+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/glob_term.mli b/intf/glob_term.mli
deleted file mode 100644
index b3159c86..00000000
--- a/intf/glob_term.mli
+++ /dev/null
@@ -1,90 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Untyped intermediate terms *)
-
-(** [glob_constr] comes after [constr_expr] and before [constr].
-
-   Resolution of names, insertion of implicit arguments placeholder,
-   and notations are done, but coercions, inference of implicit
-   arguments and pattern-matching compilation are not. *)
-
-open Names
-open Globnames
-open Decl_kinds
-open Misctypes
-
-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 =
-  | PatVar of Loc.t * Name.t
-  | PatCstr of Loc.t * constructor * cases_pattern list * Name.t
-      (** [PatCstr(p,C,l,x)] = "|'C' 'l' as 'x'" *)
-
-(** Representation of an internalized (or in other words globalized) term. *)
-type glob_constr =
-  | GRef of (Loc.t * 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 (Loc.t * Id.t)
-      (** An identifier that cannot be regarded as "GRef".
-          Bound variables are typically represented this way. *)
-  | GEvar of Loc.t * existential_name * (Id.t * glob_constr) list
-  | GPatVar of Loc.t * (bool * patvar) (** Used for patterns only *)
-  | GApp of Loc.t * glob_constr * glob_constr list
-  | GLambda of Loc.t * Name.t * binding_kind *  glob_constr * glob_constr
-  | GProd of Loc.t * Name.t * binding_kind * glob_constr * glob_constr
-  | GLetIn of Loc.t * Name.t * glob_constr * glob_constr
-  | GCases of Loc.t * case_style * glob_constr option * tomatch_tuples * cases_clauses
-      (** [GCases(l,style,r,tur,cc)] = "match 'tur' return 'r' with 'cc'" (in [MatchStyle]) *)
-  | GLetTuple of Loc.t * Name.t list * (Name.t * glob_constr option) *
-      glob_constr * glob_constr
-  | GIf of Loc.t * glob_constr * (Name.t * glob_constr option) * glob_constr * glob_constr
-  | GRec of Loc.t * fix_kind * Id.t array * glob_decl list array *
-      glob_constr array * glob_constr array
-  | GSort of Loc.t * glob_sort
-  | GHole of (Loc.t * Evar_kinds.t * intro_pattern_naming_expr * Genarg.glob_generic_argument option)
-  | GCast of Loc.t * glob_constr * glob_constr cast_type
-
-and glob_decl = Name.t * 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 =
-    Name.t * (Loc.t * inductive * Name.t list) option
-      (** [(na,id)] = "as 'na' in 'id'" where if [id] is [Some(l,I,k,args)]. *)
-
-and tomatch_tuple = (glob_constr * predicate_pattern)
-
-and tomatch_tuples = tomatch_tuple list
-
-and cases_clause = (Loc.t * Id.t list * cases_pattern list * glob_constr)
-(** [(p,il,cl,t)] = "|'cl' => 't'". Precondition: the free variables
-    of [t] are members of [il]. *)
-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: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 }
diff --git a/intf/intf.mllib b/intf/intf.mllib
new file mode 100644
index 00000000..2b8960d3
--- /dev/null
+++ b/intf/intf.mllib
@@ -0,0 +1,11 @@
+Constrexpr
+Evar_kinds
+Genredexpr
+Locus
+Extend
+Notation_term
+Decl_kinds
+Glob_term
+Misctypes
+Pattern
+Vernacexpr
diff --git a/intf/locus.mli b/intf/locus.ml
index 57b398ab..95a2e495 100644
--- a/intf/locus.mli
+++ b/intf/locus.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
diff --git a/intf/misctypes.ml b/intf/misctypes.ml
new file mode 100644
index 00000000..9eb6f62c
--- /dev/null
+++ b/intf/misctypes.ml
@@ -0,0 +1,162 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+
+(** 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 *)
+
+type patvar = Id.t
+
+(** Introduction patterns *)
+
+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 Id.t
+  | IntroFresh of Id.t
+  | IntroAnonymous
+and 'constr intro_pattern_action_expr =
+  | IntroWildcard
+  | IntroOrAndPattern of 'constr or_and_intro_pattern_expr
+  | IntroInjection of ('constr intro_pattern_expr) CAst.t list
+  | IntroApplyOn of 'constr CAst.t * 'constr intro_pattern_expr CAst.t
+  | IntroRewrite of bool
+and 'constr or_and_intro_pattern_expr =
+  | IntroOrPattern of ('constr intro_pattern_expr) CAst.t list list
+  | IntroAndPattern of ('constr intro_pattern_expr) CAst.t list
+
+(** Move destination for hypothesis *)
+
+type 'id move_location =
+  | MoveAfter of 'id
+  | MoveBefore of 'id
+  | MoveFirst
+  | MoveLast (** can be seen as "no move" when doing intro *)
+
+(** Sorts *)
+
+type 'a glob_sort_gen =
+  | GProp (** representation of [Prop] literal *)
+  | GSet  (** representation of [Set] literal *)
+  | GType of 'a (** representation of [Type] literal *)
+
+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 *)
+
+type existential_key = Evar.t
+
+(** Case style, shared with Term *)
+
+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 *)
+
+type 'a cast_type =
+  | CastConv of 'a
+  | CastVM of 'a
+  | CastCoerce (** Cast to a base type (eg, an underlying inductive type) *)
+  | CastNative of 'a
+
+(** Bindings *)
+
+type quantified_hypothesis = AnonHyp of int | NamedHyp of Id.t
+
+type 'a explicit_bindings = (quantified_hypothesis * 'a) CAst.t list
+
+type 'a bindings =
+  | ImplicitBindings of 'a list
+  | ExplicitBindings of 'a explicit_bindings
+  | NoBindings
+
+type 'a with_bindings = 'a * 'a bindings
+
+
+(** Some utility types for parsing *)
+
+type 'a or_var =
+  | ArgArg of 'a
+  | ArgVar of lident
+
+type 'a and_short_name = 'a * lident option
+
+type 'a or_by_notation_r =
+  | AN of 'a
+  | ByNotation of (string * string option)
+
+type 'a or_by_notation = 'a or_by_notation_r CAst.t
+
+(* NB: the last string in [ByNotation] is actually a [Notation.delimiters],
+   but this formulation avoids a useless dependency. *)
+
+
+(** Kinds of modules *)
+
+type module_kind = Module | ModType | ModAny
+
+(** Various flags *)
+
+type direction_flag = bool (* true = Left-to-right    false = right-to-right *)
+type evars_flag = bool     (* true = pose evars       false = fail on evars *)
+type rec_flag = bool       (* true = recursive        false = not recursive *)
+type advanced_flag = bool  (* true = advanced         false = basic *)
+type letin_flag = bool     (* true = use local def    false = use Leibniz *)
+type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *)
+
+type multi =
+  | Precisely of int
+  | UpTo of int
+  | RepeatStar
+  | RepeatPlus
+
+type 'a core_destruction_arg =
+  | ElimOnConstr of 'a
+  | ElimOnIdent of lident
+  | ElimOnAnonHyp of int
+
+type 'a destruction_arg =
+  clear_flag * 'a core_destruction_arg
+
+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/misctypes.mli b/intf/misctypes.mli
deleted file mode 100644
index 1452bbc3..00000000
--- a/intf/misctypes.mli
+++ /dev/null
@@ -1,110 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-
-(** Basic types used both in [constr_expr] and in [glob_constr] *)
-
-(** Cases pattern variables *)
-
-type patvar = Id.t
-
-(** Introduction patterns *)
-
-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 Id.t
-  | IntroFresh of Id.t
-  | IntroAnonymous
-and 'constr intro_pattern_action_expr =
-  | IntroWildcard
-  | IntroOrAndPattern of 'constr or_and_intro_pattern_expr
-  | IntroInjection of (Loc.t * 'constr intro_pattern_expr) list
-  | IntroApplyOn of 'constr * (Loc.t * 'constr intro_pattern_expr)
-  | IntroRewrite of bool
-and 'constr or_and_intro_pattern_expr =
-  | IntroOrPattern of (Loc.t * 'constr intro_pattern_expr) list list
-  | IntroAndPattern of (Loc.t * 'constr intro_pattern_expr) list
-
-(** Move destination for hypothesis *)
-
-type 'id move_location =
-  | MoveAfter of 'id
-  | MoveBefore of 'id
-  | MoveFirst
-  | MoveLast (** can be seen as "no move" when doing intro *)
-
-(** Sorts *)
-
-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 = string Loc.located list
-type level_info = string Loc.located option
-
-type glob_sort = sort_info glob_sort_gen
-type glob_level = level_info glob_sort_gen
-
-(** A synonym of [Evar.t], also defined in Term *)
-
-type existential_key = Evar.t
-
-(** Case style, shared with Term *)
-
-type case_style = Term.case_style =
-  | LetStyle
-  | IfStyle
-  | LetPatternStyle
-  | MatchStyle
-  | RegularStyle (** infer printing form from number of constructor *)
-
-(** Casts *)
-
-type 'a cast_type =
-  | CastConv of 'a
-  | CastVM of 'a
-  | CastCoerce (** Cast to a base type (eg, an underlying inductive type) *)
-  | CastNative of 'a
-
-(** Bindings *)
-
-type quantified_hypothesis = AnonHyp of int | NamedHyp of Id.t
-
-type 'a explicit_bindings = (Loc.t * quantified_hypothesis * 'a) list
-
-type 'a bindings =
-  | ImplicitBindings of 'a list
-  | ExplicitBindings of 'a explicit_bindings
-  | NoBindings
-
-type 'a with_bindings = 'a * 'a bindings
-
-
-(** Some utility types for parsing *)
-
-type 'a or_var =
-  | ArgArg of 'a
-  | ArgVar of Names.Id.t Loc.located
-
-type 'a and_short_name = 'a * Id.t Loc.located option
-
-type 'a or_by_notation =
-  | AN of 'a
-  | ByNotation of (Loc.t * string * string option)
-
-(* NB: the last string in [ByNotation] is actually a [Notation.delimiters],
-   but this formulation avoids a useless dependency. *)
-
-
-(** Kinds of modules *)
-
-type module_kind = Module | ModType | ModAny
diff --git a/intf/notation_term.mli b/intf/notation_term.ml
index 1ab9980a..af9d6918 100644
--- a/intf/notation_term.mli
+++ b/intf/notation_term.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -25,13 +27,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
-  | NLetIn of Name.t * notation_constr * notation_constr
-  | NCases of case_style * notation_constr option *
+  | 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 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) *
@@ -59,21 +61,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;
@@ -83,15 +95,29 @@ type notation_interp_env = {
 type grammar_constr_prod_item =
   | GramConstrTerminal of Tok.t
   | GramConstrNonTerminal of Extend.constr_prod_entry_key * Id.t option
-  | GramConstrListMark of int * bool
+  | GramConstrListMark of int * bool * int
     (* tells action rule to make a list of the n previous parsed items;
-       concat with last parsed list if true *)
+       concat with last parsed list when true; additionally release
+       the p last items as if they were parsed autonomously *)
 
-type notation_grammar = {
-  notgram_level : int;
+(** Dealing with precedences *)
+
+type precedence = int
+type parenRelation = L | E | Any | Prec of precedence
+type tolerability = precedence * parenRelation
+
+type level = precedence * tolerability list * Extend.constr_entry_key list
+
+(** Grammar rules for a notation *)
+
+type one_notation_grammar = {
+  notgram_level : level;
   notgram_assoc : Extend.gram_assoc option;
   notgram_notation : Constrexpr.notation;
   notgram_prods : grammar_constr_prod_item list list;
-  notgram_typs : notation_var_internalization_type list;
+}
+
+type notation_grammar = {
   notgram_onlyprinting : bool;
+  notgram_rules : one_notation_grammar list
 }
diff --git a/intf/pattern.ml b/intf/pattern.ml
new file mode 100644
index 00000000..af234767
--- /dev/null
+++ b/intf/pattern.ml
@@ -0,0 +1,44 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Globnames
+open Constr
+open Misctypes
+
+(** {5 Patterns} *)
+
+type case_info_pattern =
+    { 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 _ => _ ? *) }
+
+type constr_pattern =
+  | PRef of global_reference
+  | PVar of Id.t
+  | PEvar of existential_key * constr_pattern array
+  | PRel of int
+  | PApp of constr_pattern * constr_pattern array
+  | PSoApp of patvar * constr_pattern list
+  | 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
+  | PSort of glob_sort
+  | PMeta of patvar 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 fixpoint
+  | PCoFix of cofixpoint
+
+(** Nota : in a [PCase], the array of branches might be shorter than
+    expected, denoting the use of a final "_ => _" branch *)
diff --git a/intf/pattern.mli b/intf/pattern.mli
deleted file mode 100644
index 329ae837..00000000
--- a/intf/pattern.mli
+++ /dev/null
@@ -1,81 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Globnames
-open Term
-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 * constr
-
-(** Types of substitutions with or w/o bound variables *)
-
-type patvar_map = 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_ind : 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 global_reference
-  | PVar of Id.t
-  | PEvar of existential_key * constr_pattern array
-  | PRel of int
-  | PApp of constr_pattern * constr_pattern array
-  | PSoApp of patvar * constr_pattern list
-  | PProj of projection * 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
-  | PSort of glob_sort
-  | PMeta of patvar 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 fixpoint
-  | PCoFix of cofixpoint
-
-(** Nota : in a [PCase], the array of branches might be shorter than
-    expected, denoting the use of a final "_ => _" branch *)
diff --git a/intf/vernacexpr.mli b/intf/vernacexpr.ml
index 92e4dd61..df061bfb 100644
--- a/intf/vernacexpr.mli
+++ b/intf/vernacexpr.ml
@@ -1,25 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Loc
 open Names
-open Tacexpr
 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
@@ -27,7 +21,7 @@ type class_rawexpr = FunClass | SortClass | RefClass of reference or_by_notation
    to print a goal that is out of focus (or already solved) it doesn't
    make sense to apply a tactic to it. Hence it the types may look very
    similar, they do not seem to mean the same thing. *)
-type goal_selector = Tacexpr.goal_selector =
+type goal_selector =
   | SelectNth of int
   | SelectList of (int * int) list
   | SelectId of Id.t
@@ -40,7 +34,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
@@ -56,7 +52,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
@@ -72,7 +68,7 @@ type printable =
   | PrintScopes
   | PrintScope of string
   | PrintVisibility of string option
-  | PrintAbout of reference or_by_notation*int 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
@@ -92,29 +88,25 @@ 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 =
   | ShowGoal of goal_reference
-  | ShowGoalImplicitly of int option
   | ShowProof
-  | ShowNode
   | ShowScript
   | ShowExistentials
   | ShowUniverses
-  | ShowTree
   | ShowProofNames
   | ShowIntros of bool
   | ShowMatch of reference
-  | ShowThesis
 
 type comment =
   | CommentConstr of constr_expr
   | CommentString of string
   | CommentInt of int
 
-type reference_or_constr = 
+type reference_or_constr =
   | HintsReference of reference
   | HintsConstr of constr_expr
 
@@ -136,7 +128,7 @@ type hints_expr =
   | HintsTransparency of reference list * bool
   | HintsMode of reference * hint_mode list
   | HintsConstructors of reference list
-  | HintsExtern of int * constr_expr option * raw_tactic_expr
+  | HintsExtern of int * constr_expr option * Genarg.raw_generic_argument
 
 type search_restriction =
   | SearchInside of reference list
@@ -144,21 +136,17 @@ type search_restriction =
 
 type rec_flag       = bool (* true = Rec;           false = NoRec          *)
 type verbose_flag   = bool (* true = Verbose;       false = Silent         *)
-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
@@ -170,21 +158,20 @@ 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 sort_expr = glob_sort
+type sort_expr = Sorts.family
 
 type definition_expr =
-  | ProveBody of local_binder list * constr_expr
-  | DefineBody of local_binder list * raw_red_expr option * constr_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 fixpoint_expr =
-    plident * (Id.t located option * recursion_order_expr) * local_binder 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 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
@@ -203,28 +190,34 @@ 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 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 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 list * constr_expr * (lident option * recursion_order_expr) option)
+  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
-  | Proved of opacity_flag * (lident * theorem_kind option) option
+  (*                         name in `Save ident` when closing goal *)
+  | Proved of opacity_flag * lident option
 
 type scheme =
   | InductionScheme of bool * reference or_by_notation * sort_expr
@@ -233,6 +226,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
@@ -283,16 +277,6 @@ type bullet =
     | Star of int
     | Plus of int
 
-(** {6 Types concerning Stm} *)
-type 'a stm_vernac =
-  | JoinDocument
-  | Finish
-  | Wait
-  | PrintDag
-  | Observe of Stateid.t
-  | Command of 'a (* An out of flow command not to be recorded by Stm *)
-  | PGLast of 'a (* To ease the life of PG *)
-
 (** {6 Types concerning the module layer} *)
 
 (** Rigid / flexible module signature *)
@@ -313,47 +297,54 @@ type inline =
 type module_ast_inl = module_ast * inline
 type module_binder = bool option * lident list * module_ast_inl
 
+(** Cumulativity can be set globally, locally or unset locally and it
+   can not enabled at all. *)
+type cumulative_inductive_parsing_flag =
+  | GlobalCumulativity
+  | GlobalNonCumulativity
+  | LocalCumulativity
+  | LocalNonCumulativity
+
 (** {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
-  | VernacError of exn (* always fails *)
+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 * bool
+  | 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 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
@@ -362,21 +353,20 @@ 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 *)
   | VernacInstance of
       bool * (* abstract instance *)
-      local_binder list * (* super *)
+      local_binder_expr list * (* super *)
 	typeclass_constraint * (* instance name, class name, params *)
 	(bool * constr_expr) option * (* props *)
 	hint_info_expr
 
-  | VernacContext of local_binder list
+  | VernacContext of local_binder_expr list
 
   | VernacDeclareInstances of
     (reference * hint_info_expr) list (* instances names, priorities and patterns *)
@@ -416,9 +406,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 *
@@ -435,27 +425,22 @@ type vernac_expr =
   | VernacSetOpacity of (Conv_oracle.level * reference or_by_notation list)
   | VernacSetStrategy of
       (Conv_oracle.level * reference or_by_notation list) list
-  | VernacUnsetOption of Goptions.option_name
-  | VernacSetOption of Goptions.option_name * option_value
-  | VernacSetAppendOption of Goptions.option_name * string
+  | VernacUnsetOption of export_flag * Goptions.option_name
+  | VernacSetOption of export_flag * Goptions.option_name * option_value
   | VernacAddOption of Goptions.option_name * option_ref_value list
   | VernacRemoveOption of Goptions.option_name * option_ref_value list
   | VernacMemOption of Goptions.option_name * option_ref_value list
   | VernacPrintOption of Goptions.option_name
-  | VernacCheckMayEval of raw_red_expr option * int option * constr_expr
+  | VernacCheckMayEval of Genredexpr.raw_red_expr option * goal_selector option * constr_expr
   | VernacGlobalCheck of constr_expr
-  | VernacDeclareReduction of string * raw_red_expr
+  | VernacDeclareReduction of string * Genredexpr.raw_red_expr
   | VernacPrint of printable
-  | VernacSearch of searchable * int option * search_restriction
+  | VernacSearch of searchable * goal_selector option * search_restriction
   | VernacLocate of locatable
   | VernacRegister of lident * register_kind
   | VernacComments of comment list
 
-  (* Stm backdoor *)
-  | VernacStm of vernac_expr stm_vernac
-
   (* Proof management *)
-  | VernacGoal of constr_expr
   | VernacAbort of lident option
   | VernacAbortAll
   | VernacRestart
@@ -466,11 +451,11 @@ type vernac_expr =
   | VernacUnfocus
   | VernacUnfocused
   | VernacBullet of bullet
-  | VernacSubproof of int option
+  | VernacSubproof of goal_selector option
   | VernacEndSubproof
   | VernacShow of showable
   | VernacCheckGuard
-  | VernacProof of raw_tactic_expr option * section_subset_expr option
+  | VernacProof of Genarg.raw_generic_argument option * section_subset_expr option
   | VernacProofMode of string
   (* Toplevel control *)
   | VernacToplevelControl of exn
@@ -478,52 +463,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 tacdef_body =
-  | TacticDefinition of Id.t Loc.located * raw_tactic_expr  (* indicates that user employed ':=' in Ltac body *)
-  | TacticRedefinition of reference * raw_tactic_expr       (* indicates that user employed '::=' in Ltac body *)
+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_implicit_status = Implicit | MaximallyImplicit | NotImplicit
+(* A vernac classifier provides information about the exectuion of a
+   command:
 
-and vernac_argument_status = {
-  name : Name.t;
-  recarg_like : bool;
-  notation_scope : (Loc.t * string) option;
-  implicit_status : vernac_implicit_status;
-}
+   - 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.
 
-(* 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_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
-  | VtQuery of vernac_part_of_script * report_with
-  | VtStm of vernac_control * vernac_part_of_script
+  (* 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
+  (* To be removed *)
+  | VtMeta
   | VtUnknown
-and report_with = Stateid.t * Feedback.route_id (* feedback on id/route *)
 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_is_alias = bool
 and vernac_part_of_script = bool
-and vernac_control =
-  | VtFinish
-  | VtWait
-  | VtJoinDocument
-  | VtPrintDag
-  | VtObserve of Stateid.t
-  | VtBack of Stateid.t
-  | VtPG
 and opacity_guarantee =
   | GuaranteesOpacity (** Only generates opaque terms at [Qed] *)
   | Doesn'tGuaranteeOpacity (** May generate transparent terms even with [Qed].*)
@@ -538,3 +530,14 @@ type vernac_when =
   | VtNow
   | VtLater
 type vernac_classification = vernac_type * vernac_when
+
+
+(** Deprecated stuff *)
+type universe_decl_expr = Constrexpr.universe_decl_expr
+[@@ocaml.deprecated "alias of Constrexpr.universe_decl_expr"]
+
+type ident_decl = Constrexpr.ident_decl
+[@@ocaml.deprecated "alias of Constrexpr.ident_decl"]
+
+type name_decl = Constrexpr.name_decl
+[@@ocaml.deprecated "alias of Constrexpr.name_decl"]
diff --git a/kernel/byterun/coq_interp.c b/kernel/byterun/coq_interp.c
index 5dec3b78..af89712d 100644
--- a/kernel/byterun/coq_interp.c
+++ b/kernel/byterun/coq_interp.c
@@ -891,25 +891,58 @@ value coq_interprete
 
 
       Instruct(PROJ){
+        do_proj:
 	print_instr("PROJ");
 	if (Is_accu (accu)) {
-          value block;
-	  /* Skip over the index of projected field */
-	  pc++;
-	  /* Create atom */
-	  Alloc_small(block, 2, ATOM_PROJ_TAG);
-	  Field(block, 0) = Field(coq_global_data, *pc);
-	  Field(block, 1) = accu;
-          accu = block;
-          /* Create accumulator */
-          Alloc_small(block, 2, Accu_tag);
-          Code_val(block) = accumulate;
-          Field(block, 1) = accu;
-          accu = block;
+          *--sp = accu; // Save matched block on stack
+          accu = Field(accu, 1); // Save atom to accu register
+          switch (Tag_val(accu)) {
+          case ATOM_COFIX_TAG: // We are forcing a cofix
+            {
+              mlsize_t i, nargs;
+              sp -= 2;
+              // Push the current instruction as the return address
+              sp[0] = (value)(pc - 1);
+              sp[1] = coq_env;
+              coq_env = Field(accu, 0); // Pointer to suspension
+              accu = sp[2]; // Save accumulator to accu register
+              sp[2] = Val_long(coq_extra_args); // Push number of args for return
+              nargs = Wosize_val(accu) - 2; // Number of args = size of accumulator - 1 (accumulator code) - 1 (atom)
+              // Push arguments to stack
+              CHECK_STACK(nargs + 1);
+              sp -= nargs;
+              for (i = 0; i < nargs; ++i) sp[i] = Field(accu, i + 2);
+              *--sp = accu; // Last argument is the pointer to the suspension
+              coq_extra_args = nargs;
+              pc = Code_val(coq_env); // Trigger evaluation
+              goto check_stack;
+            }
+          case ATOM_COFIXEVALUATED_TAG:
+            {
+              accu = Field(accu, 1);
+              ++sp;
+              goto do_proj;
+            }
+          default:
+            {
+              value block;
+              /* Skip over the index of projected field */
+              ++pc;
+              /* Create atom */
+              Alloc_small(accu, 2, ATOM_PROJ_TAG);
+              Field(accu, 0) = Field(coq_global_data, *pc++);
+              Field(accu, 1) = *sp++;
+              /* Create accumulator */
+              Alloc_small(block, 2, Accu_tag);
+              Code_val(block) = accumulate;
+              Field(block, 1) = accu;
+              accu = block;
+            }
+          }
 	} else {
-	    accu = Field(accu, *pc++);
+          accu = Field(accu, *pc);
+          pc += 2;
 	}
-	pc++;
 	Next;
       }
 
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index fe9ec579..08114abc 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Bruno Barras with Benjamin Werner's account to implement
@@ -23,7 +25,7 @@ open CErrors
 open Util
 open Pp
 open Names
-open Term
+open Constr
 open Vars
 open Environ
 open Esubst
@@ -85,15 +87,16 @@ 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
+  val red_projection : reds -> Projection.t -> bool
 end
 
 module RedFlags = (struct
@@ -114,7 +117,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 +167,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 +239,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'
@@ -254,12 +259,14 @@ module KeyTable = Hashtbl.Make(IdKeyHash)
 
 let eq_table_key = IdKeyHash.equal
 
+type 'a infos_tab = 'a KeyTable.t
+
 type 'a infos_cache = {
-  i_repr : 'a infos -> constr -> 'a;
+  i_repr : 'a infos -> 'a infos_tab -> constr -> 'a;
   i_env : env;
   i_sigma : existential -> constr option;
-  i_rels : constr option array;
-  i_tab : 'a KeyTable.t }
+  i_rels : (Context.Rel.Declaration.t * Pre_env.lazy_val) Range.t;
+}
 
 and 'a infos = {
   i_flags : reds;
@@ -274,26 +281,29 @@ let assoc_defined id env = match Environ.lookup_named id env with
 | LocalDef (_, c, _) -> c
 | _ -> raise Not_found
 
-let ref_value_cache ({i_cache = cache} as infos)  ref =
+let ref_value_cache ({i_cache = cache} as infos) tab ref =
   try
-    Some (KeyTable.find cache.i_tab ref)
+    Some (KeyTable.find tab ref)
   with Not_found ->
   try
     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
-    let v = cache.i_repr infos body in
-    KeyTable.add cache.i_tab ref v;
+    let v = cache.i_repr infos tab body in
+    KeyTable.add tab ref v;
     Some v
   with
     | Not_found (* List.assoc *)
@@ -303,27 +313,14 @@ 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_tab = KeyTable.create 17 }
+      i_rels = (Environ.pre_env env).env_rel_context.env_rel_map;
+    }
   in { i_flags = flgs; i_cache = cache }
 
 
@@ -367,7 +364,7 @@ and fterm =
   | FInd of pinductive
   | FConstruct of pconstructor
   | FApp of fconstr * fconstr array
-  | FProj of projection * fconstr
+  | FProj of Projection.t * fconstr
   | FFix of fixpoint * fconstr subs
   | FCoFix of cofixpoint * fconstr subs
   | FCaseT of case_info * constr * fconstr * constr array * fconstr subs (* predicate and branches are closures *)
@@ -401,7 +398,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 +477,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 +514,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 +528,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) }
@@ -540,14 +538,23 @@ let mk_clos e t =
     | (CoFix _|Lambda _|Fix _|Prod _|Evar _|App _|Case _|Cast _|LetIn _|Proj _) ->
         {norm = Red; term = FCLOS(t,e)}
 
-let mk_clos_vect env v = CArray.Fun1.map mk_clos env v
+(** Hand-unrolling of the map function to bypass the call to the generic array
+    allocation *)
+let mk_clos_vect env v = match v with
+| [||] -> [||]
+| [|v0|] -> [|mk_clos env v0|]
+| [|v0; v1|] -> [|mk_clos env v0; mk_clos env v1|]
+| [|v0; v1; v2|] -> [|mk_clos env v0; mk_clos env v1; mk_clos env v2|]
+| [|v0; v1; v2; v3|] ->
+  [|mk_clos env v0; mk_clos env v1; mk_clos env v2; mk_clos env v3|]
+| v -> CArray.Fun1.map mk_clos env v
 
 (* Translate the head constructor of t from constr to fconstr. This
    function is parameterized by the function to apply on the direct
    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) ->
@@ -646,7 +653,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
@@ -785,7 +792,7 @@ let drop_parameters depth n argstk =
   try try_drop_parameters depth n argstk
   with Not_found ->
   (* we know that n < stack_args_size(argstk) (if well-typed term) *)
-  anomaly (Pp.str "ill-typed term: found a match on a partially applied constructor")
+  anomaly (Pp.str "ill-typed term: found a match on a partially applied constructor.")
 
 (** [eta_expand_ind_stack env ind c s t] computes stacks corresponding
     to the conversion of the eta expansion of t, considered as an inhabitant
@@ -793,14 +800,14 @@ let drop_parameters depth n argstk =
     s.
     @assumes [t] is an irreducible term, and not a constructor. [ind] is the inductive
     of the constructor term [c]
-    @raises Not_found if the inductive is not a primitive record, or if the
+    @raise Not_found if the inductive is not a primitive record, or if the
     constructor is partially applied.
  *)
 let eta_expand_ind_stack env ind m s (f, s') =
   let mib = lookup_mind (fst ind) env in
     match mib.Declarations.mind_record with
     | Some (Some (_,projs,pbs)) when
-	mib.Declarations.mind_finite == Decl_kinds.BiFinite ->
+        mib.Declarations.mind_finite == 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
@@ -847,6 +854,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,
@@ -865,15 +880,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 _|
@@ -882,7 +891,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) ->
@@ -899,23 +908,23 @@ and knht info e t stk =
 (************************************************************************)
 
 (* Computes a weak head normal form from the result of knh. *)
-let rec knr info m stk =
+let rec knr info tab m stk =
   match m.term with
   | FLambda(n,tys,f,e) when red_set info.i_flags fBETA ->
       (match get_args n tys f e stk with
-          Inl e', s -> knit info e' f s
+          Inl e', s -> knit info tab e' f s
         | Inr lam, s -> (lam,s))
   | FFlex(ConstKey (kn,_ as c)) when red_set info.i_flags (fCONST kn) ->
-      (match ref_value_cache info (ConstKey c) with
-          Some v -> kni info v stk
+      (match ref_value_cache info tab (ConstKey c) with
+          Some v -> kni info tab v stk
         | None -> (set_norm m; (m,stk)))
   | FFlex(VarKey id) when red_set info.i_flags (fVAR id) ->
-      (match ref_value_cache info (VarKey id) with
-          Some v -> kni info v stk
+      (match ref_value_cache info tab (VarKey id) with
+          Some v -> kni info tab v stk
         | None -> (set_norm m; (m,stk)))
   | FFlex(RelKey k) when red_set info.i_flags fDELTA ->
-      (match ref_value_cache info (RelKey k) with
-          Some v -> kni info v stk
+      (match ref_value_cache info tab (RelKey k) with
+          Some v -> kni info tab v stk
         | None -> (set_norm m; (m,stk)))
   | FConstruct((ind,c),u) ->
      let use_match = red_set info.i_flags fMATCH in
@@ -925,41 +934,44 @@ let rec knr info m stk =
         | (depth, args, ZcaseT(ci,_,br,e)::s) when use_match ->
             assert (ci.ci_npar>=0);
             let rargs = drop_parameters depth ci.ci_npar args in
-            knit info e br.(c-1) (rargs@s)
+            knit info tab e br.(c-1) (rargs@s)
         | (_, cargs, Zfix(fx,par)::s) when use_fix ->
             let rarg = fapp_stack(m,cargs) in
             let stk' = par @ append_stack [|rarg|] s in
             let (fxe,fxbd) = contract_fix_vect fx.term in
-            knit info fxe fxbd stk'
+            knit info tab fxe fxbd stk'
 	| (depth, args, Zproj (n, m, cst)::s) when use_match ->
 	    let rargs = drop_parameters depth n args in
 	    let rarg = project_nth_arg m rargs in
-	      kni info rarg s
+            kni info tab rarg s
         | (_,args,s) -> (m,args@s))
      else (m,stk)
   | FCoFix _ when red_set info.i_flags fCOFIX ->
       (match strip_update_shift_app m stk with
           (_, args, (((ZcaseT _|Zproj _)::_) as stk')) ->
             let (fxe,fxbd) = contract_fix_vect m.term in
-            knit info fxe fxbd (args@stk')
+            knit info tab fxe fxbd (args@stk')
         | (_,args,s) -> (m,args@s))
   | FLetIn (_,v,_,bd,e) when red_set info.i_flags fZETA ->
-      knit info (subs_cons([|v|],e)) bd stk
+      knit info tab (subs_cons([|v|],e)) bd stk
   | FEvar(ev,env) ->
       (match evar_value info.i_cache ev with
-          Some c -> knit info env c stk
+          Some c -> knit info tab 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 =
+and kni info tab m stk =
   let (hm,s) = knh info m stk in
-  knr info hm s
-and knit info e t stk =
+  knr info tab hm s
+and knit info tab e t stk =
   let (ht,s) = knht info e t stk in
-  knr info ht s
+  knr info tab ht s
 
-let kh info v stk = fapp_stack(kni info v stk)
+let kh info tab v stk = fapp_stack(kni info tab v stk)
 
 (************************************************************************)
 
@@ -987,68 +999,72 @@ let rec zip_term zfun m stk =
    1- Calls kni
    2- tries to rebuild the term. If a closure still has to be computed,
       calls itself recursively. *)
-let rec kl info m =
+let rec kl info tab m =
   if is_val m then (incr prune; term_of_fconstr m)
   else
-    let (nm,s) = kni info m [] in
-    let _ = fapp_stack(nm,s) in (* to unlock Zupdates! *)
-    zip_term (kl info) (norm_head info nm) s
+    let (nm,s) = kni info tab m [] in
+    let () = if !share then ignore (fapp_stack (nm, s)) in (* to unlock Zupdates! *)
+    zip_term (kl info tab) (norm_head info tab nm) s
 
 (* no redex: go up for atoms and already normalized terms, go down
    otherwise. *)
-and norm_head info m =
+and norm_head info tab m =
   if is_val m then (incr prune; term_of_fconstr m) else
     match m.term with
       | FLambda(n,tys,f,e) ->
           let (e',rvtys) =
             List.fold_left (fun (e,ctxt) (na,ty) ->
-              (subs_lift e, (na,kl info (mk_clos e ty))::ctxt))
+              (subs_lift e, (na,kl info tab (mk_clos e ty))::ctxt))
               (e,[]) tys in
-          let bd = kl info (mk_clos e' f) in
+          let bd = kl info tab (mk_clos e' f) in
           List.fold_left (fun b (na,ty) -> mkLambda(na,ty,b)) bd rvtys
       | FLetIn(na,a,b,f,e) ->
           let c = mk_clos (subs_lift e) f in
-          mkLetIn(na, kl info a, kl info b, kl info c)
+          mkLetIn(na, kl info tab a, kl info tab b, kl info tab c)
       | FProd(na,dom,rng) ->
-          mkProd(na, kl info dom, kl info rng)
+          mkProd(na, kl info tab dom, kl info tab rng)
       | FCoFix((n,(na,tys,bds)),e) ->
           let ftys = CArray.Fun1.map mk_clos e tys in
           let fbds =
             CArray.Fun1.map mk_clos (subs_liftn (Array.length na) e) bds in
-          mkCoFix(n,(na, CArray.Fun1.map kl info ftys, CArray.Fun1.map kl info fbds))
+          mkCoFix(n,(na, CArray.map (kl info tab) ftys, CArray.map (kl info tab) fbds))
       | FFix((n,(na,tys,bds)),e) ->
           let ftys = CArray.Fun1.map mk_clos e tys in
           let fbds =
             CArray.Fun1.map mk_clos (subs_liftn (Array.length na) e) bds in
-          mkFix(n,(na, CArray.Fun1.map kl info ftys, CArray.Fun1.map kl info fbds))
+          mkFix(n,(na, CArray.map (kl info tab) ftys, CArray.map (kl info tab) fbds))
       | FEvar((i,args),env) ->
-          mkEvar(i, Array.map (fun a -> kl info (mk_clos env a)) args)
+          mkEvar(i, Array.map (fun a -> kl info tab (mk_clos env a)) args)
       | FProj (p,c) ->
-          mkProj (p, kl info c)
-      | t -> term_of_fconstr m
+          mkProj (p, kl info tab c)
+      | FLOCKED | FRel _ | FAtom _ | FCast _ | FFlex _ | FInd _ | FConstruct _
+        | FApp _ | FCaseT _ | FLIFT _ | FCLOS _ -> term_of_fconstr m
 
 (* Initialization and then normalization *)
 
 (* weak reduction *)
-let whd_val info v =
-  with_stats (lazy (term_of_fconstr (kh info v [])))
+let whd_val info tab v =
+  with_stats (lazy (term_of_fconstr (kh info tab v [])))
 
 (* strong reduction *)
-let norm_val info v =
-  with_stats (lazy (kl info v))
+let norm_val info tab v =
+  with_stats (lazy (kl info tab v))
 
 let inject c = mk_clos (subs_id 0) c
 
-let whd_stack infos m stk =
-  let k = kni infos m stk in
-  let _ = fapp_stack k in (* to unlock Zupdates! *)
+let whd_stack infos tab m stk =
+  let k = kni infos tab m stk in
+  let () = if !share then ignore (fapp_stack k) in (* to unlock Zupdates! *)
   k
 
 (* cache of constants: the body is computed only when needed. *)
 type clos_infos = fconstr infos
 
 let create_clos_infos ?(evars=fun _ -> None) flgs env =
-  create (fun _ -> inject) flgs env evars
+  create (fun _ _ c -> inject c) flgs env evars
+
+let create_tab () = KeyTable.create 17
+
 let oracle_of_infos infos = Environ.oracle infos.i_cache.i_env
 
 let env_of_infos infos = infos.i_cache.i_env
@@ -1056,14 +1072,14 @@ let env_of_infos infos = infos.i_cache.i_env
 let infos_with_reds infos reds =
   { infos with i_flags = reds }
 
-let unfold_reference info key =
+let unfold_reference info tab key =
   match key with
   | ConstKey (kn,_) ->
     if red_set info.i_flags (fCONST kn) then
-      ref_value_cache info key
+      ref_value_cache info tab key
     else None
   | VarKey i ->
     if red_set info.i_flags (fVAR i) then
-      ref_value_cache info key
+      ref_value_cache info tab key
     else None
-  | _ -> ref_value_cache info key
+  | _ -> ref_value_cache info tab key
diff --git a/kernel/cClosure.mli b/kernel/cClosure.mli
index 077756ac..e2f5a3b8 100644
--- a/kernel/cClosure.mli
+++ b/kernel/cClosure.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Esubst
 
@@ -29,7 +31,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 +48,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 +63,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
 
@@ -69,7 +74,7 @@ module type RedFlagsSig = sig
 
   (** This tests if the projection is in unfolded state already or
       is unfodable due to delta. *)
-  val red_projection : reds -> projection -> bool
+  val red_projection : reds -> Projection.t -> bool
 end
 
 module RedFlags : RedFlagsSig
@@ -92,16 +97,18 @@ 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_tab
 type 'a infos = {
   i_flags : reds;
   i_cache : 'a infos_cache }
 
-val ref_value_cache: 'a infos -> table_key -> 'a option
-val create: ('a infos -> constr -> 'a) -> reds -> env ->
+val ref_value_cache: 'a infos -> 'a infos_tab -> table_key -> 'a option
+val create: ('a infos -> 'a infos_tab -> constr -> 'a) -> reds -> env ->
   (existential -> constr option) -> 'a infos
+val create_tab : unit -> 'a infos_tab
 val evar_value : 'a infos_cache -> existential -> constr option
 
 val info_env : 'a infos -> env
@@ -122,10 +129,10 @@ 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
+  | FProj of Projection.t * fconstr
   | FFix of fixpoint * fconstr subs
   | FCoFix of cofixpoint * fconstr subs
   | FCaseT of case_info * constr * fconstr * constr array * fconstr subs (* predicate and branches are closures *)
@@ -145,7 +152,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 +170,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
@@ -187,22 +195,22 @@ val create_clos_infos :
   ?evars:(existential->constr option) -> reds -> env -> clos_infos
 val oracle_of_infos : clos_infos -> Conv_oracle.oracle
 
-val env_of_infos : clos_infos -> env
+val env_of_infos : 'a infos -> env
 
 val infos_with_reds : clos_infos -> reds -> clos_infos
 
 (** Reduction function *)
 
 (** [norm_val] is for strong normalization *)
-val norm_val : clos_infos -> fconstr -> constr
+val norm_val : clos_infos -> fconstr infos_tab -> fconstr -> constr
 
 (** [whd_val] is for weak head normalization *)
-val whd_val : clos_infos -> fconstr -> constr
+val whd_val : clos_infos -> fconstr infos_tab -> fconstr -> constr
 
 (** [whd_stack] performs weak head normalization in a given stack. It
    stops whenever a reduction is blocked. *)
 val whd_stack :
-  clos_infos -> fconstr -> stack -> fconstr * stack
+  clos_infos -> fconstr infos_tab -> fconstr -> stack -> fconstr * stack
 
 (** [eta_expand_ind_stack env ind c s t] computes stacks correspoding
     to the conversion of the eta expansion of t, considered as an inhabitant
@@ -210,7 +218,7 @@ val whd_stack :
     s.
     @assumes [t] is a rigid term, and not a constructor. [ind] is the inductive
     of the constructor term [c]
-    @raises Not_found if the inductive is not a primitive record, or if the
+    @raise Not_found if the inductive is not a primitive record, or if the
     constructor is partially applied.
  *)
 val eta_expand_ind_stack : env -> inductive -> fconstr -> stack ->
@@ -219,7 +227,7 @@ val eta_expand_ind_stack : env -> inductive -> fconstr -> stack ->
 (** Conversion auxiliary functions to do step by step normalisation *)
 
 (** [unfold_reference] unfolds references in a [fconstr] *)
-val unfold_reference : clos_infos -> table_key -> fconstr option
+val unfold_reference : clos_infos -> fconstr infos_tab -> table_key -> fconstr option
 
 val eq_table_key : table_key -> table_key -> bool
 
@@ -235,9 +243,9 @@ val mk_clos_deep :
   (fconstr subs -> constr -> fconstr) ->
    fconstr subs -> constr -> fconstr
 
-val kni: clos_infos -> fconstr -> stack -> fconstr * stack
-val knr: clos_infos -> fconstr -> stack -> fconstr * stack
-val kl : clos_infos -> fconstr -> constr
+val kni: clos_infos -> fconstr infos_tab -> fconstr -> stack -> fconstr * stack
+val knr: clos_infos -> fconstr infos_tab -> fconstr -> stack -> fconstr * stack
+val kl : clos_infos -> fconstr infos_tab -> fconstr -> constr
 
 val to_constr : (lift -> fconstr -> constr) -> lift -> fconstr -> constr
 
diff --git a/kernel/primitives.ml b/kernel/cPrimitives.ml
index 27732c00..5b91a9b5 100644
--- a/kernel/primitives.ml
+++ b/kernel/cPrimitives.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t =
diff --git a/kernel/primitives.mli b/kernel/cPrimitives.mli
index 86e86a5e..1e99a69d 100644
--- a/kernel/primitives.mli
+++ b/kernel/cPrimitives.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t =
diff --git a/kernel/cbytecodes.ml b/kernel/cbytecodes.ml
index 810c3469..0f3a43d5 100644
--- a/kernel/cbytecodes.ml
+++ b/kernel/cbytecodes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Bruno Barras for Benjamin Grégoire as part of the
@@ -13,7 +15,7 @@
 (* This file defines the type of bytecode instructions *)
 
 open Names
-open Term
+open Constr
 
 type tag = int
 
@@ -32,19 +34,64 @@ let cofix_evaluated_tag = 7
 let last_variant_tag = 245 
 
 type structured_constant =
-  | Const_sorts of sorts
+  | Const_sort 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
 
 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_sort s1, Const_sort s2 -> Sorts.equal s1 s2
+| Const_sort _, _ -> 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
+
+let rec hash_structured_constant c =
+  let open Hashset.Combine in
+  match c with
+  | Const_sort 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)
+
+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 +121,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
@@ -135,6 +182,7 @@ type fv_elem =
   | FVnamed of Id.t
   | FVrel of int
   | FVuniv_var of int
+  | FVevar of Evar.t
 
 type fv = fv_elem array
 
@@ -149,12 +197,15 @@ type t = fv_elem
 
 let compare e1 e2 = match e1, e2 with
 | FVnamed id1, FVnamed id2 -> Id.compare id1 id2
-| FVnamed _, _ -> -1
+| FVnamed _, (FVrel _ | FVuniv_var _ | FVevar _) -> -1
 | FVrel _, FVnamed _ -> 1
 | FVrel r1, FVrel r2 -> Int.compare r1 r2
-| FVrel _, FVuniv_var _ -> -1
+| FVrel _, (FVuniv_var _ | FVevar _) -> -1
 | FVuniv_var i1, FVuniv_var i2 -> Int.compare i1 i2
-| FVuniv_var i1, _ -> 1
+| FVuniv_var i1, (FVnamed _ | FVrel _) -> 1
+| FVuniv_var i1, FVevar _ -> -1
+| FVevar _, (FVnamed _ | FVrel _ | FVuniv_var _) -> 1
+| FVevar e1, FVevar e2 -> Evar.compare e1 e2
 
 end
 
@@ -170,6 +221,7 @@ type vm_env = {
 
 
 type comp_env = {
+    arity : int;                 (* arity of the current function, 0 if none *)
     nb_uni_stack : int ;         (* number of universes on the stack,      *)
                                  (* universes are always at the bottom.    *)
     nb_stack : int;              (* number of variables on the stack       *)
@@ -186,20 +238,20 @@ open Pp
 open Util
 
 let pp_sort s =
-  match family_of_sort s with
-  | InSet -> str "Set"
-  | InProp -> str "Prop"
-  | InType -> str "Type"
+  let open Sorts in
+  match s with
+  | Prop Null -> str "Prop"
+  | Prop Pos -> str "Set"
+  | Type u -> str "Type@{" ++ Univ.pr_uni u ++ str "}"
 
 let rec pp_struct_const = function
-  | Const_sorts s -> pp_sort s
-  | Const_ind (mind, i) -> pr_mind mind ++ str"#" ++ int i
+  | Const_sort s -> pp_sort s
+  | 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) ->
      int i ++ surround (prvect_with_sep pr_comma pp_struct_const t)
   | Const_univ_level l -> Univ.Level.pr l
-  | Const_type u -> str "Type@{" ++ Univ.pr_uni u ++ str "}"
 
 let pp_lbl lbl = str "L" ++ int lbl
 
@@ -207,6 +259,7 @@ let pp_fv_elem = function
   | FVnamed id -> str "FVnamed(" ++ Id.print id ++ str ")"
   | FVrel i -> str "Rel(" ++ int i ++ str ")"
   | FVuniv_var v -> str "FVuniv(" ++ int v ++ str ")"
+  | FVevar e -> str "FVevar(" ++ int (Evar.repr e) ++ str ")"
 
 let rec pp_instr i =
   match i with
@@ -241,7 +294,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) ->
@@ -299,17 +352,4 @@ and pp_bytecodes c =
   | Ksequence (l1, l2) :: c ->
       pp_bytecodes l1 ++ pp_bytecodes l2 ++  pp_bytecodes c
   | i :: c ->
-      tab () ++ 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  *)
+      pp_instr i ++ fnl () ++ pp_bytecodes c
diff --git a/kernel/cbytecodes.mli b/kernel/cbytecodes.mli
index b8de7619..f87090c7 100644
--- a/kernel/cbytecodes.mli
+++ b/kernel/cbytecodes.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* $Id$ *)
 
 open Names
-open Term
+open Constr
 
 type tag = int
 
@@ -26,21 +28,26 @@ val cofix_evaluated_tag : tag
 val last_variant_tag : tag
 
 type structured_constant =
-  | Const_sorts of sorts
+  | Const_sort 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
 
-val pp_struct_const : structured_constant -> Pp.std_ppcmds
+val pp_struct_const : structured_constant -> Pp.t
 
 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 +76,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
@@ -132,6 +139,7 @@ type fv_elem =
   FVnamed of Id.t
 | FVrel of int
 | FVuniv_var of int
+| FVevar of Evar.t
 
 type fv = fv_elem array
 
@@ -152,6 +160,7 @@ type vm_env = {
 
 
 type comp_env = {
+    arity : int;                 (* arity of the current function, 0 if none *)
     nb_uni_stack : int ;         (** number of universes on the stack       *)
     nb_stack : int;              (** number of variables on the stack       *)
     in_stack : int list;         (** position in the stack                  *)
@@ -163,16 +172,5 @@ type comp_env = {
     in_env : vm_env ref          (** the variables that are accessed        *)
   }
 
-val pp_bytecodes : bytecodes -> Pp.std_ppcmds
-val pp_fv_elem : fv_elem -> Pp.std_ppcmds
-
-(*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  *)
+val pp_bytecodes : bytecodes -> Pp.t
+val pp_fv_elem : fv_elem -> Pp.t
diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml
index b1fc0c85..e2c535e9 100644
--- a/kernel/cbytegen.ml
+++ b/kernel/cbytegen.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Author: Benjamin Grégoire as part of the bytecode-based virtual reduction
@@ -14,7 +16,9 @@ open Util
 open Names
 open Cbytecodes
 open Cemitcodes
-open Term
+open Cinstr
+open Clambda
+open Constr
 open Declarations
 open Pre_env
 
@@ -96,7 +100,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 = {
@@ -107,8 +111,9 @@ let push_fv d e = {
 
 let fv r = !(r.in_env)
 
-let empty_comp_env ?(univs=0) ()=
-  { nb_uni_stack = univs;
+let empty_comp_env ()=
+  { arity = 0;
+    nb_uni_stack = 0;
     nb_stack = 0;
     in_stack = [];
     nb_rec = 0;
@@ -143,7 +148,8 @@ let rec add_param n sz l =
   if Int.equal n 0 then l else add_param (n - 1) sz (n+sz::l)
 
 let comp_env_fun ?(univs=0) arity =
-  { nb_uni_stack = univs ;
+  { arity;
+    nb_uni_stack = univs ;
     nb_stack = arity;
     in_stack = add_param arity 0 [];
     nb_rec = 0;
@@ -154,7 +160,8 @@ let comp_env_fun ?(univs=0) arity =
 
 
 let comp_env_fix_type  rfv =
-  { nb_uni_stack = 0;
+  { arity = 0;
+    nb_uni_stack = 0;
     nb_stack = 0;
     in_stack = [];
     nb_rec = 0;
@@ -168,7 +175,8 @@ let comp_env_fix ndef curr_pos arity rfv =
    for i = ndef downto 1 do
      prec := Koffsetclosure (2 * (ndef - curr_pos - i)) :: !prec
    done;
-   { nb_uni_stack = 0;
+   { arity;
+     nb_uni_stack = 0;
      nb_stack = arity;
      in_stack = add_param arity 0 [];
      nb_rec = ndef;
@@ -178,7 +186,8 @@ let comp_env_fix ndef curr_pos arity rfv =
    }
 
 let comp_env_cofix_type ndef rfv =
-  { nb_uni_stack = 0;
+  { arity = 0;
+    nb_uni_stack = 0;
     nb_stack = 0;
     in_stack = [];
     nb_rec = 0;
@@ -192,7 +201,8 @@ let comp_env_cofix ndef arity rfv =
    for i = 1 to ndef do
      prec := Kenvacc i :: !prec
    done;
-   { nb_uni_stack = 0;
+   { arity;
+     nb_uni_stack = 0;
      nb_stack = arity;
      in_stack = add_param arity 0 [];
      nb_rec = ndef;
@@ -244,8 +254,15 @@ let pos_rel i r sz =
 	Kenvacc(r.offset + pos)
 
 let pos_universe_var i r sz =
-  if i < r.nb_uni_stack then
-    Kacc (sz - r.nb_stack - (r.nb_uni_stack - i))
+  (* Compilation of a universe variable can happen either at toplevel (the
+  current closure correspond to a constant and has local universes) or in a
+  local closure (which has no local universes). *)
+  if r.nb_uni_stack != 0 then
+    (* Universe variables are represented by De Bruijn levels (not indices),
+    starting at 0. The shape of the stack will be [v1|..|vn|u1..up|arg1..argq]
+    with size = n + p + q, and q = r.arity. So Kacc (sz - r.arity - 1) will access
+    the last universe. *)
+    Kacc (sz - r.arity - (r.nb_uni_stack - i))
   else
     let env = !(r.in_env) in
     let db = FVuniv_var i in
@@ -255,6 +272,15 @@ let pos_universe_var i r sz =
       r.in_env := push_fv db env;
       Kenvacc(r.offset + pos)
 
+let pos_evar evk r =
+  let env = !(r.in_env) in
+  let cid = FVevar evk in
+  try Kenvacc(r.offset + find_at cid env)
+  with Not_found ->
+    let pos = env.size in
+    r.in_env := push_fv cid env;
+    Kenvacc (r.offset + pos)
+
 (*i  Examination of the continuation *)
 
 (* Discard all instructions up to the next label.                        *)
@@ -356,13 +382,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 +389,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 +411,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 +424,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
@@ -571,6 +451,7 @@ let compile_fv_elem reloc fv sz cont =
   | FVrel i -> pos_rel i reloc sz :: cont
   | FVnamed id -> pos_named id reloc :: cont
   | FVuniv_var i -> pos_universe_var i reloc sz :: cont
+  | FVevar evk -> pos_evar evk reloc :: cont
 
 let rec compile_fv reloc l sz cont =
   match l with
@@ -593,112 +474,111 @@ 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
+
+  | Levar (evk, args) ->
+      if Array.is_empty args then
+        compile_fv_elem reloc (FVevar evk) sz cont
+      else
+        (** Arguments are reversed in evar instances *)
+        let args = Array.copy args in
+        let () = Array.rev args in
+        comp_app compile_fv_elem (compile_lam env) reloc (FVevar evk) args sz 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
+      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_sort s) sz cont
+  | Lsort (Sorts.Type u) ->
+    (* We represent universes as a global constant with local universes
+       "compacted", i.e. as [u arg0 ... argn] where we will substitute (after
+       evaluation) [Var 0,...,Var n] with values of [arg0,...,argn] *)
+    let u,s = Univ.compact_univ u in
+    let compile_get_univ reloc idx sz cont =
+      set_max_stack_size sz;
+      compile_fv_elem reloc (FVuniv_var idx) sz cont
+    in
+    if List.is_empty s then
+      compile_structured_constant reloc (Const_sort (Sorts.Type u)) 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) ->
-     (* 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
-      (* 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
-      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_sort (Sorts.Type u)) (Array.of_list s) sz cont
+
+  | 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
-  | 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
+
+  | 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 +589,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 +599,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 +625,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 +663,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 +691,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 +718,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 +771,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 +854,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,87 +891,32 @@ 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 ->
-    let fn = if fail_on_error then CErrors.errorlabstrm "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)
-
-let compile_constant_body fail_on_error env univs = function
+  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
+    fn msg; None
+
+let compile_constant_body ~fail_on_error env univs = function
   | Undef _ | OpaqueDef _ -> Some BCconstant
   | Def sb ->
       let body = Mod_subst.force_constr sb in
       let instance_size =
         match univs with
-        | None -> 0
-        | Some univ -> Univ.UContext.size univ
+        | 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 +955,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 c0f48641..abab58b6 100644
--- a/kernel/cbytegen.mli
+++ b/kernel/cbytegen.mli
@@ -1,42 +1,27 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 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 ->
-			    env -> constant_universes option -> constant_def -> body_code option
+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 ad7a41a3..14f4f27c 100644
--- a/kernel/cemitcodes.ml
+++ b/kernel/cemitcodes.ml
@@ -1,56 +1,111 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Author: Benjamin Grégoire as part of the bytecode-based virtual reduction
    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 = 
-  String.unsafe_set buff pos       c1;
-  String.unsafe_set buff (pos + 1) c2;
-  String.unsafe_set buff (pos + 2) c3;
-  String.unsafe_set buff (pos + 3) c4 
+  Bytes.unsafe_set buff pos       c1;
+  Bytes.unsafe_set buff (pos + 1) c2;
+  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))
 
-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 = String.copy buff in
-  let () = List.iter (fun p -> patch buff p) patches in
+  let buff = Bytes.of_string buff in
+  let iter (reloc, npos) = Array.iter (fun pos -> patch1 buff pos reloc) npos in
+  let () = CArray.iter iter reloc in
   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(String.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 >= String.length !out_buffer then begin
-    let len = String.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
@@ -58,287 +113,274 @@ let out_word b1 b2 b3 b4 =
 	if len = Sys.max_string_length
 	then invalid_arg "String.create"  (* Pas la bonne exception .... *)
 	else Sys.max_string_length in
-    let new_buffer = String.create new_len in
-    String.blit !out_buffer 0 new_buffer 0 len;
-    out_buffer := new_buffer
+    let new_buffer = Bytes.create new_len in
+    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
-  !out_buffer.[pos]   <- Char.unsafe_chr displ;
-  !out_buffer.[pos+1] <- Char.unsafe_chr (displ asr 8);
-  !out_buffer.[pos+2] <- Char.unsafe_chr (displ asr 16);
-  !out_buffer.[pos+3] <- Char.unsafe_chr (displ asr 24)
-
-let define_label lbl =
-  if lbl >= Array.length !label_table then extend_label_table lbl;
-  match (!label_table).(lbl) with
+  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 info =
-  reloc_info := (info, !out_position) :: !reloc_info
+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 slot_for_const c =
-  enter (Reloc_const c);
-  out_int 0
+let slot_for_const env c =
+  enter env (Reloc_const c);
+  out_int env 0
 
-let slot_for_annot a =
-  enter (Reloc_annot a);
-  out_int 0
+let slot_for_annot env a =
+  enter env (Reloc_annot a);
+  out_int env 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 list of instructions. Include some peephole optimization. *)
+(* Emission of a current list and remaining lists of instructions. Include some peephole optimization. *)
 
-let rec emit = function
-  | [] -> ()
+let rec emit env insns remaining = match insns with
+  | [] -> 
+     (match remaining with 
+       [] -> () 
+     | (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
+      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
+      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
+      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
+      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
+      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
+      out env opPUSHGETGLOBAL; slot_for_const env const;
+      emit env c remaining
   | Kpop n :: Kjump :: c ->
-      out opRETURN; out_int n; emit c
+      out env opRETURN; out_int env n; emit env c remaining
   | Ksequence(c1,c2)::c ->
-      emit c1; emit c2;emit c
+      emit env c1 (c2::c::remaining)
   (* Default case *)
   | instr :: c ->
-      emit_instr instr; emit c
+      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
-
-let length = String.length
-
-type to_patch = emitcodes * (patch list) * fv
+type to_patch = emitcodes * patches * fv
 
 (* Substitution *)
 let rec subst_strcst s sc =
   match sc with
-  | Const_sorts _ | Const_b0 _ | Const_univ_level _ | Const_type _ -> sc
+  | Const_sort _ | Const_b0 _ | Const_univ_level _ -> sc
   | Const_proj p -> Const_proj (subst_constant s p)
   | 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
@@ -366,17 +408,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 code = String.create !out_position in
-  String.unsafe_blit !out_buffer 0 code 0 !out_position;
+  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 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 c80edd59..03920dc1 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 00000000..f42c4617
--- /dev/null
+++ b/kernel/cinstr.mli
@@ -0,0 +1,50 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+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
+  | Levar         of Evar.t * lambda array
+  | 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 (* must be in eta-expanded form *)
+  | 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
+
+(* Cofixpoints have to be in eta-expanded form for their call-by-need evaluation
+to be correct. Otherwise, memoization of previous evaluations will be applied
+again to extra arguments (see #7333). *)
+
+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 00000000..c39f4259
--- /dev/null
+++ b/kernel/clambda.ml
@@ -0,0 +1,866 @@
+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
+  | Levar (evk, args) ->
+    hov 1 (str "evar(" ++ Evar.print evk ++ str "," ++ spc () ++
+      prlist_with_sep spc pp_lam (Array.to_list args) ++ str ")")
+  | 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
+  | Levar (evk, args) ->
+    let args' = Array.smartmap (f n) args in
+    if args == args' then lam else Levar (evk, args')
+  | 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 _ -> 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
+  | Levar (_, args) ->
+    occurrence_args k kind args
+  | 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 (eta_expand,eta_expand_hook) = Hook.make ()
+
+let rec lambda_of_constr env c =
+  match Constr.kind c with
+  | Meta _ -> raise (Invalid_argument "Cbytegen.lambda_of_constr: Meta")
+  | Evar (evk, args) ->
+    let args = lambda_of_args env 0 args in
+    Levar (evk, args)
+
+  | 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 rec_bodies = Array.map2 (Hook.get eta_expand env.global_env) rec_bodies type_bodies in
+    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 00000000..827eb550
--- /dev/null
+++ b/kernel/clambda.mli
@@ -0,0 +1,30 @@
+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
+
+val eta_expand : (Pre_env.env -> Constr.t -> Constr.types -> Constr.t) Hook.value
+val eta_expand_hook : (Pre_env.env -> Constr.t -> Constr.types -> Constr.t) Hook.t
diff --git a/kernel/constr.ml b/kernel/constr.ml
index ce20751a..de4e7c18 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File initially created by Gérard Huet and Thierry Coquand in 1984 *)
@@ -75,39 +77,48 @@ 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
 
 (* [Var] is used for named variables and [Rel] for variables as
    de Bruijn indices. *)
-type ('constr, 'types) kind_of_term =
+type ('constr, 'types, 'sort, 'univs) kind_of_term =
   | Rel       of int
   | Var       of Id.t
   | Meta      of metavariable
   | Evar      of 'constr pexistential
-  | Sort      of Sorts.t
+  | 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 pconstant
-  | Ind       of pinductive
-  | Construct of pconstructor
+  | 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 * 'constr
+  | Proj      of Projection.t * 'constr
 (* constr is the fixpoint of the previous type. Requires option
    -rectypes of the Caml compiler to be set *)
-type t = (t,t) kind_of_term
+type t = (t, t, Sorts.t, Instance.t) kind_of_term
 type constr = t
 
 type existential = existential_key * constr array
 type rec_declaration = Name.t array * constr array * constr array
 type fixpoint = (int array * int) * rec_declaration
+  (* The array of [int]'s tells for each component of the array of
+     mutual fixpoints the number of lambdas to skip before finding the
+     recursive argument (e.g., value is 2 in "fix f (x:A) (y:=t) (z:B)
+     (v:=u) (w:I) {struct w}"), telling to skip x and z and that w is
+     the recursive argument);
+     The second component [int] tells which component of the block is
+     returned *)
 type cofixpoint = int * rec_declaration
+  (* The component [int] tells which component of the block of
+     cofixpoint is returned *)
 
 type types = constr
 
@@ -115,7 +126,7 @@ type types = constr
 (* Term constructors *)
 (*********************)
 
-(* Constructs a DeBrujin index with number n *)
+(* Constructs a de Bruijn index with number n *)
 let rels =
   [|Rel  1;Rel  2;Rel  3;Rel  4;Rel  5;Rel  6;Rel  7; Rel  8;
     Rel  9;Rel 10;Rel 11;Rel 12;Rel 13;Rel 14;Rel 15; Rel 16|]
@@ -224,7 +235,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                 *)
 (************************************************************************)
@@ -235,6 +245,174 @@ let mkVar id = Var id
 
 let kind c = c
 
+(* The other way around. We treat specifically smart constructors *)
+let of_kind = function
+| App (f, a) -> mkApp (f, a)
+| 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                         *)
 (****************************************************************************)
@@ -301,6 +479,34 @@ let iter_with_binders g f n c = match kind c with
       CArray.Fun1.iter f n tl;
       CArray.Fun1.iter f (iterate g (Array.length tl) n) bl
 
+(* [fold_constr_with_binders g f n acc c] folds [f n] on the immediate
+   subterms of [c] starting from [acc] and proceeding from left to
+   right according to the usual representation of the constructions as
+   [fold_constr] but it carries an extra data [n] (typically a lift
+   index) which is processed by [g] (which typically add 1 to [n]) at
+   each binder traversal; it is not recursive *)
+
+let fold_constr_with_binders g f n acc c =
+  match 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  n) (f n acc t) c
+  | Lambda (na,t,c) -> f (g  n) (f n acc t) c
+  | LetIn (na,b,t,c) -> f (g  n) (f n (f n acc b) t) c
+  | App (c,l) -> Array.fold_left (f n) (f n acc c) l
+  | Proj (p,c) -> f n acc c
+  | Evar (_,l) -> Array.fold_left (f n) acc l
+  | Case (_,p,c,bl) -> Array.fold_left (f n) (f n (f n acc p) c) bl
+  | Fix (_,(lna,tl,bl)) ->
+      let n' = CArray.fold_left2 (fun c n t -> g c) n lna tl in
+      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
+  | CoFix (_,(lna,tl,bl)) ->
+      let n' = CArray.fold_left2 (fun c n t -> g c) n lna tl in
+      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
+
 (* [map f c] maps [f] on the immediate subterms of [c]; it is
    not recursive and the order with which subterms are processed is
    not specified *)
@@ -476,6 +682,11 @@ let map_with_binders g f l c0 = match kind c0 with
     let bl' = CArray.Fun1.smartmap f l' bl in
     mkCoFix (ln,(lna,tl',bl'))
 
+type instance_compare_fn = global_reference -> int ->
+  Univ.Instance.t -> Univ.Instance.t -> bool
+
+type constr_compare_fn = int -> constr -> constr -> bool
+
 (* [compare_head_gen_evar k1 k2 u s e eq leq c1 c2] compare [c1] and
    [c2] (using [k1] to expose the structure of [c1] and [k2] to expose
    the structure [c2]) using [eq] to compare the immediate subterms of
@@ -487,35 +698,42 @@ let map_with_binders g f l c0 = match kind c0 with
    optimisation that physically equal arrays are equals (hence the
    calls to {!Array.equal_norefl}). *)
 
-let compare_head_gen_leq_with kind1 kind2 eq_universes leq_sorts eq leq t1 t2 =
+let compare_head_gen_leq_with kind1 kind2 leq_universes leq_sorts eq leq nargs t1 t2 =
   match kind1 t1, kind2 t2 with
   | Rel n1, Rel n2 -> Int.equal n1 n2
   | Meta m1, Meta m2 -> Int.equal m1 m2
   | Var id1, Var id2 -> Id.equal id1 id2
   | Sort s1, Sort s2 -> leq_sorts s1 s2
-  | Cast (c1,_,_), _ -> leq c1 t2
-  | _, Cast (c2,_,_) -> leq t1 c2
-  | 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
-  | App (Cast(c1, _, _),l1), _ -> leq (mkApp (c1,l1)) t2
-  | _, App (Cast (c2, _, _),l2) -> leq t1 (mkApp (c2,l2))
-  | App (c1,l1), App (c2,l2) ->
-      Int.equal (Array.length l1) (Array.length l2) &&
-        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
-  | 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
+  | Cast (c1, _, _), _ -> leq nargs c1 t2
+  | _, Cast (c2, _, _) -> leq nargs t1 c2
+  | Prod (_,t1,c1), Prod (_,t2,c2) -> eq 0 t1 t2 && leq 0 c1 c2
+  | Lambda (_,t1,c1), Lambda (_,t2,c2) -> eq 0 t1 t2 && eq 0 c1 c2
+  | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> eq 0 b1 b2 && eq 0 t1 t2 && leq nargs c1 c2
+  (* Why do we suddenly make a special case for Cast here? *)
+  | App (Cast (c1, _, _), l1), _ -> leq nargs (mkApp (c1, l1)) t2
+  | _, App (Cast (c2, _, _), l2) -> leq nargs t1 (mkApp (c2, l2))
+  | App (c1, l1), App (c2, l2) ->
+    let len = Array.length l1 in
+    Int.equal len (Array.length l2) &&
+    eq (nargs+len) c1 c2 && Array.equal_norefl (eq 0) l1 l2
+  | Proj (p1,c1), Proj (p2,c2) -> Projection.equal p1 p2 && eq 0 c1 c2
+  | Evar (e1,l1), Evar (e2,l2) -> Evar.equal e1 e2 && Array.equal (eq 0) l1 l2
+  | Const (c1,u1), Const (c2,u2) ->
+    (* The args length currently isn't used but may as well pass it. *)
+    Constant.equal c1 c2 && leq_universes (ConstRef c1) nargs u1 u2
+  | Ind (c1,u1), Ind (c2,u2) -> eq_ind c1 c2 && leq_universes (IndRef c1) nargs u1 u2
+  | Construct (c1,u1), Construct (c2,u2) ->
+    eq_constructor c1 c2 && leq_universes (ConstructRef c1) nargs u1 u2
   | Case (_,p1,c1,bl1), Case (_,p2,c2,bl2) ->
-      eq p1 p2 && eq c1 c2 && Array.equal eq bl1 bl2
+    eq 0 p1 p2 && eq 0 c1 c2 && Array.equal (eq 0) bl1 bl2
   | Fix ((ln1, i1),(_,tl1,bl1)), Fix ((ln2, i2),(_,tl2,bl2)) ->
-      Int.equal i1 i2 && Array.equal Int.equal ln1 ln2
-      && Array.equal_norefl eq tl1 tl2 && Array.equal_norefl eq bl1 bl2
+    Int.equal i1 i2 && Array.equal Int.equal ln1 ln2
+    && Array.equal_norefl (eq 0) tl1 tl2 && Array.equal_norefl (eq 0) 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
+    Int.equal ln1 ln2 && Array.equal_norefl (eq 0) tl1 tl2 && Array.equal_norefl (eq 0) bl1 bl2
+  | (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,
@@ -523,8 +741,8 @@ let compare_head_gen_leq_with kind1 kind2 eq_universes leq_sorts eq leq t1 t2 =
    application associativity, binders name and Cases annotations are
    not taken into account *)
 
-let compare_head_gen_leq eq_universes leq_sorts eq leq t1 t2 =
-  compare_head_gen_leq_with kind kind  eq_universes leq_sorts eq leq t1 t2
+let compare_head_gen_leq leq_universes leq_sorts eq leq t1 t2 =
+  compare_head_gen_leq_with kind kind leq_universes leq_sorts eq leq t1 t2
 
 (* [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
@@ -541,7 +759,7 @@ let compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq t1 t2 =
 let compare_head_gen eq_universes eq_sorts eq t1 t2 =
   compare_head_gen_leq eq_universes eq_sorts eq eq t1 t2
 
-let compare_head = compare_head_gen (fun _ -> Univ.Instance.equal) Sorts.equal
+let compare_head = compare_head_gen (fun _ _ -> Univ.Instance.equal) Sorts.equal
 
 (*******************************)
 (*  alpha conversion functions *)
@@ -549,41 +767,41 @@ let compare_head = compare_head_gen (fun _ -> Univ.Instance.equal) Sorts.equal
 
 (* alpha conversion : ignore print names and casts *)
 
-let rec eq_constr m n =
-  (m == n) || compare_head_gen (fun _ -> Instance.equal) Sorts.equal eq_constr m n
+let rec eq_constr nargs m n =
+  (m == n) || compare_head_gen (fun _ _ -> Instance.equal) Sorts.equal eq_constr nargs m n
 
-let equal m n = eq_constr m n (* to avoid tracing a recursive fun *)
+let equal n m = eq_constr 0 m n (* to avoid tracing a recursive fun *)
 
 let eq_constr_univs univs m n =
   if m == n then true
   else 
-    let eq_universes _ = UGraph.check_eq_instances univs in
+    let eq_universes _ _ = UGraph.check_eq_instances univs in
     let eq_sorts s1 s2 = s1 == s2 || UGraph.check_eq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in
-    let rec eq_constr' m n = 
-      m == n ||	compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in compare_head_gen eq_universes eq_sorts eq_constr' m n
+    let rec eq_constr' nargs m n =
+      m == n ||	compare_head_gen eq_universes eq_sorts eq_constr' nargs m n
+    in compare_head_gen eq_universes eq_sorts eq_constr' 0 m n
 
 let leq_constr_univs univs m n =
   if m == n then true
   else 
-    let eq_universes _ = UGraph.check_eq_instances univs in
+    let eq_universes _ _ = UGraph.check_eq_instances univs in
     let eq_sorts s1 s2 = s1 == s2 || 
       UGraph.check_eq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in
     let leq_sorts s1 s2 = s1 == s2 || 
       UGraph.check_leq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) in
-    let rec eq_constr' m n = 
-      m == n ||	compare_head_gen eq_universes eq_sorts eq_constr' m n
+    let rec eq_constr' nargs m n =
+      m == n || compare_head_gen eq_universes eq_sorts eq_constr' nargs m n
     in
-    let rec compare_leq m n =
-      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
+    let rec compare_leq nargs m n =
+      compare_head_gen_leq eq_universes leq_sorts eq_constr' leq_constr' nargs m n
+    and leq_constr' nargs m n = m == n || compare_leq nargs m n in
+    compare_leq 0 m n
 
 let eq_constr_univs_infer univs m n =
   if m == n then true, Constraint.empty
   else 
     let cstrs = ref Constraint.empty in
-    let eq_universes strict = UGraph.check_eq_instances univs in
+    let eq_universes _ _ = UGraph.check_eq_instances univs in
     let eq_sorts s1 s2 = 
       if Sorts.equal s1 s2 then true
       else
@@ -593,17 +811,17 @@ let eq_constr_univs_infer univs m n =
 	  (cstrs := Univ.enforce_eq u1 u2 !cstrs;
 	   true)
     in
-    let rec eq_constr' m n = 
-      m == n ||	compare_head_gen eq_universes eq_sorts eq_constr' m n
+    let rec eq_constr' nargs m n =
+      m == n || compare_head_gen eq_universes eq_sorts eq_constr' nargs m n
     in
-    let res = compare_head_gen eq_universes eq_sorts eq_constr' m n in
+    let res = compare_head_gen eq_universes eq_sorts eq_constr' 0 m n in
     res, !cstrs
 
 let leq_constr_univs_infer univs m n =
   if m == n then true, Constraint.empty
   else 
     let cstrs = ref Constraint.empty in
-    let eq_universes strict l l' = UGraph.check_eq_instances univs l l' in
+    let eq_universes _ _ l l' = UGraph.check_eq_instances univs l l' in
     let eq_sorts s1 s2 = 
       if Sorts.equal s1 s2 then true
       else
@@ -618,25 +836,22 @@ let leq_constr_univs_infer univs m n =
 	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
 	if UGraph.check_leq univs u1 u2 then true
 	else
-	  (cstrs := Univ.enforce_leq u1 u2 !cstrs; 
-	   true)
+          (try let c, _ = UGraph.enforce_leq_alg u1 u2 univs in
+            cstrs := Univ.Constraint.union c !cstrs;
+            true
+          with Univ.UniverseInconsistency _ -> false)
     in
-    let rec eq_constr' m n = 
-      m == n ||	compare_head_gen eq_universes eq_sorts eq_constr' m n
+    let rec eq_constr' nargs m n =
+      m == n || compare_head_gen eq_universes eq_sorts eq_constr' nargs m n
     in
-    let rec compare_leq m n =
-      compare_head_gen_leq eq_universes leq_sorts eq_constr' leq_constr' m n
-    and leq_constr' m n = m == n || compare_leq m n in
-    let res = compare_leq m n in
+    let rec compare_leq nargs m n =
+      compare_head_gen_leq eq_universes leq_sorts eq_constr' leq_constr' nargs m n
+    and leq_constr' nargs m n = m == n || compare_leq nargs m n in
+    let res = compare_leq 0 m n in
     res, !cstrs
 
-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)
+  (m == n) || compare_head_gen (fun _ _ _ _ -> true) (fun _ _ -> true) (fun _ -> eq_constr_nounivs) 0 m n
 
 let constr_ord_int f t1 t2 =
   let (=?) f g i1 i2 j1 j2=
@@ -649,35 +864,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
@@ -761,7 +991,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 *)
@@ -972,28 +1204,6 @@ module Hcaseinfo = Hashcons.Make(CaseinfoHash)
 
 let case_info_hash = CaseinfoHash.hash
 
-module Hsorts =
-  Hashcons.Make(
-    struct
-      open Sorts
-
-      type t = Sorts.t
-      type u = universe -> universe
-      let hashcons huniv = function
-          Prop c -> Prop c
-        | Type u -> Type (huniv u)
-      let eq s1 s2 =
-        s1 == s2 ||
-	  match (s1,s2) with
-            (Prop c1, Prop c2) -> c1 == c2
-          | (Type u1, Type u2) -> u1 == u2
-          |_ -> false
-      let hash = function
-	| Prop Null -> 0 | Prop Pos -> 1
-	| Type u -> 2 + Universe.hash u
-    end)
-
-(* let hcons_sorts = Hashcons.simple_hcons Hsorts.generate hcons_univ *)
 let hcons_caseinfo = Hashcons.simple_hcons Hcaseinfo.generate Hcaseinfo.hcons hcons_ind
 
 let hcons =
@@ -1007,8 +1217,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 42d298e3..c1d1f988 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines the most important datatype of Coq, namely kernel terms,
@@ -13,20 +15,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 *)
@@ -70,7 +74,7 @@ type types = constr
 
 (** {6 Term constructors. } *)
 
-(** Constructs a DeBrujin index (DB indices begin at 1) *)
+(** Constructs a de Bruijn index (DB indices begin at 1) *)
 val mkRel : int -> constr
 
 (** Constructs a Variable *)
@@ -80,14 +84,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,14 +115,14 @@ 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 *)
-val mkProj : (projection * constr) -> constr
+val mkProj : (Projection.t * constr) -> constr
 
 (** Inductive types *)
 
@@ -180,7 +184,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 =
@@ -188,33 +192,146 @@ type ('constr, 'types) pfixpoint =
 type ('constr, 'types) pcofixpoint =
     int * ('constr, 'types) prec_declaration
 
-type ('constr, 'types) kind_of_term =
-  | Rel       of int
-  | Var       of Id.t
+type ('constr, 'types, 'sort, 'univs) kind_of_term =
+  | Rel       of int                                  (** Gallina-variable introduced by [forall], [fun], [let-in], [fix], or [cofix]. *)
+
+  | Var       of Id.t                                 (** Gallina-variable that was introduced by Vernacular-command that extends
+                                                          the local context of the currently open section
+                                                          (i.e. [Variable] or [Let]). *)
+
   | Meta      of metavariable
   | Evar      of 'constr pexistential
-  | Sort      of Sorts.t
+  | Sort      of 'sort
   | 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 puniverses
-  | Ind       of inductive puniverses
-  | Construct of constructor puniverses
+
+  | 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. *)
+  | Construct of (constructor * 'univs)              (** A constructor of an inductive type defined by [Variant], [Inductive] or [Record] Vernacular-commands. *)
   | Case      of case_info * 'constr * 'constr * 'constr array
   | Fix       of ('constr, 'types) pfixpoint
   | CoFix     of ('constr, 'types) pcofixpoint
-  | Proj      of projection * 'constr
+  | Proj      of Projection.t * 'constr
 
 (** User view of [constr]. For [App], it is ensured there is at
    least one argument and the function is not itself an applicative
    term *)
 
-val kind : constr -> (constr, types) 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.t * 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 *)
@@ -285,48 +402,73 @@ val iter : (constr -> unit) -> constr -> unit
 val iter_with_binders :
   ('a -> 'a) -> ('a -> constr -> unit) -> 'a -> constr -> unit
 
+(** [iter_with_binders g f n c] iters [f n] on the immediate
+   subterms of [c]; it carries an extra data [n] (typically a lift
+   index) which is processed by [g] (which typically add 1 to [n]) at
+   each binder traversal; it is not recursive and the order with which
+   subterms are processed is not specified *)
+
+val fold_constr_with_binders :
+  ('a -> 'a) -> ('a -> 'b -> constr -> 'b) -> 'a -> 'b -> constr -> 'b
+
+type constr_compare_fn = int -> constr -> constr -> bool
+
 (** [compare_head f c1 c2] compare [c1] and [c2] using [f] to compare
    the immediate subterms of [c1] of [c2] if needed; Cast's, binders
    name and Cases annotations are not taken into account *)
 
-val compare_head : (constr -> constr -> bool) -> constr -> constr -> bool
+val compare_head : constr_compare_fn -> constr_compare_fn
+
+(** Convert a global reference applied to 2 instances. The int says
+   how many arguments are given (as we can only use cumulativity for
+   fully applied inductives/constructors) .*)
+type instance_compare_fn = global_reference -> int ->
+  Univ.Instance.t -> Univ.Instance.t -> 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 
-   compare sorts; Cast's, binders name and Cases annotations are not taken 
-    into account *)
+(** [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, [s] to compare sorts; Cast's, binders
+   name and Cases annotations are not taken into account *)
+
+val compare_head_gen : instance_compare_fn ->
+  (Sorts.t -> Sorts.t -> bool) ->
+  constr_compare_fn ->
+  constr_compare_fn
 
-val compare_head_gen : (bool -> Univ.Instance.t -> Univ.Instance.t -> bool) ->
+val compare_head_gen_leq_with :
+  (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) ->
+  (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) ->
+  instance_compare_fn ->
   (Sorts.t -> Sorts.t -> bool) ->
-  (constr -> constr -> bool) ->
-  constr -> constr -> bool
+  constr_compare_fn ->
+  constr_compare_fn ->
+  constr_compare_fn
 
 (** [compare_head_gen_with k1 k2 u s f c1 c2] compares [c1] and [c2]
     like [compare_head_gen u s f c1 c2], except that [k1] (resp. [k2])
     is used,rather than {!kind}, to expose the immediate subterms of
     [c1] (resp. [c2]). *)
 val compare_head_gen_with :
-  (constr -> (constr,types) kind_of_term) ->
-  (constr -> (constr,types) kind_of_term) ->
-  (bool -> Univ.Instance.t -> Univ.Instance.t -> bool) ->
+  (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) ->
+  (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) ->
+  instance_compare_fn ->
   (Sorts.t -> Sorts.t -> bool) ->
-  (constr -> constr -> bool) ->
-  constr -> constr -> bool
+  constr_compare_fn ->
+  constr_compare_fn
 
 (** [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 *)
 
-val compare_head_gen_leq : (bool -> Univ.Instance.t -> Univ.Instance.t -> bool) ->
+val compare_head_gen_leq : instance_compare_fn ->
   (Sorts.t -> Sorts.t -> bool) ->
-  (constr -> constr -> bool) ->
-  (constr -> constr -> bool) ->
-  constr -> constr -> bool
-  
+  constr_compare_fn ->
+  constr_compare_fn ->
+  constr_compare_fn
+
 (** {6 Hashconsing} *)
 
 val hash : constr -> int
@@ -335,7 +477,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 4e53b73a..4f3f649c 100644
--- a/kernel/context.ml
+++ b/kernel/context.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Jean-Christophe Filliâtre out of names.ml as part of the
@@ -37,9 +39,11 @@ struct
   module Declaration =
   struct
     (* local declaration *)
-    type t =
-      | LocalAssum of Name.t * Constr.t            (** name, type *)
-      | LocalDef of Name.t * Constr.t * Constr.t   (** name, value, type *)
+    type ('constr, 'types) pt =
+      | LocalAssum of Name.t * 'types            (** name, type *)
+      | LocalDef of Name.t * 'constr * 'types   (** name, value, type *)
+
+    type t = (Constr.constr, Constr.types) pt
 
     (** Return the name bound by a given declaration. *)
     let get_name = function
@@ -87,12 +91,12 @@ struct
       | LocalDef (_, v, ty) -> f v && f ty
 
     (** Check whether the two given declarations are equal. *)
-    let equal decl1 decl2 =
+    let equal eq decl1 decl2 =
       match decl1, decl2 with
       | LocalAssum (n1,ty1), LocalAssum (n2, ty2) ->
-          Name.equal n1 n2 && Constr.equal ty1 ty2
+          Name.equal n1 n2 && eq ty1 ty2
       | LocalDef (n1,v1,ty1), LocalDef (n2,v2,ty2) ->
-          Name.equal n1 n2 && Constr.equal v1 v2 && Constr.equal ty1 ty2
+          Name.equal n1 n2 && eq v1 v2 && eq ty1 ty2
       | _ ->
           false
 
@@ -138,7 +142,7 @@ struct
       | LocalDef (_,v,ty) -> f v; f ty
 
     (** Reduce all terms in a given declaration to a single value. *)
-    let fold f decl acc =
+    let fold_constr f decl acc =
       match decl with
       | LocalAssum (n,ty) -> f ty acc
       | LocalDef (n,v,ty) -> f ty (f v acc)
@@ -147,14 +151,12 @@ struct
       | LocalAssum (na, ty) -> na, None, ty
       | LocalDef (na, v, ty) -> na, Some v, ty
 
-    let of_tuple = function
-      | n, None, ty -> LocalAssum (n,ty)
-      | n, Some v, ty -> LocalDef (n,v,ty)
   end
 
   (** Rel-context is represented as a list of declarations.
       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 *)
@@ -169,14 +171,14 @@ struct
   (** [extended_rel_list n Γ] builds an instance [args] such that [Γ,Δ ⊢ args:Γ]
       with n = |Δ| and with the local definitions of [Γ] skipped in
       [args]. Example: for [x:T,y:=c,z:U] and [n]=2, it gives [Rel 5, Rel 3]. *)
-  let nhyps =
+  let nhyps ctx =
     let open Declaration in
     let rec nhyps acc = function
       | [] -> acc
       | LocalAssum _ :: hyps -> nhyps (succ acc) hyps
       | LocalDef _ :: hyps -> nhyps acc hyps
     in
-    nhyps 0
+    nhyps 0 ctx
 
   (** Return a declaration designated by a given de Bruijn index.
       @raise Not_found if the designated de Bruijn index is not present in the designated rel-context. *)
@@ -187,7 +189,7 @@ struct
     | _, []        -> raise Not_found
 
   (** Check whether given two rel-contexts are equal. *)
-  let equal = List.equal Declaration.equal
+  let equal eq l = List.equal (fun c -> Declaration.equal eq c) l
 
   (** Map all terms in a given rel-context. *)
   let map f = List.smartmap (Declaration.map_constr f)
@@ -205,26 +207,26 @@ struct
 
   (** Map a given rel-context to a list where each {e local assumption} is mapped to [true]
       and each {e local definition} is mapped to [false]. *)
-  let to_tags =
+  let to_tags l =
     let rec aux l = function
       | [] -> l
       | Declaration.LocalDef _ :: ctx -> aux (true::l) ctx
       | Declaration.LocalAssum _ :: ctx -> aux (false::l) ctx
-    in aux []
+    in aux [] l
 
   (** [extended_list n Γ] builds an instance [args] such that [Γ,Δ ⊢ args:Γ]
       with n = |Δ| and with the {e local definitions} of [Γ] skipped in
       [args]. Example: for [x:T, y:=c, z:U] and [n]=2, it gives [Rel 5, Rel 3]. *)
-  let to_extended_list n =
+  let to_extended_list mk n l =
     let rec reln l p = function
-      | Declaration.LocalAssum _ :: hyps -> reln (Constr.mkRel (n+p) :: l) (p+1) hyps
+      | Declaration.LocalAssum _ :: hyps -> reln (mk (n+p) :: l) (p+1) hyps
       | Declaration.LocalDef _ :: hyps -> reln l (p+1) hyps
       | [] -> l
     in
-    reln [] 1
+    reln [] 1 l
 
   (** [extended_vect n Γ] does the same, returning instead an array. *)
-  let to_extended_vect n hyps = Array.of_list (to_extended_list n hyps)
+  let to_extended_vect mk n hyps = Array.of_list (to_extended_list mk n hyps)
 end
 
 (** This module represents contexts that can capture non-anonymous variables.
@@ -235,9 +237,11 @@ struct
   module Declaration =
   struct
     (** local declaration *)
-    type t =
-      | LocalAssum of Id.t * Constr.t             (** identifier, type *)
-      | LocalDef of Id.t * Constr.t * Constr.t    (** identifier, value, type *)
+    type ('constr, 'types) pt =
+      | LocalAssum of Id.t * 'types             (** identifier, type *)
+      | LocalDef of Id.t * 'constr * 'types    (** identifier, value, type *)
+
+    type t = (Constr.constr, Constr.types) pt
 
     (** Return the identifier bound by a given declaration. *)
     let get_id = function
@@ -285,12 +289,12 @@ struct
       | LocalDef (_, v, ty) -> f v && f ty
 
     (** Check whether the two given declarations are equal. *)
-    let equal decl1 decl2 =
+    let equal eq decl1 decl2 =
       match decl1, decl2 with
       | LocalAssum (id1, ty1), LocalAssum (id2, ty2) ->
-          Id.equal id1 id2 && Constr.equal ty1 ty2
+          Id.equal id1 id2 && eq ty1 ty2
       | LocalDef (id1, v1, ty1), LocalDef (id2, v2, ty2) ->
-          Id.equal id1 id2 && Constr.equal v1 v2 && Constr.equal ty1 ty2
+          Id.equal id1 id2 && eq v1 v2 && eq ty1 ty2
       | _ ->
           false
 
@@ -336,7 +340,7 @@ struct
       | LocalDef (_, v, ty) -> f v; f ty
 
     (** Reduce all terms in a given declaration to a single value. *)
-    let fold f decl a =
+    let fold_constr f decl a =
       match decl with
       | LocalAssum (_, ty) -> f ty a
       | LocalDef (_, v, ty) -> a |> f v |> f ty
@@ -348,11 +352,24 @@ struct
     let of_tuple = function
       | id, None, ty -> LocalAssum (id, ty)
       | id, Some v, ty -> LocalDef (id, v, ty)
+
+    let of_rel_decl f = function
+      | Rel.Declaration.LocalAssum (na,t) ->
+          LocalAssum (f na, t)
+      | Rel.Declaration.LocalDef (na,v,t) ->
+          LocalDef (f na, v, t)
+            
+    let to_rel_decl = function
+      | LocalAssum (id,t) ->
+          Rel.Declaration.LocalAssum (Name id, t)
+      | LocalDef (id,v,t) ->
+          Rel.Declaration.LocalDef (Name id,v,t)
   end
 
   (** Named-context is represented as a list of declarations.
       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 *)
@@ -364,14 +381,15 @@ 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
 
   (** Check whether given two named-contexts are equal. *)
-  let equal = List.equal Declaration.equal
+  let equal eq l = List.equal (fun c -> Declaration.equal eq c) l
 
   (** Map all terms in a given named-context. *)
   let map f = List.smartmap (Declaration.map_constr f)
@@ -388,36 +406,55 @@ struct
   let fold_outside f l ~init = List.fold_right f l init
 
   (** Return the set of all identifiers bound in a given named-context. *)
-  let to_vars =
-    List.fold_left (fun accu decl -> Id.Set.add (Declaration.get_id decl) accu) Id.Set.empty
+  let to_vars l =
+    List.fold_left (fun accu decl -> Id.Set.add (Declaration.get_id decl) accu) Id.Set.empty l
 
   (** [instance_from_named_context Ω] 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. *)
-  let to_instance =
+  let to_instance mk l =
     let filter = function
-      | Declaration.LocalAssum (id, _) -> Some (Constr.mkVar id)
+      | Declaration.LocalAssum (id, _) -> Some (mk id)
       | _ -> None
     in
-    List.map_filter filter
-  end
+    List.map_filter filter l
+end
 
-module NamedList =
+module Compacted =
   struct
     module Declaration =
       struct
-        type t = Id.t list * Constr.t option * Constr.t
-
-        let map_constr f (ids, copt, ty as decl) =
-          let copt' = Option.map f copt in
-          let ty' = f ty in
-          if copt == copt' && ty == ty' then decl else (ids, copt', ty')
+        type ('constr, 'types) pt =
+          | LocalAssum of Id.t list * 'types
+          | LocalDef of Id.t list * 'constr * 'types
+
+        type t = (Constr.constr, Constr.types) pt
+
+        let map_constr f = function
+          | LocalAssum (ids, ty) as decl ->
+             let ty' = f ty in
+             if ty == ty' then decl else LocalAssum (ids, ty')
+          | LocalDef (ids, c, ty) as decl ->
+             let ty' = f ty in
+             let c' = f c in
+             if c == c' && ty == ty' then decl else LocalDef (ids,c',ty')
+
+        let of_named_decl = function
+          | Named.Declaration.LocalAssum (id,t) ->
+              LocalAssum ([id],t)
+          | Named.Declaration.LocalDef (id,v,t) ->
+              LocalDef ([id],v,t)
+
+        let to_named_context = function
+          | LocalAssum (ids, t) ->
+             List.map (fun id -> Named.Declaration.LocalAssum (id,t)) ids
+          | LocalDef (ids, v, t) ->
+             List.map (fun id -> Named.Declaration.LocalDef (id,v,t)) ids
       end
 
+    type ('constr, 'types) pt = ('constr, 'types) Declaration.pt list
     type t = Declaration.t list
 
     let fold f l ~init = List.fold_right f l init
   end
-
-type section_context = Named.t
diff --git a/kernel/context.mli b/kernel/context.mli
index b5f3904d..c97db434 100644
--- a/kernel/context.mli
+++ b/kernel/context.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The modules defined below represent a {e local context}
@@ -29,111 +31,115 @@ sig
   module Declaration :
   sig
     (* local declaration *)
-    type t = LocalAssum of Name.t * Constr.t            (** name, type *)
-           | LocalDef of Name.t * Constr.t * Constr.t   (** name, value, type *)
+    type ('constr, 'types) pt =
+    | LocalAssum of Name.t * 'types            (** name, type *)
+    | LocalDef of 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 : t -> Name.t
+    val get_name : ('c, 't) pt -> Name.t
 
     (** Return [Some value] for local-declarations and [None] for local-assumptions. *)
-    val get_value : t -> Constr.t option
+    val get_value : ('c, 't) pt -> 'c option
 
     (** Return the type of the name bound by a given declaration. *)
-    val get_type : t -> Constr.t
+    val get_type : ('c, 't) pt -> 't
 
     (** Set the name that is bound by a given declaration. *)
-    val set_name : Name.t -> t -> t
+    val set_name : Name.t -> ('c, 't) pt -> ('c, 't) pt
 
     (** Set the type of the bound variable in a given declaration. *)
-    val set_type : Constr.t -> t -> t
+    val set_type : 't -> ('c, 't) pt -> ('c, 't) pt
 
     (** Return [true] iff a given declaration is a local assumption. *)
-    val is_local_assum : t -> bool
+    val is_local_assum : ('c, 't) pt -> bool
 
     (** Return [true] iff a given declaration is a local definition. *)
-    val is_local_def : t -> bool
+    val is_local_def : ('c, 't) pt -> bool
 
     (** Check whether any term in a given declaration satisfies a given predicate. *)
-    val exists : (Constr.t -> bool) -> t -> bool
+    val exists : ('c -> bool) -> ('c, 'c) pt -> bool
 
     (** Check whether all terms in a given declaration satisfy a given predicate. *)
-    val for_all : (Constr.t -> bool) -> t -> bool
+    val for_all : ('c -> bool) -> ('c, 'c) pt -> bool
 
     (** Check whether the two given declarations are equal. *)
-    val equal : t -> t -> bool
+    val equal : ('c -> 'c -> bool) -> ('c, 'c) pt -> ('c, 'c) pt -> bool
 
     (** Map the name bound by a given declaration. *)
-    val map_name : (Name.t -> Name.t) -> t -> t
+    val map_name : (Name.t -> 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 : (Constr.t -> Constr.t) -> t -> t
+    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 : (Constr.t -> Constr.t) -> t -> t
+    val map_type : ('t -> 't) -> ('c, 't) pt -> ('c, 't) pt
 
     (** Map all terms in a given declaration. *)
-    val map_constr : (Constr.t -> Constr.t) -> t -> t
+    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 : (Constr.t -> unit) -> t -> unit
+    val iter_constr : ('c -> unit) -> ('c, 'c) pt -> unit
 
     (** Reduce all terms in a given declaration to a single value. *)
-    val fold : (Constr.t -> 'a -> 'a) -> t -> 'a -> 'a
+    val fold_constr : ('c -> 'a -> 'a) -> ('c, 'c) pt -> 'a -> 'a
 
-    val to_tuple : t -> Name.t * Constr.t option * Constr.t
-    val of_tuple : Name.t * Constr.t option * Constr.t -> t
+    val to_tuple : ('c, 't) pt -> Name.t * 'c option * 't
   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 : t
+  val empty : ('c, 't) pt
 
   (** Return a new rel-context enriched by with a given inner-most declaration. *)
-  val add : Declaration.t -> t -> t
+  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 : t -> int
+  val length : ('c, 't) pt -> int
 
   (** Check whether given two rel-contexts are equal. *)
-  val equal : t -> t -> bool
+  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 : t -> int
+  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 -> t -> Declaration.t
+  val lookup : int -> ('c, 't) pt -> ('c, 't) Declaration.pt
 
   (** Map all terms in a given rel-context. *)
-  val map : (Constr.t -> Constr.t) -> t -> t
+  val map : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt
 
   (** Perform a given action on every declaration in a given rel-context. *)
-  val iter : (Constr.t -> unit) -> t -> unit
+  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 -> Declaration.t -> 'a) -> init:'a -> t -> 'a
+  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 : (Declaration.t -> 'a -> 'a) -> t -> init:'a -> 'a
+  val fold_outside : (('c, 't) Declaration.pt -> 'a -> 'a) -> ('c, 't) pt -> init:'a -> 'a
 
   (** Map a given rel-context to a list where each {e local assumption} is mapped to [true]
       and each {e local definition} is mapped to [false]. *)
-  val to_tags : t -> bool list
+  val to_tags : ('c, 't) pt -> bool list
 
-  (** [extended_list n Γ] builds an instance [args] such that [Γ,Δ ⊢ args:Γ]
+  (** [extended_list mk n Γ] builds an instance [args] such that [Γ,Δ ⊢ args:Γ]
       with n = |Δ| and with the {e local definitions} of [Γ] skipped in
-      [args]. Example: for [x:T, y:=c, z:U] and [n]=2, it gives [Rel 5, Rel 3]. *)
-  val to_extended_list : int -> t -> Constr.t list
+      [args] where [mk] is used to build the corresponding variables.
+      Example: for [x:T, y:=c, z:U] and [n]=2, it gives [mk 5, mk 3]. *)
+  val to_extended_list : (int -> 'r) -> int -> ('c, 't) pt -> 'r list
 
   (** [extended_vect n Γ] does the same, returning instead an array. *)
-  val to_extended_vect : int -> t -> Constr.t array
+  val to_extended_vect : (int -> 'r) -> int -> ('c, 't) pt -> 'r array
 end
 
 (** This module represents contexts that can capture non-anonymous variables.
@@ -143,118 +149,136 @@ sig
   (** Representation of {e local declarations}. *)
   module Declaration :
   sig
-    type t = LocalAssum of Id.t * Constr.t            (** identifier, type *)
-           | LocalDef of Id.t * Constr.t * Constr.t   (** identifier, value, type *)
+    type ('constr, 'types) pt =
+      | LocalAssum of Id.t * 'types             (** identifier, type *)
+      | LocalDef of 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 : t -> Id.t
+    val get_id : ('c, 't) pt -> Id.t
 
     (** Return [Some value] for local-declarations and [None] for local-assumptions. *)
-    val get_value : t -> Constr.t option
+    val get_value : ('c, 't) pt -> 'c option
 
     (** Return the type of the name bound by a given declaration. *)
-    val get_type : t -> Constr.t
+    val get_type : ('c, 't) pt -> 't
 
     (** Set the identifier that is bound by a given declaration. *)
-    val set_id : Id.t -> t -> t
+    val set_id : Id.t -> ('c, 't) pt -> ('c, 't) pt
 
     (** Set the type of the bound variable in a given declaration. *)
-    val set_type : Constr.t -> t -> t
+    val set_type : 't -> ('c, 't) pt -> ('c, 't) pt
 
     (** Return [true] iff a given declaration is a local assumption. *)
-    val is_local_assum : t -> bool
+    val is_local_assum : ('c, 't) pt -> bool
 
     (** Return [true] iff a given declaration is a local definition. *)
-    val is_local_def : t -> bool
+    val is_local_def : ('c, 't) pt -> bool
 
     (** Check whether any term in a given declaration satisfies a given predicate. *)
-    val exists : (Constr.t -> bool) -> t -> bool
+    val exists : ('c -> bool) -> ('c, 'c) pt -> bool
 
     (** Check whether all terms in a given declaration satisfy a given predicate. *)
-    val for_all : (Constr.t -> bool) -> t -> bool
+    val for_all : ('c -> bool) -> ('c, 'c) pt -> bool
 
     (** Check whether the two given declarations are equal. *)
-    val equal : t -> t -> bool
+    val equal : ('c -> 'c -> bool) -> ('c, 'c) pt -> ('c, 'c) pt -> bool
 
     (** Map the identifier bound by a given declaration. *)
-    val map_id : (Id.t -> Id.t) -> t -> t
+    val map_id : (Id.t -> 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 : (Constr.t -> Constr.t) -> t -> t
+    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 : (Constr.t -> Constr.t) -> t -> t
+    val map_type : ('t -> 't) -> ('c, 't) pt -> ('c, 't) pt
 
     (** Map all terms in a given declaration. *)
-    val map_constr : (Constr.t -> Constr.t) -> t -> t
+    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 : (Constr.t -> unit) -> t -> unit
+    val iter_constr : ('c -> unit) -> ('c, 'c) pt -> unit
 
     (** Reduce all terms in a given declaration to a single value. *)
-    val fold : (Constr.t -> 'a -> 'a) -> t -> 'a -> 'a
+    val fold_constr : ('c -> 'a -> 'a) -> ('c, 'c) pt -> 'a -> 'a
+
+    val to_tuple : ('c, 't) pt -> Id.t * 'c option * 't
+    val of_tuple : Id.t * 'c option * 't -> ('c, 't) pt
 
-    val to_tuple : t -> Id.t * Constr.t option * Constr.t
-    val of_tuple : Id.t * Constr.t option * Constr.t -> t
+    (** Convert [Rel.Declaration.t] value to the corresponding [Named.Declaration.t] value.
+        The function provided as the first parameter determines how to translate "names" to "ids". *)
+    val of_rel_decl : (Name.t -> Id.t) -> ('c, 't) Rel.Declaration.pt -> ('c, 't) pt
+
+    (** Convert [Named.Declaration.t] value to the corresponding [Rel.Declaration.t] value. *)
+    (* TODO: Move this function to [Rel.Declaration] module and rename it to [of_named]. *)
+    val to_rel_decl : ('c, 't) pt -> ('c, 't) Rel.Declaration.pt
   end
 
-  (** Rel-context is represented as a list of declarations.
+  (** 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 : t
+  val empty : ('c, 't) pt
 
-  (** Return a new rel-context enriched by with a given inner-most declaration. *)
-  val add : Declaration.t -> t -> t
+  (** 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 : t -> int
+  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 : Id.t -> t -> Declaration.t
+  val lookup : Id.t -> ('c, 't) pt -> ('c, 't) Declaration.pt
 
-  (** Check whether given two rel-contexts are equal. *)
-  val equal : t -> t -> bool
+  (** 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 : (Constr.t -> Constr.t) -> t -> t
+  val map : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt
 
   (** Perform a given action on every declaration in a given named-context. *)
-  val iter : (Constr.t -> unit) -> t -> unit
+  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 -> Declaration.t -> 'a) -> init:'a -> t -> 'a
+  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 : (Declaration.t -> 'a -> 'a) -> t -> init:'a -> 'a
+  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 : t -> Id.Set.t
+  val to_vars : ('c, 't) pt -> Id.Set.t
 
-  (** [instance_from_named_context Ω] builds an instance [args] such
-      that [Ω ⊢ args:Ω] where [Ω] is a named context and with the local
+  (** [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 : t -> Constr.t list
+  val to_instance : (Id.t -> 'r) -> ('c, 't) pt -> 'r list
 end
 
-module NamedList :
+module Compacted :
 sig
   module Declaration :
   sig
-    type t = Id.t list * Constr.t option * Constr.t
-    val map_constr : (Constr.t -> Constr.t) -> t -> t
+    type ('constr, 'types) pt =
+      | LocalAssum of Id.t list * 'types
+      | LocalDef of Id.t list * 'constr * 'types
+
+    type t = (Constr.constr, Constr.types) pt
+
+    val map_constr : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt
+    val of_named_decl : ('c, 't) Named.Declaration.pt -> ('c, 't) pt
+    val to_named_context : ('c, 't) pt -> ('c, 't) Named.pt
   end
 
+  type ('constr, 'types) pt = ('constr, 'types) Declaration.pt list
   type t = Declaration.t list
 
-  val fold : (Declaration.t -> 'a -> 'a) -> t -> init:'a -> 'a
+  val fold : (('c, 't) Declaration.pt -> 'a -> 'a) -> ('c, 't) pt -> init:'a -> 'a
 end
-
-type section_context = Named.t
diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml
index 3f1cf924..7ef63c18 100644
--- a/kernel/conv_oracle.ml
+++ b/kernel/conv_oracle.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Bruno Barras as part of the rewriting of the conversion
@@ -71,7 +73,7 @@ let set_strategy ({ var_opacity; cst_opacity } as oracle) k l =
     | _ -> Cpred.add c oracle.cst_trstate
     in
     { oracle with cst_opacity; cst_trstate; }
-  | RelKey _ -> CErrors.error "set_strategy: RelKey"
+  | RelKey _ -> CErrors.user_err Pp.(str "set_strategy: RelKey")
 
 let fold_strategy f { var_opacity; cst_opacity; } accu =
   let fvar id lvl accu = f (VarKey id) lvl accu in
diff --git a/kernel/conv_oracle.mli b/kernel/conv_oracle.mli
index 70f02b54..67add5dd 100644
--- a/kernel/conv_oracle.mli
+++ b/kernel/conv_oracle.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -16,7 +18,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 +32,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 13459915..6f4541e9 100644
--- a/kernel/cooking.ml
+++ b/kernel/cooking.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Jean-Christophe Filliâtre out of V6.3 file constants.ml
@@ -17,26 +19,28 @@ open CErrors
 open Util
 open Names
 open Term
+open Constr
 open Declarations
-open Environ
 open Univ
 
+module NamedDecl = Context.Named.Declaration
+
 (*s Cooking the constants. *)
 
 let pop_dirpath p = match DirPath.repr p with
-  | [] -> anomaly ~label:"dirpath_prefix" (Pp.str "empty dirpath")
+  | [] -> anomaly ~label:"dirpath_prefix" (Pp.str "empty dirpath.")
   | _::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
 
@@ -99,42 +103,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
@@ -149,10 +153,14 @@ let abstract_constant_body =
 type recipe = { from : constant_body; info : Opaqueproof.cooking_info }
 type inline = bool
 
-type result =
-  constant_def * constant_type * projection_body option * 
-    bool * constant_universes * inline
-    * Context.section_context option
+type result = {
+  cook_body : constant_def;
+  cook_type : types;
+  cook_proj : projection_body option;
+  cook_universes : constant_universes;
+  cook_inline : inline;
+  cook_context : Context.Named.t option;
+}
 
 let on_body ml hy f = function
   | Undef _ as x -> x
@@ -161,62 +169,64 @@ let on_body ml hy f = function
     OpaqueDef (Opaqueproof.discharge_direct_opaque ~cook_constr:f
                  { Opaqueproof.modlist = ml; abstract = hy } o)
 
-let constr_of_def otab = function
-  | Undef _ -> assert false
-  | Def cs -> Mod_subst.force_constr cs
-  | OpaqueDef lc -> Opaqueproof.force_proof otab lc
-
 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 =
-  if cb.const_polymorphic && not (Univ.LMap.is_empty subst) then
-    let inst = Univ.UContext.instance cb.const_universes in
-    let cstrs = Univ.UContext.constraints cb.const_universes in
-    let len = Univ.LMap.cardinal subst in
-    let subst = 
-      Array.fold_left_i (fun i acc v -> Univ.LMap.add (Level.var i) (Level.var (i + len)) acc)
-	subst (Univ.Instance.to_array inst)
-    in
-    let cstrs' = Univ.subst_univs_level_constraints subst cstrs in
-      subst, Univ.UContext.make (inst,cstrs')
-  else subst, cb.const_universes
-
-let cook_constant env { from = cb; info } =
+let lift_univs cb subst auctx0 =
+  match cb.const_universes with
+  | 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 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 Constr.hcons c else c
+  in
   let body = on_body modlist (hyps, usubst, abs_ctx)
-    (fun c -> abstract_constant_body (expmod c) hyps)
+    map
     cb.const_body
   in
   let const_hyps =
     Context.Named.fold_outside (fun decl hyps ->
-      let open Context.Named.Declaration in
-      List.filter (fun decl' -> not (Id.equal (get_id decl) (get_id decl')))
+      List.filter (fun decl' -> not (Id.equal (NamedDecl.get_id decl) (NamedDecl.get_id decl')))
 		  hyps)
       hyps ~init:cb.const_hyps in
-  let typ = match cb.const_type with
-    | RegularArity t ->
-  	let typ =
-          abstract_constant_type (expmod t) hyps in
-  	RegularArity typ
-    | TemplateArity (ctx,s) ->
-  	let t = mkArity (ctx,Type s.template_level) in
-  	let typ = abstract_constant_type (expmod t) hyps in
-  	let j = make_judge (constr_of_def (opaque_tables env) body) typ in
-  	Typeops.make_polymorphic_if_constant_for_ind env j
-  in
+  let typ = abstract_constant_type (expmod cb.const_type) hyps in
   let projection pb =
     let c' = abstract_constant_body (expmod pb.proj_body) hyps in
     let etab = abstract_constant_body (expmod (fst pb.proj_eta)) hyps in
@@ -224,32 +234,27 @@ let cook_constant 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 
       with Not_found -> (((pb.proj_ind,0),Univ.Instance.empty), 0)
     in 
-    let typ = (* By invariant, a regular arity *)
-      match typ with RegularArity t -> t | TemplateArity _ -> assert false 
-    in
     let ctx, ty' = decompose_prod_n (n' + pb.proj_npars + 1) typ in
       { proj_ind = mind; proj_npars = pb.proj_npars + n'; proj_arg = pb.proj_arg;
 	proj_eta = etab, etat;
 	proj_type = ty'; proj_body = c' }
   in
-  let univs = 
-    let abs' = 
-      if cb.const_polymorphic then abs_ctx
-      else instantiate_univ_context abs_ctx
-    in
-      UContext.union abs' univs
-  in
-    (body, typ, Option.map projection cb.const_proj, 
-     cb.const_polymorphic, univs, cb.const_inline_code, 
-     Some const_hyps)
-
-(* let cook_constant_key = Profile.declare_profile "cook_constant" *)
-(* let cook_constant = Profile.profile2 cook_constant_key cook_constant *)
+  {
+    cook_body = body;
+    cook_type = typ;
+    cook_proj = Option.map projection cb.const_proj;
+    cook_universes = univs;
+    cook_inline = cb.const_inline_code;
+    cook_context = Some const_hyps;
+  }
+
+(* 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 327e697d..7bd0ae56 100644
--- a/kernel/cooking.mli
+++ b/kernel/cooking.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Constr
 open Declarations
 open Environ
 
@@ -16,13 +18,17 @@ type recipe = { from : constant_body; info : Opaqueproof.cooking_info }
 
 type inline = bool
 
-type result =
-  constant_def * constant_type * projection_body option * 
-    bool * constant_universes * inline
-    * Context.section_context option
-
-val cook_constant : env -> recipe -> result
-val cook_constr : Opaqueproof.cooking_info -> Term.constr -> Term.constr
+type result = {
+  cook_body : constant_def;
+  cook_type : types;
+  cook_proj : projection_body option;
+  cook_universes : constant_universes;
+  cook_inline : inline;
+  cook_context : Context.Named.t option;
+}
+
+val cook_constant : hcons:bool -> env -> recipe -> result
+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 c27cb048..01294895 100644
--- a/kernel/csymtable.ml
+++ b/kernel/csymtable.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Bruno Barras for Benjamin Grégoire as part of the
@@ -14,16 +16,16 @@
 
 open Util
 open Names
-open Term
-open Vm
+open Vmvalues
 open Cemitcodes
 open Cbytecodes
 open Declarations
 open Pre_env
 open Cbytegen
 
+module NamedDecl = Context.Named.Declaration
+module RelDecl = Context.Rel.Declaration
 
-external tcode_of_code : emitcodes -> int -> tcode = "coq_tcode_of_code"
 external eval_tcode : tcode -> values array -> values = "coq_eval_tcode"
 
 (*******************)
@@ -54,61 +56,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
@@ -189,37 +142,32 @@ and slot_for_fv env fv =
       let nv = Pre_env.lookup_named_val id env in
       begin match force_lazy_val nv with
       | None ->
-         let open Context.Named in
-         let open Declaration in
-	 env |> Pre_env.lookup_named id |> get_value |> fill_fv_cache nv id val_of_named idfun
+	 env |> Pre_env.lookup_named id |> NamedDecl.get_value |> fill_fv_cache nv id val_of_named idfun
       | Some (v, _) -> v
       end
   | FVrel i ->
       let rv = Pre_env.lookup_rel_val i env in
       begin match force_lazy_val rv with
       | None ->
-         let open Context.Rel in
-         let open Declaration in
-	 env.env_rel_context |> lookup i |> get_value |> fill_fv_cache rv i val_of_rel env_of_rel
+        env |> Pre_env.lookup_rel i |> RelDecl.get_value |> fill_fv_cache rv i val_of_rel env_of_rel
       | Some (v, _) -> v
       end
+  | FVevar evk -> val_of_evar evk
   | 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 cd561148..19b2b8b5 100644
--- a/kernel/csymtable.mli
+++ b/kernel/csymtable.mli
@@ -1,18 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* $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.mli b/kernel/declarations.ml
index f89773fc..b7427d20 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.ml
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 
 (** This module defines the internal representation of global
    declarations. This includes global constants/axioms, mutual
@@ -28,16 +30,14 @@ 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 = 
   | RegularArity of 'a
   | TemplateArity of 'b
 
-type constant_type = (types, Context.Rel.t * template_arity) declaration_arity
-
 (** Inlining level of parameters at functor applications.
     None means no inlining *)
 
@@ -50,7 +50,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 *)
@@ -58,12 +58,15 @@ type projection_body = {
   proj_body : constr; (* For compatibility with VMs only, the match version *)
 }
 
+(* Global declarations (i.e. constants) can be either: *)
 type constant_def =
-  | Undef of inline
-  | Def of constr Mod_subst.substituted
-  | OpaqueDef of Opaqueproof.opaque
+  | Undef of inline                       (** a global assumption *)
+  | Def of constr Mod_subst.substituted   (** or a transparent global definition *)
+  | OpaqueDef of Opaqueproof.opaque       (** or an opaque global definition *)
 
-type constant_universes = Univ.universe_context
+type constant_universes =
+  | 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
@@ -73,16 +76,16 @@ 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
- * the OpaueDef *)
+ * the OpaqueDef *)
 type constant_body = {
-    const_hyps : Context.section_context; (** New: younger hyp at top *)
+    const_hyps : Context.Named.t; (** New: younger hyp at top *)
     const_body : constant_def;
-    const_type : constant_type;
+    const_type : types;
     const_body_code : Cemitcodes.to_patch_substituted option;
-    const_polymorphic : bool; (** Is it polymorphic or not *)
     const_universes : constant_universes;
     const_proj : projection_body option;
     const_inline_code : bool;
@@ -115,11 +118,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 +149,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 *)
 
@@ -167,17 +170,27 @@ type one_inductive_body = {
     mind_reloc_tbl :  Cbytecodes.reloc_table;
   }
 
+type abstract_inductive_universes =
+  | 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 = {
 
     mind_packets : one_inductive_body array;  (** The component of the mutual inductive block *)
 
     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 *)
 
-    mind_hyps : Context.section_context;  (** Section hypotheses on which the block depends *)
+    mind_hyps : Context.Named.t;  (** Section hypotheses on which the block depends *)
 
     mind_nparams : int;  (** Number of expected parameters including non-uniform ones (i.e. length of mind_params_ctxt w/o let-in) *)
 
@@ -185,9 +198,7 @@ type mutual_inductive_body = {
 
     mind_params_ctxt : Context.Rel.t;  (** The context of parameters (includes let-in declaration) *)
 
-    mind_polymorphic : bool; (** Is it polymorphic or not *)
-
-    mind_universes : Univ.universe_context; (** Local universe variables and constraints *)
+    mind_universes : abstract_inductive_universes; (** Information about monomorphic/polymorphic/cumulative inductives and their universes *)
 
     mind_private : bool option; (** allow pattern-matching: Some true ok, Some false blocked *)
 
@@ -209,12 +220,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 *)
@@ -247,16 +258,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]
@@ -266,13 +277,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 :
 
@@ -281,5 +298,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 211e5e06..3652a1ce 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -1,22 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Declarations
 open Mod_subst
 open Util
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 
 (** Operations concernings types in [Declarations] :
     [constant_body], [mutual_inductive_body], [module_body] ... *)
 
-let safe_flags = {
+let safe_flags oracle = {
   check_guarded = true;
   check_universes = true;
+  conv_oracle = oracle;
 }
 
 (** {6 Arities } *)
@@ -43,50 +47,20 @@ let hcons_template_arity ar =
 
 (** {6 Constants } *)
 
-let instantiate cb c =
-  if cb.const_polymorphic then 
-    Vars.subst_instance_constr (Univ.UContext.instance cb.const_universes) c
-  else c
-
-let body_of_constant otab cb = match cb.const_body with
-  | Undef _ -> None
-  | Def c -> Some (instantiate cb (force_constr c))
-  | OpaqueDef o -> Some (instantiate cb (Opaqueproof.force_proof otab o))
-
-let type_of_constant cb =
-  match cb.const_type with
-  | RegularArity t as x -> 
-    let t' = instantiate cb t in
-      if t' == t then x else RegularArity t'
-  | TemplateArity _ as x -> x
-
-let constraints_of_constant otab cb = Univ.Constraint.union 
-  (Univ.UContext.constraints cb.const_universes)
-  (match cb.const_body with
-  | Undef _ -> Univ.empty_constraint
-  | Def c -> Univ.empty_constraint
-  | OpaqueDef o ->
-      Univ.ContextSet.constraints (Opaqueproof.force_constraints otab o))
-
-let universes_of_constant otab cb = 
-  match cb.const_body with
-  | Undef _ | Def _ -> cb.const_universes
-  | OpaqueDef o -> 
-      let body_uctxs = Opaqueproof.force_constraints otab o in
-      assert(not cb.const_polymorphic || Univ.ContextSet.is_empty body_uctxs);
-      let uctxs = Univ.ContextSet.of_context cb.const_universes in
-      Univ.ContextSet.to_context (Univ.ContextSet.union body_uctxs uctxs) 
-
-let universes_of_polymorphic_constant otab cb = 
-  if cb.const_polymorphic then 
-    let univs = universes_of_constant otab cb in
-      Univ.instantiate_univ_context univs
-  else Univ.UContext.empty
+let constant_is_polymorphic cb =
+  match cb.const_universes with
+  | Monomorphic_const _ -> false
+  | Polymorphic_const _ -> true
 
 let constant_has_body cb = match cb.const_body with
   | Undef _ -> false
   | Def _ | OpaqueDef _ -> true
 
+let constant_polymorphic_context cb =
+  match cb.const_universes with
+  | Monomorphic_const _ -> Univ.AUContext.empty
+  | Polymorphic_const ctx -> ctx
+
 let is_opaque cb = match cb.const_body with
   | OpaqueDef _ -> true
   | Undef _ | Def _ -> false
@@ -94,14 +68,10 @@ let is_opaque cb = match cb.const_body with
 (** {7 Constant substitutions } *)
 
 let subst_rel_declaration sub =
-  map_constr (subst_mps sub)
+  RelDecl.map_constr (subst_mps sub)
 
 let subst_rel_context sub = List.smartmap (subst_rel_declaration sub)
 
-let subst_template_cst_arity sub (ctx,s as arity) =
-  let ctx' = subst_rel_context sub ctx in
-    if ctx==ctx' then arity else (ctx',s)
-      
 let subst_const_type sub arity =
   if is_empty_subst sub then arity
   else subst_mps sub arity
@@ -123,7 +93,7 @@ let subst_const_body sub cb =
   if is_empty_subst sub then cb
   else
     let body' = subst_const_def sub cb.const_body in
-    let type' = subst_decl_arity subst_const_type subst_template_cst_arity sub cb.const_type in
+    let type' = subst_const_type sub cb.const_type in
     let proj' = Option.smartmap (subst_const_proj sub) cb.const_proj in
     if body' == cb.const_body && type' == cb.const_type
       && proj' == cb.const_proj then cb
@@ -134,7 +104,6 @@ let subst_const_body sub cb =
         const_proj = proj';
         const_body_code =
           Option.map (Cemitcodes.subst_to_patch_subst sub) cb.const_body_code;
-        const_polymorphic = cb.const_polymorphic;
         const_universes = cb.const_universes;
         const_inline_code = cb.const_inline_code;
         const_typing_flags = cb.const_typing_flags }
@@ -146,30 +115,29 @@ let subst_const_body sub cb =
     themselves. But would it really bring substantial gains ? *)
 
 let hcons_rel_decl =
-  map_type Term.hcons_types % map_value Term.hcons_constr % map_name Names.Name.hcons
+  RelDecl.map_name Names.Name.hcons %> RelDecl.map_value Constr.hcons %> RelDecl.map_type Constr.hcons
 
 let hcons_rel_context l = List.smartmap hcons_rel_decl l
 
-let hcons_regular_const_arity t = Term.hcons_constr t
-
-let hcons_template_const_arity (ctx, ar) = 
-  (hcons_rel_context ctx, hcons_template_arity ar)
-
-let hcons_const_type = 
-  map_decl_arity hcons_regular_const_arity hcons_template_const_arity
-
 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_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 = hcons_const_type cb.const_type;
-    const_universes = Univ.hcons_universe_context cb.const_universes }
+    const_type = Constr.hcons cb.const_type;
+    const_universes = hcons_const_universes cb.const_universes }
 
 (** {6 Inductive types } *)
 
@@ -258,27 +226,34 @@ let subst_mind_body sub mib =
     mind_params_ctxt =
       Context.Rel.map (subst_mps sub) mib.mind_params_ctxt;
     mind_packets = Array.smartmap (subst_mind_packet sub) mib.mind_packets ;
-    mind_polymorphic = mib.mind_polymorphic;
     mind_universes = mib.mind_universes;
     mind_private = mib.mind_private;
     mind_typing_flags = mib.mind_typing_flags;
   }
 
-let inductive_instance mib =
-  if mib.mind_polymorphic then
-    Univ.UContext.instance mib.mind_universes
-  else Univ.Instance.empty
+let inductive_polymorphic_context mib =
+  match mib.mind_universes with
+  | Monomorphic_ind _ -> Univ.AUContext.empty
+  | Polymorphic_ind ctx -> ctx
+  | Cumulative_ind cumi -> Univ.ACumulativityInfo.univ_context cumi
+
+let inductive_is_polymorphic mib =
+  match mib.mind_universes with
+  | Monomorphic_ind _ -> false
+  | Polymorphic_ind ctx -> true
+  | Cumulative_ind cumi -> true
 
-let inductive_context mib =
-  if mib.mind_polymorphic then 
-    Univ.instantiate_univ_context mib.mind_universes 
-  else Univ.UContext.empty
+let inductive_is_cumulative mib =
+  match mib.mind_universes with
+  | Monomorphic_ind _ -> false
+  | Polymorphic_ind ctx -> false
+  | Cumulative_ind cumi -> true
 
 (** {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 *)
 
@@ -288,8 +263,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
@@ -300,18 +275,24 @@ let hcons_mind_packet oib =
     mind_user_lc = user;
     mind_nf_lc = nf }
 
+let hcons_mind_universes miu =
+  match miu with
+  | 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)
+
 let hcons_mind mib =
   { mib with
     mind_packets = Array.smartmap hcons_mind_packet mib.mind_packets;
     mind_params_ctxt = hcons_rel_context mib.mind_params_ctxt;
-    mind_universes = Univ.hcons_universe_context mib.mind_universes }
+    mind_universes = hcons_mind_universes mib.mind_universes }
 
 (** {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 *)
 
@@ -340,7 +321,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 =
@@ -353,10 +334,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
@@ -368,9 +349,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
@@ -395,3 +378,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 6650b6b7..fb46112e 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Declarations
@@ -27,23 +29,14 @@ val subst_const_body : substitution -> constant_body -> constant_body
 
 val constant_has_body : constant_body -> bool
 
-(** Accessing const_body, forcing access to opaque proof term if needed.
-    Only use this function if you know what you're doing. *)
+val constant_polymorphic_context : constant_body -> AUContext.t
 
-val body_of_constant :
-  Opaqueproof.opaquetab -> constant_body -> Term.constr option
-val type_of_constant : constant_body -> constant_type
-val constraints_of_constant :
-  Opaqueproof.opaquetab -> constant_body -> Univ.constraints
-val universes_of_constant :
-  Opaqueproof.opaquetab -> constant_body -> Univ.universe_context
+(** Is the constant polymorphic? *)
+val constant_is_polymorphic : constant_body -> bool
 
 (** Return the universe context, in case the definition is polymorphic, otherwise
     the context is empty. *)
 
-val universes_of_polymorphic_constant :
-  Opaqueproof.opaquetab -> constant_body -> Univ.universe_context
-
 val is_opaque : constant_body -> bool
 
 (** Side effects *)
@@ -66,13 +59,17 @@ val subst_wf_paths : substitution -> wf_paths -> wf_paths
 
 val subst_mind_body : substitution -> mutual_inductive_body -> mutual_inductive_body
 
-val inductive_instance : mutual_inductive_body -> universe_instance
-val inductive_context : mutual_inductive_body -> universe_context
+val inductive_polymorphic_context : mutual_inductive_body -> AUContext.t
+
+(** Is the inductive polymorphic? *)
+val inductive_is_polymorphic : mutual_inductive_body -> bool
+(** Is the inductive cumulative? *)
+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} *)
 
@@ -83,3 +80,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/doc.tex b/kernel/doc.tex
deleted file mode 100644
index 4a9fc355..00000000
--- a/kernel/doc.tex
+++ /dev/null
@@ -1,11 +0,0 @@
-
-\newpage
-\section*{The Coq kernel}
-
-\ocwsection \label{kernel}
-This chapter describes the \Coq\ kernel, which is a type checker for the \CCI.
-The modules of the kernel are organized as follows.
-
-\bigskip
-\begin{center}\epsfig{file=kernel.dep.ps,width=\linewidth}\end{center}
-
diff --git a/kernel/entries.mli b/kernel/entries.ml
index ea7c266b..94da00c7 100644
--- a/kernel/entries.mli
+++ b/kernel/entries.ml
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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
@@ -34,6 +36,11 @@ then, in i{^ th} block, [mind_entry_params] is [xn:Xn;...;x1:X1];
 [mind_entry_lc] is [Ti1;...;Tini], defined in context [[A'1;...;A'p;x1:X1;...;xn:Xn]] where [A'i] is [Ai] generalized over [[x1:X1;...;xn:Xn]].
 *)
 
+type inductive_universes =
+  | 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;
   mind_entry_arity : constr;
@@ -46,11 +53,12 @@ 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_polymorphic : bool; 
-  mind_entry_universes : Univ.universe_context;
+  mind_entry_universes : inductive_universes;
+  (* universe constraints and the constraints for subtyping of
+     inductive types in the block. *)
   mind_entry_private : bool option;
 }
 
@@ -58,25 +66,37 @@ type mutual_inductive_entry = {
 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.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;
   (* List of section variables *)
-  const_entry_secctx : Context.section_context option;
+  const_entry_secctx : Context.Named.t option;
   (* State id on which the completion of type checking is reported *)
   const_entry_feedback : Stateid.t option;
   const_entry_type        : types option;
-  const_entry_polymorphic : bool;
-  const_entry_universes   : Univ.universe_context;
+  const_entry_universes   : constant_universes_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.section_context 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 =
@@ -103,15 +123,13 @@ 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;
   eff      : side_eff;
 }
-
-type side_effects = side_effect list
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 16ddfac6..89ba6f65 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Author: Jean-Christophe Filliâtre as part of the rebuilding of Coq
@@ -23,7 +25,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open Declarations
 open Pre_env
@@ -37,8 +39,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 +62,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 +89,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 +103,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 *)
@@ -120,7 +124,7 @@ let lookup_named = lookup_named
 let lookup_named_val id ctxt = fst (Id.Map.find id ctxt.env_named_map)
 
 let eq_named_context_val c1 c2 =
-   c1 == c2 || Context.Named.equal (named_context_of_val c1) (named_context_of_val c2)
+   c1 == c2 || Context.Named.equal Constr.equal (named_context_of_val c1) (named_context_of_val c2)
 
 (* A local const is evaluable if it is defined  *)
 
@@ -140,16 +144,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 =
@@ -185,8 +194,7 @@ let push_constraints_to_env (_,univs) env =
 
 let add_universes strict ctx g =
   let g = Array.fold_left
-	    (* Be lenient, module typing reintroduces universes and constraints due to includes *)
-	    (fun g v -> try UGraph.add_universe v strict g with UGraph.AlreadyDeclared -> g)
+            (fun g v -> UGraph.add_universe v strict g)
 	    g (Univ.Instance.to_array (Univ.UContext.instance ctx))
   in
     UGraph.merge_constraints (Univ.UContext.constraints ctx) g
@@ -196,6 +204,7 @@ let push_context ?(strict=false) ctx env =
 
 let add_universes_set strict ctx g =
   let g = Univ.LSet.fold
+            (* Be lenient, module typing reintroduces universes and constraints due to includes *)
 	    (fun v g -> try UGraph.add_universe v strict g with UGraph.AlreadyDeclared -> g)
 	    (Univ.ContextSet.levels ctx) g
   in UGraph.merge_constraints (Univ.ContextSet.constraints ctx) g
@@ -228,59 +237,39 @@ let add_constant kn cb env =
   add_constant_key kn cb no_link_info env
 
 let constraints_of cb u =
-  let univs = cb.const_universes in
-    Univ.subst_instance_constraints u (Univ.UContext.constraints univs)
-
-let map_regular_arity f = function
-  | RegularArity a as ar -> 
-    let a' = f a in 
-      if a' == a then ar else RegularArity a'
-  | TemplateArity _ -> assert false
+  match cb.const_universes with
+  | Monomorphic_const _ -> Univ.Constraint.empty
+  | Polymorphic_const ctx -> Univ.AUContext.instantiate u ctx
 
 (* constant_type gives the type of a constant *)
 let constant_type env (kn,u) =
   let cb = lookup_constant kn env in
-    if cb.const_polymorphic then
-      let csts = constraints_of cb u in
-	(map_regular_arity (subst_instance_constr u) cb.const_type, csts)
-    else cb.const_type, Univ.Constraint.empty
+  match cb.const_universes with
+  | Monomorphic_const _ -> cb.const_type, Univ.Constraint.empty
+  | Polymorphic_const ctx -> 
+    let csts = constraints_of cb u in
+    (subst_instance_constr u cb.const_type, csts)
 
 let constant_context env kn =
   let cb = lookup_constant kn env in
-    if cb.const_polymorphic then cb.const_universes
-    else Univ.UContext.empty
+  match cb.const_universes with
+  | 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 -> 
-	if cb.const_polymorphic then
-	  let csts = constraints_of cb u in
-	    (subst_instance_constr u (Mod_subst.force_constr l_body), csts)
-	else Mod_subst.force_constr l_body, Univ.Constraint.empty
-      | 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 cb.const_polymorphic then
+    if Declareops.constant_is_polymorphic cb then
       let cst = constraints_of cb u in
       let b' = match cb.const_body with
 	| Def l_body -> Some (subst_instance_constr u (Mod_subst.force_constr l_body))
 	| OpaqueDef _ -> None
 	| Undef _ -> None
       in
-	b', map_regular_arity (subst_instance_constr u) cb.const_type, cst
+	b', subst_instance_constr u cb.const_type, cst
     else 
       let b' = match cb.const_body with
 	| Def l_body -> Some (Mod_subst.force_constr l_body)
@@ -295,8 +284,8 @@ let constant_value_and_type env (kn, u) =
 (* constant_type gives the type of a constant *)
 let constant_type_in env (kn,u) =
   let cb = lookup_constant kn env in
-    if cb.const_polymorphic then
-      map_regular_arity (subst_instance_constr u) cb.const_type
+    if Declareops.constant_is_polymorphic cb then
+      subst_instance_constr u cb.const_type
     else cb.const_type
 
 let constant_value_in env (kn,u) =
@@ -321,7 +310,7 @@ let evaluable_constant kn env =
     | Undef _ -> false
 
 let polymorphic_constant cst env =
-  (lookup_constant cst env).const_polymorphic
+  Declareops.constant_is_polymorphic (lookup_constant cst env)
 
 let polymorphic_pconstant (cst,u) env =
   if Univ.Instance.is_empty u then false
@@ -330,19 +319,10 @@ let polymorphic_pconstant (cst,u) env =
 let type_in_type_constant cst env =
   not (lookup_constant cst env).const_typing_flags.check_universes
 
-let template_polymorphic_constant cst env =
-  match (lookup_constant cst env).const_type with 
-  | TemplateArity _ -> true
-  | RegularArity _ -> false
-
-let template_polymorphic_pconstant (cst,u) env =
-  if not (Univ.Instance.is_empty u) then false
-  else template_polymorphic_constant cst env
-
 let lookup_projection cst env =
   match (lookup_constant (Projection.constant cst) env).const_proj with 
   | Some pb -> pb
-  | None -> anomaly (Pp.str "lookup_projection: constant is not a projection")
+  | None -> anomaly (Pp.str "lookup_projection: constant is not a projection.")
 
 let is_projection cst env =
   match (lookup_constant cst env).const_proj with 
@@ -353,7 +333,7 @@ let is_projection cst env =
 let lookup_mind = lookup_mind
 
 let polymorphic_ind (mind,i) env =
-  (lookup_mind mind env).mind_polymorphic
+  Declareops.inductive_is_polymorphic (lookup_mind mind env)
 
 let polymorphic_pind (ind,u) env =
   if Univ.Instance.is_empty u then false
@@ -397,7 +377,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
@@ -408,12 +388,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
-    fold_constr filtrec acc c
+    Constr.fold filtrec acc c
   in
     filtrec Id.Set.empty constr
 
@@ -469,9 +449,11 @@ let lookup_modtype mp env =
 
 (*s Judgments. *)
 
-type unsafe_judgment = {
-  uj_val : constr;
-  uj_type : types }
+type ('constr, 'types) punsafe_judgment = {
+  uj_val : 'constr;
+  uj_type : 'types }
+
+type unsafe_judgment = (constr, types) punsafe_judgment
 
 let make_judge v tj =
   { uj_val = v;
@@ -480,13 +462,15 @@ let make_judge v tj =
 let j_val j = j.uj_val
 let j_type j = j.uj_type
 
-type unsafe_type_judgment = {
-  utj_val : constr;
-  utj_type : sorts }
+type 'types punsafe_type_judgment = {
+  utj_val : 'types;
+  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
 
@@ -540,9 +524,9 @@ 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")
+		     | _ -> anomaly ~label:"Environ.register" (Pp.str "should be an inductive type.")
 	in
         register_one (register_one env (KInt31 (grp,Int31Constructor)) i31c) field entry
     | field -> register_one env field entry
@@ -578,7 +562,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
@@ -586,9 +570,9 @@ 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")
+      | _ -> anomaly ~label:"Environ.register" (Pp.str "should be a constant.")
   in
   let int31_binop_from_const op prim = int31_op_from_const 2 op prim in
   let int31_unop_from_const op prim = int31_op_from_const 1 op prim in
@@ -600,67 +584,67 @@ fun rk value field ->
           match field with
           | KInt31 (grp, Int31Type) -> Retroknowledge.find rk (KInt31 (grp,Int31Bits))
           | _ -> anomaly ~label:"Environ.register"
-              (Pp.str "add_int31_decompilation_from_type called with an abnormal 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")
+              (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"
-              (Pp.str "should be an inductive type")
+              (Pp.str "should be an inductive type.")
         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;
         }
     | KInt31 (_, Int31Plus) -> int31_binop_from_const Cbytecodes.Kaddint31
-							  Primitives.Int31add
+							  CPrimitives.Int31add
     | KInt31 (_, Int31PlusC) -> int31_binop_from_const Cbytecodes.Kaddcint31
-							   Primitives.Int31addc
+							   CPrimitives.Int31addc
     | KInt31 (_, Int31PlusCarryC) -> int31_binop_from_const Cbytecodes.Kaddcarrycint31
-								Primitives.Int31addcarryc
+								CPrimitives.Int31addcarryc
     | KInt31 (_, Int31Minus) -> int31_binop_from_const Cbytecodes.Ksubint31
-							   Primitives.Int31sub
+							   CPrimitives.Int31sub
     | KInt31 (_, Int31MinusC) -> int31_binop_from_const Cbytecodes.Ksubcint31
-							    Primitives.Int31subc
+							    CPrimitives.Int31subc
     | KInt31 (_, Int31MinusCarryC) -> int31_binop_from_const
-	                                Cbytecodes.Ksubcarrycint31 Primitives.Int31subcarryc
+	                                Cbytecodes.Ksubcarrycint31 CPrimitives.Int31subcarryc
     | KInt31 (_, Int31Times) -> int31_binop_from_const Cbytecodes.Kmulint31
-							   Primitives.Int31mul
+							   CPrimitives.Int31mul
     | KInt31 (_, Int31TimesC) -> int31_binop_from_const Cbytecodes.Kmulcint31
-							   Primitives.Int31mulc
+							   CPrimitives.Int31mulc
     | KInt31 (_, Int31Div21) -> int31_op_from_const 3 Cbytecodes.Kdiv21int31
-                                                           Primitives.Int31div21
+                                                           CPrimitives.Int31div21
     | KInt31 (_, Int31Diveucl) -> int31_binop_from_const Cbytecodes.Kdivint31
-							 Primitives.Int31diveucl
+							 CPrimitives.Int31diveucl
     | KInt31 (_, Int31AddMulDiv) -> int31_op_from_const 3 Cbytecodes.Kaddmuldivint31
-                                                         Primitives.Int31addmuldiv
+                                                         CPrimitives.Int31addmuldiv
     | KInt31 (_, Int31Compare) -> int31_binop_from_const Cbytecodes.Kcompareint31
-							     Primitives.Int31compare
+							     CPrimitives.Int31compare
     | KInt31 (_, Int31Head0) -> int31_unop_from_const Cbytecodes.Khead0int31
-							  Primitives.Int31head0
+							  CPrimitives.Int31head0
     | KInt31 (_, Int31Tail0) -> int31_unop_from_const Cbytecodes.Ktail0int31
-							  Primitives.Int31tail0
+							  CPrimitives.Int31tail0
     | KInt31 (_, Int31Lor) -> int31_binop_from_const Cbytecodes.Klorint31
-							 Primitives.Int31lor
+							 CPrimitives.Int31lor
     | KInt31 (_, Int31Land) -> int31_binop_from_const Cbytecodes.Klandint31
-							  Primitives.Int31land
+							  CPrimitives.Int31land
     | KInt31 (_, Int31Lxor) -> int31_binop_from_const Cbytecodes.Klxorint31
-							  Primitives.Int31lxor
+							  CPrimitives.Int31lxor
     | _ -> empty_reactive_info
 
 let _ = Hook.set Retroknowledge.dispatch_hook dispatch
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 6ac00088..fdd84b25 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 +82,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,23 +128,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
-
-(** Old-style polymorphism *)
-val template_polymorphic_constant  : constant -> env -> bool
-val template_polymorphic_pconstant : pconstant -> env -> bool
+val type_in_type_constant : Constant.t -> env -> bool
 
 (** {6 ... } *)
 (** [constant_value env c] raises [NotEvaluableConst Opaque] if
@@ -149,38 +148,36 @@ val template_polymorphic_pconstant : pconstant -> 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 -> constant_type 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 * constant_type * 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.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 -> constant_type
-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 lookup_projection    : Names.Projection.t -> env -> projection_body
+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
@@ -198,20 +195,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
+    @raise 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
@@ -231,29 +228,32 @@ val vars_of_global : env -> constr -> Id.Set.t
 val really_needed : env -> Id.Set.t -> Id.Set.t
 
 (** like [really_needed] but computes a well ordered named context *)
-val keep_hyps : env -> Id.Set.t -> Context.section_context
+val keep_hyps : env -> Id.Set.t -> Context.Named.t
 
 (** {5 Unsafe judgments. }
     We introduce here the pre-type of judgments, which is
   actually only a datatype to store a term with its type and the type of its
   type. *)
 
-type unsafe_judgment = {
-  uj_val  : constr;
-  uj_type : types }
+type ('constr, 'types) punsafe_judgment = {
+  uj_val : 'constr;
+  uj_type : 'types }
+
+type unsafe_judgment = (constr, types) punsafe_judgment
 
-val make_judge : constr -> types -> unsafe_judgment
-val j_val  : unsafe_judgment -> constr
-val j_type : unsafe_judgment -> types
+val make_judge : 'constr -> 'types -> ('constr, 'types) punsafe_judgment
+val j_val  : ('constr, 'types) punsafe_judgment -> 'constr
+val j_type : ('constr, 'types) punsafe_judgment -> 'types
 
-type unsafe_type_judgment = {
-  utj_val  : constr;
-  utj_type : sorts }
+type 'types punsafe_type_judgment = {
+  utj_val : 'types;
+  utj_type : Sorts.t }
 
+type unsafe_type_judgment = types punsafe_type_judgment
 
 (** {6 Compilation of global declaration } *)
 
-val compile_constant_body : env -> constant_universes option -> constant_def -> Cemitcodes.body_code option
+val compile_constant_body : env -> constant_universes -> constant_def -> Cemitcodes.body_code option
 
 exception Hyp_not_found
 
diff --git a/kernel/esubst.ml b/kernel/esubst.ml
index 1dc389c6..a11a0dc0 100644
--- a/kernel/esubst.ml
+++ b/kernel/esubst.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Bruno Barras for Coq V7.0, Mar 2001 *)
diff --git a/kernel/esubst.mli b/kernel/esubst.mli
index 533d1c68..b82d6fdf 100644
--- a/kernel/esubst.mli
+++ b/kernel/esubst.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Explicit substitutions *)
diff --git a/kernel/evar.ml b/kernel/evar.ml
index b972fc11..bbe14309 100644
--- a/kernel/evar.ml
+++ b/kernel/evar.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t = int
@@ -13,6 +15,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 f28a1364..d14cdce2 100644
--- a/kernel/evar.mli
+++ b/kernel/evar.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module defines existential variables, which are isomorphic to [int].
@@ -30,5 +32,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/fast_typeops.ml b/kernel/fast_typeops.ml
deleted file mode 100644
index bd91c689..00000000
--- a/kernel/fast_typeops.ml
+++ /dev/null
@@ -1,463 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open CErrors
-open Util
-open Names
-open Univ
-open Term
-open Vars
-open Declarations
-open Environ
-open Reduction
-open Inductive
-open Type_errors
-
-let conv_leq l2r env x y = default_conv CUMUL ~l2r env x y
-
-let conv_leq_vecti env v1 v2 =
-  Array.fold_left2_i
-    (fun i _ t1 t2 ->
-      try conv_leq false env t1 t2
-      with NotConvertible -> raise (NotConvertibleVect i))
-    ()
-    v1
-    v2
-
-let check_constraints cst env = 
-  if Environ.check_constraints cst env then ()
-  else error_unsatisfied_constraints env cst
-
-(* This should be a type (a priori without intention to be an assumption) *)
-let type_judgment env c t =
-  match kind_of_term(whd_all env t) with
-    | Sort s -> {utj_val = c; utj_type = s }
-    | _ -> error_not_type env (make_judge c t)
-
-let check_type env c t =
-  match kind_of_term(whd_all env t) with
-  | Sort s -> s
-  | _ -> error_not_type env (make_judge c t)
-
-(* This should be a type intended to be assumed. The error message is *)
-(* not as useful as for [type_judgment]. *)
-let assumption_of_judgment env t ty =
-  try let _ = check_type env t ty in t
-  with TypeError _ ->
-    error_assumption env (make_judge t ty)
-
-(************************************************)
-(* Incremental typing rules: builds a typing judgment given the *)
-(* judgments for the subterms. *)
-
-(*s Type of sorts *)
-
-(* Prop and Set *)
-
-let judge_of_prop = mkSort type1_sort
-
-let judge_of_prop_contents _ = judge_of_prop
-
-(* Type of Type(i). *)
-
-let judge_of_type u =
-  let uu = Universe.super u in
-    mkType uu
-
-(*s Type of a de Bruijn index. *)
-
-let judge_of_relative env n =
-  try
-    let open Context.Rel.Declaration in
-    env |> lookup_rel n |> get_type |> lift n
-  with Not_found ->
-    error_unbound_rel env n
-
-(* Type of variables *)
-let judge_of_variable env id =
-  try named_type id env
-  with Not_found ->
-    error_unbound_var env id
-
-(* Management of context of variables. *)
-
-(* Checks if a context of variables can be instantiated by the
-   variables of the current env *)
-(* TODO: check order? *)
-let check_hyps_inclusion env f c sign =
-  Context.Named.fold_outside
-    (fun decl () ->
-      let open Context.Named.Declaration in
-      let id = get_id decl in
-      let ty1 = get_type decl in
-      try
-        let ty2 = named_type id env in
-        if not (eq_constr ty2 ty1) then raise Exit
-      with Not_found | Exit ->
-        error_reference_variables env id (f c))
-    sign
-    ~init:()
-
-(* Instantiation of terms on real arguments. *)
-
-(* Make a type polymorphic if an arity *)
-
-(* Type of constants *)
-
-
-let type_of_constant_knowing_parameters_arity env t paramtyps =
-  match t with
-  | RegularArity t -> t
-  | TemplateArity (sign,ar) ->
-      let ctx = List.rev sign in
-      let ctx,s = instantiate_universes env ctx ar paramtyps in
-      mkArity (List.rev ctx,s)
-
-let type_of_constant_knowing_parameters env cst paramtyps =
-  let ty, cu = constant_type env cst in
-    type_of_constant_knowing_parameters_arity env ty paramtyps, cu
-
-let judge_of_constant_knowing_parameters env (kn,u as cst) args =
-  let cb = lookup_constant kn env in
-  let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in
-  let ty, cu = type_of_constant_knowing_parameters env cst args in
-  let () = check_constraints cu env in
-    ty
-
-let judge_of_constant env cst =
-  judge_of_constant_knowing_parameters env cst [||]
-
-(* Type of a lambda-abstraction. *)
-
-(* [judge_of_abstraction env name var j] implements the rule
-
- env, name:typ |- j.uj_val:j.uj_type     env, |- (name:typ)j.uj_type : s
- -----------------------------------------------------------------------
-          env |- [name:typ]j.uj_val : (name:typ)j.uj_type
-
-  Since all products are defined in the Calculus of Inductive Constructions
-  and no upper constraint exists on the sort $s$, we don't need to compute $s$
-*)
-
-let judge_of_abstraction env name var ty =
-  mkProd (name, var, ty)
-
-(* Type of an application. *)
-
-let make_judgev c t = 
-  Array.map2 make_judge c t
-
-let judge_of_apply env func funt argsv argstv =
-  let len = Array.length argsv in
-  let rec apply_rec i typ = 
-    if Int.equal i len then typ
-    else 
-      (match kind_of_term (whd_all env typ) with
-      | Prod (_,c1,c2) ->
-	let arg = argsv.(i) and argt = argstv.(i) in
-	  (try
-	     let () = conv_leq false env argt c1 in
-	       apply_rec (i+1) (subst1 arg c2)
-	   with NotConvertible ->
-	     error_cant_apply_bad_type env
-	       (i+1,c1,argt)
-	       (make_judge func funt)
-	       (make_judgev argsv argstv))
-	    
-      | _ ->
-	error_cant_apply_not_functional env 
-	  (make_judge func funt)
-	  (make_judgev argsv argstv))
-  in apply_rec 0 funt
-
-(* Type of product *)
-
-let sort_of_product env domsort rangsort =
-  match (domsort, rangsort) with
-    (* Product rule (s,Prop,Prop) *)
-    | (_,       Prop Null)  -> rangsort
-    (* Product rule (Prop/Set,Set,Set) *)
-    | (Prop _,  Prop Pos) -> rangsort
-    (* Product rule (Type,Set,?) *)
-    | (Type u1, Prop Pos) ->
-        if is_impredicative_set env then
-          (* Rule is (Type,Set,Set) in the Set-impredicative calculus *)
-          rangsort
-        else
-          (* Rule is (Type_i,Set,Type_i) in the Set-predicative calculus *)
-          Type (Universe.sup Universe.type0 u1)
-    (* Product rule (Prop,Type_i,Type_i) *)
-    | (Prop Pos,  Type u2)  -> Type (Universe.sup Universe.type0 u2)
-    (* Product rule (Prop,Type_i,Type_i) *)
-    | (Prop Null, Type _)  -> rangsort
-    (* Product rule (Type_i,Type_i,Type_i) *)
-    | (Type u1, Type u2) -> Type (Universe.sup u1 u2)
-
-(* [judge_of_product env name (typ1,s1) (typ2,s2)] implements the rule
-
-    env |- typ1:s1       env, name:typ1 |- typ2 : s2
-    -------------------------------------------------------------------------
-         s' >= (s1,s2), env |- (name:typ)j.uj_val : s'
-
-  where j.uj_type is convertible to a sort s2
-*)
-let judge_of_product env name s1 s2 =
-  let s = sort_of_product env s1 s2 in
-    mkSort s
-
-(* Type of a type cast *)
-
-(* [judge_of_cast env (c,typ1) (typ2,s)] implements the rule
-
-    env |- c:typ1    env |- typ2:s    env |- typ1 <= typ2
-    ---------------------------------------------------------------------
-         env |- c:typ2
-*)
-
-let judge_of_cast env c ct k expected_type =
-  try
-    match k with
-    | VMcast ->
-      vm_conv CUMUL env ct expected_type
-    | DEFAULTcast ->
-      default_conv ~l2r:false CUMUL env ct expected_type
-    | REVERTcast ->
-      default_conv ~l2r:true CUMUL env ct expected_type
-    | NATIVEcast ->
-      let sigma = Nativelambda.empty_evars in
-      Nativeconv.native_conv CUMUL sigma env ct expected_type
-  with NotConvertible ->
-    error_actual_type env (make_judge c ct) expected_type
-
-(* Inductive types. *)
-
-(* The type is parametric over the uniform parameters whose conclusion
-   is in Type; to enforce the internal constraints between the
-   parameters and the instances of Type occurring in the type of the
-   constructors, we use the level variables _statically_ assigned to
-   the conclusions of the parameters as mediators: e.g. if a parameter
-   has conclusion Type(alpha), static constraints of the form alpha<=v
-   exist between alpha and the Type's occurring in the constructor
-   types; when the parameters is finally instantiated by a term of
-   conclusion Type(u), then the constraints u<=alpha is computed in
-   the App case of execute; from this constraints, the expected
-   dynamic constraints of the form u<=v are enforced *)
-
-let judge_of_inductive_knowing_parameters env (ind,u as indu) args =
-  let (mib,mip) as spec = lookup_mind_specif env ind in
-  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
-  let t,cst = Inductive.constrained_type_of_inductive_knowing_parameters 
-    env (spec,u) args
-  in
-    check_constraints cst env;
-    t
-
-let judge_of_inductive env (ind,u as indu) =
-  let (mib,mip) = lookup_mind_specif env ind in
-  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
-  let t,cst = Inductive.constrained_type_of_inductive env ((mib,mip),u) in
-    check_constraints cst env;
-    t
-
-(* Constructors. *)
-
-let judge_of_constructor env (c,u as cu) =
-  let _ =
-    let ((kn,_),_) = c in
-    let mib = lookup_mind kn env in
-    check_hyps_inclusion env mkConstructU cu mib.mind_hyps in
-  let specif = lookup_mind_specif env (inductive_of_constructor c) in
-  let t,cst = constrained_type_of_constructor cu specif in
-  let () = check_constraints cst env in
-    t
-
-(* Case. *)
-
-let check_branch_types env (ind,u) c ct lft explft =
-  try conv_leq_vecti env lft explft
-  with
-      NotConvertibleVect i ->
-        error_ill_formed_branch env c ((ind,i+1),u) lft.(i) explft.(i)
-    | Invalid_argument _ ->
-        error_number_branches env (make_judge c ct) (Array.length explft)
-
-let judge_of_case env ci p pt c ct lf lft =
-  let (pind, _ as indspec) =
-    try find_rectype env ct
-    with Not_found -> error_case_not_inductive env (make_judge c ct) in
-  let _ = check_case_info env pind ci in
-  let (bty,rslty) =
-    type_case_branches env indspec (make_judge p pt) c in
-  let () = check_branch_types env pind c ct lft bty in
-    rslty
-
-let judge_of_projection env p c ct =
-  let pb = lookup_projection p env in
-  let (ind,u), args =
-    try find_rectype env ct
-    with Not_found -> error_case_not_inductive env (make_judge c ct)
-  in
-    assert(eq_mind pb.proj_ind (fst ind));
-    let ty = Vars.subst_instance_constr u pb.Declarations.proj_type in
-      substl (c :: List.rev args) ty
-      
-
-(* Fixpoints. *)
-
-(* Checks the type of a general (co)fixpoint, i.e. without checking *)
-(* the specific guard condition. *)
-
-let type_fixpoint env lna lar vdef vdeft =
-  let lt = Array.length vdeft in
-  assert (Int.equal (Array.length lar) lt);
-  try
-    conv_leq_vecti env vdeft (Array.map (fun ty -> lift lt ty) lar)
-  with NotConvertibleVect i ->
-    error_ill_typed_rec_body env i lna (make_judgev vdef vdeft) lar
-
-(************************************************************************)
-(************************************************************************)
-
-(* The typing machine. *)
-    (* ATTENTION : faudra faire le typage du contexte des Const,
-    Ind et Constructsi un jour cela devient des constructions
-    arbitraires et non plus des variables *)
-let rec execute env cstr =
-  let open Context.Rel.Declaration in
-  match kind_of_term cstr with
-    (* Atomic terms *)
-    | Sort (Prop c) ->
-      judge_of_prop_contents c
-	
-    | Sort (Type u) ->
-      judge_of_type u
-
-    | Rel n ->
-      judge_of_relative env n
-
-    | Var id ->
-      judge_of_variable env id
-
-    | Const c ->
-      judge_of_constant env c
-	
-    | Proj (p, c) ->
-        let ct = execute env c in
-          judge_of_projection env p c ct
-
-    (* Lambda calculus operators *)
-    | App (f,args) ->
-        let argst = execute_array env args in
-	let ft =
-	  match kind_of_term f with
-	  | Ind ind when Environ.template_polymorphic_pind ind env ->
-	      (* Template sort-polymorphism of inductive types *)
-	    let args = Array.map (fun t -> lazy t) argst in
-	      judge_of_inductive_knowing_parameters env ind args
-	  | Const cst when Environ.template_polymorphic_pconstant cst env ->
-	      (* Template sort-polymorphism of constants *)
-	    let args = Array.map (fun t -> lazy t) argst in
-	      judge_of_constant_knowing_parameters env cst args
-	  | _ ->
-	    (* Full or no sort-polymorphism *)
-            execute env f
-	in
-
-	  judge_of_apply env f ft args argst
-
-    | Lambda (name,c1,c2) ->
-      let _ = execute_is_type env c1 in
-      let env1 = push_rel (LocalAssum (name,c1)) env in
-      let c2t = execute env1 c2 in
-        judge_of_abstraction env name c1 c2t
-
-    | Prod (name,c1,c2) ->
-      let vars = execute_is_type env c1 in
-      let env1 = push_rel (LocalAssum (name,c1)) env in
-      let vars' = execute_is_type env1 c2 in
-	judge_of_product env name vars vars'
-
-    | LetIn (name,c1,c2,c3) ->
-      let c1t = execute env c1 in
-      let _c2s = execute_is_type env c2 in
-      let _ = judge_of_cast env c1 c1t DEFAULTcast c2 in
-      let env1 = push_rel (LocalDef (name,c1,c2)) env in
-      let c3t = execute env1 c3 in
-	subst1 c1 c3t
-
-    | Cast (c,k,t) ->
-      let ct = execute env c in
-      let _ts = execute_type env t in
-      let _ = judge_of_cast env c ct k t in
-	t
-
-    (* Inductive types *)
-    | Ind ind ->
-      judge_of_inductive env ind
-
-    | Construct c ->
-      judge_of_constructor env c
-
-    | Case (ci,p,c,lf) ->
-        let ct = execute env c in
-        let pt = execute env p in
-        let lft = execute_array env lf in
-          judge_of_case env ci p pt c ct lf lft
-
-    | Fix ((vn,i as vni),recdef) ->
-      let (fix_ty,recdef') = execute_recdef env recdef i in
-      let fix = (vni,recdef') in
-        check_fix env fix; fix_ty
-	  
-    | CoFix (i,recdef) ->
-      let (fix_ty,recdef') = execute_recdef env recdef i in
-      let cofix = (i,recdef') in
-        check_cofix env cofix; fix_ty
-	  
-    (* Partial proofs: unsupported by the kernel *)
-    | Meta _ ->
-	anomaly (Pp.str "the kernel does not support metavariables")
-
-    | Evar _ ->
-	anomaly (Pp.str "the kernel does not support existential variables")
-
-and execute_is_type env constr =
-  let t = execute env constr in
-    check_type env constr t
-
-and execute_type env constr =
-  let t = execute env constr in
-    type_judgment env constr t
-
-and execute_recdef env (names,lar,vdef) i =
-  let lart = execute_array env lar in
-  let lara = Array.map2 (assumption_of_judgment env) lar lart in
-  let env1 = push_rec_types (names,lara,vdef) env in
-  let vdeft = execute_array env1 vdef in
-  let () = type_fixpoint env1 names lara vdef vdeft in
-    (lara.(i),(names,lara,vdef))
-
-and execute_array env = Array.map (execute env)
-
-(* Derived functions *)
-let infer env constr =
-  let t = execute env constr in
-    make_judge constr t
-
-let infer = 
-  if Flags.profile then
-    let infer_key = Profile.declare_profile "Fast_infer" in
-      Profile.profile2 infer_key (fun b c -> infer b c)
-  else (fun b c -> infer b c)
-
-let infer_type env constr =
-  execute_type env constr
-
-let infer_v env cv =
-  let jv = execute_array env cv in
-    make_judgev cv jv
diff --git a/kernel/fast_typeops.mli b/kernel/fast_typeops.mli
deleted file mode 100644
index 41cff607..00000000
--- a/kernel/fast_typeops.mli
+++ /dev/null
@@ -1,24 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Term
-open Environ
-open Declarations
-
-(** {6 Typing functions (not yet tagged as safe) }
-    
-    They return unsafe judgments that are "in context" of a set of 
-    (local) universe variables (the ones that appear in the term)
-    and associated constraints. In case of polymorphic definitions,
-    these variables and constraints will be generalized.
- *)
-
-
-val infer      : env -> constr       -> unsafe_judgment
-val infer_v    : env -> constr array -> unsafe_judgment array
-val infer_type : env -> types        -> unsafe_type_judgment
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index de97268b..85be2146 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -11,6 +13,7 @@ open Util
 open Names
 open Univ
 open Term
+open Constr
 open Vars
 open Declarations
 open Declareops
@@ -130,11 +133,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 +171,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 +186,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,14 +202,67 @@ 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
   in
   List.fold_left fold [] paramsctxt
 
+(* Check arities and constructors *)
+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);
+    numchecked := !numchecked + 1
+  in
+  let check_typ typ typ_env =
+    match typ with
+    | LocalAssum (_, typ') ->
+      begin
+       try
+          basic_check typ_env typ'; Environ.push_rel typ typ_env
+        with NotConvertible -> 
+          anomaly ~label:"bad inductive subtyping relation" (Pp.str "Invalid subtyping relation")
+      end
+    | _ -> anomaly (Pp.str "")
+  in
+  let typs, codom = dest_prod env arcn in
+  let last_env = Context.Rel.fold_outside check_typ typs ~init:env in
+  if not is_arity then basic_check last_env codom else ()
+
+(* Check that the subtyping information inferred for inductive types in the block is correct. *)
+(* 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 uctx = CumulativityInfo.univ_context cumi 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_other env_ar 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 _ ->
+          anomaly ~label:"check_subtyping"
+            Pp.(str "template polymorphism and cumulative polymorphism are not compatible")
+    ) inds
+
 (* Type-check an inductive definition. Does not check positivity
    conditions. *)
 (* TODO check that we don't overgeneralize construcors/inductive arities with
@@ -214,13 +270,18 @@ let param_ccls paramsctxt =
 *)
 let typecheck_inductive env mie =
   let () = match mie.mind_entry_inds with
-  | [] -> anomaly (Pp.str "empty inductive types declaration")
+  | [] -> anomaly (Pp.str "empty inductive types declaration.")
   | _ -> ()
   in
   (* Check unicity of names *)
   mind_check_names mie;
   (* Params are typed-checked here *)
-  let env' = push_context mie.mind_entry_universes env in
+  let env' =
+    match mie.mind_entry_universes with
+    | 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_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 *)
@@ -238,7 +299,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)
@@ -300,7 +361,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
@@ -313,7 +374,7 @@ let typecheck_inductive env mie =
 	      anomaly ~label:"check_inductive" 
 		(Pp.str"Incorrect universe " ++
 		   Universe.pr defu ++ Pp.str " declared for inductive type, inferred level is "
-		 ++ Universe.pr infu)
+		 ++ Universe.pr infu ++ Pp.str ".")
 	in
 	  RegularArity (not is_natural,full_arity,defu)
       in
@@ -333,18 +394,27 @@ let typecheck_inductive env mie =
 		anomaly ~label:"check_inductive" 
 		  (Pp.str"Incorrect universe " ++
 		     Universe.pr u ++ Pp.str " declared for inductive type, inferred level is "
-		   ++ Universe.pr clev)
+		   ++ Universe.pr clev ++ Pp.str ".")
 	      else
 		TemplateArity (param_ccls paramsctxt, infu)
 	  | _ (* Not an explicit occurrence of Type *) ->
 	    full_polymorphic ()
       in
-      let arity = 
-	if mie.mind_entry_polymorphic then full_polymorphic ()
-	else template_polymorphic ()
+      let arity =
+        match mie.mind_entry_universes with
+        | Monomorphic_ind_entry _ -> template_polymorphic ()
+        | Polymorphic_ind_entry _ | Cumulative_ind_entry _ -> full_polymorphic ()
       in
 	(id,cn,lc,(sign,arity)))
     inds
+  in
+  (* Check that the subtyping information inferred for inductive types in the block is correct. *)
+  (* This check produces a value of the unit type if successful or raises an anomaly if check fails. *)
+  let () = 
+    match mie.mind_entry_universes with
+    | Monomorphic_ind_entry _ -> ()
+    | Polymorphic_ind_entry _ -> ()
+    | Cumulative_ind_entry cumi -> check_subtyping cumi paramsctxt env_arities inds
   in (env_arities, env_ar_par, paramsctxt, inds)
 
 (************************************************************************)
@@ -389,11 +459,11 @@ let failwith_non_pos n ntypes c =
 
 let failwith_non_pos_vect n ntypes v =
   Array.iter (failwith_non_pos n ntypes) v;
-  anomaly ~label:"failwith_non_pos_vect" (Pp.str "some k in [n;n+ntypes-1] should occur")
+  anomaly ~label:"failwith_non_pos_vect" (Pp.str "some k in [n;n+ntypes-1] should occur.")
 
 let failwith_non_pos_list n ntypes l =
   List.iter (failwith_non_pos n ntypes) l;
-  anomaly ~label:"failwith_non_pos_list" (Pp.str "some k in [n;n+ntypes-1] should occur")
+  anomaly ~label:"failwith_non_pos_list" (Pp.str "some k in [n;n+ntypes-1] should occur.")
 
 (* Check the inductive type is called with the expected parameters *)
 (* [n] is the index of the last inductive type in [env] *)
@@ -409,7 +479,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
 	  | _ ->
@@ -436,7 +506,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)
@@ -467,7 +537,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
@@ -496,7 +566,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
@@ -604,7 +674,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
@@ -651,7 +721,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
@@ -687,7 +757,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 *)
@@ -728,13 +798,13 @@ 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. *)
   let indty, paramsletsubst =
     (* [ty] = [Ind inst] is typed in context [params] *)
-    let inst = Context.Rel.to_extended_vect 0 paramslet in
+    let inst = Context.Rel.to_extended_vect mkRel 0 paramslet in
     let ty = mkApp (mkIndU indu, inst) in
     (* [Ind inst] is typed in context [params-wo-let] *)
     let inst' = rel_list 0 nparamargs in
@@ -816,23 +886,35 @@ let compute_projections ((kn, _ as ind), u as indu) n x nparamargs params
     Array.of_list (List.rev kns),
     Array.of_list (List.rev pbs)
 
-let build_inductive env p prv ctx env_ar paramsctxt kn isrecord isfinite inds nmr recargs =
+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
+    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
+    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
   (* Compute the set of used section variables *)
   let hyps = used_section_variables env inds in
   let nparamargs = Context.Rel.nhyps paramsctxt in
   let nparamsctxt = Context.Rel.length paramsctxt in
-  let subst, ctx = Univ.abstract_universes p ctx in
-  let paramsctxt = Vars.subst_univs_level_context subst paramsctxt in
-  let env_ar = 
-    let ctx = Environ.rel_context env_ar in 
-    let ctx' = Vars.subst_univs_level_context subst ctx in
-      Environ.push_rel_context ctx' env
+  let substunivs, aiu = abstract_inductive_universes iu in
+  let paramsctxt = Vars.subst_univs_level_context substunivs paramsctxt in
+  let env_ar =
+    let ctxunivs = Environ.rel_context env_ar in 
+    let ctxunivs' = Vars.subst_univs_level_context substunivs ctxunivs in
+      Environ.push_rel_context ctxunivs' env
   in
   (* Check one inductive *)
   let build_one_packet (id,cnames,lc,(ar_sign,ar_kind)) recarg =
     (* Type of constructors in normal form *)
-    let lc = Array.map (Vars.subst_univs_level_constr subst) lc in
+    let lc = Array.map (Vars.subst_univs_level_constr substunivs) lc in
     let splayed_lc = Array.map (dest_prod_assum env_ar) lc in
     let nf_lc = Array.map (fun (d,b) -> it_mkProd_or_LetIn b d) splayed_lc in
     let consnrealdecls =
@@ -848,11 +930,11 @@ let build_inductive env p prv ctx env_ar paramsctxt kn isrecord isfinite inds nm
 	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 subst ar; 
-	    mind_sort = sort_of_univ (Univ.subst_univs_level_universe subst defs); } in
+	  { mind_user_arity = Vars.subst_univs_level_constr substunivs ar; 
+            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
@@ -871,7 +953,7 @@ let build_inductive env p prv ctx env_ar paramsctxt kn isrecord isfinite inds nm
       (* Build the inductive packet *)
       { mind_typename = id;
 	mind_arity = arkind;
-	mind_arity_ctxt = Vars.subst_univs_level_context subst ar_sign;
+	mind_arity_ctxt = Vars.subst_univs_level_context substunivs ar_sign;
 	mind_nrealargs = Context.Rel.nhyps ar_sign - nparamargs;
 	mind_nrealdecls = Context.Rel.length ar_sign - nparamsctxt;
 	mind_kelim = kelim;
@@ -893,10 +975,11 @@ let build_inductive env p prv ctx env_ar paramsctxt kn isrecord isfinite inds nm
 			   && Array.length pkt.mind_consnames == 1
 			   && pkt.mind_consnrealargs.(0) > 0 ->
       (** The elimination criterion ensures that all projections can be defined. *)
-      let u = 
-	if p then 
-	  subst_univs_level_instance subst (Univ.UContext.instance ctx)
-	else Univ.Instance.empty 
+      let u =
+        match aiu with
+        | Monomorphic_ind _ -> Univ.Instance.empty
+        | Polymorphic_ind auctx -> Univ.make_abstract_instance auctx
+        | Cumulative_ind acumi -> Univ.make_abstract_instance (Univ.ACumulativityInfo.univ_context acumi)
       in
       let indsp = ((kn, 0), u) in
       let rctx, indty = decompose_prod_assum (subst1 (mkIndU indsp) pkt.mind_nf_lc.(0)) in
@@ -919,8 +1002,7 @@ let build_inductive env p prv ctx env_ar paramsctxt kn isrecord isfinite inds nm
       mind_nparams_rec = nmr;
       mind_params_ctxt = paramsctxt;
       mind_packets = packets;
-      mind_polymorphic = p;
-      mind_universes = ctx;
+      mind_universes = aiu;
       mind_private = prv;
       mind_typing_flags = Environ.typing_flags env;
     }
@@ -935,7 +1017,6 @@ let check_inductive env kn mie =
   let chkpos = (Environ.typing_flags env).check_guarded in
   let (nmr,recargs) = check_positivity ~chkpos kn env_ar_par paramsctxt mie.mind_entry_finite inds in
   (* Build the inductive packets *)
-    build_inductive env mie.mind_entry_polymorphic mie.mind_entry_private
-      mie.mind_entry_universes
+    build_inductive env mie.mind_entry_private mie.mind_entry_universes
       env_ar paramsctxt kn mie.mind_entry_record mie.mind_entry_finite
       inds nmr recargs
diff --git a/kernel/indtypes.mli b/kernel/indtypes.mli
index 5b461539..5a38172c 100644
--- a/kernel/indtypes.mli
+++ b/kernel/indtypes.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Declarations
 open Environ
 open Entries
@@ -34,7 +36,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 +46,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 3c4c2796..9bed598b 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1,16 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Names
 open Univ
-open Term
+open Constr
 open Vars
 open Declarations
 open Declareops
@@ -25,27 +27,27 @@ type mind_specif = mutual_inductive_body * one_inductive_body
 let lookup_mind_specif env (kn,tyi) =
   let mib = Environ.lookup_mind kn env in
   if tyi >= Array.length mib.mind_packets then
-    error "Inductive.lookup_mind_specif: invalid inductive index";
+    user_err Pp.(str "Inductive.lookup_mind_specif: invalid inductive index");
   (mib, mib.mind_packets.(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
@@ -54,9 +56,11 @@ let inductive_paramdecls (mib,u) =
   Vars.subst_instance_context u mib.mind_params_ctxt
 
 let instantiate_inductive_constraints mib u =
-  if mib.mind_polymorphic then
-    Univ.subst_instance_constraints u (Univ.UContext.constraints mib.mind_universes)
-  else Univ.Constraint.empty
+  let process auctx =  Univ.AUContext.instantiate u auctx in
+  match mib.mind_universes with
+  | Monomorphic_ind _ -> Univ.Constraint.empty
+  | Polymorphic_ind auctx -> process auctx
+  | Cumulative_ind cumi -> process (Univ.ACumulativityInfo.univ_context cumi)
 
 
 (************************************************************************)
@@ -75,11 +79,11 @@ let constructor_instantiate mind u mib c =
 
 let instantiate_params full t u args sign =
   let fail () =
-    anomaly ~label:"instantiate_params" (Pp.str "type, ctxt and args mismatch") in
+    anomaly ~label:"instantiate_params" (Pp.str "type, ctxt and args mismatch.") in
   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)
@@ -92,9 +96,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
@@ -126,7 +130,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
@@ -190,11 +194,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)
 
@@ -209,9 +213,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 [||]
@@ -231,7 +235,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'
@@ -247,7 +251,7 @@ let type_of_constructor (cstr, u) (mib,mip) =
   let specif = mip.mind_user_lc in
   let i = index_of_constructor cstr in
   let nconstr = Array.length mip.mind_consnames in
-  if i > nconstr then error "Not enough constructors in the type.";
+  if i > nconstr then user_err Pp.(str "Not enough constructors in the type.");
   constructor_instantiate (fst ind) u mib specif.(i-1)
 
 let constrained_type_of_constructor (cstr,u as cstru) (mib,mip as ind) =
@@ -274,8 +278,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
@@ -294,19 +298,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 0 realargs)
+       @ 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)))
 
@@ -314,7 +319,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'
@@ -323,8 +328,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 _ =
@@ -349,22 +354,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 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
@@ -587,7 +592,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
@@ -619,7 +624,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
@@ -678,7 +683,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
@@ -707,7 +712,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
@@ -728,7 +733,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
@@ -771,7 +776,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
@@ -793,21 +798,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)
@@ -855,11 +863,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
@@ -890,7 +900,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
@@ -920,7 +930,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) ->
@@ -966,7 +976,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
 
@@ -1003,7 +1013,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 _ ->
@@ -1018,12 +1028,12 @@ 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
 	      check_nested_fix_body renv' (decr-1) recArgsDecrArg b
-	| _ -> anomaly (Pp.str "Not enough abstractions in fix body")
+	| _ -> anomaly (Pp.str "Not enough abstractions in fix body.")
 	    
   in
   check_rec_call renv [] def
@@ -1039,7 +1049,7 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
     || not (Int.equal (Array.length names) nbfix)
     || bodynum < 0
     || bodynum >= nbfix
-  then anomaly (Pp.str "Ill-formed fix term");
+  then anomaly (Pp.str "Ill-formed fix term.");
   let fixenv = push_rec_types recdef env in
   let vdefj = judgment_of_fixpoint recdef in
   let raise_err env i err =
@@ -1049,7 +1059,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
@@ -1059,9 +1069,12 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
                   try find_inductive env a
                   with Not_found ->
 		    raise_err env i (RecursionNotOnInductiveType a) in
+                let mib,_ = lookup_mind_specif env (out_punivs mind) in
+                if mib.mind_finite != Finite then
+                  raise_err env i (RecursionNotOnInductiveType a);
                 (mind, (env', b))
 	      else check_occur env' (n+1) b
-            else anomaly ~label:"check_one_fix" (Pp.str "Bad occurrence of recursive call")
+            else anomaly ~label:"check_one_fix" (Pp.str "Bad occurrence of recursive call.")
         | _ -> raise_err env i NotEnoughAbstractionInFixBody in
     check_occur fixenv 1 def in
   (* Do it on every fixpoint *)
@@ -1090,8 +1103,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;;
 *)
 
 (************************************************************************)
@@ -1100,11 +1113,11 @@ let check_fix env fix = Profile.profile3 cfkey check_fix env fix;;
 exception CoFixGuardError of env * guard_error
 
 let anomaly_ill_typed () =
-  anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor")
+  anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor.")
 
 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
     | _ ->
@@ -1116,7 +1129,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 *)
@@ -1188,8 +1201,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 521ee3c7..c7982f1f 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Univ
 open Declarations
 open Environ
@@ -32,23 +34,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 +67,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 +87,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 +113,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 +137,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 15f213ce..370185a7 100644
--- a/kernel/kernel.mllib
+++ b/kernel/kernel.mllib
@@ -13,15 +13,19 @@ Mod_subst
 Cbytecodes
 Copcodes
 Cemitcodes
-Nativevalues
-Primitives
 Opaqueproof
+Declarations
+Entries
+Vmvalues
+Nativevalues
+CPrimitives
 Declareops
 Retroknowledge
 Conv_oracle
 Pre_env
-Cbytegen
+Clambda
 Nativelambda
+Cbytegen
 Nativecode
 Nativelib
 Environ
@@ -32,7 +36,6 @@ Type_errors
 Modops
 Inductive
 Typeops
-Fast_typeops
 Indtypes
 Cooking
 Term_typing
diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml
index 95990bea..b3d06ce7 100644
--- a/kernel/mod_subst.ml
+++ b/kernel/mod_subst.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Claudio Sacerdoti from contents of term.ml, names.ml and
@@ -16,20 +18,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 +47,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 +67,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 +78,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 +119,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 +167,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 +244,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
@@ -300,7 +302,7 @@ let subst_con0 sub (cst,u) =
   match search_delta_inline resolve knu knc with
     | Some t ->
       (* In case of inlining, discard the canonical part (cf #2608) *)
-      Constant.make1 knu, t
+      Constant.make1 knu, Vars.subst_instance_constr u t
     | None ->
       let knc' =
         progress (kn_of_delta resolve) (if user then knu else knc) ~orelse:knc
@@ -340,7 +342,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 +421,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 +429,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 +448,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 +517,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 6d86b941..b14d3920 100644
--- a/kernel/mod_subst.mli
+++ b/kernel/mod_subst.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {6 [Mod_subst] } *)
 
 open Names
-open Term
+open Constr
 
 (** {6 Delta resolver} *)
 
@@ -20,44 +22,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 +74,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)]
@@ -107,9 +109,9 @@ val subst_substituted : substitution -> 'a substituted -> 'a substituted
 (**/**)
 (* debugging *)
 val debug_string_of_subst : substitution -> string
-val debug_pr_subst : substitution -> Pp.std_ppcmds
+val debug_pr_subst : substitution -> Pp.t
 val debug_string_of_delta : delta_resolver -> string
-val debug_pr_delta : delta_resolver -> Pp.std_ppcmds
+val debug_pr_delta : delta_resolver -> Pp.t
 (**/**)
 
 (** [subst_mp sub mp] guarantees that whenever the result of the
@@ -117,10 +119,10 @@ val debug_pr_delta : delta_resolver -> Pp.std_ppcmds
    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 +130,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 +142,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 +156,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 +173,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 ff44f0f5..1baab7c9 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Jacek Chrzaszcz, Aug 2002 as part of the implementation of
@@ -72,71 +74,53 @@ let rec check_with_def env struc (idl,(c,ctx)) mp equiv =
       (* In the spirit of subtyping.check_constant, we accept
          any implementations of parameters and opaques terms,
 	 as long as they have the right type *)
-      let uctx = Declareops.universes_of_constant (opaque_tables env) cb in
-      let uctx = (* Context of the spec *)
-	if cb.const_polymorphic then
-	  Univ.instantiate_univ_context uctx
-	else uctx
-      in
-      let c', univs, ctx' = 
-	if not cb.const_polymorphic then
-	  let env' = Environ.push_context ~strict:true uctx env' in
-	  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 = Typeops.type_of_constant_type env' 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', ctx, Univ.ContextSet.add_constraints cst (Univ.ContextSet.of_context ctx)
-	else
-	  let cus, ccst = Univ.UContext.dest uctx in
-	  let newus, cst = Univ.UContext.dest ctx in
-	  let () =
-	    if not (Univ.Instance.length cus == Univ.Instance.length newus) then
-	      error_incorrect_with_constraint lab
-	  in
-	  let inst = Univ.Instance.append cus newus in
-	  let csti = Univ.enforce_eq_instances cus newus cst in
-	  let csta = Univ.Constraint.union csti ccst in
-	  let env' = Environ.push_context ~strict:false (Univ.UContext.make (inst, csta)) env in
-	  let () = if not (UGraph.check_constraints cst (Environ.universes env')) then
-		     error_incorrect_with_constraint lab
-	  in
+      let c', univs, ctx' =
+        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
+          in
+          (** Terms are compared in a context with De Bruijn universe indices *)
+	  let env' = Environ.push_context ~strict:false (Univ.AUContext.repr uctx) env in
 	  let cst = match cb.const_body with
 	    | Undef _ | OpaqueDef _ ->
 	      let j = Typeops.infer env' c in
-	      let typ = Typeops.type_of_constant_type env' cb.const_type in
-	      let typ = Vars.subst_instance_constr cus typ in
+	      let typ = cb.const_type in
 	      let cst' = Reduction.infer_conv_leq env' (Environ.universes env')
 						j.uj_type typ in
 	      cst'
 	    | Def cs ->
-	       let c' = Vars.subst_instance_constr cus (Mod_subst.force_constr cs) in
+	       let c' = Mod_subst.force_constr cs in
 	       let cst' = Reduction.infer_conv env' (Environ.universes env') c c' in
 	        cst'
 	  in
 	    if not (Univ.Constraint.is_empty cst) then
 	      error_incorrect_with_constraint lab;
-	    let subst, ctx = Univ.abstract_universes true ctx in
-	      Vars.subst_univs_level_constr subst c, 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 *)
-      let univs =
-        if cb.const_polymorphic then Some cb.const_universes
-        else None
-      in
       let cb' =
 	{ cb with
 	  const_body = def;
-          const_universes = ctx ;
+          const_universes = univs ;
 	  const_body_code = Option.map Cemitcodes.from_val
-                              (compile_constant_body env' univs def) }
+                              (compile_constant_body env' cb.const_universes def) }
       in
       before@(lab,SFBconst(cb'))::after, c', ctx'
     else
@@ -179,16 +163,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
@@ -242,11 +220,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
@@ -277,7 +255,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) ->
@@ -294,9 +274,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
   |[] ->
@@ -332,6 +314,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 5949dad0..e74f455e 100644
--- a/kernel/mod_typing.mli
+++ b/kernel/mod_typing.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Declarations
@@ -21,16 +23,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 +42,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 +57,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 0f0056ed..ab187dba 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Jacek Chrzaszcz, Aug 2002 as part of the implementation of
@@ -17,7 +19,7 @@
 
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Declareops
 open Environ
@@ -35,6 +37,7 @@ type signature_mismatch_error =
   | NotConvertibleConstructorField of Id.t
   | NotConvertibleBodyField
   | NotConvertibleTypeField of env * types * types
+  | CumulativeStatusExpected of bool
   | PolymorphicStatusExpected of bool
   | NotSameConstructorNamesField
   | NotSameInductiveNameInBlockField
@@ -44,11 +47,10 @@ type signature_mismatch_error =
   | RecordFieldExpected of bool
   | RecordProjectionsExpected of Name.t list
   | NotEqualInductiveAliases
-  | NoTypeConstraintExpected
   | IncompatibleInstances
   | IncompatibleUniverses of Univ.univ_inconsistency
   | IncompatiblePolymorphism of env * types * types
-  | IncompatibleConstraints of Univ.constraints
+  | IncompatibleConstraints of Univ.AUContext.t
 
 type module_typing_error =
   | SignatureMismatch of
@@ -58,7 +60,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
@@ -67,7 +69,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
 
@@ -142,11 +144,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 ()
@@ -195,7 +198,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 =
@@ -204,10 +208,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
@@ -220,9 +221,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 ->
@@ -261,13 +267,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")
+        (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.
@@ -327,12 +333,10 @@ let strengthen_const mp_from l cb resolver =
   |_ ->
     let kn = KerName.make2 mp_from l in
     let con = constant_of_delta_kn resolver kn in
-    let u = 
-      if cb.const_polymorphic then
-	let u = Univ.UContext.instance cb.const_universes in
-	let s = Univ.make_instance_subst u in
-	  Univ.subst_univs_level_instance s u
-      else Univ.Instance.empty
+    let u =
+      match cb.const_universes with
+      | Monomorphic_const _ -> Univ.Instance.empty
+      | Polymorphic_const ctx -> Univ.make_abstract_instance ctx
     in
       { cb with
 	const_body = Def (Mod_subst.from_val (mkConstU (con,u)));
@@ -398,10 +402,10 @@ let inline_delta_resolver env inl mp mbid mtb delta =
 	    | Undef _ | OpaqueDef _ -> l
 	    | Def body ->
 	      let constr = Mod_subst.force_constr body in
-	      add_inline_delta_resolver kn (lev, Some constr) l
+              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
 
@@ -568,7 +572,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
@@ -578,19 +582,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) ->
@@ -614,14 +624,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 e9f3db6e..1db489e6 100644
--- a/kernel/modops.mli
+++ b/kernel/modops.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Declarations
 open Entries
@@ -26,9 +28,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 +45,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 +55,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 }
@@ -94,6 +96,7 @@ type signature_mismatch_error =
   | NotConvertibleConstructorField of Id.t
   | NotConvertibleBodyField
   | NotConvertibleTypeField of env * types * types
+  | CumulativeStatusExpected of bool
   | PolymorphicStatusExpected of bool
   | NotSameConstructorNamesField
   | NotSameInductiveNameInBlockField
@@ -103,11 +106,10 @@ type signature_mismatch_error =
   | RecordFieldExpected of bool
   | RecordProjectionsExpected of Name.t list
   | NotEqualInductiveAliases
-  | NoTypeConstraintExpected
   | IncompatibleInstances
   | IncompatibleUniverses of Univ.univ_inconsistency
   | IncompatiblePolymorphism of env * types * types
-  | IncompatibleConstraints of Univ.constraints
+  | IncompatibleConstraints of Univ.AUContext.t
 
 type module_typing_error =
   | SignatureMismatch of
@@ -117,7 +119,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
@@ -126,7 +128,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
 
@@ -152,4 +154,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 1eb9a317..a3aa71f2 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File created around Apr 1994 for CiC V5.10.5 by Chet Murthy collecting
@@ -34,33 +36,28 @@ struct
 
   let hash = String.hash
 
-  let warn_invalid_identifier =
-    CWarnings.create ~name:"invalid-identifier" ~category:"parsing"
-                     ~default:CWarnings.Disabled
-                     (fun s -> str s)
-
-  let check_soft ?(warn = true) x =
-    let iter (fatal, x) =
-      if fatal then CErrors.error x else
-        if warn then warn_invalid_identifier x
-    in
+  let check_valid ?(strict=true) x =
+    let iter (fatal, x) = if fatal || strict then CErrors.user_err Pp.(str x) in
     Option.iter iter (Unicode.ident_refutation x)
 
   let is_valid s = match Unicode.ident_refutation s with
   | None -> true
   | Some _ -> false
 
+  let of_bytes s =
+    let s = Bytes.to_string s in
+    check_valid s;
+    String.hcons s
+
   let of_string s =
-    let () = check_soft s in
-    let s = String.copy s in
+    let () = check_valid s in
     String.hcons s
 
   let of_string_soft s =
-    let () = check_soft ~warn:false s in
-    let s = String.copy s in
+    let () = check_valid ~strict:false s in
     String.hcons s
 
-  let to_string id = String.copy id
+  let to_string id = id
 
   let print id = str id
 
@@ -88,11 +85,14 @@ struct
   type t = Anonymous     (** anonymous identifier *)
 	 | Name of Id.t  (** non-anonymous identifier *)
 
+  let mk_name id =
+    Name id
+
   let is_anonymous = function
     | Anonymous -> true
     | Name _ -> false
 
-  let is_name = not % is_anonymous
+  let is_name = is_anonymous %> not
 
   let compare n1 n2 = match n1, n2 with
     | Anonymous, Anonymous -> 0
@@ -106,13 +106,16 @@ struct
     | _ -> false
 
   let hash = function
-  | Anonymous -> 0
-  | Name id -> Id.hash id
+    | Anonymous -> 0
+    | Name id -> Id.hash id
+
+  let print = function
+    | Anonymous -> str "_"
+    | Name id -> Id.print id
 
   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)
@@ -156,21 +159,8 @@ module DirPath =
 struct
   type t = module_ident list
 
-  let rec compare (p1 : t) (p2 : t) =
-    if p1 == p2 then 0
-    else begin match p1, p2 with
-    | [], [] -> 0
-    | [], _ -> -1
-    | _, [] -> 1
-    | id1 :: p1, id2 :: p2 ->
-      let c = Id.compare id1 id2 in
-      if Int.equal c 0 then compare p1 p2 else c
-    end
-
-  let rec equal p1 p2 = p1 == p2 || match p1, p2 with
-  | [], [] -> true
-  | id1 :: p1, id2 :: p2 -> Id.equal id1 id2 && equal p1 p2
-  | _ -> false
+  let compare = List.compare Id.compare
+  let equal = List.equal Id.equal
 
   let rec hash accu = function
   | [] -> accu
@@ -185,12 +175,14 @@ struct
 
   let empty = []
 
-  let is_empty d = match d with [] -> true | _ -> false
+  let is_empty = List.is_empty
 
   let to_string = function
     | [] -> "<>"
     | 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)
@@ -247,8 +239,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) =
@@ -549,7 +540,6 @@ module KerPair = struct
   end
 
   module SyntacticOrd = struct
-    type t = kernel_pair
     let compare x y = match x, y with
       | Same knx, Same kny -> KerName.compare knx kny
       | Dual (knux,kncx), Dual (knuy,kncy) ->
@@ -601,7 +591,13 @@ end
 module Constant = KerPair
 
 module Cmap = HMap.Make(Constant.CanOrd)
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "canonical form" of the constant. *)
+
 module Cmap_env = HMap.Make(Constant.UserOrd)
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "user form" of the constant. *)
+
 module Cpred = Predicate.Make(Constant.CanOrd)
 module Cset = Cmap.Set
 module Cset_env = Cmap_env.Set
@@ -705,6 +701,12 @@ end
 module Constrmap = Map.Make(ConstructorOrdered)
 module Constrmap_env = Map.Make(ConstructorOrdered_env)
 
+type global_reference =
+  | VarRef of variable           (** A reference to the section-context. *)
+  | 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. *)
+
 (* Better to have it here that in closure, since used in grammar.cma *)
 type evaluable_global_reference =
   | EvalVarRef of Id.t
@@ -866,7 +868,6 @@ struct
   let hash (c, b) = (if b then 0 else 1) + Constant.hash c
 
   module SyntacticOrd = struct
-    type t = constant * bool
     let compare (c, b) (c', b') =
       if b = b' then Constant.SyntacticOrd.compare c c' else -1
     let equal (c, b as x) (c', b' as x') =
@@ -876,8 +877,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 feaedc77..96e020ae 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines a lot of different notions of names used pervasively in
@@ -40,22 +42,21 @@ 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 not valid, or echo a warning if it contains invalid identifier characters.
-      @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 no warning is ever issued.
-      @raise Unicode.Unsupported if the provided string contains unsupported UTF-8 characters. *)
+  (** 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. *)
 
   val to_string : t -> string
   (** Converts a identifier into an string. *)
 
-  val print : t -> Pp.std_ppcmds
+  val print : t -> Pp.t
   (** Pretty-printer. *)
 
   module Set : Set.S with type elt = t
@@ -82,6 +83,9 @@ sig
   type t = Anonymous     (** anonymous identifier *)
 	 | Name of Id.t  (** non-anonymous identifier *)
 
+  val mk_name : Id.t -> t
+  (** constructor *)
+
   val is_anonymous : t -> bool
   (** Return [true] iff a given name is [Anonymous]. *)
 
@@ -100,11 +104,16 @@ sig
   val hcons : t -> t
   (** Hashconsing over names. *)
 
+  val print : t -> Pp.t
+  (** Pretty-printer (print "_" for [Anonymous]. *)
+
 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
 
@@ -149,6 +158,7 @@ sig
   val hcons : t -> t
   (** Hashconsing of directory paths. *)
 
+  val print : t -> Pp.t
 end
 
 (** {6 Names of structure elements } *)
@@ -179,7 +189,7 @@ sig
   val to_id : t -> Id.t
   (** Conversion to an identifier. *)
 
-  val print : t -> Pp.std_ppcmds
+  val print : t -> Pp.t
   (** Pretty-printer. *)
 
   module Set : Set.S with type elt = t
@@ -278,7 +288,7 @@ sig
   val debug_to_string : t -> string
   (** Same as [to_string], but outputs information related to debug. *)
 
-  val print : t -> Pp.std_ppcmds
+  val print : t -> Pp.t
 
   (** Comparisons *)
   val compare : t -> t -> int
@@ -290,7 +300,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:
@@ -357,9 +366,9 @@ sig
   (** Displaying *)
 
   val to_string : t -> string
-  val print : t -> Pp.std_ppcmds
+  val print : t -> Pp.t
   val debug_to_string : t -> string
-  val debug_print : t -> Pp.std_ppcmds
+  val debug_print : t -> Pp.t
 
 end
 
@@ -368,8 +377,14 @@ end
 module Cpred : Predicate.S with type elt = Constant.t
 module Cset : CSig.SetS with type elt = Constant.t
 module Cset_env  : CSig.SetS with type elt = Constant.t
+
 module Cmap : Map.ExtS with type key = Constant.t and module Set := Cset
-module Cmap_env : Map.ExtS with type key = Constant.t  and module Set := Cset_env
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "canonical form" of the constant. *)
+
+module Cmap_env : Map.ExtS with type key = Constant.t and module Set := Cset_env
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "user form" of the constant. *)
 
 (** {6 Inductive names} *)
 
@@ -433,9 +448,9 @@ sig
   (** Displaying *)
 
   val to_string : t -> string
-  val print : t -> Pp.std_ppcmds
+  val print : t -> Pp.t
   val debug_to_string : t -> string
-  val debug_print : t -> Pp.std_ppcmds
+  val debug_print : t -> Pp.t
 
 end
 
@@ -485,6 +500,13 @@ val constructor_user_hash : constructor -> int
 val constructor_syntactic_ord : constructor -> constructor -> int
 val constructor_syntactic_hash : constructor -> int
 
+(** {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.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. *)
+
 (** Better to have it here that in Closure, since required in grammar.cma *)
 type evaluable_global_reference =
   | EvalVarRef of Id.t
@@ -525,6 +547,8 @@ val eq_constant_key : Constant.t -> Constant.t -> bool
 (** equalities on constant and inductive names (for the checker) *)
 
 val eq_con_chk : Constant.t -> Constant.t -> bool
+[@@ocaml.deprecated "Same as [Constant.UserOrd.equal]."]
+
 val eq_ind_chk : inductive -> inductive -> bool
 
 (** {6 Deprecated functions. For backward compatibility.} *)
@@ -532,170 +556,171 @@ 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.std_ppcmds
-(** @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} *)
 
 type mod_bound_id = MBId.t
-(** Alias type. *)
+[@@ocaml.deprecated "Same as [MBId.t]."]
 
-val mod_bound_id_ord : mod_bound_id -> mod_bound_id -> int
-(** @deprecated Same as [MBId.compare]. *)
+val mod_bound_id_ord : MBId.t -> MBId.t -> int
+[@@ocaml.deprecated "Same as [MBId.compare]."]
 
-val mod_bound_id_eq : mod_bound_id -> mod_bound_id -> bool
-(** @deprecated Same as [MBId.equal]. *)
+val mod_bound_id_eq : MBId.t -> MBId.t -> bool
+[@@ocaml.deprecated "Same as [MBId.equal]."]
 
-val make_mbid : DirPath.t -> Id.t -> mod_bound_id
-(** @deprecated Same as [MBId.make]. *)
+val make_mbid : DirPath.t -> Id.t -> MBId.t
+[@@ocaml.deprecated "Same as [MBId.make]."]
 
-val repr_mbid : mod_bound_id -> int * Id.t * DirPath.t
-(** @deprecated Same as [MBId.repr]. *)
+val repr_mbid : MBId.t -> int * Id.t * DirPath.t
+[@@ocaml.deprecated "Same as [MBId.repr]."]
 
-val id_of_mbid : mod_bound_id -> Id.t
-(** @deprecated Same as [MBId.to_id]. *)
+val id_of_mbid : MBId.t -> Id.t
+[@@ocaml.deprecated "Same as [MBId.to_id]."]
 
-val string_of_mbid : mod_bound_id -> string
-(** @deprecated Same as [MBId.to_string]. *)
+val string_of_mbid : MBId.t -> string
+[@@ocaml.deprecated "Same as [MBId.to_string]."]
 
-val debug_string_of_mbid : mod_bound_id -> string
-(** @deprecated Same as [MBId.debug_to_string]. *)
+val debug_string_of_mbid : MBId.t -> 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.std_ppcmds
-(** @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
@@ -703,7 +728,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
 
@@ -713,110 +738,111 @@ 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.std_ppcmds
+  val print : t -> Pp.t
 
 end
 
 type projection = Projection.t
+[@@ocaml.deprecated "Alias for [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.std_ppcmds
-(** @deprecated Same as [Constant.print] *)
+val pr_con : Constant.t -> Pp.t
+[@@ocaml.deprecated "Same as [Constant.print]"]
 
-val debug_pr_con : constant -> Pp.std_ppcmds
-(** @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.std_ppcmds
-(** @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.std_ppcmds
-(** @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 eaddace4..123e7a6d 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Names
-open Term
+open Constr
 open Declarations
 open Util
 open Nativevalues
@@ -16,6 +18,8 @@ open Nativeinstr
 open Nativelambda
 open Pre_env
 
+[@@@ocaml.warning "-32-37"]
+
 (** This file defines the mllambda code generation phase of the native
 compiler. mllambda represents a fragment of ML, and can easily be printed
 to OCaml code. *)
@@ -23,7 +27,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
@@ -40,35 +44,35 @@ module LNset = Set.Make(LNord)
 
 let lname_ctr = ref (-1)
 
-let reset_lname = lname_ctr := -1
-
 let fresh_lname n = 
   incr lname_ctr;
   { lname = n; luid = !lname_ctr }
 
 (** Global names **)
 type gname = 
-  | Gind of string * pinductive (* prefix, inductive name *)
-  | Gconstruct of string * pconstructor (* prefix, constructor name *)
-  | Gconstant of string * pconstant (* 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
+  | Gind of string * inductive (* prefix, inductive name *)
+  | Gconstruct of string * constructor (* prefix, constructor name *)
+  | 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
   | Gind (s1, ind1), Gind (s2, ind2) ->
-     String.equal s1 s2 && Univ.eq_puniverses eq_ind ind1 ind2
+     String.equal s1 s2 && eq_ind ind1 ind2
   | Gconstruct (s1, c1), Gconstruct (s2, c2) ->
-      String.equal s1 s2 && Univ.eq_puniverses eq_constructor c1 c2
+      String.equal s1 s2 && eq_constructor c1 c2
   | Gconstant (s1, c1), Gconstant (s2, c2) ->
-      String.equal s1 s2 && Univ.eq_puniverses Constant.equal c1 c2
+      String.equal s1 s2 && Constant.equal c1 c2
+  | Gproj (s1, c1), Gproj (s2, c2) ->
+    String.equal s1 s2 && Constant.equal c1 c2
   | Gcase (None, i1), Gcase (None, i2) -> Int.equal i1 i2
   | Gcase (Some l1, i1), Gcase (Some l2, i2) -> Int.equal i1 i2 && Label.equal l1 l2
   | Gpred (None, i1), Gpred (None, i2) -> Int.equal i1 i2
@@ -84,7 +88,9 @@ let eq_gname gn1 gn2 =
   | Ginternal s1, Ginternal s2 -> String.equal s1 s2
   | Grel i1, Grel i2 -> Int.equal i1 i2
   | Gnamed id1, Gnamed id2 -> Id.equal id1 id2
-  | _ -> false
+  | (Gind _| Gconstruct _ | Gconstant _ | Gproj _ | Gcase _ | Gpred _
+    | Gfixtype _ | Gnorm _ | Gnormtbl _ | Ginternal _ | Grel _ | Gnamed _), _ ->
+      false
 
 let dummy_gname =
   Grel 0
@@ -92,12 +98,12 @@ let dummy_gname =
 open Hashset.Combine
 
 let gname_hash gn = match gn with
-| Gind (s, (ind,u)) ->
-   combinesmall 1 (combine3 (String.hash s) (ind_hash ind) (Univ.Instance.hash u))
-| Gconstruct (s, (c,u)) ->
-   combinesmall 2 (combine3 (String.hash s) (constructor_hash c) (Univ.Instance.hash u))
-| Gconstant (s, (c,u)) ->
-   combinesmall 3 (combine3 (String.hash s) (Constant.hash c) (Univ.Instance.hash u))
+| Gind (s, ind) ->
+   combinesmall 1 (combine (String.hash s) (ind_hash ind))
+| Gconstruct (s, c) ->
+   combinesmall 2 (combine (String.hash s) (constructor_hash c))
+| Gconstant (s, c) ->
+   combinesmall 3 (combine (String.hash s) (Constant.hash c))
 | Gcase (l, i) -> combinesmall 4 (combine (Option.hash Label.hash l) (Int.hash i))
 | Gpred (l, i) -> combinesmall 5 (combine (Option.hash Label.hash l) (Int.hash i))
 | Gfixtype (l, i) -> combinesmall 6 (combine (Option.hash Label.hash l) (Int.hash i))
@@ -110,40 +116,30 @@ let gname_hash gn = match gn with
 
 let case_ctr = ref (-1)
 
-let reset_gcase () = case_ctr := -1
-
 let fresh_gcase l =
   incr case_ctr;
   Gcase (l,!case_ctr)
 
 let pred_ctr = ref (-1)
 
-let reset_gpred () = pred_ctr := -1
-
 let fresh_gpred l = 
   incr pred_ctr;
   Gpred (l,!pred_ctr)
 
 let fixtype_ctr = ref (-1)
 
-let reset_gfixtype () = fixtype_ctr := -1
-
 let fresh_gfixtype l =
   incr fixtype_ctr;
   Gfixtype (l,!fixtype_ctr)
 
 let norm_ctr = ref (-1)
 
-let reset_norm () = norm_ctr := -1
-
 let fresh_gnorm l =
   incr norm_ctr;
   Gnorm (l,!norm_ctr)
 
 let normtbl_ctr = ref (-1)
 
-let reset_normtbl () = normtbl_ctr := -1
-
 let fresh_gnormtbl l =
   incr normtbl_ctr;
   Gnormtbl (l,!normtbl_ctr)
@@ -152,13 +148,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 ())
@@ -172,8 +168,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
 
@@ -186,10 +181,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
@@ -211,47 +203,47 @@ let empty_symbols = [||]
 let get_value tbl i =
   match tbl.(i) with
     | SymbValue v -> v
-    | _ -> anomaly (Pp.str "get_value failed")
+    | _ -> anomaly (Pp.str "get_value failed.")
 
 let get_sort tbl i =
   match tbl.(i) with
     | SymbSort s -> s
-    | _ -> anomaly (Pp.str "get_sort failed")
+    | _ -> anomaly (Pp.str "get_sort failed.")
 
 let get_name tbl i =
   match tbl.(i) with
     | SymbName id -> id
-    | _ -> anomaly (Pp.str "get_name failed")
+    | _ -> anomaly (Pp.str "get_name failed.")
 
 let get_const tbl i =
   match tbl.(i) with
     | SymbConst kn -> kn
-    | _ -> anomaly (Pp.str "get_const failed")
+    | _ -> anomaly (Pp.str "get_const failed.")
 
 let get_match tbl i =
   match tbl.(i) with
     | SymbMatch case_info -> case_info
-    | _ -> anomaly (Pp.str "get_match failed")
+    | _ -> anomaly (Pp.str "get_match failed.")
 
 let get_ind tbl i =
   match tbl.(i) with
     | SymbInd ind -> ind
-    | _ -> anomaly (Pp.str "get_ind failed")
+    | _ -> anomaly (Pp.str "get_ind failed.")
 
 let get_meta tbl i =
   match tbl.(i) with
     | SymbMeta m -> m
-    | _ -> anomaly (Pp.str "get_meta failed")
+    | _ -> anomaly (Pp.str "get_meta failed.")
 
 let get_evar tbl i =
   match tbl.(i) with
     | SymbEvar ev -> ev
-    | _ -> anomaly (Pp.str "get_evar failed")
+    | _ -> anomaly (Pp.str "get_evar failed.")
 
 let get_level tbl i =
   match tbl.(i) with
     | SymbLevel u -> u
-    | _ -> anomaly (Pp.str "get_level failed")
+    | _ -> anomaly (Pp.str "get_level failed.")
 
 let push_symbol x =
   try HashtblSymbol.find symb_tbl x
@@ -276,7 +268,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
@@ -306,7 +298,7 @@ type primitive =
   | MLmagic
   | MLarrayget
   | Mk_empty_instance
-  | Coq_primitive of Primitives.t * (prefix * constant) option
+  | Coq_primitive of CPrimitives.t * (prefix * Constant.t) option
 
 let eq_primitive p1 p2 =
   match p1, p2 with
@@ -371,9 +363,9 @@ let primitive_hash = function
   | MLsub -> 33
   | MLmul -> 34
   | MLmagic -> 35
-  | Coq_primitive (prim, None) -> combinesmall 36 (Primitives.hash prim)
+  | Coq_primitive (prim, None) -> combinesmall 36 (CPrimitives.hash prim)
   | Coq_primitive (prim, Some (prefix,kn)) ->
-     combinesmall 37 (combine3 (String.hash prefix) (Constant.hash kn) (Primitives.hash prim))
+     combinesmall 37 (combine3 (String.hash prefix) (Constant.hash kn) (CPrimitives.hash prim))
   | Mk_proj -> 38
   | MLarrayget -> 39
   | Mk_empty_instance -> 40
@@ -635,7 +627,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
@@ -742,7 +734,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 () =
@@ -931,7 +923,7 @@ let merge_branches t =
 
 
 type prim_aux = 
-  | PAprim of string * constant * Primitives.t * prim_aux array
+  | PAprim of string * Constant.t * CPrimitives.t * prim_aux array
   | PAml of mllambda
 
 let add_check cond args =
@@ -998,11 +990,11 @@ let compile_prim decl cond paux =
         | Int31lt -> 
            if Sys.word_size = 64 then
              app_prim Mk_bool [|(app_prim MLlt (args_to_int args))|]
-           else app_prim (Coq_primitive (Primitives.Int31lt,None)) args
+           else app_prim (Coq_primitive (CPrimitives.Int31lt,None)) args
         | Int31le ->
            if Sys.word_size = 64 then
              app_prim Mk_bool [|(app_prim MLle (args_to_int args))|]
-           else app_prim (Coq_primitive (Primitives.Int31le, None)) args
+           else app_prim (Coq_primitive (CPrimitives.Int31le, None)) args
 	| Int31lsl  -> of_int (mk_lsl (args_to_int args))
 	| Int31lsr  -> of_int (mk_lsr (args_to_int args))
 	| Int31land -> of_int (mk_land (args_to_int args))
@@ -1057,11 +1049,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
@@ -1078,9 +1071,9 @@ let ml_of_instance instance u =
       MLlet(lname,def,body)
   | Lapp(f,args) ->
       MLapp(ml_of_lam env l f, Array.map (ml_of_lam env l) args)
-  | Lconst (prefix,c) ->
-     let args = ml_of_instance env.env_univ (snd c) in
-     mkMLapp (MLglobal(Gconstant (prefix,c))) args
+  | Lconst (prefix, (c, u)) ->
+     let args = ml_of_instance env.env_univ u in
+     mkMLapp (MLglobal(Gconstant (prefix, c))) args
   | Lproj (prefix,c) -> MLglobal(Gproj (prefix,c))
   | Lprim _ ->
       let decl,cond,paux = extract_prim (ml_of_lam env l) t in
@@ -1291,17 +1284,17 @@ let ml_of_instance instance u =
      MLconstruct(prefix,cn,args)
   | Lconstruct (prefix, (cn,u)) ->
      let uargs = ml_of_instance env.env_univ u in
-      mkMLapp (MLglobal (Gconstruct (prefix, (cn,u)))) uargs
+      mkMLapp (MLglobal (Gconstruct (prefix, cn))) uargs
   | Luint v ->
      (match v with
      | UintVal i -> MLapp(MLprimitive Mk_uint, [|MLuint i|])
      | UintDigits (prefix,cn,ds) ->
-	let c = MLglobal (Gconstruct (prefix, (cn, Univ.Instance.empty))) in
+	let c = MLglobal (Gconstruct (prefix, cn)) in
 	let ds = Array.map (ml_of_lam env l) ds in
 	let i31 = MLapp (MLprimitive Mk_I31_accu, [|c|]) in
 	MLapp(i31, ds)
      | UintDecomp (prefix,cn,t) ->
-	let c = MLglobal (Gconstruct (prefix, (cn, Univ.Instance.empty))) in
+	let c = MLglobal (Gconstruct (prefix, cn)) in
 	let t = ml_of_lam env l t in
 	MLapp (MLprimitive Decomp_uint, [|c;t|]))
   | Lval v ->
@@ -1314,9 +1307,9 @@ let ml_of_instance instance u =
     in
     let uarg = MLapp(MLprimitive MLmagic, [|uarg|]) in
     MLapp(MLprimitive Mk_sort, [|get_sort_code i; uarg|])
-  | Lind (prefix, pind) ->
-     let uargs = ml_of_instance env.env_univ (snd pind) in
-     mkMLapp (MLglobal (Gind (prefix, pind))) uargs
+  | Lind (prefix, (ind, u)) ->
+     let uargs = ml_of_instance env.env_univ u in
+     mkMLapp (MLglobal (Gind (prefix, ind))) uargs
   | Llazy -> MLglobal (Ginternal "lazy")
   | Lforce -> MLglobal (Ginternal "Lazy.force")
 
@@ -1514,7 +1507,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 ^ ".")
@@ -1533,27 +1526,27 @@ 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
-  | Gind (prefix, ((mind,i), _)) ->
+  | Gind (prefix, (mind, i)) ->
       Format.sprintf "%sindaccu_%s_%i" prefix (string_of_mind mind) i
-  | Gconstruct (prefix, (((mind, i), j), _)) ->
+  | Gconstruct (prefix, ((mind, i), j)) ->
       Format.sprintf "%sconstruct_%s_%i_%i" prefix (string_of_mind mind) i (j-1)
-  | Gconstant (prefix, (c,_)) ->
+  | Gconstant (prefix, c) ->
       Format.sprintf "%sconst_%s" prefix (string_of_con c)
   | Gproj (prefix, c) ->
       Format.sprintf "%sproj_%s" prefix (string_of_con c)
@@ -1731,7 +1724,7 @@ let pp_mllam fmt l =
     | Mk_cofix(start) -> Format.fprintf fmt "mk_cofix_accu %i" start
     | Mk_rel i -> Format.fprintf fmt "mk_rel_accu %i" i
     | Mk_var id ->
-        Format.fprintf fmt "mk_var_accu (Names.id_of_string \"%s\")" (string_of_id id)
+        Format.fprintf fmt "mk_var_accu (Names.Id.of_string \"%s\")" (string_of_id id)
     | Mk_proj -> Format.fprintf fmt "mk_proj_accu"
     | Is_accu -> Format.fprintf fmt "is_accu"
     | Is_int -> Format.fprintf fmt "is_int"
@@ -1762,11 +1755,10 @@ let pp_mllam fmt l =
     | MLarrayget -> Format.fprintf fmt "Array.get"
     | Mk_empty_instance -> Format.fprintf fmt "Univ.Instance.empty"
     | Coq_primitive (op,None) ->
-       Format.fprintf fmt "no_check_%s" (Primitives.to_string op)
+       Format.fprintf fmt "no_check_%s" (CPrimitives.to_string op)
     | Coq_primitive (op, Some (prefix,kn)) ->
-       let u = Univ.Instance.empty in
-        Format.fprintf fmt "%s %a" (Primitives.to_string op)
-		       pp_mllam (MLglobal (Gconstant (prefix,(kn,u))))
+        Format.fprintf fmt "%s %a" (CPrimitives.to_string op)
+		       pp_mllam (MLglobal (Gconstant (prefix, kn)))
   in
   Format.fprintf fmt "@[%a@]" pp_mllam l
   
@@ -1841,17 +1833,17 @@ 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
   auxdefs, MLlet(aux_name, ml, mkMLapp (MLlocal aux_name) (Array.of_list (fv_rel@fv_named)))
 
 and compile_rel env sigma univ auxdefs n =
-  let open Context.Rel in
-  let n = length env.env_rel_context - n in
-  let open Declaration in
-  match lookup n env.env_rel_context with
+  let open Context.Rel.Declaration 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
       let auxdefs,code = compile_with_fv env sigma univ auxdefs None code in
@@ -1872,9 +1864,10 @@ and compile_named env sigma univ auxdefs id =
 let compile_constant env sigma prefix ~interactive con cb =
   match cb.const_proj with
   | None ->
-     let u =
-       if cb.const_polymorphic then Univ.UContext.instance cb.const_universes
-       else Univ.Instance.empty
+     let no_univs =
+       match cb.const_universes with
+       | Monomorphic_const _ -> true
+       | Polymorphic_const ctx -> Int.equal (Univ.AUContext.size ctx) 0
      in
     begin match cb.const_body with
     | Def t ->
@@ -1887,9 +1880,9 @@ 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 Univ.Instance.is_empty u then compile_with_fv env sigma None [] (Some l) code
+	if no_univs then compile_with_fv env sigma None [] (Some l) code
 	else
 	  let univ = fresh_univ () in
 	  let (auxdefs,code) = compile_with_fv env sigma (Some univ) [] (Some l) code in
@@ -1897,25 +1890,24 @@ let compile_constant env sigma prefix ~interactive con cb =
       in
       if !Flags.debug then Feedback.msg_debug (Pp.str "Generated mllambda code");
       let code =
-        optimize_stk (Glet(Gconstant ("",(con,u)),code)::auxdefs)
+        optimize_stk (Glet(Gconstant ("", con),code)::auxdefs)
       in
       if !Flags.debug then Feedback.msg_debug (Pp.str "Optimized mllambda code");
       code, name
     | _ -> 
         let i = push_symbol (SymbConst con) in
 	let args =
-	  if Univ.Instance.is_empty u then [|get_const_code i; MLarray [||]|]
+	  if no_univs then [|get_const_code i; MLarray [||]|]
 	  else [|get_const_code i|]
 	in
 	(*
 	let t = mkMLlam [|univ|] (mkMLapp (MLprimitive Mk_const)
 	 *)
-        [Glet(Gconstant ("",(con,u)), mkMLapp (MLprimitive Mk_const) args)],
+        [Glet(Gconstant ("", con), mkMLapp (MLprimitive Mk_const) args)],
 	  if interactive then LinkedInteractive prefix
 	  else Linked prefix
     end
   | Some pb ->
-      let u = Univ.Instance.empty in
       let mind = pb.proj_ind in
       let ind = (mind,0) in
       let mib = lookup_mind mind env in
@@ -1930,19 +1922,21 @@ 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
-        Glet(Gconstant ("",(con,u)), mkMLlam fargs (MLapp (MLglobal gn, [|MLlocal
+        Glet(Gconstant ("", con), mkMLlam fargs (MLapp (MLglobal gn, [|MLlocal
           arg|])))::
             [Glet(gn, mkMLlam [|c_uid|] code)], Linked prefix
 
@@ -1966,18 +1960,18 @@ 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_instance mb in
+  let u = Declareops.inductive_polymorphic_context mb in
   let f i stack ob =
     let gtype = Gtype((mind, i), Array.map snd ob.mind_reloc_tbl) in
     let j = push_symbol (SymbInd (mind,i)) in
-    let name = Gind ("", ((mind, i), u)) in
+    let name = Gind ("", (mind, i)) in
     let accu =
       let args =
-	if Univ.Instance.is_empty u then
+	if Int.equal (Univ.AUContext.size u) 0 then
 	  [|get_ind_code j; MLarray [||]|]
 	else [|get_ind_code j|]
       in
@@ -1989,7 +1983,7 @@ let compile_mind prefix ~interactive mb mind stack =
     let add_construct j acc (_,arity) = 
       let args = Array.init arity (fun k -> {lname = arg_name; luid = k}) in 
       let c = (mind,i), (j+1) in
-	  Glet(Gconstruct ("",(c,u)),
+	  Glet(Gconstruct ("", c),
 	     mkMLlam (Array.append params args)
 	       (MLconstruct("", c, Array.map (fun id -> MLlocal id) args)))::acc
     in
@@ -2026,21 +2020,22 @@ 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
+let compile_deps env sigma prefix ~interactive init t =
+  let rec aux env lvl init t =
+  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
-      let cb,(nameref,_) = lookup_constant_key c env in
-      let (_, (_, const_updates)) = init in
-      if is_code_loaded ~interactive nameref
-        || (Cmap_env.mem c const_updates)
-      then init
-      else
+    let c,u = get_alias env c in
+    let cb,(nameref,_) = lookup_constant_key c env in
+    let (_, (_, const_updates)) = init in
+    if is_code_loaded ~interactive nameref
+    || (Cmap_env.mem c const_updates)
+    then init
+    else
       let comp_stack, (mind_updates, const_updates) =
 	match cb.const_proj, cb.const_body with
         | None, Def t ->
-	   compile_deps env sigma prefix ~interactive init (Mod_subst.force_constr t)
+           aux env lvl init (Mod_subst.force_constr t)
 	| Some pb, _ ->
 	   let mind = pb.proj_ind in
 	   compile_mind_deps env prefix ~interactive init mind
@@ -2055,12 +2050,30 @@ let rec compile_deps env sigma prefix ~interactive init t =
   | Construct (((mind,_),_),u) -> compile_mind_deps env prefix ~interactive init mind
   | Proj (p,c) ->
     let term = mkApp (mkConst (Projection.constant p), [|c|]) in
-      compile_deps env sigma prefix ~interactive init term
+    aux env lvl init term
   | 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
+      fold_constr_with_binders succ (aux env) lvl init t
+  | Var id ->
+    let open Context.Named.Declaration in
+    begin match lookup_named id env with
+      | LocalDef (_,t,_) ->
+        aux env lvl init t
+      | _ -> init
+    end
+  | Rel n when n > lvl ->
+    let open Context.Rel.Declaration in
+    let decl = lookup_rel n env in
+    let env = env_of_rel n env in
+    begin match decl with
+    | LocalDef (_,t,_) ->
+      aux env lvl init t
+    | LocalAssum _ -> init
+    end
+  | _ -> fold_constr_with_binders succ (aux env) lvl init t
+  in
+  aux env 0 init t
 
 let compile_constant_field env prefix con acc cb =
     let (gl, _) =
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index 77d9c33f..4b23cc5f 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
-open Term
 open Names
+open Constr
 open Declarations
 open Pre_env
 open Nativelambda
@@ -32,11 +34,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 +46,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 +62,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 3c0afe38..2a7afdca 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -54,13 +56,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 +119,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 =
@@ -128,11 +135,30 @@ and conv_fix env lvl t1 f1 t2 f2 cu =
     else aux (i+1) (conv_val env CONV flvl fi1 fi2 cu) in
   aux 0 cu
 
+let warn_no_native_compiler =
+  let open Pp in
+  CWarnings.create ~name:"native-compiler-disabled" ~category:"native-compiler"
+         (fun () -> strbrk "Native compiler is disabled," ++
+                      strbrk " falling back to VM conversion test.")
+
+type vm_conv_gen = { vm_conv_gen : 'a. conv_pb -> (Constr.types, 'a) generic_conversion_function }
+
+let vm_conv_gen =
+  ref { vm_conv_gen = fun cv_pb env univs t1 t2 ->
+    generic_conv cv_pb ~l2r:false (fun _ -> None) full_transparent_state env univs t1 t2 }
+
+let set_vm_conv_gen f = vm_conv_gen := f
+
 let native_conv_gen pb sigma env univs t1 t2 =
+  if not Coq_config.native_compiler then begin
+    warn_no_native_compiler ();
+    vm_conv_gen.contents.vm_conv_gen pb env univs t1 t2
+  end
+  else
   let penv = Environ.pre_env env in 
   let ml_filename, prefix = get_ml_filename () in
   let code, upds = mk_conv_code penv sigma prefix t1 t2 in
-  match compile ml_filename code with
+  match compile ml_filename code ~profile:false with
   | (true, fn) ->
       begin
         if !Flags.debug then Feedback.msg_debug (Pp.str "Running test...");
@@ -141,24 +167,13 @@ let native_conv_gen pb sigma env univs t1 t2 =
         let t1 = Sys.time () in
         let time_info = Format.sprintf "Evaluation done in %.5f@." (t1 -. t0) in
         if !Flags.debug then Feedback.msg_debug (Pp.str time_info);
-        (* TODO change 0 when we can have deBruijn *)
+        (* TODO change 0 when we can have de Bruijn *)
         fst (conv_val env pb 0 !rt1 !rt2 univs)
       end
-  | _ -> anomaly (Pp.str "Compilation failure") 
-
-let warn_no_native_compiler =
-  let open Pp in
-  CWarnings.create ~name:"native-compiler-disabled" ~category:"native-compiler"
-         (fun () -> strbrk "Native compiler is disabled," ++
-                      strbrk " falling back to VM conversion test.")
+  | _ -> anomaly (Pp.str "Compilation failure.") 
 
 (* Wrapper for [native_conv] above *)
 let native_conv cv_pb sigma env t1 t2 =
-  if Coq_config.no_native_compiler then begin
-    warn_no_native_compiler ();
-    vm_conv cv_pb env t1 t2
-  end
-  else
   let univs = Environ.universes env in
   let b =
     if cv_pb = CUMUL then Constr.leq_constr_univs univs t1 t2
diff --git a/kernel/nativeconv.mli b/kernel/nativeconv.mli
index 63b1eb05..b603e3bd 100644
--- a/kernel/nativeconv.mli
+++ b/kernel/nativeconv.mli
@@ -1,11 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
-open Term
+open Constr
 open Reduction
 open Nativelambda
 
@@ -16,3 +18,7 @@ val native_conv : conv_pb -> evars -> types kernel_conversion_function
 (** A conversion function parametrized by a universe comparator. Used outside of
     the kernel. *)
 val native_conv_gen : conv_pb -> evars -> (types, 'a) generic_conversion_function
+
+type vm_conv_gen = { vm_conv_gen : 'a. conv_pb -> (Constr.types, 'a) generic_conversion_function }
+
+val set_vm_conv_gen : vm_conv_gen -> unit
diff --git a/kernel/nativeinstr.mli b/kernel/nativeinstr.mli
index 41e79a53..c319be32 100644
--- a/kernel/nativeinstr.mli
+++ b/kernel/nativeinstr.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 open Names
-open Term
+open Constr
 open Nativevalues
 
 (** This file defines the lambda code for the native compiler. It has been
@@ -20,22 +22,22 @@ 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 * Primitives.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
   | Lfix          of (int array * int) * fix_decl 
-  | Lcofix        of int * fix_decl 
+  | Lcofix        of int * fix_decl (* must be in eta-expanded form *)
   | Lmakeblock    of prefix * pconstructor * int * lambda array
                   (* prefix, constructor name, constructor tag, arguments *)
 	(* A fully applied constructor *)
@@ -43,11 +45,15 @@ 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 
+(* Cofixpoints have to be in eta-expanded form for their call-by-need evaluation
+to be correct. Otherwise, memoization of previous evaluations will be applied
+again to extra arguments (see #7333). *)
 
-and fix_decl =  name array * lambda array * lambda array
+and lam_branches = (constructor * Name.t array * lambda) array 
+
+and fix_decl =  Name.t array * lambda array * lambda array
diff --git a/kernel/nativelambda.ml b/kernel/nativelambda.ml
index 91b40be7..b34eede6 100644
--- a/kernel/nativelambda.ml
+++ b/kernel/nativelambda.ml
@@ -1,20 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 open Util
 open Names
 open Esubst
-open Term
+open Constr
 open Declarations
 open Pre_env
 open Nativevalues
 open Nativeinstr
 
-(** This file defines the lambda code generation phase of the native compiler *)
+module RelDecl = Context.Rel.Declaration
+
 
 exception NotClosed
 
@@ -82,10 +85,10 @@ 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 _
-  | Lconstruct _ | Llazy | Lforce | Lmeta _ | Levar _ -> lam
+  | Lrel _ | Lvar _  | Lconst _ | Lproj _ | Lval _ | Lsort _ | Lind _
+  | Lconstruct _ | Llazy | Lforce | Lmeta _ -> lam
   | Lprod(dom,codom) -> 
       let dom' = f n dom in
       let codom' = f n codom in
@@ -133,6 +136,23 @@ 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'
+  | Levar (evk, ty, args) ->
+    let ty' = f n ty in
+    let args' = Array.smartmap (f n) args in
+    if ty == ty' && args == args' then lam else Levar (evk, ty', args')
+
+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 *)
  
@@ -159,10 +179,6 @@ let rec lam_exsubst subst lam =
   | Lrel(id,i) -> lam_subst_rel lam id i subst
   | _ -> map_lam_with_binders liftn lam_exsubst subst lam
 
-let lam_subst subst lam =
-  if is_subs_id subst then lam
-  else lam_exsubst subst lam
-
 let lam_subst_args subst args =
   if is_subs_id subst then args 
   else Array.smartmap (lam_exsubst subst) args
@@ -276,71 +292,6 @@ and reduce_lapp substf lids body substa largs =
       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 Int.equal n k then 
-	if kind then false else raise Not_found
-      else kind
-  | Lvar _  | Lconst _  | Lproj _ | Luint _ | Lval _ | Lsort _ | Lind _
-  | Lconstruct _ | Llazy | Lforce | Lmeta _ | Levar _ -> 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(_,t,a,br) ->
-      let kind = occurrence k (occurrence k kind t) a in
-      let r = ref kind in
-      Array.iter (fun (_,ids,c) -> 
-	r := occurrence (k+Array.length ids) kind c && !r) br;
-      !r 
-  | Lif (t, bt, bf) ->
-      let kind = occurrence k kind t in
-      kind && occurrence k kind bt && occurrence k kind bf
-  | 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 
-
-and occurrence_args k kind args =
-  Array.fold_left (occurrence k) kind args
-    
-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 *)
@@ -349,15 +300,17 @@ let is_value lc =
   match lc with
   | Lval _ -> true
   | Lmakeblock(_,_,_,args) when Array.is_empty args -> true
+  | Luint (UintVal _) -> true
   | _ -> false
-	
+
 let get_value lc =
   match lc with
   | Lval v -> v
-  | Lmakeblock(_,_,tag,args) when Array.is_empty args -> 
+  | Lmakeblock(_,_,tag,args) when Array.is_empty args ->
       Nativevalues.mk_int tag
+  | Luint (UintVal i) -> Nativevalues.mk_uint i
   | _ -> raise Not_found
-	
+
 let make_args start _end =
   Array.init (start - _end + 1) (fun i -> Lrel (Anonymous, start - i))
     
@@ -405,8 +358,6 @@ module Vect =
       size = 0;
     }
 
-    let length v = v.size
-
     let extend v =
       if Int.equal v.size (Array.length v.elems) then 
 	let new_size = min (2*v.size) Sys.max_array_length in
@@ -420,33 +371,15 @@ module Vect =
       v.elems.(v.size) <- a;
       v.size <- v.size + 1
 
-    let push_pos v a =
-      let pos = v.size in
-      push v a;
-      pos
-
     let popn v n =
       v.size <- max 0 (v.size - n)
 
     let pop v = popn v 1
 	
-    let get v n =
-      if v.size <= n then invalid_arg "Vect.get:index out of bounds";
-      v.elems.(n)
-
     let get_last v n =
       if v.size <= n then invalid_arg "Vect.get:index out of bounds";
       v.elems.(v.size - n - 1)
 
-
-    let last v =
-      if Int.equal v.size 0 then invalid_arg "Vect.last:index out of bounds";
-      v.elems.(v.size - 1)
-
-    let clear v = v.size <- 0
-
-    let to_array v = Array.sub v.elems 0 v.size
-      
   end
 
 let empty_args = [||]
@@ -466,7 +399,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;
 
        }
@@ -505,9 +438,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
@@ -536,16 +469,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 ty = evar_type sigma ev in
+        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
@@ -568,7 +502,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
@@ -603,7 +537,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 *)
@@ -642,6 +576,7 @@ let rec lambda_of_constr env sigma c =
       Lfix(rec_init, (names, ltypes, lbodies))
 	
   | CoFix(init,(names,type_bodies,rec_bodies)) ->
+      let rec_bodies = Array.map2 (Hook.get Clambda.eta_expand !global_env) rec_bodies type_bodies in
       let ltypes = lambda_of_args env sigma 0 type_bodies in 
       Renv.push_rels env names;
       let lbodies = lambda_of_args env sigma 0 rec_bodies in
@@ -649,7 +584,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
@@ -727,8 +662,7 @@ let optimize lam =
 let lambda_of_constr env sigma c =
   set_global_env env;
   let env = Renv.make () in
-  let open Context.Rel.Declaration in
-  let ids = List.rev_map get_name !global_env.env_rel_context in
+  let ids = List.rev_map RelDecl.get_name !global_env.env_rel_context.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
@@ -745,7 +679,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 c3357440..9a1e19b3 100644
--- a/kernel/nativelambda.mli
+++ b/kernel/nativelambda.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 open Names
-open Term
+open Constr
 open Pre_env
 open Nativeinstr
 
@@ -18,13 +20,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 +40,5 @@ val compile_dynamic_int31 : bool -> prefix -> constructor -> lambda array ->
 val before_match_int31 : inductive -> bool -> prefix -> constructor -> lambda ->
 			 lambda
 
-val compile_prim : Primitives.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 1c58c744..f784509b 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 open Util
 open Nativevalues
@@ -15,7 +17,7 @@ open Envars
 used by the native compiler. *)
 
 let get_load_paths =
-  ref (fun _ -> anomaly (Pp.str "get_load_paths not initialized") : unit -> string list)
+  ref (fun _ -> anomaly (Pp.str "get_load_paths not initialized.") : unit -> string list)
 
 let open_header = ["Nativevalues";
                    "Nativecode";
@@ -35,7 +37,7 @@ let ( / ) = Filename.concat
 (* We have to delay evaluation of include_dirs because coqlib cannot be guessed
 until flags have been properly initialized *)
 let include_dirs () =
-  [Filename.temp_dir_name; coqlib () / "kernel"; coqlib () / "library"]
+  [Filename.get_temp_dir_name (); coqlib () / "kernel"; coqlib () / "library"]
 
 (* Pointer to the function linking an ML object into coq's toplevel *)
 let load_obj = ref (fun x -> () : string -> unit)
@@ -64,7 +66,8 @@ let warn_native_compiler_failed =
   in
   CWarnings.create ~name:"native-compiler-failed" ~category:"native-compiler" print
 
-let call_compiler ml_filename =
+let call_compiler ?profile:(profile=false) ml_filename =
+  let () = assert Coq_config.native_compiler in
   let load_path = !get_load_paths () in
   let load_path = List.map (fun dn -> dn / output_dir) load_path in
   let include_dirs = List.flatten (List.map (fun x -> ["-I"; x]) (include_dirs () @ load_path)) in
@@ -74,14 +77,37 @@ let call_compiler ml_filename =
   let remove f = if Sys.file_exists f then Sys.remove f in
   remove link_filename;
   remove (f ^ ".cmi");
+  let initial_args =
+    if Dynlink.is_native then
+      ["opt"; "-shared"]
+     else
+      ["ocamlc"; "-c"]
+  in
+  let profile_args =
+    if profile then
+      ["-g"]
+    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 =
-    (if Dynlink.is_native then "opt" else "ocamlc")
-    ::(if Dynlink.is_native then "-shared" else "-c")
-    ::"-o"::link_filename
-    ::"-rectypes"
-    ::"-w"::"a"
-    ::include_dirs
-    @ ["-impl"; ml_filename] in
+    initial_args @
+      profile_args @
+        flambda_args @
+      ("-o"::link_filename
+       ::"-rectypes"
+       ::"-w"::"a"
+       ::include_dirs) @
+      ["-impl"; ml_filename] in
   if !Flags.debug then Feedback.msg_debug (Pp.str (ocamlfind () ^ " " ^ (String.concat " " args)));
   try
     let res = CUnix.sys_command (ocamlfind ()) args in
@@ -95,9 +121,9 @@ let call_compiler ml_filename =
     warn_native_compiler_failed (Inr e);
     false, link_filename
 
-let compile fn code =
+let compile fn code ~profile:profile =
   write_ml_code fn code;
-  let r = call_compiler fn in
+  let r = call_compiler ~profile fn in
   if (not !Flags.debug) && Sys.file_exists fn then Sys.remove fn;
   r
 
@@ -125,7 +151,7 @@ let call_linker ?(fatal=true) prefix f upds =
   if not (Sys.file_exists f) then
     begin
       let msg = "Cannot find native compiler file " ^ f in
-      if fatal then CErrors.error msg
+      if fatal then CErrors.user_err Pp.(str msg)
       else if !Flags.debug then Feedback.msg_debug (Pp.str msg)
     end
   else
@@ -134,9 +160,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 12ad3cf2..25adcf22 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 open Nativecode
 
@@ -19,9 +21,9 @@ val load_obj : (string -> unit) ref
 
 val get_ml_filename : unit -> string * string
 
-val compile : string -> global list -> bool * 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 246b00da..c69cf722 100644
--- a/kernel/nativelibrary.ml
+++ b/kernel/nativelibrary.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -26,7 +28,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 7d01640b..31e5255f 100644
--- a/kernel/nativelibrary.mli
+++ b/kernel/nativelibrary.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 open Names
 open Declarations
@@ -13,5 +15,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 8093df30..066dfc39 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -1,14 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
-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,42 +54,43 @@ 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
 
-let accumulate_code (k:accumulator) (x:t) =
-  let o = Obj.repr k in
-  let osize = Obj.size o in
-  let r = Obj.new_block accumulate_tag (osize + 1) in
-  for i = 0 to osize - 1 do
-    Obj.set_field r i (Obj.field o i)
-  done;
-  Obj.set_field r osize (Obj.repr x);
-  (Obj.obj r:t)
-
-let rec accumulate (x:t) =
-  accumulate_code (Obj.magic accumulate) x
-
-let mk_accu_gen rcode (a:atom) =
-(*  Format.eprintf "size rcode =%i\n" (Obj.size (Obj.magic rcode)); *)
-  let r = Obj.new_block 0 3 in
-  Obj.set_field r 0 (Obj.field (Obj.magic rcode) 0);
-  Obj.set_field r 1 (Obj.field (Obj.magic rcode) 1);
-  Obj.set_field r 2 (Obj.magic a);
-  (Obj.magic r:t);;
-
-let mk_accu (a:atom) = mk_accu_gen accumulate a
+(** Unique pointer used to drive the accumulator function *)
+let ret_accu = Obj.repr (ref ())
+
+type accu_val = { mutable acc_atm : atom; acc_arg : Obj.t list }
+
+let mk_accu (a : atom) : t =
+  let rec accumulate data x =
+    if x == ret_accu then Obj.repr data
+    else
+      let data = { data with acc_arg = x :: data.acc_arg } in
+      let ans = Obj.repr (accumulate data) in
+      let () = Obj.set_tag ans accumulate_tag in
+      ans
+  in
+  let acc = { acc_atm = a; acc_arg = [] } in
+  let ans = Obj.repr (accumulate acc) in
+  (** FIXME: use another representation for accumulators, this causes naked
+      pointers. *)
+  let () = Obj.set_tag ans accumulate_tag in
+  (Obj.obj ans : t)
+
+let get_accu (k : accumulator) =
+  (Obj.magic k : Obj.t -> accu_val) ret_accu
 
 let mk_rel_accu i = 
   mk_accu (Arel i)
@@ -111,6 +115,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,39 +135,34 @@ 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))
 
 let atom_of_accu (k:accumulator) =
-  (Obj.magic (Obj.field (Obj.magic k) 2) : atom)
+  (get_accu k).acc_atm
 
 let set_atom_of_accu (k:accumulator) (a:atom) =
-  Obj.set_field (Obj.magic k) 2 (Obj.magic a)
+  (get_accu k).acc_atm <- a
 
 let accu_nargs (k:accumulator) =
-  let nargs = Obj.size (Obj.magic k) - 3 in
-(*  if nargs < 0 then Format.eprintf "nargs = %i\n" nargs; *)
-  assert (nargs >= 0);
-  nargs
+  List.length (get_accu k).acc_arg
 
 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
+  let acc = (get_accu k).acc_arg in
+  (Obj.magic (Array.of_list acc) : t array)
 
 let is_accu x =
   let o = Obj.repr x in
   Obj.is_block o && Int.equal (Obj.tag o) accumulate_tag
 
 let mk_fix_accu rec_pos pos types bodies =
-  mk_accu_gen accumulate (Afix(types,bodies,rec_pos, pos))
+  mk_accu (Afix(types,bodies,rec_pos, pos))
 
 let mk_cofix_accu pos types norm =
-  mk_accu_gen accumulate (Acofix(types,norm,pos,(Obj.magic 0 : t)))
+  mk_accu (Acofix(types,norm,pos,(Obj.magic 0 : t)))
 
 let upd_cofix (cofix :t) (cofix_fun : t) =
   let atom = atom_of_accu (Obj.magic cofix) in
@@ -177,11 +177,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
@@ -200,7 +199,7 @@ let mk_block tag args =
 (* Two instances of dummy_value should not be pointer equal, otherwise
  comparing them as terms would succeed *)
 let dummy_value : unit -> t =
-  fun () _ -> anomaly ~label:"native" (Pp.str "Evaluation failed")
+  fun () _ -> anomaly ~label:"native" (Pp.str "Evaluation failed.")
 
 let cast_accu v = (Obj.magic v:accumulator)
 
@@ -334,6 +333,7 @@ let l_or accu x y =
   if is_int x && is_int y then no_check_l_or x y
   else accu x y
 
+[@@@ocaml.warning "-37"]
 type coq_carry = 
   | Caccu of t
   | C0 of t
@@ -430,7 +430,7 @@ let addmuldiv accu x y z =
   if is_int x && is_int y && is_int z then no_check_addmuldiv x y z
   else accu x y z
 
-
+[@@@ocaml.warning "-34"]
 type coq_bool =
   | Baccu of t
   | Btrue
@@ -491,12 +491,12 @@ let str_encode expr =
 let str_decode s =
   let mshl_expr_len = String.length s / 2 in
   let mshl_expr = Buffer.create mshl_expr_len in
-  let buf = String.create 2 in
+  let buf = Bytes.create 2 in
   for i = 0 to mshl_expr_len - 1 do
-    String.blit s (2*i) buf 0 2;
-    Buffer.add_char mshl_expr (bin_of_hex buf)
+    Bytes.blit_string s (2*i) buf 0 2;
+    Buffer.add_char mshl_expr (bin_of_hex (Bytes.to_string buf))
   done;
-  Marshal.from_string (Buffer.contents mshl_expr) 0
+  Marshal.from_bytes (Buffer.to_bytes mshl_expr) 0
 
 (** Retroknowledge, to be removed when we switch to primitive integers *)
 
diff --git a/kernel/nativevalues.mli b/kernel/nativevalues.mli
index f4396659..4a58a3c7 100644
--- a/kernel/nativevalues.mli
+++ b/kernel/nativevalues.mli
@@ -1,11 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
-open Term
+open Constr
 open Names
 
 (** This modules defines the representation of values internally used by
@@ -43,33 +45,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 +86,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 130f1eb0..a484c08e 100644
--- a/kernel/opaqueproof.ml
+++ b/kernel/opaqueproof.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Univ
-open Term
+open Constr
 open Mod_subst
 
 type work_list = (Instance.t * Id.t array) Cmap.t * 
@@ -16,22 +18,31 @@ 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.UContext.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
-type opaquetab = (cooking_info list * proofterm) Int.Map.t * DirPath.t
-let empty_opaquetab = Int.Map.empty, DirPath.initial
+type opaquetab = {
+  opaque_val : (cooking_info list * proofterm) Int.Map.t;
+  (** Actual proof terms *)
+  opaque_len : int;
+  (** Size of the above map *)
+  opaque_dir : DirPath.t;
+}
+let empty_opaquetab = {
+  opaque_val = Int.Map.empty;
+  opaque_len = 0;
+  opaque_dir = DirPath.initial;
+}
 
 (* hooks *)
 let default_get_opaque dp _ =
-  CErrors.error
-    ("Cannot access opaque proofs in library " ^ DirPath.to_string dp)
+  CErrors.user_err Pp.(pr_sequence str ["Cannot access opaque proofs in library"; DirPath.to_string dp])
 let default_get_univ dp _ =
-  CErrors.error
-    ("Cannot access universe constraints of opaque proofs in library " ^
-    DirPath.to_string dp)
+  CErrors.user_err (Pp.pr_sequence Pp.str [
+    "Cannot access universe constraints of opaque proofs in library ";
+    DirPath.to_string dp])
 
 let get_opaque = ref default_get_opaque
 let get_univ = ref default_get_univ
@@ -42,62 +53,66 @@ let set_indirect_univ_accessor f = (get_univ := f)
 
 let create cu = Direct ([],cu)
 
-let turn_indirect dp o (prfs,odp) = match o with
+let turn_indirect dp o tab = match o with
   | Indirect (_,_,i) ->
-      if not (Int.Map.mem i prfs)
-      then CErrors.anomaly (Pp.str "Indirect in a different table")
-      else CErrors.anomaly (Pp.str "Already an indirect opaque")
+      if not (Int.Map.mem i tab.opaque_val)
+      then CErrors.anomaly (Pp.str "Indirect in a different table.")
+      else CErrors.anomaly (Pp.str "Already an indirect opaque.")
   | Direct (d,cu) ->
-      let cu = Future.chain ~pure:true cu (fun (c, u) -> hcons_constr c, u) in
-      let id = Int.Map.cardinal prfs in
-      let prfs = Int.Map.add id (d,cu) prfs in
-      let ndp =
-        if DirPath.equal dp odp then odp
-        else if DirPath.equal odp DirPath.initial then dp
+      (** Uncomment to check dynamically that all terms turned into
+          indirections are hashconsed. *)
+(* let check_hcons c = let c' = hcons_constr c in assert (c' == c); c in *)
+(* let cu = Future.chain ~pure:true cu (fun (c, u) -> check_hcons c; c, u) in *)
+      let id = tab.opaque_len in
+      let opaque_val = Int.Map.add id (d,cu) tab.opaque_val in
+      let opaque_dir =
+        if DirPath.equal dp tab.opaque_dir then tab.opaque_dir
+        else if DirPath.equal tab.opaque_dir DirPath.initial then dp
         else CErrors.anomaly
-          (Pp.str "Using the same opaque table for multiple dirpaths") in
-      Indirect ([],dp,id), (prfs, ndp)
+          (Pp.str "Using the same opaque table for multiple dirpaths.") in
+      let ntab = { opaque_val; opaque_dir; opaque_len = id + 1 } in
+      Indirect ([],dp,id), ntab
 
 let subst_opaque sub = function
   | Indirect (s,dp,i) -> Indirect (sub::s,dp,i)
-  | Direct _ -> CErrors.anomaly (Pp.str "Substituting a Direct opaque")
+  | Direct _ -> CErrors.anomaly (Pp.str "Substituting a Direct opaque.")
 
 let iter_direct_opaque f = function
-  | Indirect _ -> CErrors.anomaly (Pp.str "Not a direct opaque")
+  | Indirect _ -> CErrors.anomaly (Pp.str "Not a direct opaque.")
   | Direct (d,cu) ->
-      Direct (d,Future.chain ~pure:true cu (fun (c, u) -> f c; c, u))
+      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")
+  | 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 (prfs,odp) = function
+let join_opaque { opaque_val = prfs; opaque_dir = odp } = function
   | Direct (_,cu) -> ignore(Future.join cu)
   | Indirect (_,dp,i) ->
       if DirPath.equal dp odp then
         let fp = snd (Int.Map.find i prfs) in
         ignore(Future.join fp)
 
-let uuid_opaque (prfs,odp) = function
+let uuid_opaque { opaque_val = prfs; opaque_dir = odp } = function
   | Direct (_,cu) -> Some (Future.uuid cu)
   | Indirect (_,dp,i) ->
       if DirPath.equal dp odp
       then Some (Future.uuid (snd (Int.Map.find i prfs)))
       else None
 
-let force_proof (prfs,odp) = function
+let force_proof { opaque_val = prfs; opaque_dir = odp } = function
   | Direct (_,cu) ->
       fst(Future.force cu)
   | 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))
 
-let force_constraints (prfs,odp) = function
+let force_constraints { opaque_val = prfs; opaque_dir = odp } = function
   | Direct (_,cu) -> snd(Future.force cu)
   | Indirect (_,dp,i) ->
       if DirPath.equal dp odp
@@ -106,37 +121,36 @@ let force_constraints (prfs,odp) = function
         | None -> Univ.ContextSet.empty
         | Some u -> Future.force u
 
-let get_constraints (prfs,odp) = function
-  | Direct (_,cu) -> Some(Future.chain ~pure:true cu snd)
+let get_constraints { opaque_val = prfs; opaque_dir = odp } = function
+  | 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 (prfs,odp) = function
-  | Direct (_,cu) -> Future.chain ~pure:true cu fst
+let get_proof { opaque_val = prfs; opaque_dir = odp } = function
+  | 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 = []
 
-let dump (otab,_) =
-  let n = Int.Map.cardinal otab in
+let dump { opaque_val = otab; opaque_len = n } =
   let opaque_table = Array.make n a_constr in
   let univ_table = Array.make n a_univ in
   let disch_table = Array.make n a_discharge in
   let f2t_map = ref FMap.empty in
   Int.Map.iter (fun n (d,cu) ->
-    let c, u = Future.split2 ~greedy:true cu in
+    let c, u = Future.split2 cu in
     Future.sink u;
     Future.sink c;
     opaque_table.(n) <- c;
diff --git a/kernel/opaqueproof.mli b/kernel/opaqueproof.mli
index 5139cf05..b6ae80b4 100644
--- a/kernel/opaqueproof.mli
+++ b/kernel/opaqueproof.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Mod_subst
 
 (** This module implements the handling of opaque proof terms.
@@ -19,7 +21,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
 
@@ -28,17 +30,18 @@ val empty_opaquetab : opaquetab
 (** From a [proofterm] to some [opaque]. *)
 val create : proofterm -> opaque
 
-(** Turn a direct [opaque] into an indirect one, also hashconses constr.
- *  The integer is an hint of the maximum id used so far *)
+(** Turn a direct [opaque] into an indirect one. It is your responsibility to
+  hashcons the inner term beforehand. The integer is an hint of the maximum id
+  used so far *)
 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
@@ -48,7 +51,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.UContext.t } 
+  abstract : Context.Named.t * Univ.Instance.t * Univ.AUContext.t }
 
 (* The type has two caveats:
    1) cook_constr is defined after
@@ -62,7 +65,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
 
@@ -74,7 +77,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 7be8606e..8ebe48e2 100644
--- a/kernel/pre_env.ml
+++ b/kernel/pre_env.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Benjamin Grégoire out of environ.ml for better
@@ -15,9 +17,9 @@
 
 open Util
 open Names
-open Term
 open Declarations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* The type of environments. *)
 
@@ -49,7 +51,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
@@ -66,15 +68,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;
-  env_named_context : named_context_val;
-  env_rel_context   : Context.Rel.t;
-  env_rel_val       : lazy_val list;
+  env_globals       : globals;           (* globals = constants + inductive types + modules + module-types *)
+  env_named_context : named_context_val; (* section variables *)
+  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;
 }
@@ -84,6 +89,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;
@@ -91,14 +101,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 }
 
@@ -107,31 +115,49 @@ 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
   }
 
 (* Named context *)
 
 let push_named_context_val_val d rval ctxt =
-(*   assert (not (Id.Map.mem (get_id d) ctxt.env_named_map)); *)
+(*   assert (not (Id.Map.mem (NamedDecl.get_id d) ctxt.env_named_map)); *)
   {
     env_named_ctx = Context.Named.add d ctxt.env_named_ctx;
-    env_named_map = Id.Map.add (get_id d) (d, rval) ctxt.env_named_map;
+    env_named_map = Id.Map.add (NamedDecl.get_id d) (d, rval) ctxt.env_named_map;
   }
 
 let push_named_context_val d ctxt =
@@ -140,8 +166,8 @@ let push_named_context_val d ctxt =
 let match_named_context_val c = match c.env_named_ctx with
 | [] -> None
 | decl :: ctx ->
-  let (_, v) = Id.Map.find (get_id decl) c.env_named_map in
-  let map = Id.Map.remove (get_id decl) c.env_named_map in
+  let (_, v) = Id.Map.find (NamedDecl.get_id decl) c.env_named_map in
+  let map = Id.Map.remove (NamedDecl.get_id decl) c.env_named_map in
   let cval = { env_named_ctx = ctx; env_named_map = map } in
   Some (decl, v, cval)
 
@@ -155,23 +181,12 @@ let map_named_val f ctxt =
     in
     (accu, d')
   in
-  let map, ctx = List.fold_map fold ctxt.env_named_map ctxt.env_named_ctx in
-  { env_named_ctx = ctx; env_named_map = map }
+  let map, ctx = List.fold_left_map fold ctxt.env_named_map ctxt.env_named_ctx in
+  if map == ctxt.env_named_map then ctxt
+  else { env_named_ctx = ctx; env_named_map = map }
 
 let push_named d env =
-(*  if not (env.env_rel_context = []) then raise (ASSERT env.env_rel_context);
-  assert (env.env_rel_context = []); *)
-  { env_globals = env.env_globals;
-    env_named_context = push_named_context_val d env.env_named_context;
-    env_rel_context = env.env_rel_context;
-    env_rel_val = env.env_rel_val;
-    env_nb_rel = env.env_nb_rel;
-    env_stratification = env.env_stratification;
-    env_typing_flags = env.env_typing_flags;
-    env_conv_oracle = env.env_conv_oracle;
-    retroknowledge = env.retroknowledge;
-    indirect_pterms = env.indirect_pterms;
-  }
+  {env with env_named_context = push_named_context_val d env.env_named_context}
 
 let lookup_named id env =
   fst (Id.Map.find id env.env_named_context.env_named_map)
diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli
index 86679036..b0507481 100644
--- a/kernel/pre_env.mli
+++ b/kernel/pre_env.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Declarations
 
 (** The type of environments. *)
@@ -36,24 +38,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 +69,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 +100,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 1ae89347..2ae676bc 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created under Benjamin Werner account by Bruno Barras to implement
@@ -18,7 +20,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open Environ
 open CClosure
@@ -57,12 +59,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
@@ -71,6 +75,17 @@ let rec zlapp v = function
     Zlapp v2 :: s -> zlapp (Array.append v v2) s
   | s -> Zlapp v :: s
 
+(** Hand-unrolling of the map function to bypass the call to the generic array
+    allocation. Type annotation is required to tell OCaml that the array does
+    not contain floats. *)
+let map_lift (l : lift) (v : fconstr array) = match v with
+| [||] -> assert false
+| [|c0|] -> [|(l, c0)|]
+| [|c0; c1|] -> [|(l, c0); (l, c1)|]
+| [|c0; c1; c2|] -> [|(l, c0); (l, c1); (l, c2)|]
+| [|c0; c1; c2; c3|] -> [|(l, c0); (l, c1); (l, c2); (l, c3)|]
+| v -> CArray.Fun1.map (fun l t -> (l, t)) l v
+
 let pure_stack lfts stk =
   let rec pure_rec lfts stk =
     match stk with
@@ -80,7 +95,7 @@ let pure_stack lfts stk =
               (Zupdate _,lpstk)  -> lpstk
             | (Zshift n,(l,pstk)) -> (el_shft n l, pstk)
             | (Zapp a, (l,pstk)) ->
-                (l,zlapp (Array.map (fun t -> (l,t)) a) pstk)
+                (l,zlapp (map_lift l a) pstk)
 	    | (Zproj (n,m,c), (l,pstk)) ->
 		(l, Zlproj (c,l)::pstk)
             | (Zfix(fx,a),(l,pstk)) ->
@@ -96,28 +111,60 @@ let pure_stack lfts stk =
 (****************************************************************************)
 
 let whd_betaiota env t =
-  whd_val (create_clos_infos betaiota env) (inject t)
+  match kind t with
+    | (Sort _|Var _|Meta _|Evar _|Const _|Ind _|Construct _|
+       Prod _|Lambda _|Fix _|CoFix _) -> t
+    | App (c, _) ->
+      begin match kind c with
+      | Ind _ | Construct _ | Evar _ | Meta _ | Const _ | LetIn _ -> t
+      | _ -> whd_val (create_clos_infos betaiota env) (create_tab ()) (inject t)
+      end
+    | _ -> whd_val (create_clos_infos betaiota env) (create_tab ()) (inject t)
 
 let nf_betaiota env t =
-  norm_val (create_clos_infos betaiota env) (inject t)
+  norm_val (create_clos_infos betaiota env) (create_tab ()) (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
-    | _ -> whd_val (create_clos_infos betaiotazeta env) (inject x)
+    | App (c, _) ->
+      begin match kind c with
+      | Ind _ | Construct _ | Evar _ | Meta _ | Const _ -> x
+      | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | LetIn _ | App _
+        | Case _ | Fix _ | CoFix _ | Proj _ ->
+         whd_val (create_clos_infos betaiotazeta env) (create_tab ()) (inject x)
+      end
+    | Rel _ | Cast _ | LetIn _ | Case _ | Proj _ ->
+        whd_val (create_clos_infos betaiotazeta env) (create_tab ()) (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
-    | _ -> whd_val (create_clos_infos all env) (inject t)
+    | App (c, _) ->
+      begin match kind c with
+      | Ind _ | Construct _ | Evar _ | Meta _ -> t
+      | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | LetIn _ | App _
+        | Const _ |Case _ | Fix _ | CoFix _ | Proj _ ->
+         whd_val (create_clos_infos all env) (create_tab ()) (inject t)
+      end
+    | Rel _ | Cast _ | LetIn _ | Case _ | Proj _ | Const _ | Var _ ->
+        whd_val (create_clos_infos all env) (create_tab ()) (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
-    | _ -> whd_val (create_clos_infos allnolet env) (inject t)
+    | App (c, _) ->
+      begin match kind c with
+      | Ind _ | Construct _ | Evar _ | Meta _ | LetIn _ -> t
+      | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | App _
+        | Const _ | Case _ | Fix _ | CoFix _ | Proj _ ->
+         whd_val (create_clos_infos allnolet env) (create_tab ()) (inject t)
+      end
+    | Rel _ | Cast _ | Case _ | Proj _ | Const _ | Var _ ->
+        whd_val (create_clos_infos allnolet env) (create_tab ()) (inject t)
 
 (********************************************************************)
 (*                         Conversion                               *)
@@ -155,24 +202,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;
-  } 
+    compare_cumul_instances : conv_pb -> Univ.Variance.t array ->
+      Univ.Instance.t -> Univ.Instance.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 get_cumulativity_constraints cv_pb variance u u' =
+  match cv_pb with
+  | CONV ->
+    Univ.enforce_eq_variance_instances variance u u' Univ.Constraint.empty
+  | CUMUL ->
+    Univ.enforce_leq_variance_instances variance 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
+      cmp_cumul cv_pb (Univ.ACumulativityInfo.variance cumi) u1 u2 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) =
+  mind.Declarations.mind_nparams +
+  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
+      (** By invariant, both constructors have a common supertype,
+          so they are convertible _at that type_. *)
+      let variance = Array.make (Univ.Instance.length u1) Univ.Variance.Irrelevant in
+      cmp_cumul CONV variance u1 u2 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
   match k1, k2 with
@@ -195,7 +297,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)) ->
@@ -212,57 +314,16 @@ let compare_stacks f fmind lft1 stk1 lft2 stk2 cuniv =
     cmp_rec (pure_stack lft1 stk1) (pure_stack lft2 stk2) cuniv
   else raise NotConvertible
 
-let rec no_arg_available = function
-  | [] -> true
-  | Zupdate _ :: stk -> no_arg_available stk
-  | Zshift _ :: stk -> no_arg_available stk
-  | Zapp v :: stk -> Int.equal (Array.length v) 0 && no_arg_available stk
-  | Zproj _ :: _ -> true
-  | ZcaseT _ :: _ -> true
-  | Zfix _ :: _ -> true
-
-let rec no_nth_arg_available n = function
-  | [] -> true
-  | Zupdate _ :: stk -> no_nth_arg_available n stk
-  | Zshift _ :: stk -> no_nth_arg_available n stk
-  | Zapp v :: stk ->
-      let k = Array.length v in
-      if n >= k then no_nth_arg_available (n-k) stk
-      else false
-  | Zproj _ :: _ -> true
-  | ZcaseT _ :: _ -> true
-  | Zfix _ :: _ -> true
-
-let rec no_case_available = function
-  | [] -> true
-  | Zupdate _ :: stk -> no_case_available stk
-  | Zshift _ :: stk -> no_case_available stk
-  | Zapp _ :: stk -> no_case_available stk
-  | Zproj (_,_,p) :: _ -> false
-  | ZcaseT _ :: _ -> false
-  | Zfix _ :: _ -> true
-
-let in_whnf (t,stk) =
-  match fterm_of t with
-    | (FLetIn _ | FCaseT _ | FApp _ 
-	  | FCLOS _ | FLIFT _ | FCast _) -> false
-    | FLambda _ -> no_arg_available stk
-    | FConstruct _ -> no_case_available stk
-    | FCoFix _ -> no_case_available stk
-    | FFix(((ri,n),(_,_,_)),_) -> no_nth_arg_available ri.(n) 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
+type conv_tab = {
+  cnv_inf : clos_infos;
+  lft_tab : fconstr infos_tab;
+  rgt_tab : fconstr infos_tab;
+}
+(** Invariant: for any tl ∈ lft_tab and tr ∈ rgt_tab, there is no mutable memory
+    location contained both in tl and in tr. *)
+
+(** The same heap separation invariant must hold for the fconstr arguments
+    passed to each respective side of the conversion function below. *)
 
 (* Conversion between  [lft1]term1 and [lft2]term2 *)
 let rec ccnv cv_pb l2r infos lft1 lft2 term1 term2 cuniv =
@@ -272,33 +333,29 @@ let rec ccnv cv_pb l2r infos lft1 lft2 term1 term2 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
-  let rec whd_both (t1,stk1) (t2,stk2) =
-    let st1' = whd t1 stk1 in
-    let st2' = whd t2 stk2 in
-    (* Now, whd_stack on term2 might have modified st1 (due to sharing),
-       and st1 might not be in whnf anymore. If so, we iterate ccnv. *)
-    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
+  let ninfos = infos_with_reds infos.cnv_inf betaiotazeta in
+  let (hd1, v1 as appr1) = whd_stack ninfos infos.lft_tab (fst st1) (snd st1) in
+  let (hd2, v2 as appr2) = whd_stack ninfos infos.rgt_tab (fst st2) (snd st2) in
+  let appr1 = (lft1, appr1) and appr2 = (lft2, appr2) 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
+		 anomaly (Pp.str "conversion was given ill-typed terms (Sort).");
+              sort_cmp_universes (env_of_infos infos.cnv_inf) cv_pb s1 s2 cuniv
 	   | (Meta n, Meta m) ->
                if Int.equal n m
-	       then convert_stacks 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 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)
@@ -307,6 +364,8 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
 
     (* 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 l2r infos lft1 lft2 v1 v2 cuniv
         else raise NotConvertible
@@ -314,25 +373,25 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
     (* 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 l2r infos lft1 lft2 v1 v2 cuniv
+          let cuniv = conv_table_key infos.cnv_inf fl1 fl2 cuniv in
+           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
+         let oracle = CClosure.oracle_of_infos infos.cnv_inf in
          let (app1,app2) =
            if Conv_oracle.oracle_order Univ.out_punivs oracle l2r fl1 fl2 then
-	     match unfold_reference infos fl1 with
-             | Some def1 -> ((lft1, whd def1 v1), appr2)
+             match unfold_reference infos.cnv_inf infos.lft_tab fl1 with
+             | Some def1 -> ((lft1, (def1, v1)), appr2)
              | None ->
-               (match unfold_reference infos fl2 with
-               | Some def2 -> (appr1, (lft2, whd def2 v2))
+               (match unfold_reference infos.cnv_inf infos.rgt_tab fl2 with
+               | Some def2 -> (appr1, (lft2, (def2, v2)))
 	       | None -> raise NotConvertible)
            else
-	     match unfold_reference infos fl2 with
-             | Some def2 -> (appr1, (lft2, whd def2 v2))
+             match unfold_reference infos.cnv_inf infos.rgt_tab fl2 with
+             | Some def2 -> (appr1, (lft2, (def2, v2)))
              | None ->
-               (match unfold_reference infos fl1 with
-               | Some def1 -> ((lft1, whd def1 v1), appr2)
+               (match unfold_reference infos.cnv_inf infos.lft_tab fl1 with
+               | Some def1 -> ((lft1, (def1, v1)), appr2)
 	       | None -> raise NotConvertible) 
 	 in
            eqappr cv_pb l2r infos app1 app2 cuniv)
@@ -341,44 +400,46 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
       (* 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 cv_pb l2r infos (lft1, whd def1 (s1 :: v1)) appr2 cuniv
+      (match unfold_projection infos.cnv_inf 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 cv_pb l2r infos appr1 (lft2, whd def2 (s2 :: v2)) cuniv
+        match unfold_projection infos.cnv_inf 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 CONV l2r infos el1 el2 c1 c2 cuniv in
-	      convert_stacks 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 cv_pb l2r infos (lft1, whd def1 (s1 :: v1)) appr2 cuniv
+      (match unfold_projection infos.cnv_inf 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
+            (match unfold_reference infos.cnv_inf infos.rgt_tab fl2 with
               | Some def2 ->
-		 eqappr cv_pb l2r infos appr1 (lft2, whd 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 cv_pb l2r infos appr1 (lft2, whd def2 (s2 :: v2)) cuniv
+      (match unfold_projection infos.cnv_inf 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
+            (match unfold_reference infos.cnv_inf infos.lft_tab fl1 with
               | Some def1 ->
-		 eqappr cv_pb l2r infos (lft1, whd def1 v1) appr2 cuniv
+                 eqappr cv_pb l2r infos (lft1, (def1, v1)) appr2 cuniv
               | None -> raise NotConvertible)
 	  | _ -> raise NotConvertible))
       
@@ -387,16 +448,20 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
         (* Inconsistency: we tolerate that v1, v2 contain shift and update but
            we throw them away *)
         if not (is_empty_stack v1 && is_empty_stack v2) then
-	  anomaly (Pp.str "conversion was given ill-typed terms (FLambda)");
+	  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 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)");
+	  anomaly (Pp.str "conversion was given ill-typed terms (FProd).");
 	(* Luo's system *)
+        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
 
@@ -405,78 +470,102 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
         let () = match v1 with
         | [] -> ()
         | _ ->
-          anomaly (Pp.str "conversion was given unreduced term (FLambda)")
+          anomaly (Pp.str "conversion was given unreduced term (FLambda).")
         in
         let (_,_ty1,bd1) = destFLambda mk_clos hd1 in
-	eqappr 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
         | [] -> ()
         | _ ->
-	  anomaly (Pp.str "conversion was given unreduced term (FLambda)")
+	  anomaly (Pp.str "conversion was given unreduced term (FLambda).")
 	in
         let (_,_ty2,bd2) = destFLambda mk_clos hd2 in
-	eqappr 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
+       (match unfold_reference infos.cnv_inf infos.lft_tab fl1 with
 	| Some def1 ->
-	   eqappr cv_pb l2r infos (lft1, whd 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.cnv_inf)) in
+            let r1 = whd_stack (infos_with_reds infos.cnv_inf all) infos.lft_tab 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 l2r infos lft1 lft2 v1 v2 cuniv
+                eta_expand_ind_stack (info_env infos.cnv_inf) ind2 hd2 v2 (snd appr1)
+              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
+       (match unfold_reference infos.cnv_inf infos.rgt_tab fl2 with
         | Some def2 ->
-	   eqappr cv_pb l2r infos appr1 (lft2, whd def2 v2) cuniv
+          (** Symmetrical case of above. *)
+          let all = RedFlags.red_add_transparent all (RedFlags.red_transparent (info_flags infos.cnv_inf)) in
+          let r2 = whd_stack (infos_with_reds infos.cnv_inf all) infos.rgt_tab 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 l2r infos lft1 lft2 v1 v2 cuniv
+                    eta_expand_ind_stack (info_env infos.cnv_inf) ind1 hd1 v1 (snd appr2)
+                   in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
 	       with Not_found -> raise NotConvertible)
 	   | _ -> raise NotConvertible)
        
     (* Inductive types:  MutInd MutConstruct Fix Cofix *)
-
     | (FInd (ind1,u1), FInd (ind2,u2)) ->
-        if eq_ind ind1 ind2
-	then
-	  (let cuniv = convert_instances false u1 u2 cuniv in
-             convert_stacks l2r infos lft1 lft2 v1 v2 cuniv)
-        else raise NotConvertible
+      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 l2r infos lft1 lft2 v1 v2 cuniv
+        else
+          let mind = Environ.lookup_mind (fst ind1) (info_env infos.cnv_inf) 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
-	  (let cuniv = convert_instances false u1 u2 cuniv in
-           convert_stacks l2r infos lft1 lft2 v1 v2 cuniv)
-        else raise NotConvertible
+      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 l2r infos lft1 lft2 v1 v2 cuniv
+        else
+          let mind = Environ.lookup_mind (fst ind1) (info_env infos.cnv_inf) 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 *)
     | (FConstruct ((ind1,j1),u1), _) ->
       (try
     	 let v1, v2 =
-    	   eta_expand_ind_stack (info_env infos) ind1 hd1 v1 (snd appr2)
-    	 in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
+            eta_expand_ind_stack (info_env infos.cnv_inf) ind1 hd1 v1 (snd appr2)
+         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 l2r infos lft1 lft2 v1 v2 cuniv
+            eta_expand_ind_stack (info_env infos.cnv_inf) ind2 hd2 v2 (snd appr1)
+         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)) ->
@@ -487,7 +576,9 @@ and eqappr 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 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 l2r infos
 	      (el_liftn n el1) (el_liftn n el2) fcl1 fcl2 cuniv in
@@ -502,9 +593,11 @@ and eqappr 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 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 l2r infos
+            convert_vect l2r infos
 	      (el_liftn n el1) (el_liftn n el2) fcl1 fcl2 cuniv in
           convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
         else raise NotConvertible
@@ -512,10 +605,10 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
      (* 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 l2r infos lft1 lft2 stk1 stk2 cuniv =
   compare_stacks
@@ -539,6 +632,11 @@ and convert_vect 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
+  let infos = {
+    cnv_inf = infos;
+    lft_tab = create_tab ();
+    rgt_tab = create_tab ();
+  } in
   ccnv cv_pb l2r infos el_id el_id (inject t1) (inject t2) univs
 
 
@@ -549,25 +647,25 @@ 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 =
-  match (s0,s1) with
+  let open Sorts in
+  if not (type_in_type env) then
+    match (s0,s1) with
     | (Prop c1, Prop c2) when is_cumul pb ->
       begin match c1, c2 with
-      | Null, _ | _, Pos -> () (* Prop <= Set *)
-      | _ -> raise NotConvertible
+        | Null, _ | _, Pos -> () (* Prop <= Set *)
+        | _ -> raise NotConvertible
       end
     | (Prop c1, Prop c2) -> if c1 != c2 then raise NotConvertible
     | (Prop c1, Type u) ->
-	if not (type_in_type env) then
-	let u0 = univ_of_sort s0 in
-	(match pb with
-	| CUMUL -> check_leq univs u0 u
-	| CONV -> check_eq univs u0 u)
+      let u0 = univ_of_sort s0 in
+      (match pb with
+       | CUMUL -> check_leq univs u0 u
+       | CONV -> check_eq univs u0 u)
     | (Type u, Prop c) -> raise NotConvertible
     | (Type u1, Type u2) ->
-        if not (type_in_type env) then
-	(match pb with
-	| CUMUL -> check_leq univs u1 u2
-	| CONV -> check_eq univs u1 u2)
+      (match pb with
+       | CUMUL -> check_leq univs u1 u2
+       | CONV -> check_eq univs u1 u2)
 
 let checked_sort_cmp_universes env pb s0 s1 univs =
   check_sort_cmp_universes env pb s0 s1 univs; univs
@@ -576,9 +674,16 @@ let check_convert_instances ~flex u u' univs =
   if UGraph.check_eq_instances univs u u' then univs
   else raise NotConvertible
 
+(* general conversion and inference functions *)
+let check_inductive_instances cv_pb variance u1 u2 univs =
+  let csts = get_cumulativity_constraints cv_pb variance u1 u2 in
+  if (UGraph.check_constraints csts univs) then univs
+  else raise NotConvertible
+
 let checked_universes =
-  { compare = checked_sort_cmp_universes;
-    compare_instances = check_convert_instances }
+  { compare_sorts = checked_sort_cmp_universes;
+    compare_instances = check_convert_instances;
+    compare_cumul_instances = check_inductive_instances; }
 
 let infer_eq (univs, cstrs as cuniv) u u' =
   if UGraph.check_eq univs u u' then cuniv
@@ -588,36 +693,47 @@ let infer_eq (univs, cstrs as cuniv) u u' =
 let infer_leq (univs, cstrs as cuniv) u u' =
   if UGraph.check_leq univs u u' then cuniv
   else
-    let cstrs' = Univ.enforce_leq u u' cstrs in
-      univs, cstrs'
+    let cstrs', _ = UGraph.enforce_leq_alg u u' univs in
+      univs, Univ.Constraint.union cstrs cstrs'
 
 let infer_cmp_universes env pb s0 s1 univs =
-  match (s0,s1) with
+  let open Sorts in
+  if type_in_type env then univs
+  else
+    match (s0,s1) with
     | (Prop c1, Prop c2) when is_cumul pb ->
       begin match c1, c2 with
-      | Null, _ | _, Pos -> univs (* Prop <= Set *)
-      | _ -> raise NotConvertible
+        | Null, _ | _, Pos -> univs (* Prop <= Set *)
+        | _ -> raise NotConvertible
       end
     | (Prop c1, Prop c2) -> if c1 == c2 then univs else raise NotConvertible
     | (Prop c1, Type u) ->
       let u0 = univ_of_sort s0 in
-	(match pb with
-	| CUMUL -> infer_leq univs u0 u
-	| CONV -> infer_eq univs u0 u)
+      (match pb with
+       | CUMUL -> infer_leq univs u0 u
+       | CONV -> infer_eq univs u0 u)
     | (Type u, Prop c) -> raise NotConvertible
     | (Type u1, Type u2) ->
-        if not (type_in_type env) then
-	(match pb with
-	| CUMUL -> infer_leq univs u1 u2
-	| CONV -> infer_eq univs u1 u2)
-        else univs
+      (match pb with
+       | CUMUL -> infer_leq univs u1 u2
+       | CONV -> infer_eq univs u1 u2)
 
 let infer_convert_instances ~flex u u' (univs,cstrs) =
-  (univs, Univ.enforce_eq_instances u u' cstrs)
-
-let inferred_universes : (UGraph.t * Univ.Constraint.t) universe_compare = 
-  { compare = infer_cmp_universes;
-    compare_instances = infer_convert_instances }
+  let cstrs' =
+    if flex then 
+      if UGraph.check_eq_instances univs u u' then cstrs
+      else raise NotConvertible
+    else Univ.enforce_eq_instances u u' cstrs
+  in (univs, cstrs')
+
+let infer_inductive_instances cv_pb variance u1 u2 (univs,csts') =
+  let csts = get_cumulativity_constraints cv_pb variance u1 u2 in
+  (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;
+    compare_cumul_instances = infer_inductive_instances; }
 
 let gen_conv cv_pb l2r reds env evars univs t1 t2 =
   let b = 
@@ -633,8 +749,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
@@ -660,8 +776,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)
@@ -682,7 +798,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
@@ -695,22 +811,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)
@@ -718,7 +834,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                            *)
@@ -731,19 +847,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")
+    | _ -> 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
@@ -751,21 +879,31 @@ let dest_prod env =
   in
   decrec env Context.Rel.empty
 
+let dest_lam env =
+  let rec decrec env m c =
+    let t = whd_all env c in
+    match kind t with
+      | Lambda (n,a,c0) ->
+          let d = LocalAssum (n,a) in
+          decrec (push_rel d env) (Context.Rel.add d m) c0
+      | _ -> m,t
+  in
+  decrec env Context.Rel.empty
+
 (* The same but preserving lets in the context, not internal ones. *)
 let dest_prod_assum env =
   let rec prodec_rec env l ty =
     let rty = whd_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
@@ -773,14 +911,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
@@ -789,7 +926,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
 
@@ -798,3 +935,15 @@ let is_arity env c =
     let _ = dest_arity env c in
     true
   with NotArity -> false
+
+let eta_expand env t ty =
+  let env = env_of_pre_env env in
+  let ctxt, codom = dest_prod env ty in
+  let ctxt',t = dest_lam env t in
+  let d = Context.Rel.nhyps ctxt - Context.Rel.nhyps ctxt' in
+  let eta_args = List.rev_map mkRel (List.interval 1 d) in
+  let t = Term.applistc (Vars.lift d t) eta_args in
+  let t = Term.it_mkLambda_or_LetIn t (List.firstn d ctxt) in
+  Term.it_mkLambda_or_LetIn t ctxt'
+
+let _ = Hook.set Clambda.eta_expand_hook eta_expand
diff --git a/kernel/reduction.mli b/kernel/reduction.mli
index 8a2b2469..49384340 100644
--- a/kernel/reduction.mli
+++ b/kernel/reduction.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Constr
 open Environ
 
 (***********************************************************************
@@ -35,20 +37,26 @@ type 'a extended_conversion_function =
 
 type conv_pb = CONV | CUMUL
 
-type 'a universe_compare = 
-  { (* Might raise NotConvertible or UnivInconsistency *)
-    compare : env -> conv_pb -> sorts -> sorts -> 'a -> 'a;
-    compare_instances: flex:bool -> 
-		       Univ.Instance.t -> Univ.Instance.t -> 'a -> 'a;
-  } 
+type 'a universe_compare =
+  { (* Might raise NotConvertible *)
+    compare_sorts : env -> conv_pb -> Sorts.t -> Sorts.t -> 'a -> 'a;
+    compare_instances: flex:bool -> Univ.Instance.t -> Univ.Instance.t -> 'a -> 'a;
+    compare_cumul_instances : conv_pb -> Univ.Variance.t array ->
+      Univ.Instance.t -> Univ.Instance.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.Variance.t array ->
+  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
@@ -100,6 +108,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
 
@@ -108,11 +122,12 @@ val betazeta_appvect : int -> constr -> constr array -> constr
 
 val dest_prod       : env -> types -> Context.Rel.t * types
 val dest_prod_assum : env -> types -> Context.Rel.t * types
+val dest_lam        : env -> types -> Context.Rel.t * constr
 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 970bc0fc..d76b05a8 100644
--- a/kernel/retroknowledge.ml
+++ b/kernel/retroknowledge.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Arnaud Spiwack, May 2007 *)
@@ -14,7 +16,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
@@ -83,7 +85,7 @@ type flags = {fastcomputation : bool}
 (* The [proactive] knowledge contains the mapping [field->entry]. *)
 
 module Proactive =
-  Map.Make (struct type t = field let compare = compare end)
+  Map.Make (struct type t = field let compare = Pervasives.compare end)
 
 type proactive = entry Proactive.t
 
@@ -102,22 +104,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 905a05fe..0334e7a9 100644
--- a/kernel/retroknowledge.mli
+++ b/kernel/retroknowledge.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 
 type retroknowledge
 
@@ -82,9 +84,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 +94,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 +102,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 +146,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 09f7bd75..de2a890f 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Jean-Christophe Filliâtre as part of the rebuilding of
@@ -62,6 +64,8 @@ open Names
 open Declarations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (** {6 Safe environments }
 
   Fields of [safe_environment] :
@@ -69,7 +73,7 @@ open Context.Named.Declaration
   - [env] : the underlying environment (cf Environ)
   - [modpath] : the current module name
   - [modvariant] :
-    * NONE before coqtop initialization (or when -notop is used)
+    * NONE before coqtop initialization
     * LIBRARY at toplevel of a compilation or a regular coqtop session
     * STRUCT (params,oldsenv) : inside a local module, with
       module parameters [params] and earlier environment [oldsenv]
@@ -112,7 +116,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;
@@ -123,7 +127,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 }
 
@@ -141,7 +145,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;
@@ -158,7 +162,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
@@ -190,7 +194,7 @@ let check_engagement env expected_impredicative_set =
   begin
     match impredicative_set, expected_impredicative_set with
     | PredicativeSet, ImpredicativeSet ->
-        CErrors.error "Needs option -impredicative-set."
+        CErrors.user_err Pp.(str "Needs option -impredicative-set.")
     | _ -> ()
   end
 
@@ -206,19 +210,19 @@ let get_opaque_body env cbo =
          Opaqueproof.force_constraints (Environ.opaque_tables env) opaque)
 
 type private_constant = Entries.side_effect
-type private_constants = private_constant list
+type private_constants = Term_typing.side_effects
 
 type private_constant_role = Term_typing.side_effect_role =
   | Subproof
   | Schema of inductive * string
 
-let empty_private_constants = []
-let add_private x xs = x :: xs
-let concat_private xs ys = xs @ ys
+let empty_private_constants = Term_typing.empty_seff
+let add_private = Term_typing.add_seff
+let concat_private = Term_typing.concat_seff
 let mk_pure_proof = Term_typing.mk_pure_proof
 let inline_private_constants_in_constr = Term_typing.inline_side_effects
 let inline_private_constants_in_definition_entry = Term_typing.inline_entry_side_effects
-let side_effects_of_private_constants x = Term_typing.uniq_seff (List.rev x)
+let side_effects_of_private_constants = Term_typing.uniq_seff
 
 let private_con_of_con env c =
   let cbo = Environ.lookup_constant c env.env in
@@ -235,20 +239,29 @@ let private_con_of_scheme ~kind env cl =
 
 let universes_of_private eff =
   let open Declarations in
-  List.fold_left (fun acc { Entries.eff } ->
-     match eff with
-     | Entries.SEscheme (l,s) ->
-        List.fold_left (fun acc (_,_,cb,c) ->
-          let acc = match c with
-            | `Nothing -> acc
-            | `Opaque (_, ctx) -> ctx :: acc in
-          if cb.const_polymorphic then acc
-          else (Univ.ContextSet.of_context cb.const_universes) :: acc)
-        acc l
-     | Entries.SEsubproof (c, cb, e) ->
-	if cb.const_polymorphic then acc
-	else Univ.ContextSet.of_context cb.const_universes :: acc)
-   [] eff
+  List.fold_left
+    (fun acc { Entries.eff } ->
+       match eff with
+       | Entries.SEscheme (l,s) ->
+         List.fold_left
+           (fun acc (_,_,cb,c) ->
+              let acc = match c with
+                | `Nothing -> acc
+                | `Opaque (_, ctx) -> ctx :: acc
+              in
+              match cb.const_universes with
+              | Monomorphic_const ctx ->
+                ctx :: acc
+              | Polymorphic_const _ -> acc
+           )
+           acc l
+       | Entries.SEsubproof (c, cb, e) ->
+         match cb.const_universes with
+              | Monomorphic_const ctx ->
+                ctx :: acc
+              | Polymorphic_const _ -> acc
+    )
+    [] (Term_typing.uniq_seff eff)
 
 let env_of_safe_env senv = senv.env
 let env_of_senv = env_of_safe_env
@@ -344,10 +357,10 @@ let check_required current_libs needed =
     try
       let actual = DPMap.find id current_libs in
       if not(digest_match ~actual ~required) then
-        CErrors.error
-          ("Inconsistent assumptions over module "^(DirPath.to_string id)^".")
+        CErrors.user_err Pp.(pr_sequence str
+          ["Inconsistent assumptions over module"; DirPath.to_string id; "."])
     with Not_found ->
-      CErrors.error ("Reference to unknown module "^(DirPath.to_string id)^".")
+      CErrors.user_err Pp.(pr_sequence str ["Reference to unknown module"; DirPath.to_string id; "."])
   in
   Array.iter check needed
 
@@ -361,29 +374,19 @@ let check_required current_libs needed =
     cost too much. *)
 
 let safe_push_named d env =
-  let id = get_id d in
+  let id = NamedDecl.get_id d in
   let _ =
     try
       let _ = Environ.lookup_named id env in
-      CErrors.error ("Identifier "^Id.to_string id^" already defined.")
+      CErrors.user_err Pp.(pr_sequence str ["Identifier"; Id.to_string id; "already defined."])
     with Not_found -> () in
   Environ.push_named d env
 
 
 let push_named_def (id,de) senv =
-  let c,typ,univs = Term_typing.translate_local_def senv.revstruct senv.env id de in
-  let poly = de.Entries.const_entry_polymorphic 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
@@ -408,26 +411,27 @@ let labels_of_mib mib =
   get ()
 
 let globalize_constant_universes env cb =
-  if cb.const_polymorphic then
-    [Now (true, Univ.ContextSet.empty)]
-  else
-    let cstrs = Univ.ContextSet.of_context cb.const_universes in
-      Now (false, cstrs) ::  
-	(match cb.const_body with
-	| (Undef _ | Def _) -> []
-	| OpaqueDef lc ->
-	  match Opaqueproof.get_constraints (Environ.opaque_tables env) lc with
-	  | None -> []
-	  | Some fc ->
+  match cb.const_universes with
+  | Monomorphic_const cstrs ->
+    Now (false, cstrs) ::
+    (match cb.const_body with
+     | (Undef _ | Def _) -> []
+     | OpaqueDef lc ->
+       match Opaqueproof.get_constraints (Environ.opaque_tables env) lc with
+       | None -> []
+       | Some fc ->
             match Future.peek_val fc with
-            | None -> [Later fc]
-            | Some c -> [Now (false, c)])
+             | None -> [Later fc]
+             | Some c -> [Now (false, c)])
+  | Polymorphic_const _ ->
+    [Now (true, Univ.ContextSet.empty)]
       
 let globalize_mind_universes mb =
-  if mb.mind_polymorphic then
-    [Now (true, Univ.ContextSet.empty)]
-  else
-    [Now (false, Univ.ContextSet.of_context mb.mind_universes)]
+  match mb.mind_universes with
+  | Monomorphic_ind ctx ->
+    [Now (false, ctx)]
+  | Polymorphic_ind _ -> [Now (true, Univ.ContextSet.empty)]
+  | Cumulative_ind _ -> [Now (true, Univ.ContextSet.empty)]
 
 let constraints_of_sfb env sfb = 
   match sfb with
@@ -440,8 +444,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 *)
 
@@ -475,12 +479,16 @@ let add_field ((l,sfb) as field) gn senv =
 let update_resolver f senv = { senv with modresolver = f senv.modresolver }
 
 (** Insertion of constants and parameters in environment *)
+type 'a effect_entry =
+| EffectEntry : private_constants effect_entry
+| PureEntry : unit effect_entry
+
 type global_declaration =
-  | ConstantEntry of bool * private_constants Entries.constant_entry
+  | ConstantEntry : 'a effect_entry * 'a Entries.constant_entry -> global_declaration
   | GlobalRecipe of Cooking.recipe
 
 type exported_private_constant = 
-  constant * private_constants Entries.constant_entry * private_constant_role
+  Constant.t * private_constant_role
 
 let add_constant_aux no_section senv (kn, cb) =
   let l = pi3 (Constant.repr3 kn) in
@@ -499,35 +507,34 @@ 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''
 
+let export_private_constants ~in_section ce senv =
+  let exported, ce = Term_typing.export_side_effects senv.revstruct senv.env ce in
+  let bodies = List.map (fun (kn, cb, _) -> (kn, cb)) exported in
+  let exported = List.map (fun (kn, _, r) -> (kn, r)) exported in
+  let no_section = not in_section in
+  let senv = List.fold_left (add_constant_aux no_section) senv bodies in
+  (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 seff_to_export, decl =
-    match decl with
-    | ConstantEntry (true, ce) ->
-        let exports, ce =
-          Term_typing.export_side_effects senv.revstruct senv.env ce in
-        exports, ConstantEntry (false, ce)
-    | _ -> [], decl
-  in
-  let senv =
-    List.fold_left (add_constant_aux no_section) senv
-      (List.map (fun (kn,cb,_,_) -> kn, cb) seff_to_export) in
   let senv =
     let cb = 
       match decl with
-      | ConstantEntry (export_seff,ce) ->
-        Term_typing.translate_constant senv.revstruct senv.env kn ce
+      | ConstantEntry (EffectEntry, ce) ->
+        Term_typing.translate_constant (Term_typing.SideEffects senv.revstruct) senv.env kn ce
+      | ConstantEntry (PureEntry, ce) ->
+        Term_typing.translate_constant Term_typing.Pure senv.env kn ce
       | GlobalRecipe r ->
         let cb = Term_typing.translate_recipe senv.env kn r in
         if no_section then Declareops.hcons_const_body cb else cb in
     add_constant_aux no_section senv (kn, cb) in
-  (kn, List.map (fun (kn,_,ce,r) -> kn, ce, r) seff_to_export), senv
+  kn, senv
 
 (** Insertion of inductive types *)
 
@@ -541,7 +548,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
@@ -553,7 +560,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'
 
@@ -656,18 +663,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;
@@ -711,12 +721,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
@@ -794,7 +804,10 @@ type compiled_library = {
 type native_library = Nativecode.global list
 
 let get_library_native_symbols senv dir =
-  DPMap.find dir senv.native_symbols
+  try DPMap.find dir senv.native_symbols
+  with Not_found -> CErrors.user_err ~hdr:"get_library_native_symbols"
+                      Pp.((str "Linker error in the native compiler. Are you using Require inside a nested Module declaration?") ++ fnl () ++
+                          (str "This use case is not supported, but disabling the native compiler may help."))
 
 (** FIXME: MS: remove?*)
 let current_modpath senv = senv.modpath
@@ -816,7 +829,7 @@ let export ?except senv dir =
     try join_safe_environment ?except senv
     with e ->
       let e = CErrors.push e in
-      CErrors.errorlabstrm "export" (CErrors.iprint e)
+      CErrors.user_err ~hdr:"export" (CErrors.iprint e)
   in
   assert(senv.future_cst = []);
   let () = check_current_library dir senv in
@@ -829,11 +842,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
@@ -852,7 +865,7 @@ let import lib cst vodigest senv =
   check_required senv.required lib.comp_deps;
   check_engagement senv.env lib.comp_enga;
   if DirPath.equal (ModPath.dp senv.modpath) lib.comp_name then
-    CErrors.errorlabstrm "Safe_typing.import"
+    CErrors.user_err ~hdr:"Safe_typing.import"
      (Pp.strbrk "Cannot load a library with the same name as the current one.");
   let mp = MPfile lib.comp_name in
   let mb = lib.comp_mod in
@@ -903,7 +916,7 @@ let register_inline kn senv =
   let open Environ in
   let open Pre_env in
   if not (evaluable_constant kn senv.env) then
-    CErrors.error "Register inline: an evaluable constant is expected";
+    CErrors.user_err Pp.(str "Register inline: an evaluable constant is expected");
   let env = pre_env senv.env in
   let (cb,r) = Cmap_env.find kn env.env_globals.env_constants in
   let cb = {cb with const_inline_code = true} in
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index 15ebc7d8..4078a909 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -47,22 +49,29 @@ type private_constant_role =
   | Schema of inductive * string
 
 val side_effects_of_private_constants :
-  private_constants -> Entries.side_effects
+  private_constants -> Entries.side_effect list
+(** Return the list of individual side-effects in the order of their
+    creation. *)
 
 val empty_private_constants : private_constants
 val add_private : private_constant -> private_constants -> private_constants
+(** Add a constant to a list of private constants. The former must be more
+    recent than all constants appearing in the latter, i.e. one should not
+    create a dependency cycle. *)
 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 :
   Environ.env -> Constr.constr -> private_constants -> Constr.constr
 val inline_private_constants_in_definition_entry :
-  Environ.env -> private_constants Entries.definition_entry -> private_constants Entries.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
 
@@ -77,55 +86,62 @@ 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 *)
 
+type 'a effect_entry =
+| EffectEntry : private_constants effect_entry
+| PureEntry : unit effect_entry
+
 type global_declaration =
-                  (* bool: export private constants *)
-  | ConstantEntry of bool * private_constants Entries.constant_entry
+  | ConstantEntry : 'a effect_entry * 'a Entries.constant_entry -> global_declaration
   | GlobalRecipe of Cooking.recipe
 
 type exported_private_constant = 
-  constant * private_constants Entries.constant_entry * private_constant_role
+  Constant.t * private_constant_role
+
+val export_private_constants : in_section:bool ->
+  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 * exported_private_constant list) 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 *)
@@ -136,29 +152,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 } *)
 
@@ -168,26 +188,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 } *)
 
@@ -203,9 +223,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 62013b38..daeb90be 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Univ
@@ -14,7 +16,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 +93,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 eb4697ad..1bbde260 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {6 The sorts of CCI. } *)
@@ -14,7 +16,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 +40,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 c8ceb064..2e9a33a9 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Jacek Chrzaszcz, Aug 2002 as part of the implementation of
@@ -12,10 +14,10 @@
 (* This module checks subtyping of module types *)
 
 (*i*)
-open Util
 open Names
 open Univ
-open Term
+open Util
+open Constr
 open Declarations
 open Declareops
 open Reduction
@@ -63,11 +65,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,19 +79,26 @@ 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 u f env a1 a2 =
+let check_conv_error error why cst poly f env a1 a2 =
   try 
-    let a1 = Vars.subst_instance_constr u a1 in
-    let a2 = Vars.subst_instance_constr u a2 in
     let cst' = f env (Environ.universes env) a1 a2 in
       if poly then 
 	if Constraint.is_empty cst' then cst
 	else error (IncompatiblePolymorphism (env, a1, a2))
       else Constraint.union cst cst'
   with NotConvertible -> error why
+     | Univ.UniverseInconsistency e -> error (IncompatibleUniverses e)
+
+let check_polymorphic_instance error env auctx1 auctx2 =
+  if not (Univ.AUContext.size auctx1 == Univ.AUContext.size auctx2) then
+    error IncompatibleInstances
+  else if not (UGraph.check_subtype (Environ.universes env) auctx2 auctx1) then
+    error (IncompatibleConstraints auctx1)
+  else
+    Environ.push_context ~strict:false (Univ.AUContext.repr auctx2) env
 
 (* for now we do not allow reorderings *)
 
@@ -97,58 +106,39 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
   let kn1 = KerName.make2 mp1 l in
   let kn2 = KerName.make2 mp2 l in
   let error why = error_signature_mismatch l spec2 why in
-  let check_conv why cst poly u f = check_conv_error error why cst poly u f in
+  let check_conv why cst poly f = check_conv_error error why cst poly f in
   let mib1 =
     match info1 with
       | IndType ((_,0), mib) -> Declareops.subst_mind_body subst1 mib
       | _ -> error (InductiveFieldExpected mib2)
   in
-  let poly = 
-    if not (mib1.mind_polymorphic == mib2.mind_polymorphic) then
-      error (PolymorphicStatusExpected mib2.mind_polymorphic)
-    else mib2.mind_polymorphic
-  in
-  let u = 
-    if poly then 
-      CErrors.error ("Checking of subtyping of polymorphic" ^
-		       " inductive types not implemented")
-    else Instance.empty
+  let env, inst =
+    match mib1.mind_universes, mib2.mind_universes with
+    | Monomorphic_ind _, Monomorphic_ind _ -> env, Univ.Instance.empty
+    | Polymorphic_ind auctx, Polymorphic_ind auctx' ->
+      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
+      env, Univ.make_abstract_instance auctx'
+    | _ -> error 
+             (CumulativeStatusExpected (Declareops.inductive_is_cumulative mib2))
   in
   let mib2 =  Declareops.subst_mind_body subst2 mib2 in
-  let check_inductive_type cst name env t1 t2 =
-
-    (* Due to sort-polymorphism in inductive types, the conclusions of
-       t1 and t2, if in Type, are generated as the least upper bounds
-       of the types of the constructors.
-
-       By monotonicity of the infered l.u.b.  wrt subtyping (i.e.  if X:U
-       |- T(X):s and |- M:U' and U'<=U then infer_type(T(M))<=s), each
-       universe in the conclusion of t1 has an bounding universe in
-       the conclusion of t2, so that we don't need to check the
-       subtyping of the conclusions of t1 and t2.
-
-       Even if we'd like to recheck it, the inference of constraints
-       is not designed to deal with algebraic constraints of the form
-       max-univ(u1..un) <= max-univ(u'1..u'n), so that it is not easy
-       to recheck it (in short, we would need the actual graph of
-       constraints as input while type checking is currently designed
-       to output a set of constraints instead) *)
-
-    (* So we cheat and replace the subtyping problem on algebraic
-       constraints of the form max-univ(u1..un) <= max-univ(u'1..u'n)
-       (that we know are necessary true) by trivial constraints that
-       the constraint generator knows how to deal with *)
-
-    let (ctx1,s1) = dest_arity env t1 in
-    let (ctx2,s2) = dest_arity env t2 in
-    let s1,s2 =
-      match s1, s2 with
-      | Type _, Type _ -> (* shortcut here *) prop_sort, prop_sort
-      | (Prop _, Type _) | (Type _,Prop _) ->
-	error (NotConvertibleInductiveField name)
-      | _ -> (s1, s2) in
+  let check_inductive_type cst name t1 t2 =
     check_conv (NotConvertibleInductiveField name)
-      cst poly u infer_conv_leq env (mkArity (ctx1,s1)) (mkArity (ctx2,s2))
+      cst (inductive_is_polymorphic mib1) infer_conv_leq env t1 t2
   in
 
   let check_packet cst p1 p2 =
@@ -166,24 +156,23 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
       (* nparams done *)
       (* params_ctxt done because part of the inductive types *)
       (* Don't check the sort of the type if polymorphic *)
-      let ty1, cst1 = constrained_type_of_inductive env ((mib1,p1),u) in
-      let ty2, cst2 = constrained_type_of_inductive env ((mib2,p2),u) in
-      let cst = Constraint.union cst1 (Constraint.union cst2 cst) in
-      let cst = check_inductive_type cst p2.mind_typename env ty1 ty2 in
+      let ty1 = type_of_inductive env ((mib1, p1), inst) in
+      let ty2 = type_of_inductive env ((mib2, p2), inst) in
+      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
-	poly u infer_conv env t1 t2)
+	(inductive_is_polymorphic mib1) infer_conv env t1 t2)
       cst
       p2.mind_consnames
-      (arities_of_specif (mind,u) (mib1,p1))
-      (arities_of_specif (mind,u) (mib2,p2))
+      (arities_of_specif (mind, inst) (mib1, p1))
+      (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
@@ -207,7 +196,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
@@ -236,55 +225,10 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
     
 let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = 
   let error why = error_signature_mismatch l spec2 why in
-  let check_conv cst poly u f = check_conv_error error cst poly u f in
-  let check_type poly u cst env t1 t2 =
-
+  let check_conv cst poly f = check_conv_error error cst poly f in
+  let check_type poly cst env t1 t2 =
     let err = NotConvertibleTypeField (env, t1, t2) in
-
-    (* If the type of a constant is generated, it may mention
-       non-variable algebraic universes that the general conversion
-       algorithm is not ready to handle. Anyway, generated types of
-       constants are functions of the body of the constant. If the
-       bodies are the same in environments that are subtypes one of
-       the other, the types are subtypes too (i.e. if Gamma <= Gamma',
-       Gamma |- A |> T, Gamma |- A' |> T' and Gamma |- A=A' then T <= T').
-       Hence they don't have to be checked again *)
-
-    let t1,t2 =
-      if isArity t2 then
-        let (ctx2,s2) = destArity t2 in
-        match s2 with
-        | Type v when not (is_univ_variable v) ->
-          (* The type in the interface is inferred and is made of algebraic
-             universes *)
-          begin try
-            let (ctx1,s1) = dest_arity env t1 in
-            match s1 with
-            | 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)
-            | 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)
-            | Type _ ->
-              (* The type in the interface is inferred and the type in the
-                 implementation is not inferred or is inferred but from a
-                 more reduced body so that it is just a variable. Since
-                 constraints of the form "univ <= max(...)" are not
-                 expressible in the system of algebraic universes: we fail
-                 (the user has to use an explicit type in the interface *)
-                error NoTypeConstraintExpected
-          with NotArity ->
-            error err end
-        | _ ->
-	  t1,t2
-      else
-        (t1,t2) in
-      check_conv err cst poly u infer_conv_leq env t1 t2
+    check_conv err cst poly infer_conv_leq env t1 t2
   in
   match info1 with
     | Constant cb1 ->
@@ -292,43 +236,21 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
       let cb1 = Declareops.subst_const_body subst1 cb1 in
       let cb2 = Declareops.subst_const_body subst2 cb2 in
       (* Start by checking universes *)
-      let poly = 
-	if not (cb1.const_polymorphic == cb2.const_polymorphic) then
-	  error (PolymorphicStatusExpected cb2.const_polymorphic)
-	else cb2.const_polymorphic
-      in
-      let cst', env', u = 
-	if poly then 
-	  let ctx1 = Univ.instantiate_univ_context cb1.const_universes in
-	  let ctx2 = Univ.instantiate_univ_context cb2.const_universes in
-	  let inst1, ctx1 = Univ.UContext.dest ctx1 in
-	  let inst2, ctx2 = Univ.UContext.dest ctx2 in
-	    if not (Univ.Instance.length inst1 == Univ.Instance.length inst2) then
-	      error IncompatibleInstances
-	    else 
-	      let cstrs = Univ.enforce_eq_instances inst1 inst2 cst in
-	      let cstrs = Univ.Constraint.union cstrs ctx2 in
-		try 
-		  (* The environment with the expected universes plus equality 
-		     of the body instances with the expected instance *)
-		  let ctxi = Univ.Instance.append inst1 inst2 in
-		  let ctx = Univ.UContext.make (ctxi, cstrs) in
-		  let env = Environ.push_context ctx env in
-		  (* Check that the given definition does not add any constraint over
-		     the expected ones, so that it can be used in place of 
-                     the original. *)
-		    if UGraph.check_constraints ctx1 (Environ.universes env) then
-		      cstrs, env, inst2
-		    else error (IncompatibleConstraints ctx1)
-		with Univ.UniverseInconsistency incon -> 
-		  error (IncompatibleUniverses incon)
-	else
-	  cst, env, Univ.Instance.empty
+      let poly, env =
+        match cb1.const_universes, cb2.const_universes with
+        | Monomorphic_const _, Monomorphic_const _ ->
+          false, env
+        | Polymorphic_const auctx1, Polymorphic_const auctx2 ->
+          true, check_polymorphic_instance error env auctx1 auctx2
+        | Monomorphic_const _, Polymorphic_const _ ->
+          error (PolymorphicStatusExpected true)
+        | Polymorphic_const _, Monomorphic_const _ ->
+          error (PolymorphicStatusExpected false)
       in
       (* Now check types *)
-      let typ1 = Typeops.type_of_constant_type env' cb1.const_type in
-      let typ2 = Typeops.type_of_constant_type env' cb2.const_type in
-      let cst = check_type poly u cst env' typ1 typ2 in
+      let typ1 = cb1.const_type in
+      let typ2 = cb2.const_type in
+      let cst = check_type poly cst env typ1 typ2 in
       (* Now we check the bodies:
 	 - A transparent constant can only be implemented by a compatible
 	   transparent constant.
@@ -345,40 +267,19 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
 		 Anyway [check_conv] will handle that afterwards. *)
 	      let c1 = Mod_subst.force_constr lc1 in
 	      let c2 = Mod_subst.force_constr lc2 in
-	      check_conv NotConvertibleBodyField cst poly u infer_conv env' c1 c2))
+	      check_conv NotConvertibleBodyField cst poly infer_conv env c1 c2))
    | IndType ((kn,i),mind1) ->
-       ignore (CErrors.error (
+       CErrors.user_err Pp.(str @@
        "The kernel does not recognize yet that a parameter can be " ^
        "instantiated by an inductive type. Hint: you can rename the " ^
        "inductive type and give a definition to map the old name to the new " ^
-       "name."));
-      let () = assert (List.is_empty mind1.mind_hyps && List.is_empty cb2.const_hyps) in
-      if Declareops.constant_has_body cb2 then error DefinitionFieldExpected;
-      let u1 = inductive_instance mind1 in
-      let arity1,cst1 = constrained_type_of_inductive env 
-	((mind1,mind1.mind_packets.(i)),u1) in
-      let cst2 =
-        Declareops.constraints_of_constant (Environ.opaque_tables env) cb2 in 
-      let typ2 = Typeops.type_of_constant_type env cb2.const_type in
-      let cst = Constraint.union cst (Constraint.union cst1 cst2) in
-      let error = NotConvertibleTypeField (env, arity1, typ2) in
-       check_conv error cst false Univ.Instance.empty infer_conv_leq env arity1 typ2
-   | IndConstr (((kn,i),j) as cstr,mind1) ->
-      ignore (CErrors.error (
+       "name.")
+   | IndConstr (((kn,i),j),mind1) ->
+      CErrors.user_err Pp.(str @@
        "The kernel does not recognize yet that a parameter can be " ^
        "instantiated by a constructor. Hint: you can rename the " ^
        "constructor and give a definition to map the old name to the new " ^
-       "name."));
-      let () = assert (List.is_empty mind1.mind_hyps && List.is_empty cb2.const_hyps) in
-      if Declareops.constant_has_body cb2 then error DefinitionFieldExpected;
-      let u1 = inductive_instance mind1 in
-      let ty1,cst1 = constrained_type_of_constructor (cstr,u1) (mind1,mind1.mind_packets.(i)) in
-      let cst2 =
-        Declareops.constraints_of_constant (Environ.opaque_tables env) cb2 in
-      let ty2 = Typeops.type_of_constant_type env cb2.const_type in
-      let cst = Constraint.union cst (Constraint.union cst1 cst2) in
-      let error = NotConvertibleTypeField (env, ty1, ty2) in
-       check_conv error cst false Univ.Instance.empty infer_conv env ty1 ty2
+       "name.")
 
 let rec check_modules cst env msb1 msb2 subst1 subst2 =
   let mty1 = module_type_of_module msb1 in
@@ -450,7 +351,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 a00eb873..4e755e42 100644
--- a/kernel/subtyping.mli
+++ b/kernel/subtyping.mli
@@ -1,15 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 15f187e5..e1affb1c 100644
--- a/kernel/term.ml
+++ b/kernel/term.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -11,6 +13,7 @@ open Pp
 open CErrors
 open Names
 open Vars
+open Constr
 
 (**********************************************************************)
 (**         Redeclaration of types from module Constr                 *)
@@ -20,7 +23,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 +33,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,30 +70,31 @@ 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
 
-type ('constr, 'types) kind_of_term = ('constr, 'types) Constr.kind_of_term =
+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 sorts
+  | 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 pconstant
-  | Ind       of pinductive
-  | Construct of pconstructor
+  | 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 * 'constr
+  | Proj      of Projection.t * 'constr
 
-type values = Constr.values
+type values = Vmvalues.values
 
 (**********************************************************************)
 (**         Redeclaration of functions from module Constr             *)
@@ -142,7 +146,8 @@ let leq_constr_univs = Constr.leq_constr_univs
 let eq_constr_nounivs = Constr.eq_constr_nounivs
 
 let kind_of_term = Constr.kind
-let constr_ord = Constr.compare
+let compare = Constr.compare
+let constr_ord = compare
 let fold_constr = Constr.fold
 let map_puniverses = Constr.map_puniverses
 let map_constr = Constr.map
@@ -163,203 +168,57 @@ 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
-
-(* Destructs a DeBrujin 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
-let isMetaOf mv c =
-  match kind_of_term c with Meta mv' -> Int.equal mv mv' | _ -> 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
-
+exception DestKO = DestKO
+(* Destructs a de Bruijn index *)
+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
-
-(******************************************************************)
-(* Cast management                                                *)
-(******************************************************************)
-
-let rec strip_outer_cast c = match kind_of_term c with
-  | Cast (c,_,_) -> strip_outer_cast c
-  | _ -> c
-
-(* Fonction spéciale qui laisse les cast clés sous les Fix ou les Case *)
-
-let under_outer_cast f c =  match kind_of_term c with
-  | Cast (b,k,t) -> mkCast (f b, k, f t)
-  | _ -> f c
-
-let rec under_casts f c = match kind_of_term c with
-  | Cast (c,k,t) -> mkCast (under_casts f c, k, t)
-  | _            -> f c
+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 *)
 (******************************************************************)
 
-(* flattens application lists throwing casts in-between *)
-let collapse_appl c = match kind_of_term c with
-  | App (f,cl) ->
-      let rec collapse_rec f cl2 =
-        match kind_of_term (strip_outer_cast f) with
-        | App (g,cl1) -> collapse_rec g (Array.append cl1 cl2)
-        | _ -> mkApp (f,cl2)
-      in
-      collapse_rec f cl
-  | _ -> c
-
 let decompose_app c =
   match kind_of_term c with
     | App (f,cl) -> (f, Array.to_list cl)
@@ -465,7 +324,7 @@ let rec to_lambda n prod =
     match kind_of_term prod with
       | Prod (na,ty,bd) -> mkLambda (na,ty,to_lambda (n-1) bd)
       | Cast (c,_,_) -> to_lambda n c
-      | _   -> errorlabstrm "to_lambda" (mt ())
+      | _   -> user_err ~hdr:"to_lambda" (mt ())
 
 let rec to_prod n lam =
   if Int.equal n 0 then
@@ -474,7 +333,7 @@ let rec to_prod n lam =
     match kind_of_term lam with
       | Lambda (na,ty,bd) -> mkProd (na,ty,to_prod (n-1) bd)
       | Cast (c,_,_) -> to_prod n c
-      | _   -> errorlabstrm "to_prod" (mt ())
+      | _   -> user_err ~hdr:"to_prod" (mt ())
 
 let it_mkProd_or_LetIn   = List.fold_left (fun c d -> mkProd_or_LetIn d c)
 let it_mkLambda_or_LetIn = List.fold_left (fun c d -> mkLambda_or_LetIn d c)
@@ -486,7 +345,7 @@ let lambda_applist c l =
     match kind_of_term c, l with
     | Lambda(_,_,c), arg::l -> app (arg::subst) c l
     | _, [] -> substl subst c
-    | _ -> anomaly (Pp.str "Not enough lambda's") in
+    | _ -> anomaly (Pp.str "Not enough lambda's.") in
   app [] c l
 
 let lambda_appvect c v = lambda_applist c (Array.to_list v)
@@ -495,11 +354,12 @@ 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 lambda/let's") in
+    | _, [] -> anomaly (Pp.str "Not enough arguments.")
+    | _ -> anomaly (Pp.str "Not enough lambda/let's.") in
   app n [] c l
 
 let lambda_appvect_assum n c v = lambda_applist_assum n c (Array.to_list v)
@@ -510,7 +370,7 @@ let prod_applist c l =
     match kind_of_term c, l with
     | Prod(_,_,c), arg::l -> app (arg::subst) c l
     | _, [] -> substl subst c
-    | _ -> anomaly (Pp.str "Not enough prod's") in
+    | _ -> anomaly (Pp.str "Not enough prod's.") in
   app [] c l
 
 (* prod_appvect T [| a1 ; ... ; an |] -> (T a1 ... an) *)
@@ -520,11 +380,12 @@ 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 prod/let's") in
+    | _, [] -> anomaly (Pp.str "Not enough arguments.")
+    | _ -> anomaly (Pp.str "Not enough prod/let's.") in
   app n [] c l
 
 let prod_appvect_assum n c v = prod_applist_assum n c (Array.to_list v)
@@ -556,26 +417,26 @@ let decompose_lam =
 (* Given a positive integer n, transforms a product term (x1:T1)..(xn:Tn)T
    into the pair ([(xn,Tn);...;(x1,T1)],T) *)
 let decompose_prod_n n =
-  if n < 0 then error "decompose_prod_n: integer parameter must be positive";
+  if n < 0 then user_err (str "decompose_prod_n: integer parameter must be positive");
   let rec prodec_rec l n c =
     if Int.equal n 0 then l,c
     else match kind_of_term c with
       | Prod (x,t,c) -> prodec_rec ((x,t)::l) (n-1) c
       | Cast (c,_,_)   -> prodec_rec l n c
-      | _ -> error "decompose_prod_n: not enough products"
+      | _ -> user_err (str "decompose_prod_n: not enough products")
   in
   prodec_rec [] n
 
 (* Given a positive integer n, transforms a lambda term [x1:T1]..[xn:Tn]T
    into the pair ([(xn,Tn);...;(x1,T1)],T) *)
 let decompose_lam_n n =
-  if n < 0 then error "decompose_lam_n: integer parameter must be positive";
+  if n < 0 then user_err (str "decompose_lam_n: integer parameter must be positive");
   let rec lamdec_rec l n c =
     if Int.equal n 0 then l,c
     else match kind_of_term c with
       | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) (n-1) c
       | Cast (c,_,_)     -> lamdec_rec l n c
-      | _ -> error "decompose_lam_n: not enough abstractions"
+      | _ -> user_err (str "decompose_lam_n: not enough abstractions")
   in
   lamdec_rec [] n
 
@@ -611,7 +472,7 @@ let decompose_lam_assum =
    ci,Ti);..;(x1,None,T1)] and of the inner type [T]) *)
 let decompose_prod_n_assum n =
   if n < 0 then
-    error "decompose_prod_n_assum: integer parameter must be positive";
+    user_err (str "decompose_prod_n_assum: integer parameter must be positive");
   let rec prodec_rec l n c =
     if Int.equal n 0 then l,c
     else
@@ -620,7 +481,7 @@ let decompose_prod_n_assum n =
       | Prod (x,t,c)    -> prodec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c
       | LetIn (x,b,t,c) -> prodec_rec (Context.Rel.add (LocalDef (x,b,t)) l) (n-1) c
       | Cast (c,_,_)      -> prodec_rec l n c
-      | c -> error "decompose_prod_n_assum: not enough assumptions"
+      | c -> user_err (str  "decompose_prod_n_assum: not enough assumptions")
   in
   prodec_rec Context.Rel.empty n
 
@@ -632,7 +493,7 @@ let decompose_prod_n_assum n =
    but n is the actual number of destructurated lambdas. *)
 let decompose_lam_n_assum n =
   if n < 0 then
-    error "decompose_lam_n_assum: integer parameter must be positive";
+    user_err (str  "decompose_lam_n_assum: integer parameter must be positive");
   let rec lamdec_rec l n c =
     if Int.equal n 0 then l,c
     else
@@ -641,14 +502,14 @@ let decompose_lam_n_assum n =
       | Lambda (x,t,c)  -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c
       | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) n c
       | Cast (c,_,_)      -> lamdec_rec l n c
-      | c -> error "decompose_lam_n_assum: not enough abstractions"
+      | c -> user_err (str "decompose_lam_n_assum: not enough abstractions")
   in
   lamdec_rec Context.Rel.empty n
 
 (* Same, counting let-in *)
 let decompose_lam_n_decls n =
   if n < 0 then
-    error "decompose_lam_n_decls: integer parameter must be positive";
+    user_err (str "decompose_lam_n_decls: integer parameter must be positive");
   let rec lamdec_rec l n c =
     if Int.equal n 0 then l,c
     else
@@ -657,7 +518,7 @@ let decompose_lam_n_decls n =
       | Lambda (x,t,c)  -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c
       | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) (n-1) c
       | Cast (c,_,_)      -> lamdec_rec l n c
-      | c -> error "decompose_lam_n_decls: not enough abstractions"
+      | c -> user_err (str "decompose_lam_n_decls: not enough abstractions")
   in
   lamdec_rec Context.Rel.empty n
 
@@ -690,7 +551,7 @@ let destArity =
     | 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")
+    | _               -> anomaly ~label:"destArity" (Pp.str "not an arity.")
   in
   prodec_rec []
 
diff --git a/kernel/term.mli b/kernel/term.mli
index 60a3c771..ee84dcb2 100644
--- a/kernel/term.mli
+++ b/kernel/term.mli
@@ -1,12 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
+open Constr
 
 (** {5 Redeclaration of types from module Constr and Sorts}
 
@@ -15,166 +18,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) kind_of_term = ('constr, 'types) Constr.kind_of_term =
-  | Rel       of int
-  | Var       of Id.t
-  | Meta      of metavariable
-  | Evar      of 'constr pexistential
-  | Sort      of sorts
-  | 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 puniverses
-  | Ind       of inductive puniverses
-  | Construct of constructor puniverses
-  | 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
-val isMetaOf : metavariable -> 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 DeBrujin index *)
+(** 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 +152,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
+val destProj : constr -> Projection.t * constr
+[@@ocaml.deprecated "Alias for [Constr.destProj]"]
 
 (** Destructs the {% $ %}i{% $ %}th function of the block
    [Fixpoint f{_ 1} ctx{_ 1} = b{_ 1}
@@ -194,9 +166,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 +244,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 +253,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. } *)
 
@@ -349,26 +322,12 @@ val strip_lam_n : int -> constr -> constr
 val strip_prod_assum : types -> types
 val strip_lam_assum : constr -> constr
 
-(** Flattens application lists *)
-val collapse_appl : constr -> constr
-
-
-(** Remove recursively the casts around a term i.e.
-   [strip_outer_cast (Cast (Cast ... (Cast c, t) ... ))] is [c]. *)
-val strip_outer_cast : constr -> constr
-
-(** Apply a function letting Casted types in place *)
-val under_casts : (constr -> constr) -> constr -> constr
-
-(** Apply a function under components of Cast if any *)
-val under_outer_cast : (constr -> constr) -> constr -> constr
-
 (** {5 ... } *)
 (** An "arity" is a term of the form [[x1:T1]...[xn:Tn]s] with [s] a sort.
     Such a term can canonically be seen as the pair of a context of types
     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
@@ -382,7 +341,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
@@ -392,23 +351,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]}
 
@@ -417,87 +376,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
-val mkProj : projection * constr -> constr
+[@@ocaml.deprecated "Alias for Constr"]
+val mkConst : Constant.t -> constr
+[@@ocaml.deprecated "Alias for Constr"]
+val mkProj : Projection.t * 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
+[@@ocaml.deprecated "Alias for Constr.kind"]
 
-val kind_of_term : constr -> (constr, types) kind_of_term
-(** Alias for [Constr.kind] *)
+val compare : constr -> constr -> int
+[@@ocaml.deprecated "Alias for [Constr.compare]"]
 
 val constr_ord : constr -> constr -> int
-(** Alias for [Constr.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 : (int -> constr -> constr -> bool) -> int -> constr -> constr -> bool
+[@@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"]
 
-val compare_constr : (constr -> constr -> bool) -> constr -> constr -> bool
-(** Alias for [Constr.compare_head] *)
+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.t * '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 749b5dba..e621a61c 100644
--- a/kernel/term_typing.ml
+++ b/kernel/term_typing.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Jacek Chrzaszcz, Aug 2002 as part of the implementation of
@@ -15,34 +17,15 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Environ
 open Entries
 open Typeops
-open Fast_typeops
-
-let constrain_type env j poly subst = function
-  | `None -> 
-    if not poly then (* Old-style polymorphism *)
-      make_polymorphic_if_constant_for_ind env j
-    else RegularArity (Vars.subst_univs_level_constr subst j.uj_type)
-  | `Some t ->
-      let tj = infer_type env t in
-      let _ = judge_of_cast env j DEFAULTcast tj in
-	assert (eq_constr t tj.utj_val);
-	RegularArity (Vars.subst_univs_level_constr subst t)
-  | `SomeWJ (t, tj) ->
-      let tj = infer_type env t in
-      let _ = judge_of_cast env j DEFAULTcast tj in
-	assert (eq_constr t tj.utj_val);
-	RegularArity (Vars.subst_univs_level_constr subst t)
-
-let map_option_typ = function None -> `None | Some x -> `Some x
 
-(* Insertion of constants and parameters in environment. *)
+module NamedDecl = Context.Named.Declaration
 
-let mk_pure_proof c = (c, Univ.ContextSet.empty), []
+(* Insertion of constants and parameters in environment. *)
 
 let equal_eff e1 e2 =
   let open Entries in
@@ -55,67 +38,145 @@ let equal_eff e1 e2 =
           cl1 cl2
   | _ -> false
 
-let rec uniq_seff = function
-  | [] -> []
-  | x :: xs -> x :: uniq_seff (List.filter (fun y -> not (equal_eff x y)) xs)
-(* The list of side effects is in reverse order (most recent first).
- * To keep the "topological" order between effects we have to uniq-ize from
- * the tail *)
-let uniq_seff l = List.rev (uniq_seff (List.rev l))
+module SideEffects :
+sig
+  type t
+  val repr : t -> side_effect list
+  val empty : t
+  val add : side_effect -> t -> t
+  val concat : t -> t -> t
+end =
+struct
+
+let compare_seff e1 e2 = match e1, e2 with
+| SEsubproof (c1, _, _), SEsubproof (c2, _, _) -> Constant.CanOrd.compare c1 c2
+| SEscheme (cl1, _), SEscheme (cl2, _) ->
+  let cmp (_, c1, _, _) (_, c2, _, _) = Constant.CanOrd.compare c1 c2 in
+  CList.compare cmp cl1 cl2
+| SEsubproof _, SEscheme _ -> -1
+| SEscheme _, SEsubproof _ -> 1
+
+module SeffOrd = struct
+type t = side_effect
+let compare e1 e2 = compare_seff e1.eff e2.eff
+end
+
+module SeffSet = Set.Make(SeffOrd)
+
+type t = { seff : side_effect list; elts : SeffSet.t }
+(** Invariant: [seff] is a permutation of the elements of [elts] *)
+
+let repr eff = eff.seff
+let empty = { seff = []; elts = SeffSet.empty }
+let add x es =
+  if SeffSet.mem x es.elts then es
+  else { seff = x :: es.seff; elts = SeffSet.add x es.elts }
+let concat xes yes =
+  List.fold_right add xes.seff yes
+
+end
+
+type side_effects = SideEffects.t
+
+type _ trust =
+| Pure : unit trust
+| SideEffects : structure_body -> side_effects trust
+
+let uniq_seff_rev = SideEffects.repr
+let uniq_seff l = List.rev (SideEffects.repr l)
+
+let empty_seff = SideEffects.empty
+let add_seff = SideEffects.add
+let concat_seff = SideEffects.concat
+
+let mk_pure_proof c = (c, Univ.ContextSet.empty), empty_seff
 
 let inline_side_effects env body ctx side_eff =
-  let handle_sideff (t,ctx,sl) { eff = se; from_env = mb } =
+  (** First step: remove the constants that are still in the environment *)
+  let filter { eff = se; from_env = mb } =
     let cbl = match se with
-      | SEsubproof (c,cb,b) -> [c,cb,b]
-      | SEscheme (cl,_) -> List.map (fun (_,c,cb,b) -> c,cb,b) cl in
+    | SEsubproof (c, cb, b) -> [c, cb, b]
+    | SEscheme (cl,_) ->
+      List.map (fun (_, c, cb, b) -> c, cb, b) cl
+    in
     let not_exists (c,_,_) =
       try ignore(Environ.lookup_constant c env); false
       with Not_found -> true in 
     let cbl = List.filter not_exists cbl in
-    let cname c = 
-      let name = string_of_con c in
-      for i = 0 to String.length name - 1 do
-        if name.[i] == '.' || name.[i] == '#' then name.[i] <- '_' done;
-      Name (id_of_string name) in
-    let rec sub c i x = match kind_of_term x with
-      | Const (c', _) when eq_constant c c' -> mkRel i
-      | _ -> map_constr_with_binders ((+) 1) (fun i x -> sub c i x) i x in
-    let rec sub_body c u b i x = match kind_of_term x with
-      | Const (c',u') when eq_constant c c' -> 
-	Vars.subst_instance_constr u' b
-      | _ -> map_constr_with_binders ((+) 1) (sub_body c u b) i x in
-    let fix_body (c,cb,b) (t,ctx) =
-      match cb.const_body, b with
-      | Def b, _ ->
-          let b = Mod_subst.force_constr b in
-	  let poly = cb.const_polymorphic in
-	    if not poly then
-              let b_ty = Typeops.type_of_constant_type env cb.const_type in
-              let t = sub c 1 (Vars.lift 1 t) in
-	        mkLetIn (cname c, b, b_ty, t),
-		Univ.ContextSet.union ctx
-		  (Univ.ContextSet.of_context cb.const_universes)
-	    else 
-	      let univs = cb.const_universes in
-		sub_body c (Univ.UContext.instance univs) b 1 (Vars.lift 1 t), ctx
-      | OpaqueDef _, `Opaque (b,_) -> 
-	  let poly = cb.const_polymorphic in
-	    if not poly then
-              let b_ty = Typeops.type_of_constant_type env cb.const_type in
-              let t = sub c 1 (Vars.lift 1 t) in
-	        mkApp (mkLambda (cname c, b_ty, t), [|b|]),
-		Univ.ContextSet.union ctx
-		  (Univ.ContextSet.of_context cb.const_universes)
-	    else
-	      let univs = cb.const_universes in
-		sub_body c (Univ.UContext.instance univs) b 1 (Vars.lift 1 t), ctx
+    (cbl, mb)
+  in
+  (* CAVEAT: we assure that most recent effects come first *)
+  let side_eff = List.map filter (uniq_seff_rev side_eff) in
+  let sigs = List.rev_map (fun (cbl, mb) -> mb, List.length cbl) side_eff in
+  let side_eff = List.fold_left (fun accu (cbl, _) -> cbl @ accu) [] side_eff in
+  let side_eff = List.rev side_eff in
+  (** Most recent side-effects first in side_eff *)
+  if List.is_empty side_eff then (body, ctx, sigs)
+  else
+    (** Second step: compute the lifts and substitutions to apply *)
+    let cname c =
+      let name = Constant.to_string c in
+      let map c = if c == '.' || c == '#' then '_' else c in
+      let name = String.map map name in
+      Name (Id.of_string name)
+    in
+    let fold (subst, var, ctx, args) (c, cb, b) =
+      let (b, opaque) = match cb.const_body, b with
+      | Def b, _ -> (Mod_subst.force_constr b, false)
+      | OpaqueDef _, `Opaque (b,_) -> (b, true)
       | _ -> assert false
+      in
+      match cb.const_universes with
+      | 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 ctx = Univ.ContextSet.union ctx univs in
+        (subst, var + 1, ctx, (cname c, b, ty, opaque) :: args)
+      | Polymorphic_const auctx ->
+        (** Inline the term to emulate universe polymorphism *)
+        let subst = Cmap_env.add c (Inl b) subst in
+        (subst, var, ctx, args)
     in
-    let t, ctx = List.fold_right fix_body cbl (t,ctx) in
-    t, ctx, (mb,List.length cbl) :: sl
-  in
-  (* CAVEAT: we assure a proper order *)
-  List.fold_left handle_sideff (body,ctx,[]) (uniq_seff side_eff)
+    let (subst, len, ctx, args) = List.fold_left fold (Cmap_env.empty, 1, ctx, []) side_eff in
+    (** Third step: inline the definitions *)
+    let rec subst_const i k t = match Constr.kind t with
+    | Const (c, u) ->
+      let data = try Some (Cmap_env.find c subst) with Not_found -> None in
+      begin match data with
+      | None -> t
+      | Some (Inl b) ->
+        (** [b] is closed but may refer to other constants *)
+        subst_const i k (Vars.subst_instance_constr u b)
+      | Some (Inr n) ->
+        mkRel (k + n - i)
+      end
+    | Rel n ->
+      (** Lift free rel variables *)
+      if n <= k then t
+      else mkRel (n + len - i - 1)
+    | _ -> 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 *)
+      let ty = subst_const (len - i - 1) 0 ty in
+      let b = subst_const (len - i - 1) 0 b in
+      (na, b, ty, opaque)
+    in
+    let args = List.mapi map_args args in
+    let body = subst_const 0 0 body in
+    let fold_arg (na, b, ty, opaque) accu =
+      if opaque then mkApp (mkLambda (na, ty, accu), [|b|])
+      else mkLetIn (na, b, ty, accu)
+    in
+    let body = List.fold_right fold_arg args body in
+    (body, ctx, sigs)
+
+let rec is_nth_suffix n l suf =
+  if Int.equal n 0 then l == suf
+  else match l with
+  | [] -> false
+  | _ :: l -> is_nth_suffix (pred n) l suf
 
 (* Given the list of signatures of side effects, checks if they match.
  * I.e. if they are ordered descendants of the current revstruct *)
@@ -129,7 +190,7 @@ let check_signatures curmb sl =
           match sl with
           | None -> sl, None
           | Some n ->
-              if List.length mb >= how_many && CList.skipn how_many mb == curmb
+              if is_nth_suffix how_many mb curmb
               then Some (n + how_many), Some mb
               else None, None
         with CEphemeron.InvalidKey -> None, None in
@@ -139,13 +200,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)
@@ -163,73 +224,130 @@ let rec unzip ctx j =
   | `Cut (n,ty,arg) :: ctx ->
       unzip ctx { j with uj_val = mkApp (mkLambda (n,ty,j.uj_val),arg) }
 
-let hcons_j j =
-  { uj_val = hcons_constr j.uj_val; uj_type = hcons_constr j.uj_type} 
-
 let feedback_completion_typecheck =
-  let open Feedback in
   Option.iter (fun state_id ->
-      feedback ~id:(State state_id) Feedback.Complete)
+      Feedback.feedback ~id:state_id Feedback.Complete)
+
+let abstract_constant_universes = function
+  | Monomorphic_const_entry uctx ->
+    Univ.empty_level_subst, Monomorphic_const uctx
+  | 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 ~trust env kn dcl =
+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
+    | 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 abstract = poly && not (Option.is_empty kn) in
-      let usubst, univs = Univ.abstract_universes abstract uctx 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
-	Undef nl, RegularArity t, None, poly, univs, false, ctx
-
+      let t = Constr.hcons (Vars.subst_univs_level_constr usubst c) in
+      {
+        Cooking.cook_body = Undef nl;
+        cook_type = t;
+        cook_proj = None;
+        cook_universes = univs;
+        cook_inline = false;
+        cook_context = ctx;
+      }
+
+  (** Definition [c] is opaque (Qed), non polymorphic and with a specified type,
+      so we delay the typing and hash consing of its body.
+      Remark: when the universe quantification is given explicitly, we could
+      delay even in the polymorphic case.  *)
   | DefinitionEntry ({ const_entry_type = Some typ;
                        const_entry_opaque = true;
-		       const_entry_polymorphic = false} as c) ->
-      let env = push_context ~strict:true c.const_entry_universes env in
+		       const_entry_universes = Monomorphic_const_entry univs } as c) ->
+      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 ~greedy:true ~pure:true body (fun ((body,uctx),side_eff) ->
-          let body, uctx, signatures =
-            inline_side_effects env body uctx side_eff in
-          let valid_signatures = check_signatures trust signatures in
-	  let env' = push_context_set uctx env in
-          let j =
-            let body,env',ectx = skip_trusted_seff valid_signatures body env' in
-            let j = infer env' body in
-            unzip ectx j in
-          let j = hcons_j j in
-	  let subst = Univ.LMap.empty in
-          let _typ = constrain_type env' j c.const_entry_polymorphic subst
-	    (`SomeWJ (typ,tyj)) in
+        Future.chain body (fun ((body,uctx),side_eff) ->
+          let j, uctx = match trust with
+          | Pure ->
+            let env = push_context_set uctx env in
+            let j = infer env body in
+            let _ = judge_of_cast env j DEFAULTcast tyj in
+            j, uctx
+          | SideEffects mb ->
+            let (body, uctx, signatures) = inline_side_effects env body uctx side_eff in
+            let valid_signatures = check_signatures mb signatures in
+            let env = push_context_set uctx env in
+            let body,env,ectx = skip_trusted_seff valid_signatures body env in
+            let j = infer env body in
+            let j = unzip ectx j in
+            let _ = judge_of_cast env j DEFAULTcast tyj in
+            j, uctx
+          in
+          let c = Constr.hcons j.uj_val in
           feedback_completion_typecheck feedback_id;
-          j.uj_val, uctx) in
+          c, uctx) in
       let def = OpaqueDef (Opaqueproof.create proofterm) in
-      def, RegularArity typ, None, c.const_entry_polymorphic, 
-	c.const_entry_universes,
-	c.const_entry_inline_code, c.const_entry_secctx
-
+      {
+        Cooking.cook_body = def;
+        cook_type = typ;
+        cook_proj = None;
+        cook_universes = Monomorphic_const univs;
+        cook_inline = c.const_entry_inline_code;
+        cook_context = c.const_entry_secctx;
+      }
+
+  (** Other definitions have to be processed immediately. *)
   | DefinitionEntry c ->
       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 univsctx = Univ.ContextSet.of_context c.const_entry_universes in
-      let body, ctx, _ = inline_side_effects env body
-        (Univ.ContextSet.union univsctx ctx) side_eff in
-      let env = push_context_set ~strict:(not c.const_entry_polymorphic) ctx env in
-      let abstract = c.const_entry_polymorphic && not (Option.is_empty kn) in
-      let usubst, univs =
-	Univ.abstract_universes abstract (Univ.ContextSet.to_context ctx) in      
+      let body, ctx, _ = match trust with
+      | Pure -> body, ctx, []
+      | SideEffects _ -> inline_side_effects env body ctx side_eff
+      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 = constrain_type env j c.const_entry_polymorphic usubst (map_option_typ typ) in
-      let def = hcons_constr (Vars.subst_univs_level_constr usubst j.uj_val) in
+      let typ = match typ with
+        | None ->
+          Vars.subst_univs_level_constr usubst j.uj_type
+        | Some t ->
+           let tj = infer_type env t in
+           let _ = judge_of_cast env j DEFAULTcast tj in
+           Vars.subst_univs_level_constr usubst t
+      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) 
       in
 	feedback_completion_typecheck feedback_id;
-	def, typ, None, c.const_entry_polymorphic,
-        univs, c.const_entry_inline_code, c.const_entry_secctx
+      {
+        Cooking.cook_body = def;
+        cook_type = typ;
+        cook_proj = None;
+        cook_universes = univs;
+        cook_inline = c.const_entry_inline_code;
+        cook_context = c.const_entry_secctx;
+      }
 
   | ProjectionEntry {proj_entry_ind = ind; proj_entry_arg = i} ->
     let mib, _ = Inductive.lookup_mind_specif env (ind,0) in
@@ -241,61 +359,71 @@ let infer_declaration ~trust env kn dcl =
 	else assert false
       | _ -> assert false
     in
+    let univs =
+      match mib.mind_universes with
+      | Monomorphic_ind ctx -> Monomorphic_const ctx
+      | Polymorphic_ind auctx -> Polymorphic_const auctx
+      | Cumulative_ind acumi ->
+        Polymorphic_const (Univ.ACumulativityInfo.univ_context acumi)
+    in
     let term, typ = pb.proj_eta in
-      Def (Mod_subst.from_val (hcons_constr term)), RegularArity typ, Some pb,
-      mib.mind_polymorphic, mib.mind_universes, false, None
-
-let global_vars_set_constant_type env = function
-  | RegularArity t -> global_vars_set env t
-  | TemplateArity (ctx,_) ->
-      Context.Rel.fold_outside
-        (Context.Rel.Declaration.fold
-	  (fun t c -> Id.Set.union (global_vars_set env t) c))
-      ctx ~init:Id.Set.empty
-
-let record_aux env s_ty s_bo suggested_expr =
-  let open Context.Named.Declaration in
+    {
+      Cooking.cook_body = Def (Mod_subst.from_val (Constr.hcons term));
+      cook_type = typ;
+      cook_proj = Some pb;
+      cook_universes = univs;
+      cook_inline = false;
+      cook_context = None;
+    }
+
+let record_aux env s_ty s_bo =
   let in_ty = keep_hyps env s_ty in
   let v =
     String.concat " "
       (CList.map_filter (fun decl ->
-          let id = get_id decl in
-          if List.exists (Id.equal id % get_id) in_ty then None
+          let id = NamedDecl.get_id decl in
+          if List.exists (NamedDecl.get_id %> Id.equal id) in_ty then None
           else Some (Id.to_string id))
         (keep_hyps env s_bo)) in
-  Aux_file.record_in_aux "context_used" (v ^ ";" ^ suggested_expr)
+  Aux_file.record_in_aux "context_used" v
 
-let suggest_proof_using = ref (fun _ _ _ _ _ -> "")
-let set_suggest_proof_using f = suggest_proof_using := f
-
-let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx) =
-  let open Context.Named.Declaration in
+let build_constant_declaration kn env result =
+  let open Cooking in
+  let typ = result.cook_type in
   let check declared inferred =
-    let mk_set l = List.fold_right Id.Set.add (List.map get_id l) Id.Set.empty in
+    let mk_set l = List.fold_right Id.Set.add (List.map NamedDecl.get_id l) Id.Set.empty in
     let inferred_set, declared_set = mk_set inferred, mk_set declared in
     if not (Id.Set.subset inferred_set declared_set) then
-      let l = Id.Set.elements (Idset.diff inferred_set declared_set) in
+      let l = Id.Set.elements (Id.Set.diff inferred_set declared_set) in
       let n = List.length l in
-      errorlabstrm "" (Pp.(str "The following section " ++
-        str (String.plural n "variable") ++
-        str " " ++ str (String.conjugate_verb_to_be n) ++
-        str " used but not declared:" ++
-        fnl () ++ pr_sequence Id.print (List.rev l) ++ str ".")) in
+      let 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"); " ";
+          (String.conjugate_verb_to_be n); " used but not declared:"] ++ fnl () ++
+         missing_vars ++ str "." ++ fnl () ++ fnl () ++
+         str "You can either update your proof to not depend on " ++ missing_vars ++
+         str ", or you can update your Proof line from" ++ fnl () ++
+         str "Proof using " ++ declared_vars ++ fnl () ++
+         str "to" ++ fnl () ++
+         str "Proof using " ++ inferred_vars) in
   let sort evn l =
     List.filter (fun decl ->
-      let id = get_id decl in
-      List.exists (Names.Id.equal id % get_id) l)
+      let id = NamedDecl.get_id decl in
+      List.exists (NamedDecl.get_id %> Names.Id.equal id) l)
     (named_context env) in
   (* We try to postpone the computation of used section variables *)
   let hyps, def =
-    let context_ids = List.map get_id (named_context env) in
-    match ctx with
+    let context_ids = List.map NamedDecl.get_id (named_context env) in
+    let def = result.cook_body in
+    match result.cook_context with
     | None when not (List.is_empty context_ids) -> 
         (* No declared section vars, and non-empty section context:
            we must look at the body NOW, if any *)
-        let ids_typ = global_vars_set_constant_type env typ in
+        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 =
@@ -303,17 +431,13 @@ let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx)
                 (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 *)
@@ -321,22 +445,22 @@ let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx)
         match def with
         | Undef _ as x -> x (* nothing to check *)
         | Def cs as x ->
-            let ids_typ = global_vars_set_constant_type env typ in
+            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_constant_type env typ in
+              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 = 
     let res =
-      let comp_univs = if poly then Some univs else None in
-      match proj with
-      | None -> compile_constant_body env comp_univs def
+      match result.cook_proj with
+      | None -> compile_constant_body env univs def
       | Some pb ->
 	(* The compilation of primitive projections is a bit tricky, because
            they refer to themselves (the body of p looks like fun c =>
@@ -348,48 +472,51 @@ let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx)
 	  { const_hyps = hyps;
 	    const_body = def;
 	    const_type = typ;
-	    const_proj = proj;
+	    const_proj = result.cook_proj;
 	    const_body_code = None;
-	    const_polymorphic = poly;
 	    const_universes = univs;
-	    const_inline_code = inline_code;
+	    const_inline_code = result.cook_inline;
 	    const_typing_flags = Environ.typing_flags env;
 	    }
 	in
 	let env = add_constant kn cb env in
-	compile_constant_body env comp_univs def
+	compile_constant_body env univs def
     in Option.map Cemitcodes.from_val res
   in
   { const_hyps = hyps;
     const_body = def;
     const_type = typ;
-    const_proj = proj;
+    const_proj = result.cook_proj;
     const_body_code = tps;
-    const_polymorphic = poly;
     const_universes = univs;
-    const_inline_code = inline_code;
+    const_inline_code = result.cook_inline;
     const_typing_flags = Environ.typing_flags env }
 
 (*s Global and local constant declaration. *)
 
 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 =
+    match cb.const_universes with
+    | Monomorphic_const uctx ->
+      Monomorphic_const_entry uctx
+    | Polymorphic_const auctx -> 
+      Polymorphic_const_entry (Univ.AUContext.repr auctx)
+  in
   let pt =
     match cb.const_body, u with
     | OpaqueDef _, `Opaque (b, c) -> b, c
     | Def b, `Nothing -> Mod_subst.force_constr b, Univ.ContextSet.empty
     | _ -> assert false in
   DefinitionEntry {
-    const_entry_body = Future.from_val (pt, []);
+    const_entry_body = Future.from_val (pt, ());
     const_entry_secctx = None;
     const_entry_feedback = None;
-    const_entry_type =
-      (match cb.const_type with RegularArity t -> Some t | _ -> None);
-    const_entry_polymorphic = cb.const_polymorphic;
-    const_entry_universes = cb.const_universes;
+    const_entry_type = Some cb.const_type;
+    const_entry_universes = univs;
     const_entry_opaque = Declareops.is_opaque cb;
     const_entry_inline_code = cb.const_inline_code }
 ;;
@@ -407,17 +534,14 @@ type side_effect_role =
   | Schema of inductive * string
 
 type exported_side_effect = 
-  constant * constant_body * side_effects constant_entry * side_effect_role
+  Constant.t * constant_body * side_effect_role
 
-let export_side_effects mb env ce =
-  match ce with
-  | ParameterEntry _ | ProjectionEntry _ -> [], ce
-  | 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 ~greedy:true ~pure:true body
-          (fun (b_ctx, _) -> b_ctx, []) } in
+      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
         with Not_found -> true in 
@@ -429,20 +553,27 @@ let export_side_effects mb env ce =
         let cbl = List.filter not_exists cbl in
         if cbl = [] then acc, sl
         else cbl :: acc, (mb,List.length cbl) :: sl in
-      let seff, signatures = List.fold_left aux ([],[]) (uniq_seff eff) in
+      let seff, signatures = List.fold_left aux ([],[]) (uniq_seff_rev eff) in
       let trusted = check_signatures mb signatures in
       let push_seff env = function
         | kn, cb, `Nothing, _ ->
-           let env = Environ.add_constant kn cb env in
-	   if not cb.const_polymorphic then
-	     Environ.push_context ~strict:true cb.const_universes env
-	   else env
-        | kn, cb, `Opaque(_, ctx), _ -> 
-           let env = Environ.add_constant kn cb env in
-	   if not cb.const_polymorphic then
-	     let env = Environ.push_context ~strict:true cb.const_universes env in
-             Environ.push_context_set ~strict:true ctx env
-	   else env in
+          begin
+            let env = Environ.add_constant kn cb env in
+            match cb.const_universes with
+            | Monomorphic_const ctx ->
+              Environ.push_context_set ~strict:true ctx env
+            | Polymorphic_const _ -> env
+          end
+        | kn, cb, `Opaque(_, ctx), _ ->
+          begin
+            let env = Environ.add_constant kn cb env in
+            match cb.const_universes with
+            | Monomorphic_const cstctx ->
+              let env = Environ.push_context_set ~strict:true cstctx env in
+              Environ.push_context_set ~strict:true ctx env
+            | Polymorphic_const _ -> env
+          end
+      in
       let rec translate_seff sl seff acc env =
         match sl, seff with
         | _, [] -> List.rev acc, ce
@@ -450,8 +581,8 @@ let export_side_effects mb env ce =
            let env, cbs =
              List.fold_left (fun (env,cbs) (kn, ocb, u, r) ->
                let ce = constant_entry_of_side_effect ocb u in
-               let cb = translate_constant mb env kn ce in
-               (push_seff env (kn, cb,`Nothing, Subproof),(kn,cb,ce,r) :: cbs)) 
+               let cb = translate_constant Pure env kn ce in
+               (push_seff env (kn, cb,`Nothing, Subproof),(kn,cb,r) :: cbs)) 
              (env,[]) cbs in
            translate_seff sl rest (cbs @ acc) env
         | Some sl, cbs :: rest ->
@@ -459,7 +590,7 @@ let export_side_effects mb env ce =
            let cbs = List.map turn_direct cbs in
            let env = List.fold_left push_seff env cbs in
            let ecbs = List.map (fun (kn,cb,u,r) ->
-             kn, cb, constant_entry_of_side_effect cb u, r) cbs in
+             kn, cb, r) cbs in
            translate_seff (Some (sl-cbs_len)) rest (ecbs @ acc) env
      in
        translate_seff trusted seff [] env
@@ -471,38 +602,62 @@ let translate_local_assum env t =
     t
 
 let translate_recipe env kn r =
-  build_constant_declaration kn env (Cooking.cook_constant env r)
-
-let translate_local_def mb env id centry =
-  let def,typ,proj,poly,univs,inline_code,ctx =
-    infer_declaration ~trust:mb env None (DefinitionEntry centry) in
-  let typ = type_of_constant_type env typ in
-  if ctx = None && !Flags.compilation_mode = Flags.BuildVo then begin
-    match def with
+  (** We only hashcons the term when outside of a section, otherwise this would
+      be useless. It is detected by the dirpath of the constant being empty. *)
+  let (_, dir, _) = Constant.repr3 kn in
+  let hcons = DirPath.is_empty dir in
+  build_constant_declaration kn env (Cooking.cook_constant ~hcons env r)
+
+let translate_local_def env id centry =
+  let open Cooking 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.record_aux_file then begin
+    match decl.cook_body with
     | Undef _ -> ()
     | Def _ -> ()
     | OpaqueDef lc ->
-       let open Context.Named.Declaration in
-       let context_ids = List.map 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;
-  def, typ, univs
+  let () = match decl.cook_universes with
+  | Monomorphic_const ctx -> assert (Univ.ContextSet.is_empty ctx)
+  | Polymorphic_const _ -> assert false
+  in
+  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 ~greedy:true ~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'), []);
+      (body, ctx'), ());
 }
 
 let inline_side_effects env body side_eff =
diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli
index fcd95576..6a0ff072 100644
--- a/kernel/term_typing.mli
+++ b/kernel/term_typing.mli
@@ -1,19 +1,27 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Declarations
 open Entries
 
-val translate_local_def : structure_body -> env -> Id.t -> side_effects definition_entry ->
-  constant_def * types * constant_universes
+type side_effects
+
+type _ trust =
+| Pure : unit trust
+| SideEffects : structure_body -> side_effects trust
+
+val translate_local_def : env -> Id.t -> section_def_entry ->
+  constr * types
 
 val translate_local_assum : env -> types -> types
 
@@ -24,15 +32,24 @@ val inline_side_effects : env -> constr -> side_effects -> constr
     redexes. *)
 
 val inline_entry_side_effects :
-  env -> side_effects definition_entry -> side_effects definition_entry
+  env -> side_effects definition_entry -> unit definition_entry
 (** Same as {!inline_side_effects} but applied to entries. Only modifies the
     {!Entries.const_entry_body} field. It is meant to get a term out of a not
     yet type checked proof. *)
 
-val uniq_seff : side_effects -> side_effects
+val empty_seff : side_effects
+val add_seff : side_effect -> side_effects -> side_effects
+val concat_seff : side_effects -> side_effects -> side_effects
+(** [concat_seff e1 e2] adds the side-effects of [e1] to [e2], i.e. effects in
+    [e1] must be more recent than those of [e2]. *)
+val uniq_seff : side_effects -> side_effect list
+(** Return the list of individual side-effects in the order of their
+    creation. *)
+
+val equal_eff : side_effect -> side_effect -> bool
 
 val translate_constant :
-  structure_body -> env -> constant -> side_effects constant_entry ->
+  'a trust -> env -> Constant.t -> 'a constant_entry ->
     constant_body
 
 type side_effect_role =
@@ -40,31 +57,25 @@ type side_effect_role =
   | Schema of inductive * string
 
 type exported_side_effect = 
-  constant * constant_body * side_effects constant_entry * 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 * side_effects constant_entry
-
-val constant_entry_of_side_effect :
-  constant_body -> seff_env -> side_effects 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:structure_body -> env -> constant option -> 
-  side_effects constant_entry -> Cooking.result
+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 5071f0ad..1c323e3e 100644
--- a/kernel/type_errors.ml
+++ b/kernel/type_errors.ml
@@ -1,63 +1,69 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Reduction
 
 (* Type errors. *)
 
-type guard_error =
+type 'constr pguard_error =
   (* Fixpoints *)
   | NotEnoughAbstractionInFixBody
-  | RecursionNotOnInductiveType of constr
-  | RecursionOnIllegalTerm of int * (env * constr) * int list * int list
+  | RecursionNotOnInductiveType of 'constr
+  | RecursionOnIllegalTerm of int * (env * 'constr) * int list * int list
   | NotEnoughArgumentsForFixCall of int
   (* CoFixpoints *)
-  | CodomainNotInductiveType of constr
+  | 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
+  | 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 guard_error = constr pguard_error
 
 type arity_error =
   | NonInformativeToInformative
   | StrongEliminationOnNonSmallType
   | WrongArity
 
-type type_error =
+type ('constr, 'types) ptype_error =
   | UnboundRel of int
   | UnboundVar of variable
-  | NotAType of unsafe_judgment
-  | BadAssumption of unsafe_judgment
-  | ReferenceVariables of identifier * constr
-  | ElimArity of pinductive * sorts_family list * constr * unsafe_judgment
-      * (sorts_family * sorts_family * arity_error) option
-  | CaseNotInductive of unsafe_judgment
+  | NotAType of ('constr, 'types) punsafe_judgment
+  | BadAssumption of ('constr, 'types) punsafe_judgment
+  | 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 unsafe_judgment * int
-  | IllFormedBranch of constr * pconstructor * constr * constr
-  | Generalization of (Name.t * types) * unsafe_judgment
-  | ActualType of unsafe_judgment * types
+  | 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) * unsafe_judgment * unsafe_judgment array
-  | CantApplyNonFunctional of unsafe_judgment * unsafe_judgment array
-  | IllFormedRecBody of guard_error * Name.t array * int * env * unsafe_judgment array
+      (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 * unsafe_judgment array * types array
-  | UnsatisfiedConstraints of Univ.constraints
+      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 env * type_error
 
@@ -111,6 +117,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 0c3a952b..20bf300a 100644
--- a/kernel/type_errors.mli
+++ b/kernel/type_errors.mli
@@ -1,64 +1,70 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 
 (** Type errors. {% \label{%}typeerrors{% }%} *)
 
 (*i Rem: NotEnoughAbstractionInFixBody should only occur with "/i" Fix
     notation i*)
-type guard_error =
+type 'constr pguard_error =
   (** Fixpoints *)
   | NotEnoughAbstractionInFixBody
-  | RecursionNotOnInductiveType of constr
-  | RecursionOnIllegalTerm of int * (env * constr) * int list * int list
+  | RecursionNotOnInductiveType of 'constr
+  | RecursionOnIllegalTerm of int * (env * 'constr) * int list * int list
   | NotEnoughArgumentsForFixCall of int
   (** CoFixpoints *)
-  | CodomainNotInductiveType of constr
+  | 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
+  | 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 guard_error = constr pguard_error
 
 type arity_error =
   | NonInformativeToInformative
   | StrongEliminationOnNonSmallType
   | WrongArity
 
-type type_error =
+type ('constr, 'types) ptype_error =
   | UnboundRel of int
   | UnboundVar of variable
-  | NotAType of unsafe_judgment
-  | BadAssumption of unsafe_judgment
-  | ReferenceVariables of identifier * constr
-  | ElimArity of pinductive * sorts_family list * constr * unsafe_judgment
-      * (sorts_family * sorts_family * arity_error) option
-  | CaseNotInductive of unsafe_judgment
+  | NotAType of ('constr, 'types) punsafe_judgment
+  | BadAssumption of ('constr, 'types) punsafe_judgment
+  | 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 unsafe_judgment * int
-  | IllFormedBranch of constr * pconstructor * constr * constr
-  | Generalization of (Name.t * types) * unsafe_judgment
-  | ActualType of unsafe_judgment * types
+  | 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) * unsafe_judgment * unsafe_judgment array
-  | CantApplyNonFunctional of unsafe_judgment * unsafe_judgment array
-  | IllFormedRecBody of guard_error * Name.t array * int * env * unsafe_judgment array
+      (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 * unsafe_judgment array * types array
-  | UnsatisfiedConstraints of Univ.constraints
+      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 env * type_error
 
@@ -70,11 +76,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
 
@@ -99,6 +105,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 0059111c..be4c0e1e 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -1,24 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Names
 open Univ
-open Term
+open Sorts
+open Constr
 open Vars
 open Declarations
 open Environ
-open Entries
 open Reduction
 open Inductive
 open Type_errors
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let conv_leq l2r env x y = default_conv CUMUL ~l2r env x y
 
@@ -35,61 +39,50 @@ let check_constraints cst env =
   if Environ.check_constraints cst env then ()
   else error_unsatisfied_constraints env cst
 
-(* This should be a type (a priori without intension to be an assumption) *)
-let type_judgment env j =
-  match kind_of_term(whd_all env j.uj_type) with
-    | Sort s -> {utj_val = j.uj_val; utj_type = s }
-    | _ -> error_not_type env j
+(* This should be a type (a priori without intention to be an assumption) *)
+let check_type env c t =
+  match kind(whd_all env t) with
+  | Sort s -> s
+  | _ -> error_not_type env (make_judge c t)
 
-(* This should be a type intended to be assumed. The error message is *)
-(* not as useful as for [type_judgment]. *)
-let assumption_of_judgment env j =
-  try (type_judgment env j).utj_val
+(* This should be a type intended to be assumed. The error message is
+   not as useful as for [type_judgment]. *)
+let check_assumption env t ty =
+  try let _ = check_type env t ty in t
   with TypeError _ ->
-    error_assumption env j
+    error_assumption env (make_judge t ty)
 
 (************************************************)
-(* Incremental typing rules: builds a typing judgement given the *)
-(* judgements for the subterms. *)
+(* Incremental typing rules: builds a typing judgment given the *)
+(* judgments for the subterms. *)
 
 (*s Type of sorts *)
 
 (* Prop and Set *)
 
-let judge_of_prop =
-  { uj_val = mkProp;
-    uj_type = mkSort type1_sort }
-
-let judge_of_set =
-  { uj_val = mkSet;
-    uj_type = mkSort type1_sort }
-
-let judge_of_prop_contents = function
-  | Null -> judge_of_prop
-  | Pos -> judge_of_set
+let type1 = mkSort Sorts.type1
 
 (* Type of Type(i). *)
 
-let judge_of_type u =
+let type_of_type u =
   let uu = Universe.super u in
-    { uj_val = mkType u;
-      uj_type = mkType uu }
+    mkType uu
+
+let type_of_sort = function
+  | Prop c -> type1
+  | Type u -> type_of_type u
 
 (*s Type of a de Bruijn index. *)
 
-let judge_of_relative env n =
+let type_of_relative env n =
   try
-    let typ = get_type (lookup_rel n env) in
-    { uj_val  = mkRel n;
-      uj_type = lift n typ }
+    env |> lookup_rel n |> RelDecl.get_type |> lift n
   with Not_found ->
     error_unbound_rel env n
 
 (* Type of variables *)
-let judge_of_variable env id =
-  try
-    let ty = named_type id env in
-    make_judge (mkVar id) ty
+let type_of_variable env id =
+  try named_type id env
   with Not_found ->
     error_unbound_var env id
 
@@ -98,11 +91,11 @@ let judge_of_variable env id =
 (* Checks if a context of variables can be instantiated by the
    variables of the current env.
    Order does not have to be checked assuming that all names are distinct *)
-let check_hyps_inclusion env c sign =
+let check_hyps_inclusion env f c sign =
   Context.Named.fold_outside
     (fun d1 () ->
       let open Context.Named.Declaration in
-      let id = get_id d1 in
+      let id = NamedDecl.get_id d1 in
       try
         let d2 = lookup_named id env in
         conv env (get_type d2) (get_type d1);
@@ -114,7 +107,7 @@ let check_hyps_inclusion env c sign =
         | LocalDef _, LocalAssum _ -> raise NotConvertible
         | LocalDef (_,b2,_), LocalDef (_,b1,_) -> conv env b2 b1);
       with Not_found | NotConvertible | Option.Heterogeneous ->
-        error_reference_variables env id c)
+        error_reference_variables env id (f c))
     sign
     ~init:()
 
@@ -122,86 +115,20 @@ let check_hyps_inclusion env c sign =
 
 (* Make a type polymorphic if an arity *)
 
-let extract_level env p =
-  let _,c = dest_prod_assum env p in
-  match kind_of_term c with Sort (Type u) -> Univ.Universe.level u | _ -> None
-
-let extract_context_levels env l =
-  let fold l = function
-    | LocalAssum (_,p) -> extract_level env p :: l
-    | LocalDef _ -> l
-  in
-  List.fold_left fold [] l
-
-let make_polymorphic_if_constant_for_ind env {uj_val = c; uj_type = t} =
-  let params, ccl = dest_prod_assum env t in
-  match kind_of_term ccl with
-  | Sort (Type u) ->
-     let ind, l = decompose_app (whd_all env c) in
-     if isInd ind && List.is_empty l then
-       let mis = lookup_mind_specif env (fst (destInd ind)) in
-       let nparams = Inductive.inductive_params mis in
-       let paramsl = CList.lastn nparams params in
-       let param_ccls = extract_context_levels env paramsl in
-       let s = { template_param_levels = param_ccls; template_level = u} in
-       TemplateArity (params,s)
-     else RegularArity t
-  | _ ->
-      RegularArity t
-
 (* Type of constants *)
 
-let type_of_constant_type_knowing_parameters env t paramtyps =
-  match t with
-  | RegularArity t -> t
-  | TemplateArity (sign,ar) ->
-      let ctx = List.rev sign in
-      let ctx,s = instantiate_universes env ctx ar paramtyps in
-      mkArity (List.rev ctx,s)
-
-let type_of_constant_knowing_parameters env cst paramtyps =
-  let cb = lookup_constant (fst cst) env in
-  let () = check_hyps_inclusion env (mkConstU cst) cb.const_hyps in
-  let ty, cu = constant_type env cst in
-    type_of_constant_type_knowing_parameters env ty paramtyps, cu
-
-let type_of_constant_knowing_parameters_in env cst paramtyps =
-  let cb = lookup_constant (fst cst) env in
-  let () = check_hyps_inclusion env (mkConstU cst) cb.const_hyps in
-  let ty = constant_type_in env cst in
-    type_of_constant_type_knowing_parameters env ty paramtyps
-
-let type_of_constant_type env t =
-  type_of_constant_type_knowing_parameters env t [||]
 
-let type_of_constant env cst =
-  type_of_constant_knowing_parameters env cst [||]
-
-let type_of_constant_in env cst =
-  let cb = lookup_constant (fst cst) env in
-  let () = check_hyps_inclusion env (mkConstU cst) cb.const_hyps in
-  let ar = constant_type_in env cst in
-    type_of_constant_type_knowing_parameters env ar [||]
-
-let judge_of_constant_knowing_parameters env (kn,u as cst) args =
-  let c = mkConstU cst in
-  let ty, cu = type_of_constant_knowing_parameters env cst args in
+let type_of_constant env (kn,u as cst) =
+  let cb = lookup_constant kn env in
+  let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in
+  let ty, cu = constant_type env cst in
   let () = check_constraints cu env in
-    make_judge c ty
-
-let judge_of_constant env cst =
-  judge_of_constant_knowing_parameters env cst [||]
-
-let type_of_projection env (p,u) =
-  let cst = Projection.constant p in
-  let cb = lookup_constant cst env in
-  match cb.const_proj with
-  | Some pb -> 
-    if cb.const_polymorphic then
-      Vars.subst_instance_constr u pb.proj_type
-    else pb.proj_type
-  | None -> raise (Invalid_argument "type_of_projection: not a projection")
+    ty
 
+let type_of_constant_in env (kn,u as cst) =
+  let cb = lookup_constant kn env in
+  let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in
+  constant_type_in env cst
 
 (* Type of a lambda-abstraction. *)
 
@@ -215,40 +142,36 @@ let type_of_projection env (p,u) =
   and no upper constraint exists on the sort $s$, we don't need to compute $s$
 *)
 
-let judge_of_abstraction env name var j =
-  { uj_val = mkLambda (name, var.utj_val, j.uj_val);
-    uj_type = mkProd (name, var.utj_val, j.uj_type) }
-
-(* Type of let-in. *)
-
-let judge_of_letin env name defj typj j =
-  { uj_val = mkLetIn (name, defj.uj_val, typj.utj_val, j.uj_val) ;
-    uj_type = subst1 defj.uj_val j.uj_type }
+let type_of_abstraction env name var ty =
+  mkProd (name, var, ty)
 
 (* Type of an application. *)
 
-let judge_of_apply env funj argjv =
-  let rec apply_rec n typ = function
-    | [] ->
-	{ uj_val  = mkApp (j_val funj, Array.map j_val argjv);
-          uj_type = typ }
-    | hj::restjl ->
-        (match kind_of_term (whd_all env typ) with
-          | Prod (_,c1,c2) ->
-	      (try
-		 let () = conv_leq false env hj.uj_type c1 in
-		   apply_rec (n+1) (subst1 hj.uj_val c2) restjl
-	      with NotConvertible ->
-		error_cant_apply_bad_type env
-		  (n,c1, hj.uj_type)
-		  funj argjv)
-
-          | _ ->
-	      error_cant_apply_not_functional env funj argjv)
-  in
-  apply_rec 1
-    funj.uj_type
-    (Array.to_list argjv)
+let make_judgev c t = 
+  Array.map2 make_judge c t
+
+let type_of_apply env func funt argsv argstv =
+  let len = Array.length argsv in
+  let rec apply_rec i typ = 
+    if Int.equal i len then typ
+    else 
+      (match kind (whd_all env typ) with
+      | Prod (_,c1,c2) ->
+	let arg = argsv.(i) and argt = argstv.(i) in
+	  (try
+	     let () = conv_leq false env argt c1 in
+	       apply_rec (i+1) (subst1 arg c2)
+	   with NotConvertible ->
+	     error_cant_apply_bad_type env
+	       (i+1,c1,argt)
+	       (make_judge func funt)
+	       (make_judgev argsv argstv))
+	    
+      | _ ->
+	error_cant_apply_not_functional env 
+	  (make_judge func funt)
+	  (make_judgev argsv argstv))
+  in apply_rec 0 funt
 
 (* Type of product *)
 
@@ -281,10 +204,9 @@ let sort_of_product env domsort rangsort =
 
   where j.uj_type is convertible to a sort s2
 *)
-let judge_of_product env name t1 t2 =
-  let s = sort_of_product env t1.utj_type t2.utj_type in
-  { uj_val = mkProd (name, t1.utj_val, t2.utj_val);
-    uj_type = mkSort s }
+let type_of_product env name s1 s2 =
+  let s = sort_of_product env s1 s2 in
+    mkSort s
 
 (* Type of a type cast *)
 
@@ -295,29 +217,20 @@ let judge_of_product env name t1 t2 =
          env |- c:typ2
 *)
 
-let judge_of_cast env cj k tj =
-  let expected_type = tj.utj_val in
+let check_cast env c ct k expected_type =
   try
-    let c, cst =
-      match k with
-      | VMcast ->
-          mkCast (cj.uj_val, k, expected_type),
-          Reduction.vm_conv CUMUL env cj.uj_type expected_type
-      | DEFAULTcast ->
-          mkCast (cj.uj_val, k, expected_type),
-          default_conv ~l2r:false CUMUL env cj.uj_type expected_type
-      | REVERTcast ->
-          cj.uj_val,
-          default_conv ~l2r:true CUMUL env cj.uj_type expected_type
-      | NATIVEcast ->
-	 let sigma = Nativelambda.empty_evars in
-         mkCast (cj.uj_val, k, expected_type),
-         Nativeconv.native_conv CUMUL sigma env cj.uj_type expected_type
-    in
-      { uj_val = c;
-	uj_type = expected_type }
+    match k with
+    | VMcast ->
+      vm_conv CUMUL env ct expected_type
+    | DEFAULTcast ->
+      default_conv ~l2r:false CUMUL env ct expected_type
+    | REVERTcast ->
+      default_conv ~l2r:true CUMUL env ct expected_type
+    | NATIVEcast ->
+      let sigma = Nativelambda.empty_evars in
+      Nativeconv.native_conv CUMUL sigma env ct expected_type
   with NotConvertible ->
-    error_actual_type env cj expected_type
+    error_actual_type env (make_judge c ct) expected_type
 
 (* Inductive types. *)
 
@@ -333,83 +246,78 @@ let judge_of_cast env cj k tj =
    the App case of execute; from this constraints, the expected
    dynamic constraints of the form u<=v are enforced *)
 
-let judge_of_inductive_knowing_parameters env (ind,u as indu) args =
-  let c = mkIndU indu in
+let type_of_inductive_knowing_parameters env (ind,u as indu) args =
   let (mib,mip) as spec = lookup_mind_specif env ind in
-  check_hyps_inclusion env c mib.mind_hyps;
+  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
   let t,cst = Inductive.constrained_type_of_inductive_knowing_parameters 
     env (spec,u) args
   in
-    check_constraints cst env;
-    make_judge c t
+  check_constraints cst env;
+  t
 
-let judge_of_inductive env (ind,u as indu) =
-  let c = mkIndU indu in
-  let (mib,mip) as spec = lookup_mind_specif env ind in
-  check_hyps_inclusion env c mib.mind_hyps;
-  let t,cst = Inductive.constrained_type_of_inductive env (spec,u) in
-    check_constraints cst env;
-    (make_judge c t)
+let type_of_inductive env (ind,u as indu) =
+  let (mib,mip) = lookup_mind_specif env ind in
+  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
+  let t,cst = Inductive.constrained_type_of_inductive env ((mib,mip),u) in
+  check_constraints cst env;
+  t
 
 (* Constructors. *)
 
-let judge_of_constructor env (c,u as cu) =
-  let constr = mkConstructU cu in
-  let _ =
+let type_of_constructor env (c,u as cu) =
+  let () =
     let ((kn,_),_) = c in
     let mib = lookup_mind kn env in
-    check_hyps_inclusion env constr mib.mind_hyps in
+    check_hyps_inclusion env mkConstructU cu mib.mind_hyps
+  in
   let specif = lookup_mind_specif env (inductive_of_constructor c) in
   let t,cst = constrained_type_of_constructor cu specif in
   let () = check_constraints cst env in
-    (make_judge constr t)
+  t
 
 (* Case. *)
 
-let check_branch_types env (ind,u) cj (lfj,explft) =
-  try conv_leq_vecti env (Array.map j_type lfj) explft
+let check_branch_types env (ind,u) c ct lft explft =
+  try conv_leq_vecti env lft explft
   with
       NotConvertibleVect i ->
-        error_ill_formed_branch env cj.uj_val ((ind,i+1),u) lfj.(i).uj_type explft.(i)
+        error_ill_formed_branch env c ((ind,i+1),u) lft.(i) explft.(i)
     | Invalid_argument _ ->
-        error_number_branches env cj (Array.length explft)
+        error_number_branches env (make_judge c ct) (Array.length explft)
 
-let judge_of_case env ci pj cj lfj =
+let type_of_case env ci p pt c ct lf lft =
   let (pind, _ as indspec) =
-    try find_rectype env cj.uj_type
-    with Not_found -> error_case_not_inductive env cj in
+    try find_rectype env ct
+    with Not_found -> error_case_not_inductive env (make_judge c ct) in
   let () = check_case_info env pind ci in
   let (bty,rslty) =
-    type_case_branches env indspec pj cj.uj_val in
-  let () = check_branch_types env pind cj (lfj,bty) in
-  ({ uj_val  = mkCase (ci, (*nf_betaiota*) pj.uj_val, cj.uj_val,
-                       Array.map j_val lfj);
-     uj_type = rslty })
+    type_case_branches env indspec (make_judge p pt) c in
+  let () = check_branch_types env pind c ct lft bty in
+  rslty
 
-let judge_of_projection env p cj =
+let type_of_projection env p c ct =
   let pb = lookup_projection p env in
   let (ind,u), args =
-    try find_rectype env cj.uj_type
-    with Not_found -> error_case_not_inductive env cj
+    try find_rectype env ct
+    with Not_found -> error_case_not_inductive env (make_judge c ct)
   in
-    assert(eq_mind pb.proj_ind (fst ind));
-    let ty = Vars.subst_instance_constr u pb.Declarations.proj_type in
-    let ty = substl (cj.uj_val :: List.rev args) ty in
-      {uj_val = mkProj (p,cj.uj_val);
-       uj_type = ty}
+  assert(MutInd.equal pb.proj_ind (fst ind));
+  let ty = Vars.subst_instance_constr u pb.Declarations.proj_type in
+  substl (c :: CList.rev args) ty
+      
 
 (* Fixpoints. *)
 
 (* Checks the type of a general (co)fixpoint, i.e. without checking *)
 (* the specific guard condition. *)
 
-let type_fixpoint env lna lar vdefj =
-  let lt = Array.length vdefj in
+let check_fixpoint env lna lar vdef vdeft =
+  let lt = Array.length vdeft in
   assert (Int.equal (Array.length lar) lt);
   try
-    conv_leq_vecti env (Array.map j_type vdefj) (Array.map (fun ty -> lift lt ty) lar)
+    conv_leq_vecti env vdeft (Array.map (fun ty -> lift lt ty) lar)
   with NotConvertibleVect i ->
-    error_ill_typed_rec_body env i lna vdefj lar
+    error_ill_typed_rec_body env i lna (make_judgev vdef vdeft) lar
 
 (************************************************************************)
 (************************************************************************)
@@ -419,150 +327,214 @@ let type_fixpoint env lna lar vdefj =
     Ind et Constructsi un jour cela devient des constructions
     arbitraires et non plus des variables *)
 let rec execute env cstr =
-  match kind_of_term cstr with
+  let open Context.Rel.Declaration in
+  match kind cstr with
     (* Atomic terms *)
-    | Sort (Prop c) ->
-      judge_of_prop_contents c
-	
-    | Sort (Type u) ->
-      judge_of_type u
+    | Sort s -> type_of_sort s
 
     | Rel n ->
-      judge_of_relative env n
+      type_of_relative env n
 
     | Var id ->
-      judge_of_variable env id
+      type_of_variable env id
 
     | Const c ->
-      judge_of_constant env c
+      type_of_constant env c
 	
     | Proj (p, c) ->
-        let cj = execute env c in
-          judge_of_projection env p cj
+        let ct = execute env c in
+          type_of_projection env p c ct
 
     (* Lambda calculus operators *)
     | App (f,args) ->
-        let jl = execute_array env args in
-	let j =
-	  match kind_of_term f with
-	    | Ind ind when Environ.template_polymorphic_pind ind env ->
-		(* Sort-polymorphism of inductive types *)
-	      let args = Array.map (fun j -> lazy j.uj_type) jl in
-		judge_of_inductive_knowing_parameters env ind args
-	    | Const cst when Environ.template_polymorphic_pconstant cst env ->
-		(* Sort-polymorphism of constant *)
-	      let args = Array.map (fun j -> lazy j.uj_type) jl in
-		judge_of_constant_knowing_parameters env cst args
-	    | _ ->
-		(* No sort-polymorphism *)
-		execute env f
+        let argst = execute_array env args in
+	let ft =
+	  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
+	  | _ ->
+	    (* No template polymorphism *)
+            execute env f
 	in
-	  judge_of_apply env j jl
+
+          type_of_apply env f ft args argst
 
     | Lambda (name,c1,c2) ->
-      let varj = execute_type env c1 in
-      let env1 = push_rel (LocalAssum (name,varj.utj_val)) env in
-      let j' = execute env1 c2 in
-        judge_of_abstraction env name varj j'
+      let _ = execute_is_type env c1 in
+      let env1 = push_rel (LocalAssum (name,c1)) env in
+      let c2t = execute env1 c2 in
+        type_of_abstraction env name c1 c2t
 
     | Prod (name,c1,c2) ->
-      let varj = execute_type env c1 in
-      let env1 = push_rel (LocalAssum (name,varj.utj_val)) env in
-      let varj' = execute_type env1 c2 in
-	judge_of_product env name varj varj'
+      let vars = execute_is_type env c1 in
+      let env1 = push_rel (LocalAssum (name,c1)) env in
+      let vars' = execute_is_type env1 c2 in
+        type_of_product env name vars vars'
 
     | LetIn (name,c1,c2,c3) ->
-      let j1 = execute env c1 in
-      let j2 = execute_type env c2 in
-      let _ = judge_of_cast env j1 DEFAULTcast j2 in
-      let env1 = push_rel (LocalDef (name,j1.uj_val,j2.utj_val)) env in
-      let j' = execute env1 c3 in
-        judge_of_letin env name j1 j2 j'
+      let c1t = execute env c1 in
+      let _c2s = execute_is_type env c2 in
+      let () = check_cast env c1 c1t DEFAULTcast c2 in
+      let env1 = push_rel (LocalDef (name,c1,c2)) env in
+      let c3t = execute env1 c3 in
+	subst1 c1 c3t
 
     | Cast (c,k,t) ->
-      let cj = execute env c in
-      let tj = execute_type env t in
-        judge_of_cast env cj k tj
+      let ct = execute env c in
+      let _ts = (check_type env t (execute env t)) in
+      let () = check_cast env c ct k t in
+	t
 
     (* Inductive types *)
     | Ind ind ->
-      judge_of_inductive env ind
+      type_of_inductive env ind
 
     | Construct c ->
-      judge_of_constructor env c
+      type_of_constructor env c
 
     | Case (ci,p,c,lf) ->
-        let cj = execute env c in
-        let pj = execute env p in
-        let lfj = execute_array env lf in
-          judge_of_case env ci pj cj lfj
+        let ct = execute env c in
+        let pt = execute env p in
+        let lft = execute_array env lf in
+          type_of_case env ci p pt c ct lf lft
 
     | Fix ((vn,i as vni),recdef) ->
       let (fix_ty,recdef') = execute_recdef env recdef i in
       let fix = (vni,recdef') in
-        check_fix env fix;
-	make_judge (mkFix fix) fix_ty
+        check_fix env fix; fix_ty
 	  
     | CoFix (i,recdef) ->
       let (fix_ty,recdef') = execute_recdef env recdef i in
       let cofix = (i,recdef') in
-        check_cofix env cofix;
-	(make_judge (mkCoFix cofix) fix_ty)
+        check_cofix env cofix; fix_ty
 	  
     (* Partial proofs: unsupported by the kernel *)
     | Meta _ ->
-	anomaly (Pp.str "the kernel does not support metavariables")
+	anomaly (Pp.str "the kernel does not support metavariables.")
 
     | Evar _ ->
-	anomaly (Pp.str "the kernel does not support existential variables")
+	anomaly (Pp.str "the kernel does not support existential variables.")
 
-and execute_type env constr =
-  let j = execute env constr in
-    type_judgment env j
+and execute_is_type env constr =
+  let t = execute env constr in
+    check_type env constr t
 
 and execute_recdef env (names,lar,vdef) i =
-  let larj = execute_array env lar in
-  let lara = Array.map (assumption_of_judgment env) larj in
+  let lart = execute_array env lar in
+  let lara = Array.map2 (check_assumption env) lar lart in
   let env1 = push_rec_types (names,lara,vdef) env in
-  let vdefj = execute_array env1 vdef in
-  let vdefv = Array.map j_val vdefj in
-  let () = type_fixpoint env1 names lara vdefj in
-    (lara.(i),(names,lara,vdefv))
+  let vdeft = execute_array env1 vdef in
+  let () = check_fixpoint env1 names lara vdef vdeft in
+    (lara.(i),(names,lara,vdef))
 
 and execute_array env = Array.map (execute env)
 
 (* Derived functions *)
 let infer env constr =
-  let j = execute env constr in
-    assert (eq_constr j.uj_val constr);
-    j
+  let t = execute env constr in
+    make_judge constr t
+
+let infer = 
+  if Flags.profile then
+    let infer_key = CProfile.declare_profile "Fast_infer" in
+      CProfile.profile2 infer_key (fun b c -> infer b c)
+  else (fun b c -> infer b c)
 
-(* let infer_key = Profile.declare_profile "infer" *)
-(* let infer = Profile.profile2 infer_key infer *)
+let assumption_of_judgment env {uj_val=c; uj_type=t} =
+  check_assumption env c t
+
+let type_judgment env {uj_val=c; uj_type=t} =
+  let s = check_type env c t in
+  {utj_val = c; utj_type = s }
 
 let infer_type env constr =
-  let j = execute_type env constr in
-    j
+  let t = execute env constr in
+  let s = check_type env constr t in
+  {utj_val = constr; utj_type = s}
 
 let infer_v env cv =
   let jv = execute_array env cv in
-    jv
+    make_judgev cv jv
 
 (* Typing of several terms. *)
 
 let infer_local_decl env id = function
-  | LocalDefEntry c ->
-      let j = infer env c in
-      LocalDef (Name id, j.uj_val, j.uj_type)
-  | LocalAssumEntry c ->
-      let j = infer env c in
-      LocalAssum (Name id, assumption_of_judgment env j)
+  | Entries.LocalDefEntry c ->
+      let t = execute env c in
+      RelDecl.LocalDef (Name id, c, t)
+  | Entries.LocalAssumEntry c ->
+      let t = execute env c in
+      RelDecl.LocalAssum (Name id, check_assumption env c t)
 
 let infer_local_decls env decls =
   let rec inferec env = function
   | (id, d) :: l ->
       let (env, l) = inferec env l in
       let d = infer_local_decl env id d in
-	(push_rel d env, Context.Rel.add d l)
-  | [] -> (env, Context.Rel.empty) in
+        (push_rel d env, Context.Rel.add d l)
+  | [] -> (env, Context.Rel.empty)
+  in
   inferec env decls
+
+let judge_of_prop = make_judge mkProp type1
+let judge_of_set = make_judge mkSet type1
+let judge_of_type u = make_judge (mkType u) (type_of_type u)
+
+let judge_of_prop_contents = function
+  | Null -> judge_of_prop
+  | Pos -> judge_of_set
+
+let judge_of_relative env k = make_judge (mkRel k) (type_of_relative env k)
+
+let judge_of_variable env x = make_judge (mkVar x) (type_of_variable env x)
+
+let judge_of_constant env cst = make_judge (mkConstU cst) (type_of_constant env cst)
+
+let judge_of_projection env p cj =
+  make_judge (mkProj (p,cj.uj_val)) (type_of_projection env p cj.uj_val cj.uj_type)
+
+let dest_judgev v =
+  Array.map j_val v, Array.map j_type v
+
+let judge_of_apply env funj argjv =
+  let args, argtys = dest_judgev argjv in
+  make_judge (mkApp (funj.uj_val, args)) (type_of_apply env funj.uj_val funj.uj_type args argtys)
+
+let judge_of_abstraction env x varj bodyj =
+  make_judge (mkLambda (x, varj.utj_val, bodyj.uj_val))
+             (type_of_abstraction env x varj.utj_val bodyj.uj_type)
+
+let judge_of_product env x varj outj =
+  make_judge (mkProd (x, varj.utj_val, outj.utj_val))
+             (mkSort (sort_of_product env varj.utj_type outj.utj_type))
+
+let judge_of_letin env name defj typj j =
+  make_judge (mkLetIn (name, defj.uj_val, typj.utj_val, j.uj_val))
+             (subst1 defj.uj_val j.uj_type)
+
+let judge_of_cast env cj k tj =
+  let () = check_cast env cj.uj_val cj.uj_type k tj.utj_val in
+  let c = match k with | REVERTcast -> cj.uj_val | _ -> mkCast (cj.uj_val, k, tj.utj_val) in
+  make_judge c tj.utj_val
+
+let judge_of_inductive env indu =
+  make_judge (mkIndU indu) (type_of_inductive env indu)
+
+let judge_of_constructor env cu =
+  make_judge (mkConstructU cu) (type_of_constructor env cu)
+
+let judge_of_case env ci pj cj lfj =
+  let lf, lft = dest_judgev lfj in
+  make_judge (mkCase (ci, (*nf_betaiota*) pj.uj_val, cj.uj_val, lft))
+             (type_of_case env ci pj.uj_val pj.uj_type cj.uj_val cj.uj_type lf lft)
+
+let type_of_projection_constant env (p,u) =
+  let cst = Projection.constant p in
+  let cb = lookup_constant cst env in
+  match cb.const_proj with
+  | Some pb ->
+    if Declareops.constant_is_polymorphic cb then
+      Vars.subst_instance_constr u pb.proj_type
+    else pb.proj_type
+  | None -> raise (Invalid_argument "type_of_projection: not a projection")
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index 2112284e..85b2cfff 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -1,21 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
+open Constr
 open Univ
-open Term
 open Environ
 open Entries
-open Declarations
 
 (** {6 Typing functions (not yet tagged as safe) }
 
-    They return unsafe judgments that are "in context" of a set of 
+    They return unsafe judgments that are "in context" of a set of
     (local) universe variables (the ones that appear in the term)
     and associated constraints. In case of polymorphic definitions,
     these variables and constraints will be generalized.
@@ -38,27 +39,28 @@ 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 } *)
 
 val judge_of_constant : env -> pconstant -> unsafe_judgment
 
-val judge_of_constant_knowing_parameters :
-  env -> pconstant -> types Lazy.t array -> unsafe_judgment
-
 (** {6 type of an applied projection } *)
 
-val judge_of_projection : env -> Names.projection -> unsafe_judgment -> unsafe_judgment
+val judge_of_projection : env -> Projection.t -> unsafe_judgment -> unsafe_judgment
 
 (** {6 Type of application. } *)
 val judge_of_apply :
@@ -70,9 +72,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
@@ -91,9 +93,6 @@ val judge_of_cast :
 
 val judge_of_inductive : env -> inductive puniverses -> unsafe_judgment
 
-(* val judge_of_inductive_knowing_parameters : *)
-(*   env -> inductive -> unsafe_judgment array -> unsafe_judgment *)
-
 val judge_of_constructor : env -> constructor puniverses -> unsafe_judgment
 
 (** {6 Type of Cases. } *)
@@ -101,30 +100,9 @@ val judge_of_case : env -> case_info
   -> unsafe_judgment -> unsafe_judgment -> unsafe_judgment array
     -> unsafe_judgment
 
-(** Typecheck general fixpoint (not checking guard conditions) *)
-val type_fixpoint : env -> Name.t array -> types array
-    -> unsafe_judgment array -> unit
-
-val type_of_constant : env -> pconstant -> types constrained
-
-val type_of_constant_type : env -> constant_type -> types
-
-val type_of_projection : env -> Names.projection puniverses -> types
+val type_of_projection_constant : env -> Projection.t puniverses -> types
 
 val type_of_constant_in : env -> pconstant -> types
 
-val type_of_constant_type_knowing_parameters :
-  env -> constant_type -> types Lazy.t array -> types
-
-val type_of_constant_knowing_parameters :
-  env -> pconstant -> types Lazy.t array -> types constrained
-
-val type_of_constant_knowing_parameters_in :
-  env -> pconstant -> types Lazy.t array -> types
-
-(** Make a type polymorphic if an arity *)
-val make_polymorphic_if_constant_for_ind : env -> unsafe_judgment ->
-  constant_type
-
 (** Check that hyps are included in env and fails with error otherwise *)
-val check_hyps_inclusion : env -> constr -> Context.section_context -> unit
+val check_hyps_inclusion : env -> ('a -> constr) -> 'a -> Context.Named.t -> unit
diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index 4884d0de..5d5c4831 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -132,7 +134,7 @@ let rec repr g u =
   let a =
     try UMap.find u g.entries
     with Not_found -> CErrors.anomaly ~label:"Univ.repr"
-        (str"Universe " ++ Level.pr u ++ str" undefined")
+        (str"Universe " ++ Level.pr u ++ str" undefined.")
   in
   match a with
     | Equiv v -> repr g v
@@ -354,13 +356,15 @@ let get_new_edges g to_merge =
       UMap.empty to_merge
   in
   let ltle =
-    UMap.fold (fun _ n acc ->
-      UMap.merge (fun _ strict1 strict2 ->
-        match strict1, strict2 with
-        | Some true, _ | _, Some true -> Some true
-        | _, _ -> Some false)
-        acc n.ltle)
-      to_merge_lvl UMap.empty
+    let fold _ n acc =
+      let fold u strict acc =
+        if strict then UMap.add u strict acc
+        else if UMap.mem u acc then acc
+        else UMap.add u false acc
+      in
+      UMap.fold fold n.ltle acc
+    in
+    UMap.fold fold to_merge_lvl UMap.empty
   in
   let ltle, _ = clean_ltle g ltle in
   let ltle =
@@ -738,6 +742,45 @@ let check_constraint g (l,d,r) =
 let check_constraints c g =
   Constraint.for_all (check_constraint g) c
 
+let leq_expr (u,m) (v,n) =
+  let d = match m - n with
+    | 1 -> Lt
+    | diff -> assert (diff <= 0); Le
+  in
+  (u,d,v)
+
+let enforce_leq_alg u v g =
+  let enforce_one (u,v) = function
+    | Inr _ as orig -> orig
+    | Inl (cstrs,g) as orig ->
+      if check_smaller_expr g u v then orig
+      else
+        (let c = leq_expr u v in
+         match enforce_constraint c g with
+         | g -> Inl (Constraint.add c cstrs,g)
+         | exception (UniverseInconsistency _ as e) -> Inr e)
+  in
+  (* max(us) <= max(vs) <-> forall u in us, exists v in vs, u <= v *)
+  let c = Universe.map (fun u -> Universe.map (fun v -> (u,v)) v) u in
+  let c = List.cartesians enforce_one (Inl (Constraint.empty,g)) c in
+  (* We pick a best constraint: smallest number of constraints, not an error if possible. *)
+  let order x y = match x, y with
+    | Inr _, Inr _ -> 0
+    | Inl _, Inr _ -> -1
+    | Inr _, Inl _ -> 1
+    | Inl (c,_), Inl (c',_) ->
+      Int.compare (Constraint.cardinal c) (Constraint.cardinal c')
+  in
+  match List.min order c with
+  | Inl x -> x
+  | Inr e -> raise e
+
+(* sanity check wrapper *)
+let enforce_leq_alg u v g =
+  let _,g as cg = enforce_leq_alg u v g in
+  assert (check_leq g u v);
+  cg
+
 (* Normalization *)
 
 (** [normalize_universes g] returns a graph where all edges point
@@ -828,6 +871,18 @@ let sort_universes g =
   in
   normalize_universes g
 
+(** Subtyping of polymorphic contexts *)
+
+let check_subtype univs ctxT ctx =
+  if AUContext.size ctxT == AUContext.size ctx then
+    let (inst, cst) = UContext.dest (AUContext.repr ctx) in
+    let cstT = UContext.constraints (AUContext.repr ctxT) in
+    let push accu v = add_universe v false accu in
+    let univs = Array.fold_left push univs (Instance.to_array inst) in
+    let univs = merge_constraints cstT univs in
+    check_constraints cst univs
+  else false
+
 (** Instances *)
 
 let check_eq_instances g t1 t2 =
@@ -876,23 +931,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 e95cf4d1..0f078255 100644
--- a/kernel/uGraph.mli
+++ b/kernel/uGraph.mli
@@ -1,39 +1,34 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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
+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
 
-val is_initial_universes : universes -> bool
-
-val sort_universes : universes -> universes
-
-(** Adds a universe to the graph, ensuring it is >= or > Set.
-   @raises AlreadyDeclared if the level is already declared in the graph. *)
+(** Check if we are in the initial case *)
+val is_initial_universes : t -> bool
 
-exception AlreadyDeclared
-
-val add_universe : universe_level -> bool -> universes -> universes
+(** 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.
@@ -41,23 +36,42 @@ val add_universe : universe_level -> bool -> universes -> universes
   universes graph. It raises the exception [UniverseInconsistency] if the
   constraints are not satisfiable. *)
 
-val enforce_constraint : univ_constraint -> universes -> universes
-val merge_constraints : constraints -> universes -> universes
+val enforce_constraint : univ_constraint -> t -> t
+val merge_constraints : Constraint.t -> t -> t
 
-val constraints_of_universes : universes -> constraints
+val check_constraint  : t -> univ_constraint -> bool
+val check_constraints : Constraint.t -> t -> bool
 
-val check_constraint  : universes -> univ_constraint -> bool
-val check_constraints : constraints -> universes -> bool
+(** Picks an arbitrary set of constraints sufficient to ensure [u <= v]. *)
+val enforce_leq_alg : Universe.t -> Universe.t -> t -> Constraint.t * t
 
-val check_eq_instances : Instance.t check_function
-(** Check equality of instances w.r.t. a universe graph *)
+(** Adds a universe to the graph, ensuring it is >= or > Set.
+   @raise AlreadyDeclared if the level is already declared in the graph. *)
+
+exception AlreadyDeclared
+
+val add_universe : Level.t -> bool -> t -> t
 
 (** {6 Pretty-printing of universes. } *)
 
-val pr_universes : (Level.t -> Pp.std_ppcmds) -> universes -> Pp.std_ppcmds
+val pr_universes : (Level.t -> Pp.t) -> t -> Pp.t
+
+(** The empty graph of universes *)
+val empty_universes : t
+[@@ocaml.deprecated "Use UGraph.initial_universes"]
+
+val sort_universes : t -> t
+
+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 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 : t -> unit
diff --git a/kernel/univ.ml b/kernel/univ.ml
index 09f884ec..3158db52 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created in Caml by Gérard Huet for CoC 4.8 [Dec 1988] *)
@@ -31,133 +33,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 +123,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 +194,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 +268,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 +286,12 @@ struct
 
     end
 
-    module HExpr = 
-    struct 
-
-      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
+    module H = Hashcons.Make(ExprHash)
 
-    let hcons = HExpr.hcons
+    let hcons =
+      Hashcons.simple_hcons H.generate H.hcons Level.hcons
 
-    let make l = hcons (l, 0)
+    let make l = (l, 0)
 
     let compare u v =
       if u == v then 0
@@ -436,14 +300,10 @@ 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_prop = function
-      | (l,0) -> Level.is_prop l
-      | _ -> false
-	
     let is_small = function
       | (l,0) -> Level.is_small l
       | _ -> false
@@ -452,6 +312,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'
@@ -461,13 +323,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
@@ -481,19 +343,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
@@ -519,71 +378,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 rec hcons = function
-  | Nil -> Huniv.nil
-  | Cons (x, _, l) -> Huniv.cons x (hcons l)
+  let equal x y = x == y || List.equal Expr.equal x y
 
-  let make l = Huniv.tip (Expr.make l)
-  let tip x = Huniv.tip x
+  let compare x y = if x == y then 0 else List.compare Expr.compare x y
+
+  module Huniv = Hashcons.Hlist(Expr)
+
+  let hcons = Hashcons.recursive_hcons Huniv.generate Huniv.hcons Expr.hcons
+
+  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)
@@ -605,16 +456,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
@@ -627,7 +478,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'
@@ -635,22 +486,23 @@ 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 []
+
   (* 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
@@ -729,8 +581,11 @@ struct
       pp_std ++ prl u1 ++ pr_constraint_type op ++
 	prl u2 ++ fnl () )  c (str "")
 
+  let universes_of c =
+    fold (fun (u1, op, u2) unvs -> LSet.add u2 (LSet.add u1 unvs)) c LSet.empty
 end
 
+let universes_of_constraints = Constraint.universes_of
 let empty_constraint = Constraint.empty
 let union_constraint = Constraint.union
 let eq_constraint = Constraint.equal
@@ -785,7 +640,7 @@ let enforce_eq_level u v c =
 let enforce_eq u v c =
   match Universe.level u, Universe.level v with
     | Some u, Some v -> enforce_eq_level u v c
-    | _ -> anomaly (Pp.str "A universe comparison can only happen between variables")
+    | _ -> anomaly (Pp.str "A universe comparison can only happen between variables.")
 
 let check_univ_eq u v = Universe.equal u v
 
@@ -805,13 +660,13 @@ let constraint_add_leq v u c =
       else if j <= -1 (* n = m+k, v+k <= u <-> v+(k-1) < u *) then
 	if Level.equal x y then (* u+(k+1) <= u *)
 	  raise (UniverseInconsistency (Le, Universe.tip v, Universe.tip u, None))
-	else anomaly (Pp.str"Unable to handle arbitrary u+k <= v constraints")
+	else anomaly (Pp.str"Unable to handle arbitrary u+k <= v constraints.")
       else if j = 0 then
 	Constraint.add (x,Le,y) c
       else (* j >= 1 *) (* m = n + k, u <= v+k *)
 	if Level.equal x y then c (* u <= u+k, trivial *)
 	else if Level.is_small x then c (* Prop,Set <= u+S k, trivial *)
-	else anomaly (Pp.str"Unable to handle arbitrary u <= v+k constraints")
+        else Constraint.add (x,Le,y) c (* u <= v implies u <= v+k *)
 	  
 let check_univ_leq_one u v = Universe.exists (Expr.leq u) v
 
@@ -819,13 +674,7 @@ 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
-  in aux c v
+  List.fold_left (fun c v -> (List.fold_left (fun c u -> constraint_add_leq u v c) c u)) c v
 
 let enforce_leq u v c =
   if check_univ_leq u v then c
@@ -834,21 +683,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) ? *)
 
@@ -865,15 +709,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
@@ -893,7 +777,7 @@ module Instance : sig
 
     val subst_fn : universe_level_subst_fn -> t -> t
     
-    val pr : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds
+    val pr : (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
     val levels : t -> LSet.t
 end = 
 struct
@@ -903,8 +787,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 = 
@@ -970,8 +853,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 ||
@@ -986,9 +873,37 @@ let enforce_eq_instances x y =
   let ax = Instance.to_array x and ay = Instance.to_array y in
     if Array.length ax != Array.length ay then
       anomaly (Pp.(++) (Pp.str "Invalid argument: enforce_eq_instances called with")
-		 (Pp.str " instances of different lengths"));
+		 (Pp.str " instances of different lengths."));
     CArray.fold_right2 enforce_eq_level ax ay
 
+let enforce_eq_variance_instances = Variance.eq_constraints
+let enforce_leq_variance_instances = Variance.leq_constraints
+
+let subst_instance_level s l =
+  match l.Level.data with
+  | Level.Var n -> s.(n) 
+  | _ -> l
+
+let subst_instance_instance s i = 
+  Array.smartmap (fun l -> subst_instance_level s l) i
+
+let subst_instance_universe s u =
+  let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in
+  let u' = Universe.smartmap f u in
+    if u == u' then u
+    else Universe.sort u'
+
+let subst_instance_constraint s (u,d,v as c) =
+  let u' = subst_instance_level s u in
+  let v' = subst_instance_level s v in
+    if u' == u && v' == v then c
+    else (u',d,v')
+
+let subst_instance_constraints s csts =
+  Constraint.fold 
+    (fun c csts -> Constraint.add (subst_instance_constraint s c) csts)
+    csts Constraint.empty 
+
 type universe_instance = Instance.t
 
 type 'a puniverses = 'a * Instance.t
@@ -1010,9 +925,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)
@@ -1032,6 +947,69 @@ end
 type universe_context = UContext.t
 let hcons_universe_context = UContext.hcons
 
+module AUContext =
+struct
+  include UContext
+
+  let repr (inst, cst) =
+    (Array.mapi (fun i l -> Level.var i) inst, cst)
+
+  let instantiate inst (u, cst) =
+    assert (Array.length u = Array.length inst);
+    subst_instance_constraints inst cst
+
+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 an array of
+   Variance.t.
+
+    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 * Variance.t array
+
+  let make 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, [||])
+  let is_empty (univs, variance) = UContext.is_empty univs && Array.is_empty variance
+
+  let pr prl (univs, variance) =
+    UContext.pr prl ~variance univs
+
+  let hcons (univs, variance) = (* should variance be hconsed? *)
+    (UContext.hcons univs, variance)
+
+  let univ_context (univs, subtypcst) = univs
+  let variance (univs, variance) = variance
+
+  (** This function takes a universe context representing constraints
+     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
+
+type cumulativity_info = CumulativityInfo.t
+let hcons_cumulativity_info = CumulativityInfo.hcons
+
+module ACumulativityInfo = CumulativityInfo
+
+type abstract_cumulativity_info = ACumulativityInfo.t
+let hcons_abstract_cumulativity_info = ACumulativityInfo.hcons
+
 (** A set of universes with universe constraints.
     We linearize the set to a list after typechecking. 
     Beware, representation could change.
@@ -1091,6 +1069,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
@@ -1136,6 +1115,9 @@ let subst_univs_level_constraints subst csts =
     (fun c -> Option.fold_right Constraint.add (subst_univs_level_constraint subst c))
     csts Constraint.empty 
 
+let subst_univs_level_abstract_universe_context subst (inst, csts) =
+  inst, subst_univs_level_constraints subst csts
+
 (** With level to universe substitutions. *)
 type universe_subst_fn = universe_level -> universe
 
@@ -1146,7 +1128,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))
@@ -1157,59 +1139,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 subst_instance_level s l =
-  match l.Level.data with
-  | Level.Var n -> s.(n) 
-  | _ -> l
-
-let subst_instance_instance s i = 
-  Array.smartmap (fun l -> subst_instance_level s l) i
-
-let subst_instance_universe s u =
-  let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in
-  let u' = Universe.smartmap f u in
-    if u == u' then u
-    else Universe.sort u'
-
-let subst_instance_constraint s (u,d,v as c) =
-  let u' = subst_instance_level s u in
-  let v' = subst_instance_level s v in
-    if u' == u && v' == v then c
-    else (u',d,v')
-
-let subst_instance_constraints s csts =
-  Constraint.fold 
-    (fun c csts -> Constraint.add (subst_instance_constraint s c) csts)
-    csts Constraint.empty 
-
-(** Substitute instance inst for ctx in csts *)
-let instantiate_univ_context (ctx, csts) = 
-  (ctx, subst_instance_constraints ctx csts)
-
-let instantiate_univ_constraints u (_, csts) = 
-  subst_instance_constraints u csts
-
 let make_instance_subst i = 
   let arr = Instance.to_array i in
     Array.fold_left_i (fun i acc l ->
@@ -1222,16 +1154,35 @@ let make_inverse_instance_subst i =
       LMap.add (Level.var i) l acc)
       LMap.empty arr
 
-let abstract_universes poly ctx =
+let make_abstract_instance (ctx, _) = 
+  Array.mapi (fun i l -> Level.var i) ctx
+
+let abstract_universes ctx =
   let instance = UContext.instance ctx in
-    if poly then
-      let subst = make_instance_subst instance in
-      let cstrs = subst_univs_level_constraints subst 
-	(UContext.constraints ctx)
-      in
-      let ctx = UContext.make (instance, cstrs) in
-	subst, ctx
-    else empty_level_subst, ctx
+  let subst = make_instance_subst instance in
+  let cstrs = subst_univs_level_constraints subst 
+      (UContext.constraints ctx)
+  in
+  let ctx = UContext.make (instance, cstrs) in
+  instance, ctx
+
+let abstract_cumulativity_info (univs, variance) =
+  let subst, univs = abstract_universes univs in
+  subst, (univs, variance)
+
+let rec compact_univ s vars i u =
+  match u with
+  | [] -> (s, List.rev vars)
+  | (lvl, _) :: u ->
+    match Level.var_index lvl with
+    | Some k when not (LMap.mem lvl s) ->
+      let lvl' = Level.var i in
+      compact_univ (LMap.add lvl lvl' s) (k :: vars) (i+1) u
+    | _ -> compact_univ s vars i u
+
+let compact_univ u =
+  let (s, s') = compact_univ LMap.empty [] 0 u in
+  (subst_univs_level_universe s u, s')
 
 (** Pretty-printing *)
 
@@ -1239,6 +1190,12 @@ let pr_constraints prl = Constraint.pr prl
 
 let pr_universe_context = UContext.pr
 
+let pr_cumulativity_info = CumulativityInfo.pr
+
+let pr_abstract_universe_context = AUContext.pr
+
+let pr_abstract_cumulativity_info = ACumulativityInfo.pr
+
 let pr_universe_context_set = ContextSet.pr
 
 let pr_universe_subst = 
@@ -1287,10 +1244,3 @@ let explain_universe_inconsistency prl (o,u,v,p) =
 let compare_levels = Level.compare
 let eq_levels = Level.equal
 let equal_universes = Universe.equal
-
-
-let subst_instance_constraints = 
-  if Flags.profile then 
-    let key = Profile.declare_profile "subst_instance_constraints" in
-      Profile.profile2 key subst_instance_constraints
-  else subst_instance_constraints
diff --git a/kernel/univ.mli b/kernel/univ.mli
index 1ccdebd5..aaed899b 100644
--- a/kernel/univ.mli
+++ b/kernel/univ.mli
@@ -1,13 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Universes. *)
-
 module Level :
 sig
   type t
@@ -20,11 +21,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 *)
 
@@ -37,7 +38,7 @@ sig
   (** Create a new universe level from a unique identifier and an associated
       module path. *)
 
-  val pr : t -> Pp.std_ppcmds
+  val pr : t -> Pp.t
   (** Pretty-printing *)
 
   val to_string : t -> string
@@ -46,21 +47,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
-	      
-  val pr : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds
+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
@@ -86,10 +90,10 @@ sig
   val make : Level.t -> t
   (** Create a universe representing the given level. *)
 
-  val pr : t -> Pp.std_ppcmds
+  val pr : t -> Pp.t
   (** Pretty-printing *)
 
-  val pr_with : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds
+  val pr_with : (Level.t -> Pp.t) -> t -> Pp.t
 
   val is_level : t -> bool
   (** Test if the universe is a level or an algebraic universe. *)
@@ -106,83 +110,87 @@ 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
+
 end
 
 type universe = Universe.t
+[@@ocaml.deprecated "Use Universe.t"]
 
 (** Alias name. *)
 
-val pr_uni : universe -> Pp.std_ppcmds
-	      
-(** 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
-
-(** Enforcing constraints. *)
+val constraints_of : 'a constrained -> Constraint.t
 
-type 'a constraint_function = 'a -> 'a -> constraints -> constraints
+(** Enforcing Constraint.t. *)
+type 'a constraint_function = 'a -> 'a -> Constraint.t -> Constraint.t
 
-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 +202,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. *)
@@ -218,7 +226,7 @@ sig
   (** [subst_union x y] favors the bindings of the first map that are [Some],
       otherwise takes y's bindings. *)
 
-  val pr : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds
+  val pr : ('a -> Pp.t) -> 'a t -> Pp.t
   (** Pretty-printing *)
 end
 
@@ -226,18 +234,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 level_subst_of : universe_subst_fn -> universe_level_subst_fn
+  val pr : t -> Pp.t
+
+end
 
 (** {6 Universe instances} *)
 
-module Instance : 
+module Instance :
 sig
   type t
   (** A universe instance represents a vector of argument universes
@@ -270,7 +293,7 @@ sig
   val subst_fn : universe_level_subst_fn -> t -> t
   (** Substitution by a level-to-level function. *)
 
-  val pr : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds
+  val pr : (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
   (** Pretty-printing, no comments *)
 
   val levels : t -> LSet.t
@@ -279,54 +302,130 @@ sig
 end
 
 type universe_instance = Instance.t
+[@@ocaml.deprecated "Use Instance.t"]
+
+val enforce_eq_instances : Instance.t constraint_function
 
-val enforce_eq_instances : universe_instance constraint_function
+val enforce_eq_variance_instances : Variance.t array -> Instance.t constraint_function
+val enforce_leq_variance_instances : Variance.t array -> 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
+  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 Constraint.t. *)
+
+  val empty : t
+  val is_empty : t -> bool
+
+  (** Don't use. *)
+  val instance : t -> Instance.t
+
+  val size : t -> int
+
+  (** Keeps the order of the instances *)
+  val union : t -> t -> t
+
+  val instantiate : Instance.t -> t -> Constraint.t
+  (** Generate the set of instantiated Constraint.t **)
+
+end
+
+type abstract_universe_context = AUContext.t
+[@@ocaml.deprecated "Use AUContext.t"]
+
+(** 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 variance
+   array has the same length as the universe instance. *)
+module CumulativityInfo :
+sig
+  type t
+
+  val make : UContext.t * Variance.t array -> t
+
+  val empty : t
+  val is_empty : t -> bool
+
+  val univ_context : t -> UContext.t
+  val variance : t -> Variance.t array
+
+  (** This function takes a universe context representing constraints
+     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 -> 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
@@ -336,36 +435,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_instance : universe_level_subst -> universe_instance -> universe_instance
+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 -> AUContext.t -> AUContext.t
+val subst_univs_level_instance : universe_level_subst -> Instance.t -> Instance.t
 
 (** Level to universe substitutions. *)
 
@@ -373,49 +479,73 @@ 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_constraints : universe_instance -> constraints -> constraints
+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 : bool -> universe_context -> universe_level_subst * universe_context
+val make_inverse_instance_subst : Instance.t -> universe_level_subst
 
-(** Get the instantiated graph. *)
-val instantiate_univ_context : universe_context -> universe_context
+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 instantiate_univ_constraints : universe_instance -> universe_context -> constraints
+val make_abstract_instance : AUContext.t -> Instance.t
 
-(** {6 Pretty-printing of universes. } *)
+(** [compact_univ u] remaps local variables in [u] such that their indices become
+     consecutive. It returns the new universe and the mapping.
+     Example: compact_univ [(Var 0, i); (Prop, 0); (Var 2; j))] =
+       [(Var 0,i); (Prop, 0); (Var 1; j)], [0; 2]
+*)
+val compact_univ : Universe.t -> Universe.t * int list
 
-val pr_constraint_type : constraint_type -> Pp.std_ppcmds
-val pr_constraints : (Level.t -> Pp.std_ppcmds) -> constraints -> Pp.std_ppcmds
-val pr_universe_context : (Level.t -> Pp.std_ppcmds) -> universe_context -> Pp.std_ppcmds
-val pr_universe_context_set : (Level.t -> Pp.std_ppcmds) -> universe_context_set -> Pp.std_ppcmds
-val explain_universe_inconsistency : (Level.t -> Pp.std_ppcmds) -> 
-  univ_inconsistency -> Pp.std_ppcmds
+(** {6 Pretty-printing of universes. } *)
 
-val pr_universe_level_subst : universe_level_subst -> Pp.std_ppcmds
-val pr_universe_subst : universe_subst -> Pp.std_ppcmds
+val pr_constraint_type : constraint_type -> 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
+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_universe_context_set : universe_context_set -> universe_context_set 
+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 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 2ca749d5..0f588a63 100644
--- a/kernel/vars.ml
+++ b/kernel/vars.ml
@@ -1,14 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Esubst
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 
 (*********************)
 (*     Occurring     *)
@@ -26,7 +29,7 @@ let closedn n c =
   in
   try closed_rec n c; true with LocalOccur -> false
 
-(* [closed0 M] is true iff [M] is a (deBruijn) closed term *)
+(* [closed0 M] is true iff [M] is a (de Bruijn) closed term *)
 
 let closed0 c = closedn 0 c
 
@@ -132,8 +135,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
@@ -160,25 +163,35 @@ let substnl laml n c = substn_many (make_subst laml) n c
 let substl laml c = substn_many (make_subst laml) 0 c
 let subst1 lam c = substn_many [|make_substituend lam|] 0 c
 
-let substnl_decl laml k r = map_constr (fun c -> substnl laml k c) r
-let substl_decl laml r = map_constr (fun c -> substnl laml 0 c) r
-let subst1_decl lam r = map_constr (fun c -> subst1 lam c) r
+let substnl_decl laml k r = RelDecl.map_constr (fun c -> substnl laml k c) r
+let substl_decl laml r = RelDecl.map_constr (fun c -> substnl laml 0 c) r
+let subst1_decl lam r = RelDecl.map_constr (fun c -> subst1 lam c) r
 
 (* Build a substitution from an instance, inserting missing let-ins *)
 
 let subst_of_rel_context_instance sign l =
   let rec aux subst sign l =
+    let open RelDecl in
     match sign, l with
     | LocalAssum _ :: sign', a::args' -> aux (a::subst) sign' args'
     | LocalDef (_,c,_)::sign', args' ->
 	aux (substl subst c :: subst) sign' args'
     | [], [] -> subst
-    | _ -> CErrors.anomaly (Pp.str "Instance and signature do not match")
+    | _ -> CErrors.anomaly (Pp.str "Instance and signature do not match.")
   in aux [] (List.rev sign) l
 
 let adjust_subst_to_rel_context sign l =
   List.rev (subst_of_rel_context_instance sign l)
 
+let adjust_rel_to_rel_context sign n =
+  let rec aux sign =
+    let open RelDecl in
+    match sign with
+    | LocalAssum _ :: sign' -> let (n',p) = aux sign' in (n'+1,p)
+    | LocalDef (_,c,_)::sign' -> let (n',p) = aux sign' in (n'+1,if n'<n then p+1 else p)
+    | [] -> (0,n)
+  in snd (aux sign)
+
 (* (thin_val sigma) removes identity substitutions from sigma *)
 
 let rec thin_val = function
@@ -224,49 +237,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 
@@ -308,42 +278,37 @@ let subst_instance_constr subst c =
   if Univ.Instance.is_empty subst then c
   else
     let f u = Univ.subst_instance_instance subst u in
-    let changed = ref false in
-    let rec aux t = 
+    let rec aux t =
       match kind t with
-      | Const (c, u) -> 
-	if Univ.Instance.is_empty u then t
-	else 
-          let u' = f u in 
-	    if u' == u then t
-	    else (changed := true; mkConstU (c, u'))
+      | Const (c, u) ->
+       if Univ.Instance.is_empty u then t
+       else
+          let u' = f u in
+           if u' == u then t
+           else (mkConstU (c, u'))
       | Ind (i, u) ->
-	if Univ.Instance.is_empty u then t
-	else 
-	  let u' = f u in 
-	    if u' == u then t
-	    else (changed := true; mkIndU (i, u'))
+       if Univ.Instance.is_empty u then t
+       else
+         let u' = f u in
+           if u' == u then t
+           else (mkIndU (i, u'))
       | Construct (c, u) ->
-	if Univ.Instance.is_empty u then t
-	else 
-          let u' = f u in 
-	    if u' == u then t
-	    else (changed := true; mkConstructU (c, u'))
-      | Sort (Sorts.Type u) -> 
+       if Univ.Instance.is_empty u then t
+       else
+          let u' = f u in
+           if u' == u then t
+           else (mkConstructU (c, u'))
+      | Sort (Sorts.Type u) ->
          let u' = Univ.subst_instance_universe subst u in
-	   if u' == u then t else 
-	     (changed := true; mkSort (Sorts.sort_of_univ u'))
+          if u' == u then t else
+            (mkSort (Sorts.sort_of_univ u'))
       | _ -> Constr.map aux t
     in
-    let c' = aux c in
-      if !changed then c' else c
+    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
-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 574d50ec..a0c7ba4b 100644
--- a/kernel/vars.mli
+++ b/kernel/vars.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -11,10 +13,10 @@ open Constr
 
 (** {6 Occur checks } *)
 
-(** [closedn n M] is true iff [M] is a (deBruijn) closed term under n binders *)
+(** [closedn n M] is true iff [M] is a (de Bruijn) closed term under n binders *)
 val closedn : int -> constr -> bool
 
-(** [closed0 M] is true iff [M] is a (deBruijn) closed term *)
+(** [closed0 M] is true iff [M] is a (de Bruijn) closed term *)
 val closed0 : constr -> bool
 
 (** [noccurn n M] returns true iff [Rel n] does NOT occur in term [M]  *)
@@ -73,6 +75,10 @@ val subst_of_rel_context_instance : Context.Rel.t -> constr list -> substl
 (** For compatibility: returns the substitution reversed *)
 val adjust_subst_to_rel_context : Context.Rel.t -> constr list -> constr list
 
+(** Take an index in an instance of a context and returns its index wrt to
+    the full context (e.g. 2 in [x:A;y:=b;z:C] is 3, i.e. a reference to z) *)
+val adjust_rel_to_rel_context : ('a, 'b) Context.Rel.pt -> int -> int
+
 (** [substnl [a�;...;an] k c] substitutes in parallel [a�],...,[an]
     for respectively [Rel(k+1)],...,[Rel(k+n)] in [c]; it relocates
     accordingly indexes in [an],...,[a1] and [c]. In terms of typing, if
@@ -125,20 +131,11 @@ 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
-
-type id_key = constant tableKey
-val eq_id_key : id_key -> id_key -> bool
+val subst_instance_constr : Instance.t -> constr -> constr
+val subst_instance_context : Instance.t -> Context.Rel.t -> Context.Rel.t
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index 74d956be..437de99e 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 =
@@ -43,7 +44,6 @@ let rec conv_val env pb k v1 v2 cu =
 and conv_whd env pb k whd1 whd2 cu =
 (*  Pp.(msg_debug (str "conv_whd(" ++ pr_whd whd1 ++ str ", " ++ pr_whd whd2 ++ str ")")) ; *)
   match whd1, whd2 with
-  | Vsort s1, Vsort s2 -> sort_cmp_universes env pb s1 s2 cu
   | Vuniv_level _ , _
   | _ , Vuniv_level _ ->
     (** Both of these are invalid since universes are handled via
@@ -80,7 +80,7 @@ and conv_whd env pb k whd1 whd2 cu =
      (* on the fly eta expansion *)
       conv_val env CONV (k+1) (apply_whd k whd1) (apply_whd k whd2) cu
 
-  | Vsort _, _ | Vprod _, _ | Vfix _, _ | Vcofix _, _  | Vconstr_const _, _
+  | Vprod _, _ | Vfix _, _ | Vcofix _, _  | Vconstr_const _, _
   | Vconstr_block _, _ | Vatom_stk _, _ -> raise NotConvertible
 
 
@@ -88,34 +88,39 @@ and conv_atom env pb k a1 stk1 a2 stk2 cu =
 (*  Pp.(msg_debug (str "conv_atom(" ++ pr_atom a1 ++ str ", " ++ pr_atom a2 ++ str ")")) ; *)
   match a1, a2 with
   | Aind ((mi,i) as ind1) , Aind ind2 ->
-      if eq_ind ind1 ind2 && compare_stack stk1 stk2
-      then
-        if Environ.polymorphic_ind ind1 env
-        then
-          let mib = Environ.lookup_mind mi env in
-	  let ulen = Univ.UContext.size mib.Declarations.mind_universes in
-          match stk1 , stk2 with
-	  | [], [] -> assert (Int.equal ulen 0); cu
-	  | Zapp args1 :: stk1' , Zapp args2 :: stk2' ->
-	     assert (ulen <= nargs args1);
-             assert (ulen <= nargs args2);
-	     let u1 = Array.init ulen (fun i -> uni_lvl_val (arg args1 i)) in
-	     let u2 = Array.init ulen (fun i -> uni_lvl_val (arg args2 i)) in
-	     let u1 = Univ.Instance.of_array u1 in
-	     let u2 = Univ.Instance.of_array u2 in
-	     let cu = convert_instances ~flex:false u1 u2 cu in
-             conv_arguments env ~from:ulen k args1 args2
-			    (conv_stack env k stk1' stk2' cu)
-	  | _, _ -> assert false (* Should not happen if problem is well typed *)
-        else
-	  conv_stack env k stk1 stk2 cu
-      else raise NotConvertible
+    if eq_ind ind1 ind2 && compare_stack stk1 stk2 then
+      if Environ.polymorphic_ind ind1 env then
+        let mib = Environ.lookup_mind mi env in
+	let ulen = 
+          match mib.Declarations.mind_universes with
+          | 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)
+        in
+        match stk1 , stk2 with
+	| [], [] -> assert (Int.equal ulen 0); cu
+        | Zapp args1 :: stk1' , Zapp args2 :: stk2' ->
+          assert (ulen <= nargs args1);
+          assert (ulen <= nargs args2);
+          let u1 = Array.init ulen (fun i -> uni_lvl_val (arg args1 i)) in
+          let u2 = Array.init ulen (fun i -> uni_lvl_val (arg args2 i)) in
+          let u1 = Univ.Instance.of_array u1 in
+          let u2 = Univ.Instance.of_array u2 in
+          let cu = convert_instances ~flex:false u1 u2 cu in
+          conv_arguments env ~from:ulen k args1 args2
+	    (conv_stack env k stk1' stk2' cu)
+        | _, _ -> assert false (* Should not happen if problem is well typed *)
+      else
+	conv_stack env k stk1 stk2 cu
+    else raise NotConvertible
   | Aid ik1, Aid ik2 ->
-      if Vars.eq_id_key ik1 ik2 && compare_stack stk1 stk2 then
+    if Vmvalues.eq_id_key ik1 ik2 && compare_stack stk1 stk2 then
 	conv_stack env k stk1 stk2 cu
       else raise NotConvertible
-  | Atype _ , _ | _, Atype _ -> assert false
-  | Aind _, _ | Aid _, _ -> raise NotConvertible
+  | Asort s1, Asort s2 ->
+    sort_cmp_universes env pb s1 s2 cu
+  | Asort _ , _ | Aind _, _ | Aid _, _ -> raise NotConvertible
 
 and conv_stack env k stk1 stk2 cu =
   match stk1, stk2 with
@@ -200,4 +205,6 @@ 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
+let _ = if Coq_config.bytecode_compiler then
+  Nativeconv.set_vm_conv_gen { Nativeconv.vm_conv_gen = vm_conv_gen }
diff --git a/kernel/vconv.mli b/kernel/vconv.mli
index ff01735c..620f6b5e 100644
--- a/kernel/vconv.mli
+++ b/kernel/vconv.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Constr
 open Environ
 open Reduction
 
@@ -19,4 +21,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 53483a22..14aeb732 100644
--- a/kernel/vm.ml
+++ b/kernel/vm.ml
@@ -1,51 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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,107 +30,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 +45,71 @@ 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)
-
-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)
-
-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"
-
 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
@@ -632,51 +168,22 @@ let rec apply_stack a stk v =
 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
+  | Vprod _ | Vconstr_const _ | Vconstr_block _ -> assert false
+  | 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 6e9579aa..50ebc906 100644
--- a/kernel/vm.mli
+++ b/kernel/vm.mli
@@ -1,115 +1,35 @@
-open Names
-open Term
-open Cbytecodes
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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.std_ppcmds
-val pr_whd : whd -> Pp.std_ppcmds
-val pr_stack : stack -> Pp.std_ppcmds
-
-(** 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 00000000..0e0cb4e5
--- /dev/null
+++ b/kernel/vmvalues.ml
@@ -0,0 +1,542 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+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 id_key =
+| ConstKey of Constant.t
+| VarKey of Id.t
+| RelKey of Int.t
+| EvarKey of Evar.t
+
+let eq_id_key k1 k2 = match k1, k2 with
+| ConstKey c1, ConstKey c2 -> Constant.equal c1 c2
+| VarKey id1, VarKey id2 -> Id.equal id1 id2
+| RelKey n1, RelKey n2 -> Int.equal n1 n2
+| EvarKey evk1, EvarKey evk2 -> Evar.equal evk1 evk2
+| _ -> false
+
+type atom =
+  | Aid of id_key
+  | Aind of inductive
+  | Asort of Sorts.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 =
+  | 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
+        | 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
+     | [] -> Vatom_stk(Obj.magic at, stk)
+     | [Zapp args] ->
+        let args = Array.init (nargs args) (arg args) in
+        let s = Obj.obj (Obj.field at 0) in
+        begin match s with
+        | Type u ->
+          let inst = Instance.of_array (Array.map uni_lvl_val args) in
+          let u = Univ.subst_instance_universe inst u in
+          Vatom_stk (Asort (Type u), [])
+        | _ -> assert false
+        end
+     | _ -> 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 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_sort s -> obj_of_atom (Asort 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)
+
+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 = id_key
+  let equal = eq_id_key
+  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)
+  | EvarKey evk -> combinesmall 4 (Evar.hash evk)
+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)
+
+let val_of_evar evk = val_of_idkey (EvarKey evk)
+
+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 ")"
+  | Asort _ -> str "Asort(")
+and pr_whd w =
+  Pp.(match w with
+  | 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 00000000..c6e342a9
--- /dev/null
+++ b/kernel/vmvalues.mli
@@ -0,0 +1,154 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 id_key =
+| ConstKey of Constant.t
+| VarKey of Id.t
+| RelKey of Int.t
+| EvarKey of Evar.t
+
+val eq_id_key : id_key -> id_key -> bool
+
+type atom =
+  | Aid of id_key
+  | Aind of inductive
+  | Asort of Sorts.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 =
+  | 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_evar : Evar.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/aux_file.ml b/lib/aux_file.ml
index 0f0f09aa..0f947660 100644
--- a/lib/aux_file.ml
+++ b/lib/aux_file.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* The file format is a header
@@ -17,10 +19,6 @@ let version = 1
 
 let oc = ref None
 
-let chop_extension f =
-  if check_suffix f ".v" then chop_extension f
-  else f
-
 let aux_file_name_for vfile =
   dirname vfile ^ "/." ^ chop_extension(basename vfile) ^ ".aux"
 
@@ -50,19 +48,21 @@ let contents x = x
 
 let empty_aux_file = H.empty
 
-let get aux loc key = M.find key (H.find (Loc.unloc loc) aux)
+let get ?loc aux key = M.find key (H.find (Option.cata Loc.unloc (0,0) loc) aux)
 
-let record_in_aux_at loc key v =
+let record_in_aux_at ?loc key v =
   Option.iter (fun oc ->
-    let i, j = Loc.unloc loc in
-    Printf.fprintf oc "%d %d %s %S\n" i j key v)
-  !oc
+      match loc with
+      | Some loc -> let i, j = Loc.unloc loc in
+                    Printf.fprintf oc "%d %d %s %S\n" i j key v
+      | None     -> Printf.fprintf oc "0 0 %s %S\n" key v
+    ) !oc
 
-let current_loc = ref Loc.ghost
+let current_loc : Loc.t option ref = ref None
 
-let record_in_aux_set_at loc = current_loc := loc
+let record_in_aux_set_at ?loc () = current_loc := loc
 
-let record_in_aux key v = record_in_aux_at !current_loc key v
+let record_in_aux key v = record_in_aux_at ?loc:!current_loc key v
 
 let set h loc k v =
   let m = try H.find loc h with Not_found -> M.empty in
@@ -76,14 +76,15 @@ let load_aux_file_for vfile =
   let add loc k v = h := set !h loc k v in
   let aux_fname = aux_file_name_for vfile in
   try
-    let ic = open_in aux_fname in
-    let ver, hash, fname = Scanf.fscanf ic "COQAUX%d %s %s\n" ret3 in
+    let ib = Scanf.Scanning.from_channel (open_in aux_fname) in
+    let ver, hash, fname =
+      Scanf.bscanf ib "COQAUX%d %s %s\n" ret3 in
     if ver <> version then raise (Failure "aux file version mismatch");
     if fname <> vfile then
       raise (Failure "aux file name mismatch");
     let only_dummyloc = Digest.to_hex (Digest.file vfile) <> hash in
     while true do
-      let i, j, k, v = Scanf.fscanf ic "%d %d %s %S\n" ret4 in
+      let i, j, k, v = Scanf.bscanf ib "%d %d %s %S\n" ret4 in
       if not only_dummyloc || (i = 0 && j = 0) then add (i,j) k v;
     done;
     raise End_of_file
@@ -94,4 +95,4 @@ let load_aux_file_for vfile =
     Flags.if_verbose Feedback.msg_info Pp.(str"Loading file "++str aux_fname++str": "++str s);
      empty_aux_file
 
-let set h loc k v = set h (Loc.unloc loc) k v
+let set ?loc h k v = set h (Option.cata Loc.unloc (0,0) loc) k v
diff --git a/lib/aux_file.mli b/lib/aux_file.mli
index 86e322b7..efdd75fd 100644
--- a/lib/aux_file.mli
+++ b/lib/aux_file.mli
@@ -1,17 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type aux_file
 
 val load_aux_file_for : string -> aux_file
-val get : aux_file -> Loc.t -> string -> string
 val empty_aux_file : aux_file
-val set : aux_file -> Loc.t -> string -> string -> aux_file
+val get : ?loc:Loc.t -> aux_file -> string -> string
+val set : ?loc:Loc.t -> aux_file -> string -> string -> aux_file
 
 module H : Map.S with type key = int * int
 module M : Map.S with type key = string
@@ -22,6 +24,6 @@ val start_aux_file : aux_file:string -> v_file:string -> unit
 val stop_aux_file : unit -> unit 
 val recording : unit -> bool
 
-val record_in_aux_at : Loc.t -> string -> string -> unit
+val record_in_aux_at : ?loc:Loc.t -> string -> string -> unit
 val record_in_aux : string -> string -> unit
-val record_in_aux_set_at : Loc.t -> unit
+val record_in_aux_set_at : ?loc:Loc.t -> unit -> unit
diff --git a/lib/cAst.ml b/lib/cAst.ml
new file mode 100644
index 00000000..e1da072d
--- /dev/null
+++ b/lib/cAst.ml
@@ -0,0 +1,26 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** The ast type contains generic metadata for AST nodes. *)
+type 'a t = {
+  v   : 'a;
+  loc : Loc.t option;
+}
+
+let make ?loc v = { v; loc }
+
+let map f n = { n with v = f n.v }
+let map_with_loc f n = { n with v = f ?loc:n.loc n.v }
+let map_from_loc f l =
+  let loc, v = l in
+  { v = f ?loc v ; loc }
+
+let with_val f n = f n.v
+let with_loc_val f n = f ?loc:n.loc n.v
diff --git a/lib/cAst.mli b/lib/cAst.mli
new file mode 100644
index 00000000..8443b1af
--- /dev/null
+++ b/lib/cAst.mli
@@ -0,0 +1,24 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** The ast type contains generic metadata for AST nodes *)
+type 'a t = private {
+  v   : 'a;
+  loc : Loc.t option;
+}
+
+val make : ?loc:Loc.t -> 'a -> 'a t
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+val map_with_loc : (?loc:Loc.t -> 'a -> 'b) -> 'a t -> 'b t
+val map_from_loc : (?loc:Loc.t -> 'a -> 'b) -> 'a Loc.located -> 'b t
+
+val with_val : ('a -> 'b) -> 'a t -> 'b
+val with_loc_val : (?loc:Loc.t -> 'a -> 'b) -> 'a t -> 'b
diff --git a/lib/cErrors.ml b/lib/cErrors.ml
index 5c56192f..97502211 100644
--- a/lib/cErrors.ml
+++ b/lib/cErrors.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 open Pp
 
@@ -14,17 +16,7 @@ let push = Backtrace.add_backtrace
 
 (* Errors *)
 
-exception Anomaly of string option * std_ppcmds (* System errors *)
-
-(* XXX: To move to common tagging functions in Pp, blocked on tag
- * system cleanup as we cannot define generic error tags now.
- *
- * Anyways, tagging should not happen here, but in the specific
- * listener to the msg_* stuff.
- *)
-let tag_err_str s = tag Ppstyle.(Tag.inj error_tag tag) (str s) ++ spc ()
-let err_str       = tag_err_str "Error:"
-let ann_str       = tag_err_str "Anomaly:"
+exception Anomaly of string option * Pp.t (* System errors *)
 
 let _ =
   let pr = function
@@ -36,25 +28,23 @@ let _ =
 let make_anomaly ?label pp =
   Anomaly (label, pp)
 
-let anomaly ?loc ?label pp = match loc with
-  | None -> raise (Anomaly (label, pp))
-  | Some loc -> Loc.raise loc (Anomaly (label, pp))
+let anomaly ?loc ?label pp =
+  Loc.raise ?loc (Anomaly (label, pp))
 
 let is_anomaly = function
 | Anomaly _ -> true
 | _ -> false
 
-exception UserError of string * std_ppcmds (* User errors *)
-let error string = raise (UserError("_", str string))
-let errorlabstrm l pps = raise (UserError(l,pps))
-
-exception AlreadyDeclared of std_ppcmds (* for already declared Schemes *)
-let alreadydeclared pps = raise (AlreadyDeclared(pps))
+exception UserError of string option * Pp.t (* User errors *)
 
 let todo s = prerr_string ("TODO: "^s^"\n")
 
-let user_err_loc (loc,s,strm) = Loc.raise loc (UserError (s,strm))
-let invalid_arg_loc (loc,s) = Loc.raise loc (Invalid_argument s)
+let user_err ?loc ?hdr strm = Loc.raise ?loc (UserError (hdr, strm))
+
+let invalid_arg ?loc s   = Loc.raise ?loc (Invalid_argument s)
+
+exception AlreadyDeclared of Pp.t (* for already declared Schemes *)
+let alreadydeclared pps = raise (AlreadyDeclared(pps))
 
 exception Timeout
 exception Drop
@@ -89,7 +79,7 @@ let where = function
   if !Flags.debug then str "in " ++ str s ++ str ":" ++ spc () else mt ()
 
 let raw_anomaly e = match e with
-  | Anomaly (s, pps) -> where s ++ pps ++ str "."
+  | Anomaly (s, pps) -> where s ++ pps
   | Assert_failure _ | Match_failure _ -> str (Printexc.to_string e) ++ str "."
   | _ -> str "Uncaught exception " ++ str (Printexc.to_string e) ++ str "."
 
@@ -103,9 +93,8 @@ let print_backtrace e = match Backtrace.get_backtrace e with
 
 let print_anomaly askreport e =
   if askreport then
-    hov 0 (ann_str ++ raw_anomaly e ++ spc () ++
-           strbrk "Please report at " ++ str Coq_config.wwwbugtracker ++
-           str ".")
+    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)
 
@@ -125,7 +114,7 @@ let iprint_no_report (e, info) =
 
 let _ = register_handler begin function
   | UserError(s, pps) ->
-    hov 0 (err_str ++ where (Some s) ++ pps)
+    hov 0 (where s ++ pps)
   | _ -> raise Unhandled
 end
 
@@ -133,12 +122,14 @@ end
     by inner functions during a [vernacinterp]. They should be handled
     only at the very end of interp, to be displayed to the user. *)
 
+[@@@ocaml.warning "-52"]
 let noncritical = function
   | Sys.Break | Out_of_memory | Stack_overflow
   | Assert_failure _ | Match_failure _ | Anomaly _
   | Timeout | Drop | Quit -> false
   | Invalid_argument "equal: functional value" -> false
   | _ -> true
+[@@@ocaml.warning "+52"]
 
 (** Check whether an exception is handled *)
 
@@ -148,13 +139,3 @@ let handled e =
   let bottom _ = raise Bottom in
   try let _ = print_gen bottom !handle_stack e in true
   with Bottom -> false
-
-(** Prints info which is either an error or
-   an anomaly and then exits with the appropriate
-   error code *)
-
-let fatal_error info anomaly =
-  let msg = info ++ fnl () in
-  pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.err_ft msg;
-  Format.pp_print_flush !Pp_control.err_ft ();
-  exit (if anomaly then 129 else 1)
diff --git a/lib/cErrors.mli b/lib/cErrors.mli
index e5dad93f..ec34dd62 100644
--- a/lib/cErrors.mli
+++ b/lib/cErrors.mli
@@ -1,12 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
-
-open Pp
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** This modules implements basic manipulations of errors for use
     throughout Coq's code. *)
@@ -21,10 +21,10 @@ val push : exn -> Exninfo.iexn
  [Anomaly] is used for system errors and [UserError] for the
    user's ones. *)
 
-val make_anomaly : ?label:string -> std_ppcmds -> exn
+val make_anomaly : ?label:string -> Pp.t -> exn
 (** Create an anomaly. *)
 
-val anomaly : ?loc:Loc.t -> ?label:string -> std_ppcmds -> 'a
+val anomaly : ?loc:Loc.t -> ?label:string -> Pp.t -> 'a
 (** Raise an anomaly, with an optional location and an optional
     label identifying the anomaly. *)
 
@@ -33,15 +33,18 @@ val is_anomaly : exn -> bool
     This is mostly provided for compatibility. Please avoid doing specific
     tricks with anomalies thanks to it. See rather [noncritical] below. *)
 
-exception UserError of string * std_ppcmds
-val error : string -> 'a
-val errorlabstrm : string -> std_ppcmds -> 'a
-val user_err_loc : Loc.t * string * std_ppcmds -> 'a
+exception UserError of string option * Pp.t
+(** Main error signaling exception. It carries a header plus a pretty printing
+    doc *)
+
+val user_err : ?loc:Loc.t -> ?hdr:string -> Pp.t -> 'a
+(** Main error raising primitive. [user_err ?loc ?hdr pp] signals an
+    error [pp] with optional header and location [hdr] [loc] *)
 
-exception AlreadyDeclared of std_ppcmds
-val alreadydeclared : std_ppcmds -> 'a
+exception AlreadyDeclared of Pp.t
+val alreadydeclared : Pp.t -> 'a
 
-val invalid_arg_loc : Loc.t * string -> 'a
+val invalid_arg : ?loc:Loc.t -> string -> 'a
 
 (** [todo] is for running of an incomplete code its implementation is
    "do nothing" (or print a message), but this function should not be
@@ -71,16 +74,16 @@ exception Quit
 
 exception Unhandled
 
-val register_handler : (exn -> Pp.std_ppcmds) -> unit
+val register_handler : (exn -> Pp.t) -> unit
 
 (** The standard exception printer *)
-val print : ?info:Exninfo.info -> exn -> Pp.std_ppcmds
-val iprint : Exninfo.iexn -> Pp.std_ppcmds
+val print : ?info:Exninfo.info -> exn -> Pp.t
+val iprint : Exninfo.iexn -> Pp.t
 
 (** Same as [print], except that the "Please report" part of an anomaly
     isn't printed (used in Ltac debugging). *)
-val print_no_report : exn -> Pp.std_ppcmds
-val iprint_no_report : Exninfo.iexn -> Pp.std_ppcmds
+val print_no_report : exn -> Pp.t
+val iprint_no_report : Exninfo.iexn -> Pp.t
 
 (** Critical exceptions should not be caught and ignored by mistake
     by inner functions during a [vernacinterp]. They should be handled
@@ -92,8 +95,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
-
-(** Prints info which is either an error or
-   an anomaly and then exits with the appropriate
-   error code *)
-val fatal_error : Pp.std_ppcmds -> bool -> 'a
diff --git a/lib/profile.ml b/lib/cProfile.ml
index d620fe69..07a11450 100644
--- a/lib/profile.ml
+++ b/lib/cProfile.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 let word_length = Sys.word_size / 8
@@ -85,6 +87,9 @@ let init_alloc = ref 0.0
 let reset_profile () = List.iter reset_record !prof_table
 
 let init_profile () =
+  (* We test Flags.profile as a way to support declaring profiled
+     functions in plugins *)
+  if !prof_table <> [] || Flags.profile then begin
   let outside = create_record () in
   stack := [outside];
   last_alloc := get_alloc ();
@@ -92,6 +97,7 @@ let init_profile () =
   init_time := get_time ();
   outside.tottime <- - !init_time;
   outside.owntime <- - !init_time
+  end
 
 let ajoute n o =
   o.owntime <- o.owntime + n.owntime;
@@ -317,15 +323,15 @@ let adjust_time ov_bc ov_ad e =
      owntime = e.owntime - int_of_float (ad_imm +. bc_imm) }
 
 let close_profile print =
-  let dw = spent_alloc () in
-  let t = get_time () in
-  match !stack with
-    | [outside] ->
-	outside.tottime <- outside.tottime + t;
-	outside.owntime <- outside.owntime + t;
-	ajoute_ownalloc outside dw;
-	ajoute_totalloc outside dw;
-	if !prof_table <> [] then begin
+  if !prof_table <> [] then begin
+      let dw = spent_alloc () in
+      let t = get_time () in
+      match !stack with
+      | [outside] ->
+	  outside.tottime <- outside.tottime + t;
+	  outside.owntime <- outside.owntime + t;
+	  ajoute_ownalloc outside dw;
+	  ajoute_totalloc outside dw;
 	  let ov_bc = time_overhead_B_C () (* B+C overhead *) in
 	  let ov_ad = time_overhead_A_D () (* A+D overhead *) in
 	  let adjust (n,e) = (n, adjust_time ov_bc ov_ad e) in
@@ -346,8 +352,8 @@ let close_profile print =
 	  in
 	  if print then format_profile updated_data;
 	  init_profile ()
-	end
-    | _ -> failwith "Inconsistency"
+      | _ -> failwith "Inconsistency"
+    end
 
 let print_profile () = close_profile true
 
@@ -358,9 +364,6 @@ let declare_profile name =
   prof_table := (name,e)::!prof_table;
   e
 
-(* Default initialization, may be overridden *)
-let _ = init_profile ()
-
 (******************************)
 (* Entry points for profiling *)
 let profile1 e f a =
diff --git a/lib/profile.mli b/lib/cProfile.mli
index 3328d7ea..764faf8d 100644
--- a/lib/profile.mli
+++ b/lib/cProfile.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {6 This program is a small time and allocation profiler for Objective Caml } *)
diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml
index cc2463e2..fda25a0a 100644
--- a/lib/cWarnings.ml
+++ b/lib/cWarnings.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -20,11 +22,8 @@ type t = {
 let warnings : (string, t) Hashtbl.t = Hashtbl.create 97
 let categories : (string, string list) Hashtbl.t = Hashtbl.create 97
 
-let current_loc = ref Loc.ghost
 let flags = ref ""
 
-let set_current_loc = (:=) current_loc
-
 let get_flags () = !flags
 
 let add_warning_in_category ~name ~category =
@@ -35,35 +34,6 @@ let add_warning_in_category ~name ~category =
   in
   Hashtbl.replace categories category (name::ws)
 
-let refine_loc = function
-  | None when not (Loc.is_ghost !current_loc) -> Some !current_loc
-  | loc -> loc
-
-let create ~name ~category ?(default=Enabled) pp =
-  Hashtbl.add warnings name { default; category; status = default };
-  add_warning_in_category ~name ~category;
-  if default <> Disabled then
-    add_warning_in_category ~name ~category:"default";
-  fun ?loc x -> let w = Hashtbl.find warnings name in
-           match w.status with
-           | Disabled -> ()
-           | AsError ->
-              begin match refine_loc loc with
-              | Some loc -> CErrors.user_err_loc (loc,"_",pp x)
-              | None -> CErrors.errorlabstrm "_" (pp x)
-              end
-           | Enabled ->
-              let msg =
-                pp x ++ spc () ++ str "[" ++ str name ++ str "," ++
-                  str category ++ str "]"
-              in
-              let loc = refine_loc loc in
-              Feedback.msg_warning ?loc msg
-
-let warn_unknown_warning =
-  create ~name:"unknown-warning" ~category:"toplevel"
-         (fun name -> strbrk "Unknown warning name: " ++ str name)
-
 let set_warning_status ~name status =
   try
     let w = Hashtbl.find warnings name in 
@@ -82,7 +52,7 @@ let set_all_warnings_status status =
 
 let set_category_status ~name status =
   let names = Hashtbl.find categories name in
-  List.iter (fun name -> set_warning_status name status) names
+  List.iter (fun name -> set_warning_status ~name status) names
 
 let is_all_keyword name = CString.equal name "all"
 let is_none_keyword s = CString.equal s "none"
@@ -93,7 +63,7 @@ let parse_flag s =
     | '+' -> (AsError, String.sub s 1 (String.length s - 1))
     | '-' -> (Disabled, String.sub s 1 (String.length s - 1))
     | _ -> (Enabled, s)
-  else CErrors.error "Invalid warnings flag"
+  else CErrors.user_err Pp.(str "Invalid warnings flag")
 
 let string_of_flag (status,name) =
   match status with
@@ -118,18 +88,16 @@ let set_status ~name status =
 let split_flags s =
   let reg = Str.regexp "[ ,]+" in Str.split reg s
 
-let check_warning ~silent (_status,name) =
-  is_all_keyword name ||
-  Hashtbl.mem categories name ||
-  Hashtbl.mem warnings name ||
-  (if not silent then warn_unknown_warning name; false)
-
 (** [cut_before_all_rev] removes all flags subsumed by a later occurrence of the
     "all" flag, and reverses the list. *)
 let rec cut_before_all_rev acc = function
   | [] -> acc
-  | (_status,name as w) :: warnings ->
-     cut_before_all_rev (w :: if is_all_keyword name then [] else acc) warnings
+  | (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
 
@@ -150,10 +118,9 @@ let uniquize_flags_rev flags =
     | [] -> acc
   in aux [] CString.Set.empty flags
 
-(** [normalize_flags] removes unknown or redundant warnings. If [silent] is
-    true, it emits a warning when an unknown warning is met. *)
+(** [normalize_flags] removes redundant warnings. Unknown warnings are kept
+    because they may be declared in a plugin that will be linked later. *)
 let normalize_flags ~silent warnings =
-  let warnings = List.filter (check_warning ~silent) warnings in
   let warnings = cut_before_all_rev warnings in
   uniquize_flags_rev warnings
 
@@ -166,7 +133,7 @@ let normalize_flags_string s =
     let flags = normalize_flags ~silent:false flags in
     string_of_flags flags
 
-let rec parse_warnings items =
+let parse_warnings items =
   CList.iter (fun (status, name) -> set_status ~name status) items
 
 (* For compatibility, we accept "none" *)
@@ -186,3 +153,26 @@ let parse_flags s =
 
 let set_flags s =
   reset_default_warnings (); let s = parse_flags s in flags := s
+
+(* Adds a warning to the [warnings] and [category] tables. We then reparse the
+   warning flags string, because the warning being created might have been set
+   already. *)
+let create ~name ~category ?(default=Enabled) pp =
+  Hashtbl.replace warnings name { default; category; status = default };
+  add_warning_in_category ~name ~category;
+  if default <> Disabled then
+    add_warning_in_category ~name ~category:"default";
+  (* We re-parse and also re-normalize the flags, because the category of the
+     new warning is now known. *)
+  set_flags !flags;
+  fun ?loc x ->
+           let w = Hashtbl.find warnings name in
+           match w.status with
+           | Disabled -> ()
+           | AsError -> CErrors.user_err ?loc (pp x)
+           | Enabled ->
+              let msg =
+                pp x ++ spc () ++ str "[" ++ str name ++ str "," ++
+                  str category ++ str "]"
+              in
+              Feedback.msg_warning ?loc msg
diff --git a/lib/cWarnings.mli b/lib/cWarnings.mli
index 3f6cee31..f97a53c4 100644
--- a/lib/cWarnings.mli
+++ b/lib/cWarnings.mli
@@ -1,17 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type status = Disabled | Enabled | AsError
 
-val set_current_loc : Loc.t -> unit
-
 val create : name:string -> category:string -> ?default:status ->
-             ('a -> Pp.std_ppcmds) -> ?loc:Loc.t -> 'a -> unit
+             ('a -> Pp.t) -> ?loc:Loc.t -> 'a -> unit
 
 val get_flags : unit -> string
 val set_flags : string -> unit
diff --git a/lib/control.ml b/lib/control.ml
index bf0e1b1c..3fbeb168 100644
--- a/lib/control.ml
+++ b/lib/control.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s interruption *)
@@ -12,21 +14,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 +34,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,12 +42,12 @@ 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 =
     while not !killed do
-      let cur = Unix.time () in
+      let cur = Unix.gettimeofday () in
       if float_of_int n <= cur -. init then begin
         interrupt := true;
         exited := true;
@@ -57,12 +56,12 @@ let windows_timeout n f e =
       Thread.delay 0.5
     done
   in
-  let init = Unix.time () in
+  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.time () in
+    let cur = Unix.gettimeofday () in
     (** The thread did not interrupt, but the computation took longer than
         expected. *)
     let () = if float_of_int n <= cur -. init then begin
@@ -80,12 +79,13 @@ 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_fun_ref = ref timeout_fun
+let set_timeout f = timeout_fun_ref := f
 
-let timeout n f e = !timeout_fun.timeout n f e
+let timeout n f e = !timeout_fun_ref.timeout n f e
diff --git a/lib/control.mli b/lib/control.mli
index 681df313..59e2a151 100644
--- a/lib/control.mli
+++ b/lib/control.mli
@@ -1,13 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** 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 +21,11 @@ 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 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. *)
 
+(** Set a particular timeout function; warning, this is an internal
+   API and it is scheduled to go away. *)
+type timeout = { timeout : 'a 'b. int -> ('a -> 'b) -> 'a -> exn -> 'b }
 val set_timeout : timeout -> unit
-(** Set a particular timeout function. *)
diff --git a/lib/coqProject_file.ml4 b/lib/coqProject_file.ml4
new file mode 100644
index 00000000..d6c340f6
--- /dev/null
+++ b/lib/coqProject_file.ml4
@@ -0,0 +1,255 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+type arg_source = CmdLine | ProjectFile
+
+type 'a sourced = { thing : 'a; source : arg_source }
+
+type project = {
+  project_file  : string option;
+  makefile : string option;
+  install_kind  : install option;
+  use_ocamlopt : bool;
+
+  v_files : string sourced list;
+  mli_files : string sourced list;
+  ml4_files : string sourced list;
+  ml_files : string sourced list;
+  mllib_files : string sourced list;
+  mlpack_files : string sourced list;
+
+  ml_includes : path sourced list;
+  r_includes  : (path * logic_path) sourced list;
+  q_includes  : (path * logic_path) sourced list;
+  extra_args : string sourced list;
+  defs : (string * string) sourced list;
+
+  (* deprecated in favor of a Makefile.local using :: rules *)
+  extra_targets : extra_target sourced list;
+  subdirs : string sourced list;
+}
+and extra_target = {
+  target : string;
+  dependencies : string;
+  phony : bool;
+  command : string;
+}
+and logic_path = string
+and path = { path : string; canonical_path : string }
+and install =
+  | NoInstall
+  | TraditionalInstall
+  | UserInstall
+
+(* TODO generate with PPX *)
+let mk_project project_file makefile install_kind use_ocamlopt = {
+  project_file;
+  makefile;
+  install_kind;
+  use_ocamlopt;
+
+  v_files = [];
+  mli_files = [];
+  ml4_files = [];
+  ml_files = [];
+  mllib_files = [];
+  mlpack_files = [];
+  extra_targets = [];
+  subdirs = [];
+  ml_includes = [];
+  r_includes = [];
+  q_includes = [];
+  extra_args = [];
+  defs = [];
+}
+
+(********************* utils ********************************************)
+
+let rec post_canonize f =
+  if Filename.basename f = Filename.current_dir_name
+  then let dir = Filename.dirname f in
+    if dir = Filename.current_dir_name then f else post_canonize dir
+  else f
+
+(********************* parser *******************************************)
+
+exception Parsing_error of string
+
+let rec parse_string = parser
+  | [< '' ' | '\n' | '\t' >] -> ""
+  | [< 'c; s >] -> (String.make 1 c)^(parse_string s)
+  | [< >] -> ""
+and parse_string2 = parser
+  | [< ''"' >] -> ""
+  | [< 'c; s >] -> (String.make 1 c)^(parse_string2 s)
+  | [< >] -> raise (Parsing_error "unterminated string")
+and parse_skip_comment = parser
+  | [< ''\n'; s >] -> s
+  | [< 'c; s >] -> parse_skip_comment s
+  | [< >] -> [< >]
+and parse_args = parser
+  | [< '' ' | '\n' | '\t'; s >] -> parse_args s
+  | [< ''#'; s >] -> parse_args (parse_skip_comment s)
+  | [< ''"'; str = parse_string2; s >] -> ("" ^ str) :: parse_args s
+  | [< 'c; str = parse_string; s >] -> ((String.make 1 c) ^ str) :: (parse_args s)
+  | [< >] -> []
+
+let parse f =
+  let c = open_in f in
+  let res = parse_args (Stream.of_channel c) in
+  close_in c;
+  res
+;;
+
+(* Copy from minisys.ml, since we don't see that file here *)
+let exists_dir dir =
+  let rec strip_trailing_slash dir =
+    let len = String.length dir in
+    if len > 0 && (dir.[len-1] = '/' || dir.[len-1] = '\\')
+    then strip_trailing_slash (String.sub dir 0 (len-1)) else dir in
+  try Sys.is_directory (strip_trailing_slash dir) with Sys_error _ -> false
+
+
+let process_cmd_line orig_dir proj args =
+  let parsing_project_file = ref (proj.project_file <> None) in
+  let sourced x = { thing = x; source = if !parsing_project_file then ProjectFile else CmdLine } in
+  let orig_dir = (* avoids turning foo.v in ./foo.v *)
+    if orig_dir = "." then "" else orig_dir 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);
+      canonical_path = CUnix.canonical_path_name p } in
+  let rec aux proj = function
+  | [] -> proj
+  | "-impredicative-set" :: _ ->
+    error "Use \"-arg -impredicative-set\" instead of \"-impredicative-set\""
+  | "-no-install" :: _ ->
+    error "Use \"-install none\" instead of \"-no-install\""
+  | "-custom" :: _ ->
+    error "Use \"-extra[-phony] target deps command\" instead of \"-custom command deps target\""
+  
+  | ("-no-opt"|"-byte") :: r -> aux { proj with use_ocamlopt =  false } r
+  | ("-full"|"-opt") :: r -> aux { proj with use_ocamlopt =  true } r
+  | "-install" :: d :: r ->
+    if proj.install_kind <> None then
+      Feedback.msg_warning (Pp.str "-install set more than once.");
+    let install = match d with
+      | "user" -> UserInstall
+      | "none" -> NoInstall
+      | "global" -> TraditionalInstall
+      | _ -> error ("invalid option \""^d^"\" passed to -install") in
+    aux { proj with install_kind = Some install } r
+  | "-extra" :: target :: dependencies :: command :: r ->
+    let tgt = { target; dependencies; phony = false; command } in
+    aux { proj with extra_targets = proj.extra_targets @ [sourced tgt] } r
+  | "-extra-phony" :: target :: dependencies :: command :: r ->
+    let tgt = { target; dependencies; phony = true; command } in
+    aux { proj with extra_targets = proj.extra_targets @ [sourced tgt] } r
+
+  | "-Q" :: d :: lp :: r ->
+    aux { proj with q_includes = proj.q_includes @ [sourced (mk_path d,lp)] } r
+  | "-I" :: d :: r ->
+    aux { proj with ml_includes = proj.ml_includes @ [sourced (mk_path d)] } r
+  | "-R" :: d :: lp :: r ->
+    aux { proj with r_includes = proj.r_includes @ [sourced (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
+      error "Option -o given more than once";
+    aux { proj with makefile = Some file } r  
+  | v :: "=" :: def :: r ->
+    aux { proj with defs = proj.defs @ [sourced (v,def)] } r
+  | "-arg" :: a :: r ->
+    aux { proj with extra_args = proj.extra_args @ [sourced a] } r
+  | f :: r ->
+      let f = CUnix.correct_path f orig_dir in
+      let proj =
+        if exists_dir f then { proj with subdirs = proj.subdirs @ [sourced f] }
+        else match CUnix.get_extension f with
+          | ".v" ->
+            { proj with v_files = proj.v_files @ [sourced f] }
+        | ".ml" -> { proj with ml_files = proj.ml_files @ [sourced f] }
+        | ".ml4" -> { proj with ml4_files = proj.ml4_files @ [sourced f] }
+        | ".mli" -> { proj with mli_files = proj.mli_files @ [sourced f] }
+        | ".mllib" -> { proj with mllib_files = proj.mllib_files @ [sourced f] }
+        | ".mlpack" -> { proj with mlpack_files = proj.mlpack_files @ [sourced f] }
+        | _ -> raise (Parsing_error ("Unknown option "^f)) in
+      aux proj r
+ in
+   aux proj args
+
+ (******************************* API ************************************)
+
+let cmdline_args_to_project ~curdir 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) (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 = from then None
+    else find_project_file ~from:newdir ~projfile_name
+;;
+
+let all_files { v_files; ml_files; mli_files; ml4_files;
+                mllib_files; mlpack_files } =
+  v_files @ mli_files @ ml4_files @ ml_files @ mllib_files @ mlpack_files
+
+let map_sourced_list f l = List.map (fun x -> f x.thing) l
+;;
+
+let map_cmdline f l = CList.map_filter (function
+    | {thing=x; source=CmdLine} -> Some (f x)
+    | {source=ProjectFile} -> None) l
+
+let coqtop_args_from_project
+  { ml_includes; r_includes; q_includes; extra_args }
+=
+  let map = map_sourced_list  in
+  let args =
+    map (fun { canonical_path = i } -> ["-I"; i]) ml_includes @
+    map (fun ({ canonical_path = i }, l) -> ["-Q"; i; l]) q_includes @
+    map (fun ({ canonical_path = p }, l) -> ["-R"; p; l]) r_includes @
+    [map (fun x -> x) extra_args] in
+  List.flatten args
+;;
+
+let filter_cmdline l = CList.map_filter
+    (function {thing; source=CmdLine} -> Some thing | {source=ProjectFile} -> None)
+    l
+;;
+
+let forget_source {thing} = thing
+
+(* vim:set ft=ocaml: *)
diff --git a/lib/coqProject_file.mli b/lib/coqProject_file.mli
new file mode 100644
index 00000000..5780bb5d
--- /dev/null
+++ b/lib/coqProject_file.mli
@@ -0,0 +1,68 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+exception Parsing_error of string
+
+type arg_source = CmdLine | ProjectFile
+
+type 'a sourced = { thing : 'a; source : arg_source }
+
+type project = {
+  project_file  : string option;
+  makefile : string option;
+  install_kind  : install option;
+  use_ocamlopt : bool;
+
+  v_files : string sourced list;
+  mli_files : string sourced list;
+  ml4_files : string sourced list;
+  ml_files : string sourced list;
+  mllib_files : string sourced list;
+  mlpack_files : string sourced list;
+
+  ml_includes : path sourced list;
+  r_includes  : (path * logic_path) sourced list;
+  q_includes  : (path * logic_path) sourced list;
+  extra_args : string sourced list;
+  defs : (string * string) sourced list;
+
+  (* deprecated in favor of a Makefile.local using :: rules *)
+  extra_targets : extra_target sourced list;
+  subdirs : string sourced list;
+}
+and extra_target = {
+  target : string;
+  dependencies : string;
+  phony : bool;
+  command : string;
+}
+and logic_path = string
+and path = { path : string; canonical_path : string }
+and install =
+  | NoInstall
+  | TraditionalInstall
+  | UserInstall
+
+val cmdline_args_to_project : curdir:string -> string list -> project
+val read_project_file : string -> project
+val coqtop_args_from_project : project -> string list
+val find_project_file : from:string -> projfile_name:string -> string option
+
+val all_files : project -> string sourced list
+
+val map_sourced_list : ('a -> 'b) -> 'a sourced list -> 'b list
+
+(** Only uses the elements with source=CmdLine *)
+val map_cmdline : ('a -> 'b) -> 'a sourced list -> 'b list
+
+(** Only uses the elements with source=CmdLine *)
+val filter_cmdline : 'a sourced list -> 'a list
+
+val forget_source : 'a sourced -> 'a
diff --git a/lib/dAst.ml b/lib/dAst.ml
new file mode 100644
index 00000000..f34ab956
--- /dev/null
+++ b/lib/dAst.ml
@@ -0,0 +1,43 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 00000000..28c78784
--- /dev/null
+++ b/lib/dAst.mli
@@ -0,0 +1,30 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** 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/deque.ml b/lib/deque.ml
deleted file mode 100644
index ac89a35b..00000000
--- a/lib/deque.ml
+++ /dev/null
@@ -1,97 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-exception Empty
-
-type 'a t = {
-  face : 'a list;
-  rear : 'a list;
-  lenf : int;
-  lenr : int;
-}
-
-let rec split i accu l = match l with
-| [] ->
-  if Int.equal i 0 then (accu, []) else invalid_arg "split"
-| t :: q ->
-  if Int.equal i 0 then (accu, l)
-  else split (pred i) (t :: accu) q
-
-let balance q =
-  let avg = (q.lenf + q.lenr) / 2 in
-  let dif = q.lenf + q.lenr - avg in
-  if q.lenf > succ (2 * q.lenr) then
-    let (ff, fr) = split avg [] q.face in
-    { face = List.rev ff ; rear = q.rear @ List.rev fr; lenf = avg; lenr = dif }
-  else if q.lenr > succ (2 * q.lenf) then
-    let (rf, rr) = split avg [] q.rear in
-    { face = q.face @ List.rev rr ; rear = List.rev rf; lenf = dif; lenr = avg }
-  else q
-
-let empty = {
-  face = [];
-  rear = [];
-  lenf = 0;
-  lenr = 0;
-}
-
-let lcons x q =
-  balance { q with lenf = succ q.lenf; face = x :: q.face }
-
-let lhd q = match q.face with
-| [] ->
-  begin match q.rear with
-  | [] -> raise Empty
-  | t :: _ -> t
-  end
-| t :: _ -> t
-
-let ltl q = match q.face with
-| [] ->
-  begin match q.rear with
-  | [] -> raise Empty
-  | t :: _ -> empty
-  end
-| t :: r -> balance { q with lenf = pred q.lenf; face = r }
-
-let rcons x q =
-  balance { q with lenr = succ q.lenr; rear = x :: q.rear }
-
-let rhd q = match q.rear with
-| [] ->
-  begin match q.face with
-  | [] -> raise Empty
-  | t :: r -> t
-  end
-| t :: _ -> t
-
-let rtl q = match q.rear with
-| [] ->
-  begin match q.face with
-  | [] -> raise Empty
-  | t :: r -> empty
-  end
-| t :: r ->
-  balance { q with lenr = pred q.lenr; rear = r }
-
-let rev q = {
-  face = q.rear;
-  rear = q.face;
-  lenf = q.lenr;
-  lenr = q.lenf;
-}
-
-let length q = q.lenf + q.lenr
-
-let is_empty q = Int.equal (length q) 0
-
-let filter f q =
-  let fold (accu, len) x = if f x then (x :: accu, succ len) else (accu, len) in
-  let (rf, lenf) = List.fold_left fold ([], 0) q.face in
-  let (rr, lenr) = List.fold_left fold ([], 0) q.rear in
-  balance { face = List.rev rf; rear = List.rev rr; lenf = lenf; lenr = lenr }
diff --git a/lib/deque.mli b/lib/deque.mli
deleted file mode 100644
index 6963f1db..00000000
--- a/lib/deque.mli
+++ /dev/null
@@ -1,58 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** * Purely functional, double-ended queues *)
-
-(** This module implements the banker's deque, from Okasaki. Most operations are
-    amortized O(1). *)
-
-type +'a t
-
-exception Empty
-
-(** {5 Constructor} *)
-
-val empty : 'a t
-
-(** The empty deque. *)
-
-(** {5 Left-side operations} *)
-
-val lcons : 'a -> 'a t -> 'a t
-(** Pushes an element on the left side of the deque. *)
-
-val lhd : 'a t -> 'a
-(** Returns the leftmost element in the deque. Raises [Empty] when empty. *)
-
-val ltl : 'a t -> 'a t
-(** Returns the left-tail of the deque. Raises [Empty] when empty. *)
-
-(** {5 Right-side operations} *)
-
-val rcons : 'a -> 'a t -> 'a t
-(** Same as [lcons] but on the right side. *)
-
-val rhd : 'a t -> 'a
-(** Same as [lhd] but on the right side. *)
-
-val rtl : 'a t -> 'a t
-(** Same as [ltl] but on the right side. *)
-
-(** {5 Operations} *)
-
-val rev : 'a t -> 'a t
-(** Reverse deque. *)
-
-val length : 'a t -> int
-(** Length of a deque. *)
-
-val is_empty : 'a t -> bool
-(** Emptyness of a deque. *)
-
-val filter : ('a -> bool) -> 'a t -> 'a t
-(** Filters the deque *)
diff --git a/lib/doc.tex b/lib/doc.tex
deleted file mode 100644
index 35bd15fa..00000000
--- a/lib/doc.tex
+++ /dev/null
@@ -1,7 +0,0 @@
-
-\newpage
-\section*{Utility libraries}
-
-\ocwsection \label{lib}
-This chapter describes the various utility libraries used in the code
-of \Coq.
diff --git a/lib/envars.ml b/lib/envars.ml
index 89ce5283..be82bfe9 100644
--- a/lib/envars.ml
+++ b/lib/envars.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -23,8 +25,6 @@ let ( / ) a b =
 
 let coqify d = d / "coq"
 
-let opt2list = function None -> [] | Some x -> [x]
-
 let home ~warn =
   getenv_else "HOME" (fun () ->
     try (Sys.getenv "HOMEDRIVE")^(Sys.getenv "HOMEPATH") with Not_found ->
@@ -81,9 +81,6 @@ let expand_path_macros ~warn s =
 
 (** {2 Coq paths} *)
 
-let relative_base =
-  Filename.dirname (Filename.dirname Sys.executable_name)
-
 let coqbin =
   CUnix.canonical_path_name (Filename.dirname Sys.executable_name)
 
@@ -98,25 +95,26 @@ let _ =
   if Coq_config.arch_is_win32 then
     Unix.putenv "PATH" (coqbin ^ ";" ^ getenv_else "PATH" (fun () -> ""))
 
+(** Add a local installation suffix (unless the suffix is itself
+    absolute in which case the prefix does not matter) *)
+let use_suffix prefix suffix =
+  if String.length suffix > 0 && suffix.[0] = '/' then suffix else prefix / suffix
+
 (** [check_file_else ~dir ~file oth] checks if [file] exists in
-    the installation directory [dir] given relatively to [coqroot].
-    If this Coq is only locally built, then [file] must be in [coqroot].
+    the installation directory [dir] given relatively to [coqroot],
+    which maybe has been relocated.
     If the check fails, then [oth ()] is evaluated.
     Using file system equality seems well enough for this heuristic *)
 let check_file_else ~dir ~file oth =
-  let path = if Coq_config.local then coqroot else coqroot / dir in
+  let path = use_suffix coqroot dir in
   if Sys.file_exists (path / file) then path else oth ()
 
 let guess_coqlib fail =
   let prelude = "theories/Init/Prelude.vo" in
-  let dir = if Coq_config.arch_is_win32 then "lib" else "lib/coq" in
-  check_file_else ~dir ~file:prelude
+  check_file_else ~dir:Coq_config.coqlibsuffix ~file:prelude
     (fun () ->
-      let coqlib = match Coq_config.coqlib with
-        | Some coqlib -> coqlib
-        | None -> coqroot
-      in
-      if Sys.file_exists (coqlib / prelude) then coqlib
+      if not Coq_config.local && Sys.file_exists (Coq_config.coqlib / prelude)
+      then Coq_config.coqlib
       else
         fail "cannot guess a path for Coq libraries; please use -coqlib option")
 
@@ -130,8 +128,19 @@ let set_coqlib ~fail =
 let coqlib () = !Flags.coqlib
 
 let docdir () =
-  let dir = if Coq_config.arch_is_win32 then "doc" else "share/doc/coq" in
-  check_file_else ~dir ~file:"html" (fun () -> Coq_config.docdir)
+  (* This assumes implicitly that the suffix is non-trivial *)
+  let path = use_suffix coqroot Coq_config.docdirsuffix in
+  if Sys.file_exists path then path else Coq_config.docdir
+
+let datadir () =
+  (* This assumes implicitly that the suffix is non-trivial *)
+  let path = use_suffix coqroot Coq_config.datadirsuffix in
+  if Sys.file_exists path then path else Coq_config.datadir
+
+let configdir () =
+  (* This assumes implicitly that the suffix is non-trivial *)
+  let path = use_suffix coqroot Coq_config.configdirsuffix in
+  if Sys.file_exists path then path else Coq_config.configdir
 
 let coqpath =
   let coqpath = getenv_else "COQPATH" (fun () -> "") in
@@ -146,31 +155,23 @@ let coqpath =
 
 let exe s = s ^ Coq_config.exec_extension
 
-let guess_ocamlfind () = which (user_path ()) (exe "ocamlfind")
-
-let ocamlfind () =
-  if !Flags.ocamlfind_spec then !Flags.ocamlfind else
-    if !Flags.boot then Coq_config.ocamlfind else
-      try guess_ocamlfind () / "ocamlfind"  with Not_found -> Coq_config.ocamlfind
-
-(** {2 Camlp4 paths} *)
+let ocamlfind () = Coq_config.ocamlfind
 
-let guess_camlp4bin () = which (user_path ()) (exe Coq_config.camlp4)
+(** {2 Camlp5 paths} *)
 
-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 guess_camlp5bin () = which (user_path ()) (exe "camlp5")
 
-let camlp4 () = camlp4bin () / exe Coq_config.camlp4
+let camlp5bin () =
+  if !Flags.boot then Coq_config.camlp5bin else
+    try guess_camlp5bin ()
+    with Not_found ->
+      Coq_config.camlp5bin
 
-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"
@@ -190,20 +191,27 @@ let xdg_data_dirs warn =
     try
       List.map coqify (path_to_list (Sys.getenv "XDG_DATA_DIRS"))
     with
-      | Not_found when String.equal Sys.os_type "Win32" -> [relative_base / "share"]
-      | Not_found -> ["/usr/local/share/coq";"/usr/share/coq"]
+      | Not_found -> [datadir ()]
   in
-  xdg_data_home warn :: sys_dirs @ opt2list Coq_config.datadir
-
-let xdg_config_dirs warn =
-  let sys_dirs =
-    try
-      List.map coqify (path_to_list (Sys.getenv "XDG_CONFIG_DIRS"))
-    with
-      | Not_found when String.equal Sys.os_type "Win32" -> [relative_base / "config"]
-      | Not_found -> ["/etc/xdg/coq"]
-  in
-  xdg_config_home warn :: sys_dirs @ opt2list Coq_config.configdir
+  xdg_data_home warn :: sys_dirs
 
 let xdg_dirs ~warn =
   List.filter Sys.file_exists (xdg_data_dirs warn)
+
+(* Print the configuration information *)
+
+let print_config ?(prefix_var_name="") f coq_src_subdirs =
+  let open Printf in 
+  fprintf f "%sLOCAL=%s\n" prefix_var_name (if Coq_config.local then "1" else "0");
+  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 "%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 90a42859..66b86252 100644
--- a/lib/envars.mli
+++ b/lib/envars.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file provides a high-level interface to the environment variables 
@@ -27,12 +29,18 @@ val home : warn:(string -> unit) -> string
 (** [coqlib] is the path to the Coq library. *)
 val coqlib : unit -> string
 
+(** [docdir] is the path to the installed documentation. *)
+val docdir : unit -> string
+
+(** [datadir] is the path to the installed data directory. *)
+val datadir : unit -> string
+
+(** [configdir] is the path to the installed config directory. *)
+val configdir : unit -> string
+
 (** [set_coqlib] must be runned once before any access to [coqlib] *)
 val set_coqlib : fail:(string -> string) -> unit
 
-(** [docdir] is the path to the Coq documentation. *)
-val docdir : unit -> string
-
 (** [coqbin] is the name of the current executable. *)
 val coqbin : string
 
@@ -47,17 +55,14 @@ val coqroot : string
     the order it gets added to the search path. *)
 val coqpath : string list
 
-(** [camlbin ()] is the path to the ocamlfind binary. *)
+(** [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.
@@ -66,6 +71,8 @@ val camlp4 : unit -> string
 *)
 val xdg_config_home : (string -> unit) -> string
 val xdg_data_home   : (string -> unit) -> string
-val xdg_config_dirs : (string -> unit) -> string list
 val xdg_data_dirs   : (string -> unit) -> string list
 val xdg_dirs : warn : (string -> unit) -> string list
+
+(** {6 Prints the configuration information } *)
+val print_config : ?prefix_var_name:string -> out_channel -> string list -> unit
diff --git a/lib/explore.ml b/lib/explore.ml
index aa7bddf2..4dc48ab6 100644
--- a/lib/explore.ml
+++ b/lib/explore.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -14,7 +16,7 @@ module type SearchProblem = sig
   type state
   val branching : state -> state list
   val success : state -> bool
-  val pp : state -> std_ppcmds
+  val pp : state -> Pp.t
 end
 
 module Make = functor(S : SearchProblem) -> struct
diff --git a/lib/explore.mli b/lib/explore.mli
index 2b273e12..528a1b97 100644
--- a/lib/explore.mli
+++ b/lib/explore.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {6 Search strategies. } *)
@@ -27,7 +29,7 @@ module type SearchProblem = sig
 
   val success : state -> bool
 
-  val pp : state -> Pp.std_ppcmds
+  val pp : state -> Pp.t
 
 end
 
diff --git a/lib/feedback.ml b/lib/feedback.ml
index 44b3ee35..cb8f8aad 100644
--- a/lib/feedback.ml
+++ b/lib/feedback.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Xml_datatype
@@ -15,9 +17,7 @@ type level =
   | Warning
   | Error
 
-type edit_id = int
-type state_id = Stateid.t
-type edit_or_state_id = Edit of edit_id | State of state_id
+type doc_id = int
 type route_id = int
 
 type feedback_content =
@@ -27,206 +27,97 @@ type feedback_content =
   | ProcessingIn of string
   | InProgress of int
   | WorkerStatus of string * string
-  | Goals of Loc.t * string
   | AddedAxiom
   | GlobRef of Loc.t * string * string * string * string
   | GlobDef of Loc.t * string * string * string
   | FileDependency of string option * string
   | FileLoaded of string * string
   (* Extra metadata *)
-  | Custom of Loc.t * string * xml
+  | Custom of Loc.t option * string * xml
   (* Generic messages *)
-  | Message of level * Loc.t option * Richpp.richpp
+  | Message of level * Loc.t option * Pp.t
 
 type feedback = {
-  id : edit_or_state_id;
+  doc_id   : doc_id;            (* The document being concerned *)
+  span_id  : Stateid.t;
+  route    : route_id;
   contents : feedback_content;
-  route : route_id;
 }
 
-let default_route = 0
-
-(** Feedback and logging *)
-open Pp
-open Pp_control
-
-type logger = ?loc:Loc.t -> level -> std_ppcmds -> unit
-
-let msgnl_with ?pp_tag fmt strm = msg_with ?pp_tag fmt (strm ++ fnl ())
-
-(* XXX: This is really painful! *)
-module Emacs = struct
-
-  (* Special chars for emacs, to detect warnings inside goal output *)
-  let emacs_quote_start = String.make 1 (Char.chr 254)
-  let emacs_quote_end   = String.make 1 (Char.chr 255)
-
-  let emacs_quote_err g =
-    hov 0 (str emacs_quote_start ++ g ++ str emacs_quote_end)
-
-  let emacs_quote_info_start = "<infomsg>"
-  let emacs_quote_info_end = "</infomsg>"
-
-  let emacs_quote_info g =
-    hov 0 (str emacs_quote_info_start++ brk(0,0) ++ g ++ brk(0,0) ++ str emacs_quote_info_end)
-
-end
-
-open Emacs
-
-let  dbg_str = tag Ppstyle.(Tag.inj debug_tag   tag) (str "Debug:")   ++ spc ()
-let info_str = mt ()
-let warn_str = tag Ppstyle.(Tag.inj warning_tag tag) (str "Warning:") ++ spc ()
-let  err_str = tag Ppstyle.(Tag.inj error_tag   tag) (str "Error:"  ) ++ spc ()
-
-let make_body quoter info ?loc s =
-  let loc = Option.cata Pp.pr_loc (Pp.mt ()) loc in
-  quoter (hov 0 (loc ++ info ++ s))
-
-(* Generic logger *)
-let gen_logger dbg err ?pp_tag ?loc level msg = match level with
-  | Debug   -> msgnl_with ?pp_tag !std_ft (make_body dbg  dbg_str ?loc msg)
-  | Info    -> msgnl_with ?pp_tag !std_ft (make_body dbg info_str ?loc msg)
-  | Notice  -> msgnl_with ?pp_tag !std_ft msg
-  | Warning -> Flags.if_warn (fun () ->
-               msgnl_with ?pp_tag !err_ft (make_body err warn_str ?loc msg)) ()
-  | Error   -> msgnl_with ?pp_tag !err_ft (make_body err  err_str ?loc msg)
-
-(* We provide a generic clear_log_backend callback for backends
-   wanting to do clenaup after the print.
-*)
-let std_logger_tag     = ref None
-let std_logger_cleanup = ref (fun () -> ())
-
-let std_logger ?loc level msg =
-  gen_logger (fun x -> x) (fun x -> x) ?pp_tag:!std_logger_tag ?loc level msg;
-  !std_logger_cleanup ()
-
-(* Rules for emacs:
-   - Debug/info: emacs_quote_info
-   - Warning/Error: emacs_quote_err
-   - Notice: unquoted
-
-  Note the inconsistency.
- *)
-let emacs_logger = gen_logger emacs_quote_info emacs_quote_err ?pp_tag:None
-
-(** Color logging. Moved from pp_style, it may need some more refactoring  *)
-
-(** Not thread-safe. We should put a lock somewhere if we print from
-    different threads. Do we? *)
-let make_style_stack () =
-  (** Default tag is to reset everything *)
-  let empty = Terminal.make () in
-  let default_tag = Terminal.({
-      fg_color = Some `DEFAULT;
-      bg_color = Some `DEFAULT;
-      bold = Some false;
-      italic = Some false;
-      underline = Some false;
-      negative = Some false;
-    })
-  in
-  let style_stack = ref [] in
-  let peek () = match !style_stack with
-  | []      -> default_tag  (** Anomalous case, but for robustness *)
-  | st :: _ -> st
-  in
-  let push tag =
-    let style = match Ppstyle.get_style tag with
-      | None    -> empty
-      | Some st -> st
-    in
-    (** Use the merging of the latest tag and the one being currently pushed.
-    This may be useful if for instance the latest tag changes the background and
-    the current one the foreground, so that the two effects are additioned. *)
-    let style = Terminal.merge (peek ()) style in
-    style_stack := style :: !style_stack;
-    Terminal.eval style
-  in
-  let pop _ = match !style_stack with
-  | []       -> (** Something went wrong, we fallback *)
-                Terminal.eval default_tag
-  | _ :: rem -> style_stack := rem;
-                Terminal.eval (peek ())
-  in
-  let clear () = style_stack := [] in
-  push, pop, clear
-
-let init_color_output () =
-  let open Pp_control in
-  let push_tag, pop_tag, clear_tag = make_style_stack () in
-  std_logger_cleanup := clear_tag;
-  std_logger_tag     := Some Ppstyle.pp_tag;
-  let tag_handler = {
-    Format.mark_open_tag   = push_tag;
-    Format.mark_close_tag  = pop_tag;
-    Format.print_open_tag  = ignore;
-    Format.print_close_tag = ignore;
-  } in
-  Format.pp_set_mark_tags !std_ft true;
-  Format.pp_set_mark_tags !err_ft true;
-  Format.pp_set_formatter_tag_functions !std_ft tag_handler;
-  Format.pp_set_formatter_tag_functions !err_ft tag_handler
-
-let logger       = ref std_logger
-let set_logger l = logger := l
-
-let msg_info    ?loc x = !logger ?loc Info x
-let msg_notice  ?loc x = !logger ?loc Notice x
-let msg_warning ?loc x = !logger ?loc Warning x
-let msg_error   ?loc x = !logger ?loc Error x
-let msg_debug   ?loc x = !logger ?loc Debug x
-
 (** Feeders *)
-let feeders = ref []
-let add_feeder f = feeders := f :: !feeders
+let feeders : (int, feedback -> unit) Hashtbl.t = Hashtbl.create 7
 
-let debug_feeder = function
-  | { contents = Message (Debug, loc, pp) } ->
-       msg_debug ?loc (Pp.str (Richpp.raw_print pp))
-  | _ -> ()
+let add_feeder =
+  let f_id = ref 0 in fun f ->
+  incr f_id;
+  Hashtbl.add feeders !f_id f;
+  !f_id
 
-let feedback_id    = ref (Edit 0)
+let del_feeder fid = Hashtbl.remove feeders fid
+
+let default_route = 0
+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
-  List.iter (fun f -> f m) !feeders
+  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, Richpp.richpp_of_pp msg))
-
-(* Output to file *)
-let ft_logger old_logger ft ?loc level mesg =
-  let id x = x in
-  match level with
-  | Debug   -> msgnl_with ft (make_body id  dbg_str mesg)
-  | Info    -> msgnl_with ft (make_body id info_str mesg)
-  | Notice  -> msgnl_with ft mesg
-  | Warning -> old_logger ?loc level mesg
-  | Error   -> old_logger ?loc level mesg
-
-let with_output_to_file fname func input =
-  let old_logger = !logger in
-  let channel = open_out (String.concat "." [fname; "out"]) in
-  logger := ft_logger old_logger (Format.formatter_of_out_channel channel);
-  try
-    let output = func input in
-    logger := old_logger;
-    close_out channel;
-    output
-  with reraise ->
-    let reraise = Backtrace.add_backtrace reraise in
-    logger := old_logger;
-    close_out channel;
-    Exninfo.iraise reraise
-
+  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 5160bd5b..64fdf372 100644
--- a/lib/feedback.mli
+++ b/lib/feedback.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Xml_datatype
 
-(* Old plain messages (used to be in Pp) *)
+(* Legacy-style logging messages (used to be in Pp) *)
 type level =
   | Debug
   | Info
@@ -17,11 +19,10 @@ type level =
   | Error
 
 
-(** Coq "semantic" infos obtained during parsing/execution *)
-type edit_id = int
-type state_id = Stateid.t
-type edit_or_state_id = Edit of edit_id | State of state_id
+(** Document unique identifier for serialization *)
+type doc_id = int
 
+(** Coq "semantic" infos obtained during execution *)
 type route_id = int
 
 val default_route : route_id
@@ -36,68 +37,42 @@ type feedback_content =
   | InProgress of int
   | WorkerStatus of string * string
   (* Generally useful metadata *)
-  | Goals of Loc.t * string
   | AddedAxiom
   | GlobRef of Loc.t * string * string * string * string
   | GlobDef of Loc.t * string * string * string
   | FileDependency of string option * string
   | FileLoaded of string * string
   (* Extra metadata *)
-  | Custom of Loc.t * string * xml
+  | Custom of Loc.t option * string * xml
   (* Generic messages *)
-  | Message of level * Loc.t option * Richpp.richpp
+  | Message of level * Loc.t option * Pp.t
 
 type feedback = {
-  id       : edit_or_state_id;  (* The document part concerned *)
-  contents : feedback_content;  (* The payload *)
+  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 *)
 }
 
 (** {6 Feedback sent, even asynchronously, to the user interface} *)
 
-(** Moved here from pp.ml *)
-
-(* Morally the parser gets a string and an edit_id, and gives back an AST.
- * Feedbacks during the parsing phase are attached to this edit_id.
- * The interpreter assignes an exec_id to the ast, and feedbacks happening
- * during interpretation are attached to the exec_id.
- * Only one among state_id and edit_id can be provided. *)
-
-(** A [logger] takes a level plus a pretty printing doc and logs it *)
-type logger = ?loc:Loc.t -> level -> Pp.std_ppcmds -> unit
-
-(** [set_logger l] makes the [msg_*] to use [l] for logging *)
-val set_logger : logger -> unit
-
-(** [std_logger] standard logger to [stdout/stderr]  *)
-val std_logger : logger
+(* The interpreter assignes an state_id to the ast, and feedbacks happening
+ * during interpretation are attached to it.
+ *)
 
-(** [init_color_output ()] Enable color in the std_logger *)
-val init_color_output : unit -> unit
+(** [add_feeder f] adds a feeder listiner [f], returning its id *)
+val add_feeder : (feedback -> unit) -> int
 
-(** [feedback_logger] will produce feedback messages instead IO events *)
-val feedback_logger : logger
-val emacs_logger    : logger
+(** [del_feeder fid] removes the feeder with id [fid] *)
+val del_feeder : int -> unit
 
-
-(** [add_feeder] feeders observe the feedback *)
-val add_feeder : (feedback -> unit) -> unit
-
-(** Prints feedback messages of kind Message(Debug,_) using msg_debug *)
-val debug_feeder : feedback -> unit
-
-(** [feedback ?id ?route fb] produces feedback fb, with [route] and
-    [id] set appropiatedly, if absent, it will use the defaults set by
-    [set_id_for_feedback] *)
-val feedback :
-  ?id:edit_or_state_id -> ?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 -> edit_or_state_id -> unit
-
-(** [with_output_to_file file f x] executes [f x] with logging
-    redirected to a file [file] *)
-val with_output_to_file : string -> ('a -> 'b) -> 'a -> 'b
+val set_id_for_feedback : ?route:route_id -> doc_id -> Stateid.t -> unit
 
 (** {6 output functions}
 
@@ -109,24 +84,29 @@ relaxed. *)
 (* Should we advertise these functions more? Should they be the ONLY
    allowed way to output something? *)
 
-val msg_info : ?loc:Loc.t -> Pp.std_ppcmds -> unit
+val msg_info : ?loc:Loc.t -> Pp.t -> unit
 (** Message that displays information, usually in verbose mode, such as [Foobar
     is defined] *)
 
-val msg_notice : ?loc:Loc.t -> Pp.std_ppcmds -> unit
+val msg_notice : ?loc:Loc.t -> Pp.t -> unit
 (** Message that should be displayed, such as [Print Foo] or [Show Bar]. *)
 
-val msg_warning : ?loc:Loc.t -> Pp.std_ppcmds -> unit
+val msg_warning : ?loc:Loc.t -> Pp.t -> unit
 (** Message indicating that something went wrong, but without serious
     consequences. *)
 
-val msg_error : ?loc:Loc.t -> Pp.std_ppcmds -> unit
-(** Message indicating that something went really wrong, though still
-    recoverable; otherwise an exception would have been raised. *)
+val msg_error : ?loc:Loc.t -> Pp.t -> unit
+[@@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.std_ppcmds -> unit
+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 0e2f7e5a..8491873e 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -1,18 +1,34 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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,80 +41,25 @@ 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 in_debugger = ref false
 let in_toplevel = ref false
 
 let profile = false
 
-let print_emacs = ref false
-let coqtop_ui = ref false
-
-let xml_export = ref false
-
 let ide_slave = ref false
-let ideslave_coqtop_flags = ref None
-
-let time = ref false
 
 let raw_print = ref false
-
-let record_print = ref true
-
 let univ_print = ref false
 
 let we_are_parsing = ref false
@@ -108,33 +69,25 @@ let we_are_parsing = ref false
 (* Current means no particular compatibility consideration.
    For correct comparisons, this constructor should remain the last one. *)
 
-type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | Current
+type compat_version = V8_6 | V8_7 | Current
 
 let compat_version = ref Current
 
 let version_compare v1 v2 = match v1, v2 with
-| V8_2, V8_2 -> 0
-| V8_2, (V8_3 | V8_4 | V8_5 | Current) -> -1
-| V8_3, V8_2 -> 1
-| V8_3, V8_3 -> 0
-| V8_3, (V8_4 | V8_5 | Current) -> -1
-| V8_4, (V8_2 | V8_3) -> 1
-| V8_4, V8_4 -> 0
-| V8_4, (V8_5 | Current) -> -1
-| V8_5, (V8_2 | V8_3 | V8_4) -> 1
-| V8_5, V8_5 -> 0
-| V8_5, Current -> -1
-| Current, Current -> 0
-| Current, (V8_2 | V8_3 | V8_4 | V8_5) -> 1
+  | V8_6, V8_6 -> 0
+  | V8_6, _ -> -1
+  | _, V8_6 -> 1
+  | V8_7, V8_7 -> 0
+  | V8_7, _ -> -1
+  | _, V8_7 -> 1
+  | Current, Current -> 0
 
 let version_strictly_greater v = version_compare !compat_version v > 0
 let version_less_or_equal v = not (version_strictly_greater v)
 
 let pr_version = function
-  | V8_2 -> "8.2"
-  | V8_3 -> "8.3"
-  | V8_4 -> "8.4"
-  | V8_5 -> "8.5"
+  | V8_6 -> "8.6"
+  | V8_7 -> "8.7"
   | Current -> "current"
 
 (* Translate *)
@@ -142,32 +95,24 @@ let beautify = ref false
 let beautify_file = ref false
 
 (* Silent / Verbose *)
-let silent = ref false
-let make_silent flag = silent := flag; ()
-let is_silent () = !silent
-let is_verbose () = not !silent
+let quiet = ref false
+let silently f x = with_option quiet f x
+let verbosely f x = without_option quiet f x
 
-let silently f x = with_option silent f x
-let verbosely f x = without_option silent f x
-
-let if_silent f x = if !silent then f x
-let if_verbose f x = if not !silent then f x
+let if_silent f x = if !quiet then f x
+let if_verbose f x = if not !quiet then f x
 
 let auto_intros = ref true
 let make_auto_intros flag = auto_intros := flag
-let is_auto_intros () = version_strictly_greater V8_2 && !auto_intros
+let is_auto_intros () = !auto_intros
 
 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
 
 (** [program_mode] tells that Program mode has been activated, either
     globally via [Set Program] or locally via the Program command prefix. *)
@@ -179,12 +124,6 @@ let warn = ref true
 let make_warn flag = warn := flag;  ()
 let if_warn f x = if !warn then f x
 
-(* The number of printed hypothesis in a goal *)
-
-let print_hyps_limit = ref (None : int option)
-let set_print_hyps_limit n = print_hyps_limit := n
-let print_hyps_limit () = !print_hyps_limit
-
 (* Flags for external tools *)
 
 let browser_cmd_fmt =
@@ -206,14 +145,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
@@ -222,15 +153,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 89760264..85aaf879 100644
--- a/lib/flags.mli
+++ b/lib/flags.mli
@@ -1,85 +1,70 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Global options of the system. *)
 
+(** Command-line flags  *)
+
 val boot : bool ref
-val load_init : bool ref
 
-val batch_mode : bool ref
-type compilation_mode = BuildVo | BuildVio | Vio2Vo
-val compilation_mode : compilation_mode ref
-val compilation_output_name : string option ref
+(** 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
 
-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
+(** Async-related flags *)
 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
 
 val profile : bool
 
-val print_emacs : bool ref
-val coqtop_ui : bool ref
-
-val xml_export : bool ref
-
+(* -ide_slave: printing will be more verbose, will affect stm caching *)
 val ide_slave : bool ref
-val ideslave_coqtop_flags : string option ref
-
-val time : bool ref
 
+(* development flag to detect race conditions, it should go away. *)
 val we_are_parsing : bool ref
 
+(* Set Printing All flag. For some reason it is a global flag *)
 val raw_print : bool ref
-val record_print : bool ref
+
+(* Univ print flag, never set anywere. Maybe should belong to Univ? *)
 val univ_print : bool ref
 
-type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | Current
+type compat_version = V8_6 | V8_7 | Current
 val compat_version : compat_version ref
 val version_compare : compat_version -> compat_version -> int
 val version_strictly_greater : compat_version -> bool
 val version_less_or_equal : compat_version -> bool
 val pr_version : compat_version -> string
 
+(* Beautify command line flags, should move to printing? *)
 val beautify : bool ref
 val beautify_file : bool ref
 
-val make_silent : bool -> unit
-val is_silent : unit -> bool
-val is_verbose : unit -> bool
+(* Coq quiet mode. Note that normal mode is called "verbose" here,
+   whereas [quiet] supresses normal output such as goals in coqtop *)
+val quiet : bool ref
 val silently : ('a -> 'b) -> 'a -> 'b
 val verbosely : ('a -> 'b) -> 'a -> 'b
 val if_silent : ('a -> unit) -> 'a -> unit
 val if_verbose : ('a -> unit) -> 'a -> unit
 
+(* Miscellaneus flags for vernac *)
 val make_auto_intros : bool -> unit
 val is_auto_intros : unit -> bool
 
@@ -90,14 +75,23 @@ 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
 
 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
@@ -111,10 +105,6 @@ val without_option : bool ref -> ('a -> 'b) -> 'a -> 'b
 (** Temporarily extends the reference to a list *)
 val with_extra_values : 'c list ref -> 'c list -> ('a -> 'b) -> 'a -> 'b
 
-(** If [None], no limit *)
-val set_print_hyps_limit : int option -> unit
-val print_hyps_limit : unit -> int option
-
 (** Options for external tools *)
 
 (** Returns string format for default browser to use from Coq or CoqIDE *)
@@ -126,27 +116,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
 
@@ -154,3 +134,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 ea0382a6..7a5b6f69 100644
--- a/lib/future.ml
+++ b/lib/future.ml
@@ -1,17 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(* 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 +26,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 +56,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 +71,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 +92,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 +107,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 +121,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 +138,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 -> Closure (fun () -> f v)
-  | Val (v, Some _) when pure -> Closure (fun () -> f v)
-  | 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 ?(greedy=true) ~pure x f =
-  let y = chain ~pure x f in
-  if is_over x && greedy then ignore(force ~pure y);
+           (Pp.str "A computation can be replaced only if is_exn holds.")
+
+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
@@ -204,16 +170,15 @@ let join kx =
 
 let sink kx = if is_val kx then ignore(join kx)
 
-let split2 ?greedy x =
-  chain ?greedy ~pure:true x (fun x -> fst x),
-  chain ?greedy ~pure:true x (fun x -> snd x)
+let split2 x =
+  chain x (fun x -> fst x), chain x (fun x -> snd x)
 
-let map2 ?greedy f x l =
+let map2 f x l =
   CList.map_i (fun i y ->
-    let xi = chain ?greedy ~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
+          CErrors.anomaly (Pp.str "Future.map2 length mismatch.")) in
     f xi y) 0 l
 
 let print f kx =
@@ -226,6 +191,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 114c5917..d9e8c87b 100644
--- a/lib/future.mli
+++ b/lib/future.mli
@@ -1,47 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(* 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
@@ -87,7 +59,7 @@ val from_val : ?fix_exn:fix_exn -> 'a -> 'a computation
    the value is not just the 'a but also the global system state *)
 val from_here : ?fix_exn:fix_exn -> 'a -> 'a computation
 
-(* To get the fix_exn of a computation and build a Tacexpr.declaration_hook.
+(* To get the fix_exn of a computation and build a Lemmas.declaration_hook.
  * When a future enters the environment a corresponding hook is run to perform
  * some work.  If this fails, then its failure has to be annotated with the
  * same state id that corresponds to the future computation end.  I.e. Qed
@@ -113,28 +85,17 @@ val is_exn : 'a computation -> bool
 val peek_val : 'a computation -> 'a option
 val uuid : 'a computation -> UUID.t
 
-(* [chain greedy pure c f] chains computation [c] with [f].
- * The [greedy] and [pure] parameters are 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.
- * [greedy]:
- *   The [greedy] parameter forces immediately the new computation if
- *   the old one is_over (Exn or Val). Defaults to true. *)
-val chain : ?greedy:bool -> 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
@@ -143,25 +104,14 @@ val join : 'a computation -> 'a
 val sink : 'a computation -> unit
 
 (*** Utility functions ************************************************* ***)
-val split2 : ?greedy:bool ->
+val split2 :
   ('a * 'b) computation -> 'a computation * 'b computation
-val map2 : ?greedy:bool ->
+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.std_ppcmds) -> 'a computation -> Pp.std_ppcmds
-
-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 print : ('a -> Pp.t) -> 'a computation -> Pp.t
 
-val customize_not_ready_msg : (string -> Pp.std_ppcmds) -> unit
-val customize_not_here_msg : (string -> Pp.std_ppcmds) -> 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 05c828d5..209d1b27 100644
--- a/lib/genarg.ml
+++ b/lib/genarg.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,7 +13,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
@@ -58,7 +60,7 @@ fun t1 t2 -> match t1, t2 with
   end
 | _ -> None
 
-let rec pr_genarg_type : type a b c. (a, b, c) genarg_type -> std_ppcmds = function
+let rec pr_genarg_type : type a b c. (a, b, c) genarg_type -> Pp.t = function
 | ListArg t -> pr_genarg_type t ++ spc () ++ str "list"
 | OptArg t -> pr_genarg_type t ++ spc () ++ str "opt"
 | PairArg (t1, t2) ->
@@ -159,7 +161,7 @@ let create_arg name =
   match ArgT.name name with
   | None -> ExtraArg (ArgT.create name)
   | Some _ ->
-    CErrors.anomaly (str "generic argument already declared: " ++ str name)
+    CErrors.anomaly (str "generic argument already declared: " ++ str name ++ str ".")
 
 let make0 = create_arg
 
@@ -172,19 +174,22 @@ sig
   val default : ('raw, 'glb, 'top) genarg_type -> ('raw, 'glb, 'top) obj option
 end
 
+let get_arg_tag = function
+| ExtraArg s -> s
+| _ -> assert false
+
 module Register (M : GenObj) =
 struct
   module GenMap = ArgMap(struct type ('r, 'g, 't) t = ('r, 'g, 't) M.obj end)
   let arg0_map = ref GenMap.empty
 
-  let register0 arg f = match arg with
-  | ExtraArg s ->
+  let register0 arg f =
+    let s = get_arg_tag arg in
     if GenMap.mem s !arg0_map then
-      let msg = str M.name ++ str " function already registered: " ++ str (ArgT.repr s) in
+      let msg = str M.name ++ str " function already registered: " ++ str (ArgT.repr s) ++ str "." in
       CErrors.anomaly msg
     else
       arg0_map := GenMap.add s (GenMap.Pack f) !arg0_map
-  | _ -> assert false
 
   let get_obj0 name =
     try
@@ -192,13 +197,11 @@ struct
     with Not_found ->
       match M.default (ExtraArg name) with
       | None ->
-        CErrors.anomaly (str M.name ++ str " function not found: " ++ str (ArgT.repr name))
+        CErrors.anomaly (str M.name ++ str " function not found: " ++ str (ArgT.repr name) ++ str ".")
       | Some obj -> obj
 
   (** For now, the following function is quite dummy and should only be applied
       to an extra argument type, otherwise, it will badly fail. *)
-  let obj t = match t with
-  | ExtraArg s -> get_obj0 s
-  | _ -> assert false
+  let obj t = get_obj0 @@ get_arg_tag t
 
 end
diff --git a/lib/genarg.mli b/lib/genarg.mli
index d7ad9b93..bb85f99e 100644
--- a/lib/genarg.mli
+++ b/lib/genarg.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Generic arguments used by the extension mechanisms of several Coq ASTs. *)
@@ -146,7 +148,7 @@ val abstract_argument_type_eq :
   ('a, 'l) abstract_argument_type -> ('b, 'l) abstract_argument_type ->
   ('a, 'b) CSig.eq option
 
-val pr_argument_type : argument_type -> Pp.std_ppcmds
+val pr_argument_type : argument_type -> Pp.t
 (** Print a human-readable representation for a given type. *)
 
 val genarg_tag : 'a generic_argument -> argument_type
@@ -157,6 +159,9 @@ val unquote : ('a, 'co) abstract_argument_type -> argument_type
 
   This is boilerplate code used here and there in the code of Coq. *)
 
+val get_arg_tag : ('a, 'b, 'c) genarg_type -> ('a, 'b, 'c) ArgT.tag
+(** Works only on base objects (ExtraArg), otherwise fails badly. *)
+
 module type GenObj =
 sig
   type ('raw, 'glb, 'top) obj
diff --git a/lib/hook.ml b/lib/hook.ml
index a370fe35..1e2a2f27 100644
--- a/lib/hook.ml
+++ b/lib/hook.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type 'a content =
diff --git a/lib/hook.mli b/lib/hook.mli
index 50347f33..67abd34d 100644
--- a/lib/hook.mli
+++ b/lib/hook.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module centralizes the notions of hooks. Hooks are pointers that are to
diff --git a/lib/lib.mllib b/lib/lib.mllib
index 8791f074..08918594 100644
--- a/lib/lib.mllib
+++ b/lib/lib.mllib
@@ -1,21 +1,29 @@
+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
+CProfile
 Future
+Spawn
+
+CAst
+DAst
+Genarg
+
 RemoteCounter
+Aux_file
+Envars
+CoqProject_file
diff --git a/lib/loc.ml b/lib/loc.ml
index 0f9864a9..1a09091b 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -1,15 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* 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,16 +29,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 ghost = {
-  fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
-  bp = 0; ep = 0; }
-
-let is_ghost loc = loc.ep = 0
+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;
@@ -51,26 +56,38 @@ let merge loc1 loc2 =
     bp = loc2.bp; ep = loc1.ep; }
   else loc2
 
+let merge_opt l1 l2 = match l1, l2 with
+  | None, None    -> None
+  | Some l , None -> Some l
+  | None, Some l  -> Some l
+  | Some l1, Some l2 -> Some (merge l1 l2)
+
+let finer l1 l2 = match l1, l2 with
+  | None, _    -> false
+  | Some l , None -> true
+  | Some l1, Some l2 -> l1.fname = l2.fname && merge l1 l2 = l2
+
 let unloc loc = (loc.bp, loc.ep)
 
-let dummy_loc = ghost
-let join_loc = merge
+let shift_loc kb kp loc = { loc with bp = loc.bp + kb ; ep = loc.ep + kp }
 
 (** Located type *)
+type 'a located = t option * 'a
 
-type 'a located = t * 'a
-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
+let tag ?loc x = loc, x
+let map f (l,x) = (l, f x)
 
 (** Exceptions *)
 
 let location : t Exninfo.t = Exninfo.make ()
 
 let add_loc e loc = Exninfo.add e location loc
-
 let get_loc e = Exninfo.get e location
 
-let raise loc e =
-  let info = Exninfo.add Exninfo.null location loc in
-  Exninfo.iraise (e, info)
+let raise ?loc e =
+  match loc with
+  | None     -> raise e
+  | Some loc ->
+    let info = Exninfo.add Exninfo.null location loc in
+    Exninfo.iraise (e, info)
+
diff --git a/lib/loc.mli b/lib/loc.mli
index c08e097a..23df1ebd 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -1,15 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {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 *)
@@ -18,14 +24,11 @@ type t = {
   ep : int; (** end position *)
 }
 
-type 'a located = t * 'a
-(** Embed a location in a type *)
-
 (** {5 Location manipulation} *)
 
 (** 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 *)
 
@@ -35,13 +38,18 @@ val unloc : t -> int * int
 val make_loc : int * int -> t
 (** Make a location out of its start and end position *)
 
-val ghost : t
-(** Dummy location *)
+val merge : t -> t -> t
+val merge_opt : t option -> t option -> t option
+(** Merge locations, usually generating the largest possible span *)
 
-val is_ghost : t -> bool
-(** Test whether the location is meaningful *)
+val finer : t option -> t option -> bool
+(** Answers [true] when the first location is more defined, or, when
+    both defined, included in the second one *)
 
-val merge : t -> t -> t
+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} *)
 
@@ -51,21 +59,15 @@ val add_loc : Exninfo.info -> t -> Exninfo.info
 val get_loc : Exninfo.info -> t option
 (** Retrieving the optional location of an exception *)
 
-val raise : t -> exn -> 'a
+val raise : ?loc:t -> exn -> 'a
 (** [raise loc e] is the same as [Pervasives.raise (add_loc e loc)]. *)
 
-(** {5 Location utilities} *)
-
-val located_fold_left : ('a -> 'b -> 'a) -> 'a -> 'b located -> 'a
-val located_iter2 : ('a -> 'b -> unit) -> 'a located -> 'b located -> unit
+(** {5 Objects with location information } *)
 
-val down_located : ('a -> 'b) -> 'a located -> 'b
-(** Projects out a located object *)
+type 'a located = t option * 'a
 
-(** {5 Backward compatibility} *)
-
-val dummy_loc : t
-(** Same as [ghost] *)
+val tag : ?loc:t -> 'a -> 'a located
+(** Embed a location in a type *)
 
-val join_loc : t -> t -> t
-(** Same as [merge] *)
+val map : ('a -> 'b) -> 'a located -> 'b located
+(** Modify an object carrying a location *)
diff --git a/lib/pp.ml b/lib/pp.ml
index f3bb4753..cd81f6e7 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -1,69 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-module Glue : sig
-
-  (** The [Glue] module implements a container data structure with
-      efficient concatenation. *)
-
-  type 'a t
-
-  val atom : 'a -> 'a t
-  val glue : 'a t -> 'a t -> 'a t
-  val empty : 'a t
-  val is_empty : 'a t -> bool
-  val iter : ('a -> unit) -> 'a t -> unit
-
-end = struct
-
-  type 'a t = GEmpty | GLeaf of 'a | GNode of 'a t * 'a t
-
-  let atom x = GLeaf x
-
-  let glue x y =
-    match x, y with
-    | GEmpty, _ -> y
-    | _, GEmpty -> x
-    | _, _ -> GNode (x,y)
-
-  let empty = GEmpty
-
-  let is_empty x = x = GEmpty
-
-  let rec iter f = function
-    | GEmpty -> ()
-    | GLeaf x -> f x
-    | GNode (x,y) -> iter f x; iter f y
-
-end
-
-module Tag :
-sig
-  type t 
-  type 'a key
-  val create : string -> 'a key
-  val inj : 'a -> 'a key -> t
-  val prj : t -> 'a key -> 'a option
-end =
-struct
-
-module Dyn = Dyn.Make(struct end)
-
-type t = Dyn.t
-type 'a key = 'a Dyn.tag
-let create = Dyn.create
-let inj = Dyn.Easy.inj
-let prj = Dyn.Easy.prj
-
-end
-
-open Pp_control
-
 (* The different kinds of blocks are:
    \begin{description}
    \item[hbox:] Horizontal block no line breaking;
@@ -72,54 +16,37 @@ open Pp_control
       this block is small enough to fit on a single line
    \item[hovbox:] Horizontal or Vertical block: breaks lead to new line
       only when necessary to print the content of the block
-   \item[tbox:] Tabulation block: go to tabulation marks and no line breaking
-      (except if no mark yet on the reste of the line)
    \end{description}
  *)
 
+type pp_tag = string
+
 type block_type =
-  | Pp_hbox of int
-  | Pp_vbox of int
-  | Pp_hvbox of int
+  | Pp_hbox   of int
+  | Pp_vbox   of int
+  | Pp_hvbox  of int
   | Pp_hovbox of int
-  | Pp_tbox
 
-type str_token =
-| Str_def of string
-| Str_len of string * int (** provided length *)
-
-type 'a ppcmd_token =
-  | Ppcmd_print of 'a
-  | Ppcmd_box of block_type * ('a ppcmd_token Glue.t)
+type doc_view =
+  | Ppcmd_empty
+  | Ppcmd_string of string
+  | Ppcmd_glue of doc_view list
+  | Ppcmd_box  of block_type * doc_view
+  | Ppcmd_tag of pp_tag * doc_view
+  (* Are those redundant? *)
   | Ppcmd_print_break of int * int
-  | Ppcmd_set_tab
-  | Ppcmd_print_tbreak of int * int
-  | Ppcmd_white_space of int
   | Ppcmd_force_newline
-  | Ppcmd_print_if_broken
-  | Ppcmd_open_box of block_type
-  | Ppcmd_close_box
-  | Ppcmd_close_tbox
   | Ppcmd_comment of string list
-  | Ppcmd_open_tag of Tag.t
-  | Ppcmd_close_tag
-
-type 'a ppdir_token =
-  | Ppdir_ppcmds of 'a ppcmd_token Glue.t
-  | Ppdir_print_newline
-  | Ppdir_print_flush
 
-type ppcmd = str_token ppcmd_token
+(* Following discussion on #390, we play on the safe side and make the
+   internal representation opaque here. *)
+type t = doc_view
 
-type std_ppcmds = ppcmd Glue.t
+type std_ppcmds = t
+[@@ocaml.deprecated "alias of Pp.t"]
 
-type 'a ppdirs = 'a ppdir_token Glue.t
-
-let (++) = Glue.glue
-
-let app = Glue.glue
-
-let is_empty g = Glue.is_empty g
+let repr x = x
+let unrepr x = x
 
 (* Compute length of an UTF-8 encoded string
    Rem 1 : utf8_length <= String.length (equal if pure ascii)
@@ -157,25 +84,43 @@ let utf8_length s =
   done ;
   !cnt
 
+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
+
+let (++) = app
+
 (* formatting commands *)
-let str s = Glue.atom(Ppcmd_print (Str_def s))
-let stras (i, s) = Glue.atom(Ppcmd_print (Str_len (s, i)))
-let brk (a,b) = Glue.atom(Ppcmd_print_break (a,b))
-let tbrk (a,b) = Glue.atom(Ppcmd_print_tbreak (a,b))
-let tab () = Glue.atom(Ppcmd_set_tab)
-let fnl () = Glue.atom(Ppcmd_force_newline)
-let pifb () = Glue.atom(Ppcmd_print_if_broken)
-let ws n = Glue.atom(Ppcmd_white_space n)
-let comment l = Glue.atom(Ppcmd_comment l)
+let str s     = Ppcmd_string s
+let brk (a,b) = Ppcmd_print_break (a,b)
+let fnl  ()   = Ppcmd_force_newline
+let ws n      = Ppcmd_print_break (n,0)
+let comment l = Ppcmd_comment l
 
 (* derived commands *)
-let mt () = Glue.empty
-let spc () = Glue.atom(Ppcmd_print_break (1,0))
-let cut () = Glue.atom(Ppcmd_print_break (0,0))
-let align () = Glue.atom(Ppcmd_print_break (0,0))
-let int n = str (string_of_int n)
-let real r = str (string_of_float r)
-let bool b = str (string_of_bool b)
+let mt    () = Ppcmd_empty
+let spc   () = Ppcmd_print_break (1,0)
+let cut   () = Ppcmd_print_break (0,0)
+let align () = Ppcmd_print_break (0,0)
+let int   n  = str (string_of_int n)
+let real  r  = str (string_of_float r)
+let bool  b  = str (string_of_bool b)
+
+(* XXX: To Remove *)
 let strbrk s =
   let rec aux p n =
     if n < String.length s then
@@ -184,50 +129,18 @@ let strbrk s =
         else str (String.sub s p (n-p)) :: spc () :: aux (n+1) (n+1)
       else aux p (n + 1)
     else if p = n then [] else [str (String.sub s p (n-p))]
-  in List.fold_left (++) Glue.empty (aux 0 0)
-
-let pr_loc_pos loc =
-  if Loc.is_ghost loc then (str"<unknown>")
-  else
-    let loc = Loc.unloc loc in
-    int (fst loc) ++ str"-" ++ int (snd loc)
-
-let pr_loc loc =
-  if Loc.is_ghost loc then str"<unknown>" ++ fnl ()
-  else
-    let fname = loc.Loc.fname in
-    if CString.equal fname "" then
-      Loc.(str"Toplevel input, characters " ++ int loc.bp ++
-	   str"-" ++ int loc.ep ++ str":" ++ fnl ())
-    else
-      Loc.(str"File " ++ str "\"" ++ str fname ++ str "\"" ++
-	   str", line " ++ int loc.line_nb ++ str", characters " ++
-	   int (loc.bp-loc.bol_pos) ++ str"-" ++ int (loc.ep-loc.bol_pos) ++
-	   str":" ++ fnl())
+  in Ppcmd_glue (aux 0 0)
 
-let ismt = is_empty
+let ismt = function | Ppcmd_empty -> true | _ -> false
 
 (* boxing commands *)
-let h n s = Glue.atom(Ppcmd_box(Pp_hbox n,s))
-let v n s = Glue.atom(Ppcmd_box(Pp_vbox n,s))
-let hv n s = Glue.atom(Ppcmd_box(Pp_hvbox n,s))
-let hov n s = Glue.atom(Ppcmd_box(Pp_hovbox n,s))
-let t s = Glue.atom(Ppcmd_box(Pp_tbox,s))
-
-(* Opening and closing of boxes *)
-let hb n = Glue.atom(Ppcmd_open_box(Pp_hbox n))
-let vb n = Glue.atom(Ppcmd_open_box(Pp_vbox n))
-let hvb n = Glue.atom(Ppcmd_open_box(Pp_hvbox n))
-let hovb n = Glue.atom(Ppcmd_open_box(Pp_hovbox n))
-let tb () = Glue.atom(Ppcmd_open_box Pp_tbox)
-let close () = Glue.atom(Ppcmd_close_box)
-let tclose () = Glue.atom(Ppcmd_close_tbox)
+let h   n s = Ppcmd_box(Pp_hbox n,s)
+let v   n s = Ppcmd_box(Pp_vbox n,s)
+let hv  n s = Ppcmd_box(Pp_hvbox n,s)
+let hov n s = Ppcmd_box(Pp_hovbox n,s)
 
 (* Opening and closed of tags *)
-let open_tag t = Glue.atom(Ppcmd_open_tag t)
-let close_tag () = Glue.atom(Ppcmd_close_tag)
-let tag t s = open_tag t ++ s ++ close_tag ()
-let eval_ppcmds l = l
+let tag t s = Ppcmd_tag(t,s)
 
 (* In new syntax only double quote char is escaped by repeating it *)
 let escape_string s =
@@ -254,71 +167,34 @@ let rec pr_com ft s =
       Some s2 -> Format.pp_force_newline ft (); pr_com ft s2
     | None -> ()
 
-type tag_handler = Tag.t -> Format.tag
-
 (* pretty printing functions *)
-let pp_dirs ?pp_tag ft =
-  let pp_open_box = function
+let pp_with ft pp =
+  let cpp_open_box = function
     | Pp_hbox n   -> Format.pp_open_hbox ft ()
     | Pp_vbox n   -> Format.pp_open_vbox ft n
     | Pp_hvbox n  -> Format.pp_open_hvbox ft n
     | Pp_hovbox n -> Format.pp_open_hovbox ft n
-    | Pp_tbox     -> Format.pp_open_tbox ft ()
   in
-  let rec pp_cmd = function
-    | Ppcmd_print tok         ->
-        begin match tok with
-        | Str_def s ->
-          let n = utf8_length s in
-          Format.pp_print_as ft n s
-        | Str_len (s, n) ->
-          Format.pp_print_as ft n s
-        end
-    | Ppcmd_box(bty,ss)       -> (* Prevent evaluation of the stream! *)
-        pp_open_box bty ;
-        if not (Format.over_max_boxes ()) then Glue.iter pp_cmd ss;
-        Format.pp_close_box ft ()
-    | Ppcmd_open_box bty      -> pp_open_box bty
-    | Ppcmd_close_box         -> Format.pp_close_box ft ()
-    | Ppcmd_close_tbox        -> Format.pp_close_tbox ft ()
-    | Ppcmd_white_space n     -> Format.pp_print_break ft n 0
-    | Ppcmd_print_break(m,n)  -> Format.pp_print_break ft m n
-    | Ppcmd_set_tab           -> Format.pp_set_tab ft ()
-    | Ppcmd_print_tbreak(m,n) -> Format.pp_print_tbreak ft m n
-    | Ppcmd_force_newline     -> Format.pp_force_newline ft ()
-    | Ppcmd_print_if_broken   -> Format.pp_print_if_newline ft ()
+  let rec pp_cmd = let open Format in function
+    | Ppcmd_empty             -> ()
+    | Ppcmd_glue sl           -> List.iter pp_cmd sl
+    | Ppcmd_string str        -> let n = utf8_length str in
+                                 pp_print_as ft n str
+    | Ppcmd_box(bty,ss)       -> cpp_open_box bty ;
+                                 if not (over_max_boxes ()) then pp_cmd ss;
+                                 pp_close_box ft ()
+    | Ppcmd_print_break(m,n)  -> pp_print_break ft m n
+    | Ppcmd_force_newline     -> pp_force_newline ft ()
     | Ppcmd_comment coms      -> List.iter (pr_com ft) coms
-    | Ppcmd_open_tag tag ->
-      begin match pp_tag with
-      | None -> ()
-      | Some f -> Format.pp_open_tag ft (f tag)
-      end
-    | Ppcmd_close_tag ->
-      begin match pp_tag with
-      | None -> ()
-      | Some _ -> Format.pp_close_tag ft ()
-      end
+    | Ppcmd_tag(tag, s)       -> pp_open_tag  ft tag;
+                                 pp_cmd s;
+                                 pp_close_tag ft ()
   in
-  let pp_dir = function
-    | Ppdir_ppcmds cmdstream -> Glue.iter pp_cmd cmdstream
-    | Ppdir_print_newline    -> Format.pp_print_newline ft ()
-    | Ppdir_print_flush      -> Format.pp_print_flush ft ()
-  in
-  fun (dirstream : _ ppdirs) ->
-    try
-      Glue.iter pp_dir dirstream
-    with reraise ->
-      let reraise = Backtrace.add_backtrace reraise in
-      let () = Format.pp_print_flush ft () in
-      Exninfo.iraise reraise
-
-(* pretty printing functions WITHOUT FLUSH *)
-let pp_with ?pp_tag ft strm =
-  pp_dirs ?pp_tag ft (Glue.atom (Ppdir_ppcmds strm))
-
-(* pretty printing functions WITH FLUSH *)
-let msg_with ?pp_tag ft strm =
-  pp_dirs ?pp_tag ft (Glue.atom(Ppdir_ppcmds strm) ++ Glue.atom(Ppdir_print_flush))
+  try pp_cmd pp
+  with reraise ->
+    let reraise = Backtrace.add_backtrace reraise in
+    let () = Format.pp_print_flush ft () in
+    Exninfo.iraise reraise
 
 (* If mixing some output and a goal display, please use msg_warning,
    so that interfaces (proofgeneral for example) can easily dispatch
@@ -326,7 +202,7 @@ let msg_with ?pp_tag ft strm =
 
 (** Output to a string formatter *)
 let string_of_ppcmds c =
-  Format.fprintf Format.str_formatter "@[%a@]" (msg_with ?pp_tag:None) c;
+  Format.fprintf Format.str_formatter "@[%a@]" pp_with c;
   Format.flush_str_formatter ()
 
 (* Copy paste from Util *)
@@ -334,6 +210,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
@@ -353,29 +230,31 @@ let pr_nth n =
 
 (* [prlist pr [a ; ... ; c]] outputs [pr a ++ ... ++ pr c] *)
 
-let prlist pr l = List.fold_left (fun x e -> x ++ pr e) Glue.empty l
+let prlist pr l = Ppcmd_glue (List.map pr l)
 
 (* unlike all other functions below, [prlist] works lazily.
    if a strict behavior is needed, use [prlist_strict] instead.
    evaluation is done from left to right. *)
 
-let prlist_sep_lastsep no_empty sep lastsep elem =
-  let rec start = function
-    |[] -> mt ()
-    |[e] -> elem e
-    |h::t -> let e = elem h in
-        if no_empty && ismt e then start t else
-          let rec aux = function
-            |[] -> mt ()
-            |h::t ->
-               let e = elem h and r = aux t in
-                 if no_empty && ismt e then r else
-                   if ismt r
-                   then let s = lastsep () in s ++ e
-                   else let s = sep () in s ++ e ++ r
-          in let r = aux t in e ++ r
-  in start
-
+let prlist_sep_lastsep no_empty sep_thunk lastsep_thunk elem l =
+  let sep = sep_thunk () in
+  let lastsep = lastsep_thunk () in
+  let elems = List.map elem l in
+  let filtered_elems =
+    if no_empty then
+      List.filter (fun e -> not (ismt e)) elems
+    else
+      elems
+  in
+  let rec insert_seps es =
+    match es with
+    | []     -> mt ()
+    | [e]    -> e
+    | h::[e] -> h ++ lastsep ++ e
+    | h::t   -> h ++ sep ++ insert_seps t
+  in
+  insert_seps filtered_elems
+  
 let prlist_strict pr l = prlist_sep_lastsep true mt mt pr l
 (* [prlist_with_sep sep pr [a ; ... ; c]] outputs
    [pr a ++ sep() ++ ... ++ sep() ++ pr c] *)
@@ -418,4 +297,3 @@ let prvect_with_sep sep elem v = prvecti_with_sep sep (fun _ -> elem) v
 let prvect elem v = prvect_with_sep mt elem v
 
 let surround p = hov 1 (str"(" ++ p ++ str")")
-
diff --git a/lib/pp.mli b/lib/pp.mli
index 8342a983..f3a0a29b 100644
--- a/lib/pp.mli
+++ b/lib/pp.mli
@@ -1,179 +1,191 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(** Pretty-printers. *)
-
-type std_ppcmds
-
-(** {6 Formatting commands} *)
-
-val str   : string -> std_ppcmds
-val stras : int * string -> std_ppcmds
-val brk   : int * int -> std_ppcmds
-val tbrk  : int * int -> std_ppcmds
-val tab   : unit -> std_ppcmds
-val fnl   : unit -> std_ppcmds
-val pifb  : unit -> std_ppcmds
-val ws    : int -> std_ppcmds
-val mt    : unit -> std_ppcmds
-val ismt  : std_ppcmds -> bool
-
-val comment  : string list -> std_ppcmds
-
-(** {6 Manipulation commands} *)
+(** Coq document type. *)
+
+(** Pretty printing guidelines ******************************************)
+(*                                                                      *)
+(* `Pp.t` is the main pretty printing document type                     *)
+(* in the Coq system. Documents are composed laying out boxes, and      *)
+(* users can add arbitrary tag metadata that backends are free          *)
+(* to interpret.                                                        *)
+(*                                                                      *)
+(* The datatype has a public view to allow serialization or advanced    *)
+(* uses, however regular users are _strongly_ warned againt its use,    *)
+(* they should instead rely on the available functions below.           *)
+(*                                                                      *)
+(* Box order and number is indeed an important factor. Try to create    *)
+(* a proper amount of boxes. The `++` operator provides "efficient"     *)
+(* concatenation, but using the list constructors is usually preferred. *)
+(*                                                                      *)
+(* That is to say, this:                                                *)
+(*                                                                      *)
+(* `hov [str "Term"; hov (pr_term t); str "is defined"]`                *)
+(*                                                                      *)
+(* is preferred to:                                                     *)
+(*                                                                      *)
+(* `hov (str "Term" ++ hov (pr_term t) ++ str "is defined")`            *)
+(*                                                                      *)
+(************************************************************************)
 
-val app : std_ppcmds -> std_ppcmds -> std_ppcmds
-(** Concatenation. *)
+(* XXX: Improve and add attributes *)
+type pp_tag = string
 
-val (++) : std_ppcmds -> std_ppcmds -> std_ppcmds
-(** Infix alias for [app]. *)
+(* Following discussion on #390, we play on the safe side and make the
+   internal representation opaque here. *)
+type t
 
-val eval_ppcmds : std_ppcmds -> std_ppcmds
-(** Force computation. *)
+type std_ppcmds = t
+[@@ocaml.deprecated "alias of Pp.t"]
 
-val is_empty : std_ppcmds -> bool
-(** Test emptyness. *)
+type block_type =
+  | Pp_hbox   of int
+  | Pp_vbox   of int
+  | Pp_hvbox  of int
+  | Pp_hovbox of int
 
-(** {6 Derived commands} *)
+type doc_view =
+  | Ppcmd_empty
+  | Ppcmd_string of string
+  | Ppcmd_glue of t list
+  | Ppcmd_box  of block_type * t
+  | Ppcmd_tag  of pp_tag * t
+  (* Are those redundant? *)
+  | Ppcmd_print_break of int * int
+  | Ppcmd_force_newline
+  | Ppcmd_comment of string list
 
-val spc : unit -> std_ppcmds
-val cut : unit -> std_ppcmds
-val align : unit -> std_ppcmds
-val int : int -> std_ppcmds
-val real : float -> std_ppcmds
-val bool : bool -> std_ppcmds
-val qstring : string -> std_ppcmds
-val qs : string -> std_ppcmds
-val quote : std_ppcmds -> std_ppcmds
-val strbrk : string -> std_ppcmds
+val repr   : t -> doc_view
+val unrepr : doc_view -> t
 
-(** {6 Boxing commands} *)
+(** {6 Formatting commands} *)
 
-val h : int -> std_ppcmds -> std_ppcmds
-val v : int -> std_ppcmds -> std_ppcmds
-val hv : int -> std_ppcmds -> std_ppcmds
-val hov : int -> std_ppcmds -> std_ppcmds
-val t : std_ppcmds -> std_ppcmds
+val str   : string -> t
+val brk   : int * int -> t
+val fnl   : unit -> t
+val ws    : int -> t
+val mt    : unit -> t
+val ismt  : t -> bool
 
-(** {6 Opening and closing of boxes} *)
+val comment  : string list -> t
 
-val hb : int -> std_ppcmds
-val vb : int -> std_ppcmds
-val hvb : int -> std_ppcmds
-val hovb : int -> std_ppcmds
-val tb : unit -> std_ppcmds
-val close : unit -> std_ppcmds
-val tclose : unit -> std_ppcmds
+(** {6 Manipulation commands} *)
 
-(** {6 Opening and closing of tags} *)
+val app : t -> t -> t
+(** Concatenation. *)
 
-module Tag :
-sig
-  type t
-  (** Type of tags. Tags are dynamic types comparable to {Dyn.t}. *)
+val seq : t list -> t
+(** Multi-Concatenation. *)
 
-  type 'a key
-  (** Keys used to inject tags *)
+val (++) : t -> t -> t
+(** Infix alias for [app]. *)
 
-  val create : string -> 'a key
-  (** Create a key with the given name. Two keys cannot share the same name, if
-      ever this is the case this function raises an assertion failure. *)
+(** {6 Derived commands} *)
 
-  val inj : 'a -> 'a key -> t
-  (** Inject an object into a tag. *)
+val spc : unit -> t
+val cut : unit -> t
+val align : unit -> t
+val int : int -> t
+val real : float -> t
+val bool : bool -> t
+val qstring : string -> t
+val qs : string -> t
+val quote : t -> t
+val strbrk : string -> t
 
-  val prj : t -> 'a key -> 'a option
-  (** Project an object from a tag. *)
-end
+(** {6 Boxing commands} *)
 
-val tag : Tag.t -> std_ppcmds -> std_ppcmds
-val open_tag : Tag.t -> std_ppcmds
-val close_tag : unit -> std_ppcmds
+val h : int -> t -> t
+val v : int -> t -> t
+val hv : int -> t -> t
+val hov : int -> t -> t
 
-(** {6 Utilities} *)
+(** {6 Tagging} *)
 
-val string_of_ppcmds : std_ppcmds -> string
+val tag : pp_tag -> t -> t
 
 (** {6 Printing combinators} *)
 
-val pr_comma : unit -> std_ppcmds
+val pr_comma : unit -> t
 (** Well-spaced comma. *)
 
-val pr_semicolon : unit -> std_ppcmds
+val pr_semicolon : unit -> t
 (** Well-spaced semicolon. *)
 
-val pr_bar : unit -> std_ppcmds
+val pr_bar : unit -> t
 (** Well-spaced pipe bar. *)
 
-val pr_arg : ('a -> std_ppcmds) -> 'a -> std_ppcmds
+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. *)
 
-val pr_non_empty_arg : ('a -> std_ppcmds) -> 'a -> std_ppcmds
+val pr_non_empty_arg : ('a -> t) -> 'a -> t
 (** Adds a space in front of its argument if non empty. *)
 
-val pr_opt : ('a -> std_ppcmds) -> 'a option -> std_ppcmds
+val pr_opt : ('a -> t) -> 'a option -> t
 (** Inner object preceded with a space if [Some], nothing otherwise. *)
 
-val pr_opt_no_spc : ('a -> std_ppcmds) -> 'a option -> std_ppcmds
+val pr_opt_no_spc : ('a -> t) -> 'a option -> t
 (** Same as [pr_opt] but without the leading space. *)
 
-val pr_nth : int -> std_ppcmds
+val pr_nth : int -> t
 (** Ordinal number with the correct suffix (i.e. "st", "nd", "th", etc.). *)
 
-val prlist : ('a -> std_ppcmds) -> 'a list -> std_ppcmds
+val prlist : ('a -> t) -> 'a list -> t
 (** Concatenation of the list contents, without any separator.
 
     Unlike all other functions below, [prlist] works lazily. If a strict
     behavior is needed, use [prlist_strict] instead. *)
 
-val prlist_strict :  ('a -> std_ppcmds) -> 'a list -> std_ppcmds
+val prlist_strict :  ('a -> t) -> 'a list -> t
 (** Same as [prlist], but strict. *)
 
 val prlist_with_sep :
-   (unit -> std_ppcmds) -> ('a -> std_ppcmds) -> 'a list -> std_ppcmds
+   (unit -> t) -> ('a -> t) -> 'a list -> t
 (** [prlist_with_sep sep pr [a ; ... ; c]] outputs
-    [pr a ++ sep() ++ ... ++ sep() ++ pr c]. *)
+    [pr a ++ sep () ++ ... ++ sep () ++ pr c]. 
+    where the thunk sep is memoized, rather than being called each place 
+     its result is used.
+*)
 
-val prvect : ('a -> std_ppcmds) -> 'a array -> std_ppcmds
+val prvect : ('a -> t) -> 'a array -> t
 (** As [prlist], but on arrays. *)
 
-val prvecti : (int -> 'a -> std_ppcmds) -> 'a array -> std_ppcmds
+val prvecti : (int -> 'a -> t) -> 'a array -> t
 (** Indexed version of [prvect]. *)
 
 val prvect_with_sep :
-   (unit -> std_ppcmds) -> ('a -> std_ppcmds) -> 'a array -> std_ppcmds
+   (unit -> t) -> ('a -> t) -> 'a array -> t
 (** As [prlist_with_sep], but on arrays. *)
 
 val prvecti_with_sep :
-   (unit -> std_ppcmds) -> (int -> 'a -> std_ppcmds) -> 'a array -> std_ppcmds
+   (unit -> t) -> (int -> 'a -> t) -> 'a array -> t
 (** Indexed version of [prvect_with_sep]. *)
 
-val pr_enum : ('a -> std_ppcmds) -> 'a list -> std_ppcmds
+val pr_enum : ('a -> t) -> 'a list -> t
 (** [pr_enum pr [a ; b ; ... ; c]] outputs
     [pr a ++ str "," ++ pr b ++ str "," ++ ... ++ str "and" ++ pr c]. *)
 
-val pr_sequence : ('a -> std_ppcmds) -> 'a list -> std_ppcmds
+val pr_sequence : ('a -> t) -> 'a list -> t
 (** Sequence of objects separated by space (unless an element is empty). *)
 
-val surround : std_ppcmds -> std_ppcmds
+val surround : t -> t
 (** Surround with parenthesis. *)
 
-val pr_vertical_list : ('b -> std_ppcmds) -> 'b list -> std_ppcmds
-
-val pr_loc : Loc.t -> std_ppcmds
-
-(** {6 Low-level pretty-printing functions with and without flush} *)
+val pr_vertical_list : ('b -> t) -> 'b list -> t
 
-(** FIXME: These ignore the logging settings and call [Format] directly *)
-type tag_handler = Tag.t -> Format.tag
+(** {6 Main renderers, to formatter and to string } *)
 
-(** [msg_with ?pp_tag fmt pp] Print [pp] to [fmt] and flush [fmt]  *)
-val msg_with : ?pp_tag:tag_handler -> Format.formatter -> std_ppcmds -> unit
+(** [pp_with fmt pp] Print [pp] to [fmt] and don't flush [fmt]  *)
+val pp_with          : Format.formatter -> t -> unit
 
-(** [msg_with ?pp_tag fmt pp] Print [pp] to [fmt] and don't flush [fmt]  *)
-val pp_with  : ?pp_tag:tag_handler -> Format.formatter -> std_ppcmds -> unit
+val string_of_ppcmds : t -> string
diff --git a/lib/pp_control.ml b/lib/pp_control.ml
deleted file mode 100644
index 890ffe0a..00000000
--- a/lib/pp_control.ml
+++ /dev/null
@@ -1,93 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* Parameters of pretty-printing *)
-
-type pp_global_params = {
-  margin : int;
-  max_indent : int;
-  max_depth : int;
-  ellipsis : string }
-
-(* Default parameters of pretty-printing *)
-
-let dflt_gp = {
-  margin     = 78;
-  max_indent = 50;
-  max_depth  = 50;
-  ellipsis   = "..." }
-
-(* A deeper pretty-printer to print proof scripts *)
-
-let deep_gp = {
-  margin     = 78;
-  max_indent = 50;
-  max_depth  = 10000;
-  ellipsis   = "..." }
-
-(* set_gp : Format.formatter -> pp_global_params -> unit
- * set the parameters of a formatter *)
-
-let set_gp ft gp =
-  Format.pp_set_margin ft gp.margin ;
-  Format.pp_set_max_indent ft gp.max_indent ;
-  Format.pp_set_max_boxes ft gp.max_depth ;
-  Format.pp_set_ellipsis_text ft gp.ellipsis
-
-let set_dflt_gp ft = set_gp ft dflt_gp
-
-let get_gp ft =
-  { margin = Format.pp_get_margin ft ();
-    max_indent = Format.pp_get_max_indent ft ();
-    max_depth = Format.pp_get_max_boxes ft ();
-    ellipsis = Format.pp_get_ellipsis_text ft () }
-
-(* with_fp : 'a pp_formatter_params -> Format.formatter
- * returns of formatter for given formatter functions *)
-
-let with_fp chan out_function flush_function =
-  let ft = Format.make_formatter out_function flush_function in
-  Format.pp_set_formatter_out_channel ft chan;
-  ft
-
-(* Output on a channel ch *)
-
-let with_output_to ch =
-  let ft = with_fp ch (output ch) (fun () -> flush ch) in
-  set_gp ft deep_gp;
-  ft
-
-let std_ft = ref Format.std_formatter
-let _ = set_dflt_gp !std_ft
-
-let err_ft = ref Format.err_formatter
-let _ = set_gp !err_ft deep_gp
-
-let deep_ft = ref (with_output_to stdout)
-let _ = set_gp !deep_ft deep_gp
-
-(* For parametrization through vernacular *)
-let default = Format.pp_get_max_boxes !std_ft ()
-let default_margin = Format.pp_get_margin !std_ft ()
-
-let get_depth_boxes () = Some (Format.pp_get_max_boxes !std_ft ())
-let set_depth_boxes v =
-  Format.pp_set_max_boxes !std_ft (match v with None -> default | Some v -> v)
-
-let get_margin () = Some (Format.pp_get_margin !std_ft ())
-let set_margin v =
-  let v = match v with None -> default_margin | Some v -> v in
-  Format.pp_set_margin Format.str_formatter v;
-  Format.pp_set_margin !std_ft v;
-  Format.pp_set_margin !deep_ft v;
-  (* Heuristic, based on usage: the column on the right of max_indent
-     column is 20% of width, capped to 30 characters *)
-  let m = max (64 * v / 100) (v-30) in
-  Format.pp_set_max_indent Format.str_formatter m;
-  Format.pp_set_max_indent !std_ft m;
-  Format.pp_set_max_indent !deep_ft m
diff --git a/lib/pp_control.mli b/lib/pp_control.mli
deleted file mode 100644
index d26f89eb..00000000
--- a/lib/pp_control.mli
+++ /dev/null
@@ -1,38 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Parameters of pretty-printing. *)
-
-type pp_global_params = {
-  margin : int;
-  max_indent : int;
-  max_depth : int;
-  ellipsis : string }
-
-val dflt_gp : pp_global_params
-val deep_gp : pp_global_params
-val set_gp : Format.formatter -> pp_global_params -> unit
-val set_dflt_gp : Format.formatter -> unit
-val get_gp : Format.formatter -> pp_global_params
-
-
-(** {6 Output functions of pretty-printing. } *)
-
-val with_output_to : out_channel -> Format.formatter
-
-val std_ft : Format.formatter ref
-val err_ft : Format.formatter ref
-val deep_ft : Format.formatter ref
-
-(** {6 For parametrization through vernacular. } *)
-
-val set_depth_boxes : int option -> unit
-val get_depth_boxes : unit -> int option
-
-val set_margin : int option -> unit
-val get_margin : unit -> int option
diff --git a/lib/ppstyle.ml b/lib/ppstyle.ml
deleted file mode 100644
index aa47c516..00000000
--- a/lib/ppstyle.ml
+++ /dev/null
@@ -1,73 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-module String = CString
-
-type t = string
-(** We use the concatenated string, with dots separating each string. We
-    forbid the use of dots in the strings. *)
-
-let tags : Terminal.style option String.Map.t ref = ref String.Map.empty
-
-let make ?style tag =
-  let check s = if String.contains s '.' then invalid_arg "Ppstyle.make" in
-  let () = List.iter check tag in
-  let name = String.concat "." tag in
-  let () = assert (not (String.Map.mem name !tags)) in
-  let () = tags := String.Map.add name style !tags in
-  name
-
-let repr t = String.split '.' t
-
-let get_style tag =
-  try String.Map.find tag !tags with Not_found -> assert false
-
-let set_style tag st =
-  try tags := String.Map.update tag st !tags with Not_found -> assert false
-
-let clear_styles () =
-  tags := String.Map.map (fun _ -> None) !tags
-
-let dump () = String.Map.bindings !tags
-
-let parse_config s =
-  let styles = Terminal.parse s in
-  let set accu (name, st) =
-    try String.Map.update name (Some st) accu with Not_found -> accu
-  in
-  tags := List.fold_left set !tags styles
-
-let tag = Pp.Tag.create "ppstyle"
-
-(** Default tag is to reset everything *)
-let default = Terminal.({
-  fg_color = Some `DEFAULT;
-  bg_color = Some `DEFAULT;
-  bold = Some false;
-  italic = Some false;
-  underline = Some false;
-  negative = Some false;
-})
-
-let empty = Terminal.make ()
-
-let error_tag =
-  let style = Terminal.make ~bold:true ~fg_color:`WHITE ~bg_color:`RED () in
-  make ~style ["message"; "error"]
-
-let warning_tag =
-  let style = Terminal.make ~bold:true ~fg_color:`WHITE ~bg_color:`YELLOW () in
-  make ~style ["message"; "warning"]
-
-let debug_tag =
-  let style = Terminal.make ~bold:true ~fg_color:`WHITE ~bg_color:`MAGENTA () in
-  make ~style ["message"; "debug"]
-
-let pp_tag t = match Pp.Tag.prj t tag with
-| None -> ""
-| Some key -> key
diff --git a/lib/ppstyle.mli b/lib/ppstyle.mli
deleted file mode 100644
index d9fd7576..00000000
--- a/lib/ppstyle.mli
+++ /dev/null
@@ -1,63 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Highlighting of printers. Used for pretty-printing terms that should be
-    displayed on a color-capable terminal. *)
-
-(** {5 Style tags} *)
-
-type t = string
-
-(** Style tags *)
-
-val make : ?style:Terminal.style -> string list -> t
-(** Create a new tag with the given name. Each name must be unique. The optional
-    style is taken as the default one. *)
-
-val repr : t -> string list
-(** Gives back the original name of the style tag where each string has been
-    concatenated and separated with a dot. *)
-
-val tag : t Pp.Tag.key
-(** An annotation for styles *)
-
-(** {5 Manipulating global styles} *)
-
-val get_style : t -> Terminal.style option
-(** Get the style associated to a tag. *)
-
-val set_style : t -> Terminal.style option -> unit
-(** Set a style associated to a tag. *)
-
-val clear_styles : unit -> unit
-(** Clear all styles. *)
-
-val parse_config : string -> unit
-(** Add all styles from the given string as parsed by {!Terminal.parse}.
-    Unregistered tags are ignored. *)
-
-val dump : unit -> (t * Terminal.style option) list
-(** Recover the list of known tags together with their current style. *)
-
-(** {5 Color output} *)
-
-val pp_tag : Pp.tag_handler
-(** Returns the name of a style tag that is understandable by the formatters
-    that have been inititialized through {!init_color_output}. To be used with
-    {!Pp.pp_with}. *)
-
-(** {5 Tags} *)
-
-val error_tag : t
-(** Tag used by the {!Pp.msg_error} function. *)
-
-val warning_tag : t
-(** Tag used by the {!Pp.msg_warning} function. *)
-
-val debug_tag : t
-(** Tag used by the {!Pp.msg_debug} function. *)
diff --git a/lib/remoteCounter.ml b/lib/remoteCounter.ml
index e7646fb7..978b8b73 100644
--- a/lib/remoteCounter.ml
+++ b/lib/remoteCounter.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type 'a getter = unit -> 'a
@@ -25,7 +27,7 @@ let new_counter ~name a ~incr ~build =
     (* - in the main process there is a race condition between slave
          managers (that are threads) and the main thread, hence the mutex *)
     if Flags.async_proofs_is_worker () then
-      CErrors.anomaly(Pp.str"Slave processes must install remote counters");
+      CErrors.anomaly(Pp.str"Slave processes must install remote counters.");
     Mutex.lock m; let x = f () in Mutex.unlock m;
     build x in
   let mk_thsafe_remote_getter f () =
@@ -33,7 +35,7 @@ let new_counter ~name a ~incr ~build =
   let getter = ref(mk_thsafe_local_getter (fun () -> !data := incr !!data; !!data)) in
   let installer f =
     if not (Flags.async_proofs_is_worker ()) then
-      CErrors.anomaly(Pp.str"Only slave processes can install a remote counter");
+      CErrors.anomaly(Pp.str"Only slave processes can install a remote counter.");
     getter := mk_thsafe_remote_getter f in
   (fun () -> !getter ()), installer
 
diff --git a/lib/remoteCounter.mli b/lib/remoteCounter.mli
index 1b0fa6a0..ae0605cf 100644
--- a/lib/remoteCounter.mli
+++ b/lib/remoteCounter.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Remote counters are *global* counters for fresh ids.  In the master/slave
diff --git a/lib/rtree.ml b/lib/rtree.ml
index f89b98c0..0e371025 100644
--- a/lib/rtree.ml
+++ b/lib/rtree.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
diff --git a/lib/rtree.mli b/lib/rtree.mli
index e27134c3..8edfc3d3 100644
--- a/lib/rtree.mli
+++ b/lib/rtree.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Type of regular tree with nodes labelled by values of type 'a
@@ -78,7 +80,7 @@ val map : ('a -> 'b) -> 'a t -> 'b t
 val smartmap : ('a -> 'a) -> 'a t -> 'a t
 
 (** A rather simple minded pretty-printer *)
-val pp_tree : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds
+val pp_tree : ('a -> Pp.t) -> 'a t -> Pp.t
 
 val eq_rtree : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 (** @deprecated Same as [Rtree.equal] *)
diff --git a/lib/spawn.ml b/lib/spawn.ml
index 47917697..63e9e452 100644
--- a/lib/spawn.ml
+++ b/lib/spawn.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 let proto_version = 0
 let prefer_sock = Sys.os_type = "Win32"
-let accept_timeout = 2.0
+let accept_timeout = 10.0
 
 let pr_err s = Printf.eprintf "(Spawn  ,%d) %s\n%!" (Unix.getpid ()) s
 let prerr_endline s = if !Flags.debug then begin pr_err s end else ()
@@ -28,8 +30,6 @@ module type Control = sig
 
 end
 
-module type Empty = sig end
-
 module type MainLoopModel = sig
   type async_chan
   type condition
@@ -200,7 +200,7 @@ let spawn ?(prefer_sock=prefer_sock) ?(env=Unix.environment ())
   p, cout
 
 let stats { oob_req; oob_resp; alive } =
-  assert_ alive "This process is dead";
+  assert_ alive "This process is dead.";
   output_value oob_req ReqStats;
   flush oob_req;
   input_value oob_resp
@@ -216,7 +216,7 @@ let rec wait p =
 
 end
 
-module Sync(T : Empty) = struct
+module Sync () = struct
 
 type process = {
   cin  : in_channel;
@@ -251,7 +251,7 @@ let kill ({ pid = unixpid; oob_req; oob_resp; cin; cout; alive } as p) =
   with e -> prerr_endline ("kill: "^Printexc.to_string e) end
 
 let stats { oob_req; oob_resp; alive } =
-  assert_ alive "This process is dead";
+  assert_ alive "This process is dead.";
   output_value oob_req ReqStats;
   flush oob_req;
   let RespStats g = input_value oob_resp in g
diff --git a/lib/spawn.mli b/lib/spawn.mli
index 9b86b095..c7a56349 100644
--- a/lib/spawn.mli
+++ b/lib/spawn.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This module implements spawning/killing managed processes with a
@@ -34,8 +36,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 +64,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/stateid.ml b/lib/stateid.ml
index ae25735c..a258d505 100644
--- a/lib/stateid.ml
+++ b/lib/stateid.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t = int
@@ -32,7 +34,6 @@ let compare = Int.compare
 module Self = struct
  type t = int
  let compare = compare
- let equal = equal
 end
 
 module Set = Set.Make(Self)
@@ -41,7 +42,7 @@ type ('a,'b) request = {
   exn_info : t * t;
   stop : t;
   document : 'b;
-  loc : Loc.t;
+  loc : Loc.t option;
   uuid     : 'a;
   name     : string
 }
diff --git a/lib/stateid.mli b/lib/stateid.mli
index 1d87a343..5d4b71a3 100644
--- a/lib/stateid.mli
+++ b/lib/stateid.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type t
@@ -34,7 +36,7 @@ type ('a,'b) request = {
   exn_info : t * t;
   stop : t;
   document : 'b;
-  loc : Loc.t;
+  loc : Loc.t option;
   uuid     : 'a;
   name     : string
 }
diff --git a/lib/system.ml b/lib/system.ml
index 4b99de70..dfede29e 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* $Id$ *)
@@ -52,7 +54,10 @@ 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)
+
+(** Don't trust in interactive mode (the default) *)
+let trust_file_cache = ref false
 
 let exists_in_dir_respecting_case dir bf =
   let cache_dir dir =
@@ -62,10 +67,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 +85,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
@@ -131,7 +136,7 @@ let find_file_in_path ?(warn=true) paths filename =
       let root = Filename.dirname filename in
       root, filename
     else
-      CErrors.errorlabstrm "System.find_file_in_path"
+      CErrors.user_err ~hdr:"System.find_file_in_path"
 	(hov 0 (str "Can't find file" ++ spc () ++ str filename))
   else
     (* the name is considered to be the transcription as a relative
@@ -139,7 +144,7 @@ let find_file_in_path ?(warn=true) paths filename =
        to be locate respecting case *)
     try where_in_path ~warn paths filename
     with Not_found ->
-      CErrors.errorlabstrm "System.find_file_in_path"
+      CErrors.user_err ~hdr:"System.find_file_in_path"
 	(hov 0 (str "Can't find file" ++ spc () ++ str filename ++ spc () ++
 		str "on loadpath"))
 
@@ -162,7 +167,7 @@ let is_in_system_path filename =
 let open_trapping_failure name =
   try open_out_bin name
   with e when CErrors.noncritical e ->
-    CErrors.errorlabstrm "System.open" (str "Can't open " ++ str name)
+    CErrors.user_err ~hdr:"System.open" (str "Can't open " ++ str name)
 
 let warn_cannot_remove_file =
   CWarnings.create ~name:"cannot-remove-file" ~category:"filesystem"
@@ -174,7 +179,7 @@ let try_remove filename =
     warn_cannot_remove_file filename
 
 let error_corrupted file s =
-  CErrors.errorlabstrm "System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.")
+  CErrors.user_err ~hdr:"System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.")
 
 let input_binary_int f ch =
   try input_binary_int ch
@@ -251,7 +256,7 @@ let extern_state magic filename val_0 =
       let () = try_remove filename in
       iraise reraise
   with Sys_error s ->
-    CErrors.errorlabstrm "System.extern_state" (str "System error: " ++ str s)
+    CErrors.user_err ~hdr:"System.extern_state" (str "System error: " ++ str s)
 
 let intern_state magic filename =
   try
@@ -260,12 +265,12 @@ let intern_state magic filename =
     close_in channel;
     v
   with Sys_error s ->
-    CErrors.errorlabstrm "System.intern_state" (str "System error: " ++ str s)
+    CErrors.user_err ~hdr:"System.intern_state" (str "System error: " ++ str s)
 
 let with_magic_number_check f a =
   try f a
   with Bad_magic_number {filename=fname;actual=actual;expected=expected} ->
-    CErrors.errorlabstrm "with_magic_number_check"
+    CErrors.user_err ~hdr:"with_magic_number_check"
     (str"File " ++ str fname ++ strbrk" has bad magic number " ++
     int actual ++ str" (expected " ++ int expected ++ str")." ++
     spc () ++
@@ -292,23 +297,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 () =
-  if Flags.async_proofs_is_worker () then !Flags.async_proofs_worker_id
-  else Printf.sprintf "master:%d" (Thread.id (Thread.self ()))
-    
diff --git a/lib/system.mli b/lib/system.mli
index 21436909..3349dfea 100644
--- a/lib/system.mli
+++ b/lib/system.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {5 Coqtop specific system utilities} *)
@@ -54,6 +56,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 } *)
@@ -96,9 +104,6 @@ type time
 
 val get_time : unit -> time
 val time_difference : time -> time -> float (** in seconds *)
-val fmt_time_difference : time -> time -> Pp.std_ppcmds
-
-val with_time : bool -> ('a -> 'b) -> 'a -> 'b
+val fmt_time_difference : time -> time -> Pp.t
 
-(** {6 Name of current process.} *)
-val process_id : unit -> string
+val with_time : batch:bool -> ('a -> 'b) -> 'a -> 'b
diff --git a/lib/unicodetable.ml b/lib/unicodetable.ml
deleted file mode 100644
index f4e978d6..00000000
--- a/lib/unicodetable.ml
+++ /dev/null
@@ -1,2619 +0,0 @@
-
-(** Unicode tables generated from Camomile. *)
-
-(* Letter, Uppercase *)
-let lu = [
-  (0x00041,0x0005A);
-  (0x000C0,0x000D6);
-  (0x000D8,0x000DE);
-  (0x00100,0x00100);
-  (0x00102,0x00102);
-  (0x00104,0x00104);
-  (0x00106,0x00106);
-  (0x00108,0x00108);
-  (0x0010A,0x0010A);
-  (0x0010C,0x0010C);
-  (0x0010E,0x0010E);
-  (0x00110,0x00110);
-  (0x00112,0x00112);
-  (0x00114,0x00114);
-  (0x00116,0x00116);
-  (0x00118,0x00118);
-  (0x0011A,0x0011A);
-  (0x0011C,0x0011C);
-  (0x0011E,0x0011E);
-  (0x00120,0x00120);
-  (0x00122,0x00122);
-  (0x00124,0x00124);
-  (0x00126,0x00126);
-  (0x00128,0x00128);
-  (0x0012A,0x0012A);
-  (0x0012C,0x0012C);
-  (0x0012E,0x0012E);
-  (0x00130,0x00130);
-  (0x00132,0x00132);
-  (0x00134,0x00134);
-  (0x00136,0x00136);
-  (0x00139,0x00139);
-  (0x0013B,0x0013B);
-  (0x0013D,0x0013D);
-  (0x0013F,0x0013F);
-  (0x00141,0x00141);
-  (0x00143,0x00143);
-  (0x00145,0x00145);
-  (0x00147,0x00147);
-  (0x0014A,0x0014A);
-  (0x0014C,0x0014C);
-  (0x0014E,0x0014E);
-  (0x00150,0x00150);
-  (0x00152,0x00152);
-  (0x00154,0x00154);
-  (0x00156,0x00156);
-  (0x00158,0x00158);
-  (0x0015A,0x0015A);
-  (0x0015C,0x0015C);
-  (0x0015E,0x0015E);
-  (0x00160,0x00160);
-  (0x00162,0x00162);
-  (0x00164,0x00164);
-  (0x00166,0x00166);
-  (0x00168,0x00168);
-  (0x0016A,0x0016A);
-  (0x0016C,0x0016C);
-  (0x0016E,0x0016E);
-  (0x00170,0x00170);
-  (0x00172,0x00172);
-  (0x00174,0x00174);
-  (0x00176,0x00176);
-  (0x00178,0x00179);
-  (0x0017B,0x0017B);
-  (0x0017D,0x0017D);
-  (0x00181,0x00182);
-  (0x00184,0x00184);
-  (0x00186,0x00187);
-  (0x00189,0x0018B);
-  (0x0018E,0x00191);
-  (0x00193,0x00194);
-  (0x00196,0x00198);
-  (0x0019C,0x0019D);
-  (0x0019F,0x001A0);
-  (0x001A2,0x001A2);
-  (0x001A4,0x001A4);
-  (0x001A6,0x001A7);
-  (0x001A9,0x001A9);
-  (0x001AC,0x001AC);
-  (0x001AE,0x001AF);
-  (0x001B1,0x001B3);
-  (0x001B5,0x001B5);
-  (0x001B7,0x001B8);
-  (0x001BC,0x001BC);
-  (0x001C4,0x001C4);
-  (0x001C7,0x001C7);
-  (0x001CA,0x001CA);
-  (0x001CD,0x001CD);
-  (0x001CF,0x001CF);
-  (0x001D1,0x001D1);
-  (0x001D3,0x001D3);
-  (0x001D5,0x001D5);
-  (0x001D7,0x001D7);
-  (0x001D9,0x001D9);
-  (0x001DB,0x001DB);
-  (0x001DE,0x001DE);
-  (0x001E0,0x001E0);
-  (0x001E2,0x001E2);
-  (0x001E4,0x001E4);
-  (0x001E6,0x001E6);
-  (0x001E8,0x001E8);
-  (0x001EA,0x001EA);
-  (0x001EC,0x001EC);
-  (0x001EE,0x001EE);
-  (0x001F1,0x001F1);
-  (0x001F4,0x001F4);
-  (0x001F6,0x001F8);
-  (0x001FA,0x001FA);
-  (0x001FC,0x001FC);
-  (0x001FE,0x001FE);
-  (0x00200,0x00200);
-  (0x00202,0x00202);
-  (0x00204,0x00204);
-  (0x00206,0x00206);
-  (0x00208,0x00208);
-  (0x0020A,0x0020A);
-  (0x0020C,0x0020C);
-  (0x0020E,0x0020E);
-  (0x00210,0x00210);
-  (0x00212,0x00212);
-  (0x00214,0x00214);
-  (0x00216,0x00216);
-  (0x00218,0x00218);
-  (0x0021A,0x0021A);
-  (0x0021C,0x0021C);
-  (0x0021E,0x0021E);
-  (0x00220,0x00220);
-  (0x00222,0x00222);
-  (0x00224,0x00224);
-  (0x00226,0x00226);
-  (0x00228,0x00228);
-  (0x0022A,0x0022A);
-  (0x0022C,0x0022C);
-  (0x0022E,0x0022E);
-  (0x00230,0x00230);
-  (0x00232,0x00232);
-  (0x00386,0x00386);
-  (0x00388,0x0038A);
-  (0x0038C,0x0038C);
-  (0x0038E,0x0038F);
-  (0x00391,0x003A1);
-  (0x003A3,0x003AB);
-  (0x003D2,0x003D4);
-  (0x003D8,0x003D8);
-  (0x003DA,0x003DA);
-  (0x003DC,0x003DC);
-  (0x003DE,0x003DE);
-  (0x003E0,0x003E0);
-  (0x003E2,0x003E2);
-  (0x003E4,0x003E4);
-  (0x003E6,0x003E6);
-  (0x003E8,0x003E8);
-  (0x003EA,0x003EA);
-  (0x003EC,0x003EC);
-  (0x003EE,0x003EE);
-  (0x003F4,0x003F4);
-  (0x00400,0x0042F);
-  (0x00460,0x00460);
-  (0x00462,0x00462);
-  (0x00464,0x00464);
-  (0x00466,0x00466);
-  (0x00468,0x00468);
-  (0x0046A,0x0046A);
-  (0x0046C,0x0046C);
-  (0x0046E,0x0046E);
-  (0x00470,0x00470);
-  (0x00472,0x00472);
-  (0x00474,0x00474);
-  (0x00476,0x00476);
-  (0x00478,0x00478);
-  (0x0047A,0x0047A);
-  (0x0047C,0x0047C);
-  (0x0047E,0x0047E);
-  (0x00480,0x00480);
-  (0x0048A,0x0048A);
-  (0x0048C,0x0048C);
-  (0x0048E,0x0048E);
-  (0x00490,0x00490);
-  (0x00492,0x00492);
-  (0x00494,0x00494);
-  (0x00496,0x00496);
-  (0x00498,0x00498);
-  (0x0049A,0x0049A);
-  (0x0049C,0x0049C);
-  (0x0049E,0x0049E);
-  (0x004A0,0x004A0);
-  (0x004A2,0x004A2);
-  (0x004A4,0x004A4);
-  (0x004A6,0x004A6);
-  (0x004A8,0x004A8);
-  (0x004AA,0x004AA);
-  (0x004AC,0x004AC);
-  (0x004AE,0x004AE);
-  (0x004B0,0x004B0);
-  (0x004B2,0x004B2);
-  (0x004B4,0x004B4);
-  (0x004B6,0x004B6);
-  (0x004B8,0x004B8);
-  (0x004BA,0x004BA);
-  (0x004BC,0x004BC);
-  (0x004BE,0x004BE);
-  (0x004C0,0x004C1);
-  (0x004C3,0x004C3);
-  (0x004C5,0x004C5);
-  (0x004C7,0x004C7);
-  (0x004C9,0x004C9);
-  (0x004CB,0x004CB);
-  (0x004CD,0x004CD);
-  (0x004D0,0x004D0);
-  (0x004D2,0x004D2);
-  (0x004D4,0x004D4);
-  (0x004D6,0x004D6);
-  (0x004D8,0x004D8);
-  (0x004DA,0x004DA);
-  (0x004DC,0x004DC);
-  (0x004DE,0x004DE);
-  (0x004E0,0x004E0);
-  (0x004E2,0x004E2);
-  (0x004E4,0x004E4);
-  (0x004E6,0x004E6);
-  (0x004E8,0x004E8);
-  (0x004EA,0x004EA);
-  (0x004EC,0x004EC);
-  (0x004EE,0x004EE);
-  (0x004F0,0x004F0);
-  (0x004F2,0x004F2);
-  (0x004F4,0x004F4);
-  (0x004F8,0x004F8);
-  (0x00500,0x00500);
-  (0x00502,0x00502);
-  (0x00504,0x00504);
-  (0x00506,0x00506);
-  (0x00508,0x00508);
-  (0x0050A,0x0050A);
-  (0x0050C,0x0050C);
-  (0x0050E,0x0050E);
-  (0x00531,0x00556);
-  (0x010A0,0x010C5);
-  (0x01E00,0x01E00);
-  (0x01E02,0x01E02);
-  (0x01E04,0x01E04);
-  (0x01E06,0x01E06);
-  (0x01E08,0x01E08);
-  (0x01E0A,0x01E0A);
-  (0x01E0C,0x01E0C);
-  (0x01E0E,0x01E0E);
-  (0x01E10,0x01E10);
-  (0x01E12,0x01E12);
-  (0x01E14,0x01E14);
-  (0x01E16,0x01E16);
-  (0x01E18,0x01E18);
-  (0x01E1A,0x01E1A);
-  (0x01E1C,0x01E1C);
-  (0x01E1E,0x01E1E);
-  (0x01E20,0x01E20);
-  (0x01E22,0x01E22);
-  (0x01E24,0x01E24);
-  (0x01E26,0x01E26);
-  (0x01E28,0x01E28);
-  (0x01E2A,0x01E2A);
-  (0x01E2C,0x01E2C);
-  (0x01E2E,0x01E2E);
-  (0x01E30,0x01E30);
-  (0x01E32,0x01E32);
-  (0x01E34,0x01E34);
-  (0x01E36,0x01E36);
-  (0x01E38,0x01E38);
-  (0x01E3A,0x01E3A);
-  (0x01E3C,0x01E3C);
-  (0x01E3E,0x01E3E);
-  (0x01E40,0x01E40);
-  (0x01E42,0x01E42);
-  (0x01E44,0x01E44);
-  (0x01E46,0x01E46);
-  (0x01E48,0x01E48);
-  (0x01E4A,0x01E4A);
-  (0x01E4C,0x01E4C);
-  (0x01E4E,0x01E4E);
-  (0x01E50,0x01E50);
-  (0x01E52,0x01E52);
-  (0x01E54,0x01E54);
-  (0x01E56,0x01E56);
-  (0x01E58,0x01E58);
-  (0x01E5A,0x01E5A);
-  (0x01E5C,0x01E5C);
-  (0x01E5E,0x01E5E);
-  (0x01E60,0x01E60);
-  (0x01E62,0x01E62);
-  (0x01E64,0x01E64);
-  (0x01E66,0x01E66);
-  (0x01E68,0x01E68);
-  (0x01E6A,0x01E6A);
-  (0x01E6C,0x01E6C);
-  (0x01E6E,0x01E6E);
-  (0x01E70,0x01E70);
-  (0x01E72,0x01E72);
-  (0x01E74,0x01E74);
-  (0x01E76,0x01E76);
-  (0x01E78,0x01E78);
-  (0x01E7A,0x01E7A);
-  (0x01E7C,0x01E7C);
-  (0x01E7E,0x01E7E);
-  (0x01E80,0x01E80);
-  (0x01E82,0x01E82);
-  (0x01E84,0x01E84);
-  (0x01E86,0x01E86);
-  (0x01E88,0x01E88);
-  (0x01E8A,0x01E8A);
-  (0x01E8C,0x01E8C);
-  (0x01E8E,0x01E8E);
-  (0x01E90,0x01E90);
-  (0x01E92,0x01E92);
-  (0x01E94,0x01E94);
-  (0x01EA0,0x01EA0);
-  (0x01EA2,0x01EA2);
-  (0x01EA4,0x01EA4);
-  (0x01EA6,0x01EA6);
-  (0x01EA8,0x01EA8);
-  (0x01EAA,0x01EAA);
-  (0x01EAC,0x01EAC);
-  (0x01EAE,0x01EAE);
-  (0x01EB0,0x01EB0);
-  (0x01EB2,0x01EB2);
-  (0x01EB4,0x01EB4);
-  (0x01EB6,0x01EB6);
-  (0x01EB8,0x01EB8);
-  (0x01EBA,0x01EBA);
-  (0x01EBC,0x01EBC);
-  (0x01EBE,0x01EBE);
-  (0x01EC0,0x01EC0);
-  (0x01EC2,0x01EC2);
-  (0x01EC4,0x01EC4);
-  (0x01EC6,0x01EC6);
-  (0x01EC8,0x01EC8);
-  (0x01ECA,0x01ECA);
-  (0x01ECC,0x01ECC);
-  (0x01ECE,0x01ECE);
-  (0x01ED0,0x01ED0);
-  (0x01ED2,0x01ED2);
-  (0x01ED4,0x01ED4);
-  (0x01ED6,0x01ED6);
-  (0x01ED8,0x01ED8);
-  (0x01EDA,0x01EDA);
-  (0x01EDC,0x01EDC);
-  (0x01EDE,0x01EDE);
-  (0x01EE0,0x01EE0);
-  (0x01EE2,0x01EE2);
-  (0x01EE4,0x01EE4);
-  (0x01EE6,0x01EE6);
-  (0x01EE8,0x01EE8);
-  (0x01EEA,0x01EEA);
-  (0x01EEC,0x01EEC);
-  (0x01EEE,0x01EEE);
-  (0x01EF0,0x01EF0);
-  (0x01EF2,0x01EF2);
-  (0x01EF4,0x01EF4);
-  (0x01EF6,0x01EF6);
-  (0x01EF8,0x01EF8);
-  (0x01F08,0x01F0F);
-  (0x01F18,0x01F1D);
-  (0x01F28,0x01F2F);
-  (0x01F38,0x01F3F);
-  (0x01F48,0x01F4D);
-  (0x01F59,0x01F59);
-  (0x01F5B,0x01F5B);
-  (0x01F5D,0x01F5D);
-  (0x01F5F,0x01F5F);
-  (0x01F68,0x01F6F);
-  (0x01FB8,0x01FBB);
-  (0x01FC8,0x01FCB);
-  (0x01FD8,0x01FDB);
-  (0x01FE8,0x01FEC);
-  (0x01FF8,0x01FFB);
-  (0x02102,0x02102);
-  (0x02107,0x02107);
-  (0x0210B,0x0210D);
-  (0x02110,0x02112);
-  (0x02115,0x02115);
-  (0x02119,0x0211D);
-  (0x02124,0x02124);
-  (0x02126,0x02126);
-  (0x02128,0x02128);
-  (0x0212A,0x0212D);
-  (0x02130,0x02131);
-  (0x02133,0x02133);
-  (0x0213E,0x0213F);
-  (0x02145,0x02145);
-  (0x0FF21,0x0FF3A);
-  (0x10400,0x10425);
-  (0x1D400,0x1D419);
-  (0x1D434,0x1D44D);
-  (0x1D468,0x1D481);
-  (0x1D49C,0x1D49C);
-  (0x1D49E,0x1D49F);
-  (0x1D4A2,0x1D4A2);
-  (0x1D4A5,0x1D4A6);
-  (0x1D4A9,0x1D4AC);
-  (0x1D4AE,0x1D4B5);
-  (0x1D4D0,0x1D4E9);
-  (0x1D504,0x1D505);
-  (0x1D507,0x1D50A);
-  (0x1D50D,0x1D514);
-  (0x1D516,0x1D51C);
-  (0x1D538,0x1D539);
-  (0x1D53B,0x1D53E);
-  (0x1D540,0x1D544);
-  (0x1D546,0x1D546);
-  (0x1D54A,0x1D550);
-  (0x1D56C,0x1D585);
-  (0x1D5A0,0x1D5B9);
-  (0x1D5D4,0x1D5ED);
-  (0x1D608,0x1D621);
-  (0x1D63C,0x1D655);
-  (0x1D670,0x1D689);
-  (0x1D6A8,0x1D6C0);
-  (0x1D6E2,0x1D6FA);
-  (0x1D71C,0x1D734);
-  (0x1D756,0x1D76E);
-  (0x1D790,0x1D7A8)
-]
-(* Letter, Lowercase *)
-let ll = [
-  (0x00061,0x0007A);
-  (0x000AA,0x000AA);
-  (0x000B5,0x000B5);
-  (0x000BA,0x000BA);
-  (0x000DF,0x000F6);
-  (0x000F8,0x000FF);
-  (0x00101,0x00101);
-  (0x00103,0x00103);
-  (0x00105,0x00105);
-  (0x00107,0x00107);
-  (0x00109,0x00109);
-  (0x0010B,0x0010B);
-  (0x0010D,0x0010D);
-  (0x0010F,0x0010F);
-  (0x00111,0x00111);
-  (0x00113,0x00113);
-  (0x00115,0x00115);
-  (0x00117,0x00117);
-  (0x00119,0x00119);
-  (0x0011B,0x0011B);
-  (0x0011D,0x0011D);
-  (0x0011F,0x0011F);
-  (0x00121,0x00121);
-  (0x00123,0x00123);
-  (0x00125,0x00125);
-  (0x00127,0x00127);
-  (0x00129,0x00129);
-  (0x0012B,0x0012B);
-  (0x0012D,0x0012D);
-  (0x0012F,0x0012F);
-  (0x00131,0x00131);
-  (0x00133,0x00133);
-  (0x00135,0x00135);
-  (0x00137,0x00138);
-  (0x0013A,0x0013A);
-  (0x0013C,0x0013C);
-  (0x0013E,0x0013E);
-  (0x00140,0x00140);
-  (0x00142,0x00142);
-  (0x00144,0x00144);
-  (0x00146,0x00146);
-  (0x00148,0x00149);
-  (0x0014B,0x0014B);
-  (0x0014D,0x0014D);
-  (0x0014F,0x0014F);
-  (0x00151,0x00151);
-  (0x00153,0x00153);
-  (0x00155,0x00155);
-  (0x00157,0x00157);
-  (0x00159,0x00159);
-  (0x0015B,0x0015B);
-  (0x0015D,0x0015D);
-  (0x0015F,0x0015F);
-  (0x00161,0x00161);
-  (0x00163,0x00163);
-  (0x00165,0x00165);
-  (0x00167,0x00167);
-  (0x00169,0x00169);
-  (0x0016B,0x0016B);
-  (0x0016D,0x0016D);
-  (0x0016F,0x0016F);
-  (0x00171,0x00171);
-  (0x00173,0x00173);
-  (0x00175,0x00175);
-  (0x00177,0x00177);
-  (0x0017A,0x0017A);
-  (0x0017C,0x0017C);
-  (0x0017E,0x00180);
-  (0x00183,0x00183);
-  (0x00185,0x00185);
-  (0x00188,0x00188);
-  (0x0018C,0x0018D);
-  (0x00192,0x00192);
-  (0x00195,0x00195);
-  (0x00199,0x0019B);
-  (0x0019E,0x0019E);
-  (0x001A1,0x001A1);
-  (0x001A3,0x001A3);
-  (0x001A5,0x001A5);
-  (0x001A8,0x001A8);
-  (0x001AA,0x001AB);
-  (0x001AD,0x001AD);
-  (0x001B0,0x001B0);
-  (0x001B4,0x001B4);
-  (0x001B6,0x001B6);
-  (0x001B9,0x001BA);
-  (0x001BD,0x001BF);
-  (0x001C6,0x001C6);
-  (0x001C9,0x001C9);
-  (0x001CC,0x001CC);
-  (0x001CE,0x001CE);
-  (0x001D0,0x001D0);
-  (0x001D2,0x001D2);
-  (0x001D4,0x001D4);
-  (0x001D6,0x001D6);
-  (0x001D8,0x001D8);
-  (0x001DA,0x001DA);
-  (0x001DC,0x001DD);
-  (0x001DF,0x001DF);
-  (0x001E1,0x001E1);
-  (0x001E3,0x001E3);
-  (0x001E5,0x001E5);
-  (0x001E7,0x001E7);
-  (0x001E9,0x001E9);
-  (0x001EB,0x001EB);
-  (0x001ED,0x001ED);
-  (0x001EF,0x001F0);
-  (0x001F3,0x001F3);
-  (0x001F5,0x001F5);
-  (0x001F9,0x001F9);
-  (0x001FB,0x001FB);
-  (0x001FD,0x001FD);
-  (0x001FF,0x001FF);
-  (0x00201,0x00201);
-  (0x00203,0x00203);
-  (0x00205,0x00205);
-  (0x00207,0x00207);
-  (0x00209,0x00209);
-  (0x0020B,0x0020B);
-  (0x0020D,0x0020D);
-  (0x0020F,0x0020F);
-  (0x00211,0x00211);
-  (0x00213,0x00213);
-  (0x00215,0x00215);
-  (0x00217,0x00217);
-  (0x00219,0x00219);
-  (0x0021B,0x0021B);
-  (0x0021D,0x0021D);
-  (0x0021F,0x0021F);
-  (0x00223,0x00223);
-  (0x00225,0x00225);
-  (0x00227,0x00227);
-  (0x00229,0x00229);
-  (0x0022B,0x0022B);
-  (0x0022D,0x0022D);
-  (0x0022F,0x0022F);
-  (0x00231,0x00231);
-  (0x00233,0x00233);
-  (0x00250,0x002AD);
-  (0x00390,0x00390);
-  (0x003AC,0x003CE);
-  (0x003D0,0x003D1);
-  (0x003D5,0x003D7);
-  (0x003D9,0x003D9);
-  (0x003DB,0x003DB);
-  (0x003DD,0x003DD);
-  (0x003DF,0x003DF);
-  (0x003E1,0x003E1);
-  (0x003E3,0x003E3);
-  (0x003E5,0x003E5);
-  (0x003E7,0x003E7);
-  (0x003E9,0x003E9);
-  (0x003EB,0x003EB);
-  (0x003ED,0x003ED);
-  (0x003EF,0x003F3);
-  (0x003F5,0x003F5);
-  (0x00430,0x0045F);
-  (0x00461,0x00461);
-  (0x00463,0x00463);
-  (0x00465,0x00465);
-  (0x00467,0x00467);
-  (0x00469,0x00469);
-  (0x0046B,0x0046B);
-  (0x0046D,0x0046D);
-  (0x0046F,0x0046F);
-  (0x00471,0x00471);
-  (0x00473,0x00473);
-  (0x00475,0x00475);
-  (0x00477,0x00477);
-  (0x00479,0x00479);
-  (0x0047B,0x0047B);
-  (0x0047D,0x0047D);
-  (0x0047F,0x0047F);
-  (0x00481,0x00481);
-  (0x0048B,0x0048B);
-  (0x0048D,0x0048D);
-  (0x0048F,0x0048F);
-  (0x00491,0x00491);
-  (0x00493,0x00493);
-  (0x00495,0x00495);
-  (0x00497,0x00497);
-  (0x00499,0x00499);
-  (0x0049B,0x0049B);
-  (0x0049D,0x0049D);
-  (0x0049F,0x0049F);
-  (0x004A1,0x004A1);
-  (0x004A3,0x004A3);
-  (0x004A5,0x004A5);
-  (0x004A7,0x004A7);
-  (0x004A9,0x004A9);
-  (0x004AB,0x004AB);
-  (0x004AD,0x004AD);
-  (0x004AF,0x004AF);
-  (0x004B1,0x004B1);
-  (0x004B3,0x004B3);
-  (0x004B5,0x004B5);
-  (0x004B7,0x004B7);
-  (0x004B9,0x004B9);
-  (0x004BB,0x004BB);
-  (0x004BD,0x004BD);
-  (0x004BF,0x004BF);
-  (0x004C2,0x004C2);
-  (0x004C4,0x004C4);
-  (0x004C6,0x004C6);
-  (0x004C8,0x004C8);
-  (0x004CA,0x004CA);
-  (0x004CC,0x004CC);
-  (0x004CE,0x004CE);
-  (0x004D1,0x004D1);
-  (0x004D3,0x004D3);
-  (0x004D5,0x004D5);
-  (0x004D7,0x004D7);
-  (0x004D9,0x004D9);
-  (0x004DB,0x004DB);
-  (0x004DD,0x004DD);
-  (0x004DF,0x004DF);
-  (0x004E1,0x004E1);
-  (0x004E3,0x004E3);
-  (0x004E5,0x004E5);
-  (0x004E7,0x004E7);
-  (0x004E9,0x004E9);
-  (0x004EB,0x004EB);
-  (0x004ED,0x004ED);
-  (0x004EF,0x004EF);
-  (0x004F1,0x004F1);
-  (0x004F3,0x004F3);
-  (0x004F5,0x004F5);
-  (0x004F9,0x004F9);
-  (0x00501,0x00501);
-  (0x00503,0x00503);
-  (0x00505,0x00505);
-  (0x00507,0x00507);
-  (0x00509,0x00509);
-  (0x0050B,0x0050B);
-  (0x0050D,0x0050D);
-  (0x0050F,0x0050F);
-  (0x00561,0x00587);
-  (0x01E01,0x01E01);
-  (0x01E03,0x01E03);
-  (0x01E05,0x01E05);
-  (0x01E07,0x01E07);
-  (0x01E09,0x01E09);
-  (0x01E0B,0x01E0B);
-  (0x01E0D,0x01E0D);
-  (0x01E0F,0x01E0F);
-  (0x01E11,0x01E11);
-  (0x01E13,0x01E13);
-  (0x01E15,0x01E15);
-  (0x01E17,0x01E17);
-  (0x01E19,0x01E19);
-  (0x01E1B,0x01E1B);
-  (0x01E1D,0x01E1D);
-  (0x01E1F,0x01E1F);
-  (0x01E21,0x01E21);
-  (0x01E23,0x01E23);
-  (0x01E25,0x01E25);
-  (0x01E27,0x01E27);
-  (0x01E29,0x01E29);
-  (0x01E2B,0x01E2B);
-  (0x01E2D,0x01E2D);
-  (0x01E2F,0x01E2F);
-  (0x01E31,0x01E31);
-  (0x01E33,0x01E33);
-  (0x01E35,0x01E35);
-  (0x01E37,0x01E37);
-  (0x01E39,0x01E39);
-  (0x01E3B,0x01E3B);
-  (0x01E3D,0x01E3D);
-  (0x01E3F,0x01E3F);
-  (0x01E41,0x01E41);
-  (0x01E43,0x01E43);
-  (0x01E45,0x01E45);
-  (0x01E47,0x01E47);
-  (0x01E49,0x01E49);
-  (0x01E4B,0x01E4B);
-  (0x01E4D,0x01E4D);
-  (0x01E4F,0x01E4F);
-  (0x01E51,0x01E51);
-  (0x01E53,0x01E53);
-  (0x01E55,0x01E55);
-  (0x01E57,0x01E57);
-  (0x01E59,0x01E59);
-  (0x01E5B,0x01E5B);
-  (0x01E5D,0x01E5D);
-  (0x01E5F,0x01E5F);
-  (0x01E61,0x01E61);
-  (0x01E63,0x01E63);
-  (0x01E65,0x01E65);
-  (0x01E67,0x01E67);
-  (0x01E69,0x01E69);
-  (0x01E6B,0x01E6B);
-  (0x01E6D,0x01E6D);
-  (0x01E6F,0x01E6F);
-  (0x01E71,0x01E71);
-  (0x01E73,0x01E73);
-  (0x01E75,0x01E75);
-  (0x01E77,0x01E77);
-  (0x01E79,0x01E79);
-  (0x01E7B,0x01E7B);
-  (0x01E7D,0x01E7D);
-  (0x01E7F,0x01E7F);
-  (0x01E81,0x01E81);
-  (0x01E83,0x01E83);
-  (0x01E85,0x01E85);
-  (0x01E87,0x01E87);
-  (0x01E89,0x01E89);
-  (0x01E8B,0x01E8B);
-  (0x01E8D,0x01E8D);
-  (0x01E8F,0x01E8F);
-  (0x01E91,0x01E91);
-  (0x01E93,0x01E93);
-  (0x01E95,0x01E9B);
-  (0x01EA1,0x01EA1);
-  (0x01EA3,0x01EA3);
-  (0x01EA5,0x01EA5);
-  (0x01EA7,0x01EA7);
-  (0x01EA9,0x01EA9);
-  (0x01EAB,0x01EAB);
-  (0x01EAD,0x01EAD);
-  (0x01EAF,0x01EAF);
-  (0x01EB1,0x01EB1);
-  (0x01EB3,0x01EB3);
-  (0x01EB5,0x01EB5);
-  (0x01EB7,0x01EB7);
-  (0x01EB9,0x01EB9);
-  (0x01EBB,0x01EBB);
-  (0x01EBD,0x01EBD);
-  (0x01EBF,0x01EBF);
-  (0x01EC1,0x01EC1);
-  (0x01EC3,0x01EC3);
-  (0x01EC5,0x01EC5);
-  (0x01EC7,0x01EC7);
-  (0x01EC9,0x01EC9);
-  (0x01ECB,0x01ECB);
-  (0x01ECD,0x01ECD);
-  (0x01ECF,0x01ECF);
-  (0x01ED1,0x01ED1);
-  (0x01ED3,0x01ED3);
-  (0x01ED5,0x01ED5);
-  (0x01ED7,0x01ED7);
-  (0x01ED9,0x01ED9);
-  (0x01EDB,0x01EDB);
-  (0x01EDD,0x01EDD);
-  (0x01EDF,0x01EDF);
-  (0x01EE1,0x01EE1);
-  (0x01EE3,0x01EE3);
-  (0x01EE5,0x01EE5);
-  (0x01EE7,0x01EE7);
-  (0x01EE9,0x01EE9);
-  (0x01EEB,0x01EEB);
-  (0x01EED,0x01EED);
-  (0x01EEF,0x01EEF);
-  (0x01EF1,0x01EF1);
-  (0x01EF3,0x01EF3);
-  (0x01EF5,0x01EF5);
-  (0x01EF7,0x01EF7);
-  (0x01EF9,0x01EF9);
-  (0x01F00,0x01F07);
-  (0x01F10,0x01F15);
-  (0x01F20,0x01F27);
-  (0x01F30,0x01F37);
-  (0x01F40,0x01F45);
-  (0x01F50,0x01F57);
-  (0x01F60,0x01F67);
-  (0x01F70,0x01F7D);
-  (0x01F80,0x01F87);
-  (0x01F90,0x01F97);
-  (0x01FA0,0x01FA7);
-  (0x01FB0,0x01FB4);
-  (0x01FB6,0x01FB7);
-  (0x01FBE,0x01FBE);
-  (0x01FC2,0x01FC4);
-  (0x01FC6,0x01FC7);
-  (0x01FD0,0x01FD3);
-  (0x01FD6,0x01FD7);
-  (0x01FE0,0x01FE7);
-  (0x01FF2,0x01FF4);
-  (0x01FF6,0x01FF7);
-  (0x02071,0x02071);
-  (0x0207F,0x0207F);
-  (0x0210A,0x0210A);
-  (0x0210E,0x0210F);
-  (0x02113,0x02113);
-  (0x0212F,0x0212F);
-  (0x02134,0x02134);
-  (0x02139,0x02139);
-  (0x0213D,0x0213D);
-  (0x02146,0x02149);
-  (0x0FB00,0x0FB06);
-  (0x0FB13,0x0FB17);
-  (0x0FF41,0x0FF5A);
-  (0x10428,0x1044D);
-  (0x1D41A,0x1D433);
-  (0x1D44E,0x1D454);
-  (0x1D456,0x1D467);
-  (0x1D482,0x1D49B);
-  (0x1D4B6,0x1D4B9);
-  (0x1D4BB,0x1D4BB);
-  (0x1D4BD,0x1D4C0);
-  (0x1D4C2,0x1D4C3);
-  (0x1D4C5,0x1D4CF);
-  (0x1D4EA,0x1D503);
-  (0x1D51E,0x1D537);
-  (0x1D552,0x1D56B);
-  (0x1D586,0x1D59F);
-  (0x1D5BA,0x1D5D3);
-  (0x1D5EE,0x1D607);
-  (0x1D622,0x1D63B);
-  (0x1D656,0x1D66F);
-  (0x1D68A,0x1D6A3);
-  (0x1D6C2,0x1D6DA);
-  (0x1D6DC,0x1D6E1);
-  (0x1D6FC,0x1D714);
-  (0x1D716,0x1D71B);
-  (0x1D736,0x1D74E);
-  (0x1D750,0x1D755);
-  (0x1D770,0x1D788);
-  (0x1D78A,0x1D78F);
-  (0x1D7AA,0x1D7C2);
-  (0x1D7C4,0x1D7C9)
-]
-(* Letter, Titlecase *)
-let lt = [
-  (0x001C5,0x001C5);
-  (0x001C8,0x001C8);
-  (0x001CB,0x001CB);
-  (0x001F2,0x001F2);
-  (0x01F88,0x01F8F);
-  (0x01F98,0x01F9F);
-  (0x01FA8,0x01FAF);
-  (0x01FBC,0x01FBC);
-  (0x01FCC,0x01FCC);
-  (0x01FFC,0x01FFC)
-]
-(* Mark, Non-Spacing *)
-let mn = [
-  (0x00300,0x0034F);
-  (0x00360,0x0036F);
-  (0x00483,0x00486);
-  (0x00591,0x005A1);
-  (0x005A3,0x005B9);
-  (0x005BB,0x005BD);
-  (0x005BF,0x005BF);
-  (0x005C1,0x005C2);
-  (0x005C4,0x005C4);
-  (0x0064B,0x00655);
-  (0x00670,0x00670);
-  (0x006D6,0x006DC);
-  (0x006DF,0x006E4);
-  (0x006E7,0x006E8);
-  (0x006EA,0x006ED);
-  (0x00711,0x00711);
-  (0x00730,0x0074A);
-  (0x007A6,0x007B0);
-  (0x00901,0x00902);
-  (0x0093C,0x0093C);
-  (0x00941,0x00948);
-  (0x0094D,0x0094D);
-  (0x00951,0x00954);
-  (0x00962,0x00963);
-  (0x00981,0x00981);
-  (0x009BC,0x009BC);
-  (0x009C1,0x009C4);
-  (0x009CD,0x009CD);
-  (0x009E2,0x009E3);
-  (0x00A02,0x00A02);
-  (0x00A3C,0x00A3C);
-  (0x00A41,0x00A42);
-  (0x00A47,0x00A48);
-  (0x00A4B,0x00A4D);
-  (0x00A70,0x00A71);
-  (0x00A81,0x00A82);
-  (0x00ABC,0x00ABC);
-  (0x00AC1,0x00AC5);
-  (0x00AC7,0x00AC8);
-  (0x00ACD,0x00ACD);
-  (0x00B01,0x00B01);
-  (0x00B3C,0x00B3C);
-  (0x00B3F,0x00B3F);
-  (0x00B41,0x00B43);
-  (0x00B4D,0x00B4D);
-  (0x00B56,0x00B56);
-  (0x00B82,0x00B82);
-  (0x00BC0,0x00BC0);
-  (0x00BCD,0x00BCD);
-  (0x00C3E,0x00C40);
-  (0x00C46,0x00C48);
-  (0x00C4A,0x00C4D);
-  (0x00C55,0x00C56);
-  (0x00CBF,0x00CBF);
-  (0x00CC6,0x00CC6);
-  (0x00CCC,0x00CCD);
-  (0x00D41,0x00D43);
-  (0x00D4D,0x00D4D);
-  (0x00DCA,0x00DCA);
-  (0x00DD2,0x00DD4);
-  (0x00DD6,0x00DD6);
-  (0x00E31,0x00E31);
-  (0x00E34,0x00E3A);
-  (0x00E47,0x00E4E);
-  (0x00EB1,0x00EB1);
-  (0x00EB4,0x00EB9);
-  (0x00EBB,0x00EBC);
-  (0x00EC8,0x00ECD);
-  (0x00F18,0x00F19);
-  (0x00F35,0x00F35);
-  (0x00F37,0x00F37);
-  (0x00F39,0x00F39);
-  (0x00F71,0x00F7E);
-  (0x00F80,0x00F84);
-  (0x00F86,0x00F87);
-  (0x00F90,0x00F97);
-  (0x00F99,0x00FBC);
-  (0x00FC6,0x00FC6);
-  (0x0102D,0x01030);
-  (0x01032,0x01032);
-  (0x01036,0x01037);
-  (0x01039,0x01039);
-  (0x01058,0x01059);
-  (0x01712,0x01714);
-  (0x01732,0x01734);
-  (0x01752,0x01753);
-  (0x01772,0x01773);
-  (0x017B7,0x017BD);
-  (0x017C6,0x017C6);
-  (0x017C9,0x017D3);
-  (0x0180B,0x0180D);
-  (0x018A9,0x018A9);
-  (0x020D0,0x020DC);
-  (0x020E1,0x020E1);
-  (0x020E5,0x020EA);
-  (0x0302A,0x0302F);
-  (0x03099,0x0309A);
-  (0x0FB1E,0x0FB1E);
-  (0x0FE00,0x0FE0F);
-  (0x0FE20,0x0FE23);
-  (0x1D167,0x1D169);
-  (0x1D17B,0x1D182);
-  (0x1D185,0x1D18B);
-  (0x1D1AA,0x1D1AD)
-]
-(* Mark, Spacing Combining *)
-let mc = [
-  (0x00903,0x00903);
-  (0x0093E,0x00940);
-  (0x00949,0x0094C);
-  (0x00982,0x00983);
-  (0x009BE,0x009C0);
-  (0x009C7,0x009C8);
-  (0x009CB,0x009CC);
-  (0x009D7,0x009D7);
-  (0x00A3E,0x00A40);
-  (0x00A83,0x00A83);
-  (0x00ABE,0x00AC0);
-  (0x00AC9,0x00AC9);
-  (0x00ACB,0x00ACC);
-  (0x00B02,0x00B03);
-  (0x00B3E,0x00B3E);
-  (0x00B40,0x00B40);
-  (0x00B47,0x00B48);
-  (0x00B4B,0x00B4C);
-  (0x00B57,0x00B57);
-  (0x00BBE,0x00BBF);
-  (0x00BC1,0x00BC2);
-  (0x00BC6,0x00BC8);
-  (0x00BCA,0x00BCC);
-  (0x00BD7,0x00BD7);
-  (0x00C01,0x00C03);
-  (0x00C41,0x00C44);
-  (0x00C82,0x00C83);
-  (0x00CBE,0x00CBE);
-  (0x00CC0,0x00CC4);
-  (0x00CC7,0x00CC8);
-  (0x00CCA,0x00CCB);
-  (0x00CD5,0x00CD6);
-  (0x00D02,0x00D03);
-  (0x00D3E,0x00D40);
-  (0x00D46,0x00D48);
-  (0x00D4A,0x00D4C);
-  (0x00D57,0x00D57);
-  (0x00D82,0x00D83);
-  (0x00DCF,0x00DD1);
-  (0x00DD8,0x00DDF);
-  (0x00DF2,0x00DF3);
-  (0x00F3E,0x00F3F);
-  (0x00F7F,0x00F7F);
-  (0x0102C,0x0102C);
-  (0x01031,0x01031);
-  (0x01038,0x01038);
-  (0x01056,0x01057);
-  (0x017B4,0x017B6);
-  (0x017BE,0x017C5);
-  (0x017C7,0x017C8);
-  (0x1D165,0x1D166);
-  (0x1D16D,0x1D172)
-]
-(* Mark, Enclosing *)
-let me = [
-  (0x00488,0x00489);
-  (0x006DE,0x006DE);
-  (0x020DD,0x020E0);
-  (0x020E2,0x020E4)
-]
-(* Number, Decimal Digit *)
-let nd = [
-  (0x00030,0x00039);
-  (0x00660,0x00669);
-  (0x006F0,0x006F9);
-  (0x00966,0x0096F);
-  (0x009E6,0x009EF);
-  (0x00A66,0x00A6F);
-  (0x00AE6,0x00AEF);
-  (0x00B66,0x00B6F);
-  (0x00BE7,0x00BEF);
-  (0x00C66,0x00C6F);
-  (0x00CE6,0x00CEF);
-  (0x00D66,0x00D6F);
-  (0x00E50,0x00E59);
-  (0x00ED0,0x00ED9);
-  (0x00F20,0x00F29);
-  (0x01040,0x01049);
-  (0x01369,0x01371);
-  (0x017E0,0x017E9);
-  (0x01810,0x01819);
-  (0x0FF10,0x0FF19);
-  (0x1D7CE,0x1D7FF)
-]
-(* Number, Letter *)
-let nl = [
-  (0x016EE,0x016F0);
-  (0x02160,0x02183);
-  (0x03007,0x03007);
-  (0x03021,0x03029);
-  (0x03038,0x0303A);
-  (0x1034A,0x1034A)
-]
-(* Number, Other *)
-let no = [
-  (0x000B2,0x000B3);
-  (0x000B9,0x000B9);
-  (0x000BC,0x000BE);
-  (0x009F4,0x009F9);
-  (0x00BF0,0x00BF2);
-  (0x00F2A,0x00F33);
-  (0x01372,0x0137C);
-  (0x02070,0x02070);
-  (0x02074,0x02079);
-  (0x02080,0x02089);
-  (0x02153,0x0215F);
-  (0x02460,0x0249B);
-  (0x024EA,0x024FE);
-  (0x02776,0x02793);
-  (0x03192,0x03195);
-  (0x03220,0x03229);
-  (0x03251,0x0325F);
-  (0x03280,0x03289);
-  (0x032B1,0x032BF);
-  (0x10320,0x10323)
-]
-(* Separator, Space *)
-let zs = [
-  (0x00020,0x00020);
-  (0x000A0,0x000A0);
-  (0x01680,0x01680);
-  (0x02000,0x0200B);
-  (0x0202F,0x0202F);
-  (0x0205F,0x0205F);
-  (0x03000,0x03000)
-]
-(* Separator, Line *)
-let zl = [
-  (0x02028,0x02028)
-]
-(* Separator, Paragraph *)
-let zp = [
-  (0x02029,0x02029)
-]
-(* Other, Control *)
-let cc = [
-  (0x00000,0x0001F);
-  (0x0007F,0x0009F)
-]
-(* Other, Format *)
-let cf = [
-  (0x006DD,0x006DD);
-  (0x0070F,0x0070F);
-  (0x0180E,0x0180E);
-  (0x0200C,0x0200F);
-  (0x0202A,0x0202E);
-  (0x02060,0x02063);
-  (0x0206A,0x0206F);
-  (0x0FEFF,0x0FEFF);
-  (0x0FFF9,0x0FFFB);
-  (0x1D173,0x1D17A);
-  (0xE0001,0xE0001);
-  (0xE0020,0xE007F)
-]
-(* Other, Surrogate *)
-let cs = [
-  (0x0D800,0x0DEFE);
-  (0x0DFFF,0x0DFFF)
-]
-(* Other, Private Use *)
-let co = [
-  (0x0E000,0x0F8FF)
-]
-(* Other, Not Assigned *)
-let cn = [
-  (0x00221,0x00221);
-  (0x00234,0x0024F);
-  (0x002AE,0x002AF);
-  (0x002EF,0x002FF);
-  (0x00350,0x0035F);
-  (0x00370,0x00373);
-  (0x00376,0x00379);
-  (0x0037B,0x0037D);
-  (0x0037F,0x00383);
-  (0x0038B,0x0038B);
-  (0x0038D,0x0038D);
-  (0x003A2,0x003A2);
-  (0x003CF,0x003CF);
-  (0x003F7,0x003FF);
-  (0x00487,0x00487);
-  (0x004CF,0x004CF);
-  (0x004F6,0x004F7);
-  (0x004FA,0x004FF);
-  (0x00510,0x00530);
-  (0x00557,0x00558);
-  (0x00560,0x00560);
-  (0x00588,0x00588);
-  (0x0058B,0x00590);
-  (0x005A2,0x005A2);
-  (0x005BA,0x005BA);
-  (0x005C5,0x005CF);
-  (0x005EB,0x005EF);
-  (0x005F5,0x0060B);
-  (0x0060D,0x0061A);
-  (0x0061C,0x0061E);
-  (0x00620,0x00620);
-  (0x0063B,0x0063F);
-  (0x00656,0x0065F);
-  (0x006EE,0x006EF);
-  (0x006FF,0x006FF);
-  (0x0070E,0x0070E);
-  (0x0072D,0x0072F);
-  (0x0074B,0x0077F);
-  (0x007B2,0x00900);
-  (0x00904,0x00904);
-  (0x0093A,0x0093B);
-  (0x0094E,0x0094F);
-  (0x00955,0x00957);
-  (0x00971,0x00980);
-  (0x00984,0x00984);
-  (0x0098D,0x0098E);
-  (0x00991,0x00992);
-  (0x009A9,0x009A9);
-  (0x009B1,0x009B1);
-  (0x009B3,0x009B5);
-  (0x009BA,0x009BB);
-  (0x009BD,0x009BD);
-  (0x009C5,0x009C6);
-  (0x009C9,0x009CA);
-  (0x009CE,0x009D6);
-  (0x009D8,0x009DB);
-  (0x009DE,0x009DE);
-  (0x009E4,0x009E5);
-  (0x009FB,0x00A01);
-  (0x00A03,0x00A04);
-  (0x00A0B,0x00A0E);
-  (0x00A11,0x00A12);
-  (0x00A29,0x00A29);
-  (0x00A31,0x00A31);
-  (0x00A34,0x00A34);
-  (0x00A37,0x00A37);
-  (0x00A3A,0x00A3B);
-  (0x00A3D,0x00A3D);
-  (0x00A43,0x00A46);
-  (0x00A49,0x00A4A);
-  (0x00A4E,0x00A58);
-  (0x00A5D,0x00A5D);
-  (0x00A5F,0x00A65);
-  (0x00A75,0x00A80);
-  (0x00A84,0x00A84);
-  (0x00A8C,0x00A8C);
-  (0x00A8E,0x00A8E);
-  (0x00A92,0x00A92);
-  (0x00AA9,0x00AA9);
-  (0x00AB1,0x00AB1);
-  (0x00AB4,0x00AB4);
-  (0x00ABA,0x00ABB);
-  (0x00AC6,0x00AC6);
-  (0x00ACA,0x00ACA);
-  (0x00ACE,0x00ACF);
-  (0x00AD1,0x00ADF);
-  (0x00AE1,0x00AE5);
-  (0x00AF0,0x00B00);
-  (0x00B04,0x00B04);
-  (0x00B0D,0x00B0E);
-  (0x00B11,0x00B12);
-  (0x00B29,0x00B29);
-  (0x00B31,0x00B31);
-  (0x00B34,0x00B35);
-  (0x00B3A,0x00B3B);
-  (0x00B44,0x00B46);
-  (0x00B49,0x00B4A);
-  (0x00B4E,0x00B55);
-  (0x00B58,0x00B5B);
-  (0x00B5E,0x00B5E);
-  (0x00B62,0x00B65);
-  (0x00B71,0x00B81);
-  (0x00B84,0x00B84);
-  (0x00B8B,0x00B8D);
-  (0x00B91,0x00B91);
-  (0x00B96,0x00B98);
-  (0x00B9B,0x00B9B);
-  (0x00B9D,0x00B9D);
-  (0x00BA0,0x00BA2);
-  (0x00BA5,0x00BA7);
-  (0x00BAB,0x00BAD);
-  (0x00BB6,0x00BB6);
-  (0x00BBA,0x00BBD);
-  (0x00BC3,0x00BC5);
-  (0x00BC9,0x00BC9);
-  (0x00BCE,0x00BD6);
-  (0x00BD8,0x00BE6);
-  (0x00BF3,0x00C00);
-  (0x00C04,0x00C04);
-  (0x00C0D,0x00C0D);
-  (0x00C11,0x00C11);
-  (0x00C29,0x00C29);
-  (0x00C34,0x00C34);
-  (0x00C3A,0x00C3D);
-  (0x00C45,0x00C45);
-  (0x00C49,0x00C49);
-  (0x00C4E,0x00C54);
-  (0x00C57,0x00C5F);
-  (0x00C62,0x00C65);
-  (0x00C70,0x00C81);
-  (0x00C84,0x00C84);
-  (0x00C8D,0x00C8D);
-  (0x00C91,0x00C91);
-  (0x00CA9,0x00CA9);
-  (0x00CB4,0x00CB4);
-  (0x00CBA,0x00CBD);
-  (0x00CC5,0x00CC5);
-  (0x00CC9,0x00CC9);
-  (0x00CCE,0x00CD4);
-  (0x00CD7,0x00CDD);
-  (0x00CDF,0x00CDF);
-  (0x00CE2,0x00CE5);
-  (0x00CF0,0x00D01);
-  (0x00D04,0x00D04);
-  (0x00D0D,0x00D0D);
-  (0x00D11,0x00D11);
-  (0x00D29,0x00D29);
-  (0x00D3A,0x00D3D);
-  (0x00D44,0x00D45);
-  (0x00D49,0x00D49);
-  (0x00D4E,0x00D56);
-  (0x00D58,0x00D5F);
-  (0x00D62,0x00D65);
-  (0x00D70,0x00D81);
-  (0x00D84,0x00D84);
-  (0x00D97,0x00D99);
-  (0x00DB2,0x00DB2);
-  (0x00DBC,0x00DBC);
-  (0x00DBE,0x00DBF);
-  (0x00DC7,0x00DC9);
-  (0x00DCB,0x00DCE);
-  (0x00DD5,0x00DD5);
-  (0x00DD7,0x00DD7);
-  (0x00DE0,0x00DF1);
-  (0x00DF5,0x00E00);
-  (0x00E3B,0x00E3E);
-  (0x00E5C,0x00E80);
-  (0x00E83,0x00E83);
-  (0x00E85,0x00E86);
-  (0x00E89,0x00E89);
-  (0x00E8B,0x00E8C);
-  (0x00E8E,0x00E93);
-  (0x00E98,0x00E98);
-  (0x00EA0,0x00EA0);
-  (0x00EA4,0x00EA4);
-  (0x00EA6,0x00EA6);
-  (0x00EA8,0x00EA9);
-  (0x00EAC,0x00EAC);
-  (0x00EBA,0x00EBA);
-  (0x00EBE,0x00EBF);
-  (0x00EC5,0x00EC5);
-  (0x00EC7,0x00EC7);
-  (0x00ECE,0x00ECF);
-  (0x00EDA,0x00EDB);
-  (0x00EDE,0x00EFF);
-  (0x00F48,0x00F48);
-  (0x00F6B,0x00F70);
-  (0x00F8C,0x00F8F);
-  (0x00F98,0x00F98);
-  (0x00FBD,0x00FBD);
-  (0x00FCD,0x00FCE);
-  (0x00FD0,0x00FFF);
-  (0x01022,0x01022);
-  (0x01028,0x01028);
-  (0x0102B,0x0102B);
-  (0x01033,0x01035);
-  (0x0103A,0x0103F);
-  (0x0105A,0x0109F);
-  (0x010C6,0x010CF);
-  (0x010F9,0x010FA);
-  (0x010FC,0x010FF);
-  (0x0115A,0x0115E);
-  (0x011A3,0x011A7);
-  (0x011FA,0x011FF);
-  (0x01207,0x01207);
-  (0x01247,0x01247);
-  (0x01249,0x01249);
-  (0x0124E,0x0124F);
-  (0x01257,0x01257);
-  (0x01259,0x01259);
-  (0x0125E,0x0125F);
-  (0x01287,0x01287);
-  (0x01289,0x01289);
-  (0x0128E,0x0128F);
-  (0x012AF,0x012AF);
-  (0x012B1,0x012B1);
-  (0x012B6,0x012B7);
-  (0x012BF,0x012BF);
-  (0x012C1,0x012C1);
-  (0x012C6,0x012C7);
-  (0x012CF,0x012CF);
-  (0x012D7,0x012D7);
-  (0x012EF,0x012EF);
-  (0x0130F,0x0130F);
-  (0x01311,0x01311);
-  (0x01316,0x01317);
-  (0x0131F,0x0131F);
-  (0x01347,0x01347);
-  (0x0135B,0x01360);
-  (0x0137D,0x0139F);
-  (0x013F5,0x01400);
-  (0x01677,0x0167F);
-  (0x0169D,0x0169F);
-  (0x016F1,0x016FF);
-  (0x0170D,0x0170D);
-  (0x01715,0x0171F);
-  (0x01737,0x0173F);
-  (0x01754,0x0175F);
-  (0x0176D,0x0176D);
-  (0x01771,0x01771);
-  (0x01774,0x0177F);
-  (0x017DD,0x017DF);
-  (0x017EA,0x017FF);
-  (0x0180F,0x0180F);
-  (0x0181A,0x0181F);
-  (0x01878,0x0187F);
-  (0x018AA,0x01DFF);
-  (0x01E9C,0x01E9F);
-  (0x01EFA,0x01EFF);
-  (0x01F16,0x01F17);
-  (0x01F1E,0x01F1F);
-  (0x01F46,0x01F47);
-  (0x01F4E,0x01F4F);
-  (0x01F58,0x01F58);
-  (0x01F5A,0x01F5A);
-  (0x01F5C,0x01F5C);
-  (0x01F5E,0x01F5E);
-  (0x01F7E,0x01F7F);
-  (0x01FB5,0x01FB5);
-  (0x01FC5,0x01FC5);
-  (0x01FD4,0x01FD5);
-  (0x01FDC,0x01FDC);
-  (0x01FF0,0x01FF1);
-  (0x01FF5,0x01FF5);
-  (0x01FFF,0x01FFF);
-  (0x02053,0x02056);
-  (0x02058,0x0205E);
-  (0x02064,0x02069);
-  (0x02072,0x02073);
-  (0x0208F,0x0209F);
-  (0x020B2,0x020CF);
-  (0x020EB,0x020FF);
-  (0x0213B,0x0213C);
-  (0x0214C,0x02152);
-  (0x02184,0x0218F);
-  (0x023CF,0x023FF);
-  (0x02427,0x0243F);
-  (0x0244B,0x0245F);
-  (0x024FF,0x024FF);
-  (0x02614,0x02615);
-  (0x02618,0x02618);
-  (0x0267E,0x0267F);
-  (0x0268A,0x02700);
-  (0x02705,0x02705);
-  (0x0270A,0x0270B);
-  (0x02728,0x02728);
-  (0x0274C,0x0274C);
-  (0x0274E,0x0274E);
-  (0x02753,0x02755);
-  (0x02757,0x02757);
-  (0x0275F,0x02760);
-  (0x02795,0x02797);
-  (0x027B0,0x027B0);
-  (0x027BF,0x027CF);
-  (0x027EC,0x027EF);
-  (0x02B00,0x02E7F);
-  (0x02E9A,0x02E9A);
-  (0x02EF4,0x02EFF);
-  (0x02FD6,0x02FEF);
-  (0x02FFC,0x02FFF);
-  (0x03040,0x03040);
-  (0x03097,0x03098);
-  (0x03100,0x03104);
-  (0x0312D,0x03130);
-  (0x0318F,0x0318F);
-  (0x031B8,0x031EF);
-  (0x0321D,0x0321F);
-  (0x03244,0x03250);
-  (0x0327C,0x0327E);
-  (0x032CC,0x032CF);
-  (0x032FF,0x032FF);
-  (0x03377,0x0337A);
-  (0x033DE,0x033DF);
-  (0x033FF,0x033FF);
-  (0x04DB6,0x04DFF);
-  (0x09FA6,0x09FFF);
-  (0x0A48D,0x0A48F);
-  (0x0A4C7,0x0ABFF);
-  (0x0D7A4,0x0D7FF);
-  (0x0DEFF,0x0DFFE);
-  (0x0FA2E,0x0FA2F);
-  (0x0FA6B,0x0FAFF);
-  (0x0FB07,0x0FB12);
-  (0x0FB18,0x0FB1C);
-  (0x0FB37,0x0FB37);
-  (0x0FB3D,0x0FB3D);
-  (0x0FB3F,0x0FB3F);
-  (0x0FB42,0x0FB42);
-  (0x0FB45,0x0FB45);
-  (0x0FBB2,0x0FBD2);
-  (0x0FD40,0x0FD4F);
-  (0x0FD90,0x0FD91);
-  (0x0FDC8,0x0FDEF);
-  (0x0FDFD,0x0FDFF);
-  (0x0FE10,0x0FE1F);
-  (0x0FE24,0x0FE2F);
-  (0x0FE47,0x0FE48);
-  (0x0FE53,0x0FE53);
-  (0x0FE67,0x0FE67);
-  (0x0FE6C,0x0FE6F);
-  (0x0FE75,0x0FE75);
-  (0x0FEFD,0x0FEFE);
-  (0x0FF00,0x0FF00);
-  (0x0FFBF,0x0FFC1);
-  (0x0FFC8,0x0FFC9);
-  (0x0FFD0,0x0FFD1);
-  (0x0FFD8,0x0FFD9);
-  (0x0FFDD,0x0FFDF);
-  (0x0FFE7,0x0FFE7);
-  (0x0FFEF,0x0FFF8);
-  (0x0FFFE,0x102FF);
-  (0x1031F,0x1031F);
-  (0x10324,0x1032F);
-  (0x1034B,0x103FF);
-  (0x10426,0x10427);
-  (0x1044E,0x1CFFF);
-  (0x1D0F6,0x1D0FF);
-  (0x1D127,0x1D129);
-  (0x1D1DE,0x1D3FF);
-  (0x1D455,0x1D455);
-  (0x1D49D,0x1D49D);
-  (0x1D4A0,0x1D4A1);
-  (0x1D4A3,0x1D4A4);
-  (0x1D4A7,0x1D4A8);
-  (0x1D4AD,0x1D4AD);
-  (0x1D4BA,0x1D4BA);
-  (0x1D4BC,0x1D4BC);
-  (0x1D4C1,0x1D4C1);
-  (0x1D4C4,0x1D4C4);
-  (0x1D506,0x1D506);
-  (0x1D50B,0x1D50C);
-  (0x1D515,0x1D515);
-  (0x1D51D,0x1D51D);
-  (0x1D53A,0x1D53A);
-  (0x1D53F,0x1D53F);
-  (0x1D545,0x1D545);
-  (0x1D547,0x1D549);
-  (0x1D551,0x1D551);
-  (0x1D6A4,0x1D6A7);
-  (0x1D7CA,0x1D7CD);
-  (0x1D800,0x1FFFF);
-  (0x2A6D7,0x2F7FF);
-  (0x2FA1E,0xE0000);
-  (0xE0002,0xE001F);
-  (0xE0080,0x7FFFFFFF)
-]
-(* Letter, Modifier *)
-let lm = [
-  (0x002B0,0x002B8);
-  (0x002BB,0x002C1);
-  (0x002D0,0x002D1);
-  (0x002E0,0x002E4);
-  (0x002EE,0x002EE);
-  (0x0037A,0x0037A);
-  (0x00559,0x00559);
-  (0x00640,0x00640);
-  (0x006E5,0x006E6);
-  (0x00E46,0x00E46);
-  (0x00EC6,0x00EC6);
-  (0x017D7,0x017D7);
-  (0x01843,0x01843);
-  (0x03005,0x03005);
-  (0x03031,0x03035);
-  (0x0303B,0x0303B);
-  (0x0309D,0x0309E);
-  (0x030FC,0x030FE);
-  (0x0FF70,0x0FF70);
-  (0x0FF9E,0x0FF9F)
-]
-(* Letter, Other *)
-let lo = [
-  (0x001BB,0x001BB);
-  (0x001C0,0x001C3);
-  (0x005D0,0x005EA);
-  (0x005F0,0x005F2);
-  (0x00621,0x0063A);
-  (0x00641,0x0064A);
-  (0x0066E,0x0066F);
-  (0x00671,0x006D3);
-  (0x006D5,0x006D5);
-  (0x006FA,0x006FC);
-  (0x00710,0x00710);
-  (0x00712,0x0072C);
-  (0x00780,0x007A5);
-  (0x007B1,0x007B1);
-  (0x00905,0x00939);
-  (0x0093D,0x0093D);
-  (0x00950,0x00950);
-  (0x00958,0x00961);
-  (0x00985,0x0098C);
-  (0x0098F,0x00990);
-  (0x00993,0x009A8);
-  (0x009AA,0x009B0);
-  (0x009B2,0x009B2);
-  (0x009B6,0x009B9);
-  (0x009DC,0x009DD);
-  (0x009DF,0x009E1);
-  (0x009F0,0x009F1);
-  (0x00A05,0x00A0A);
-  (0x00A0F,0x00A10);
-  (0x00A13,0x00A28);
-  (0x00A2A,0x00A30);
-  (0x00A32,0x00A33);
-  (0x00A35,0x00A36);
-  (0x00A38,0x00A39);
-  (0x00A59,0x00A5C);
-  (0x00A5E,0x00A5E);
-  (0x00A72,0x00A74);
-  (0x00A85,0x00A8B);
-  (0x00A8D,0x00A8D);
-  (0x00A8F,0x00A91);
-  (0x00A93,0x00AA8);
-  (0x00AAA,0x00AB0);
-  (0x00AB2,0x00AB3);
-  (0x00AB5,0x00AB9);
-  (0x00ABD,0x00ABD);
-  (0x00AD0,0x00AD0);
-  (0x00AE0,0x00AE0);
-  (0x00B05,0x00B0C);
-  (0x00B0F,0x00B10);
-  (0x00B13,0x00B28);
-  (0x00B2A,0x00B30);
-  (0x00B32,0x00B33);
-  (0x00B36,0x00B39);
-  (0x00B3D,0x00B3D);
-  (0x00B5C,0x00B5D);
-  (0x00B5F,0x00B61);
-  (0x00B83,0x00B83);
-  (0x00B85,0x00B8A);
-  (0x00B8E,0x00B90);
-  (0x00B92,0x00B95);
-  (0x00B99,0x00B9A);
-  (0x00B9C,0x00B9C);
-  (0x00B9E,0x00B9F);
-  (0x00BA3,0x00BA4);
-  (0x00BA8,0x00BAA);
-  (0x00BAE,0x00BB5);
-  (0x00BB7,0x00BB9);
-  (0x00C05,0x00C0C);
-  (0x00C0E,0x00C10);
-  (0x00C12,0x00C28);
-  (0x00C2A,0x00C33);
-  (0x00C35,0x00C39);
-  (0x00C60,0x00C61);
-  (0x00C85,0x00C8C);
-  (0x00C8E,0x00C90);
-  (0x00C92,0x00CA8);
-  (0x00CAA,0x00CB3);
-  (0x00CB5,0x00CB9);
-  (0x00CDE,0x00CDE);
-  (0x00CE0,0x00CE1);
-  (0x00D05,0x00D0C);
-  (0x00D0E,0x00D10);
-  (0x00D12,0x00D28);
-  (0x00D2A,0x00D39);
-  (0x00D60,0x00D61);
-  (0x00D85,0x00D96);
-  (0x00D9A,0x00DB1);
-  (0x00DB3,0x00DBB);
-  (0x00DBD,0x00DBD);
-  (0x00DC0,0x00DC6);
-  (0x00E01,0x00E30);
-  (0x00E32,0x00E33);
-  (0x00E40,0x00E45);
-  (0x00E81,0x00E82);
-  (0x00E84,0x00E84);
-  (0x00E87,0x00E88);
-  (0x00E8A,0x00E8A);
-  (0x00E8D,0x00E8D);
-  (0x00E94,0x00E97);
-  (0x00E99,0x00E9F);
-  (0x00EA1,0x00EA3);
-  (0x00EA5,0x00EA5);
-  (0x00EA7,0x00EA7);
-  (0x00EAA,0x00EAB);
-  (0x00EAD,0x00EB0);
-  (0x00EB2,0x00EB3);
-  (0x00EBD,0x00EBD);
-  (0x00EC0,0x00EC4);
-  (0x00EDC,0x00EDD);
-  (0x00F00,0x00F00);
-  (0x00F40,0x00F47);
-  (0x00F49,0x00F6A);
-  (0x00F88,0x00F8B);
-  (0x01000,0x01021);
-  (0x01023,0x01027);
-  (0x01029,0x0102A);
-  (0x01050,0x01055);
-  (0x010D0,0x010F8);
-  (0x01100,0x01159);
-  (0x0115F,0x011A2);
-  (0x011A8,0x011F9);
-  (0x01200,0x01206);
-  (0x01208,0x01246);
-  (0x01248,0x01248);
-  (0x0124A,0x0124D);
-  (0x01250,0x01256);
-  (0x01258,0x01258);
-  (0x0125A,0x0125D);
-  (0x01260,0x01286);
-  (0x01288,0x01288);
-  (0x0128A,0x0128D);
-  (0x01290,0x012AE);
-  (0x012B0,0x012B0);
-  (0x012B2,0x012B5);
-  (0x012B8,0x012BE);
-  (0x012C0,0x012C0);
-  (0x012C2,0x012C5);
-  (0x012C8,0x012CE);
-  (0x012D0,0x012D6);
-  (0x012D8,0x012EE);
-  (0x012F0,0x0130E);
-  (0x01310,0x01310);
-  (0x01312,0x01315);
-  (0x01318,0x0131E);
-  (0x01320,0x01346);
-  (0x01348,0x0135A);
-  (0x013A0,0x013F4);
-  (0x01401,0x0166C);
-  (0x0166F,0x01676);
-  (0x01681,0x0169A);
-  (0x016A0,0x016EA);
-  (0x01700,0x0170C);
-  (0x0170E,0x01711);
-  (0x01720,0x01731);
-  (0x01740,0x01751);
-  (0x01760,0x0176C);
-  (0x0176E,0x01770);
-  (0x01780,0x017B3);
-  (0x017DC,0x017DC);
-  (0x01820,0x01842);
-  (0x01844,0x01877);
-  (0x01880,0x018A8);
-  (0x02135,0x02138);
-  (0x03006,0x03006);
-  (0x0303C,0x0303C);
-  (0x03041,0x03096);
-  (0x0309F,0x0309F);
-  (0x030A1,0x030FA);
-  (0x030FF,0x030FF);
-  (0x03105,0x0312C);
-  (0x03131,0x0318E);
-  (0x031A0,0x031B7);
-  (0x031F0,0x031FF);
-  (0x03400,0x04DB5);
-  (0x04E00,0x09FA5);
-  (0x0A000,0x0A48C);
-  (0x0AC00,0x0D7A3);
-  (0x0F900,0x0FA2D);
-  (0x0FA30,0x0FA6A);
-  (0x0FB1D,0x0FB1D);
-  (0x0FB1F,0x0FB28);
-  (0x0FB2A,0x0FB36);
-  (0x0FB38,0x0FB3C);
-  (0x0FB3E,0x0FB3E);
-  (0x0FB40,0x0FB41);
-  (0x0FB43,0x0FB44);
-  (0x0FB46,0x0FBB1);
-  (0x0FBD3,0x0FD3D);
-  (0x0FD50,0x0FD8F);
-  (0x0FD92,0x0FDC7);
-  (0x0FDF0,0x0FDFB);
-  (0x0FE70,0x0FE74);
-  (0x0FE76,0x0FEFC);
-  (0x0FF66,0x0FF6F);
-  (0x0FF71,0x0FF9D);
-  (0x0FFA0,0x0FFBE);
-  (0x0FFC2,0x0FFC7);
-  (0x0FFCA,0x0FFCF);
-  (0x0FFD2,0x0FFD7);
-  (0x0FFDA,0x0FFDC);
-  (0x10300,0x1031E);
-  (0x10330,0x10349);
-  (0x20000,0x2A6D6);
-  (0x2F800,0x2FA1D)
-]
-(* Punctuation, Connector *)
-let pc = [
-  (0x0005F,0x0005F);
-  (0x0203F,0x02040);
-  (0x030FB,0x030FB);
-  (0x0FE33,0x0FE34);
-  (0x0FE4D,0x0FE4F);
-  (0x0FF3F,0x0FF3F);
-  (0x0FF65,0x0FF65)
-]
-(* Punctuation, Dash *)
-let pd = [
-  (0x0002D,0x0002D);
-  (0x000AD,0x000AD);
-  (0x0058A,0x0058A);
-  (0x01806,0x01806);
-  (0x02010,0x02015);
-  (0x0301C,0x0301C);
-  (0x03030,0x03030);
-  (0x030A0,0x030A0);
-  (0x0FE31,0x0FE32);
-  (0x0FE58,0x0FE58);
-  (0x0FE63,0x0FE63);
-  (0x0FF0D,0x0FF0D)
-]
-(* Punctuation, Open *)
-let ps = [
-  (0x00028,0x00028);
-  (0x0005B,0x0005B);
-  (0x0007B,0x0007B);
-  (0x00F3A,0x00F3A);
-  (0x00F3C,0x00F3C);
-  (0x0169B,0x0169B);
-  (0x0201A,0x0201A);
-  (0x0201E,0x0201E);
-  (0x02045,0x02045);
-  (0x0207D,0x0207D);
-  (0x0208D,0x0208D);
-  (0x02329,0x02329);
-  (0x023B4,0x023B4);
-  (0x02768,0x02768);
-  (0x0276A,0x0276A);
-  (0x0276C,0x0276C);
-  (0x0276E,0x0276E);
-  (0x02770,0x02770);
-  (0x02772,0x02772);
-  (0x02774,0x02774);
-  (0x027E6,0x027E6);
-  (0x027E8,0x027E8);
-  (0x027EA,0x027EA);
-  (0x02983,0x02983);
-  (0x02985,0x02985);
-  (0x02987,0x02987);
-  (0x02989,0x02989);
-  (0x0298B,0x0298B);
-  (0x0298D,0x0298D);
-  (0x0298F,0x0298F);
-  (0x02991,0x02991);
-  (0x02993,0x02993);
-  (0x02995,0x02995);
-  (0x02997,0x02997);
-  (0x029D8,0x029D8);
-  (0x029DA,0x029DA);
-  (0x029FC,0x029FC);
-  (0x03008,0x03008);
-  (0x0300A,0x0300A);
-  (0x0300C,0x0300C);
-  (0x0300E,0x0300E);
-  (0x03010,0x03010);
-  (0x03014,0x03014);
-  (0x03016,0x03016);
-  (0x03018,0x03018);
-  (0x0301A,0x0301A);
-  (0x0301D,0x0301D);
-  (0x0FD3E,0x0FD3E);
-  (0x0FE35,0x0FE35);
-  (0x0FE37,0x0FE37);
-  (0x0FE39,0x0FE39);
-  (0x0FE3B,0x0FE3B);
-  (0x0FE3D,0x0FE3D);
-  (0x0FE3F,0x0FE3F);
-  (0x0FE41,0x0FE41);
-  (0x0FE43,0x0FE43);
-  (0x0FE59,0x0FE59);
-  (0x0FE5B,0x0FE5B);
-  (0x0FE5D,0x0FE5D);
-  (0x0FF08,0x0FF08);
-  (0x0FF3B,0x0FF3B);
-  (0x0FF5B,0x0FF5B);
-  (0x0FF5F,0x0FF5F);
-  (0x0FF62,0x0FF62)
-]
-(* Punctuation, Close *)
-let pe = [
-  (0x00029,0x00029);
-  (0x0005D,0x0005D);
-  (0x0007D,0x0007D);
-  (0x00F3B,0x00F3B);
-  (0x00F3D,0x00F3D);
-  (0x0169C,0x0169C);
-  (0x02046,0x02046);
-  (0x0207E,0x0207E);
-  (0x0208E,0x0208E);
-  (0x0232A,0x0232A);
-  (0x023B5,0x023B5);
-  (0x02769,0x02769);
-  (0x0276B,0x0276B);
-  (0x0276D,0x0276D);
-  (0x0276F,0x0276F);
-  (0x02771,0x02771);
-  (0x02773,0x02773);
-  (0x02775,0x02775);
-  (0x027E7,0x027E7);
-  (0x027E9,0x027E9);
-  (0x027EB,0x027EB);
-  (0x02984,0x02984);
-  (0x02986,0x02986);
-  (0x02988,0x02988);
-  (0x0298A,0x0298A);
-  (0x0298C,0x0298C);
-  (0x0298E,0x0298E);
-  (0x02990,0x02990);
-  (0x02992,0x02992);
-  (0x02994,0x02994);
-  (0x02996,0x02996);
-  (0x02998,0x02998);
-  (0x029D9,0x029D9);
-  (0x029DB,0x029DB);
-  (0x029FD,0x029FD);
-  (0x03009,0x03009);
-  (0x0300B,0x0300B);
-  (0x0300D,0x0300D);
-  (0x0300F,0x0300F);
-  (0x03011,0x03011);
-  (0x03015,0x03015);
-  (0x03017,0x03017);
-  (0x03019,0x03019);
-  (0x0301B,0x0301B);
-  (0x0301E,0x0301F);
-  (0x0FD3F,0x0FD3F);
-  (0x0FE36,0x0FE36);
-  (0x0FE38,0x0FE38);
-  (0x0FE3A,0x0FE3A);
-  (0x0FE3C,0x0FE3C);
-  (0x0FE3E,0x0FE3E);
-  (0x0FE40,0x0FE40);
-  (0x0FE42,0x0FE42);
-  (0x0FE44,0x0FE44);
-  (0x0FE5A,0x0FE5A);
-  (0x0FE5C,0x0FE5C);
-  (0x0FE5E,0x0FE5E);
-  (0x0FF09,0x0FF09);
-  (0x0FF3D,0x0FF3D);
-  (0x0FF5D,0x0FF5D);
-  (0x0FF60,0x0FF60);
-  (0x0FF63,0x0FF63)
-]
-(* Punctuation, Initial quote  *)
-let pi = [
-  (0x000AB,0x000AB);
-  (0x02018,0x02018);
-  (0x0201B,0x0201C);
-  (0x0201F,0x0201F);
-  (0x02039,0x02039)
-]
-(* Punctuation, Final quote  *)
-let pf = [
-  (0x000BB,0x000BB);
-  (0x02019,0x02019);
-  (0x0201D,0x0201D);
-  (0x0203A,0x0203A)
-]
-(* Punctuation, Other *)
-let po = [
-  (0x00021,0x00023);
-  (0x00025,0x00027);
-  (0x0002A,0x0002A);
-  (0x0002C,0x0002C);
-  (0x0002E,0x0002F);
-  (0x0003A,0x0003B);
-  (0x0003F,0x00040);
-  (0x0005C,0x0005C);
-  (0x000A1,0x000A1);
-  (0x000B7,0x000B7);
-  (0x000BF,0x000BF);
-  (0x0037E,0x0037E);
-  (0x00387,0x00387);
-  (0x0055A,0x0055F);
-  (0x00589,0x00589);
-  (0x005BE,0x005BE);
-  (0x005C0,0x005C0);
-  (0x005C3,0x005C3);
-  (0x005F3,0x005F4);
-  (0x0060C,0x0060C);
-  (0x0061B,0x0061B);
-  (0x0061F,0x0061F);
-  (0x0066A,0x0066D);
-  (0x006D4,0x006D4);
-  (0x00700,0x0070D);
-  (0x00964,0x00965);
-  (0x00970,0x00970);
-  (0x00DF4,0x00DF4);
-  (0x00E4F,0x00E4F);
-  (0x00E5A,0x00E5B);
-  (0x00F04,0x00F12);
-  (0x00F85,0x00F85);
-  (0x0104A,0x0104F);
-  (0x010FB,0x010FB);
-  (0x01361,0x01368);
-  (0x0166D,0x0166E);
-  (0x016EB,0x016ED);
-  (0x01735,0x01736);
-  (0x017D4,0x017D6);
-  (0x017D8,0x017DA);
-  (0x01800,0x01805);
-  (0x01807,0x0180A);
-  (0x02016,0x02017);
-  (0x02020,0x02027);
-  (0x02030,0x02038);
-  (0x0203B,0x0203E);
-  (0x02041,0x02043);
-  (0x02047,0x02051);
-  (0x02057,0x02057);
-  (0x023B6,0x023B6);
-  (0x03001,0x03003);
-  (0x0303D,0x0303D);
-  (0x0FE30,0x0FE30);
-  (0x0FE45,0x0FE46);
-  (0x0FE49,0x0FE4C);
-  (0x0FE50,0x0FE52);
-  (0x0FE54,0x0FE57);
-  (0x0FE5F,0x0FE61);
-  (0x0FE68,0x0FE68);
-  (0x0FE6A,0x0FE6B);
-  (0x0FF01,0x0FF03);
-  (0x0FF05,0x0FF07);
-  (0x0FF0A,0x0FF0A);
-  (0x0FF0C,0x0FF0C);
-  (0x0FF0E,0x0FF0F);
-  (0x0FF1A,0x0FF1B);
-  (0x0FF1F,0x0FF20);
-  (0x0FF3C,0x0FF3C);
-  (0x0FF61,0x0FF61);
-  (0x0FF64,0x0FF64)
-]
-(* Symbol, Math *)
-let sm = [
-  (0x0002B,0x0002B);
-  (0x0003C,0x0003E);
-  (0x0007C,0x0007C);
-  (0x0007E,0x0007E);
-  (0x000AC,0x000AC);
-  (0x000B1,0x000B1);
-  (0x000D7,0x000D7);
-  (0x000F7,0x000F7);
-  (0x003F6,0x003F6);
-  (0x02044,0x02044);
-  (0x02052,0x02052);
-  (0x0207A,0x0207C);
-  (0x0208A,0x0208C);
-  (0x02140,0x02144);
-  (0x0214B,0x0214B);
-  (0x02190,0x02194);
-  (0x0219A,0x0219B);
-  (0x021A0,0x021A0);
-  (0x021A3,0x021A3);
-  (0x021A6,0x021A6);
-  (0x021AE,0x021AE);
-  (0x021CE,0x021CF);
-  (0x021D2,0x021D2);
-  (0x021D4,0x021D4);
-  (0x021F4,0x022FF);
-  (0x02308,0x0230B);
-  (0x02320,0x02321);
-  (0x0237C,0x0237C);
-  (0x0239B,0x023B3);
-  (0x025B7,0x025B7);
-  (0x025C1,0x025C1);
-  (0x025F8,0x025FF);
-  (0x0266F,0x0266F);
-  (0x027D0,0x027E5);
-  (0x027F0,0x027FF);
-  (0x02900,0x02982);
-  (0x02999,0x029D7);
-  (0x029DC,0x029FB);
-  (0x029FE,0x02AFF);
-  (0x0FB29,0x0FB29);
-  (0x0FE62,0x0FE62);
-  (0x0FE64,0x0FE66);
-  (0x0FF0B,0x0FF0B);
-  (0x0FF1C,0x0FF1E);
-  (0x0FF5C,0x0FF5C);
-  (0x0FF5E,0x0FF5E);
-  (0x0FFE2,0x0FFE2);
-  (0x0FFE9,0x0FFEC);
-  (0x1D6C1,0x1D6C1);
-  (0x1D6DB,0x1D6DB);
-  (0x1D6FB,0x1D6FB);
-  (0x1D715,0x1D715);
-  (0x1D735,0x1D735);
-  (0x1D74F,0x1D74F);
-  (0x1D76F,0x1D76F);
-  (0x1D789,0x1D789);
-  (0x1D7A9,0x1D7A9);
-  (0x1D7C3,0x1D7C3)
-]
-(* Symbol, Currency *)
-let sc = [
-  (0x00024,0x00024);
-  (0x000A2,0x000A5);
-  (0x009F2,0x009F3);
-  (0x00E3F,0x00E3F);
-  (0x017DB,0x017DB);
-  (0x020A0,0x020B1);
-  (0x0FDFC,0x0FDFC);
-  (0x0FE69,0x0FE69);
-  (0x0FF04,0x0FF04);
-  (0x0FFE0,0x0FFE1);
-  (0x0FFE5,0x0FFE6)
-]
-(* Symbol, Modifier *)
-let sk = [
-  (0x0005E,0x0005E);
-  (0x00060,0x00060);
-  (0x000A8,0x000A8);
-  (0x000AF,0x000AF);
-  (0x000B4,0x000B4);
-  (0x000B8,0x000B8);
-  (0x002B9,0x002BA);
-  (0x002C2,0x002CF);
-  (0x002D2,0x002DF);
-  (0x002E5,0x002ED);
-  (0x00374,0x00375);
-  (0x00384,0x00385);
-  (0x01FBD,0x01FBD);
-  (0x01FBF,0x01FC1);
-  (0x01FCD,0x01FCF);
-  (0x01FDD,0x01FDF);
-  (0x01FED,0x01FEF);
-  (0x01FFD,0x01FFE);
-  (0x0309B,0x0309C);
-  (0x0FF3E,0x0FF3E);
-  (0x0FF40,0x0FF40);
-  (0x0FFE3,0x0FFE3)
-]
-(* Symbol, Other  *)
-let so = [
-  (0x000A6,0x000A7);
-  (0x000A9,0x000A9);
-  (0x000AE,0x000AE);
-  (0x000B0,0x000B0);
-  (0x000B6,0x000B6);
-  (0x00482,0x00482);
-  (0x006E9,0x006E9);
-  (0x006FD,0x006FE);
-  (0x009FA,0x009FA);
-  (0x00B70,0x00B70);
-  (0x00F01,0x00F03);
-  (0x00F13,0x00F17);
-  (0x00F1A,0x00F1F);
-  (0x00F34,0x00F34);
-  (0x00F36,0x00F36);
-  (0x00F38,0x00F38);
-  (0x00FBE,0x00FC5);
-  (0x00FC7,0x00FCC);
-  (0x00FCF,0x00FCF);
-  (0x02100,0x02101);
-  (0x02103,0x02106);
-  (0x02108,0x02109);
-  (0x02114,0x02114);
-  (0x02116,0x02118);
-  (0x0211E,0x02123);
-  (0x02125,0x02125);
-  (0x02127,0x02127);
-  (0x02129,0x02129);
-  (0x0212E,0x0212E);
-  (0x02132,0x02132);
-  (0x0213A,0x0213A);
-  (0x0214A,0x0214A);
-  (0x02195,0x02199);
-  (0x0219C,0x0219F);
-  (0x021A1,0x021A2);
-  (0x021A4,0x021A5);
-  (0x021A7,0x021AD);
-  (0x021AF,0x021CD);
-  (0x021D0,0x021D1);
-  (0x021D3,0x021D3);
-  (0x021D5,0x021F3);
-  (0x02300,0x02307);
-  (0x0230C,0x0231F);
-  (0x02322,0x02328);
-  (0x0232B,0x0237B);
-  (0x0237D,0x0239A);
-  (0x023B7,0x023CE);
-  (0x02400,0x02426);
-  (0x02440,0x0244A);
-  (0x0249C,0x024E9);
-  (0x02500,0x025B6);
-  (0x025B8,0x025C0);
-  (0x025C2,0x025F7);
-  (0x02600,0x02613);
-  (0x02616,0x02617);
-  (0x02619,0x0266E);
-  (0x02670,0x0267D);
-  (0x02680,0x02689);
-  (0x02701,0x02704);
-  (0x02706,0x02709);
-  (0x0270C,0x02727);
-  (0x02729,0x0274B);
-  (0x0274D,0x0274D);
-  (0x0274F,0x02752);
-  (0x02756,0x02756);
-  (0x02758,0x0275E);
-  (0x02761,0x02767);
-  (0x02794,0x02794);
-  (0x02798,0x027AF);
-  (0x027B1,0x027BE);
-  (0x02800,0x028FF);
-  (0x02E80,0x02E99);
-  (0x02E9B,0x02EF3);
-  (0x02F00,0x02FD5);
-  (0x02FF0,0x02FFB);
-  (0x03004,0x03004);
-  (0x03012,0x03013);
-  (0x03020,0x03020);
-  (0x03036,0x03037);
-  (0x0303E,0x0303F);
-  (0x03190,0x03191);
-  (0x03196,0x0319F);
-  (0x03200,0x0321C);
-  (0x0322A,0x03243);
-  (0x03260,0x0327B);
-  (0x0327F,0x0327F);
-  (0x0328A,0x032B0);
-  (0x032C0,0x032CB);
-  (0x032D0,0x032FE);
-  (0x03300,0x03376);
-  (0x0337B,0x033DD);
-  (0x033E0,0x033FE);
-  (0x0A490,0x0A4C6);
-  (0x0FFE4,0x0FFE4);
-  (0x0FFE8,0x0FFE8);
-  (0x0FFED,0x0FFEE);
-  (0x0FFFC,0x0FFFD);
-  (0x1D000,0x1D0F5);
-  (0x1D100,0x1D126);
-  (0x1D12A,0x1D164);
-  (0x1D16A,0x1D16C);
-  (0x1D183,0x1D184);
-  (0x1D18C,0x1D1A9);
-  (0x1D1AE,0x1D1DD)
-]
-
-(* Conversion to lower case. *)
-let to_lower = [
-  (0x00041,0x0005A), `Delta (32);
-  (0x000C0,0x000D6), `Delta (32);
-  (0x000D8,0x000DE), `Delta (32);
-  (0x00100,0x00100), `Abs (0x00101);
-  (0x00102,0x00102), `Abs (0x00103);
-  (0x00104,0x00104), `Abs (0x00105);
-  (0x00106,0x00106), `Abs (0x00107);
-  (0x00108,0x00108), `Abs (0x00109);
-  (0x0010A,0x0010A), `Abs (0x0010B);
-  (0x0010C,0x0010C), `Abs (0x0010D);
-  (0x0010E,0x0010E), `Abs (0x0010F);
-  (0x00110,0x00110), `Abs (0x00111);
-  (0x00112,0x00112), `Abs (0x00113);
-  (0x00114,0x00114), `Abs (0x00115);
-  (0x00116,0x00116), `Abs (0x00117);
-  (0x00118,0x00118), `Abs (0x00119);
-  (0x0011A,0x0011A), `Abs (0x0011B);
-  (0x0011C,0x0011C), `Abs (0x0011D);
-  (0x0011E,0x0011E), `Abs (0x0011F);
-  (0x00120,0x00120), `Abs (0x00121);
-  (0x00122,0x00122), `Abs (0x00123);
-  (0x00124,0x00124), `Abs (0x00125);
-  (0x00126,0x00126), `Abs (0x00127);
-  (0x00128,0x00128), `Abs (0x00129);
-  (0x0012A,0x0012A), `Abs (0x0012B);
-  (0x0012C,0x0012C), `Abs (0x0012D);
-  (0x0012E,0x0012E), `Abs (0x0012F);
-  (0x00130,0x00130), `Abs (0x00069);
-  (0x00132,0x00132), `Abs (0x00133);
-  (0x00134,0x00134), `Abs (0x00135);
-  (0x00136,0x00136), `Abs (0x00137);
-  (0x00139,0x00139), `Abs (0x0013A);
-  (0x0013B,0x0013B), `Abs (0x0013C);
-  (0x0013D,0x0013D), `Abs (0x0013E);
-  (0x0013F,0x0013F), `Abs (0x00140);
-  (0x00141,0x00141), `Abs (0x00142);
-  (0x00143,0x00143), `Abs (0x00144);
-  (0x00145,0x00145), `Abs (0x00146);
-  (0x00147,0x00147), `Abs (0x00148);
-  (0x0014A,0x0014A), `Abs (0x0014B);
-  (0x0014C,0x0014C), `Abs (0x0014D);
-  (0x0014E,0x0014E), `Abs (0x0014F);
-  (0x00150,0x00150), `Abs (0x00151);
-  (0x00152,0x00152), `Abs (0x00153);
-  (0x00154,0x00154), `Abs (0x00155);
-  (0x00156,0x00156), `Abs (0x00157);
-  (0x00158,0x00158), `Abs (0x00159);
-  (0x0015A,0x0015A), `Abs (0x0015B);
-  (0x0015C,0x0015C), `Abs (0x0015D);
-  (0x0015E,0x0015E), `Abs (0x0015F);
-  (0x00160,0x00160), `Abs (0x00161);
-  (0x00162,0x00162), `Abs (0x00163);
-  (0x00164,0x00164), `Abs (0x00165);
-  (0x00166,0x00166), `Abs (0x00167);
-  (0x00168,0x00168), `Abs (0x00169);
-  (0x0016A,0x0016A), `Abs (0x0016B);
-  (0x0016C,0x0016C), `Abs (0x0016D);
-  (0x0016E,0x0016E), `Abs (0x0016F);
-  (0x00170,0x00170), `Abs (0x00171);
-  (0x00172,0x00172), `Abs (0x00173);
-  (0x00174,0x00174), `Abs (0x00175);
-  (0x00176,0x00176), `Abs (0x00177);
-  (0x00178,0x00178), `Abs (0x000FF);
-  (0x00179,0x00179), `Abs (0x0017A);
-  (0x0017B,0x0017B), `Abs (0x0017C);
-  (0x0017D,0x0017D), `Abs (0x0017E);
-  (0x00181,0x00181), `Abs (0x00253);
-  (0x00182,0x00182), `Abs (0x00183);
-  (0x00184,0x00184), `Abs (0x00185);
-  (0x00186,0x00186), `Abs (0x00254);
-  (0x00187,0x00187), `Abs (0x00188);
-  (0x00189,0x0018A), `Delta (205);
-  (0x0018B,0x0018B), `Abs (0x0018C);
-  (0x0018E,0x0018E), `Abs (0x001DD);
-  (0x0018F,0x0018F), `Abs (0x00259);
-  (0x00190,0x00190), `Abs (0x0025B);
-  (0x00191,0x00191), `Abs (0x00192);
-  (0x00193,0x00193), `Abs (0x00260);
-  (0x00194,0x00194), `Abs (0x00263);
-  (0x00196,0x00196), `Abs (0x00269);
-  (0x00197,0x00197), `Abs (0x00268);
-  (0x00198,0x00198), `Abs (0x00199);
-  (0x0019C,0x0019C), `Abs (0x0026F);
-  (0x0019D,0x0019D), `Abs (0x00272);
-  (0x0019F,0x0019F), `Abs (0x00275);
-  (0x001A0,0x001A0), `Abs (0x001A1);
-  (0x001A2,0x001A2), `Abs (0x001A3);
-  (0x001A4,0x001A4), `Abs (0x001A5);
-  (0x001A6,0x001A6), `Abs (0x00280);
-  (0x001A7,0x001A7), `Abs (0x001A8);
-  (0x001A9,0x001A9), `Abs (0x00283);
-  (0x001AC,0x001AC), `Abs (0x001AD);
-  (0x001AE,0x001AE), `Abs (0x00288);
-  (0x001AF,0x001AF), `Abs (0x001B0);
-  (0x001B1,0x001B2), `Delta (217);
-  (0x001B3,0x001B3), `Abs (0x001B4);
-  (0x001B5,0x001B5), `Abs (0x001B6);
-  (0x001B7,0x001B7), `Abs (0x00292);
-  (0x001B8,0x001B8), `Abs (0x001B9);
-  (0x001BC,0x001BC), `Abs (0x001BD);
-  (0x001C4,0x001C4), `Abs (0x001C6);
-  (0x001C7,0x001C7), `Abs (0x001C9);
-  (0x001CA,0x001CA), `Abs (0x001CC);
-  (0x001CD,0x001CD), `Abs (0x001CE);
-  (0x001CF,0x001CF), `Abs (0x001D0);
-  (0x001D1,0x001D1), `Abs (0x001D2);
-  (0x001D3,0x001D3), `Abs (0x001D4);
-  (0x001D5,0x001D5), `Abs (0x001D6);
-  (0x001D7,0x001D7), `Abs (0x001D8);
-  (0x001D9,0x001D9), `Abs (0x001DA);
-  (0x001DB,0x001DB), `Abs (0x001DC);
-  (0x001DE,0x001DE), `Abs (0x001DF);
-  (0x001E0,0x001E0), `Abs (0x001E1);
-  (0x001E2,0x001E2), `Abs (0x001E3);
-  (0x001E4,0x001E4), `Abs (0x001E5);
-  (0x001E6,0x001E6), `Abs (0x001E7);
-  (0x001E8,0x001E8), `Abs (0x001E9);
-  (0x001EA,0x001EA), `Abs (0x001EB);
-  (0x001EC,0x001EC), `Abs (0x001ED);
-  (0x001EE,0x001EE), `Abs (0x001EF);
-  (0x001F1,0x001F1), `Abs (0x001F3);
-  (0x001F4,0x001F4), `Abs (0x001F5);
-  (0x001F6,0x001F6), `Abs (0x00195);
-  (0x001F7,0x001F7), `Abs (0x001BF);
-  (0x001F8,0x001F8), `Abs (0x001F9);
-  (0x001FA,0x001FA), `Abs (0x001FB);
-  (0x001FC,0x001FC), `Abs (0x001FD);
-  (0x001FE,0x001FE), `Abs (0x001FF);
-  (0x00200,0x00200), `Abs (0x00201);
-  (0x00202,0x00202), `Abs (0x00203);
-  (0x00204,0x00204), `Abs (0x00205);
-  (0x00206,0x00206), `Abs (0x00207);
-  (0x00208,0x00208), `Abs (0x00209);
-  (0x0020A,0x0020A), `Abs (0x0020B);
-  (0x0020C,0x0020C), `Abs (0x0020D);
-  (0x0020E,0x0020E), `Abs (0x0020F);
-  (0x00210,0x00210), `Abs (0x00211);
-  (0x00212,0x00212), `Abs (0x00213);
-  (0x00214,0x00214), `Abs (0x00215);
-  (0x00216,0x00216), `Abs (0x00217);
-  (0x00218,0x00218), `Abs (0x00219);
-  (0x0021A,0x0021A), `Abs (0x0021B);
-  (0x0021C,0x0021C), `Abs (0x0021D);
-  (0x0021E,0x0021E), `Abs (0x0021F);
-  (0x00220,0x00220), `Abs (0x0019E);
-  (0x00222,0x00222), `Abs (0x00223);
-  (0x00224,0x00224), `Abs (0x00225);
-  (0x00226,0x00226), `Abs (0x00227);
-  (0x00228,0x00228), `Abs (0x00229);
-  (0x0022A,0x0022A), `Abs (0x0022B);
-  (0x0022C,0x0022C), `Abs (0x0022D);
-  (0x0022E,0x0022E), `Abs (0x0022F);
-  (0x00230,0x00230), `Abs (0x00231);
-  (0x00232,0x00232), `Abs (0x00233);
-  (0x00386,0x00386), `Abs (0x003AC);
-  (0x00388,0x0038A), `Delta (37);
-  (0x0038C,0x0038C), `Abs (0x003CC);
-  (0x0038E,0x0038F), `Delta (63);
-  (0x00391,0x003A1), `Delta (32);
-  (0x003A3,0x003AB), `Delta (32);
-  (0x003D8,0x003D8), `Abs (0x003D9);
-  (0x003DA,0x003DA), `Abs (0x003DB);
-  (0x003DC,0x003DC), `Abs (0x003DD);
-  (0x003DE,0x003DE), `Abs (0x003DF);
-  (0x003E0,0x003E0), `Abs (0x003E1);
-  (0x003E2,0x003E2), `Abs (0x003E3);
-  (0x003E4,0x003E4), `Abs (0x003E5);
-  (0x003E6,0x003E6), `Abs (0x003E7);
-  (0x003E8,0x003E8), `Abs (0x003E9);
-  (0x003EA,0x003EA), `Abs (0x003EB);
-  (0x003EC,0x003EC), `Abs (0x003ED);
-  (0x003EE,0x003EE), `Abs (0x003EF);
-  (0x003F4,0x003F4), `Abs (0x003B8);
-  (0x00400,0x0040F), `Delta (80);
-  (0x00410,0x0042F), `Delta (32);
-  (0x00460,0x00460), `Abs (0x00461);
-  (0x00462,0x00462), `Abs (0x00463);
-  (0x00464,0x00464), `Abs (0x00465);
-  (0x00466,0x00466), `Abs (0x00467);
-  (0x00468,0x00468), `Abs (0x00469);
-  (0x0046A,0x0046A), `Abs (0x0046B);
-  (0x0046C,0x0046C), `Abs (0x0046D);
-  (0x0046E,0x0046E), `Abs (0x0046F);
-  (0x00470,0x00470), `Abs (0x00471);
-  (0x00472,0x00472), `Abs (0x00473);
-  (0x00474,0x00474), `Abs (0x00475);
-  (0x00476,0x00476), `Abs (0x00477);
-  (0x00478,0x00478), `Abs (0x00479);
-  (0x0047A,0x0047A), `Abs (0x0047B);
-  (0x0047C,0x0047C), `Abs (0x0047D);
-  (0x0047E,0x0047E), `Abs (0x0047F);
-  (0x00480,0x00480), `Abs (0x00481);
-  (0x0048A,0x0048A), `Abs (0x0048B);
-  (0x0048C,0x0048C), `Abs (0x0048D);
-  (0x0048E,0x0048E), `Abs (0x0048F);
-  (0x00490,0x00490), `Abs (0x00491);
-  (0x00492,0x00492), `Abs (0x00493);
-  (0x00494,0x00494), `Abs (0x00495);
-  (0x00496,0x00496), `Abs (0x00497);
-  (0x00498,0x00498), `Abs (0x00499);
-  (0x0049A,0x0049A), `Abs (0x0049B);
-  (0x0049C,0x0049C), `Abs (0x0049D);
-  (0x0049E,0x0049E), `Abs (0x0049F);
-  (0x004A0,0x004A0), `Abs (0x004A1);
-  (0x004A2,0x004A2), `Abs (0x004A3);
-  (0x004A4,0x004A4), `Abs (0x004A5);
-  (0x004A6,0x004A6), `Abs (0x004A7);
-  (0x004A8,0x004A8), `Abs (0x004A9);
-  (0x004AA,0x004AA), `Abs (0x004AB);
-  (0x004AC,0x004AC), `Abs (0x004AD);
-  (0x004AE,0x004AE), `Abs (0x004AF);
-  (0x004B0,0x004B0), `Abs (0x004B1);
-  (0x004B2,0x004B2), `Abs (0x004B3);
-  (0x004B4,0x004B4), `Abs (0x004B5);
-  (0x004B6,0x004B6), `Abs (0x004B7);
-  (0x004B8,0x004B8), `Abs (0x004B9);
-  (0x004BA,0x004BA), `Abs (0x004BB);
-  (0x004BC,0x004BC), `Abs (0x004BD);
-  (0x004BE,0x004BE), `Abs (0x004BF);
-  (0x004C1,0x004C1), `Abs (0x004C2);
-  (0x004C3,0x004C3), `Abs (0x004C4);
-  (0x004C5,0x004C5), `Abs (0x004C6);
-  (0x004C7,0x004C7), `Abs (0x004C8);
-  (0x004C9,0x004C9), `Abs (0x004CA);
-  (0x004CB,0x004CB), `Abs (0x004CC);
-  (0x004CD,0x004CD), `Abs (0x004CE);
-  (0x004D0,0x004D0), `Abs (0x004D1);
-  (0x004D2,0x004D2), `Abs (0x004D3);
-  (0x004D4,0x004D4), `Abs (0x004D5);
-  (0x004D6,0x004D6), `Abs (0x004D7);
-  (0x004D8,0x004D8), `Abs (0x004D9);
-  (0x004DA,0x004DA), `Abs (0x004DB);
-  (0x004DC,0x004DC), `Abs (0x004DD);
-  (0x004DE,0x004DE), `Abs (0x004DF);
-  (0x004E0,0x004E0), `Abs (0x004E1);
-  (0x004E2,0x004E2), `Abs (0x004E3);
-  (0x004E4,0x004E4), `Abs (0x004E5);
-  (0x004E6,0x004E6), `Abs (0x004E7);
-  (0x004E8,0x004E8), `Abs (0x004E9);
-  (0x004EA,0x004EA), `Abs (0x004EB);
-  (0x004EC,0x004EC), `Abs (0x004ED);
-  (0x004EE,0x004EE), `Abs (0x004EF);
-  (0x004F0,0x004F0), `Abs (0x004F1);
-  (0x004F2,0x004F2), `Abs (0x004F3);
-  (0x004F4,0x004F4), `Abs (0x004F5);
-  (0x004F8,0x004F8), `Abs (0x004F9);
-  (0x00500,0x00500), `Abs (0x00501);
-  (0x00502,0x00502), `Abs (0x00503);
-  (0x00504,0x00504), `Abs (0x00505);
-  (0x00506,0x00506), `Abs (0x00507);
-  (0x00508,0x00508), `Abs (0x00509);
-  (0x0050A,0x0050A), `Abs (0x0050B);
-  (0x0050C,0x0050C), `Abs (0x0050D);
-  (0x0050E,0x0050E), `Abs (0x0050F);
-  (0x00531,0x00556), `Delta (48);
-  (0x01E00,0x01E00), `Abs (0x01E01);
-  (0x01E02,0x01E02), `Abs (0x01E03);
-  (0x01E04,0x01E04), `Abs (0x01E05);
-  (0x01E06,0x01E06), `Abs (0x01E07);
-  (0x01E08,0x01E08), `Abs (0x01E09);
-  (0x01E0A,0x01E0A), `Abs (0x01E0B);
-  (0x01E0C,0x01E0C), `Abs (0x01E0D);
-  (0x01E0E,0x01E0E), `Abs (0x01E0F);
-  (0x01E10,0x01E10), `Abs (0x01E11);
-  (0x01E12,0x01E12), `Abs (0x01E13);
-  (0x01E14,0x01E14), `Abs (0x01E15);
-  (0x01E16,0x01E16), `Abs (0x01E17);
-  (0x01E18,0x01E18), `Abs (0x01E19);
-  (0x01E1A,0x01E1A), `Abs (0x01E1B);
-  (0x01E1C,0x01E1C), `Abs (0x01E1D);
-  (0x01E1E,0x01E1E), `Abs (0x01E1F);
-  (0x01E20,0x01E20), `Abs (0x01E21);
-  (0x01E22,0x01E22), `Abs (0x01E23);
-  (0x01E24,0x01E24), `Abs (0x01E25);
-  (0x01E26,0x01E26), `Abs (0x01E27);
-  (0x01E28,0x01E28), `Abs (0x01E29);
-  (0x01E2A,0x01E2A), `Abs (0x01E2B);
-  (0x01E2C,0x01E2C), `Abs (0x01E2D);
-  (0x01E2E,0x01E2E), `Abs (0x01E2F);
-  (0x01E30,0x01E30), `Abs (0x01E31);
-  (0x01E32,0x01E32), `Abs (0x01E33);
-  (0x01E34,0x01E34), `Abs (0x01E35);
-  (0x01E36,0x01E36), `Abs (0x01E37);
-  (0x01E38,0x01E38), `Abs (0x01E39);
-  (0x01E3A,0x01E3A), `Abs (0x01E3B);
-  (0x01E3C,0x01E3C), `Abs (0x01E3D);
-  (0x01E3E,0x01E3E), `Abs (0x01E3F);
-  (0x01E40,0x01E40), `Abs (0x01E41);
-  (0x01E42,0x01E42), `Abs (0x01E43);
-  (0x01E44,0x01E44), `Abs (0x01E45);
-  (0x01E46,0x01E46), `Abs (0x01E47);
-  (0x01E48,0x01E48), `Abs (0x01E49);
-  (0x01E4A,0x01E4A), `Abs (0x01E4B);
-  (0x01E4C,0x01E4C), `Abs (0x01E4D);
-  (0x01E4E,0x01E4E), `Abs (0x01E4F);
-  (0x01E50,0x01E50), `Abs (0x01E51);
-  (0x01E52,0x01E52), `Abs (0x01E53);
-  (0x01E54,0x01E54), `Abs (0x01E55);
-  (0x01E56,0x01E56), `Abs (0x01E57);
-  (0x01E58,0x01E58), `Abs (0x01E59);
-  (0x01E5A,0x01E5A), `Abs (0x01E5B);
-  (0x01E5C,0x01E5C), `Abs (0x01E5D);
-  (0x01E5E,0x01E5E), `Abs (0x01E5F);
-  (0x01E60,0x01E60), `Abs (0x01E61);
-  (0x01E62,0x01E62), `Abs (0x01E63);
-  (0x01E64,0x01E64), `Abs (0x01E65);
-  (0x01E66,0x01E66), `Abs (0x01E67);
-  (0x01E68,0x01E68), `Abs (0x01E69);
-  (0x01E6A,0x01E6A), `Abs (0x01E6B);
-  (0x01E6C,0x01E6C), `Abs (0x01E6D);
-  (0x01E6E,0x01E6E), `Abs (0x01E6F);
-  (0x01E70,0x01E70), `Abs (0x01E71);
-  (0x01E72,0x01E72), `Abs (0x01E73);
-  (0x01E74,0x01E74), `Abs (0x01E75);
-  (0x01E76,0x01E76), `Abs (0x01E77);
-  (0x01E78,0x01E78), `Abs (0x01E79);
-  (0x01E7A,0x01E7A), `Abs (0x01E7B);
-  (0x01E7C,0x01E7C), `Abs (0x01E7D);
-  (0x01E7E,0x01E7E), `Abs (0x01E7F);
-  (0x01E80,0x01E80), `Abs (0x01E81);
-  (0x01E82,0x01E82), `Abs (0x01E83);
-  (0x01E84,0x01E84), `Abs (0x01E85);
-  (0x01E86,0x01E86), `Abs (0x01E87);
-  (0x01E88,0x01E88), `Abs (0x01E89);
-  (0x01E8A,0x01E8A), `Abs (0x01E8B);
-  (0x01E8C,0x01E8C), `Abs (0x01E8D);
-  (0x01E8E,0x01E8E), `Abs (0x01E8F);
-  (0x01E90,0x01E90), `Abs (0x01E91);
-  (0x01E92,0x01E92), `Abs (0x01E93);
-  (0x01E94,0x01E94), `Abs (0x01E95);
-  (0x01EA0,0x01EA0), `Abs (0x01EA1);
-  (0x01EA2,0x01EA2), `Abs (0x01EA3);
-  (0x01EA4,0x01EA4), `Abs (0x01EA5);
-  (0x01EA6,0x01EA6), `Abs (0x01EA7);
-  (0x01EA8,0x01EA8), `Abs (0x01EA9);
-  (0x01EAA,0x01EAA), `Abs (0x01EAB);
-  (0x01EAC,0x01EAC), `Abs (0x01EAD);
-  (0x01EAE,0x01EAE), `Abs (0x01EAF);
-  (0x01EB0,0x01EB0), `Abs (0x01EB1);
-  (0x01EB2,0x01EB2), `Abs (0x01EB3);
-  (0x01EB4,0x01EB4), `Abs (0x01EB5);
-  (0x01EB6,0x01EB6), `Abs (0x01EB7);
-  (0x01EB8,0x01EB8), `Abs (0x01EB9);
-  (0x01EBA,0x01EBA), `Abs (0x01EBB);
-  (0x01EBC,0x01EBC), `Abs (0x01EBD);
-  (0x01EBE,0x01EBE), `Abs (0x01EBF);
-  (0x01EC0,0x01EC0), `Abs (0x01EC1);
-  (0x01EC2,0x01EC2), `Abs (0x01EC3);
-  (0x01EC4,0x01EC4), `Abs (0x01EC5);
-  (0x01EC6,0x01EC6), `Abs (0x01EC7);
-  (0x01EC8,0x01EC8), `Abs (0x01EC9);
-  (0x01ECA,0x01ECA), `Abs (0x01ECB);
-  (0x01ECC,0x01ECC), `Abs (0x01ECD);
-  (0x01ECE,0x01ECE), `Abs (0x01ECF);
-  (0x01ED0,0x01ED0), `Abs (0x01ED1);
-  (0x01ED2,0x01ED2), `Abs (0x01ED3);
-  (0x01ED4,0x01ED4), `Abs (0x01ED5);
-  (0x01ED6,0x01ED6), `Abs (0x01ED7);
-  (0x01ED8,0x01ED8), `Abs (0x01ED9);
-  (0x01EDA,0x01EDA), `Abs (0x01EDB);
-  (0x01EDC,0x01EDC), `Abs (0x01EDD);
-  (0x01EDE,0x01EDE), `Abs (0x01EDF);
-  (0x01EE0,0x01EE0), `Abs (0x01EE1);
-  (0x01EE2,0x01EE2), `Abs (0x01EE3);
-  (0x01EE4,0x01EE4), `Abs (0x01EE5);
-  (0x01EE6,0x01EE6), `Abs (0x01EE7);
-  (0x01EE8,0x01EE8), `Abs (0x01EE9);
-  (0x01EEA,0x01EEA), `Abs (0x01EEB);
-  (0x01EEC,0x01EEC), `Abs (0x01EED);
-  (0x01EEE,0x01EEE), `Abs (0x01EEF);
-  (0x01EF0,0x01EF0), `Abs (0x01EF1);
-  (0x01EF2,0x01EF2), `Abs (0x01EF3);
-  (0x01EF4,0x01EF4), `Abs (0x01EF5);
-  (0x01EF6,0x01EF6), `Abs (0x01EF7);
-  (0x01EF8,0x01EF8), `Abs (0x01EF9);
-  (0x01F08,0x01F0F), `Delta (-8);
-  (0x01F18,0x01F1D), `Delta (-8);
-  (0x01F28,0x01F2F), `Delta (-8);
-  (0x01F38,0x01F3F), `Delta (-8);
-  (0x01F48,0x01F4D), `Delta (-8);
-  (0x01F59,0x01F59), `Abs (0x01F51);
-  (0x01F5B,0x01F5B), `Abs (0x01F53);
-  (0x01F5D,0x01F5D), `Abs (0x01F55);
-  (0x01F5F,0x01F5F), `Abs (0x01F57);
-  (0x01F68,0x01F6F), `Delta (-8);
-  (0x01FB8,0x01FB9), `Delta (-8);
-  (0x01FBA,0x01FBB), `Delta (-74);
-  (0x01FC8,0x01FCB), `Delta (-86);
-  (0x01FD8,0x01FD9), `Delta (-8);
-  (0x01FDA,0x01FDB), `Delta (-100);
-  (0x01FE8,0x01FE9), `Delta (-8);
-  (0x01FEA,0x01FEB), `Delta (-112);
-  (0x01FEC,0x01FEC), `Abs (0x01FE5);
-  (0x01FF8,0x01FF9), `Delta (-128);
-  (0x01FFA,0x01FFB), `Delta (-126);
-  (0x02126,0x02126), `Abs (0x003C9);
-  (0x0212A,0x0212A), `Abs (0x0006B);
-  (0x0212B,0x0212B), `Abs (0x000E5);
-  (0x0FF21,0x0FF3A), `Delta (32);
-  (0x10400,0x10425), `Delta (40);
-  (0x001C5,0x001C5), `Abs (0x001C6);
-  (0x001C8,0x001C8), `Abs (0x001C9);
-  (0x001CB,0x001CB), `Abs (0x001CC);
-  (0x001F2,0x001F2), `Abs (0x001F3);
-  (0x01F88,0x01F8F), `Delta (-8);
-  (0x01F98,0x01F9F), `Delta (-8);
-  (0x01FA8,0x01FAF), `Delta (-8);
-  (0x01FBC,0x01FBC), `Abs (0x01FB3);
-  (0x01FCC,0x01FCC), `Abs (0x01FC3);
-  (0x01FFC,0x01FFC), `Abs (0x01FF3);
-  (0x02160,0x0216F), `Delta (16)
-]
-
diff --git a/lib/util.ml b/lib/util.ml
index 009dfbe1..7d7d380b 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (* Mapping under pairs *)
 
@@ -87,13 +89,17 @@ let matrix_transpose mat =
 
 let identity x = x
 
-(** Function composition: the mathematical [∘] operator.
+(** Left-to-right function composition:
+    
+    [f1 %> f2] is [fun x -> f2 (f1 x)].
 
-    So [g % f] is a synonym for [fun x -> g (f x)].
+    [f1 %> f2 %> f3] is [fun x -> f3 (f2 (f1 x))].
 
-    Also because [%] is right-associative, [h % g % f] means [fun x -> h (g (f x))].
- *)
-let (%) f g x = f (g x)
+    [f1 %> f2 %> f3 %> f4] is [fun x -> f4 (f3 (f2 (f1 x)))]
+
+    etc.
+*)
+let (%>) f g x = g (f x)
 
 let const x _ = x
 
@@ -132,6 +138,8 @@ type ('a, 'b) union = ('a, 'b) CSig.union = Inl of 'a | Inr of 'b
 type 'a until = 'a CSig.until = Stop of 'a | Cont of 'a
 type ('a, 'b) eq = ('a, 'b) CSig.eq = Refl : ('a, 'a) eq
 
+let sym : type a b. (a, b) eq -> (b, a) eq = fun Refl -> Refl
+
 module Union =
 struct
   let map f g = function
@@ -157,11 +165,20 @@ let iraise = Exninfo.iraise
 
 let open_utf8_file_in fname =
   let is_bom s =
-    Int.equal (Char.code s.[0]) 0xEF &&
-    Int.equal (Char.code s.[1]) 0xBB &&
-    Int.equal (Char.code s.[2]) 0xBF
+    Int.equal (Char.code (Bytes.get s 0)) 0xEF &&
+    Int.equal (Char.code (Bytes.get s 1)) 0xBB &&
+    Int.equal (Char.code (Bytes.get s 2)) 0xBF
   in
   let in_chan = open_in fname in
-  let s = "   " in
+  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 6bed7e35..1eb60f50 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module contains numerous utility functions on strings, lists,
@@ -84,13 +86,17 @@ val matrix_transpose : 'a list list -> 'a list list
 
 val identity : 'a -> 'a
 
-(** Function composition: the mathematical [∘] operator.
+(** Left-to-right function composition:
+    
+    [f1 %> f2] is [fun x -> f2 (f1 x)].
 
-    So [g % f] is a synonym for [fun x -> g (f x)].
+    [f1 %> f2 %> f3] is [fun x -> f3 (f2 (f1 x))].
 
-    Also because [%] is right-associative, [h % g % f] means [fun x -> h (g (f x))].
+    [f1 %> f2 %> f3 %> f4] is [fun x -> f4 (f3 (f2 (f1 x)))]
+
+    etc.
 *)
-val (%) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b
+val ( %> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
 
 val const : 'a -> 'b -> 'a
 val iterate : ('a -> 'a) -> int -> 'a -> 'a
@@ -129,5 +135,12 @@ type 'a until = 'a CSig.until = Stop of 'a | Cont of 'a
 
 type ('a, 'b) eq = ('a, 'b) CSig.eq = Refl : ('a, 'a) eq
 
+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/lib/xml_datatype.mli b/lib/xml_datatype.mli
index a8e37935..19c046e9 100644
--- a/lib/xml_datatype.mli
+++ b/lib/xml_datatype.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** ['a gxml] is the type for semi-structured documents. They generalize
diff --git a/interp/coqlib.ml b/library/coqlib.ml
index 588637b7..3f01c617 100644
--- a/interp/coqlib.ml
+++ b/library/coqlib.ml
@@ -1,22 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Pp
 open Names
-open Term
 open Libnames
 open Globnames
 open Nametab
-open Smartlocate
 
-let coq = Nameops.coq_string (* "Coq" *)
+let coq = Libnames.coq_string (* "Coq" *)
 
 (************************************************************************)
 (* Generic functions to find Coq objects *)
@@ -26,29 +26,27 @@ type message = string
 let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 
 let find_reference locstr dir s =
-  let sp = Libnames.make_path (make_dir dir) (Id.of_string s) in
-  try global_of_extended_global (Nametab.extended_global_of_path sp)
+  let dp = make_dir dir in
+  let sp = Libnames.make_path dp (Id.of_string s) in
+  try Nametab.global_of_path sp
   with Not_found ->
-    anomaly ~label:locstr (str "cannot find " ++ Libnames.pr_path sp)
+    (* Following bug 5066 we are more permissive with the handling
+       of not found errors here *)
+    user_err ~hdr:locstr
+      Pp.(str "cannot find " ++ Libnames.pr_path sp ++
+          str "; maybe library " ++ DirPath.print dp ++
+          str " has to be required first.")
 
 let coq_reference locstr dir s = find_reference locstr (coq::dir) s
-let coq_constant locstr dir s = Universes.constr_of_global (coq_reference locstr dir s)
-
-let gen_reference = coq_reference
-let gen_constant = coq_constant
 
 let has_suffix_in_dirs dirs ref =
   let dir = dirpath (path_of_global ref) in
   List.exists (fun d -> is_dirpath_prefix_of d dir) dirs
 
-let global_of_extended q =
-  try Some (global_of_extended_global q) with Not_found -> None
-
 let gen_reference_in_modules locstr dirs s =
   let dirs = List.map make_dir dirs in
   let qualid = qualid_of_string s in
-  let all = Nametab.locate_extended_all qualid in
-  let all = List.map_filter global_of_extended all in
+  let all = Nametab.locate_all qualid in
   let all = List.sort_uniquize RefOrdered_env.compare all in
   let these = List.filter (has_suffix_in_dirs dirs) all in
   match these with
@@ -56,18 +54,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)
+        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)
-
-let gen_constant_in_modules locstr dirs s =
-  Universes.constr_of_global (gen_reference_in_modules locstr dirs s)
-
+           prlist_with_sep pr_comma DirPath.print dirs ++ str ".")
 
 (* For tactics/commands requiring vernacular libraries *)
 
@@ -86,23 +80,19 @@ let check_required_library d =
      (Loc.ghost,make_qualid (DirPath.make (List.rev prefix)) m)
 *)
 (* or failing ...*)
-      errorlabstrm "Coqlib.check_required_library"
-        (str "Library " ++ pr_dirpath dir ++ str " has to be required first.")
+      user_err ~hdr:"Coqlib.check_required_library"
+        (str "Library " ++ DirPath.print dir ++ str " has to be required first.")
 
 (************************************************************************)
 (* Specific Coq objects *)
 
 let init_reference dir s =
-  let d = "Init"::dir in
-  check_required_library (coq::d); gen_reference "Coqlib" d s
-
-let init_constant dir s =
-  let d = "Init"::dir in
-  check_required_library (coq::d); gen_constant "Coqlib" d s
+  let d = coq::"Init"::dir in
+  check_required_library d; find_reference "Coqlib" d s
 
 let logic_reference dir s =
-  let d = "Logic"::dir in
-  check_required_library ("Coq"::d); gen_reference "Coqlib" d s
+  let d = coq::"Logic"::dir in
+  check_required_library d; find_reference "Coqlib" d s
 
 let arith_dir = [coq;"Arith"]
 let arith_modules = [arith_dir]
@@ -149,12 +139,6 @@ let make_con dir id = Globnames.encode_con dir (Id.of_string id)
 let id = make_con datatypes_module "idProp"
 let type_of_id = make_con datatypes_module "IDProp"
 
-let _ = Termops.set_impossible_default_clause 
-  (fun () -> 
-    let c, ctx = Universes.fresh_global_instance (Global.env()) (ConstRef id) in
-    let (_, u) = destConst c in
-      (c,mkConstU (type_of_id,u)), ctx)
-
 (** Natural numbers *)
 let nat_kn = make_ind datatypes_module "nat"
 let nat_path = Libnames.make_path datatypes_module (Id.of_string "nat")
@@ -194,16 +178,16 @@ type coq_sigma_data = {
   typ   : global_reference }
 
 type coq_bool_data  = {
-  andb : constr;
-  andb_prop : constr;
-  andb_true_intro : constr}
+  andb : global_reference;
+  andb_prop : global_reference;
+  andb_true_intro : global_reference}
 
 let build_bool_type () =
-  { andb =  init_constant ["Datatypes"] "andb";
-    andb_prop =  init_constant ["Datatypes"] "andb_prop";
-    andb_true_intro =  init_constant ["Datatypes"] "andb_true_intro" }
+  { andb =  init_reference ["Datatypes"] "andb";
+    andb_prop =  init_reference ["Datatypes"] "andb_prop";
+    andb_true_intro =  init_reference ["Datatypes"] "andb_true_intro" }
 
-let build_sigma_set () = anomaly (Pp.str "Use build_sigma_type")
+let build_sigma_set () = anomaly (Pp.str "Use build_sigma_type.")
 
 let build_sigma_type () =
   { proj1 = init_reference ["Specif"] "projT1";
@@ -244,7 +228,6 @@ type coq_inversion_data = {
 }
 
 let lazy_init_reference dir id = lazy (init_reference dir id)
-let lazy_init_constant dir id = lazy (init_constant dir id)
 let lazy_logic_reference dir id = lazy (logic_reference dir id)
 
 (* Leibniz equality on Type *)
@@ -307,7 +290,7 @@ let build_coq_inversion_jmeq_data () =
   inv_congr = Lazy.force coq_jmeq_congr_canonical }
 
 (* Specif *)
-let coq_sumbool  = lazy_init_constant ["Specif"] "sumbool"
+let coq_sumbool  = lazy_init_reference ["Specif"] "sumbool"
 
 let build_coq_sumbool () = Lazy.force coq_sumbool
 
@@ -349,22 +332,22 @@ let build_coq_inversion_eq_true_data () =
   inv_congr = Lazy.force coq_eq_true_congr }
 
 (* The False proposition *)
-let coq_False  = lazy_init_constant ["Logic"] "False"
+let coq_False  = lazy_init_reference ["Logic"] "False"
 
 (* The True proposition and its unique proof *)
-let coq_True   = lazy_init_constant ["Logic"] "True"
-let coq_I      = lazy_init_constant ["Logic"] "I"
+let coq_True   = lazy_init_reference ["Logic"] "True"
+let coq_I      = lazy_init_reference ["Logic"] "I"
 
 (* Connectives *)
-let coq_not = lazy_init_constant ["Logic"] "not"
-let coq_and = lazy_init_constant ["Logic"] "and"
-let coq_conj = lazy_init_constant ["Logic"] "conj"
-let coq_or = lazy_init_constant ["Logic"] "or"
-let coq_ex = lazy_init_constant ["Logic"] "ex"
-let coq_iff = lazy_init_constant ["Logic"] "iff"
+let coq_not = lazy_init_reference ["Logic"] "not"
+let coq_and = lazy_init_reference ["Logic"] "and"
+let coq_conj = lazy_init_reference ["Logic"] "conj"
+let coq_or = lazy_init_reference ["Logic"] "or"
+let coq_ex = lazy_init_reference ["Logic"] "ex"
+let coq_iff = lazy_init_reference ["Logic"] "iff"
 
-let coq_iff_left_proj  = lazy_init_constant ["Logic"] "proj1"
-let coq_iff_right_proj = lazy_init_constant ["Logic"] "proj2"
+let coq_iff_left_proj  = lazy_init_reference ["Logic"] "proj1"
+let coq_iff_right_proj = lazy_init_reference ["Logic"] "proj2"
 
 (* Runtime part *)
 let build_coq_True ()  = Lazy.force coq_True
@@ -385,9 +368,9 @@ let build_coq_iff_right_proj () = Lazy.force coq_iff_right_proj
 (* The following is less readable but does not depend on parsing *)
 let coq_eq_ref      = lazy (init_reference ["Logic"] "eq")
 let coq_identity_ref = lazy (init_reference ["Datatypes"] "identity")
-let coq_jmeq_ref     = lazy (gen_reference "Coqlib" ["Logic";"JMeq"] "JMeq")
-let coq_eq_true_ref = lazy (gen_reference "Coqlib" ["Init";"Datatypes"] "eq_true")
-let coq_existS_ref  = lazy (anomaly (Pp.str "use coq_existT_ref"))
+let coq_jmeq_ref     = lazy (find_reference "Coqlib" [coq;"Logic";"JMeq"] "JMeq")
+let coq_eq_true_ref = lazy (find_reference "Coqlib" [coq;"Init";"Datatypes"] "eq_true")
+let coq_existS_ref  = lazy (anomaly (Pp.str "use coq_existT_ref."))
 let coq_existT_ref  = lazy (init_reference ["Specif"] "existT")
 let coq_exist_ref  = lazy (init_reference ["Specif"] "exist")
 let coq_not_ref     = lazy (init_reference ["Logic"] "not")
@@ -396,4 +379,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")
-
diff --git a/interp/coqlib.mli b/library/coqlib.mli
index 5ba26d82..8077c47c 100644
--- a/interp/coqlib.mli
+++ b/library/coqlib.mli
@@ -1,55 +1,62 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Libnames
 open Globnames
-open Term
 open Util
 
 (** This module collects the global references, constructions and
     patterns of the standard library used in ocaml files *)
 
+(** The idea is to migrate to rebindable name-based approach, thus the
+    only function this FILE will provide will be:
+
+    [find_reference : string -> global_reference]
+
+    such that [find_reference "core.eq.type"] returns the proper [global_reference]
+
+    [bind_reference : string -> global_reference -> unit]
+
+    will bind a reference.
+
+    A feature based approach would be possible too.
+
+    Contrary to the old approach of raising an anomaly, we expect
+    tactics to gracefully fail in the absence of some primitive.
+
+    This is work in progress, see below.
+*)
+
 (** {6 ... } *)
 (** [find_reference caller_message [dir;subdir;...] s] returns a global
    reference to the name dir.subdir.(...).s; the corresponding module
    must have been required or in the process of being compiled so that
-   it must be used lazyly; it raises an anomaly with the given message
+   it must be used lazily; it raises an anomaly with the given message
    if not found *)
 
 type message = string
 
 val find_reference : message -> string list -> string -> global_reference
-
-(** [coq_reference caller_message [dir;subdir;...] s] returns a
-   global reference to the name Coq.dir.subdir.(...).s *)
-
 val coq_reference : message -> string list -> string -> global_reference
 
-(** idem but return a term *)
-
-val coq_constant : message -> string list -> string -> constr
-
-(** Synonyms of [coq_constant] and [coq_reference] *)
-
-val gen_constant : message -> string list -> string -> constr
-val gen_reference :  message -> string list -> string -> global_reference
+(** For tactics/commands requiring vernacular libraries *)
+val check_required_library : string list -> unit
 
 (** Search in several modules (not prefixed by "Coq") *)
-val gen_constant_in_modules : string->string list list-> string -> constr
 val gen_reference_in_modules : string->string list list-> string -> global_reference
+
 val arith_modules : string list list
 val zarith_base_modules : string list list
 val init_modules : string list list
 
-(** For tactics/commands requiring vernacular libraries *)
-val check_required_library : string list -> unit
-
 (** {6 Global references } *)
 
 (** Modules *)
@@ -65,6 +72,10 @@ val jmeq_module_name : string list
 
 val datatypes_module_name : string list
 
+(** Identity  *)
+val id : Constant.t
+val type_of_id : Constant.t
+
 (** Natural numbers *)
 val nat_path : full_path
 val glob_nat : global_reference
@@ -95,9 +106,9 @@ val glob_jmeq : global_reference
    at runtime. *)
 
 type coq_bool_data = {
-  andb : constr;
-  andb_prop : constr;
-  andb_true_intro : constr}
+  andb : global_reference;
+  andb_prop : global_reference;
+  andb_true_intro : global_reference}
 val build_bool_type : coq_bool_data delayed
 
 (** {6 For Equality tactics } *)
@@ -154,33 +165,33 @@ val build_coq_inversion_jmeq_data : coq_inversion_data delayed
 val build_coq_inversion_eq_true_data : coq_inversion_data delayed
 
 (** Specif *)
-val build_coq_sumbool : constr delayed
+val build_coq_sumbool : global_reference delayed
 
 (** {6 ... } *)
 (** Connectives 
    The False proposition *)
-val build_coq_False : constr delayed
+val build_coq_False : global_reference delayed
 
 (** The True proposition and its unique proof *)
-val build_coq_True : constr delayed
-val build_coq_I : constr delayed
+val build_coq_True : global_reference delayed
+val build_coq_I : global_reference delayed
 
 (** Negation *)
-val build_coq_not : constr delayed
+val build_coq_not : global_reference delayed
 
 (** Conjunction *)
-val build_coq_and : constr delayed
-val build_coq_conj : constr delayed
-val build_coq_iff : constr delayed
+val build_coq_and : global_reference delayed
+val build_coq_conj : global_reference delayed
+val build_coq_iff : global_reference delayed
 
-val build_coq_iff_left_proj : constr delayed
-val build_coq_iff_right_proj : constr delayed
+val build_coq_iff_left_proj : global_reference delayed
+val build_coq_iff_right_proj : global_reference delayed
 
 (** Disjunction *)
-val build_coq_or : constr delayed
+val build_coq_or : global_reference delayed
 
 (** Existential quantifier *)
-val build_coq_ex : constr delayed
+val build_coq_ex : global_reference delayed
 
 val coq_eq_ref : global_reference lazy_t
 val coq_identity_ref : global_reference lazy_t
diff --git a/library/declaremods.ml b/library/declaremods.ml
index b2806a1a..762efc5e 100644
--- a/library/declaremods.ml
+++ b/library/declaremods.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -39,7 +41,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 +64,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 +128,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 +145,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)
 
@@ -166,30 +168,30 @@ let consistency_checks exists dir dirinfo =
     let globref =
       try Nametab.locate_dir (qualid_of_dirpath dir)
       with Not_found ->
-        errorlabstrm "consistency_checks"
-          (pr_dirpath dir ++ str " should already exist!")
+        user_err ~hdr:"consistency_checks"
+          (DirPath.print dir ++ str " should already exist!")
     in
     assert (eq_global_dir_reference globref dirinfo)
   else
     if Nametab.exists_dir dir then
-      errorlabstrm "consistency_checks"
-        (pr_dirpath dir ++ str " already exists")
+      user_err ~hdr:"consistency_checks"
+        (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 +224,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 =
@@ -252,7 +254,7 @@ let in_modkeep : Lib.lib_objects -> obj =
 
 let do_modtype i sp mp sobjs =
   if Nametab.exists_modtype sp then
-    anomaly (pr_path sp ++ str " already exists");
+    anomaly (pr_path sp ++ str " already exists.");
   Nametab.push_modtype (Nametab.Until i) sp mp;
   ModSubstObjs.set mp sobjs
 
@@ -284,9 +286,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 +338,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]. *)
 
@@ -345,7 +347,7 @@ let get_applications mexpr =
   let rec get params = function
     | MEident mp -> mp, params
     | MEapply (fexpr, mp) -> get (mp::params) fexpr
-    | MEwith _ -> error "Non-atomic functor application."
+    | MEwith _ -> user_err Pp.(str "Non-atomic functor application.")
   in get [] mexpr
 
 (** Create the substitution corresponding to some functor applications *)
@@ -353,7 +355,7 @@ let get_applications mexpr =
 let rec compute_subst env mbids sign mp_l inl =
   match mbids,mp_l with
     | _,[] -> mbids,empty_subst
-    | [],r -> error "Application of a functor with too few arguments."
+    | [],r -> user_err Pp.(str "Application of a functor with too few arguments.")
     | mbid::mbids,mp::mp_l ->
 	let farg_id, farg_b, fbody_b = Modops.destr_functor sign in
 	let mb = Environ.lookup_module mp env in
@@ -442,23 +444,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 +477,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 +529,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}
@@ -557,40 +566,32 @@ let openmodtype_info =
   Summary.ref ([] : module_type_body list) ~name:"MODTYPE-INFO"
 
 
-(** XML output hooks *)
-
-let (f_xml_declare_module, xml_declare_module) = Hook.make ~default:ignore ()
-let (f_xml_start_module, xml_start_module) = Hook.make ~default:ignore ()
-let (f_xml_end_module, xml_end_module) = Hook.make ~default:ignore ()
-let (f_xml_declare_module_type, xml_declare_module_type) = Hook.make ~default:ignore ()
-let (f_xml_start_module_type, xml_start_module_type) = Hook.make ~default:ignore ()
-let (f_xml_end_module_type, xml_end_module_type) = Hook.make ~default:ignore ()
-
-let if_xml f x = if !Flags.xml_export then f x else ()
-
 (** {6 Modules : start, end, declare} *)
 
 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);
-  Lib.add_frozen_state ();
-  if_xml (Hook.get f_xml_start_module) mp;
+  Nametab.push_dir (Nametab.Until 1) (prefix.obj_dir) (DirOpenModule prefix);
   mp
 
 let end_module () =
@@ -629,33 +630,39 @@ let end_module () =
   assert (eq_full_path (fst newoname) (fst oldoname));
   assert (ModPath.equal (mp_of_kn (snd newoname)) mp);
 
-  Lib.add_frozen_state () (* to prevent recaching *);
-  if_xml (Hook.get f_xml_end_module) mp;
   mp
 
 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)
@@ -674,6 +681,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 *)
@@ -684,7 +692,6 @@ let declare_module interp_modast id args res mexpr_o fs =
 
   let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in
   ignore (Lib.add_leaf id (in_module sobjs));
-  if_xml (Hook.get f_xml_declare_module) mp;
   mp
 
 end
@@ -695,14 +702,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);
-  Lib.add_frozen_state ();
-  if_xml (Hook.get f_xml_start_module_type) mp;
+  Nametab.push_dir (Nametab.Until 1) (prefix.obj_dir) (DirOpenModtype prefix);
   mp
 
 let end_modtype () =
@@ -719,8 +726,6 @@ let end_modtype () =
   assert (eq_full_path (fst oname) (fst oldoname));
   assert (ModPath.equal (mp_of_kn (snd oname)) mp);
 
-  Lib.add_frozen_state ()(* to prevent recaching *);
-  if_xml (Hook.get f_xml_end_module_type) mp;
   mp
 
 let declare_modtype interp_modast id args mtys (mty,ann) fs =
@@ -728,14 +733,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
@@ -754,7 +766,6 @@ let declare_modtype interp_modast id args mtys (mty,ann) fs =
   check_subtypes_mt mp sub_mty_l;
 
   ignore (Lib.add_leaf id (in_modtype sobjs));
-  if_xml (Hook.get f_xml_declare_module_type) mp;
   mp
 
 end
@@ -777,7 +788,7 @@ let rec decompose_functor mpl typ =
   match mpl, typ with
   | [], _ -> typ
   | _::mpl, MoreFunctor(_,_,str) -> decompose_functor mpl str
-  | _ -> error "Application of a functor with too much arguments."
+  | _ -> user_err Pp.(str "Application of a functor with too much arguments.")
 
 exception NoIncludeSelf
 
@@ -790,7 +801,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
@@ -883,7 +896,7 @@ let register_library dir cenv (objs:library_objects) digest univ =
       (* If not, let's do it now ... *)
       let mp' = Global.import cenv univ digest in
       if not (ModPath.equal mp mp') then
-        anomaly (Pp.str "Unexpected disk module name");
+        anomaly (Pp.str "Unexpected disk module name.");
   in
   let sobjs,keepobjs = objs in
   do_module false Lib.load_objects 1 dir mp ([],Objs sobjs) keepobjs
@@ -894,8 +907,7 @@ let get_library_native_symbols dir =
 let start_library dir =
   let mp = Global.start_library dir in
   openmod_info := default_module_info;
-  Lib.start_compilation dir mp;
-  Lib.add_frozen_state ()
+  Lib.start_compilation dir mp
 
 let end_library_hook = ref ignore
 let append_end_library_hook f =
@@ -933,7 +945,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;
@@ -969,11 +981,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} *)
 
@@ -983,7 +994,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 3917fe8d..fd8d2961 100644
--- a/library/declaremods.mli
+++ b/library/declaremods.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -13,10 +15,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 +32,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,23 +55,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
-
-(** Hooks for XML output *)
-val xml_declare_module : (module_path -> unit) Hook.t
-val xml_start_module : (module_path -> unit) Hook.t
-val xml_end_module : (module_path -> unit) Hook.t
-val xml_declare_module_type : (module_path -> unit) Hook.t
-val xml_start_module_type : (module_path -> unit) Hook.t
-val xml_end_module_type : (module_path -> unit) Hook.t
+val end_modtype : unit -> ModPath.t
 
 (** {6 Libraries i.e. modules on disk } *)
 
@@ -80,7 +74,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
 
@@ -98,13 +92,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  *)
 
@@ -121,7 +115,7 @@ val iter_all_segments :
   (Libnames.object_name -> Libobject.obj -> unit) -> unit
 
 
-val debug_print_modtab : unit -> Pp.std_ppcmds
+val debug_print_modtab : unit -> Pp.t
 
 (** For printing modules, [process_module_binding] adds names of
     bound module (and its components) to Nametab. It also loads
diff --git a/library/decls.ml b/library/decls.ml
index 6e21880f..12c820fb 100644
--- a/library/decls.ml
+++ b/library/decls.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module registers tables for some non-logical informations
@@ -14,10 +16,12 @@ open Names
 open Decl_kinds
 open Libnames
 
+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"
@@ -46,20 +50,18 @@ let constant_kind kn = Cmap.find kn !csttab
 
 (** Miscellaneous functions. *)
 
-open Context.Named.Declaration
-
 let initialize_named_context_for_proof () =
   let sign = Global.named_context () in
   List.fold_right
     (fun d signv ->
-      let id = get_id d in
-      let d = if variable_opacity id then LocalAssum (id, get_type d) else d in
+      let id = NamedDecl.get_id d in
+      let d = if variable_opacity id then NamedDecl.LocalAssum (id, NamedDecl.get_type d) else d in
       Environ.push_named_context_val d signv) sign Environ.empty_named_context_val
 
 let last_section_hyps dir =
   Context.Named.fold_outside
     (fun d sec_ids ->
-      let id = get_id d in
+      let id = NamedDecl.get_id d in
       try if DirPath.equal dir (variable_path id) then id::sec_ids else sec_ids
       with Not_found -> sec_ids)
     (Environ.named_context (Global.env()))
diff --git a/library/decls.mli b/library/decls.mli
index 1ca7f894..d9fc2915 100644
--- a/library/decls.mli
+++ b/library/decls.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -17,21 +19,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/dischargedhypsmap.ml b/library/dischargedhypsmap.ml
index cea1fd7d..abcdb93a 100644
--- a/library/dischargedhypsmap.ml
+++ b/library/dischargedhypsmap.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Libnames
diff --git a/library/dischargedhypsmap.mli b/library/dischargedhypsmap.mli
index ea4a9424..c7067722 100644
--- a/library/dischargedhypsmap.mli
+++ b/library/dischargedhypsmap.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Libnames
diff --git a/library/doc.tex b/library/doc.tex
deleted file mode 100644
index 33af5933..00000000
--- a/library/doc.tex
+++ /dev/null
@@ -1,16 +0,0 @@
-
-\newpage
-\section*{The Coq library}
-
-\ocwsection \label{library}
-This chapter describes the \Coq\ library, which is made of two parts:
-\begin{itemize}
-  \item a general mechanism to keep a trace of all operations and of
-    the state of the system, with backtrack capabilities;
-  \item a global environment for the CCI, with functions to export and 
-    import compiled modules.
-\end{itemize}
-The modules of the library are organized as follows.
-
-\bigskip
-\begin{center}\epsfig{file=library.dep.ps}\end{center}
diff --git a/library/global.ml b/library/global.ml
index e748434d..dcb20a28 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -20,6 +22,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
 
@@ -30,9 +33,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
@@ -43,7 +46,7 @@ let () =
 let assert_not_parsing () =
   if !Flags.we_are_parsing then
     CErrors.anomaly (
-      Pp.strbrk"The global environment cannot be accessed during parsing")
+      Pp.strbrk"The global environment cannot be accessed during parsing.")
 
 let safe_env () = assert_not_parsing(); !global_env
 
@@ -51,6 +54,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 ()
@@ -78,13 +83,14 @@ 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)
 
 let set_engagement c = globalize0 (Safe_typing.set_engagement c)
 let set_typing_flags c = globalize0 (Safe_typing.set_typing_flags c)
+let export_private_constants ~in_section cd = globalize (Safe_typing.export_private_constants ~in_section cd)
 let add_constant dir id d = globalize (Safe_typing.add_constant dir (i2l id) d)
 let add_mind dir id mie = globalize (Safe_typing.add_mind dir (i2l id) mie)
 let add_modtype id me inl = globalize (Safe_typing.add_modtype (i2l id) me inl)
@@ -121,12 +127,22 @@ let lookup_modtype kn = lookup_modtype kn (env())
 let exists_objlabel id = Safe_typing.exists_objlabel id (safe_env ())
 
 let opaque_tables () = Environ.opaque_tables (env ())
-let body_of_constant_body cb = Declareops.body_of_constant (opaque_tables ()) cb
+
+let instantiate cb c =
+  let open Declarations in
+  match cb.const_universes with
+  | Monomorphic_const _ -> c, Univ.AUContext.empty
+  | Polymorphic_const ctx -> c, ctx
+
+let body_of_constant_body cb =
+  let open Declarations in
+  let otab = opaque_tables () in
+  match cb.const_body with
+  | Undef _ -> None
+  | Def c -> Some (instantiate cb (Mod_subst.force_constr c))
+  | OpaqueDef o -> Some (instantiate cb (Opaqueproof.force_proof otab o))
+
 let body_of_constant cst = body_of_constant_body (lookup_constant cst)
-let constraints_of_constant_body cb =
-  Declareops.constraints_of_constant (opaque_tables ()) cb
-let universes_of_constant_body cb =
-  Declareops.universes_of_constant (opaque_tables ()) cb
 
 (** Operations on kernel names *)
 
@@ -162,74 +178,64 @@ open Globnames
 (** Build a fresh instance for a given context, its associated substitution and 
     the instantiated constraints. *)
 
-let type_of_global_unsafe r = 
-  let env = env() in
+let constr_of_global_in_context env r =
+  let open Constr in
   match r with
-  | VarRef id -> Environ.named_type id env
-  | ConstRef c -> 
-     let cb = Environ.lookup_constant c env in 
-     let univs =
-       Declareops.universes_of_polymorphic_constant
-         (Environ.opaque_tables env) cb in
-     let ty = Typeops.type_of_constant_type env cb.Declarations.const_type in
-       Vars.subst_instance_constr (Univ.UContext.instance univs) ty
+  | VarRef id -> mkVar id, Univ.AUContext.empty
+  | ConstRef c ->
+    let cb = Environ.lookup_constant c env in
+    let univs = Declareops.constant_polymorphic_context cb in
+    mkConstU (c, Univ.make_abstract_instance univs), univs
   | IndRef ind ->
-     let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-     let inst = 
-       if mib.Declarations.mind_polymorphic then 
-	 Univ.UContext.instance mib.Declarations.mind_universes
-       else Univ.Instance.empty
-     in
-       Inductive.type_of_inductive env (specif, inst)
+    let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    mkIndU (ind, Univ.make_abstract_instance univs), univs
   | ConstructRef cstr ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-     let inst = Univ.UContext.instance mib.Declarations.mind_universes in
-       Inductive.type_of_constructor (cstr,inst) specif
+    let (mib,oib as specif) =
+      Inductive.lookup_mind_specif env (inductive_of_constructor cstr)
+    in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    mkConstructU (cstr, Univ.make_abstract_instance univs), univs
 
 let type_of_global_in_context env r = 
-  let open Declarations in
   match r with
-  | VarRef id -> Environ.named_type id env, Univ.UContext.empty
+  | VarRef id -> Environ.named_type id env, Univ.AUContext.empty
   | ConstRef c -> 
-     let cb = Environ.lookup_constant c env in 
-     let univs =
-       Declareops.universes_of_polymorphic_constant
-         (Environ.opaque_tables env) cb in
-       Typeops.type_of_constant_type env cb.Declarations.const_type, univs
+    let cb = Environ.lookup_constant c env in 
+    let univs = Declareops.constant_polymorphic_context cb in
+    cb.Declarations.const_type, univs
   | IndRef ind ->
-     let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
-     let univs = 
-       if mib.mind_polymorphic then Univ.instantiate_univ_context mib.mind_universes 
-       else Univ.UContext.empty
-     in Inductive.type_of_inductive env (specif, Univ.UContext.instance univs), univs
+    let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    let inst = Univ.make_abstract_instance univs in
+    let env = Environ.push_context ~strict:false (Univ.AUContext.repr univs) env in
+    Inductive.type_of_inductive env (specif, inst), univs
   | ConstructRef cstr ->
-     let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-     let univs = 
-       if mib.mind_polymorphic then Univ.instantiate_univ_context mib.mind_universes 
-       else Univ.UContext.empty
-     in
-     let inst = Univ.UContext.instance univs in
-       Inductive.type_of_constructor (cstr,inst) specif, univs
+    let (mib,oib as specif) =
+      Inductive.lookup_mind_specif env (inductive_of_constructor cstr) 
+    in
+    let univs = Declareops.inductive_polymorphic_context mib in
+    let inst = Univ.make_abstract_instance univs in
+    Inductive.type_of_constructor (cstr,inst) specif, univs
 
 let universes_of_global env r = 
-  let open Declarations in
     match r with
-    | VarRef id -> Univ.UContext.empty
+    | VarRef id -> Univ.AUContext.empty
     | ConstRef c -> 
       let cb = Environ.lookup_constant c env in 
-	Declareops.universes_of_polymorphic_constant
-          (Environ.opaque_tables env) cb
+      Declareops.constant_polymorphic_context cb
     | IndRef ind ->
       let (mib, oib) = Inductive.lookup_mind_specif env ind in
-	Univ.instantiate_univ_context mib.mind_universes 
+      Declareops.inductive_polymorphic_context mib
     | ConstructRef cstr ->
-      let (mib,oib) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
-	Univ.instantiate_univ_context mib.mind_universes 
+      let (mib,oib) = 
+        Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
+      Declareops.inductive_polymorphic_context mib
 
 let universes_of_global gr = 
   universes_of_global (env ()) gr
 
-let is_polymorphic r = 
+let is_polymorphic r =
   let env = env() in 
   match r with
   | VarRef id -> false
@@ -241,7 +247,7 @@ let is_template_polymorphic r =
   let env = env() in 
   match r with
   | VarRef id -> false
-  | ConstRef c -> Environ.template_polymorphic_constant c env
+  | ConstRef c -> false
   | IndRef ind -> Environ.template_polymorphic_ind ind env
   | ConstructRef cstr -> Environ.template_polymorphic_ind (inductive_of_constructor cstr) env
 
@@ -253,6 +259,9 @@ let is_type_in_type r =
   | IndRef ind -> Environ.type_in_type_ind ind env
   | ConstructRef cstr -> Environ.type_in_type_ind (inductive_of_constructor cstr) env
 
+let current_modpath () =
+  Safe_typing.current_modpath (safe_env ())
+
 let current_dirpath () = 
   Safe_typing.current_dirpath (safe_env ())
 
diff --git a/library/global.mli b/library/global.mli
index 247ca20b..b82039a0 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -32,41 +34,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.definition_entry ->
+  unit Entries.definition_entry * Safe_typing.exported_private_constant list
 
 val add_constant :
-  DirPath.t -> Id.t -> Safe_typing.global_declaration ->
-    constant * Safe_typing.exported_private_constant list
+  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 ->
@@ -75,35 +80,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 option
-val body_of_constant_body : Declarations.constant_body -> Term.constr option
-val constraints_of_constant_body :
-  Declarations.constant_body -> Univ.constraints
-val universes_of_constant_body :
-  Declarations.constant_body -> Univ.universe_context
+
+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 -> (Constr.constr * Univ.AUContext.t) option
+(** Same as {!body_of_constant} but on {!Declarations.constant_body}. *)
 
 (** {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 } *)
 
@@ -119,42 +127,40 @@ val is_polymorphic : Globnames.global_reference -> bool
 val is_template_polymorphic : Globnames.global_reference -> bool
 val is_type_in_type : Globnames.global_reference -> bool
 
-val type_of_global_in_context : Environ.env -> 
-  Globnames.global_reference -> Constr.types Univ.in_universe_context
-(** Returns the type of the constant in its global or local universe
+val constr_of_global_in_context : Environ.env ->
+  Globnames.global_reference -> Constr.types * Univ.AUContext.t
+(** Returns the type of the constant in its local universe
     context. The type should not be used without pushing it's universe
     context in the environmnent of usage. For non-universe-polymorphic
     constants, it does not matter. *)
 
-val type_of_global_unsafe : Globnames.global_reference -> Constr.types 
-(** Returns the type of the constant, forgetting its universe context if
-    it is polymorphic, use with care: for polymorphic constants, the
-    type cannot be used to produce a term used by the kernel.  For safe
-    handling of polymorphic global references, one should look at a
-    particular instantiation of the reference, in some particular
-    universe context (part of an [env] or [evar_map]), see
-    e.g. [type_of_constant_in]. If you want to create a fresh instance
-    of the reference and get its type look at [Evd.fresh_global] or
-    [Evarutil.new_global] and [Retyping.get_type_of]. *)
+val type_of_global_in_context : Environ.env -> 
+  Globnames.global_reference -> Constr.types * Univ.AUContext.t
+(** Returns the type of the constant in its local universe
+    context. The type should not be used without pushing it's universe
+    context in the environmnent of usage. For non-universe-polymorphic
+    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.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_modpath : unit -> ModPath.t
+
+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 a78f5f13..6c9c813e 100644
--- a/library/globnames.ml
+++ b/library/globnames.ml
@@ -1,21 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 =
+type global_reference = Names.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,7 +28,7 @@ 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
@@ -67,12 +69,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 +82,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 +159,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 +182,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 +217,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,15 +233,15 @@ 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)
   | IndRef (kn,i) -> IndRef (pop_kn kn,i)
   | ConstructRef ((kn,i),j) -> ConstructRef ((pop_kn kn,i),j)
-  | VarRef id -> anomaly (Pp.str "VarRef not poppable")
+  | VarRef id -> anomaly (Pp.str "VarRef not poppable.")
diff --git a/library/globnames.mli b/library/globnames.mli
index f4956e3d..f2b88b87 100644
--- a/library/globnames.mli
+++ b/library/globnames.mli
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 =
+type global_reference = Names.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 +29,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 +49,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 +75,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 +94,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/goptions.ml b/library/goptions.ml
index 9dc0f405..eb7bb5b4 100644
--- a/library/goptions.ml
+++ b/library/goptions.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This module manages customization parameters at the vernacular level     *)
@@ -24,7 +26,6 @@ type option_value =
 
 (** Summary of an option status *)
 type option_state = {
-  opt_sync  : bool;
   opt_depr  : bool;
   opt_name  : string;
   opt_value : option_value;
@@ -36,7 +37,7 @@ type option_state = {
 let nickname table = String.concat " " table
 
 let error_undeclared_key key =
-  errorlabstrm "Goptions" (str (nickname key) ++ str ": no table or option of this type")
+  user_err ~hdr:"Goptions" (str (nickname key) ++ str ": no table or option of this type")
 
 (****************************************************************************)
 (* 1- Tables                                                                *)
@@ -58,11 +59,10 @@ module MakeTable =
 	  val table : (string * key table_of_A) list ref
 	  val encode : key -> t
 	  val subst : substitution -> t -> t
-          val printer : t -> std_ppcmds
+          val printer : t -> Pp.t
           val key : option_name
           val title : string
-          val member_message : t -> bool -> std_ppcmds
-          val synchronous : bool
+          val member_message : t -> bool -> Pp.t
         end) ->
   struct
     type option_mark =
@@ -73,17 +73,13 @@ module MakeTable =
 
     let _ =
       if String.List.mem_assoc nick !A.table then
-	error "Sorry, this table name is already used."
+	user_err Pp.(str "Sorry, this table name is already used.")
 
     module MySet = Set.Make (struct type t = A.t let compare = A.compare end)
 
-    let t =
-      if A.synchronous
-      then Summary.ref MySet.empty ~name:nick
-      else ref MySet.empty
+    let t = Summary.ref MySet.empty ~name:nick
 
     let (add_option,remove_option) =
-      if A.synchronous then
         let cache_options (_,(f,p)) = match f with
           | GOadd -> t := MySet.add p !t
           | GOrmv -> t := MySet.remove p !t in
@@ -103,9 +99,6 @@ module MakeTable =
 	in
         ((fun c -> Lib.add_anonymous_leaf (inGo (GOadd, c))),
          (fun c -> Lib.add_anonymous_leaf (inGo (GOrmv, c))))
-      else
-        ((fun c -> t := MySet.add c !t),
-         (fun c -> t := MySet.remove c !t))
 
     let print_table table_name printer table =
       Feedback.msg_notice
@@ -140,8 +133,7 @@ module type StringConvertArg =
 sig
   val key : option_name
   val title : string
-  val member_message : string -> bool -> std_ppcmds
-  val synchronous : bool
+  val member_message : string -> bool -> Pp.t
 end
 
 module StringConvert = functor (A : StringConvertArg) ->
@@ -156,7 +148,6 @@ struct
   let key = A.key
   let title = A.title
   let member_message = A.member_message
-  let synchronous = A.synchronous
 end
 
 module MakeStringTable =
@@ -172,11 +163,10 @@ sig
   val compare : t -> t -> int
   val encode : reference -> t
   val subst : substitution -> t -> t
-  val printer : t -> std_ppcmds
+  val printer : t -> Pp.t
   val key : option_name
   val title : string
-  val member_message : t -> bool -> std_ppcmds
-  val synchronous : bool
+  val member_message : t -> bool -> Pp.t
 end
 
 module RefConvert = functor (A : RefConvertArg) ->
@@ -191,7 +181,6 @@ struct
   let key = A.key
   let title = A.title
   let member_message = A.member_message
-  let synchronous = A.synchronous
 end
 
 module MakeRefTable =
@@ -201,14 +190,13 @@ module MakeRefTable =
 (* 2- Flags.                                                              *)
 
 type 'a option_sig = {
-  optsync  : bool;
   optdepr  : bool;
   optname  : string;
   optkey   : option_name;
   optread  : unit -> 'a;
   optwrite : 'a -> unit }
 
-type option_locality = OptLocal | OptDefault | OptGlobal
+type option_locality = OptDefault | OptLocal | OptExport | OptGlobal
 
 type option_mod = OptSet | OptAppend
 
@@ -228,31 +216,24 @@ let get_option key = OptionMap.find key !value_tab
 
 let check_key key = try
   let _ = get_option key in
-  error "Sorry, this option name is already used."
+  user_err Pp.(str "Sorry, this option name is already used.")
 with Not_found ->
   if String.List.mem_assoc (nickname key) !string_table
     || String.List.mem_assoc (nickname key) !ref_table
-  then error "Sorry, this option name is already used."
+  then user_err Pp.(str "Sorry, this option name is already used.")
 
 open Libobject
-open Lib
 
 let warn_deprecated_option =
   CWarnings.create ~name:"deprecated-option" ~category:"deprecated"
          (fun key -> str "Option" ++ spc () ++ str (nickname key) ++
                        strbrk " is deprecated")
 
-let get_locality = function
-  | Some true -> OptLocal
-  | Some false -> OptGlobal
-  | None -> OptDefault
-
 let declare_option cast uncast append ?(preprocess = fun x -> x)
-  { optsync=sync; optdepr=depr; optname=name; optkey=key; optread=read; optwrite=write } =
+  { optdepr=depr; optname=name; optkey=key; optread=read; optwrite=write } =
   check_key key;
   let default = read() in
   let change =
-    if sync then
       let _ = Summary.declare_summary (nickname key)
         { Summary.freeze_function = (fun _ -> read ());
           Summary.unfreeze_function = write;
@@ -261,33 +242,41 @@ let declare_option cast uncast append ?(preprocess = fun x -> x)
         match m with
         | OptSet -> write v
         | OptAppend -> write (append (read ()) v) in
-      let load_options i o = cache_options o in
+      let load_options i (_, (l, _, _) as o) = match l with
+      | OptGlobal -> cache_options o
+      | OptExport -> ()
+      | OptLocal | OptDefault ->
+        (** Ruled out by classify_function *)
+        assert false
+      in
+      let open_options i  (_, (l, _, _) as o) = match l with
+      | OptExport -> if Int.equal i 1 then cache_options o
+      | OptGlobal -> ()
+      | OptLocal | OptDefault ->
+        (** Ruled out by classify_function *)
+        assert false
+      in
       let subst_options (subst,obj) = obj in
       let discharge_options (_,(l,_,_ as o)) =
-        match l with OptLocal -> None | _ -> Some o in
+        match l with OptLocal -> None | (OptExport | OptGlobal | OptDefault) -> Some o in
       let classify_options (l,_,_ as o) =
-        match l with OptGlobal -> Substitute o | _ -> Dispose in
+        match l with (OptExport | OptGlobal) -> Substitute o | (OptLocal | OptDefault) -> Dispose in
       let options : option_locality * option_mod * _ -> obj =
         declare_object
           { (default_object (nickname key)) with
             load_function = load_options;
+            open_function = open_options;
             cache_function = cache_options;
             subst_function = subst_options;
             discharge_function = discharge_options;
             classify_function = classify_options } in
       (fun l m v -> let v = preprocess v in Lib.add_anonymous_leaf (options (l, m, v)))
-    else
-      (fun _ m v ->
-        let v = preprocess v in
-        match m with
-       | OptSet -> write v
-       | OptAppend -> write (append (read ()) v))
   in
   let warn () = if depr then warn_deprecated_option key in
   let cread () = cast (read ()) in
   let cwrite l v = warn (); change l OptSet (uncast v) in
   let cappend l v = warn (); change l OptAppend (uncast v) in
-  value_tab := OptionMap.add key (name, depr, (sync,cread,cwrite,cappend)) !value_tab;
+  value_tab := OptionMap.add key (name, depr, (cread,cwrite,cappend)) !value_tab;
   write
 
 type 'a write_function = 'a -> unit
@@ -295,23 +284,23 @@ type 'a write_function = 'a -> unit
 let declare_int_option =
   declare_option
     (fun v -> IntValue v)
-    (function IntValue v -> v | _ -> anomaly (Pp.str "async_option"))
-    (fun _ _ -> anomaly (Pp.str "async_option"))
+    (function IntValue v -> v | _ -> anomaly (Pp.str "async_option."))
+    (fun _ _ -> anomaly (Pp.str "async_option."))
 let declare_bool_option =
   declare_option
     (fun v -> BoolValue v)
-    (function BoolValue v -> v | _ -> anomaly (Pp.str "async_option"))
-    (fun _ _ -> anomaly (Pp.str "async_option"))
+    (function BoolValue v -> v | _ -> anomaly (Pp.str "async_option."))
+    (fun _ _ -> anomaly (Pp.str "async_option."))
 let declare_string_option =
   declare_option
     (fun v -> StringValue v)
-    (function StringValue v -> v | _ -> anomaly (Pp.str "async_option"))
+    (function StringValue v -> v | _ -> anomaly (Pp.str "async_option."))
     (fun x y -> x^","^y)
 let declare_stringopt_option =
   declare_option
     (fun v -> StringOptValue v)
-    (function StringOptValue v -> v | _ -> anomaly (Pp.str "async_option"))
-    (fun _ _ -> anomaly (Pp.str "async_option"))
+    (function StringOptValue v -> v | _ -> anomaly (Pp.str "async_option."))
+    (fun _ _ -> anomaly (Pp.str "async_option."))
 
 (* 3- User accessible commands *)
 
@@ -322,14 +311,14 @@ let warn_unknown_option =
                    (fun key -> strbrk "There is no option " ++
                                  str (nickname key) ++ str ".")
 
-let set_option_value locality check_and_cast key v =
+let set_option_value ?(locality = OptDefault) check_and_cast key v =
   let opt = try Some (get_option key) with Not_found -> None in
   match opt with
   | None -> warn_unknown_option key
-  | Some (name, depr, (_,read,write,append)) ->
-    write (get_locality locality) (check_and_cast v (read ()))
+  | Some (name, depr, (read,write,append)) ->
+    write locality (check_and_cast v (read ()))
 
-let bad_type_error () = error "Bad type of value for this option."
+let bad_type_error () = user_err Pp.(str "Bad type of value for this option.")
 
 let check_int_value v = function
   | IntValue _ -> IntValue v
@@ -354,25 +343,25 @@ let check_unset_value v = function
    warning. This allows a script to refer to an option that doesn't
    exist anymore *)
 
-let set_int_option_value_gen locality =
-  set_option_value locality check_int_value
-let set_bool_option_value_gen locality key v =
-  set_option_value locality check_bool_value key v
-let set_string_option_value_gen locality =
-  set_option_value locality check_string_value
-let unset_option_value_gen locality key =
-  set_option_value locality check_unset_value key ()
+let set_int_option_value_gen ?locality =
+  set_option_value ?locality check_int_value
+let set_bool_option_value_gen ?locality key v =
+  set_option_value ?locality check_bool_value key v
+let set_string_option_value_gen ?locality =
+  set_option_value ?locality check_string_value
+let unset_option_value_gen ?locality key =
+  set_option_value ?locality check_unset_value key ()
 
-let set_string_option_append_value_gen locality key v =
+let set_string_option_append_value_gen ?(locality = OptDefault) key v =
   let opt = try Some (get_option key) with Not_found -> None in
   match opt with
   | None -> warn_unknown_option key
-  | Some (name, depr, (_,read,write,append)) ->
-    append (get_locality locality) (check_string_value v (read ()))
+  | Some (name, depr, (read,write,append)) ->
+    append locality (check_string_value v (read ()))
 
-let set_int_option_value = set_int_option_value_gen None
-let set_bool_option_value = set_bool_option_value_gen None
-let set_string_option_value = set_string_option_value_gen None
+let set_int_option_value opt v = set_int_option_value_gen opt v
+let set_bool_option_value opt v = set_bool_option_value_gen opt v
+let set_string_option_value opt v = set_string_option_value_gen opt v
 
 (* Printing options/tables *)
 
@@ -382,13 +371,13 @@ let msg_option_value (name,v) =
     | BoolValue false -> str "off"
     | IntValue (Some n) -> int n
     | IntValue None   -> str "undefined"
-    | StringValue s   -> str "\"" ++ str s ++ str "\""
+    | StringValue s   -> quote (str s)
     | StringOptValue None   -> str"undefined"
-    | StringOptValue (Some s)   -> str "\"" ++ str s ++ str "\""
+    | StringOptValue (Some s)   -> quote (str s)
 (*     | IdentValue r    -> pr_global_env Id.Set.empty r *)
 
 let print_option_value key =
-  let (name, depr, (_,read,_,_)) = get_option key in
+  let (name, depr, (read,_,_)) = get_option key in
   let s = read () in
   match s with
     | BoolValue b ->
@@ -398,9 +387,8 @@ let print_option_value key =
 
 let get_tables () =
   let tables = !value_tab in
-  let fold key (name, depr, (sync,read,_,_)) accu =
+  let fold key (name, depr, (read,_,_)) accu =
     let state = {
-      opt_sync = sync;
       opt_name = name;
       opt_depr = depr;
       opt_value = read ();
@@ -415,17 +403,10 @@ let print_tables () =
     if depr then msg ++ str " [DEPRECATED]" ++ fnl ()
     else msg ++ fnl ()
   in
-  str "Synchronous options:" ++ fnl () ++
-    OptionMap.fold
-      (fun key (name, depr, (sync,read,_,_)) p ->
-        if sync then p ++ print_option key name (read ()) depr
-        else p)
-      !value_tab (mt ()) ++
-  str "Asynchronous options:" ++ fnl () ++
+  str "Options:" ++ fnl () ++
     OptionMap.fold
-      (fun key (name, depr, (sync,read,_,_)) p ->
-        if sync then p
-        else p ++ print_option key name (read ()) depr)
+      (fun key (name, depr, (read,_,_)) p ->
+        p ++ print_option key name (read ()) depr)
       !value_tab (mt ()) ++
   str "Tables:" ++ fnl () ++
     List.fold_right
diff --git a/library/goptions.mli b/library/goptions.mli
index 3b3651f3..6c14d19e 100644
--- a/library/goptions.mli
+++ b/library/goptions.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module manages customization parameters at the vernacular level     *)
@@ -40,15 +42,16 @@
        Unset Tata Tutu Titi.
        Print Table Tata Tutu Titi. (** synonym: Test Table Tata Tutu Titi. *)
 
-   The created table/option may be declared synchronous or not
-   (synchronous = consistent with the resetting commands)                   *)
+   All options are synchronized with the document.
+*)
 
-open Pp
 open Libnames
 open Mod_subst
 
 type option_name = string list
 
+type option_locality = OptDefault | OptLocal | OptExport | OptGlobal
+
 (** {6 Tables. } *)
 
 (** The functor [MakeStringTable] declares a table containing objects
@@ -64,8 +67,7 @@ module MakeStringTable :
     (A : sig
        val key : option_name
        val title : string
-       val member_message : string -> bool -> std_ppcmds
-       val synchronous : bool
+       val member_message : string -> bool -> Pp.t
      end) ->
 sig
   val active : string -> bool
@@ -89,11 +91,10 @@ module MakeRefTable :
            val compare : t -> t -> int
            val encode : reference -> t
 	   val subst : substitution -> t -> t
-           val printer : t -> std_ppcmds
+           val printer : t -> Pp.t
            val key : option_name
            val title : string
-           val member_message : t -> bool -> std_ppcmds
-           val synchronous : bool
+           val member_message : t -> bool -> Pp.t
          end) ->
     sig
       val active : A.t -> bool
@@ -108,8 +109,6 @@ module MakeRefTable :
    used when printing the option value (command "Print Toto Titi." *)
 
 type 'a option_sig = {
-  optsync    : bool;
-  (** whether the option is synchronous w.r.t to the section/module system. *)
   optdepr    : bool;
   (** whether the option is DEPRECATED *)
   optname    : string;
@@ -120,8 +119,6 @@ type 'a option_sig = {
   optwrite   : 'a -> unit
 }
 
-(** When an option is declared synchronous ([optsync] is [true]), the output is
-   a synchronous write function. Otherwise it is [optwrite] *)
 (** The [preprocess] function is triggered before setting the option. It can be
     used to emit a warning on certain values, and clean-up the final value. *)
 
@@ -155,13 +152,12 @@ val get_ref_table :
       mem : reference -> unit;
       print : unit >
 
-(** The first argument is a locality flag.
-    [Some true] = "Local", [Some false]="Global". *)
-val set_int_option_value_gen    : bool option -> option_name -> int option -> unit
-val set_bool_option_value_gen   : bool option -> option_name -> bool   -> unit
-val set_string_option_value_gen : bool option -> option_name -> string -> unit
-val set_string_option_append_value_gen : bool option -> option_name -> string -> unit
-val unset_option_value_gen : bool option -> option_name -> unit
+(** The first argument is a locality flag. *)
+val set_int_option_value_gen    : ?locality:option_locality -> option_name -> int option -> unit
+val set_bool_option_value_gen   : ?locality:option_locality -> option_name -> bool   -> unit
+val set_string_option_value_gen : ?locality:option_locality -> option_name -> string -> unit
+val set_string_option_append_value_gen : ?locality:option_locality -> option_name -> string -> unit
+val unset_option_value_gen : ?locality:option_locality -> option_name -> unit
 
 val set_int_option_value    : option_name -> int option -> unit
 val set_bool_option_value   : option_name -> bool   -> unit
@@ -177,13 +173,12 @@ type option_value =
 
 (** Summary of an option status *)
 type option_state = {
-  opt_sync  : bool;
   opt_depr  : bool;
   opt_name  : string;
   opt_value : option_value;
 }
 
 val get_tables : unit -> option_state OptionMap.t
-val print_tables : unit -> std_ppcmds
+val print_tables : unit -> Pp.t
 
 val error_undeclared_key : option_name -> 'a
diff --git a/library/heads.ml b/library/heads.ml
index 02465f22..198672a0 100644
--- a/library/heads.ml
+++ b/library/heads.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open Mod_subst
 open Environ
@@ -25,7 +27,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 +59,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 ->
@@ -72,7 +74,8 @@ let kind_of_head env t =
        with Not_found ->
          CErrors.anomaly
            Pp.(str "constant not found in kind_of_head: " ++
-               str (Names.Constant.to_string cst)))
+               Names.Constant.print cst ++
+               str "."))
   | Construct _ | CoFix _ ->
       if b then NotImmediatelyComputableHead else ConstructorHead
   | Sort _ | Ind _ | Prod _ -> RigidHead RigidType
@@ -127,11 +130,11 @@ let compute_head = function
    let is_Def = function Declarations.Def _ -> true | _ -> false in
    let body = 
      if cb.Declarations.const_proj = None && is_Def cb.Declarations.const_body
-     then Declareops.body_of_constant (Environ.opaque_tables env) cb else None 
+     then Global.body_of_constant cst else None
    in
      (match body with
      | None -> RigidHead (RigidParameter cst)
-     | Some c -> kind_of_head env c)
+     | Some (c, _) -> kind_of_head env c)
 | EvalVarRef id ->
     (match Global.lookup_named id with
      | LocalDef (_,c,_) when not (Decls.variable_opacity id) ->
@@ -155,7 +158,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 5acf5f54..42124299 100644
--- a/library/heads.mli
+++ b/library/heads.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 
 (** This module is about the computation of an approximation of the
diff --git a/library/keys.ml b/library/keys.ml
index 057dc3b6..34a6adab 100644
--- a/library/keys.ml
+++ b/library/keys.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Keys for unification and indexing *)
@@ -114,11 +116,11 @@ let inKeys : key_obj -> obj =
 let declare_equiv_keys ref ref' =
   Lib.add_anonymous_leaf (inKeys (ref,ref'))
 
-let constr_key c =
+let constr_key kind c =
   let open Globnames in 
   try 
     let rec aux k = 
-      match kind_of_term k with
+      match kind k with
       | Const (c, _) -> KGlob (ConstRef c)
       | Ind (i, u) -> KGlob (IndRef i)
       | Construct (c,u) -> KGlob (ConstructRef c)
diff --git a/library/keys.mli b/library/keys.mli
index 69668590..1fb9a3de 100644
--- a/library/keys.mli
+++ b/library/keys.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Globnames
@@ -16,8 +18,8 @@ val declare_equiv_keys : key -> key -> unit
 val equiv_keys : key -> key -> bool
 (** Check equivalence of keys. *)
 
-val constr_key : Term.constr -> key option
+val constr_key : ('a -> ('a, 't, 'u, 'i) Constr.kind_of_term) -> 'a -> key option
 (** Compute the head key of a term. *)
 
-val pr_keys : (global_reference -> Pp.std_ppcmds) -> Pp.std_ppcmds
+val pr_keys : (global_reference -> Pp.t) -> Pp.t
 (** Pretty-print the mapping *)
diff --git a/library/kindops.ml b/library/kindops.ml
index 21b1bec3..247319fa 100644
--- a/library/kindops.ml
+++ b/library/kindops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Decl_kinds
@@ -23,45 +25,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")
+    CErrors.anomaly (Pp.str "Internal definition kind.")
diff --git a/library/kindops.mli b/library/kindops.mli
index 3e95eaa7..df39019d 100644
--- a/library/kindops.mli
+++ b/library/kindops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Decl_kinds
@@ -12,4 +14,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 f680ecee..543cb45b 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -1,18 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
+open Names
 open Libnames
 open Globnames
-open Nameops
 open Libobject
+open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 type is_type = bool (* Module Type or just Module *)
 type export = bool option (* None for a Module Type *)
@@ -24,7 +29,6 @@ type node =
   | ClosedModule  of library_segment
   | OpenedSection of object_prefix * Summary.frozen
   | ClosedSection of library_segment
-  | FrozenState of Summary.frozen
 
 and library_entry = object_name * node
 
@@ -60,7 +64,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' ->
@@ -73,11 +77,10 @@ let classify_segment seg =
     (* LEM; TODO: Understand what this does and see if what I do is the
                   correct thing for ClosedMod(ule|type) *)
     | (_,ClosedModule _) :: stk -> clean acc stk
-    | (_,OpenedSection _) :: _ -> error "there are still opened sections"
+    | (_,OpenedSection _) :: _ -> user_err Pp.(str "there are still opened sections")
     | (_,OpenedModule (ty,_,_,_)) :: _ ->
-      errorlabstrm "Lib.classify_segment"
+      user_err ~hdr:"Lib.classify_segment"
         (str "there are still opened " ++ str (module_kind ty) ++ str "s")
-    | (_,FrozenState _) :: stk -> clean acc stk
   in
     clean ([],[],[]) (List.rev seg)
 
@@ -92,23 +95,35 @@ 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   : DirPath.t option;
+  lib_stk     : library_segment;
+  path_prefix : object_prefix;
+}
 
-let lib_stk = ref ([] : library_segment)
+let initial_lib_state = {
+  comp_name   = None;
+  lib_stk     = [];
+  path_prefix = initial_prefix;
+}
 
-let comp_name = ref None
+let lib_state = ref initial_lib_state
 
 let library_dp () =
-  match !comp_name with Some m -> m | None -> default_library
+  match !lib_state.comp_name with Some m -> m | None -> default_library
 
 (* [path_prefix] is a pair of absolute dirpath and a pair of current
    module path and relative section path *)
-let path_prefix = ref initial_prefix
 
-let cwd () = fst !path_prefix
-let current_prefix () = snd !path_prefix
-let current_mp () = fst (snd !path_prefix)
-let current_sections () = snd (snd !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 ()))
@@ -126,10 +141,10 @@ 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 !path_prefix id
+let make_oname id = Libnames.make_oname !lib_state.path_prefix id
 
 let recalc_path_prefix () =
   let rec recalc = function
@@ -139,18 +154,28 @@ let recalc_path_prefix () =
     | _::l -> recalc l
     | [] -> initial_prefix
   in
-  path_prefix := recalc !lib_stk
+  lib_state := { !lib_state with path_prefix = recalc !lib_state.lib_stk }
 
 let pop_path_prefix () =
-  let dir,(mp,sec) = !path_prefix in
-  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
     | [] -> raise Not_found
     | ent::l -> if p ent then ent else find l
   in
-  find !lib_stk
+  find !lib_state.lib_stk
+
+let find_entries_p p =
+  let rec find = function
+    | [] -> []
+    | ent::l -> if p ent then ent::find l else find l
+  in
+  find !lib_state.lib_stk
 
 let split_lib_gen test =
   let rec collect after equal = function
@@ -171,8 +196,8 @@ let split_lib_gen test =
 		| _ -> findeq (hd::after) before)
     | [] -> None
   in
-    match findeq [] !lib_stk with
-      | None -> error "no such entry"
+    match findeq [] !lib_state.lib_stk with
+      | None -> user_err Pp.(str "no such entry")
       | Some r -> r
 
 let eq_object_name (fp1, kn1) (fp2, kn2) =
@@ -196,10 +221,10 @@ let split_lib_at_opening sp =
 (* Adding operations. *)
 
 let add_entry sp node =
-  lib_stk := (sp,node) :: !lib_stk
+  lib_state := { !lib_state with lib_stk = (sp,node) :: !lib_state.lib_stk }
 
 let pull_to_head oname =
-  lib_stk := (oname,List.assoc oname !lib_stk) :: List.remove_assoc oname !lib_stk
+  lib_state := { !lib_state with lib_stk = (oname,List.assoc oname !lib_state.lib_stk) :: List.remove_assoc oname !lib_state.lib_stk }
 
 let anonymous_id =
   let n = ref 0 in
@@ -209,8 +234,8 @@ 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
-    error ("No session module started (use -top dir)");
+  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);
   add_entry oname (Leaf obj);
@@ -242,10 +267,6 @@ let add_anonymous_leaf ?(cache_first = true) obj =
     cache_object (oname,obj)
   end
 
-let add_frozen_state () =
-  add_anonymous_entry
-    (FrozenState (Summary.freeze_summaries ~marshallable:`No))
-
 (* Modules. *)
 
 let is_opening_node = function
@@ -260,21 +281,21 @@ let current_mod_id () =
   try match find_entry_p is_opening_node_or_lib with
     | oname,OpenedModule (_,_,_,fs) -> basename (fst oname)
     | oname,CompilingLibrary _ -> basename (fst oname)
-    | _ -> error "you are not in a module"
-  with Not_found -> error "no opened modules"
+    | _ -> user_err Pp.(str "you are not in a module")
+  with Not_found -> user_err Pp.(str "no opened modules")
 
 
 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
-    errorlabstrm "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));
-  path_prefix := prefix;
+  lib_state := { !lib_state with path_prefix = prefix} ;
   prefix
 
 let start_module = start_mod false
@@ -282,8 +303,8 @@ let start_modtype = start_mod true None
 
 let error_still_opened string oname =
   let id = basename (fst oname) in
-  errorlabstrm ""
-    (str "The " ++ str string ++ str " " ++ pr_id id ++ str " is still opened.")
+  user_err 
+    (str "The " ++ str string ++ str " " ++ Id.print id ++ str " is still opened.")
 
 let end_mod is_type =
   let oname,fs =
@@ -293,19 +314,19 @@ let end_mod is_type =
 	else error_still_opened (module_kind ty) oname
       | oname,OpenedSection _ -> error_still_opened "section" oname
       | _ -> assert false
-    with Not_found -> error "No opened modules."
+    with Not_found -> user_err (Pp.str "No opened modules.")
   in
   let (after,mark,before) = split_lib_at_opening oname in
-  lib_stk := before;
+  lib_state := { !lib_state with lib_stk = before };
   add_entry oname (ClosedModule (List.rev (mark::after)));
-  let prefix = !path_prefix in
+  let prefix = !lib_state.path_prefix in
   recalc_path_prefix ();
   (oname, prefix, fs, after)
 
 let end_module () = end_mod false
 let end_modtype () = end_mod true
 
-let contents () = !lib_stk
+let contents () = !lib_state.lib_stk
 
 let contents_after sp = let (after,_,_) = split_lib sp in after
 
@@ -313,47 +334,49 @@ let contents_after sp = let (after,_,_) = split_lib sp in after
 
 (* TODO: use check_for_module ? *)
 let start_compilation s mp =
-  if !comp_name != None then
-    error "compilation unit is already started";
-  if not (Names.DirPath.is_empty (current_sections ())) then
-    error "some sections are already opened";
-  let prefix = s, (mp, Names.DirPath.empty) in
-  let () = add_anonymous_entry (CompilingLibrary prefix) in
-  comp_name := Some s;
-  path_prefix := prefix
+  if !lib_state.comp_name != None then
+    user_err Pp.(str "compilation unit is already started");
+  if not (Names.DirPath.is_empty (!lib_state.path_prefix.obj_sec)) then
+    user_err Pp.(str "some sections are already opened");
+  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 " ++ 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."
 
 let end_compilation_checks dir =
-  let _ =
-    try match snd (find_entry_p is_opening_node) with
-      | OpenedSection _ -> error "There are some open sections."
-      | OpenedModule (ty,_,_,_) ->
-	errorlabstrm "Lib.end_compilation_checks"
-          (str "There are some open " ++ str (module_kind ty) ++ str "s.")
-      | _ -> assert false
-    with Not_found -> ()
-  in
+  let _ = match find_entries_p is_opening_node with
+    | [] -> ()
+    | es -> user_err ~hdr:"Lib.end_compilation_checks" (open_blocks_message es) in
   let is_opening_lib = function _,CompilingLibrary _ -> true | _ -> false
   in
   let oname =
     try match find_entry_p is_opening_lib with
       |	(oname, CompilingLibrary prefix) -> oname
       | _ -> assert false
-    with Not_found -> anomaly (Pp.str "No module declared")
+    with Not_found -> anomaly (Pp.str "No module declared.")
   in
   let _ =
-    match !comp_name with
+    match !lib_state.comp_name with
       | 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 "The current open module has name" ++ spc () ++ DirPath.print m ++
+             spc () ++ str "and not" ++ spc () ++ DirPath.print m ++ str ".");
   in
   oname
 
 let end_compilation oname =
   let (after,mark,before) = split_lib_at_opening oname in
-  comp_name := None;
-  !path_prefix,after
+  lib_state := { !lib_state with comp_name = None };
+  !lib_state.path_prefix,after
 
 (* Returns true if we are inside an opened module or module type *)
 
@@ -379,10 +402,10 @@ let find_opening_node id =
     let oname,entry = find_entry_p is_opening_node in
     let id' = basename (fst oname) in
     if not (Names.Id.equal id id') then
-      errorlabstrm "Lib.find_opening_node"
-        (str "Last block to end has name " ++ pr_id id' ++ str ".");
+      user_err ~hdr:"Lib.find_opening_node"
+        (str "Last block to end has name " ++ Id.print id' ++ str ".");
     entry
-  with Not_found -> error "There is nothing to end."
+  with Not_found -> user_err Pp.(str "There is nothing to end.")
 
 (* Discharge tables *)
 
@@ -393,17 +416,20 @@ let find_opening_node id =
    - the list of substitution to do at section closing
 *)
 
-type variable_info = Names.Id.t * Decl_kinds.binding_kind * Term.constr option * Term.types
+type variable_info = Context.Named.Declaration.t * Decl_kinds.binding_kind
 
 type variable_context = variable_info list
-type abstr_info = variable_context * Univ.universe_level_subst * Univ.UContext.t
-		  
+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)
@@ -416,7 +442,7 @@ let add_section () =
 let check_same_poly p vars =
   let pred = function Context _ -> p = false | Variable (_, _, poly, _) -> p != poly in
   if List.exists pred vars then
-    error "Cannot mix universe polymorphic and monomorphic declarations in sections."
+    user_err Pp.(str  "Cannot mix universe polymorphic and monomorphic declarations in sections.")
 
 let add_section_variable id impl poly ctx =
   match !sectab with
@@ -433,12 +459,10 @@ let add_section_context ctx =
        sectab := (Context ctx :: vars,repl,abs)::sl
 
 let extract_hyps (secs,ohyps) =
-  let open Context.Named.Declaration in
   let rec aux = function
-    | (Variable (id,impl,poly,ctx)::idl, decl::hyps) when Names.Id.equal id (get_id decl) ->
-      let (id',b,t) = to_tuple decl in
+    | (Variable (id,impl,poly,ctx)::idl, decl::hyps) when Names.Id.equal id (NamedDecl.get_id decl) ->
       let l, r = aux (idl,hyps) in 
-	(id',impl,b,t) :: l, if poly then Univ.ContextSet.union r ctx else r
+      (decl,impl) :: l, if poly then Univ.ContextSet.union r ctx else r
     | (Variable (_,_,poly,ctx)::idl,hyps) ->
         let l, r = aux (idl,hyps) in
           l, if poly then Univ.ContextSet.union r ctx else r
@@ -448,17 +472,11 @@ let extract_hyps (secs,ohyps) =
     | [], _ -> [],Univ.ContextSet.empty
   in aux (secs,ohyps)
 
-let instance_from_variable_context sign =
-  let rec inst_rec = function
-    | (id,b,None,_) :: sign -> id :: inst_rec sign
-    | _ :: sign -> inst_rec sign
-    | [] -> [] in
-  Array.of_list (inst_rec sign)
-
-let named_of_variable_context ctx = let open Context.Named.Declaration in
-                                    List.map (function id,_,None,t -> LocalAssum (id,t)
-                                                     | id,_,Some b,t -> LocalDef (id,b,t))
-                                             ctx
+let instance_from_variable_context =
+  List.map fst %> List.filter is_local_assum %> List.map NamedDecl.get_id %> Array.of_list
+
+let named_of_variable_context =
+  List.map fst
   
 let add_section_replacement f g poly hyps =
   match !sectab with
@@ -467,10 +485,15 @@ let add_section_replacement f g poly hyps =
     let () = check_same_poly poly vars in
     let sechyps,ctx = extract_hyps (vars,hyps) in
     let ctx = Univ.ContextSet.to_context ctx in
-    let subst, ctx = Univ.abstract_universes true ctx in
+    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 (Univ.UContext.instance ctx,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
@@ -488,16 +511,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))
@@ -513,23 +545,17 @@ let is_in_section ref =
 
 (*************)
 (* Sections. *)
-
-(* XML output hooks *)
-let (f_xml_open_section, xml_open_section) = Hook.make ~default:ignore ()
-let (f_xml_close_section, xml_close_section) = Hook.make ~default:ignore ()
-
 let open_section id =
-  let olddir,(mp,oldsec) = !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
-    errorlabstrm "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);
-  path_prefix := prefix;
-  if !Flags.xml_export then Hook.get f_xml_open_section id;
+  Nametab.push_dir (Nametab.Until 1) obj_dir (DirOpenSection prefix);
+  lib_state := { !lib_state with path_prefix = prefix };
   add_section ()
 
 
@@ -540,10 +566,9 @@ let discharge_item ((sp,_ as oname),e) =
   match e with
   | Leaf lobj ->
       Option.map (fun o -> (basename sp,o)) (discharge_object (oname,lobj))
-  | FrozenState _ -> None
   | ClosedSection _ | ClosedModule _ -> None
   | OpenedSection _ | OpenedModule _ | CompilingLibrary _ ->
-      anomaly (Pp.str "discharge_item")
+      anomaly (Pp.str "discharge_item.")
 
 let close_section () =
   let oname,fs =
@@ -551,14 +576,13 @@ let close_section () =
       | oname,OpenedSection (_,fs) -> oname,fs
       | _ -> assert false
     with Not_found ->
-      error "No opened section."
+      user_err Pp.(str  "No opened section.")
   in
   let (secdecls,mark,before) = split_lib_at_opening oname in
-  lib_stk := before;
-  let full_olddir = fst !path_prefix in
+  lib_state := { !lib_state with lib_stk = before };
+  let full_olddir = !lib_state.path_prefix.obj_dir in
   pop_path_prefix ();
   add_entry oname (ClosedSection (List.rev (mark::secdecls)));
-  if !Flags.xml_export then Hook.get f_xml_close_section (basename (fst oname));
   let newdecls = List.map discharge_item secdecls in
   Summary.unfreeze_summaries fs;
   List.iter (Option.iter (fun (id,o) -> add_discharged_leaf id o)) newdecls;
@@ -566,7 +590,7 @@ let close_section () =
 
 (* State and initialization. *)
 
-type frozen = Names.DirPath.t option * library_segment
+type frozen = lib_state
 
 let freeze ~marshallable =
   match marshallable with
@@ -581,30 +605,25 @@ let freeze ~marshallable =
         | n, ClosedModule _ -> Some (n,ClosedModule [])
         | n, OpenedSection (op, _) ->
                Some(n,OpenedSection(op,Summary.empty_frozen))
-        | n, ClosedSection _ -> Some (n,ClosedSection [])
-        | _, FrozenState _ -> None)
-      !lib_stk in
-    !comp_name, lib_stk
+        | n, ClosedSection _ -> Some (n,ClosedSection []))
+      !lib_state.lib_stk in
+    { !lib_state with lib_stk }
   | _ ->
-    !comp_name, !lib_stk
+    !lib_state
 
-let unfreeze (mn,stk) =
-  comp_name := mn;
-  lib_stk := stk;
-  recalc_path_prefix ()
+let unfreeze st = lib_state := st
 
 let init () =
-  unfreeze (None,[]);
-  Summary.init_summaries ();
-  add_frozen_state () (* Stores e.g. the keywords declared in g_*.ml4 *)
+  unfreeze initial_lib_state;
+  Summary.init_summaries ()
 
 (* 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
@@ -626,12 +645,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 ())
 
@@ -652,3 +671,11 @@ let discharge_con cst =
 
 let discharge_inductive (kn,i) =
   (discharge_kn kn,i)
+
+let discharge_abstract_universe_context { abstr_subst = subst; abstr_uctx = abs_ctx } auctx =
+  let open Univ 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 a8e110c6..26f1718c 100644
--- a/library/lib.mli
+++ b/library/lib.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
@@ -23,7 +25,6 @@ type node =
   | ClosedModule  of library_segment
   | OpenedSection of Libnames.object_prefix * Summary.frozen
   | ClosedSection of library_segment
-  | FrozenState of Summary.frozen
 
 and library_segment = (Libnames.object_name * node) list
 
@@ -61,8 +62,6 @@ val pull_to_head : Libnames.object_name -> unit
    for each of them *)
 val add_leaves : Names.Id.t -> Libobject.obj list -> Libnames.object_name
 
-val add_frozen_state : unit -> unit
-
 (** {6 ... } *)
 
 (** The function [contents] gives access to the current entire segment *)
@@ -84,8 +83,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
@@ -106,11 +105,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 :
@@ -123,11 +122,9 @@ val end_modtype :
   Libnames.object_name * Libnames.object_prefix *
     Summary.frozen * library_segment
 
-(** [Lib.add_frozen_state] must be called after each of the above functions *)
-
 (** {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
@@ -137,8 +134,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 } *)
@@ -155,37 +152,43 @@ val unfreeze : frozen -> unit
 
 val init : unit -> unit
 
-(** XML output hooks *)
-val xml_open_section : (Names.Id.t -> unit) Hook.t
-val xml_close_section : (Names.Id.t -> unit) Hook.t
-
 (** {6 Section management for discharge } *)
-type variable_info = Names.Id.t * Decl_kinds.binding_kind *
-    Term.constr option * Term.types
+type variable_info = Context.Named.Declaration.t * Decl_kinds.binding_kind
 type variable_context = variable_info list 
-type abstr_info = variable_context * Univ.universe_level_subst * Univ.UContext.t
+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 :
+  abstr_info -> Univ.AUContext.t -> Univ.universe_level_subst * Univ.AUContext.t
diff --git a/library/libnames.ml b/library/libnames.ml
index dd74e192..d8473132 100644
--- a/library/libnames.ml
+++ b/library/libnames.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -13,7 +15,7 @@ open Names
 
 (**********************************************)
 
-let pr_dirpath sl = str (DirPath.to_string sl)
+let pr_dirpath sl = DirPath.print sl
 
 (*s Operations on dirpaths *)
 
@@ -58,14 +60,14 @@ let add_dirpath_suffix p id = DirPath.make (id :: DirPath.repr p)
 let parse_dir s =
   let len = String.length s in
   let rec decoupe_dirs dirs n =
-    if Int.equal n len && n > 0 then error (s ^ " is an invalid path.");
+    if Int.equal n len && n > 0 then user_err Pp.(str @@ s ^ " is an invalid path.");
     if n >= len then dirs else
     let pos =
       try
 	String.index_from s n '.'
       with Not_found -> len
     in
-    if Int.equal pos n then error (s ^ " is an invalid path.");
+    if Int.equal pos n then user_err Pp.(str @@ s ^ " is an invalid path.");
     let dir = String.sub s n (pos-n) in
     decoupe_dirs ((Id.of_string dir)::dirs) (pos+1)
   in
@@ -154,12 +156,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 +177,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
@@ -183,54 +190,59 @@ let eq_global_dir_reference r1 r2 = match r1, r2 with
 | DirClosedSection dp1, DirClosedSection dp2 -> DirPath.equal dp1 dp2
 | _ -> false
 
-type reference =
-  | Qualid of qualid Loc.located
-  | Ident of Id.t Loc.located
+type reference_r =
+  | Qualid of qualid
+  | Ident of Id.t
+type reference = reference_r CAst.t
 
-let qualid_of_reference = function
-  | Qualid (loc,qid) -> loc, qid
-  | Ident (loc,id) -> loc, qualid_of_ident id
+let qualid_of_reference = CAst.map (function
+  | Qualid qid -> qid
+  | Ident id -> qualid_of_ident id)
 
-let string_of_reference = function
-  | Qualid (loc,qid) -> string_of_qualid qid
-  | Ident (loc,id) -> Id.to_string id
+let string_of_reference = CAst.with_val (function
+  | Qualid qid -> string_of_qualid qid
+  | Ident id -> Id.to_string id)
 
-let pr_reference = function
-  | Qualid (_,qid) -> pr_qualid qid
-  | Ident (_,id) -> Id.print id
+let pr_reference = CAst.with_val (function
+  | Qualid qid -> pr_qualid qid
+  | Ident id -> Id.print id)
 
-let loc_of_reference = function
-  | Qualid (loc,qid) -> loc
-  | Ident (loc,id) -> loc
-
-let eq_reference r1 r2 = match r1, r2 with
-| Qualid (_, q1), Qualid (_, q2) -> qualid_eq q1 q2
-| Ident (_, id1), Ident (_, id2) -> Id.equal id1 id2
+let eq_reference {CAst.v=r1} {CAst.v=r2} = match r1, r2 with
+| Qualid q1, Qualid q2 -> qualid_eq q1 q2
+| Ident id1, Ident id2 -> Id.equal id1 id2
 | _ -> false
 
-let join_reference ns r =
+let join_reference {CAst.loc=l1;v=ns} {CAst.loc=l2;v=r} =
+  CAst.make ?loc:(Loc.merge_opt l1 l2) (
   match ns , r with
-    Qualid (_, q1), Qualid (loc, q2) ->
+    Qualid q1, Qualid q2 ->
       let (dp1,id1) = repr_qualid q1 in
       let (dp2,id2) = repr_qualid q2 in
-      Qualid (loc,
-	      make_qualid
+      Qualid (make_qualid
 		(append_dirpath (append_dirpath dp1 (dirpath_of_string (Names.Id.to_string id1))) dp2)
 		id2)
-  | Qualid (_, q1), Ident (loc, id2) ->
+  | Qualid q1, Ident id2 ->
     let (dp1,id1) = repr_qualid q1 in
-    Qualid (loc,
-	    make_qualid
+    Qualid (make_qualid
 	      (append_dirpath dp1 (dirpath_of_string (Names.Id.to_string id1)))
 	      id2)
-  | Ident (_, id1), Qualid (loc, q2) ->
+  | Ident id1, Qualid q2 ->
     let (dp2,id2) = repr_qualid q2 in
-    Qualid (loc, make_qualid
+    Qualid (make_qualid
       (append_dirpath (dirpath_of_string (Names.Id.to_string id1)) dp2)
       id2)
-  | Ident (_, id1), Ident (loc, id2) ->
-    Qualid (loc, make_qualid
+  | Ident id1, Ident id2 ->
+    Qualid (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 *)
 
diff --git a/library/libnames.mli b/library/libnames.mli
index 58d1da9d..9dad2612 100644
--- a/library/libnames.mli
+++ b/library/libnames.mli
@@ -1,23 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
-open Pp
-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.std_ppcmds
+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
@@ -58,7 +59,7 @@ val basename : full_path -> Id.t
 (** Parsing and printing of section path as ["coq_root.module.id"] *)
 val path_of_string : string -> full_path
 val string_of_path : full_path -> string
-val pr_path : full_path -> std_ppcmds
+val pr_path : full_path -> Pp.t
 
 module Spmap  : CSig.MapS with type key = full_path
 
@@ -77,7 +78,7 @@ val repr_qualid : qualid -> DirPath.t * Id.t
 
 val qualid_eq : qualid -> qualid -> bool
 
-val pr_qualid : qualid -> std_ppcmds
+val pr_qualid : qualid -> Pp.t
 val string_of_qualid : qualid -> string
 val qualid_of_string : string -> qualid
 
@@ -92,9 +93,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
 
@@ -117,18 +136,31 @@ val eq_global_dir_reference :
     global name (referred either by a qualified name or by a single
     name) or a variable *)
 
-type reference =
-  | Qualid of qualid located
-  | Ident of Id.t located
+type reference_r =
+  | Qualid of qualid
+  | Ident of Id.t
+type reference = reference_r CAst.t
 
 val eq_reference : reference -> reference -> bool
-val qualid_of_reference : reference -> qualid located
+val qualid_of_reference : reference -> qualid CAst.t
 val string_of_reference : reference -> string
-val pr_reference : reference -> std_ppcmds
-val loc_of_reference : reference -> Loc.t
+val pr_reference : reference -> Pp.t
 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 caa03c85..c5cd0152 100644
--- a/library/libobject.ml
+++ b/library/libobject.ml
@@ -1,16 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Libnames
 open Pp
-open Util
 
-module Dyn = Dyn.Make(struct end)
+module Dyn = Dyn.Make ()
 
 type 'a substitutivity =
     Dispose | Substitute of 'a | Keep of 'a | Anticipate of 'a
@@ -91,16 +92,8 @@ let declare_object_full odecl =
 			     dyn_rebuild_function = rebuild };
   (infun,outfun)
 
-(* The "try .. with .. " allows for correct printing when calling
-   declare_object a loading time.
-*)
-
-let declare_object odecl =
-  try fst (declare_object_full odecl)
-  with e -> CErrors.fatal_error (CErrors.print e) (CErrors.is_anomaly e)
-let declare_object_full odecl =
-  try declare_object_full odecl
-  with e -> CErrors.fatal_error (CErrors.print e) (CErrors.is_anomaly e)
+let declare_object odecl = fst (declare_object_full odecl)
+let declare_object_full odecl = declare_object_full odecl
 
 (* this function describes how the cache, load, open, and export functions
    are triggered. *)
diff --git a/library/libobject.mli b/library/libobject.mli
index 51b9af05..aefa81b2 100644
--- a/library/libobject.mli
+++ b/library/libobject.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Libnames
@@ -56,6 +58,9 @@ open Mod_subst
      rebuild the non volatile content of a section from the data
      collected by the discharge function
 
+  Any type defined as a persistent object must be pure (e.g. no references) and
+  marshallable by the OCaml Marshal module (e.g. no closures).
+
 *)
 
 type 'a substitutivity =
diff --git a/library/library.ml b/library/library.ml
index d44f796a..56d2709d 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -12,9 +14,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 +98,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 = {
@@ -131,8 +132,8 @@ let find_library dir =
 let try_find_library dir =
   try find_library dir
   with Not_found ->
-    errorlabstrm "Library.find_library"
-      (str "Unknown library " ++ pr_dirpath dir)
+    user_err ~hdr:"Library.find_library"
+      (str "Unknown library " ++ DirPath.print dir)
 
 let register_library_filename dir f =
   (* Not synchronized: overwrite the previous binding if one existed *)
@@ -171,7 +172,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
@@ -329,12 +330,12 @@ let locate_qualified_library ?root ?(warn = true) qid =
 
 let error_unmapped_dir qid =
   let prefix, _ = repr_qualid qid in
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str "Cannot load " ++ pr_qualid qid ++ str ":" ++ spc () ++
-     str "no physical path bound to" ++ spc () ++ pr_dirpath prefix ++ fnl ())
+     str "no physical path bound to" ++ spc () ++ DirPath.print prefix ++ fnl ())
 
 let error_lib_not_found qid =
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str"Cannot find library " ++ pr_qualid qid ++ str" in loadpath")
 
 let try_locate_absolute_library dir =
@@ -360,9 +361,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
@@ -378,7 +379,7 @@ let access_table what tables dp i =
       let t =
         try fetch_delayed f
         with Faulty f ->
-          errorlabstrm "Library.access_table"
+          user_err ~hdr:"Library.access_table"
             (str "The file " ++ str f ++ str " (bound to " ++ str dir_path ++
              str ") is inaccessible or corrupted,\ncannot load some " ++
              str what ++ str " in it.\n")
@@ -408,9 +409,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 =
   {
@@ -463,10 +464,10 @@ let rec intern_library (needed, contents) (dir, f) from =
   let f = match f with Some f -> f | None -> try_locate_absolute_library dir in
   let m = intern_from_file f in
   if not (DirPath.equal dir m.library_name) then
-    errorlabstrm "load_physical_library"
+    user_err ~hdr:"load_physical_library"
       (str "The file " ++ str f ++ str " contains library" ++ spc () ++
-       pr_dirpath m.library_name ++ spc () ++ str "and not library" ++
-       spc() ++ pr_dirpath dir);
+       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 +478,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
-    errorlabstrm "" (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) =
@@ -551,8 +552,6 @@ let in_require : require_obj -> obj =
 (* Require libraries, import them if [export <> None], mark them for export
    if [export = Some true] *)
 
-let (f_xml_require, xml_require) = Hook.make ~default:ignore ()
-
 let warn_require_in_module =
   CWarnings.create ~name:"require-in-module" ~category:"deprecated"
                    (fun () -> strbrk "Require inside a module is" ++
@@ -574,16 +573,15 @@ let require_library_from_dirpath modrefl export =
       end
     else
       add_anonymous_leaf (in_require (needed,modrefl,export));
-    if !Flags.xml_export then List.iter (Hook.get f_xml_require) modrefl;
-  add_frozen_state ()
+  ()
 
 (* the function called by Vernacentries.vernac_import *)
 
-let safe_locate_module (loc,qid) =
+let safe_locate_module {CAst.loc;v=qid} =
   try Nametab.locate_module qid
   with Not_found ->
-    user_err_loc
-      (loc,"import_library", pr_qualid qid ++ str " is not a module")
+    user_err ?loc ~hdr:"import_library"
+      (pr_qualid qid ++ str " is not a module")
 
 let import_module export modl =
   (* Optimization: libraries in a raw in the list are imported
@@ -597,7 +595,7 @@ let import_module export modl =
     | [] -> ()
     | modl -> add_anonymous_leaf (in_import_library (List.rev modl, export)) in
   let rec aux acc = function
-    | (loc,dir as m) :: l ->
+    | ({CAst.loc; v=dir} as m) :: l ->
         let m,acc =
           try Nametab.locate_module dir, acc
           with Not_found-> flush acc; safe_locate_module m, [] in
@@ -607,8 +605,8 @@ let import_module export modl =
             flush acc;
             try Declaremods.import_module export mp; aux [] l
             with Not_found ->
-              user_err_loc (loc,"import_library",
-                pr_qualid dir ++ str " is not a module"))
+              user_err ?loc ~hdr:"import_library"
+                (pr_qualid dir ++ str " is not a module"))
     | [] -> flush acc
   in aux [] modl
 
@@ -619,39 +617,19 @@ let check_coq_overwriting p id =
   let l = DirPath.repr p in
   let is_empty = match l with [] -> true | _ -> false in
   if not !Flags.boot && not is_empty && Id.equal (List.last l) coq_root then
-    errorlabstrm ""
-      (str "Cannot build module " ++ pr_dirpath p ++ str "." ++ pr_id id ++ str "." ++ spc () ++
+    user_err 
+      (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 = errorlabstrm "" (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;
@@ -668,10 +646,10 @@ let load_library_todo f =
   let tasks, _, _ = System.marshal_in_segment f ch in
   let (s5 : seg_proofs), _, _ = System.marshal_in_segment f ch in
   close_in ch;
-  if tasks = None then errorlabstrm "restart" (str"not a .vio file");
-  if s2 = None then errorlabstrm "restart" (str"not a .vio file");
-  if s3 = None then errorlabstrm "restart" (str"not a .vio file");
-  if pi3 (Option.get s2) then errorlabstrm "restart" (str"not a .vio file");
+  if tasks = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if s2 = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if s3 = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if pi3 (Option.get s2) then user_err ~hdr:"restart" (str"not a .vio file");
   longf, s0, s1, Option.get s2, Option.get s3, Option.get tasks, s5
 
 (************************************************************************)
@@ -687,8 +665,8 @@ let current_deps () =
 let current_reexports () = !libraries_exports_list
 
 let error_recursively_dependent_library dir =
-  errorlabstrm ""
-    (strbrk "Unable to use logical name " ++ pr_dirpath dir ++
+  user_err 
+    (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.")
 
@@ -706,7 +684,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,_) ->
@@ -734,7 +713,7 @@ let save_library_to ?todo dir f otab =
       except Int.Set.empty in
   let is_done_or_todo i x = Future.is_val x || Int.Set.mem i except in
   Array.iteri (fun i x ->
-    if not(is_done_or_todo i x) then CErrors.errorlabstrm "library"
+    if not(is_done_or_todo i x) then CErrors.user_err ~hdr:"library"
       Pp.(str"Proof object "++int i++str" is not checked nor to be checked"))
     opaque_table;
   let sd = {
@@ -761,10 +740,10 @@ 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
-	error "Could not compile the library to native code."
+	user_err Pp.(str "Could not compile the library to native code.")
    with reraise ->
     let reraise = CErrors.push reraise in
     let () = Feedback.msg_warning (str "Removed file " ++ str f') in
diff --git a/library/library.mli b/library/library.mli
index b9044b60..0877ebb5 100644
--- a/library/library.mli
+++ b/library/library.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Loc
 open Names
 open Libnames
 
@@ -29,13 +30,13 @@ 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 *)
-val import_module : bool -> qualid located list -> unit
+val import_module : bool -> qualid CAst.t list -> unit
 
 (** Start the compilation of a file as a library. The first argument must be
     output file, and the 
@@ -67,9 +68,6 @@ val library_full_filename : DirPath.t -> string
   (** - Overwrite the filename of all libraries (used when restoring a state) *)
 val overwrite_library_filenames : string -> unit
 
-(** {6 Hook for the xml exportation of libraries } *)
-val xml_require : (DirPath.t -> unit) Hook.t
-
 (** {6 Locate a library in the load paths } *)
 exception LibUnmappedDir
 exception LibNotFound
diff --git a/library/library.mllib b/library/library.mllib
index 92065736..e43bfb5a 100644
--- a/library/library.mllib
+++ b/library/library.mllib
@@ -1,11 +1,9 @@
-Nameops
 Libnames
 Globnames
 Libobject
 Summary
 Nametab
 Global
-Universes
 Lib
 Declaremods
 Loadpath
@@ -17,3 +15,4 @@ Goptions
 Decls
 Heads
 Keys
+Coqlib
diff --git a/library/loadpath.ml b/library/loadpath.ml
index d03c6c55..fc13c864 100644
--- a/library/loadpath.ml
+++ b/library/loadpath.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -29,7 +31,7 @@ let physical p = p.path_physical
 let get_load_paths () = !load_paths
 
 let anomaly_too_many_paths path =
-  anomaly (str "Several logical paths are associated to" ++ spc () ++ str path)
+  anomaly (str "Several logical paths are associated to" ++ spc () ++ str path ++ str ".")
 
 let find_load_path phys_dir =
   let phys_dir = CUnix.canonical_path_name phys_dir in
@@ -54,8 +56,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 +77,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
@@ -113,5 +115,5 @@ let expand_path ?root dir =
 let locate_file fname =
   let paths = List.map physical !load_paths in
   let _,longfname =
-    System.find_file_in_path ~warn:(Flags.is_verbose()) paths fname in
+    System.find_file_in_path ~warn:(not !Flags.quiet) paths fname in
   longfname
diff --git a/library/loadpath.mli b/library/loadpath.mli
index 4e79edbd..4044ca11 100644
--- a/library/loadpath.mli
+++ b/library/loadpath.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
diff --git a/library/nameops.ml b/library/nameops.ml
deleted file mode 100644
index 71405d02..00000000
--- a/library/nameops.ml
+++ /dev/null
@@ -1,155 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Util
-open Names
-
-(* Identifiers *)
-
-let pr_id id = Id.print id
-
-let pr_name = function
-  | Anonymous -> str "_"
-  | Name id -> pr_id id
-
-(* Utilities *)
-
-let code_of_0 = Char.code '0'
-let code_of_9 = Char.code '9'
-
-let cut_ident skip_quote s =
-  let s = Id.to_string s in
-  let slen = String.length s in
-  (* [n'] is the position of the first non nullary digit *)
-  let rec numpart n n' =
-    if Int.equal n 0 then
-      (* ident made of _ and digits only [and ' if skip_quote]: don't cut it *)
-      slen
-    else
-      let c = Char.code (String.get s (n-1)) in
-      if Int.equal c code_of_0 && not (Int.equal n slen) then
-	numpart (n-1) n'
-      else if code_of_0 <= c && c <= code_of_9 then
-	numpart (n-1) (n-1)
-      else if skip_quote && (Int.equal c (Char.code '\'') || Int.equal c (Char.code '_')) then
-	numpart (n-1) (n-1)
-      else
-	n'
-  in
-  numpart slen slen
-
-let repr_ident s =
-  let numstart = cut_ident false s in
-  let s = Id.to_string s in
-  let slen = String.length s in
-  if Int.equal numstart slen then
-    (s, None)
-  else
-    (String.sub s 0 numstart,
-     Some (int_of_string (String.sub s numstart (slen - numstart))))
-
-let make_ident sa = function
-  | Some n ->
-      let c = Char.code (String.get sa (String.length sa -1)) in
-      let s =
-        if c < code_of_0 || c > code_of_9 then sa ^ (string_of_int n)
-        else sa ^ "_" ^ (string_of_int n) in
-      Id.of_string s
-  | None -> Id.of_string (String.copy sa)
-
-let root_of_id id =
-  let suffixstart = cut_ident true id in
-  Id.of_string (String.sub (Id.to_string id) 0 suffixstart)
-
-(* Rem: semantics is a bit different, if an ident starts with toto00 then
-  after successive renamings it comes to toto09, then it goes on with toto10 *)
-let lift_subscript id =
-  let id = Id.to_string id in
-  let len = String.length id in
-  let rec add carrypos =
-    let c = id.[carrypos] in
-    if is_digit c then
-      if Int.equal (Char.code c) (Char.code '9') then begin
-	assert (carrypos>0);
-	add (carrypos-1)
-      end
-      else begin
-	let newid = String.copy id in
-	String.fill newid (carrypos+1) (len-1-carrypos) '0';
-	newid.[carrypos] <- Char.chr (Char.code c + 1);
-	newid
-      end
-    else begin
-      let newid = id^"0" in
-      if carrypos < len-1 then begin
-	String.fill newid (carrypos+1) (len-1-carrypos) '0';
-	newid.[carrypos+1] <- '1'
-      end;
-      newid
-    end
-  in Id.of_string (add (len-1))
-
-let has_subscript id =
-  let id = Id.to_string id in
-  is_digit (id.[String.length id - 1])
-
-let forget_subscript id =
-  let numstart = cut_ident false id in
-  let newid = String.make (numstart+1) '0' in
-  String.blit (Id.to_string id) 0 newid 0 numstart;
-  (Id.of_string newid)
-
-let add_suffix id s = Id.of_string (Id.to_string id ^ s)
-let add_prefix s id = Id.of_string (s ^ Id.to_string id)
-
-let atompart_of_id id = fst (repr_ident id)
-
-(* Names *)
-
-let out_name = function
-  | Name id -> id
-  | Anonymous -> failwith "Nameops.out_name"
-
-let name_fold f na a =
-  match na with
-  | Name id -> f id a
-  | Anonymous -> a
-
-let name_iter f na = name_fold (fun x () -> f x) na ()
-
-let name_cons na l =
-  match na with
-  | Anonymous -> l
-  | Name id -> id::l
-
-let name_app f = function
-  | Name id -> Name (f id)
-  | Anonymous -> Anonymous
-
-let name_fold_map f e = function
-  | Name id -> let (e,id) = f e id in (e,Name id)
-  | Anonymous -> e,Anonymous
-
-let name_max na1 na2 =
-  match na1 with
-  | Name _ -> na1
-  | Anonymous -> na2
-
-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
diff --git a/library/nameops.mli b/library/nameops.mli
deleted file mode 100644
index 39ce409b..00000000
--- a/library/nameops.mli
+++ /dev/null
@@ -1,55 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-
-(** Identifiers and names *)
-val pr_id : Id.t -> Pp.std_ppcmds
-val pr_name : Name.t -> Pp.std_ppcmds
-
-val make_ident : string -> int option -> Id.t
-val repr_ident : Id.t -> string * int option
-
-val atompart_of_id : Id.t -> string  (** remove trailing digits *)
-val root_of_id : Id.t -> Id.t (** remove trailing digits, ' and _ *)
-
-val add_suffix : Id.t -> string -> Id.t
-val add_prefix : string -> Id.t -> Id.t
-
-val has_subscript    : Id.t -> bool
-val lift_subscript   : Id.t -> Id.t
-val forget_subscript : Id.t -> Id.t
-
-val out_name : Name.t -> Id.t
-(** [out_name] associates [id] to [Name id]. Raises [Failure "Nameops.out_name"]
-    otherwise. *)
-
-val name_fold : (Id.t -> 'a -> 'a) -> Name.t -> 'a -> 'a
-val name_iter : (Id.t -> unit) -> Name.t -> unit
-val name_cons : Name.t -> Id.t list -> Id.t list
-val name_app : (Id.t -> Id.t) -> Name.t -> Name.t
-val name_fold_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> Name.t -> 'a * Name.t
-val name_max : Name.t -> Name.t -> Name.t
-
-val pr_lab : Label.t -> Pp.std_ppcmds
-
-(** 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
-
-(** Metavariables *)
-val pr_meta : Term.metavariable -> Pp.std_ppcmds
-val string_of_meta : Term.metavariable -> string
diff --git a/library/nametab.ml b/library/nametab.ml
index fa5db37e..2046bf75 100644
--- a/library/nametab.ml
+++ b/library/nametab.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -16,14 +18,8 @@ open Globnames
 
 exception GlobalizationError of qualid
 
-let error_global_not_found_loc loc q =
-  Loc.raise loc (GlobalizationError q)
-
-let error_global_not_found q = raise (GlobalizationError q)
-
-(* Kinds of global names *)
-
-type ltac_constant = kernel_name
+let error_global_not_found {CAst.loc;v} =
+  Loc.raise ?loc (GlobalizationError v)
 
 (* The visibility can be registered either
    - for all suffixes not shorter then a given int - when the object
@@ -87,8 +83,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
 
@@ -127,7 +124,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
@@ -145,8 +142,8 @@ struct
 		(* This is an absolute name, we must keep it otherwise it may
 		   become unaccessible forever *)
 		(* But ours is also absolute! This is an error! *)
-		error ("Cannot mask the absolute name \""
-		       ^ U.to_string uname' ^ "\"!")
+		user_err Pp.(str @@ "Cannot mask the absolute name \""
+                                   ^ U.to_string uname' ^ "\"!")
 	  | Nothing
 	  | Relative _ -> mktree (Absolute (uname,o)) tree.map
 
@@ -160,7 +157,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
@@ -276,19 +273,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)
 
@@ -296,7 +288,7 @@ module DirPath' =
 struct
   include DirPath
   let repr dir = match DirPath.repr dir with
-    | [] -> anomaly (Pp.str "Empty dirpath")
+    | [] -> anomaly (Pp.str "Empty dirpath.")
     | id :: l -> (id, l)
 end
 
@@ -313,6 +305,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 ***************************************************)
 
@@ -329,9 +331,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 *********************************************************)
 
@@ -370,20 +383,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 *******************************************************)
 
@@ -404,23 +415,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
 
@@ -430,8 +441,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
@@ -450,16 +459,16 @@ let global_of_path sp =
 
 let extended_global_of_path sp = ExtRefTab.find sp !the_ccitab
 
-let global r =
-  let (loc,qid) = qualid_of_reference r in
-  try match locate_extended qid with
+let global ({CAst.loc;v=r} as lr)=
+  let {CAst.loc; v} as qid = qualid_of_reference lr in
+  try match locate_extended v with
     | TrueGlobal ref -> ref
     | SynDef _ ->
-        user_err_loc (loc,"global",
-          str "Unexpected reference to a notation: " ++
-          pr_qualid qid)
+        user_err ?loc ~hdr:"global"
+          (str "Unexpected reference to a notation: " ++
+           pr_qualid v)
   with Not_found ->
-    error_global_not_found_loc loc qid
+    error_global_not_found qid
 
 (* Exists functions ********************************************************)
 
@@ -473,7 +482,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 ***********************************************)
 
@@ -494,12 +503,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 =
@@ -521,50 +530,49 @@ 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)
   with Not_found as e ->
     if !Flags.debug then Feedback.msg_debug (Pp.str "pr_global_env not found"); raise e
 
-let global_inductive r =
-  match global r with
+let global_inductive ({CAst.loc; v=r} as lr) =
+  match global lr with
   | IndRef ind -> ind
   | ref ->
-      user_err_loc (loc_of_reference r,"global_inductive",
-        pr_reference r ++ spc () ++ str "is not an inductive type")
-
+      user_err ?loc ~hdr:"global_inductive"
+        (pr_reference lr ++ spc () ++ str "is not an inductive type")
 
 (********************************************************************)
 
 (********************************************************************)
 (* 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 a8a0572b..cd28518a 100644
--- a/library/nametab.mli
+++ b/library/nametab.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open Names
 open Libnames
 open Globnames
@@ -60,8 +61,7 @@ open Globnames
 exception GlobalizationError of qualid
 
 (** Raises a globalization error *)
-val error_global_not_found_loc : Loc.t -> qualid -> 'a
-val error_global_not_found     : qualid -> 'a
+val error_global_not_found : qualid CAst.t -> 'a
 
 (** {6 Register visibility of things } *)
 
@@ -76,13 +76,15 @@ val error_global_not_found     : 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 } *)
 
@@ -91,13 +93,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
@@ -111,9 +113,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 *)
 
@@ -127,7 +128,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 } *)
 
@@ -144,9 +145,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 *)
@@ -156,7 +160,7 @@ val basename_of_global : global_reference -> Id.t
 
 (** Printing of global references using names as short as possible.
     @raise Not_found when the reference is not in the global tables. *)
-val pr_global_env : Id.Set.t -> global_reference -> std_ppcmds
+val pr_global_env : Id.Set.t -> global_reference -> Pp.t
 
 
 (** The [shortest_qualid] functions given an object with [user_name]
@@ -166,11 +170,46 @@ val pr_global_env : Id.Set.t -> global_reference -> std_ppcmds
 
 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 *)
 
 val extended_locate : qualid -> extended_global_reference (*= locate_extended *)
 val absolute_reference : full_path -> global_reference (** = global_of_path *)
+
+(** {5 Generic name handling} *)
+
+(** NOT FOR PUBLIC USE YET. Plugin writers, please do not rely on this API. *)
+
+module type UserName = sig
+  type t
+  val equal : t -> t -> bool
+  val to_string : t -> string
+  val repr : t -> Id.t * module_ident list
+end
+
+module type EqualityType =
+sig
+  type t
+  val equal : t -> t -> bool
+end
+
+module type NAMETREE = sig
+  type elt
+  type t
+  type user_name
+
+  val empty : t
+  val push : visibility -> user_name -> elt -> t -> t
+  val locate : qualid -> t -> elt
+  val find : user_name -> t -> elt
+  val exists : user_name -> t -> bool
+  val user_name : qualid -> t -> user_name
+  val shortest_qualid : Id.Set.t -> user_name -> t -> qualid
+  val find_prefixes : qualid -> t -> elt list
+end
+
+module Make (U : UserName) (E : EqualityType) :
+  NAMETREE with type user_name = U.t and type elt = E.t
diff --git a/library/states.ml b/library/states.ml
index 95bd819d..ae45b18b 100644
--- a/library/states.ml
+++ b/library/states.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -37,5 +39,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 12c71c99..1e0361ea 100644
--- a/library/states.mli
+++ b/library/states.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {6 States of the system} *)
@@ -30,10 +32,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 6efa07f3..7ef19fbf 100644
--- a/library/summary.ml
+++ b/library/summary.ml
@@ -1,29 +1,36 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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,138 +39,126 @@ 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)
+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 warn_summary_out_of_scope =
+  let name = "summary-out-of-scope" in
+  let category = "dev" in
+  let default = CWarnings.Disabled in
+  CWarnings.create ~name ~category ~default (fun name ->
+    Pp.str (Printf.sprintf
+      "A Coq plugin was loaded inside a local scope (such as a Section). It is recommended to load plugins at the start of the file. Summary entry: %s"
+      name)
+    )
+
+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)
-  in
-  let () = match fs.ml_module with
-  | None -> anomaly (str "Undeclared summary " ++ str ml_modules)
-  | 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
+   * 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 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
+        warn_summary_out_of_scope 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
-      Printf.eprintf "Error unfrezing summay %s\n%s\n%!"
-        (name_of_summary id) (Pp.string_of_ppcmds (CErrors.iprint e));
-      iraise e
-  in
-  (** We rely on the order of the frozen list, and the order of folding *)
-  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 =
@@ -172,19 +167,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
 
@@ -196,8 +194,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 1b57613c..ed6c26b1 100644
--- a/library/summary.mli
+++ b/library/summary.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module registers the declaration of global tables, which will be kept
@@ -14,6 +16,8 @@ type marshallable =
   | `No        (* Full data will be store in memory, e.g. for Undo            *)
   | `Shallow ] (* Only part of the data will be marshalled to a slave process *)
 
+(** Types of global Coq states. The ['a] type should be pure and marshallable by
+    the standard OCaml marshalling function. *)
 type 'a summary_declaration = {
   (** freeze_function [true] is for marshalling to disk. 
    *  e.g. lazy must be forced *)
@@ -34,6 +38,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.
@@ -41,6 +51,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. *)
@@ -53,10 +64,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. *)
@@ -70,19 +82,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/universes.mli b/library/universes.mli
deleted file mode 100644
index d3a271b8..00000000
--- a/library/universes.mli
+++ /dev/null
@@ -1,238 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Names
-open Term
-open Environ
-open Univ
-
-val set_minimization : bool ref
-val is_set_minimization : unit -> bool
-
-(** Universes *)
-
-(** 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
-
-val pr_with_global_universes : Level.t -> Pp.std_ppcmds
-
-(** Local universe name <-> level mapping *)
-
-type universe_binders = (Id.t * Univ.universe_level) list
-					   
-val register_universe_binders : Globnames.global_reference -> universe_binders -> unit
-val universe_binders_of_global : Globnames.global_reference -> universe_binders
-
-(** The global universe counter *)
-val set_remote_new_univ_level : universe_level 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_global_univ : unit -> universe in_universe_context_set
-val new_sort_in_family : sorts_family -> sorts
-
-(** {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.
-*)
-
-type universe_constraint_type = ULe | UEq | ULub
-
-type universe_constraint = universe * universe_constraint_type * universe
-module Constraints : sig
-  include Set.S with type elt = universe_constraint
-		       
-  val pr : t -> Pp.std_ppcmds
-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
-
-val subst_univs_universe_constraints : universe_subst_fn -> 
-  universe_constraints -> universe_constraints
-
-val enforce_eq_instances_univs : bool -> universe_instance universe_constraint_function
-
-val to_constraints : UGraph.t -> universe_constraints -> constraints
-
-(** [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
-
-(** [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
-    subterms of [m] and [n], arguments. *)
-val eq_constr_univs_infer_with :
-  (constr -> (constr,types) kind_of_term) ->
-  (constr -> (constr,types) 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 -> bool universe_constrained
-
-(** [leq_constr_universes a b] [true, c] if [a] is convertible to [b] modulo
-    alpha, casts, application grouping and the universe constraints in [c]. *)
-val leq_constr_universes : constr -> constr -> bool universe_constrained
-
-(** [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
-
-(** Build a fresh instance for a given context, its associated substitution and 
-    the instantiated constraints. *)
-
-val fresh_instance_from_context : universe_context -> 
-  universe_instance constrained
-
-val fresh_instance_from : universe_context -> universe_instance option ->
-  universe_instance in_universe_context_set
-
-val fresh_sort_in_family : env -> sorts_family -> 
-  sorts in_universe_context_set
-val fresh_constant_instance : env -> constant ->
-  pconstant in_universe_context_set
-val fresh_inductive_instance : env -> inductive ->
-  pinductive in_universe_context_set
-val fresh_constructor_instance : env -> constructor ->
-  pconstructor in_universe_context_set
-
-val fresh_global_instance : ?names:Univ.Instance.t -> env -> Globnames.global_reference -> 
-  constr in_universe_context_set
-
-val fresh_global_or_constr_instance : env -> Globnames.global_reference_or_constr -> 
-  constr in_universe_context_set
-
-(** 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
-
-(** Raises [Not_found] if not a global reference. *)
-val global_of_constr : constr -> Globnames.global_reference puniverses
-
-val global_app_of_constr : constr -> Globnames.global_reference puniverses * constr option
-
-val constr_of_global_univ : Globnames.global_reference puniverses -> constr
-
-val extend_context : 'a in_universe_context_set -> universe_context_set -> 
-  'a in_universe_context_set
-
-(** Simplification and pruning of constraints:
-    [normalize_context_set ctx us]
-
-    - Instantiate the variables in [us] with their most precise
-    universe levels respecting the constraints.
-
-    - Normalizes the context [ctx] w.r.t. equality constraints, 
-    choosing a canonical universe in each equivalence class 
-    (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
-
-type universe_opt_subst = universe 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 -> 
-  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
-
-val normalize_univ_variables : universe_opt_subst -> 
-  universe_opt_subst * universe_set * universe_set * universe_subst
-
-val normalize_univ_variable : 
-  find:(universe_level -> universe) ->
-  update:(universe_level -> universe -> universe) ->
-  universe_level -> universe
-
-val normalize_univ_variable_opt_subst : universe_opt_subst ref ->
-  (universe_level -> universe)
-
-val normalize_univ_variable_subst : universe_subst ref ->
-  (universe_level -> universe)
-
-val normalize_universe_opt_subst : universe_opt_subst ref ->
-  (universe -> universe)
-
-val normalize_universe_subst : universe_subst ref ->
-  (universe -> universe)
-
-(** Create a fresh global in the global environment, without side effects.
-    BEWARE: this raises an ANOMALY on polymorphic constants/inductives: 
-    the constraints should be properly added to an evd. 
-    See Evd.fresh_global, Evarutil.new_global, and pf_constr_of_global for
-    the proper way to get a fresh copy of a global reference. *)
-val constr_of_global : Globnames.global_reference -> constr
-
-(** ** DEPRECATED ** synonym of [constr_of_global] *)
-val constr_of_reference : Globnames.global_reference -> constr
-
-(** [unsafe_constr_of_global gr] turns [gr] into a constr, works on polymorphic
-    references by taking the original universe instance that is not recorded 
-    anywhere. The constraints are forgotten as well. DO NOT USE in new code. *)
-val unsafe_constr_of_global : Globnames.global_reference -> constr in_universe_context
-
-(** 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
-    universe counter, use with care). *)
-val type_of_global : Globnames.global_reference -> types in_universe_context_set
-
-(** [unsafe_type_of_global gr] returns [gr]'s type, works on polymorphic
-    references by taking the original universe instance that is not recorded 
-    anywhere. The constraints are forgotten as well. 
-    USE with care. *)
-val unsafe_type_of_global : Globnames.global_reference -> types
-
-(** Full universes substitutions into terms *)
-
-val nf_evars_and_universes_opt_subst : (existential -> constr option) -> 
-  universe_opt_subst -> constr -> constr
-
-(** Shrink a universe context to a restricted set of variables *)
-
-val universes_of_constr : constr -> universe_set
-val restrict_universe_context : universe_context_set -> universe_set -> universe_context_set
-val simplify_universe_context : universe_context_set -> 
-  universe_context_set * universe_level_subst
-
-val refresh_constraints : UGraph.t -> universe_context_set -> universe_context_set * UGraph.t
-
-(** Pretty-printing *)
-
-val pr_universe_opt_subst : universe_opt_subst -> Pp.std_ppcmds
-
-(** {6 Support for old-style sort-polymorphism } *)
-
-val solve_constraints_system : universe option array -> universe array -> universe array ->
-  universe array
diff --git a/ltac/evar_tactics.ml b/ltac/evar_tactics.ml
deleted file mode 100644
index 30aeba3b..00000000
--- a/ltac/evar_tactics.ml
+++ /dev/null
@@ -1,91 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open CErrors
-open Evar_refiner
-open Tacmach
-open Tacexpr
-open Refiner
-open Evd
-open Locus
-open Sigma.Notations
-open Proofview.Notations
-open Context.Named.Declaration
-
-(* The instantiate tactic *)
-
-let instantiate_evar evk (ist,rawc) sigma =
-  let evi = Evd.find sigma evk in
-  let filtered = Evd.evar_filtered_env evi in
-  let constrvars = Tacinterp.extract_ltac_constr_values ist filtered in
-  let lvar = {
-    Pretyping.ltac_constrs = constrvars;
-    ltac_uconstrs = Names.Id.Map.empty;
-    ltac_idents = Names.Id.Map.empty;
-    ltac_genargs = ist.Geninterp.lfun;
-  } in
-  let sigma' = w_refine (evk,evi) (lvar ,rawc) sigma in
-  tclEVARS sigma'
-
-let instantiate_tac n c ido =
-  Proofview.V82.tactic begin fun gl ->
-  let sigma = gl.sigma in
-  let evl =
-    match ido with
-	ConclLocation () -> evar_list (pf_concl gl)
-      | HypLocation (id,hloc) ->
-	  let decl = Environ.lookup_named_val id (Goal.V82.hyps sigma (sig_it gl)) in
-	    match hloc with
-		InHyp ->
-		  (match decl with
-                    | LocalAssum (_,typ) -> evar_list typ
-		    | _ -> error
-			"Please be more specific: in type or value?")
-	      | InHypTypeOnly ->
-		  evar_list (get_type decl)
-	      | InHypValueOnly ->
-		  (match decl with
-		    | LocalDef (_,body,_) -> evar_list body
-		    | _ -> error "Not a defined hypothesis.") in
-  if List.length evl < n then
-    error "Not enough uninstantiated existential variables.";
-  if n <= 0 then error "Incorrect existential variable index.";
-  let evk,_ = List.nth evl (n-1) in
-  instantiate_evar evk c sigma gl
-  end
-
-let instantiate_tac_by_name id c =
-  Proofview.V82.tactic begin fun gl ->
-  let sigma = gl.sigma in
-  let evk =
-    try Evd.evar_key id sigma
-    with Not_found -> error "Unknown existential variable." in
-  instantiate_evar evk c sigma gl
-  end
-
-let let_evar name typ =
-  let src = (Loc.ghost,Evar_kinds.GoalEvar) in
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
-    let sigma = Tacmach.New.project gl in
-    let env = Proofview.Goal.env gl in
-    let sigma = ref sigma in
-    let _ = Typing.e_sort_of env sigma typ in
-    let sigma = Sigma.Unsafe.of_evar_map !sigma in
-    let id = match name with
-    | Names.Anonymous -> 
-      let id = Namegen.id_of_name_using_hdchar env typ name in
-      Namegen.next_ident_away_in_goal id (Termops.ids_of_named_context (Environ.named_context env))
-    | Names.Name id -> id
-    in
-    let Sigma (evar, sigma, p) = Evarutil.new_evar env sigma ~src ~naming:(Misctypes.IntroFresh id) typ in
-    let tac =
-      (Tactics.letin_tac None (Names.Name id) evar None Locusops.nowhere)
-    in
-    Sigma (tac, sigma, p)
-  end }
diff --git a/ltac/evar_tactics.mli b/ltac/evar_tactics.mli
deleted file mode 100644
index e67540c0..00000000
--- a/ltac/evar_tactics.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Tacexpr
-open Locus
-
-val instantiate_tac : int -> Tacinterp.interp_sign * Glob_term.glob_constr ->
-  (Id.t * hyp_location_flag, unit) location -> unit Proofview.tactic
-
-val instantiate_tac_by_name : Id.t ->
-  Tacinterp.interp_sign * Glob_term.glob_constr -> unit Proofview.tactic
-
-val let_evar : Name.t -> Term.types -> unit Proofview.tactic
diff --git a/ltac/profile_ltac.mli b/ltac/profile_ltac.mli
deleted file mode 100644
index e5e2e419..00000000
--- a/ltac/profile_ltac.mli
+++ /dev/null
@@ -1,48 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Ltac profiling primitives *)
-
-val do_profile :
-  string -> ('a * Tacexpr.ltac_call_kind) list ->
-    'b Proofview.tactic -> 'b Proofview.tactic
-
-val set_profiling : bool -> unit
-
-(* Cut off results < than specified cutoff *)
-val print_results : cutoff:float -> unit
-
-val print_results_tactic : string -> unit
-
-val reset_profile : unit -> unit
-
-val do_print_results_at_close : unit -> unit
-
-(* The collected statistics for a tactic. The timing data is collected over all
- * instances of a given tactic from its parent. E.g. if tactic 'aaa' calls
- * 'foo' twice, then 'aaa' will contain just one entry for 'foo' with the
- * statistics of the two invocations combined, and also combined over all
- * invocations of 'aaa'.
- * total:     time spent running this tactic and its subtactics (seconds)
- * local:      time spent running this tactic, minus its subtactics (seconds)
- * ncalls: the number of invocations of this tactic that have been made
- * max_total: the greatest running time of a single invocation (seconds)
- *)
-type treenode = {
-  name : CString.Map.key;
-  total : float;
-  local : float;
-  ncalls : int;
-  max_total : float;
-  children : treenode CString.Map.t
-}
-
-(* Returns the profiling results known by the current process *)
-val get_local_profiling_results : unit -> treenode
-val feedback_results : treenode -> unit
-
diff --git a/ltac/profile_ltac_tactics.ml4 b/ltac/profile_ltac_tactics.ml4
deleted file mode 100644
index 8cb76d81..00000000
--- a/ltac/profile_ltac_tactics.ml4
+++ /dev/null
@@ -1,40 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-(** Ltac profiling entrypoints *)
-
-open Profile_ltac
-open Stdarg
-
-DECLARE PLUGIN "profile_ltac_plugin"
-
-let tclSET_PROFILING b =
-   Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> set_profiling b))
-
-TACTIC EXTEND start_ltac_profiling
-| [ "start" "ltac" "profiling" ] -> [ tclSET_PROFILING true ]
-END
-
-TACTIC EXTEND stop_profiling
-| [ "stop" "ltac" "profiling" ] -> [ tclSET_PROFILING false ]
-END
-
-VERNAC COMMAND EXTEND ResetLtacProfiling CLASSIFIED AS SIDEFF
-  [ "Reset" "Ltac" "Profile" ] -> [ reset_profile() ]
-END
-
-VERNAC COMMAND EXTEND ShowLtacProfile CLASSIFIED AS QUERY
-| [ "Show" "Ltac" "Profile" ] -> [ print_results ~cutoff:!Flags.profile_ltac_cutoff ]
-| [ "Show" "Ltac" "Profile" "CutOff" int(n) ] -> [ print_results ~cutoff:(float_of_int n) ]
-END
-
-VERNAC COMMAND EXTEND ShowLtacProfileTactic CLASSIFIED AS QUERY
-  [ "Show" "Ltac" "Profile" string(s) ] -> [ print_results_tactic s ]
-END
diff --git a/ltac/taccoerce.mli b/ltac/taccoerce.mli
deleted file mode 100644
index 0b67f872..00000000
--- a/ltac/taccoerce.mli
+++ /dev/null
@@ -1,96 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Names
-open Term
-open Misctypes
-open Pattern
-open Genarg
-open Geninterp
-
-(** Coercions from highest level generic arguments to actual data used by Ltac
-    interpretation. Those functions examinate dynamic types and try to return
-    something sensible according to the object content. *)
-
-exception CannotCoerceTo of string
-(** Exception raised whenever a coercion failed. *)
-
-(** {5 High-level access to values}
-
-  The [of_*] functions cast a given argument into a value. The [to_*] do the
-  converse, and return [None] if there is a type mismatch.
-
-*)
-
-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_int : int -> t
-  val to_int : t -> int option
-  val to_list : t -> t list option
-  val to_option : t -> t option option
-  val to_pair : t -> (t * t) option
-end
-
-(** {5 Coercion functions} *)
-
-val coerce_to_constr_context : Value.t -> constr
-
-val coerce_var_to_ident : bool -> Environ.env -> Value.t -> Id.t
-
-val coerce_to_ident_not_fresh : Evd.evar_map -> Environ.env -> Value.t -> Id.t
-
-val coerce_to_intro_pattern : Environ.env -> Value.t -> Tacexpr.delayed_open_constr intro_pattern_expr
-
-val coerce_to_intro_pattern_naming :
-  Environ.env -> Value.t -> intro_pattern_naming_expr
-
-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_uconstr : Environ.env -> Value.t -> Glob_term.closed_glob_constr
-
-val coerce_to_closed_constr : Environ.env -> Value.t -> constr
-
-val coerce_to_evaluable_ref :
-  Environ.env -> Value.t -> evaluable_global_reference
-
-val coerce_to_constr_list : Environ.env -> Value.t -> constr list
-
-val coerce_to_intro_pattern_list :
-  Loc.t -> Environ.env -> Value.t -> Tacexpr.intro_patterns
-
-val coerce_to_hyp : Environ.env -> Value.t -> Id.t
-
-val coerce_to_hyp_list : Environ.env -> Value.t -> Id.t list
-
-val coerce_to_reference : Environ.env -> Value.t -> Globnames.global_reference
-
-val coerce_to_quantified_hypothesis : Value.t -> quantified_hypothesis
-
-val coerce_to_decl_or_quant_hyp : Environ.env -> Value.t -> quantified_hypothesis
-
-val coerce_to_int_or_var_list : Value.t -> int or_var list
-
-(** {5 Missing generic arguments} *)
-
-val wit_constr_context : (Empty.t, Empty.t, constr) genarg_type
-
-val wit_constr_under_binders : (Empty.t, Empty.t, constr_under_binders) genarg_type
diff --git a/ltac/tactic_option.mli b/ltac/tactic_option.mli
deleted file mode 100644
index ed759a76..00000000
--- a/ltac/tactic_option.mli
+++ /dev/null
@@ -1,15 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Tacexpr
-open Vernacexpr
-
-val declare_tactic_option : ?default:Tacexpr.glob_tactic_expr -> string -> 
-  (* put *) (locality_flag -> glob_tactic_expr -> unit) *
-  (* get *) (unit -> locality_flag * unit Proofview.tactic) *
-  (* print *) (unit -> Pp.std_ppcmds)
diff --git a/man/coqchk.1 b/man/coqchk.1
index 76a7cfc5..f9241c0d 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 81f7e1e0..c417402c 100644
--- a/man/coqdep.1
+++ b/man/coqdep.1
@@ -80,9 +80,12 @@ Prints the dependencies of Caml modules.
 \" of each Coq file given as argument and complete (if needed)
 \" the list of Caml modules. The new command is printed on
 \" the standard output. No dependency is computed with this option.
+.TP
+.BI \-f \ file
+Read filenames and options -I, -R and -Q from a _CoqProject FILE.
 .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/coqide.1 b/man/coqide.1
index f82bf2ad..3592f6e4 100644
--- a/man/coqide.1
+++ b/man/coqide.1
@@ -123,13 +123,6 @@ Set sort Set impredicative.
 .TP
 .B \-dont\-load\-proofs
 Don't load opaque proofs in memory.
-.TP
-.B \-xml
-Export XML files either to the hierarchy rooted in
-the directory
-.B COQ_XML_LIBRARY_ROOT
-(if set) or to stdout (if unset).
-
 
 .SH SEE ALSO
 
diff --git a/man/coqmktop.1 b/man/coqmktop.1
deleted file mode 100644
index 810df782..00000000
--- 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 feee7fd8..084adfe4 100644
--- a/man/coqtop.1
+++ b/man/coqtop.1
@@ -110,7 +110,7 @@ print Coq version and exit
 
 .TP
 .B \-q
-skip loading of rcfile
+skip loading of rcfile (resource file) if any
 
 .TP
 .BI \-init\-file \ filename
@@ -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
 
@@ -153,12 +147,6 @@ set sort Set impredicative
 .B \-dont\-load\-proofs
 don't load opaque proofs in memory
 
-.TP
-.B \-xml
-export XML files either to the hierarchy rooted in
-the directory $COQ_XML_LIBRARY_ROOT (if set) or to
-stdout (if unset)
-
 .SH SEE ALSO
 
 .BR coqc (1),
diff --git a/man/gallina.1 b/man/gallina.1
index 8c607216..f8879c45 100644
--- a/man/gallina.1
+++ b/man/gallina.1
@@ -29,7 +29,7 @@ The suffix '.g' stands for Gallina.
 
 For that purpose, gallina removes all commands that follow a
 "Theorem", "Lemma", "Fact", "Remark" or "Goal" statement until it
-reaches a command "Abort.", "Save.", "Qed.", "Defined." or "Proof
+reaches a command "Abort.", "Qed.", "Defined." or "Proof
 <...>.". It also removes every "Hint", "Syntax",
 "Immediate"  or "Transparent" command.
 
@@ -52,7 +52,7 @@ Comments are removed in the *.g file.
 .SH NOTES
 
 Nested comments are correctly handled. In particular, every command
-"Save." or "Abort." in a comment is not taken into account.
+"Qed." or "Abort." in a comment is not taken into account.
 
 
 .SH BUGS
diff --git a/parsing/cLexer.ml4 b/parsing/cLexer.ml4
index aec6a326..d65b35c4 100644
--- a/parsing/cLexer.ml4
+++ b/parsing/cLexer.ml4
@@ -1,15 +1,38 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open Util
 open Tok
-open Compat
+
+(** 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 = 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;
+    Loc.ep = Ploc.last_pos loc;
+    Loc.line_nb_last = Ploc.line_nb_last loc;
+    Loc.bol_pos_last = Ploc.bol_pos_last loc; }
+
+let (!@) = to_coqloc
 
 (* Dictionaries: trees annotated with string options, each node being a map
    from chars to dictionaries (the subtrees). A trie, in other words. *)
@@ -89,7 +112,6 @@ module Error = struct
     | Unterminated_string
     | Undefined_token
     | Bad_token of string
-    | UnsupportedUnicode of int
 
   exception E of t
 
@@ -100,21 +122,45 @@ module Error = struct
          | Unterminated_comment -> "Unterminated comment"
          | Unterminated_string -> "Unterminated string"
          | Undefined_token -> "Undefined token"
-         | Bad_token tok -> Format.sprintf "Bad token %S" tok
-         | UnsupportedUnicode x ->
-             Printf.sprintf "Unsupported Unicode character (0x%x)" x)
-
-  (* Require to fix the Camlp4 signature *)
-  let print ppf x = Pp.pp_with ~pp_tag:Ppstyle.pp_tag ppf (Pp.str (to_string x))
+         | Bad_token tok -> Format.sprintf "Bad token %S" tok)
 
 end
 open Error
 
-let err loc str = Loc.raise (Compat.to_coqloc loc) (Error.E str)
+let err loc str = Loc.raise ~loc:(to_coqloc loc) (Error.E str)
 
 let bad_token str = raise (Error.E (Bad_token str))
 
-(* Lexer conventions on tokens *)
+(* Update a loc without allocating an intermediate pair *)
+let set_loc_pos loc bp ep =
+  Ploc.sub loc (bp - Ploc.first_pos loc) (ep - bp)
+
+(* Increase line number by 1 and update position of beginning of line *)
+let bump_loc_line loc bol_pos =
+  Ploc.make_loc (Ploc.file_name loc) (Ploc.line_nb loc + 1) bol_pos
+		(Ploc.first_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
+
+(* Same as [bump_loc_line], but for the last line in location *)
+(* For an obscure reason, camlp5 does not give an easy way to set line_nb_stop,
+   so we have to resort to a hack merging two locations. *)
+(* Warning: [bump_loc_line_last] changes the end position. You may need to call
+   [set_loc_pos] to fix it. *)
+let bump_loc_line_last loc bol_pos =
+  let loc' =
+    Ploc.make_loc (Ploc.file_name loc) (Ploc.line_nb_last loc + 1) bol_pos
+		  (Ploc.first_pos loc + 1, Ploc.last_pos loc + 1) (Ploc.comment loc)
+  in
+  Ploc.encl loc loc'
+
+(* For some reason, the [Ploc.after] function of Camlp5 does not update line
+   numbers, so we define our own function that does it. *)
+let after loc =
+  let line_nb = Ploc.line_nb_last loc in
+  let bol_pos = Ploc.bol_pos_last loc in
+  Ploc.make_loc (Ploc.file_name loc) line_nb bol_pos
+		(Ploc.last_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
+
+(** Lexer conventions on tokens *)
 
 type token_kind =
   | Utf8Token of (Unicode.status * int)
@@ -186,7 +232,7 @@ let check_keyword str =
   let rec loop_symb = parser
     | [< ' (' ' | '\n' | '\r' | '\t' | '"') >] -> bad_token str
     | [< s >] ->
-        match unlocated lookup_utf8 Compat.CompatLoc.ghost s with
+        match unlocated lookup_utf8 Ploc.dummy s with
         | Utf8Token (_,n) -> njunk n s; loop_symb s
         | AsciiChar -> Stream.junk s; loop_symb s
         | EmptyStream -> ()
@@ -200,9 +246,9 @@ let check_ident str =
     | [< ' ('0'..'9' | ''') when intail; s >] ->
         loop_id true s
     | [< s >] ->
-        match unlocated lookup_utf8 Compat.CompatLoc.ghost s with
-        | Utf8Token (Unicode.Letter, n) -> njunk n s; loop_id true s
-        | Utf8Token (Unicode.IdentPart, n) when intail ->
+        match unlocated lookup_utf8 Ploc.dummy s with
+        | 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 -> ()
@@ -233,25 +279,26 @@ let remove_keyword str =
 let keywords () = ttree_elements !token_tree
 
 (* Freeze and unfreeze the state of the lexer *)
-type frozen_t = ttree
+type keyword_state = ttree
 
-let freeze () = !token_tree
-let unfreeze tt = (token_tree := tt)
+let get_keyword_state () = !token_tree
+let set_keyword_state tt = (token_tree := tt)
 
 (* The string buffering machinery *)
 
-let buff = ref (String.create 80)
+let buff = ref (Bytes.create 80)
 
 let store len x =
-  if len >= String.length !buff then
-    buff := !buff ^ String.create (String.length !buff);
-  !buff.[len] <- x;
+  let open Bytes in
+  if len >= length !buff then
+    buff := cat !buff (create (length !buff));
+  set !buff len x;
   succ len
 
 let rec nstore n len cs =
   if n>0 then nstore (n-1) (store len (Stream.next cs)) cs else len
 
-let get_buff len = String.sub !buff 0 len
+let get_buff len = Bytes.sub_string !buff 0 len
 
 (* The classical lexer: idents, numbers, quoted strings, comments *)
 
@@ -266,9 +313,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
@@ -293,13 +340,13 @@ let rec string loc ~comm_level bp len = parser
       if esc then string loc ~comm_level bp (store len '"') s else (loc, len)
   | [< ''('; s >] ->
       (parser
-        | [< ''*'; s >] ->
-            string loc
-              (Option.map succ comm_level)
+      | [< ''*'; s >] ->
+        let comm_level = Option.map succ comm_level in
+            string loc ~comm_level
               bp (store (store len '(') '*')
               s
         | [< >] ->
-            string loc comm_level bp (store len '(') s) s
+            string loc ~comm_level bp (store len '(') s) s
   | [< ''*'; s >] ->
       (parser
         | [< '')'; s >] ->
@@ -309,9 +356,9 @@ let rec string loc ~comm_level bp len = parser
             | _ -> ()
             in
             let comm_level = Option.map pred comm_level in
-            string loc comm_level bp (store (store len '*') ')') s
+            string loc ~comm_level bp (store (store len '*') ')') s
         | [< >] ->
-            string loc comm_level bp (store len '*') s) s
+            string loc ~comm_level bp (store len '*') s) s
   | [< ''\n' as c; s >] ep ->
      (* If we are parsing a comment, the string if not part of a token so we
      update the first line of the location. Otherwise, we update the last
@@ -320,17 +367,14 @@ let rec string loc ~comm_level bp len = parser
        if Option.has_some comm_level then bump_loc_line loc ep
        else bump_loc_line_last loc ep
      in
-     string loc comm_level bp (store len c) s
-  | [< 'c; s >] -> string loc comm_level bp (store len c) s
+     string loc ~comm_level bp (store len c) s
+  | [< 'c; s >] -> string loc ~comm_level bp (store len c) s
   | [< _ = Stream.empty >] ep ->
      let loc = set_loc_pos loc bp ep in
      err loc Unterminated_string
 
-(* Hook for exporting comment into xml theory files *)
-let (f_xml_output_comment, xml_output_comment) = Hook.make ~default:ignore ()
-
 (* To associate locations to a file name *)
-let current_file = ref None
+let current_file = ref Loc.ToplevelInput
 
 (* Utilities for comments in beautify *)
 let comment_begin = ref None
@@ -342,18 +386,8 @@ let comments = ref []
 let current_comment = Buffer.create 8192
 let between_commands = ref true
 
-let rec split_comments comacc acc pos = function
-    [] -> comments := List.rev acc; comacc
-  | ((b,e),c as com)::coms ->
-      (* Take all comments that terminates before pos, or begin exactly
-         at pos (used to print comments attached after an expression) *)
-      if e<=pos || pos=b then split_comments (c::comacc) acc pos coms
-      else split_comments comacc (com::acc) pos coms
-
-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) =
@@ -362,10 +396,13 @@ 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 get_comment_state (_,_,_,c,_) = c
 
 let real_push_char c = Buffer.add_char current_comment c
 
@@ -390,9 +427,6 @@ let null_comment s =
 
 let comment_stop ep =
   let current_s = Buffer.contents current_comment in
-  if !Flags.xml_export && Buffer.length current_comment > 0 &&
-    (!between_commands || not(null_comment current_s)) then
-      Hook.get f_xml_output_comment current_s;
   (if !Flags.beautify && Buffer.length current_comment > 0 &&
     (!between_commands || not(null_comment current_s)) then
     let bp = match !comment_begin with
@@ -500,7 +534,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)
@@ -514,7 +548,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)
 
@@ -560,7 +594,7 @@ let rec next_token loc = parser bp
   | [< ' ('0'..'9' as c); len = number (store 0 c) >] ep ->
       comment_stop bp;
       (INT (get_buff len), set_loc_pos loc bp ep)
-  | [< ''\"'; (loc,len) = string loc None bp 0 >] ep ->
+  | [< ''\"'; (loc,len) = string loc ~comm_level:None bp 0 >] ep ->
       comment_stop bp;
       (STRING (get_buff len), set_loc_pos loc bp ep)
   | [< ' ('(' as c);
@@ -579,13 +613,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 ->
@@ -619,8 +653,6 @@ let loct_add loct i loc = Hashtbl.add loct i loc
    we unfreeze the state of the lexer. This restores the behaviour of the
    lexer. B.B. *)
 
-IFDEF CAMLP5 THEN
-
 type te = Tok.t
 
 (** Names of tokens, for this lexer, used in Grammar error messages *)
@@ -638,12 +670,12 @@ let token_text = function
 
 let func cs =
   let loct = loct_create () in
-  let cur_loc = ref (Compat.make_loc !current_file 1 0 0 0) in
+  let cur_loc = ref (from_coqloc !current_file 1 0 0 0) in
   let ts =
     Stream.from
       (fun i ->
          let (tok, loc) = next_token !cur_loc cs in
-	 cur_loc := Compat.after loc;
+	 cur_loc := after loc;
          loct_add loct i loc; Some tok)
   in
   (ts, loct_func loct)
@@ -659,41 +691,6 @@ let lexer = {
   Token.tok_comm = None;
   Token.tok_text = token_text }
 
-ELSE (* official camlp4 for ocaml >= 3.10 *)
-
-module M_ = Camlp4.ErrorHandler.Register (Error)
-
-module Loc = Compat.CompatLoc
-module Token = struct
-  include Tok (* Cf. tok.ml *)
-  module Loc = Compat.CompatLoc
-  module Error = Camlp4.Struct.EmptyError
-  module Filter = struct
-    type token_filter = (Tok.t * Loc.t) Stream.t -> (Tok.t * Loc.t) Stream.t
-    type t = unit
-    let mk _is_kwd = ()
-    let keyword_added () kwd _ = add_keyword kwd
-    let keyword_removed () _ = ()
-    let filter () x = x
-    let define_filter () _ = ()
-  end
-end
-
-let mk () =
-  let loct = loct_create () in
-  let cur_loc = ref (Compat.make_loc !current_file 1 0 0 0) in
-  let rec self init_loc (* FIXME *) =
-    parser i
-       [< (tok, loc) = next_token !cur_loc; s >] ->
-            cur_loc := Compat.set_loc_file loc !current_file;
-	    loct_add loct i loc;
-            [< '(tok, loc); self init_loc s >]
-      | [< >] -> [< >]
-  in
-  self
-
-END
-
 (** Terminal symbols interpretation *)
 
 let is_ident_not_keyword s =
@@ -716,13 +713,13 @@ let strip s =
   in
   if len == String.length s then s
   else
-    let s' = String.create len in
+    let s' = Bytes.create len in
     let rec loop i i' =
       if i == String.length s then s'
       else if s.[i] == ' ' then loop (i + 1) i'
-      else begin s'.[i'] <- s.[i]; loop (i + 1) (i' + 1) end
+      else begin Bytes.set s' i' s.[i]; loop (i + 1) (i' + 1) end
     in
-    loop 0 0
+    Bytes.to_string (loop 0 0)
 
 let terminal s =
   let s = strip s in
diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli
index e0fdf8cb..a14f08d9 100644
--- a/parsing/cLexer.mli
+++ b/parsing/cLexer.mli
@@ -1,32 +1,60 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+(** This should be functional but it is not due to the interface *)
 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 is_ident : string -> bool
 val check_keyword : string -> unit
-
-type frozen_t
-val freeze : unit -> frozen_t
-val unfreeze : frozen_t -> unit
-
-val xml_output_comment : (string -> unit) Hook.t
-
-(* Retrieve the comments lexed at a given location of the stream
-   currently being processeed *)
-val extract_comments : int -> string list
-
 val terminal : string -> Tok.t
 
 (** The lexer of Coq: *)
 
-include Compat.LexerSig
+(* modtype Grammar.GLexerType: sig
+     type te val
+     lexer : te Plexing.lexer
+   end
+
+where
+
+  type lexer 'te =
+    { tok_func : lexer_func 'te;
+      tok_using : pattern -> unit;
+      tok_removing : pattern -> unit;
+      tok_match : pattern -> 'te -> string;
+      tok_text : pattern -> string;
+      tok_comm : mutable option (list location) }
+ *)
+include Grammar.GLexerType with type te = Tok.t
+
+module Error : sig
+  type t
+  exception E of t
+  val to_string : t -> string
+end
+
+(* Mainly for comments state, etc... *)
+type 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
+val get_comment_state : lexer_state -> ((int * int) * string) list
diff --git a/parsing/compat.ml4 b/parsing/compat.ml4
deleted file mode 100644
index befa0d01..00000000
--- a/parsing/compat.ml4
+++ /dev/null
@@ -1,421 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Compatibility file depending on ocaml/camlp4 version *)
-
-(** Locations *)
-
-let file_loc_of_file = function
-| None -> ""
-| Some f -> f
-
-IFDEF CAMLP5 THEN
-
-module CompatLoc = struct
-  include Ploc
-  let ghost = dummy
-  let merge = encl
-end
-
-exception Exc_located = Ploc.Exc
-
-let to_coqloc loc =
-  { Loc.fname = Ploc.file_name loc;
-    Loc.line_nb = Ploc.line_nb loc;
-    Loc.bol_pos = Ploc.bol_pos loc;
-    Loc.bp = Ploc.first_pos loc;
-    Loc.ep = Ploc.last_pos loc;
-    Loc.line_nb_last = Ploc.line_nb_last loc;
-    Loc.bol_pos_last = Ploc.bol_pos_last loc; }
-
-let make_loc fname line_nb bol_pos bp ep = Ploc.make_loc (file_loc_of_file fname) line_nb bol_pos (bp, ep) ""
-
-(* Update a loc without allocating an intermediate pair *)
-let set_loc_pos loc bp ep =
-  Ploc.sub loc (bp - Ploc.first_pos loc) (ep - bp)
-
-(* Increase line number by 1 and update position of beginning of line *)
-let bump_loc_line loc bol_pos =
-  Ploc.make_loc (Ploc.file_name loc) (Ploc.line_nb loc + 1) bol_pos
-		(Ploc.first_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
-
-(* Same as [bump_loc_line], but for the last line in location *)
-(* For an obscure reason, camlp5 does not give an easy way to set line_nb_stop,
-   so we have to resort to a hack merging two locations. *)
-(* Warning: [bump_loc_line_last] changes the end position. You may need to call
-   [set_loc_pos] to fix it. *)
-let bump_loc_line_last loc bol_pos =
-  let loc' =
-    Ploc.make_loc (Ploc.file_name loc) (Ploc.line_nb_last loc + 1) bol_pos
-		  (Ploc.first_pos loc + 1, Ploc.last_pos loc + 1) (Ploc.comment loc)
-  in
-  Ploc.encl loc loc'
-
-let set_loc_file loc fname =
-  Ploc.make_loc fname (Ploc.line_nb loc) (Ploc.bol_pos loc)
-		(Ploc.first_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
-
-(* For some reason, the [Ploc.after] function of Camlp5 does not update line
-   numbers, so we define our own function that does it. *)
-let after loc =
-  let line_nb = Ploc.line_nb_last loc in
-  let bol_pos = Ploc.bol_pos_last loc in
-  Ploc.make_loc (Ploc.file_name loc) line_nb bol_pos
-		(Ploc.last_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
-
-ELSE
-
-module CompatLoc = Camlp4.PreCast.Loc
-
-exception Exc_located = CompatLoc.Exc_located
-
-let to_coqloc loc =
-  { Loc.fname = CompatLoc.file_name loc;
-    Loc.line_nb = CompatLoc.start_line loc;
-    Loc.bol_pos = CompatLoc.start_bol loc;
-    Loc.bp = CompatLoc.start_off loc;
-    Loc.ep = CompatLoc.stop_off loc;
-    Loc.line_nb_last = CompatLoc.stop_line loc;
-    Loc.bol_pos_last = CompatLoc.stop_bol loc; }
-
-let make_loc fname line_nb bol_pos start stop =
-  CompatLoc.of_tuple (file_loc_of_file fname, line_nb, bol_pos, start, line_nb, bol_pos, stop, false)
-
-open CompatLoc
-
-let set_loc_pos loc bp ep =
-  of_tuple (file_name loc, start_line loc, start_bol loc, bp,
-	    stop_line loc, stop_bol loc, ep, is_ghost loc)
-
-let bump_loc_line loc bol_pos =
-  of_tuple (file_name loc, start_line loc + 1, bol_pos, start_off loc,
-	    start_line loc + 1, bol_pos, stop_off loc, is_ghost loc)
-
-let bump_loc_line_last loc bol_pos =
-  of_tuple (file_name loc, start_line loc, start_bol loc, start_off loc,
-	    stop_line loc + 1, bol_pos, stop_off loc, is_ghost loc)
-
-let set_loc_file loc fname =
-  of_tuple (file_loc_of_file fname, start_line loc, start_bol loc, start_off loc,
-	    stop_line loc, stop_bol loc, stop_off loc, is_ghost loc)
-
-let after loc =
-  of_tuple (file_name loc, stop_line loc, stop_bol loc, stop_off loc,
-	    stop_line loc, stop_bol loc, stop_off loc, is_ghost loc)
-
-END
-
-let (!@) = to_coqloc
-
-(** Misc module emulation *)
-
-IFDEF CAMLP5 THEN
-
-module PcamlSig = struct end
-module Token = Token
-module CompatGramext = struct include Gramext type assoc = g_assoc end
-
-ELSE
-
-module PcamlSig = Camlp4.Sig
-module Ast = Camlp4.PreCast.Ast
-module Pcaml = Camlp4.PreCast.Syntax
-module MLast = Ast
-module Token = struct exception Error of string end
-module CompatGramext = Camlp4.Sig.Grammar
-
-END
-
-(** Signature of CLexer *)
-
-IFDEF CAMLP5 THEN
-
-module type LexerSig = sig
-  include Grammar.GLexerType with type te = Tok.t
-  module Error : sig
-    type t
-    exception E of t
-    val to_string : t -> string
-  end
-  type lexer_state
-  val init_lexer_state : string option -> lexer_state
-  val set_lexer_state : lexer_state -> unit
-  val release_lexer_state : unit -> lexer_state
-  val drop_lexer_state : unit -> unit
-end
-
-ELSE
-
-module type LexerSig = sig
-  include Camlp4.Sig.Lexer with module Loc = CompatLoc and type Token.t = Tok.t
-  type lexer_state
-  val init_lexer_state : string option -> lexer_state
-  val set_lexer_state : lexer_state -> unit
-  val release_lexer_state : unit -> lexer_state
-  val drop_lexer_state : unit -> unit
-end
-
-END
-
-(** Signature and implementation of grammars *)
-
-IFDEF CAMLP5 THEN
-
-module type GrammarSig = 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
-  val srules' : production_rule list -> symbol
-  val parse_tokens_after_filter : 'a entry -> Tok.t Stream.t -> 'a
-end
-
-module GrammarMake (L:LexerSig) : GrammarSig = struct
-  include Grammar.GMake (L)
-  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 = parsable * L.lexer_state ref
-  let parsable ?file c =
-    let state = ref (L.init_lexer_state file) in
-    L.set_lexer_state !state;
-    let a = parsable c in
-    state := L.release_lexer_state ();
-    (a,state)
-  let action = Gramext.action
-  let entry_create = Entry.create
-  let entry_parse e (p,state) =
-    L.set_lexer_state !state;
-    try
-      let c = Entry.parse e p in
-      state := L.release_lexer_state ();
-      c
-    with Exc_located (loc,e) ->
-      L.drop_lexer_state ();
-      let loc' = Loc.get_loc (Exninfo.info e) in
-      let loc = match loc' with None -> to_coqloc loc | Some loc -> loc in
-      Loc.raise loc e
-  let with_parsable (p,state) f x =
-    L.set_lexer_state !state;
-    try
-      let a = f x in
-      state := L.release_lexer_state ();
-      a
-    with e ->
-      L.drop_lexer_state ();
-      raise e
-
-  let entry_print ft x = Entry.print ft x
-  let srules' = Gramext.srules
-  let parse_tokens_after_filter = Entry.parse_token
-end
-
-ELSE
-
-module type GrammarSig = sig
-  include Camlp4.Sig.Grammar.Static
-    with module Loc = CompatLoc and type Token.t = Tok.t
-  type 'a entry = 'a Entry.t
-  type action = Action.t
-  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
-  val srules' : production_rule list -> symbol
-end
-
-module GrammarMake (L:LexerSig) : GrammarSig = struct
-  (* We need to refer to Coq's module Loc before it is hidden by include *)
-  let raise_coq_loc loc e = Loc.raise (to_coqloc loc) e
-  include Camlp4.Struct.Grammar.Static.Make (L)
-  type 'a entry = 'a Entry.t
-  type action = Action.t
-  type coq_parsable = char Stream.t * L.lexer_state ref
-  let parsable ?file s = let state = ref (L.init_lexer_state file) in (s, state)
-  let action = Action.mk
-  let entry_create = Entry.mk
-  let entry_parse e (s,state) =
-    L.set_lexer_state !state;
-    try
-      let c = parse e (*FIXME*)CompatLoc.ghost s in
-      state := L.release_lexer_state ();
-      c
-    with Exc_located (loc,e) ->
-      L.drop_lexer_state ();
-      raise_coq_loc loc e;;
-  let with_parsable (p,state) f x =
-    L.set_lexer_state !state;
-    try
-      let a = f x in
-      state := L.release_lexer_state ();
-      a
-    with e ->
-      L.drop_lexer_state ();
-      Pervasives.raise e;;
-  let entry_print ft x = Entry.print ft x
-  let srules' = srules (entry_create "dummy")
-end
-
-END
-
-(** Some definitions are grammar-specific in Camlp4, so we use a functor to
-    depend on it while taking a dummy argument in Camlp5. *)
-
-module GramextMake (G : GrammarSig) :
-sig
-  val stoken : Tok.t -> G.symbol
-  val sself : G.symbol
-  val snext : G.symbol
-  val slist0 : G.symbol -> G.symbol
-  val slist0sep : G.symbol * G.symbol -> G.symbol
-  val slist1 : G.symbol -> G.symbol
-  val slist1sep : G.symbol * G.symbol -> G.symbol
-  val sopt : G.symbol -> G.symbol
-  val snterml : G.internal_entry * string -> G.symbol
-  val snterm : G.internal_entry -> G.symbol
-  val snterml_level : G.symbol -> string
-end =
-struct
-
-IFDEF CAMLP5 THEN
-  let stoken tok =
-    let pattern = match tok with
-    | Tok.KEYWORD s -> "", s
-    | Tok.IDENT s -> "IDENT", s
-    | Tok.PATTERNIDENT s -> "PATTERNIDENT", s
-    | Tok.FIELD s -> "FIELD", s
-    | Tok.INT s -> "INT", s
-    | Tok.STRING s -> "STRING", s
-    | Tok.LEFTQMARK -> "LEFTQMARK", ""
-    | Tok.BULLET s -> "BULLET", s
-    | Tok.EOI -> "EOI", ""
-    in
-    Gramext.Stoken pattern
-ELSE
-  module Gramext = G
-  let stoken tok = match tok with
-  | Tok.KEYWORD s -> Gramext.Skeyword s
-  | tok -> Gramext.Stoken (Tok.equal tok, G.Token.to_string tok)
-END
-
-  IFDEF CAMLP5 THEN
-     let slist0sep (x, y) = Gramext.Slist0sep (x, y, false)
-     let slist1sep (x, y) = Gramext.Slist1sep (x, y, false)
-  ELSE
-    let slist0sep (x, y) = Gramext.Slist0sep (x, y)
-    let slist1sep (x, y) = Gramext.Slist1sep (x, y)
-  END
-
-  let snterml (x, y) = Gramext.Snterml (x, y)
-  let snterm x = Gramext.Snterm x
-  let sself = Gramext.Sself
-  let snext = Gramext.Snext
-  let slist0 x = Gramext.Slist0 x
-  let slist1 x = Gramext.Slist1 x
-  let sopt x = Gramext.Sopt x
-
-  let snterml_level = function
-  | Gramext.Snterml (_, l) -> l
-  | _ -> failwith "snterml_level"
-
-end
-
-
-(** Misc functional adjustments *)
-
-(** - The lexer produces streams made of pairs in camlp4 *)
-
-let get_tok = IFDEF CAMLP5 THEN fun x -> x ELSE fst END
-
-(** - Gram.extend is more currified in camlp5 than in camlp4 *)
-
-IFDEF CAMLP5 THEN
-let maybe_curry f x y = f (x,y)
-let maybe_uncurry f (x,y) = f x y
-ELSE
-let maybe_curry f = f
-let maybe_uncurry f = f
-END
-
-(** Compatibility with camlp5 strict mode *)
-IFDEF CAMLP5 THEN
-  IFDEF STRICT THEN
-    let vala x = Ploc.VaVal x
-  ELSE
-    let vala x = x
-  END
-ELSE
-  let vala x = x
-END
-
-(** Fix a quotation difference in [str_item] *)
-
-let declare_str_items loc l =
-IFDEF CAMLP5 THEN
-  MLast.StDcl (loc, vala l) (* correspond to <:str_item< declare $list:l'$ end >> *)
-ELSE
-  Ast.stSem_of_list l
-END
-
-(** Quotation difference for match clauses *)
-
-let default_patt loc =
-  (<:patt< _ >>, vala None, <:expr< failwith "Extension: cannot occur" >>)
-
-IFDEF CAMLP5 THEN
-
-let make_fun loc cl =
-  let l = cl @ [default_patt loc] in
-  MLast.ExFun (loc, vala l)  (* correspond to <:expr< fun [ $list:l$ ] >> *)
-
-ELSE
-
-let make_fun loc cl =
-  let mk_when = function
-    | Some w -> w
-    | None -> Ast.ExNil loc
-  in
-  let mk_clause (patt,optwhen,expr) =
-    (* correspond to <:match_case< ... when ... -> ... >> *)
-    Ast.McArr (loc, patt, mk_when optwhen, expr) in
-  let init = mk_clause (default_patt loc) in
-  let add_clause x acc = Ast.McOr (loc, mk_clause x, acc) in
-  let l = List.fold_right add_clause cl init in
-  Ast.ExFun (loc,l) (* correspond to <:expr< fun [ $l$ ] >> *)
-
-END
-
-IFDEF CAMLP5 THEN
-let warning_verbose = Gramext.warning_verbose
-ELSE
-(* TODO: this is a workaround, since there isn't such
-   [warning_verbose] in new camlp4. *)
-let warning_verbose = ref true
-END
diff --git a/parsing/doc.tex b/parsing/doc.tex
deleted file mode 100644
index 68ab601c..00000000
--- a/parsing/doc.tex
+++ /dev/null
@@ -1,9 +0,0 @@
-
-\newpage
-\section*{The Coq parsers and printers}
-
-\ocwsection \label{parsing}
-This chapter describes the implementation of the \Coq\ parsers and printers.
-
-\bigskip
-\begin{center}\epsfig{file=parsing.dep.ps}\end{center}
diff --git a/parsing/egramcoq.ml b/parsing/egramcoq.ml
index a292c746..5f63d21c 100644
--- a/parsing/egramcoq.ml
+++ b/parsing/egramcoq.ml
@@ -1,16 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Pcoq
 open Constrexpr
-open Notation
 open Notation_term
 open Extend
 open Libnames
@@ -22,11 +23,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
@@ -35,7 +36,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;
@@ -45,8 +47,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]
 
@@ -71,7 +73,7 @@ let error_level_assoc p current expected =
     | Extend.LeftA -> str "left"
     | Extend.RightA -> str "right"
     | Extend.NonA -> str "non" in
-  errorlabstrm ""
+  user_err 
     (str "Level " ++ int p ++ str " is already declared " ++
      pr_assoc current ++ str " associative while it is now expected to be " ++
      pr_assoc expected ++ str " associative.")
@@ -80,10 +82,6 @@ let create_pos = function
   | None -> Extend.First
   | Some lev -> Extend.After (constr_level lev)
 
-type gram_level =
-  gram_position option * gram_assoc option * string option *
-  (** for reinitialization: *) gram_reinit option
-
 let find_position_gen current ensure assoc lev =
   match lev with
   | None ->
@@ -148,11 +146,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,
@@ -176,8 +174,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
 
@@ -209,7 +207,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)) ->
@@ -230,14 +228,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, Bigint.bigint) entry
-| TTBinder : ('self, local_binder list) entry
+| TTBigint : ('self, Constrexpr.raw_natural_number) 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 list) entry
-| TTBinderListF : Tok.t list -> ('self, local_binder 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
 
@@ -262,9 +260,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
@@ -291,40 +291,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) = match na with
-  | Anonymous -> CHole (loc,None,Misctypes.IntroAnonymous,None)
-  | Name id -> CRef (Ident (loc,id), None)
-
-let cases_pattern_expr_of_name (loc,na) = match na with
-  | Anonymous -> CPatAtom (loc,None)
-  | Name id -> CPatAtom (loc,Some (Ident (loc,id)))
+| 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 (CAst.make ?loc @@ Ident id))
 
 type 'r env = {
   constrs : 'r list;
   constrlists : 'r list list;
-  binders : (local_binder 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 }
@@ -334,21 +328,25 @@ 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 (CPrim (Loc.ghost, Numeral v))
-  | ForPattern -> push_constr subst (CPatPrim (Loc.ghost, Numeral v))
+  | ForConstr ->  push_constr subst (CAst.make @@ CPrim (Numeral (v,true)))
+  | ForPattern -> push_constr subst (CAst.make @@ CPatPrim (Numeral (v,true)))
   end
 | TTReference ->
   begin match forpat with
-  | ForConstr -> push_constr subst (CRef (v, None))
-  | ForPattern -> push_constr subst (CPatAtom (Loc.ghost, Some v))
+  | ForConstr  -> push_constr subst (CAst.make @@ CRef (v, None))
+  | ForPattern -> push_constr subst (CAst.make @@ CPatAtom (Some v))
   end
 | TTConstrList _ -> { subst with constrlists = v :: subst.constrlists }
 
@@ -359,7 +357,7 @@ type (_, _) ty_symbol =
 type ('self, _, 'r) ty_rule =
 | TyStop : ('self, 'r, 'r) ty_rule
 | TyNext : ('self, 'a, 'r) ty_rule * ('self, 'b) ty_symbol -> ('self, 'b -> 'a, 'r) ty_rule
-| TyMark : int * bool * ('self, 'a, 'r) ty_rule -> ('self, 'a, 'r) ty_rule
+| TyMark : int * bool * int * ('self, 'a, 'r) ty_rule -> ('self, 'a, 'r) ty_rule
 
 type 'r gen_eval = Loc.t -> 'r env -> 'r
 
@@ -373,18 +371,27 @@ let rec ty_eval : type s a. (s, a, Loc.t -> s) ty_rule -> s gen_eval -> s env ->
 | TyNext (rem, TyNonTerm (forpat, e, _, true)) ->
   fun f env v ->
     ty_eval rem f (push_item forpat e env v)
-| TyMark (n, b, rem) ->
+| TyMark (n, b, p, rem) ->
   fun f env ->
     let heads, constrs = List.chop n env.constrs in
-    let constrlists =
-      if b then (heads @ List.hd env.constrlists) :: List.tl env.constrlists
-      else heads :: env.constrlists
+    let constrlists, constrs =
+      if b then
+         (* We rearrange constrs = c1..cn rem and constrlists = [d1..dr e1..ep] rem' into
+            constrs = e1..ep rem and constrlists [c1..cn d1..dr] rem' *)
+         let constrlist = List.hd env.constrlists in
+         let constrlist, tail = List.chop (List.length constrlist - p) constrlist in
+         (heads @ constrlist) :: List.tl env.constrlists, tail @ constrs
+      else
+         (* We rearrange constrs = c1..cn e1..ep rem into
+            constrs = e1..ep rem and add a constr list [c1..cn] *)
+        let constrlist, tail = List.chop (n - p) heads in
+        constrlist :: env.constrlists, tail @ constrs
     in
     ty_eval rem f { env with constrs; constrlists; } 
 
 let rec ty_erase : type s a r. (s, a, r) ty_rule -> (s, a, r) Extend.rule = function
 | TyStop -> Stop
-| TyMark (_, _, r) -> ty_erase r
+| TyMark (_, _, _, r) -> ty_erase r
 | TyNext (rem, TyTerm tok) -> Next (ty_erase rem, Atoken tok)
 | TyNext (rem, TyNonTerm (_, _, s, _)) -> Next (ty_erase rem, s)
 
@@ -403,9 +410,9 @@ let make_ty_rule assoc from forpat prods =
     let s = symbol_of_entry assoc from e in
     let bind = match var with None -> false | Some _ -> true in
     AnyTyRule (TyNext (r, TyNonTerm (forpat, e, s, bind)))
-  | GramConstrListMark (n, b) :: rem ->
+  | GramConstrListMark (n, b, p) :: rem ->
     let AnyTyRule r = make_ty_rule rem in
-    AnyTyRule (TyMark (n, b, r))
+    AnyTyRule (TyMark (n, b, p, r))
   in
   make_ty_rule (List.rev prods)
 
@@ -430,16 +437,14 @@ 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
-  CNotation (loc, 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
-  CPatNotation (loc, notation, env, [])
+  CAst.make ~loc @@ CPatNotation (notation, env, [])
 
 let extend_constr state forpat ng =
-  let n = ng.notgram_level in
+  let n,_,_ = ng.notgram_level in
   let assoc = ng.notgram_assoc in
   let (entry, level) = interp_constr_entry_key forpat n in
   let fold (accu, state) pt =
@@ -450,7 +455,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
@@ -460,7 +465,7 @@ let extend_constr state forpat ng =
 
 let constr_levels = GramState.field ()
 
-let extend_constr_notation (_, ng) state =
+let extend_constr_notation ng state =
   let levels = match GramState.get state constr_levels with
   | None -> default_constr_levels
   | Some lev -> lev
@@ -472,7 +477,7 @@ let extend_constr_notation (_, ng) state =
   let state = GramState.set state constr_levels levels in
   (r @ r', state)
 
-let constr_grammar : (Notation.level * notation_grammar) grammar_command =
+let constr_grammar : one_notation_grammar grammar_command =
   create_grammar_command "Notation" extend_constr_notation
 
-let extend_constr_grammar pr ntn = extend_grammar_command constr_grammar (pr, ntn)
+let extend_constr_grammar ntn = extend_grammar_command constr_grammar ntn
diff --git a/parsing/egramcoq.mli b/parsing/egramcoq.mli
index 6dda3817..e15add10 100644
--- a/parsing/egramcoq.mli
+++ b/parsing/egramcoq.mli
@@ -1,25 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Names
-open Constrexpr
-open Notation_term
-open Pcoq
-open Extend
-open Genarg
-open Egramml
-
-(** 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. *)
 
 (** {5 Adding notations} *)
 
-val extend_constr_grammar : Notation.level -> Notation_term.notation_grammar -> unit
+val extend_constr_grammar : Notation_term.one_notation_grammar -> unit
 (** Add a term notation rule to the parsing system. *)
diff --git a/parsing/egramml.ml b/parsing/egramml.ml
index 97a3e89a..90cd7d10 100644
--- a/parsing/egramml.ml
+++ b/parsing/egramml.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -17,7 +19,7 @@ open Vernacexpr
 type 's grammar_prod_item =
   | GramTerminal of string
   | GramNonTerminal :
-      Loc.t * 'a raw_abstract_argument_type * ('s, 'a) symbol -> 's grammar_prod_item
+      ('a raw_abstract_argument_type option * ('s, 'a) symbol) Loc.located -> 's grammar_prod_item
 
 type 'a ty_arg = ('a -> raw_generic_argument)
 
@@ -36,9 +38,9 @@ let rec ty_rule_of_gram = function
   let tok = Atoken (CLexer.terminal s) in
   let r = TyNext (rem, tok, None) in
   AnyTyRule r
-| GramNonTerminal (_, t, tok) :: rem ->
+| GramNonTerminal (_, (t, tok)) :: rem ->
   let AnyTyRule rem = ty_rule_of_gram rem in
-  let inj = Some (fun obj -> Genarg.in_gen t obj) in
+  let inj = Option.map (fun t obj -> Genarg.in_gen t obj) t in
   let r = TyNext (rem, tok, inj) in
   AnyTyRule r
 
diff --git a/parsing/egramml.mli b/parsing/egramml.mli
index 1ad94720..31aa1a98 100644
--- a/parsing/egramml.mli
+++ b/parsing/egramml.mli
@@ -1,22 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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. *)
 
 type 's grammar_prod_item =
   | GramTerminal of string
-  | GramNonTerminal : Loc.t * 'a Genarg.raw_abstract_argument_type *
-      ('s, 'a) Extend.symbol -> 's grammar_prod_item
+  | GramNonTerminal : ('a Genarg.raw_abstract_argument_type option *
+      ('s, 'a) Extend.symbol) Loc.located -> 's grammar_prod_item
 
 val extend_vernac_command_grammar :
   Vernacexpr.extend_name -> vernac_expr Pcoq.Gram.entry option ->
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index 7f3a3d10..59b74545 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -12,7 +14,6 @@ open Constrexpr
 open Constrexpr_ops
 open Util
 open Tok
-open Compat
 open Misctypes
 open Decl_kinds
 
@@ -34,42 +35,39 @@ let _ = List.iter CLexer.add_keyword constr_kw
 let mk_cast = function
     (c,(_,None)) -> c
   | (c,(_,Some ty)) ->
-    let loc = Loc.merge (constr_loc c) (constr_loc ty)
-    in CCast(loc, c, CastConv ty)
+    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) =
-  LocalRawAssum ([loc, na], Default expl,
-    CHole (loc, Some (Evar_kinds.BinderType na), IntroAnonymous, None))
+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 binders_of_lidents l =
-  List.map (fun (loc, id) -> binder_of_name Explicit (loc, Name id)) 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 -> CHole (loc, None, IntroAnonymous, None) in
+    | 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,_) ->
-    CErrors.user_err_loc
-      (aloc,"Constr:mk_cofixb",
-       Pp.str"Annotation forbidden in cofix expression.")) (fst ann) in
+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
   let ty = match tyc with
       Some ty -> ty
-    | None -> CHole (loc, None, IntroAnonymous, None) in
+    | None -> CAst.make @@ CHole (None, IntroAnonymous, None) in
   (id,bl,ty,body)
 
 let mk_fix(loc,kw,id,dcls) =
   if kw then
-    let fb = List.map mk_fixb dcls in
-    CFix(loc,id,fb)
+    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
-    CCoFix(loc,id,fb)
+    let fb : cofix_expr list = List.map mk_cofixb dcls in
+    CAst.make ~loc @@ CCoFix(id,fb)
 
 let mk_single_fix (loc,kw,dcl) =
   let (id,_,_,_,_) = dcl in mk_fix(loc,kw,id,[dcl])
@@ -81,11 +79,11 @@ let err () = raise Stream.Failure
 let lpar_id_coloneq =
   Gram.Entry.of_parser "test_lpar_id_coloneq"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
         | KEYWORD "(" ->
-            (match get_tok (stream_nth 1 strm) with
+            (match stream_nth 1 strm with
 	      | IDENT s ->
-                  (match get_tok (stream_nth 2 strm) with
+                  (match stream_nth 2 strm with
                     | KEYWORD ":=" ->
                         stream_njunk 3 strm;
                         Names.Id.of_string s
@@ -96,9 +94,9 @@ let lpar_id_coloneq =
 let impl_ident_head =
   Gram.Entry.of_parser "impl_ident_head"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
 	| KEYWORD "{" ->
-	    (match get_tok (stream_nth 1 strm) with
+	    (match stream_nth 1 strm with
 	      | IDENT ("wf"|"struct"|"measure") -> err ()
 	      | IDENT s ->
 		  stream_njunk 2 strm;
@@ -109,33 +107,33 @@ let impl_ident_head =
 let name_colon =
   Gram.Entry.of_parser "name_colon"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
 	| IDENT s ->
-            (match get_tok (stream_nth 1 strm) with
+            (match stream_nth 1 strm with
               | KEYWORD ":" ->
                   stream_njunk 2 strm;
                   Name (Names.Id.of_string s)
               | _ -> err ())
 	| KEYWORD "_" ->
-          (match get_tok (stream_nth 1 strm) with
+          (match stream_nth 1 strm with
               | KEYWORD ":" ->
                   stream_njunk 2 strm;
                   Anonymous
               | _ -> err ())
         | _ -> err ())
 
-let aliasvar = function CPatAlias (loc, _, 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, Anonymous) ] ]
+    [ [ "_" -> CAst.make ~loc:!@loc Anonymous ] ]
   ;
   global:
     [ [ r = Prim.reference -> r ] ]
@@ -150,12 +148,24 @@ GEXTEND Gram
     [ [ "Set"  -> GSet
       | "Prop" -> GProp
       | "Type" -> GType []
-      | "Type"; "@{"; u = universe; "}" -> GType (List.map (fun (loc,x) -> (loc, Id.to_string x)) u)
+      | "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 identref SEP ","; ")" -> ids
-      | id = identref -> [id]
+    [ [ IDENT "max"; "("; ids = LIST1 universe_expr SEP ","; ")" -> ids
+      | u = universe_expr -> [u]
       ] ]
   ;
   lconstr:
@@ -163,132 +173,136 @@ GEXTEND Gram
   ;
   constr:
     [ [ c = operconstr LEVEL "8" -> c
-      | "@"; f=global; i = instance -> CAppExpl(!@loc,(None,f,i),[]) ] ]
+      | "@"; f=global; i = instance -> CAst.make ~loc:!@loc @@ CAppExpl((None,f,i),[]) ] ]
   ;
   operconstr:
     [ "200" RIGHTA
       [ c = binder_constr -> c ]
     | "100" RIGHTA
       [ c1 = operconstr; "<:"; c2 = binder_constr ->
-                 CCast(!@loc,c1, CastVM c2)
+                 CAst.make ~loc:(!@loc) @@ CCast(c1, CastVM c2)
       | c1 = operconstr; "<:"; c2 = SELF ->
-                 CCast(!@loc,c1, CastVM c2)
+                 CAst.make ~loc:(!@loc) @@ CCast(c1, CastVM c2)
       | c1 = operconstr; "<<:"; c2 = binder_constr ->
-                 CCast(!@loc,c1, CastNative c2)
+                 CAst.make ~loc:(!@loc) @@ CCast(c1, CastNative c2)
       | c1 = operconstr; "<<:"; c2 = SELF ->
-                 CCast(!@loc,c1, CastNative c2)
+                 CAst.make ~loc:(!@loc) @@ CCast(c1, CastNative c2)
       | c1 = operconstr; ":";c2 = binder_constr ->
-                 CCast(!@loc,c1, CastConv c2)
+                 CAst.make ~loc:(!@loc) @@ CCast(c1, CastConv c2)
       | c1 = operconstr; ":"; c2 = SELF ->
-                 CCast(!@loc,c1, CastConv c2)
+                 CAst.make ~loc:(!@loc) @@ CCast(c1, CastConv c2)
       | c1 = operconstr; ":>" ->
-                 CCast(!@loc,c1, CastCoerce) ]
+                 CAst.make ~loc:(!@loc) @@ CCast(c1, CastCoerce) ]
     | "99" RIGHTA [ ]
     | "90" RIGHTA [ ]
     | "10" LEFTA
-      [ f=operconstr; args=LIST1 appl_arg -> CApp(!@loc,(None,f),args)
-      | "@"; f=global; i = instance; args=LIST0 NEXT -> CAppExpl(!@loc,(None,f,i),args)
-      | "@"; (locid,id) = pattern_identref; args=LIST1 identref ->
-          let args = List.map (fun x -> CRef (Ident x,None), None) args in
-          CApp(!@loc,(None,CPatVar(locid,id)),args) ]
+      [ 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)
+      | "@"; lid = pattern_identref; args=LIST1 identref ->
+          let { CAst.loc = locid; v = id } = lid in
+          let args = List.map (fun x -> CAst.make @@ CRef (CAst.make ?loc:x.CAst.loc @@ Ident 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"; ".." ->
-          CAppExpl (!@loc,(None,Ident (!@loc,ldots_var),None),[c]) ]
+          CAst.make ~loc:!@loc @@ CAppExpl ((None, CAst.make ~loc:!@loc @@ Ident ldots_var, None),[c]) ]
     | "8" [ ]
     | "1" LEFTA
       [ c=operconstr; ".("; f=global; args=LIST0 appl_arg; ")" ->
-	CApp(!@loc,(Some (List.length args+1),CRef (f,None)),args@[c,None])
+	CAst.make ~loc:(!@loc) @@ CApp((Some (List.length args+1), CAst.make @@ CRef (f,None)),args@[c,None])
       | c=operconstr; ".("; "@"; f=global;
         args=LIST0 (operconstr LEVEL "9"); ")" ->
-        CAppExpl(!@loc,(Some (List.length args+1),f,None),args@[c])
-      | c=operconstr; "%"; key=IDENT -> CDelimiters (!@loc,key,c) ]
+        CAst.make ~loc:(!@loc) @@ CAppExpl((Some (List.length args+1),f,None),args@[c])
+      | c=operconstr; "%"; key=IDENT -> CAst.make ~loc:(!@loc) @@ CDelimiters (key,c) ]
     | "0"
       [ c=atomic_constr -> c
       | c=match_constr -> c
       | "("; c = operconstr LEVEL "200"; ")" ->
-          (match c with
-              CPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
-                CNotation(!@loc,"( _ )",([c],[],[]))
+          (match c.CAst.v with
+            | CPrim (Numeral (n,true)) ->
+                CAst.make ~loc:(!@loc) @@ CNotation("( _ )",([c],[],[],[]))
             | _ -> c)
       | "{|"; c = record_declaration; "|}" -> c
+      | "{"; c = binder_constr ; "}" ->
+          CAst.make ~loc:(!@loc) @@ CNotation(("{ _ }"),([c],[],[],[]))
       | "`{"; c = operconstr LEVEL "200"; "}" ->
-	  CGeneralization (!@loc, Implicit, None, c)
+	  CAst.make ~loc:(!@loc) @@ CGeneralization (Implicit, None, c)
       | "`("; c = operconstr LEVEL "200"; ")" ->
-	  CGeneralization (!@loc, Explicit, None, c)
-      | IDENT "ltac"; ":"; "("; tac = Tactic.tactic_expr; ")" ->
-          let arg = Genarg.in_gen (Genarg.rawwit Constrarg.wit_tactic) tac in
-          CHole (!@loc, None, IntroAnonymous, Some arg)
+	  CAst.make ~loc:(!@loc) @@ CGeneralization (Explicit, None, c)
       ] ]
   ;
   record_declaration:
-    [ [ fs = record_fields -> CRecord (!@loc, fs) ] ]
+    [ [ fs = record_fields -> CAst.make ~loc:(!@loc) @@ CRecord fs ] ]
   ;
 
   record_fields:
     [ [ f = record_field_declaration; ";"; fs = record_fields -> f :: fs
-      | f = record_field_declaration; ";" -> [f]
       | f = record_field_declaration -> [f]
       | -> []
     ] ]
   ;
 
   record_field_declaration:
-    [ [ id = global; params = LIST0 identref; ":="; c = lconstr ->
-      (id, abstract_constr_expr c (binders_of_lidents params)) ] ]
+    [ [ id = global; bl = binders; ":="; c = lconstr ->
+      (id, if bl = [] then c else mkCLambdaN ~loc:!@loc bl c) ] ]
   ;
   binder_constr:
     [ [ "forall"; bl = open_binders; ","; c = operconstr LEVEL "200" ->
-          mkCProdN (!@loc) bl c
+          mkCProdN ~loc:!@loc bl c
       | "fun"; bl = open_binders; "=>"; c = operconstr LEVEL "200" ->
-          mkCLambdaN (!@loc) bl c
+          mkCLambdaN ~loc:!@loc bl c
       | "let"; id=name; bl = binders; ty = type_cstr; ":=";
         c1 = operconstr LEVEL "200"; "in"; c2 = operconstr LEVEL "200" ->
-          let loc1 =
-	    Loc.merge (local_binders_loc bl) (constr_loc c1)
-	  in
-          CLetIn(!@loc,id,mkCLambdaN loc1 bl (mk_cast(c1,ty)),c2)
+          let ty,c1 = match ty, c1 with
+          | (_,None), { CAst.v = CCast(c, CastConv t) } -> (Loc.tag ?loc:(constr_loc t) @@ Some t), c (* Tolerance, see G_vernac.def_body *)
+          | _, _ -> ty, c1 in
+          CAst.make ~loc:!@loc @@ CLetIn(id,mkCLambdaN ?loc:(constr_loc c1) bl c1,
+                 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 with
-              CFix(_,id,_) -> id
-            | CCoFix(_,id,_) -> id
+          let { CAst.loc = li; v = id } = match fixp.CAst.v with
+              CFix(id,_) -> id
+            | CCoFix(id,_) -> id
             | _ -> assert false in
-          CLetIn(!@loc,(li,Name id),fixp,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";
           c2 = operconstr LEVEL "200" ->
-          CLetTuple (!@loc,lb,po,c1,c2)
+          CAst.make ~loc:!@loc @@ CLetTuple (lb,po,c1,c2)
       | "let"; "'"; p=pattern; ":="; c1 = operconstr LEVEL "200";
           "in"; c2 = operconstr LEVEL "200" ->
-	    CCases (!@loc, LetPatternStyle, None, [c1, None, None], [(!@loc, [(!@loc,[p])], c2)])
+	    CAst.make ~loc:!@loc @@
+            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" ->
-	    CCases (!@loc, LetPatternStyle, Some rt, [c1, aliasvar p, None], [(!@loc, [(!@loc, [p])], c2)])
+	    CAst.make ~loc:!@loc @@
+            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" ->
-	    CCases (!@loc, LetPatternStyle, Some rt, [c1, aliasvar p, Some t], [(!@loc, [(!@loc, [p])], c2)])
+	    CAst.make ~loc:!@loc @@
+            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" ->
-          CIf (!@loc, c, po, b1, b2)
+          CAst.make ~loc:(!@loc) @@ CIf (c, po, b1, b2)
       | c=fix_constr -> c ] ]
   ;
   appl_arg:
     [ [ id = lpar_id_coloneq; c=lconstr; ")" ->
-	  (c,Some (!@loc,ExplByName id))
+          (c,Some (CAst.make ~loc:!@loc @@ ExplByName id))
       | c=operconstr LEVEL "9" -> (c,None) ] ]
   ;
   atomic_constr:
-    [ [ g=global; i=instance -> CRef (g,i)
-      | s=sort -> CSort (!@loc,s)
-      | n=INT -> CPrim (!@loc, Numeral (Bigint.of_string n))
-      | s=string -> CPrim (!@loc, String s)
-      | "_" -> CHole (!@loc, None, IntroAnonymous, None)
-      | "?"; "["; id=ident; "]"  -> CHole (!@loc, None, IntroIdentifier id, None)
-      | "?"; "["; id=pattern_ident; "]"  -> CHole (!@loc, None, IntroFresh id, None)
-      | id=pattern_ident; inst = evar_instance -> CEvar(!@loc,id,inst) ] ]
+    [ [ g=global; i=instance -> CAst.make ~loc:!@loc @@ CRef (g,i)
+      | s=sort   -> CAst.make ~loc:!@loc @@  CSort s
+      | n=INT    -> CAst.make ~loc:!@loc @@ CPrim (Numeral (n,true))
+      | s=string -> CAst.make ~loc:!@loc @@ CPrim (String s)
+      | "_"      -> CAst.make ~loc:!@loc @@ CHole (None, IntroAnonymous, None)
+      | "?"; "["; id=ident; "]"  -> CAst.make ~loc:!@loc @@  CHole (None, IntroIdentifier id, None)
+      | "?"; "["; id=pattern_ident; "]"  -> CAst.make ~loc:!@loc @@  CHole (None, IntroFresh id, None)
+      | id=pattern_ident; inst = evar_instance -> CAst.make ~loc:!@loc @@ CEvar(id,inst) ] ]
   ;
   inst:
     [ [ id = ident; ":="; c = lconstr -> (id,c) ] ]
@@ -298,14 +312,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 = identref -> GType (Some (fst id, Id.to_string (snd id)))
+      | "Type" -> GType UUnknown
+      | "_" -> GType UAnonymous
+      | id = global -> GType (UNamed id)
       ] ]
   ;
   fix_constr:
@@ -329,7 +344,7 @@ GEXTEND Gram
   ;
   match_constr:
     [ [ "match"; ci=LIST1 case_item SEP ","; ty=OPT case_type; "with";
-        br=branches; "end" -> CCases(!@loc,RegularStyle,ty,ci,br) ] ]
+        br=branches; "end" -> CAst.make ~loc:!@loc @@ CCases(RegularStyle,ty,ci,br) ] ]
   ;
   case_item:
     [ [ c=operconstr LEVEL "100";
@@ -352,11 +367,11 @@ GEXTEND Gram
     [ [ OPT"|"; br=LIST0 eqn SEP "|" -> br ] ]
   ;
   mult_pattern:
-    [ [ pl = LIST1 pattern LEVEL "99" SEP "," -> (!@loc,pl) ] ]
+    [ [ pl = LIST1 pattern LEVEL "99" SEP "," -> pl ] ]
   ;
   eqn:
     [ [ pll = LIST1 mult_pattern SEP "|";
-        "=>"; rhs = lconstr -> (!@loc,pll,rhs) ] ]
+        "=>"; rhs = lconstr -> (CAst.make ~loc:!@loc (pll,rhs)) ] ]
   ;
   record_pattern:
     [ [ id = global; ":="; pat = pattern -> (id, pat) ] ]
@@ -371,55 +386,47 @@ GEXTEND Gram
   pattern:
     [ "200" RIGHTA [ ]
     | "100" RIGHTA
-      [ p = pattern; "|"; pl = LIST1 pattern SEP "|" -> CPatOr (!@loc,p::pl) ]
+      [ p = pattern; "|"; pl = LIST1 pattern SEP "|" -> CAst.make ~loc:!@loc @@ CPatOr (p::pl) ]
     | "99" RIGHTA [ ]
-    | "11" LEFTA
-      [ p = pattern; "as"; id = ident ->
-	  CPatAlias (!@loc, p, id) ]
-    | "10" RIGHTA
-      [ p = pattern; lp = LIST1 NEXT ->
-        (match p with
-	  | CPatAtom (_, Some r) -> CPatCstr (!@loc, r, None, lp)
-	  | CPatCstr (_, r, None, l2) -> CErrors.user_err_loc
-              (cases_pattern_expr_loc p, "compound_pattern",
-               Pp.str "Nested applications not supported.")
-	  | CPatCstr (_, r, l1, l2) -> CPatCstr (!@loc, r, l1 , l2@lp)
-	  | CPatNotation (_, n, s, l) -> CPatNotation (!@loc, n , s, l@lp)
-          | _ -> CErrors.user_err_loc
-              (cases_pattern_expr_loc p, "compound_pattern",
-               Pp.str "Such pattern cannot have arguments."))
-      |"@"; r = Prim.reference; lp = LIST0 NEXT ->
-        CPatCstr (!@loc, r, Some lp, []) ]
+    | "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 -> CPatDelimiters (!@loc,key,c) ]
+      [ c = pattern; "%"; key=IDENT -> CAst.make ~loc:!@loc @@ CPatDelimiters (key,c) ]
     | "0"
-      [ r = Prim.reference -> CPatAtom (!@loc,Some r)
-      | "{|"; pat = record_patterns; "|}" -> CPatRecord (!@loc, pat)
-      | "_" -> CPatAtom (!@loc,None)
+      [ r = Prim.reference                -> CAst.make ~loc:!@loc @@ CPatAtom (Some r)
+      | "{|"; pat = record_patterns; "|}" -> CAst.make ~loc:!@loc @@ CPatRecord pat
+      | "_" -> CAst.make ~loc:!@loc @@ CPatAtom None
       | "("; p = pattern LEVEL "200"; ")" ->
-          (match p with
-              CPatPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
-                CPatNotation(!@loc,"( _ )",([p],[]),[])
+          (match p.CAst.v with
+            | CPatPrim (Numeral (n,true)) ->
+                 CAst.make ~loc:!@loc @@ CPatNotation("( _ )",([p],[]),[])
             | _ -> p)
       | "("; p = pattern LEVEL "200"; ":"; ty = lconstr; ")" ->
           let p =
             match p with
-              CPatPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
-                CPatNotation(!@loc,"( _ )",([p],[]),[])
+            | { CAst.v = CPatPrim (Numeral (n,true)) } ->
+                 CAst.make ~loc:!@loc @@ CPatNotation("( _ )",([p],[]),[])
             | _ -> p
           in
-	  CPatCast (!@loc, p, ty)
-      | n = INT -> CPatPrim (!@loc, Numeral (Bigint.of_string n))
-      | s = string -> CPatPrim (!@loc, String s) ] ]
+	  CAst.make ~loc:!@loc @@ CPatCast (p, ty)
+      | n = INT    -> CAst.make ~loc:!@loc @@ CPatPrim (Numeral (n,true))
+      | s = string -> CAst.make ~loc:!@loc @@ CPatPrim (String s) ] ]
   ;
   impl_ident_tail:
     [ [ "}" -> binder_of_name Implicit
     | nal=LIST1 name; ":"; c=lconstr; "}" ->
-        (fun na -> LocalRawAssum (na::nal,Default Implicit,c))
+        (fun na -> CLocalAssum (na::nal,Default Implicit,c))
     | nal=LIST1 name; "}" ->
-        (fun na -> LocalRawAssum (na::nal,Default Implicit,CHole (Loc.join_loc (fst na) !@loc, Some (Evar_kinds.BinderType (snd na)), IntroAnonymous, None)))
+        (fun na -> CLocalAssum (na::nal,Default Implicit,
+                                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 -> LocalRawAssum ([na],Default Implicit,c))
+	(fun na -> CLocalAssum ([na],Default Implicit,c))
     ] ]
   ;
   fixannot:
@@ -430,7 +437,7 @@ GEXTEND Gram
     ] ]
   ;
   impl_name_head:
-    [ [ id = impl_ident_head -> (!@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 ->
@@ -445,13 +452,13 @@ GEXTEND Gram
        the latter is unique *)
     [ [ (* open binder *)
         id = name; idl = LIST0 name; ":"; c = lconstr ->
-          [LocalRawAssum (id::idl,Default Explicit,c)]
+          [CLocalAssum (id::idl,Default Explicit,c)]
 	(* binders factorized with open binder *)
       | id = name; idl = LIST0 name; bl = binders ->
           binders_of_names (id::idl) @ bl
       | id1 = name; ".."; id2 = name ->
-          [LocalRawAssum ([id1;(!@loc,Name ldots_var);id2],
-	                  Default Explicit,CHole (!@loc, None, IntroAnonymous, None))]
+          [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'
     ] ]
@@ -460,51 +467,53 @@ GEXTEND Gram
     [ [ l = LIST0 binder -> List.flatten l ] ]
   ;
   binder:
-    [ [ id = name -> [LocalRawAssum ([id],Default Explicit,CHole (!@loc, None, IntroAnonymous, None))]
+    [ [ id = name -> [CLocalAssum ([id],Default Explicit, CAst.make ~loc:!@loc @@ CHole (None, IntroAnonymous, None))]
       | bl = closed_binder -> bl ] ]
   ;
   closed_binder:
     [ [ "("; id=name; idl=LIST1 name; ":"; c=lconstr; ")" ->
-          [LocalRawAssum (id::idl,Default Explicit,c)]
+          [CLocalAssum (id::idl,Default Explicit,c)]
       | "("; id=name; ":"; c=lconstr; ")" ->
-          [LocalRawAssum ([id],Default Explicit,c)]
+          [CLocalAssum ([id],Default Explicit,c)]
       | "("; id=name; ":="; c=lconstr; ")" ->
-          [LocalRawDef (id,c)]
+          (match c.CAst.v with
+          | CCast(c, CastConv t) -> [CLocalDef (id,c,Some t)]
+          | _ -> [CLocalDef (id,c,None)])
       | "("; id=name; ":"; t=lconstr; ":="; c=lconstr; ")" ->
-          [LocalRawDef (id,CCast (Loc.merge (constr_loc t) (!@loc),c, CastConv t))]
+          [CLocalDef (id,c,Some t)]
       | "{"; id=name; "}" ->
-          [LocalRawAssum ([id],Default Implicit,CHole (!@loc, None, IntroAnonymous, None))]
+          [CLocalAssum ([id],Default Implicit, CAst.make ~loc:!@loc @@ CHole (None, IntroAnonymous, None))]
       | "{"; id=name; idl=LIST1 name; ":"; c=lconstr; "}" ->
-          [LocalRawAssum (id::idl,Default Implicit,c)]
+          [CLocalAssum (id::idl,Default Implicit,c)]
       | "{"; id=name; ":"; c=lconstr; "}" ->
-          [LocalRawAssum ([id],Default Implicit,c)]
+          [CLocalAssum ([id],Default Implicit,c)]
       | "{"; id=name; idl=LIST1 name; "}" ->
-          List.map (fun id -> LocalRawAssum ([id],Default Implicit,CHole (!@loc, None, IntroAnonymous, None))) (id::idl)
+          List.map (fun id -> CLocalAssum ([id],Default Implicit, CAst.make ~loc:!@loc @@ CHole (None, IntroAnonymous, None))) (id::idl)
       | "`("; tc = LIST1 typeclass_constraint SEP "," ; ")" ->
-	  List.map (fun (n, b, t) -> LocalRawAssum ([n], Generalized (Implicit, Explicit, b), t)) tc
+	  List.map (fun (n, b, t) -> CLocalAssum ([n], Generalized (Implicit, Explicit, b), t)) tc
       | "`{"; tc = LIST1 typeclass_constraint SEP "," ; "}" ->
-	  List.map (fun (n, b, t) -> LocalRawAssum ([n], Generalized (Implicit, Implicit, b), t)) tc
+	  List.map (fun (n, b, t) -> CLocalAssum ([n], Generalized (Implicit, Implicit, b), t)) tc
       | "'"; p = pattern LEVEL "0" ->
           let (p, ty) =
-            match p with
-            | CPatCast (_, p, ty) -> (p, Some ty)
+            match p.CAst.v with
+            | CPatCast (p, ty) -> (p, Some ty)
             | _ -> (p, None)
           in
-          [LocalPattern (!@loc, p, ty)]
+          [CLocalPattern (CAst.make ~loc:!@loc (p, ty))]
     ] ]
   ;
   typeclass_constraint:
-    [ [ "!" ; c = operconstr LEVEL "200" -> (!@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, iid), expl, c
+          (CAst.make ~loc:!@loc iid), expl, c
       | c = operconstr LEVEL "200" ->
-	  (!@loc, Anonymous), false, c
+          (CAst.make ~loc:!@loc Anonymous), false, c
     ] ]
   ;
 
   type_cstr:
-    [ [ c=OPT [":"; c=lconstr -> c] -> (!@loc,c) ] ]
+    [ [ c=OPT [":"; c=lconstr -> c] -> Loc.tag ~loc:!@loc c ] ]
   ;
   END;;
diff --git a/parsing/g_prim.ml4 b/parsing/g_prim.ml4
index b90e06cd..b25ea766 100644
--- a/parsing/g_prim.ml4
+++ b/parsing/g_prim.ml4
@@ -1,15 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Compat
 open Names
 open Libnames
-open Tok (* necessary for camlp4 *)
 
 open Pcoq
 open Pcoq.Prim
@@ -28,13 +28,13 @@ let my_int_of_string loc s =
     if n > 1024 * 2048 then raise Exit;
     n
   with Failure _ | Exit ->
-    CErrors.user_err_loc (loc,"",Pp.str "Cannot support a so large number.")
+    CErrors.user_err ~loc  (Pp.str "Cannot support a so large number.")
 
 GEXTEND Gram
   GLOBAL:
     bigint natural integer identref name ident var preident
     fullyqualid qualid reference dirpath ne_lstring
-    ne_string string pattern_ident pattern_identref by_notation smart_global;
+    ne_string string lstring pattern_ident pattern_identref by_notation smart_global;
   preident:
     [ [ s = IDENT -> s ] ]
   ;
@@ -45,13 +45,13 @@ GEXTEND Gram
     [ [ LEFTQMARK; id = ident -> id ] ]
   ;
   pattern_identref:
-    [ [ id = pattern_ident -> (!@loc, id) ] ]
+    [ [ id = pattern_ident -> CAst.make ~loc:!@loc id ] ]
   ;
   var: (* as identref, but interpret as a term identifier in ltac *)
-    [ [ id = ident -> (!@loc, id) ] ]
+    [ [ id = ident -> CAst.make ~loc:!@loc id ] ]
   ;
   identref:
-    [ [ id = ident -> (!@loc, id) ] ]
+    [ [ id = ident -> CAst.make ~loc:!@loc id ] ]
   ;
   field:
     [ [ s = FIELD -> Id.of_string s ] ]
@@ -62,8 +62,8 @@ GEXTEND Gram
       ] ]
   ;
   fullyqualid:
-    [ [ id = ident; (l,id')=fields -> !@loc,id::List.rev (id'::l)
-      | id = ident -> !@loc,[id]
+    [ [ id = ident; (l,id')=fields -> CAst.make ~loc:!@loc @@ id::List.rev (id'::l)
+      | id = ident -> CAst.make ~loc:!@loc [id]
       ] ]
   ;
   basequalid:
@@ -72,32 +72,32 @@ GEXTEND Gram
       ] ]
   ;
   name:
-    [ [ IDENT "_" -> (!@loc, Anonymous)
-      | id = ident -> (!@loc, Name id) ] ]
+    [ [ IDENT "_"  -> CAst.make ~loc:!@loc Anonymous
+      | id = ident -> CAst.make ~loc:!@loc @@ Name id ] ]
   ;
   reference:
     [ [ id = ident; (l,id') = fields ->
-        Qualid (!@loc, local_make_qualid (l@[id]) id')
-      | id = ident -> Ident (!@loc,id)
+        CAst.make ~loc:!@loc @@ Qualid (local_make_qualid (l@[id]) id')
+      | id = ident -> CAst.make ~loc:!@loc @@ Ident id
       ] ]
   ;
   by_notation:
-    [ [ s = ne_string; sc = OPT ["%"; key = IDENT -> key ] -> (!@loc, s, sc) ] ]
+    [ [ s = ne_string; sc = OPT ["%"; key = IDENT -> key ] -> (s, sc) ] ]
   ;
   smart_global:
-    [ [ c = reference -> Misctypes.AN c
-      | ntn = by_notation -> Misctypes.ByNotation ntn ] ]
+    [ [ c = reference -> CAst.make ~loc:!@loc @@ Misctypes.AN c
+      | ntn = by_notation -> CAst.make ~loc:!@loc @@ Misctypes.ByNotation ntn ] ]
   ;
   qualid:
-    [ [ qid = basequalid -> !@loc, qid ] ]
+    [ [ qid = basequalid -> CAst.make ~loc:!@loc qid ] ]
   ;
   ne_string:
     [ [ s = STRING ->
-        if s="" then CErrors.user_err_loc(!@loc, "", Pp.str"Empty string."); s
+        if s="" then CErrors.user_err ~loc:!@loc (Pp.str"Empty string."); s
     ] ]
   ;
   ne_lstring:
-    [ [ s = ne_string -> (!@loc, s) ] ]
+    [ [ s = ne_string -> CAst.make ~loc:!@loc s ] ]
   ;
   dirpath:
     [ [ id = ident; l = LIST0 field ->
@@ -106,6 +106,9 @@ GEXTEND Gram
   string:
     [ [ s = STRING -> s ] ]
   ;
+  lstring:
+    [ [ s = string -> (CAst.make ~loc:!@loc s) ] ]
+  ;
   integer:
     [ [ i = INT      -> my_int_of_string (!@loc) i
       | "-"; i = INT -> - my_int_of_string (!@loc) i ] ]
@@ -113,7 +116,7 @@ GEXTEND Gram
   natural:
     [ [ i = INT -> my_int_of_string (!@loc) i ] ]
   ;
-  bigint: (* Negative numbers are dealt with specially *)
-    [ [ i = INT -> (Bigint.of_string i) ] ]
+  bigint: (* Negative numbers are dealt with elsewhere *)
+    [ [ i = INT -> i ] ]
   ;
 END
diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4
index 70c5d5d8..e393c2bb 100644
--- a/parsing/g_proofs.ml4
+++ b/parsing/g_proofs.ml4
@@ -1,50 +1,57 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Compat
 open Constrexpr
 open Vernacexpr
 open Misctypes
-open Tok
 
 open Pcoq
-open Pcoq.Tactic
 open Pcoq.Prim
 open Pcoq.Constr
 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"
+
+let warn_deprecated_focus =
+  CWarnings.create ~name:"deprecated-focus" ~category:"deprecated"
+         (fun () ->
+           Pp.strbrk
+             "The Focus command is deprecated; use bullets or focusing brackets instead"
+         )
+
+let warn_deprecated_focus_n n =
+  CWarnings.create ~name:"deprecated-focus" ~category:"deprecated"
+         (fun () ->
+           Pp.(str "The Focus command is deprecated;" ++ spc ()
+               ++ str "use '" ++ int n ++ str ": {' instead")
+         )
+
+let warn_deprecated_unfocus =
+  CWarnings.create ~name:"deprecated-unfocus" ~category:"deprecated"
+         (fun () -> Pp.strbrk "The Unfocus command is deprecated")
 
 (* Proof commands *)
 GEXTEND Gram
-  GLOBAL: command;
+  GLOBAL: hint command;
 
   opt_hintbases:
   [ [ -> []
     | ":"; 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"; "with"; ta = tactic; 
-        l = OPT [ "using"; l = G_vernac.section_subset_expr -> l ] ->
-          VernacProof (Some ta,hint_proof_using G_vernac.section_subset_expr l)
-      | IDENT "Proof"; "using"; l = G_vernac.section_subset_expr;
-        ta = OPT [ "with"; ta = tactic -> ta ] ->
-          VernacProof (ta,Some l)
       | IDENT "Proof"; c = lconstr -> VernacExactProof c
       | IDENT "Abort" -> VernacAbort None
       | IDENT "Abort"; IDENT "All" -> VernacAbortAll
@@ -52,44 +59,37 @@ 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 "Save" -> VernacEndProof (Proved (Opaque None,None))
-      | IDENT "Save"; tok = thm_token; id = identref ->
-	  VernacEndProof (Proved (Opaque None,Some (id,Some tok)))
+      | IDENT "Qed" -> VernacEndProof (Proved (Opaque,None))
       | IDENT "Save"; id = identref ->
-	  VernacEndProof (Proved (Opaque None,Some (id,None)))
+	  VernacEndProof (Proved (Opaque, Some id))
       | IDENT "Defined" -> VernacEndProof (Proved (Transparent,None))
       |	IDENT "Defined"; id=identref ->
-	  VernacEndProof (Proved (Transparent,Some (id,None)))
+	  VernacEndProof (Proved (Transparent,Some id))
       | IDENT "Restart" -> VernacRestart
       | IDENT "Undo" -> VernacUndo 1
       | IDENT "Undo"; n = natural -> VernacUndo n
       | IDENT "Undo"; IDENT "To"; n = natural -> VernacUndoTo n
-      | IDENT "Focus" -> VernacFocus None
-      | IDENT "Focus"; n = natural -> VernacFocus (Some n)
-      | IDENT "Unfocus" -> VernacUnfocus
+      | IDENT "Focus" ->
+         warn_deprecated_focus ~loc:!@loc ();
+         VernacFocus None
+      | IDENT "Focus"; n = natural ->
+         warn_deprecated_focus_n n ~loc:!@loc ();
+         VernacFocus (Some n)
+      | IDENT "Unfocus" ->
+         warn_deprecated_unfocus ~loc:!@loc ();
+         VernacUnfocus
       | IDENT "Unfocused" -> VernacUnfocused
       | IDENT "Show" -> VernacShow (ShowGoal OpenSubgoals)
       | IDENT "Show"; n = natural -> VernacShow (ShowGoal (NthGoal n))
       | IDENT "Show"; id = ident -> VernacShow (ShowGoal (GoalId id))
-      | IDENT "Show"; IDENT "Goal" -> VernacShow (ShowGoal (GoalId (Names.Id.of_string "Goal")))
-      | IDENT "Show"; IDENT "Goal"; n = string ->
-          VernacShow (ShowGoal (GoalUid n))
-      | IDENT "Show"; IDENT "Implicit"; IDENT "Arguments"; n = OPT natural ->
-	  VernacShow (ShowGoalImplicitly n)
-      | IDENT "Show"; IDENT "Node" -> VernacShow ShowNode
       | IDENT "Show"; IDENT "Script" -> VernacShow ShowScript
       | IDENT "Show"; IDENT "Existentials" -> VernacShow ShowExistentials
       | IDENT "Show"; IDENT "Universes" -> VernacShow ShowUniverses
-      | IDENT "Show"; IDENT "Tree" -> VernacShow ShowTree
       | IDENT "Show"; IDENT "Conjectures" -> VernacShow ShowProofNames
       | IDENT "Show"; IDENT "Proof" -> VernacShow ShowProof
       | IDENT "Show"; IDENT "Intro" -> VernacShow (ShowIntros false)
       | IDENT "Show"; IDENT "Intros" -> VernacShow (ShowIntros true)
       | IDENT "Show"; IDENT "Match"; id = reference -> VernacShow (ShowMatch id)
-      | IDENT "Show"; IDENT "Thesis" -> VernacShow ShowThesis
       | IDENT "Guarded" -> VernacCheckGuard
       (* Hints for Auto and EAuto *)
       | IDENT "Create"; IDENT "HintDb" ;
@@ -97,19 +97,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 ] ]
@@ -122,14 +119,11 @@ GEXTEND Gram
       | IDENT "Opaque"; lc = LIST1 global -> HintsTransparency (lc, false)
       | IDENT "Mode"; l = global; m = mode -> HintsMode (l, m)
       | IDENT "Unfold"; lqid = LIST1 global -> HintsUnfold lqid
-      | IDENT "Constructors"; lc = LIST1 global -> HintsConstructors lc
-      | IDENT "Extern"; n = natural; c = OPT constr_pattern ; "=>";
-          tac = tactic ->
-	  HintsExtern (n,c,tac) ] ]
+      | IDENT "Constructors"; lc = LIST1 global -> HintsConstructors lc ] ]
     ;
   constr_body:
     [ [ ":="; c = lconstr -> c
-      | ":"; t = lconstr; ":="; c = lconstr -> CCast(!@loc,c,CastConv t) ] ]
+      | ":"; t = lconstr; ":="; c = lconstr -> CAst.make ~loc:!@loc @@ CCast(c,CastConv t) ] ]
   ;
   mode:
     [ [ l = LIST1 [ "+" -> ModeInput
diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4
index e61be53a..61b1de82 100644
--- a/parsing/g_vernac.ml4
+++ b/parsing/g_vernac.ml4
@@ -1,23 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
-open Compat
 open CErrors
 open Util
 open Names
+open Vernacexpr
 open Constrexpr
 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
@@ -41,7 +43,6 @@ let def_body = Gram.entry_create "vernac:def_body"
 let decl_notation = Gram.entry_create "vernac:decl_notation"
 let record_field = Gram.entry_create "vernac:record_field"
 let of_type_with_opt_coercion = Gram.entry_create "vernac:of_type_with_opt_coercion"
-let subgoal_command = Gram.entry_create "proof_mode:subgoal_command"
 let instance_name = Gram.entry_create "vernac:instance_name"
 let section_subset_expr = Gram.entry_create "vernac:section_subset_expr"
 
@@ -53,53 +54,57 @@ let make_bullet s =
   | '*' -> Star n
   | _ -> assert false
 
+let parse_compat_version ?(allow_old = true) = let open Flags in function
+  | "8.8" -> Current
+  | "8.7" -> V8_7
+  | "8.6" -> V8_6
+  | ("8.5" | "8.4" | "8.3" | "8.2" | "8.1" | "8.0") as s ->
+    CErrors.user_err ~hdr:"get_compat_version"
+      Pp.(str "Compatibility with version " ++ str s ++ str " not supported.")
+  | s ->
+    CErrors.user_err ~hdr:"get_compat_version"
+      Pp.(str "Unknown compatibility version \"" ++ str s ++ str "\".")
+
 GEXTEND Gram
-  GLOBAL: vernac gallina_ext noedit_mode subprf subgoal_command;
-  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 "Finish"; "." -> VernacStm Finish
-      | IDENT "Stm"; IDENT "Wait"; "." -> VernacStm Wait
-      | IDENT "Stm"; IDENT "PrintDag"; "." -> VernacStm PrintDag
-      | IDENT "Stm"; IDENT "Observe"; id = INT; "." ->
-          VernacStm (Observe (Stateid.of_int (int_of_string id)))
-      | IDENT "Stm"; IDENT "Command"; v = vernac_aux -> VernacStm (Command v)
-      | IDENT "Stm"; IDENT "PGLast"; v = vernac_aux -> VernacStm (PGLast v)
+      | 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 = subgoal_command -> c None] ]
+    [ [ c = query_command -> c None] ]
   ;
 
   subprf:
@@ -109,17 +114,8 @@ GEXTEND Gram
     ] ]
   ;
 
-  subgoal_command:
-    [ [ c = query_command; "." ->
-                  begin function
-                    | Some (SelectNth g) -> c (Some g)
-                    | None -> c None
-                    | _ ->
-                        VernacError (UserError ("",str"Typing and evaluation commands, cannot be used with the \"all:\" selector."))
-                  end ] ]
-  ;
   located_vernac:
-    [ [ v = vernac -> !@loc, v ] ]
+    [ [ v = vernac_control -> CAst.make ~loc:!@loc v ] ]
   ;
 END
 
@@ -137,47 +133,57 @@ 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 univ_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,None)) ] ->
-          VernacStartTheoremProof (thm, (Some id,(bl,c,None))::l, false)
+          [ "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 *)
-      | priv = private_token; f = finite_token;
+      | cum = cumulativity_token; priv = private_token; f = finite_token;
         indl = LIST1 inductive_definition SEP "with" ->
 	  let (k,f) = f in
-	  let indl=List.map (fun ((a,b,c,d),e) -> ((a,b,c,k,d),e)) indl in
-          VernacInductive (priv,f,indl)
+          let indl=List.map (fun ((a,b,c,d),e) -> ((a,b,c,k,d),e)) indl in
+	  let cum =
+	    match cum with
+	      Some true -> LocalCumulativity
+            | Some false -> LocalNonCumulativity
+	    | None ->
+                if Flags.is_polymorphic_inductive_cumulativity () then
+                  GlobalCumulativity
+                else
+                  GlobalNonCumulativity
+	  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)
@@ -199,60 +205,82 @@ 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:
-    [ [ "Inductive" -> (Inductive_kw,Finite)
-      | "CoInductive" -> (CoInductive,CoFinite)
-      | "Variant" -> (Variant,BiFinite)
+    [ [ IDENT "Inductive" -> (Inductive_kw,Finite)
+      | IDENT "CoInductive" -> (CoInductive,CoFinite)
+      | IDENT "Variant" -> (Variant,BiFinite)
       | IDENT "Record" -> (Record,BiFinite)
       | IDENT "Structure" -> (Structure,BiFinite)
       | IDENT "Class" -> (Class true,BiFinite) ] ]
   ;
+  cumulativity_token:
+    [ [ IDENT "Cumulative" -> Some true | IDENT "NonCumulative" -> Some false | -> None ] ]
+  ;
   private_token:
     [ [ IDENT "Private" -> true | -> false ] ]
   ;
   (* Simple definitions *)
   def_body:
     [ [ bl = binders; ":="; red = reduce; c = lconstr ->
-      let (bl, c) = expand_pattern_binders mkCLambdaN bl c in
-      (match c with
-          CCast(_,c, CastConv t) -> DefineBody (bl, red, c, Some t)
+      if List.exists (function CLocalPattern _ -> true | _ -> false) bl
+      then
+        (* FIXME: "red" will be applied to types in bl and Cast with remain *)
+        let c = mkCLambdaN ~loc:!@loc bl c in
+	DefineBody ([], red, c, None)
+      else
+        (match c with
+        | { CAst.v = CCast(c, CastConv t) } -> DefineBody (bl, red, c, Some t)
         | _ -> DefineBody (bl, red, c, None))
     | bl = binders; ":"; t = lconstr; ":="; red = reduce; c = lconstr ->
         let ((bl, c), tyo) =
-          if List.exists (function LocalPattern _ -> true | _ -> false) bl
+          if List.exists (function CLocalPattern _ -> true | _ -> false) bl
           then
-            let c = CCast (!@loc, c, CastConv t) in
-            (expand_pattern_binders mkCLambdaN bl c, None)
+            (* FIXME: "red" will be applied to types in bl and Cast with remain *)
+            let c = CAst.make ~loc:!@loc @@ CCast (c, CastConv t) in
+            (([],mkCLambdaN ~loc:!@loc bl c), None)
           else ((bl, c), Some t)
         in
 	DefineBody (bl, red, c, tyo)
@@ -260,7 +288,7 @@ GEXTEND Gram
         ProveBody (bl, t) ] ]
   ;
   reduce:
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in" -> Some r
+    [ [ IDENT "Eval"; r = red_expr; "in" -> Some r
       | -> None ] ]
   ;
   one_decl_notation:
@@ -277,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) ] ]
@@ -303,20 +331,20 @@ 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) ] ]
   ;
   type_cstr:
     [ [ ":"; c=lconstr -> c
-      | -> CHole (!@loc, None, Misctypes.IntroAnonymous, None) ] ]
+      | -> CAst.make ~loc:!@loc @@ CHole (None, Misctypes.IntroAnonymous, None) ] ]
   ;
   (* Inductive schemes *)
   scheme:
@@ -325,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 *)
@@ -340,8 +368,8 @@ GEXTEND Gram
   binder_nodef:
     [ [ b = binder_let ->
       (match b with
-          LocalRawAssum(l,ty) -> (l,ty)
-        | LocalRawDef _ ->
+          CLocalAssum(l,ty) -> (l,ty)
+        | CLocalDef _ ->
             Util.user_err_loc
               (loc,"fix_param",Pp.str"defined binder not allowed here.")) ] ]
   ;
@@ -360,19 +388,19 @@ GEXTEND Gram
   ;
   record_binder_body:
     [ [ l = binders; oc = of_type_with_opt_coercion;
-         t = lconstr -> fun id -> (oc,AssumExpr (id,mkCProdN (!@loc) l t))
+         t = lconstr -> fun id -> (oc,AssumExpr (id,mkCProdN ~loc:!@loc l t))
       | l = binders; oc = of_type_with_opt_coercion;
          t = lconstr; ":="; b = lconstr -> fun id ->
-	   (oc,DefExpr (id,mkCLambdaN (!@loc) l b,Some (mkCProdN (!@loc) l t)))
+	   (oc,DefExpr (id,mkCLambdaN ~loc:!@loc l b,Some (mkCProdN ~loc:!@loc l t)))
       | l = binders; ":="; b = lconstr -> fun id ->
-         match b with
-	 | CCast(_,b, (CastConv t|CastVM t|CastNative t)) ->
-	     (None,DefExpr(id,mkCLambdaN (!@loc) l b,Some (mkCProdN (!@loc) l t)))
+         match b.CAst.v with
+	 | CCast(b', (CastConv t|CastVM t|CastNative t)) ->
+	     (None,DefExpr(id,mkCLambdaN ~loc:!@loc l b',Some (mkCProdN ~loc:!@loc l t)))
          | _ ->
-	     (None,DefExpr(id,mkCLambdaN (!@loc) l b,None)) ] ]
+	     (None,DefExpr(id,mkCLambdaN ~loc:!@loc l b,None)) ] ]
   ;
   record_binder:
-    [ [ id = name -> (None,AssumExpr(id,CHole (!@loc, None, Misctypes.IntroAnonymous, None)))
+    [ [ id = name -> (None,AssumExpr(id, CAst.make ~loc:!@loc @@ CHole (None, Misctypes.IntroAnonymous, None)))
       | id = name; f = record_binder_body -> f id ] ]
   ;
   assum_list:
@@ -382,16 +410,16 @@ 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)) ] ]
   ;
 
   constructor_type:
     [[ l = binders;
       t= [ coe = of_type_with_opt_coercion; c = lconstr ->
-	            fun l id -> (not (Option.is_empty coe),(id,mkCProdN (!@loc) l c))
+	            fun l id -> (not (Option.is_empty coe),(id,mkCProdN ~loc:!@loc l c))
             |  ->
-		 fun l id -> (false,(id,mkCProdN (!@loc) l (CHole (!@loc, None, Misctypes.IntroAnonymous, None)))) ]
+		 fun l id -> (false,(id,mkCProdN ~loc:!@loc l (CAst.make ~loc:!@loc @@ CHole (None, Misctypes.IntroAnonymous, None)))) ]
 	 -> t l
      ]]
 ;
@@ -413,7 +441,7 @@ let only_starredidentrefs =
   Gram.Entry.of_parser "test_only_starredidentrefs"
     (fun strm ->
       let rec aux n =
-      match get_tok (Util.stream_nth n strm) with
+      match Util.stream_nth n strm with
         | KEYWORD "." -> ()
         | KEYWORD ")" -> ()
         | (IDENT _ | KEYWORD "Type" | KEYWORD "*") -> aux (n+1)
@@ -522,25 +550,26 @@ GEXTEND Gram
   (* Module expressions *)
   module_expr:
     [ [ me = module_expr_atom -> me
-      | me1 = module_expr; me2 = module_expr_atom -> CMapply (!@loc,me1,me2)
+      | me1 = module_expr; me2 = module_expr_atom -> CAst.make ~loc:!@loc @@ CMapply (me1,me2)
       ] ]
   ;
   module_expr_atom:
-    [ [ qid = qualid -> CMident qid | "("; me = module_expr; ")" -> me ] ]
+    [ [ qid = qualid -> CAst.make ~loc:!@loc @@ CMident (qid.CAst.v) | "("; me = module_expr; ")" -> me ] ]
   ;
   with_declaration:
-    [ [ "Definition"; fqid = fullyqualid; ":="; c = Constr.lconstr ->
-          CWith_Definition (fqid,c)
+    [ [ "Definition"; fqid = fullyqualid; udecl = OPT univ_decl; ":="; c = Constr.lconstr ->
+          CWith_Definition (fqid,udecl,c)
       | IDENT "Module"; fqid = fullyqualid; ":="; qid = qualid ->
 	  CWith_Module (fqid,qid)
       ] ]
   ;
   module_type:
-    [ [ qid = qualid -> CMident qid
+    [ [ qid = qualid -> CAst.make ~loc:!@loc @@ CMident (qid.CAst.v)
       | "("; mt = module_type; ")" -> mt
-      | mty = module_type; me = module_expr_atom -> CMapply (!@loc,mty,me)
+      | mty = module_type; me = module_expr_atom ->
+          CAst.make ~loc:!@loc @@ CMapply (mty,me)
       | mty = module_type; "with"; decl = with_declaration ->
-          CMwith (!@loc,mty,decl)
+          CAst.make ~loc:!@loc @@ CMwith (mty,decl)
       ] ]
   ;
   (* Proof using *)
@@ -552,8 +581,8 @@ GEXTEND Gram
   starredidentref:
     [ [ i = identref -> SsSingl i
       | i = identref; "*" -> SsFwdClose(SsSingl i)
-      | "Type" -> SsSingl (!@loc, Id.of_string "Type")
-      | "Type"; "*" -> SsFwdClose (SsSingl (!@loc, Id.of_string "Type")) ]]
+      | "Type" -> SsType
+      | "Type"; "*" -> SsFwdClose SsType ]]
   ;
   ssexpr:
     [ "35" 
@@ -580,12 +609,6 @@ let warn_deprecated_implicit_arguments =
   CWarnings.create ~name:"deprecated-implicit-arguments" ~category:"deprecated"
          (fun () -> strbrk "Implicit Arguments is deprecated; use Arguments instead")
 
-let warn_deprecated_arguments_syntax =
-  CWarnings.create ~name:"deprecated-arguments-syntax" ~category:"deprecated"
-         (fun () -> strbrk "The \"/\" and \"!\" modifiers have an effect only "
-                    ++ strbrk "in the first arguments list. The syntax allowing"
-                    ++ strbrk " them to appear in other lists is deprecated.")
-
 (* Extensions: implicits, coercions, etc. *)
 GEXTEND Gram
   GLOBAL: gallina_ext instance_name hint_info;
@@ -601,43 +624,29 @@ GEXTEND Gram
             VernacSetStrategy l
       (* Canonical structure *)
       | IDENT "Canonical"; IDENT "Structure"; qid = global ->
-	  VernacCanonical (AN qid)
+          VernacCanonical CAst.(make ~loc:!@loc @@ AN qid)
       | IDENT "Canonical"; IDENT "Structure"; ntn = by_notation ->
-	  VernacCanonical (ByNotation ntn)
-      | IDENT "Canonical"; IDENT "Structure"; qid = global;
-          d = def_body ->
+          VernacCanonical CAst.(make ~loc:!@loc @@ ByNotation ntn)
+      | IDENT "Canonical"; IDENT "Structure"; qid = global; d = def_body ->
           let s = coerce_reference_to_id qid in
-	  VernacDefinition
-	    ((Some Global,CanonicalStructure),((Loc.ghost,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.ghost,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.ghost,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 (CAst.make ~loc:!@loc @@ AN qid, s, t)
       | IDENT "Coercion"; ntn = by_notation; ":"; s = class_rawexpr; ">->";
          t = class_rawexpr ->
-	  VernacCoercion (false, ByNotation ntn, s, t)
+          VernacCoercion (CAst.make ~loc:!@loc @@ ByNotation ntn, s, t)
 
-      | IDENT "Context"; c = binders ->
-	  VernacContext c
+      | IDENT "Context"; c = LIST1 binder ->
+          VernacContext (List.flatten c)
 
       | IDENT "Instance"; namesup = instance_name; ":";
 	 expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200";
@@ -663,10 +672,7 @@ GEXTEND Gram
         args = LIST0 argument_spec_block;
         more_implicits = OPT
           [ ","; impl = LIST1
-            [ impl = LIST0 more_implicits_block ->
-              let warn_deprecated = List.exists fst impl in
-              if warn_deprecated then warn_deprecated_arguments_syntax ~loc:!@loc ();
-              List.flatten (List.map snd impl)]
+            [ impl = LIST0 more_implicits_block -> List.flatten impl]
             SEP "," -> impl
           ];
         mods = OPT [ ":"; l = LIST1 arguments_modifier SEP "," -> l ] ->
@@ -679,7 +685,7 @@ GEXTEND Gram
               if Option.is_empty !slash_position then
                 (slash_position := Some i; parse_args i args)
               else
-                error "The \"/\" modifier can occur only once"
+                user_err Pp.(str "The \"/\" modifier can occur only once")
          in
          let args = parse_args 0 (List.flatten args) in
          let more_implicits = Option.default [] more_implicits in
@@ -739,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, 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 *)
@@ -752,43 +758,37 @@ 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, y) x
-         | Some _, Some _ -> error "scope declared twice" in
+         | 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;
                  notation_scope=f notation_scope;
                  implicit_status = NotImplicit}) items
     | "["; items = LIST1 argument_spec; "]"; sc = OPT scope ->
        let f x = match sc, x with
-         | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
-         | Some _, Some _ -> error "scope declared twice" in
+         | 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;
                  notation_scope=f notation_scope;
                  implicit_status = Implicit}) items
     | "{"; items = LIST1 argument_spec; "}"; sc = OPT scope ->
        let f x = match sc, x with
-         | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
-         | Some _, Some _ -> error "scope declared twice" in
+         | 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;
                  notation_scope=f notation_scope;
                  implicit_status = MaximallyImplicit}) items
     ]
   ];
-  name_or_bang: [
-       [ b = OPT "!"; id = name ->
-       not (Option.is_empty b), id
-    ]
-  ];
   (* Same as [argument_spec_block], but with only implicit status and names *)
   more_implicits_block: [
-    [ (bang,name) = name_or_bang -> (bang, [(snd name, Vernacexpr.NotImplicit)])
-    | "/" -> (true (* Should warn about deprecated syntax *), [])
-    | "["; items = LIST1 name_or_bang; "]" ->
-       (List.exists fst items, List.map (fun (_,(_,name)) -> (name, Vernacexpr.Implicit)) items)
-    | "{"; items = LIST1 name_or_bang; "}" ->
-       (List.exists fst items, List.map (fun (_,(_,name)) -> (name, Vernacexpr.MaximallyImplicit)) items)
+    [ name = name -> [(name.CAst.v, Vernacexpr.NotImplicit)]
+    | "["; items = LIST1 name; "]" ->
+       List.map (fun name -> (name.CAst.v, Vernacexpr.Implicit)) items
+    | "{"; items = LIST1 name; "}" ->
+       List.map (fun name -> (name.CAst.v, Vernacexpr.MaximallyImplicit)) items
     ]
   ];
   strategy_level:
@@ -799,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, Anonymous), None), []  ] ]
+      | -> ((CAst.make ~loc:!@loc Anonymous), None), []  ] ]
   ;
   hint_info:
     [ [ "|"; i = OPT natural; pat = OPT constr_pattern ->
@@ -822,12 +822,19 @@ GEXTEND Gram
 END
 
 GEXTEND Gram
-  GLOBAL: command query_command class_rawexpr;
+  GLOBAL: command query_command class_rawexpr gallina_ext;
+
+  gallina_ext:
+    [ [ IDENT "Export"; "Set"; table = option_table; v = option_value ->
+        VernacSetOption (true, table, v)
+      | IDENT "Export"; IDENT "Unset"; table = option_table ->
+          VernacUnsetOption (true, table)
+    ] ];
 
   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 ->
@@ -871,7 +878,7 @@ GEXTEND Gram
 
       (* 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 ->
@@ -887,24 +894,9 @@ GEXTEND Gram
 
       (* For acting on parameter tables *)
       | "Set"; table = option_table; v = option_value ->
-        begin match v with
-        | StringValue s ->
-          (* We make a special case for warnings because appending is their
-          natural semantics *)
-          if CString.List.equal table ["Warnings"] then
-            VernacSetAppendOption (table, s)
-          else
-            let (last, prefix) = List.sep_last table in
-            if String.equal last "Append" && not (List.is_empty prefix) then
-              VernacSetAppendOption (prefix, s)
-            else
-              VernacSetOption (table, v)
-        | _ -> VernacSetOption (table, v)
-        end
-      | "Set"; table = option_table ->
-  	  VernacSetOption (table,BoolValue true)
+          VernacSetOption (false, table, v)
       | IDENT "Unset"; table = option_table ->
-  	  VernacUnsetOption table
+          VernacUnsetOption (false, table)
 
       | IDENT "Print"; IDENT "Table"; table = option_table ->
 	  VernacPrintOption table
@@ -929,33 +921,34 @@ GEXTEND Gram
 	  VernacRemoveOption ([table], v) ]] 
   ;
   query_command: (* TODO: rapprocher Eval et Check *)
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in"; c = lconstr ->
+    [ [ IDENT "Eval"; r = red_expr; "in"; c = lconstr; "." ->
           fun g -> VernacCheckMayEval (Some r, g, c)
-      | IDENT "Compute"; c = lconstr ->
+      | IDENT "Compute"; c = lconstr; "." ->
 	  fun g -> VernacCheckMayEval (Some (Genredexpr.CbvVm None), g, c)
-      | IDENT "Check"; c = lconstr ->
+      | 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 "SearchHead"; c = constr_pattern; l = in_or_out_modules ->
+      | 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 ->
+      | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules; "." ->
 	  fun g -> VernacSearch (SearchPattern c,g, l)
-      | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules ->
+      | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules; "." ->
 	  fun g -> VernacSearch (SearchRewrite c,g, l)
-      | IDENT "Search"; s = searchabout_query; l = searchabout_queries ->
+      | IDENT "Search"; s = searchabout_query; l = searchabout_queries; "." ->
 	  let (sl,m) = l in fun g -> VernacSearch (SearchAbout (s::sl),g, m)
       (* compatibility: SearchAbout *)
-      | IDENT "SearchAbout"; s = searchabout_query; l = searchabout_queries ->
+      | IDENT "SearchAbout"; s = searchabout_query; l = searchabout_queries; "." ->
 	  fun g -> let (sl,m) = l in VernacSearch (SearchAbout (s::sl),g, m)
       (* compatibility: SearchAbout with "[ ... ]" *)
       | IDENT "SearchAbout"; "["; sl = LIST1 searchabout_query; "]";
-	  l = in_or_out_modules -> fun g -> VernacSearch (SearchAbout sl,g, l)
+	l = in_or_out_modules; "." ->
+         fun g -> VernacSearch (SearchAbout sl,g, l)
       ] ]
   ;
   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 ->
@@ -963,7 +956,7 @@ GEXTEND Gram
 	  PrintGrammar ent
       | IDENT "LoadPath"; dir = OPT dirpath -> PrintLoadPath dir
       | IDENT "Modules" ->
-          error "Print Modules is obsolete; use Print Libraries instead"
+          user_err Pp.(str "Print Modules is obsolete; use Print Libraries instead")
       | IDENT "Libraries" -> PrintModules
 
       | IDENT "ML"; IDENT "Path" -> PrintMLLoadPath
@@ -1006,11 +999,11 @@ 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)
+    [ [ -> BoolValue true
+      | n  = integer   -> IntValue (Some n)
       | s  = STRING    -> StringValue s ] ]
   ;
   option_ref_value:
@@ -1056,6 +1049,9 @@ GEXTEND Gram
       | -> ([],SearchOutside [])
       ] ]
   ;
+  univ_name_list:
+    [ [  "@{" ; l = LIST0 name; "}" -> l ] ]
+  ;
 END;
 
 GEXTEND Gram
@@ -1078,15 +1074,15 @@ GEXTEND Gram
 
 (* Tactic Debugger *)
       |	IDENT "Debug"; IDENT "On" ->
-          VernacSetOption (["Ltac";"Debug"], BoolValue true)
+          VernacSetOption (false, ["Ltac";"Debug"], BoolValue true)
 
       |	IDENT "Debug"; IDENT "Off" ->
-          VernacSetOption (["Ltac";"Debug"], BoolValue false)
+          VernacSetOption (false, ["Ltac";"Debug"], BoolValue false)
 
 (* registration of a custom reduction *)
 
       | IDENT "Declare"; IDENT "Reduction"; s = IDENT; ":=";
-         r = Tactic.red_expr ->
+         r = red_expr ->
 	   VernacDeclareReduction (s,r)
 
  ] ];
@@ -1099,11 +1095,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)
@@ -1113,33 +1109,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 = ne_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 *)
@@ -1149,12 +1143,9 @@ GEXTEND Gram
     [ [ "("; IDENT "only"; IDENT "parsing"; ")" ->
          Some Flags.Current
       | "("; IDENT "compat"; s = STRING; ")" ->
-         Some (Coqinit.get_compat_version s)
+         Some (parse_compat_version s)
       | -> None ] ]
   ;
-  obsolete_locality:
-    [ [ IDENT "Local" -> true | -> false ] ]
-  ;
   level:
     [ [ IDENT "level"; n = natural -> NumLevel n
       | IDENT "next"; IDENT "level" -> NextLevel ] ]
@@ -1167,15 +1158,17 @@ GEXTEND Gram
       | IDENT "only"; IDENT "printing" -> SetOnlyPrinting
       | IDENT "only"; IDENT "parsing" -> SetOnlyParsing
       | IDENT "compat"; s = STRING ->
-        SetCompatVersion (Coqinit.get_compat_version s)
-      | IDENT "format"; s1 = [s = STRING -> (!@loc,s)];
-                        s2 = OPT [s = STRING -> (!@loc,s)] ->
+        SetCompatVersion (parse_compat_version 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)
     ] ]
   ;
@@ -1183,7 +1176,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 8df519b5..00000000
--- a/parsing/highparsing.mllib
+++ /dev/null
@@ -1,5 +0,0 @@
-G_constr
-G_vernac
-G_prim
-G_proofs
-G_tactic
diff --git a/parsing/parsing.mllib b/parsing/parsing.mllib
index 0e1c79c9..1f29636b 100644
--- a/parsing/parsing.mllib
+++ b/parsing/parsing.mllib
@@ -1,6 +1,9 @@
 Tok
-Compat
 CLexer
 Pcoq
 Egramml
 Egramcoq
+G_constr
+G_vernac
+G_prim
+G_proofs
diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml
index 7dc02190..258c4bb1 100644
--- a/parsing/pcoq.ml
+++ b/parsing/pcoq.ml
@@ -1,46 +1,211 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
-open Compat
 open CErrors
 open Util
 open Extend
 open Genarg
 
+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 = 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;
+    Loc.ep = Ploc.last_pos loc;
+    Loc.line_nb_last = Ploc.line_nb_last loc;
+    Loc.bol_pos_last = Ploc.bol_pos_last loc; }
+
+let (!@) = to_coqloc
+
 (** The parser of Coq *)
+module G : sig
+
+  include Grammar.S with type te = Tok.t
+
+(* where Grammar.S
+
+module type S =
+  sig
+    type te = 'x;
+    type parsable = 'x;
+    value parsable : Stream.t char -> parsable;
+    value tokens : string -> list (string * int);
+    value glexer : Plexing.lexer te;
+    value set_algorithm : parse_algorithm -> unit;
+    module Entry :
+      sig
+        type e 'a = 'y;
+        value create : string -> e 'a;
+        value parse : e 'a -> parsable -> 'a;
+        value parse_token : e 'a -> Stream.t te -> 'a;
+        value name : e 'a -> string;
+        value of_parser : string -> (Stream.t te -> 'a) -> e 'a;
+        value print : Format.formatter -> e 'a -> unit;
+        external obj : e 'a -> Gramext.g_entry te = "%identity";
+      end
+    ;
+    module Unsafe :
+      sig
+        value gram_reinit : Plexing.lexer te -> unit;
+        value clear_entry : Entry.e 'a -> unit;
+      end
+    ;
+    value extend :
+      Entry.e 'a -> option Gramext.position ->
+        list
+          (option string * option Gramext.g_assoc *
+           list (list (Gramext.g_symbol te) * Gramext.g_action)) ->
+        unit;
+    value delete_rule : Entry.e 'a -> list (Gramext.g_symbol te) -> unit;
+  end
+  *)
+
+  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: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
+  val entry_print : Format.formatter -> 'a entry -> unit
+
+  val comment_state : coq_parsable -> ((int * int) * string) list
+
+  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 = struct
+
+  include Grammar.GMake(CLexer)
+
+  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 = parsable * CLexer.lexer_state ref
+
+  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.get_lexer_state ();
+    (a,state)
+
+  let action = Gramext.action
+  let entry_create = Entry.create
+
+  let entry_parse e (p,state) =
+    CLexer.set_lexer_state !state;
+    try
+      let c = Entry.parse e p in
+      state := CLexer.get_lexer_state ();
+      c
+    with Ploc.Exc (loc,e) ->
+      CLexer.drop_lexer_state ();
+      let loc' = Loc.get_loc (Exninfo.info e) in
+      let loc = match loc' with None -> to_coqloc loc | Some loc -> loc in
+      Loc.raise ~loc e
+
+  let comment_state (p,state) =
+    CLexer.get_comment_state !state
+
+  let entry_print ft x = Entry.print ft x
+
+  (* Not used *)
+  let srules' = Gramext.srules
+  let parse_tokens_after_filter = Entry.parse_token
+
+end
 
-module G = GrammarMake (CLexer)
 
-let warning_verbose = Compat.warning_verbose
+let warning_verbose = Gramext.warning_verbose
 
 let of_coq_assoc = function
-| Extend.RightA -> CompatGramext.RightA
-| Extend.LeftA -> CompatGramext.LeftA
-| Extend.NonA -> CompatGramext.NonA
+| Extend.RightA -> Gramext.RightA
+| Extend.LeftA -> Gramext.LeftA
+| Extend.NonA -> Gramext.NonA
 
 let of_coq_position = function
-| Extend.First -> CompatGramext.First
-| Extend.Last -> CompatGramext.Last
-| Extend.Before s -> CompatGramext.Before s
-| Extend.After s -> CompatGramext.After s
-| Extend.Level s -> CompatGramext.Level s
+| Extend.First -> Gramext.First
+| Extend.Last -> Gramext.Last
+| Extend.Before s -> Gramext.Before s
+| Extend.After s -> Gramext.After s
+| Extend.Level s -> Gramext.Level s
+
+module Symbols : sig
+  val stoken : Tok.t -> G.symbol
+  val sself : G.symbol
+  val snext : G.symbol
+  val slist0 : G.symbol -> G.symbol
+  val slist0sep : G.symbol * G.symbol -> G.symbol
+  val slist1 : G.symbol -> G.symbol
+  val slist1sep : G.symbol * G.symbol -> G.symbol
+  val sopt : G.symbol -> G.symbol
+  val snterml : G.internal_entry * string -> G.symbol
+  val snterm : G.internal_entry -> G.symbol
+end = struct
+
+  let stoken tok =
+    let pattern = match tok with
+    | Tok.KEYWORD s -> "", s
+    | Tok.IDENT s -> "IDENT", s
+    | Tok.PATTERNIDENT s -> "PATTERNIDENT", s
+    | Tok.FIELD s -> "FIELD", s
+    | Tok.INT s -> "INT", s
+    | Tok.STRING s -> "STRING", s
+    | Tok.LEFTQMARK -> "LEFTQMARK", ""
+    | Tok.BULLET s -> "BULLET", s
+    | Tok.EOI -> "EOI", ""
+    in
+    Gramext.Stoken pattern
 
-module Symbols = GramextMake(G)
+     let slist0sep (x, y) = Gramext.Slist0sep (x, y, false)
+     let slist1sep (x, y) = Gramext.Slist1sep (x, y, false)
 
-let camlp4_verbosity silent f x =
+  let snterml (x, y) = Gramext.Snterml (x, y)
+  let snterm x = Gramext.Snterm x
+  let sself = Gramext.Sself
+  let snext = Gramext.Snext
+  let slist0 x = Gramext.Slist0 x
+  let slist1 x = Gramext.Slist1 x
+  let sopt x = Gramext.Sopt x
+
+end
+
+let camlp5_verbosity silent f x =
   let a = !warning_verbose in
   warning_verbose := silent;
   f x;
   warning_verbose := a
 
-let camlp4_verbose f x = camlp4_verbosity (Flags.is_verbose ()) f x
-
 (** Grammar extensions *)
 
 (** NB: [extend_statment =
@@ -55,7 +220,7 @@ let camlp4_verbose f x = camlp4_verbosity (Flags.is_verbose ()) f x
 (** Binding general entry keys to symbol *)
 
 let rec of_coq_action : type a r. (r, a, Loc.t -> r) Extend.rule -> a -> G.action = function
-| Stop -> fun f -> G.action (fun loc -> f (to_coqloc loc))
+| Stop -> fun f -> G.action (fun loc -> f (!@ loc))
 | Next (r, _) -> fun f -> G.action (fun x -> of_coq_action r (f x))
 
 let rec symbol_of_prod_entry_key : type s a. (s, a) symbol -> _ = function
@@ -107,7 +272,7 @@ type ext_kind =
 
 (** The list of extensions *)
 
-let camlp4_state = ref []
+let camlp5_state = ref []
 
 (** Deletion *)
 
@@ -121,10 +286,10 @@ let grammar_delete e reinit (pos,rls) =
     let a = of_coq_assoc a in
     let ext = of_coq_position ext in
     let lev = match pos with
-    | Some (CompatGramext.Level n) -> n
+    | Some (Gramext.Level n) -> n
     | _ -> assert false
     in
-    maybe_uncurry (G.extend e) (Some ext, [Some lev,Some a,[]])
+    (G.extend e) (Some ext) [Some lev,Some a,[]]
   | None -> ()
 
 (** Extension *)
@@ -132,13 +297,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 (maybe_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 (maybe_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. *)
@@ -147,21 +312,21 @@ module Gram =
   struct
     include G
     let extend e =
-      maybe_curry
-	(fun ext ->
-	   camlp4_state :=
-	     (ByEXTEND ((fun () -> grammar_delete e None ext),
-			(fun () -> maybe_uncurry (G.extend e) ext)))
-	   :: !camlp4_state;
-	   maybe_uncurry (G.extend e) ext)
+      curry
+    (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
@@ -173,18 +338,18 @@ module Gram =
 
 let rec remove_grammars n =
   if n>0 then
-    (match !camlp4_state with
-       | [] -> anomaly ~label:"Pcoq.remove_grammars" (Pp.str "too many rules to remove")
+    (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]
 
@@ -194,14 +359,14 @@ let eoi_entry en =
   let e = Gram.entry_create ((Gram.Entry.name en) ^ "_eoi") in
   let symbs = [Symbols.snterm (Gram.Entry.obj en); Symbols.stoken Tok.EOI] in
   let act = Gram.action (fun _ x loc -> x) in
-  maybe_uncurry (Gram.extend e) (None, make_rule [symbs, act]);
+  uncurry (Gram.extend e) (None, make_rule [symbs, act]);
   e
 
 let map_entry f en =
   let e = Gram.entry_create ((Gram.Entry.name en) ^ "_map") in
   let symbs = [Symbols.snterm (Gram.Entry.obj en)] in
   let act = Gram.action (fun x loc -> f x) in
-  maybe_uncurry (Gram.extend e) (None, make_rule [symbs, act]);
+  uncurry (Gram.extend e) (None, make_rule [symbs, act]);
   e
 
 (* Parse a string, does NOT check if the entire string was read
@@ -267,6 +432,7 @@ module Prim =
     let integer = gec_gen "integer"
     let bigint = Gram.entry_create "Prim.bigint"
     let string = gec_gen "string"
+    let lstring = Gram.entry_create "Prim.lstring"
     let reference = make_gen_entry uprim "reference"
     let by_notation = Gram.entry_create "by_notation"
     let smart_global = Gram.entry_create "smart_global"
@@ -276,7 +442,8 @@ module Prim =
 
     let name = Gram.entry_create "Prim.name"
     let identref = Gram.entry_create "Prim.identref"
-    let pidentref = Gram.entry_create "Prim.pidentref"
+    let univ_decl = Gram.entry_create "Prim.univ_decl"
+    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"
 
@@ -306,6 +473,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"
@@ -325,48 +493,6 @@ module Module =
     let module_type = Gram.entry_create "module_type"
   end
 
-module Tactic =
-  struct
-    (* Main entry for extensions *)
-    let simple_tactic = Gram.entry_create "tactic:simple_tactic"
-
-    (* Entries that can be referred via the string -> Gram.entry table *)
-    (* Typically for tactic user extensions *)
-    let open_constr =
-      make_gen_entry utactic "open_constr"
-    let constr_with_bindings =
-      make_gen_entry utactic "constr_with_bindings"
-    let bindings =
-      make_gen_entry utactic "bindings"
-    let hypident = Gram.entry_create "hypident"
-    let constr_may_eval = make_gen_entry utactic "constr_may_eval"
-    let constr_eval = make_gen_entry utactic "constr_eval"
-    let uconstr =
-      make_gen_entry utactic "uconstr"
-    let quantified_hypothesis =
-      make_gen_entry utactic "quantified_hypothesis"
-    let destruction_arg = make_gen_entry utactic "destruction_arg"
-    let int_or_var = make_gen_entry utactic "int_or_var"
-    let red_expr = make_gen_entry utactic "red_expr"
-    let simple_intropattern =
-      make_gen_entry utactic "simple_intropattern"
-    let in_clause = make_gen_entry utactic "in_clause"
-    let clause_dft_concl = 
-      make_gen_entry utactic "clause"
-
-
-    (* Main entries for ltac *)
-    let tactic_arg = Gram.entry_create "tactic:tactic_arg"
-    let tactic_expr = make_gen_entry utactic "tactic_expr"
-    let binder_tactic = make_gen_entry utactic "binder_tactic"
-
-    let tactic = make_gen_entry utactic "tactic"
-
-    (* Main entry for quotations *)
-    let tactic_eoi = eoi_entry tactic
-
-  end
-
 module Vernac_ =
   struct
     let gec_vernac s = Gram.entry_create ("vernac:" ^ s)
@@ -376,22 +502,22 @@ 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"
     (* Main vernac entry *)
     let main_entry = Gram.entry_create "vernac"
     let noedit_mode = gec_vernac "noedit_command"
 
     let () =
-      let act_vernac = Gram.action (fun v loc -> Some (!@loc, v)) in
+      let act_vernac = Gram.action (fun v loc -> Some (to_coqloc loc, v)) in
       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
-      maybe_uncurry (Gram.extend main_entry) (None, make_rule rule)
+      uncurry (Gram.extend main_entry) (None, make_rule rule)
 
     let command_entry_ref = ref noedit_mode
     let command_entry =
@@ -409,16 +535,16 @@ let epsilon_value f e =
   let r = Rule (Next (Stop, e), fun x _ -> f x) in
   let ext = of_coq_extend_statement (None, [None, None, [r]]) in
   let entry = G.entry_create "epsilon" in
-  let () = maybe_uncurry (G.extend entry) ext in
+  let () = uncurry (G.extend entry) ext in
   try Some (parse_string entry "") with _ -> None
 
 (** 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)
 
@@ -458,9 +584,9 @@ let extend_dyn_grammar (GrammarCommand.Dyn (tag, g)) = extend_grammar_command ta
 (* Summary functions: the state of the lexer is included in that of the parser.
    Because the grammar affects the set of keywords when adding or removing
    grammar rules. *)
-type frozen_t = (int * GrammarCommand.t * GramState.t) list * CLexer.frozen_t
+type frozen_t = (int * GrammarCommand.t * GramState.t) list * CLexer.keyword_state
 
-let freeze _ : frozen_t = (!grammar_stack, CLexer.freeze ())
+let freeze _ : frozen_t = (!grammar_stack, CLexer.get_keyword_state ())
 
 (* We compare the current state of the grammar and the state to unfreeze,
    by computing the longest common suffixes *)
@@ -475,7 +601,7 @@ let unfreeze (grams, lex) =
   let n = number_of_entries undo in
   remove_grammars n;
   grammar_stack := common;
-  CLexer.unfreeze lex;
+  CLexer.set_keyword_state lex;
   List.iter extend_dyn_grammar (List.rev_map pi2 redo)
 
 (** No need to provide an init function : the grammar state is
@@ -483,8 +609,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 }
@@ -501,27 +627,25 @@ let with_grammar_rule_protection f x =
 
 let () =
   let open Stdarg in
-  let open Constrarg in
-(*   Grammar.register0 wit_unit; *)
-(*   Grammar.register0 wit_bool; *)
   Grammar.register0 wit_int (Prim.integer);
   Grammar.register0 wit_string (Prim.string);
   Grammar.register0 wit_pre_ident (Prim.preident);
-  Grammar.register0 wit_int_or_var (Tactic.int_or_var);
-  Grammar.register0 wit_intro_pattern (Tactic.simple_intropattern);
   Grammar.register0 wit_ident (Prim.ident);
   Grammar.register0 wit_var (Prim.var);
   Grammar.register0 wit_ref (Prim.reference);
-  Grammar.register0 wit_quant_hyp (Tactic.quantified_hypothesis);
+  Grammar.register0 wit_sort_family (Constr.sort_family);
   Grammar.register0 wit_constr (Constr.constr);
-  Grammar.register0 wit_uconstr (Tactic.uconstr);
-  Grammar.register0 wit_open_constr (Tactic.open_constr);
-  Grammar.register0 wit_constr_with_bindings (Tactic.constr_with_bindings);
-  Grammar.register0 wit_bindings (Tactic.bindings);
-(*   Grammar.register0 wit_hyp_location_flag; *)
-  Grammar.register0 wit_red_expr (Tactic.red_expr);
-  Grammar.register0 wit_tactic (Tactic.tactic);
-  Grammar.register0 wit_ltac (Tactic.tactic);
-  Grammar.register0 wit_clause_dft_concl (Tactic.clause_dft_concl);
-  Grammar.register0 wit_destruction_arg (Tactic.destruction_arg);
+  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 37165f6c..9f186224 100644
--- a/parsing/pcoq.mli
+++ b/parsing/pcoq.mli
@@ -1,25 +1,93 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Loc
 open Names
 open Extend
 open Vernacexpr
 open Genarg
 open Constrexpr
-open Tacexpr
 open Libnames
 open Misctypes
 open Genredexpr
 
 (** The parser of Coq *)
 
-module Gram : module type of Compat.GrammarMake(CLexer)
+module Gram : sig
+
+  include Grammar.S with type te = Tok.t
+
+(* Where Grammar.S is
+
+module type S =
+  sig
+    type te = 'x;
+    type parsable = 'x;
+    value parsable : Stream.t char -> parsable;
+    value tokens : string -> list (string * int);
+    value glexer : Plexing.lexer te;
+    value set_algorithm : parse_algorithm -> unit;
+    module Entry :
+      sig
+        type e 'a = 'y;
+        value create : string -> e 'a;
+        value parse : e 'a -> parsable -> 'a;
+        value parse_token : e 'a -> Stream.t te -> 'a;
+        value name : e 'a -> string;
+        value of_parser : string -> (Stream.t te -> 'a) -> e 'a;
+        value print : Format.formatter -> e 'a -> unit;
+        external obj : e 'a -> Gramext.g_entry te = "%identity";
+      end
+    ;
+    module Unsafe :
+      sig
+        value gram_reinit : Plexing.lexer te -> unit;
+        value clear_entry : Entry.e 'a -> unit;
+      end
+    ;
+    value extend :
+      Entry.e 'a -> option Gramext.position ->
+        list
+          (option string * option Gramext.g_assoc *
+           list (list (Gramext.g_symbol te) * Gramext.g_action)) ->
+        unit;
+    value delete_rule : Entry.e 'a -> list (Gramext.g_symbol te) -> unit;
+  end
+
+*)
+
+  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: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
+  val entry_print : Format.formatter -> 'a entry -> unit
+
+  (* Get comment parsing information from the Lexer *)
+  val comment_state : coq_parsable -> ((int * int) * string) list
+
+  (* 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
 
 (** The parser of Coq is built from three kinds of rule declarations:
 
@@ -59,7 +127,7 @@ module Gram : module type of Compat.GrammarMake(CLexer)
         |
         | 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:
@@ -96,9 +164,9 @@ module Gram : module type of Compat.GrammarMake(CLexer)
 
 *)
 
-(** 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 *)
 
@@ -127,25 +195,27 @@ 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 univ_decl : universe_decl_expr 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 : Bigint.bigint Gram.entry
+    val bigint : Constrexpr.raw_natural_number Gram.entry
     val integer : int Gram.entry
     val string : string Gram.entry
-    val qualid : qualid located Gram.entry
-    val fullyqualid : Id.t list located Gram.entry
+    val lstring : lstring Gram.entry
+    val qualid : qualid CAst.t Gram.entry
+    val fullyqualid : Id.t list CAst.t Gram.entry
     val reference : reference Gram.entry
-    val by_notation : (Loc.t * string * string option) Gram.entry
+    val by_notation : (string * string option) 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
+    val ne_lstring : lstring Gram.entry
+    val var : lident Gram.entry
   end
 
 module Constr :
@@ -159,17 +229,18 @@ 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
-    val closed_binder : local_binder list Gram.entry
-    val binder : local_binder list Gram.entry (* closed_binder or variable *)
-    val binders : local_binder list Gram.entry (* list of binder *)
-    val open_binders : local_binder list Gram.entry
-    val binders_fixannot : (local_binder list * (Id.t located option * recursion_order_expr)) Gram.entry
-    val typeclass_constraint : (Name.t located * bool * 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 * (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 :
@@ -178,46 +249,22 @@ module Module :
     val module_type : module_ast Gram.entry
   end
 
-module Tactic :
-  sig
-    val open_constr : constr_expr Gram.entry
-    val constr_with_bindings : constr_expr with_bindings Gram.entry
-    val bindings : constr_expr bindings Gram.entry
-    val hypident : (Id.t located * Locus.hyp_location_flag) Gram.entry
-    val constr_may_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
-    val constr_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
-    val uconstr : constr_expr Gram.entry
-    val quantified_hypothesis : quantified_hypothesis Gram.entry
-    val destruction_arg : constr_expr with_bindings destruction_arg Gram.entry
-    val int_or_var : int or_var Gram.entry
-    val red_expr : raw_red_expr Gram.entry
-    val simple_tactic : raw_tactic_expr Gram.entry
-    val simple_intropattern : constr_expr intro_pattern_expr located Gram.entry
-    val in_clause : Names.Id.t Loc.located Locus.clause_expr Gram.entry
-    val clause_dft_concl : Names.Id.t Loc.located Locus.clause_expr Gram.entry
-    val tactic_arg : raw_tactic_arg Gram.entry
-    val tactic_expr : raw_tactic_expr Gram.entry
-    val binder_tactic : raw_tactic_expr Gram.entry
-    val tactic : raw_tactic_expr Gram.entry
-    val tactic_eoi : raw_tactic_expr Gram.entry
-  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 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
     val hint_info : Vernacexpr.hint_info_expr Gram.entry
   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
@@ -265,3 +312,17 @@ val recover_grammar_command : 'a grammar_command -> 'a list
 (** Recover the current stack of grammar extensions. *)
 
 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 f4b60aee..91b4f25b 100644
--- a/parsing/tok.ml
+++ b/parsing/tok.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The type of token for the Coq lexer and parser *)
@@ -60,7 +62,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 b9286c53..9b8c0085 100644
--- a/parsing/tok.mli
+++ b/parsing/tok.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The type of token for the Coq lexer and parser *)
@@ -22,7 +24,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/.merlin b/plugins/.merlin
new file mode 100644
index 00000000..2ba61696
--- /dev/null
+++ b/plugins/.merlin
@@ -0,0 +1 @@
+REC
diff --git a/plugins/btauto/g_btauto.ml4 b/plugins/btauto/g_btauto.ml4
index f3e2c99f..3ae0f45c 100644
--- a/plugins/btauto/g_btauto.ml4
+++ b/plugins/btauto/g_btauto.ml4
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*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 6e8b2eb0..a09abfa1 100644
--- a/plugins/btauto/refl_btauto.ml
+++ b/plugins/btauto/refl_btauto.ml
@@ -1,5 +1,3 @@
-open Proofview.Notations
-
 let contrib_name = "btauto"
 
 let init_constant dir s =
@@ -8,18 +6,18 @@ let init_constant dir s =
   in
   find_constant contrib_name dir s
 
-let get_constant dir s = lazy (Coqlib.gen_constant contrib_name dir s)
+let get_constant dir s = lazy (Universes.constr_of_global @@ Coqlib.coq_reference contrib_name dir s)
 
 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 (c : Term.constr) =
-  Term.kind_of_term (Term.strip_outer_cast 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"]
@@ -55,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 -> 
@@ -105,7 +97,7 @@ module Bool = struct
   | Negb of t
   | Ifb of t * t * t
 
-  let quote (env : Env.t) (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
@@ -113,7 +105,7 @@ module Bool = struct
     let xorb = Lazy.force xorb in
     let negb = Lazy.force negb in
 
-    let rec aux c = match decomp_term c with
+    let rec aux c = match decomp_term sigma c with
     | Term.App (head, args) ->
       if head === andb && Array.length args = 2 then
         Andb (aux args.(0), aux args.(1))
@@ -172,16 +164,18 @@ 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|]
 
   let print_counterexample p env gl =
     let var = lapp witness [|p|] in
+    let var = EConstr.of_constr var in
     (* Compute an assignment that dissatisfies the goal *)
     let _, var = Tacmach.pf_reduction_of_red_expr gl (Genredexpr.CbvVm None) var in
-    let rec to_list l = match decomp_term l with
+    let var = EConstr.Unsafe.to_constr var in
+    let rec to_list l = match decomp_term (Tacmach.project gl) l with
     | Term.App (c, _)
       when c === (Lazy.force CoqList._nil) -> []
     | Term.App (c, [|_; h; 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
@@ -217,10 +212,11 @@ module Btauto = struct
     Tacticals.tclFAIL 0 msg gl
 
   let try_unification env =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.nf_enter begin fun gl ->
       let concl = Proofview.Goal.concl gl in
       let eq = Lazy.force eq in
-      let t = decomp_term concl in
+      let concl = EConstr.Unsafe.to_constr concl in
+      let t = decomp_term (Tacmach.New.project gl) concl in
       match t with
       | Term.App (c, [|typ; p; _|]) when c === eq ->
       (* should be an equality [@eq poly ?p (Cst false)] *)
@@ -229,33 +225,36 @@ module Btauto = struct
       | _ ->
           let msg = str "Btauto: Internal error" in
           Tacticals.New.tclFAIL 0 msg
-    end }
+    end
 
   let tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.nf_enter begin fun gl ->
       let concl = Proofview.Goal.concl gl in
+      let concl = EConstr.Unsafe.to_constr concl in
+      let sigma = Tacmach.New.project gl in
       let eq = Lazy.force eq in
       let bool = Lazy.force Bool.typ in
-      let t = decomp_term concl in
+      let t = decomp_term sigma concl in
       match t with
       | Term.App (c, [|typ; tl; tr|])
           when typ === bool && c === eq ->
           let env = Env.empty () in
-          let fl = Bool.quote env tl in
-          let fr = Bool.quote env tr in
+          let fl = Bool.quote env sigma tl in
+          let fr = Bool.quote env sigma tr in
           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;
-            Tactics.apply (Lazy.force soundness);
+            Tactics.apply (EConstr.of_constr (Lazy.force soundness));
             Tactics.normalise_vm_in_concl;
             try_unification env
           ]
       | _ ->
           let msg = str "Cannot recognize a boolean equality" in
           Tacticals.New.tclFAIL 0 msg
-    end }
+    end
 
 end
diff --git a/plugins/btauto/vo.itarget b/plugins/btauto/vo.itarget
deleted file mode 100644
index 1f72d3ef..00000000
--- a/plugins/btauto/vo.itarget
+++ /dev/null
@@ -1,3 +0,0 @@
-Algebra.vo
-Reflect.vo
-Btauto.vo
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index bc53b113..8e53a044 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -1,24 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file implements the basic congruence-closure algorithm by *)
-(* Downey,Sethi and Tarjan. *)
+(* Downey, Sethi and Tarjan. *)
 (* 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 Goptions
 open Tacmach
-open Evd
+open Util
 
 let init_size=5
 
@@ -29,8 +31,7 @@ let debug x =
 
 let _=
   let gdopt=
-    { optsync=true;
-      optdepr=false;
+    { optdepr=false;
       optname="Congruence Verbose";
       optkey=["Congruence";"Verbose"];
       optread=(fun ()-> !cc_verbose);
@@ -62,7 +63,7 @@ module ST=struct
 
   let enter t sign st=
     if IntPairTable.mem st.toterm sign then
-	anomaly ~label:"enter" (Pp.str "signature already entered")
+	anomaly ~label:"enter" (Pp.str "signature already entered.")
     else
 	IntPairTable.replace st.toterm sign t;
 	IntTable.replace st.tosign t sign
@@ -136,7 +137,7 @@ let family_eq f1 f2 = match f1, f2 with
 
 type term=
     Symb of constr
-  | Product of sorts * sorts
+  | Product of Sorts.t * Sorts.t
   | Eps of Id.t
   | Appli of term*term
   | Constructor of cinfo (* constructor arity + nhyps *)
@@ -155,7 +156,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)
@@ -216,7 +217,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
@@ -233,7 +234,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
 
@@ -270,7 +271,8 @@ type state =
      mutable rew_depth:int;
      mutable changed:bool;
      by_type: Int.Set.t Typehash.t;
-     mutable gls:Proof_type.goal Tacmach.sigma}
+     mutable env:Environ.env;
+     sigma:Evd.evar_map}
 
 let dummy_node =
   {
@@ -305,7 +307,8 @@ let empty depth gls:state =
     rew_depth=depth;
     by_type=Constrhash.create init_size;
     changed=false;
-    gls=gls
+    env=pf_env gls;
+    sigma=project gls
   }
     
 let forest state = state.uf
@@ -322,7 +325,7 @@ let find uf i= find_aux uf [] i
 let get_representative uf i=
   match uf.map.(i).clas with
       Rep r -> r
-    | _ -> anomaly ~label:"get_representative" (Pp.str "not a representative")
+    | _ -> anomaly ~label:"get_representative" (Pp.str "not a representative.")
 
 let get_constructors uf i= uf.map.(i).constructors
 
@@ -340,7 +343,7 @@ let rec find_oldest_pac uf i pac=
 let get_constructor_info uf i=
   match uf.map.(i).term with
       Constructor cinfo->cinfo
-    | _ -> anomaly ~label:"get_constructor" (Pp.str "not a constructor")
+    | _ -> anomaly ~label:"get_constructor" (Pp.str "not a constructor.")
 
 let size uf i=
   (get_representative uf i).weight
@@ -385,7 +388,7 @@ let term uf i=uf.map.(i).term
 let subterms uf i=
   match uf.map.(i).vertex with
       Node(j,k) -> (j,k)
-    | _ -> anomaly ~label:"subterms" (Pp.str "not a node")
+    | _ -> anomaly ~label:"subterms" (Pp.str "not a node.")
 
 let signature uf i=
   let j,k=subterms uf i in (find uf j,find uf k)
@@ -424,7 +427,7 @@ let cc_product s1 s2 =
 	   mkLambda(_B_,mkSort(s2),_body_))
 
 let rec constr_of_term = function
-    Symb s-> applist_projection s []
+    Symb s-> s
   | Product(s1,s2) -> cc_product s1 s2
   | Eps id -> mkVar id
   | Constructor cinfo -> mkConstructU cinfo.ci_constr
@@ -432,37 +435,20 @@ let rec constr_of_term = function
       make_app [(constr_of_term s2)] s1
 and make_app l=function
     Appli (s1,s2)->make_app ((constr_of_term s2)::l) s1
-  | other -> 
-    applist_proj other l
-and applist_proj c l =
-  match c with
-  | Symb s -> applist_projection s l
-  | _ -> applistc (constr_of_term c) l
-and applist_projection c l =
-  match kind_of_term c with
-  | Const c when Environ.is_projection (fst c) (Global.env()) ->
-    let p = Projection.make (fst c) false in
-    (match l with 
-    | [] -> (* Expand the projection *)
-      let ty,_ = Typeops.type_of_constant (Global.env ()) c in
-      let 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
-    | hd :: tl ->
-      applistc (mkProj (p, hd)) tl)
-  | _ -> applistc c l
-
-let rec canonize_name c =
-  let func =  canonize_name in
-    match kind_of_term c with
+  | other -> Term.applist (constr_of_term other,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 Constr.kind c with
       | Const (kn,u) ->
-	  let canon_const = constant_of_kn (canonical_con kn) in 
+	  let canon_const = Constant.make1 (Constant.canonical kn) in 
 	    (mkConstU (canon_const,u))
       | Ind ((kn,i),u) ->
-	  let canon_mind = mind_of_kn (canonical_mind kn) in
+	  let canon_mind = MutInd.make1 (MutInd.canonical kn) in
 	    (mkIndU ((canon_mind,i),u))
       | Construct (((kn,i),j),u) ->
-	  let canon_mind = mind_of_kn (canonical_mind kn) in
+	  let canon_mind = MutInd.make1 (MutInd.canonical kn) in
 	    mkConstructU (((canon_mind,i),j),u)
       | Prod (na,t,ct) ->
 	  mkProd (na,func t, func ct)
@@ -474,7 +460,7 @@ let rec canonize_name c =
 	  mkApp (func ct,Array.smartmap func l)
       | Proj(p,c) ->
 	let p' = Projection.map (fun kn ->
-          constant_of_kn (canonical_con kn)) p in 
+          Constant.make1 (Constant.canonical kn)) p in 
 	  (mkProj (p', func c))
       | _ -> c
 
@@ -485,7 +471,7 @@ let build_subst uf subst =
     (fun i ->
       try term uf i
       with e when CErrors.noncritical e ->
-        anomaly (Pp.str "incomplete matching"))
+        anomaly (Pp.str "incomplete matching."))
     subst
 
 let rec inst_pattern subst = function
@@ -497,10 +483,10 @@ let rec inst_pattern subst = function
 	   args t
 
 let pr_idx_term uf i = str "[" ++ int i ++ str ":=" ++
-  Termops.print_constr (constr_of_term (term uf i)) ++ str "]"
+  Termops.print_constr (EConstr.of_constr (constr_of_term (term uf i))) ++ str "]"
 
 let pr_term t = str "[" ++
-  Termops.print_constr (constr_of_term t) ++ str "]"
+  Termops.print_constr (EConstr.of_constr (constr_of_term t)) ++ str "]"
 
 let rec add_term state t=
   let uf=state.uf in
@@ -508,8 +494,8 @@ let rec add_term state t=
 	Not_found ->
 	  let b=next uf in
           let trm = constr_of_term t in
-	  let typ = pf_unsafe_type_of state.gls trm in
-	  let typ = canonize_name typ in
+          let typ = Typing.unsafe_type_of state.env state.sigma (EConstr.of_constr trm) in
+          let typ = canonize_name state.sigma typ in
 	  let new_node=
 	    match t with
 		Symb _ | Product (_,_) ->
@@ -615,7 +601,7 @@ let add_inst state (inst,int_subst) =
 	      begin
 		debug (fun () ->
 		   (str "Adding new equality, depth="++ int state.rew_depth) ++ fnl () ++
-	          (str "  [" ++ Termops.print_constr prf ++ str " : " ++
+	          (str "  [" ++ Termops.print_constr (EConstr.of_constr prf) ++ str " : " ++
 			   pr_term s ++ str " == " ++ pr_term t ++ str "]"));
 		add_equality state prf s t
 	      end
@@ -623,7 +609,7 @@ let add_inst state (inst,int_subst) =
 	      begin
 		debug (fun () ->
 		   (str "Adding new disequality, depth="++ int state.rew_depth) ++ fnl () ++
-	          (str "  [" ++ Termops.print_constr prf ++ str " : " ++
+	          (str "  [" ++ Termops.print_constr (EConstr.of_constr prf) ++ str " : " ++
 			   pr_term s ++ str " <> " ++ pr_term t ++ str "]"));
 		add_disequality state (Hyp prf) s t
 	      end
@@ -750,7 +736,7 @@ let process_constructor_mark t i rep pac state =
 			state.combine;
 		      f (n-1) q1 q2
 		  | _-> anomaly ~label:"add_pacs"
-		      (Pp.str "weird error in injection subterms merge")
+		      (Pp.str "weird error in injection subterms merge.")
 	    in f cinfo.ci_nhyps opac.args pac.args
       | Partial_applied | Partial _ ->
 (*	  add_pac state.uf.map.(i) pac t; *)
@@ -817,11 +803,10 @@ let one_step state =
 let __eps__ = Id.of_string "_eps_"
 
 let new_state_var typ state =
-  let id = pf_get_new_id __eps__ state.gls in
-  let {it=gl ; sigma=sigma} = state.gls in
-  let gls = Goal.V82.new_goal_with sigma gl [Context.Named.Declaration.LocalAssum (id,typ)] in
-    state.gls<- gls;
-    id
+  let ids = Environ.ids_of_named_context_val (Environ.named_context_val state.env) in
+  let id = Namegen.next_ident_away __eps__ ids in
+  state.env<- EConstr.push_named (Context.Named.Declaration.LocalAssum (id,typ)) state.env;
+  id
 
 let complete_one_class state i=
   match (get_representative state.uf i).inductive_status with
@@ -829,18 +814,19 @@ let complete_one_class state i=
 	let rec app t typ n =
 	  if n<=0 then t else
 	    let _,etyp,rest= destProd typ in
-	    let id = new_state_var etyp state in
+            let id = new_state_var (EConstr.of_constr etyp) state in
 		app (Appli(t,Eps id)) (substl [mkVar id] rest) (n-1) in
-	let _c = pf_unsafe_type_of state.gls
-	  (constr_of_term (term state.uf pac.cnode)) in
+        let _c = Typing.unsafe_type_of state.env state.sigma
+	  (EConstr.of_constr (constr_of_term (term state.uf pac.cnode))) in
+        let _c = EConstr.Unsafe.to_constr _c in
 	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)
-    | _ -> anomaly (Pp.str "wrong incomplete class")
+    | _ -> anomaly (Pp.str "wrong incomplete class.")
 
 let complete state =
   Int.Set.iter (complete_one_class state) state.pa_classes
@@ -980,7 +966,7 @@ let find_instances state =
 	Control.check_for_interrupt ();
 	do_match state res pb_stack
       done;
-      anomaly (Pp.str "get out of here !")
+      anomaly (Pp.str "get out of here!")
     with Stack.Empty -> () in
     !res
 
diff --git a/plugins/cc/ccalgo.mli b/plugins/cc/ccalgo.mli
index c7fa2f56..4ebc6a13 100644
--- a/plugins/cc/ccalgo.mli
+++ b/plugins/cc/ccalgo.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
-open Term
+open Constr
 open Names
 
 type pa_constructor =
@@ -30,7 +32,7 @@ type cinfo =
 
 type term =
     Symb of constr
-  | Product of sorts * sorts
+  | Product of Sorts.t * Sorts.t
   | Eps of Id.t
   | Appli of term*term
   | Constructor of cinfo (* constructor arity + nhyps *)
@@ -85,7 +87,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
@@ -120,7 +122,7 @@ val term_equal : term -> term -> bool
 
 val constr_of_term : term -> constr
 
-val debug : (unit -> Pp.std_ppcmds) -> unit
+val debug : (unit -> Pp.t) -> unit
 
 val forest : state -> forest
 
@@ -128,7 +130,7 @@ val axioms : forest -> (term * term) Constrhash.t
 
 val epsilons : forest -> pa_constructor list
 
-val empty : int -> Proof_type.goal Tacmach.sigma -> state
+val empty : int -> Goal.goal Evd.sigma -> state
 
 val add_term : state -> term -> int
 
@@ -169,7 +171,7 @@ val find_instances : state -> (quant_eq * int array) list
 
 val execute : bool -> state -> explanation option
 
-val pr_idx_term : forest -> int -> Pp.std_ppcmds
+val pr_idx_term : forest -> int -> Pp.t
 
 val empty_forest: unit -> forest
 
diff --git a/plugins/cc/ccproof.ml b/plugins/cc/ccproof.ml
index f58847ca..1f1fa9c9 100644
--- a/plugins/cc/ccproof.ml
+++ b/plugins/cc/ccproof.ml
@@ -1,16 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file uses the (non-compressed) union-find structure to generate *)
 (* proof-trees that will be transformed into proof-terms in cctac.ml4   *)
 
 open CErrors
-open Term
+open Constr
 open Ccalgo
 open Pp
 
@@ -47,7 +49,7 @@ let rec ptrans p1 p3=
 	{p_lhs=p1.p_lhs;
 	 p_rhs=p3.p_rhs;
 	 p_rule=Trans (p1,p3)}
-      else anomaly (Pp.str "invalid cc transitivity")
+      else anomaly (Pp.str "invalid cc transitivity.")
 
 let rec psym p =
   match p.p_rule with
@@ -85,7 +87,7 @@ let rec nth_arg t n=
 	if n>0 then
 	  nth_arg t1 (n-1)
 	else t2
-    | _ -> anomaly ~label:"nth_arg" (Pp.str "not enough args")
+    | _ -> anomaly ~label:"nth_arg" (Pp.str "not enough args.")
 
 let pinject p c n a =
   {p_lhs=nth_arg p.p_lhs (n-a);
diff --git a/plugins/cc/ccproof.mli b/plugins/cc/ccproof.mli
index eacbfeac..bebef241 100644
--- a/plugins/cc/ccproof.mli
+++ b/plugins/cc/ccproof.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Ccalgo
-open Term
+open Constr
 
 type rule=
     Ax of constr
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index fd46d806..d19817e7 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file is the interface between the c-c algorithm and Coq *)
@@ -12,20 +14,21 @@ open Evd
 open Names
 open Inductiveops
 open Declarations
-open Term
+open Constr
+open EConstr
 open Vars
-open Tacmach
 open Tactics
 open Typing
 open Ccalgo
 open Ccproof
 open Pp
-open CErrors
 open Util
 open Proofview.Notations
-open Context.Rel.Declaration
 
-let reference dir s = lazy (Coqlib.gen_reference "CC" dir s)
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
+let reference dir s = lazy (Coqlib.coq_reference "CC" dir s)
 
 let _f_equal = reference ["Init";"Logic"] "f_equal"
 let _eq_rect = reference ["Init";"Logic"] "eq_rect"
@@ -37,13 +40,11 @@ let _False = reference ["Init";"Logic"] "False"
 let _True = reference ["Init";"Logic"] "True"
 let _I = reference ["Init";"Logic"] "I"
 
-let whd env=
-  let infos=CClosure.create_clos_infos CClosure.betaiotazeta env in
-    (fun t -> CClosure.whd_val infos (CClosure.inject t))
+let whd env sigma t =
+  Reductionops.clos_whd_flags CClosure.betaiotazeta env sigma t
 
-let whd_delta env=
-   let infos=CClosure.create_clos_infos CClosure.all env in
-    (fun t -> CClosure.whd_val infos (CClosure.inject t))
+let whd_delta env sigma t =
+  Reductionops.clos_whd_flags CClosure.all env sigma t
 
 (* decompose member of equality in an applicative format *)
 
@@ -51,12 +52,12 @@ let whd_delta env=
 let sf_of env sigma c = e_sort_of env (ref sigma) c
 
 let rec decompose_term env sigma t=
-    match kind_of_term (whd env t) with
+    match EConstr.kind sigma (whd env sigma t) with
       App (f,args)->
 	let tf=decompose_term env sigma f in
 	let targs=Array.map (decompose_term env sigma) args in
 	  Array.fold_left (fun s t->Appli (s,t)) tf targs
-    | Prod (_,a,_b) when not (Termops.dependent (mkRel 1) _b) ->
+    | Prod (_,a,_b) when noccurn sigma 1 _b ->
 	let b = Termops.pop _b in
 	let sort_b = sf_of env sigma b in
 	let sort_a = sf_of env sigma a in
@@ -65,7 +66,8 @@ let rec decompose_term env sigma t=
 	      decompose_term env sigma b)
     | Construct c ->
 	let (((mind,i_ind),i_con),u)= c in 
-	let canon_mind = mind_of_kn (canonical_mind mind) 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
 	let (oib,_)=Global.lookup_inductive (canon_ind) in
 	let nargs=constructor_nallargs_env env (canon_ind,i_con) in
@@ -74,28 +76,31 @@ let rec decompose_term env sigma t=
 		       ci_nhyps=nargs-oib.mind_nparams}
     | Ind c -> 
 	let (mind,i_ind),u = c in 
-	let canon_mind = mind_of_kn (canonical_mind mind) in
-	let canon_ind = canon_mind,i_ind in  (Symb (mkIndU (canon_ind,u)))
+	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 (Constr.mkIndU (canon_ind,u)))
     | Const (c,u) -> 
-	let canon_const = constant_of_kn (canonical_con c) in 
-	  (Symb (mkConstU (canon_const,u)))
+	let u = EInstance.kind sigma u in
+	let canon_const = Constant.make1 (Constant.canonical c) in 
+	  (Symb (Constr.mkConstU (canon_const,u)))
     | Proj (p, c) -> 
-	let canon_const kn = constant_of_kn (canonical_con kn) in 
+	let canon_const kn = Constant.make1 (Constant.canonical kn) in 
 	let p' = Projection.map canon_const p in
-	(Appli (Symb (mkConst (Projection.constant p')), decompose_term env sigma c))
+	let c = Retyping.expand_projection env sigma p' c [] in
+	decompose_term env sigma c
     | _ ->
-       let t = strip_outer_cast t in
-       if closed0 t then Symb t else raise Not_found
+       let t = Termops.strip_outer_cast sigma t in
+       if closed0 sigma t then Symb (EConstr.to_constr sigma t) else raise Not_found
 
 (* decompose equality in members and type *)
-open Globnames
+open Termops
 
 let atom_of_constr env sigma term =
-  let wh =  (whd_delta env term) in
-  let kot = kind_of_term wh in
+  let wh = whd_delta env sigma term in
+  let kot = EConstr.kind sigma wh in
     match kot with
       App (f,args)->
-	if is_global (Lazy.force _eq) f && Int.equal (Array.length args) 3
+	if is_global sigma (Lazy.force _eq) f && Int.equal (Array.length args) 3
 	  then `Eq (args.(0),
 		   decompose_term env sigma args.(1),
 		   decompose_term env sigma args.(2))
@@ -103,14 +108,14 @@ let atom_of_constr env sigma term =
     | _ -> `Other (decompose_term env sigma term)
 
 let rec pattern_of_constr env sigma c =
-  match kind_of_term (whd env c) with
+  match EConstr.kind sigma (whd env sigma c) with
       App (f,args)->
 	let pf = decompose_term env sigma f in
 	let pargs,lrels = List.split
 	  (Array.map_to_list (pattern_of_constr env sigma) args) in
 	  PApp (pf,List.rev pargs),
 	List.fold_left Int.Set.union Int.Set.empty lrels
-    | Prod (_,a,_b) when not (Termops.dependent (mkRel 1) _b) ->
+    | Prod (_,a,_b) when noccurn sigma 1 _b ->
 	let b = Termops.pop _b in
 	let pa,sa = pattern_of_constr env sigma a in
 	let pb,sb = pattern_of_constr env sigma b in
@@ -129,19 +134,19 @@ let non_trivial = function
 
 let patterns_of_constr env sigma nrels term=
   let f,args=
-    try destApp (whd_delta env term) with DestKO -> raise Not_found in
-	if is_global (Lazy.force _eq) f && Int.equal (Array.length args) 3
+    try destApp sigma (whd_delta env sigma term) with DestKO -> raise Not_found in
+	if is_global sigma (Lazy.force _eq) f && Int.equal (Array.length args) 3
 	then
 	  let patt1,rels1 = pattern_of_constr env sigma args.(1)
 	  and patt2,rels2 = pattern_of_constr env sigma args.(2) in
 	  let valid1 =
 	    if not (Int.equal (Int.Set.cardinal rels1) nrels) then Creates_variables
 	    else if non_trivial patt1 then Normal
-	    else Trivial args.(0)
+	    else Trivial (EConstr.to_constr sigma args.(0))
 	  and valid2 =
 	    if not (Int.equal (Int.Set.cardinal rels2) nrels) then Creates_variables
 	    else if non_trivial patt2 then Normal
-	    else Trivial args.(0) in
+	    else Trivial (EConstr.to_constr sigma args.(0)) in
 	    if valid1 != Creates_variables
 	      || valid2 != Creates_variables  then
 	      nrels,valid1,patt1,valid2,patt2
@@ -149,28 +154,28 @@ let patterns_of_constr env sigma nrels term=
 	else raise Not_found
 
 let rec quantified_atom_of_constr env sigma nrels term =
-  match kind_of_term (whd_delta env term) with
+  match EConstr.kind sigma (whd_delta env sigma term) with
       Prod (id,atom,ff) -> 
-	if is_global (Lazy.force _False) ff then
+	if is_global sigma (Lazy.force _False) ff then
 	  let patts=patterns_of_constr env sigma nrels atom in
 	      `Nrule patts
 	else 
-	  quantified_atom_of_constr (Environ.push_rel (LocalAssum (id,atom)) env) sigma (succ nrels) ff
+	  quantified_atom_of_constr (EConstr.push_rel (RelDecl.LocalAssum (id,atom)) env) sigma (succ nrels) ff
     | _ ->  
 	let patts=patterns_of_constr env sigma nrels term in
 	    `Rule patts
 
 let litteral_of_constr env sigma term=
-  match kind_of_term (whd_delta env term) with
+  match EConstr.kind sigma (whd_delta env sigma term) with
     | Prod (id,atom,ff) -> 
-	if is_global (Lazy.force _False) ff then
+	if is_global sigma (Lazy.force _False) ff then
 	  match (atom_of_constr env sigma atom) with
 	      `Eq(t,a,b) -> `Neq(t,a,b)
 	    | `Other(p) -> `Nother(p)
 	else
 	  begin
 	    try 
-	      quantified_atom_of_constr (Environ.push_rel (LocalAssum (id,atom)) env) sigma 1 ff
+	      quantified_atom_of_constr (EConstr.push_rel (RelDecl.LocalAssum (id,atom)) env) sigma 1 ff
 	    with Not_found ->
 	      `Other (decompose_term env sigma term)
 	  end
@@ -181,9 +186,10 @@ let litteral_of_constr env sigma term=
 (* store all equalities from the context *)
 
 let make_prb gls depth additionnal_terms =
+  let open Tacmach.New in
   let env=pf_env gls in
-  let sigma=sig_sig gls in
-  let state = empty depth gls in
+  let sigma=project gls in
+  let state = empty depth {it = Proofview.Goal.goal gls; sigma } in
   let pos_hyps = ref [] in
   let neg_hyps =ref [] in
     List.iter
@@ -192,10 +198,10 @@ let make_prb gls depth additionnal_terms =
 	   ignore (add_term state t)) additionnal_terms;
     List.iter
       (fun decl ->
-         let (id,_,e) = Context.Named.Declaration.to_tuple decl in
+         let id = NamedDecl.get_id decl in
 	 begin
-	   let cid=mkVar id in
-	   match litteral_of_constr env sigma e with
+	   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
 	     | `Other ph ->
@@ -212,9 +218,9 @@ let make_prb gls depth additionnal_terms =
 		 neg_hyps:=(cid,nh):: !neg_hyps
 	     | `Rule patts -> add_quant state id true patts
 	     | `Nrule patts -> add_quant state id false patts
-	 end) (Environ.named_context_of_val (Goal.V82.nf_hyps gls.sigma gls.it));
+	 end) (Proofview.Goal.hyps gls);
     begin
-      match atom_of_constr env sigma (Evarutil.nf_evar sigma (pf_concl gls)) with
+      match atom_of_constr env sigma (pf_concl gls) with
 	  `Eq (t,a,b) -> add_disequality state Goal a b
 	|	`Other g ->
 		  List.iter
@@ -226,63 +232,88 @@ let make_prb gls depth additionnal_terms =
 (* indhyps builds the array of arrays of constructor hyps for (ind largs) *)
 
 let build_projection intype (cstr:pconstructor) special default gls=
+  let open Tacmach.New in
   let ci= (snd(fst cstr)) in
-  let body=Equality.build_selector (pf_env gls) (project gls) ci (mkRel 1) intype special default in
+  let sigma = project gls in
+  let body=Equality.build_selector (pf_env gls) sigma ci (mkRel 1) intype special default in
   let id=pf_get_new_id (Id.of_string "t") gls in
-    mkLambda(Name id,intype,body)
+  sigma, mkLambda(Name id,intype,body)
 
 (* generate an adhoc tactic following the proof tree  *)
 
-let _M =mkMeta
-
 let app_global f args k =
-  Tacticals.pf_constr_of_global (Lazy.force f) (fun fc -> k (mkApp (fc, args)))
-
-let new_app_global f args k =
-  Tacticals.New.pf_constr_of_global (Lazy.force f) (fun fc -> k (mkApp (fc, args)))
-
-let new_refine c = Proofview.V82.tactic (refine c)
+  Tacticals.New.pf_constr_of_global (Lazy.force f) >>= fun fc -> k (mkApp (fc, args))
+
+let rec gen_holes env sigma t n accu =
+  if Int.equal n 0 then (sigma, List.rev accu)
+  else match EConstr.kind sigma t with
+  | Prod (_, u, t) ->
+    let (sigma, ev) = Evarutil.new_evar env sigma u in
+    let t = EConstr.Vars.subst1 ev t in
+    gen_holes env sigma t (pred n) (ev :: accu)
+  | _ -> assert false
+
+let app_global_with_holes f args n =
+  Proofview.Goal.enter begin fun gl ->
+    Tacticals.New.pf_constr_of_global (Lazy.force f) >>= fun fc ->
+    let env = Proofview.Goal.env gl in
+    let concl = Proofview.Goal.concl gl in
+    Refine.refine ~typecheck:false begin fun sigma ->
+      let t = Tacmach.New.pf_get_type_of gl fc in
+      let t = Termops.prod_applist sigma t (Array.to_list args) in
+      let ans = mkApp (fc, args) in
+      let (sigma, holes) = gen_holes env sigma t n [] in
+      let ans = applist (ans, holes) in
+      let evdref = ref sigma in
+      let () = Typing.e_check env evdref ans concl in
+      (!evdref, ans)
+    end
+  end
 
 let assert_before n c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let evm, _ = Tacmach.New.pf_apply type_of gl c in
-      Tacticals.New.tclTHEN (Proofview.V82.tactic (Refiner.tclEVARS evm)) (assert_before n c)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evm)
+    (assert_before n c)
+  end
 
 let refresh_type env evm ty =
   Evarsolve.refresh_universes ~status:Evd.univ_flexible ~refreshset:true
 			      (Some false) env evm ty
 
 let refresh_universes ty k =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let evm = Tacmach.New.project gl in
     let evm, ty = refresh_type env evm ty in
-    Tacticals.New.tclTHEN (Proofview.V82.tactic (Refiner.tclEVARS evm)) (k ty)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evm) (k ty)
+  end
+
+let constr_of_term c = EConstr.of_constr (constr_of_term c)
 
 let rec proof_tac p : unit Proofview.tactic =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let type_of t = Tacmach.New.pf_unsafe_type_of gl t in
   try (* type_of can raise exceptions *)
   match p.p_rule with
-      Ax c -> exact_check c
+      Ax c -> exact_check (EConstr.of_constr c)
     | SymAx c ->
+        let c = EConstr.of_constr c in
 	let l=constr_of_term p.p_lhs and
 	    r=constr_of_term p.p_rhs in
 	refresh_universes (type_of l) (fun typ ->
-        new_app_global _sym_eq [|typ;r;l;c|] exact_check)
+        app_global _sym_eq [|typ;r;l;c|] exact_check)
     | Refl t ->
 	let lr = constr_of_term t in
 	refresh_universes (type_of lr) (fun typ ->
-        new_app_global _refl_equal [|typ;constr_of_term t|] exact_check)
+        app_global _refl_equal [|typ;constr_of_term t|] exact_check)
     | Trans (p1,p2)->
 	let t1 = constr_of_term p1.p_lhs and
 	    t2 = constr_of_term p1.p_rhs and
 	    t3 = constr_of_term p2.p_rhs in
 	refresh_universes (type_of t2) (fun typ ->
-	let prf = new_app_global _trans_eq [|typ;t1;t2;t3;_M 1;_M 2|] in
-          Tacticals.New.tclTHENS (prf new_refine) [(proof_tac p1);(proof_tac p2)])
+	let prf = app_global_with_holes _trans_eq [|typ;t1;t2;t3;|] 2 in
+          Tacticals.New.tclTHENS prf [(proof_tac p1);(proof_tac p2)])
     | Congr (p1,p2)->
 	let tf1=constr_of_term p1.p_lhs
 	and tx1=constr_of_term p2.p_lhs
@@ -291,20 +322,20 @@ let rec proof_tac p : unit Proofview.tactic =
 	refresh_universes (type_of tf1) (fun typf ->
 	refresh_universes (type_of tx1) (fun typx ->
 	refresh_universes (type_of (mkApp (tf1,[|tx1|]))) (fun typfx ->
-        let id = Tacmach.New.of_old (fun gls -> pf_get_new_id (Id.of_string "f") gls) gl in
+        let id = Tacmach.New.pf_get_new_id (Id.of_string "f") gl in
 	let appx1 = mkLambda(Name id,typf,mkApp(mkRel 1,[|tx1|])) in
-	let lemma1 = app_global _f_equal [|typf;typfx;appx1;tf1;tf2;_M 1|] in
-	let lemma2 = app_global _f_equal [|typx;typfx;tf2;tx1;tx2;_M 1|] in
+	let lemma1 = app_global_with_holes _f_equal [|typf;typfx;appx1;tf1;tf2|] 1 in
+	let lemma2 = app_global_with_holes _f_equal [|typx;typfx;tf2;tx1;tx2|] 1 in
 	let prf =
-	  app_global _trans_eq
+	  app_global_with_holes _trans_eq
 		[|typfx;
 		  mkApp(tf1,[|tx1|]);
 		  mkApp(tf2,[|tx1|]);
-		  mkApp(tf2,[|tx2|]);_M 2;_M 3|] in
-	  Tacticals.New.tclTHENS (Proofview.V82.tactic (prf refine))
-	    [Tacticals.New.tclTHEN (Proofview.V82.tactic (lemma1 refine)) (proof_tac p1);
+		  mkApp(tf2,[|tx2|])|] 2 in
+	  Tacticals.New.tclTHENS prf
+	    [Tacticals.New.tclTHEN lemma1 (proof_tac p1);
   	     Tacticals.New.tclFIRST
-	       [Tacticals.New.tclTHEN (Proofview.V82.tactic (lemma2 refine)) (proof_tac p2);
+	       [Tacticals.New.tclTHEN lemma2 (proof_tac p2);
 		reflexivity;
                 Tacticals.New.tclZEROMSG
 		    (Pp.str
@@ -316,96 +347,86 @@ let rec proof_tac p : unit Proofview.tactic =
 	 let special=mkRel (1+nargs-argind) in
 	 refresh_universes (type_of ti) (fun intype ->
          refresh_universes (type_of default) (fun outtype ->
-         let proj =
-           Tacmach.New.of_old (build_projection intype cstr special default) gl
+         let sigma, proj =
+           build_projection intype cstr special default gl
          in
 	 let injt=
-           app_global _f_equal [|intype;outtype;proj;ti;tj;_M 1|] in
-	   Tacticals.New.tclTHEN (Proofview.V82.tactic (injt refine)) (proof_tac prf)))
+           app_global_with_holes _f_equal [|intype;outtype;proj;ti;tj|] 1 in
+	 Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+                               (Tacticals.New.tclTHEN injt (proof_tac prf))))
   with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
-  end }
+  end
 
 let refute_tac c t1 t2 p =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
-  let hid = Tacmach.New.of_old (pf_get_new_id (Id.of_string "Heq")) gl in
+  let hid = Tacmach.New.pf_get_new_id (Id.of_string "Heq") gl in
   let false_t=mkApp (c,[|mkVar hid|]) in
   let k intype =
-    let neweq= new_app_global _eq [|intype;tt1;tt2|] in
+    let neweq= app_global _eq [|intype;tt1;tt2|] in
     Tacticals.New.tclTHENS (neweq (assert_before (Name hid)))
       [proof_tac p; simplest_elim false_t]
   in refresh_universes (Tacmach.New.pf_unsafe_type_of gl tt1) k
-  end }
+  end
 
-let refine_exact_check c gl =
-  let evm, _ = pf_apply type_of gl c in
-    Tacticals.tclTHEN (Refiner.tclEVARS evm) (Proofview.V82.of_tactic (exact_check c)) gl
+let refine_exact_check c =
+  Proofview.Goal.enter begin fun gl ->
+    let evm, _ = Tacmach.New.pf_apply type_of gl c in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evm) (exact_check c)
+  end
 
 let convert_to_goal_tac c t1 t2 p = 
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
   let k sort =
-    let neweq= new_app_global _eq [|sort;tt1;tt2|] in
-    let e = Tacmach.New.of_old (pf_get_new_id (Id.of_string "e")) gl in
-    let x = Tacmach.New.of_old (pf_get_new_id (Id.of_string "X")) gl in
+    let neweq= app_global _eq [|sort;tt1;tt2|] in
+    let e = Tacmach.New.pf_get_new_id (Id.of_string "e") gl in
+    let x = Tacmach.New.pf_get_new_id (Id.of_string "X") gl in
     let identity=mkLambda (Name x,sort,mkRel 1) in
-    let endt=app_global _eq_rect [|sort;tt1;identity;c;tt2;mkVar e|] in
+    let endt = app_global _eq_rect [|sort;tt1;identity;c;tt2;mkVar e|] in
     Tacticals.New.tclTHENS (neweq (assert_before (Name e)))
-			   [proof_tac p; Proofview.V82.tactic (endt refine_exact_check)]
+			   [proof_tac p; endt refine_exact_check]
   in refresh_universes (Tacmach.New.pf_unsafe_type_of gl tt2) k
-  end }
+  end
 
 let convert_to_hyp_tac c1 t1 c2 t2 p =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let tt2=constr_of_term t2 in
-  let h = Tacmach.New.of_old (pf_get_new_id (Id.of_string "H")) gl in
+  let h = Tacmach.New.pf_get_new_id (Id.of_string "H") gl in
   let false_t=mkApp (c2,[|mkVar h|]) in
     Tacticals.New.tclTHENS (assert_before (Name h) tt2)
       [convert_to_goal_tac c1 t1 t2 p;
        simplest_elim false_t]
-  end }
+  end
 
-let discriminate_tac (cstr,u as cstru) p =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let t1=constr_of_term p.p_lhs and t2=constr_of_term p.p_rhs in
+(* Essentially [assert (Heq : lhs = rhs) by proof_tac p; discriminate Heq] *)
+let discriminate_tac cstru p =
+  Proofview.Goal.enter begin fun gl ->
+    let lhs=constr_of_term p.p_lhs and rhs=constr_of_term p.p_rhs in
     let env = Proofview.Goal.env gl in
-    let concl = Proofview.Goal.concl gl in
-    let xid = Tacmach.New.of_old (pf_get_new_id (Id.of_string "X")) gl in
-    let identity = Universes.constr_of_global (Lazy.force _I) in
-    let trivial = Universes.constr_of_global (Lazy.force _True) in
     let evm = Tacmach.New.project gl in
-    let evm, intype = refresh_type env evm (Tacmach.New.pf_unsafe_type_of gl t1) in
-    let evm, outtype = Evd.new_sort_variable Evd.univ_flexible evm in
-    let outtype = mkSort outtype in
-    let pred = mkLambda(Name xid,outtype,mkRel 1) in
-    let hid = Tacmach.New.of_old (pf_get_new_id (Id.of_string "Heq")) gl in
-    let proj = Tacmach.New.of_old (build_projection intype cstru trivial concl) gl in
-    let injt=app_global _f_equal
-			[|intype;outtype;proj;t1;t2;mkVar hid|] in
-    let endt k =
-      injt (fun injt ->
-            app_global _eq_rect
-		       [|outtype;trivial;pred;identity;concl;injt|] k) in
-    let neweq=new_app_global _eq [|intype;t1;t2|] in
+    let evm, intype = refresh_type env evm (Tacmach.New.pf_unsafe_type_of gl lhs) in
+    let hid = Tacmach.New.pf_get_new_id (Id.of_string "Heq") gl in
+    let neweq=app_global _eq [|intype;lhs;rhs|] in
     Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS evm)
 			  (Tacticals.New.tclTHENS (neweq (assert_before (Name hid)))
-      [proof_tac p; Proofview.V82.tactic (endt refine_exact_check)])
-  end }
+      [proof_tac p; Equality.discrHyp hid])
+  end
 
 (* wrap everything *)
 
-let build_term_to_complete uf meta pac =
+let build_term_to_complete uf pac =
   let cinfo = get_constructor_info uf pac.cnode in
-  let real_args = List.map (fun i -> constr_of_term (term uf i)) pac.args in
-  let dummy_args = List.rev (List.init pac.arity meta) in
-  let all_args = List.rev_append real_args dummy_args in
-    applistc (mkConstructU cinfo.ci_constr) all_args
+  let real_args = List.rev_map (fun i -> constr_of_term (term uf i)) pac.args in
+  let (kn, u) = cinfo.ci_constr in
+  (applist (mkConstructU (kn, EInstance.make u), real_args), pac.arity)
 
 let cc_tactic depth additionnal_terms =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+    let sigma = Tacmach.New.project gl in
     Coqlib.check_required_library Coqlib.logic_module_name;
     let _ = debug (fun () -> Pp.str "Reading subgoal ...") in
-    let state = Tacmach.New.of_old (fun gls -> make_prb gls depth additionnal_terms) gl in
+    let state = make_prb gl depth additionnal_terms in
     let _ = debug (fun () -> Pp.str "Problem built, solving ...") in
     let sol = execute true state in
     let _ = debug (fun () -> Pp.str "Computation completed.") in
@@ -420,16 +441,17 @@ let cc_tactic depth additionnal_terms =
 	    let cstr=(get_constructor_info uf ipac.cnode).ci_constr in
 	    discriminate_tac cstr p
 	| Incomplete ->
+            let open Glob_term in
             let env = Proofview.Goal.env gl in
-	    let metacnt = ref 0 in
-	    let newmeta _ = incr metacnt; _M !metacnt in
-	    let terms_to_complete =
-	      List.map
-		(build_term_to_complete uf newmeta)
-		(epsilons uf) in
+            let terms_to_complete = List.map (build_term_to_complete uf) (epsilons uf) in
+            let hole = DAst.make @@ GHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None) in
+            let pr_missing (c, missing) =
+              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 (DAst.make @@ GApp (c, holes))
+            in
 	    Feedback.msg_info
-	      (Pp.str "Goal is solvable by congruence but \
- some arguments are missing.");
+	      (Pp.str "Goal is solvable by congruence but some arguments are missing.");
 	    Feedback.msg_info
 	      (Pp.str "  Try " ++
 		 hov 8
@@ -437,7 +459,7 @@ let cc_tactic depth additionnal_terms =
 		   str "\"congruence with (" ++
 		     prlist_with_sep
 		     (fun () -> str ")" ++ spc () ++ str "(")
-		     (Termops.print_constr_env env)
+		     pr_missing
 		     terms_to_complete ++
 		     str ")\","
 		 end ++
@@ -448,20 +470,23 @@ let cc_tactic depth additionnal_terms =
 	    let ta=term uf dis.lhs and tb=term uf dis.rhs in
 	    match dis.rule with
 	      Goal -> proof_tac p
-	    | Hyp id -> refute_tac id ta tb p
+	    | Hyp id -> refute_tac (EConstr.of_constr id) ta tb p
 	    | HeqG id ->
+                let id = EConstr.of_constr id in
 		convert_to_goal_tac id ta tb p
 	    | HeqnH (ida,idb) ->
+                let ida = EConstr.of_constr ida in
+                let idb = EConstr.of_constr idb in
 		convert_to_hyp_tac ida ta idb tb p
-  end }
+  end
 
-let cc_fail gls =
-  errorlabstrm  "Congruence" (Pp.str "congruence failed.")
+let cc_fail =
+  Tacticals.New.tclZEROMSG (Pp.str "congruence failed.")
 
 let congruence_tac depth l =
   Tacticals.New.tclORELSE
     (Tacticals.New.tclTHEN (Tacticals.New.tclREPEAT introf) (cc_tactic depth l))
-    (Proofview.V82.tactic cc_fail)
+    cc_fail
 
 (* Beware: reflexivity = constructor 1 = apply refl_equal
    might be slow now, let's rather do something equivalent
@@ -475,31 +500,31 @@ let congruence_tac depth l =
 *)
 
 let mk_eq f c1 c2 k =
-  Tacticals.New.pf_constr_of_global (Lazy.force f) (fun fc ->
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Tacticals.New.pf_constr_of_global (Lazy.force f) >>= fun fc ->
+  Proofview.Goal.enter begin fun gl ->
     let open Tacmach.New in
     let evm, ty = pf_apply type_of gl c1 in
     let evm, ty = Evarsolve.refresh_universes (Some false) (pf_env gl) evm ty in
     let term = mkApp (fc, [| ty; c1; c2 |]) in
     let evm, _ =  type_of (pf_env gl) evm term in
-    Tacticals.New.tclTHEN (Proofview.V82.tactic (Refiner.tclEVARS evm))
-			  (k term)
-    end })
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evm) (k term)
+    end
 
 let f_equal =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
+    let sigma = Tacmach.New.project gl in
     let cut_eq c1 c2 =
       try (* type_of can raise an exception *)
         Tacticals.New.tclTHENS
 	  (mk_eq _eq c1 c2 Tactics.cut)
-	  [Proofview.tclUNIT ();Tacticals.New.tclTRY ((new_app_global _refl_equal [||]) apply)]
+	  [Proofview.tclUNIT ();Tacticals.New.tclTRY ((app_global _refl_equal [||]) apply)]
       with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
     in
     Proofview.tclORELSE
-      begin match kind_of_term concl with
-      | App (r,[|_;t;t'|]) when Globnames.is_global (Lazy.force _eq) r ->
-	  begin match kind_of_term t, kind_of_term t' with
+      begin match EConstr.kind sigma concl with
+      | App (r,[|_;t;t'|]) when is_global sigma (Lazy.force _eq) r ->
+	  begin match EConstr.kind sigma t, EConstr.kind sigma t' with
 	  | App (f,v), App (f',v') when Int.equal (Array.length v) (Array.length v') ->
 	      let rec cuts i =
 		if i < 0 then Tacticals.New.tclTRY (congruence_tac 1000 [])
@@ -510,7 +535,7 @@ let f_equal =
       | _ -> Proofview.tclUNIT ()
       end
       begin function (e, info) -> match e with
-        | Type_errors.TypeError _ -> Proofview.tclUNIT ()
+        | Pretype_errors.PretypeError _ | Type_errors.TypeError _ -> Proofview.tclUNIT ()
         | e -> Proofview.tclZERO ~info e
       end
-  end }
+  end
diff --git a/plugins/cc/cctac.mli b/plugins/cc/cctac.mli
index 7c1d9f1c..a1bbcbc0 100644
--- a/plugins/cc/cctac.mli
+++ b/plugins/cc/cctac.mli
@@ -1,20 +1,20 @@
-
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
-open Proof_type
+open EConstr
 
 val proof_tac: Ccproof.proof -> unit Proofview.tactic
 
 val cc_tactic : int -> constr list ->  unit Proofview.tactic
 
-val cc_fail : tactic
+val cc_fail : unit Proofview.tactic
 
 val congruence_tac : int -> constr list -> unit Proofview.tactic
 
diff --git a/plugins/cc/g_congruence.ml4 b/plugins/cc/g_congruence.ml4
index 52a13511..fb013ac1 100644
--- a/plugins/cc/g_congruence.ml4
+++ b/plugins/cc/g_congruence.ml4
@@ -1,16 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
+open Ltac_plugin
 open Cctac
 open Stdarg
-open Constrarg
 
 DECLARE PLUGIN "cc_plugin"
 
diff --git a/plugins/decl_mode/decl_expr.mli b/plugins/decl_mode/decl_expr.mli
deleted file mode 100644
index 29ecb94c..00000000
--- a/plugins/decl_mode/decl_expr.mli
+++ /dev/null
@@ -1,102 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Tacexpr
-
-type 'it statement =
-    {st_label:Name.t;
-     st_it:'it}
-
-type thesis_kind =
-    Plain
-  | For of Id.t
-
-type 'this or_thesis =
-    This of 'this
-  | Thesis of thesis_kind
-
-type side = Lhs | Rhs
-
-type elim_type =
-    ET_Case_analysis
-  | ET_Induction
-
-type block_type =
-    B_proof
-  | B_claim
-  | B_focus
-  | B_elim of elim_type
-
-type ('it,'constr,'tac) cut =
-    {cut_stat: 'it;
-     cut_by: 'constr list option;
-     cut_using: 'tac option}
-
-type ('var,'constr) hyp =
-    Hvar of 'var
-  | Hprop of 'constr statement
-
-type ('constr,'tac) casee =
-    Real of 'constr
-  | Virtual of ('constr statement,'constr,'tac) cut
-
-type ('var,'constr,'pat,'tac) bare_proof_instr =
-  | Pthen of ('var,'constr,'pat,'tac) bare_proof_instr
-  | Pthus of ('var,'constr,'pat,'tac) bare_proof_instr
-  | Phence of ('var,'constr,'pat,'tac) bare_proof_instr
-  | Pcut of ('constr or_thesis statement,'constr,'tac) cut
-  | Prew of side * ('constr statement,'constr,'tac) cut
-  | Psuffices of ((('var,'constr) hyp list * 'constr or_thesis),'constr,'tac) cut
-  | Passume of ('var,'constr) hyp list
-  | Plet of ('var,'constr) hyp list
-  | Pgiven of ('var,'constr) hyp list
-  | Pconsider of 'constr*('var,'constr) hyp list
-  | Pclaim of 'constr statement
-  | Pfocus of 'constr statement
-  | Pdefine of Id.t * 'var list * 'constr
-  | Pcast of Id.t or_thesis * 'constr
-  | Psuppose of ('var,'constr) hyp list
-  | Pcase of 'var list*'pat*(('var,'constr or_thesis) hyp list)
-  | Ptake of 'constr list
-  | Pper of elim_type * ('constr,'tac) casee
-  | Pend of block_type
-  | Pescape
-
-type emphasis = int
-
-type ('var,'constr,'pat,'tac) gen_proof_instr=
-    {emph: emphasis;
-     instr: ('var,'constr,'pat,'tac) bare_proof_instr }
-
-
-type raw_proof_instr =
-    ((Id.t * (Constrexpr.constr_expr option)) Loc.located,
-     Constrexpr.constr_expr,
-     Constrexpr.cases_pattern_expr,
-     raw_tactic_expr) gen_proof_instr
-
-type glob_proof_instr =
-    ((Id.t * (Tacexpr.glob_constr_and_expr option)) Loc.located,
-     Tacexpr.glob_constr_and_expr,
-     Constrexpr.cases_pattern_expr,
-     Tacexpr.glob_tactic_expr) gen_proof_instr
-
-type proof_pattern =
-    {pat_vars: Term.types statement list;
-     pat_aliases: (Term.constr*Term.types) statement list;
-     pat_constr: Term.constr;
-     pat_typ: Term.types;
-     pat_pat: Glob_term.cases_pattern;
-     pat_expr: Constrexpr.cases_pattern_expr}
-
-type proof_instr =
-    (Term.constr statement,
-     Term.constr,
-     proof_pattern,
-     Geninterp.Val.t) gen_proof_instr
diff --git a/plugins/decl_mode/decl_interp.ml b/plugins/decl_mode/decl_interp.ml
deleted file mode 100644
index a862423e..00000000
--- a/plugins/decl_mode/decl_interp.ml
+++ /dev/null
@@ -1,473 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open CErrors
-open Util
-open Names
-open Constrexpr
-open Tacintern
-open Decl_expr
-open Decl_mode
-open Pretyping
-open Glob_term
-open Term
-open Vars
-open Pp
-open Decl_kinds
-open Misctypes
-
-(* INTERN *)
-
-let glob_app (loc,hd,args) = if List.is_empty args then hd else GApp(loc,hd,args)
-
-let intern_justification_items globs =
-  Option.map (List.map (intern_constr globs))
-
-let intern_justification_method globs =
-  Option.map (intern_pure_tactic globs)
-
-let intern_statement intern_it globs st =
-  {st_label=st.st_label;
-   st_it=intern_it globs st.st_it}
-
-let intern_no_bind intern_it globs x =
-  globs,intern_it globs x
-
-let intern_constr_or_thesis globs = function
-    Thesis n -> Thesis n
-  | This c -> This (intern_constr globs c)
-
-let add_var id globs=
-    {globs with ltacvars = Id.Set.add id globs.ltacvars}
-
-let add_name nam globs=
- match nam with
-     Anonymous -> globs
-   | Name id -> add_var id globs
-
-let intern_hyp iconstr globs = function
-    Hvar (loc,(id,topt)) -> add_var id globs,
-      Hvar (loc,(id,Option.map (intern_constr globs) topt))
-  | Hprop st -> add_name st.st_label globs,
-      Hprop (intern_statement iconstr globs st)
-
-let intern_hyps iconstr globs hyps =
-  snd (List.fold_map (intern_hyp iconstr) globs hyps)
-
-let intern_cut intern_it globs cut=
-  let nglobs,nstat=intern_it globs cut.cut_stat in
-    {cut_stat=nstat;
-     cut_by=intern_justification_items nglobs cut.cut_by;
-     cut_using=intern_justification_method nglobs cut.cut_using}
-
-let intern_casee globs = function
-    Real c -> Real (intern_constr globs c)
-  | Virtual cut -> Virtual
-      (intern_cut (intern_no_bind (intern_statement intern_constr)) globs cut)
-
-let intern_hyp_list args globs =
-  let intern_one globs (loc,(id,opttyp)) =
-    (add_var id globs),
-    (loc,(id,Option.map (intern_constr globs) opttyp)) in
-  List.fold_map intern_one globs args
-
-let intern_suffices_clause globs (hyps,c) =
-  let nglobs,nhyps = List.fold_map (intern_hyp intern_constr) globs hyps in
-    nglobs,(nhyps,intern_constr_or_thesis nglobs c)
-
-let intern_fundecl args body globs=
-  let nglobs,nargs = intern_hyp_list args globs in
-    nargs,intern_constr nglobs body
-
-let rec add_vars_of_simple_pattern globs = function
-    CPatAlias (loc,p,id) ->
-      add_vars_of_simple_pattern (add_var id globs) p
-(*      Loc.raise loc
-	(UserError ("simple_pattern",str "\"as\" is not allowed here"))*)
-  | CPatOr (loc, _)->
-      Loc.raise loc
-	(UserError ("simple_pattern",str "\"(_ | _)\" is not allowed here"))
-  | CPatDelimiters (_,_,p) ->
-      add_vars_of_simple_pattern globs p
-  | CPatCstr (_,_,pl1,pl2) ->
-    List.fold_left add_vars_of_simple_pattern
-      (Option.fold_left (List.fold_left add_vars_of_simple_pattern) globs pl1) pl2
-  | CPatNotation(_,_,(pl,pll),pl') ->
-      List.fold_left add_vars_of_simple_pattern globs (List.flatten (pl::pl'::pll))
-  | CPatAtom (_,Some (Libnames.Ident (_,id))) -> add_var id globs
-  |  _  -> globs
-
-let rec intern_bare_proof_instr globs = function
-    Pthus i -> Pthus (intern_bare_proof_instr globs i)
-  | Pthen i -> Pthen (intern_bare_proof_instr globs i)
-  | Phence i -> Phence (intern_bare_proof_instr globs i)
-  | Pcut c -> Pcut
-      (intern_cut
-	 (intern_no_bind (intern_statement intern_constr_or_thesis)) globs c)
-  | Psuffices c ->
-      Psuffices (intern_cut intern_suffices_clause globs c)
-  | Prew (s,c) -> Prew
-      (s,intern_cut
-	 (intern_no_bind  (intern_statement intern_constr)) globs c)
-  | Psuppose hyps -> Psuppose (intern_hyps intern_constr globs hyps)
-  | Pcase (params,pat,hyps) ->
-      let nglobs,nparams = intern_hyp_list params globs in
-      let nnglobs= add_vars_of_simple_pattern nglobs pat in
-      let nhyps = intern_hyps intern_constr_or_thesis nnglobs hyps in
-	Pcase (nparams,pat,nhyps)
-  | Ptake witl -> Ptake (List.map (intern_constr globs) witl)
-  | Pconsider (c,hyps) -> Pconsider (intern_constr globs c,
-				      intern_hyps intern_constr globs hyps)
-  | Pper (et,c) -> Pper (et,intern_casee globs c)
-  | Pend bt -> Pend bt
-  | Pescape -> Pescape
-  | Passume hyps -> Passume (intern_hyps intern_constr globs hyps)
-  | Pgiven hyps -> Pgiven (intern_hyps intern_constr globs hyps)
-  | Plet hyps -> Plet (intern_hyps intern_constr globs hyps)
-  | Pclaim st -> Pclaim (intern_statement intern_constr globs st)
-  | Pfocus st -> Pfocus (intern_statement intern_constr globs st)
-  | Pdefine (id,args,body) ->
-      let nargs,nbody = intern_fundecl args body globs in
-	Pdefine (id,nargs,nbody)
-  | Pcast (id,typ) ->
-      Pcast (id,intern_constr globs typ)
-
-let intern_proof_instr globs instr=
-  {emph = instr.emph;
-   instr = intern_bare_proof_instr globs instr.instr}
-
-(* INTERP *)
-
-let interp_justification_items env sigma =
-    Option.map (List.map (fun c -> fst (*FIXME*)(understand env sigma (fst c))))
-
-let interp_constr check_sort env sigma c =
-  if check_sort then
-    fst (understand env sigma ~expected_type:IsType (fst c) (* FIXME *))
-  else
-    fst (understand env sigma (fst c))
-
-let special_whd env =
-  let infos=CClosure.create_clos_infos CClosure.all env in
-    (fun t -> CClosure.whd_val infos (CClosure.inject t))
-
-let _eq = lazy (Universes.constr_of_global (Coqlib.glob_eq))
-
-let decompose_eq env id =
-  let typ = Environ.named_type id env in
-  let whd = special_whd env typ in
-    match kind_of_term whd with
-	App (f,args)->
-	  if eq_constr f (Lazy.force _eq) && Int.equal (Array.length args) 3
-	  then args.(0)
-	  else error "Previous step is not an equality."
-      | _ -> error "Previous step is not an equality."
-
-let get_eq_typ info env =
-  let typ = decompose_eq env (get_last env) in
-    typ
-
-let interp_constr_in_type typ env sigma c =
-  fst (understand env sigma (fst c) ~expected_type:(OfType typ))(*FIXME*)
-
-let interp_statement interp_it env sigma st =
-  {st_label=st.st_label;
-   st_it=interp_it env sigma st.st_it}
-
-let interp_constr_or_thesis check_sort env sigma = function
-    Thesis n -> Thesis n
-  | This c -> This (interp_constr check_sort env sigma c)
-
-let abstract_one_hyp inject h glob =
-  match h with
-      Hvar (loc,(id,None)) ->
-	GProd (Loc.ghost,Name id, Explicit, GHole (loc,Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), glob)
-    | Hvar (loc,(id,Some typ)) ->
-	GProd (Loc.ghost,Name id, Explicit, fst typ, glob)
-    | Hprop st ->
-	GProd (Loc.ghost,st.st_label, Explicit, inject st.st_it, glob)
-
-let glob_constr_of_hyps inject hyps head =
-  List.fold_right (abstract_one_hyp inject) hyps head
-
-let glob_prop = GSort (Loc.ghost,GProp)
-
-let rec match_hyps blend names constr = function
-    [] -> [],substl names constr
-  | hyp::q ->
-      let (name,typ,body)=destProd constr in
-      let st= {st_label=name;st_it=substl names typ} in
-      let qnames=
-	match name with
-	    Anonymous -> mkMeta 0 :: names
-	  | Name id -> mkVar id :: names in
-      let qhyp = match hyp with
-	  Hprop st' -> Hprop (blend st st')
-	| Hvar _ -> Hvar st in
-      let rhyps,head = match_hyps blend qnames body q in
-	qhyp::rhyps,head
-
-let interp_hyps_gen inject blend env sigma hyps head =
-  let constr= fst(*FIXME*) (understand env sigma (glob_constr_of_hyps inject hyps head)) in
-    match_hyps blend [] constr hyps
-
-let interp_hyps env sigma hyps = fst (interp_hyps_gen fst (fun x _ -> x) env sigma hyps glob_prop)
-
-let dummy_prefix= Id.of_string "__"
-
-let rec deanonymize ids =
-  function
-      PatVar (loc,Anonymous) ->
-	let (found,known) = !ids in
-	let new_id=Namegen.next_ident_away dummy_prefix known in
-	let _= ids:= (loc,new_id) :: found , new_id :: known in
-	  PatVar (loc,Name new_id)
-    | PatVar (loc,Name id) as pat ->
-	let (found,known) = !ids in
-	let _= ids:= (loc,id) :: found , known in
-	  pat
-    | PatCstr(loc,cstr,lpat,nam) ->
-	PatCstr(loc,cstr,List.map (deanonymize ids) lpat,nam)
-
-let rec glob_of_pat =
-  function
-      PatVar (loc,Anonymous) -> anomaly (Pp.str "Anonymous pattern variable")
-    | PatVar (loc,Name id) ->
-	  GVar (loc,id)
-    | PatCstr(loc,((ind,_) as cstr),lpat,_) ->
-	let mind= fst (Global.lookup_inductive ind) in
-	let rec add_params n q =
-	  if n<=0 then q else
-	    add_params (pred n) (GHole(Loc.ghost,
-				       Evar_kinds.TomatchTypeParameter(ind,n), Misctypes.IntroAnonymous, None)::q) in
-	    let args = List.map glob_of_pat lpat in
-	      glob_app(loc,GRef(Loc.ghost,Globnames.ConstructRef cstr,None),
-		   add_params mind.Declarations.mind_nparams args)
-
-let prod_one_hyp = function
-    (loc,(id,None)) ->
-      (fun glob ->
-	 GProd (Loc.ghost,Name id, Explicit,
-		GHole (loc,Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), glob))
-  | (loc,(id,Some typ)) ->
-      (fun glob ->
-	 GProd (Loc.ghost,Name id, Explicit, fst typ, glob))
-
-let prod_one_id (loc,id) glob =
-  GProd (Loc.ghost,Name id, Explicit,
-	 GHole (loc,Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), glob)
-
-let let_in_one_alias (id,pat) glob =
-  GLetIn (Loc.ghost,Name id, glob_of_pat pat, glob)
-
-let rec bind_primary_aliases map pat =
-  match pat with
-      PatVar (_,_) -> map
-    | PatCstr(loc,_,lpat,nam) ->
-	let map1 =
-	  match nam with
-	      Anonymous -> map
-	    | Name id -> (id,pat)::map
-	in
-	  List.fold_left bind_primary_aliases map1 lpat
-
-let bind_secondary_aliases map subst =
-  Id.Map.fold (fun ids idp map -> (ids,Id.List.assoc idp map)::map) subst map
-
-let bind_aliases patvars subst patt =
-  let map = bind_primary_aliases [] patt in
-  let map1 = bind_secondary_aliases map subst in
-  List.rev map1
-
-let interp_pattern env pat_expr =
-  let patvars,pats = Constrintern.intern_pattern env pat_expr in
-    match pats with
-	[] -> anomaly (Pp.str "empty pattern list")
-      | [subst,patt] ->
-	  (patvars,bind_aliases patvars subst patt,patt)
-      | _  -> anomaly (Pp.str "undetected disjunctive pattern")
-
-let rec match_args dest names constr = function
-    [] -> [],names,substl names constr
-  | _::q ->
-      let (name,typ,body)=dest constr in
-      let st={st_label=name;st_it=substl names typ} in
-      let qnames=
-	match name with
-	    Anonymous -> assert  false
-	  | Name id -> mkVar id :: names in
-      let args,bnames,body = match_args dest qnames body q in
-	st::args,bnames,body
-
-let rec match_aliases names constr = function
-    [] -> [],names,substl names constr
-  | _::q ->
-      let (name,c,typ,body)=destLetIn constr in
-      let st={st_label=name;st_it=(substl names c,substl names typ)} in
-      let qnames=
-	match name with
-	    Anonymous -> assert false
-	  | Name id -> mkVar id :: names in
-      let args,bnames,body = match_aliases qnames body q in
-	st::args,bnames,body
-
-let detype_ground env c = Detyping.detype false [] env Evd.empty c
-
-let interp_cases info env sigma params (pat:cases_pattern_expr) hyps =
-  let et,pinfo =
-    match info.pm_stack with
-	Per(et,pi,_,_)::_ -> et,pi
-      | _ -> error "No proof per cases/induction/inversion in progress." in
-  let mib,oib=Global.lookup_inductive  pinfo.per_ind in
-  let num_params = pinfo.per_nparams in
-  let _ =
-    let expected = mib.Declarations.mind_nparams - num_params in
-      if not (Int.equal (List.length params) expected) then
-	errorlabstrm "suppose it is" 
-	  (str "Wrong number of extra arguments: " ++ 
-	     (if Int.equal expected 0 then str "none" else int expected) ++ spc () ++
-	     str "expected.") in
-  let app_ind =
-    let rind = GRef (Loc.ghost,Globnames.IndRef pinfo.per_ind,None) in
-    let rparams = List.map (detype_ground env) pinfo.per_params in
-    let rparams_rec =
-      List.map
-	(fun (loc,(id,_)) ->
-	   GVar (loc,id)) params in
-    let dum_args=
-      List.init oib.Declarations.mind_nrealargs
-	(fun _ -> GHole (Loc.ghost,Evar_kinds.QuestionMark (Evar_kinds.Define false),Misctypes.IntroAnonymous, None)) in
-      glob_app(Loc.ghost,rind,rparams@rparams_rec@dum_args) in
-  let pat_vars,aliases,patt = interp_pattern env pat in
-  let inject = function
-      Thesis (Plain) -> Glob_term.GSort(Loc.ghost,GProp)
-    | Thesis (For rec_occ) ->
-	if not (Id.List.mem rec_occ pat_vars) then
-	  errorlabstrm "suppose it is"
-	    (str "Variable " ++ Nameops.pr_id rec_occ ++
-	       str " does not occur in pattern.");
-	Glob_term.GSort(Loc.ghost,GProp)
-    | This (c,_) -> c in
-  let term1 = glob_constr_of_hyps inject hyps glob_prop in
-  let loc_ids,npatt =
-    let rids=ref ([],pat_vars) in
-    let npatt= deanonymize rids patt in
-      List.rev (fst !rids),npatt in
-  let term2 =
-    GLetIn(Loc.ghost,Anonymous,
-	   GCast(Loc.ghost,glob_of_pat npatt,
-		 CastConv app_ind),term1) in
-  let term3=List.fold_right let_in_one_alias aliases term2 in
-  let term4=List.fold_right prod_one_id loc_ids term3 in
-  let term5=List.fold_right prod_one_hyp params term4 in
-  let constr = fst (understand env sigma term5)(*FIXME*) in
-  let tparams,nam4,rest4 = match_args destProd [] constr params in
-  let tpatvars,nam3,rest3 = match_args destProd nam4 rest4 loc_ids in
-  let taliases,nam2,rest2 = match_aliases nam3 rest3 aliases in
-  let (_,pat_pat,pat_typ,rest1) = destLetIn rest2 in
-  let blend st st' =
-    match st'.st_it with
-	Thesis nam -> {st_it=Thesis nam;st_label=st'.st_label}
-      | This _ -> {st_it = This st.st_it;st_label=st.st_label} in
-  let thyps = fst (match_hyps blend nam2 (Termops.pop rest1) hyps) in
-    tparams,{pat_vars=tpatvars;
-	     pat_aliases=taliases;
-	     pat_constr=pat_pat;
-	     pat_typ=pat_typ;
-	     pat_pat=patt;
-	     pat_expr=pat},thyps
-
-let interp_cut interp_it env sigma cut=
-  let nenv,nstat = interp_it env sigma cut.cut_stat in
-    { cut_using=Option.map (Tacinterp.Value.of_closure (Tacinterp.default_ist ())) cut.cut_using;
-       cut_stat=nstat;
-       cut_by=interp_justification_items nenv sigma cut.cut_by}
-
-let interp_no_bind interp_it env sigma x =
-  env,interp_it env sigma x
-
-let interp_suffices_clause env sigma (hyps,cot)=
-  let (locvars,_) as res =
-    match cot with
-	This (c,_) ->
-	  let nhyps,nc = interp_hyps_gen fst (fun x _ -> x) env sigma hyps c in
-	  nhyps,This nc
-      | Thesis Plain as th  -> interp_hyps env sigma hyps,th
-      | Thesis (For n) -> error "\"thesis for\" is not applicable here." in
-  let push_one hyp env0 =
-    match hyp with
-	(Hprop st | Hvar st) ->
-	  match st.st_label with
-	      Name id -> Environ.push_named (Context.Named.Declaration.LocalAssum (id,st.st_it)) env0
-	    | _ -> env in
-  let nenv = List.fold_right push_one locvars env in
-    nenv,res
-
-let interp_casee env sigma = function
-    Real c -> Real (fst (understand env sigma (fst c)))(*FIXME*)
-  | Virtual cut -> Virtual (interp_cut (interp_no_bind (interp_statement (interp_constr true))) env sigma cut)
-
-let abstract_one_arg = function
-    (loc,(id,None)) ->
-      (fun glob ->
-	 GLambda (Loc.ghost,Name id, Explicit,
-		GHole (loc,Evar_kinds.BinderType (Name id),Misctypes.IntroAnonymous,None), glob))
-  | (loc,(id,Some typ)) ->
-      (fun glob ->
-	 GLambda (Loc.ghost,Name id, Explicit, fst typ, glob))
-
-let glob_constr_of_fun args body =
-  List.fold_right abstract_one_arg args (fst body)
-
-let interp_fun env sigma args body =
-  let constr=fst (*FIXME*) (understand env sigma (glob_constr_of_fun args body)) in
-    match_args destLambda [] constr args
-
-let rec interp_bare_proof_instr info env sigma = function
-    Pthus i -> Pthus (interp_bare_proof_instr info env sigma i)
-  | Pthen i -> Pthen (interp_bare_proof_instr info env sigma i)
-  | Phence i -> Phence (interp_bare_proof_instr info env sigma i)
-  | Pcut c -> Pcut (interp_cut
-		      (interp_no_bind (interp_statement
-					 (interp_constr_or_thesis true)))
-		      env sigma c)
-  | Psuffices c ->
-      Psuffices (interp_cut interp_suffices_clause env sigma c)
-  | Prew (s,c) -> Prew (s,interp_cut
-			  (interp_no_bind (interp_statement
-			     (interp_constr_in_type (get_eq_typ info env))))
-			  env sigma c)
-
-  | Psuppose hyps -> Psuppose (interp_hyps env sigma hyps)
-  | Pcase (params,pat,hyps) ->
-      let tparams,tpat,thyps = interp_cases info env sigma params pat hyps in
-	Pcase (tparams,tpat,thyps)
-  | Ptake witl ->
-      Ptake (List.map (fun c -> fst (*FIXME*) (understand env sigma (fst c))) witl)
-  | Pconsider (c,hyps) -> Pconsider (interp_constr false env sigma c,
-				     interp_hyps env sigma hyps)
-  | Pper (et,c) -> Pper (et,interp_casee env sigma c)
-  | Pend bt -> Pend bt
-  | Pescape -> Pescape
-  | Passume hyps -> Passume (interp_hyps env sigma hyps)
-  | Pgiven hyps -> Pgiven (interp_hyps env sigma hyps)
-  | Plet hyps -> Plet (interp_hyps env sigma hyps)
-  | Pclaim st -> Pclaim (interp_statement (interp_constr true) env sigma st)
-  | Pfocus st -> Pfocus (interp_statement (interp_constr true) env sigma st)
-  | Pdefine (id,args,body) ->
-      let nargs,_,nbody = interp_fun env sigma args body in
-	Pdefine (id,nargs,nbody)
-  | Pcast (id,typ) ->
-      Pcast(id,interp_constr true env sigma typ)
-
-let interp_proof_instr info env sigma instr=
-  {emph = instr.emph;
-   instr = interp_bare_proof_instr info env sigma instr.instr}
-
-
-
diff --git a/plugins/decl_mode/decl_interp.mli b/plugins/decl_mode/decl_interp.mli
deleted file mode 100644
index 4303ecdb..00000000
--- a/plugins/decl_mode/decl_interp.mli
+++ /dev/null
@@ -1,15 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Tacintern
-open Decl_expr
-
-
-val intern_proof_instr : glob_sign -> raw_proof_instr -> glob_proof_instr
-val interp_proof_instr : Decl_mode.pm_info ->
-  Environ.env -> Evd.evar_map -> glob_proof_instr -> proof_instr
diff --git a/plugins/decl_mode/decl_mode.ml b/plugins/decl_mode/decl_mode.ml
deleted file mode 100644
index 92d40890..00000000
--- a/plugins/decl_mode/decl_mode.ml
+++ /dev/null
@@ -1,136 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Term
-open Evd
-open CErrors
-open Util
-
-let daimon_flag = ref false
-
-let set_daimon_flag () = daimon_flag:=true
-let clear_daimon_flag () = daimon_flag:=false
-let get_daimon_flag () = !daimon_flag
-
-
-
-
-type split_tree=
-    Skip_patt of Id.Set.t * split_tree
-  | Split_patt of Id.Set.t * inductive *
-		(bool array * (Id.Set.t * split_tree) option) array
-  | Close_patt of split_tree
-  | End_patt of (Id.t * (int * int))
-
-type elim_kind =
-    EK_dep of split_tree
-  | EK_nodep
-  | EK_unknown
-
-type recpath = int option*Declarations.wf_paths
-
-type per_info =
-    {per_casee:constr;
-     per_ctype:types;
-     per_ind:inductive;
-     per_pred:constr;
-     per_args:constr list;
-     per_params:constr list;
-     per_nparams:int;
-     per_wf:recpath}
-
-type stack_info =
-    Per of Decl_expr.elim_type * per_info * elim_kind * Id.t list
-  | Suppose_case
-  | Claim
-  | Focus_claim
-
-type pm_info =
-    { pm_stack : stack_info list}
-let info = Store.field ()
-
-
-(* Current proof mode *)
-
-type command_mode =
-    Mode_tactic
-  | Mode_proof
-  | Mode_none
-
-let mode_of_pftreestate pts =
-  (* spiwack: it used to be "top_goal_..." but this should be fine *)
-  let { it = goals ; sigma = sigma } = Proof.V82.subgoals pts in
-  let goal = List.hd goals in
-  match Store.get (Goal.V82.extra sigma goal) info with
-  | None -> Mode_tactic 
-  | Some _ -> Mode_proof
-	  
-let get_current_mode () =
-  try 
-    mode_of_pftreestate (Pfedit.get_pftreestate ())
-  with Proof_global.NoCurrentProof -> Mode_none
-
-let check_not_proof_mode str =
- match get_current_mode () with
- | Mode_proof -> error str
- | _ -> ()
-
-let get_info sigma gl=
-  match Store.get (Goal.V82.extra sigma gl) info with
-  | None ->  invalid_arg "get_info"
-  | Some pm -> pm
-
-let try_get_info sigma gl =
-  Store.get (Goal.V82.extra sigma gl) info
-
-let get_goal_stack pts =
-  let { it = goals ; sigma = sigma } = Proof.V82.subgoals pts in
-  let info = get_info sigma (List.hd goals) in
-  info.pm_stack
-
-
-let proof_focus = Proof.new_focus_kind ()
-let proof_cond = Proof.done_cond proof_focus
-
-let focus p =
-  let inf = get_goal_stack p in
-  Proof_global.simple_with_current_proof (fun _ -> Proof.focus proof_cond inf 1)
-
-let unfocus () =
-  Proof_global.simple_with_current_proof (fun _ p -> Proof.unfocus proof_focus p ())
-
-let get_top_stack pts =
-  try
-    Proof.get_at_focus proof_focus pts
-  with Proof.NoSuchFocus ->
-    let { it = gl ; sigma = sigma } = Proof.V82.top_goal pts in
-    let info = get_info sigma gl in
-    info.pm_stack
-
-let get_stack pts = Proof.get_at_focus proof_focus pts
-
-let get_last env = match Environ.named_context env with
-  | decl :: _ -> Context.Named.Declaration.get_id decl
-  | [] -> error "no previous statement to use"
-
-
-let get_end_command pts =
-  match get_top_stack pts with
-  | [] -> "\"end proof\""
-  | Claim::_ -> "\"end claim\""
-  | Focus_claim::_-> "\"end focus\""
-  | Suppose_case :: Per (et,_,_,_) :: _ | Per (et,_,_,_) :: _  ->
-      begin
-	match et with
-	  Decl_expr.ET_Case_analysis ->
-	    "\"end cases\" or start a new case"
-	| Decl_expr.ET_Induction ->
-	    "\"end induction\" or start a new case"
-      end
-  | _ -> anomaly (Pp.str"lonely suppose")
diff --git a/plugins/decl_mode/decl_mode.mli b/plugins/decl_mode/decl_mode.mli
deleted file mode 100644
index dfeee833..00000000
--- a/plugins/decl_mode/decl_mode.mli
+++ /dev/null
@@ -1,79 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Term
-open Evd
-
-val set_daimon_flag : unit -> unit
-val clear_daimon_flag : unit -> unit
-val get_daimon_flag : unit -> bool
-
-type command_mode =
-    Mode_tactic
-  | Mode_proof
-  | Mode_none
-
-val mode_of_pftreestate : Proof.proof -> command_mode
-
-val get_current_mode : unit -> command_mode
-
-val check_not_proof_mode : string -> unit
-
-type split_tree=
-    Skip_patt of Id.Set.t * split_tree
-  | Split_patt of Id.Set.t * inductive *
-		(bool array * (Id.Set.t * split_tree) option) array
-  | Close_patt of split_tree
-  | End_patt of (Id.t * (int * int))
-
-type elim_kind =
-    EK_dep of split_tree
-  | EK_nodep
-  | EK_unknown
-
-type recpath = int option*Declarations.wf_paths
-
-type per_info =
-    {per_casee:constr;
-     per_ctype:types;
-     per_ind:inductive;
-     per_pred:constr;
-     per_args:constr list;
-     per_params:constr list;
-     per_nparams:int;
-     per_wf:recpath}
-
-type stack_info =
-    Per of Decl_expr.elim_type * per_info * elim_kind * Names.Id.t list
-  | Suppose_case
-  | Claim
-  | Focus_claim
-
-type pm_info =
-    {pm_stack : stack_info list }
-
-val info : pm_info Store.field
-
-val get_info : Evd.evar_map -> Proof_type.goal -> pm_info
-
-val try_get_info : Evd.evar_map -> Proof_type.goal -> pm_info option
-
-val get_stack : Proof.proof -> stack_info list
-
-val get_top_stack : Proof.proof -> stack_info list
-
-val get_last:  Environ.env -> Id.t
-(** [get_last] raises a [UserError] when it cannot find a previous
-    statement in the environment. *)
-
-val get_end_command : Proof.proof -> string
-
-val focus : Proof.proof -> unit
-
-val unfocus : unit -> unit
diff --git a/plugins/decl_mode/decl_mode_plugin.mlpack b/plugins/decl_mode/decl_mode_plugin.mlpack
deleted file mode 100644
index 1b84a079..00000000
--- a/plugins/decl_mode/decl_mode_plugin.mlpack
+++ /dev/null
@@ -1,5 +0,0 @@
-Decl_mode
-Decl_interp
-Decl_proof_instr
-Ppdecl_proof
-G_decl_mode
diff --git a/plugins/decl_mode/decl_proof_instr.ml b/plugins/decl_mode/decl_proof_instr.ml
deleted file mode 100644
index d30fcf60..00000000
--- a/plugins/decl_mode/decl_proof_instr.ml
+++ /dev/null
@@ -1,1552 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open CErrors
-open Util
-open Pp
-open Evd
-
-open Tacmach
-open Tacintern
-open Decl_expr
-open Decl_mode
-open Decl_interp
-open Glob_term
-open Glob_ops
-open Names
-open Nameops
-open Declarations
-open Tactics
-open Tacticals
-open Term
-open Vars
-open Termops
-open Namegen
-open Goptions
-open Misctypes
-open Sigma.Notations
-open Context.Named.Declaration
-
-(* Strictness option *)
-
-let clear ids { it = goal; sigma } =
-  let ids = List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty ids in
-  let env = Goal.V82.env sigma goal in
-  let sign = Goal.V82.hyps sigma goal in
-  let cl = Goal.V82.concl sigma goal in
-  let evdref = ref (Evd.clear_metas sigma) in
-  let (hyps, concl) =
-    try Evarutil.clear_hyps_in_evi env evdref sign cl ids
-    with Evarutil.ClearDependencyError (id, _) ->
-      errorlabstrm "" (str "Cannot clear " ++ pr_id id)
-  in
-  let sigma = !evdref in
-  let (gl,ev,sigma) = Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) in
-  let sigma = Goal.V82.partial_solution_to sigma goal gl ev in
-  { it = [gl]; sigma }
-
-let get_its_info gls = get_info gls.sigma gls.it
-
-let get_strictness,set_strictness =
-  let strictness = ref false in
-    (fun () -> (!strictness)),(fun b -> strictness:=b)
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "strict proofs";
-      optkey   = ["Strict";"Proofs"];
-      optread  = get_strictness;
-      optwrite = set_strictness }
-
-let tcl_change_info_gen info_gen =
-  (fun gls ->
-     let it = sig_it gls in
-     let concl = pf_concl gls in
-     let hyps = Goal.V82.hyps (project gls) it in
-     let extra = Goal.V82.extra (project gls) it in
-     let (gl,ev,sigma) = Goal.V82.mk_goal (project gls) hyps concl (info_gen extra) in
-     let sigma = Goal.V82.partial_solution sigma it ev in
-     { it = [gl] ; sigma= sigma; } )
-
-let tcl_change_info info gls =
-  let info_gen s = Store.set s Decl_mode.info info in
-  tcl_change_info_gen info_gen gls
-
-let tcl_erase_info gls =
-  let info_gen s = Store.remove s Decl_mode.info in
-  tcl_change_info_gen info_gen gls
-
-let special_whd gl=
-  let infos=CClosure.create_clos_infos CClosure.all (pf_env gl) in
-    (fun t -> CClosure.whd_val infos (CClosure.inject t))
-
-let special_nf gl=
-  let infos=CClosure.create_clos_infos CClosure.betaiotazeta (pf_env gl) in
-    (fun t -> CClosure.norm_val infos (CClosure.inject t))
-
-let is_good_inductive env ind =
-  let mib,oib = Inductive.lookup_mind_specif env ind in
-    Int.equal oib.mind_nrealargs 0 && not (Inductiveops.mis_is_recursive (ind,mib,oib))
-
-let check_not_per pts =
-  if not (Proof.is_done pts) then
-    match get_stack pts with
-	Per (_,_,_,_)::_ ->
-	  error "You are inside a proof per cases/induction.\n\
-Please \"suppose\" something or \"end\" it now."
-      | _ -> ()
-
-let mk_evd metalist gls =
-  let evd0= clear_metas (sig_sig gls) in
-  let add_one (meta,typ) evd =
-    meta_declare meta typ evd in
-    List.fold_right add_one metalist evd0
-
-let is_tmp id = (Id.to_string id).[0] == '_'
-
-let tmp_ids gls =
-  let ctx = pf_hyps gls in
-    match ctx with
-	[] -> []
-      | _::q -> List.filter is_tmp (ids_of_named_context q)
-
-let clean_tmp gls =
-  let clean_id id0 gls0 =
-      tclTRY (clear [id0]) gls0 in
-  let rec clean_all = function
-      [] -> tclIDTAC
-    | id :: rest -> tclTHEN (clean_id id) (clean_all rest)
-  in
-    clean_all (tmp_ids gls) gls
-
-let assert_postpone id t =
-  assert_before (Name id) t
-
-(* start a proof *)
-
-
-let start_proof_tac gls=
-  let info={pm_stack=[]} in
-  tcl_change_info info gls
-
-let go_to_proof_mode () =
-  ignore (Pfedit.by (Proofview.V82.tactic start_proof_tac));
-  let p = Proof_global.give_me_the_proof () in
-  Decl_mode.focus p
-
-(* closing gaps *)
-
-(* spiwack: should use [Proofview.give_up] but that would require
-   moving the whole declarative mode into the new proof engine.  It
-   will eventually have to be done.
-
-   As far as I can tell, [daimon_tac] is used after a [thus thesis],
-   it will leave uninstantiated variables instead of giving a relevant
-   message at [Qed]. *)
-let daimon_tac gls =
-  set_daimon_flag ();
-  {it=[];sigma=sig_sig gls;}
-
-let daimon_instr env p =
-  let (p,(status,_)) =
-    Proof.run_tactic env begin
-      Proofview.tclINDEPENDENT Proofview.give_up
-    end p
-  in
-  p,status
-
-let do_daimon () =
-  let env = Global.env () in
-  let status =
-    Proof_global.with_current_proof begin fun _ p ->
-      daimon_instr env p
-    end
-  in
-  if not status then Feedback.feedback Feedback.AddedAxiom else ()
-
-(* post-instruction focus management *)
-
-let goto_current_focus () = 
-  Decl_mode.unfocus ()
-
-(* spiwack: used to catch errors indicating lack of "focusing command"
-   in the proof tree. In the current implementation, however, entering
-   the declarative mode puts a focus first, there should, therefore,
-   never be exception raised here. *)
-let goto_current_focus_or_top () =
-  goto_current_focus ()
-
-(* return *)
-
-let close_tactic_mode () =
-  try do_daimon ();goto_current_focus ()
-  with Not_found ->
-    error "\"return\" cannot be used outside of Declarative Proof Mode."
-
-let return_from_tactic_mode () =
-  close_tactic_mode ()
-
-(* end proof/claim *)
-
-let close_block bt pts =
-    if Proof.no_focused_goal pts then
-      goto_current_focus ()
-    else
-      let stack =
-	if Proof.is_done pts then
-	  get_top_stack pts
-	else
-	  get_stack pts 
-      in
-      match bt,stack with
-	B_claim, Claim::_ | B_focus, Focus_claim::_ | B_proof, [] ->
-	  do_daimon ();goto_current_focus ()
-      | _, Claim::_ ->
-	  error "\"end claim\" expected."
-      | _, Focus_claim::_ ->
-	  error "\"end focus\" expected."
-      | _, [] ->
- 	  error "\"end proof\" expected."
-      | _, (Per (et,_,_,_)::_|Suppose_case::Per (et,_,_,_)::_) ->
-	  begin
-	    match et with
-		ET_Case_analysis -> error "\"end cases\" expected."
-	      | ET_Induction ->  error "\"end induction\" expected."
-	  end
-      | _,_ -> anomaly (Pp.str "Lonely suppose on stack.")
-
-
-(* utility for suppose / suppose it is *)
-
-let close_previous_case pts =
-  if
-    Proof.is_done pts
-  then
-    match get_top_stack pts with
-	Per (et,_,_,_) :: _ -> anomaly (Pp.str "Weird case occurred ...")
-      | Suppose_case :: Per (et,_,_,_) :: _ ->
-	  goto_current_focus ()
-      | _ -> error "Not inside a proof per cases or induction."
-  else
-    match get_stack pts with
-	Per (et,_,_,_) :: _ -> ()
-      | Suppose_case :: Per (et,_,_,_) :: _ ->
-	  do_daimon ();goto_current_focus ()
-      | _ -> error "Not inside a proof per cases or induction."
-
-(* Proof instructions *)
-
-(* automation *)
-
-let filter_hyps f gls =
-  let filter_aux id =
-    let id = get_id id in
-    if f id then
-      tclIDTAC
-    else
-      tclTRY (clear [id])  in
-    tclMAP filter_aux (pf_hyps gls) gls
-
-let local_hyp_prefix = Id.of_string "___"
-
-let add_justification_hyps keep items gls =
-  let add_aux c gls=
-    match kind_of_term c with
-	Var id ->
-	  keep:=Id.Set.add id !keep;
-	  tclIDTAC gls
-      | _ ->
-	  let id=pf_get_new_id local_hyp_prefix gls in
-	    keep:=Id.Set.add id !keep;
-	    tclTHEN (Proofview.V82.of_tactic (letin_tac None (Names.Name id) c None Locusops.nowhere))
-              (Proofview.V82.of_tactic (clear_body [id])) gls in
-    tclMAP add_aux items gls
-
-let prepare_goal items gls =
-  let tokeep = ref Id.Set.empty in
-  let auxres = add_justification_hyps tokeep items gls in
-   tclTHENLIST
-     [ (fun _ -> auxres);
-       filter_hyps (let keep = !tokeep in fun id -> Id.Set.mem id keep)] gls
-
-let my_automation_tac = ref
-  (Proofview.tclZERO (CErrors.make_anomaly (Pp.str"No automation registered")))
-
-let register_automation_tac tac = my_automation_tac:= tac
-
-let automation_tac = Proofview.tclBIND (Proofview.tclUNIT ()) (fun () -> !my_automation_tac)
-
-let warn_insufficient_justification =
-  CWarnings.create ~name:"declmode-insufficient-justification" ~category:"declmode"
-    (fun () -> strbrk "Insufficient justification.")
-
-let justification tac gls=
-    tclORELSE
-      (tclSOLVE [tclTHEN tac (Proofview.V82.of_tactic assumption)])
-      (fun gls ->
-	 if get_strictness () then
-	   error "Insufficient justification."
-	 else
-	   begin
-             warn_insufficient_justification ();
-	     daimon_tac gls
-	   end) gls
-
-let default_justification elems gls=
-  justification (tclTHEN (prepare_goal elems) (Proofview.V82.of_tactic automation_tac)) gls
-
-(* code for conclusion refining *)
-
-let constant dir s = lazy (Coqlib.gen_constant "Declarative" dir s)
-
-let _and       = constant ["Init";"Logic"] "and"
-
-let _and_rect  = constant ["Init";"Logic"] "and_rect"
-
-let _prod      = constant ["Init";"Datatypes"] "prod"
-
-let _prod_rect = constant ["Init";"Datatypes"] "prod_rect"
-
-let _ex        = constant ["Init";"Logic"] "ex"
-
-let _ex_ind    = constant ["Init";"Logic"] "ex_ind"
-
-let _sig       = constant ["Init";"Specif"] "sig"
-
-let _sig_rect  = constant ["Init";"Specif"] "sig_rect"
-
-let _sigT      = constant ["Init";"Specif"] "sigT"
-
-let _sigT_rect = constant ["Init";"Specif"] "sigT_rect"
-
-type stackd_elt =
-{se_meta:metavariable;
- se_type:types;
- se_last_meta:metavariable;
- se_meta_list:(metavariable*types) list;
- se_evd: evar_map}
-
-let rec replace_in_list m l = function
-    [] -> raise Not_found
-  | c::q -> if Int.equal m (fst c) then l@q else c::replace_in_list m l q
-
-let enstack_subsubgoals env se stack gls=
-  let hd,params = decompose_app (special_whd gls se.se_type) in
-    match kind_of_term hd with
-	Ind (ind,u as indu) when is_good_inductive env ind -> (* MS: FIXME *)
-	  let mib,oib=
-	    Inductive.lookup_mind_specif env ind in
-          let gentypes=
-            Inductive.arities_of_constructors indu (mib,oib) in
-	  let process i gentyp =
-	    let constructor = mkConstructU ((ind,succ i),u)
-	      (* constructors numbering*) in
-	    let appterm = applist (constructor,params) in
-	    let apptype = prod_applist gentyp params in
-	    let rc,_ = Reduction.dest_prod env apptype in
-	    let rec meta_aux last lenv = function
-		[] -> (last,lenv,[])
-	      | decl::q ->
-		  let nlast=succ last in
-		  let (llast,holes,metas) =
-		    meta_aux nlast (mkMeta nlast :: lenv) q in
-                    let open Context.Rel.Declaration in
-		    (llast,holes,(nlast,special_nf gls (substl lenv (get_type decl)))::metas) in
-	    let (nlast,holes,nmetas) =
-		meta_aux se.se_last_meta [] (List.rev rc) in
-	    let refiner = applist (appterm,List.rev holes) in
-	    let evd = meta_assign se.se_meta
-              (refiner,(Conv,TypeProcessed (* ? *))) se.se_evd in
-	    let ncreated = replace_in_list
-	      se.se_meta nmetas se.se_meta_list in
-	    let evd0 = List.fold_left
-	      (fun evd (m,typ) -> meta_declare m typ evd) evd nmetas in
-	      List.iter (fun (m,typ) ->
-			   Stack.push
-			     {se_meta=m;
-			      se_type=typ;
-			      se_evd=evd0;
-			      se_meta_list=ncreated;
-			      se_last_meta=nlast} stack) (List.rev nmetas)
-	  in
-	    Array.iteri process gentypes
-      | _ -> ()
-
-let rec nf_list evd =
-  function
-      [] -> []
-    | (m,typ)::others ->
-	if meta_defined evd m then
-	    nf_list evd others
-	else
-	  (m,Reductionops.nf_meta evd typ)::nf_list evd others
-
-let find_subsubgoal c ctyp skip submetas gls =
-  let env= pf_env gls in
-  let concl = pf_concl gls in
-  let evd = mk_evd ((0,concl)::submetas) gls in
-  let stack = Stack.create () in
-  let max_meta =
-      List.fold_left (fun a (m,_) -> max a m) 0 submetas in
-  let _ = Stack.push
-		{se_meta=0;
-		 se_type=concl;
-		 se_last_meta=max_meta;
-		 se_meta_list=[0,concl];
-		 se_evd=evd} stack  in
-  let rec dfs n =
-    let se = Stack.pop stack in
-      try
-	let unifier =
-	  Unification.w_unify env se.se_evd Reduction.CUMUL
-	    ~flags:(Unification.elim_flags ()) ctyp se.se_type in
-	  if n <= 0 then
-	      {se with
-		 se_evd=meta_assign se.se_meta
-                  (c,(Conv,TypeNotProcessed (* ?? *))) unifier;
-	         se_meta_list=replace_in_list
-		  se.se_meta submetas se.se_meta_list}
-	  else
-	      dfs (pred n)
-      with e when CErrors.noncritical e ->
-	begin
-	  enstack_subsubgoals env se stack gls;
-	  dfs n
-	end in
-  let nse= try dfs skip with Stack.Empty -> raise Not_found in
-    nf_list nse.se_evd nse.se_meta_list,Reductionops.nf_meta nse.se_evd (mkMeta 0)
-
-let concl_refiner metas body gls =
-  let concl = pf_concl gls in
-  let evd = sig_sig gls in
-  let env = pf_env gls in
-  let sort = family_of_sort (Typing.e_sort_of env (ref evd) concl) in
-  let rec aux env avoid subst = function
-      [] -> anomaly ~label:"concl_refiner" (Pp.str "cannot happen")
-    | (n,typ)::rest ->
-	let _A = subst_meta subst typ in
-	let x = id_of_name_using_hdchar env _A Anonymous in
-	let _x = fresh_id avoid x gls in
-	let nenv = Environ.push_named (LocalAssum (_x,_A)) env in
-	let asort = family_of_sort (Typing.e_sort_of nenv (ref evd) _A) in
-	let nsubst = (n,mkVar _x)::subst in
-	  if List.is_empty rest then
-	    asort,_A,mkNamedLambda _x _A (subst_meta nsubst body)
-	  else
-	    let bsort,_B,nbody =
-	      aux nenv (_x::avoid) ((n,mkVar _x)::subst) rest in
-	    let body = mkNamedLambda _x _A nbody in
-	      if occur_term (mkVar _x) _B then
-	        begin
-		  let _P = mkNamedLambda _x _A _B in
-		    match bsort,sort with
-			InProp,InProp ->
-			  let _AxB = mkApp(Lazy.force _ex,[|_A;_P|]) in
-			    InProp,_AxB,
-			  mkApp(Lazy.force _ex_ind,[|_A;_P;concl;body|])
-		    | InProp,_ ->
-			let _AxB = mkApp(Lazy.force _sig,[|_A;_P|]) in
-			let _P0 = mkLambda(Anonymous,_AxB,concl) in
-			  InType,_AxB,
-			mkApp(Lazy.force _sig_rect,[|_A;_P;_P0;body|])
-		    | _,_ ->
-			let _AxB = mkApp(Lazy.force _sigT,[|_A;_P|]) in
-			let _P0 = mkLambda(Anonymous,_AxB,concl) in
-			  InType,_AxB,
-			mkApp(Lazy.force _sigT_rect,[|_A;_P;_P0;body|])
-		end
-	      else
-		begin
-		  match asort,bsort with
-		      InProp,InProp ->
-			let _AxB = mkApp(Lazy.force _and,[|_A;_B|]) in
-			  InProp,_AxB,
-		     mkApp(Lazy.force _and_rect,[|_A;_B;concl;body|])
-		    |_,_ ->
-		       let _AxB = mkApp(Lazy.force _prod,[|_A;_B|]) in
-		       let _P0 = mkLambda(Anonymous,_AxB,concl) in
-			 InType,_AxB,
-			mkApp(Lazy.force _prod_rect,[|_A;_B;_P0;body|])
-		end
-  in
-  let (_,_,prf) = aux env [] [] metas in
-    mkApp(prf,[|mkMeta 1|])
-
-let thus_tac c ctyp submetas gls =
-  let list,proof =
-    try
-      find_subsubgoal c ctyp 0 submetas gls
-    with Not_found ->
-      error "I could not relate this statement to the thesis." in
-  if List.is_empty list then
-    Proofview.V82.of_tactic (exact_check proof) gls
-  else
-    let refiner = concl_refiner list proof gls in
-      Tacmach.refine refiner gls
-
-(* general forward step *)
-
-let mk_stat_or_thesis info gls = function
-    This c -> c
-  | Thesis (For _ ) ->
-      error "\"thesis for ...\" is not applicable here."
-  | Thesis Plain -> pf_concl gls
-
-let just_tac _then cut info gls0 =
-  let last_item =
-    if _then then
-      try [mkVar (get_last (pf_env gls0))]
-      with UserError _ ->
-	error "\"then\" and \"hence\" require at least one previous fact"
-    else []
-  in
-  let items_tac gls = 
-    match cut.cut_by with
-	None -> tclIDTAC gls
-      | Some items -> prepare_goal (last_item@items) gls in
-  let method_tac gls =
-    match cut.cut_using with
-        None ->
-	  Proofview.V82.of_tactic automation_tac gls
-      | Some tac ->
-	  Proofview.V82.of_tactic (Tacinterp.tactic_of_value (Tacinterp.default_ist ()) tac) gls in
-    justification (tclTHEN items_tac method_tac) gls0
-
-let instr_cut mkstat _thus _then cut gls0 =
-  let info = get_its_info gls0 in
-  let stat = cut.cut_stat in
-  let (c_id,_) = match stat.st_label with
-      Anonymous ->
-	pf_get_new_id (Id.of_string "_fact") gls0,false
-    | Name id -> id,true in
-  let c_stat = mkstat info gls0 stat.st_it in
-  let thus_tac gls=
-    if _thus then
-      thus_tac (mkVar c_id) c_stat [] gls
-    else tclIDTAC gls in
-    tclTHENS (Proofview.V82.of_tactic (assert_postpone c_id c_stat))
-      [tclTHEN tcl_erase_info (just_tac _then cut info);
-       thus_tac] gls0
-
-
-(* iterated equality *)
-let _eq = lazy (Universes.constr_of_global (Coqlib.glob_eq))
-
-let decompose_eq id gls =
-  let typ = pf_get_hyp_typ gls id in
-  let whd =  (special_whd gls typ) in
-    match kind_of_term whd with
-	App (f,args)->
-	  if eq_constr f (Lazy.force _eq) && Int.equal (Array.length args) 3
-	  then (args.(0),
-		args.(1),
-		args.(2))
-	  else error "Previous step is not an equality."
-      | _ -> error "Previous step is not an equality."
-
-let instr_rew _thus rew_side cut gls0 =
-  let last_id =
-    try get_last (pf_env gls0)
-    with UserError _ -> error "No previous equality."
-  in
-  let typ,lhs,rhs = decompose_eq last_id gls0 in
-  let items_tac gls =
-    match cut.cut_by with
-	None -> tclIDTAC gls
-      | Some items -> prepare_goal items gls in
-  let method_tac gls =
-    match cut.cut_using with
-        None ->
-	  Proofview.V82.of_tactic automation_tac gls
-      | Some tac ->
-	  Proofview.V82.of_tactic (Tacinterp.tactic_of_value (Tacinterp.default_ist ()) tac) gls in
-  let just_tac gls =
-    justification (tclTHEN items_tac method_tac) gls in
-  let (c_id,_) = match cut.cut_stat.st_label with
-      Anonymous ->
-	pf_get_new_id (Id.of_string "_eq") gls0,false
-    | Name id -> id,true in
-  let thus_tac new_eq gls=
-    if _thus then
-      thus_tac (mkVar c_id) new_eq [] gls
-    else tclIDTAC gls in
-    match rew_side with
-	Lhs ->
-	  let new_eq = mkApp(Lazy.force _eq,[|typ;cut.cut_stat.st_it;rhs|]) in
-	    tclTHENS (Proofview.V82.of_tactic (assert_postpone c_id new_eq))
-	      [tclTHEN tcl_erase_info
-		 (tclTHENS (Proofview.V82.of_tactic (transitivity lhs))
-		    [just_tac;Proofview.V82.of_tactic (exact_check (mkVar last_id))]);
-	       thus_tac new_eq] gls0
-      | Rhs ->
-	  let new_eq = mkApp(Lazy.force _eq,[|typ;lhs;cut.cut_stat.st_it|]) in
-	    tclTHENS (Proofview.V82.of_tactic (assert_postpone c_id new_eq))
-	      [tclTHEN tcl_erase_info
-		 (tclTHENS (Proofview.V82.of_tactic (transitivity rhs))
-		    [Proofview.V82.of_tactic (exact_check (mkVar last_id));just_tac]);
-	       thus_tac new_eq] gls0
-
-
-(* tactics for claim/focus *)
-
-let instr_claim _thus st gls0 =
-  let info = get_its_info gls0 in
-  let (id,_) = match st.st_label with
-      Anonymous -> pf_get_new_id (Id.of_string "_claim") gls0,false
-    | Name id -> id,true in
-  let thus_tac gls=
-    if _thus then
-      thus_tac (mkVar id) st.st_it [] gls
-    else tclIDTAC gls in
-  let ninfo1 = {pm_stack=
-      (if _thus then Focus_claim else Claim)::info.pm_stack} in
-    tclTHENS (Proofview.V82.of_tactic (assert_postpone id st.st_it))
-      [thus_tac;
-       tcl_change_info ninfo1] gls0
-
-(* tactics for assume *)
-
-let push_intro_tac coerce nam gls =
-      let (hid,_) =
-	match nam with
-	    Anonymous -> pf_get_new_id (Id.of_string "_hyp") gls,false
-	  | Name id -> id,true in
-	tclTHENLIST
-	  [Proofview.V82.of_tactic (intro_mustbe_force hid);
-	   coerce hid]
-	  gls
-
-let assume_tac hyps gls =
-  List.fold_right
-    (fun (Hvar st | Hprop st) ->
-       tclTHEN
-	 (push_intro_tac
-	    (fun id ->
-	       Proofview.V82.of_tactic (convert_hyp (LocalAssum (id,st.st_it)))) st.st_label))
-	 hyps tclIDTAC gls
-
-let assume_hyps_or_theses hyps gls =
-  List.fold_right
-    (function
-	 (Hvar {st_label=nam;st_it=c} | Hprop {st_label=nam;st_it=This c}) ->
-	   tclTHEN
-	     (push_intro_tac
-		(fun id ->
-		   Proofview.V82.of_tactic (convert_hyp (LocalAssum (id,c)))) nam)
-       | Hprop {st_label=nam;st_it=Thesis (tk)} ->
-	   tclTHEN
-	     (push_intro_tac
-		(fun id -> tclIDTAC) nam))
-    hyps tclIDTAC gls
-
-let assume_st hyps gls =
-  List.fold_right
-    (fun st ->
-       tclTHEN
-	 (push_intro_tac
-	    (fun id -> Proofview.V82.of_tactic (convert_hyp (LocalAssum (id,st.st_it)))) st.st_label))
-	 hyps tclIDTAC gls
-
-let assume_st_letin hyps gls =
-  List.fold_right
-    (fun st ->
-       tclTHEN
-	 (push_intro_tac
-	    (fun id ->
-	       Proofview.V82.of_tactic (convert_hyp (LocalDef (id, fst st.st_it, snd st.st_it)))) st.st_label))
-	 hyps tclIDTAC gls
-
-(* suffices *)
-
-let rec metas_from n hyps =
-  match hyps with
-      _ :: q -> n :: metas_from (succ n) q
-    | [] -> []
-
-let rec build_product args body =
-  match args with
-      (Hprop st| Hvar st )::rest ->
-	let pprod= lift 1 (build_product rest body) in
-	let lbody =
-	  match st.st_label with
-	      Anonymous -> pprod
-	    | Name id -> subst_term (mkVar id) pprod in
-	  mkProd (st.st_label, st.st_it, lbody)
-    | [] -> body
-
-let rec build_applist prod = function
-    [] -> [],prod
-  | n::q ->
-      let (_,typ,_) = destProd prod in
-      let ctx,head = build_applist (prod_applist prod [mkMeta n]) q in
-	(n,typ)::ctx,head
-
-let instr_suffices _then cut gls0 =
-  let info = get_its_info gls0 in
-  let c_id = pf_get_new_id (Id.of_string "_cofact") gls0 in
-  let ctx,hd = cut.cut_stat in
-  let c_stat = build_product ctx (mk_stat_or_thesis info gls0 hd) in
-  let metas = metas_from 1 ctx in
-  let c_ctx,c_head = build_applist c_stat metas in
-  let c_term = applist (mkVar c_id,List.map mkMeta metas) in
-  let thus_tac gls=
-    thus_tac c_term c_head c_ctx gls in
-   tclTHENS (Proofview.V82.of_tactic (assert_postpone c_id c_stat))
-     [tclTHENLIST
-	 [ assume_tac ctx;
-	   tcl_erase_info;
-	   just_tac _then cut info];
-      thus_tac] gls0
-
-(* tactics for consider/given *)
-
-let conjunction_arity id gls =
-  let typ = pf_get_hyp_typ gls id  in
-  let hd,params = decompose_app (special_whd gls typ) in
-  let env =pf_env gls in
-    match kind_of_term hd with
-	Ind (ind,u as indu) when is_good_inductive env ind ->
-	  let mib,oib=
-	    Inductive.lookup_mind_specif env ind in
-          let gentypes=
-            Inductive.arities_of_constructors indu (mib,oib) in
-	  let _ = if not (Int.equal (Array.length gentypes) 1) then raise Not_found in
-	  let apptype = prod_applist gentypes.(0) params in
-	  let rc,_ = Reduction.dest_prod env apptype in
-	    List.length rc
-      | _ -> raise Not_found
-
-let rec intron_then n ids ltac gls =
-  if n<=0 then
-    ltac ids gls
-  else
-    let id = pf_get_new_id (Id.of_string "_tmp") gls in
-      tclTHEN
-	(Proofview.V82.of_tactic (intro_mustbe_force id))
-	(intron_then (pred n) (id::ids) ltac) gls
-
-
-let rec consider_match may_intro introduced available expected gls =
-  match available,expected with
-      [],[] ->
-	  tclIDTAC gls
-    | _,[] -> error "Last statements do not match a complete hypothesis."
-	(* should tell which ones *)
-    | [],hyps ->
-	if may_intro then
-	  begin
- 	    let id = pf_get_new_id (Id.of_string "_tmp") gls in
-	      tclIFTHENELSE
-		(Proofview.V82.of_tactic (intro_mustbe_force id))
-		(consider_match true [] [id] hyps)
-		(fun _ ->
-		   error "Not enough sub-hypotheses to match statements.")
-		gls
-          end
-	else
-	  error "Not enough sub-hypotheses to match statements."
-	    (* should tell which ones *)
-    | id::rest_ids,(Hvar st | Hprop st)::rest ->
-	tclIFTHENELSE (Proofview.V82.of_tactic (convert_hyp (LocalAssum (id,st.st_it))))
-	  begin
-	    match st.st_label with
-		Anonymous ->
-		  consider_match may_intro ((id,false)::introduced) rest_ids rest
-	      | Name hid ->
-		  tclTHENLIST
-		    [Proofview.V82.of_tactic (rename_hyp [id,hid]);
-		     consider_match may_intro ((hid,true)::introduced) rest_ids rest]
-	  end
-	  begin
-	    (fun gls ->
-	       let nhyps =
-		 try conjunction_arity id gls with
-		     Not_found -> error "Matching hypothesis not found." in
-		 tclTHENLIST
-		   [Proofview.V82.of_tactic (simplest_case (mkVar id));
-		    intron_then nhyps []
-		      (fun l -> consider_match may_intro introduced
-			 (List.rev_append l rest_ids) expected)] gls)
-	  end
-	  gls
-
-let consider_tac c hyps gls =
-  match kind_of_term (strip_outer_cast c) with
-      Var id ->
-	consider_match false [] [id] hyps gls
-    | _ ->
-	let id = pf_get_new_id (Id.of_string "_tmp") gls in
-	tclTHEN
-	  (Proofview.V82.of_tactic (pose_proof (Name id) c))
- 	  (consider_match false [] [id] hyps) gls
-
-
-let given_tac hyps gls =
-  consider_match true [] [] hyps gls
-
-(* tactics for take *)
-
-let rec take_tac wits gls =
-  match wits with
-      [] -> tclIDTAC gls
-    | wit::rest ->
-	let typ = pf_unsafe_type_of gls wit in
-	  tclTHEN (thus_tac wit typ []) (take_tac rest)  gls
-
-
-(* tactics for define *)
-
-let rec build_function args body =
-  match args with
-      st::rest ->
-	let pfun= lift 1 (build_function rest body) in
-	let id = match st.st_label with
-	    Anonymous -> assert false
-	  | Name id -> id in
-	  mkLambda (Name id, st.st_it, subst_term (mkVar id) pfun)
-    | [] -> body
-
-let define_tac id args body gls =
-  let t = build_function args body in
-    Proofview.V82.of_tactic (letin_tac None (Name id) t None Locusops.nowhere) gls
-
-(* tactics for reconsider *)
-
-let cast_tac id_or_thesis typ gls =
-  match id_or_thesis with
-      This id ->
-	let body = pf_get_hyp gls id |> get_value in
-	  Proofview.V82.of_tactic (convert_hyp (of_tuple (id,body,typ))) gls
-    | Thesis (For _ ) ->
-	error "\"thesis for ...\" is not applicable here."
-    | Thesis Plain ->
-          Proofview.V82.of_tactic (convert_concl typ DEFAULTcast) gls
-
-(* per cases *)
-
-let is_rec_pos (main_ind,wft) =
-  match main_ind with
-      None -> false
-    | Some index ->
-	match fst (Rtree.dest_node wft) with
-	    Mrec (_,i) when Int.equal i index -> true
-	  | _ -> false
-
-let rec constr_trees (main_ind,wft) ind =
-    match Rtree.dest_node wft with
-      Norec,_ ->
-	let itree =
-	  (snd (Global.lookup_inductive ind)).mind_recargs in
-	  constr_trees (None,itree) ind
-    | _,constrs -> main_ind,constrs
-
-let ind_args rp ind =
-    let main_ind,constrs = constr_trees rp ind in
-    let args ctree =
-      Array.map (fun t -> main_ind,t) (snd (Rtree.dest_node ctree)) in
-      Array.map args constrs
-
-let init_tree ids ind rp nexti =
-  let indargs = ind_args rp ind in
-  let do_i i arp = (Array.map is_rec_pos arp),nexti i arp in
-    Split_patt (ids,ind,Array.mapi do_i indargs)
-
-let map_tree_rp rp id_fun mapi = function
-    Split_patt (ids,ind,branches) ->
-  let indargs = ind_args rp ind in
-  let do_i i (recargs,bri) = recargs,mapi i indargs.(i) bri in
-    Split_patt (id_fun ids,ind,Array.mapi do_i branches)
-  | _ -> failwith "map_tree_rp: not a splitting node"
-
-let map_tree id_fun mapi = function
-    Split_patt (ids,ind,branches) ->
-  let do_i i (recargs,bri) = recargs,mapi i bri in
-    Split_patt (id_fun ids,ind,Array.mapi do_i branches)
-  | _ -> failwith "map_tree: not a splitting node"
-
-
-let start_tree env ind rp =
-  init_tree Id.Set.empty ind rp (fun _ _ -> None)
-
-let build_per_info etype casee gls =
-  let concl=pf_concl gls in
-  let env=pf_env gls in
-  let ctyp=pf_unsafe_type_of gls casee in
-  let is_dep = dependent casee concl in
-  let hd,args = decompose_app (special_whd gls ctyp) in
-  let (ind,u) =
-    try
-      destInd hd
-    with DestKO ->
-      error "Case analysis must be done on an inductive object." in
-  let mind,oind = Global.lookup_inductive ind in
-  let nparams,index =
-    match etype with
-	ET_Induction -> mind.mind_nparams_rec,Some (snd ind)
-      | _ -> mind.mind_nparams,None in
-  let params,real_args = List.chop nparams args in
-  let abstract_obj c body =
-    let typ=pf_unsafe_type_of gls c in
-      lambda_create env (typ,subst_term c body) in
-  let pred= List.fold_right abstract_obj
-    real_args (lambda_create env (ctyp,subst_term casee concl)) in
-    is_dep,
-  {per_casee=casee;
-   per_ctype=ctyp;
-   per_ind=ind;
-   per_pred=pred;
-   per_args=real_args;
-   per_params=params;
-   per_nparams=nparams;
-   per_wf=index,oind.mind_recargs}
-
-let per_tac etype casee gls=
-  let env=pf_env gls in
-  let info = get_its_info gls in
-    match casee with
-	Real c ->
-	  let is_dep,per_info = build_per_info etype c gls in
-	  let ek =
-	    if is_dep then
-	      EK_dep (start_tree env per_info.per_ind per_info.per_wf)
-	    else EK_unknown in
-	    tcl_change_info
-	      {pm_stack=
-		  Per(etype,per_info,ek,[])::info.pm_stack} gls
-      | Virtual cut ->
-	  assert (cut.cut_stat.st_label == Anonymous);
-	  let id = pf_get_new_id (Id.of_string "anonymous_matched") gls in
-	  let c = mkVar id in
-	  let modified_cut =
-	    {cut with cut_stat={cut.cut_stat with st_label=Name id}} in
-	    tclTHEN
-	      (instr_cut (fun _ _ c -> c) false false modified_cut)
-	      (fun gls0 ->
-		 let is_dep,per_info = build_per_info etype c gls0 in
-		   assert (not is_dep);
-		   tcl_change_info
-		     {pm_stack=
-			 Per(etype,per_info,EK_unknown,[])::info.pm_stack} gls0)
-	      gls
-
-(* suppose *)
-
-let register_nodep_subcase id= function
-    Per(et,pi,ek,clauses)::s ->
-      begin
-	match ek with
-	    EK_unknown -> clauses,Per(et,pi,EK_nodep,id::clauses)::s
-	  | EK_nodep -> clauses,Per(et,pi,EK_nodep,id::clauses)::s
-	  | EK_dep _ -> error "Do not mix \"suppose\" with \"suppose it is\"."
-      end
-  | _ -> anomaly (Pp.str "wrong stack state")
-
-let suppose_tac hyps gls0 =
-  let info = get_its_info gls0 in
-  let thesis = pf_concl gls0 in
-  let id = pf_get_new_id (Id.of_string "subcase_") gls0 in
-  let clause = build_product hyps thesis in
-  let ninfo1 = {pm_stack=Suppose_case::info.pm_stack} in
-  let old_clauses,stack = register_nodep_subcase id info.pm_stack in
-  let ninfo2 = {pm_stack=stack} in
-    tclTHENS (Proofview.V82.of_tactic (assert_postpone id clause))
-      [tclTHENLIST [tcl_change_info ninfo1;
-		    assume_tac hyps;
-		    clear old_clauses];
-       tcl_change_info ninfo2] gls0
-
-(* suppose it is ... *)
-
-(* pattern matching compiling *)
-
-let rec skip_args rest ids n =
-  if n <= 0 then
-    Close_patt rest
-  else
-    Skip_patt (ids,skip_args rest ids (pred n))
-
-let rec tree_of_pats ((id,_) as cpl) pats =
-  match pats with
-      [] -> End_patt cpl
-    | args::stack ->
-	match args with
-	    [] -> Close_patt (tree_of_pats cpl stack)
-	  | (patt,rp) :: rest_args ->
-	      match patt with
-		  PatVar (_,v) ->
-		    Skip_patt (Id.Set.singleton id,
-			       tree_of_pats cpl (rest_args::stack))
-		| PatCstr (_,(ind,cnum),args,nam) ->
-		    let nexti i ati =
-		      if Int.equal i (pred cnum) then
-			let nargs =
-			  List.map_i (fun j a -> (a,ati.(j))) 0 args in
-			  Some (Id.Set.singleton id,
-				tree_of_pats cpl (nargs::rest_args::stack))
-		      else None
-		      in init_tree Id.Set.empty ind rp nexti
-
-let rec add_branch ((id,_) as cpl) pats tree=
-  match pats with
-      [] ->
-	begin
-	  match tree with
-	      End_patt cpl0 -> End_patt cpl0
-		(* this ensures precedence for overlapping patterns *)
-	    | _ -> anomaly (Pp.str "tree is expected to end here")
-	end
-    | args::stack ->
-	match args with
-	    [] ->
-	      begin
-		match tree with
-		   Close_patt t ->
-		     Close_patt (add_branch cpl stack t)
-		  | _ -> anomaly (Pp.str "we should pop here")
-	      end
-	  | (patt,rp) :: rest_args ->
-	      match patt with
-		  PatVar (_,v) ->
-		    begin
-		      match tree with
-			  Skip_patt (ids,t) ->
-			    Skip_patt (Id.Set.add id ids,
-				       add_branch cpl (rest_args::stack) t)
-			| Split_patt (_,_,_) ->
-			    map_tree (Id.Set.add id)
-			      (fun i bri ->
-				 append_branch cpl 1 (rest_args::stack) bri)
-			      tree
-			| _ -> anomaly (Pp.str "No pop/stop expected here")
-		    end
-		| PatCstr (_,(ind,cnum),args,nam) ->
-		      match tree with
-			Skip_patt (ids,t) ->
-			  let nexti i ati =
-			    if Int.equal i (pred cnum) then
-			      let nargs =
-				List.map_i (fun j a -> (a,ati.(j))) 0 args in
-				Some (Id.Set.add id ids,
-				      add_branch cpl (nargs::rest_args::stack)
-					(skip_args t ids (Array.length ati)))
-			    else
-			      Some (ids,
-				    skip_args t ids (Array.length ati))
-			  in init_tree ids ind rp nexti
-		      | Split_patt (_,ind0,_) ->
-			  if (not (eq_ind ind ind0)) then error
-			    (* this can happen with coercions *)
-	                    "Case pattern belongs to wrong inductive type.";
-			  let mapi i ati bri =
-			    if Int.equal i (pred cnum) then
-			      let nargs =
-				List.map_i (fun j a -> (a,ati.(j))) 0 args in
-				append_branch cpl 0
-				  (nargs::rest_args::stack) bri
-			    else bri in
-			    map_tree_rp rp (fun ids -> ids) mapi tree
-		      | _ -> anomaly (Pp.str "No pop/stop expected here")
-and append_branch ((id,_) as cpl) depth pats = function
-    Some (ids,tree) ->
-      Some (Id.Set.add id ids,append_tree cpl depth pats tree)
-  | None ->
-      Some (Id.Set.singleton id,tree_of_pats cpl pats)
-and append_tree ((id,_) as cpl) depth pats tree =
-  if depth<=0 then add_branch cpl pats tree
-  else match tree with
-      Close_patt t ->
-	Close_patt (append_tree cpl (pred depth) pats t)
-    | Skip_patt (ids,t) ->
-	Skip_patt (Id.Set.add id ids,append_tree cpl depth pats t)
-    | End_patt _ -> anomaly (Pp.str "Premature end of branch")
-    | Split_patt (_,_,_) ->
-	map_tree (Id.Set.add id)
-	  (fun i bri -> append_branch cpl (succ depth) pats bri) tree
-
-(* suppose it is *)
-
-let rec st_assoc id = function
-    [] -> raise Not_found
-  | st::_ when Name.equal st.st_label id  -> st.st_it
-  | _ :: rest -> st_assoc id rest
-
-let thesis_for obj typ per_info env=
-  let rc,hd1=decompose_prod typ in
-  let cind,all_args=decompose_app typ in
-  let ind,u = destInd cind in
-  let _ = if not (eq_ind ind per_info.per_ind) then
-    errorlabstrm "thesis_for"
-      ((Printer.pr_constr_env env Evd.empty obj) ++ spc () ++
-	 str"cannot give an induction hypothesis (wrong inductive type).") in
-  let params,args = List.chop per_info.per_nparams all_args in
-  let _ = if not (List.for_all2 eq_constr params per_info.per_params) then
-    errorlabstrm "thesis_for"
-      ((Printer.pr_constr_env env Evd.empty obj) ++ spc () ++
-	 str "cannot give an induction hypothesis (wrong parameters).") in
-  let hd2 = (applist ((lift (List.length rc) per_info.per_pred),args@[obj])) in
-    compose_prod rc (Reductionops.whd_beta Evd.empty hd2)
-
-let rec build_product_dep pat_info per_info args body gls =
-  match args with
-      (Hprop {st_label=nam;st_it=This c}
-      | Hvar {st_label=nam;st_it=c})::rest ->
-	let pprod=
-	  lift 1 (build_product_dep pat_info per_info rest body gls) in
-	let lbody =
-	  match nam with
-	      Anonymous -> body
-	    | Name id -> subst_var id pprod in
-	  mkProd (nam,c,lbody)
-    | Hprop ({st_it=Thesis tk} as st)::rest ->
-	let pprod=
-	  lift 1 (build_product_dep pat_info per_info rest body gls) in
-	let lbody =
-	  match st.st_label with
-	      Anonymous -> body
-	    | Name id -> subst_var id pprod in
-	let ptyp =
-	  match tk with
-	      For id ->
-		let obj = mkVar id in
-		let typ =
-		  try st_assoc (Name id) pat_info.pat_vars
-		  with Not_found ->
-		    snd (st_assoc (Name id) pat_info.pat_aliases) in
-		  thesis_for obj typ per_info (pf_env gls)
-	    | Plain -> pf_concl gls in
-	  mkProd (st.st_label,ptyp,lbody)
-    | [] -> body
-
-let build_dep_clause params pat_info per_info hyps gls =
-  let concl=
-    thesis_for pat_info.pat_constr pat_info.pat_typ per_info (pf_env gls) in
-  let open_clause =
-    build_product_dep pat_info per_info hyps concl gls in
-  let prod_one st body =
-    match st.st_label with
-	Anonymous -> mkProd(Anonymous,st.st_it,lift 1 body)
-      | Name id -> mkNamedProd id st.st_it (lift 1 body) in
-  let let_one_in st body =
-    match st.st_label with
-	Anonymous -> mkLetIn(Anonymous,fst st.st_it,snd st.st_it,lift 1 body)
-      | Name id ->
-	  mkNamedLetIn id (fst st.st_it) (snd st.st_it) (lift 1 body) in
-  let aliased_clause =
-    List.fold_right let_one_in pat_info.pat_aliases open_clause in
-    List.fold_right prod_one (params@pat_info.pat_vars) aliased_clause
-
-let rec register_dep_subcase id env per_info pat = function
-    EK_nodep -> error  "Only \"suppose it is\" can be used here."
-  | EK_unknown ->
-      register_dep_subcase id env per_info pat
-	(EK_dep (start_tree env per_info.per_ind per_info.per_wf))
-  | EK_dep tree -> EK_dep (add_branch id [[pat,per_info.per_wf]] tree)
-
-let case_tac params pat_info hyps gls0 =
-  let info = get_its_info gls0 in
-  let id = pf_get_new_id (Id.of_string "subcase_") gls0 in
-  let et,per_info,ek,old_clauses,rest =
-    match info.pm_stack with
-	Per (et,pi,ek,old_clauses)::rest -> (et,pi,ek,old_clauses,rest)
-      | _ -> anomaly (Pp.str "wrong place for cases") in
-  let clause = build_dep_clause params pat_info per_info hyps gls0 in
-  let ninfo1 = {pm_stack=Suppose_case::info.pm_stack} in
-  let nek = 
-    register_dep_subcase (id,(List.length params,List.length hyps)) 
-      (pf_env gls0) per_info pat_info.pat_pat ek in  
-  let ninfo2 = {pm_stack=Per(et,per_info,nek,id::old_clauses)::rest} in
-    tclTHENS (Proofview.V82.of_tactic (assert_postpone id clause))
-      [tclTHENLIST
-	 [tcl_change_info ninfo1;
-	  assume_st (params@pat_info.pat_vars);
-	  assume_st_letin pat_info.pat_aliases;
-	  assume_hyps_or_theses hyps;
-	  clear old_clauses];
-       tcl_change_info ninfo2] gls0
-
-(* end cases *)
-
-type ('a, 'b) instance_stack =
-    ('b * (('a option * constr list) list)) list
-
-let initial_instance_stack ids : (_, _) instance_stack =
-  List.map (fun id -> id,[None,[]]) ids
-
-let push_one_arg arg = function
-    [] -> anomaly (Pp.str "impossible")
-  | (head,args) :: ctx ->
-      ((head,(arg::args)) :: ctx)
-
-let push_arg arg stacks =
-  List.map (fun (id,stack) -> (id,push_one_arg arg stack)) stacks
-
-
-let push_one_head c ids (id,stack) =
-  let head = if Id.Set.mem id ids then Some c else None in
-    id,(head,[]) :: stack
-
-let push_head c ids stacks =
-  List.map (push_one_head c ids) stacks
-
-let pop_one (id,stack) =
-  let nstack=
-    match stack with
-	[] -> anomaly (Pp.str "impossible")
-      | [c] as l -> l
-      | (Some head,args)::(head0,args0)::ctx ->
-	  let arg = applist (head,(List.rev args)) in
-	    (head0,(arg::args0))::ctx
-     | (None,args)::(head0,args0)::ctx ->
-	 (head0,(args@args0))::ctx
-  in id,nstack
-
-let pop_stacks stacks =
-  List.map pop_one stacks
-
-let hrec_for fix_id per_info gls obj_id =
-  let obj=mkVar obj_id in
-  let typ=pf_get_hyp_typ gls obj_id in
-  let rc,hd1=decompose_prod typ in
-  let cind,all_args=decompose_app typ in
-  let ind,u = destInd cind in assert (eq_ind ind per_info.per_ind);
-  let params,args= List.chop per_info.per_nparams all_args in
-  assert begin
-    try List.for_all2 eq_constr params per_info.per_params with
-        Invalid_argument _ -> false end;
-  let hd2 = applist (mkVar fix_id,args@[obj]) in
-    compose_lam rc (Reductionops.whd_beta gls.sigma hd2)
-
-let warn_missing_case =
-  CWarnings.create ~name:"declmode-missing-case" ~category:"declmode"
-    (fun () -> strbrk "missing case")
-
-let rec execute_cases fix_name per_info tacnext args objs nhrec tree gls =
-  match tree, objs  with
-      Close_patt t,_ ->
-	let args0 = pop_stacks args in
-	  execute_cases fix_name per_info tacnext args0 objs nhrec t gls
-    | Skip_patt (_,t),skipped::next_objs ->
-	let args0 = push_arg skipped args in
-	  execute_cases fix_name per_info tacnext args0 next_objs nhrec t gls
-    | End_patt (id,(nparams,nhyps)),[] -> 
-	begin
-	  match Id.List.assoc id args with
-	      [None,br_args] -> 
-		let all_metas = 
-		  List.init (nparams + nhyps) (fun n -> mkMeta (succ n))  in
-		let param_metas,hyp_metas = List.chop nparams all_metas in
-		  tclTHEN
-		    (tclDO nhrec (Proofview.V82.of_tactic introf))
-		    (tacnext 
-		       (applist (mkVar id,
-				 List.append param_metas 
-				   (List.rev_append br_args hyp_metas)))) gls
-	    | _ -> anomaly (Pp.str "wrong stack size")
-	end
-    | Split_patt (ids,ind,br), casee::next_objs ->
-	let (mind,oind) as spec = Global.lookup_inductive ind in
-	let nparams = mind.mind_nparams in
-	let concl=pf_concl gls in
-	let env=pf_env gls in
-	let ctyp=pf_unsafe_type_of gls casee in
-	let hd,all_args = decompose_app (special_whd gls ctyp) in
-	let ind', u = destInd hd in
-	let _ = assert (eq_ind ind' ind) in (* just in case *)
-	let params,real_args = List.chop nparams all_args in
-	let abstract_obj c body =
-	  let typ=pf_unsafe_type_of gls c in
-	    lambda_create env (typ,subst_term c body) in
-	let elim_pred = List.fold_right abstract_obj
-	  real_args (lambda_create env (ctyp,subst_term casee concl)) in
-	let case_info = Inductiveops.make_case_info env ind RegularStyle in
-	let gen_arities = Inductive.arities_of_constructors (ind,u) spec in
-	let f_ids typ =
-	  let sign =
-	    (prod_assum (prod_applist typ params)) in
-	    find_intro_names sign gls in
-	let constr_args_ids = Array.map f_ids gen_arities in
-	let case_term =
-	  mkCase(case_info,elim_pred,casee,
-		 Array.mapi (fun i _ -> mkMeta (succ i)) constr_args_ids) in
-	let branch_tac i (recargs,bro) gls0 =
-	  let args_ids = constr_args_ids.(i) in
-	  let rec aux n = function
-	      [] ->
-		assert (Int.equal n (Array.length recargs));
-		next_objs,[],nhrec
-	    | id :: q ->
-		let objs,recs,nrec = aux (succ n) q in
-		  if recargs.(n)
-		  then (mkVar id::objs),(id::recs),succ nrec
-		  else (mkVar id::objs),recs,nrec in
-	  let objs,recs,nhrec = aux 0 args_ids in
-	    tclTHENLIST
-	      [tclMAP (fun id -> Proofview.V82.of_tactic (intro_mustbe_force id)) args_ids;
-	       begin
-		 fun gls1 ->
-		   let hrecs =
-		     List.map
-		       (fun id ->
-			  hrec_for (out_name fix_name) per_info gls1 id)
-		       recs in
-		     Proofview.V82.of_tactic (generalize hrecs) gls1
-	       end;
-	       match bro with
-		   None ->
-                     warn_missing_case ();
-                     tacnext (mkMeta 1)
-		 | Some (sub_ids,tree) ->
-		     let br_args =
-		       List.filter
-			 (fun (id,_) -> Id.Set.mem id sub_ids) args in
-		     let construct =
-		       applist (mkConstruct(ind,succ i),params) in
-		     let p_args =
-		       push_head construct ids br_args in
-		       execute_cases fix_name per_info tacnext
-			 p_args objs nhrec tree] gls0 in
-	  tclTHENSV
-	    (refine case_term)
-	    (Array.mapi branch_tac br) gls
-    | Split_patt (_, _, _) , [] ->
-	anomaly ~label:"execute_cases " (Pp.str "Nothing to split")
-    | Skip_patt _ , [] ->
-	anomaly ~label:"execute_cases " (Pp.str "Nothing to skip")
-    | End_patt (_,_) , _ :: _  ->
-	anomaly ~label:"execute_cases " (Pp.str "End of branch with garbage left")
-
-let understand_my_constr env sigma c concl =
-  let env = env in
-  let rawc = Detyping.detype false [] env Evd.empty c in
-  let rec frob = function
-    | GEvar _ -> GHole (Loc.ghost,Evar_kinds.QuestionMark Evar_kinds.Expand,Misctypes.IntroAnonymous,None)
-    | rc ->  map_glob_constr frob rc
-  in
-  Pretyping.understand_tcc env sigma ~expected_type:(Pretyping.OfType concl) (frob rawc)
-
-let my_refine c gls =
-  let oc = { run = begin fun sigma ->
-    let sigma = Sigma.to_evar_map sigma in
-    let (sigma, c) = understand_my_constr (pf_env gls) sigma c (pf_concl gls) in
-    Sigma.Unsafe.of_pair (c, sigma)
-  end } in
-  Proofview.V82.of_tactic (Tactics.New.refine oc) gls
-
-(* end focus/claim *)
-
-let end_tac et2 gls =
-  let info = get_its_info gls in
-  let et1,pi,ek,clauses =
-    match info.pm_stack with
-	Suppose_case::_ ->
-	  anomaly (Pp.str "This case should already be trapped")
-      | Claim::_ ->
-	  error "\"end claim\" expected."
-      | Focus_claim::_ ->
-	  error "\"end focus\" expected."
-      | Per(et',pi,ek,clauses)::_ -> (et',pi,ek,clauses)
-      | [] ->
-	  anomaly (Pp.str "This case should already be trapped") in
-  let et = match et1, et2 with
-  | ET_Case_analysis, ET_Case_analysis -> et1
-  | ET_Induction, ET_Induction -> et1
-  | ET_Case_analysis, _ -> error "\"end cases\" expected."
-  | ET_Induction, _ -> error "\"end induction\" expected."
-  in
-    tclTHEN
-      tcl_erase_info
-      begin
-	match et,ek with
-	    _,EK_unknown ->
-	      tclSOLVE [Proofview.V82.of_tactic (simplest_elim pi.per_casee)]
-	  | ET_Case_analysis,EK_nodep ->
-	      tclTHEN
-		(Proofview.V82.of_tactic (simplest_case pi.per_casee))
-		(default_justification (List.map mkVar clauses))
-	  | ET_Induction,EK_nodep ->
-	      tclTHENLIST
-		[Proofview.V82.of_tactic (generalize (pi.per_args@[pi.per_casee]));
-		 Proofview.V82.of_tactic (simple_induct (AnonHyp (succ (List.length pi.per_args))));
-		 default_justification (List.map mkVar clauses)]
-	  | ET_Case_analysis,EK_dep tree ->
-		 execute_cases Anonymous pi 
-		   (fun c -> tclTHENLIST 
-		      [my_refine c;
-		       clear clauses;
-		       justification (Proofview.V82.of_tactic assumption)])
-		   (initial_instance_stack clauses) [pi.per_casee] 0 tree
-	  | ET_Induction,EK_dep tree ->
-	      let nargs = (List.length pi.per_args) in
-		tclTHEN (Proofview.V82.of_tactic (generalize (pi.per_args@[pi.per_casee])))
-		  begin
-		    fun gls0 ->
-		      let fix_id =
-			pf_get_new_id (Id.of_string "_fix") gls0 in
-		      let c_id =
-			pf_get_new_id (Id.of_string "_main_arg") gls0 in
-			tclTHENLIST
-			  [Proofview.V82.of_tactic (fix (Some fix_id) (succ nargs));
-			   tclDO nargs (Proofview.V82.of_tactic introf);
-			   Proofview.V82.of_tactic (intro_mustbe_force c_id);
-			   execute_cases (Name fix_id) pi
-			     (fun c ->
-				tclTHENLIST
-				  [clear [fix_id];
-				   my_refine c;
-				   clear clauses;
-				   justification (Proofview.V82.of_tactic assumption)])
-			     (initial_instance_stack clauses)
-			     [mkVar c_id]  0 tree] gls0
-		  end
-      end gls
-
-(* escape *)
-
-let escape_tac gls =
-  (* spiwack: sets an empty info stack to avoid interferences.
-     We could erase the info altogether, but that doesn't play
-     well with the Decl_mode.focus (used in post_processing). *)
-  let info={pm_stack=[]} in
-  tcl_change_info info gls
-
-(* General instruction engine *)
-
-let rec do_proof_instr_gen _thus _then instr =
-  match instr with
-      Pthus i ->
-	assert (not _thus);
-	do_proof_instr_gen true _then i
-    | Pthen i ->
-	assert (not _then);
-	do_proof_instr_gen _thus true i
-    | Phence i ->
-	assert (not (_then || _thus));
-	do_proof_instr_gen true true i
-    | Pcut c ->
-	instr_cut mk_stat_or_thesis _thus _then c
-    | Psuffices c ->
-	instr_suffices _then c
-    | Prew (s,c) ->
-	assert (not _then);
-	instr_rew _thus s c
-    | Pconsider (c,hyps)    -> consider_tac c hyps
-    | Pgiven hyps            -> given_tac hyps
-    | Passume hyps           -> assume_tac hyps
-    | Plet hyps              -> assume_tac hyps
-    | Pclaim st              -> instr_claim false st
-    | Pfocus st              -> instr_claim true st
-    | Ptake witl             -> take_tac witl
-    | Pdefine (id,args,body) -> define_tac id args body
-    | Pcast (id,typ)         -> cast_tac id typ
-    | Pper (et,cs)           -> per_tac et cs
-    | Psuppose hyps      -> suppose_tac hyps
-    | Pcase (params,pat_info,hyps) -> case_tac params pat_info hyps
-    | Pend (B_elim et) -> end_tac et
-    | Pend _ -> anomaly (Pp.str "Not applicable")
-    | Pescape -> escape_tac
-
-let eval_instr {instr=instr} =
-  do_proof_instr_gen false false instr
-
-let rec preprocess pts instr =
-  match instr with
-    Phence i |Pthus i | Pthen i -> preprocess pts i
-  | Psuffices _ | Pcut _ |  Passume _ | Plet _ | Pclaim _ | Pfocus _
-  | Pconsider (_,_) | Pcast (_,_) | Pgiven _ | Ptake _
-  | Pdefine (_,_,_) | Pper _ | Prew _ ->
-      check_not_per pts;
-      true
-  | Pescape ->
-      check_not_per pts;
-      true
-  | Pcase _ | Psuppose _ | Pend (B_elim _) ->
-      close_previous_case pts ;
-      true
-  | Pend bt ->
-      close_block bt pts ;
-      false
-
-let rec postprocess pts instr =
-  match instr with
-      Phence i | Pthus i | Pthen i -> postprocess pts i
-    | Pcut _ | Psuffices _ | Passume _ | Plet _ | Pconsider (_,_) | Pcast (_,_)
-    | Pgiven _ | Ptake _ | Pdefine (_,_,_) | Prew (_,_) -> ()
-    | Pclaim _ | Pfocus _ | Psuppose _ | Pcase _ | Pper _ ->
-      Decl_mode.focus pts
-    | Pescape ->
-      Decl_mode.focus pts;
-      Proof_global.set_proof_mode "Classic"
-    | Pend (B_elim ET_Induction) ->
-  	begin
-	  let pfterm = List.hd (Proof.partial_proof pts) in
-	  let { it = gls ; sigma = sigma } = Proof.V82.subgoals pts in
-	  let env =  try
-		       Goal.V82.env sigma (List.hd gls)
-	             with Failure "hd" ->
-		       Global.env ()
-	  in
-	    try
-	      Inductiveops.control_only_guard env pfterm;
-	      goto_current_focus_or_top ()
- 	    with
-		Type_errors.TypeError(env,
-				      Type_errors.IllFormedRecBody(_,_,_,_,_)) ->
-		  anomaly (Pp.str "\"end induction\" generated an ill-formed fixpoint")
-	end
-    | Pend (B_elim ET_Case_analysis) -> goto_current_focus ()
-    | Pend B_proof -> Proof_global.set_proof_mode "Classic"
-    | Pend _ -> ()
-
-let do_instr raw_instr pts =
-  let has_tactic = preprocess pts raw_instr.instr in
-  (* spiwack: hack! [preprocess] assumes that the [pts] is indeed the
-     current proof (and, actually so does [do_instr] later one, so
-     it's ok to do the same here. Ideally the proof should be properly
-     threaded through the commands here, but since the are interleaved
-     with actions on the proof mode, which is attached to the global
-     proof environment, it is not possible without heavy lifting. *)
-  let pts = Proof_global.give_me_the_proof () in
-  let pts =
-    if has_tactic then
-            let { it=gls ; sigma=sigma; } = Proof.V82.subgoals pts in
-      let gl = { it=List.hd gls ; sigma=sigma; } in
-      let env=  pf_env gl in
-      let ist = {ltacvars = Id.Set.empty; genv = env} in
-      let glob_instr = intern_proof_instr ist raw_instr in
-      let instr =
-	interp_proof_instr (get_its_info gl) env sigma glob_instr in
-      let (pts',_) = Proof.run_tactic (Global.env())
-        (Proofview.V82.tactic (tclTHEN (eval_instr instr) clean_tmp)) pts in
-      pts'
-    else pts
-  in
-  Proof_global.simple_with_current_proof (fun _ _ -> pts);
-  postprocess pts raw_instr.instr
-
-let proof_instr raw_instr =
-  let p = Proof_global.give_me_the_proof () in
-  do_instr raw_instr p
-
-(*
-
-(* STUFF FOR ITERATED RELATIONS *)
-let decompose_bin_app t=
-  let hd,args = destApp
-
-let identify_transitivity_lemma c =
-  let varx,tx,c1 = destProd c in
-  let vary,ty,c2 = destProd (pop c1) in
-  let varz,tz,c3 = destProd (pop c2) in
-  let _,p1,c4 = destProd (pop c3) in
-  let _,lp2,lp3 = destProd (pop c4) in
-  let p2=pop lp2 in
-  let p3=pop lp3 in
-*)
-
diff --git a/plugins/decl_mode/decl_proof_instr.mli b/plugins/decl_mode/decl_proof_instr.mli
deleted file mode 100644
index 325969da..00000000
--- a/plugins/decl_mode/decl_proof_instr.mli
+++ /dev/null
@@ -1,108 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Term
-open Tacmach
-open Decl_mode
-
-val go_to_proof_mode: unit -> unit
-val return_from_tactic_mode: unit -> unit
-
-val register_automation_tac: unit Proofview.tactic -> unit
-
-val automation_tac : unit Proofview.tactic
-
-val concl_refiner:
-  Termops.meta_type_map -> constr -> Proof_type.goal sigma -> constr
-
-val do_instr: Decl_expr.raw_proof_instr -> Proof.proof -> unit
-val proof_instr: Decl_expr.raw_proof_instr -> unit
-
-val tcl_change_info : Decl_mode.pm_info -> tactic
-
-val execute_cases :
-    Name.t ->
-    Decl_mode.per_info ->
-    (Term.constr -> Proof_type.tactic) ->
-    (Id.Set.elt * (Term.constr option * Term.constr list) list) list ->
-    Term.constr list -> int -> Decl_mode.split_tree -> Proof_type.tactic
-
-val tree_of_pats : 
-  Id.t * (int * int) -> (Glob_term.cases_pattern*recpath) list list ->
-  split_tree
-
-val add_branch : 
-  Id.t * (int * int) -> (Glob_term.cases_pattern*recpath) list list ->
-  split_tree -> split_tree
-
-val append_branch :
-  Id.t *(int * int) -> int -> (Glob_term.cases_pattern*recpath) list list ->
-  (Id.Set.t * Decl_mode.split_tree) option ->
-  (Id.Set.t * Decl_mode.split_tree) option
-
-val append_tree :
-  Id.t * (int * int) -> int -> (Glob_term.cases_pattern*recpath) list list ->
-  split_tree -> split_tree
-
-val build_dep_clause :   Term.types Decl_expr.statement list ->
-    Decl_expr.proof_pattern ->
-    Decl_mode.per_info ->
-    (Term.types Decl_expr.statement, Term.types Decl_expr.or_thesis)
-    Decl_expr.hyp list -> Proof_type.goal Tacmach.sigma -> Term.types
-
-val register_dep_subcase :    
-    Id.t * (int * int) ->
-    Environ.env ->
-    Decl_mode.per_info ->
-    Glob_term.cases_pattern -> Decl_mode.elim_kind -> Decl_mode.elim_kind
-
-val thesis_for :     Term.constr ->
-    Term.constr -> Decl_mode.per_info -> Environ.env -> Term.constr
-
-val close_previous_case : Proof.proof -> unit
-
-val pop_stacks :
-  (Id.t *
-     (Term.constr option * Term.constr list) list) list ->
-  (Id.t *
-     (Term.constr option * Term.constr list) list) list
-
-val push_head :   Term.constr ->
-  Id.Set.t ->
-  (Id.t *
-     (Term.constr option * Term.constr list) list) list ->
-  (Id.t *
-     (Term.constr option * Term.constr list) list) list
-
-val push_arg : Term.constr ->
-  (Id.t *
-     (Term.constr option * Term.constr list) list) list ->
-  (Id.t *
-     (Term.constr option * Term.constr list) list) list
-
-val hrec_for:
-    Id.t ->
-    Decl_mode.per_info -> Proof_type.goal Tacmach.sigma ->
-    Id.t -> Term.constr
-
-val consider_match :
-   bool ->
-    (Id.Set.elt*bool) list ->
-    Id.Set.elt list ->
-    (Term.types Decl_expr.statement, Term.types) Decl_expr.hyp list ->
-    Proof_type.tactic
-
-val init_tree:
-    Id.Set.t ->
-    inductive ->
-    int option * Declarations.wf_paths ->
-    (int ->
-     (int option * Declarations.recarg Rtree.t) array ->
-     (Id.Set.t * Decl_mode.split_tree) option) ->
-    Decl_mode.split_tree
diff --git a/plugins/decl_mode/g_decl_mode.ml4 b/plugins/decl_mode/g_decl_mode.ml4
deleted file mode 100644
index 6c17dcc4..00000000
--- a/plugins/decl_mode/g_decl_mode.ml4
+++ /dev/null
@@ -1,386 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-DECLARE PLUGIN "decl_mode_plugin"
-
-open Compat
-open Pp
-open Decl_expr
-open Names
-open Pcoq
-open Vernacexpr
-open Tok (* necessary for camlp4 *)
-
-open Pcoq.Constr
-open Pcoq.Tactic
-open Ppdecl_proof
-
-let pr_goal gs =
-  let (g,sigma) = Goal.V82.nf_evar (Tacmach.project gs) (Evd.sig_it gs) in
-  let env = Goal.V82.env sigma g in
-  let concl = Goal.V82.concl sigma g in
-  let goal =
-    Printer.pr_context_of env sigma ++ cut () ++
-      str "============================" ++ cut ()  ++
-      str "thesis :=" ++ cut () ++
-      Printer.pr_goal_concl_style_env env sigma concl in
-  str "     *** Declarative Mode ***" ++ fnl () ++ fnl () ++
-    str "  " ++ v 0 goal
-
-let pr_subgoals ?(pr_first=true) _ sigma _ _ _ gll =
-  match gll with
-  | [goal] when pr_first ->
-      pr_goal { Evd.it = goal ; sigma = sigma }
-  | _ ->
-      (* spiwack: it's not very nice to have to call proof global
-         here, a more robust solution would be to add a hook for
-         [Printer.pr_open_subgoals] in proof modes, in order to
-         compute the end command. Yet a more robust solution would be
-         to have focuses give explanations of their unfocusing
-         behaviour. *)
-      let p = Proof_global.give_me_the_proof () in
-      let close_cmd = Decl_mode.get_end_command p in
-      str "Subproof completed, now type " ++ str close_cmd ++ str "."
-
-let interp_proof_instr _ { Evd.it = gl ; sigma = sigma }=
-  Decl_interp.interp_proof_instr 
-    (Decl_mode.get_info sigma gl)
-    (Goal.V82.env sigma gl)
-    (sigma)
-
-let vernac_decl_proof () = 
-  let pf = Proof_global.give_me_the_proof () in
-  if Proof.is_done pf then 
-    CErrors.error "Nothing left to prove here."
-  else
-    begin
-      Decl_proof_instr.go_to_proof_mode () ;
-      Proof_global.set_proof_mode "Declarative"
-    end
-
-(* spiwack: some bureaucracy is not performed here *)
-let vernac_return () =
-  begin
-    Decl_proof_instr.return_from_tactic_mode () ;
-    Proof_global.set_proof_mode "Declarative"
-  end
-
-let vernac_proof_instr instr =
-  Decl_proof_instr.proof_instr instr
-
-(* Before we can write an new toplevel command (see below) 
-    which takes a [proof_instr] as argument, we need to declare
-    how to parse it, print it, globalise it and interprete it.
-    Normally we could do that easily through ARGUMENT EXTEND, 
-    but as the parsing is fairly complicated we will do it manually to
-    indirect through the [proof_instr] grammar entry. *)
-(* spiwack: proposal: doing that directly from argextend.ml4, maybe ? *)
-
-(* Only declared at raw level, because only used in vernac commands. *)
-let wit_proof_instr : (raw_proof_instr, glob_proof_instr, proof_instr) Genarg.genarg_type =
-  Genarg.make0 "proof_instr"
-
-(* We create a new parser entry [proof_mode]. The Declarative proof mode
-    will replace the normal parser entry for tactics with this one. *)
-let proof_mode : vernac_expr Gram.entry =
-  Gram.entry_create "vernac:proof_command"
-(* Auxiliary grammar entry. *)
-let proof_instr : raw_proof_instr Gram.entry =
-  Pcoq.create_generic_entry Pcoq.utactic "proof_instr" (Genarg.rawwit wit_proof_instr)
-
-let _ = Pptactic.declare_extra_genarg_pprule wit_proof_instr
-  pr_raw_proof_instr pr_glob_proof_instr pr_proof_instr
-
-let classify_proof_instr = function
-  | { instr = Pescape |Pend B_proof } -> VtProofMode "Classic", VtNow
-  | _ -> Vernac_classifier.classify_as_proofstep
-
-(* We use the VERNAC EXTEND facility with a custom non-terminal
-    to populate [proof_mode] with a new toplevel interpreter.
-    The "-" indicates that the rule does not start with a distinguished
-    string. *)
-VERNAC proof_mode EXTEND ProofInstr
-  [ - proof_instr(instr) ] => [classify_proof_instr instr] -> [ vernac_proof_instr instr ]
-END
-
-(* It is useful to use GEXTEND directly to call grammar entries that have been
-    defined previously VERNAC EXTEND. In this case we allow, in proof mode,
-    the use of commands like Check or Print. VERNAC EXTEND does quite a bit of
-    bureaucracy for us, but it is not needed in this sort of case, and it would require
-    to have an ARGUMENT EXTEND version of the "proof_mode" grammar entry. *)
-GEXTEND Gram
-  GLOBAL: proof_mode ;
-
-  proof_mode: LAST
-    [ [ c=G_vernac.subgoal_command -> c (Some (Vernacexpr.SelectNth 1)) ] ]
-  ;
-END  
-
-(* We register a new proof mode here *)
-
-let _ = 
-  Proof_global.register_proof_mode { Proof_global.
-				       name = "Declarative" ; (* name for identifying and printing *)
-				       (* function [set] goes from No Proof Mode to 
-					   Declarative Proof Mode performing side effects *)
-				       set = begin fun () ->
-					 (* We set the command non terminal to
-					     [proof_mode] (which we just defined). *)
-					 Pcoq.set_command_entry proof_mode ;
-					 (* We substitute the goal printer, by the one we built
-					     for the proof mode. *)
-					 Printer.set_printer_pr { Printer.default_printer_pr with
-								                Printer.pr_goal = pr_goal;
-                                                                                pr_subgoals = pr_subgoals; }
-				       end ;
-                                       (* function [reset] goes back to No Proof Mode from
-					   Declarative Proof Mode *)
-				       reset = begin fun () ->
-					 (* We restore the command non terminal to
-					      [noedit_mode]. *)
-					 Pcoq.set_command_entry Pcoq.Vernac_.noedit_mode ;
-					 (* We restore the goal printer to default *)
-					 Printer.set_printer_pr Printer.default_printer_pr
-				       end
-				   }
-
-VERNAC COMMAND EXTEND DeclProof
-[ "proof" ] => [ VtProofMode "Declarative", VtNow ] -> [ vernac_decl_proof () ]
-END
-VERNAC COMMAND EXTEND  DeclReturn
-[ "return" ] => [ VtProofMode "Declarative", VtNow ] -> [ vernac_return () ]
-END
-
-let none_is_empty = function
-    None -> []
-  | Some l -> l
-
-GEXTEND Gram
-GLOBAL: proof_instr;
-  thesis :
-    [[ "thesis" -> Plain 
-     | "thesis"; "for"; i=ident -> (For i)
-     ]];
-  statement :
-    [[ i=ident ; ":" ; c=constr -> {st_label=Name i;st_it=c}
-     | i=ident -> {st_label=Anonymous;
-		   st_it=Constrexpr.CRef (Libnames.Ident (!@loc, i), None)}
-     | c=constr -> {st_label=Anonymous;st_it=c}
-     ]];
-  constr_or_thesis :
-     [[ t=thesis -> Thesis t ] |
-      [ c=constr -> This c
-      ]];
-  statement_or_thesis : 
-    [
-      [ t=thesis -> {st_label=Anonymous;st_it=Thesis t} ] 
-    |
-      [ i=ident ; ":" ; cot=constr_or_thesis -> {st_label=Name i;st_it=cot}
-      | i=ident -> {st_label=Anonymous;
-		    st_it=This (Constrexpr.CRef (Libnames.Ident (!@loc, i), None))}
-      | c=constr -> {st_label=Anonymous;st_it=This c}
-      ]
-    ];
-  justification_items : 
-    [[ -> Some [] 
-     | "by"; l=LIST1 constr SEP "," -> Some l
-     | "by"; "*"                    -> None ]]
-  ;
-  justification_method : 
-    [[ -> None 
-     | "using";  tac = tactic -> Some tac ]]
-  ;
-  simple_cut_or_thesis :
-    [[ ls = statement_or_thesis;
-       j = justification_items;
-       taco = justification_method 	
-	 -> {cut_stat=ls;cut_by=j;cut_using=taco} ]]
-  ;
-  simple_cut :
-    [[ ls = statement;
-       j = justification_items;
-       taco = justification_method 	
-	 -> {cut_stat=ls;cut_by=j;cut_using=taco} ]]
-  ;
-  elim_type:
-    [[ IDENT "induction" -> ET_Induction
-     | IDENT "cases" -> ET_Case_analysis ]]
-  ;
-  block_type :
-    [[ IDENT "claim" -> B_claim
-     | IDENT "focus" -> B_focus
-     | IDENT "proof" -> B_proof
-     | et=elim_type -> B_elim et ]]
-  ;    
-  elim_obj:
-    [[ IDENT "on"; c=constr -> Real c
-     | IDENT "of"; c=simple_cut -> Virtual c ]]
-  ;  
-  elim_step:
-    [[ IDENT "consider" ; 
-       h=consider_vars ; IDENT "from" ; c=constr -> Pconsider (c,h)
-     | IDENT "per"; et=elim_type; obj=elim_obj -> Pper (et,obj)
-     | IDENT "suffices"; ls=suff_clause;
-       j = justification_items;
-       taco = justification_method 	
-	-> Psuffices {cut_stat=ls;cut_by=j;cut_using=taco} ]] 
-  ;
-  rew_step :
-    [[ "~=" ;         c=simple_cut -> (Rhs,c)       
-     | "=~" ;         c=simple_cut -> (Lhs,c)]]
-  ;
-  cut_step:
-    [[ "then"; tt=elim_step -> Pthen tt
-     | "then"; c=simple_cut_or_thesis -> Pthen (Pcut c)
-     | IDENT "thus"; tt=rew_step -> Pthus (let s,c=tt in Prew (s,c)) 
-     | IDENT "thus"; c=simple_cut_or_thesis -> Pthus (Pcut c)
-     | IDENT "hence"; c=simple_cut_or_thesis -> Phence (Pcut c)
-     | tt=elim_step -> tt
-     | tt=rew_step -> let s,c=tt in Prew (s,c); 
-     | IDENT "have"; c=simple_cut_or_thesis -> Pcut c;
-     | IDENT "claim"; c=statement -> Pclaim c;
-     | IDENT "focus"; IDENT "on"; c=statement -> Pfocus c;    
-     | "end"; bt = block_type -> Pend bt;
-     | IDENT "escape" -> Pescape ]]
-  ;
-  (* examiner s'il est possible de faire R _ et _ R pour R une relation qcq*)
-  loc_id: 
-    [[ id=ident -> fun x -> (!@loc,(id,x)) ]];
-  hyp:
-    [[ id=loc_id -> id None ;
-     | id=loc_id ; ":" ; c=constr -> id (Some c)]]
-  ;
-  consider_vars:
-    [[ name=hyp -> [Hvar name]
-     | name=hyp; ","; v=consider_vars -> (Hvar name) :: v
-     | name=hyp; 
-       IDENT "such"; IDENT "that"; h=consider_hyps -> (Hvar name)::h
-     ]]
-  ;
-  consider_hyps:  
-    [[ st=statement; IDENT "and"; h=consider_hyps  -> Hprop st::h
-     | st=statement; IDENT "and"; 
-       IDENT "consider" ; v=consider_vars  -> Hprop st::v
-     | st=statement -> [Hprop st]
-     ]]
-  ;  
-  assume_vars:
-    [[ name=hyp -> [Hvar name]
-     | name=hyp; ","; v=assume_vars -> (Hvar name) :: v
-     | name=hyp; 
-       IDENT "such"; IDENT "that"; h=assume_hyps -> (Hvar name)::h
-     ]]
-  ;
-  assume_hyps:  
-    [[ st=statement; IDENT "and"; h=assume_hyps  -> Hprop st::h
-     | st=statement; IDENT "and"; 
-       IDENT "we"; IDENT "have" ; v=assume_vars  -> Hprop st::v
-     | st=statement -> [Hprop st]
-     ]]
-  ;
-  assume_clause:
-    [[ IDENT "we" ; IDENT "have" ; v=assume_vars -> v
-    |  h=assume_hyps -> h ]]
-  ; 
-  suff_vars:
-    [[ name=hyp; IDENT "to"; IDENT "show" ; c = constr_or_thesis ->
-      [Hvar name],c
-     | name=hyp; ","; v=suff_vars -> 
-	 let (q,c) = v in ((Hvar name) :: q),c
-     | name=hyp; 
-       IDENT "such"; IDENT "that"; h=suff_hyps -> 
-	 let (q,c) = h in ((Hvar name) :: q),c
-     ]];
-  suff_hyps:  
-    [[ st=statement; IDENT "and"; h=suff_hyps  ->	 
-	 let (q,c) = h in (Hprop st::q),c
-     | st=statement; IDENT "and"; 
-       IDENT "to" ; IDENT "have" ; v=suff_vars -> 
-	 let (q,c) = v in (Hprop st::q),c
-     | st=statement; IDENT "to"; IDENT "show" ; c = constr_or_thesis -> 
-	 [Hprop st],c
-     ]]
-  ;
-  suff_clause:
-    [[ IDENT "to" ; IDENT "have" ; v=suff_vars -> v
-    |  h=suff_hyps -> h ]]
-  ; 
-  let_vars:
-    [[ name=hyp -> [Hvar name]
-     | name=hyp; ","; v=let_vars -> (Hvar name) :: v
-     | name=hyp; IDENT "be"; 
-       IDENT "such"; IDENT "that"; h=let_hyps -> (Hvar name)::h
-     ]]
-  ;
-  let_hyps:  
-    [[ st=statement; IDENT "and"; h=let_hyps  -> Hprop st::h
-    |  st=statement; IDENT "and"; "let"; v=let_vars  -> Hprop st::v
-    |  st=statement -> [Hprop st]
-    ]];
-  given_vars:
-    [[ name=hyp -> [Hvar name]
-     | name=hyp; ","; v=given_vars -> (Hvar name) :: v
-     | name=hyp; IDENT "such"; IDENT "that"; h=given_hyps -> (Hvar name)::h
-     ]]
-  ;
-  given_hyps:  
-    [[ st=statement; IDENT "and"; h=given_hyps  -> Hprop st::h
-    |  st=statement; IDENT "and"; IDENT "given"; v=given_vars  -> Hprop st::v
-    |  st=statement -> [Hprop st]
-    ]];
-  suppose_vars:
-    [[name=hyp -> [Hvar name] 
-     |name=hyp; ","; v=suppose_vars -> (Hvar name) :: v
-     |name=hyp; OPT[IDENT "be"]; 
-      IDENT "such"; IDENT "that"; h=suppose_hyps -> (Hvar name)::h
-     ]]
-  ;
-  suppose_hyps:  
-    [[ st=statement_or_thesis; IDENT "and"; h=suppose_hyps -> Hprop st::h
-     | st=statement_or_thesis; IDENT "and"; IDENT "we"; IDENT "have";
-          v=suppose_vars -> Hprop st::v
-     | st=statement_or_thesis -> [Hprop st]
-     ]]
-  ;
-  suppose_clause:
-    [[ IDENT "we"; IDENT "have"; v=suppose_vars -> v;
-     |  h=suppose_hyps -> h ]]
-  ;
-  intro_step:
-    [[ IDENT "suppose" ; h=assume_clause -> Psuppose h
-     | IDENT "suppose" ; IDENT "it"; IDENT "is" ; c=pattern LEVEL "0" ;
-       po=OPT[ "with"; p=LIST1 hyp SEP ","-> p  ] ; 
-       ho=OPT[ IDENT "and" ; h=suppose_clause -> h ] -> 
-	 Pcase (none_is_empty po,c,none_is_empty ho)
-     | "let" ; v=let_vars -> Plet v	 
-     | IDENT "take"; witnesses = LIST1 constr SEP ","  -> Ptake witnesses
-     | IDENT "assume"; h=assume_clause -> Passume h
-     | IDENT "given"; h=given_vars -> Pgiven h
-     | IDENT "define"; id=ident; args=LIST0 hyp; 
-       "as"; body=constr -> Pdefine(id,args,body)
-     | IDENT "reconsider"; id=ident; "as" ; typ=constr -> Pcast (This id,typ)
-     | IDENT "reconsider"; t=thesis; "as" ; typ=constr -> Pcast (Thesis t ,typ)
-     ]]
-  ;
-  emphasis : 
-    [[ -> 0
-     | "*" -> 1
-     | "**" -> 2
-     | "***" -> 3
-     ]]
-  ;
-  bare_proof_instr:
-    [[ c = cut_step -> c ;
-     | i = intro_step -> i ]]
-  ;
-  proof_instr :
-    [[ e=emphasis;i=bare_proof_instr;"." -> {emph=e;instr=i}]]
-  ;
-END;;
diff --git a/plugins/decl_mode/ppdecl_proof.ml b/plugins/decl_mode/ppdecl_proof.ml
deleted file mode 100644
index 59a0bb5a..00000000
--- a/plugins/decl_mode/ppdecl_proof.ml
+++ /dev/null
@@ -1,215 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open CErrors
-open Pp
-open Decl_expr
-open Names
-open Nameops
-
-let pr_label = function
-    Anonymous -> mt ()
-  | Name id -> pr_id id ++ spc () ++ str ":" ++ spc ()
-
-let pr_justification_items pr_constr = function
-    Some [] -> mt ()
-  | Some (_::_ as l) ->
-      spc () ++ str "by" ++ spc () ++
-	prlist_with_sep (fun () -> str ",") pr_constr l
-  | None -> spc () ++ str "by *"
-
-let pr_justification_method pr_tac = function
-    None -> mt ()
-  | Some tac ->
-      spc () ++ str "using" ++ spc () ++ pr_tac tac
-
-let pr_statement pr_constr st =
-  pr_label st.st_label ++ pr_constr st.st_it
-
-let pr_or_thesis pr_this = function
-    Thesis Plain -> str "thesis"
-  | Thesis (For id) ->
-      str "thesis" ++ spc() ++ str "for" ++ spc () ++ pr_id id
-  | This c -> pr_this c
-
-let pr_cut pr_constr pr_tac pr_it c =
-  hov 1 (pr_it c.cut_stat) ++
-    pr_justification_items pr_constr c.cut_by ++
-    pr_justification_method pr_tac c.cut_using
-
-let type_or_thesis = function
-    Thesis _ -> Term.mkProp
-  | This c -> c
-
-let _I x = x
-
-let rec pr_hyps pr_var pr_constr gtyp sep _be _have hyps =
-  let pr_sep = if sep then str "and" ++ spc () else mt () in
-    match hyps with
-	(Hvar _ ::_) as rest ->
-	  spc () ++ pr_sep ++ str _have ++
-	    pr_vars pr_var pr_constr gtyp false _be _have rest
-      | Hprop st :: rest ->
-	  begin
-	(* let npr_constr env = pr_constr (Environ.push_named (id,None,gtyp st.st_it) env)*) 
-	      spc() ++ pr_sep ++ pr_statement pr_constr st ++
-		pr_hyps pr_var pr_constr gtyp true _be _have rest
-	  end
-      | [] -> mt ()
-
-and pr_vars pr_var pr_constr gtyp sep _be _have vars =
-  match vars with
-    Hvar st :: rest ->
-      begin
-	(* let npr_constr env = pr_constr (Environ.push_named (id,None,gtyp st.st_it) env)*) 
-	let pr_sep = if sep then pr_comma () else mt () in
-		spc() ++ pr_sep ++
-		  pr_var st ++
-		  pr_vars pr_var pr_constr gtyp true _be _have rest
-      end
-   | (Hprop _ :: _) as rest ->
-      let _st =  if _be then
-	str "be such that"
-      else
-	str "such that" in
-	spc() ++ _st ++  pr_hyps pr_var pr_constr gtyp false _be _have rest
-  | [] -> mt ()
-
-let pr_suffices_clause pr_var pr_constr (hyps,c) =
-    pr_hyps pr_var pr_constr _I false false "to have" hyps ++ spc () ++
-       str "to show" ++ spc () ++ pr_or_thesis pr_constr c
-
-let pr_elim_type = function
-    ET_Case_analysis -> str "cases"
-  | ET_Induction -> str "induction"
-
-let pr_block_type = function
-    B_elim et -> pr_elim_type et
-  | B_proof -> str "proof"
-  | B_claim -> str "claim"
-  | B_focus -> str "focus"
-
-let pr_casee pr_constr pr_tac =function
-    Real c -> str "on" ++ spc () ++ pr_constr c
-  | Virtual cut -> str "of" ++ spc () ++ pr_cut pr_constr pr_tac (pr_statement pr_constr) cut
-
-let pr_side = function
-    Lhs -> str "=~"
-  | Rhs -> str "~="
-
-let rec pr_bare_proof_instr pr_var pr_constr pr_pat pr_tac _then _thus = function
-  | Pescape -> str "escape"
-  | Pthen i -> pr_bare_proof_instr pr_var pr_constr pr_pat pr_tac  true _thus i
-  | Pthus i -> pr_bare_proof_instr pr_var pr_constr pr_pat pr_tac  _then true i
-  | Phence i -> pr_bare_proof_instr pr_var pr_constr pr_pat pr_tac true true i
-  | Pcut c ->
-      begin
-	match _then,_thus with
-	    false,false -> str "have" ++ spc () ++
-	      pr_cut pr_constr pr_tac (pr_statement (pr_or_thesis pr_constr)) c
-	  | false,true  -> str "thus" ++ spc () ++
-	      pr_cut pr_constr pr_tac (pr_statement (pr_or_thesis pr_constr)) c
-	  | true,false  -> str "then" ++ spc () ++
-	      pr_cut pr_constr pr_tac (pr_statement (pr_or_thesis pr_constr)) c
-	  | true,true   -> str "hence" ++ spc () ++
-	      pr_cut pr_constr pr_tac (pr_statement (pr_or_thesis pr_constr)) c
-      end
-  | Psuffices c ->
-      str "suffices" ++  pr_cut pr_constr pr_tac (pr_suffices_clause pr_var pr_constr) c
-  | Prew (sid,c) ->
-      (if _thus then str "thus" else str "    ") ++ spc () ++
-	pr_side sid ++ spc () ++ pr_cut pr_constr pr_tac (pr_statement pr_constr) c
-  | Passume hyps ->
-      str "assume" ++ pr_hyps pr_var pr_constr _I false false "we have" hyps
-  | Plet hyps ->
-      str "let" ++ pr_vars pr_var pr_constr _I false true "let" hyps
-  | Pclaim st ->
-      str "claim" ++ spc () ++ pr_statement pr_constr st
-  | Pfocus st ->
-      str "focus on" ++ spc () ++ pr_statement pr_constr st
-  | Pconsider (id,hyps) ->
-      str "consider" ++ pr_vars pr_var pr_constr _I false false "consider" hyps
-      ++ spc () ++ str "from " ++ pr_constr id
-  | Pgiven hyps ->
-      str "given" ++ pr_vars pr_var pr_constr _I false false "given" hyps
-  | Ptake witl ->
-      str "take" ++ spc () ++
-	prlist_with_sep pr_comma pr_constr witl
-  | Pdefine (id,args,body) ->
-      str "define" ++ spc () ++ pr_id id ++ spc () ++
-	prlist_with_sep spc
-	(fun st -> str "(" ++
-	   pr_var st ++ str ")") args ++ spc () ++
-	str "as" ++ (pr_constr body)
-  | Pcast (id,typ) ->
-      str "reconsider" ++ spc () ++
-	pr_or_thesis pr_id id ++ spc () ++
-	str "as" ++ spc () ++ (pr_constr typ)
-  | Psuppose hyps ->
-      str "suppose" ++
-	pr_hyps pr_var pr_constr _I false false "we have" hyps 
-  | Pcase (params,pat,hyps) ->
-      str "suppose it is" ++ spc () ++ pr_pat pat ++
-	(if params = [] then mt () else
-	   (spc () ++ str "with" ++ spc () ++
-	      prlist_with_sep spc
-	      (fun st -> str "(" ++
-		 pr_var st ++ str ")") params ++ spc ()))
-      ++
-	(if hyps = [] then mt () else
-	   (spc () ++ str "and" ++
-	      pr_hyps pr_var (pr_or_thesis pr_constr) type_or_thesis
-	      false false "we have" hyps)) 
-  | Pper (et,c) -> 
-      str "per" ++ spc () ++ pr_elim_type et ++ spc () ++
-	pr_casee pr_constr pr_tac c  
-  | Pend blk -> str "end" ++ spc () ++ pr_block_type blk
-
-let pr_emph = function
-    0 -> str "    "
-  | 1 -> str "*   "
-  | 2 -> str "**  "
-  | 3 -> str "*** "
-  | _ -> anomaly (Pp.str "unknown emphasis")
-
-let pr_gen_proof_instr pr_var pr_constr pr_pat pr_tac instr =
-  pr_emph instr.emph ++ spc () ++
-    pr_bare_proof_instr pr_var pr_constr pr_pat pr_tac false false instr.instr
-
-
-let pr_raw_proof_instr pconstr1 pconstr2 ptac (instr : raw_proof_instr) =
-   pr_gen_proof_instr
-     (fun (_,(id,otyp)) -> 
-       match otyp with
-	 None -> pr_id id
-       | Some typ -> str "(" ++ pr_id id ++ str ":" ++ pconstr1 typ ++str ")"
-     )
-     pconstr2
-     Ppconstr.pr_cases_pattern_expr
-     (ptac Pptactic.ltop)
-     instr
-
-let pr_glob_proof_instr pconstr1 pconstr2 ptac (instr : glob_proof_instr) =
-    pr_gen_proof_instr
-      (fun (_,(id,otyp)) -> 
-	match otyp with
-	  None -> pr_id id
-	| Some typ -> str "(" ++ pr_id id ++ str ":" ++ pconstr1 typ ++str ")")
-     pconstr2
-     Ppconstr.pr_cases_pattern_expr
-     (ptac Pptactic.ltop)
-     instr
-
-let pr_proof_instr pconstr1 pconstr2 ptac (instr : proof_instr) =
-  pr_gen_proof_instr
-    (fun st -> pr_statement pconstr1 st)
-    pconstr2
-    (fun mpat -> Ppconstr.pr_cases_pattern_expr mpat.pat_expr)
-    (ptac Pptactic.ltop)
-    instr
-
diff --git a/plugins/decl_mode/ppdecl_proof.mli b/plugins/decl_mode/ppdecl_proof.mli
deleted file mode 100644
index 678fc076..00000000
--- a/plugins/decl_mode/ppdecl_proof.mli
+++ /dev/null
@@ -1,14 +0,0 @@
-
-open Decl_expr
-open Pptactic
-
-val pr_gen_proof_instr : 
-  ('var -> Pp.std_ppcmds) ->
-  ('constr -> Pp.std_ppcmds) ->
-  ('pat -> Pp.std_ppcmds) ->
-  ('tac -> Pp.std_ppcmds) ->  
-  ('var,'constr,'pat,'tac) gen_proof_instr -> Pp.std_ppcmds
-
-val pr_raw_proof_instr : raw_proof_instr raw_extra_genarg_printer
-val pr_glob_proof_instr : glob_proof_instr glob_extra_genarg_printer
-val pr_proof_instr : proof_instr extra_genarg_printer
diff --git a/plugins/derive/Derive.v b/plugins/derive/Derive.v
index 0d5a93b0..d1046ae7 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 e39d17b5..8a55538b 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -1,16 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+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
 
@@ -28,16 +31,17 @@ let start_deriving f suchthat lemma =
   (* spiwack: I don't know what the rigidity flag does, picked the one
      that looked the most general. *)
   let (sigma,f_type_sort) = Evd.new_sort_variable Evd.univ_flexible_alg sigma in
-  let f_type_type = Term.mkSort f_type_sort in
+  let f_type_type = EConstr.mkSort f_type_sort in
   (** create the initial goals for the proof: |- Type ; |- ?1 ; f:=?2 |- suchthat *)
   let goals =
     let open Proofview in
         TCons ( env , sigma , f_type_type , (fun sigma f_type ->
         TCons ( env , sigma , f_type , (fun sigma ef ->
+        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
 
@@ -51,9 +55,9 @@ let start_deriving f suchthat lemma =
           [suchthat], respectively. *)
       let (opaque,f_def,lemma_def) =
         match com with
-        | Admitted _ -> CErrors.error"Admitted isn't supported in Derive."
+        | Admitted _ -> CErrors.user_err Pp.(str "Admitted isn't supported in Derive.")
         | Proved (_,Some _,_) ->
-            CErrors.error"Cannot save a proof of Derive with an explicit name."
+            CErrors.user_err Pp.(str "Cannot save a proof of Derive with an explicit name.")
         | Proved (opaque, None, obj) ->
             match Proof_global.(obj.entries) with
             | [_;f_def;lemma_def] ->
@@ -65,7 +69,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/derive.mli b/plugins/derive/derive.mli
index 9ea876f1..06ff9c48 100644
--- a/plugins/derive/derive.mli
+++ b/plugins/derive/derive.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** [start_deriving f suchthat lemma] starts a proof of [suchthat]
diff --git a/plugins/derive/g_derive.ml4 b/plugins/derive/g_derive.ml4
index d4dc7e0e..a5932414 100644
--- a/plugins/derive/g_derive.ml4
+++ b/plugins/derive/g_derive.ml4
@@ -1,14 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Constrarg
-
-(*i camlp4deps: "grammar/grammar.cma"  i*)
+open Stdarg
 
 DECLARE PLUGIN "derive_plugin"
 
diff --git a/plugins/derive/vo.itarget b/plugins/derive/vo.itarget
deleted file mode 100644
index b4809821..00000000
--- a/plugins/derive/vo.itarget
+++ /dev/null
@@ -1 +0,0 @@
-Derive.vo
\ No newline at end of file
diff --git a/plugins/extraction/CHANGES b/plugins/extraction/CHANGES
index cf97ae3a..4bc3dba3 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/ExtrHaskellBasic.v b/plugins/extraction/ExtrHaskellBasic.v
index 294d6102..d08a81da 100644
--- a/plugins/extraction/ExtrHaskellBasic.v
+++ b/plugins/extraction/ExtrHaskellBasic.v
@@ -1,5 +1,7 @@
 (** Extraction to Haskell : use of basic Haskell types *)
 
+Require Coq.extraction.Extraction.
+
 Extract Inductive bool => "Prelude.Bool" [ "Prelude.True" "Prelude.False" ].
 Extract Inductive option => "Prelude.Maybe" [ "Prelude.Just" "Prelude.Nothing" ].
 Extract Inductive unit => "()" [ "()" ].
diff --git a/plugins/extraction/ExtrHaskellNatInt.v b/plugins/extraction/ExtrHaskellNatInt.v
index e94e7d42..267322d9 100644
--- a/plugins/extraction/ExtrHaskellNatInt.v
+++ b/plugins/extraction/ExtrHaskellNatInt.v
@@ -1,5 +1,7 @@
 (** Extraction of [nat] into Haskell's [Int] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Arith.
 Require Import ExtrHaskellNatNum.
 
diff --git a/plugins/extraction/ExtrHaskellNatInteger.v b/plugins/extraction/ExtrHaskellNatInteger.v
index 038f0ed8..4c5c71f5 100644
--- a/plugins/extraction/ExtrHaskellNatInteger.v
+++ b/plugins/extraction/ExtrHaskellNatInteger.v
@@ -1,5 +1,7 @@
 (** Extraction of [nat] into Haskell's [Integer] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Arith.
 Require Import ExtrHaskellNatNum.
 
diff --git a/plugins/extraction/ExtrHaskellNatNum.v b/plugins/extraction/ExtrHaskellNatNum.v
index 244eb85f..09b04446 100644
--- a/plugins/extraction/ExtrHaskellNatNum.v
+++ b/plugins/extraction/ExtrHaskellNatNum.v
@@ -6,6 +6,8 @@
  * implements [Num].
  *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Arith.
 Require Import EqNat.
 
@@ -32,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/ExtrHaskellString.v b/plugins/extraction/ExtrHaskellString.v
index 3558f4f2..ac1f6f91 100644
--- a/plugins/extraction/ExtrHaskellString.v
+++ b/plugins/extraction/ExtrHaskellString.v
@@ -2,6 +2,8 @@
  * Special handling of ascii and strings for extraction to Haskell.
  *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Ascii.
 Require Import String.
 
diff --git a/plugins/extraction/ExtrHaskellZInt.v b/plugins/extraction/ExtrHaskellZInt.v
index 66690851..0345ffc4 100644
--- a/plugins/extraction/ExtrHaskellZInt.v
+++ b/plugins/extraction/ExtrHaskellZInt.v
@@ -1,5 +1,7 @@
 (** Extraction of [Z] into Haskell's [Int] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import ZArith.
 Require Import ExtrHaskellZNum.
 
diff --git a/plugins/extraction/ExtrHaskellZInteger.v b/plugins/extraction/ExtrHaskellZInteger.v
index f192f16e..f7f9e2f8 100644
--- a/plugins/extraction/ExtrHaskellZInteger.v
+++ b/plugins/extraction/ExtrHaskellZInteger.v
@@ -1,5 +1,7 @@
 (** Extraction of [Z] into Haskell's [Integer] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import ZArith.
 Require Import ExtrHaskellZNum.
 
diff --git a/plugins/extraction/ExtrHaskellZNum.v b/plugins/extraction/ExtrHaskellZNum.v
index cbbfda75..4141bd20 100644
--- a/plugins/extraction/ExtrHaskellZNum.v
+++ b/plugins/extraction/ExtrHaskellZNum.v
@@ -6,6 +6,8 @@
  * implements [Num].
  *)
 
+Require Coq.extraction.Extraction.
+
 Require Import ZArith.
 Require Import EqNat.
 
diff --git a/plugins/extraction/ExtrOcamlBasic.v b/plugins/extraction/ExtrOcamlBasic.v
index d9b000c2..36bb1148 100644
--- a/plugins/extraction/ExtrOcamlBasic.v
+++ b/plugins/extraction/ExtrOcamlBasic.v
@@ -1,11 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+Require Coq.extraction.Extraction.
+
 (** Extraction to Ocaml : use of basic Ocaml types *)
 
 Extract Inductive bool => bool [ true false ].
diff --git a/plugins/extraction/ExtrOcamlBigIntConv.v b/plugins/extraction/ExtrOcamlBigIntConv.v
index c42938c8..2d832799 100644
--- a/plugins/extraction/ExtrOcamlBigIntConv.v
+++ b/plugins/extraction/ExtrOcamlBigIntConv.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Extraction to Ocaml: conversion from/to [big_int] *)
@@ -13,6 +15,8 @@
     simplifies the use of [Big_int] (it can be found in the sources
     of Coq). *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Arith ZArith.
 
 Parameter bigint : Type.
diff --git a/plugins/extraction/ExtrOcamlIntConv.v b/plugins/extraction/ExtrOcamlIntConv.v
index 515fa52d..a3a4d45c 100644
--- a/plugins/extraction/ExtrOcamlIntConv.v
+++ b/plugins/extraction/ExtrOcamlIntConv.v
@@ -1,15 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Extraction to Ocaml: conversion from/to [int]
 
     Nota: no check that [int] values aren't generating overflows *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Arith ZArith.
 
 Parameter int : Type.
@@ -94,4 +98,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/ExtrOcamlNatBigInt.v b/plugins/extraction/ExtrOcamlNatBigInt.v
index 3149e702..c403f7c5 100644
--- a/plugins/extraction/ExtrOcamlNatBigInt.v
+++ b/plugins/extraction/ExtrOcamlNatBigInt.v
@@ -1,13 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Extraction of [nat] into Ocaml's [big_int] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Arith Even Div2 EqNat Euclid.
 Require Import ExtrOcamlBasic.
 
@@ -42,7 +46,7 @@ Extract Constant EqNat.eq_nat_decide => "Big.eq".
 
 Extract Constant Peano_dec.eq_nat_dec => "Big.eq".
 
-Extract Constant Compare_dec.nat_compare =>
+Extract Constant Nat.compare =>
  "Big.compare_case Eq Lt Gt".
 
 Extract Constant Compare_dec.leb => "Big.le".
diff --git a/plugins/extraction/ExtrOcamlNatInt.v b/plugins/extraction/ExtrOcamlNatInt.v
index 7c607f7a..a2f809a0 100644
--- a/plugins/extraction/ExtrOcamlNatInt.v
+++ b/plugins/extraction/ExtrOcamlNatInt.v
@@ -1,13 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Extraction of [nat] into Ocaml's [int] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Arith Even Div2 EqNat Euclid.
 Require Import ExtrOcamlBasic.
 
@@ -55,7 +59,7 @@ Extract Inlined Constant EqNat.eq_nat_decide => "(=)".
 
 Extract Inlined Constant Peano_dec.eq_nat_dec => "(=)".
 
-Extract Constant Compare_dec.nat_compare =>
+Extract Constant Nat.compare =>
  "fun n m -> if n=m then Eq else if n<m then Lt else Gt".
 Extract Inlined Constant Compare_dec.leb => "(<=)".
 Extract Inlined Constant Compare_dec.le_lt_dec => "(<=)".
diff --git a/plugins/extraction/ExtrOcamlString.v b/plugins/extraction/ExtrOcamlString.v
index 6af591ee..030b486b 100644
--- a/plugins/extraction/ExtrOcamlString.v
+++ b/plugins/extraction/ExtrOcamlString.v
@@ -1,13 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Extraction to Ocaml : special handling of ascii and strings *)
 
+Require Coq.extraction.Extraction.
+
 Require Import Ascii String.
 
 Extract Inductive ascii => char
diff --git a/plugins/extraction/ExtrOcamlZBigInt.v b/plugins/extraction/ExtrOcamlZBigInt.v
index c9e8eac0..f7746b3e 100644
--- a/plugins/extraction/ExtrOcamlZBigInt.v
+++ b/plugins/extraction/ExtrOcamlZBigInt.v
@@ -1,13 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Extraction of [positive], [N] and [Z] into Ocaml's [big_int] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import ZArith NArith.
 Require Import ExtrOcamlBasic.
 
diff --git a/plugins/extraction/ExtrOcamlZInt.v b/plugins/extraction/ExtrOcamlZInt.v
index 4d33174b..f0e4b297 100644
--- a/plugins/extraction/ExtrOcamlZInt.v
+++ b/plugins/extraction/ExtrOcamlZInt.v
@@ -1,13 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Extraction of [positive], [N] and [Z] into Ocaml's [int] *)
 
+Require Coq.extraction.Extraction.
+
 Require Import ZArith NArith.
 Require Import ExtrOcamlBasic.
 
diff --git a/plugins/extraction/Extraction.v b/plugins/extraction/Extraction.v
new file mode 100644
index 00000000..b79d32e6
--- /dev/null
+++ b/plugins/extraction/Extraction.v
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+Declare ML Module "extraction_plugin".
diff --git a/plugins/extraction/big.ml b/plugins/extraction/big.ml
index 44b81d76..9c0f373c 100644
--- a/plugins/extraction/big.ml
+++ b/plugins/extraction/big.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** [Big] : a wrapper around ocaml [Big_int] with nicer names,
diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml
index 3c5f6cb7..f235bb89 100644
--- a/plugins/extraction/common.ml
+++ b/plugins/extraction/common.ml
@@ -1,14 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open Util
 open Names
+open ModPath
 open Namegen
 open Nameops
 open Libnames
@@ -44,7 +47,7 @@ let pp_apply2 st par args =
 
 let pr_binding = function
   | [] -> mt ()
-  | l  -> str " " ++ prlist_with_sep (fun () -> str " ") pr_id l
+  | l  -> str " " ++ prlist_with_sep (fun () -> str " ") Id.print l
 
 let pp_tuple_light f = function
   | [] -> mt ()
@@ -67,7 +70,9 @@ let pp_boxed_tuple f = function
     blocks is less that a line length. To avoid this awkward situation,
     we attach a big virtual size to [fnl] newlines. *)
 
-let fnl () = stras (1000000,"") ++ fnl ()
+(* EG: This looks quite suspicious... but beware of bugs *)
+(* let fnl () = stras (1000000,"") ++ fnl () *)
+let fnl () = fnl ()
 
 let fnl2 () = fnl () ++ fnl ()
 
@@ -91,10 +96,7 @@ let begins_with_CoqXX s =
 
 let unquote s =
   if lang () != Scheme then s
-  else
-    let s = String.copy s in
-    for i=0 to String.length s - 1 do if s.[i] == '\'' then s.[i] <- '~' done;
-    s
+  else String.map (fun c -> if c == '\'' then '~' else c) s
 
 let rec qualify delim = function
   | [] -> assert false
@@ -110,12 +112,17 @@ let pseudo_qualify = qualify "__"
 let is_upper s = match s.[0] with 'A' .. 'Z' -> true | _ -> false
 let is_lower s = match s.[0] with 'a' .. 'z' | '_' -> true | _ -> false
 
-let lowercase_id id = Id.of_string (String.uncapitalize (ascii_of_id id))
+[@@@ocaml.warning "-3"]       (* String.(un)capitalize_ascii since 4.03.0 GPR#124 *)
+let capitalize = String.capitalize
+let uncapitalize = String.uncapitalize
+[@@@ocaml.warning "+3"]
+
+let lowercase_id id = Id.of_string (uncapitalize (ascii_of_id id))
 let uppercase_id id =
   let s = ascii_of_id id in
   assert (not (String.is_empty s));
   if s.[0] == '_' then Id.of_string ("Coq_"^s)
-  else Id.of_string (String.capitalize s)
+  else Id.of_string (capitalize s)
 
 type kind = Term | Type | Cons | Mod
 
@@ -145,7 +152,7 @@ type env = Id.t list * Id.Set.t
 (*s Generic renaming issues for local variable names. *)
 
 let rec rename_id id avoid =
-  if Id.Set.mem id avoid then rename_id (lift_subscript id) avoid else id
+  if Id.Set.mem id avoid then rename_id (increment_subscript id) avoid else id
 
 let rec rename_vars avoid = function
   | [] ->
@@ -269,8 +276,8 @@ let params_ren_add, params_ren_mem =
   seen at this level.
 *)
 
-type visible_layer = { mp : module_path;
-		       params : module_path list;
+type visible_layer = { mp : ModPath.t;
+		       params : ModPath.t list;
 		       mutable content : Label.t KMap.t; }
 
 let pop_visible, push_visible, get_visible =
@@ -308,15 +315,16 @@ end
 
 module DupMap = Map.Make(DupOrd)
 
-let add_duplicate, check_duplicate =
+let add_duplicate, get_duplicate =
   let index = ref 0 and dups = ref DupMap.empty in
   register_cleanup (fun () -> index := 0; dups := DupMap.empty);
   let add mp l =
      incr index;
      let ren = "Coq__" ^ string_of_int !index in
      dups := DupMap.add (mp,l) ren !dups
-  and check mp l = DupMap.find (mp, l) !dups
-  in (add,check)
+  and get mp l =
+    try Some (DupMap.find (mp, l) !dups) with Not_found -> None
+  in (add,get)
 
 type reset_kind = AllButExternal | Everything
 
@@ -399,7 +407,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
@@ -510,10 +518,11 @@ let pp_duplicate k' prefix mp rls olab =
       (* Here rls=s::rls', we search the label for s inside mp *)
       List.tl rls, get_nth_label_mp (mp_length mp - mp_length prefix) mp
   in
-  try dottify (check_duplicate prefix lbl :: rls')
-  with Not_found ->
-    assert (get_phase () == Pre); (* otherwise it's too late *)
-    add_duplicate prefix lbl; dottify rls
+  match get_duplicate prefix lbl with
+  | Some ren -> dottify (ren :: rls')
+  | None ->
+     assert (get_phase () == Pre); (* otherwise it's too late *)
+     add_duplicate prefix lbl; dottify rls
 
 let fstlev_ks k = function
   | [] -> assert false
diff --git a/plugins/extraction/common.mli b/plugins/extraction/common.mli
index 2f560196..78545c8b 100644
--- a/plugins/extraction/common.mli
+++ b/plugins/extraction/common.mli
@@ -1,38 +1,39 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Globnames
 open Miniml
-open Pp
 
 (** By default, in module Format, you can do horizontal placing of blocks
     even if they include newlines, as long as the number of chars in the
     blocks are less that a line length. To avoid this awkward situation,
     we attach a big virtual size to [fnl] newlines. *)
 
-val fnl : unit -> std_ppcmds
-val fnl2 : unit -> std_ppcmds
-val space_if : bool -> std_ppcmds
+val fnl : unit -> Pp.t
+val fnl2 : unit -> Pp.t
+val space_if : bool -> Pp.t
 
-val pp_par : bool -> std_ppcmds -> std_ppcmds
+val pp_par : bool -> Pp.t -> Pp.t
 
 (** [pp_apply] : a head part applied to arguments, possibly with parenthesis *)
-val pp_apply : std_ppcmds -> bool -> std_ppcmds list -> std_ppcmds
+val pp_apply : Pp.t -> bool -> Pp.t list -> Pp.t
 
 (** Same as [pp_apply], but with also protection of the head by parenthesis *)
-val pp_apply2 : std_ppcmds -> bool -> std_ppcmds list -> std_ppcmds
+val pp_apply2 : Pp.t -> bool -> Pp.t list -> Pp.t
 
-val pp_tuple_light : (bool -> 'a -> std_ppcmds) -> 'a list -> std_ppcmds
-val pp_tuple : ('a -> std_ppcmds) -> 'a list -> std_ppcmds
-val pp_boxed_tuple : ('a -> std_ppcmds) -> 'a list -> std_ppcmds
+val pp_tuple_light : (bool -> 'a -> Pp.t) -> 'a list -> Pp.t
+val pp_tuple : ('a -> Pp.t) -> 'a list -> Pp.t
+val pp_boxed_tuple : ('a -> Pp.t) -> 'a list -> Pp.t
 
-val pr_binding : Id.t list -> std_ppcmds
+val pr_binding : Id.t list -> Pp.t
 
 val rename_id : Id.t -> Id.Set.t -> Id.t
 
@@ -49,20 +50,20 @@ type phase = Pre | Impl | Intf
 val set_phase : phase -> unit
 val get_phase : unit -> phase
 
-val opened_libraries : unit -> module_path list
+val opened_libraries : unit -> ModPath.t list
 
 type kind = Term | Type | Cons | Mod
 
 val pp_global : kind -> global_reference -> string
-val pp_module : module_path -> string
+val pp_module : ModPath.t -> string
 
-val top_visible_mp : unit -> module_path
+val top_visible_mp : unit -> ModPath.t
 (* In [push_visible], the [module_path list] corresponds to
    module parameters, the innermost one coming first in the list *)
-val push_visible : module_path -> module_path list -> unit
+val push_visible : ModPath.t -> ModPath.t list -> unit
 val pop_visible : unit -> unit
 
-val check_duplicate : module_path -> Label.t -> string
+val get_duplicate : ModPath.t -> Label.t -> string option
 
 type reset_kind = AllButExternal | Everything
 
@@ -72,7 +73,7 @@ val set_keywords : Id.Set.t -> unit
 
 (** For instance: [mk_ind "Coq.Init.Datatypes" "nat"] *)
 
-val mk_ind : string -> string -> mutual_inductive
+val mk_ind : string -> string -> MutInd.t
 
 (** Special hack for constants of type Ascii.ascii : if an
     [Extract Inductive ascii => char] has been declared, then
@@ -80,4 +81,4 @@ val mk_ind : string -> string -> mutual_inductive
 
 val is_native_char : ml_ast -> bool
 val get_native_char : ml_ast -> char
-val pp_native_char : ml_ast -> std_ppcmds
+val pp_native_char : ml_ast -> Pp.t
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 52f22ee6..397cb292 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -1,15 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Miniml
-open Term
+open Constr
 open Declarations
 open Names
+open ModPath
 open Libnames
 open Globnames
 open Pp
@@ -27,13 +30,13 @@ open Common
 let toplevel_env () =
   let get_reference = function
     | (_,kn), Lib.Leaf o ->
-	let mp,_,l = repr_kn kn in
+	let mp,_,l = KerName.repr kn in
 	begin match Libobject.object_tag o with
 	  | "CONSTANT" ->
-            let constant = Global.lookup_constant (constant_of_kn kn) in
+            let constant = Global.lookup_constant (Constant.make1 kn) in
             Some (l, SFBconst constant)
 	  | "INDUCTIVE" ->
-            let inductive = Global.lookup_mind (mind_of_kn kn) in
+            let inductive = Global.lookup_mind (MutInd.make1 kn) in
             Some (l, SFBmind inductive)
 	  | "MODULE" ->
             let modl = Global.lookup_module (MPdot (mp, l)) in
@@ -41,7 +44,7 @@ let toplevel_env () =
 	  | "MODULE TYPE" ->
             let modtype = Global.lookup_modtype (MPdot (mp, l)) in
             Some (l, SFBmodtype modtype)
-          | "INCLUDE" -> error "No extraction of toplevel Include yet."
+          | "INCLUDE" -> user_err Pp.(str "No extraction of toplevel Include yet.")
 	  | _ -> None
         end
     | _ -> None
@@ -72,21 +75,21 @@ module type VISIT = sig
 
   (* Add the module_path and all its prefixes to the mp visit list.
      We'll keep all fields of these modules. *)
-  val add_mp_all : module_path -> unit
+  val add_mp_all : ModPath.t -> unit
 
   (* Add reference / ... in the visit lists.
      These functions silently add the mp of their arg in the mp list *)
   val add_ref : global_reference -> unit
-  val add_kn : kernel_name -> unit
+  val add_kn : KerName.t -> unit
   val add_decl_deps : ml_decl -> unit
   val add_spec_deps : ml_spec -> unit
 
   (* Test functions:
      is a particular object a needed dependency for the current extraction ? *)
-  val needed_ind : mutual_inductive -> bool
-  val needed_cst : constant -> bool
-  val needed_mp : module_path -> bool
-  val needed_mp_all : module_path -> bool
+  val needed_ind : MutInd.t -> bool
+  val needed_cst : Constant.t -> bool
+  val needed_mp : ModPath.t -> bool
+  val needed_mp_all : ModPath.t -> bool
 end
 
 module Visit : VISIT = struct
@@ -101,8 +104,8 @@ module Visit : VISIT = struct
     v.kn <- KNset.empty;
     v.mp <- MPset.empty;
     v.mp_all <- MPset.empty
-  let needed_ind i = KNset.mem (user_mind i) v.kn
-  let needed_cst c = KNset.mem (user_con c) v.kn
+  let needed_ind i = KNset.mem (MutInd.user i) v.kn
+  let needed_cst c = KNset.mem (Constant.user c) v.kn
   let needed_mp mp = MPset.mem mp v.mp || MPset.mem mp v.mp_all
   let needed_mp_all mp = MPset.mem mp v.mp_all
   let add_mp mp =
@@ -111,10 +114,10 @@ module Visit : VISIT = struct
     check_loaded_modfile mp;
     v.mp <- MPset.union (prefixes_mp mp) v.mp;
     v.mp_all <- MPset.add mp v.mp_all
-  let add_kn kn = v.kn <- KNset.add kn v.kn; add_mp (modpath kn)
+  let add_kn kn = v.kn <- KNset.add kn v.kn; add_mp (KerName.modpath kn)
   let add_ref = function
-    | ConstRef c -> add_kn (user_con c)
-    | IndRef (ind,_) | ConstructRef ((ind,_),_) -> add_kn (user_mind ind)
+    | ConstRef c -> add_kn (Constant.user c)
+    | IndRef (ind,_) | ConstructRef ((ind,_),_) -> add_kn (MutInd.user ind)
     | VarRef _ -> assert false
   let add_decl_deps = decl_iter_references add_ref add_ref add_ref
   let add_spec_deps = spec_iter_references add_ref add_ref add_ref
@@ -131,25 +134,28 @@ let rec add_labels mp = function
 exception Impossible
 
 let check_arity env cb =
-  let t = Typeops.type_of_constant_type env cb.const_type in
+  let t = cb.const_type in
   if Reduction.is_arity env t then raise Impossible
 
-let check_fix env cb i =
+let get_body lbody =
+  EConstr.of_constr (Mod_subst.force_constr lbody)
+
+let check_fix env sg cb i =
   match cb.const_body with
     | Def lbody ->
-	(match kind_of_term (Mod_subst.force_constr lbody) with
-	  | Fix ((_,j),recd) when Int.equal i j -> check_arity env cb; (true,recd)
+        (match EConstr.kind sg (get_body 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)
     | Undef _ | OpaqueDef _ -> raise Impossible
 
-let prec_declaration_equal (na1, ca1, ta1) (na2, ca2, ta2) =
+let prec_declaration_equal sg (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 (EConstr.eq_constr sg) ca1 ca2 &&
+  Array.equal (EConstr.eq_constr sg) ta1 ta2
 
-let factor_fix env l cb msb =
-  let _,recd as check = check_fix env cb 0 in
+let factor_fix env sg l cb msb =
+  let _,recd as check = check_fix env sg cb 0 in
   let n = Array.length (let fi,_,_ = recd in fi) in
   if Int.equal n 1 then [|l|], recd, msb
   else begin
@@ -160,9 +166,9 @@ let factor_fix env l cb msb =
       (fun j ->
 	 function
 	   | (l,SFBconst cb') ->
-	       let check' = check_fix env cb' (j+1) in
-	       if not ((fst check : bool) == (fst check') &&
-		   prec_declaration_equal (snd check) (snd check'))
+              let check' = check_fix env sg cb' (j+1) in
+              if not ((fst check : bool) == (fst check') &&
+                        prec_declaration_equal sg (snd check) (snd check'))
 	       then raise Impossible;
 	       labels.(j+1) <- l;
 	   | _ -> raise Impossible) msb';
@@ -174,26 +180,32 @@ let factor_fix env l cb msb =
     (hack proposed by Elie)
 *)
 
-let expand_mexpr env mp me =
+let expand_mexpr env mpo me =
   let inl = Some (Flags.get_inline_level()) in
-  Mod_typing.translate_mse env (Some mp) inl me
-
-(** Ad-hoc update of environment, inspired by [Mod_type.check_with_aux_def].
-    To check with Elie. *)
+  Mod_typing.translate_mse env mpo inl me
 
-let rec mp_of_mexpr = function
-  | MEident mp -> mp
-  | MEwith (seb,_) -> mp_of_mexpr seb
-  | _ -> assert false
+let expand_modtype env mp me =
+  let inl = Some (Flags.get_inline_level()) in
+  Mod_typing.translate_modtype env mp inl ([],me)
 
 let no_delta = Mod_subst.empty_delta_resolver
 
-let env_for_mtb_with_def env mp me idl =
+let flatten_modtype env mp me_alg struc_opt =
+  match struc_opt with
+  | Some me -> me, no_delta
+  | None ->
+     let mtb = expand_modtype env mp me_alg in
+     mtb.mod_type, mtb.mod_delta
+
+(** Ad-hoc update of environment, inspired by [Mod_typing.check_with_aux_def].
+*)
+
+let env_for_mtb_with_def env mp me reso idl =
   let struc = Modops.destr_nofunctor me in
   let l = Label.of_id (List.hd idl) in
   let spot = function (l',SFBconst _) -> Label.equal l l' | _ -> false in
   let before = fst (List.split_when spot struc) in
-  Modops.add_structure mp before no_delta env
+  Modops.add_structure mp before reso env
 
 let make_cst resolver mp l =
   Mod_subst.constant_of_delta_kn resolver (KerName.make2 mp l)
@@ -233,20 +245,26 @@ let rec extract_structure_spec env mp reso = function
    [extract_mexpression_spec] should come from a [mod_type_alg] field.
    This way, any encountered [MEident] should be a true module type. *)
 
-and extract_mexpr_spec env mp1 (me_struct,me_alg) = match me_alg with
+and extract_mexpr_spec env mp1 (me_struct_o,me_alg) = match me_alg with
   | MEident mp -> Visit.add_mp_all mp; MTident mp
   | MEwith(me',WithDef(idl,(c,ctx)))->
-      let env' = env_for_mtb_with_def env (mp_of_mexpr me') me_struct idl in
-      let mt = extract_mexpr_spec env mp1 (me_struct,me') in
-      (match extract_with_type env' c with (* cb may contain some kn *)
+      let me_struct,delta = flatten_modtype env mp1 me' me_struct_o in
+      let env' = env_for_mtb_with_def env mp1 me_struct delta idl in
+      let mt = extract_mexpr_spec env mp1 (None,me') in
+      let sg = Evd.from_env env in
+      (match extract_with_type env' sg (EConstr.of_constr c) with
+       (* cb may contain some kn *)
 	 | None -> mt
-	 | Some (vl,typ) -> MTwith(mt,ML_With_type(idl,vl,typ)))
+	 | Some (vl,typ) ->
+            type_iter_references Visit.add_ref typ;
+            MTwith(mt,ML_With_type(idl,vl,typ)))
   | MEwith(me',WithMod(idl,mp))->
       Visit.add_mp_all mp;
-      MTwith(extract_mexpr_spec env mp1 (me_struct,me'), ML_With_module(idl,mp))
+      MTwith(extract_mexpr_spec env mp1 (None,me'), ML_With_module(idl,mp))
   | MEapply _ ->
      (* No higher-order module type in OCaml : we use the expanded version *)
-     extract_msignature_spec env mp1 no_delta (*TODO*) me_struct
+     let me_struct,delta = flatten_modtype env mp1 me_alg me_struct_o in
+     extract_msignature_spec env mp1 delta me_struct
 
 and extract_mexpression_spec env mp1 (me_struct,me_alg) = match me_alg with
   | MoreFunctor (mbid, mtb, me_alg') ->
@@ -257,8 +275,8 @@ and extract_mexpression_spec env mp1 (me_struct,me_alg) = match me_alg with
       let mp = MPbound mbid in
       let env' = Modops.add_module_type mp mtb env in
       MTfunsig (mbid, extract_mbody_spec env mp mtb,
-		extract_mexpression_spec env' mp1 (me_struct',me_alg'))
-  | NoFunctor m -> extract_mexpr_spec env mp1 (me_struct,m)
+                extract_mexpression_spec env' mp1 (me_struct',me_alg'))
+  | NoFunctor m -> extract_mexpr_spec env mp1 (Some me_struct,m)
 
 and extract_msignature_spec env mp1 reso = function
   | NoFunctor struc ->
@@ -270,7 +288,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
 
@@ -285,12 +304,13 @@ let rec extract_structure env mp reso ~all = function
   | [] -> []
   | (l,SFBconst cb) :: struc ->
       (try
-	 let vl,recd,struc = factor_fix env l cb struc in
+         let sg = Evd.from_env env in
+         let vl,recd,struc = factor_fix env sg l cb struc in
 	 let vc = Array.map (make_cst reso mp) vl in
 	 let ms = extract_structure env mp reso ~all struc in
 	 let b = Array.exists Visit.needed_cst vc in
 	 if all || b then
-	   let d = extract_fixpoint env vc recd in
+           let d = extract_fixpoint env sg vc recd in
 	   if (not b) && (logical_decl d) then ms
 	   else begin Visit.add_decl_deps d; (l,SEdecl d) :: ms end
 	 else ms
@@ -330,11 +350,11 @@ 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]. *)
-      let sign,_,delta,_ = expand_mexpr env mp me in
+      let sign,_,delta,_ = expand_mexpr env (Some mp) me in
       extract_msignature env mp delta ~all:true sign
   | MEident mp ->
       if is_modfile mp && not (modular ()) then error_MPfile_as_mod mp false;
@@ -435,7 +455,7 @@ let mono_filename f =
 	  else
             try Id.of_string (Filename.basename f)
 	    with UserError _ ->
-              error "Extraction: provided filename is not a valid identifier"
+              user_err Pp.(str "Extraction: provided filename is not a valid identifier")
 	in
 	Some (f^d.file_suffix), Option.map ((^) f) d.sig_suffix, id
 
@@ -472,13 +492,14 @@ let formatter dry file =
     if dry then Format.make_formatter (fun _ _ _ -> ()) (fun _ -> ())
     else
       match file with
-	| Some f -> Pp_control.with_output_to f
+	| Some f -> Topfmt.with_output_to f
 	| None -> Format.formatter_of_buffer buf
   in
+  (* XXX: Fixme, this shouldn't depend on Topfmt *)
   (* We never want to see ellipsis ... in extracted code *)
   Format.pp_set_max_boxes ft max_int;
   (* We reuse the width information given via "Set Printing Width" *)
-  (match Pp_control.get_margin () with
+  (match Topfmt.get_margin () with
     | None -> ()
     | Some i ->
       Format.pp_set_margin ft i;
@@ -507,8 +528,7 @@ let print_structure_to_file (fn,si,mo) dry struc =
   in
   (* First, a dry run, for computing objects to rename or duplicate *)
   set_phase Pre;
-  let devnull = formatter true None in
-  pp_with devnull (d.pp_struct struc);
+  ignore (d.pp_struct struc);
   let opened = opened_libraries () in
   (* Print the implementation *)
   let cout = if dry then None else Option.map open_out fn in
@@ -519,8 +539,10 @@ let print_structure_to_file (fn,si,mo) dry struc =
     set_phase Impl;
     pp_with ft (d.preamble mo comment opened unsafe_needs);
     pp_with ft (d.pp_struct struc);
+    Format.pp_print_flush ft ();
     Option.iter close_out cout;
   with reraise ->
+    Format.pp_print_flush ft ();
     Option.iter close_out cout; raise reraise
   end;
   if not dry then Option.iter info_file fn;
@@ -533,8 +555,10 @@ let print_structure_to_file (fn,si,mo) dry struc =
 	 set_phase Intf;
 	 pp_with ft (d.sig_preamble mo comment opened unsafe_needs);
 	 pp_with ft (d.pp_sig (signature_of_structure struc));
+         Format.pp_print_flush ft ();
 	 close_out cout;
        with reraise ->
+         Format.pp_print_flush ft ();
 	 close_out cout; raise reraise
        end;
        info_file si)
@@ -554,11 +578,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 =
-  check_inside_section (); check_inside_module ();
+let init ?(compute=false) ?(inner=false) modular library =
+  if not inner then (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 ()
 
@@ -572,8 +597,8 @@ let warns () =
 let rec locate_ref = function
   | [] -> [],[]
   | r::l ->
-      let q = snd (qualid_of_reference r) in
-      let mpo = try Some (Nametab.locate_module q) with Not_found -> None
+      let q = qualid_of_reference r in
+      let mpo = try Some (Nametab.locate_module q.CAst.v) with Not_found -> None
       and ro =
         try Some (Smartlocate.global_with_alias r)
         with Nametab.GlobalizationError _ | UserError _ -> None
@@ -583,7 +608,7 @@ let rec locate_ref = function
 	| None, Some r -> let refs,mps = locate_ref l in r::refs,mps
 	| Some mp, None -> let refs,mps = locate_ref l in refs,mp::mps
 	| Some mp, Some r ->
-           warning_ambiguous_name (q,mp,r);
+           warning_ambiguous_name (q.CAst.v,mp,r);
            let refs,mps = locate_ref l in refs,mp::mps
 
 (*s Recursive extraction in the Coq toplevel. The vernacular command is
@@ -621,7 +646,7 @@ let separate_extraction lr =
     is \verb!Extraction! [qualid]. *)
 
 let simple_extraction r =
-  Vernacentries.dump_global (Misctypes.AN r);
+  Vernacentries.dump_global CAst.(make (Misctypes.AN r));
   match locate_ref [r] with
   | ([], [mp]) as p -> full_extr None p
   | [r],[] ->
@@ -653,7 +678,7 @@ let extraction_library is_rec m =
   let l = List.rev (environment_until (Some dir_m)) in
   let select l (mp,struc) =
     if Visit.needed_mp mp
-    then (mp, extract_structure env mp no_delta true struc) :: l
+    then (mp, extract_structure env mp no_delta ~all:true struc) :: l
     else l
   in
   let struc = List.fold_left select [] l in
@@ -668,15 +693,76 @@ let extraction_library is_rec m =
   List.iter print struc;
   reset ()
 
-let structure_for_compute c =
-  init false false;
-  let env = Global.env () in
-  let ast, mlt = Extraction.extract_constr env c in
+(** 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 env sg c =
+  init false false ~compute:true;
+  let ast, mlt = Extraction.extract_constr env sg c in
   let ast = Mlutil.normalize ast in
   let refs = ref Refset.empty in
   let add_ref r = refs := Refset.add r !refs in
   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 *)
+
+let compile f =
+  try
+    let args = ["ocamlc";"-I";Filename.dirname f;"-c";f^"i";f] in
+    let res = CUnix.sys_command (Envars.ocamlfind ()) args in
+    match res with
+    | Unix.WEXITED 0 -> ()
+    | Unix.WEXITED n | Unix.WSIGNALED n | Unix.WSTOPPED n ->
+       CErrors.user_err
+         Pp.(str "Compilation of file " ++ str f ++
+             str " failed with exit code " ++ int n)
+  with Unix.Unix_error (e,_,_) ->
+    CErrors.user_err
+      Pp.(str "Compilation of file " ++ str f ++
+          str " failed with error " ++ str (Unix.error_message e))
+
+let remove f =
+  if Sys.file_exists f then Sys.remove f
+
+let extract_and_compile l =
+  if lang () != Ocaml then
+    CErrors.user_err (Pp.str "This command only works with OCaml extraction");
+  let f = Filename.temp_file "testextraction" ".ml" in
+  let () = full_extraction (Some f) l in
+  let () = compile f in
+  let () = remove f; remove (f^"i") in
+  let base = Filename.chop_suffix f ".ml" in
+  let () = remove (base^".cmo"); remove (base^".cmi") in
+  Feedback.msg_notice (str "Extracted code successfully compiled")
+
+(* Show the extraction of the current ongoing proof *)
+
+let show_extraction () =
+  init ~inner:true false false;
+  let prf = Proof_global.give_me_the_proof () in
+  let sigma, env = Pfedit.get_current_context () in
+  let trms = Proof.partial_proof prf in
+  let extr_term t =
+    let ast, ty = extract_constr env sigma t in
+    let mp = Lib.current_mp () in
+    let l = Label.of_id (Proof_global.get_current_proof_name ()) in
+    let fake_ref = ConstRef (Constant.make2 mp l) in
+    let decl = Dterm (fake_ref, ast, ty) in
+    print_one_decl [] mp decl
+  in
+  Feedback.msg_notice (Pp.prlist_with_sep Pp.fnl extr_term trms)
diff --git a/plugins/extraction/extract_env.mli b/plugins/extraction/extract_env.mli
index 90f4f911..591d3bb8 100644
--- a/plugins/extraction/extract_env.mli
+++ b/plugins/extraction/extract_env.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s This module declares the extraction commands. *)
@@ -17,18 +19,26 @@ val full_extraction : string option -> reference list -> unit
 val separate_extraction : reference list -> unit
 val extraction_library : bool -> Id.t -> unit
 
+(* For the test-suite : extraction to a temporary file + ocamlc on it *)
+
+val extract_and_compile : reference list -> unit
+
 (* For debug / external output via coqtop.byte + Drop : *)
 
 val mono_environment :
- global_reference list -> module_path list -> Miniml.ml_structure
+ global_reference list -> ModPath.t list -> Miniml.ml_structure
 
 (* Used by the Relation Extraction plugin *)
 
 val print_one_decl :
-  Miniml.ml_structure -> module_path -> Miniml.ml_decl -> Pp.std_ppcmds
+  Miniml.ml_structure -> ModPath.t -> Miniml.ml_decl -> Pp.t
 
 (* Used by Extraction Compute *)
 
 val structure_for_compute :
-  Term.constr ->
-    Miniml.ml_flat_structure * Miniml.ml_ast * Miniml.ml_type
+  Environ.env -> Evd.evar_map -> EConstr.t ->
+    Miniml.ml_decl list * Miniml.ml_ast * Miniml.ml_type
+
+(* Show the extraction of the current ongoing proof *)
+
+val show_extraction : unit -> unit
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index a980a43f..f25f6362 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -1,16 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
 open Util
 open Names
 open Term
-open Vars
+open Constr
 open Declarations
 open Declareops
 open Environ
@@ -31,22 +33,20 @@ open Context.Rel.Declaration
 exception I of inductive_kind
 
 (* A set of all fixpoint functions currently being extracted *)
-let current_fixpoints = ref ([] : constant list)
-
-let none = Evd.empty
+let current_fixpoints = ref ([] : Constant.t list)
 
 (* NB: In OCaml, [type_of] and [get_of] might raise
    [SingletonInductiveBecomeProp]. This exception will be caught
    in late wrappers around the exported functions of this file,
    in order to display the location of the issue. *)
 
-let type_of env c =
+let type_of env sg c =
   let polyprop = (lang() == Haskell) in
-  Retyping.get_type_of ~polyprop env none (strip_outer_cast c)
+  Retyping.get_type_of ~polyprop env sg (strip_outer_cast sg c)
 
-let sort_of env c =
+let sort_of env sg c =
   let polyprop = (lang() == Haskell) in
-  Retyping.get_sort_family_of ~polyprop env none (strip_outer_cast c)
+  Retyping.get_sort_family_of ~polyprop env sg (strip_outer_cast sg c)
 
 (*S Generation of flags and signatures. *)
 
@@ -73,49 +73,88 @@ type flag = info * scheme
 (*s [flag_of_type] transforms a type [t] into a [flag].
   Really important function. *)
 
-let rec flag_of_type env t : flag =
-  let t = whd_all env none t in
-  match kind_of_term t with
-    | Prod (x,t,c) -> flag_of_type (push_rel (LocalAssum (x,t)) env) c
-    | Sort s when Sorts.is_prop s -> (Logic,TypeScheme)
+let rec flag_of_type env sg t : flag =
+  let t = whd_all env sg t in
+  match EConstr.kind sg t with
+    | Prod (x,t,c) -> flag_of_type (EConstr.push_rel (LocalAssum (x,t)) env) sg c
+    | Sort s when Sorts.is_prop (EConstr.ESorts.kind sg s) -> (Logic,TypeScheme)
     | Sort _ -> (Info,TypeScheme)
-    | _ -> if (sort_of env t) == InProp then (Logic,Default) else (Info,Default)
+    | _ -> if (sort_of env sg t) == InProp then (Logic,Default) else (Info,Default)
 
 (*s Two particular cases of [flag_of_type]. *)
 
-let is_default env t = match flag_of_type env t with
+let is_default env sg t = match flag_of_type env sg t with
 | (Info, Default) -> true
 | _ -> false
 
 exception NotDefault of kill_reason
 
-let check_default env t =
-  match flag_of_type env t with
+let check_default env sg t =
+  match flag_of_type env sg t with
     | _,TypeScheme -> raise (NotDefault Ktype)
     | Logic,_ -> raise (NotDefault Kprop)
     | _ -> ()
 
-let is_info_scheme env t = match flag_of_type env t with
+let is_info_scheme env sg t = match flag_of_type env sg t with
 | (Info, TypeScheme) -> true
 | _ -> false
 
+let push_rel_assum (n, t) env =
+  EConstr.push_rel (LocalAssum (n, t)) env
+
+let push_rels_assum assums =
+  EConstr.push_rel_context (List.map (fun (x,t) -> LocalAssum (x,t)) assums)
+
+let get_body lconstr = EConstr.of_constr (Mod_subst.force_constr lconstr)
+
+let get_opaque env c =
+  EConstr.of_constr
+    (Opaqueproof.force_proof (Environ.opaque_tables env) c)
+
+let applistc c args = EConstr.mkApp (c, Array.of_list args)
+
+(* Same as [Environ.push_rec_types], but for [EConstr.t] *)
+let push_rec_types (lna,typarray,_) env =
+  let ctxt =
+    Array.map2_i
+      (fun i na t -> LocalAssum (na, EConstr.Vars.lift i t)) lna typarray
+  in
+  Array.fold_left (fun e assum -> EConstr.push_rel assum e) env ctxt
+
+(* Same as [Termops.nb_lam], but for [EConstr.t] *)
+let nb_lam sg c = List.length (fst (EConstr.decompose_lam sg c))
+
+(* Same as [Term.decompose_lam_n] but for [EConstr.t] *)
+let decompose_lam_n sg n =
+  let rec lamdec_rec l n c =
+    if n <= 0 then l,c
+    else match EConstr.kind sg c with
+      | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) (n-1) c
+      | Cast (c,_,_)     -> lamdec_rec l n c
+      | _ -> raise Not_found
+  in
+  lamdec_rec [] n
+
 (*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 none c) with
+let rec type_sign env sg c =
+  match EConstr.kind sg (whd_all env sg 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)
+        (if is_info_scheme env sg t then Keep else Kill Kprop)
+        :: (type_sign (push_rel_assum (n,t) env) sg d)
     | _ -> []
 
-let rec type_scheme_nb_args env c =
-  match kind_of_term (whd_all env none c) with
+let rec type_scheme_nb_args env sg c =
+  match EConstr.kind sg (whd_all env sg 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
+        let n = type_scheme_nb_args (push_rel_assum (n,t) env) sg d in
+        if is_info_scheme env sg t then n+1 else n
     | _ -> 0
 
-let _ = Hook.set type_scheme_nb_args_hook type_scheme_nb_args
+let type_scheme_nb_args' env c =
+  type_scheme_nb_args env (Evd.from_env env) (EConstr.of_constr c)
+
+let _ = Hook.set type_scheme_nb_args_hook type_scheme_nb_args'
 
 (*s [type_sign_vl] does the same, plus a type var list. *)
 
@@ -132,21 +171,22 @@ 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 none c) with
+let rec type_sign_vl env sg c =
+  match EConstr.kind sg (whd_all env sg 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
-	else Keep::s, (make_typvar n vl) :: vl
+        let s,vl = type_sign_vl (push_rel_assum (n,t) env) sg d in
+        if not (is_info_scheme env sg t) then Kill Kprop::s, vl
+        else Keep::s, (make_typvar n vl) :: vl
     | _ -> [],[]
 
-let rec nb_default_params env c =
-  match kind_of_term (whd_all env none c) with
+let rec nb_default_params env sg c =
+  match EConstr.kind sg (whd_all env sg 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
+        let n = nb_default_params (push_rel_assum (n,t) env) sg d in
+        if is_default env sg t then n+1 else n
     | _ -> 0
 
 (* Enriching a signature with implicit information *)
@@ -197,7 +237,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
@@ -213,62 +253,62 @@ let parse_ind_args si args relmax =
    generate ML type var anymore (in subterms for example). *)
 
 
-let rec extract_type env db j c args =
-  match kind_of_term (whd_betaiotazeta Evd.empty c) with
+let rec extract_type env sg db j c args =
+  match EConstr.kind sg (whd_betaiotazeta sg c) with
     | App (d, args') ->
-	(* We just accumulate the arguments. *)
-	extract_type env db j d (Array.to_list args' @ args)
+        (* We just accumulate the arguments. *)
+        extract_type env sg db j d (Array.to_list args' @ args)
     | Lambda (_,_,d) ->
 	(match args with
 	   | [] -> assert false (* A lambda cannot be a type. *)
-	   | a :: args -> extract_type env db j (subst1 a d) args)
+           | a :: args -> extract_type env sg db j (EConstr.Vars.subst1 a d) args)
     | Prod (n,t,d) ->
 	assert (List.is_empty args);
 	let env' = push_rel_assum (n,t) env in
-	(match flag_of_type env t with
+        (match flag_of_type env sg t with
 	   | (Info, Default) ->
 	       (* Standard case: two [extract_type] ... *)
-	       let mld = extract_type env' (0::db) j d [] in
+               let mld = extract_type env' sg (0::db) j d [] in
 	       (match expand env mld with
 		  | Tdummy d -> Tdummy d
-		  | _ -> Tarr (extract_type env db 0 t [], mld))
+                  | _ -> Tarr (extract_type env sg db 0 t [], mld))
 	   | (Info, TypeScheme) when j > 0 ->
 	       (* A new type var. *)
-	       let mld = extract_type env' (j::db) (j+1) d [] in
+               let mld = extract_type env' sg (j::db) (j+1) d [] in
 	       (match expand env mld with
 		  | Tdummy d -> Tdummy d
 		  | _ -> Tarr (Tdummy Ktype, mld))
 	   | _,lvl ->
-	       let mld = extract_type env' (0::db) j d [] in
+               let mld = extract_type env' sg (0::db) j d [] in
 	       (match expand env mld with
 		  | Tdummy d -> Tdummy d
 		  | _ ->
 		      let reason = if lvl == TypeScheme then Ktype else Kprop in
 		      Tarr (Tdummy reason, mld)))
     | Sort _ -> Tdummy Ktype (* The two logical cases. *)
-    | _ when sort_of env (applist (c, args)) == InProp -> Tdummy Kprop
+    | _ when sort_of env sg (applistc c args) == InProp -> Tdummy Kprop
     | Rel n ->
-	(match lookup_rel n env with
-           | LocalDef (_,t,_) -> extract_type env db j (lift n t) args
+        (match EConstr.lookup_rel n env with
+           | LocalDef (_,t,_) ->
+               extract_type env sg db j (EConstr.Vars.lift n t) args
 	   | _ ->
 	       (* Asks [db] a translation for [n]. *)
 	       if n > List.length db then Tunknown
 	       else let n' = List.nth db (n-1) in
 	       if Int.equal n' 0 then Tunknown else Tvar n')
-    | Const (kn,u as c) ->
-	let r = ConstRef kn in
-	let cb = lookup_constant kn env in
-	let typ,_ = Typeops.type_of_constant env c in
-	(match flag_of_type env typ with
+    | Const (kn,u) ->
+        let r = ConstRef kn in
+        let typ = type_of env sg (EConstr.mkConstU (kn,u)) in
+        (match flag_of_type env sg typ with
 	   | (Logic,_) -> assert false (* Cf. logical cases above *)
 	   | (Info, TypeScheme) ->
-	       let mlt = extract_type_app env db (r, type_sign env typ) args in
-	       (match cb.const_body with
+               let mlt = extract_type_app env sg db (r, type_sign env sg typ) args in
+               (match (lookup_constant kn env).const_body with
 		  | Undef _ | OpaqueDef _ -> mlt
-		  | Def _ when is_custom r -> mlt
+                  | Def _ when is_custom (ConstRef kn) -> mlt
 		  | Def lbody ->
-		      let newc = applist (Mod_subst.force_constr lbody, args) in
-		      let mlt' = extract_type env db j newc [] in
+                      let newc = applistc (get_body lbody) args in
+                      let mlt' = extract_type env sg db j newc [] in
 		      (* ML type abbreviations interact badly with Coq *)
 		      (* reduction, so [mlt] and [mlt'] might be different: *)
 		      (* The more precise is [mlt'], extracted after reduction *)
@@ -277,32 +317,51 @@ let rec extract_type env db j c args =
 		      if eq_ml_type (expand env mlt) (expand env mlt') then mlt else mlt')
 	   | (Info, Default) ->
                (* Not an ML type, for example [(c:forall X, X->X) Type nat] *)
-	       (match cb.const_body with
+               (match (lookup_constant kn env).const_body with
 		  | Undef _  | OpaqueDef _ -> Tunknown (* Brutal approx ... *)
 		  | Def lbody ->
 		      (* We try to reduce. *)
-		      let newc = applist (Mod_subst.force_constr lbody, args) in
-		      extract_type env db j newc []))
+                      let newc = applistc (get_body lbody) args in
+                      extract_type env sg db j newc []))
     | Ind ((kn,i),u) ->
-	let s = (extract_ind env kn).ind_packets.(i).ip_sign in
-	extract_type_app env db (IndRef (kn,i),s) args
-    | Case _ | Fix _ | CoFix _ | Proj _ -> Tunknown
-    | _ -> assert false
+        let s = (extract_ind env kn).ind_packets.(i).ip_sign in
+        extract_type_app env sg db (IndRef (kn,i),s) 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 sg db j (EConstr.mkProj (Projection.unfold p, t)) args
+    | Case _ | Fix _ | CoFix _ -> Tunknown
+    | Evar _ | Meta _ -> Taxiom (* only possible during Show Extraction *)
+    | Var v ->
+       (* For Show Extraction *)
+       let open Context.Named.Declaration in
+       (match EConstr.lookup_named v env with
+        | LocalDef (_,body,_) ->
+           extract_type env sg db j (EConstr.applist (body,args)) []
+        | LocalAssum (_,ty) ->
+           let r = VarRef v in
+           (match flag_of_type env sg ty with
+            | (Logic,_) -> assert false (* Cf. logical cases above *)
+            | (Info, TypeScheme) ->
+              extract_type_app env sg db (r, type_sign env sg ty) args
+            | (Info, Default) -> Tunknown))
+    | Cast _ | LetIn _ | Construct _ -> assert false
 
 (*s Auxiliary function dealing with type application.
   Precondition: [r] is a type scheme represented by the signature [s],
   and is completely applied: [List.length args = List.length s]. *)
 
-and extract_type_app env db (r,s) args =
+and extract_type_app env sg db (r,s) args =
   let ml_args =
     List.fold_right
       (fun (b,c) a -> if b == Keep then
-	 let p = List.length (fst (splay_prod env none (type_of env c))) in
+         let p = List.length (fst (splay_prod env sg (type_of env sg c))) in
          let db = iterate (fun l -> 0 :: l) p db in
-         (extract_type_scheme env db c p) :: a
+         (extract_type_scheme env sg db c p) :: a
        else a)
       (List.combine s args) []
-  in Tglob (r,  ml_args)
+  in Tglob (r, ml_args)
 
 (*S Extraction of a type scheme. *)
 
@@ -313,18 +372,18 @@ and extract_type_app env db (r,s) args =
 
 (* [db] is a context for translating Coq [Rel] into ML type [Tvar]. *)
 
-and extract_type_scheme env db c p =
-  if Int.equal p 0 then extract_type env db 0 c []
+and extract_type_scheme env sg db c p =
+  if Int.equal p 0 then extract_type env sg db 0 c []
   else
-    let c = whd_betaiotazeta Evd.empty c in
-    match kind_of_term c with
+    let c = whd_betaiotazeta sg c in
+    match EConstr.kind sg c with
       | Lambda (n,t,d) ->
-          extract_type_scheme (push_rel_assum (n,t) env) db d (p-1)
+          extract_type_scheme (push_rel_assum (n,t) env) sg db d (p-1)
       | _ ->
-          let rels = fst (splay_prod env none (type_of env c)) in
+          let rels = fst (splay_prod env sg (type_of env sg c)) in
           let env = push_rels_assum rels env in
-          let eta_args = List.rev_map mkRel (List.interval 1 p) in
-          extract_type env db 0 (lift p c) eta_args
+          let eta_args = List.rev_map EConstr.mkRel (List.interval 1 p) in
+          extract_type env sg db 0 (EConstr.Vars.lift p c) eta_args
 
 
 (*S Extraction of an inductive type. *)
@@ -351,14 +410,14 @@ and extract_really_ind env kn mib =
        (cf Vector and bug #2570) *)
     let equiv =
       if lang () != Ocaml ||
-	 (not (modular ()) && at_toplevel (mind_modpath kn)) ||
-	 KerName.equal (canonical_mind kn) (user_mind kn)
+	 (not (modular ()) && at_toplevel (MutInd.modpath kn)) ||
+	 KerName.equal (MutInd.canonical kn) (MutInd.user kn)
       then
 	NoEquiv
       else
 	begin
-	  ignore (extract_ind env (mind_of_kn (canonical_mind kn)));
-	  Equiv (canonical_mind kn)
+	  ignore (extract_ind env (MutInd.make1 (MutInd.canonical kn)));
+	  Equiv (MutInd.canonical kn)
 	end
     in
     (* Everything concerning parameters. *)
@@ -366,6 +425,7 @@ and extract_really_ind env kn mib =
     let mip0 = mib.mind_packets.(0) in
     let npar = mib.mind_nparams in
     let epar = push_rel_context mib.mind_params_ctxt env in
+    let sg = Evd.from_env env in
     (* First pass: we store inductive signatures together with *)
     (* their type var list. *)
     let packets =
@@ -373,8 +433,9 @@ and extract_really_ind env kn mib =
 	(fun i mip ->
 	   let (_,u),_ = Universes.fresh_inductive_instance env (kn,i) in
 	   let ar = Inductive.type_of_inductive env ((mib,mip),u) in
-	   let info = (fst (flag_of_type env ar) = Info) in
-	   let s,v = if info then type_sign_vl env ar else [],[] in
+           let ar = EConstr.of_constr ar in
+           let info = (fst (flag_of_type env sg ar) = Info) in
+           let s,v = if info then type_sign_vl env sg ar else [],[] in
 	   let t = Array.make (Array.length mip.mind_nf_lc) [] in
 	   { ip_typename = mip.mind_typename;
 	     ip_consnames = mip.mind_consnames;
@@ -400,13 +461,14 @@ 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
 	  let db = db_from_ind dbmap npar in
-	  p.ip_types.(j) <- extract_type_cons epar db dbmap t (npar+1)
+          p.ip_types.(j) <-
+            extract_type_cons epar sg db dbmap (EConstr.of_constr t) (npar+1)
 	done
     done;
     (* Third pass: we determine special cases. *)
@@ -415,7 +477,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);
@@ -429,7 +491,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
@@ -459,10 +521,9 @@ and extract_really_ind env kn mib =
 	(* Is this record officially declared with its projections ? *)
 	(* If so, we use this information. *)
 	begin try
-	  let n = nb_default_params env
-            (Inductive.type_of_inductive env ((mib,mip0),u))
-	  in
-	  let check_proj kn = if Cset.mem kn !projs then add_projection n kn ip
+          let ty = Inductive.type_of_inductive env ((mib,mip0),u) in
+          let n = nb_default_params env sg (EConstr.of_constr ty) in
+          let check_proj kn = if Cset.mem kn !projs then add_projection n kn ip
           in
 	  List.iter (Option.iter check_proj) (lookup_projections ip)
 	with Not_found -> ()
@@ -487,13 +548,13 @@ and extract_really_ind env kn mib =
    - [i] is the rank of the current product (initially [params_nb+1])
 *)
 
-and extract_type_cons env db dbmap c i =
-  match kind_of_term (whd_all env none c) with
+and extract_type_cons env sg db dbmap c i =
+  match EConstr.kind sg (whd_all env sg 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
-	let l = extract_type_cons env' db' dbmap d (i+1) in
-	(extract_type env db 0 t []) :: l
+        let l = extract_type_cons env' sg db' dbmap d (i+1) in
+        (extract_type env sg db 0 t []) :: l
     | _ -> []
 
 (*s Recording the ML type abbreviation of a Coq type scheme constant. *)
@@ -508,16 +569,17 @@ and mlt_env env r = match r with
         match lookup_typedef kn cb with
         | Some _ as o -> o
         | None ->
-           let typ = Typeops.type_of_constant_type env cb.const_type
+           let sg = Evd.from_env env in
+           let typ = EConstr.of_constr cb.const_type
            (* FIXME not sure if we should instantiate univs here *) in
-	   match flag_of_type env typ with
-	   | Info,TypeScheme ->
-	      let body = Mod_subst.force_constr l_body in
-	      let s = type_sign env typ in
-	      let db = db_from_sign s in
-	      let t = extract_type_scheme env db body (List.length s)
-	      in add_typedef kn cb t; Some t
-	   | _ -> None
+           match flag_of_type env sg typ with
+           | Info,TypeScheme ->
+              let body = get_body l_body in
+              let s = type_sign env sg typ in
+              let db = db_from_sign s in
+              let t = extract_type_scheme env sg db body (List.length s)
+              in add_typedef kn cb t; Some t
+           | _ -> None
 
 and expand env = type_expand (mlt_env env)
 and type2signature env = type_to_signature (mlt_env env)
@@ -527,16 +589,16 @@ let type_expunge_from_sign env = type_expunge_from_sign (mlt_env env)
 
 (*s Extraction of the type of a constant. *)
 
-let record_constant_type env kn opt_typ =
+let record_constant_type env sg kn opt_typ =
   let cb = lookup_constant kn env in
   match lookup_cst_type kn cb with
   | Some schema -> schema
   | None ->
      let typ = match opt_typ with
-       | None -> Typeops.type_of_constant_type env cb.const_type
+       | None -> EConstr.of_constr cb.const_type
        | Some typ -> typ
      in
-     let mlt = extract_type env [] 1 typ [] in
+     let mlt = extract_type env sg [] 1 typ [] in
      let schema = (type_maxvar mlt, mlt) in
      let () = add_cst_type kn cb schema in
      schema
@@ -548,74 +610,86 @@ let record_constant_type env kn opt_typ =
 (* [mle] is a ML environment [Mlenv.t]. *)
 (* [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
+let rec extract_term env sg mle mlt c args =
+  match EConstr.kind sg c with
     | App (f,a) ->
-	extract_term env mle mlt f (Array.to_list a @ args)
+       extract_term env sg mle mlt f (Array.to_list a @ args)
     | Lambda (n, t, d) ->
 	let id = id_of_name n in
 	(match args with
 	   | a :: l ->
 	       (* We make as many [LetIn] as possible. *)
- 	       let d' = mkLetIn (Name id,a,t,applistc d (List.map (lift 1) l))
-	       in extract_term env mle mlt d' []
+               let l' = List.map (EConstr.Vars.lift 1) l in
+               let d' = EConstr.mkLetIn (Name id,a,t,applistc d l') in
+               extract_term env sg mle mlt d' []
 	   | [] ->
 	       let env' = push_rel_assum (Name id, t) env in
 	       let id, a =
-		 try check_default env t; Id id, new_meta()
-		 with NotDefault d -> Dummy, Tdummy d
+                 try check_default env sg t; Id id, new_meta()
+                 with NotDefault d -> Dummy, Tdummy d
 	       in
 	       let b = new_meta () in
 	       (* If [mlt] cannot be unified with an arrow type, then magic! *)
 	       let magic = needs_magic (mlt, Tarr (a, b)) in
-	       let d' = extract_term env' (Mlenv.push_type mle a) b d [] in
+               let d' = extract_term env' sg (Mlenv.push_type mle a) b d [] in
 	       put_magic_if magic (MLlam (id, d')))
     | LetIn (n, c1, t1, c2) ->
 	let id = id_of_name n in
-	let env' = push_rel (LocalDef (Name id, c1, t1)) env in
+        let env' = EConstr.push_rel (LocalDef (Name id, c1, t1)) env in
 	(* We directly push the args inside the [LetIn].
            TODO: the opt_let_app flag is supposed to prevent that *)
-	let args' = List.map (lift 1) args in
+        let args' = List.map (EConstr.Vars.lift 1) args in
 	(try
-	  check_default env t1;
+          check_default env sg t1;
 	  let a = new_meta () in
-	  let c1' = extract_term env mle a c1 [] in
+          let c1' = extract_term env sg mle a c1 [] in
 	  (* The type of [c1'] is generalized and stored in [mle]. *)
 	  let mle' =
 	    if generalizable c1'
 	    then Mlenv.push_gen mle a
 	    else Mlenv.push_type mle a
 	  in
-	  MLletin (Id id, c1', extract_term env' mle' mlt c2 args')
+          MLletin (Id id, c1', extract_term env' sg mle' mlt c2 args')
 	with NotDefault d ->
 	  let mle' = Mlenv.push_std_type mle (Tdummy d) in
-	  ast_pop (extract_term env' mle' mlt c2 args'))
+          ast_pop (extract_term env' sg mle' mlt c2 args'))
     | Const (kn,_) ->
-	extract_cst_app env mle mlt kn args
+        extract_cst_app env sg mle mlt kn args
     | Construct (cp,_) ->
-	extract_cons_app env mle mlt cp args
+        extract_cons_app env sg mle mlt cp args
     | Proj (p, c) ->
         let term = Retyping.expand_projection env (Evd.from_env env) p c [] in
-	  extract_term env mle mlt term args
+        extract_term env sg mle mlt term args
     | Rel n ->
 	(* As soon as the expected [mlt] for the head is known, *)
 	(* we unify it with an fresh copy of the stored type of [Rel n]. *)
 	let extract_rel mlt = put_magic (mlt, Mlenv.get mle n) (MLrel n)
-	in extract_app env mle mlt extract_rel args
+        in extract_app env sg mle mlt extract_rel args
     | Case ({ci_ind=ip},_,c0,br) ->
- 	extract_app env mle mlt (extract_case env mle (ip,c0,br)) args
+        extract_app env sg mle mlt (extract_case env sg mle (ip,c0,br)) args
     | Fix ((_,i),recd) ->
- 	extract_app env mle mlt (extract_fix env mle i recd) args
+        extract_app env sg mle mlt (extract_fix env sg mle i recd) args
     | CoFix (i,recd) ->
- 	extract_app env mle mlt (extract_fix env mle i recd) args
-    | Cast (c,_,_) -> extract_term env mle mlt c args
-    | Ind _ | Prod _ | Sort _ | Meta _ | Evar _ | Var _ -> assert false
+        extract_app env sg mle mlt (extract_fix env sg mle i recd) args
+    | Cast (c,_,_) -> extract_term env sg mle mlt c args
+    | Evar _ | Meta _ -> MLaxiom
+    | Var v ->
+       (* Only during Show Extraction *)
+       let open Context.Named.Declaration in
+       let ty = match EConstr.lookup_named v env with
+         | LocalAssum (_,ty) -> ty
+         | LocalDef (_,_,ty) -> ty
+       in
+       let vty = extract_type env sg [] 0 ty [] in
+       let extract_var mlt = put_magic (mlt,vty) (MLglob (VarRef v)) in
+       extract_app env sg mle mlt extract_var args
+    | Ind _ | Prod _ | Sort _ -> assert false
 
 (*s [extract_maybe_term] is [extract_term] for usual terms, else [MLdummy] *)
 
-and extract_maybe_term env mle mlt c =
-  try check_default env (type_of env c);
-    extract_term env mle mlt c []
+and extract_maybe_term env sg mle mlt c =
+  try check_default env sg (type_of env sg c);
+    extract_term env sg mle mlt c []
   with NotDefault d ->
     put_magic (mlt, Tdummy d) (MLdummy d)
 
@@ -625,28 +699,28 @@ and extract_maybe_term env mle mlt c =
    This gives us the expected type of the head. Then we use the
    [mk_head] to produce the ML head from this type. *)
 
-and extract_app env mle mlt mk_head args =
+and extract_app env sg mle mlt mk_head args =
   let metas = List.map new_meta args in
   let type_head = type_recomp (metas, mlt) in
-  let mlargs = List.map2 (extract_maybe_term env mle) metas args in
+  let mlargs = List.map2 (extract_maybe_term env sg mle) metas args in
   mlapp (mk_head type_head) mlargs
 
 (*s Auxiliary function used to extract arguments of constant or constructor. *)
 
-and make_mlargs env e s args typs =
+and make_mlargs env sg e s args typs =
   let rec f = function
     | [], [], _ -> []
-    | a::la, t::lt, [] -> extract_maybe_term env e t a :: (f (la,lt,[]))
-    | a::la, t::lt, Keep::s -> extract_maybe_term env e t a :: (f (la,lt,s))
+    | a::la, t::lt, [] -> extract_maybe_term env sg e t a :: (f (la,lt,[]))
+    | a::la, t::lt, Keep::s -> extract_maybe_term env sg e t a :: (f (la,lt,s))
     | _::la, _::lt, _::s -> f (la,lt,s)
     | _ -> assert false
   in f (args,typs,s)
 
 (*s Extraction of a constant applied to arguments. *)
 
-and extract_cst_app env mle mlt kn args =
+and extract_cst_app env sg mle mlt kn args =
   (* First, the [ml_schema] of the constant, in expanded version. *)
-  let nb,t = record_constant_type env kn None in
+  let nb,t = record_constant_type env sg kn None in
   let schema = nb, expand env t in
   (* Can we instantiate types variables for this constant ? *)
   (* In Ocaml, inside the definition of this constant, the answer is no. *)
@@ -672,7 +746,7 @@ and extract_cst_app env mle mlt kn args =
   let ls = List.length s in
   let la = List.length args in
   (* The ml arguments, already expunged from known logical ones *)
-  let mla = make_mlargs env mle s args metas in
+  let mla = make_mlargs env sg mle s args metas in
   let mla =
     if magic1 || lang () != Ocaml then mla
     else
@@ -717,7 +791,7 @@ and extract_cst_app env mle mlt kn args =
    they are fixed, and thus are not used for the computation.
    \end{itemize} *)
 
-and extract_cons_app env mle mlt (((kn,i) as ip,j) as cp) args =
+and extract_cons_app env sg mle mlt (((kn,i) as ip,j) as cp) args =
   (* First, we build the type of the constructor, stored in small pieces. *)
   let mi = extract_ind env kn in
   let params_nb = mi.ind_nparams in
@@ -758,7 +832,7 @@ and extract_cons_app env mle mlt (((kn,i) as ip,j) as cp) args =
     put_magic_if magic2
       (dummy_lams (anonym_or_dummy_lams head' s) (params_nb - la))
   else
-    let mla = make_mlargs env mle s args' metas in
+    let mla = make_mlargs env sg mle s args' metas in
     if Int.equal la (ls + params_nb)
     then put_magic_if (magic2 && not magic1) (head mla)
     else (* [ params_nb <= la <= ls + params_nb ] *)
@@ -769,7 +843,7 @@ and extract_cons_app env mle mlt (((kn,i) as ip,j) as cp) args =
 
 (*S Extraction of a case. *)
 
-and extract_case env mle ((kn,i) as ip,c,br) mlt =
+and extract_case env sg mle ((kn,i) as ip,c,br) mlt =
   (* [br]: bodies of each branch (in functional form) *)
   (* [ni]: number of arguments without parameters in each branch *)
   let ni = constructors_nrealargs_env env ip in
@@ -780,9 +854,9 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
     MLexn "absurd case"
   end else
     (* [c] has an inductive type, and is not a type scheme type. *)
-    let t = type_of env c in
+    let t = type_of env sg c in
     (* The only non-informative case: [c] is of sort [Prop] *)
-    if (sort_of env t) == InProp then
+    if (sort_of env sg t) == InProp then
       begin
 	add_recursors env kn; (* May have passed unseen if logical ... *)
 	(* Logical singleton case: *)
@@ -790,7 +864,7 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
 	assert (Int.equal br_size 1);
 	let s = iterate (fun l -> Kill Kprop :: l) ni.(0) [] in
 	let mlt = iterate (fun t -> Tarr (Tdummy Kprop, t)) ni.(0) mlt in
-	let e = extract_maybe_term env mle mlt br.(0) in
+        let e = extract_maybe_term env sg mle mlt br.(0) in
 	snd (case_expunge s e)
       end
     else
@@ -799,7 +873,7 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
       let metas = Array.init (List.length oi.ip_vars) new_meta in
       (* The extraction of the head. *)
       let type_head = Tglob (IndRef ip, Array.to_list metas) in
-      let a = extract_term env mle type_head c [] in
+      let a = extract_term env sg mle type_head c [] in
       (* The extraction of each branch. *)
       let extract_branch i =
 	let r = ConstructRef (ip,i+1) in
@@ -810,7 +884,7 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
 	let s = List.map (type2sign env) oi.ip_types.(i) in
 	let s = sign_with_implicits r s mi.ind_nparams in
 	(* Extraction of the branch (in functional form). *)
-	let e = extract_maybe_term env mle (type_recomp (l,mlt)) br.(i) in
+        let e = extract_maybe_term env sg mle (type_recomp (l,mlt)) br.(i) in
 	(* We suppress dummy arguments according to signature. *)
 	let ids,e = case_expunge s e in
 	(List.rev ids, Pusual r, e)
@@ -832,12 +906,12 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
 
 (*s Extraction of a (co)-fixpoint. *)
 
-and extract_fix env mle i (fi,ti,ci as recd) mlt =
+and extract_fix env sg mle i (fi,ti,ci as recd) mlt =
   let env = push_rec_types recd env in
   let metas = Array.map new_meta fi in
   metas.(i) <- mlt;
   let mle = Array.fold_left Mlenv.push_type mle metas in
-  let ei = Array.map2 (extract_maybe_term env mle) metas ci in
+  let ei = Array.map2 (extract_maybe_term env sg mle) metas ci in
   MLfix (i, Array.map id_of_name fi, ei)
 
 (*S ML declarations. *)
@@ -845,34 +919,34 @@ and extract_fix env mle i (fi,ti,ci as recd) mlt =
 (* [decomp_lams_eta env c t] finds the number [n] of products in the type [t],
    and decompose the term [c] in [n] lambdas, with eta-expansion if needed. *)
 
-let decomp_lams_eta_n n m env c t =
-  let rels = fst (splay_prod_n env none n t) in
+let decomp_lams_eta_n n m env sg c t =
+  let rels = fst (splay_prod_n env sg n t) in
   let rels = List.map (fun (LocalAssum (id,c) | LocalDef (id,_,c)) -> (id,c)) rels in
-  let rels',c = decompose_lam c in
+  let rels',c = EConstr.decompose_lam sg c in
   let d = n - m in
   (* we'd better keep rels' as long as possible. *)
   let rels = (List.firstn d rels) @ rels' in
-  let eta_args = List.rev_map mkRel (List.interval 1 d) in
-  rels, applist (lift d c,eta_args)
+  let eta_args = List.rev_map EConstr.mkRel (List.interval 1 d) in
+  rels, applistc (EConstr.Vars.lift d c) eta_args
 
 (* 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 sg c = match EConstr.kind sg c with
   | Lambda _ | Const _ -> true
   | App (c,v) ->
       (* if all arguments are variables, these variables will
 	 disappear after extraction (see [empty_s] below) *)
-      Array.for_all isRel v && gentypvar_ok c
-  | Cast (c,_,_) -> gentypvar_ok c
+      Array.for_all (EConstr.isRel sg) v && gentypvar_ok sg c
+  | Cast (c,_,_) -> gentypvar_ok sg c
   | _ -> false
 
 (*s From a constant to a ML declaration. *)
 
-let extract_std_constant env kn body typ =
+let extract_std_constant env sg kn body typ =
   reset_meta_count ();
   (* The short type [t] (i.e. possibly with abbreviations). *)
-  let t = snd (record_constant_type env kn (Some typ)) in
+  let t = snd (record_constant_type env sg kn (Some typ)) in
   (* The real type [t']: without head products, expanded, *)
   (* and with [Tvar] translated to [Tvar'] (not instantiable). *)
   let l,t' = type_decomp (expand env (var2var' t)) in
@@ -887,14 +961,14 @@ let extract_std_constant env kn body typ =
      break user's clever let-ins and partial applications). *)
   let rels, c =
     let n = List.length s
-    and m = nb_lam body in
-    if n <= m then decompose_lam_n n body
+    and m = nb_lam sg body in
+    if n <= m then decompose_lam_n sg n body
     else
       let s,s' = List.chop m s in
       if List.for_all ((==) Keep) s' &&
 	(lang () == Haskell || sign_kind s != UnsafeLogicalSig)
-      then decompose_lam_n m body
-      else decomp_lams_eta_n n m env body typ
+      then decompose_lam_n sg m body
+      else decomp_lams_eta_n n m env sg body typ
   in
   (* Should we do one eta-expansion to avoid non-generalizable '_a ? *)
   let rels, c =
@@ -902,9 +976,9 @@ let extract_std_constant env kn body typ =
     let s,s' = List.chop n s in
     let k = sign_kind s in
     let empty_s = (k == EmptySig || k == SafeLogicalSig) in
-    if lang () == Ocaml && empty_s && not (gentypvar_ok c)
+    if lang () == Ocaml && empty_s && not (gentypvar_ok sg c)
       && not (List.is_empty s') && not (Int.equal (type_maxvar t) 0)
-    then decomp_lams_eta_n (n+1) n env body typ
+    then decomp_lams_eta_n (n+1) n env sg body typ
     else rels,c
   in
   let n = List.length rels in
@@ -918,16 +992,16 @@ let extract_std_constant env kn body typ =
   (* The according Coq environment. *)
   let env = push_rels_assum rels env in
   (* The real extraction: *)
-  let e = extract_term env mle t' c [] in
+  let e = extract_term env sg mle t' c [] in
   (* Expunging term and type from dummy lambdas. *)
   let trm = term_expunge s (ids,e) in
   trm, type_expunge_from_sign env s t
 
 (* Extracts the type of an axiom, honors the Extraction Implicit declaration. *)
-let extract_axiom env kn typ =
+let extract_axiom env sg kn typ =
   reset_meta_count ();
   (* The short type [t] (i.e. possibly with abbreviations). *)
-  let t = snd (record_constant_type env kn (Some typ)) in
+  let t = snd (record_constant_type env sg kn (Some typ)) in
   (* The real type [t']: without head products, expanded, *)
   (* and with [Tvar] translated to [Tvar'] (not instantiable). *)
   let l,_ = type_decomp (expand env (var2var' t)) in
@@ -936,18 +1010,19 @@ let extract_axiom env kn typ =
   let s = sign_with_implicits (ConstRef kn) s 0 in
   type_expunge_from_sign env s t
 
-let extract_fixpoint env vkn (fi,ti,ci) =
+let extract_fixpoint env sg vkn (fi,ti,ci) =
   let n = Array.length vkn in
   let types = Array.make n (Tdummy Kprop)
   and terms = Array.make n (MLdummy Kprop) in
   let kns = Array.to_list vkn in
   current_fixpoints := kns;
   (* for replacing recursive calls [Rel ..] by the corresponding [Const]: *)
-  let sub = List.rev_map mkConst kns in
+  let sub = List.rev_map EConstr.mkConst kns in
   for i = 0 to n-1 do
-    if sort_of env ti.(i) != InProp then
+    if sort_of env sg ti.(i) != InProp then
       try
-        let e,t = extract_std_constant env vkn.(i) (substl sub ci.(i)) ti.(i) in
+        let e,t = extract_std_constant env sg vkn.(i)
+                   (EConstr.Vars.substl sub ci.(i)) ti.(i) in
         terms.(i) <- e;
         types.(i) <- t;
       with SingletonInductiveBecomesProp id ->
@@ -957,32 +1032,33 @@ let extract_fixpoint env vkn (fi,ti,ci) =
   Dfix (Array.map (fun kn -> ConstRef kn) vkn, terms, types)
 
 let extract_constant env kn cb =
+  let sg = Evd.from_env env in
   let r = ConstRef kn in
-  let typ = Typeops.type_of_constant_type env cb.const_type in
+  let typ = EConstr.of_constr cb.const_type in
   let warn_info () = if not (is_custom r) then add_info_axiom r in
   let warn_log () = if not (constant_has_body cb) then add_log_axiom r
   in
   let mk_typ_ax () =
-    let n = type_scheme_nb_args env typ in
+    let n = type_scheme_nb_args env sg typ in
     let ids = iterate (fun l -> anonymous_name::l) n [] in
     Dtype (r, ids, Taxiom)
   in
   let mk_typ c =
-    let s,vl = type_sign_vl env typ in
+    let s,vl = type_sign_vl env sg typ in
     let db = db_from_sign s in
-    let t = extract_type_scheme env db c (List.length s)
+    let t = extract_type_scheme env sg db c (List.length s)
     in Dtype (r, vl, t)
   in
   let mk_ax () =
-    let t = extract_axiom env kn typ in
+    let t = extract_axiom env sg kn typ in
     Dterm (r, MLaxiom, t)
   in
   let mk_def c =
-    let e,t = extract_std_constant env kn c typ in
+    let e,t = extract_std_constant env sg kn c typ in
     Dterm (r,e,t)
   in
   try
-    match flag_of_type env typ with
+    match flag_of_type env sg typ with
     | (Logic,TypeScheme) -> warn_log (); Dtype (r, [], Tdummy Ktype)
     | (Logic,Default) -> warn_log (); Dterm (r, MLdummy Kprop, Tdummy Kprop)
     | (Info,TypeScheme) ->
@@ -990,73 +1066,72 @@ let extract_constant env kn cb =
 	  | Undef _ -> warn_info (); mk_typ_ax ()
 	  | Def c ->
 	     (match cb.const_proj with
-	      | None -> mk_typ (Mod_subst.force_constr c)
-	      | Some pb -> mk_typ pb.proj_body)
+              | None -> mk_typ (get_body c)
+              | Some pb -> mk_typ (EConstr.of_constr pb.proj_body))
 	  | OpaqueDef c ->
 	    add_opaque r;
-	    if access_opaque () then
-              mk_typ (Opaqueproof.force_proof (Environ.opaque_tables env) c)
+            if access_opaque () then mk_typ (get_opaque env c)
             else mk_typ_ax ())
     | (Info,Default) ->
         (match cb.const_body with
 	  | Undef _ -> warn_info (); mk_ax ()
 	  | Def c ->
 	     (match cb.const_proj with
-	      | None -> mk_def (Mod_subst.force_constr c)
-	      | Some pb -> mk_def pb.proj_body)
+              | None -> mk_def (get_body c)
+              | Some pb -> mk_def (EConstr.of_constr pb.proj_body))
 	  | OpaqueDef c ->
 	    add_opaque r;
-	    if access_opaque () then
-              mk_def (Opaqueproof.force_proof (Environ.opaque_tables env) c)
+            if access_opaque () then mk_def (get_opaque env c)
             else mk_ax ())
   with SingletonInductiveBecomesProp id ->
     error_singleton_become_prop id (Some (ConstRef kn))
 
 let extract_constant_spec env kn cb =
+  let sg = Evd.from_env env in
   let r = ConstRef kn in
-  let typ = Typeops.type_of_constant_type env cb.const_type in
+  let typ = EConstr.of_constr cb.const_type in
   try
-    match flag_of_type env typ with
+    match flag_of_type env sg typ with
     | (Logic, TypeScheme) -> Stype (r, [], Some (Tdummy Ktype))
     | (Logic, Default) -> Sval (r, Tdummy Kprop)
     | (Info, TypeScheme) ->
-	let s,vl = type_sign_vl env typ in
+        let s,vl = type_sign_vl env sg typ in
 	(match cb.const_body with
 	  | Undef _ | OpaqueDef _ -> Stype (r, vl, None)
 	  | Def body ->
 	      let db = db_from_sign s in
-              let body = Mod_subst.force_constr body in
-	      let t = extract_type_scheme env db body (List.length s)
-	      in Stype (r, vl, Some t))
+              let body = get_body body in
+              let t = extract_type_scheme env sg db body (List.length s)
+              in Stype (r, vl, Some t))
     | (Info, Default) ->
-	let t = snd (record_constant_type env kn (Some typ)) in
-	Sval (r, type_expunge env t)
+        let t = snd (record_constant_type env sg kn (Some typ)) in
+        Sval (r, type_expunge env t)
   with SingletonInductiveBecomesProp id ->
     error_singleton_become_prop id (Some (ConstRef kn))
 
-let extract_with_type env c =
+let extract_with_type env sg c =
   try
-    let typ = type_of env c in
-    match flag_of_type env typ with
+    let typ = type_of env sg c in
+    match flag_of_type env sg typ with
     | (Info, TypeScheme) ->
-	let s,vl = type_sign_vl env typ in
-	let db = db_from_sign s in
-	let t = extract_type_scheme env db c (List.length s) in
-	Some (vl, t)
+        let s,vl = type_sign_vl env sg typ in
+        let db = db_from_sign s in
+        let t = extract_type_scheme env sg db c (List.length s) in
+        Some (vl, t)
     | _ -> None
   with SingletonInductiveBecomesProp id ->
     error_singleton_become_prop id None
 
-let extract_constr env c =
+let extract_constr env sg c =
   reset_meta_count ();
   try
-    let typ = type_of env c in
-    match flag_of_type env typ with
+    let typ = type_of env sg c in
+    match flag_of_type env sg typ with
     | (_,TypeScheme) -> MLdummy Ktype, Tdummy Ktype
     | (Logic,_) -> MLdummy Kprop, Tdummy Kprop
     | (Info,Default) ->
-       let mlt = extract_type env [] 1 typ [] in
-       extract_term env Mlenv.empty mlt c [], mlt
+       let mlt = extract_type env sg [] 1 typ [] in
+       extract_term env sg Mlenv.empty mlt c [], mlt
   with SingletonInductiveBecomesProp id ->
     error_singleton_become_prop id None
 
diff --git a/plugins/extraction/extraction.mli b/plugins/extraction/extraction.mli
index cdda777a..d27c79cb 100644
--- a/plugins/extraction/extraction.mli
+++ b/plugins/extraction/extraction.mli
@@ -1,35 +1,39 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s Extraction from Coq terms to Miniml. *)
 
 open Names
-open Term
 open Declarations
 open Environ
+open Evd
 open Miniml
 
-val extract_constant : env -> constant -> constant_body -> ml_decl
+val extract_constant : env -> Constant.t -> constant_body -> ml_decl
 
-val extract_constant_spec : env -> constant -> constant_body -> ml_spec
+val extract_constant_spec : env -> Constant.t -> constant_body -> ml_spec
 
 (** For extracting "module ... with ..." declaration *)
 
-val extract_with_type : env -> constr -> ( Id.t list * ml_type ) option
+val extract_with_type :
+  env -> evar_map -> EConstr.t -> ( Id.t list * ml_type ) option
 
 val extract_fixpoint :
-  env -> constant array -> (constr, types) prec_declaration -> ml_decl
+  env -> evar_map -> Constant.t array ->
+    (EConstr.t, EConstr.types) Constr.prec_declaration -> ml_decl
 
-val extract_inductive : env -> mutual_inductive -> ml_ind
+val extract_inductive : env -> MutInd.t -> ml_ind
 
-(** For extraction compute *)
+(** For Extraction Compute and Show Extraction *)
 
-val extract_constr : env -> constr -> ml_ast * ml_type
+val extract_constr : env -> evar_map -> EConstr.t -> ml_ast * ml_type
 
 (*s Is a [ml_decl] or a [ml_spec] logical ? *)
 
diff --git a/plugins/extraction/extraction_plugin.mlpack b/plugins/extraction/extraction_plugin.mlpack
index 9184f650..7f98348e 100644
--- a/plugins/extraction/extraction_plugin.mlpack
+++ b/plugins/extraction/extraction_plugin.mlpack
@@ -1,3 +1,4 @@
+Miniml
 Table
 Mlutil
 Modutil
diff --git a/plugins/extraction/g_extraction.ml4 b/plugins/extraction/g_extraction.ml4
index 19fda4ae..93909f3e 100644
--- a/plugins/extraction/g_extraction.ml4
+++ b/plugins/extraction/g_extraction.ml4
@@ -1,24 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
+open Pcoq.Prim
 
 DECLARE PLUGIN "extraction_plugin"
 
 (* ML names *)
 
+open Ltac_plugin
 open Genarg
 open Stdarg
-open Constrarg
-open Pcoq.Prim
 open Pp
 open Names
-open Nameops
 open Table
 open Extract_env
 
@@ -33,7 +33,7 @@ END
 
 let pr_int_or_id _ _ _ = function
   | ArgInt i -> int i
-  | ArgId id -> pr_id id
+  | ArgId id -> Id.print id
 
 ARGUMENT EXTEND int_or_id
   PRINTED BY pr_int_or_id
@@ -42,14 +42,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 ]
@@ -65,6 +71,10 @@ VERNAC COMMAND EXTEND Extraction CLASSIFIED AS QUERY
 (* Monolithic extraction to a file *)
 | [ "Extraction" string(f) ne_global_list(l) ]
   -> [ full_extraction (Some f) l ]
+
+(* Extraction to a temporary file and OCaml compilation *)
+| [ "Extraction" "TestCompile" ne_global_list(l) ]
+  -> [ extract_and_compile l ]
 END
 
 VERNAC COMMAND EXTEND SeparateExtraction CLASSIFIED AS QUERY
@@ -150,3 +160,9 @@ VERNAC COMMAND EXTEND ExtractionInductive CLASSIFIED AS SIDEFF
     mlname(id) "[" mlname_list(idl) "]" string_opt(o) ]
   -> [ extract_inductive x id idl o ]
 END
+(* Show the extraction of the current proof *)
+
+VERNAC COMMAND EXTEND ShowExtraction CLASSIFIED AS QUERY
+| [ "Show" "Extraction" ]
+  -> [ show_extraction () ]
+END
diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml
index 0692c88c..e6234c14 100644
--- a/plugins/extraction/haskell.ml
+++ b/plugins/extraction/haskell.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s Production of Haskell syntax. *)
@@ -12,7 +14,6 @@ open Pp
 open CErrors
 open Util
 open Names
-open Nameops
 open Globnames
 open Table
 open Miniml
@@ -20,9 +21,10 @@ open Mlutil
 open Common
 
 (*s Haskell renaming issues. *)
-
+[@@@ocaml.warning "-3"]       (* String.(un)capitalize_ascii since 4.03.0 GPR#124 *)
 let pr_lower_id id = str (String.uncapitalize (Id.to_string id))
 let pr_upper_id id = str (String.capitalize (Id.to_string id))
+[@@@ocaml.warning "+3"]
 
 let keywords =
   List.fold_right (fun s -> Id.Set.add (Id.of_string s))
@@ -58,7 +60,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 +79,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 () ++
@@ -92,7 +93,7 @@ let preamble mod_name comment used_modules usf =
 let pp_abst = function
   | [] -> (mt ())
   | l  -> (str "\\" ++
-             prlist_with_sep (fun () -> (str " ")) pr_id l ++
+             prlist_with_sep (fun () -> (str " ")) Id.print l ++
              str " ->" ++ spc ())
 
 (*s The pretty-printer for haskell syntax *)
@@ -108,7 +109,7 @@ let rec pp_type par vl t =
   let rec pp_rec par = function
     | Tmeta _ | Tvar' _ -> assert false
     | Tvar i ->
-      (try pr_id (List.nth vl (pred i))
+      (try Id.print (List.nth vl (pred i))
        with Failure _ -> (str "a" ++ int i))
     | Tglob (r,[]) -> pp_global Type r
     | Tglob (IndRef(kn,0),l)
@@ -145,9 +146,9 @@ 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 (pr_id id)
+        apply (Id.print id)
     | MLapp (f,args') ->
 	let stl = List.map (pp_expr true env []) args' in
         pp_expr par env (stl @ args) f
@@ -158,7 +159,7 @@ let rec pp_expr par env args =
 	apply2 st
     | MLletin (id,a1,a2) ->
 	let i,env' = push_vars [id_of_mlid id] env in
-	let pp_id = pr_id (List.hd i)
+	let pp_id = Id.print (List.hd i)
 	and pp_a1 = pp_expr false env [] a1
 	and pp_a2 = pp_expr (not par && expr_needs_par a2) env' [] a2 in
 	let pp_def =
@@ -185,7 +186,7 @@ let rec pp_expr par env args =
         pp_boxed_tuple (pp_expr true env []) l
     | MLcase (_,t, pv) when is_custom_match pv ->
         if not (is_regular_match pv) then
-	  error "Cannot mix yet user-given match and general patterns.";
+	  user_err Pp.(str "Cannot mix yet user-given match and general patterns.");
 	let mkfun (ids,_,e) =
 	  if not (List.is_empty ids) then named_lams (List.rev ids) e
 	  else dummy_lams (ast_lift 1 e) 1
@@ -222,10 +223,10 @@ and pp_cons_pat par r ppl =
 
 and pp_gen_pat par ids env = function
   | Pcons (r,l) -> pp_cons_pat par r (List.map (pp_gen_pat true ids env) l)
-  | Pusual r -> pp_cons_pat par r (List.map pr_id ids)
+  | Pusual r -> pp_cons_pat par r (List.map Id.print ids)
   | Ptuple l -> pp_boxed_tuple (pp_gen_pat false ids env) l
   | Pwild -> str "_"
-  | Prel n -> pr_id (get_db_name n env)
+  | Prel n -> Id.print (get_db_name n env)
 
 and pp_one_pat env (ids,p,t) =
   let ids',env' = push_vars (List.rev_map id_of_mlid ids) env in
@@ -250,10 +251,10 @@ and pp_fix par env i (ids,bl) args =
     (v 0
        (v 1 (str "let {" ++ fnl () ++
 	     prvect_with_sep (fun () -> str ";" ++ fnl ())
-	       (fun (fi,ti) -> pp_function env (pr_id fi) ti)
+	       (fun (fi,ti) -> pp_function env (Id.print fi) ti)
 	       (Array.map2 (fun a b -> a,b) ids bl) ++
 	     str "}") ++
-        fnl () ++ str "in " ++ pp_apply (pr_id ids.(i)) false args))
+        fnl () ++ str "in " ++ pp_apply (Id.print ids.(i)) false args))
 
 and pp_function env f t =
   let bl,t' = collect_lams t in
@@ -265,19 +266,19 @@ and pp_function env f t =
 (*s Pretty-printing of inductive types declaration. *)
 
 let pp_logical_ind packet =
-  pp_comment (pr_id packet.ip_typename ++ str " : logical inductive") ++
+  pp_comment (Id.print packet.ip_typename ++ str " : logical inductive") ++
   pp_comment (str "with constructors : " ++
-	      prvect_with_sep spc pr_id packet.ip_consnames)
+	      prvect_with_sep spc Id.print packet.ip_consnames)
 
 let pp_singleton kn packet =
   let name = pp_global Type (IndRef (kn,0)) in
   let l = rename_tvars keywords packet.ip_vars in
   hov 2 (str "type " ++ name ++ spc () ++
-	 prlist_with_sep spc pr_id l ++
+	 prlist_with_sep spc Id.print l ++
 	 (if not (List.is_empty l) then str " " else mt ()) ++ str "=" ++ spc () ++
 	 pp_type false l (List.hd packet.ip_types.(0)) ++ fnl () ++
 	 pp_comment (str "singleton inductive, whose constructor was " ++
-		     pr_id packet.ip_consnames.(0)))
+		     Id.print packet.ip_consnames.(0)))
 
 let pp_one_ind ip pl cv =
   let pl = rename_tvars keywords pl in
@@ -329,7 +330,7 @@ let pp_decl = function
 	    let ids,s = find_type_custom r in
 	    prlist (fun id -> str (id^" ")) ids ++ str "=" ++ spc () ++ str s
 	  with Not_found ->
-	    prlist (fun id -> pr_id id ++ str " ") l ++
+	    prlist (fun id -> Id.print id ++ str " ") l ++
 	    if t == Taxiom then str "= () -- AXIOM TO BE REALIZED" ++ fnl ()
 	    else str "=" ++ spc () ++ pp_type false l t
 	in
diff --git a/plugins/extraction/haskell.mli b/plugins/extraction/haskell.mli
index 6f493206..27cb6b94 100644
--- a/plugins/extraction/haskell.mli
+++ b/plugins/extraction/haskell.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val haskell_descr : Miniml.language_descr
diff --git a/plugins/extraction/miniml.ml b/plugins/extraction/miniml.ml
new file mode 100644
index 00000000..e1e49d92
--- /dev/null
+++ b/plugins/extraction/miniml.ml
@@ -0,0 +1,222 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(*s Target language for extraction: a core ML called MiniML. *)
+
+open Names
+open Globnames
+
+(* The [signature] type is used to know how many arguments a CIC
+   object expects, and what these arguments will become in the ML
+   object. *)
+
+(* We eliminate from terms:
+   1) types
+   2) logical parts
+   3) user-declared implicit arguments of a constant of constructor
+*)
+
+type kill_reason =
+  | Ktype
+  | Kprop
+  | Kimplicit of global_reference * int  (* n-th arg of a cst or construct *)
+
+type sign = Keep | Kill of kill_reason
+
+
+(* Convention: outmost lambda/product gives the head of the list. *)
+
+type signature = sign list
+
+(*s ML type expressions. *)
+
+type ml_type =
+  | Tarr    of ml_type * ml_type
+  | Tglob   of global_reference * ml_type list
+  | Tvar    of int
+  | Tvar'   of int (* same as Tvar, used to avoid clash *)
+  | Tmeta   of ml_meta (* used during ML type reconstruction *)
+  | Tdummy  of kill_reason
+  | Tunknown
+  | Taxiom
+
+and ml_meta = { id : int; mutable contents : ml_type option }
+
+(* ML type schema.
+   The integer is the number of variable in the schema. *)
+
+type ml_schema = int * ml_type
+
+(*s ML inductive types. *)
+
+type inductive_kind =
+  | Singleton
+  | Coinductive
+  | Standard
+  | Record of global_reference option list (* None for anonymous field *)
+
+(* A [ml_ind_packet] is the miniml counterpart of a [one_inductive_body].
+   If the inductive is logical ([ip_logical = false]), then all other fields
+   are unused. Otherwise,
+   [ip_sign] is a signature concerning the arguments of the inductive,
+   [ip_vars] contains the names of the type variables surviving in ML,
+   [ip_types] contains the ML types of all constructors.
+*)
+
+type ml_ind_packet = {
+  ip_typename : Id.t;
+  ip_consnames : Id.t array;
+  ip_logical : bool;
+  ip_sign : signature;
+  ip_vars : Id.t list;
+  ip_types : (ml_type list) array
+}
+
+(* [ip_nparams] contains the number of parameters. *)
+
+type equiv =
+  | NoEquiv
+  | Equiv of KerName.t
+  | RenEquiv of string
+
+type ml_ind = {
+  ind_kind : inductive_kind;
+  ind_nparams : int;
+  ind_packets : ml_ind_packet array;
+  ind_equiv : equiv
+}
+
+(*s ML terms. *)
+
+type ml_ident =
+  | Dummy
+  | Id of Id.t
+  | Tmp of Id.t
+
+(** We now store some typing information on constructors
+    and cases to avoid type-unsafe optimisations. This will be
+    either the type of the applied constructor or the type
+    of the head of the match.
+*)
+
+(** Nota : the constructor [MLtuple] and the extension of [MLcase]
+    to general patterns have been proposed by P.N. Tollitte for
+    his Relation Extraction plugin. [MLtuple] is currently not
+    used by the main extraction, as well as deep patterns. *)
+
+type ml_branch = ml_ident list * ml_pattern * ml_ast
+
+and ml_ast =
+  | MLrel    of int
+  | MLapp    of ml_ast * ml_ast list
+  | MLlam    of ml_ident * ml_ast
+  | MLletin  of ml_ident * ml_ast * ml_ast
+  | MLglob   of global_reference
+  | MLcons   of ml_type * global_reference * ml_ast list
+  | MLtuple  of ml_ast list
+  | MLcase   of ml_type * ml_ast * ml_branch array
+  | MLfix    of int * Id.t array * ml_ast array
+  | MLexn    of string
+  | MLdummy  of kill_reason
+  | MLaxiom
+  | MLmagic  of ml_ast
+
+and ml_pattern =
+  | Pcons   of global_reference * ml_pattern list
+  | Ptuple  of ml_pattern list
+  | Prel    of int (** Cf. the idents in the branch. [Prel 1] is the last one. *)
+  | Pwild
+  | Pusual  of global_reference (** Shortcut for Pcons (r,[Prel n;...;Prel 1]) **)
+
+(*s ML declarations. *)
+
+type ml_decl =
+  | Dind  of MutInd.t * ml_ind
+  | Dtype of global_reference * Id.t list * ml_type
+  | Dterm of global_reference * ml_ast * ml_type
+  | Dfix  of global_reference array * ml_ast array * ml_type array
+
+type ml_spec =
+  | Sind  of MutInd.t * ml_ind
+  | Stype of global_reference * Id.t list * ml_type option
+  | Sval  of global_reference * ml_type
+
+type ml_specif =
+  | Spec of ml_spec
+  | Smodule of ml_module_type
+  | Smodtype of ml_module_type
+
+and ml_module_type =
+  | MTident of ModPath.t
+  | MTfunsig of MBId.t * ml_module_type * ml_module_type
+  | MTsig of ModPath.t * ml_module_sig
+  | MTwith of ml_module_type * ml_with_declaration
+
+and ml_with_declaration =
+  | ML_With_type of Id.t list * Id.t list * ml_type
+  | ML_With_module of Id.t list * ModPath.t
+
+and ml_module_sig = (Label.t * ml_specif) list
+
+type ml_structure_elem =
+  | SEdecl of ml_decl
+  | SEmodule of ml_module
+  | SEmodtype of ml_module_type
+
+and ml_module_expr =
+  | MEident of ModPath.t
+  | MEfunctor of MBId.t * ml_module_type * ml_module_expr
+  | MEstruct of ModPath.t * ml_module_structure
+  | MEapply of ml_module_expr * ml_module_expr
+
+and ml_module_structure = (Label.t * ml_structure_elem) list
+
+and ml_module =
+    { ml_mod_expr : ml_module_expr;
+      ml_mod_type : ml_module_type }
+
+(* NB: we do not translate the [mod_equiv] field, since [mod_equiv = mp]
+   implies that [mod_expr = MEBident mp]. Same with [msb_equiv]. *)
+
+type ml_structure = (ModPath.t * ml_module_structure) list
+
+type ml_signature = (ModPath.t * ml_module_sig) list
+
+type unsafe_needs = {
+  mldummy : bool;
+  tdummy : bool;
+  tunknown : bool;
+  magic : bool
+}
+
+type language_descr = {
+  keywords : Id.Set.t;
+
+  (* Concerning the source file *)
+  file_suffix : string;
+  file_naming : ModPath.t -> string;
+  (* the second argument is a comment to add to the preamble *)
+  preamble :
+    Id.t -> Pp.t option -> ModPath.t list -> unsafe_needs ->
+    Pp.t;
+  pp_struct : ml_structure -> Pp.t;
+
+  (* Concerning a possible interface file *)
+  sig_suffix : string option;
+  (* the second argument is a comment to add to the preamble *)
+  sig_preamble :
+    Id.t -> Pp.t option -> ModPath.t list -> unsafe_needs ->
+    Pp.t;
+  pp_sig : ml_signature -> Pp.t;
+
+  (* for an isolated declaration print *)
+  pp_decl : ml_decl -> Pp.t;
+
+}
diff --git a/plugins/extraction/miniml.mli b/plugins/extraction/miniml.mli
index db336152..e1e49d92 100644
--- a/plugins/extraction/miniml.mli
+++ b/plugins/extraction/miniml.mli
@@ -1,14 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s Target language for extraction: a core ML called MiniML. *)
 
-open Pp
 open Names
 open Globnames
 
@@ -82,7 +83,7 @@ type ml_ind_packet = {
 
 type equiv =
   | NoEquiv
-  | Equiv of kernel_name
+  | Equiv of KerName.t
   | RenEquiv of string
 
 type ml_ind = {
@@ -137,13 +138,13 @@ and ml_pattern =
 (*s ML declarations. *)
 
 type ml_decl =
-  | Dind  of mutual_inductive * ml_ind
+  | Dind  of MutInd.t * ml_ind
   | Dtype of global_reference * Id.t list * ml_type
   | Dterm of global_reference * ml_ast * ml_type
   | Dfix  of global_reference array * ml_ast array * ml_type array
 
 type ml_spec =
-  | Sind  of mutual_inductive * ml_ind
+  | Sind  of MutInd.t * ml_ind
   | Stype of global_reference * Id.t list * ml_type option
   | Sval  of global_reference * ml_type
 
@@ -153,14 +154,14 @@ type ml_specif =
   | Smodtype of ml_module_type
 
 and ml_module_type =
-  | MTident of module_path
+  | MTident of ModPath.t
   | MTfunsig of MBId.t * ml_module_type * ml_module_type
-  | MTsig of module_path * ml_module_sig
+  | MTsig of ModPath.t * ml_module_sig
   | MTwith of ml_module_type * ml_with_declaration
 
 and ml_with_declaration =
   | ML_With_type of Id.t list * Id.t list * ml_type
-  | ML_With_module of Id.t list * module_path
+  | ML_With_module of Id.t list * ModPath.t
 
 and ml_module_sig = (Label.t * ml_specif) list
 
@@ -170,9 +171,9 @@ type ml_structure_elem =
   | SEmodtype of ml_module_type
 
 and ml_module_expr =
-  | MEident of module_path
+  | MEident of ModPath.t
   | MEfunctor of MBId.t * ml_module_type * ml_module_expr
-  | MEstruct of module_path * ml_module_structure
+  | MEstruct of ModPath.t * ml_module_structure
   | MEapply of ml_module_expr * ml_module_expr
 
 and ml_module_structure = (Label.t * ml_structure_elem) list
@@ -184,11 +185,9 @@ and ml_module =
 (* NB: we do not translate the [mod_equiv] field, since [mod_equiv = mp]
    implies that [mod_expr = MEBident mp]. Same with [msb_equiv]. *)
 
-type ml_structure = (module_path * ml_module_structure) list
+type ml_structure = (ModPath.t * ml_module_structure) list
 
-type ml_signature = (module_path * ml_module_sig) list
-
-type ml_flat_structure = ml_structure_elem list
+type ml_signature = (ModPath.t * ml_module_sig) list
 
 type unsafe_needs = {
   mldummy : bool;
@@ -202,22 +201,22 @@ type language_descr = {
 
   (* Concerning the source file *)
   file_suffix : string;
-  file_naming : module_path -> string;
+  file_naming : ModPath.t -> string;
   (* the second argument is a comment to add to the preamble *)
   preamble :
-    Id.t -> std_ppcmds option -> module_path list -> unsafe_needs ->
-    std_ppcmds;
-  pp_struct : ml_structure -> std_ppcmds;
+    Id.t -> Pp.t option -> ModPath.t list -> unsafe_needs ->
+    Pp.t;
+  pp_struct : ml_structure -> Pp.t;
 
   (* Concerning a possible interface file *)
   sig_suffix : string option;
   (* the second argument is a comment to add to the preamble *)
   sig_preamble :
-    Id.t -> std_ppcmds option -> module_path list -> unsafe_needs ->
-    std_ppcmds;
-  pp_sig : ml_signature -> std_ppcmds;
+    Id.t -> Pp.t option -> ModPath.t list -> unsafe_needs ->
+    Pp.t;
+  pp_sig : ml_signature -> Pp.t;
 
   (* for an isolated declaration print *)
-  pp_decl : ml_decl -> std_ppcmds;
+  pp_decl : ml_decl -> Pp.t;
 
 }
diff --git a/plugins/extraction/mlutil.ml b/plugins/extraction/mlutil.ml
index 402fe4ff..0656d487 100644
--- a/plugins/extraction/mlutil.ml
+++ b/plugins/extraction/mlutil.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -28,9 +30,9 @@ let dummy_name = Id.of_string "_"
 let anonymous = Id anonymous_name
 
 let id_of_name = function
-  | Anonymous -> anonymous_name
-  | Name id when Id.equal id dummy_name -> anonymous_name
-  | Name id -> id
+  | Name.Anonymous -> anonymous_name
+  | Name.Name id when Id.equal id dummy_name -> anonymous_name
+  | Name.Name id -> id
 
 let id_of_mlid = function
   | Dummy -> dummy_name
@@ -120,7 +122,6 @@ let rec mgu = function
       mgu (a, a'); mgu (b, b')
   | Tglob (r,l), Tglob (r',l') when Globnames.eq_gr r r' ->
        List.iter mgu (List.combine l l')
-  | (Tdummy _, _ | _, Tdummy _) when lang() == Haskell -> ()
   | Tdummy _, Tdummy _ -> ()
   | Tvar i, Tvar j when Int.equal i j -> ()
   | Tvar' i, Tvar' j when  Int.equal i j -> ()
@@ -128,11 +129,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 ||
@@ -770,6 +775,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. *)
 
@@ -1052,7 +1071,12 @@ let rec simpl o = function
   | MLmagic(MLcase(typ,e,br)) ->
      let br' = Array.map (fun (ids,p,c) -> (ids,p,MLmagic c)) br in
      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 *)
@@ -1487,7 +1511,7 @@ let inline_test r t =
 
 let con_of_string s =
   let d, id = Libnames.split_dirpath (dirpath_of_string s) in
-  Constant.make2 (MPfile d) (Label.of_id id)
+  Constant.make2 (ModPath.MPfile d) (Label.of_id id)
 
 let manual_inline_set =
   List.fold_right (fun x -> Cset_env.add (con_of_string x))
diff --git a/plugins/extraction/mlutil.mli b/plugins/extraction/mlutil.mli
index c6675524..55a1ee89 100644
--- a/plugins/extraction/mlutil.mli
+++ b/plugins/extraction/mlutil.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -48,7 +50,7 @@ end
 
 (*s Utility functions over ML types without meta *)
 
-val type_mem_kn : mutual_inductive -> ml_type -> bool
+val type_mem_kn : MutInd.t -> ml_type -> bool
 
 val type_maxvar : ml_type -> int
 
diff --git a/plugins/extraction/modutil.ml b/plugins/extraction/modutil.ml
index 60fe8e76..f33a59ed 100644
--- a/plugins/extraction/modutil.ml
+++ b/plugins/extraction/modutil.ml
@@ -1,12 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
+open ModPath
 open Globnames
 open CErrors
 open Util
@@ -16,10 +19,15 @@ open Mlutil
 
 (*S Functions upon ML modules. *)
 
+(** Note: a syntax like [(F M) with ...] is actually legal, see for instance
+    bug #4720. Hence the code below tries to handle [MTsig], maybe not in
+    a perfect way, but that should be enough for the use of [se_iter] below. *)
+
 let rec msid_of_mt = function
   | MTident mp -> mp
+  | MTsig(mp,_) -> mp
   | MTwith(mt,_)-> msid_of_mt mt
-  | _ -> anomaly ~label:"extraction" (Pp.str "the With operator isn't applied to a name")
+  | MTfunsig _ -> assert false (* A functor cannot be inside a MTwith *)
 
 (*s Apply some functions upon all [ml_decl] and [ml_spec] found in a
    [ml_structure]. *)
@@ -35,7 +43,7 @@ let se_iter do_decl do_spec do_mp =
 	  List.fold_left (fun mp l -> MPdot(mp,Label.of_id l)) mp_mt idl'
 	in
 	let r = ConstRef (Constant.make2 mp_w (Label.of_id l')) in
-	mt_iter mt; do_decl (Dtype(r,l,t))
+        mt_iter mt; do_spec (Stype(r,l,Some t))
     | MTwith (mt,ML_With_module(idl,mp))->
         let mp_mt = msid_of_mt mt in
         let mp_w =
@@ -110,7 +118,7 @@ let ind_iter_references do_term do_cons do_type kn ind =
     do_type (IndRef ip);
     if lang () == Ocaml then
       (match ind.ind_equiv with
-	 | Miniml.Equiv kne -> do_type (IndRef (mind_of_kn kne, snd ip));
+	 | Miniml.Equiv kne -> do_type (IndRef (MutInd.make1 kne, snd ip));
 	 | _ -> ());
     Array.iteri (fun j -> cons_iter (ip,j+1)) p.ip_types
   in
@@ -231,7 +239,7 @@ let get_decl_in_structure r struc =
 		  | _ -> error_not_visible r
     in go ll sel
   with Not_found ->
-    anomaly (Pp.str "reference not found in extracted structure")
+    anomaly (Pp.str "reference not found in extracted structure.")
 
 
 (*s Optimization of a [ml_structure]. *)
diff --git a/plugins/extraction/modutil.mli b/plugins/extraction/modutil.mli
index dc870824..6a81f270 100644
--- a/plugins/extraction/modutil.mli
+++ b/plugins/extraction/modutil.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -17,6 +19,7 @@ val struct_type_search : (ml_type -> bool) -> ml_structure -> bool
 
 type do_ref = global_reference -> unit
 
+val type_iter_references : do_ref -> ml_type -> unit
 val ast_iter_references : do_ref -> do_ref -> do_ref -> ml_ast -> unit
 val decl_iter_references : do_ref -> do_ref -> do_ref -> ml_decl -> unit
 val spec_iter_references : do_ref -> do_ref -> do_ref -> ml_spec -> unit
@@ -25,7 +28,7 @@ val signature_of_structure : ml_structure -> ml_signature
 
 val mtyp_of_mexpr : ml_module_expr -> ml_module_type
 
-val msid_of_mt : ml_module_type -> module_path
+val msid_of_mt : ml_module_type -> ModPath.t
 
 val get_decl_in_structure : global_reference -> ml_structure -> ml_decl
 
@@ -36,5 +39,5 @@ val get_decl_in_structure : global_reference -> ml_structure -> ml_decl
    optimizations. The first argument is the list of objects we want to appear.
 *)
 
-val optimize_struct : global_reference list * module_path list ->
+val optimize_struct : global_reference list * ModPath.t list ->
   ml_structure -> ml_structure
diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml
index 1c29a9bc..96d87604 100644
--- a/plugins/extraction/ocaml.ml
+++ b/plugins/extraction/ocaml.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s Production of Ocaml syntax. *)
@@ -12,7 +14,7 @@ open Pp
 open CErrors
 open Util
 open Names
-open Nameops
+open ModPath
 open Globnames
 open Table
 open Miniml
@@ -28,7 +30,7 @@ let pp_tvar id = str ("'" ^ Id.to_string id)
 let pp_abst = function
   | [] -> mt ()
   | l  ->
-      str "fun " ++ prlist_with_sep (fun () -> str " ") pr_id l ++
+      str "fun " ++ prlist_with_sep (fun () -> str " ") Id.print l ++
       str " ->" ++ spc ()
 
 let pp_parameters l =
@@ -66,7 +68,7 @@ let pp_header_comment = function
   | None -> mt ()
   | Some com -> pp_comment com ++ fnl2 ()
 
-let then_nl pp = if Pp.is_empty pp then mt () else pp ++ fnl ()
+let then_nl pp = if Pp.ismt pp then mt () else pp ++ fnl ()
 
 let pp_tdummy usf =
   if usf.tdummy || usf.tunknown then str "type __ = Obj.t" ++ fnl () else mt ()
@@ -100,11 +102,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
@@ -182,7 +214,7 @@ let rec pp_expr par env args =
         (* Try to survive to the occurrence of a Dummy rel.
            TODO: we should get rid of this hack (cf. #592) *)
         let id = if Id.equal id dummy_name then Id.of_string "__" else id in
-        apply (pr_id id)
+        apply (Id.print id)
     | MLapp (f,args') ->
 	let stl = List.map (pp_expr true env []) args' in
         pp_expr par env (stl @ args) f
@@ -194,7 +226,7 @@ let rec pp_expr par env args =
 	apply2 st
     | MLletin (id,a1,a2) ->
 	let i,env' = push_vars [id_of_mlid id] env in
-	let pp_id = pr_id (List.hd i)
+	let pp_id = Id.print (List.hd i)
 	and pp_a1 = pp_expr false env [] a1
 	and pp_a2 = pp_expr (not par && expr_needs_par a2) env' [] a2 in
 	hv 0 (apply2 (pp_letin pp_id pp_a1 pp_a2))
@@ -246,7 +278,7 @@ let rec pp_expr par env args =
         pp_boxed_tuple (pp_expr true env []) l
     | MLcase (_, t, pv) when is_custom_match pv ->
         if not (is_regular_match pv) then
-	  error "Cannot mix yet user-given match and general patterns.";
+	  user_err Pp.(str "Cannot mix yet user-given match and general patterns.");
 	let mkfun (ids,_,e) =
 	  if not (List.is_empty ids) then named_lams (List.rev ids) e
 	  else dummy_lams (ast_lift 1 e) 1
@@ -330,10 +362,10 @@ and pp_cons_pat r ppl =
 
 and pp_gen_pat ids env = function
   | Pcons (r, l) -> pp_cons_pat r (List.map (pp_gen_pat ids env) l)
-  | Pusual r -> pp_cons_pat r (List.map pr_id ids)
+  | Pusual r -> pp_cons_pat r (List.map Id.print ids)
   | Ptuple l -> pp_boxed_tuple (pp_gen_pat ids env) l
   | Pwild -> str "_"
-  | Prel n -> pr_id (get_db_name n env)
+  | Prel n -> Id.print (get_db_name n env)
 
 and pp_ifthenelse env expr pv = match pv with
   | [|([],tru,the);([],fal,els)|] when
@@ -372,7 +404,7 @@ and pp_function env t =
 	  v 0 (pp_pat env' pv)
 	else
           pr_binding (List.rev bl) ++
-          str " = match " ++ pr_id (List.hd bl) ++ str " with" ++ fnl () ++
+          str " = match " ++ Id.print (List.hd bl) ++ str " with" ++ fnl () ++
 	  v 0 (pp_pat env' pv)
     | _ ->
           pr_binding (List.rev bl) ++
@@ -387,10 +419,10 @@ and pp_fix par env i (ids,bl) args =
     (v 0 (str "let rec " ++
 	  prvect_with_sep
       	    (fun () -> fnl () ++ str "and ")
-	    (fun (fi,ti) -> pr_id fi ++ pp_function env ti)
+	    (fun (fi,ti) -> Id.print fi ++ pp_function env ti)
 	    (Array.map2 (fun id b -> (id,b)) ids bl) ++
 	  fnl () ++
-	  hov 2 (str "in " ++ pp_apply (pr_id ids.(i)) false args)))
+	  hov 2 (str "in " ++ pp_apply (Id.print ids.(i)) false args)))
 
 (* Ad-hoc double-newline in v boxes, with enough negative whitespace
    to avoid indenting the intermediate blank line *)
@@ -431,7 +463,7 @@ let pp_Dfix (rv,c,t) =
 let pp_equiv param_list name = function
   | NoEquiv, _ -> mt ()
   | Equiv kn, i ->
-      str " = " ++ pp_parameters param_list ++ pp_global Type (IndRef (mind_of_kn kn,i))
+      str " = " ++ pp_parameters param_list ++ pp_global Type (IndRef (MutInd.make1 kn,i))
   | RenEquiv ren, _  ->
       str " = " ++ pp_parameters param_list ++ str (ren^".") ++ name
 
@@ -451,10 +483,10 @@ let pp_one_ind prefix ip_equiv pl name cnames ctyps =
   else fnl () ++ v 0 (prvecti pp_constructor ctyps)
 
 let pp_logical_ind packet =
-  pp_comment (pr_id packet.ip_typename ++ str " : logical inductive") ++
+  pp_comment (Id.print packet.ip_typename ++ str " : logical inductive") ++
   fnl () ++
   pp_comment (str "with constructors : " ++
-	      prvect_with_sep spc pr_id packet.ip_consnames) ++
+	      prvect_with_sep spc Id.print packet.ip_consnames) ++
   fnl ()
 
 let pp_singleton kn packet =
@@ -463,7 +495,7 @@ let pp_singleton kn packet =
   hov 2 (str "type " ++ pp_parameters l ++ name ++ str " =" ++ spc () ++
 	 pp_type false l (List.hd packet.ip_types.(0)) ++ fnl () ++
 	 pp_comment (str "singleton inductive, whose constructor was " ++
-		     pr_id packet.ip_consnames.(0)))
+		     Id.print packet.ip_consnames.(0)))
 
 let pp_record kn fields ip_equiv packet =
   let ind = IndRef (kn,0) in
@@ -555,24 +587,6 @@ let pp_decl = function
     | Dfix (rv,defs,typs) ->
 	pp_Dfix (rv,defs,typs)
 
-let pp_alias_decl ren = function
-  | Dind (kn,i) -> pp_mind kn { i with ind_equiv = RenEquiv ren }
-  | Dtype (r, l, _) ->
-      let name = pp_global Type r in
-      let l = rename_tvars keywords l in
-      let ids = pp_parameters l in
-      hov 2 (str "type " ++ ids ++ name ++ str " =" ++ spc () ++ ids ++
-	     str (ren^".") ++ name)
-  | Dterm (r, a, t) ->
-      let name = pp_global Term r in
-      hov 2 (str "let " ++ name ++ str (" = "^ren^".") ++ name)
-  | Dfix (rv, _, _) ->
-      prvecti (fun i r -> if is_inline_custom r then mt () else
-		 let name = pp_global Term r in
-		 hov 2 (str "let " ++ name ++ str (" = "^ren^".") ++ name) ++
-		 fnl ())
-	rv
-
 let pp_spec = function
   | Sval (r,_) when is_inline_custom r -> mt ()
   | Stype (r,_,_) when is_inline_custom r -> mt ()
@@ -597,42 +611,32 @@ let pp_spec = function
       in
       hov 2 (str "type " ++ ids ++ name ++ def)
 
-let pp_alias_spec ren = function
-  | Sind (kn,i) -> pp_mind kn { i with ind_equiv = RenEquiv ren }
-  | Stype (r,l,_) ->
-      let name = pp_global Type r in
-      let l = rename_tvars keywords l in
-      let ids = pp_parameters l in
-      hov 2 (str "type " ++ ids ++ name ++ str " =" ++ spc () ++ ids ++
-	     str (ren^".") ++ name)
-  | Sval _ -> assert false
-
 let rec pp_specif = function
   | (_,Spec (Sval _ as s)) -> pp_spec s
   | (l,Spec s) ->
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
+     (match Common.get_duplicate (top_visible_mp ()) l with
+      | None -> pp_spec s
+      | Some ren ->
 	 hov 1 (str ("module "^ren^" : sig") ++ fnl () ++ pp_spec s) ++
 	 fnl () ++ str "end" ++ fnl () ++
-	 pp_alias_spec ren s
-       with Not_found -> pp_spec s)
+         str ("include module type of struct include "^ren^" end"))
   | (l,Smodule mt) ->
       let def = pp_module_type [] mt in
-      let def' = pp_module_type [] mt in
       let name = pp_modname (MPdot (top_visible_mp (), l)) in
       hov 1 (str "module " ++ name ++ str " :" ++ fnl () ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-	 fnl () ++ hov 1 (str ("module "^ren^" :") ++ fnl () ++ def')
-       with Not_found -> Pp.mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | None -> Pp.mt ()
+       | Some ren ->
+         fnl () ++
+         hov 1 (str ("module "^ren^" :") ++ spc () ++
+                str "module type of struct include " ++ name ++ str " end"))
   | (l,Smodtype mt) ->
       let def = pp_module_type [] mt in
       let name = pp_modname (MPdot (top_visible_mp (), l)) in
       hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-	 fnl () ++ str ("module type "^ren^" = ") ++ name
-       with Not_found -> Pp.mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | None -> Pp.mt ()
+       | Some ren -> fnl () ++ str ("module type "^ren^" = ") ++ name)
 
 and pp_module_type params = function
   | MTident kn ->
@@ -646,15 +650,17 @@ and pp_module_type params = function
       push_visible mp params;
       let try_pp_specif l x =
         let px = pp_specif x in
-        if Pp.is_empty px then l else px::l
+        if Pp.ismt px then l else px::l
       in
       (* We cannot use fold_right here due to side effects in pp_specif *)
       let l = List.fold_left try_pp_specif [] sign in
       let l = List.rev l in
       pop_visible ();
       str "sig" ++ fnl () ++
-      v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
-	fnl () ++ str "end"
+      (if List.is_empty l then mt ()
+       else
+         v 1 (str " " ++ prlist_with_sep cut2 identity l) ++ fnl ())
+      ++ str "end"
   | MTwith(mt,ML_With_type(idl,vl,typ)) ->
       let ids = pp_parameters (rename_tvars keywords vl) in
       let mp_mt = msid_of_mt mt in
@@ -681,12 +687,11 @@ let is_short = function MEident _ | MEapply _ -> true | _ -> false
 
 let rec pp_structure_elem = function
   | (l,SEdecl d) ->
-       (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
+     (match Common.get_duplicate (top_visible_mp ()) l with
+      | None -> pp_decl d
+      | Some ren ->
 	 hov 1 (str ("module "^ren^" = struct") ++ fnl () ++ pp_decl d) ++
-	 fnl () ++ str "end" ++ fnl () ++
-	 pp_alias_decl ren d
-	with Not_found -> pp_decl d)
+	 fnl () ++ str "end" ++ fnl () ++ str ("include "^ren))
   | (l,SEmodule m) ->
       let typ =
         (* virtual printing of the type, in order to have a correct mli later*)
@@ -699,18 +704,16 @@ let rec pp_structure_elem = function
       hov 1
 	(str "module " ++ name ++ typ ++ str " =" ++
 	 (if is_short m.ml_mod_expr then spc () else fnl ()) ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-	 fnl () ++ str ("module "^ren^" = ") ++ name
-       with Not_found -> mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | Some ren -> fnl () ++ str ("module "^ren^" = ") ++ name
+       | None -> mt ())
   | (l,SEmodtype m) ->
       let def = pp_module_type [] m in
       let name = pp_modname (MPdot (top_visible_mp (), l)) in
       hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-         fnl () ++ str ("module type "^ren^" = ") ++ name
-       with Not_found -> mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | None -> mt ()
+       | Some ren -> fnl () ++ str ("module type "^ren^" = ") ++ name)
 
 and pp_module_expr params = function
   | MEident mp -> pp_modname mp
@@ -725,15 +728,17 @@ and pp_module_expr params = function
       push_visible mp params;
       let try_pp_structure_elem l x =
         let px = pp_structure_elem x in
-        if Pp.is_empty px then l else px::l
+        if Pp.ismt px then l else px::l
       in
       (* We cannot use fold_right here due to side effects in pp_structure_elem *)
       let l = List.fold_left try_pp_structure_elem [] sel in
       let l = List.rev l in
       pop_visible ();
       str "struct" ++ fnl () ++
-      v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
-      fnl () ++ str "end"
+      (if List.is_empty l then mt ()
+       else
+         v 1 (str " " ++ prlist_with_sep cut2 identity l) ++ fnl ())
+      ++ str "end"
 
 let rec prlist_sep_nonempty sep f = function
   | [] -> mt ()
@@ -741,7 +746,7 @@ let rec prlist_sep_nonempty sep f = function
   | h::t ->
      let e = f h in
      let r = prlist_sep_nonempty sep f t in
-     if Pp.is_empty e then r
+     if Pp.ismt e then r
      else e ++ sep () ++ r
 
 let do_struct f s =
diff --git a/plugins/extraction/ocaml.mli b/plugins/extraction/ocaml.mli
index f579a54b..96d12344 100644
--- a/plugins/extraction/ocaml.mli
+++ b/plugins/extraction/ocaml.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val ocaml_descr : Miniml.language_descr
diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml
index a6309e61..76a0c740 100644
--- a/plugins/extraction/scheme.ml
+++ b/plugins/extraction/scheme.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s Production of Scheme syntax. *)
@@ -40,11 +42,7 @@ let preamble _ comment _ usf =
   (if usf.mldummy then str "(define __ (lambda (_) __))\n\n" else mt ())
 
 let pr_id id =
-  let s = Id.to_string id in
-  for i = 0 to String.length s - 1 do
-    if s.[i] == '\'' then s.[i] <- '~'
-  done;
-  str s
+  str @@ String.map (fun c -> if c == '\'' then '~' else c) (Id.to_string id)
 
 let paren = pp_par true
 
@@ -100,9 +98,9 @@ let rec pp_expr env args =
 		 prlist_with_sep spc (pp_cons_args env) args')
 	in
 	if is_coinductive r then paren (str "delay " ++ st) else st
-    | MLtuple _ -> error "Cannot handle tuples in Scheme yet."
+    | MLtuple _ -> user_err Pp.(str "Cannot handle tuples in Scheme yet.")
     | MLcase (_,_,pv) when not (is_regular_match pv) ->
-	error "Cannot handle general patterns in Scheme yet."
+	user_err Pp.(str "Cannot handle general patterns in Scheme yet.")
     | MLcase (_,t,pv) when is_custom_match pv ->
 	let mkfun (ids,_,e) =
 	  if not (List.is_empty ids) then named_lams (List.rev ids) e
diff --git a/plugins/extraction/scheme.mli b/plugins/extraction/scheme.mli
index 5e1ec0d5..defd8184 100644
--- a/plugins/extraction/scheme.mli
+++ b/plugins/extraction/scheme.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val scheme_descr : Miniml.language_descr
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index ff66d915..54c6d9d7 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
+open ModPath
 open Term
 open Declarations
-open Nameops
 open Namegen
 open Libobject
 open Goptions
@@ -20,6 +22,11 @@ open Util
 open Pp
 open Miniml
 
+[@@@ocaml.warning "-3"]       (* String.capitalize_ascii since 4.03.0 GPR#124 *)
+let capitalize = String.capitalize
+[@@@ocaml.warning "+3"]
+
+
 (** Sets and maps for [global_reference] that use the "user" [kernel_name]
     instead of the canonical one *)
 
@@ -30,15 +37,14 @@ module Refset' = Refset_env
 
 let occur_kn_in_ref kn = function
   | IndRef (kn',_)
-  | ConstructRef ((kn',_),_) -> Names.eq_mind kn kn'
-  | ConstRef _ -> false
-  | VarRef _ -> assert false
+  | ConstructRef ((kn',_),_) -> MutInd.equal kn kn'
+  | ConstRef _ | VarRef _ -> false
 
 let repr_of_r = function
-  | ConstRef kn -> repr_con kn
+  | ConstRef kn -> Constant.repr3 kn
   | IndRef (kn,_)
-  | ConstructRef ((kn,_),_) -> repr_mind kn
-  | VarRef _ -> assert false
+  | ConstructRef ((kn,_),_) -> MutInd.repr3 kn
+  | VarRef v -> KerName.repr (Lib.make_kn v)
 
 let modpath_of_r r =
   let mp,_,_ = repr_of_r r in mp
@@ -55,11 +61,11 @@ let is_modfile = function
   | _ -> false
 
 let raw_string_of_modfile = function
-  | MPfile f -> String.capitalize (Id.to_string (List.hd (DirPath.repr f)))
+  | MPfile f -> capitalize (Id.to_string (List.hd (DirPath.repr f)))
   | _ -> assert false
 
 let is_toplevel mp =
-  ModPath.equal mp initial_path || ModPath.equal mp (Lib.current_mp ())
+  ModPath.equal mp ModPath.initial || ModPath.equal mp (Lib.current_mp ())
 
 let at_toplevel mp =
   is_modfile mp || is_toplevel mp
@@ -245,6 +251,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 ()].
@@ -256,18 +267,18 @@ let safe_basename_of_global r =
   let last_chance r =
     try Nametab.basename_of_global r
     with Not_found ->
-      anomaly (Pp.str "Inductive object unknown to extraction and not globally visible")
+      anomaly (Pp.str "Inductive object unknown to extraction and not globally visible.")
   in
   match r with
-    | ConstRef kn -> Label.to_id (con_label kn)
-    | IndRef (kn,0) -> Label.to_id (mind_label kn)
+    | ConstRef kn -> Label.to_id (Constant.label kn)
+    | IndRef (kn,0) -> Label.to_id (MutInd.label kn)
     | IndRef (kn,i) ->
       (try (unsafe_lookup_ind kn).ind_packets.(i).ip_typename
        with Not_found -> last_chance r)
     | ConstructRef ((kn,i),j) ->
       (try (unsafe_lookup_ind kn).ind_packets.(i).ip_consnames.(j-1)
        with Not_found -> last_chance r)
-    | VarRef _ -> assert false
+    | VarRef v -> v
 
 let string_of_global r =
  try string_of_qualid (Nametab.shortest_qualid_of_global Id.Set.empty r)
@@ -281,8 +292,8 @@ let safe_pr_long_global r =
   try Printer.pr_global r
   with Not_found -> match r with
     | ConstRef kn ->
-	let mp,_,l = repr_con kn in
-	str ((string_of_mp mp)^"."^(Label.to_string l))
+	let mp,_,l = Constant.repr3 kn in
+	str ((ModPath.to_string mp)^"."^(Label.to_string l))
     | _ -> assert false
 
 let pr_long_mp mp =
@@ -293,7 +304,7 @@ let pr_long_global ref = pr_path (Nametab.path_of_global ref)
 
 (*S Warning and Error messages. *)
 
-let err s = errorlabstrm "Extraction" s
+let err s = user_err ~hdr:"Extraction" s
 
 let warn_extraction_axiom_to_realize =
   CWarnings.create ~name:"extraction-axiom-to-realize" ~category:"extraction"
@@ -411,7 +422,7 @@ let error_singleton_become_prop id og =
                 str " (or in its mutual block)"
     | None -> mt ()
   in
-  err (str "The informative inductive type " ++ pr_id id ++
+  err (str "The informative inductive type " ++ Id.print id ++
        str " has a Prop instance" ++ loc ++ str "." ++ fnl () ++
        str "This happens when a sort-polymorphic singleton inductive type\n" ++
        str "has logical parameters, such as (I,I) : (True * True) : Prop.\n" ++
@@ -439,9 +450,10 @@ let error_MPfile_as_mod mp b =
 	    "Please "^s2^"use (Recursive) Extraction Library instead.\n"))
 
 let argnames_of_global r =
-  let typ = Global.type_of_global_unsafe r in
+  let env = Global.env () in
+  let typ, _ = Global.type_of_global_in_context env r in
   let rels,_ =
-    decompose_prod (Reduction.whd_all (Global.env ()) typ) in
+    decompose_prod (Reduction.whd_all env typ) in
   List.rev_map fst rels
 
 let msg_of_implicit = function
@@ -475,7 +487,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
   | _ -> ()
@@ -494,8 +506,7 @@ let my_bool_option name initval =
   let flag = ref initval in
   let access = fun () -> !flag in
   let _ = declare_bool_option
-    {optsync = true;
-     optdepr = false;
+    {optdepr = false;
      optname = "Extraction "^name;
      optkey = ["Extraction"; name];
      optread = access;
@@ -567,16 +578,14 @@ let chg_flag n = int_flag_ref := n; opt_flag_ref := flag_of_int n
 let optims () = !opt_flag_ref
 
 let _ = declare_bool_option
-	  {optsync = true;
-           optdepr = false;
+	  {optdepr = false;
 	   optname = "Extraction Optimize";
 	   optkey = ["Extraction"; "Optimize"];
 	   optread = (fun () -> not (Int.equal !int_flag_ref 0));
 	   optwrite = (fun b -> chg_flag (if b then int_flag_init else 0))}
 
 let _ = declare_int_option
-          { optsync = true;
-            optdepr = false;
+          { optdepr = false;
             optname = "Extraction Flag";
             optkey = ["Extraction";"Flag"];
             optread = (fun _ -> Some !int_flag_ref);
@@ -590,8 +599,7 @@ let conservative_types_ref = ref false
 let conservative_types () = !conservative_types_ref
 
 let _ = declare_bool_option
-  {optsync = true;
-   optdepr = false;
+  {optdepr = false;
    optname = "Extraction Conservative Types";
    optkey = ["Extraction"; "Conservative"; "Types"];
    optread = (fun () -> !conservative_types_ref);
@@ -603,8 +611,7 @@ let file_comment_ref = ref ""
 let file_comment () = !file_comment_ref
 
 let _ = declare_string_option
-  {optsync = true;
-   optdepr = false;
+  {optdepr = false;
    optname = "Extraction File Comment";
    optkey = ["Extraction"; "File"; "Comment"];
    optread = (fun () -> !file_comment_ref);
@@ -721,7 +728,7 @@ let add_implicits r l =
          let i = List.index Name.equal (Name id) names in
          Int.Set.add i s
        with Not_found ->
-	 err (str "No argument " ++ pr_id id ++ str " for " ++
+	 err (str "No argument " ++ Id.print id ++ str " for " ++
 	      safe_pr_global r)
   in
   let ints = List.fold_left add_arg Int.Set.empty l in
@@ -749,11 +756,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 =
@@ -762,7 +769,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'
 
@@ -773,13 +780,11 @@ let file_of_modfile mp =
     | MPfile f -> Id.to_string (List.hd (DirPath.repr f))
     | _ -> assert false
   in
-  let s = String.copy (string_of_modfile mp) in
-  if s.[0] != s0.[0] then s.[0] <- s0.[0];
-  s
+  String.mapi (fun i c -> if i = 0 then s0.[0] else c) (string_of_modfile mp)
 
 let add_blacklist_entries l =
   blacklist_table :=
-    List.fold_right (fun s -> Id.Set.add (Id.of_string (String.capitalize s)))
+    List.fold_right (fun s -> Id.Set.add (Id.of_string (capitalize s)))
       l !blacklist_table
 
 (* Registration of operations for rollback. *)
@@ -801,7 +806,7 @@ let extraction_blacklist l =
 (* Printing part *)
 
 let print_extraction_blacklist () =
-  prlist_with_sep fnl pr_id (Id.Set.elements !blacklist_table)
+  prlist_with_sep fnl Id.print (Id.Set.elements !blacklist_table)
 
 (* Reset part *)
 
@@ -879,7 +884,7 @@ let extract_constant_inline inline r ids s =
   match g with
     | ConstRef kn ->
 	let env = Global.env () in
-	let typ = Global.type_of_global_unsafe (ConstRef kn) in
+	let typ, _ = Global.type_of_global_in_context env (ConstRef kn) in
 	let typ = Reduction.whd_all env typ in
 	if Reduction.is_arity env typ
 	  then begin
@@ -894,7 +899,7 @@ let extract_constant_inline inline r ids s =
 let extract_inductive r s l optstr =
   check_inside_section ();
   let g = Smartlocate.global_with_alias r in
-  Dumpglob.add_glob (loc_of_reference r) g;
+  Dumpglob.add_glob ?loc:r.CAst.loc g;
   match g with
     | IndRef ((kn,i) as ip) ->
 	let mib = Global.lookup_mind kn in
diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli
index 15a08756..906dfd96 100644
--- a/plugins/extraction/table.mli
+++ b/plugins/extraction/table.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -21,22 +23,22 @@ val safe_basename_of_global : global_reference -> Id.t
 
 val warning_axioms : unit -> unit
 val warning_opaques : bool -> unit
-val warning_ambiguous_name : ?loc:Loc.t -> qualid * module_path * global_reference -> unit
+val warning_ambiguous_name : ?loc:Loc.t -> qualid * ModPath.t * global_reference -> unit
 val warning_id : string -> unit
 val error_axiom_scheme : global_reference -> int -> 'a
 val error_constant : global_reference -> 'a
 val error_inductive : global_reference -> 'a
 val error_nb_cons : unit -> 'a
-val error_module_clash : module_path -> module_path -> 'a
-val error_no_module_expr : module_path -> 'a
+val error_module_clash : ModPath.t -> ModPath.t -> 'a
+val error_no_module_expr : ModPath.t -> 'a
 val error_singleton_become_prop : Id.t -> global_reference option -> 'a
 val error_unknown_module : qualid -> 'a
 val error_scheme : unit -> 'a
 val error_not_visible : global_reference -> 'a
-val error_MPfile_as_mod : module_path -> bool -> 'a
+val error_MPfile_as_mod : ModPath.t -> bool -> 'a
 val check_inside_module : unit -> unit
 val check_inside_section : unit -> unit
-val check_loaded_modfile : module_path -> unit
+val check_loaded_modfile : ModPath.t -> unit
 val msg_of_implicit : kill_reason -> string
 val err_or_warn_remaining_implicit : kill_reason -> unit
 
@@ -44,22 +46,22 @@ val info_file : string -> unit
 
 (*s utilities about [module_path] and [kernel_names] and [global_reference] *)
 
-val occur_kn_in_ref : mutual_inductive -> global_reference -> bool
-val repr_of_r : global_reference -> module_path * DirPath.t * Label.t
-val modpath_of_r : global_reference -> module_path
+val occur_kn_in_ref : MutInd.t -> global_reference -> bool
+val repr_of_r : global_reference -> ModPath.t * DirPath.t * Label.t
+val modpath_of_r : global_reference -> ModPath.t
 val label_of_r : global_reference -> Label.t
-val base_mp : module_path -> module_path
-val is_modfile : module_path -> bool
-val string_of_modfile : module_path -> string
-val file_of_modfile : module_path -> string
-val is_toplevel : module_path -> bool
-val at_toplevel : module_path -> bool
-val mp_length : module_path -> int
-val prefixes_mp : module_path -> MPset.t
+val base_mp : ModPath.t -> ModPath.t
+val is_modfile : ModPath.t -> bool
+val string_of_modfile : ModPath.t -> string
+val file_of_modfile : ModPath.t -> string
+val is_toplevel : ModPath.t -> bool
+val at_toplevel : ModPath.t -> bool
+val mp_length : ModPath.t -> int
+val prefixes_mp : ModPath.t -> MPset.t
 val common_prefix_from_list :
-  module_path -> module_path list -> module_path option
-val get_nth_label_mp : int -> module_path -> Label.t
-val labels_of_ref : global_reference -> module_path * Label.t list
+  ModPath.t -> ModPath.t list -> ModPath.t option
+val get_nth_label_mp : int -> ModPath.t -> Label.t
+val labels_of_ref : global_reference -> ModPath.t * Label.t list
 
 (*s Some table-related operations *)
 
@@ -71,16 +73,16 @@ val labels_of_ref : global_reference -> module_path * Label.t list
    [mutual_inductive_body] as checksum. In both case, we should ideally
    also check the env *)
 
-val add_typedef : constant -> constant_body -> ml_type -> unit
-val lookup_typedef : constant -> constant_body -> ml_type option
+val add_typedef : Constant.t -> constant_body -> ml_type -> unit
+val lookup_typedef : Constant.t -> constant_body -> ml_type option
 
-val add_cst_type : constant -> constant_body -> ml_schema -> unit
-val lookup_cst_type : constant -> constant_body -> ml_schema option
+val add_cst_type : Constant.t -> constant_body -> ml_schema -> unit
+val lookup_cst_type : Constant.t -> constant_body -> ml_schema option
 
-val add_ind : mutual_inductive -> mutual_inductive_body -> ml_ind -> unit
-val lookup_ind : mutual_inductive -> mutual_inductive_body -> ml_ind option
+val add_ind : MutInd.t -> mutual_inductive_body -> ml_ind -> unit
+val lookup_ind : MutInd.t -> mutual_inductive_body -> ml_ind option
 
-val add_inductive_kind : mutual_inductive -> inductive_kind -> unit
+val add_inductive_kind : MutInd.t -> inductive_kind -> unit
 val is_coinductive : global_reference -> bool
 val is_coinductive_type : ml_type -> bool
 (* What are the fields of a record (empty for a non-record) *)
@@ -88,10 +90,10 @@ val get_record_fields :
   global_reference -> global_reference option list
 val record_fields_of_type : ml_type -> global_reference option list
 
-val add_recursors : Environ.env -> mutual_inductive -> unit
+val add_recursors : Environ.env -> MutInd.t -> unit
 val is_recursor : global_reference -> bool
 
-val add_projection : int -> constant -> inductive -> unit
+val add_projection : int -> Constant.t -> inductive -> unit
 val is_projection : global_reference -> bool
 val projection_arity : global_reference -> int
 val projection_info : global_reference -> inductive * int (* arity *)
@@ -165,6 +167,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 +182,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
@@ -191,7 +196,7 @@ val find_custom_match : ml_branch array -> string
 
 val extraction_language : lang -> unit
 val extraction_inline : bool -> reference list -> unit
-val print_extraction_inline : unit -> Pp.std_ppcmds
+val print_extraction_inline : unit -> Pp.t
 val reset_extraction_inline : unit -> unit
 val extract_constant_inline :
   bool -> reference -> string list -> string -> unit
@@ -206,7 +211,7 @@ val extraction_implicit : reference -> int_or_id list -> unit
 
 val extraction_blacklist : Id.t list -> unit
 val reset_extraction_blacklist : unit -> unit
-val print_extraction_blacklist : unit -> Pp.std_ppcmds
+val print_extraction_blacklist : unit -> Pp.t
 
 
 
diff --git a/plugins/extraction/vo.itarget b/plugins/extraction/vo.itarget
deleted file mode 100644
index 9c30c5eb..00000000
--- a/plugins/extraction/vo.itarget
+++ /dev/null
@@ -1,16 +0,0 @@
-ExtrHaskellBasic.vo
-ExtrHaskellNatNum.vo
-ExtrHaskellNatInt.vo
-ExtrHaskellNatInteger.vo
-ExtrHaskellZNum.vo
-ExtrHaskellZInt.vo
-ExtrHaskellZInteger.vo
-ExtrHaskellString.vo
-ExtrOcamlBasic.vo
-ExtrOcamlIntConv.vo
-ExtrOcamlBigIntConv.vo
-ExtrOcamlNatInt.vo
-ExtrOcamlNatBigInt.vo
-ExtrOcamlZInt.vo
-ExtrOcamlZBigInt.vo
-ExtrOcamlString.vo
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index 58744b57..047fc9fb 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -1,21 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Hipattern
 open Names
-open Term
+open Constr
+open EConstr
 open Vars
 open Termops
-open Tacmach
 open Util
 open Declarations
 open Globnames
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 
 let qflag=ref true
 
@@ -38,33 +41,33 @@ 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
 
-let construct_nhyps ind gls =
+let construct_nhyps env ind =
   let nparams = (fst (Global.lookup_inductive (fst ind))).mind_nparams in
-  let constr_types = Inductiveops.arities_of_constructors (pf_env gls) ind in
+  let constr_types = Inductiveops.arities_of_constructors env ind in
   let hyp = nb_prod_after nparams in
     Array.map hyp constr_types
 
 (* indhyps builds the array of arrays of constructor hyps for (ind largs)*)
-let ind_hyps nevar ind largs gls=
-  let types= Inductiveops.arities_of_constructors (pf_env gls) ind in
+let ind_hyps env sigma nevar ind largs =
+  let types= Inductiveops.arities_of_constructors env ind in
   let myhyps t =
-    let t1=prod_applist t largs in
-    let t2=snd (decompose_prod_n_assum nevar t1) in
-      fst (decompose_prod_assum t2) in
+    let t = EConstr.of_constr t 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
 
-let special_nf gl=
-  let infos=CClosure.create_clos_infos !red_flags (pf_env gl) in
-    (fun t -> CClosure.norm_val infos (CClosure.inject t))
+let special_nf env sigma t =
+  Reductionops.clos_norm_flags !red_flags env sigma t
 
-let special_whd gl=
-  let infos=CClosure.create_clos_infos !red_flags (pf_env gl) in
-    (fun t -> CClosure.whd_val infos (CClosure.inject t))
+let special_whd env sigma t =
+  Reductionops.clos_whd_flags !red_flags env sigma t
 
 type kind_of_formula=
     Arrow of constr*constr
@@ -75,18 +78,21 @@ type kind_of_formula=
   | Forall of constr*constr
   | Atom of constr
 
-let kind_of_formula gl term =
-  let normalize=special_nf gl in
-  let cciterm=special_whd gl term in
-    match match_with_imp_term cciterm with
-	Some (a,b)-> Arrow(a,(pop b))
+let pop t = Vars.lift (-1) t
+
+let kind_of_formula env sigma term =
+  let normalize = special_nf env sigma in
+  let cciterm = special_whd env sigma term in
+    match match_with_imp_term sigma cciterm with
+	Some (a,b)-> Arrow (a, pop b)
       |_->
-	 match match_with_forall_term cciterm with
-	     Some (_,a,b)-> Forall(a,b)
+	 match match_with_forall_term sigma cciterm with
+	     Some (_,a,b)-> Forall (a, b)
 	   |_->
-	      match match_with_nodep_ind cciterm with
+	      match match_with_nodep_ind sigma cciterm with
 		  Some (i,l,n)->
-		    let ind,u=destInd i in
+		    let ind,u=EConstr.destInd sigma i in
+		    let u = EConstr.EInstance.kind sigma u in
 		    let (mib,mip) = Global.lookup_inductive ind in
 		    let nconstr=Array.length mip.mind_consnames in
 		      if Int.equal nconstr 0 then
@@ -95,7 +101,7 @@ let kind_of_formula gl term =
 			let has_realargs=(n>0) in
 			let is_trivial=
 			  let is_constant c =
-			    Int.equal (nb_prod c) mib.mind_nparams in
+			    Int.equal (nb_prod sigma (EConstr.of_constr c)) mib.mind_nparams in
 			    Array.exists is_constant mip.mind_nf_lc in
 			  if Inductiveops.mis_is_recursive (ind,mib,mip) ||
 			    (has_realargs && not is_trivial)
@@ -107,8 +113,11 @@ let kind_of_formula gl term =
 			    else
 			      Or((ind,u),l,is_trivial)
 		| _ ->
-		    match match_with_sigma_type cciterm with
-			Some (i,l)-> Exists((destInd i),l)
+		    match match_with_sigma_type sigma cciterm with
+			Some (i,l)->
+                          let (ind, u) = EConstr.destInd sigma i in
+                          let u = EConstr.EInstance.kind sigma u in
+                          Exists((ind, u), l)
 		      |_-> Atom (normalize cciterm)
 
 type atoms = {positive:constr list;negative:constr list}
@@ -119,29 +128,29 @@ let no_atoms = (false,{positive=[];negative=[]})
 
 let dummy_id=VarRef (Id.of_string "_") (* "_" cannot be parsed *)
 
-let build_atoms gl metagen side cciterm =
+let build_atoms env sigma metagen side cciterm =
   let trivial =ref false
   and positive=ref []
   and negative=ref [] in
-  let normalize=special_nf gl in
-  let rec build_rec env polarity cciterm=
-    match kind_of_formula gl cciterm with
+  let normalize=special_nf env sigma in
+  let rec build_rec subst polarity cciterm=
+    match kind_of_formula env sigma cciterm with
 	False(_,_)->if not polarity then trivial:=true
       | Arrow (a,b)->
-	  build_rec env (not polarity) a;
-	  build_rec env polarity b
+	  build_rec subst (not polarity) a;
+	  build_rec subst polarity b
       | And(i,l,b) | Or(i,l,b)->
 	  if b then
 	    begin
-	      let unsigned=normalize (substnl env 0 cciterm) in
+	      let unsigned=normalize (substnl subst 0 cciterm) in
 		if polarity then
 		  positive:= unsigned :: !positive
 		else
 		  negative:= unsigned :: !negative
 	    end;
-	  let v = ind_hyps 0 i l gl in
+	  let v = ind_hyps env sigma 0 i l in
 	  let g i _ decl =
-	    build_rec env polarity (lift i (get_type decl)) in
+	    build_rec subst polarity (lift i (RelDecl.get_type decl)) in
 	  let f l =
 	    List.fold_left_i g (1-(List.length l)) () l in
 	    if polarity && (* we have a constant constructor *)
@@ -150,16 +159,16 @@ let build_atoms gl metagen side cciterm =
 	    Array.iter f v
       | Exists(i,l)->
 	  let var=mkMeta (metagen true) in
-	  let v =(ind_hyps 1 i l gl).(0) in
+	  let v =(ind_hyps env sigma 1 i l).(0) in
 	  let g i _ decl =
-	    build_rec (var::env) polarity (lift i (get_type decl)) in
+	    build_rec (var::subst) polarity (lift i (RelDecl.get_type decl)) in
 	    List.fold_left_i g (2-(List.length l)) () v
       | Forall(_,b)->
 	  let var=mkMeta (metagen true) in
-	    build_rec (var::env) polarity b
+	    build_rec (var::subst) polarity b
       | Atom t->
-	  let unsigned=substnl env 0 t in
-	    if not (isMeta unsigned) then (* discarding wildcard atoms *)
+	  let unsigned=substnl subst 0 t in
+	    if not (isMeta sigma unsigned) then (* discarding wildcard atoms *)
 	      if polarity then
 		positive:= unsigned :: !positive
 	      else
@@ -169,9 +178,9 @@ let build_atoms gl metagen side cciterm =
 	  Concl    -> build_rec [] true cciterm
 	| Hyp      -> build_rec [] false cciterm
 	| Hint     ->
-	    let rels,head=decompose_prod cciterm in
-	    let env=List.rev_map (fun _->mkMeta (metagen true)) rels in
-	      build_rec env false head;trivial:=false (* special for hints *)
+	    let rels,head=decompose_prod sigma cciterm in
+	    let subst=List.rev_map (fun _->mkMeta (metagen true)) rels in
+	      build_rec subst false head;trivial:=false (* special for hints *)
     end;
     (!trivial,
      {positive= !positive;
@@ -207,32 +216,32 @@ type t={id:global_reference;
 	pat:(left_pattern,right_pattern) sum;
 	atoms:atoms}
 
-let build_formula side nam typ gl metagen=
-  let normalize = special_nf gl in
+let build_formula env sigma side nam typ metagen=
+  let normalize = special_nf env sigma in
     try
       let m=meta_succ(metagen false) in
       let trivial,atoms=
 	if !qflag then
-	  build_atoms gl metagen side typ
+	  build_atoms env sigma metagen side typ
 	else no_atoms in
       let pattern=
 	match side with
 	    Concl ->
 	      let pat=
-		match kind_of_formula gl typ with
+		match kind_of_formula env sigma typ with
 		    False(_,_)        -> Rfalse
 		  | Atom a       -> raise (Is_atom a)
 		  | And(_,_,_)        -> Rand
 		  | Or(_,_,_)         -> Ror
 		  | Exists (i,l) ->
-		      let d = get_type (List.last (ind_hyps 0 i l gl).(0)) in
+		      let d = RelDecl.get_type (List.last (ind_hyps env sigma 0 i l).(0)) in
 			Rexists(m,d,trivial)
 		  | Forall (_,a) -> Rforall
 		  | Arrow (a,b) -> Rarrow in
 		Right pat
 	  | _ ->
 	      let pat=
-		match kind_of_formula gl typ with
+		match kind_of_formula env sigma typ with
 		    False(i,_)        ->  Lfalse
 		  | Atom a       ->  raise (Is_atom a)
 		  | And(i,_,b)         ->
@@ -249,7 +258,7 @@ let build_formula side nam typ gl metagen=
 		  | Arrow (a,b) ->
 		      let nfa=normalize a in
 			LA (nfa,
-			    match kind_of_formula gl a with
+			    match kind_of_formula env sigma a with
 				False(i,l)-> LLfalse(i,l)
 			      | Atom t->     LLatom
 			      | And(i,l,_)-> LLand(i,l)
diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli
index 5db8ff59..2962d923 100644
--- a/plugins/firstorder/formula.mli
+++ b/plugins/firstorder/formula.mli
@@ -1,12 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Constr
+open EConstr
 open Globnames
 
 val qflag : bool ref
@@ -23,10 +26,10 @@ type ('a,'b) sum = Left of 'a | Right of 'b
 
 type counter = bool -> metavariable
 
-val construct_nhyps : pinductive -> Proof_type.goal Tacmach.sigma -> int array
+val construct_nhyps : Environ.env -> pinductive -> int array
 
-val ind_hyps : int -> pinductive -> constr list ->
-  Proof_type.goal Tacmach.sigma -> Context.Rel.t array
+val ind_hyps : Environ.env -> Evd.evar_map -> int -> pinductive ->
+  constr list -> EConstr.rel_context array
 
 type atoms = {positive:constr list;negative:constr list}
 
@@ -34,7 +37,7 @@ type side = Hyp | Concl | Hint
 
 val dummy_id: global_reference
 
-val build_atoms : Proof_type.goal Tacmach.sigma -> counter ->
+val build_atoms : Environ.env -> Evd.evar_map -> counter ->
   side -> constr -> bool * atoms
 
 type right_pattern =
@@ -69,6 +72,6 @@ type t={id: global_reference;
 
 (*exception Is_atom of constr*)
 
-val build_formula : side -> global_reference -> types ->
-  Proof_type.goal Tacmach.sigma -> counter -> (t,types) sum
+val build_formula : Environ.env -> Evd.evar_map -> side -> global_reference -> types ->
+  counter -> (t,types) sum
 
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index 43fac8ad..30deb6f4 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -1,22 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma"  i*)
 
+open Ltac_plugin
 open Formula
 open Sequent
 open Ground
 open Goptions
-open Tacticals
+open Tacmach.New
+open Tacticals.New
 open Tacinterp
 open Libnames
-open Constrarg
 open Stdarg
+open Tacarg
 open Pcoq.Prim
 
 DECLARE PLUGIN "ground_plugin"
@@ -27,8 +30,7 @@ let ground_depth=ref 3
 
 let _=
   let gdopt=
-    { optsync=true;
-      optdepr=false;
+    { optdepr=false;
       optname="Firstorder Depth";
       optkey=["Firstorder";"Depth"];
       optread=(fun ()->Some !ground_depth);
@@ -39,18 +41,17 @@ let _=
   in
     declare_int_option gdopt
 
-let congruence_depth=ref 100
 
 let _=
+  let congruence_depth=ref 100 in
   let gdopt=
-    { optsync=true;
-      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
@@ -60,16 +61,19 @@ let default_intuition_tac =
   let name = { Tacexpr.mltac_plugin = "ground_plugin"; mltac_tactic = "auto_with"; } in
   let entry = { Tacexpr.mltac_name = name; mltac_index = 0 } in
   Tacenv.register_ml_tactic name [| tac |];
-  Tacexpr.TacML (Loc.ghost, entry, [])
+  Tacexpr.TacML (Loc.tag (entry, []))
 
 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
@@ -80,21 +84,29 @@ END
 
 let fail_solver=tclFAIL 0 (Pp.str "GTauto failed")
 
-let gen_ground_tac flag taco ids bases gl=
+let gen_ground_tac flag taco ids bases =
   let backup= !qflag in
-    try
+  Proofview.tclOR begin
+  Proofview.Goal.enter begin fun gl ->
       qflag:=flag;
       let solver=
 	match taco with
 	    Some tac-> tac
 	  | None-> snd (default_solver ()) in
-      let startseq gl=
+      let startseq k =
+        Proofview.Goal.enter begin fun gl ->
 	let seq=empty_seq !ground_depth in
-        let seq,gl = extend_with_ref_list ids seq gl in
-        extend_with_auto_hints bases seq gl in
-      let result=ground_tac (Proofview.V82.of_tactic solver) startseq gl in
-	qflag:=backup;result
-    with reraise -> qflag:=backup;raise reraise
+        let seq, sigma = extend_with_ref_list (pf_env gl) (project gl) ids seq in
+        let seq, sigma = extend_with_auto_hints (pf_env gl) (project gl) bases seq in
+        tclTHEN (Proofview.Unsafe.tclEVARS sigma) (k seq)
+        end
+      in
+      let result=ground_tac solver startseq in
+      qflag := backup;
+      result
+  end
+  end
+  (fun (e, info) -> qflag := backup; Proofview.tclZERO ~info e)
 
 (* special for compatibility with Intuition
 
@@ -112,7 +124,6 @@ let normalize_evaluables=
 	   unfold_in_hyp (Lazy.force defined_connectives)
 	   (Tacexpr.InHypType id)) *)
 
-open Pp
 open Genarg
 open Ppconstr
 open Printer
@@ -143,36 +154,15 @@ END
 
 TACTIC EXTEND firstorder
     [ "firstorder" tactic_opt(t) firstorder_using(l) ] ->
-      [ Proofview.V82.tactic (gen_ground_tac true (Option.map (tactic_of_value ist) t) l []) ]
+      [ gen_ground_tac true (Option.map (tactic_of_value ist) t) l [] ]
 |   [ "firstorder" tactic_opt(t) "with" ne_preident_list(l) ] ->
-      [ Proofview.V82.tactic (gen_ground_tac true (Option.map (tactic_of_value ist) t) [] l) ]
+      [ gen_ground_tac true (Option.map (tactic_of_value ist) t) [] l ]
 |   [ "firstorder" tactic_opt(t) firstorder_using(l)
        "with" ne_preident_list(l') ] ->
-      [ Proofview.V82.tactic (gen_ground_tac true (Option.map (tactic_of_value ist) t) l l') ]
+      [ gen_ground_tac true (Option.map (tactic_of_value ist) t) l l' ]
 END
 
 TACTIC EXTEND gintuition
   [ "gintuition" tactic_opt(t) ] ->
-     [ Proofview.V82.tactic (gen_ground_tac false (Option.map (tactic_of_value ist) t) [] []) ]
+     [ gen_ground_tac false (Option.map (tactic_of_value ist) t) [] [] ]
 END
-
-open Proofview.Notations
-open Cc_plugin
-open Decl_mode_plugin
-
-let default_declarative_automation =
-  Proofview.tclUNIT () >>= fun () -> (* delay for [congruence_depth] *)
-  Tacticals.New.tclORELSE
-    (Tacticals.New.tclORELSE (Auto.h_trivial [] None)
-    (Cctac.congruence_tac !congruence_depth []))
-    (Proofview.V82.tactic (gen_ground_tac true
-       (Some (Tacticals.New.tclTHEN
-		(snd (default_solver ()))
-		(Cctac.congruence_tac !congruence_depth [])))
-       [] []))
-
-
-
-let () =
-  Decl_proof_instr.register_automation_tac default_declarative_automation
-
diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml
index 628af4e7..4e3ba573 100644
--- a/plugins/firstorder/ground.ml
+++ b/plugins/firstorder/ground.ml
@@ -1,18 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+open Ltac_plugin
 open Formula
 open Sequent
 open Rules
 open Instances
-open Term
-open Tacmach
-open Tacticals
+open Constr
+open Tacmach.New
+open Tacticals.New
 
 let update_flags ()=
   let predref=ref Names.Cpred.empty in
@@ -28,18 +31,24 @@ let update_flags ()=
       CClosure.betaiotazeta
       (Names.Id.Pred.full,Names.Cpred.complement !predref)
 
-let ground_tac solver startseq gl=
+let ground_tac solver startseq =
+  Proofview.Goal.enter begin fun gl ->
   update_flags ();
-  let rec toptac skipped seq gl=
-    if Tacinterp.get_debug()=Tactic_debug.DebugOn 0
-    then Feedback.msg_debug (Printer.pr_goal gl);
+  let rec toptac skipped seq =
+    Proofview.Goal.enter begin fun gl ->
+    let () =
+      if Tacinterp.get_debug()=Tactic_debug.DebugOn 0
+      then
+        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)
       begin
 	try
-	  let (hd,seq1)=take_formula seq
-	  and re_add s=re_add_formula_list skipped s in
+	  let (hd,seq1)=take_formula (project gl) seq
+	  and re_add s=re_add_formula_list (project gl) skipped s in
 	  let continue=toptac []
-	  and backtrack gl=toptac (hd::skipped) seq1 gl in
+	  and backtrack =toptac (hd::skipped) seq1 in
 	    match hd.pat with
 		Right rpat->
 		  begin
@@ -59,7 +68,7 @@ let ground_tac solver startseq gl=
 			  or_tac  backtrack continue (re_add seq1)
 		      | Rfalse->backtrack
 		      | Rexists(i,dom,triv)->
-			  let (lfp,seq2)=collect_quantified seq in
+			  let (lfp,seq2)=collect_quantified (project gl) seq in
 			  let backtrack2=toptac (lfp@skipped) seq2 in
 			    if  !qflag && seq.depth>0 then
 			      quantified_tac lfp backtrack2
@@ -79,7 +88,7 @@ let ground_tac solver startseq gl=
 			  left_or_tac ind backtrack
 			  hd.id continue (re_add seq1)
 		      | Lforall (_,_,_)->
-			  let (lfp,seq2)=collect_quantified seq in
+			  let (lfp,seq2)=collect_quantified (project gl) seq in
 			  let backtrack2=toptac (lfp@skipped) seq2 in
 			    if  !qflag && seq.depth>0 then
 			      quantified_tac lfp backtrack2
@@ -118,7 +127,8 @@ let ground_tac solver startseq gl=
 			    ll_atom_tac typ la_tac hd.id continue (re_add seq1)
 		  end
 	    with Heap.EmptyHeap->solver
-      end gl in
-    let seq, gl' = startseq gl in
-    wrap (List.length (pf_hyps gl)) true (toptac []) seq gl'
-
+      end
+    end in
+    let n = List.length (Proofview.Goal.hyps gl) in
+    startseq (fun seq -> wrap n true (toptac []) seq)
+  end
diff --git a/plugins/firstorder/ground.mli b/plugins/firstorder/ground.mli
index b5669463..958fc4cf 100644
--- a/plugins/firstorder/ground.mli
+++ b/plugins/firstorder/ground.mli
@@ -1,11 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-val ground_tac:     Tacmach.tactic ->
-  (Proof_type.goal Tacmach.sigma -> Sequent.t * Proof_type.goal Tacmach.sigma) -> Tacmach.tactic
+
+val ground_tac: unit Proofview.tactic ->
+  ((Sequent.t -> unit Proofview.tactic) -> unit Proofview.tactic) -> unit Proofview.tactic
 
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index eebd974e..e8c0b927 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -1,35 +1,37 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Unify
 open Rules
 open CErrors
 open Util
-open Term
+open EConstr
 open Vars
-open Tacmach
+open Tacmach.New
 open Tactics
-open Tacticals
-open Termops
+open Tacticals.New
+open Proofview.Notations
 open Reductionops
 open Formula
 open Sequent
 open Names
 open Misctypes
-open Sigma.Notations
 open Context.Rel.Declaration
 
 let compare_instance inst1 inst2=
+        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)->
-	      (OrderedConstr.compare d1 d2)
+	      (cmp d1 d2)
 	  | Real((m1,c1),n1),Real((m2,c2),n2)->
-	      ((-) =? (-) ==? OrderedConstr.compare) m2 m1 n1 n2 c1 c2
+	      ((-) =? (-) ==? cmp) m2 m1 n1 n2 c1 c2
 	  | Phantom(_),Real((m,_),_)-> if Int.equal m 0 then -1 else 1
 	  | Real((m,_),_),Phantom(_)-> if Int.equal m 0 then 1 else -1
 
@@ -56,12 +58,12 @@ let make_simple_atoms seq=
       | None->[]
   in {negative=seq.latoms;positive=ratoms}
 
-let do_sequent setref triv id seq i dom atoms=
+let do_sequent sigma setref triv id seq i dom atoms=
   let flag=ref true in
   let phref=ref triv in
   let do_atoms a1 a2 =
     let do_pair t1 t2 =
-      match unif_atoms i dom t1 t2 with
+      match unif_atoms sigma i dom t1 t2 with
 	  None->()
 	| Some (Phantom _) ->phref:=true
 	| Some c ->flag:=false;setref:=IS.add (c,id) !setref in
@@ -71,26 +73,26 @@ let do_sequent setref triv id seq i dom atoms=
     do_atoms atoms (make_simple_atoms seq);
     !flag && !phref
 
-let match_one_quantified_hyp setref seq lf=
+let match_one_quantified_hyp sigma setref seq lf=
   match lf.pat with
       Left(Lforall(i,dom,triv))|Right(Rexists(i,dom,triv))->
-	if do_sequent setref triv lf.id seq i dom lf.atoms then
+	if do_sequent sigma setref triv lf.id seq i dom lf.atoms then
 	  setref:=IS.add ((Phantom dom),lf.id) !setref
-    | _ -> anomaly (Pp.str "can't happen")
+    | _ -> anomaly (Pp.str "can't happen.")
 
-let give_instances lf seq=
+let give_instances sigma lf seq=
   let setref=ref IS.empty in
-    List.iter (match_one_quantified_hyp setref seq) lf;
+    List.iter (match_one_quantified_hyp sigma setref seq) lf;
     IS.elements !setref
 
 (* collector for the engine *)
 
-let rec collect_quantified seq=
+let rec collect_quantified sigma seq=
   try
-    let hd,seq1=take_formula seq in
+    let hd,seq1=take_formula sigma seq in
       (match hd.pat with
 	   Left(Lforall(_,_,_)) | Right(Rexists(_,_,_)) ->
-	     let (q,seq2)=collect_quantified seq1 in
+	     let (q,seq2)=collect_quantified sigma seq1 in
 	       ((hd::q),seq2)
 	 | _->[],seq)
   with Heap.EmptyHeap -> [],seq
@@ -99,92 +101,99 @@ let rec collect_quantified seq=
 
 let dummy_bvid=Id.of_string "x"
 
-let mk_open_instance id idc gl m t=
-  let env=pf_env gl in
-  let evmap=Refiner.project gl in
+let mk_open_instance env evmap id idc m t =
   let var_id=
     if id==dummy_id then dummy_bvid else
-      let typ=pf_unsafe_type_of gl idc in
+      let typ=Typing.unsafe_type_of env evmap idc in
 	(* since we know we will get a product,
 	   reduction is not too expensive *)
-      let (nam,_,_)=destProd (whd_all env evmap typ) in
+      let (nam,_,_)=destProd evmap (whd_all env evmap typ) in
 	match nam with
 	    Name id -> id
 	  | Anonymous ->  dummy_bvid in
   let revt=substl (List.init m (fun i->mkRel (m-i))) t in
   let rec aux n avoid env evmap decls =
     if Int.equal n 0 then evmap, decls else
-      let nid=(fresh_id avoid var_id gl) in
-      let evmap = Sigma.Unsafe.of_evar_map evmap in
-      let Sigma ((c, _), evmap, _) = Evarutil.new_type_evar env evmap Evd.univ_flexible in
-      let evmap = Sigma.to_evar_map evmap in
+      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) (Environ.push_rel decl env) evmap (decl::decls) in
-  let evmap, decls = aux m [] env evmap [] in
-    evmap, decls, revt
+	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   *)
 
 let left_instance_tac (inst,id) continue seq=
+  let open EConstr in
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
   match inst with
       Phantom dom->
-	if lookup (id,None) seq then
+	if lookup sigma (id,None) seq then
 	  tclFAIL 0 (Pp.str "already done")
 	else
-	  tclTHENS (Proofview.V82.of_tactic (cut dom))
+	  tclTHENS (cut dom)
 	    [tclTHENLIST
-	       [Proofview.V82.of_tactic introf;
-                pf_constr_of_global id (fun idc ->
-		(fun gls-> Proofview.V82.of_tactic (generalize
-		   [mkApp(idc,
-			  [|mkVar (Tacmach.pf_nth_hyp_id gls 1)|])]) gls));
-		Proofview.V82.of_tactic introf;
+	       [introf;
+                (pf_constr_of_global id >>= fun idc ->
+                Proofview.Goal.enter begin fun gl ->
+                  let id0 = List.nth (pf_ids_of_hyps gl) 0 in
+                  generalize [mkApp(idc, [|mkVar id0|])]
+                end);
+		introf;
 		tclSOLVE [wrap 1 false continue
 			    (deepen (record (id,None) seq))]];
-	    tclTRY (Proofview.V82.of_tactic assumption)]
-    | Real((m,t) as c,_)->
-	if lookup (id,Some c) seq then
+	    tclTRY assumption]
+    | Real((m,t),_)->
+        let c = (m, EConstr.to_constr sigma t) in
+	if lookup sigma (id,Some c) seq then
 	  tclFAIL 0 (Pp.str "already done")
 	else
 	  let special_generalize=
 	    if m>0 then
-	      pf_constr_of_global id (fun idc ->
-		fun gl->
-		  let evmap,rc,ot = mk_open_instance id idc gl m t in
+	      (pf_constr_of_global id >>= fun idc ->
+		Proofview.Goal.enter begin fun gl->
+		  let (evmap, rc, ot) = mk_open_instance (pf_env gl) (project gl) id idc m t in
 		  let gt=
 		    it_mkLambda_or_LetIn
 		      (mkApp(idc,[|ot|])) rc in
 		  let evmap, _ =
 		    try Typing.type_of (pf_env gl) evmap gt
 		    with e when CErrors.noncritical e ->
-		      error "Untypable instance, maybe higher-order non-prenex quantification" in
-		    tclTHEN (Refiner.tclEVARS evmap) (Proofview.V82.of_tactic (generalize [gt])) gl)
+		      user_err Pp.(str "Untypable instance, maybe higher-order non-prenex quantification") in
+                  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evmap)
+		    (generalize [gt])
+                end)
 	    else
-	      pf_constr_of_global id (fun idc ->
-		Proofview.V82.of_tactic (generalize [mkApp(idc,[|t|])]))
+	      pf_constr_of_global id >>= fun idc -> generalize [mkApp(idc,[|t|])]
 	  in
 	    tclTHENLIST
 	      [special_generalize;
-	       Proofview.V82.of_tactic introf;
+	       introf;
 	       tclSOLVE
 		 [wrap 1 false continue (deepen (record (id,Some c) seq))]]
+  end
 
 let right_instance_tac inst continue seq=
+  let open EConstr in
+  Proofview.Goal.enter begin fun gl ->
   match inst with
       Phantom dom ->
-	tclTHENS (Proofview.V82.of_tactic (cut dom))
+	tclTHENS (cut dom)
 	[tclTHENLIST
-	   [Proofview.V82.of_tactic introf;
-	    (fun gls->
-	       Proofview.V82.of_tactic (split (ImplicitBindings
-			[mkVar (Tacmach.pf_nth_hyp_id gls 1)])) gls);
+	   [introf;
+            Proofview.Goal.enter begin fun gl ->
+              let id0 = List.nth (pf_ids_of_hyps gl) 0 in
+              split (ImplicitBindings [mkVar id0])
+            end;
 	    tclSOLVE [wrap 0 true continue (deepen seq)]];
-	 tclTRY (Proofview.V82.of_tactic assumption)]
+	 tclTRY assumption]
     | Real ((0,t),_) ->
-	(tclTHEN (Proofview.V82.of_tactic (split (ImplicitBindings [t])))
+	(tclTHEN (split (ImplicitBindings [t]))
 	   (tclSOLVE [wrap 0 true continue (deepen seq)]))
     | Real ((m,t),_) ->
 	tclFAIL 0 (Pp.str "not implemented ... yet")
+  end
 
 let instance_tac inst=
   if (snd inst)==dummy_id then
@@ -192,10 +201,10 @@ let instance_tac inst=
   else
     left_instance_tac inst
 
-let quantified_tac lf backtrack continue seq gl=
-  let insts=give_instances lf seq in
+let quantified_tac lf backtrack continue seq =
+  Proofview.Goal.enter begin fun gl ->
+  let insts=give_instances (project gl) lf seq in
     tclORELSE
       (tclFIRST (List.map (fun inst->instance_tac inst continue seq) insts))
-      backtrack gl
-
-
+      backtrack
+  end
diff --git a/plugins/firstorder/instances.mli b/plugins/firstorder/instances.mli
index ce711f3f..61786ffd 100644
--- a/plugins/firstorder/instances.mli
+++ b/plugins/firstorder/instances.mli
@@ -1,17 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Globnames
 open Rules
 
-val collect_quantified : Sequent.t -> Formula.t list * Sequent.t
+val collect_quantified : Evd.evar_map -> Sequent.t -> Formula.t list * Sequent.t
 
-val give_instances : Formula.t list -> Sequent.t ->
+val give_instances : Evd.evar_map -> Formula.t list -> Sequent.t ->
   (Unify.instance * global_reference) list
 
 val quantified_tac : Formula.t list -> seqtac with_backtracking
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index ffb63af0..cfcd6561 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -1,25 +1,31 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Names
-open Term
+open EConstr
 open Vars
-open Tacmach
+open Tacmach.New
 open Tactics
-open Tacticals
+open Tacticals.New
+open Proofview.Notations
 open Termops
 open Formula
 open Sequent
 open Globnames
 open Locus
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
+
+type tactic = unit Proofview.tactic
 
 type seqtac= (Sequent.t -> tactic) -> Sequent.t -> tactic
 
@@ -27,136 +33,157 @@ type lseqtac= global_reference -> seqtac
 
 type 'a with_backtracking = tactic -> 'a
 
-let wrap n b continue seq gls=
+let wrap n b continue seq =
+  Proofview.Goal.nf_enter begin fun gls ->
   Control.check_for_interrupt ();
-  let nc=pf_hyps gls in
+  let nc = Proofview.Goal.hyps gls in
   let env=pf_env gls in
+  let sigma = project gls in
   let rec aux i nc ctx=
     if i<=0 then seq else
       match nc with
-	  []->anomaly (Pp.str "Not the expected number of hyps")
+	  []->anomaly (Pp.str "Not the expected number of hyps.")
 	| nd::q->
-            let id = get_id nd in
-	    if occur_var env id (pf_concl gls) ||
-	      List.exists (occur_var_in_decl env id) ctx then
+            let id = NamedDecl.get_id nd in
+	    if occur_var env sigma id (pf_concl gls) ||
+	      List.exists (occur_var_in_decl env sigma id) ctx then
 		(aux (i-1) q (nd::ctx))
 	    else
-	      add_formula Hyp (VarRef id) (get_type nd) (aux (i-1) q (nd::ctx)) gls in
+	      add_formula env sigma Hyp (VarRef id) (NamedDecl.get_type nd) (aux (i-1) q (nd::ctx)) in
   let seq1=aux n nc [] in
   let seq2=if b then
-    add_formula Concl dummy_id (pf_concl gls) seq1 gls else seq1 in
-    continue seq2 gls
+    add_formula env sigma Concl dummy_id (pf_concl gls) seq1 else seq1 in
+    continue seq2
+  end
 
 let basename_of_global=function
     VarRef id->id
   | _->assert false
 
 let clear_global=function
-    VarRef id-> Proofview.V82.of_tactic (clear [id])
+    VarRef id-> clear [id]
   | _->tclIDTAC
 
 (* connection rules *)
 
-let axiom_tac t seq=
-  try pf_constr_of_global (find_left t seq) (fun c -> Proofview.V82.of_tactic (exact_no_check c))
-  with Not_found->tclFAIL 0 (Pp.str "No axiom link")
+let axiom_tac t seq =
+  Proofview.Goal.enter begin fun gl ->
+  try
+    pf_constr_of_global (find_left (project gl) t seq) >>= fun c ->
+    exact_no_check c
+  with Not_found -> tclFAIL 0 (Pp.str "No axiom link")
+  end
 
-let ll_atom_tac a backtrack id continue seq=
+let ll_atom_tac a backtrack id continue seq =
+  let open EConstr in
   tclIFTHENELSE
-    (try
-      tclTHENLIST
-	[pf_constr_of_global (find_left a seq) (fun left ->
-	  pf_constr_of_global id (fun id -> 
-	    Proofview.V82.of_tactic (generalize [mkApp(id, [|left|])])));
+      (tclTHENLIST
+	[(Proofview.tclEVARMAP >>= fun sigma ->
+          let gr =
+            try Proofview.tclUNIT (find_left sigma a seq)
+            with Not_found -> tclFAIL 0 (Pp.str "No link")
+          in
+          gr >>= fun gr ->
+          pf_constr_of_global gr >>= fun left ->
+	  pf_constr_of_global id >>= fun id -> 
+	    generalize [(mkApp(id, [|left|]))]);
 	 clear_global id;
-	 Proofview.V82.of_tactic intro]
-    with Not_found->tclFAIL 0 (Pp.str "No link"))
+	 intro])
     (wrap 1 false continue seq) backtrack
 
 (* right connectives rules *)
 
 let and_tac backtrack continue seq=
-  tclIFTHENELSE (Proofview.V82.of_tactic simplest_split) (wrap 0 true continue seq) backtrack
+  tclIFTHENELSE simplest_split (wrap 0 true continue seq) backtrack
 
 let or_tac backtrack continue seq=
   tclORELSE
-    (Proofview.V82.of_tactic (any_constructor false (Some (Proofview.V82.tactic (tclCOMPLETE (wrap 0 true continue seq))))))
+    (any_constructor false (Some (tclCOMPLETE (wrap 0 true continue seq))))
     backtrack
 
 let arrow_tac backtrack continue seq=
-  tclIFTHENELSE (Proofview.V82.of_tactic intro) (wrap 1 true continue seq)
+  tclIFTHENELSE intro (wrap 1 true continue seq)
     (tclORELSE
-       (tclTHEN (Proofview.V82.of_tactic introf) (tclCOMPLETE (wrap 1 true continue seq)))
+       (tclTHEN introf (tclCOMPLETE (wrap 1 true continue seq)))
        backtrack)
 (* left connectives rules *)
 
-let left_and_tac ind backtrack id continue seq gls=
- let n=(construct_nhyps ind gls).(0) in
+let left_and_tac ind backtrack id continue seq =
+  Proofview.Goal.enter begin fun gl ->
+  let n=(construct_nhyps (pf_env gl) ind).(0) in
    tclIFTHENELSE
      (tclTHENLIST
-      [Proofview.V82.of_tactic (Tacticals.New.pf_constr_of_global id simplest_elim);
+      [(pf_constr_of_global id >>= simplest_elim);
        clear_global id;
-       tclDO n (Proofview.V82.of_tactic intro)])
+       tclDO n intro])
      (wrap n false continue seq)
-     backtrack gls
+     backtrack
+  end
 
-let left_or_tac ind backtrack id continue seq gls=
-  let v=construct_nhyps ind gls in
+let left_or_tac ind backtrack id continue seq =
+  Proofview.Goal.enter begin fun gl ->
+  let v=construct_nhyps (pf_env gl) ind in
   let f n=
     tclTHENLIST
       [clear_global id;
-       tclDO n (Proofview.V82.of_tactic intro);
+       tclDO n intro;
        wrap n false continue seq] in
     tclIFTHENSVELSE
-      (Proofview.V82.of_tactic (Tacticals.New.pf_constr_of_global id simplest_elim))
+      (pf_constr_of_global id >>= simplest_elim)
       (Array.map f v)
-      backtrack gls
+      backtrack
+  end
 
 let left_false_tac id=
-  Proofview.V82.of_tactic (Tacticals.New.pf_constr_of_global id simplest_elim)
+  Tacticals.New.pf_constr_of_global id >>= simplest_elim
 
 (* left arrow connective rules *)
 
 (* We use this function for false, and, or, exists *)
 
-let ll_ind_tac (ind,u as indu) largs backtrack id continue seq gl=
-     let rcs=ind_hyps 0 indu largs gl in
+let ll_ind_tac (ind,u as indu) largs backtrack id continue seq =
+  Proofview.Goal.enter begin fun gl ->
+     let rcs=ind_hyps (pf_env gl) (project gl) 0 indu largs in
      let vargs=Array.of_list largs in
              (* construire le terme  H->B, le generaliser etc *)
      let myterm idc i=
        let rc=rcs.(i) in
        let p=List.length rc in
+       let u = EInstance.make u in
        let cstr=mkApp ((mkConstructU ((ind,(i+1)),u)),vargs) in
        let vars=Array.init p (fun j->mkRel (p-j)) in
        let capply=mkApp ((lift p cstr),vars) in
        let head=mkApp ((lift p idc),[|capply|]) in
-         it_mkLambda_or_LetIn head rc in
+         EConstr.it_mkLambda_or_LetIn head rc in
        let lp=Array.length rcs in
        let newhyps idc =List.init lp (myterm idc) in
 	 tclIFTHENELSE
 	   (tclTHENLIST
-	      [pf_constr_of_global id (fun idc -> Proofview.V82.of_tactic (generalize (newhyps idc)));
+	      [(pf_constr_of_global id >>= fun idc -> generalize (newhyps idc));
 	       clear_global id;
-	       tclDO lp (Proofview.V82.of_tactic intro)])
-	   (wrap lp false continue seq) backtrack gl
+	       tclDO lp intro])
+	   (wrap lp false continue seq) backtrack
+  end
 
 let ll_arrow_tac a b c backtrack id continue seq=
+  let open EConstr in
+  let open Vars in
   let cc=mkProd(Anonymous,a,(lift 1 b)) in
-  let d idc =mkLambda (Anonymous,b,
+  let d idc = mkLambda (Anonymous,b,
 		  mkApp (idc, [|mkLambda (Anonymous,(lift 1 a),(mkRel 2))|])) in
     tclORELSE
-      (tclTHENS (Proofview.V82.of_tactic (cut c))
+      (tclTHENS (cut c)
 	 [tclTHENLIST
-	    [Proofview.V82.of_tactic introf;
+	    [introf;
 	     clear_global id;
 	     wrap 1 false continue seq];
-	  tclTHENS (Proofview.V82.of_tactic (cut cc))
-            [pf_constr_of_global id (fun c -> Proofview.V82.of_tactic (exact_no_check c));
+	  tclTHENS (cut cc)
+            [(pf_constr_of_global id >>= fun c -> exact_no_check c);
 	     tclTHENLIST
-	       [pf_constr_of_global id (fun idc -> Proofview.V82.of_tactic (generalize [d idc]));
+	       [(pf_constr_of_global id >>= fun idc -> generalize [d idc]);
 		clear_global id;
-		Proofview.V82.of_tactic introf;
-		Proofview.V82.of_tactic introf;
+		introf;
+		introf;
 		tclCOMPLETE (wrap 2 true continue seq)]]])
       backtrack
 
@@ -164,37 +191,40 @@ let ll_arrow_tac a b c backtrack id continue seq=
 
 let forall_tac backtrack continue seq=
   tclORELSE
-    (tclIFTHENELSE (Proofview.V82.of_tactic intro) (wrap 0 true continue seq)
+    (tclIFTHENELSE intro (wrap 0 true continue seq)
        (tclORELSE
-	  (tclTHEN (Proofview.V82.of_tactic introf) (tclCOMPLETE (wrap 0 true continue seq)))
+	  (tclTHEN introf (tclCOMPLETE (wrap 0 true continue seq)))
 	  backtrack))
     (if !qflag then
        tclFAIL 0 (Pp.str "reversible in 1st order mode")
      else
        backtrack)
 
-let left_exists_tac ind backtrack id continue seq gls=
-  let n=(construct_nhyps ind gls).(0) in
+let left_exists_tac ind backtrack id continue seq =
+  Proofview.Goal.enter begin fun gl ->
+  let n=(construct_nhyps (pf_env gl) ind).(0) in
     tclIFTHENELSE
-      (Proofview.V82.of_tactic (Tacticals.New.pf_constr_of_global id simplest_elim))
+      (Tacticals.New.pf_constr_of_global id >>= simplest_elim)
       (tclTHENLIST [clear_global id;
-                    tclDO n (Proofview.V82.of_tactic intro);
+                    tclDO n intro;
                     (wrap (n-1) false continue seq)])
       backtrack
-      gls
+  end
 
 let ll_forall_tac prod backtrack id continue seq=
   tclORELSE
-    (tclTHENS (Proofview.V82.of_tactic (cut prod))
+    (tclTHENS (cut prod)
        [tclTHENLIST
-	  [Proofview.V82.of_tactic intro;
-           pf_constr_of_global id (fun idc ->
-	   (fun gls->
-	      let id0=pf_nth_hyp_id gls 1 in
+	  [intro;
+           (pf_constr_of_global id >>= fun idc ->
+	   Proofview.Goal.enter begin fun gls->
+              let open EConstr in
+	      let id0 = List.nth (pf_ids_of_hyps gls) 0 in
               let term=mkApp(idc,[|mkVar(id0)|]) in
-		tclTHEN (Proofview.V82.of_tactic (generalize [term])) (Proofview.V82.of_tactic (clear [id0])) gls));
+              tclTHEN (generalize [term]) (clear [id0])
+           end);
 	   clear_global id;
-	   Proofview.V82.of_tactic intro;
+	   intro;
 	   tclCOMPLETE (wrap 1 false continue (deepen seq))];
 	tclCOMPLETE (wrap 0 true continue (deepen seq))])
     backtrack
@@ -203,15 +233,17 @@ let ll_forall_tac prod backtrack id continue seq=
 
 (* special for compatibility with old Intuition *)
 
-let constant str = Coqlib.gen_constant "User" ["Init";"Logic"] str
+let constant str = Universes.constr_of_global
+  @@ Coqlib.coq_reference "User" ["Init";"Logic"] str
 
 let defined_connectives=lazy
-  [AllOccurrences,EvalConstRef (fst (destConst (constant "not")));
-   AllOccurrences,EvalConstRef (fst (destConst (constant "iff")))]
+  [AllOccurrences,EvalConstRef (fst (Constr.destConst (constant "not")));
+   AllOccurrences,EvalConstRef (fst (Constr.destConst (constant "iff")))]
 
 let normalize_evaluables=
-  onAllHypsAndConcl
-    (function
-	 None-> Proofview.V82.of_tactic (unfold_in_concl (Lazy.force defined_connectives))
-       | Some id ->
-	   Proofview.V82.of_tactic (unfold_in_hyp (Lazy.force defined_connectives) (id,InHypTypeOnly)))
+  Proofview.Goal.enter begin fun gl ->
+    unfold_in_concl (Lazy.force defined_connectives) <*>
+    tclMAP
+      (fun id -> unfold_in_hyp (Lazy.force defined_connectives) (id,InHypTypeOnly))
+      (pf_ids_of_hyps gl)
+  end
diff --git a/plugins/firstorder/rules.mli b/plugins/firstorder/rules.mli
index 381b7cd8..859388b3 100644
--- a/plugins/firstorder/rules.mli
+++ b/plugins/firstorder/rules.mli
@@ -1,16 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
-open Tacmach
 open Names
+open Constr
+open EConstr
 open Globnames
 
+type tactic = unit Proofview.tactic
+
 type seqtac= (Sequent.t -> tactic) -> Sequent.t -> tactic
 
 type lseqtac= global_reference -> seqtac
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index 1248b60a..28599179 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -1,17 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open CErrors
 open Util
 open Formula
 open Unify
-open Tacmach
 open Globnames
 open Pp
 
@@ -55,13 +56,7 @@ struct
 	(priority e1.pat) - (priority e2.pat)
 end
 
-module OrderedConstr=
-struct
-  type t=constr
-  let compare=constr_ord
-end
-
-type h_item = global_reference * (int*constr) option
+type h_item = global_reference * (int*Constr.t) option
 
 module Hitem=
 struct
@@ -71,23 +66,25 @@ 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)
 
-let cm_add typ nam cm=
+let cm_add sigma typ nam cm=
+  let typ = EConstr.to_constr sigma typ in
   try
     let l=CM.find typ cm in CM.add typ (nam::l) cm
   with
       Not_found->CM.add typ [nam] cm
 
-let cm_remove typ nam cm=
+let cm_remove sigma typ nam cm=
+  let typ = EConstr.to_constr sigma typ in
   try
     let l=CM.find typ cm in
     let l0=List.filter (fun id-> not (Globnames.eq_gr id nam)) l in
@@ -112,19 +109,19 @@ let deepen seq={seq with depth=seq.depth-1}
 
 let record item seq={seq with history=History.add item seq.history}
 
-let lookup item seq=
+let lookup sigma item seq=
   History.mem item seq.history ||
   match item with
       (_,None)->false
-    | (id,Some ((m,t) as c))->
+    | (id,Some (m, t))->
 	let p (id2,o)=
 	  match o with
 	      None -> false
-	    | Some ((m2,t2) as c2)-> Globnames.eq_gr id id2 && m2>m && more_general c2 c in
+	    | Some (m2, t2)-> Globnames.eq_gr id id2 && m2>m && more_general sigma (m2, EConstr.of_constr t2) (m, EConstr.of_constr t) in
 	  History.exists p seq.history
 
-let add_formula side nam t seq gl=
-  match build_formula side nam t gl seq.cnt with
+let add_formula env sigma side nam t seq =
+  match build_formula env sigma side nam t seq.cnt with
       Left f->
 	begin
 	  match side with
@@ -136,7 +133,7 @@ let add_formula side nam t seq gl=
 	    | _ ->
 		{seq with
 		   redexes=HP.add f seq.redexes;
-		   context=cm_add f.constr nam seq.context}
+		   context=cm_add sigma f.constr nam seq.context}
 	end
     | Right t->
 	match side with
@@ -144,18 +141,18 @@ let add_formula side nam t seq gl=
 	      {seq with gl=t;glatom=Some t}
 	  | _ ->
 	      {seq with
-		 context=cm_add t nam seq.context;
+		 context=cm_add sigma t nam seq.context;
 		 latoms=t::seq.latoms}
 
-let re_add_formula_list lf seq=
+let re_add_formula_list sigma lf seq=
   let do_one f cm=
     if f.id == dummy_id then cm
-    else cm_add f.constr f.id cm in
+    else cm_add sigma f.constr f.id cm in
   {seq with
      redexes=List.fold_right HP.add lf seq.redexes;
      context=List.fold_right do_one lf seq.context}
 
-let find_left t seq=List.hd (CM.find t seq.context)
+let find_left sigma t seq=List.hd (CM.find (EConstr.to_constr sigma t) seq.context)
 
 (*let rev_left seq=
   try
@@ -164,7 +161,7 @@ let find_left t seq=List.hd (CM.find t seq.context)
   with Heap.EmptyHeap -> false
 *)
 
-let rec take_formula seq=
+let rec take_formula sigma seq=
   let hd=HP.maximum seq.redexes
   and hp=HP.remove seq.redexes in
     if hd.id == dummy_id then
@@ -172,11 +169,11 @@ let rec take_formula seq=
 	if seq.gl==hd.constr then
 	  hd,nseq
 	else
-	  take_formula nseq (* discarding deprecated goal *)
+	  take_formula sigma nseq (* discarding deprecated goal *)
     else
       hd,{seq with
 	    redexes=hp;
-	    context=cm_remove hd.constr hd.id seq.context}
+	    context=cm_remove sigma hd.constr hd.id seq.context}
 
 let empty_seq depth=
   {redexes=HP.empty;
@@ -196,17 +193,17 @@ let expand_constructor_hints =
     | gr ->
 	[gr])
 
-let extend_with_ref_list l seq gl =
+let extend_with_ref_list env sigma l seq =
   let l = expand_constructor_hints l in
-  let f gr (seq,gl) =
-    let gl, c = pf_eapply Evd.fresh_global gl gr in
-    let typ=(pf_unsafe_type_of gl c) in
-      (add_formula Hyp gr typ seq gl,gl) in
-    List.fold_right f l (seq,gl)
+  let f gr (seq, sigma) =
+    let sigma, c = Evd.fresh_global env sigma gr in
+    let sigma, typ= Typing.type_of env sigma (EConstr.of_constr c) in
+      (add_formula env sigma Hyp gr typ seq, sigma) in
+    List.fold_right f l (seq, sigma)
 
 open Hints
 
-let extend_with_auto_hints l seq gl=
+let extend_with_auto_hints env sigma l seq =
   let seqref=ref seq in
   let f p_a_t =
     match repr_hint p_a_t.code with
@@ -214,9 +211,9 @@ let extend_with_auto_hints l seq gl=
       | Res_pf_THEN_trivial_fail (c,_) ->
           let (c, _, _) = c in
 	  (try
-	     let gr = global_of_constr c in
-	     let typ=(pf_unsafe_type_of gl c) in
-	       seqref:=add_formula Hint gr typ !seqref gl
+	     let (gr, _) = Termops.global_of_constr sigma c in
+	     let typ=(Typing.unsafe_type_of env sigma c) in
+	       seqref:=add_formula env sigma Hint gr typ !seqref
 	   with Not_found->())
       | _-> () in
   let g _ _ l = List.iter f l in
@@ -225,14 +222,14 @@ let extend_with_auto_hints l seq gl=
       try
 	searchtable_map dbname
       with Not_found->
-	error ("Firstorder: "^dbname^" : No such Hint database") in
+	user_err Pp.(str ("Firstorder: "^dbname^" : No such Hint database")) in
       Hint_db.iter g hdb in
     List.iter h l;
-    !seqref, gl (*FIXME: forgetting about universes*)
+    !seqref, sigma (*FIXME: forgetting about universes*)
 
 let print_cmap map=
   let print_entry c l s=
-    let xc=Constrextern.extern_constr false (Global.env ()) Evd.empty c in
+    let xc=Constrextern.extern_constr false (Global.env ()) Evd.empty (EConstr.of_constr c) in
       str "| " ++
       prlist Printer.pr_global l ++
       str " : " ++
diff --git a/plugins/firstorder/sequent.mli b/plugins/firstorder/sequent.mli
index 06c9251e..c4ed3e21 100644
--- a/plugins/firstorder/sequent.mli
+++ b/plugins/firstorder/sequent.mli
@@ -1,28 +1,27 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open Formula
-open Tacmach
 open Globnames
 
-module OrderedConstr: Set.OrderedType with type t=constr
+module CM: CSig.MapS with type key=Constr.t
 
-module CM: CSig.MapS with type key=constr
-
-type h_item = global_reference * (int*constr) option
+type h_item = global_reference * (int*Constr.t) option
 
 module History: Set.S with type elt = h_item
 
-val cm_add : constr -> global_reference -> global_reference list CM.t ->
+val cm_add : Evd.evar_map -> constr -> global_reference -> global_reference list CM.t ->
   global_reference list CM.t
 
-val cm_remove : constr -> global_reference -> global_reference list CM.t ->
+val cm_remove : Evd.evar_map -> constr -> global_reference -> global_reference list CM.t ->
   global_reference list CM.t
 
 module HP: Heap.S with type elt=Formula.t
@@ -40,23 +39,22 @@ val deepen: t -> t
 
 val record: h_item -> t -> t
 
-val lookup: h_item -> t -> bool
+val lookup: Evd.evar_map -> h_item -> t -> bool
 
-val add_formula : side -> global_reference -> constr -> t ->
-  Proof_type.goal sigma -> t
+val add_formula : Environ.env -> Evd.evar_map -> side -> global_reference -> constr -> t -> t
 
-val re_add_formula_list : Formula.t list -> t -> t
+val re_add_formula_list : Evd.evar_map -> Formula.t list -> t -> t
 
-val find_left : constr -> t -> global_reference
+val find_left : Evd.evar_map -> constr -> t -> global_reference
 
-val take_formula : t -> Formula.t * t
+val take_formula : Evd.evar_map -> t -> Formula.t * t
 
 val empty_seq : int -> t
 
-val extend_with_ref_list : global_reference list ->
-  t -> Proof_type.goal sigma -> t * Proof_type.goal sigma
+val extend_with_ref_list : Environ.env -> Evd.evar_map -> global_reference list ->
+  t -> t * Evd.evar_map
 
-val extend_with_auto_hints : Hints.hint_db_name list ->
-  t -> Proof_type.goal sigma -> t * Proof_type.goal sigma
+val extend_with_auto_hints : Environ.env -> Evd.evar_map -> Hints.hint_db_name list ->
+  t -> t * Evd.evar_map
 
-val print_cmap: global_reference list CM.t -> Pp.std_ppcmds
+val print_cmap: global_reference list CM.t -> Pp.t
diff --git a/plugins/firstorder/unify.ml b/plugins/firstorder/unify.ml
index d9ab36ad..b869c04a 100644
--- a/plugins/firstorder/unify.ml
+++ b/plugins/firstorder/unify.ml
@@ -1,13 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Term
+open EConstr
 open Vars
 open Termops
 open Reductionops
@@ -21,7 +24,12 @@ exception UFAIL of constr*constr
    to the equation set. Raises UFAIL with a pair of  terms
 *)
 
-let unif t1 t2=
+let pop t = Vars.lift (-1) t
+let subst_meta subst t =
+  let subst = List.map (fun (m, c) -> (m, EConstr.Unsafe.to_constr c)) subst in
+  EConstr.of_constr (subst_meta subst (EConstr.Unsafe.to_constr t))
+
+let unif evd t1 t2=
   let bige=Queue.create ()
   and sigma=ref [] in
   let bind i t=
@@ -29,7 +37,7 @@ let unif t1 t2=
       (List.map (function (n,tn)->(n,subst_meta [i,t] tn)) !sigma) in
   let rec head_reduce t=
     (* forbids non-sigma-normal meta in head position*)
-    match kind_of_term t with
+    match EConstr.kind evd t with
 	Meta i->
 	  (try
 	     head_reduce (Int.List.assoc i !sigma)
@@ -38,25 +46,25 @@ let unif t1 t2=
     Queue.add (t1,t2) bige;
     try while true do
       let t1,t2=Queue.take bige in
-      let nt1=head_reduce (whd_betaiotazeta Evd.empty t1)
-      and nt2=head_reduce (whd_betaiotazeta Evd.empty t2) in
-	match (kind_of_term nt1),(kind_of_term nt2) with
+      let nt1=head_reduce (whd_betaiotazeta evd t1)
+      and nt2=head_reduce (whd_betaiotazeta evd t2) in
+	match (EConstr.kind evd nt1),(EConstr.kind evd nt2) with
 	    Meta i,Meta j->
 	      if not (Int.equal i j) then
 		if i<j then bind j nt1
 		else bind i nt2
 	  | Meta i,_ ->
 	      let t=subst_meta !sigma nt2 in
-		if Int.Set.is_empty (free_rels t) &&
-		  not (occur_term (mkMeta i) t) then
+		if Int.Set.is_empty (free_rels evd t) &&
+		  not (dependent evd (EConstr.mkMeta i) t) then
 		    bind i t else raise (UFAIL(nt1,nt2))
 	  | _,Meta i ->
 	      let t=subst_meta !sigma nt1 in
-		if Int.Set.is_empty (free_rels t) &&
-		  not (occur_term (mkMeta i) t) then
+		if Int.Set.is_empty (free_rels evd t) &&
+		  not (dependent evd (EConstr.mkMeta i) t) then
 		    bind i t else raise (UFAIL(nt1,nt2))
-	  | Cast(_,_,_),_->Queue.add (strip_outer_cast nt1,nt2) bige
- 	  | _,Cast(_,_,_)->Queue.add (nt1,strip_outer_cast nt2) bige
+	  | Cast(_,_,_),_->Queue.add (strip_outer_cast evd nt1,nt2) bige
+ 	  | _,Cast(_,_,_)->Queue.add (nt1,strip_outer_cast evd nt2) bige
 	  | (Prod(_,a,b),Prod(_,c,d))|(Lambda(_,a,b),Lambda(_,c,d))->
 	      Queue.add (a,c) bige;Queue.add (pop b,pop d) bige
 	  | Case (_,pa,ca,va),Case (_,pb,cb,vb)->
@@ -78,19 +86,19 @@ let unif t1 t2=
 		  for i=0 to l-1 do
 		    Queue.add (va.(i),vb.(i)) bige
 		  done
-	  | _->if not (eq_constr_nounivs nt1 nt2) then raise (UFAIL (nt1,nt2))
+	  | _->if not (eq_constr_nounivs evd nt1 nt2) then raise (UFAIL (nt1,nt2))
     done;
       assert false
 	(* this place is unreachable but needed for the sake of typing *)
     with Queue.Empty-> !sigma
 
-let value i t=
+let value evd i t=
   let add x y=
     if x<0 then y else if y<0 then x else x+y in
   let rec vaux term=
-    if isMeta term && Int.equal (destMeta term) i then 0 else
+    if isMeta evd term && Int.equal (destMeta evd term) i then 0 else
       let f v t=add v (vaux t) in
-      let vr=fold_constr f (-1) term in
+      let vr=EConstr.fold evd f (-1) term in
 	if vr<0 then -1 else vr+1 in
     vaux t
 
@@ -98,11 +106,11 @@ type instance=
     Real of (int*constr)*int
   | Phantom of constr
 
-let mk_rel_inst t=
+let mk_rel_inst evd t=
   let new_rel=ref 1 in
   let rel_env=ref [] in
   let rec renum_rec d t=
-    match kind_of_term t with
+    match EConstr.kind evd t with
 	Meta n->
 	  (try
 	     mkRel (d+(Int.List.assoc n !rel_env))
@@ -111,15 +119,15 @@ let mk_rel_inst t=
 	       incr new_rel;
 	       rel_env:=(n,m) :: !rel_env;
 	       mkRel (m+d))
-      | _ -> map_constr_with_binders succ renum_rec d t
+      | _ -> EConstr.map_with_binders evd succ renum_rec d t
   in
   let nt=renum_rec 0 t in (!new_rel - 1,nt)
 
-let unif_atoms i dom t1 t2=
+let unif_atoms evd i dom t1 t2=
   try
-    let t=Int.List.assoc i (unif t1 t2) in
-      if isMeta t then Some (Phantom dom)
-      else Some (Real(mk_rel_inst t,value i t1))
+    let t=Int.List.assoc i (unif evd t1 t2) in
+      if isMeta evd t then Some (Phantom dom)
+      else Some (Real(mk_rel_inst evd t,value evd i t1))
   with
       UFAIL(_,_) ->None
     | Not_found ->Some (Phantom dom)
@@ -128,11 +136,11 @@ let renum_metas_from k n t= (* requires n = max (free_rels t) *)
   let l=List.init n (fun i->mkMeta (k+i)) in
     substl l t
 
-let more_general (m1,t1) (m2,t2)=
+let more_general evd (m1,t1) (m2,t2)=
   let mt1=renum_metas_from 0 m1 t1
   and mt2=renum_metas_from m1 m2 t2 in
     try
-      let sigma=unif mt1 mt2 in
-      let p (n,t)= n<m1 || isMeta t in
+      let sigma=unif evd mt1 mt2 in
+      let p (n,t)= n<m1 || isMeta evd t in
 	List.for_all p sigma
     with UFAIL(_,_)->false
diff --git a/plugins/firstorder/unify.mli b/plugins/firstorder/unify.mli
index 4fe9ad38..ed35500f 100644
--- a/plugins/firstorder/unify.mli
+++ b/plugins/firstorder/unify.mli
@@ -1,21 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Constr
+open EConstr
 
 exception UFAIL of constr*constr
 
-val unif : constr -> constr -> (int*constr) list
+val unif : Evd.evar_map -> constr -> constr -> (int*constr) list
 
 type instance=
     Real of (int*constr)*int (* nb trous*terme*valeur heuristique *)
   | Phantom of constr        (* domaine de quantification *)
 
-val unif_atoms : metavariable -> constr -> constr -> constr -> instance option
+val unif_atoms : Evd.evar_map -> metavariable -> constr -> constr -> constr -> instance option
 
-val more_general : (int*constr) -> (int*constr) -> bool
+val more_general : Evd.evar_map -> (int*constr) -> (int*constr) -> bool
diff --git a/plugins/fourier/Fourier.v b/plugins/fourier/Fourier.v
index 1d7ee93e..07f32be8 100644
--- a/plugins/fourier/Fourier.v
+++ b/plugins/fourier/Fourier.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* "Fourier's method to solve linear inequations/equations systems.".*)
@@ -13,6 +15,6 @@ Require Export DiscrR.
 Require Export Fourier_util.
 Declare ML Module "fourier_plugin".
 
-Ltac fourier := abstract (fourierz; field; discrR).
+Ltac fourier := abstract (compute [IZR IPR IPR_2] in *; fourierz; field; discrR).
 
 Ltac fourier_eq := apply Rge_antisym; fourier.
diff --git a/plugins/fourier/Fourier_util.v b/plugins/fourier/Fourier_util.v
index d4b0e2e1..d3159698 100644
--- a/plugins/fourier/Fourier_util.v
+++ b/plugins/fourier/Fourier_util.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Rbase.
diff --git a/plugins/fourier/fourier.ml b/plugins/fourier/fourier.ml
index 4919232c..bee2b3b5 100644
--- a/plugins/fourier/fourier.ml
+++ b/plugins/fourier/fourier.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Méthode d'élimination de Fourier *)
diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml
index 51bd3009..b1c003de 100644
--- a/plugins/fourier/fourierR.ml
+++ b/plugins/fourier/fourierR.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
@@ -12,7 +14,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 +29,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};;
@@ -76,15 +74,15 @@ let flin_emult a f =
 type ineq = Rlt | Rle | Rgt | Rge
 
 let string_of_R_constant kn =
-  match Names.repr_con kn with
-    | MPfile dir, sec_dir, id when
+  match Constant.repr3 kn with
+    | ModPath.MPfile dir, sec_dir, id when
 	sec_dir = DirPath.empty &&
 	DirPath.to_string dir = "Coq.Reals.Rdefinitions"
 	-> Label.to_string id
     | _ -> "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 +90,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 +123,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
@@ -190,9 +188,11 @@ type hineq={hname:constr; (* le nom de l'hypothèse *)
 exception NoIneq
 
 let ineq1_of_constr (h,t) =
-    match (kind_of_term t) with
+  let h = EConstr.Unsafe.to_constr h in
+  let t = EConstr.Unsafe.to_constr t in
+    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
@@ -231,7 +231,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"->
@@ -281,14 +281,17 @@ let fourier_lineq lineq1 =
 (* Defined constants *)
 
 let get = Lazy.force
-let constant = Coqlib.gen_constant "Fourier"
+let cget = get
+let eget c = EConstr.of_constr (Lazy.force c)
+let constant path s = Universes.constr_of_global @@
+  Coqlib.coq_reference "Fourier" path s
 
 (* Standard library *)
 open Coqlib
 let coq_sym_eqT = lazy (build_coq_eq_sym ())
-let coq_False = lazy (build_coq_False ())
-let coq_not = lazy (build_coq_not ())
-let coq_eq = lazy (build_coq_eq ())
+let coq_False = lazy (Universes.constr_of_global @@ build_coq_False ())
+let coq_not = lazy (Universes.constr_of_global @@ build_coq_not ())
+let coq_eq = lazy (Universes.constr_of_global @@ build_coq_eq ())
 
 (* Rdefinitions *)
 let constant_real = constant ["Reals";"Rdefinitions"]
@@ -373,6 +376,7 @@ let rational_to_real x =
 (* preuve que 0<n*1/d
 *)
 let tac_zero_inf_pos gl (n,d) =
+  let get = eget in
    let tacn=ref (apply (get coq_Rlt_zero_1)) in
    let tacd=ref (apply (get coq_Rlt_zero_1)) in
    for _i = 1 to n - 1 do
@@ -385,6 +389,7 @@ let tac_zero_inf_pos gl (n,d) =
 (* preuve que 0<=n*1/d
 *)
 let tac_zero_infeq_pos gl (n,d)=
+  let get = eget in
    let tacn=ref (if n=0
                  then (apply (get coq_Rle_zero_zero))
                  else (apply (get coq_Rle_zero_1))) in
@@ -399,7 +404,8 @@ let tac_zero_infeq_pos gl (n,d)=
 (* preuve que 0<(-n)*(1/d) => False
 *)
 let tac_zero_inf_false gl (n,d) =
-    if n=0 then (apply (get coq_Rnot_lt0))
+      let get = eget in
+if n=0 then (apply (get coq_Rnot_lt0))
     else
      (Tacticals.New.tclTHEN (apply (get coq_Rle_not_lt))
 	      (tac_zero_infeq_pos gl (-n,d)))
@@ -408,6 +414,7 @@ let tac_zero_inf_false gl (n,d) =
 (* preuve que 0<=(-n)*(1/d) => False
 *)
 let tac_zero_infeq_false gl (n,d) =
+  let get = eget in
      (Tacticals.New.tclTHEN (apply (get coq_Rlt_not_le_frac_opp))
 	      (tac_zero_inf_pos gl (-n,d)))
 ;;
@@ -415,7 +422,8 @@ let tac_zero_infeq_false gl (n,d) =
 let exact = exact_check;;
 
 let tac_use h =
-  let tac = exact h.hname in
+  let get = eget in
+  let tac = exact (EConstr.of_constr h.hname) in
   match h.htype with
     "Rlt" -> tac
   |"Rle" -> tac
@@ -428,7 +436,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
@@ -459,16 +467,19 @@ exception GoalDone
 
 (* Résolution d'inéquations linéaires dans R *)
 let rec fourier () =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.nf_enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
+    let sigma = Tacmach.New.project gl in
     Coqlib.check_required_library ["Coq";"fourier";"Fourier"];
-    let goal = strip_outer_cast concl in
+    let goal = Termops.strip_outer_cast sigma concl in
+    let goal = EConstr.Unsafe.to_constr goal in
     let fhyp=Id.of_string "new_hyp_for_fourier" in
     (* si le but est une inéquation, on introduit son contraire,
        et le but à prouver devient False *)
     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
 	     "Rlt" ->
 	       (Tacticals.New.tclTHEN
@@ -494,18 +505,18 @@ let rec fourier () =
         |_-> raise GoalDone
      with GoalDone ->
     (* les hypothèses *)
-    let hyps = List.map (fun (h,t)-> (mkVar h,t))
+    let hyps = List.map (fun (h,t)-> (EConstr.mkVar h,t))
                         (list_of_sign (Proofview.Goal.hyps gl)) in
     let lineq =ref [] in
     List.iter (fun h -> try (lineq:=(ineq1_of_constr h)@(!lineq))
 		        with NoIneq -> ())
               hyps;
     (* lineq = les inéquations découlant des hypothèses *)
-    if !lineq=[] then CErrors.error "No inequalities";
+    if !lineq=[] then CErrors.user_err Pp.(str "No inequalities");
     let res=fourier_lineq (!lineq) in
     let tac=ref (Proofview.tclUNIT ()) in
     if res=[]
-    then CErrors.error "fourier failed"
+    then CErrors.user_err Pp.(str "fourier failed")
     (* l'algorithme de Fourier a réussi: on va en tirer une preuve Coq *)
     else (match res with
         [(cres,sres,lc)]->
@@ -547,6 +558,7 @@ let rec fourier () =
 			      !t2 |] in
 	   let tc=rational_to_real cres in
        (* puis sa preuve *)
+          let get = eget in
            let tac1=ref (if h1.hstrict
                          then (Tacticals.New.tclTHENS (apply (get coq_Rfourier_lt))
                                  [tac_use h1;
@@ -583,30 +595,30 @@ let rec fourier () =
                       then tac_zero_inf_false gl (rational_to_fraction cres)
                       else tac_zero_infeq_false gl (rational_to_fraction cres)
            in
-           tac:=(Tacticals.New.tclTHENS (cut ineq)
+           tac:=(Tacticals.New.tclTHENS (cut (EConstr.of_constr ineq))
                      [Tacticals.New.tclTHEN (change_concl
-			       (mkAppL [| get coq_not; ineq|]
-				       ))
+			       (EConstr.of_constr (mkAppL [| cget coq_not; ineq|]
+				       )))
 		      (Tacticals.New.tclTHEN (apply (if sres then get coq_Rnot_lt_lt
 					       else get coq_Rnot_le_le))
 			    (Tacticals.New.tclTHENS (Equality.replace
-				       (mkAppL [|get coq_Rminus;!t2;!t1|]
-					       )
-				       tc)
+				       (EConstr.of_constr (mkAppL [|cget coq_Rminus;!t2;!t1|]
+					       ))
+				       (EConstr.of_constr tc))
 		 	       [tac2;
                                 (Tacticals.New.tclTHENS
 				  (Equality.replace
-				    (mkApp (get coq_Rinv,
-				      [|get coq_R1|]))
+				    (EConstr.of_constr (mkApp (cget coq_Rinv,
+				      [|cget coq_R1|])))
 				    (get coq_R1))
 (* en attendant Field, ça peut aider Ring de remplacer 1/1 par 1 ... *)
 
       			        [Tacticals.New.tclORELSE
                                    (* TODO : Ring.polynom []*) (Proofview.tclUNIT ())
                                    (Proofview.tclUNIT ());
-				 Tacticals.New.pf_constr_of_global (get coq_sym_eqT) (fun symeq ->
+				 Tacticals.New.pf_constr_of_global (cget coq_sym_eqT) >>= fun symeq ->
 					  (Tacticals.New.tclTHEN (apply symeq)
-						(apply (get coq_Rinv_1))))]
+						(apply (get coq_Rinv_1)))]
 
 					 )
 				]));
@@ -619,7 +631,7 @@ let rec fourier () =
 (*    ((tclTHEN !tac (tclFAIL 1 (* 1 au hasard... *))) gl) *)
       !tac
 (*      ((tclABSTRACT None !tac) gl) *)
-  end }
+  end
 ;;
 
 (*
diff --git a/plugins/fourier/g_fourier.ml4 b/plugins/fourier/g_fourier.ml4
index 7c665ae7..44560ac1 100644
--- a/plugins/fourier/g_fourier.ml4
+++ b/plugins/fourier/g_fourier.ml4
@@ -1,13 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
+open Ltac_plugin
 open FourierR
 
 DECLARE PLUGIN "fourier_plugin"
diff --git a/plugins/fourier/vo.itarget b/plugins/fourier/vo.itarget
deleted file mode 100644
index 87d82dac..00000000
--- a/plugins/fourier/vo.itarget
+++ /dev/null
@@ -1,2 +0,0 @@
-Fourier_util.vo
-Fourier.vo
diff --git a/plugins/funind/FunInd.v b/plugins/funind/FunInd.v
new file mode 100644
index 00000000..12458c10
--- /dev/null
+++ b/plugins/funind/FunInd.v
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+Require Coq.extraction.Extraction.
+Declare ML Module "recdef_plugin".
diff --git a/plugins/funind/Recdef.v b/plugins/funind/Recdef.v
index e4433247..d94e62b4 100644
--- a/plugins/funind/Recdef.v
+++ b/plugins/funind/Recdef.v
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+Require Export Coq.funind.FunInd.
 Require Import PeanoNat.
-
 Require Compare_dec.
 Require Wf_nat.
 
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index b0ffc775..d04887a4 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -1,14 +1,14 @@
 open Printer
 open CErrors
 open Util
-open Term
+open Constr
+open EConstr
 open Vars
 open Namegen
 open Names
 open Pp
 open Tacmach
 open Termops
-open Proof_type
 open Tacticals
 open Tactics
 open Indfun_common
@@ -16,6 +16,8 @@ open Libnames
 open Globnames
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* let msgnl = Pp.msgnl *)
 
 (*
@@ -42,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 = 
@@ -93,6 +99,7 @@ let list_chop ?(msg="") n l =
   with Failure (msg') ->
     failwith (msg ^ msg')
 
+let pop t = Vars.lift (-1) t
 
 let make_refl_eq constructor type_of_t t  =
 (*   let refl_equal_term = Lazy.force refl_equal in *)
@@ -101,7 +108,7 @@ let make_refl_eq constructor type_of_t t  =
 
 type pte_info =
     {
-      proving_tac : (Id.t list ->  Tacmach.tactic);
+      proving_tac : (Id.t list -> Tacmach.tactic);
       is_valid : constr -> bool
     }
 
@@ -129,16 +136,16 @@ let refine c =
 
 let thin l = Proofview.V82.of_tactic (Tactics.clear l)
 
-let eq_constr u v = eq_constr_nounivs u v
+let eq_constr sigma u v = EConstr.eq_constr_nounivs sigma u v
 
-let is_trivial_eq t =
+let is_trivial_eq sigma t =
   let res =   try
     begin
-      match kind_of_term t with
-	| App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) ->
-	    eq_constr t1 t2
-	| App(f,[|t1;a1;t2;a2|]) when eq_constr f (jmeq ())  ->
-	    eq_constr t1 t2 && eq_constr a1 a2
+      match EConstr.kind sigma t with
+	| App(f,[|_;t1;t2|]) when eq_constr sigma f (Lazy.force eq) ->
+	    eq_constr sigma t1 t2
+	| App(f,[|t1;a1;t2;a2|]) when eq_constr sigma f (jmeq ())  ->
+	    eq_constr sigma t1 t2 && eq_constr sigma a1 a2
 	| _ -> false
     end
   with e when CErrors.noncritical e -> false
@@ -146,30 +153,30 @@ let is_trivial_eq t =
 (*   observe (str "is_trivial_eq " ++ Printer.pr_lconstr t ++ (if res then str " true" else str " false")); *)
   res
 
-let rec incompatible_constructor_terms t1 t2 =
-  let c1,arg1 = decompose_app t1
-  and c2,arg2 = decompose_app t2
+let rec incompatible_constructor_terms sigma t1 t2 =
+  let c1,arg1 = decompose_app sigma t1
+  and c2,arg2 = decompose_app sigma t2
   in
-  (not (eq_constr t1 t2)) &&
-    isConstruct c1 && isConstruct c2 &&
+  (not (eq_constr sigma t1 t2)) &&
+    isConstruct sigma c1 && isConstruct sigma c2 &&
     (
-      not (eq_constr c1 c2) ||
-	List.exists2 incompatible_constructor_terms arg1 arg2
+      not (eq_constr sigma c1 c2) ||
+	List.exists2 (incompatible_constructor_terms sigma) arg1 arg2
     )
 
-let is_incompatible_eq t =
+let is_incompatible_eq sigma t =
   let res =
     try
-      match kind_of_term t with
-	| App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) ->
-	    incompatible_constructor_terms t1 t2
-	| App(f,[|u1;t1;u2;t2|]) when eq_constr f (jmeq ()) ->
-	    (eq_constr u1 u2 &&
-	       incompatible_constructor_terms t1 t2)
+      match EConstr.kind sigma t with
+	| App(f,[|_;t1;t2|]) when eq_constr sigma f (Lazy.force eq) ->
+	    incompatible_constructor_terms sigma t1 t2
+	| App(f,[|u1;t1;u2;t2|]) when eq_constr sigma f (jmeq ()) ->
+	    (eq_constr sigma u1 u2 &&
+	       incompatible_constructor_terms sigma t1 t2)
 	| _ -> false
     with e when CErrors.noncritical e -> false
   in
-  if res then   observe (str "is_incompatible_eq " ++ Printer.pr_lconstr 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 =
@@ -206,40 +213,41 @@ let prove_trivial_eq h_id context (constructor,type_of_term,term) =
 
 
 
-let find_rectype env c =
-  let (t, l) = decompose_app (Reduction.whd_betaiotazeta env c) in
-  match kind_of_term t with
+let find_rectype env sigma c =
+  let (t, l) = decompose_app sigma (Reductionops.whd_betaiotazeta sigma c) in
+  match EConstr.kind sigma t with
   | Ind ind -> (t, l)
   | Construct _ -> (t,l)
   | _ -> raise Not_found
 
 
-let isAppConstruct ?(env=Global.env ()) t =
+let isAppConstruct ?(env=Global.env ()) sigma t =
   try
-    let t',l = find_rectype (Global.env ()) t in
-    observe (str "isAppConstruct : " ++ Printer.pr_lconstr t ++ str " -> " ++ Printer.pr_lconstr (applist  (t',l)));
+    let t',l = find_rectype env sigma t in
+    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
 
 let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta  *)
-  let clos_norm_flags flgs env sigma t =
-    CClosure.norm_val (CClosure.create_clos_infos flgs env) (CClosure.inject (Reductionops.nf_evar sigma t)) in
-  clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
+  Reductionops.clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
 
 
+exception NoChange
 
-let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
+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_lconstr t  ++ str "    " ++ match t' with None -> str "" | Some t -> Printer.pr_lconstr t );
-      failwith "NoChange";
+      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
-  let eq_constr = Evarconv.e_conv env (ref sigma) in
-  if not (noccurn 1 end_of_type)
+  let eq_constr c1 c2 = Evarconv.e_conv env (ref sigma) c1 c2 in
+  if not (noccurn sigma 1 end_of_type)
   then nochange "dependent"; (* if end_of_type depends on this term we don't touch it  *)
-    if not (isApp t) then nochange "not an equality";
-    let f_eq,args = destApp t in
+    if not (isApp sigma t) then nochange "not an equality";
+    let f_eq,args = destApp sigma t in
     let constructor,t1,t2,t1_typ =
       try
 	if (eq_constr f_eq (Lazy.force eq))
@@ -256,42 +264,42 @@ let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
 	  else nochange "not an equality"
       with e when CErrors.noncritical e -> nochange "not an equality"
     in
-    if not ((closed0 (fst t1)) && (closed0 (snd t1)))then nochange "not a closed lhs";
+    if not ((closed0 sigma (fst t1)) && (closed0 sigma (snd t1)))then nochange "not a closed lhs";
     let rec compute_substitution sub t1 t2 =
 (*       observe (str "compute_substitution : " ++ pr_lconstr t1 ++ str " === " ++ pr_lconstr t2); *)
-      if isRel t2
+      if isRel sigma t2
       then
-	let t2 = destRel t2  in
+	let t2 = destRel sigma t2  in
 	begin
 	  try
 	    let t1' = Int.Map.find t2 sub in
 	    if not (eq_constr t1 t1') then nochange "twice bound variable";
 	    sub
 	  with Not_found ->
-	    assert (closed0 t1);
+	    assert (closed0 sigma t1);
 	    Int.Map.add t2 t1 sub
 	end
-      else if isAppConstruct t1 && isAppConstruct t2
+      else if isAppConstruct sigma t1 && isAppConstruct sigma t2
       then
 	begin
-	  let c1,args1 =  find_rectype env t1
-	  and c2,args2 = find_rectype env t2
+	  let c1,args1 =  find_rectype env sigma t1
+	  and c2,args2 = find_rectype env sigma t2
 	  in
 	  if not (eq_constr c1 c2) then nochange "cannot solve (diff)";
 	  List.fold_left2 compute_substitution sub args1 args2
 	end
       else
-	if (eq_constr t1 t2) then sub else nochange ~t':(make_refl_eq constructor (Reduction.whd_all env t1) t2)  "cannot solve (diff)"
+	if (eq_constr t1 t2) then sub else nochange ~t':(make_refl_eq constructor (Reductionops.whd_all env sigma t1) t2)  "cannot solve (diff)"
     in
     let sub = compute_substitution Int.Map.empty (snd t1) (snd t2) in
     let sub = compute_substitution sub (fst t1) (fst t2) in
-    let end_of_type_with_pop = Termops.pop end_of_type in (*the equation will be removed *)
+    let end_of_type_with_pop = pop end_of_type in (*the equation will be removed *)
     let new_end_of_type =
       (* Ugly hack to prevent Map.fold order change between ocaml-3.08.3 and ocaml-3.08.4
 	 Can be safely replaced by the next comment for Ocaml >= 3.08.4
       *)
       let sub = Int.Map.bindings sub in
-      List.fold_left (fun end_of_type (i,t)  -> lift 1 (substnl  [t] (i-1) end_of_type))
+      List.fold_left (fun end_of_type (i,t)  -> liftn 1 i (substnl  [t] (i-1) end_of_type))
 	end_of_type_with_pop
 	sub
     in
@@ -307,7 +315,7 @@ let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
 	   try
 	     let witness = Int.Map.find i sub in
 	     if is_local_def decl then anomaly (Pp.str "can not redefine a rel!");
-	     (Termops.pop end_of_type,ctxt_size,mkLetIn (get_name decl, witness, get_type decl, witness_fun))
+	     (pop end_of_type,ctxt_size,mkLetIn (RelDecl.get_name decl, witness, RelDecl.get_type decl, witness_fun))
 	   with Not_found  ->
 	     (mkProd_or_LetIn decl end_of_type, ctxt_size + 1, mkLambda_or_LetIn decl witness_fun)
 	)
@@ -316,9 +324,9 @@ let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
 	context
     in
     let new_type_of_hyp =
-      Reductionops.nf_betaiota Evd.empty 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 ctxt_size new_type_of_hyp
+      decompose_prod_n_assum sigma ctxt_size new_type_of_hyp
     in
     let prove_new_hyp : tactic =
       tclTHEN
@@ -351,21 +359,21 @@ let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
     new_ctxt,new_end_of_type,simpl_eq_tac
 
 
-let is_property (ptes_info:ptes_info) t_x full_type_of_hyp =
-  if isApp t_x
+let is_property sigma (ptes_info:ptes_info) t_x full_type_of_hyp =
+  if isApp sigma t_x
   then
-    let pte,args = destApp t_x in
-    if isVar pte && Array.for_all closed0 args
+    let pte,args = destApp sigma t_x in
+    if isVar sigma pte && Array.for_all (closed0 sigma) args
     then
       try
-	let info = Id.Map.find (destVar pte) ptes_info in
+	let info = Id.Map.find (destVar sigma pte) ptes_info in
 	info.is_valid full_type_of_hyp
       with Not_found -> false
     else false
   else false
 
-let isLetIn t =
-  match kind_of_term t with
+let isLetIn sigma t =
+  match EConstr.kind sigma t with
     | LetIn _ -> true
     | _ -> false
 
@@ -385,15 +393,16 @@ let rewrite_until_var arg_num eq_ids : tactic =
      will break the Guard when trying to save the Lemma.
   *)
   let test_var g =
-    let _,args = destApp (pf_concl g) in
-    not ((isConstruct args.(arg_num)) || isAppConstruct args.(arg_num))
+    let sigma = project g in
+    let _,args = destApp sigma (pf_concl g) in
+    not ((isConstruct sigma args.(arg_num)) || isAppConstruct sigma args.(arg_num))
   in
   let rec do_rewrite eq_ids g  =
     if test_var g
     then tclIDTAC g
     else
       match eq_ids with
-	| [] -> anomaly (Pp.str "Cannot find a way to prove recursive property");
+	| [] -> anomaly (Pp.str "Cannot find a way to prove recursive property.");
 	| eq_id::eq_ids ->
 	    tclTHEN
 	      (tclTRY (Proofview.V82.of_tactic (Equality.rewriteRL (mkVar eq_id))))
@@ -405,30 +414,30 @@ let rewrite_until_var arg_num eq_ids : tactic =
 
 let rec_pte_id = Id.of_string "Hrec"
 let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
-  let coq_False = Coqlib.build_coq_False () in
-  let coq_True = Coqlib.build_coq_True () in
-  let coq_I = Coqlib.build_coq_I () in
+  let coq_False = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_False ()) in
+  let coq_True = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_True ()) in
+  let coq_I = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_I ()) in
   let rec scan_type  context type_of_hyp : tactic =
-    if isLetIn type_of_hyp then
+    if isLetIn sigma type_of_hyp then
       let real_type_of_hyp = it_mkProd_or_LetIn type_of_hyp context in
       let reduced_type_of_hyp = nf_betaiotazeta real_type_of_hyp in
       (* length of context didn't change ? *)
       let new_context,new_typ_of_hyp =
-	 decompose_prod_n_assum (List.length context) reduced_type_of_hyp
+	 decompose_prod_n_assum sigma (List.length context) reduced_type_of_hyp
       in
         tclTHENLIST
 	[ h_reduce_with_zeta (Locusops.onHyp hyp_id);
 	  scan_type new_context new_typ_of_hyp ]
-    else if isProd type_of_hyp
+    else if isProd sigma type_of_hyp
     then
       begin
-	let (x,t_x,t') = destProd type_of_hyp in
+	let (x,t_x,t') = destProd sigma type_of_hyp in
 	let actual_real_type_of_hyp = it_mkProd_or_LetIn t' context in
-	if is_property ptes_infos t_x actual_real_type_of_hyp then
+	if is_property sigma ptes_infos t_x actual_real_type_of_hyp then
 	  begin
-	    let pte,pte_args =  (destApp t_x) in
-	    let (* fix_info *) prove_rec_hyp = (Id.Map.find (destVar pte) ptes_infos).proving_tac in
-	    let popped_t' = Termops.pop t' in
+	    let pte,pte_args =  (destApp sigma t_x) in
+	    let (* fix_info *) prove_rec_hyp = (Id.Map.find (destVar sigma pte) ptes_infos).proving_tac in
+	    let popped_t' = pop t' in
 	    let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in
 	    let prove_new_type_of_hyp =
 	      let context_length = List.length context in
@@ -465,20 +474,20 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
 		scan_type context popped_t'
 	      ]
 	  end
-	else if eq_constr t_x coq_False then
+	else if eq_constr sigma t_x coq_False then
 	  begin
 (* 	    observe (str "Removing : "++ Ppconstr.pr_id hyp_id++  *)
 (* 		       str " since it has False in its preconds " *)
 (* 		    ); *)
 	    raise TOREMOVE;  (* False -> .. useless *)
 	  end
-	else if is_incompatible_eq t_x then raise TOREMOVE (* t_x := C1 ... =  C2 ... *)
-	else if eq_constr t_x coq_True  (* Trivial => we remove this precons *)
+	else if is_incompatible_eq sigma t_x then raise TOREMOVE (* t_x := C1 ... =  C2 ... *)
+	else if eq_constr sigma t_x coq_True  (* Trivial => we remove this precons *)
 	then
 (* 	    observe (str "In "++Ppconstr.pr_id hyp_id++  *)
 (* 		       str " removing useless precond True" *)
 (* 		    );  *)
-	  let popped_t' = Termops.pop t' in
+	  let popped_t' = pop t' in
 	  let real_type_of_hyp =
 	    it_mkProd_or_LetIn popped_t' context
 	  in
@@ -504,15 +513,15 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
 	      ((* observe_tac "prove_trivial" *) prove_trivial);
 	    scan_type context popped_t'
 	  ]
-	else if is_trivial_eq t_x
+	else if is_trivial_eq sigma t_x
 	then (*  t_x :=  t = t   => we remove this precond *)
-	  let popped_t' = Termops.pop t' in
+	  let popped_t' = pop t' in
 	  let real_type_of_hyp =
 	    it_mkProd_or_LetIn popped_t' context
 	  in
-	  let hd,args = destApp t_x in
+	  let hd,args = destApp sigma t_x in
 	  let get_args hd args =
-	    if eq_constr hd (Lazy.force eq)
+	    if eq_constr sigma hd (Lazy.force eq)
 	    then (Lazy.force refl_equal,args.(0),args.(1))
 	    else (jmeq_refl (),args.(0),args.(1))
 	  in
@@ -533,7 +542,7 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
 	      tclTHEN
 		tac
 		(scan_type new_context new_t')
-	    with Failure "NoChange" ->
+	    with NoChange ->
 	      (* Last thing todo : push the rel in the context and continue *)
 	      scan_type (LocalAssum (x,t_x) :: context) t'
 	  end
@@ -584,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 [
@@ -595,18 +604,18 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos =
 	   let new_term_value_eq = pf_unsafe_type_of g' (mkVar heq_id) in
 	   (* compute the new value of the body *)
 	   let new_term_value =
-	     match kind_of_term new_term_value_eq with
+	     match EConstr.kind (project g') new_term_value_eq with
 	       | App(f,[| _;_;args2 |]) -> args2
 	       | _ ->
 		   observe (str "cannot compute new term value : " ++ pr_gls g' ++ fnl () ++ str "last hyp is" ++
-			      pr_lconstr_env (pf_env g') Evd.empty new_term_value_eq
+			      pr_leconstr_env (pf_env g') (project g') new_term_value_eq
 			   );
-		   anomaly (Pp.str "cannot compute new term value")
+		   anomaly (Pp.str "cannot compute new term value.")
 	   in
 	 let fun_body =
 	   mkLambda(Anonymous,
 		    pf_unsafe_type_of g' term,
-		    Termops.replace_term term (mkRel 1) dyn_infos.info
+		    Termops.replace_term (project g') term (mkRel 1) dyn_infos.info
 		   )
 	 in
 	 let new_body = pf_nf_betaiota g' (mkApp(fun_body,[| new_term_value |])) in
@@ -683,34 +692,36 @@ let instanciate_hyps_with_args (do_prove:Id.t list -> tactic) hyps args_id =
 
 let build_proof
     (interactive_proof:bool)
-    (fnames:constant list)
+    (fnames:Constant.t list)
     ptes_infos
     dyn_infos
     : 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 kind_of_term dyn_infos.info with
+	match EConstr.kind sigma dyn_infos.info with
 	  | Case(ci,ct,t,cb) ->
 	      let do_finalize_t dyn_info' =
 		fun g ->
 		  let t = dyn_info'.info in
 		  let dyn_infos = {dyn_info' with info =
 		      mkCase(ci,ct,t,cb)} in
-		  let g_nb_prod = nb_prod (pf_concl g) in
+		  let g_nb_prod = nb_prod (project g) (pf_concl g) in
 		  let type_of_term = pf_unsafe_type_of g t in
 		  let term_eq =
 		    make_refl_eq (Lazy.force refl_equal) type_of_term t
 		  in
-		  tclTHENSEQ
+		  tclTHENLIST
 		    [
 		      Proofview.V82.of_tactic (generalize (term_eq::(List.map mkVar dyn_infos.rec_hyps)));
 		      thin dyn_infos.rec_hyps;
 		      Proofview.V82.of_tactic (pattern_option [Locus.AllOccurrencesBut [1],t] None);
 		      (fun g -> observe_tac "toto" (
-			 tclTHENSEQ [Proofview.V82.of_tactic (Simple.case t);
+			 tclTHENLIST [Proofview.V82.of_tactic (Simple.case t);
 				     (fun g' ->
-					let g'_nb_prod = nb_prod (pf_concl g') in
+					let g'_nb_prod = nb_prod (project g') (pf_concl g') in
 					let nb_instanciate_partial = g'_nb_prod - g_nb_prod in
 			 		observe_tac "treat_new_case"
 					  (treat_new_case
@@ -730,7 +741,7 @@ let build_proof
 	      build_proof do_finalize_t {dyn_infos with info = t} g
 	  | Lambda(n,t,b) ->
 	      begin
-		match kind_of_term( pf_concl g) with
+		match EConstr.kind sigma (pf_concl g) with
 		  | Prod _ ->
 		      tclTHEN
 			(Proofview.V82.of_tactic intro)
@@ -760,9 +771,9 @@ let build_proof
 	  | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ ->
 	      do_finalize dyn_infos g
 	  | App(_,_) ->
-	      let f,args = decompose_app dyn_infos.info in
+	      let f,args = decompose_app sigma dyn_infos.info in
 	      begin
-		match kind_of_term f with
+		match EConstr.kind sigma f with
 		  | App _ -> assert false (* we have collected all the app in decompose_app *)
 		  | Proj _ -> assert false (*FIXME*)
 		  | Var _ | Construct _ | Rel _ | Evar _ | Meta _  | Ind _ | Sort _ | Prod _ ->
@@ -784,7 +795,7 @@ let build_proof
 		      do_finalize dyn_infos  g
 		  | Lambda _ ->
 		      let new_term =
-                        Reductionops.nf_beta Evd.empty 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 _ ->
@@ -815,10 +826,11 @@ let build_proof
 		      build_proof new_finalize {dyn_infos  with info = f } g
 	      end
 	  | Fix _ | CoFix _ ->
-	      error ( "Anonymous local (co)fixpoints are not handled yet")
+	      user_err Pp.(str ( "Anonymous local (co)fixpoints are not handled yet"))
+
 
-	  | Proj _ -> error "Prod"
-	  | Prod _ -> error "Prod"
+	  | Proj _ -> user_err Pp.(str "Prod")
+	  | Prod _ -> do_finalize dyn_infos g
 	  | LetIn _ ->
 	      let new_infos =
 		{ dyn_infos with
@@ -833,10 +845,10 @@ let build_proof
 		 h_reduce_with_zeta Locusops.onConcl;
 		 build_proof do_finalize new_infos
 		] g
-	  | Rel _ -> anomaly (Pp.str "Free var in goal conclusion !")
+	  | 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_lconstr 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
@@ -902,7 +914,7 @@ let prove_rec_hyp_for_struct fix_info =
       (fun  eq_hyps -> tclTHEN
 	(rewrite_until_var (fix_info.idx) eq_hyps)
 	(fun g ->
-	   let _,pte_args = destApp (pf_concl g) in
+	   let _,pte_args = destApp (project g) (pf_concl g) in
 	   let rec_hyp_proof =
 	     mkApp(mkVar fix_info.name,array_get_start pte_args)
 	   in
@@ -923,10 +935,11 @@ let generalize_non_dep hyp g =
   let to_revert,_ =
     let open Context.Named.Declaration in
     Environ.fold_named_context_reverse (fun (clear,keep) decl ->
+      let decl = map_named_decl EConstr.of_constr decl in
       let hyp = get_id decl in
       if Id.List.mem hyp hyps
-        || List.exists (Termops.occur_var_in_decl env hyp) keep
-	|| Termops.occur_var env hyp hyp_typ
+        || List.exists (Termops.occur_var_in_decl env (project g) hyp) keep
+	|| Termops.occur_var env (project g) hyp hyp_typ
 	|| Termops.is_section_variable hyp (* should be dangerous *)
       then (clear,decl::keep)
       else (hyp::clear,keep))
@@ -938,8 +951,8 @@ let generalize_non_dep hyp g =
     ((* observe_tac "thin" *) (thin to_revert))
     g
 
-let id_of_decl decl = Nameops.out_name (get_name decl)
-let var_of_decl decl = mkVar (id_of_decl decl)
+let id_of_decl = RelDecl.get_name %> Nameops.Name.get_id
+let var_of_decl = id_of_decl %> mkVar
 let revert idl =
   tclTHEN
     (Proofview.V82.of_tactic (generalize (List.map mkVar idl)))
@@ -949,11 +962,12 @@ let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num
 (*   observe (str "nb_args := " ++ str (string_of_int nb_args)); *)
 (*   observe (str "nb_params := " ++ str (string_of_int nb_params)); *)
 (*   observe (str "rec_args_num := " ++ str (string_of_int (rec_args_num + 1) )); *)
-  let f_def = Global.lookup_constant (fst (destConst f)) in
+  let f_def = Global.lookup_constant (fst (destConst evd f)) in
   let eq_lhs = mkApp(f,Array.init (nb_params + nb_args) (fun i -> mkRel(nb_params + nb_args - i))) in
-  let f_body = Option.get (Global.body_of_constant_body f_def) in
-  let params,f_body_with_params = decompose_lam_n nb_params f_body in
-  let (_,num),(_,_,bodies) = destFix f_body_with_params in
+  let (f_body, _) = Option.get (Global.body_of_constant_body f_def) in
+  let f_body = EConstr.of_constr f_body in
+  let params,f_body_with_params = decompose_lam_n evd nb_params f_body in
+  let (_,num),(_,_,bodies) = destFix evd f_body_with_params in
   let fnames_with_params =
     let params = Array.init nb_params (fun i -> mkRel(nb_params - i)) in
     let fnames = List.rev (Array.to_list (Array.map (fun f -> mkApp(f,params)) fnames)) in
@@ -968,20 +982,20 @@ let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num
   let (type_ctxt,type_of_f),evd =
     let evd,t = Typing.type_of ~refresh:true (Global.env ()) evd f
     in 
-    decompose_prod_n_assum
+    decompose_prod_n_assum evd
       (nb_params + nb_args) t,evd
   in
   let eqn = mkApp(Lazy.force eq,[|type_of_f;eq_lhs;eq_rhs|]) in
   let lemma_type = it_mkProd_or_LetIn eqn type_ctxt in
   (* Pp.msgnl (str "lemma type " ++ Printer.pr_lconstr lemma_type ++ fnl () ++ str "f_body " ++ Printer.pr_lconstr f_body); *)
-  let f_id = Label.to_id (con_label (fst (destConst f))) in
+  let f_id = Label.to_id (Constant.label (fst (destConst evd f))) in
   let prove_replacement =
-    tclTHENSEQ
+    tclTHENLIST
       [
 	tclDO (nb_params + rec_args_num + 1) (Proofview.V82.of_tactic intro);
 	observe_tac "" (fun g ->
 	   let rec_id = pf_nth_hyp_id g 1 in
-	   tclTHENSEQ
+	   tclTHENLIST
 	     [observe_tac "generalize_non_dep in generate_equation_lemma" (generalize_non_dep rec_id);
 	      observe_tac "h_case" (Proofview.V82.of_tactic (simplest_case (mkVar rec_id)));
 	      (Proofview.V82.of_tactic intros_reflexivity)] g
@@ -1008,10 +1022,10 @@ let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num
 let do_replace (evd:Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num all_funs g =
   let equation_lemma =
     try
-      let finfos = find_Function_infos (fst (destConst f)) (*FIXME*) in
+      let finfos = find_Function_infos (fst (destConst !evd f)) (*FIXME*) in
       mkConst (Option.get finfos.equation_lemma)
     with (Not_found | Option.IsNone as e) ->
-      let f_id = Label.to_id (con_label (fst (destConst f))) in
+      let f_id = Label.to_id (Constant.label (fst (destConst !evd f))) in
       (*i The next call to mk_equation_id is valid since we will construct the lemma
 	Ensures by: obvious
 	i*)
@@ -1020,12 +1034,12 @@ let do_replace (evd:Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num a
       let _ =
 	match e with
 	  | Option.IsNone ->
-	      let finfos = find_Function_infos (fst (destConst f)) in
+	      let finfos = find_Function_infos (fst (destConst !evd f)) in
 	      update_Function
 		{finfos with
 		   equation_lemma = Some (match Nametab.locate (qualid_of_ident equation_lemma_id) with
 					      ConstRef c -> c
-					    | _ -> CErrors.anomaly (Pp.str "Not a constant")
+					    | _ -> CErrors.anomaly (Pp.str "Not a constant.")
 					 )
 		}
 	  | _ -> ()
@@ -1036,11 +1050,12 @@ let do_replace (evd:Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num a
 	  (Global.env ()) !evd
 	  (Constrintern.locate_reference (qualid_of_ident equation_lemma_id))
       in
+      let res = EConstr.of_constr res in
       evd:=evd';                       
       let _ = Typing.e_type_of ~refresh:true (Global.env ()) evd res in 
       res
   in
-  let nb_intro_to_do = nb_prod (pf_concl g) in
+  let nb_intro_to_do = nb_prod (project g) (pf_concl g) in
     tclTHEN
       (tclDO nb_intro_to_do (Proofview.V82.of_tactic intro))
       (
@@ -1059,7 +1074,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
   (* Pp.msgnl (str "princ_type " ++ Printer.pr_lconstr princ_type); *)
   (* Pp.msgnl (str "all_funs "); *)
   (* Array.iter (fun c -> Pp.msgnl (Printer.pr_lconstr c)) all_funs; *)
-    let princ_info = compute_elim_sig princ_type in
+    let princ_info = compute_elim_sig (project g) princ_type in
     let fresh_id =
       let avoid = ref (pf_ids_of_hyps g) in
       (fun na ->
@@ -1072,7 +1087,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	 (Name new_id)
       )
     in
-    let fresh_decl = map_name fresh_id in
+    let fresh_decl = RelDecl.map_name fresh_id in
     let princ_info : elim_scheme =
       { princ_info with
 	  params = List.map fresh_decl princ_info.params;
@@ -1083,16 +1098,16 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
     in
     let get_body const =
       match Global.body_of_constant const with
-	| Some body ->
+	| Some (body, _) ->
 	     Tacred.cbv_norm_flags
 	       (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
 	       (Global.env ())
 	       (Evd.empty)
-	       body
-	| None -> error ( "Cannot define a principle over an axiom ")
+	       (EConstr.of_constr body)
+	| None -> user_err Pp.(str "Cannot define a principle over an axiom ")
     in
     let fbody = get_body fnames.(fun_num) in
-    let f_ctxt,f_body = decompose_lam fbody in
+    let f_ctxt,f_body = decompose_lam (project g) fbody in
     let f_ctxt_length = List.length f_ctxt in
     let diff_params = princ_info.nparams - f_ctxt_length in
     let full_params,princ_params,fbody_with_full_params =
@@ -1119,27 +1134,27 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	)
     in
     observe (str "full_params := " ++
-	       prlist_with_sep spc (fun decl -> Ppconstr.pr_id (Nameops.out_name (get_name decl)))
+	       prlist_with_sep spc (RelDecl.get_name %> Nameops.Name.get_id %> Ppconstr.pr_id)
 	       full_params
 	    );
     observe (str "princ_params := " ++
-	       prlist_with_sep spc (fun decl -> Ppconstr.pr_id (Nameops.out_name (get_name decl)))
+	       prlist_with_sep spc (RelDecl.get_name %> Nameops.Name.get_id %> Ppconstr.pr_id)
 	       princ_params
 	    );
     observe (str "fbody_with_full_params := " ++
-	       pr_lconstr 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
     in
     let fix_offset = List.length princ_params in
     let ptes_to_fix,infos =
-      match kind_of_term fbody_with_full_params with
+      match EConstr.kind (project g) fbody_with_full_params with
 	| Fix((idxs,i),(names,typess,bodies)) ->
 	    let bodies_with_all_params =
 	      Array.map
 		(fun body ->
-		   Reductionops.nf_betaiota Evd.empty
+                   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))
 		)
@@ -1148,14 +1163,14 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	    let info_array =
 	      Array.mapi
 		(fun i types ->
-		   let types = prod_applist types (List.rev_map var_of_decl princ_params) in
+		   let types = prod_applist (project g) types (List.rev_map var_of_decl princ_params) in
 		   { idx = idxs.(i)  - fix_offset;
-		     name = Nameops.out_name (fresh_id names.(i));
+		     name = Nameops.Name.get_id (fresh_id names.(i));
 		     types = types;
 		     offset = fix_offset;
 		     nb_realargs =
 		       List.length
-			 (fst (decompose_lam bodies.(i))) - fix_offset;
+			 (fst (decompose_lam (project g) bodies.(i))) - fix_offset;
 		     body_with_param = bodies_with_all_params.(i);
 		     num_in_block = i
 		   }
@@ -1165,24 +1180,24 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	    let pte_to_fix,rev_info =
 	      List.fold_left_i
 		(fun i (acc_map,acc_info) decl ->
-		   let pte = get_name decl in
+		   let pte = RelDecl.get_name decl in
 		   let infos = info_array.(i) in
-		   let type_args,_ = decompose_prod infos.types in
+		   let type_args,_ = decompose_prod (project g) infos.types in
 		   let nargs = List.length type_args in
 		   let f = applist(mkConst fnames.(i), List.rev_map var_of_decl princ_info.params) in
 		   let first_args = Array.init nargs (fun i -> mkRel (nargs -i)) in
 		   let app_f = mkApp(f,first_args) in
 		   let pte_args = (Array.to_list first_args)@[app_f] in
-		   let app_pte = applist(mkVar (Nameops.out_name pte),pte_args) in
+		   let app_pte = applist(mkVar (Nameops.Name.get_id pte),pte_args) in
 		   let body_with_param,num =
 		     let body = get_body fnames.(i) in
 		     let body_with_full_params =
-		       Reductionops.nf_betaiota Evd.empty (
+                       Reductionops.nf_betaiota (pf_env g) (project g) (
 			 applist(body,List.rev_map var_of_decl full_params))
 		     in
-		     match kind_of_term body_with_full_params with
+		     match EConstr.kind (project g) body_with_full_params with
 		       | Fix((_,num),(_,_,bs)) ->
-			       Reductionops.nf_betaiota Evd.empty
+                               Reductionops.nf_betaiota (pf_env g) (project g)
 				 (
 				   (applist
 				      (substl
@@ -1191,7 +1206,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 					 bs.(num),
 				       List.rev_map var_of_decl princ_params))
 				 ),num
-			 | _ -> error "Not a mutual block"
+			 | _ -> user_err Pp.(str "Not a mutual block")
 		   in
 		   let info =
 		     {infos with
@@ -1200,9 +1215,9 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 			 num_in_block = num
 		     }
 		   in
-(* 		   observe (str "binding " ++ Ppconstr.pr_id (Nameops.out_name pte) ++  *)
+(* 		   observe (str "binding " ++ Ppconstr.pr_id (Nameops.Name.get_id pte) ++  *)
 (* 			      str " to " ++ Ppconstr.pr_id info.name); *)
-		   (Id.Map.add (Nameops.out_name pte) info acc_map,info::acc_info)
+		   (Id.Map.add (Nameops.Name.get_id pte) info acc_map,info::acc_info)
 		   )
 		0
 		(Id.Map.empty,[])
@@ -1215,7 +1230,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
     let mk_fixes : tactic =
       let pre_info,infos = list_chop fun_num infos in
       match pre_info,infos with
-	| [],[] -> tclIDTAC
+	| _,[] -> tclIDTAC
 	| _, this_fix_info::others_infos ->
 	    let other_fix_infos =
 	      List.map
@@ -1231,10 +1246,9 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	    else
 	      Proofview.V82.of_tactic (Tactics.mutual_fix this_fix_info.name (this_fix_info.idx + 1)
 		other_fix_infos 0)
-	| _ -> anomaly (Pp.str "Not a valid information")
     in
     let first_tac : tactic = (* every operations until fix creations *)
-      tclTHENSEQ
+      tclTHENLIST
 	[ observe_tac "introducing params" (Proofview.V82.of_tactic (intros_using (List.rev_map id_of_decl princ_info.params)));
 	  observe_tac "introducing predictes" (Proofview.V82.of_tactic (intros_using (List.rev_map id_of_decl princ_info.predicates)));
 	  observe_tac "introducing branches" (Proofview.V82.of_tactic (intros_using (List.rev_map id_of_decl princ_info.branches)));
@@ -1243,16 +1257,16 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
     in
     let intros_after_fixes : tactic =
       fun gl ->
-	let ctxt,pte_app =  (decompose_prod_assum (pf_concl gl)) in
-	let pte,pte_args = (decompose_app pte_app) in
+	let ctxt,pte_app =  (decompose_prod_assum (project gl) (pf_concl gl)) in
+	let pte,pte_args = (decompose_app (project gl) pte_app) in
 	try
 	  let pte =
-            try destVar pte
-            with DestKO -> anomaly (Pp.str "Property is not a variable")
+            try destVar (project gl) pte
+            with DestKO -> anomaly (Pp.str "Property is not a variable.")
           in
 	  let fix_info = Id.Map.find  pte ptes_to_fix in
 	  let nb_args = fix_info.nb_realargs in
-	  tclTHENSEQ
+	  tclTHENLIST
 	    [
 	      (* observe_tac ("introducing args") *) (tclDO nb_args (Proofview.V82.of_tactic intro));
 	      (fun g -> (* replacement of the function by its body *)
@@ -1266,18 +1280,18 @@ 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) (project g)
 			 (applist(fix_body,List.rev_map mkVar args_id));
 		     eq_hyps = []
 		   }
 		 in
-		 tclTHENSEQ
+		 tclTHENLIST
 		   [
 		     observe_tac "do_replace"
 		       (do_replace evd
 			  full_params
 			  (fix_info.idx + List.length princ_params)
-			  (args_id@(List.map (fun decl -> Nameops.out_name (get_name decl)) princ_params))
+			  (args_id@(List.map (RelDecl.get_name %> Nameops.Name.get_id) princ_params))
 			  (all_funs.(fix_info.num_in_block))
 			  fix_info.num_in_block
 			  all_funs
@@ -1314,7 +1328,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	    ] gl
 	with Not_found ->
 	  let nb_args = min (princ_info.nargs) (List.length ctxt) in
-	  tclTHENSEQ
+	  tclTHENLIST
 	    [
 	      tclDO nb_args (Proofview.V82.of_tactic intro);
 	      (fun g -> (* replacement of the function by its body *)
@@ -1326,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)
@@ -1334,8 +1348,8 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 		     eq_hyps = []
 		   }
 		 in
-		 let fname = destConst (fst (decompose_app (List.hd (List.rev pte_args)))) in
-		 tclTHENSEQ
+		 let fname = destConst (project g) (fst (decompose_app (project g) (List.hd (List.rev pte_args)))) in
+		 tclTHENLIST
 		   [Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalConstRef (fst fname))]);
 		    let do_prove =
 		      build_proof
@@ -1375,7 +1389,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 
 
 (* Proof of principles of general functions *)
-(* let  hrec_id =

+(* let  hrec_id = Recdef.hrec_id *)
 (* and acc_inv_id = Recdef.acc_inv_id *)
 (* and ltof_ref = Recdef.ltof_ref *)
 (* and acc_rel = Recdef.acc_rel *)
@@ -1389,12 +1403,12 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 
 let prove_with_tcc tcc_lemma_constr eqs : tactic =
   match !tcc_lemma_constr with
-    | None -> anomaly (Pp.str "No tcc proof !!")
-    | Some lemma ->
+  | Undefined -> anomaly (Pp.str "No tcc proof !!")
+  | Value lemma ->
 	fun gls ->
 (* 	  let hid = next_ident_away_in_goal h_id (pf_ids_of_hyps gls) in *)
 (* 	  let ids = hid::pf_ids_of_hyps gls in  *)
-	  tclTHENSEQ
+	  tclTHENLIST
 	    [
 (* 	      generalize [lemma]; *)
 (* 	      h_intro hid; *)
@@ -1408,7 +1422,7 @@ let prove_with_tcc tcc_lemma_constr eqs : tactic =
 	      Proofview.V82.of_tactic (Eauto.gen_eauto (false,5) [] (Some []))
 	    ]
 	    gls
-
+  | Not_needed -> tclIDTAC
 
 let backtrack_eqs_until_hrec hrec eqs : tactic =
   fun gls ->
@@ -1416,14 +1430,14 @@ let backtrack_eqs_until_hrec hrec eqs : tactic =
     let rewrite =
       tclFIRST (List.map (fun x -> Proofview.V82.of_tactic (Equality.rewriteRL x)) eqs )
     in
-    let _,hrec_concl  = decompose_prod (pf_unsafe_type_of gls (mkVar hrec)) in
-    let f_app = Array.last (snd (destApp hrec_concl)) in
-    let f =  (fst (destApp f_app)) in
+    let _,hrec_concl  = decompose_prod (project gls) (pf_unsafe_type_of gls (mkVar hrec)) in
+    let f_app = Array.last (snd (destApp (project gls) hrec_concl)) in
+    let f =  (fst (destApp (project gls) f_app)) in
     let rec backtrack : tactic =
       fun g ->
-	let f_app = Array.last (snd (destApp (pf_concl g))) in
-	match kind_of_term f_app with
-	  | App(f',_) when eq_constr f' f -> tclIDTAC g
+	let f_app = Array.last (snd (destApp (project g) (pf_concl g))) in
+	match EConstr.kind (project g) f_app with
+	  | App(f',_) when eq_constr (project g) f' f -> tclIDTAC g
 	  | _ -> tclTHEN rewrite backtrack g
     in
     backtrack gls
@@ -1449,13 +1463,13 @@ let rec rewrite_eqs_in_eqs eqs =
 
 let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : tactic =
   fun gls ->
-    (tclTHENSEQ
+    (tclTHENLIST
        [
 	 backtrack_eqs_until_hrec hrec eqs;
 	 (* observe_tac ("new_prove_with_tcc ( applying "^(Id.to_string hrec)^" )" ) *)
 	 (tclTHENS  (* We must have exactly ONE subgoal !*)
 	    (Proofview.V82.of_tactic (apply (mkVar hrec)))
-	    [ tclTHENSEQ
+	    [ tclTHENLIST
 		[
 		  (Proofview.V82.of_tactic (keep (tcc_hyps@eqs)));
 		  (Proofview.V82.of_tactic (apply (Lazy.force acc_inv)));
@@ -1474,7 +1488,7 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : tactic =
 			    tclCOMPLETE(
 				    Eauto.eauto_with_bases
 				      (true,5)
-				      [{ Tacexpr.delayed = fun _ sigma -> Sigma.here (Lazy.force refl_equal) sigma}]
+				      [(fun _ sigma -> (sigma, Lazy.force refl_equal))]
 				      [Hints.Hint_db.empty empty_transparent_state false]
 				  )
 			   )
@@ -1487,20 +1501,20 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : tactic =
       gls
 
 
-let is_valid_hypothesis predicates_name =
+let is_valid_hypothesis sigma predicates_name =
   let predicates_name = List.fold_right Id.Set.add predicates_name Id.Set.empty in
   let is_pte typ =
-    if isApp typ
+    if isApp sigma typ
     then
-      let pte,_ = destApp typ in
-      if isVar pte
-      then Id.Set.mem (destVar pte) predicates_name
+      let pte,_ = destApp sigma typ in
+      if isVar sigma pte
+      then Id.Set.mem (destVar sigma pte) predicates_name
       else false
     else false
   in
   let rec is_valid_hypothesis typ =
     is_pte typ ||
-      match kind_of_term typ with
+      match EConstr.kind sigma typ with
 	| Prod(_,pte,typ') -> is_pte pte && is_valid_hypothesis typ'
 	| _ -> false
   in
@@ -1510,7 +1524,7 @@ let prove_principle_for_gen
     (f_ref,functional_ref,eq_ref) tcc_lemma_ref is_mes
     rec_arg_num rec_arg_type relation gl =
   let princ_type = pf_concl gl in
-  let princ_info = compute_elim_sig princ_type in
+  let princ_info = compute_elim_sig (project gl) princ_type in
   let fresh_id =
     let avoid = ref (pf_ids_of_hyps gl) in
     fun na ->
@@ -1556,17 +1570,17 @@ let prove_principle_for_gen
       | _ -> assert false
   in
 (*   observe (str "rec_arg_id := " ++ pr_lconstr (mkVar rec_arg_id)); *)
-  let subst_constrs = List.map (fun decl -> mkVar (Nameops.out_name (get_name decl))) (pre_rec_arg@princ_info.params) in
+  let subst_constrs = List.map (get_name %> Nameops.Name.get_id %> mkVar) (pre_rec_arg@princ_info.params) in
   let relation = substl subst_constrs relation in
   let input_type = substl subst_constrs rec_arg_type in
-  let wf_thm_id = Nameops.out_name (fresh_id (Name (Id.of_string "wf_R"))) in
+  let wf_thm_id = Nameops.Name.get_id (fresh_id (Name (Id.of_string "wf_R"))) in
   let acc_rec_arg_id =
-    Nameops.out_name (fresh_id (Name (Id.of_string ("Acc_"^(Id.to_string rec_arg_id)))))
+    Nameops.Name.get_id (fresh_id (Name (Id.of_string ("Acc_"^(Id.to_string rec_arg_id)))))
   in
   let revert l =
     tclTHEN (Proofview.V82.of_tactic (Tactics.generalize (List.map mkVar l))) (Proofview.V82.of_tactic (clear l))
   in
-  let fix_id = Nameops.out_name (fresh_id (Name hrec_id)) in
+  let fix_id = Nameops.Name.get_id (fresh_id (Name hrec_id)) in
   let prove_rec_arg_acc g =
       ((* observe_tac "prove_rec_arg_acc"  *)
 	 (tclCOMPLETE
@@ -1584,11 +1598,12 @@ let prove_principle_for_gen
       )
       g
   in
-  let args_ids = List.map (fun decl -> Nameops.out_name (get_name decl)) princ_info.args in
+  let args_ids = List.map (get_name %> Nameops.Name.get_id) princ_info.args in
   let lemma =
     match !tcc_lemma_ref with
-     | None -> error "No tcc proof !!"
-     | Some lemma -> lemma
+     | Undefined -> user_err Pp.(str "No tcc proof !!")
+     | Value lemma -> EConstr.of_constr lemma
+     | Not_needed -> EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_I ())
   in
 (*   let rec list_diff del_list check_list = *)
 (*     match del_list with *)
@@ -1606,9 +1621,9 @@ let prove_principle_for_gen
       let hid =
 	next_ident_away_in_goal
 	  (Id.of_string "prov")
-	  hyps
+	  (Id.Set.of_list hyps)
       in
-      tclTHENSEQ
+      tclTHENLIST
 	[
 	  Proofview.V82.of_tactic (generalize [lemma]);
 	  Proofview.V82.of_tactic (Simple.intro hid);
@@ -1627,11 +1642,11 @@ let prove_principle_for_gen
 	  ]
 	  gls
   in
-  tclTHENSEQ
+  tclTHENLIST
     [
       observe_tac "start_tac" start_tac;
       h_intros
-	(List.rev_map (fun decl -> Nameops.out_name (get_name decl))
+	(List.rev_map (get_name %> Nameops.Name.get_id)
 	   (princ_info.args@princ_info.branches@princ_info.predicates@princ_info.params)
 	);
       (* observe_tac "" *) Proofview.V82.of_tactic (assert_by
@@ -1648,7 +1663,7 @@ let prove_principle_for_gen
       Proofview.V82.of_tactic (Equality.rewriteLR (mkConst eq_ref));
       (* observe_tac "finish" *) (fun gl' ->
 	 let body =
-	   let _,args = destApp (pf_concl gl') in
+	   let _,args = destApp (project gl') (pf_concl gl') in
 	   Array.last args
 	 in
 	 let body_info rec_hyps =
@@ -1669,14 +1684,14 @@ let prove_principle_for_gen
 	 in
 	 let acc_inv = lazy (mkApp(Lazy.force acc_inv, [|mkVar  acc_rec_arg_id|])) in
 	 let predicates_names =
-	   List.map (fun decl -> Nameops.out_name (get_name decl)) princ_info.predicates
+	   List.map (get_name %> Nameops.Name.get_id) princ_info.predicates
 	 in
 	 let pte_info =
 	   { proving_tac =
 	       (fun eqs ->
 (* 		  msgnl (str "tcc_list := "++ prlist_with_sep spc Ppconstr.pr_id  !tcc_list); *)
-(* 		  msgnl (str "princ_info.args := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.out_name na)) princ_info.args)); *)
-(* 		  msgnl (str "princ_info.params := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.out_name na)) princ_info.params)); *)
+(* 		  msgnl (str "princ_info.args := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.Name.get_id na)) princ_info.args)); *)
+(* 		  msgnl (str "princ_info.params := "++ prlist_with_sep spc Ppconstr.pr_id  (List.map  (fun (na,_,_) -> (Nameops.Name.get_id na)) princ_info.params)); *)
 (* 		  msgnl (str "acc_rec_arg_id := "++  Ppconstr.pr_id acc_rec_arg_id); *)
 (* 		  msgnl (str "eqs := "++ prlist_with_sep spc Ppconstr.pr_id  eqs); *)
 
@@ -1685,13 +1700,13 @@ let prove_principle_for_gen
 		       is_mes acc_inv fix_id
 
 		       (!tcc_list@(List.map
-			   (fun decl -> (Nameops.out_name (get_name decl)))
+			   (get_name %> Nameops.Name.get_id)
 			   (princ_info.args@princ_info.params)
 			)@ ([acc_rec_arg_id])) eqs
 		    )
 
 	       );
-	     is_valid = is_valid_hypothesis predicates_names
+	     is_valid = is_valid_hypothesis (project gl') predicates_names
 	   }
 	 in
 	 let ptes_info : pte_info Id.Map.t =
@@ -1714,7 +1729,7 @@ let prove_principle_for_gen
 	 (* observe_tac "instanciate_hyps_with_args"  *)
 	   (instanciate_hyps_with_args
 	      make_proof
-	      (List.map (fun decl -> Nameops.out_name (get_name decl)) princ_info.branches)
+	      (List.map (get_name %> Nameops.Name.get_id) princ_info.branches)
 	      (List.rev args_ids)
 	   )
 	   gl'
diff --git a/plugins/funind/functional_principles_proofs.mli b/plugins/funind/functional_principles_proofs.mli
index 34ce6696..64fbfaee 100644
--- a/plugins/funind/functional_principles_proofs.mli
+++ b/plugins/funind/functional_principles_proofs.mli
@@ -1,19 +1,18 @@
 open Names
-open Term
 
 val prove_princ_for_struct :
   Evd.evar_map ref ->
   bool ->
-  int -> constant array -> constr array -> int -> Tacmach.tactic
+  int -> Constant.t array -> EConstr.constr array -> int -> Tacmach.tactic
 
 
 val prove_principle_for_gen :
-  constant*constant*constant -> (* name of the function, the functional and the fixpoint equation *)
-  constr option ref -> (* a pointer to the obligation proofs lemma *)
+  Constant.t * Constant.t * Constant.t -> (* name of the function, the functional and the fixpoint equation *)
+  Indfun_common.tcc_lemma_value ref -> (* a pointer to the obligation proofs lemma *)
   bool -> (* is that function uses measure *)
   int -> (* the number of recursive argument *)
-  types -> (* the type of the recursive argument *)
-  constr -> (* the wf relation used to prove the function *)
+  EConstr.types -> (* the type of the recursive argument *)
+  EConstr.constr -> (* the wf relation used to prove the function *)
   Tacmach.tactic
 
 
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 5e72b867..804548ce 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,8 +13,8 @@ open Tactics
 open Context.Rel.Declaration
 open Indfun_common
 open Functional_principles_proofs
-open Misctypes
-open Sigma.Notations
+
+module RelDecl = Context.Rel.Declaration
 
 exception Toberemoved_with_rel of int*constr
 exception Toberemoved
@@ -21,25 +23,28 @@ let observe s =
   if do_observe ()
   then Feedback.msg_debug s
 
+let pop t = Vars.lift (-1) t
+
 (*
    Transform an inductive induction principle into
    a functional one
 *)
 let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
-  let princ_type_info = compute_elim_sig princ_type in
+  let princ_type = EConstr.of_constr princ_type in
+  let princ_type_info = compute_elim_sig Evd.empty princ_type (** FIXME *) in
   let env = Global.env () in
-  let env_with_params = Environ.push_rel_context princ_type_info.params env in
+  let env_with_params = EConstr.push_rel_context princ_type_info.params env in
   let tbl = Hashtbl.create 792 in
-  let rec change_predicates_names (avoid:Id.t list) (predicates:Context.Rel.t)  : Context.Rel.t =
+  let rec change_predicates_names (avoid:Id.t list) (predicates:EConstr.rel_context)  : EConstr.rel_context =
     match predicates with
     | [] -> []
     | 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;
-	   set_name (Name id) decl :: change_predicates_names (id::avoid) predicates
-	| Anonymous -> anomaly (Pp.str "Anonymous property binder "))
+	   RelDecl.set_name (Name id) decl :: change_predicates_names (id::avoid) predicates
+	| Anonymous -> anomaly (Pp.str "Anonymous property binder."))
   in
   let avoid = (Termops.ids_of_context env_with_params ) in
   let princ_type_info =
@@ -51,14 +56,14 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 (*   observe (str "princ_infos : " ++ pr_elim_scheme princ_type_info); *)
   let change_predicate_sort i decl =
     let new_sort = sorts.(i) in
-    let args,_ = decompose_prod (get_type decl) in
+    let args,_ = decompose_prod (EConstr.Unsafe.to_constr (RelDecl.get_type decl)) in
     let real_args =
       if princ_type_info.indarg_in_concl
       then List.tl args
       else args
     in
-    Context.Named.Declaration.LocalAssum (Nameops.out_name (Context.Rel.Declaration.get_name decl),
-                                          compose_prod real_args (mkSort new_sort))
+    Context.Named.Declaration.LocalAssum (Nameops.Name.get_id (Context.Rel.Declaration.get_name decl),
+                                          Term.compose_prod real_args (mkSort new_sort))
   in
   let new_predicates =
     List.map_i
@@ -70,18 +75,19 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
   let rel_as_kn =
     fst (match princ_type_info.indref with
 	   | Some (Globnames.IndRef ind) -> ind
-	   | _ -> error "Not a valid predicate"
+	   | _ -> user_err Pp.(str "Not a valid predicate")
 	)
   in
   let ptes_vars = List.map Context.Named.Declaration.get_id new_predicates in
   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
   let pre_princ =
+    let open EConstr in
     it_mkProd_or_LetIn
       (it_mkProd_or_LetIn
 	 (Option.fold_right
@@ -93,28 +99,31 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
       )
       princ_type_info.branches
   in
+  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
   in
   let dummy_var = mkVar (Id.of_string "________") in
   let mk_replacement c i args =
-    let res = mkApp(rel_to_fun.(i), Array.map Termops.pop (array_get_start args)) in
-    observe (str "replacing " ++ pr_lconstr c ++ str " by "  ++ pr_lconstr res);
+    let res = mkApp(rel_to_fun.(i), Array.map pop (array_get_start args)) in
+    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
@@ -143,13 +152,13 @@ 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
-	    applist(new_f, new_args),
-	    list_union_eq eq_constr binders_to_remove_from_f binders_to_remove
+	    applistc new_f new_args,
+	    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 ++ *)
@@ -165,26 +174,26 @@ 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 (Termops.pop new_b), filter_map (eq_constr (mkRel 1)) Termops.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 Termops.pop binders_to_remove_from_b)
+	       (List.map pop binders_to_remove_from_b)
 	   )
 
        with
 	 | Toberemoved ->
-(* 	    observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+(* 	    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 [dummy_var] 1 b)  in
-	    new_b, List.map Termops.pop binders_to_remove_from_b
+	    new_b, List.map pop binders_to_remove_from_b
 	| Toberemoved_with_rel (n,c) ->
-(* 	    observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+(* 	    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 Termops.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
@@ -194,31 +203,31 @@ 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 (Termops.pop new_b),filter_map (eq_constr (mkRel 1)) Termops.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)
-	      (List.map Termops.pop binders_to_remove_from_b)
+	      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)
 	  )
 
       with
 	| Toberemoved ->
-(* 	    observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+(* 	    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 [dummy_var] 1 b)  in
-	    new_b, List.map Termops.pop binders_to_remove_from_b
+	    new_b, List.map pop binders_to_remove_from_b
 	| Toberemoved_with_rel (n,c) ->
-(* 	    observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+(* 	    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 Termops.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,_ =
@@ -235,20 +244,21 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
                                  | Context.Named.Declaration.LocalDef (id,t,b) -> LocalDef (Name (Hashtbl.find tbl id), t, b))
           	      new_predicates)
     )
-    princ_type_info.params
+    (List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) princ_type_info.params)
 
 
 
 let change_property_sort evd toSort princ princName =
   let open Context.Rel.Declaration in
-  let princ_info = compute_elim_sig princ in
+  let princ = EConstr.of_constr princ in
+  let princ_info = compute_elim_sig evd princ in
   let change_sort_in_predicate decl =
     LocalAssum
     (get_name decl,
-     let args,ty = decompose_prod (get_type decl) in
+     let args,ty = decompose_prod (EConstr.Unsafe.to_constr (get_type decl)) in
      let s = destSort ty in
        Global.add_constraints (Univ.enforce_leq (univ_of_sort toSort) (univ_of_sort s) Univ.Constraint.empty);
-       compose_prod args (mkSort toSort)
+       Term.compose_prod args (mkSort toSort)
     )
   in
   let evd,princName_as_constr =
@@ -264,11 +274,11 @@ let change_property_sort evd toSort princ princName =
     (it_mkLambda_or_LetIn init
        (List.map change_sort_in_predicate princ_info.predicates)
     )
-    princ_info.params
+    (List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) princ_info.params)
 
 let build_functional_principle (evd:Evd.evar_map ref) interactive_proof old_princ_type sorts funs i proof_tac hook =
   (* First we get the type of the old graph principle *)
-  let mutr_nparams = (compute_elim_sig old_princ_type).nparams in
+  let mutr_nparams = (compute_elim_sig !evd (EConstr.of_constr old_princ_type)).nparams in
   (*   let time1 = System.get_time ()  in *)
   let new_principle_type =
     compute_new_princ_type_from_rel
@@ -279,20 +289,21 @@ 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 new_principle_type 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
   begin
     Lemmas.start_proof
       new_princ_name
       (Decl_kinds.Global,Flags.is_universe_polymorphism (),(Decl_kinds.Proof Decl_kinds.Theorem))
       !evd
-      new_principle_type
+      (EConstr.of_constr new_principle_type)
       hook
   ;
     (*       let _tim1 = System.get_time ()  in *)
-      ignore (Pfedit.by  (Proofview.V82.tactic (proof_tac (Array.map mkConstU funs) mutr_nparams)));
+      let map (c, u) = EConstr.mkConstU (c, EConstr.EInstance.make u) in
+      ignore (Pfedit.by  (Proofview.V82.tactic (proof_tac (Array.map map funs) mutr_nparams)));
     (*       let _tim2 =  System.get_time ()  in *)
     (* 	begin *)
     (* 	  let dur1 = System.time_difference tim1 tim2 in *)
@@ -321,8 +332,8 @@ let generate_functional_principle (evd: Evd.evar_map ref)
     match new_princ_name with
       | Some (id) -> id,id
       | None ->
-	  let id_of_f = Label.to_id (con_label (fst f)) in
-	  id_of_f,Indrec.make_elimination_ident id_of_f (family_of_sort type_sort)
+	  let id_of_f = Label.to_id (Constant.label (fst f)) in
+	  id_of_f,Indrec.make_elimination_ident id_of_f (Sorts.family type_sort)
   in
   let names = ref [new_princ_name] in
   let hook =
@@ -331,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' 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
@@ -362,12 +377,12 @@ let generate_functional_principle (evd: Evd.evar_map ref)
     begin
       begin
 	try
-	  let id = Pfedit.get_current_proof_name () in
+	  let id = Proof_global.get_current_proof_name () in
 	  let s = Id.to_string id in
 	  let n = String.length "___________princ_________" in
 	  if String.length s >= n
 	  then if String.equal (String.sub s 0 n) "___________princ_________"
-	  then Pfedit.delete_current_proof ()
+	  then Proof_global.discard_current ()
 	  else ()
 	  else ()
 	with e when CErrors.noncritical e -> ()
@@ -380,17 +395,17 @@ let generate_functional_principle (evd: Evd.evar_map ref)
 exception Not_Rec
 
 let get_funs_constant mp dp =
-  let get_funs_constant const e : (Names.constant*int) array =
-    match kind_of_term ((strip_lam e)) with
+  let get_funs_constant const e : (Names.Constant.t*int) array =
+    match Constr.kind ((strip_lam e)) with
       | Fix((_,(na,_,_))) ->
 	  Array.mapi
 	    (fun i na ->
 	       match na with
 		 | Name id ->
-		     let const = make_con mp dp (Label.of_id id) in
+		     let const = Constant.make3 mp dp (Label.of_id id) in
 		     const,i
 		 | Anonymous ->
-		     anomaly (Pp.str "Anonymous fix")
+		     anomaly (Pp.str "Anonymous fix.")
 	    )
 	    na
       | _ -> [|const,0|]
@@ -398,15 +413,16 @@ let get_funs_constant mp dp =
   function const ->
     let find_constant_body const =
       match Global.body_of_constant const with
-	| Some body ->
+	| Some (body, _) ->
 	    let body = Tacred.cbv_norm_flags
 	      (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
 	      (Global.env ())
 	      (Evd.from_env (Global.env ()))
-	      body
+	      (EConstr.of_constr body)
 	    in
+	    let body = EConstr.Unsafe.to_constr body in
 	    body
-	| None -> error ( "Cannot define a principle over an axiom ")
+	| None -> user_err Pp.(str ( "Cannot define a principle over an axiom "))
     in
     let f = find_constant_body const in
     let l_const = get_funs_constant const f in
@@ -421,8 +437,8 @@ 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)
-	   then error "Not a mutal recursive block"
+	   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
     in
@@ -430,21 +446,21 @@ 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
 		then raise Not_Rec
-		else error "Not a mutal recursive block"
+		else user_err Pp.(str "Not a mutal recursive block")
 	in
 	let first_infos = extract_info true (List.hd l_bodies) in
 	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  error "Not a mutal recursive block"
+	  then  user_err Pp.(str "Not a mutal recursive block")
 	in
 	List.iter check l_bodies
       with Not_Rec -> ()
@@ -454,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
@@ -486,12 +502,12 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
   in
   let _ = evd := sigma in 
   let l_schemes =
-    List.map (Typing.unsafe_type_of env sigma) schemes
+    List.map (EConstr.of_constr %> Typing.unsafe_type_of env sigma %> EConstr.Unsafe.to_constr) schemes
   in
   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
@@ -514,12 +530,12 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
        begin
 	 begin
 	   try
-	     let id = Pfedit.get_current_proof_name () in
+	     let id = Proof_global.get_current_proof_name () in
 	     let s = Id.to_string id in
 	     let n = String.length "___________princ_________" in
 	     if String.length s >= n
 	     then if String.equal (String.sub s 0 n) "___________princ_________"
-		  then Pfedit.delete_current_proof ()
+		  then Proof_global.discard_current ()
 		  else ()
 	     else ()
 	   with e when CErrors.noncritical e -> ()
@@ -555,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
@@ -565,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;
@@ -609,19 +625,22 @@ let build_scheme fas =
 	      try
 		Smartlocate.global_with_alias f
 	      with Not_found ->
-                errorlabstrm "FunInd.build_scheme"
+                user_err ~hdr:"FunInd.build_scheme"
                   (str "Cannot find " ++ Libnames.pr_reference f)
 	    in
-	    let evd',f = Evd.fresh_global (Global.env ()) !evd f_as_constant in
+            let evd',f = Evd.fresh_global (Global.env ()) !evd f_as_constant in
             let _ = evd := evd' in 
-	    let _ = Typing.e_type_of ~refresh:true (Global.env ()) evd f in 
-	    (destConst f,sort)
+	    let _ = Typing.e_type_of ~refresh:true (Global.env ()) evd (EConstr.of_constr f) in 
+            if isConst f
+            then (destConst f,sort)
+            else user_err Pp.(pr_constr_env (Global.env ()) !evd f ++spc () ++ str "should be the named of a globally defined function")
 	 )
 	 fas
 		   ) in
   let bodies_types =
     make_scheme evd pconstants      
   in
+
   List.iter2
     (fun (princ_id,_,_) def_entry ->
        ignore
@@ -641,12 +660,12 @@ let build_case_scheme fa =
 (*   in  *)
   let funs =
     let (_,f,_) = fa in
-    try fst (Universes.unsafe_constr_of_global (Smartlocate.global_with_alias f))
+    try fst (Global.constr_of_global_in_context (Global.env ()) (Smartlocate.global_with_alias f))
     with Not_found ->
-      errorlabstrm "FunInd.build_case_scheme"
+      user_err ~hdr:"FunInd.build_case_scheme"
         (str "Cannot find " ++ Libnames.pr_reference f) in
   let first_fun,u = destConst  funs in
-  let funs_mp,funs_dp,_ = Names.repr_con first_fun in
+  let funs_mp,funs_dp,_ = Constant.repr3 first_fun in
   let first_fun_kn = try fst (find_Function_infos  first_fun).graph_ind with Not_found -> raise No_graph_found in
   let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in
   let this_block_funs = Array.map (fun (c,_) -> (c,u)) this_block_funs_indexes in
@@ -659,15 +678,13 @@ let build_case_scheme fa =
 	 let ind = first_fun_kn,funs_indexes in
 	   (ind,Univ.Instance.empty)(*FIXME*),prop_sort
   in
-  let sigma = Sigma.Unsafe.of_evar_map sigma in
-  let Sigma (scheme, sigma, _) = 
+  let (sigma, scheme) = 
       Indrec.build_case_analysis_scheme_default env sigma ind sf
   in
-  let sigma = Sigma.to_evar_map sigma in
-  let scheme_type =  (Typing.unsafe_type_of env sigma ) scheme in
+  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 3fa2644c..33aeafef 100644
--- a/plugins/funind/functional_principles_types.mli
+++ b/plugins/funind/functional_principles_types.mli
@@ -1,14 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
-open Misctypes
+open Constr
 
 val generate_functional_principle :
   Evd.evar_map ref -> 
@@ -17,7 +18,7 @@ val generate_functional_principle :
   (* induction principle on rel *)
   types ->
   (* *)
-  sorts array option ->
+  Sorts.t array option ->
   (* Name of the new principle *)
   (Id.t) option ->
   (* the compute functions to use   *)
@@ -27,18 +28,13 @@ val generate_functional_principle :
   (* The tactic to use to make the proof w.r
      the number of params
   *)
-  (constr array -> int -> Tacmach.tactic) ->
+  (EConstr.constr array -> int -> Tacmach.tactic) ->
   unit
 
-val compute_new_princ_type_from_rel : constr array -> sorts 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 42e49031..90af20b4 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -1,47 +1,32 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
-(*i camlp4deps: "grammar/grammar.cma" i*)
-open Compat
+open Ltac_plugin
 open Util
-open Term
 open Pp
 open Constrexpr
 open Indfun_common
 open Indfun
 open Genarg
-open Constrarg
+open Stdarg
 open Misctypes
+open Pcoq
 open Pcoq.Prim
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
 
 DECLARE PLUGIN "recdef_plugin"
 
-let pr_binding prc = function
-  | loc, NamedHyp id, c -> hov 1 (Ppconstr.pr_id id ++ str " := " ++ cut () ++ prc c)
-  | loc, AnonHyp n, c -> hov 1 (int n ++ str " := " ++ cut () ++ prc c)
-
-let pr_bindings prc prlc = function
-  | ImplicitBindings l ->
-      brk (1,1) ++ str "with" ++ brk (1,1) ++
-      pr_sequence prc l
-  | ExplicitBindings l ->
-      brk (1,1) ++ str "with" ++ brk (1,1) ++
-        pr_sequence (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
-  | NoBindings -> mt ()
-
-let pr_with_bindings prc prlc (c,bl) =
-  prc c ++ hv 0 (pr_bindings prc prlc bl)
-
 let pr_fun_ind_using  prc prlc _ opt_c =
   match opt_c with
     | None -> mt ()
-    | Some b -> spc () ++ hov 2 (str "using" ++ spc () ++ pr_with_bindings prc prlc b)
+    | Some b -> spc () ++ hov 2 (str "using" ++ spc () ++ Miscprint.pr_with_bindings prc prlc b)
 
 (* Duplication of printing functions because "'a with_bindings" is
    (internally) not uniform in 'a: indeed constr_with_bindings at the
@@ -49,16 +34,12 @@ let pr_fun_ind_using  prc prlc _ opt_c =
    "constr with_bindings"; hence, its printer cannot be polymorphic in
    (prc,prlc)... *)
 
-let pr_with_bindings_typed prc prlc (c,bl) =
-  prc c ++
-  hv 0 (pr_bindings prc prlc bl)
-
 let pr_fun_ind_using_typed prc prlc _ opt_c =
   match opt_c with
     | None -> mt ()
     | Some b ->
-      let (b, _) = Tactics.run_delayed (Global.env ()) Evd.empty b in
-      spc () ++ hov 2 (str "using" ++ spc () ++ pr_with_bindings_typed prc prlc b)
+      let (_, b) = b (Global.env ()) Evd.empty in
+      spc () ++ hov 2 (str "using" ++ spc () ++ Miscprint.pr_with_bindings prc prlc b)
 
 
 ARGUMENT EXTEND fun_ind_using
@@ -80,7 +61,6 @@ TACTIC EXTEND newfuninv
      ]
 END
 
-
 let pr_intro_as_pat _prc _ _ pat =
   match pat with
     | Some pat ->
@@ -88,16 +68,17 @@ let pr_intro_as_pat _prc _ _ pat =
         str"<simple_intropattern>"
     | None -> mt ()
 
-let out_disjunctive = function
-  | loc, IntroAction (IntroOrAndPattern l) -> (loc,l)
-  | _ -> CErrors.error "Disjunctive or conjunctive intro pattern expected."
+let out_disjunctive = CAst.map (function
+  | IntroAction (IntroOrAndPattern l) -> l
+  | _ -> CErrors.user_err Pp.(str "Disjunctive or conjunctive intro pattern expected."))
 
 ARGUMENT EXTEND with_names TYPED AS intropattern_opt PRINTED BY pr_intro_as_pat
 |   [ "as"  simple_intropattern(ipat) ] -> [ Some ipat ]
 | []  ->[ None ]
 END
 
-
+let functional_induction b c x pat =
+  Proofview.V82.tactic (functional_induction true c x (Option.map out_disjunctive pat))
 
 
 TACTIC EXTEND newfunind
@@ -106,9 +87,9 @@ TACTIC EXTEND newfunind
        let c = match cl with
 	 | [] -> assert false
 	 | [c] -> c
-	 | c::cl -> applist(c,cl)
+	 | c::cl -> EConstr.applist(c,cl)
        in
-       Extratactics.onSomeWithHoles (fun x -> Proofview.V82.tactic (functional_induction true c x (Option.map out_disjunctive pat))) princl ]
+       Extratactics.onSomeWithHoles (fun x -> functional_induction true c x pat) princl ]
 END
 (***** debug only ***)
 TACTIC EXTEND snewfunind
@@ -117,9 +98,9 @@ TACTIC EXTEND snewfunind
        let c = match cl with
 	 | [] -> assert false
 	 | [c] -> c
-	 | c::cl -> applist(c,cl)
+	 | c::cl -> EConstr.applist(c,cl)
        in
-       Extratactics.onSomeWithHoles (fun x -> Proofview.V82.tactic (functional_induction false c x (Option.map out_disjunctive pat))) princl ]
+       Extratactics.onSomeWithHoles (fun x -> functional_induction false c x pat) princl ]
 END
 
 
@@ -143,7 +124,7 @@ END
 
 module Gram = Pcoq.Gram
 module Vernac = Pcoq.Vernac_
-module Tactic = Pcoq.Tactic
+module Tactic = Pltac
 
 type function_rec_definition_loc_argtype = (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) Loc.located
 
@@ -157,15 +138,14 @@ GEXTEND Gram
   GLOBAL: function_rec_definition_loc ;
 
   function_rec_definition_loc:
-    [ [ g = Vernac.rec_definition -> !@loc, g ]]
+    [ [ g = Vernac.rec_definition -> Loc.tag ~loc:!@loc g ]]
     ;
 
 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
@@ -175,7 +155,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)
@@ -184,13 +164,13 @@ VERNAC COMMAND EXTEND Function
 END
 
 let pr_fun_scheme_arg (princ_name,fun_name,s) =
-  Nameops.pr_id princ_name ++ str " :=" ++ spc() ++ str "Induction for " ++
+  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
 
 
@@ -227,7 +207,7 @@ VERNAC COMMAND EXTEND NewFunctionalScheme
 		  ;
 		    try Functional_principles_types.build_scheme fas
 		    with Functional_principles_types.No_graph_found ->
-		      CErrors.error ("Cannot generate induction principle(s)")
+		      CErrors.user_err Pp.(str "Cannot generate induction principle(s)")
 		      | e when CErrors.noncritical e ->
 			  let names = List.map (fun (_,na,_) -> na) fas in
 			  warning_error names e
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 52179ae5..04006453 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
@@ -12,6 +12,9 @@ open Util
 open Glob_termops
 open Misctypes
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 let observe strm =
   if do_observe ()
   then Feedback.msg_debug strm
@@ -29,6 +32,14 @@ type binder_type =
 
 type glob_context = (binder_type*glob_constr) list
 
+
+let rec solve_trivial_holes pat_as_term e =
+  match DAst.get pat_as_term, DAst.get e with
+  | GHole _,_ -> e
+  | GApp(fp,argsp),GApp(fe,argse) when glob_constr_eq fp fe ->
+       DAst.make (GApp((solve_trivial_holes fp fe),List.map2 solve_trivial_holes argsp argse))
+  | _,_ -> pat_as_term
+                                              
 (*
    compose_glob_context [(bt_1,n_1,t_1);......] rt returns
    b_1(n_1,t_1,.....,bn(n_k,t_k,rt)) where the b_i's are the
@@ -39,7 +50,7 @@ let compose_glob_context =
     match bt with
       | Lambda n -> mkGLambda(n,t,acc)
       | Prod n -> mkGProd(n,t,acc)
-      | LetIn n -> mkGLetIn(n,t,acc)
+      | LetIn n -> mkGLetIn(n,t,None,acc)
   in
   List.fold_right compose_binder
 
@@ -109,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
@@ -126,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
@@ -171,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
@@ -203,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 =
@@ -223,7 +234,12 @@ let combine_lam n t b =
 		      compose_glob_context b.context b.value )
   }
 
-
+let combine_prod2 n t b =
+  {
+    context = [];
+    value = mkGProd(n, compose_glob_context t.context t.value,
+		      compose_glob_context b.context b.value )
+  }
 
 let combine_prod n t b =
   { context = t.context@((Prod n,t.value)::b.context); value = b.value}
@@ -245,10 +261,10 @@ let mk_result ctxt value avoid =
 **************************************************)
 
 let coq_True_ref =
-  lazy  (Coqlib.gen_reference "" ["Init";"Logic"] "True")
+  lazy  (Coqlib.coq_reference "" ["Init";"Logic"] "True")
 
 let coq_False_ref =
-  lazy  (Coqlib.gen_reference "" ["Init";"Logic"] "False")
+  lazy  (Coqlib.coq_reference "" ["Init";"Logic"] "False")
 
 (*
   [make_discr_match_el \[e1,...en\]] builds match e1,...,en with
@@ -271,10 +287,10 @@ let make_discr_match_el  =
 *)
 let make_discr_match_brl i =
   List.map_i
-    (fun j (_,idl,patl,_) ->
+    (fun j {CAst.v=(idl,patl,_)} -> CAst.make @@
        if Int.equal j i
-       then (Loc.ghost,idl,patl, mkGRef (Lazy.force coq_True_ref))
-       else (Loc.ghost,idl,patl, mkGRef (Lazy.force coq_False_ref))
+       then (idl,patl, mkGRef (Lazy.force coq_True_ref))
+       else (idl,patl, mkGRef (Lazy.force coq_False_ref))
     )
     0
 (*
@@ -333,27 +349,28 @@ let raw_push_named (na,raw_value,raw_typ) env =
   match na with
     | Anonymous -> env
     | Name id ->
-	let value = Option.map (fun x-> fst (Pretyping.understand env (Evd.from_env env) x)) raw_value in
-	let typ,ctx = Pretyping.understand env (Evd.from_env env) ~expected_type:Pretyping.IsType raw_typ in
-        let open Context.Named.Declaration in
-	Environ.push_named (of_tuple (id,value,typ)) env
+        let typ,_ = Pretyping.understand env (Evd.from_env env) ~expected_type:Pretyping.IsType raw_typ in
+        (match raw_value with
+        | None ->
+           EConstr.push_named (NamedDecl.LocalAssum (id,typ)) env
+        | Some value ->
+           EConstr.push_named (NamedDecl.LocalDef (id, value, typ)) env)
 
 
 let add_pat_variables pat typ env : Environ.env =
   let rec add_pat_variables env pat typ  : Environ.env =
-    let open Context.Rel.Declaration in
     observe (str "new rel env := " ++ Printer.pr_rel_context_of env (Evd.from_env env));
 
-    match pat with
-      | PatVar(_,na) -> Environ.push_rel (LocalAssum (na,typ)) env
-      | PatCstr(_,c,patl,na) ->
+    match DAst.get pat with
+      | PatVar na -> Environ.push_rel (RelDecl.LocalAssum (na,typ)) env
+      | PatCstr(c,patl,na) ->
 	  let Inductiveops.IndType(indf,indargs) =
-	    try Inductiveops.find_rectype env (Evd.from_env env) typ
+	    try Inductiveops.find_rectype env (Evd.from_env env) (EConstr.of_constr typ)
 	    with Not_found -> assert false
 	  in
 	  let constructors = Inductiveops.get_constructors env indf in
 	  let constructor : Inductiveops.constructor_summary = List.find (fun cs -> eq_constructor c (fst cs.Inductiveops.cs_cstr)) (Array.to_list constructors) in
-	  let cs_args_types :types list = List.map get_type constructor.Inductiveops.cs_args in
+	  let cs_args_types :types list = List.map RelDecl.get_type constructor.Inductiveops.cs_args in
 	  List.fold_left2 add_pat_variables env patl (List.rev cs_args_types)
   in
   let new_env = add_pat_variables  env pat typ in
@@ -361,21 +378,30 @@ let add_pat_variables pat typ env : Environ.env =
     fst (
       Context.Rel.fold_outside
 	(fun decl (env,ctxt) ->
-         let _,v,t = Context.Rel.Declaration.to_tuple decl in
-	 match Context.Rel.Declaration.get_name decl with
-	   | Anonymous -> assert false
-	   | Name id ->
-	       let new_t =  substl ctxt t in
-	       let new_v = Option.map (substl ctxt) v in
-	       observe (str "for variable " ++ Ppconstr.pr_id id ++  fnl () ++
-			  str "old type := " ++ Printer.pr_lconstr t ++ fnl () ++
-			  str "new type := " ++ Printer.pr_lconstr new_t ++ fnl () ++
-			  Option.fold_right (fun v _ -> str "old value := " ++ Printer.pr_lconstr v ++ fnl ()) v (mt ()) ++
-			  Option.fold_right (fun v _ -> str "new value := " ++ Printer.pr_lconstr v ++ fnl ()) new_v (mt ())
-		       );
-               let open Context.Named.Declaration in
-	       (Environ.push_named (of_tuple (id,new_v,new_t)) env,mkVar id::ctxt)
-      )
+           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_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,[])
     )
@@ -386,31 +412,30 @@ let add_pat_variables pat typ env : Environ.env =
 
 
 
-let rec pattern_to_term_and_type env typ  = function
-  | PatVar(loc,Anonymous) -> assert false
-  | PatVar(loc,Name id) ->
+let rec pattern_to_term_and_type env typ  = DAst.with_val (function
+  | PatVar Anonymous -> assert false
+  | PatVar (Name id) ->
 	mkGVar id
-  | PatCstr(loc,constr,patternl,_) ->
+  | PatCstr(constr,patternl,_) ->
       let cst_narg =
 	Inductiveops.constructor_nallargs_env
 	  (Global.env ())
 	  constr
       in
       let Inductiveops.IndType(indf,indargs) =
-	try Inductiveops.find_rectype env (Evd.from_env env) typ
+	try Inductiveops.find_rectype env (Evd.from_env env) (EConstr.of_constr typ)
 	with Not_found -> assert false
       in
       let constructors = Inductiveops.get_constructors env indf in
       let constructor  = List.find (fun cs -> eq_constructor (fst cs.Inductiveops.cs_cstr) constr) (Array.to_list constructors) in
-      let open Context.Rel.Declaration in
-      let cs_args_types :types list = List.map get_type constructor.Inductiveops.cs_args in
+      let cs_args_types :types list = List.map RelDecl.get_type constructor.Inductiveops.cs_args in
       let _,cstl = Inductiveops.dest_ind_family indf in
       let csta = Array.of_list cstl in
       let implicit_args =
 	Array.to_list
 	  (Array.init
 	     (cst_narg - List.length patternl)
-	     (fun i -> Detyping.detype false [] env (Evd.from_env env) 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 =
@@ -419,6 +444,7 @@ let rec pattern_to_term_and_type env typ  = function
       mkGApp(mkGRef(ConstructRef constr),
 	     implicit_args@patl_as_term
 	    )
+  )
 
 (* [build_entry_lc funnames avoid rt] construct the list (in fact a build_entry_return)
    of constructors corresponding to [rt] when replacing calls to [funnames] by calls to the
@@ -452,13 +478,14 @@ let rec pattern_to_term_and_type env typ  = function
 *)
 
 
-let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
-  observe (str " Entering : " ++ Printer.pr_glob_constr rt);
-  match rt with
-    | GRef _ | GVar _ | GEvar _ | GPatVar _     | GSort _  | GHole _  ->
+let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
+  observe (str " Entering : " ++ Printer.pr_glob_constr_env env rt);
+  let open CAst in
+  match DAst.get rt with
+    | GRef _ | GVar _ | GEvar _ | GPatVar _ | GSort _  | GHole _ ->
 	(* do nothing (except changing type of course) *)
 	mk_result [] rt avoid
-    | GApp(_,_,_) ->
+    | GApp(_,_) ->
 	let f,args = glob_decompose_app rt in
 	let args_res : (glob_constr list) build_entry_return =
 	  List.fold_right (* create the arguments lists of constructors and combine them *)
@@ -470,20 +497,20 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	    (mk_result [] [] avoid)
 	in
 	begin
-	  match f with
+	  match DAst.get f with
 	    | GLambda _  -> 
 		let rec aux t l = 
 		  match l with 
 		    | [] -> t
-		    | u::l -> 
-			match t with 
-			  | GLambda(loc,na,_,nat,b) -> 
-			      GLetIn(Loc.ghost,na,u,aux b l)
+		    | u::l -> DAst.make @@
+			match DAst.get t with 
+			  | GLambda(na,_,nat,b) -> 
+			      GLetIn(na,u,None,aux b l)
 			  | _ -> 
-			      GApp(Loc.ghost,t,l)
+			      GApp(t,l)
 		in
 		build_entry_lc env funnames avoid (aux f args)
-	    | GVar(_,id) when Id.Set.mem id funnames ->
+	    | GVar id when Id.Set.mem id funnames ->
 		(* if we have [f t1 ... tn] with [f]$\in$[fnames]
 		   then we create a fresh variable [res],
 		   add [res] and its "value" (i.e. [res v1 ... vn]) to each
@@ -492,8 +519,8 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 		   The "value" of this branch is then simply [res]
 		*)
 		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) rt_as_constr in
-		let res_raw_type = Detyping.detype false [] env (Evd.from_env env) rt_typ in
+                let rt_typ = Typing.unsafe_type_of env (Evd.from_env env) rt_as_constr 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
@@ -524,7 +551,7 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 		      args_res.result
 		}
 	    | GApp _ -> assert false (* we have collected all the app in [glob_decompose_app] *)
-       	    | GLetIn(_,n,t,b) ->
+	    | GLetIn(n,v,t,b) ->
 		(* if we have [(let x := v in b) t1 ... tn] ,
 		   we discard our work and compute the list of constructor for
 		   [let x = v in (b t1 ... tn)] up to alpha conversion
@@ -533,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
-			    (GVar(Loc.ghost,id))
+			    (DAst.make @@ GVar id)
 			    b
 			in
 			(Name new_id,new_b,new_avoid)
@@ -548,7 +575,7 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 		  env
 		  funnames
 		  avoid
-		  (mkGLetIn(new_n,t,mkGApp(new_b,args)))
+		  (mkGLetIn(new_n,v,t,mkGApp(new_b,args)))
 	    | GCases _  | GIf _ | GLetTuple _ ->
 		(* we have [(match e1, ...., en with ..... end) t1 tn]
 		   we first compute the result from the case and
@@ -556,18 +583,18 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 		*)
 		let f_res = build_entry_lc env funnames args_res.to_avoid f in
 		combine_results combine_app f_res  args_res
-	    | GCast(_,b,_) ->
+	    | GCast(b,_) ->
 		(* for an applied cast we just trash the cast part
 		   and restart the work.
 
 		   WARNING: We need to restart since [b] itself should be an application term
 		*)
 		build_entry_lc env funnames avoid (mkGApp(b,args))
-	    | GRec _ -> error "Not handled GRec"
-	    | GProd _ -> error "Cannot apply a type"
+	    | GRec _ -> user_err Pp.(str "Not handled GRec")
+	    | GProd _ -> user_err Pp.(str "Cannot apply a type")
 	end (* end of the application treatement *)
 
-    | GLambda(_,n,_,t,b) ->
+    | GLambda(n,_,t,b) ->
 	(* we first compute the list of constructor
 	   corresponding to the body of the function,
 	   then the one corresponding to the type
@@ -582,7 +609,7 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	let new_env = raw_push_named (new_n,None,t) env in
 	let b_res = build_entry_lc new_env funnames avoid b in
 	combine_results (combine_lam new_n) t_res b_res
-    | GProd(_,n,_,t,b) ->
+    | GProd(n,_,t,b) ->
 	(* we first compute the list of constructor
 	   corresponding to the body of the function,
 	   then the one corresponding to the type
@@ -591,45 +618,47 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	let t_res = build_entry_lc env funnames avoid t in
 	let new_env = raw_push_named (n,None,t) env in
 	let b_res = build_entry_lc new_env funnames avoid b in
-	combine_results (combine_prod n) t_res b_res
-    | GLetIn(_,n,v,b) ->
+        if List.length t_res.result = 1 && List.length b_res.result = 1
+        then combine_results (combine_prod2 n) t_res b_res
+        else combine_results (combine_prod n) t_res b_res
+    | GLetIn(n,v,typ,b) ->
 	(* we first compute the list of constructor
 	   corresponding to the body of the function,
 	   then the one corresponding to the value [t]
 	   and combine the two result
 	*)
+        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) v_as_constr in
+        let v_type = Typing.unsafe_type_of env (Evd.from_env env) v_as_constr in
 	let new_env =
-          let open Context.Named.Declaration in
 	  match n with
 	      Anonymous -> env
-	    | Name id -> Environ.push_named (of_tuple (id,Some v_as_constr,v_type)) env
+            | Name id -> EConstr.push_named (NamedDecl.LocalDef (id,v_as_constr,v_type)) env
 	in
 	let b_res = build_entry_lc new_env funnames avoid b in
 	combine_results (combine_letin n) v_res b_res
-    | GCases(_,_,_,el,brl) ->
+    | GCases(_,_,el,brl) ->
 	(* we create the discrimination function
 	   and treat the case itself
 	*)
 	let make_discr = make_discr_match brl in
 	build_entry_lc_from_case env funnames make_discr el brl avoid
-    | GIf(_,b,(na,e_option),lhs,rhs) ->
+    | GIf(b,(na,e_option),lhs,rhs) ->
 	let b_as_constr,ctx = Pretyping.understand env (Evd.from_env env) b in
-	let b_typ = Typing.unsafe_type_of env (Evd.from_env env) b_as_constr in
+        let b_typ = Typing.unsafe_type_of env (Evd.from_env env) b_as_constr in
 	let (ind,_) =
 	  try Inductiveops.find_inductive env (Evd.from_env env) b_typ
 	  with Not_found ->
-	    errorlabstrm "" (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")
+	    user_err  (str "Cannot find the inductive associated to " ++
+                               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);
 	let brl =
 	  List.map_i
-	    (fun i x -> (Loc.ghost,[],[case_pats.(i)],x))
+            (fun i x -> CAst.make ([],[case_pats.(i)],x))
 	    0
 	    [lhs;rhs]
 	in
@@ -638,7 +667,7 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	in
 	(* 		Pp.msgnl (str "new case := " ++ Printer.pr_glob_constr match_expr); *)
 	build_entry_lc env funnames avoid match_expr
-    | GLetTuple(_,nal,_,b,e) ->
+    | GLetTuple(nal,_,b,e) ->
 	begin
 	  let nal_as_glob_constr =
 	    List.map
@@ -649,25 +678,23 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	      nal
 	  in
 	  let b_as_constr,ctx = Pretyping.understand env (Evd.from_env env) b in
-	  let b_typ = Typing.unsafe_type_of env (Evd.from_env env) b_as_constr in
+          let b_typ = Typing.unsafe_type_of env (Evd.from_env env) b_as_constr in
 	  let (ind,_) =
 	    try Inductiveops.find_inductive env (Evd.from_env env) b_typ
 	    with Not_found ->
-	      errorlabstrm "" (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")
+	      user_err  (str "Cannot find the inductive associated to " ++
+                                 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);
-	  let br =
-	    (Loc.ghost,[],[case_pats.(0)],e)
-	  in
+          let br = CAst.make ([],[case_pats.(0)],e) in
 	  let match_expr = mkGCases(None,[b,(Anonymous,None)],[br]) in
 	  build_entry_lc env funnames avoid match_expr
 
 	end
-    | GRec _ -> error "Not handled GRec"
-    | GCast(_,b,_) ->
+    | GRec _ -> user_err Pp.(str "Not handled GRec")
+    | GCast(b,_) ->
 	build_entry_lc env funnames  avoid b
 and build_entry_lc_from_case env funname make_discr
     (el:tomatch_tuples)
@@ -696,7 +723,7 @@ and build_entry_lc_from_case env funname make_discr
 	let types =
 	  List.map (fun (case_arg,_) ->
 		      let case_arg_as_constr,ctx = Pretyping.understand env (Evd.from_env env) case_arg in
-		      Typing.unsafe_type_of env (Evd.from_env env) case_arg_as_constr
+                      EConstr.Unsafe.to_constr (Typing.unsafe_type_of env (Evd.from_env env) case_arg_as_constr)
 		   ) el
 	in
 	(****** The next works only if the match is not dependent ****)
@@ -727,7 +754,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
     | [] -> (* computed_branches  *) {result = [];to_avoid = avoid}
     | br::brl' ->
 	(* alpha conversion to prevent name clashes *)
-	let _,idl,patl,return = alpha_br avoid br in
+        let {CAst.v=(idl,patl,return)} = alpha_br avoid br in
 	let new_avoid  = idl@avoid in 	(* for now we can no more use idl as an identifier *)
 	(* building a list of precondition stating that we are not in this branch
 	   (will be used in the following recursive calls)
@@ -743,10 +770,10 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
 		   List.fold_right
 		     (fun id acc ->
 			let typ_of_id =
-			  Typing.unsafe_type_of env_with_pat_ids (Evd.from_env env) (mkVar id)
+			  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))
@@ -791,15 +818,22 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
 	      List.map3
 	      (fun pat e typ_as_constr ->
 		 let this_pat_ids = ids_of_pat pat in
-		 let typ = Detyping.detype false [] new_env (Evd.from_env env) typ_as_constr in
+		 let typ_as_constr = EConstr.of_constr 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 
+                  (* observe (str "those_pattern_preconds" ++ spc () ++ *)
+                  (*            str "pat" ++ spc () ++ pr_glob_constr pat_as_term ++ spc ()++ *)
+                  (*            str "e" ++ spc () ++ pr_glob_constr e ++spc ()++ *)
+                  (*            str "typ_as_constr" ++ spc () ++ pr_lconstr typ_as_constr); *)
 		 List.fold_right
 		   (fun id  acc ->
 		      if Id.Set.mem id this_pat_ids
 		      then (Prod (Name id),
-		      let typ_of_id = Typing.unsafe_type_of new_env (Evd.from_env env) (mkVar id) in
+		      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
@@ -841,37 +875,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 rt1,rt2 with 
-    | GRef(_,r1,_), GRef (_,r2,_) -> Globnames.eq_gr r1 r2
+  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
 (*
@@ -880,28 +922,30 @@ 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
-  match rt with
-    | GProd(_,n,k,t,b) ->
+  let open CAst in
+  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
-	    | GApp(_,(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
-		    | (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
+                        let new_env = EConstr.push_rel (LocalAssum (n,t')) env in
 			let new_b,id_to_exclude =
 			  rebuild_cons new_env
 			    nb_args relname
@@ -913,12 +957,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
-	    | GApp(loc1,GRef(loc2,eq_as_ref,_),[ty;GVar(loc3,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
@@ -932,7 +980,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		    let subst_b =
 		      if is_in_b then b else  replace_var_by_term id rt b
 		    in
-		    let new_env = Environ.push_rel (LocalAssum (n,t')) env in
+                    let new_env = EConstr.push_rel (LocalAssum (n,t')) env in
 		    let new_b,id_to_exclude =
 		      rebuild_cons
 			new_env
@@ -942,51 +990,50 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		    in
 		    mkGProd(n,t,new_b),id_to_exclude
 		  with Continue ->
-		    let jmeq = Globnames.IndRef (fst (destInd (jmeq ()))) in
+		    let jmeq = Globnames.IndRef (fst (EConstr.destInd Evd.empty (jmeq ()))) in
 		    let ty',ctx = Pretyping.understand env (Evd.from_env env) ty in
-		    let ind,args' = Inductive.find_inductive env ty' in
+                    let ind,args' = Inductiveops.find_inductive env Evd.(from_env env) ty' in
 		    let mib,_ = Global.lookup_inductive (fst ind) in
 		    let nparam = mib.Declarations.mind_nparams in
 		    let params,arg' =
 		      ((Util.List.chop nparam args'))
 		    in
-		    let rt_typ =
-		       GApp(Loc.ghost,
-			    GRef (Loc.ghost,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)
-				 p) params)@(Array.to_list
+				 (EConstr.of_constr p)) params)@(Array.to_list
 				      (Array.make
 					 (List.length args' - nparam)
 					 (mkGHole ()))))
 		    in
 		    let eq' =
-		      GApp(loc1,GRef(loc2,jmeq,None),[ty;GVar(loc3,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 sigma = Evd.(from_env env) in
 		    let new_args =
-		      match kind_of_term eq'_as_constr with
+                      match EConstr.kind sigma eq'_as_constr with
 			| App(_,[|_;_;ty;_|]) ->
-			    let ty = Array.to_list (snd (destApp ty)) in
+                            let ty = Array.to_list (snd (EConstr.destApp sigma ty)) in
 			    let ty' = snd (Util.List.chop nparam ty) in
 			    List.fold_left2
 			      (fun acc var_as_constr arg ->
 				 if isRel var_as_constr
 				 then
-                                   let open Context.Rel.Declaration in
-				   let na = get_name (Environ.lookup_rel (destRel var_as_constr) env) in
+				   let na = RelDecl.get_name (Environ.lookup_rel (destRel var_as_constr) env) in
 				   match na with
 				     | Anonymous -> acc
 				     | Name id' ->
-					 (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
@@ -1015,7 +1062,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		    in
 		    let new_env =
 		      let t',ctx = Pretyping.understand env (Evd.from_env env) eq' in
-		      Environ.push_rel (LocalAssum (n,t')) env
+                      EConstr.push_rel (LocalAssum (n,t')) env
 		    in
 		    let new_b,id_to_exclude =
 		      rebuild_cons
@@ -1031,8 +1078,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
 		  *)
-	    | GApp(loc1,GRef(loc2,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 
@@ -1043,7 +1090,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
@@ -1051,9 +1098,9 @@ 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_env = EConstr.push_rel (LocalAssum (n,t')) env in
 		let new_b,id_to_exclude =
 		  rebuild_cons new_env
 		    nb_args relname
@@ -1067,9 +1114,9 @@ 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_env = EConstr.push_rel (LocalAssum (n,t')) env in
 		let new_b,id_to_exclude =
 		  rebuild_cons new_env
 		    nb_args relname
@@ -1082,15 +1129,15 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 			(Id.Set.filter not_free_in_t id_to_exclude)
 		  | _ -> mkGProd(n,t,new_b),Id.Set.filter not_free_in_t id_to_exclude
 	end
-    | GLambda(_,n,k,t,b) ->
+    | GLambda(n,k,t,b) ->
 	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 ->
-		let new_env = Environ.push_rel (LocalAssum (n,t')) env in
+                let new_env = EConstr.push_rel (LocalAssum (n,t')) env in
 		let new_b,id_to_exclude =
 		  rebuild_cons new_env
 		    nb_args relname
@@ -1101,18 +1148,21 @@ 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
-		  GProd(Loc.ghost,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")
+		  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,t,b) ->
+    | GLetIn(n,v,t,b) ->
 	begin
+          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
 	  let evd = Evd.from_ctx ctx in
-	  let type_t' = Typing.unsafe_type_of env evd t' in
+          let type_t' = Typing.unsafe_type_of env evd t' in
+          let t' = EConstr.Unsafe.to_constr t' in
+	  let type_t' = EConstr.Unsafe.to_constr type_t' in
 	  let new_env = Environ.push_rel (LocalDef (n,t',type_t')) env in
 	  let new_b,id_to_exclude =
 	    rebuild_cons new_env
@@ -1122,10 +1172,10 @@ 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)
-	    | _ -> GLetIn(Loc.ghost,n,t,new_b),
+	    | _ -> 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) ->
+    | GLetTuple(nal,(na,rto),t,b) ->
 	assert (Option.is_empty rto);
 	begin
 	  let not_free_in_t id = not (is_free_in id t) in
@@ -1137,7 +1187,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 	      depth t
 	  in
 	  let t',ctx = Pretyping.understand env (Evd.from_env env) new_t in
-	  let new_env = Environ.push_rel (LocalAssum (na,t')) env in
+          let new_env = EConstr.push_rel (LocalAssum (na,t')) env in
 	  let new_b,id_to_exclude =
 	    rebuild_cons new_env
 	      nb_args relname
@@ -1148,7 +1198,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) *)
 (* 	    | _ -> *)
-	  GLetTuple(Loc.ghost,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
@@ -1174,31 +1224,39 @@ 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 = function
+let rec compute_cst_params relnames params gt = DAst.with_val (function
   | GRef _ | GVar _ | GEvar _ | GPatVar _ -> params
-  | GApp(_,GVar(_,relname'),rtl) when Id.Set.mem relname' relnames ->
-      compute_cst_params_from_app [] (params,rtl)
-  | GApp(_,f,args) ->
+  | 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)
-  | GLambda(_,_,_,t,b) | GProd(_,_,_,t,b) | GLetIn(_,_,t,b) | GLetTuple(_,_,_,t,b) ->
+    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
+  | GLetIn(_,v,t,b) ->
+      let v_params = compute_cst_params relnames params v in
+      let t_params = Option.fold_left (compute_cst_params relnames) v_params t in
+      compute_cst_params relnames t_params b
   | GCases _ ->
       params  (* If there is still cases at this point they can only be
 		 discrimination ones *)
   | GSort _ -> params
   | GHole _ -> params
   | GIf _ | GRec _ | GCast _ ->
-      raise (UserError("compute_cst_params", str "Not handled case"))
+      raise (UserError(Some "compute_cst_params", str "Not handled case"))
+  ) 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,_,is_defined) as param)::params',(GVar(_,id'))::rtl'
-	when Id.compare id id' == 0 && not is_defined ->
+    | ((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
 
-let compute_params_name relnames (args : (Name.t * Glob_term.glob_constr * bool) list array) csts =
+let compute_params_name relnames (args : (Name.t * Glob_term.glob_constr * glob_constr option) list array) csts =
   let rels_params =
     Array.mapi
       (fun i args ->
@@ -1213,11 +1271,11 @@ let compute_params_name relnames (args : (Name.t * Glob_term.glob_constr * bool)
   let _ =
     try
       List.iteri
-	(fun i ((n,nt,is_defined) as param) ->
+	(fun i ((n,nt,typ) as param) ->
 	   if Array.for_all
 	     (fun l ->
-		let (n',nt',is_defined') = List.nth l i in
-		Name.equal n n' && glob_constr_eq nt nt' && (is_defined : bool) == is_defined')
+		let (n',nt',typ') = List.nth l i in
+		Name.equal n n' && glob_constr_eq nt nt' && Option.equal glob_constr_eq typ typ')
 	     rels_params
 	   then
 	     l := param::!l
@@ -1229,18 +1287,18 @@ let compute_params_name relnames (args : (Name.t * Glob_term.glob_constr * bool)
   List.rev !l
 
 let rec rebuild_return_type rt =
-  match rt with
-    | Constrexpr.CProdN(loc,n,t') ->
-	Constrexpr.CProdN(loc,n,rebuild_return_type t')
-    | Constrexpr.CLetIn(loc,na,t,t') ->
-	Constrexpr.CLetIn(loc,na,t,rebuild_return_type t')
-    | _ -> Constrexpr.CProdN(Loc.ghost,[[Loc.ghost,Anonymous],
-				       Constrexpr.Default Decl_kinds.Explicit,rt],
-			    Constrexpr.CSort(Loc.ghost,GType []))
-
+  let loc = rt.CAst.loc in
+  match rt.CAst.v with
+    | Constrexpr.CProdN(n,t') ->
+        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([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 * bool) 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
@@ -1262,36 +1320,41 @@ let do_build_inductive
   let open Context.Named.Declaration in
   let evd,env =
     Array.fold_right2
-      (fun id c (evd,env) ->
-       let evd,t = Typing.type_of env evd (mkConstU c) in
+      (fun id (c, u) (evd,env) ->
+       let u = EConstr.EInstance.make u in
+       let evd,t = Typing.type_of env evd (EConstr.mkConstU (c, u)) in
+       let t = EConstr.Unsafe.to_constr t in
        evd,
        Environ.push_named (LocalAssum (id,t))
-			   (* try *)
-			   (*   Typing.e_type_of env evd (mkConstU c) *)
-			   (* with Not_found -> *)
-			   (*   raise (UserError("do_build_inductive", str "Cannot handle partial fixpoint")) *)
 			 env
       )
       funnames
       (Array.of_list funconstants)
       (evd,Global.env ())
   in
-  let resa = Array.map (build_entry_lc env  funnames_as_set []) rta in
+  (* we solve and replace the implicits *)
+  let rta =
+    Array.mapi (fun i rt ->
+        let _,t = Typing.type_of env evd (EConstr.of_constr (mkConstU ((Array.of_list funconstants).(i)))) in
+        resolve_and_replace_implicits ~expected_type:(Pretyping.OfType t) env evd rt
+      ) rta
+  in
+  let resa = Array.map (build_entry_lc env funnames_as_set []) rta in
   let env_with_graphs =
     let rel_arity i funargs =  (* Rebuilding arities (with parameters) *)
-      let rel_first_args :(Name.t * Glob_term.glob_constr * bool ) list  =
+      let rel_first_args :(Name.t * Glob_term.glob_constr * Glob_term.glob_constr option ) list  =
 	funargs
       in
       List.fold_right
-	(fun (n,t,is_defined) acc ->
-	   if is_defined
-	   then
-	     Constrexpr.CLetIn(Loc.ghost,(Loc.ghost, n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
+	(fun (n,t,typ) acc ->
+          match typ with
+          | Some typ ->
+             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)
-	   else
-	     Constrexpr.CProdN
-	       (Loc.ghost,
-		[[(Loc.ghost,n)],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t],
+	  | None ->
+	     CAst.make @@ Constrexpr.CProdN
+               ([Constrexpr.CLocalAssum([CAst.make n],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t)],
 		acc
 	       )
 	)
@@ -1304,8 +1367,9 @@ let do_build_inductive
     *)
     let rel_arities = Array.mapi rel_arity funsargs in
     Util.Array.fold_left2 (fun env rel_name rel_ar ->
-			     Environ.push_named (LocalAssum (rel_name,
-						             fst (with_full_print (Constrintern.interp_constr env evd) rel_ar))) env) env relnames rel_arities
+        let rex = fst (with_full_print (Constrintern.interp_constr env evd) rel_ar) in
+        let rex = EConstr.Unsafe.to_constr rex in
+        Environ.push_named (LocalAssum (rel_name,rex)) env) env relnames rel_arities
   in
   (* and of the real constructors*)
   let constr i res =
@@ -1346,19 +1410,19 @@ let do_build_inductive
     rel_constructors
   in
   let rel_arity i funargs =  (* Reduilding arities (with parameters) *)
-    let rel_first_args :(Name.t * Glob_term.glob_constr * bool ) list  =
+    let rel_first_args :(Name.t * Glob_term.glob_constr * Glob_term.glob_constr option ) list  =
       (snd (List.chop nrel_params funargs))
     in
     List.fold_right
-      (fun (n,t,is_defined) acc ->
-	 if is_defined
-	 then
-	   Constrexpr.CLetIn(Loc.ghost,(Loc.ghost, n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
+      (fun (n,t,typ) acc ->
+         match typ with
+         | Some typ ->
+           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)
-	 else
-	   Constrexpr.CProdN
-	   (Loc.ghost,
-	   [[(Loc.ghost,n)],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t],
+	 | None ->
+           CAst.make @@ Constrexpr.CProdN
+           ([Constrexpr.CLocalAssum([CAst.make n],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t)],
 	    acc
 	   )
       )
@@ -1382,20 +1446,21 @@ let do_build_inductive
   in
   let rel_params =
     List.map
-      (fun (n,t,is_defined) ->
-	 if is_defined
-	 then
-	   Constrexpr.LocalRawDef((Loc.ghost,n), Constrextern.extern_glob_constr Id.Set.empty t)
-	 else
-	 Constrexpr.LocalRawAssum
-	   ([(Loc.ghost,n)], Constrexpr_ops.default_binder_kind, Constrextern.extern_glob_constr Id.Set.empty t)
+      (fun (n,t,typ) ->
+         match typ with
+         | Some typ ->
+           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
+           ([(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.ghost,id),
+         false,((CAst.make id),
 		with_full_print
 		  (Constrextern.extern_glob_type Id.Set.empty) ((* zeta_normalize *) (alpha_rt rel_params_ids t))
 	       )
@@ -1403,7 +1468,7 @@ let do_build_inductive
       (rel_constructors)
   in
   let rel_ind i ext_rel_constructors =
-    (((Loc.ghost,relnames.(i)), None),
+    (((CAst.make @@ relnames.(i)), None),
     rel_params,
     Some rel_arities.(i),
     ext_rel_constructors),[]
@@ -1432,7 +1497,9 @@ let do_build_inductive
 (*   in *)
   let _time2 = System.get_time () in
   try
-    with_full_print (Flags.silently (Command.do_mutual_inductive rel_inds (Flags.is_universe_polymorphism ()) false)) Decl_kinds.Finite
+    with_full_print
+      (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
@@ -1443,7 +1510,7 @@ let do_build_inductive
 	in
 	let msg =
 	  str "while trying to define"++ spc () ++
-	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(false,Decl_kinds.Finite,repacked_rel_inds))
+            Ppvernac.pr_vernac Vernacexpr.(VernacExpr([], VernacInductive(GlobalNonCumulativity,false,Declarations.Finite,repacked_rel_inds)))
 	    ++ fnl () ++
 	    msg
 	in
@@ -1458,7 +1525,7 @@ let do_build_inductive
 	in
 	let msg =
 	  str "while trying to define"++ spc () ++
-	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(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 5bb1376e..ff0e98d0 100644
--- a/plugins/funind/glob_term_to_relation.mli
+++ b/plugins/funind/glob_term_to_relation.mli
@@ -11,8 +11,8 @@ val build_inductive :
   Id.t list -> (* The list of function name *) 
  *)
   Evd.evar_map ->
-  Term.pconstant list -> 
-  (Name.t*Glob_term.glob_constr*bool) list list -> (* The list of function args *)
+  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 *)
   unit
diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 01e5ef7f..769fcc1c 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 = GRef(Loc.ghost,ref,None)
-let mkGVar id = GVar(Loc.ghost,id)
-let mkGApp(rt,rtl) = GApp(Loc.ghost,rt,rtl)
-let mkGLambda(n,t,b) = GLambda(Loc.ghost,n,Explicit,t,b)
-let mkGProd(n,t,b) = GProd(Loc.ghost,n,Explicit,t,b)
-let mkGLetIn(n,t,b) = GLetIn(Loc.ghost,n,t,b)
-let mkGCases(rto,l,brl) = GCases(Loc.ghost,Term.RegularStyle,rto,l,brl)
-let mkGSort s = GSort(Loc.ghost,s)
-let mkGHole () = GHole(Loc.ghost,Evar_kinds.BinderType Anonymous,Misctypes.IntroAnonymous,None)
-let mkGCast(b,t) = GCast(Loc.ghost,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
-  | 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
-  | GProd(_,n,k,t,b) ->
-      glob_decompose_prod ((n,None,Some t)::args) b
-  | GLetIn(_,n,t,b) ->
-      glob_decompose_prod ((n,Some t,None)::args) b
-  | 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,None) -> mkGLetIn(n,bdy,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
-	| 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
-	| GProd(_,n,_,t,b) ->
-	    glob_decompose_prod (i-1) ((n,None,Some t)::args) b
-	| GLetIn(_,n,t,b) ->
-	    glob_decompose_prod (i-1) ((n,Some t,None)::args) b
-	| 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
-    | 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,96 +51,93 @@ let remove_name_from_mapping mapping na =
 
 let change_vars =
   let rec change_vars mapping rt =
-    match rt with
-      | GRef _ -> rt
-      | GVar(loc,id) ->
+    DAst.map_with_loc (fun ?loc -> function
+      | GRef _ as x -> x
+      | GVar id ->
 	  let new_id =
 	    try
 	      Id.Map.find id mapping
 	    with Not_found -> id
 	  in
-	  GVar(loc,new_id)
-      | GEvar _ -> rt
-      | GPatVar _ -> rt
-      | GApp(loc,rt',rtl) ->
-	  GApp(loc,
-	       change_vars mapping rt',
+	  GVar(new_id)
+      | GEvar _ as x   -> x
+      | GPatVar _ as x -> x
+      | GApp(rt',rtl) ->
+	  GApp(change_vars mapping rt',
 	       List.map (change_vars mapping) rtl
 	      )
-      | GLambda(loc,name,k,t,b) ->
-	  GLambda(loc,
-		  name,
+      | GLambda(name,k,t,b) ->
+	  GLambda(name,
 		  k,
 		  change_vars mapping t,
 		  change_vars (remove_name_from_mapping mapping name) b
 		 )
-      | GProd(loc,name,k,t,b) ->
-	  GProd(loc,
-		  name,
+      | GProd(name,k,t,b) ->
+	  GProd(  name,
 	          k,
 		  change_vars mapping t,
 		  change_vars (remove_name_from_mapping mapping name) b
 		 )
-      | GLetIn(loc,name,def,b) ->
-	  GLetIn(loc,
-		 name,
+      | GLetIn(name,def,typ,b) ->
+	  GLetIn(name,
 		 change_vars mapping def,
+		 Option.map (change_vars mapping) typ,
 		 change_vars (remove_name_from_mapping mapping name) b
 		)
-      | GLetTuple(loc,nal,(na,rto),b,e) ->
+      | GLetTuple(nal,(na,rto),b,e) ->
 	  let new_mapping = List.fold_left remove_name_from_mapping mapping nal in
-	  GLetTuple(loc,
-		    nal,
+	  GLetTuple(nal,
 		    (na, Option.map (change_vars mapping) rto),
 		    change_vars mapping b,
 		    change_vars new_mapping e
 		   )
-      | GCases(loc,sty,infos,el,brl) ->
-	  GCases(loc,sty,
+      | GCases(sty,infos,el,brl) ->
+	  GCases(sty,
 		 infos,
 		 List.map (fun (e,x) -> (change_vars mapping e,x)) el,
 		 List.map (change_vars_br mapping) brl
 		)
-      | GIf(loc,b,(na,e_option),lhs,rhs) ->
-	  GIf(loc,
-	      change_vars mapping b,
+      | GIf(b,(na,e_option),lhs,rhs) ->
+	  GIf(change_vars mapping b,
 	      (na,Option.map (change_vars mapping) e_option),
 	      change_vars mapping lhs,
 	      change_vars mapping rhs
 	     )
-      | GRec _ -> error "Local (co)fixes are not supported"
-      | GSort _ -> rt
-      | GHole _ -> rt
-      | GCast(loc,b,c) ->
-	  GCast(loc,change_vars mapping b,
+      | GRec _ -> user_err ?loc Pp.(str "Local (co)fixes are not supported")
+      | GSort _ as x -> x
+      | GHole _ as x -> x
+      | GCast(b,c) ->
+	  GCast(change_vars mapping b,
 		Miscops.map_cast_type (change_vars mapping) c)
-  and change_vars_br mapping ((loc,idl,patl,res) as br) =
+      ) rt
+  and change_vars_br mapping ({CAst.loc;v=(idl,patl,res)} as br) =
     let new_mapping = List.fold_right Id.Map.remove idl mapping in
     if Id.Map.is_empty new_mapping
     then br
-    else (loc,idl,patl,change_vars new_mapping res)
+    else CAst.make ?loc (idl,patl,change_vars new_mapping res)
   in
   change_vars
 
 
 
 let rec alpha_pat excluded pat =
-  match pat with
-    | PatVar(loc,Anonymous) ->
+  let loc = pat.CAst.loc in
+  match DAst.get pat with
+    | PatVar Anonymous ->
 	let new_id = Indfun_common.fresh_id excluded "_x" in
-	PatVar(loc,Name new_id),(new_id::excluded),Id.Map.empty
-    | PatVar(loc,Name id) ->
+	(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
-	  PatVar(loc,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(loc,constr,patl,na) ->
+	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
@@ -222,7 +150,7 @@ let rec alpha_pat excluded pat =
 	    ([],new_excluded,map)
 	    patl
 	in
-	PatCstr(loc,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 =
@@ -241,11 +169,11 @@ let alpha_patl excluded patl  =
 
 let raw_get_pattern_id pat acc =
   let rec get_pattern_id pat =
-    match pat with
-      | PatVar(loc,Anonymous) -> assert false
-      | PatVar(loc,Name id) ->
+    match DAst.get pat with
+      | PatVar(Anonymous) -> assert false
+      | PatVar(Name id) ->
 	  [id]
-      | PatCstr(loc,constr,patternl,_) ->
+      | PatCstr(constr,patternl,_) ->
 	  List.fold_right
 	  (fun pat idl ->
 	     let idl' = get_pattern_id pat in
@@ -259,28 +187,30 @@ let raw_get_pattern_id pat acc =
 let get_pattern_id pat = raw_get_pattern_id pat []
 
 let rec alpha_rt excluded rt =
-  let new_rt =
-    match rt with
-      | GRef _ | GVar _ | GEvar _ | GPatVar _ -> rt
-      | GLambda(loc,Anonymous,k,t,b) ->
-	  let new_id = Namegen.next_ident_away (Id.of_string "_x") excluded in
+  let loc = rt.CAst.loc in
+  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") (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
-	  GLambda(loc,Name new_id,k,new_t,new_b)
-      | GProd(loc,Anonymous,k,t,b) ->
+	  GLambda(Name new_id,k,new_t,new_b)
+      | GProd(Anonymous,k,t,b) ->
 	let new_t = alpha_rt excluded t in
 	let new_b = alpha_rt excluded b in
-	GProd(loc,Anonymous,k,new_t,new_b)
-    | GLetIn(loc,Anonymous,t,b) ->
-	let new_t = alpha_rt excluded t in
+	GProd(Anonymous,k,new_t,new_b)
+    | GLetIn(Anonymous,b,t,c) ->
 	let new_b = alpha_rt excluded b in
-	GLetIn(loc,Anonymous,new_t,new_b)
-    | GLambda(loc,Name id,k,t,b) ->
-	let new_id = Namegen.next_ident_away id excluded in
+	let new_t = Option.map (alpha_rt excluded) t in
+	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 (Id.Set.of_list excluded) in
 	let t,b =
 	  if Id.equal new_id id
-	  then t,b
+	  then t, b
 	  else
 	    let replace = change_vars (Id.Map.add id new_id Id.Map.empty) in
 	    (t,replace b)
@@ -288,9 +218,9 @@ let rec alpha_rt excluded rt =
 	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
-	GLambda(loc,Name new_id,k,new_t,new_b)
-    | GProd(loc,Name id,k,t,b) ->
-	let new_id = Namegen.next_ident_away id excluded in
+	GLambda(Name new_id,k,new_t,new_b)
+    | GProd(Name id,k,t,b) ->
+	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
@@ -301,30 +231,27 @@ let rec alpha_rt excluded rt =
 	in
 	let new_t = alpha_rt new_excluded t in
 	let new_b = alpha_rt new_excluded b in
-	GProd(loc,Name new_id,k,new_t,new_b)
-    | GLetIn(loc,Name id,t,b) ->
-	let new_id = Namegen.next_ident_away id excluded in
-	let t,b =
-	  if Id.equal new_id id
-	  then t,b
-	  else
-	    let replace = change_vars (Id.Map.add id new_id Id.Map.empty) in
-	    (t,replace b)
+	GProd(Name new_id,k,new_t,new_b)
+    | GLetIn(Name id,b,t,c) ->
+	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
 	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
-	GLetIn(loc,Name new_id,new_t,new_b)
-
+	let new_t = Option.map (alpha_rt new_excluded) t in
+	let new_c = alpha_rt new_excluded c in
+	GLetIn(Name new_id,new_b,new_t,new_c)
 
-    | GLetTuple(loc,nal,(na,rto),t,b) ->
+    | GLetTuple(nal,(na,rto),t,b) ->
 	let rev_new_nal,new_excluded,mapping =
 	  List.fold_left
 	    (fun (nal,excluded,mapping) na ->
 	       match na with
 		 | Anonymous -> (na::nal,excluded,mapping)
 		 | Name id ->
-		     let new_id = 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
@@ -344,85 +271,92 @@ let rec alpha_rt excluded rt =
 	let new_t = alpha_rt new_excluded new_t in
 	let new_b = alpha_rt new_excluded new_b in
 	let new_rto = Option.map (alpha_rt new_excluded) new_rto  in
-	GLetTuple(loc,new_nal,(na,new_rto),new_t,new_b)
-    | GCases(loc,sty,infos,el,brl) ->
+	GLetTuple(new_nal,(na,new_rto),new_t,new_b)
+    | GCases(sty,infos,el,brl) ->
 	let new_el =
 	  List.map (function (rt,i) -> alpha_rt excluded rt, i) el
 	in
-	GCases(loc,sty,infos,new_el,List.map (alpha_br excluded) brl)
-    | GIf(loc,b,(na,e_o),lhs,rhs) ->
-	GIf(loc,alpha_rt excluded b,
+	GCases(sty,infos,new_el,List.map (alpha_br excluded) brl)
+    | GIf(b,(na,e_o),lhs,rhs) ->
+	GIf(alpha_rt excluded b,
 	    (na,Option.map (alpha_rt excluded) e_o),
 	    alpha_rt excluded lhs,
 	    alpha_rt excluded rhs
 	   )
-    | GRec _ -> error "Not handled GRec"
-    | GSort _ -> rt
-    | GHole _ -> rt
-    | GCast (loc,b,c) ->
-	GCast(loc,alpha_rt excluded b,
+    | GRec _ -> user_err Pp.(str "Not handled GRec")
+    | GSort _
+    | GHole _ as rt -> rt
+    | GCast (b,c) ->
+	GCast(alpha_rt excluded b,
 	      Miscops.map_cast_type (alpha_rt excluded) c)
-    | GApp(loc,f,args) ->
-	GApp(loc,
-	     alpha_rt excluded f,
+    | GApp(f,args) ->
+	GApp(alpha_rt excluded f,
 	     List.map (alpha_rt excluded) args
 	    )
   in
   new_rt
 
-and alpha_br excluded (loc,ids,patl,res) =
+and alpha_br excluded {CAst.loc;v=(ids,patl,res)} =
   let new_patl,new_excluded,mapping = alpha_patl excluded patl in
   let new_ids = List.fold_right raw_get_pattern_id new_patl [] in
   let new_excluded = new_ids@excluded in
   let renamed_res = change_vars mapping res in
   let new_res = alpha_rt new_excluded renamed_res in
-  (loc,new_ids,new_patl,new_res)
+  CAst.make ?loc (new_ids,new_patl,new_res)
 
 (*
    [is_free_in id rt] checks if [id] is a free variable in [rt]
 *)
 let is_free_in id =
-  let rec is_free_in = function
+  let rec is_free_in x = DAst.with_loc_val (fun ?loc -> function
     | GRef _ ->  false
-    | GVar(_,id') -> Id.compare id' id == 0
+    | GVar id' -> Id.compare id' id == 0
     | GEvar _ -> false
     | GPatVar _ -> false
-    | GApp(_,rt,rtl) -> List.exists is_free_in (rt::rtl)
-    | GLambda(_,n,_,t,b) | GProd(_,n,_,t,b) | GLetIn(_,n,t,b) ->
+    | GApp(rt,rtl) -> List.exists is_free_in (rt::rtl)
+    | GLambda(n,_,t,b) | GProd(n,_,t,b) ->
 	let check_in_b =
 	  match n with
 	    | Name id' -> not (Id.equal id' id)
 	    | _ -> true
 	in
 	is_free_in t || (check_in_b && is_free_in b)
-    | GCases(_,_,_,el,brl) ->
+    | GLetIn(n,b,t,c) ->
+	let check_in_c =
+	  match n with
+	    | Name id' -> not (Id.equal id' id)
+	    | _ -> true
+	in
+	is_free_in b || Option.cata is_free_in true t || (check_in_c && is_free_in c)
+    | GCases(_,_,el,brl) ->
 	(List.exists (fun (e,_) -> is_free_in e) el) ||
 	  List.exists is_free_in_br brl
-    | GLetTuple(_,nal,_,b,t) ->
+    | GLetTuple(nal,_,b,t) ->
 	let check_in_nal =
 	  not (List.exists (function Name id' -> Id.equal id' id | _ -> false) nal)
 	in
 	is_free_in t  || (check_in_nal && is_free_in b)
 
-    | GIf(_,cond,_,br1,br2) ->
+    | GIf(cond,_,br1,br2) ->
 	is_free_in cond || is_free_in br1 || is_free_in br2
-    | GRec _ -> raise (UserError("",str "Not handled GRec"))
+    | GRec _  -> user_err Pp.(str "Not handled GRec")
     | GSort _ -> false
     | 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
-  and is_free_in_br (_,ids,_,rt) =
+    | GCast (b,(CastConv t|CastVM t|CastNative t)) -> is_free_in b || is_free_in t
+    | GCast (b,CastCoerce) -> is_free_in b
+    ) x
+  and is_free_in_br {CAst.v=(ids,_,rt)} =
     (not (Id.List.mem id ids)) && is_free_in rt
   in
   is_free_in
 
 
 
-let rec pattern_to_term  = function
-  | PatVar(loc,Anonymous) -> assert false
-  | PatVar(loc,Name id) ->
+let rec pattern_to_term pt = DAst.with_val (function
+  | PatVar Anonymous -> assert false
+  | PatVar(Name id) ->
 	mkGVar id
-  | PatCstr(loc,constr,patternl,_) ->
+  | PatCstr(constr,patternl,_) ->
       let cst_narg =
 	Inductiveops.constructor_nallargs_env
 	  (Global.env ())
@@ -441,77 +375,73 @@ let rec pattern_to_term  = function
       mkGApp(mkGRef(Globnames.ConstructRef constr),
 	     implicit_args@patl_as_term
 	    )
-
+  ) pt
 
 
 let replace_var_by_term x_id term =
-  let rec replace_var_by_pattern rt =
-    match rt with
-      | GRef _ -> rt
-      | GVar(_,id) when Id.compare id x_id == 0 -> term
-      | GVar _ -> rt
-      | GEvar _ -> rt
-      | GPatVar _ -> rt
-      | GApp(loc,rt',rtl) ->
-	  GApp(loc,
-	       replace_var_by_pattern rt',
+  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 _
+      | GPatVar _ as rt -> rt
+      | GApp(rt',rtl) ->
+	  GApp(replace_var_by_pattern rt',
 	       List.map replace_var_by_pattern rtl
 	      )
-      | GLambda(_,Name id,_,_,_) when Id.compare id x_id == 0 -> rt
-      | GLambda(loc,name,k,t,b) ->
-	  GLambda(loc,
-		  name,
+      | GLambda(Name id,_,_,_) as rt when Id.compare id x_id == 0 -> rt
+      | GLambda(name,k,t,b) ->
+	  GLambda(name,
 		  k,
 		  replace_var_by_pattern t,
 		  replace_var_by_pattern b
 		 )
-      | GProd(_,Name id,_,_,_) when Id.compare id x_id == 0 -> rt
-      | GProd(loc,name,k,t,b) ->
-	  GProd(loc,
-		  name,
+      | GProd(Name id,_,_,_) as rt when Id.compare id x_id == 0 -> rt
+      | GProd(name,k,t,b) ->
+	  GProd(  name,
 	          k,
 		  replace_var_by_pattern t,
 		  replace_var_by_pattern b
 		 )
-      | GLetIn(_,Name id,_,_) when Id.compare id x_id == 0 -> rt
-      | GLetIn(loc,name,def,b) ->
-	  GLetIn(loc,
-		 name,
+      | GLetIn(Name id,_,_,_) as rt when Id.compare id x_id == 0 -> rt
+      | GLetIn(name,def,typ,b) ->
+	  GLetIn(name,
 		 replace_var_by_pattern def,
+		 Option.map (replace_var_by_pattern) typ,
 		 replace_var_by_pattern b
 		)
-      | GLetTuple(_,nal,_,_,_)
+      | GLetTuple(nal,_,_,_) as rt
 	  when List.exists (function Name id -> Id.equal id x_id | _ -> false) nal  ->
 	  rt
-      | GLetTuple(loc,nal,(na,rto),def,b) ->
-	  GLetTuple(loc,
-		    nal,
+      | GLetTuple(nal,(na,rto),def,b) ->
+	  GLetTuple(nal,
 		    (na,Option.map replace_var_by_pattern rto),
 		    replace_var_by_pattern def,
 		    replace_var_by_pattern b
 		   )
-      | GCases(loc,sty,infos,el,brl) ->
-	  GCases(loc,sty,
+      | GCases(sty,infos,el,brl) ->
+	  GCases(sty,
 		 infos,
 		 List.map (fun (e,x) -> (replace_var_by_pattern e,x)) el,
 		 List.map replace_var_by_pattern_br brl
 		)
-      | GIf(loc,b,(na,e_option),lhs,rhs) ->
-	  GIf(loc, replace_var_by_pattern b,
+      | GIf(b,(na,e_option),lhs,rhs) ->
+	  GIf(replace_var_by_pattern b,
 	      (na,Option.map replace_var_by_pattern e_option),
 	      replace_var_by_pattern lhs,
 	      replace_var_by_pattern rhs
 	     )
-      | GRec _ -> raise (UserError("",str "Not handled GRec"))
-      | GSort _ -> rt
-      | GHole _ -> rt
-      | GCast(loc,b,c) ->
-	  GCast(loc,replace_var_by_pattern b,
+      | GRec _ -> raise (UserError(None,str "Not handled GRec"))
+      | GSort _
+      | GHole _ as rt -> rt
+      | GCast(b,c) ->
+	  GCast(replace_var_by_pattern b,
 		Miscops.map_cast_type replace_var_by_pattern c)
-  and replace_var_by_pattern_br ((loc,idl,patl,res) as br) =
+    ) x
+  and replace_var_by_pattern_br ({CAst.loc;v=(idl,patl,res)} as br) =
     if List.exists (fun id -> Id.compare id x_id == 0) idl
     then br
-    else (loc,idl,patl,replace_var_by_pattern res)
+    else CAst.make ?loc (idl,patl,replace_var_by_pattern res)
   in
   replace_var_by_pattern
 
@@ -523,16 +453,16 @@ exception NotUnifiable
 
 let rec are_unifiable_aux  = function
   | [] -> ()
-  | eq::eqs ->
-      match eq with
-	 | PatVar _,_ | _,PatVar _ -> are_unifiable_aux eqs
-	 | PatCstr(_,constructor1,cpl1,_),PatCstr(_,constructor2,cpl2,_) ->
+  | (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
 	       let eqs' =
 		 try (List.combine cpl1 cpl2) @ eqs
-		 with Invalid_argument _ -> anomaly (Pp.str "are_unifiable_aux")
+		 with Invalid_argument _ -> anomaly (Pp.str "are_unifiable_aux.")
 	       in
 	       are_unifiable_aux eqs'
 
@@ -545,16 +475,16 @@ let are_unifiable pat1 pat2 =
 
 let rec eq_cases_pattern_aux  = function
   | [] -> ()
-  | eq::eqs ->
-      match eq with
-	 | PatVar _,PatVar _ -> eq_cases_pattern_aux eqs
-	 | PatCstr(_,constructor1,cpl1,_),PatCstr(_,constructor2,cpl2,_) ->
+  | (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
 	       let eqs' =
 		 try (List.combine cpl1 cpl2) @ eqs
-		 with Invalid_argument _ -> anomaly (Pp.str "eq_cases_pattern_aux")
+		 with Invalid_argument _ -> anomaly (Pp.str "eq_cases_pattern_aux.")
 	       in
 	       eq_cases_pattern_aux eqs'
 	 | _ -> raise NotUnifiable
@@ -568,143 +498,116 @@ let eq_cases_pattern pat1 pat2 =
 
 
 let ids_of_pat =
-  let rec ids_of_pat ids = function
-    | PatVar(_,Anonymous) -> ids
-    | PatVar(_,Name id) -> Id.Set.add id ids
-    | PatCstr(_,_,patl,_) -> List.fold_left ids_of_pat ids patl
+  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
+    )
   in
   ids_of_pat Id.Set.empty
 
-let id_of_name = function
-  | Names.Anonymous -> Id.of_string "x"
-  | Names.Name x -> x
-
-(* TODO: finish Rec caes *)
-let ids_of_glob_constr c =
-  let rec ids_of_glob_constr acc c =
-    let idof = id_of_name in
-    match c with
-      | GVar (_,id) -> id::acc
-      | GApp (loc,g,args) ->
-          ids_of_glob_constr [] g @ List.flatten (List.map (ids_of_glob_constr []) args) @ acc
-      | GLambda (loc,na,k,ty,c) -> idof na :: ids_of_glob_constr [] ty @ ids_of_glob_constr [] c @ acc
-      | GProd (loc,na,k,ty,c) -> idof na :: ids_of_glob_constr [] ty @ ids_of_glob_constr [] c @ acc
-      | GLetIn (loc,na,b,c) -> idof na :: ids_of_glob_constr [] b @ ids_of_glob_constr [] c @ acc
-      | GCast (loc,c,(CastConv t|CastVM t|CastNative t)) -> ids_of_glob_constr [] c @ ids_of_glob_constr [] t @ acc
-      | GCast (loc,c,CastCoerce) -> ids_of_glob_constr [] c @ acc
-      | GIf (loc,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 (loc,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 rt =
-    match rt with
-      | GRef _ -> rt
-      | GVar _ -> rt
-      | GEvar _ -> rt
-      | GPatVar _ -> rt
-      | GApp(loc,rt',rtl) ->
-	  GApp(loc,
-	       zeta_normalize_term rt',
-	       List.map zeta_normalize_term rtl
-	      )
-      | GLambda(loc,name,k,t,b) ->
-	  GLambda(loc,
-		  name,
-		  k,
-		  zeta_normalize_term t,
-		  zeta_normalize_term b
-		 )
-      | GProd(loc,name,k,t,b) ->
-	  GProd(loc,
-		name,
-	        k,
-		zeta_normalize_term t,
-		zeta_normalize_term b
-		 )
-      | GLetIn(_,Name id,def,b) ->
-	  zeta_normalize_term (replace_var_by_term id def b)
-      | GLetIn(loc,Anonymous,def,b) -> zeta_normalize_term b
-      | GLetTuple(loc,nal,(na,rto),def,b) ->
-	  GLetTuple(loc,
-		    nal,
-		    (na,Option.map zeta_normalize_term rto),
-		    zeta_normalize_term def,
-		    zeta_normalize_term b
-		   )
-      | GCases(loc,sty,infos,el,brl) ->
-	  GCases(loc,sty,
-		 infos,
-		 List.map (fun (e,x) -> (zeta_normalize_term e,x)) el,
-		 List.map zeta_normalize_br brl
-		)
-      | GIf(loc,b,(na,e_option),lhs,rhs) ->
-	  GIf(loc, zeta_normalize_term b,
-	      (na,Option.map zeta_normalize_term e_option),
-	      zeta_normalize_term lhs,
-	      zeta_normalize_term rhs
-	     )
-      | GRec _ -> raise (UserError("",str "Not handled GRec"))
-      | GSort _ -> rt
-      | GHole _ -> rt
-      | GCast(loc,b,c) ->
-	  GCast(loc,zeta_normalize_term b,
-                Miscops.map_cast_type zeta_normalize_term c)
-  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 pat =
-    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 pat) (List.fold_left add_as map patl)
-      | PatCstr(_,_,patl,_) -> List.fold_left add_as map patl
+      | 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 rt =
-    match rt with
-      | GRef _ | GEvar _ | GPatVar _ | GSort _ | GHole _ -> rt
-      | GVar(_,id) ->
+  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
+	      DAst.get (Id.Map.find id map)
 	    with Not_found -> rt
 	  end
-      | GApp(loc,f,args) -> GApp(loc,expand_as map f,List.map (expand_as map) args)
-      | GLambda(loc,na,k,t,b) -> GLambda(loc,na,k,expand_as map t, expand_as map b)
-      | GProd(loc,na,k,t,b) -> GProd(loc,na,k,expand_as map t, expand_as map b)
-      | GLetIn(loc,na,v,b) -> GLetIn(loc,na, expand_as map v,expand_as map b)
-      | GLetTuple(loc,nal,(na,po),v,b) ->
-	  GLetTuple(loc,nal,(na,Option.map (expand_as map) po),
+      | GApp(f,args) -> GApp(expand_as map f,List.map (expand_as map) args)
+      | GLambda(na,k,t,b) -> GLambda(na,k,expand_as map t, expand_as map b)
+      | GProd(na,k,t,b) -> GProd(na,k,expand_as map t, expand_as map b)
+      | GLetIn(na,v,typ,b) -> GLetIn(na, expand_as map v,Option.map (expand_as map) typ,expand_as map b)
+      | GLetTuple(nal,(na,po),v,b) ->
+	  GLetTuple(nal,(na,Option.map (expand_as map) po),
 		    expand_as map v, expand_as map b)
-      | GIf(loc,e,(na,po),br1,br2) ->
-	  GIf(loc,expand_as map e,(na,Option.map (expand_as map) po),
+      | GIf(e,(na,po),br1,br2) ->
+	  GIf(expand_as map e,(na,Option.map (expand_as map) po),
 	      expand_as map br1, expand_as map br2)
-      | GRec _ ->  error "Not handled GRec"
-      | GCast(loc,b,c) ->
-	  GCast(loc,expand_as map b,
+      | GRec _ ->  user_err Pp.(str "Not handled GRec")
+      | GCast(b,c) ->
+	  GCast(expand_as map b,
 		Miscops.map_cast_type (expand_as map) c)
-      | GCases(loc,sty,po,el,brl) ->
-	  GCases(loc, sty, Option.map (expand_as map) po, List.map (fun (rt,t) -> expand_as map rt,t) el,
+      | 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)
-  and expand_as_br map (loc,idl,cpl,rt) =
-    (loc,idl,cpl, expand_as (List.fold_left add_as map cpl) rt)
+    )
+  and expand_as_br map {CAst.loc; v=(idl,cpl,rt)} =
+    CAst.make ?loc (idl,cpl, expand_as (List.fold_left add_as map cpl) rt)
   in
   expand_as Id.Map.empty
+
+(* [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 
+ *)
+
+exception Found of Evd.evar_info
+let resolve_and_replace_implicits ?(flags=Pretyping.all_and_fail_flags) ?(expected_type=Pretyping.WithoutTypeConstraint) env sigma rt =
+  let open Evd in
+  let open Evar_kinds in 
+  (* 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, 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 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 *)
+           Evd.fold (* to simulate an iter *)
+             (fun _ evi _ ->
+               match evi.evar_source with
+               | (loc_evi,ImplicitArg(gr_evi,p_evi,b_evi)) ->
+                  if Globnames.eq_gr grk gr_evi && pk=p_evi && bk=b_evi  && rt.CAst.loc = loc_evi
+                  then raise (Found evi)
+               | _ -> ()
+             )
+             ctx
+             ();
+           (* the hole was not solved : we do nothing *)
+           rt
+         with Found evi -> (* we found the evar corresponding to this hole *)
+           match evi.evar_body with
+           | Evar_defined c ->
+           (* we just have to lift the solution in glob_term *)
+              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 *)
+       (
+         let res = 
+           try (* we scan the new evar map to find the evar corresponding to this hole (by looking the source *)
+             Evd.fold (* to simulate an iter *)
+               (fun _ evi _ ->
+                 match evi.evar_source with
+                 | (loc_evi,BinderType na') ->
+                    if Name.equal na na' && rt.CAst.loc = loc_evi  then raise (Found evi)
+                 | _ -> ()
+               )
+               ctx
+               ();
+             (* the hole was not solved : we do nothing *)
+             rt
+           with Found evi -> (* we found the evar corresponding to this hole *)
+                match evi.evar_body with
+                | Evar_defined c ->
+                   (* we just have to lift the solution in glob_term *)
+                   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
+       )
+    | _ -> Glob_ops.map_glob_constr change rt 
+  in
+  change rt
diff --git a/plugins/funind/glob_termops.mli b/plugins/funind/glob_termops.mli
index 179e8fe8..7088ae59 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
@@ -19,24 +18,13 @@ val mkGVar : Id.t -> glob_constr
 val mkGApp  : glob_constr*(glob_constr list) -> glob_constr
 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 -> 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 *)
 
@@ -82,11 +62,8 @@ val alpha_rt : Id.t list -> glob_constr -> glob_constr
 
 (* same as alpha_rt but for case branches *)
 val alpha_br : Id.t list ->
-    Loc.t * Id.t list * Glob_term.cases_pattern list *
-    Glob_term.glob_constr ->
-    Loc.t * Id.t list * Glob_term.cases_pattern list *
-    Glob_term.glob_constr
-
+  Glob_term.cases_clause ->
+  Glob_term.cases_clause
 
 (* Reduction function *)
 val replace_var_by_term  :
@@ -112,13 +89,10 @@ 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 :
+      ?flags:Pretyping.inference_flags -> 
+      ?expected_type:Pretyping.typing_constraint -> Environ.env -> Evd.evar_map -> glob_constr -> glob_constr
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 18817f50..57863ee6 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -1,8 +1,9 @@
-open Context.Rel.Declaration
 open CErrors
+open Sorts
 open Util
 open Names
-open Term
+open Constr
+open EConstr
 open Pp
 open Indfun_common
 open Libnames
@@ -11,39 +12,42 @@ open Glob_term
 open Declarations
 open Misctypes
 open Decl_kinds
-open Sigma.Notations
 
-let is_rec_info scheme_info =
+module RelDecl = Context.Rel.Declaration
+
+let is_rec_info sigma scheme_info =
   let test_branche min acc decl =
     acc || (
       let new_branche =
-	it_mkProd_or_LetIn mkProp (fst (decompose_prod_assum (get_type decl))) in
-      let free_rels_in_br = Termops.free_rels new_branche in
+	it_mkProd_or_LetIn mkProp (fst (decompose_prod_assum sigma (RelDecl.get_type decl))) in
+      let free_rels_in_br = Termops.free_rels sigma new_branche in
       let max = min + scheme_info.Tactics.npredicates in
       Int.Set.exists (fun i -> i >= min && i< max) free_rels_in_br
     )
   in
   List.fold_left_i test_branche 1 false (List.rev scheme_info.Tactics.branches)
 
-let choose_dest_or_ind scheme_info =
-  Tactics.induction_destruct (is_rec_info scheme_info) false
+let choose_dest_or_ind scheme_info args =
+  Proofview.tclBIND Proofview.tclEVARMAP (fun sigma ->
+  Tactics.induction_destruct (is_rec_info sigma scheme_info) false args)
 
 let functional_induction with_clean c princl pat =
   let res =
-    let f,args = decompose_app c in
     fun g ->
+    let sigma = Tacmach.project g in
+    let f,args = decompose_app sigma c in
     let princ,bindings, princ_type,g' =
       match princl with
       | None -> (* No principle is given let's find the good one *)
 	 begin
-	   match kind_of_term f with
+	   match EConstr.kind sigma f with
 	   | Const (c',u) ->
 	      let princ_option =
 		let finfo = (* we first try to find out a graph on f *)
 		  try find_Function_infos c'
 		  with Not_found ->
-		    errorlabstrm "" (str "Cannot find induction information on "++
-				       Printer.pr_lconstr (mkConst c') )
+		    user_err  (str "Cannot find induction information on "++
+                                       Printer.pr_leconstr_env (Tacmach.pf_env g) sigma (mkConst c') )
 		in
 		match Tacticals.elimination_sort_of_goal g with
 		| InProp -> finfo.prop_lemma
@@ -61,7 +65,7 @@ let functional_induction with_clean c princl pat =
 			  (or f_rec, f_rect) i*)
 		  let princ_name =
 		    Indrec.make_elimination_ident
-		      (Label.to_id (con_label c'))
+		      (Label.to_id (Constant.label c'))
 		      (Tacticals.elimination_sort_of_goal g)
 		  in
 		  try
@@ -70,30 +74,41 @@ let functional_induction with_clean c princl pat =
 		    (b,a)
 		    (* mkConst(const_of_id princ_name ),g (\* FIXME *\) *)
 		  with Not_found -> (* This one is neither defined ! *)
-		    errorlabstrm "" (str "Cannot find induction principle for "
-				     ++Printer.pr_lconstr (mkConst c') )
+		    user_err  (str "Cannot find induction principle for "
+                                     ++ Printer.pr_leconstr_env (Tacmach.pf_env g) sigma (mkConst c') )
 	      in
-	      (princ,NoBindings, Tacmach.pf_unsafe_type_of g' princ,g')
-	   | _ -> raise (UserError("",str "functional induction must be used with a function" ))
+	      let princ = EConstr.of_constr princ in
+	      (princ,NoBindings,Tacmach.pf_unsafe_type_of g' princ,g')
+	   | _ -> raise (UserError(None,str "functional induction must be used with a function" ))
 	 end
       | Some ((princ,binding)) ->
 	 princ,binding,Tacmach.pf_unsafe_type_of g princ,g
     in
-    let princ_infos = Tactics.compute_elim_sig princ_type in
+    let sigma = Tacmach.project g' in
+    let princ_infos = Tactics.compute_elim_sig (Tacmach.project g') princ_type in
     let args_as_induction_constr =
       let c_list =
 	if princ_infos.Tactics.farg_in_concl
 	then [c] else []
       in
+      if List.length args + List.length c_list = 0
+      then user_err Pp.(str "Cannot recognize a valid functional scheme" );
       let encoded_pat_as_patlist =
-        List.make (List.length args + List.length c_list - 1) None @ [pat] in
-      List.map2 (fun c pat -> ((None,Tacexpr.ElimOnConstr ({ Tacexpr.delayed = fun env sigma -> Sigma ((c,NoBindings), sigma, Sigma.refl) })),(None,pat),None))
-        (args@c_list) encoded_pat_as_patlist
+        List.make (List.length args + List.length c_list - 1) None @ [pat]
+      in
+      List.map2
+        (fun c pat ->
+          ((None,
+            Ltac_plugin.Tacexpr.ElimOnConstr (fun env sigma -> (sigma,(c,NoBindings)))),
+           (None,pat),
+           None))
+        (args@c_list)
+        encoded_pat_as_patlist
     in
     let princ' = Some (princ,bindings) in
     let princ_vars =
       List.fold_right
-	(fun a acc -> try Id.Set.add (destVar a) acc with DestKO -> acc)
+	(fun a acc -> try Id.Set.add (destVar sigma a) acc with DestKO -> acc)
 	args
 	Id.Set.empty
     in
@@ -128,15 +143,14 @@ let functional_induction with_clean c princl pat =
 
 let rec abstract_glob_constr c = function
   | [] -> c
-  | Constrexpr.LocalRawDef (x,b)::bl -> Constrexpr_ops.mkLetInC(x,b,abstract_glob_constr c bl)
-  | Constrexpr.LocalRawAssum (idl,k,t)::bl ->
+  | Constrexpr.CLocalDef (x,b,t)::bl -> Constrexpr_ops.mkLetInC(x,b,t,abstract_glob_constr c bl)
+  | Constrexpr.CLocalAssum (idl,k,t)::bl ->
       List.fold_right (fun x b -> Constrexpr_ops.mkLambdaC([x],k,t,b)) idl
         (abstract_glob_constr c bl)
-  | Constrexpr.LocalPattern _::bl -> assert false
+  | Constrexpr.CLocalPattern _::bl -> assert false
 
 let interp_casted_constr_with_implicits env sigma impls c  =
-  Constrintern.intern_gen Pretyping.WithoutTypeConstraint env ~impls
-    ~allow_patvar:false c
+  Constrintern.intern_gen Pretyping.WithoutTypeConstraint env sigma ~impls c
 
 (*
    Construct a fixpoint as a Glob_term
@@ -149,14 +163,14 @@ let build_newrecursive
   let sigma = Evd.from_env env0 in
   let (rec_sign,rec_impls) =
     List.fold_left
-      (fun (env,impls) (((_,recname),_),bl,arityc,_) ->
-        let arityc = Constrexpr_ops.prod_constr_expr arityc bl in
+      (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 impl = Constrintern.compute_internalization_data env0 Constrintern.Recursive arity impls' 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 evd Constrintern.Recursive arity impls' in
         let open Context.Named.Declaration in
-        (Environ.push_named (LocalAssum (recname,arity)) env, Id.Map.add recname impl impls))
+        (EConstr.push_named (LocalAssum (recname,arity)) env, Id.Map.add recname impl impls))
       (env0,Constrintern.empty_internalization_env) lnameargsardef in
   let recdef =
     (* Declare local notations *)
@@ -175,37 +189,41 @@ let build_newrecursive l =
        match body_opt with 
 	 | Some body -> 
 	     (fixna,bll,ar,body)
-	 | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given")
+	 | None -> user_err ~hdr:"Function" (str "Body of Function must be given")
     ) l
   in
   build_newrecursive l'
 
+let error msg = user_err Pp.(str msg)
+
 (* Checks whether or not the mutual bloc is recursive *)
 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 = function
-    | GVar(_,id) -> check_id id names
+  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
+    | GCast(b,_) -> lookup names b
     | GRec _ -> error "GRec not handled"
-    | GIf(_,b,_,lhs,rhs) ->
+    | GIf(b,_,lhs,rhs) ->
 	(lookup names b) || (lookup names lhs) || (lookup names rhs)
-    | GLetIn(_,na,t,b) | GLambda(_,na,_,t,b) | GProd(_,na,_,t,b)  ->
-	lookup names t || lookup (Nameops.name_fold Id.Set.remove na names) b
-    | GLetTuple(_,nal,_,t,b) -> lookup names t ||
+    | GProd(na,_,t,b) | GLambda(na,_,t,b) ->
+	lookup names t || lookup (Nameops.Name.fold_right Id.Set.remove na names) b
+    | GLetIn(na,b,t,c) ->
+	lookup names b || Option.cata (lookup names) true t || lookup (Nameops.Name.fold_right Id.Set.remove na names) c
+    | GLetTuple(nal,_,t,b) -> lookup names t ||
 	lookup
 	  (List.fold_left
-	     (fun acc na -> Nameops.name_fold Id.Set.remove na acc)
+	     (fun acc na -> Nameops.Name.fold_right Id.Set.remove na acc)
 	     names
 	     nal
 	  )
 	  b
-    | GApp(_,f,args) -> List.exists (lookup names) (f::args)
-    | GCases(_,_,_,el,brl) ->
+    | GApp(f,args) -> List.exists (lookup names) (f::args)
+    | GCases(_,_,el,brl) ->
 	List.exists (fun (e,_) -> lookup names e) el ||
 	  List.exists (lookup_br names) brl
-  and lookup_br names (_,idl,_,rt) =
+  and lookup_br names {CAst.v=(idl,_,rt)} =
     let new_names = List.fold_right Id.Set.remove idl names in
     lookup new_names rt
   in
@@ -214,9 +232,9 @@ let is_rec names =
 let rec local_binders_length = function
   (* Assume that no `{ ... } contexts occur *)
   | [] -> 0
-  | Constrexpr.LocalRawDef _::bl -> 1 + local_binders_length bl
-  | Constrexpr.LocalRawAssum (idl,_,_)::bl -> List.length idl + local_binders_length bl
-  | Constrexpr.LocalPattern _::bl -> assert false
+  | Constrexpr.CLocalDef _::bl -> 1 + local_binders_length bl
+  | Constrexpr.CLocalAssum (idl,_,_)::bl -> List.length idl + local_binders_length bl
+  | Constrexpr.CLocalPattern _::bl -> assert false
 
 let prepare_body ((name,_,args,types,_),_) rt =
   let n = local_binders_length args in
@@ -242,7 +260,9 @@ let derive_inversion fix_names =
 	 let evd,c =
 	   Evd.fresh_global
 	     (Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident id)) in 
-	 evd, destConst c::l
+        let c = EConstr.of_constr c in
+        let (cst, u) = destConst evd c in
+	 evd, (cst, EInstance.kind evd u) :: l
 	)
 	fix_names
 	(evd',[])
@@ -262,14 +282,14 @@ let derive_inversion fix_names =
 	       (Global.env ()) evd
 	       (Constrintern.locate_reference (Libnames.qualid_of_ident (mk_rel_id id)))
 	   in 
-	   evd,(fst (destInd id))::l
+	   let id = EConstr.of_constr id in
+	   evd,(fst (destInd evd id))::l
 	  )
 	  fix_names
 	  (evd',[])
       in
       Invfun.derive_correctness
 	Functional_principles_types.make_scheme
-	functional_induction
 	fix_names_as_constant
 	lind;
       with e when CErrors.noncritical e ->
@@ -321,7 +341,7 @@ let error_error names e =
   in
   match e with
     | Building_graph e ->
-	errorlabstrm ""
+	user_err 
 	  (str "Cannot define graph(s) for " ++
 	     h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
 	     e_explain e)
@@ -329,9 +349,9 @@ let error_error names e =
 
 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 array -> Term.constr array -> int ->
+    (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
@@ -344,7 +364,7 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
 	(*i The next call to mk_rel_id is valid since we have just construct the graph
 	   Ensures by : do_built
 	i*)
-	let f_R_mut = Ident (Loc.ghost,mk_rel_id (List.nth names 0)) in
+        let f_R_mut = CAst.make @@ Ident (mk_rel_id (List.nth names 0)) in
 	let ind_kn =
 	  fst (locate_with_msg
 		 (pr_reference f_R_mut++str ": Not an inductive type!")
@@ -352,7 +372,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 = CAst.map (fun n -> Ident n) fname in
 	  locate_with_msg
 	    (pr_reference f_ref++str ": Not an inductive type!")
 	    locate_constant
@@ -367,7 +387,8 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
 	     let evd = ref (Evd.from_env env) in
 	     let evd',uprinc = Evd.fresh_global env !evd princ in
              let _ = evd := evd' in 
-	     let princ_type = Typing.e_type_of ~refresh:true env evd uprinc in
+	     let princ_type = Typing.e_type_of ~refresh:true env evd (EConstr.of_constr uprinc) in
+	     let princ_type = EConstr.Unsafe.to_constr princ_type in
     	     Functional_principles_types.generate_functional_principle
 	       evd
 		 interactive_proof
@@ -390,33 +411,40 @@ 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 ->
-      let body = match body with | Some body -> body | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given") in 
-      Command.do_definition
+    | [(({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 
+      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
-	    evd,((destConst c)::l)
+            let c = EConstr.of_constr c in
+            let (cst, u) = destConst evd c in
+            let u = EInstance.kind evd u in
+            evd,((cst, u) :: l)
 	   )
 	   (Evd.from_env (Global.env ()),[])
 	   fixpoint_exprl
        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
-	    evd,((destConst c)::l)
+            let c = EConstr.of_constr c in
+            let (cst, u) = destConst evd c in
+            let u = EInstance.kind evd u in
+            evd,((cst, u) :: l)
 	   )
 	   (Evd.from_env (Global.env ()),[])
 	   fixpoint_exprl
@@ -426,7 +454,7 @@ let register_struct is_rec (fixpoint_exprl:(Vernacexpr.fixpoint_expr * Vernacexp
 
 let generate_correction_proof_wf f_ref tcc_lemma_ref
     is_mes functional_ref eq_ref rec_arg_num rec_arg_type nb_args relation
-    (_: int) (_:Names.constant array) (_:Term.constr array) (_:int) : Tacmach.tactic =
+    (_: int) (_:Names.Constant.t array) (_:EConstr.constr array) (_:int) : Tacmach.tactic =
   Functional_principles_proofs.prove_principle_for_gen
     (f_ref,functional_ref,eq_ref)
     tcc_lemma_ref is_mes  rec_arg_num rec_arg_type relation
@@ -435,11 +463,11 @@ let generate_correction_proof_wf f_ref tcc_lemma_ref
 let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas args ret_type body
     pre_hook
     =
-  let type_of_f = Constrexpr_ops.prod_constr_expr ret_type args in
+  let type_of_f = Constrexpr_ops.mkCProdN args ret_type in
   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
@@ -451,22 +479,21 @@ let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas
   in
   let unbounded_eq =
     let f_app_args =
-      Constrexpr.CAppExpl
-	(Loc.ghost,
-	 (None,(Ident (Loc.ghost,fname)),None) ,
+      CAst.make @@ Constrexpr.CAppExpl(
+         (None,CAst.make @@ Ident 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)
 	 )
 	)
     in
-    Constrexpr.CApp (Loc.ghost,(None,Constrexpr_ops.mkRefC (Qualid (Loc.ghost,(qualid_of_string "Logic.eq")))),
+    CAst.make @@ Constrexpr.CApp ((None,Constrexpr_ops.mkRefC (CAst.make @@ Qualid (qualid_of_string "Logic.eq"))),
 		    [(f_app_args,None);(body,None)])
   in
-  let eq = Constrexpr_ops.prod_constr_expr unbounded_eq args in
+  let eq = Constrexpr_ops.mkCProdN args unbounded_eq in
   let hook ((f_ref,_) as fconst) tcc_lemma_ref (functional_ref,_) (eq_ref,_) rec_arg_num rec_arg_type
       nb_args relation =
     try
@@ -495,7 +522,7 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
       | None ->
 	  begin
 	    match args with
-	      | [Constrexpr.LocalRawAssum ([(_,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 ->
@@ -503,15 +530,15 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
 	    match
 	      List.find
 		(function
-		   | Constrexpr.LocalRawAssum(l,k,t) ->
+		   | 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
 		)
 		args
 	    with
-	      | Constrexpr.LocalRawAssum(_,k,t)  ->	    t,wf_args
+	      | Constrexpr.CLocalAssum(_,k,t)  ->	    t,wf_args
 	      | _ -> assert false
 	  with Not_found -> assert false
   in
@@ -520,13 +547,13 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
       | None ->
 	  let ltof =
 	    let make_dir l = DirPath.make (List.rev_map Id.of_string l) in
-	    Libnames.Qualid (Loc.ghost,Libnames.qualid_of_path
+            CAst.make @@ Libnames.Qualid (Libnames.qualid_of_path
 			       (Libnames.make_path (make_dir ["Arith";"Wf_nat"]) (Id.of_string "ltof")))
 	  in
 	  let fun_from_mes =
 	    let applied_mes =
 	      Constrexpr_ops.mkAppC(wf_mes_expr,[Constrexpr_ops.mkIdentC wf_arg])    in
-	    Constrexpr_ops.mkLambdaC ([(Loc.ghost,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])
@@ -537,7 +564,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.ghost,Name a;Loc.ghost,Name b],
+              [CAst.make @@ Name a; CAst.make @@ Name b],
 	      Constrexpr.Default Explicit,
 	      wf_arg_type,
 	      Constrexpr_ops.mkAppC(wf_rel_expr,
@@ -557,60 +584,54 @@ let map_option f = function
   | Some v -> Some (f v)
 
 open Constrexpr
-open Topconstr
 
-let make_assoc assoc l1 l2 =
-  let fold assoc a b = match a, b with
-  | (_, Name na), (_, Name id) -> Id.Map.add na id assoc
-  | _, _ -> assoc
-  in
-  List.fold_left2 fold assoc l1 l2
-
-let rec rebuild_bl (aux,assoc) bl typ = 
-	match bl,typ with 
-	  | [], _ -> (List.rev aux,replace_vars_constr_expr assoc typ,assoc)
-	  | (Constrexpr.LocalRawAssum(nal,bk,_))::bl',typ ->
-	     rebuild_nal (aux,assoc) bk bl' nal (List.length nal) typ
-	  | (Constrexpr.LocalRawDef(na,_))::bl',Constrexpr.CLetIn(_,_,nat,typ') ->
-	    rebuild_bl ((Constrexpr.LocalRawDef(na,replace_vars_constr_expr assoc nat)::aux),assoc)
+let rec rebuild_bl aux bl typ =
+	match bl,typ with
+	  | [], _ -> List.rev aux,typ
+	  | (CLocalAssum(nal,bk,_))::bl',typ ->
+	     rebuild_nal aux bk bl' nal  typ
+	  | (CLocalDef(na,_,_))::bl',{ CAst.v = CLetIn(_,nat,ty,typ') } ->
+	    rebuild_bl (Constrexpr.CLocalDef(na,nat,ty)::aux)
 	      bl' typ'
 	  | _ -> assert false
-      and rebuild_nal (aux,assoc) bk bl' nal lnal typ = 
+and rebuild_nal aux bk bl' nal typ =
 	match nal,typ with 
-	  | [], _ -> rebuild_bl (aux,assoc) bl' typ
-	  | _,CProdN(_,[],typ) -> rebuild_nal (aux,assoc) bk bl' nal lnal typ
-	  | _,CProdN(_,(nal',bk',nal't)::rest,typ') -> 
-	    let lnal' = List.length nal' in 
-	    if lnal' >= lnal 
-	    then 
-	      let old_nal',new_nal' = List.chop lnal nal' in
-	      let nassoc = make_assoc assoc old_nal' nal in
-	      let assum = LocalRawAssum(nal,bk,replace_vars_constr_expr assoc nal't) in
-	      rebuild_bl ((assum :: aux), nassoc) bl' 
-		(if List.is_empty new_nal' && List.is_empty rest
-		 then typ'
-		 else if List.is_empty new_nal'
-		 then CProdN(Loc.ghost,rest,typ')
-		 else CProdN(Loc.ghost,((new_nal',bk',nal't)::rest),typ'))
-	    else 
-	      let captured_nal,non_captured_nal = List.chop lnal' nal in
-	      let nassoc = make_assoc assoc nal' captured_nal in
-	      let assum = LocalRawAssum(captured_nal,bk,replace_vars_constr_expr assoc nal't) in
-	      rebuild_nal ((assum :: aux), nassoc)
-		bk bl' non_captured_nal (lnal - lnal') (CProdN(Loc.ghost,rest,typ'))
-	  | _ -> assert false
-
-let rebuild_bl (aux,assoc) bl typ = rebuild_bl (aux,assoc) bl typ
+	  | _,{ CAst.v = CProdN([],typ) } -> rebuild_nal aux bk bl' nal typ
+	  | [], _ -> rebuild_bl aux bl' typ
+          | 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 (CLocalAssum(nal',bk',nal't)::rest) in
+	       rebuild_nal
+		 (assum::aux)
+		 bk
+		 bl'
+		 nal
+		 (CAst.make @@ CProdN(new_rest,typ'))
+	     else
+	       let assum = CLocalAssum([na'],bk,nal't) in
+               let new_rest = if nal' = [] then rest else (CLocalAssum(nal',bk',nal't)::rest) in
+	       rebuild_nal
+		 (assum::aux)
+		 bk
+		 bl'
+		 (na::nal)
+		 (CAst.make @@ CProdN(new_rest,typ'))
+	  | _ ->
+	     assert false
+
+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 (Constrextern.extern_constr false (Global.env ()) (Evd.from_ctx ctx))) typel in
+    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 = 
     List.map2 (fun ((lna,(rec_arg_opt,rec_order),bl,ret_typ,opt_body),notation_list) fix_typ -> 
      
-      let new_bl',new_ret_type,_ = rebuild_bl ([],Id.Map.empty) bl fix_typ in 
+      let new_bl',new_ret_type = rebuild_bl [] bl fix_typ in 
       (((lna,(rec_arg_opt,rec_order),new_bl',new_ret_type,opt_body),notation_list):(Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list))
     )
       fixpoint_exprl constr_expr_typel 
@@ -624,13 +645,13 @@ 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
 	  in 
 	  let fixpoint_exprl = [fixpoint_expr] in 
-	  let body = match body with | Some body -> body | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given") in 
+	  let body = match body with | Some body -> body | None -> user_err ~hdr:"Function" (str "Body of Function must be given") in 
 	  let recdefs,rec_impls = build_newrecursive fixpoint_exprl in
 	  let using_lemmas = [] in 
 	  let pre_hook pconstants =
@@ -645,10 +666,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
@@ -656,7 +677,7 @@ let do_generate_principle pconstants on_error register_built interactive_proof
 	  let fixpoint_exprl = [fixpoint_expr] in 
 	  let recdefs,rec_impls = build_newrecursive fixpoint_exprl in
 	  let using_lemmas = [] in
-	  let body = match body with | Some body -> body | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given") in 
+	  let body = match body with | Some body -> body | None -> user_err ~hdr:"Function" (str "Body of Function must be given") in 
 	  let pre_hook pconstants =
 	    generate_principle
 	      (ref (Evd.from_env (Global.env ())))
@@ -669,7 +690,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) ->
@@ -682,7 +703,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
@@ -708,67 +729,69 @@ let do_generate_principle pconstants on_error register_built interactive_proof
   in
   ()
 
-let rec add_args id new_args b =
-  match b with
-  | CRef (r,_) ->
-      begin      match r with
-	| Libnames.Ident(loc,fname) when Id.equal fname id ->
-	    CAppExpl(Loc.ghost,(None,r,None),new_args)
+let rec add_args id new_args = CAst.map (function
+  | CRef (r,_) as b ->
+      begin match r with
+        | {CAst.v=Libnames.Ident fname} when Id.equal fname id ->
+	    CAppExpl((None,r,None),new_args)
 	| _ -> b
       end
-  | CFix  _  | CCoFix _ -> anomaly ~label:"add_args " (Pp.str "todo")
-  | CProdN(loc,nal,b1) ->
-      CProdN(loc,
-	     List.map (fun (nal,k,b2) -> (nal,k,add_args id new_args b2)) nal,
+  | CFix  _  | CCoFix _ -> anomaly ~label:"add_args " (Pp.str "todo.")
+  | CProdN(nal,b1) ->
+        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(loc,nal,b1) ->
-      CLambdaN(loc,
-	       List.map (fun (nal,k,b2) -> (nal,k,add_args id new_args  b2)) nal,
+  | CLambdaN(nal,b1) ->
+      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(loc,na,b1,b2) ->
-      CLetIn(loc,na,add_args id new_args b1,add_args id new_args b2)
-  | CAppExpl(loc,(pf,r,us),exprl) ->
+  | 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)
+  | CAppExpl((pf,r,us),exprl) ->
       begin
 	match r with
-	| Libnames.Ident(loc,fname) when Id.equal fname id ->
-	    CAppExpl(loc,(pf,r,us),new_args@(List.map (add_args id new_args) exprl))
-	| _ -> CAppExpl(loc,(pf,r,us),List.map (add_args id new_args) exprl)
+        | {CAst.v=Libnames.Ident fname} when Id.equal fname id ->
+	    CAppExpl((pf,r,us),new_args@(List.map (add_args id new_args) exprl))
+	| _ -> CAppExpl((pf,r,us),List.map (add_args id new_args) exprl)
       end
-  | CApp(loc,(pf,b),bl) ->
-      CApp(loc,(pf,add_args id new_args b),
+  | CApp((pf,b),bl) ->
+      CApp((pf,add_args id new_args b),
 	   List.map (fun (e,o) -> add_args id new_args e,o) bl)
-  | CCases(loc,sty,b_option,cel,cal) ->
-      CCases(loc,sty,Option.map (add_args id new_args) b_option,
+  | CCases(sty,b_option,cel,cal) ->
+      CCases(sty,Option.map (add_args id new_args) b_option,
 	     List.map (fun (b,na,b_option) ->
 			 add_args id new_args b,
 			 na, b_option) cel,
-	     List.map (fun (loc,cpl,e) -> (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(loc,nal,(na,b_option),b1,b2) ->
-      CLetTuple(loc,nal,(na,Option.map (add_args id new_args) b_option),
+  | CLetTuple(nal,(na,b_option),b1,b2) ->
+      CLetTuple(nal,(na,Option.map (add_args id new_args) b_option),
 		add_args id new_args b1,
 		add_args id new_args b2
 	       )
 
-  | CIf(loc,b1,(na,b_option),b2,b3) ->
-      CIf(loc,add_args id new_args b1,
+  | CIf(b1,(na,b_option),b2,b3) ->
+      CIf(add_args id new_args b1,
 	  (na,Option.map (add_args id new_args) b_option),
 	  add_args id new_args b2,
 	  add_args id new_args b3
 	 )
-  | CHole _ -> b
-  | CPatVar _ -> b
-  | CEvar _ -> b
-  | CSort _ -> b
-  | CCast(loc,b1,b2)  ->
-      CCast(loc,add_args id new_args b1,
+  | CHole _
+  | CPatVar _
+  | CEvar _
+  | CPrim _
+  | CSort _ as b -> b
+  | CCast(b1,b2)  ->
+      CCast(add_args id new_args b1,
 	    Miscops.map_cast_type (add_args id new_args) b2)
-  | CRecord (loc, pars) ->
-      CRecord (loc, List.map (fun (e,o) -> e, add_args id new_args o) pars)
-  | CNotation _ -> anomaly ~label:"add_args " (Pp.str "CNotation")
-  | CGeneralization _ -> anomaly ~label:"add_args " (Pp.str "CGeneralization")
-  | CPrim _ -> b
-  | CDelimiters _ -> anomaly ~label:"add_args " (Pp.str "CDelimiters")
+  | CRecord pars ->
+      CRecord (List.map (fun (e,o) -> e, add_args id new_args o) pars)
+  | CNotation _ -> anomaly ~label:"add_args " (Pp.str "CNotation.")
+  | CGeneralization _ -> anomaly ~label:"add_args " (Pp.str "CGeneralization.")
+  | CDelimiters _ -> anomaly ~label:"add_args " (Pp.str "CDelimiters.")
+  )
 exception Stop of  Constrexpr.constr_expr
 
 
@@ -779,8 +802,8 @@ let rec chop_n_arrow n t =
   if n <= 0
   then t (* If we have already removed all the arrows then return the type *)
   else (* If not we check the form of [t] *)
-    match t with
-      | Constrexpr.CProdN(_,nal_ta',t') -> (* If we have a forall, to result are possible :
+    match t.CAst.v with
+      | 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
@@ -792,104 +815,103 @@ 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
 		      aux (n - nal_l) nal_ta'
 		    else
-		      let new_t' =
-			Constrexpr.CProdN(Loc.ghost,
-					((snd (List.chop n nal)),k,t'')::nal_ta',t')
+		      let new_t' = CAst.make @@
+			Constrexpr.CProdN(
+                                        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
 	      chop_n_arrow new_n t'
 	    with Stop t -> t
 	  end
-      | _ -> anomaly (Pp.str "Not enough products")
+      | _ -> anomaly (Pp.str "Not enough products.")
 
 
-let rec get_args b t : Constrexpr.local_binder list *
+let rec get_args b t : Constrexpr.local_binder_expr list *
     Constrexpr.constr_expr * Constrexpr.constr_expr =
-  match b with
-    | Constrexpr.CLambdaN (loc, (nal_ta), b') ->
+  match b.CAst.v with
+    | 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.LocalRawAssum (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 ("",str "Cannot find " ++ Printer.pr_lconstr (mkConst c)) )
-	  end
-      | _ -> raise (UserError ("", 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 !"
-     | Some body ->
+     | None -> error "Cannot build a graph over an axiom!"
+     | Some (body, _) ->
 	 let env = Global.env () in
 	 let sigma = Evd.from_env env in
 	 let extern_body,extern_type =
 	   with_full_print (fun () ->
-		(Constrextern.extern_constr false env sigma body,
+		(Constrextern.extern_constr false env sigma (EConstr.of_constr body),
 		 Constrextern.extern_type false env sigma
-                   ((*FIXME*) Typeops.type_of_constant_type env c_body.const_type)
+                   (EConstr.of_constr (*FIXME*) c_body.const_type)
 		)
 	     )
 	     ()
 	 in
 	 let (nal_tas,b,t)  = get_args extern_body extern_type in
 	 let expr_list =
-	   match b with
-	     | Constrexpr.CFix(loc,l_id,fixexprl) ->
+	   match b.CAst.v with
+	     | Constrexpr.CFix(l_id,fixexprl) ->
 		 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
 			       (function
-				  | Constrexpr.LocalRawDef (na,_)-> []
-				  | Constrexpr.LocalRawAssum (nal,_,_) ->
+				  | Constrexpr.CLocalDef (na,_,_)-> []
+				  | Constrexpr.CLocalAssum (nal,_,_) ->
 				      List.map
-					(fun (loc,n) ->
-					   CRef(Libnames.Ident(loc, Nameops.out_name n),None))
+                                        (fun {CAst.loc;v=n} -> CAst.make ?loc @@
+                                           CRef(CAst.make ?loc @@ Libnames.Ident(Nameops.Name.get_id n),None))
 					nal
-                                  | Constrexpr.LocalPattern _ -> assert false
+                                  | Constrexpr.CLocalPattern _ -> assert false
 			       )
 			       nal_tas
 			    )
 			in
-			let b' = add_args (snd id) new_args b in
-			((((id,None), ( Some (Loc.ghost,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 (con_label c) in
-		 [(((Loc.ghost,id),None),(None,Constrexpr.CStructRec),nal_tas,t,Some b),[]]
+		let id = Label.to_id (Constant.label c) in
+                 [((CAst.make id,None),(None,Constrexpr.CStructRec),nal_tas,t,Some b),[]]
 	 in
-	 let mp,dp,_ = repr_con c 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 (make_con 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.mli b/plugins/funind/indfun.mli
index 1c27bdfa..dcc1c2ea 100644
--- a/plugins/funind/indfun.mli
+++ b/plugins/funind/indfun.mli
@@ -1,8 +1,8 @@
 open Misctypes
 
-val warn_cannot_define_graph : ?loc:Loc.t -> Pp.std_ppcmds * Pp.std_ppcmds -> unit
+val warn_cannot_define_graph : ?loc:Loc.t -> Pp.t * Pp.t -> unit
 
-val warn_cannot_define_principle : ?loc:Loc.t -> Pp.std_ppcmds * Pp.std_ppcmds -> unit
+val warn_cannot_define_principle : ?loc:Loc.t -> Pp.t * Pp.t -> unit
 
 val do_generate_principle :  
   bool -> 
@@ -12,10 +12,10 @@ val do_generate_principle :
 
 val functional_induction :  
   bool ->
-  Term.constr ->
-  (Term.constr * Term.constr bindings) option ->
-  Tacexpr.or_and_intro_pattern option ->
-  Proof_type.goal Tacmach.sigma -> Proof_type.goal list Evd.sigma
+  EConstr.constr ->
+  (EConstr.constr * EConstr.constr bindings) option ->
+  Ltac_plugin.Tacexpr.or_and_intro_pattern option ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
 
 
 val make_graph :  Globnames.global_reference -> unit
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index f56e9241..a0b9217c 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)
 
@@ -21,19 +23,16 @@ let get_name avoid ?(default="H") = function
   | Name n -> Name n
 
 let array_get_start a =
-  try
-    Array.init
-      (Array.length a - 1)
-      (fun i -> a.(i))
-  with Invalid_argument "index out of bounds" ->
-    invalid_arg "array_get_start"
+  Array.init
+    (Array.length a - 1)
+    (fun i -> a.(i))
 
 let id_of_name = function
     Name id -> id
   | _ -> raise Not_found
 
 let locate  ref =
-    let (loc,qid) = qualid_of_reference ref in
+    let {CAst.v=qid} = qualid_of_reference ref in
     Nametab.locate qid
 
 let locate_ind ref =
@@ -49,7 +48,7 @@ let locate_constant ref =
 
 let locate_with_msg msg f x =
   try f x
-  with Not_found -> raise (CErrors.UserError("", msg))
+  with Not_found -> raise (CErrors.UserError(None, msg))
 
 
 let filter_map filter f =
@@ -69,11 +68,11 @@ let chop_rlambda_n  =
       if n == 0
       then List.rev acc,rt
       else
-	match rt with
-	  | Glob_term.GLambda(_,name,k,t,b) -> chop_lambda_n ((name,t,false)::acc) (n-1) b
-	  | Glob_term.GLetIn(_,name,v,b) -> chop_lambda_n ((name,v,true)::acc) (n-1) b
+	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
 	  | _ ->
-	      raise (CErrors.UserError("chop_rlambda_n",
+	      raise (CErrors.UserError(Some "chop_rlambda_n",
 				    str "chop_rlambda_n: Not enough Lambdas"))
   in
   chop_lambda_n []
@@ -83,9 +82,9 @@ let chop_rprod_n  =
       if n == 0
       then List.rev acc,rt
       else
-	match rt with
-	  | Glob_term.GProd(_,name,k,t,b) -> chop_prod_n ((name,t)::acc) (n-1) b
-	  | _ -> raise (CErrors.UserError("chop_rprod_n",str "chop_rprod_n: Not enough products"))
+	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
   chop_prod_n []
 
@@ -101,20 +100,15 @@ let list_union_eq eq_fun l1 l2 =
 let list_add_set_eq eq_fun x l =
   if List.exists (eq_fun x) l then l else x::l
 
-
-
-
 let const_of_id id =
-  let _,princ_ref =
-    qualid_of_reference (Libnames.Ident (Loc.ghost,id))
-  in
+  let princ_ref = qualid_of_ident id in
   try Constrintern.locate_reference princ_ref
   with Not_found ->
-    CErrors.errorlabstrm "IndFun.const_of_id"
-      (str "cannot find " ++ Nameops.pr_id id)
+    CErrors.user_err ~hdr:"IndFun.const_of_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
@@ -123,15 +117,16 @@ let def_of_const t =
     |_ -> assert false
 
 let coq_constant s =
-  Coqlib.gen_constant_in_modules "RecursiveDefinition"
+  Universes.constr_of_global @@
+  Coqlib.gen_reference_in_modules "RecursiveDefinition"
     Coqlib.init_modules s;;
 
 let find_reference sl s =
   let dp = Names.DirPath.make (List.rev_map Id.of_string sl) in
   Nametab.locate (make_qualid dp (Id.of_string s))
 
-let eq = lazy(coq_constant "eq")
-let refl_equal = lazy(coq_constant "eq_refl")
+let eq = lazy(EConstr.of_constr (coq_constant "eq"))
+let refl_equal = lazy(EConstr.of_constr (coq_constant "eq_refl"))
 
 (*****************************************************************)
 (* Copy of the standart save mechanism but without the much too  *)
@@ -162,7 +157,7 @@ let save with_clean id const (locality,_,kind) hook =
         let kn = declare_constant id ~local (DefinitionEntry const, k) in
 	(locality, ConstRef kn)
   in
-  if with_clean then  Pfedit.delete_current_proof ();
+  if with_clean then Proof_global.discard_current ();
   CEphemeron.iter_opt hook (fun f -> Lemmas.call_hook fix_exn f l r);
   definition_message id
 
@@ -174,7 +169,7 @@ let cook_proof _ =
 
 let get_proof_clean do_reduce =
   let result = cook_proof do_reduce in
-  Pfedit.delete_current_proof ();
+  Proof_global.discard_current ();
   result
 
 let with_full_print f a =
@@ -183,12 +178,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
@@ -197,6 +193,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
@@ -206,6 +203,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
 
@@ -218,14 +216,14 @@ let with_full_print f a =
 
 type function_info =
     {
-      function_constant : constant;
+      function_constant : Constant.t;
       graph_ind : inductive;
-      equation_lemma : constant option;
-      correctness_lemma : constant option;
-      completeness_lemma : constant option;
-      rect_lemma : constant option;
-      rec_lemma : constant option;
-      prop_lemma : constant option;
+      equation_lemma : Constant.t option;
+      correctness_lemma : Constant.t option;
+      completeness_lemma : Constant.t option;
+      rect_lemma : Constant.t option;
+      rec_lemma : Constant.t option;
+      prop_lemma : Constant.t option;
       is_general : bool; (* Has this function been defined using general recursive definition *)
     }
 
@@ -332,18 +330,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
-       (Global.type_of_global_unsafe (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 () ++
@@ -351,7 +349,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
@@ -371,7 +369,7 @@ let in_Function : function_info -> Libobject.obj =
 
 let find_or_none id =
   try Some
-    (match Nametab.locate (qualid_of_ident id) with ConstRef c -> c | _ -> CErrors.anomaly (Pp.str "Not a constant")
+    (match Nametab.locate (qualid_of_ident id) with ConstRef c -> c | _ -> CErrors.anomaly (Pp.str "Not a constant.")
     )
   with Not_found -> None
 
@@ -390,7 +388,7 @@ let update_Function finfo =
 			 
 
 let add_Function is_general f =
-  let f_id = Label.to_id (con_label f) in
+  let f_id = Label.to_id (Constant.label f) in
   let equation_lemma = find_or_none (mk_equation_id f_id)
   and correctness_lemma = find_or_none (mk_correct_id f_id)
   and completeness_lemma = find_or_none (mk_complete_id f_id)
@@ -399,7 +397,7 @@ let add_Function is_general f =
   and prop_lemma = find_or_none (Nameops.add_suffix f_id "_ind")
   and graph_ind =
     match Nametab.locate (qualid_of_ident (mk_rel_id f_id))
-    with | IndRef ind -> ind | _ -> CErrors.anomaly (Pp.str "Not an inductive")
+    with | IndRef ind -> ind | _ -> CErrors.anomaly (Pp.str "Not an inductive.")
   in
   let finfos =
     { function_constant = f;
@@ -425,7 +423,6 @@ open Goptions
 
 let functional_induction_rewrite_dependent_proofs_sig = 
   {
-    optsync = false;
     optdepr = false;
     optname = "Functional Induction Rewrite Dependent";
     optkey =  ["Functional";"Induction";"Rewrite";"Dependent"];
@@ -438,7 +435,6 @@ let do_rewrite_dependent () = !functional_induction_rewrite_dependent_proofs = t
 
 let function_debug_sig =
   {
-    optsync = false;
     optdepr = false;
     optname = "Function debug";
     optkey =  ["Function_debug"];
@@ -457,7 +453,6 @@ let strict_tcc = ref false
 let is_strict_tcc () = !strict_tcc
 let strict_tcc_sig =
   {
-    optsync = false;
     optdepr = false;
     optname = "Raw Function Tcc";
     optkey =  ["Function_raw_tcc"];
@@ -475,13 +470,17 @@ exception ToShow of exn
 let jmeq () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
-    Coqlib.gen_constant "Function" ["Logic";"JMeq"] "JMeq"
+    EConstr.of_constr @@
+    Universes.constr_of_global @@
+      Coqlib.coq_reference "Function" ["Logic";"JMeq"] "JMeq"
   with e when CErrors.noncritical e -> raise (ToShow e)
 
 let jmeq_refl () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
-    Coqlib.gen_constant "Function" ["Logic";"JMeq"] "JMeq_refl"
+    EConstr.of_constr @@
+    Universes.constr_of_global @@
+      Coqlib.coq_reference "Function" ["Logic";"JMeq"] "JMeq_refl"
   with e when CErrors.noncritical e -> raise (ToShow e)
 
 let h_intros l =
@@ -489,10 +488,13 @@ let h_intros l =
 
 let h_id = Id.of_string "h"
 let hrec_id = Id.of_string "hrec"
-let well_founded = function () -> (coq_constant "well_founded")
-let acc_rel = function () -> (coq_constant "Acc")
-let acc_inv_id = function () -> (coq_constant "Acc_inv")
-let well_founded_ltof = function () ->  (Coqlib.coq_constant "" ["Arith";"Wf_nat"] "well_founded_ltof")
+let well_founded = function () -> EConstr.of_constr (coq_constant "well_founded")
+let acc_rel = function () -> EConstr.of_constr (coq_constant "Acc")
+let acc_inv_id = function () -> EConstr.of_constr (coq_constant "Acc_inv")
+
+let well_founded_ltof () = EConstr.of_constr @@ Universes.constr_of_global @@
+    Coqlib.coq_reference "" ["Arith";"Wf_nat"] "well_founded_ltof"
+
 let ltof_ref = function  () -> (find_reference ["Coq";"Arith";"Wf_nat"] "ltof")
 
 let evaluable_of_global_reference r = (* Tacred.evaluable_of_global_reference (Global.env ()) *)
@@ -501,8 +503,58 @@ let evaluable_of_global_reference r = (* Tacred.evaluable_of_global_reference (G
     | VarRef id -> EvalVarRef id
     | _ -> assert false;;
 
-let list_rewrite (rev:bool) (eqs: (constr*bool) list) =
+let list_rewrite (rev:bool) (eqs: (EConstr.constr*bool) list) =
   tclREPEAT
     (List.fold_right
        (fun (eq,b) i -> tclORELSE (Proofview.V82.of_tactic ((if b then Equality.rewriteLR else Equality.rewriteRL) eq)) i)
        (if rev then (List.rev eqs) else eqs) (tclFAIL 0 (mt())));;
+
+let decompose_lam_n sigma n =
+  if n < 0 then CErrors.user_err Pp.(str "decompose_lam_n: integer parameter must be positive");
+  let rec lamdec_rec l n c =
+    if Int.equal n 0 then l,c
+    else match EConstr.kind sigma c with
+      | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) (n-1) c
+      | Cast (c,_,_)     -> lamdec_rec l n c
+      | _ -> CErrors.user_err Pp.(str "decompose_lam_n: not enough abstractions")
+  in
+  lamdec_rec [] n
+
+let lamn n env b =
+  let open EConstr in
+  let rec lamrec = function
+    | (0, env, b)        -> b
+    | (n, ((v,t)::l), b) -> lamrec (n-1,  l, mkLambda (v,t,b))
+    | _ -> assert false
+  in
+  lamrec (n,env,b)
+
+(* compose_lam [xn:Tn;..;x1:T1] b = [x1:T1]..[xn:Tn]b *)
+let compose_lam l b = lamn (List.length l) l b
+
+(* prodn n [xn:Tn;..;x1:T1;Gamma] b = (x1:T1)..(xn:Tn)b *)
+let prodn n env b =
+  let open EConstr in
+  let rec prodrec = function
+    | (0, env, b)        -> b
+    | (n, ((v,t)::l), b) -> prodrec (n-1,  l, mkProd (v,t,b))
+    | _ -> assert false
+  in
+  prodrec (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 =
+  | Undefined
+  | 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 e5c756f5..5cc7163a 100644
--- a/plugins/funind/indfun_common.mli
+++ b/plugins/funind/indfun_common.mli
@@ -1,5 +1,4 @@
 open Names
-open Pp
 
 (*
    The mk_?_id function build different name w.r.t. a function
@@ -11,7 +10,7 @@ val mk_complete_id : Id.t -> Id.t
 val mk_equation_id : Id.t -> Id.t
 
 
-val msgnl : std_ppcmds -> unit
+val msgnl : Pp.t -> unit
 
 val fresh_id : Id.t list -> string -> Id.t
 val fresh_name : Id.t list -> string -> Name.t
@@ -22,9 +21,9 @@ val array_get_start : 'a array -> 'a array
 val id_of_name : Name.t -> Id.t
 
 val locate_ind : Libnames.reference -> inductive
-val locate_constant : Libnames.reference -> constant
+val locate_constant : Libnames.reference -> Constant.t
 val locate_with_msg :
-  Pp.std_ppcmds -> (Libnames.reference -> 'a) ->
+  Pp.t -> (Libnames.reference -> 'a) ->
   Libnames.reference -> 'a
 
 val filter_map : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list
@@ -34,17 +33,17 @@ val list_add_set_eq :
   ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
 
 val chop_rlambda_n : int -> Glob_term.glob_constr ->
-  (Name.t*Glob_term.glob_constr*bool) list * Glob_term.glob_constr
+  (Name.t*Glob_term.glob_constr*Glob_term.glob_constr option) list * 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 eq : Term.constr Lazy.t
-val refl_equal : Term.constr Lazy.t
+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 *)
-val jmeq : unit -> Term.constr
-val jmeq_refl : unit -> Term.constr
+val jmeq : unit -> EConstr.constr
+val jmeq_refl : unit -> EConstr.constr
 
 val save : bool -> Id.t -> Safe_typing.private_constants Entries.definition_entry  -> Decl_kinds.goal_kind ->
   unit Lemmas.declaration_hook CEphemeron.key -> unit
@@ -69,28 +68,28 @@ val with_full_print : ('a -> 'b) -> 'a -> 'b
 
 type function_info =
     {
-      function_constant : constant;
+      function_constant : Constant.t;
       graph_ind : inductive;
-      equation_lemma : constant option;
-      correctness_lemma : constant option;
-      completeness_lemma : constant option;
-      rect_lemma : constant option;
-      rec_lemma : constant option;
-      prop_lemma : constant option;
+      equation_lemma : Constant.t option;
+      correctness_lemma : Constant.t option;
+      completeness_lemma : Constant.t option;
+      rect_lemma : Constant.t option;
+      rec_lemma : Constant.t option;
+      prop_lemma : Constant.t option;
       is_general : bool;
     }
 
-val find_Function_infos : constant -> function_info
+val find_Function_infos : Constant.t -> function_info
 val find_Function_of_graph : inductive -> function_info
 (* WARNING: To be used just after the graph definition !!! *)
-val add_Function : bool -> constant -> unit
+val add_Function : bool -> Constant.t -> unit
 
 val update_Function : function_info -> unit
 
 
 (** debugging *)
-val pr_info : function_info -> Pp.std_ppcmds
-val pr_table : unit -> Pp.std_ppcmds
+val pr_info : function_info -> Pp.t
+val pr_table : unit -> Pp.t
 
 
 (* val function_debug : bool ref  *)
@@ -104,13 +103,25 @@ exception ToShow of exn
 
 val is_strict_tcc : unit -> bool
 
-val h_intros: Names.Id.t list -> Proof_type.tactic
+val h_intros: Names.Id.t list -> Tacmach.tactic
 val h_id :  Names.Id.t
 val hrec_id :  Names.Id.t
-val acc_inv_id :  Term.constr Util.delayed
+val acc_inv_id :  EConstr.constr Util.delayed
 val ltof_ref : Globnames.global_reference Util.delayed
-val well_founded_ltof : Term.constr Util.delayed
-val acc_rel : Term.constr Util.delayed
-val well_founded : Term.constr Util.delayed
+val well_founded_ltof : EConstr.constr Util.delayed
+val acc_rel : EConstr.constr Util.delayed
+val well_founded : EConstr.constr Util.delayed
 val evaluable_of_global_reference : Globnames.global_reference -> Names.evaluable_global_reference
-val list_rewrite : bool -> (Term.constr*bool) list -> Proof_type.tactic
+val list_rewrite : bool -> (EConstr.constr*bool) list -> Tacmach.tactic
+
+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 =
+  | Undefined
+  | 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 26fc88a6..bed95740 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -1,17 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Tacexpr
+open Ltac_plugin
 open Declarations
 open CErrors
 open Util
 open Names
 open Term
+open Constr
+open EConstr
 open Vars
 open Pp
 open Globnames
@@ -23,30 +27,7 @@ open Misctypes
 open Termops
 open Context.Rel.Declaration
 
-(* Some pretty printing function for debugging purpose *)
-
-let pr_binding prc  =
-  function
-    | loc, NamedHyp id, c -> hov 1 (Ppconstr.pr_id id ++ str " := " ++ Pp.cut () ++ prc c)
-    | loc, AnonHyp n, c -> hov 1 (int n ++ str " := " ++ Pp.cut () ++ prc c)
-
-let pr_bindings prc prlc = function
-  | ImplicitBindings l ->
-      brk (1,1) ++ str "with" ++ brk (1,1) ++
-      pr_sequence prc l
-  | ExplicitBindings l ->
-      brk (1,1) ++ str "with" ++ brk (1,1) ++
-        pr_sequence (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
-  | NoBindings -> mt ()
-
-
-let pr_with_bindings prc prlc (c,bl) =
-  prc c ++ hv 0 (pr_bindings prc prlc bl)
-
-
-
-let pr_constr_with_binding prc (c,bl) :  Pp.std_ppcmds =
-  pr_with_bindings prc prc  (c,bl)
+module RelDecl = Context.Rel.Declaration
 
 (* The local debugging mechanism *)
 (* let msgnl = Pp.msgnl *)
@@ -77,12 +58,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
@@ -106,12 +81,8 @@ let thin ids gl = Proofview.V82.of_tactic (Tactics.clear ids) gl
 
 let make_eq () =
   try
-    Universes.constr_of_global (Coqlib.build_coq_eq ())
+    EConstr.of_constr (Universes.constr_of_global (Coqlib.build_coq_eq ()))
   with _ -> assert false 
-let make_eq_refl () =
-  try
-    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]
@@ -129,15 +100,16 @@ let make_eq_refl () =
 let generate_type evd g_to_f f graph i =
   (*i we deduce the number of arguments of the function and its returned type from the graph i*)
   let evd',graph =
-    Evd.fresh_global  (Global.env ()) !evd  (Globnames.IndRef (fst (destInd graph)))
+    Evd.fresh_global  (Global.env ()) !evd  (Globnames.IndRef (fst (destInd !evd graph)))
   in
+  let graph = EConstr.of_constr graph in
   evd:=evd';
   let graph_arity = Typing.e_type_of (Global.env ()) evd graph in
-  let ctxt,_ = decompose_prod_assum graph_arity in
+  let ctxt,_ = decompose_prod_assum !evd graph_arity in
   let fun_ctxt,res_type =
     match ctxt with
-      | [] | [_] -> anomaly (Pp.str "Not a valid context")
-      | decl :: fun_ctxt -> fun_ctxt, get_type decl
+      | [] | [_] -> anomaly (Pp.str "Not a valid context.")
+      | decl :: fun_ctxt -> fun_ctxt, RelDecl.get_type decl
   in
   let rec args_from_decl i accu = function
   | [] -> accu
@@ -148,13 +120,13 @@ let generate_type evd g_to_f f graph i =
     args_from_decl (succ i) (t :: accu) l
   in
   (*i We need to name the vars [res] and [fv] i*)
-  let filter = fun decl -> match get_name decl with
+  let filter = fun decl -> match RelDecl.get_name decl with
 			   | Name id -> Some id
 			   | Anonymous -> None
   in
-  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
@@ -191,15 +163,16 @@ let generate_type evd g_to_f f graph i =
    WARNING: while convertible, [type_of body] and [type] can be non equal
 *)
 let find_induction_principle evd f =
-  let f_as_constant,u =  match kind_of_term f with
+  let f_as_constant,u =  match EConstr.kind !evd f with
     | Const c' -> c'
-    | _ -> error "Must be used with a function"
+    | _ -> user_err Pp.(str "Must be used with a function")
   in
   let infos = find_Function_infos f_as_constant in
   match infos.rect_lemma with
     | None -> raise Not_found
     | Some rect_lemma ->
        let evd',rect_lemma = Evd.fresh_global  (Global.env ()) !evd  (Globnames.ConstRef rect_lemma) in
+       let rect_lemma = EConstr.of_constr rect_lemma in
        let evd',typ = Typing.type_of ~refresh:true (Global.env ()) evd' rect_lemma in
        evd:=evd';
        rect_lemma,typ
@@ -209,14 +182,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.
 
@@ -237,29 +209,29 @@ 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 : 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~:
        \[fun (x_1:t_1)\ldots(x_n:t_n)=> fun  fv => fun res => res = fv \rightarrow graph\ x_1\ldots x_n\ res\]
     *)
     (* we the get the definition of the graphs block *)
-    let graph_ind,u = destInd graphs_constr.(i) in
+    let graph_ind,u = destInd evd graphs_constr.(i) in
     let kn = fst graph_ind in
     let mib,_ = Global.lookup_inductive graph_ind in
     (* and the principle to use in this lemma in $\zeta$ normal form *)
     let f_principle,princ_type = schemes.(i) in
     let princ_type =  nf_zeta princ_type in
-    let princ_infos = Tactics.compute_elim_sig princ_type in
+    let princ_infos = Tactics.compute_elim_sig evd princ_type in
     (* The number of args of the function is then easily computable *)
-    let nb_fun_args = nb_prod (pf_concl g)  - 2  in
+    let nb_fun_args = nb_prod (project g) (pf_concl g) - 2 in
     let args_names = generate_fresh_id (Id.of_string "x") [] nb_fun_args in
     let ids = args_names@(pf_ids_of_hyps g) in
     (* Since we cannot ensure that the functional principle is defined in the
        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
@@ -268,14 +240,14 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       List.map
 	(fun decl ->
 	   List.map
-	     (fun id -> Loc.ghost, IntroNaming (IntroIdentifier id))
-	     (generate_fresh_id (Id.of_string "y") ids (List.length (fst (decompose_prod_assum (get_type decl)))))
+             (fun id -> CAst.make @@ IntroNaming (IntroIdentifier id))
+	     (generate_fresh_id (Id.of_string "y") ids (List.length (fst (decompose_prod_assum evd (RelDecl.get_type decl)))))
 	)
 	branches
     in
     (* before building the full intro pattern for the principle *)
     let eq_ind = make_eq () in
-    let eq_construct = mkConstructUi (destInd eq_ind, 1) in
+    let eq_construct = mkConstructUi (destInd evd eq_ind, 1) in
     (* The next to referencies will be used to find out which constructor to apply in each branch *)
     let ind_number = ref 0
     and min_constr_number = ref 0 in
@@ -284,10 +256,10 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       (* We get the identifiers of this branch *)
       let pre_args =
       	List.fold_right
-      	  (fun (_,pat) acc ->
+          (fun {CAst.v=pat} acc ->
       	     match pat with
 	       | IntroNaming (IntroIdentifier id) -> id::acc
-      	       | _ -> anomaly (Pp.str "Not an identifier")
+      	       | _ -> anomaly (Pp.str "Not an identifier.")
       	  )
       	  (List.nth intro_pats (pred i))
       	  []
@@ -304,17 +276,18 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
 	List.fold_right 
 	  (fun hid acc ->
 	     let type_of_hid = pf_unsafe_type_of g (mkVar hid) in
-	     match kind_of_term type_of_hid with
+	     let sigma = project g in
+	     match EConstr.kind sigma type_of_hid with
 	       | Prod(_,_,t') ->
 		   begin
-		     match kind_of_term t' with
+		     match EConstr.kind sigma t' with
 		       | Prod(_,t'',t''') ->
 			   begin
-			     match kind_of_term t'',kind_of_term t''' with
+			     match EConstr.kind sigma t'',EConstr.kind sigma t''' with
 			       | App(eq,args), App(graph',_)
 				   when
-				     (eq_constr eq eq_ind) &&
-				       Array.exists  (Constr.eq_constr_nounivs graph') graphs_constr ->
+				     (EConstr.eq_constr sigma eq eq_ind) &&
+				       Array.exists  (EConstr.eq_constr_nounivs sigma graph') graphs_constr ->
 				   (args.(2)::(mkApp(mkVar hid,[|args.(2);(mkApp(eq_construct,[|args.(0);args.(2)|]))|]))
 				    ::acc)
 			       | _ -> mkVar hid ::  acc
@@ -360,7 +333,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       in
       (* observe (str "constructor := " ++ Printer.pr_lconstr_env (pf_env g) app_constructor); *)
       (
-	tclTHENSEQ
+	tclTHENLIST
 	  [
 	    observe_tac("h_intro_patterns ")  (let l = (List.nth intro_pats (pred i)) in 
 					       match l with 
@@ -379,7 +352,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
 	      Locusops.onConcl);
 	    observe_tac ("toto ") tclIDTAC;
     
-	    (* introducing the the result of the graph and the equality hypothesis *)
+            (* introducing the result of the graph and the equality hypothesis *)
 	    observe_tac "introducing" (tclMAP (fun x -> Proofview.V82.of_tactic (Simple.intro x)) [res;hres]);
 	    (* replacing [res] with its value *)
 	    observe_tac "rewriting res value" (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar hres)));
@@ -395,11 +368,11 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       Array.map
 	(fun ((_,(ctxt,concl))) ->
 	   match ctxt with
-	     | [] | [_] | [_;_] -> anomaly (Pp.str "bad context")
+	     | [] | [_] | [_;_] -> anomaly (Pp.str "bad context.")
 	     | hres::res::decl::ctxt ->
-		let res = Termops.it_mkLambda_or_LetIn
-			    (Termops.it_mkProd_or_LetIn concl [hres;res])
-			    (LocalAssum (get_name decl, get_type decl) :: ctxt)
+		let res = EConstr.it_mkLambda_or_LetIn
+			    (EConstr.it_mkProd_or_LetIn concl [hres;res])
+			    (LocalAssum (RelDecl.get_name decl, RelDecl.get_type decl) :: ctxt)
 		in
 		res
 	)
@@ -415,7 +388,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       let params_bindings,avoid =
 	List.fold_left2
 	  (fun (bindings,avoid) decl p ->
-	     let id = Namegen.next_ident_away (Nameops.out_name (get_name decl)) avoid in
+	     let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) (Id.Set.of_list avoid) in
 	     p::bindings,id::avoid
 	  )
 	  ([],pf_ids_of_hyps g)
@@ -425,7 +398,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       let lemmas_bindings =
 	List.rev (fst  (List.fold_left2
 	  (fun (bindings,avoid) decl p ->
-	     let id = Namegen.next_ident_away (Nameops.out_name (get_name decl)) avoid in
+	     let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) (Id.Set.of_list avoid) in
 	     (nf_zeta p)::bindings,id::avoid)
 	  ([],avoid)
 	  princ_infos.predicates
@@ -433,7 +406,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       in
       (params_bindings@lemmas_bindings)
     in
-    tclTHENSEQ
+    tclTHENLIST
       [ 
 	observe_tac "principle" (Proofview.V82.of_tactic (assert_by
 	  (Name principle_id)
@@ -465,7 +438,7 @@ let generalize_dependent_of x hyp g =
   tclMAP
     (function
        | LocalAssum (id,t) when not (Id.equal id hyp) &&
-	   (Termops.occur_var (pf_env g) x t) -> tclTHEN (Proofview.V82.of_tactic (Tactics.generalize [mkVar id])) (thin [id])
+	   (Termops.occur_var (pf_env g) (project g) x t) -> tclTHEN (Proofview.V82.of_tactic (Tactics.generalize [mkVar id])) (thin [id])
        | _ -> tclIDTAC
     )
     (pf_hyps g)
@@ -486,46 +459,47 @@ let tauto =
 
 let  rec intros_with_rewrite g =
   observe_tac "intros_with_rewrite" intros_with_rewrite_aux g
-and intros_with_rewrite_aux : tactic =
+and intros_with_rewrite_aux : Tacmach.tactic =
   fun g ->
     let eq_ind = make_eq () in
-    match kind_of_term (pf_concl g) with
+    let sigma = project g in
+    match EConstr.kind sigma (pf_concl g) with
 	  | Prod(_,t,t') ->
 	      begin
-		match kind_of_term t with
-		  | App(eq,args) when (eq_constr eq eq_ind)  ->
+		match EConstr.kind sigma t with
+		  | App(eq,args) when (EConstr.eq_constr sigma eq eq_ind)  ->
  		      if Reductionops.is_conv (pf_env g) (project g) args.(1) args.(2)
 		      then
 			let id = pf_get_new_id (Id.of_string "y") g  in
-			tclTHENSEQ [ Proofview.V82.of_tactic (Simple.intro id); thin [id]; intros_with_rewrite ] g
-		      else if isVar args.(1) && (Environ.evaluable_named (destVar args.(1)) (pf_env g)) 
-		      then tclTHENSEQ[
-			Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalVarRef (destVar args.(1)))]);
-			tclMAP (fun id -> tclTRY(Proofview.V82.of_tactic (unfold_in_hyp [(Locus.AllOccurrences, Names.EvalVarRef (destVar args.(1)))] ((destVar args.(1)),Locus.InHyp) )))
+			tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id); thin [id]; intros_with_rewrite ] g
+		      else if isVar sigma args.(1) && (Environ.evaluable_named (destVar sigma args.(1)) (pf_env g)) 
+		      then tclTHENLIST[
+			Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(1)))]);
+			tclMAP (fun id -> tclTRY(Proofview.V82.of_tactic (unfold_in_hyp [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(1)))] ((destVar sigma args.(1)),Locus.InHyp) )))
 			  (pf_ids_of_hyps g);
 			intros_with_rewrite
 		      ] g
-		      else if isVar args.(2) && (Environ.evaluable_named (destVar args.(2)) (pf_env g)) 
-		      then tclTHENSEQ[
-			Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalVarRef (destVar args.(2)))]);
-			tclMAP (fun id -> tclTRY(Proofview.V82.of_tactic (unfold_in_hyp [(Locus.AllOccurrences, Names.EvalVarRef (destVar args.(2)))] ((destVar args.(2)),Locus.InHyp) )))
+		      else if isVar sigma args.(2) && (Environ.evaluable_named (destVar sigma args.(2)) (pf_env g)) 
+		      then tclTHENLIST[
+			Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(2)))]);
+			tclMAP (fun id -> tclTRY(Proofview.V82.of_tactic (unfold_in_hyp [(Locus.AllOccurrences, Names.EvalVarRef (destVar sigma args.(2)))] ((destVar sigma args.(2)),Locus.InHyp) )))
 			  (pf_ids_of_hyps g);
 			intros_with_rewrite
 		      ] g
-		      else if isVar args.(1)
+		      else if isVar sigma args.(1)
 		      then
 			let id = pf_get_new_id (Id.of_string "y") g  in
-			tclTHENSEQ [ Proofview.V82.of_tactic (Simple.intro id);
-				     generalize_dependent_of (destVar args.(1)) id;
+			tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id);
+				     generalize_dependent_of (destVar sigma args.(1)) id;
 				     tclTRY (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar id)));
 				     intros_with_rewrite
 				   ]
 			  g
-		      else if isVar args.(2) 
+		      else if isVar sigma args.(2) 
 		      then 
 			let id = pf_get_new_id (Id.of_string "y") g  in
-			tclTHENSEQ [ Proofview.V82.of_tactic (Simple.intro id);
-				     generalize_dependent_of (destVar args.(2)) id;
+			tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id);
+				     generalize_dependent_of (destVar sigma args.(2)) id;
 				     tclTRY (Proofview.V82.of_tactic (Equality.rewriteRL (mkVar id)));
 				     intros_with_rewrite
 				   ]
@@ -533,21 +507,21 @@ and intros_with_rewrite_aux : tactic =
 		      else
 			begin
 			  let id = pf_get_new_id (Id.of_string "y") g  in
-			  tclTHENSEQ[
+			  tclTHENLIST[
 			    Proofview.V82.of_tactic (Simple.intro id);
 			    tclTRY (Proofview.V82.of_tactic (Equality.rewriteLR (mkVar id)));
 			    intros_with_rewrite
 			  ] g
 			end
-		  | Ind _ when eq_constr t (Coqlib.build_coq_False ()) ->
+		  | Ind _ when EConstr.eq_constr sigma t (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_False ())) ->
 		      Proofview.V82.of_tactic tauto g
 		  | Case(_,_,v,_) ->
-		      tclTHENSEQ[
+		      tclTHENLIST[
 			Proofview.V82.of_tactic (simplest_case v);
 			intros_with_rewrite
 		      ] g
 		  | LetIn _ ->
-		      tclTHENSEQ[
+		      tclTHENLIST[
 			Proofview.V82.of_tactic (reduce
 			  (Genredexpr.Cbv
 			     {Redops.all_flags
@@ -559,10 +533,10 @@ and intros_with_rewrite_aux : tactic =
 		      ] g
 		  | _ ->
 		      let id = pf_get_new_id (Id.of_string "y") g  in
-		      tclTHENSEQ [ Proofview.V82.of_tactic (Simple.intro id);intros_with_rewrite] g
+		      tclTHENLIST [ Proofview.V82.of_tactic (Simple.intro id);intros_with_rewrite] g
 	      end
 	  | LetIn _ ->
-	      tclTHENSEQ[
+	      tclTHENLIST[
 		Proofview.V82.of_tactic (reduce
 		  (Genredexpr.Cbv
 		     {Redops.all_flags
@@ -577,9 +551,9 @@ and intros_with_rewrite_aux : tactic =
 let rec reflexivity_with_destruct_cases g =
   let destruct_case () =
     try
-      match kind_of_term (snd (destApp (pf_concl g))).(2) with
+      match EConstr.kind (project g) (snd (destApp (project g) (pf_concl g))).(2) with
 	| Case(_,_,v,_) ->
-	    tclTHENSEQ[
+	    tclTHENLIST[
 	      Proofview.V82.of_tactic (simplest_case v);
 	      Proofview.V82.of_tactic intros;
 	      observe_tac "reflexivity_with_destruct_cases" reflexivity_with_destruct_cases
@@ -588,18 +562,23 @@ 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 ->
 	 match sc with
 	     None -> tclIDTAC g
 	   | Some id ->
-	       match kind_of_term  (pf_unsafe_type_of g (mkVar id)) with
-		 | App(eq,[|_;t1;t2|]) when eq_constr eq eq_ind ->
+	       match EConstr.kind (project g) (pf_unsafe_type_of g (mkVar id)) with
+		 | 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 tclTHENSEQ [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
     )
@@ -646,25 +625,25 @@ let rec reflexivity_with_destruct_cases g =
 *)
 
 
-let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
+let prove_fun_complete funcs graphs schemes lemmas_types_infos i : Tacmach.tactic =
   fun g ->
     (* We compute the types of the different mutually recursive lemmas
        in $\zeta$ normal form
     *)
     let lemmas =
       Array.map
-	(fun (_,(ctxt,concl)) -> nf_zeta (Termops.it_mkLambda_or_LetIn concl ctxt))
+	(fun (_,(ctxt,concl)) -> nf_zeta (EConstr.it_mkLambda_or_LetIn concl ctxt))
 	lemmas_types_infos
     in
     (* We get the constant and the principle corresponding to this lemma *)
     let f = funcs.(i) in
-    let graph_principle = nf_zeta schemes.(i)  in
+    let graph_principle = nf_zeta (EConstr.of_constr schemes.(i))  in
     let princ_type = pf_unsafe_type_of g graph_principle in
-    let princ_infos = Tactics.compute_elim_sig princ_type in
+    let princ_infos = Tactics.compute_elim_sig (project g) princ_type in
     (* Then we get the number of argument of the function
        and compute a fresh name for each of them
     *)
-    let nb_fun_args = nb_prod (pf_concl g)  - 2  in
+    let nb_fun_args = nb_prod (project g) (pf_concl g) - 2 in
     let args_names = generate_fresh_id (Id.of_string "x") [] nb_fun_args in
     let ids = args_names@(pf_ids_of_hyps g) in
     (* and fresh names for res H and the principle (cf bug bug #1174) *)
@@ -682,7 +661,7 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
 	(fun decl ->
 	   List.map
 	     (fun id -> id)
-	     (generate_fresh_id (Id.of_string "y") ids (nb_prod (get_type decl)))
+	     (generate_fresh_id (Id.of_string "y") ids (nb_prod (project g) (RelDecl.get_type decl)))
 	)
 	branches
     in
@@ -690,20 +669,20 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
        using [f_equation] if it is recursive (that is the graph is infinite
        or unfold if the graph is finite
     *)
-    let rewrite_tac j ids : tactic =
+    let rewrite_tac j ids : Tacmach.tactic =
       let graph_def = graphs.(j) in
       let infos =
-        try find_Function_infos (fst (destConst funcs.(j)))
-        with Not_found ->  error "No graph found"
+        try find_Function_infos (fst (destConst (project g) funcs.(j)))
+        with Not_found ->  user_err Pp.(str "No graph found")
       in
       if infos.is_general
         || Rtree.is_infinite Declareops.eq_recarg graph_def.mind_recargs
       then
 	let eq_lemma =
 	  try Option.get (infos).equation_lemma
-	  with Option.IsNone -> anomaly (Pp.str "Cannot find equation lemma")
+	  with Option.IsNone -> anomaly (Pp.str "Cannot find equation lemma.")
 	in
-	tclTHENSEQ[
+	tclTHENLIST[
 	  tclMAP (fun id -> Proofview.V82.of_tactic (Simple.intro id)) ids;
 	  Proofview.V82.of_tactic (Equality.rewriteLR (mkConst eq_lemma));
 	  (* Don't forget to $\zeta$ normlize the term since the principles
@@ -719,7 +698,7 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
 	  thin ids
 	]
       else
-        Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalConstRef (fst (destConst f)))])
+        Proofview.V82.of_tactic (unfold_in_concl [(Locus.AllOccurrences, Names.EvalConstRef (fst (destConst (project g) f)))])
     in
     (* The proof of each branche itself *)
     let ind_number = ref 0 in
@@ -739,7 +718,7 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
 	  end
       in
       let this_branche_ids = List.nth intro_pats (pred i) in
-      tclTHENSEQ[
+      tclTHENLIST[
 	(* we expand the definition of the function *)
         observe_tac "rewrite_tac" (rewrite_tac this_ind_number this_branche_ids);
 	(* introduce hypothesis with some rewrite *)
@@ -750,8 +729,9 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
 	g
     in
     let params_names = fst (List.chop princ_infos.nparams args_names) in
+    let open EConstr in
     let params = List.map mkVar params_names in
-    tclTHENSEQ
+    tclTHENLIST
       [ tclMAP (fun id -> Proofview.V82.of_tactic (Simple.intro id)) (args_names@[res;hres]);
 	observe_tac "h_generalize"
 	(Proofview.V82.of_tactic (generalize [mkApp(applist(graph_principle,params),Array.map (fun c -> applist(c,params)) lemmas)]));
@@ -763,19 +743,20 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
       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 funs_constr = Array.map mkConstU funs  in
-  States.with_state_protection_on_exception
+  let map (c, u) = mkConstU (c, EInstance.make u) in
+  let funs_constr = Array.map map funs  in
+  (* 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 
@@ -789,10 +770,10 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
 	 in
 	 let type_info = (type_of_lemma_ctxt,type_of_lemma_concl) in
 	 graphs_constr.(i) <- graph;
-	 let type_of_lemma = Termops.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt in
+	 let type_of_lemma = EConstr.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt in
 	 let _ = Typing.e_type_of (Global.env ()) evd type_of_lemma in 
 	   let type_of_lemma = nf_zeta type_of_lemma in
-	   observe (str "type_of_lemma := " ++ Printer.pr_lconstr_env (Global.env ()) !evd type_of_lemma);
+	   observe (str "type_of_lemma := " ++ Printer.pr_leconstr_env (Global.env ()) !evd type_of_lemma);
 	   type_of_lemma,type_info
 	)
 	funs_constr
@@ -811,18 +792,18 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
 	  Array.of_list
 	    (List.map
 	       (fun entry ->
-		  (fst (fst(Future.force entry.Entries.const_entry_body)), Option.get entry.Entries.const_entry_type )
+		  (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 ->
-	 let f_id = Label.to_id (con_label (fst f_as_constant)) in
+	 let f_id = Label.to_id (Constant.label (fst f_as_constant)) in
 	 (*i The next call to mk_correct_id is valid since we are constructing the lemma
 	     Ensures by: obvious
 	 i*)
@@ -842,7 +823,8 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
 	 (* let lem_cst = fst (destConst (Constrintern.global_reference lem_id)) in *)
 	 let _,lem_cst_constr = Evd.fresh_global
 				  (Global.env ()) !evd (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id)) in
-	 let (lem_cst,_) = destConst lem_cst_constr in
+        let lem_cst_constr = EConstr.of_constr lem_cst_constr in
+	 let (lem_cst,_) = destConst !evd lem_cst_constr in
 	 update_Function {finfo with correctness_lemma = Some lem_cst};
 
       )
@@ -856,23 +838,23 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
 	 let type_info = (type_of_lemma_ctxt,type_of_lemma_concl) in
 	 graphs_constr.(i) <- graph;
 	 let type_of_lemma =
-	   Termops.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt
+	   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_lconstr type_of_lemma);
+         observe (str "type_of_lemma := " ++ Printer.pr_leconstr_env env !evd type_of_lemma);
 	 type_of_lemma,type_info
 	)
 	funs_constr
 	graphs_constr
     in
 
-    let (kn,_) as graph_ind,u  = (destInd graphs_constr.(0)) in
+    let (kn,_) as graph_ind,u  = (destInd !evd graphs_constr.(0)) in
     let mib,mip = Global.lookup_inductive graph_ind in
     let sigma, scheme = 
 	(Indrec.build_mutual_induction_scheme (Global.env ()) !evd
 	   (Array.to_list
 	      (Array.mapi
-		 (fun i _ -> ((kn,i),u(* Univ.Instance.empty *)),true,InType)
+		 (fun i _ -> ((kn,i), EInstance.kind !evd u),true,InType)
 		 mib.Declarations.mind_packets
 	      )
 	   )
@@ -886,7 +868,7 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
     in
     Array.iteri
       (fun i f_as_constant ->
-	 let f_id = Label.to_id (con_label (fst f_as_constant)) in
+	 let f_id = Label.to_id (Constant.label (fst f_as_constant)) in
 	 (*i The next call to mk_complete_id is valid since we are constructing the lemma
 	     Ensures by: obvious
 	   i*)
@@ -902,7 +884,8 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
 	 let finfo = find_Function_infos (fst f_as_constant) in
 	 let _,lem_cst_constr = Evd.fresh_global
 				  (Global.env ()) !evd (Constrintern.locate_reference (Libnames.qualid_of_ident lem_id)) in
-	 let (lem_cst,_) = destConst lem_cst_constr in
+         let lem_cst_constr = EConstr.of_constr lem_cst_constr in
+	 let (lem_cst,_) = destConst !evd lem_cst_constr in
 	 update_Function {finfo with completeness_lemma = Some lem_cst}
       )
       funs)
@@ -917,16 +900,17 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
    if the type of hypothesis has not this form or if we cannot find the completeness lemma then we do nothing
 *)
 let revert_graph kn post_tac hid g =
+    let sigma = project g in
     let typ = pf_unsafe_type_of g (mkVar hid) in
-    match kind_of_term typ with
-      | App(i,args) when isInd i ->
-	  let ((kn',num) as ind'),u = destInd i in
+    match EConstr.kind sigma typ with
+      | App(i,args) when isInd sigma i ->
+	  let ((kn',num) as ind'),u = destInd sigma i in
 	  if MutInd.equal kn kn'
 	  then (* We have generated a graph hypothesis so that we must change it if we can *)
 	    let info =
 	      try find_Function_of_graph ind'
 	      with Not_found -> (* The graphs are mutually recursive but we cannot find one of them !*)
-		anomaly (Pp.str "Cannot retrieve infos about a mutual block")
+		anomaly (Pp.str "Cannot retrieve infos about a mutual block.")
 	    in
 	    (* if we can find a completeness lemma for this function
 	       then we can come back to the functional form. If not, we do nothing
@@ -935,7 +919,7 @@ let revert_graph kn post_tac hid g =
 	      | None -> tclIDTAC g
 	      | Some f_complete ->
 		  let f_args,res = Array.chop (Array.length args - 1) args in
-		  tclTHENSEQ
+		  tclTHENLIST
 		    [
 		      Proofview.V82.of_tactic (generalize [applist(mkConst f_complete,(Array.to_list f_args)@[res.(0);mkVar hid])]);
 		      thin [hid];
@@ -965,21 +949,22 @@ let revert_graph kn post_tac hid g =
    \end{enumerate}
 *)
 
-let functional_inversion kn hid fconst f_correct : tactic =
+let functional_inversion kn hid fconst f_correct : Tacmach.tactic =
   fun g ->
     let old_ids = List.fold_right Id.Set.add  (pf_ids_of_hyps g) Id.Set.empty in
+    let sigma = project g in
     let type_of_h = pf_unsafe_type_of g (mkVar hid) in
-    match kind_of_term type_of_h with
-      | App(eq,args) when eq_constr eq (make_eq ())  ->
+    match EConstr.kind sigma type_of_h with
+      | App(eq,args) when EConstr.eq_constr sigma eq (make_eq ())  ->
 	  let pre_tac,f_args,res =
-	    match kind_of_term args.(1),kind_of_term args.(2) with
-	      | App(f,f_args),_ when eq_constr f fconst ->
+	    match EConstr.kind sigma args.(1),EConstr.kind sigma args.(2) with
+	      | App(f,f_args),_ when EConstr.eq_constr sigma f fconst ->
 		  ((fun hid -> Proofview.V82.of_tactic (intros_symmetry (Locusops.onHyp hid))),f_args,args.(2))
-	      |_,App(f,f_args) when eq_constr f fconst ->
+	      |_,App(f,f_args) when EConstr.eq_constr sigma f fconst ->
 		 ((fun hid -> tclIDTAC),f_args,args.(1))
 	      | _ -> (fun hid -> tclFAIL 1 (mt ())),[||],args.(2)
 	  in
-	  tclTHENSEQ[
+	  tclTHENLIST [
 	    pre_tac hid;
 	    Proofview.V82.of_tactic (generalize [applist(f_correct,(Array.to_list f_args)@[res;mkVar hid])]);
 	    thin [hid];
@@ -993,12 +978,13 @@ let functional_inversion kn hid fconst f_correct : tactic =
       | _ -> tclFAIL 1 (mt ()) g
 
 
+let error msg = user_err Pp.(str msg)
 
 let invfun qhyp f  =
   let f =
     match f with
       | ConstRef f -> f
-      | _ -> raise (CErrors.UserError("",str "Not a function"))
+      | _ -> raise (CErrors.UserError(None,str "Not a function"))
   in
   try
     let finfos = find_Function_infos f in
@@ -1012,7 +998,7 @@ let invfun qhyp f  =
     | Not_found ->  error "No graph found"
     | Option.IsNone  -> error "Cannot use equivalence with graph!"
 
-
+exception NoFunction
 let invfun qhyp f g =
   match f with
     | Some f -> invfun qhyp f g
@@ -1020,42 +1006,43 @@ let invfun qhyp f g =
        Proofview.V82.of_tactic begin
 	Tactics.try_intros_until
 	  (fun hid -> Proofview.V82.tactic begin fun g ->
+            let sigma = project g in
 	     let hyp_typ = pf_unsafe_type_of g (mkVar hid)  in
-	     match kind_of_term hyp_typ with
-	       | App(eq,args) when eq_constr eq (make_eq ()) ->
+	     match EConstr.kind sigma hyp_typ with
+	       | App(eq,args) when EConstr.eq_constr sigma eq (make_eq ()) ->
 		   begin
-		     let f1,_ = decompose_app args.(1) in
+		     let f1,_ = decompose_app sigma args.(1) in
 		     try
-		       if not (isConst f1) then failwith "";
-		       let finfos = find_Function_infos (fst (destConst f1)) in
+		       if not (isConst sigma f1) then raise NoFunction;
+		       let finfos = find_Function_infos (fst (destConst sigma f1)) in
 		       let f_correct = mkConst(Option.get finfos.correctness_lemma)
 		       and kn = fst finfos.graph_ind
 		       in
 		       functional_inversion kn hid f1 f_correct g
-		     with | Failure "" | Option.IsNone | Not_found ->
+		     with | NoFunction | Option.IsNone | Not_found ->
 		       try
-			 let f2,_ = decompose_app args.(2) in
-			 if not (isConst f2) then failwith "";
-			 let finfos = find_Function_infos (fst (destConst f2)) in
+			 let f2,_ = decompose_app sigma args.(2) in
+			 if not (isConst sigma f2) then raise NoFunction;
+			 let finfos = find_Function_infos (fst (destConst sigma f2)) in
 			 let f_correct = mkConst(Option.get finfos.correctness_lemma)
 			 and kn = fst finfos.graph_ind
 			 in
 			 functional_inversion kn hid  f2 f_correct g
 		       with
-			 | Failure "" ->
-			     errorlabstrm "" (str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
+			 | NoFunction ->
+			     user_err  (str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
 			 | Option.IsNone  ->
 			     if do_observe ()
 			     then
 			       error "Cannot use equivalence with graph for any side of the equality"
-			     else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
+			     else user_err  (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
 			 | Not_found ->
 			     if do_observe ()
 			     then
 			       error "No graph found for any side of equality"
-			     else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
+			     else user_err  (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
 		   end
-	       | _ -> errorlabstrm "" (Ppconstr.pr_id hid ++ str " must be an equality ")
+	       | _ -> user_err  (Ppconstr.pr_id hid ++ str " must be an equality ")
 	  end)
 	  qhyp
           end
diff --git a/plugins/funind/invfun.mli b/plugins/funind/invfun.mli
new file mode 100644
index 00000000..ad306ab2
--- /dev/null
+++ b/plugins/funind/invfun.mli
@@ -0,0 +1,19 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 de4210af..00000000
--- a/plugins/funind/merge.ml
+++ /dev/null
@@ -1,1009 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* 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 Termops
-open Declarations
-open Glob_term
-open Glob_termops
-open Decl_kinds
-open Context.Rel.Declaration
-
-(** {1 Utilities}  *)
-
-(** {2 Useful operations on constr and glob_constr} *)
-
-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 str = Name (Id.of_string str)
-let string_of_name nme = Id.to_string (id_of_name nme)
-
-(** [isVarf f x] returns [true] if term [x] is of the form [(Var f)]. *)
-let isVarf f x =
-    match x with
-      | 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 = CRef (Libnames.Ident (Loc.ghost,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.lift_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
-
-let showind (id:Id.t) =
-  let cstrid = Constrintern.global_reference id in
-  let ind1,cstrlist = Inductiveops.find_inductive (Global.env()) Evd.empty cstrid in
-  let mib1,ib1 = Inductive.lookup_mind_specif (Global.env()) (fst ind1) in
-  List.iter (fun decl ->
-    print_string (string_of_name (Context.Rel.Declaration.get_name decl) ^ ":");
-    prconstr (get_type decl); print_string "\n")
-    ib1.mind_arity_ctxt;
-    Printf.printf "arity :"; prconstr (Inductiveops.type_of_inductive (Global.env ()) ind1);
-  Array.iteri
-    (fun i x -> Printf.printf"type constr %d :" i ; prconstr x)
-    ib1.mind_user_lc
-
-(** {2 Misc} *)
-
-exception Found of int
-
-(* Array scanning *)
-
-let array_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)
-
-
-
-
-(** {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 (get_name decl) ^ " : ");
-			   prconstr (get_type decl); prstr "\n")
-    otherprms1 in
-  let _ = prstr "\notherprms2:\n" in
-  let _ =
-    List.iter (fun decl -> prstr (string_of_name (get_name decl) ^ " : "); prconstr (get_type decl); prstr "\n")
-    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 c1 , c2 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
-        GApp (Loc.ghost,GVar (Loc.ghost,shift.ident) , args)
-    | GApp(_,f1, arr1), GApp(_,f2,arr2)  -> raise NoMerge
-    | GLetIn(_,nme,bdy,trm) , _ ->
-        let _ = prstr "\nICI2!\n" in
-        let newtrm = merge_app trm c2 id1 id2 shift filter_shift_stable in
-        GLetIn(Loc.ghost,nme,bdy,newtrm)
-    | _, GLetIn(_,nme,bdy,trm) ->
-        let _ = prstr "\nICI3!\n" in
-        let newtrm = merge_app c1 trm id1 id2 shift filter_shift_stable in
-        GLetIn(Loc.ghost,nme,bdy,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 c1 , c2 with
-    | GApp(_,f1, arr1), GApp(_,f2,arr2) ->
-        let args = filter_shift_stable lnk (arr1 @ arr2) in
-        GApp (Loc.ghost,GVar(Loc.ghost,shift.ident) , args)
-          (* FIXME: what if the function appears in the body of the let? *)
-    | GLetIn(_,nme,bdy,trm) , _ ->
-      let _ = prstr "\nICI2 '!\n" in
-        let newtrm = merge_app_unsafe trm c2 shift filter_shift_stable in
-        GLetIn(Loc.ghost,nme,bdy,newtrm)
-    | _, GLetIn(_,nme,bdy,trm) ->
-        let _ = prstr "\nICI3 '!\n" in
-        let newtrm = merge_app_unsafe c1 trm shift filter_shift_stable in
-        GLetIn(Loc.ghost,nme,bdy,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 (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 (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 (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 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
-    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
-        LocalRawAssum ([(Loc.ghost,nme)], Constrexpr_ops.default_binder_kind, typ) :: acc)
-      [] params in
-  let concl = Constrextern.extern_constr false (Global.env()) Evd.empty concl in
-  let arity,_ =
-    List.fold_left
-      (fun (acc,env) decl ->
-        let nm = Context.Rel.Declaration.get_name decl in
-        let c = get_type decl in
-        let typ = Constrextern.extern_constr false env Evd.empty c in
-        let newenv = Environ.push_rel (LocalAssum (nm,c)) env in
-        CProdN (Loc.ghost, [[(Loc.ghost,nm)],Constrexpr_ops.default_binder_kind,typ] , acc) , newenv)
-      (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.ghost, 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.ghost,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 traw = Detyping.detype false [] (Global.env()) Evd.empty t in
-        GProd (Loc.ghost,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 (*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.ghost,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 ->
-      errorlabstrm "indfun" (Nameops.pr_id id ++ str " has no functional scheme")
-
-(** [merge id1 id2 args1 args2 id] builds and declares a new inductive
-    type called [id], representing the merged graphs of both graphs
-    [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,mkProp,mkProp)
-
-
-let relprinctype_to_funprinctype relprinctype nfuns =
-  let relinfo = compute_elim_sig 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 = remove_last_arg (pop 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 = popn nfuns 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 fa84e4dd..fb9ae64b 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1,12 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+
+module CVars = Vars
+
+open Constr
+open EConstr
 open Vars
 open Namegen
 open Environ
@@ -25,7 +31,7 @@ open Nametab
 open Declare
 open Decl_kinds
 open Tacred
-open Proof_type
+open Goal
 open Pfedit
 open Glob_term
 open Pretyping
@@ -39,56 +45,63 @@ open Auto
 open Eauto
 
 open Indfun_common
-open Sigma.Notations
 open Context.Rel.Declaration
 
-
 (* Ugly things which should not be here *)
 
-let coq_constant m s =
-  Coqlib.coq_constant "RecursiveDefinition" m s
+let coq_constant m s = EConstr.of_constr @@ Universes.constr_of_global @@
+  Coqlib.coq_reference "RecursiveDefinition" m s
 
 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 =
-  Coqlib.gen_constant_in_modules "RecursiveDefinition" Coqlib.init_modules s
+  EConstr.of_constr (
+    Universes.constr_of_global @@
+    Coqlib.gen_reference_in_modules "RecursiveDefinition" Coqlib.init_modules s)
 
 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
 	     | _ -> raise Not_found)
        with Not_found ->
 	 anomaly (str "Cannot find definition of constant " ++
-		    (Id.print (Label.to_id (con_label (fst sp)))))
+		    (Id.print (Label.to_id (Constant.label (fst sp)))) ++ str ".")
       )
      |_ -> assert false
 
-let type_of_const t =
-   match (kind_of_term t) with
-    Const sp -> Typeops.type_of_constant (Global.env()) sp
+let type_of_const sigma t =
+   match (EConstr.kind sigma t) with
+   | Const (sp, u) ->
+      let u = EInstance.kind sigma u in
+      (* FIXME discarding universe constraints *)
+      Typeops.type_of_constant_in (Global.env()) (sp, u)
     |_ -> assert false
 
 let constr_of_global x = 
-  fst (Universes.unsafe_constr_of_global x)
+  fst (Global.constr_of_global_in_context (Global.env ()) x)
 
 let constant sl s = constr_of_global (find_reference sl s)
 
 let const_of_ref = function
     ConstRef kn -> kn
-  | _ -> anomaly (Pp.str "ConstRef expected")
+  | _ -> anomaly (Pp.str "ConstRef expected.")
 
 
 let nf_zeta env =
@@ -98,9 +111,7 @@ let nf_zeta env =
 
 
 let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta  *)
-  let clos_norm_flags flgs env sigma t =
-    CClosure.norm_val (CClosure.create_clos_infos flgs env) (CClosure.inject (Reductionops.nf_evar sigma t)) in
-  clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
+  Reductionops.clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
 
 
 
@@ -110,13 +121,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 (*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"
@@ -128,13 +143,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 -> error "module Recdef not loaded"
-let iter = function () -> (constr_of_global (delayed_force iter_ref))
+  with Not_found -> user_err Pp.(str "module Recdef not loaded")
+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")
@@ -147,7 +162,7 @@ let coq_O = function () -> (coq_init_constant "O")
 let coq_S = function () -> (coq_init_constant "S")
 let lt_n_O = function () -> (coq_constant arith_Nat "nlt_0_r")
 let max_ref = function () -> (find_reference ["Recdef"] "max")
-let max_constr = function () -> (constr_of_global (delayed_force max_ref))
+let max_constr = function () -> EConstr.of_constr (constr_of_global (delayed_force max_ref))
 let coq_conj = function () -> find_reference Coqlib.logic_module_name "conj"
 
 let f_S t = mkApp(delayed_force coq_S, [|t|]);;
@@ -166,9 +181,10 @@ let simpl_iter clause =
     clause
 
 (* Others ugly things ... *)
-let (value_f:constr list -> global_reference -> constr) =
+let (value_f: Constr.t list -> global_reference -> Constr.t) =
+  let open Term in
+  let open Constr in
   fun al fterm ->
-    let d0 = Loc.ghost in
     let rev_x_id_l =
       (
 	List.fold_left
@@ -185,21 +201,21 @@ let (value_f:constr list -> global_reference -> constr) =
     in
     let env = Environ.push_rel_context context (Global.env ()) in
     let glob_body =
-      GCases
-	(d0,RegularStyle,None,
-	 [GApp(d0, GRef(d0,fterm,None), List.rev_map (fun x_id -> GVar(d0, x_id)) rev_x_id_l),
+      DAst.make @@
+       GCases
+	(RegularStyle,None,
+	 [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)],
-	 [d0, [v_id], [PatCstr(d0,(destIndRef
-				     (delayed_force coq_sig_ref),1),
-			       [PatVar(d0, Name v_id);
-				PatVar(d0, Anonymous)],
-			       Anonymous)],
-	  GVar(d0,v_id)])
+         [CAst.make ([v_id], [DAst.make @@ PatCstr ((destIndRef (delayed_force coq_sig_ref),1),
+			   [DAst.make @@ PatVar(Name v_id); DAst.make @@ PatVar Anonymous],
+                           Anonymous)],
+	    DAst.make @@ GVar v_id)])
     in
     let body = fst (understand env (Evd.from_env env) glob_body)(*FIXME*) in
+    let body = EConstr.Unsafe.to_constr body in
     it_mkLambda_or_LetIn body context
 
-let (declare_f : Id.t -> logical_kind -> 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);;
 
@@ -301,14 +317,14 @@ let tclUSER_if_not_mes concl_tac is_mes names_to_suppress =
 (* [check_not_nested forbidden e] checks that [e] does not contains any variable 
    of [forbidden]
 *)
-let check_not_nested forbidden e =
+let check_not_nested sigma forbidden e =
   let rec check_not_nested e =  
-    match kind_of_term e with 
+    match EConstr.kind sigma e with 
       | Rel _ -> ()
       | Var x ->
         if Id.List.mem x forbidden
-        then errorlabstrm "Recdef.check_not_nested"
-               (str "check_not_nested: failure " ++ pr_id x)
+        then user_err ~hdr:"Recdef.check_not_nested"
+               (str "check_not_nested: failure " ++ Id.print x)
       | Meta _ | Evar _ | Sort _ -> ()
       | Cast(e,_,t) -> check_not_nested e;check_not_nested t
       | Prod(_,t,b) -> check_not_nested t;check_not_nested b
@@ -321,13 +337,14 @@ let check_not_nested forbidden e =
       | Construct _ -> ()
       | Case(_,t,e,a) -> 
 	check_not_nested t;check_not_nested e;Array.iter check_not_nested a
-      | Fix _ -> error "check_not_nested : Fix"
-      | CoFix _ -> error "check_not_nested : Fix"
+      | Fix _ -> user_err Pp.(str "check_not_nested : Fix")
+      | CoFix _ -> user_err Pp.(str "check_not_nested : Fix")
   in
   try 
     check_not_nested e 
   with UserError(_,p) -> 
-    errorlabstrm "_" (str "on expr : " ++ Printer.pr_lconstr 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 = 
@@ -374,15 +391,17 @@ type journey_info =
 
 	       
 
-let rec add_vars forbidden e = 
-  match kind_of_term e with 
+let add_vars sigma forbidden e = 
+  let rec aux forbidden e =
+  match EConstr.kind sigma e with 
     | Var x -> x::forbidden 
-    | _ -> fold_constr add_vars forbidden e 
-
+    | _ -> EConstr.fold sigma aux forbidden e
+  in
+  aux forbidden e
 
 let treat_case forbid_new_ids to_intros finalize_tac nb_lam e infos : tactic = 
   fun g -> 
-    let rev_context,b = decompose_lam_n nb_lam e in 
+    let rev_context,b = decompose_lam_n (project g) nb_lam e in
     let ids = List.fold_left (fun acc (na,_) -> 	
       let pre_id = 
 	match na with 
@@ -404,17 +423,17 @@ let treat_case forbid_new_ids to_intros finalize_tac nb_lam e infos : tactic =
 	    (fun g' -> 
 	      let ty_teq = pf_unsafe_type_of g' (mkVar heq) in
 	      let teq_lhs,teq_rhs =
-		let _,args = try destApp ty_teq with DestKO -> assert false in
+		let _,args = try destApp (project g') ty_teq with DestKO -> assert false in
 		args.(1),args.(2)
 	      in
-	      let new_b' = Termops.replace_term teq_lhs teq_rhs new_b in 
+	      let new_b' = Termops.replace_term (project g') teq_lhs teq_rhs new_b in 
 	      let new_infos = {
 		infos with 
 		  info = new_b';
 		  eqs = heq::infos.eqs;
 		  forbidden_ids = 
 		  if forbid_new_ids 
-		  then add_vars infos.forbidden_ids new_b'
+		  then add_vars (project g') infos.forbidden_ids new_b'
 		  else infos.forbidden_ids
 	      } in 
 	      finalize_tac new_infos g' 
@@ -423,34 +442,35 @@ let treat_case forbid_new_ids to_intros finalize_tac nb_lam e infos : tactic =
 	)
       ] g
 
-let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
-  match kind_of_term expr_info.info with 
-    | CoFix _ | Fix _ -> error "Function cannot treat local fixpoint or cofixpoint"
-    | Proj _ -> error "Function cannot treat projections"
+let rec travel_aux jinfo continuation_tac (expr_info:constr infos) g =
+  let sigma = project g in
+  match EConstr.kind sigma expr_info.info with 
+    | CoFix _ | Fix _ -> user_err Pp.(str "Function cannot treat local fixpoint or cofixpoint")
+    | Proj _ -> user_err Pp.(str "Function cannot treat projections")
     | LetIn(na,b,t,e) -> 
       begin
 	let new_continuation_tac = 
 	  jinfo.letiN (na,b,t,e) expr_info continuation_tac
 	in
 	travel jinfo new_continuation_tac 
-	  {expr_info with info = b; is_final=false}
+	  {expr_info with info = b; is_final=false} g
       end
-    | Rel _ -> anomaly (Pp.str "Free var in goal conclusion !")
+    | Rel _ -> anomaly (Pp.str "Free var in goal conclusion!")
     | Prod _ -> 
       begin
 	try
-	  check_not_nested (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
-	  jinfo.otherS () expr_info continuation_tac expr_info
+	  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 ->
-	  errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
+          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
 	try
-	  check_not_nested (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
-	  jinfo.otherS () expr_info continuation_tac expr_info
+	  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 ->
-	  errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
+          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
@@ -461,15 +481,15 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
 	travel 
 	  jinfo continuation_tac_a 
 	  {expr_info with info = a; is_main_branch = false; 
-	    is_final = false}
+	    is_final = false} g
       end
     | App _ -> 
-      let f,args = decompose_app expr_info.info in 
-      if eq_constr f (expr_info.f_constr) 
-      then jinfo.app_reC (f,args) expr_info continuation_tac expr_info 
+      let f,args = decompose_app sigma expr_info.info in 
+      if EConstr.eq_constr sigma f (expr_info.f_constr) 
+      then jinfo.app_reC (f,args) expr_info continuation_tac expr_info g
       else
       begin
-	match kind_of_term f with 
+	match EConstr.kind sigma f with 
 	  | App _ -> assert false (* f is coming from a decompose_app *)
 	  | Const _ | Construct _ | Rel _ | Evar _ | Meta _  | Ind _ 
 	  | Sort _ | Prod _ | Var _ -> 
@@ -477,15 +497,15 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
 	    let new_continuation_tac = 
 	      jinfo.apP (f,args) expr_info continuation_tac in 
 	    travel_args jinfo
-	      expr_info.is_main_branch new_continuation_tac new_infos
-	  | Case _ ->  errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain an applied match (See Limitation in Section 2.3 of refman)")
-	  | _ -> anomaly (Pp.str "travel_aux : unexpected "++ Printer.pr_lconstr expr_info.info)
+	      expr_info.is_main_branch new_continuation_tac new_infos g
+          | 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}
+    | Cast(t,_,_) -> travel jinfo continuation_tac {expr_info with info=t} g
     | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ ->
       let new_continuation_tac = 
 	jinfo.otherS () expr_info continuation_tac in
-      new_continuation_tac expr_info
+      new_continuation_tac expr_info g
 and travel_args jinfo is_final continuation_tac infos = 
   let (f_args',args) = infos.info in 
   match args with 
@@ -502,27 +522,28 @@ 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_lconstr expr_info.info) 
+    (str jinfo.message ++ pr_leconstr_rd expr_info.info)
     (travel_aux jinfo continuation_tac expr_info)
 
 (* Termination proof *) 
 
 let rec prove_lt hyple g = 
+  let sigma = project g in
   begin
     try
-      let (varx,varz) = match decompose_app (pf_concl g) with
-        | _, x::z::_ when isVar x && isVar z -> x, z
+      let (varx,varz) = match decompose_app sigma (pf_concl g) with
+        | _, x::z::_ when isVar sigma x && isVar sigma z -> x, z
         | _ -> assert false
       in
       let h =
 	List.find (fun id ->
-          match decompose_app (pf_unsafe_type_of g (mkVar id)) with
-            | _, t::_ -> eq_constr t varx
+          match decompose_app sigma (pf_unsafe_type_of g (mkVar id)) with
+            | _, t::_ -> EConstr.eq_constr sigma t varx
             | _ -> false
 	) hyple
       in
       let y =
-	List.hd (List.tl (snd (decompose_app (pf_unsafe_type_of g (mkVar h))))) in
+	List.hd (List.tl (snd (decompose_app sigma (pf_unsafe_type_of g (mkVar h))))) in
       observe_tclTHENLIST (str "prove_lt1")[
 	Proofview.V82.of_tactic (apply (mkApp(le_lt_trans (),[|varx;y;varz;mkVar h|])));
 	observe_tac (str "prove_lt") (prove_lt hyple)
@@ -638,12 +659,13 @@ let terminate_others _ expr_info continuation_tac infos =
     ]
   else continuation_tac infos
 
-let terminate_letin (na,b,t,e) expr_info continuation_tac info = 
+let terminate_letin (na,b,t,e) expr_info continuation_tac info g =
+  let sigma = project g in
   let new_e = subst1 info.info e in 
   let new_forbidden = 
     let forbid = 
       try 
-	check_not_nested (expr_info.f_id::expr_info.forbidden_ids) b;
+	check_not_nested sigma (expr_info.f_id::expr_info.forbidden_ids) b;
 	true
       with e when CErrors.noncritical e -> false
     in
@@ -654,7 +676,7 @@ let terminate_letin (na,b,t,e) expr_info continuation_tac info =
 	| Name id -> id::info.forbidden_ids
     else info.forbidden_ids 
   in
-  continuation_tac {info with info = new_e; forbidden_ids = new_forbidden} 
+  continuation_tac {info with info = new_e; forbidden_ids = new_forbidden} g
 
 let pf_type c tac gl = 
   let evars, ty = Typing.type_of (pf_env gl) (project gl) c in
@@ -673,7 +695,7 @@ let pf_typel l tac =
   introduced back later; the result is the pair of the tactic and the
   list of hypotheses that have been generalized and cleared. *)
 let mkDestructEq :
-  Id.t list -> constr -> goal sigma -> tactic * Id.t list =
+  Id.t list -> constr -> goal Evd.sigma -> tactic * Id.t list =
   fun not_on_hyp expr g ->
   let hyps = pf_hyps g in
   let to_revert =
@@ -681,7 +703,7 @@ let mkDestructEq :
       (fun decl ->
         let open Context.Named.Declaration in
         let id = get_id decl in
-        if Id.List.mem id not_on_hyp || not (Termops.occur_term expr (get_type decl))
+        if Id.List.mem id not_on_hyp || not (Termops.dependent (project g) expr (get_type decl))
         then None else Some id) hyps in
   let to_revert_constr = List.rev_map mkVar to_revert in
   let type_of_expr = pf_unsafe_type_of g expr in
@@ -691,18 +713,18 @@ let mkDestructEq :
     observe_tclTHENLIST (str "mkDestructEq")
      [Proofview.V82.of_tactic (generalize new_hyps);
       (fun g2 ->
-        let changefun patvars = { run = fun sigma ->
-          let redfun = pattern_occs [Locus.AllOccurrencesBut [1], expr] in
-          redfun.Reductionops.e_redfun (pf_env g2) sigma (pf_concl g2)
-        } in
+        let changefun patvars sigma =
+          pattern_occs [Locus.AllOccurrencesBut [1], expr] (pf_env g2) sigma (pf_concl g2)
+        in
 	Proofview.V82.of_tactic (change_in_concl None changefun) g2);
       Proofview.V82.of_tactic (simplest_case expr)]), to_revert
 
 
 let terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos g =
+  let sigma = project g in
   let f_is_present =
     try
-      check_not_nested (expr_info.f_id::expr_info.forbidden_ids) a;
+      check_not_nested sigma (expr_info.f_id::expr_info.forbidden_ids) a;
       false
     with e when CErrors.noncritical e ->
       true
@@ -716,25 +738,26 @@ 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_lconstr 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
 	 (List.map_i (fun i e -> observe_tac (str "do treat case") (treat_case f_is_present to_thin_intro (next_step continuation_tac) ci.ci_cstr_ndecls.(i) e new_info)) 0 (Array.to_list l)
 	 ))
     with 
-      | UserError("Refiner.thensn_tac3",_) 
-      | UserError("Refiner.tclFAIL_s",_) ->
-	(observe_tac (str "is computable " ++ Printer.pr_lconstr new_info.info) (next_step continuation_tac {new_info with info = nf_betaiotazeta new_info.info} )
+      | UserError(Some "Refiner.thensn_tac3",_) 
+      | UserError(Some "Refiner.tclFAIL_s",_) ->
+        (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
     
-let terminate_app_rec (f,args) expr_info continuation_tac _ = 
-  List.iter (check_not_nested (expr_info.f_id::expr_info.forbidden_ids))
+let terminate_app_rec (f,args) expr_info continuation_tac _ g =
+  let sigma = project g in
+  List.iter (check_not_nested sigma (expr_info.f_id::expr_info.forbidden_ids))
     args;
   begin
     try 
-      let v = List.assoc_f (List.equal Constr.equal) args expr_info.args_assoc in
+      let v = List.assoc_f (List.equal (EConstr.eq_constr sigma)) args expr_info.args_assoc in
       let new_infos = {expr_info with info = v} in 
       observe_tclTHENLIST (str "terminate_app_rec")[
 	continuation_tac new_infos;
@@ -748,7 +771,7 @@ let terminate_app_rec (f,args) expr_info continuation_tac _ =
 	  ]
 	else
 	  tclIDTAC			       
-      ]    
+      ] g
     with Not_found -> 
       observe_tac (str "terminate_app_rec not found") (tclTHENS
 	(Proofview.V82.of_tactic (simplest_elim (mkApp(mkVar expr_info.ih,Array.of_list args))))
@@ -805,7 +828,7 @@ let terminate_app_rec (f,args) expr_info continuation_tac _ =
 		      );
 		  ]
 	      ])
-	])
+	]) g
   end
 
 let terminate_info = 
@@ -827,8 +850,9 @@ let equation_case next_step (ci,a,t,l) expr_info continuation_tac infos =
   observe_tac (str "equation case") (terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos)
 
 let rec prove_le g = 
+  let sigma = project g in
   let x,z = 
-    let _,args = decompose_app (pf_concl g) in 
+    let _,args = decompose_app sigma (pf_concl g) in 
     (List.hd args,List.hd (List.tl args))
   in 
   tclFIRST[
@@ -836,13 +860,17 @@ 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 (reference_of_constr (le ())),[|Pattern.PVar (destVar 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 = 
-	  let _,args = decompose_app t in 
+	  let _,args = decompose_app sigma t in 
 	  List.hd (List.tl args)
 	in 
 	observe_tclTHENLIST (str "prove_le")[
@@ -858,21 +886,21 @@ let rec make_rewrite_list expr_info max = function
   | [] -> tclIDTAC
   | (_,p,hp)::l -> 
     observe_tac (str "make_rewrite_list") (tclTHENS
-      (observe_tac (str "rewrite heq on " ++ pr_id p ) (
+      (observe_tac (str "rewrite heq on " ++ Id.print p ) (
 	(fun g -> 
+          let sigma = project g in
 	  let t_eq = compute_renamed_type g (mkVar hp) in
 	  let k,def =
-	    let k_na,_,t = destProd t_eq in
-	    let _,_,t  = destProd t in
-	    let def_na,_,_ = destProd t in
-	    Nameops.out_name k_na,Nameops.out_name def_na
+	    let k_na,_,t = destProd sigma t_eq in
+	    let _,_,t  = destProd sigma t in
+	    let def_na,_,_ = destProd sigma t in
+	    Nameops.Name.get_id k_na,Nameops.Name.get_id def_na
 	  in
 	  Proofview.V82.of_tactic (general_rewrite_bindings false Locus.AllOccurrences
 	    true (* dep proofs also: *) true 
 	    (mkVar hp,
-	     ExplicitBindings[Loc.ghost,NamedHyp def,
-			      expr_info.f_constr;Loc.ghost,NamedHyp k,
-			      (f_S max)]) false) g) )
+             ExplicitBindings[CAst.make @@ (NamedHyp def, expr_info.f_constr);
+                              CAst.make @@ (NamedHyp k, f_S max)]) false) g) )
       )
       [make_rewrite_list expr_info max l;
        observe_tclTHENLIST (str "make_rewrite_list")[ (* x < S max proof *)
@@ -886,20 +914,20 @@ let make_rewrite expr_info l hp max =
     (observe_tac (str "make_rewrite") (make_rewrite_list expr_info max l))
     (observe_tac (str "make_rewrite") (tclTHENS
        (fun g -> 
+          let sigma = project g in
 	  let t_eq = compute_renamed_type g (mkVar hp) in
 	  let k,def =
-	    let k_na,_,t = destProd t_eq in
-	    let _,_,t  = destProd t in
-	    let def_na,_,_ = destProd t in
-	    Nameops.out_name k_na,Nameops.out_name def_na
+	    let k_na,_,t = destProd sigma t_eq in
+	    let _,_,t  = destProd sigma t in
+	    let def_na,_,_ = destProd sigma t in
+	    Nameops.Name.get_id k_na,Nameops.Name.get_id def_na
 	  in
 	 observe_tac (str "general_rewrite_bindings")
 	   (Proofview.V82.of_tactic (general_rewrite_bindings false Locus.AllOccurrences
 	    true (* dep proofs also: *) true 
 	    (mkVar hp,
-	     ExplicitBindings[Loc.ghost,NamedHyp def,
-			      expr_info.f_constr;Loc.ghost,NamedHyp k,
-			      (f_S (f_S max))]) false)) g)
+             ExplicitBindings[CAst.make @@ (NamedHyp def, expr_info.f_constr);
+                              CAst.make @@ (NamedHyp k, f_S (f_S max))]) false)) g)
        [observe_tac(str "make_rewrite finalize") (
 	 (* tclORELSE( h_reflexivity) *)
 	 (observe_tclTHENLIST (str "make_rewrite")[
@@ -916,7 +944,7 @@ let make_rewrite expr_info l hp max =
 	    ]))
        ;
 	 observe_tclTHENLIST (str "make_rewrite1")[ (* x < S (S max) proof *)
-	 Proofview.V82.of_tactic (apply (delayed_force le_lt_SS));
+	 Proofview.V82.of_tactic (apply (EConstr.of_constr (delayed_force le_lt_SS)));
 	 observe_tac (str "prove_le (3)") prove_le
 	 ]
        ])  
@@ -953,7 +981,7 @@ let rec destruct_hex expr_info acc l =
 	onNthHypId 1 (fun hp -> 
 	  onNthHypId 2 (fun p -> 
 	    observe_tac 
-	      (str "destruct_hex after " ++ pr_id hp ++ spc () ++ pr_id p)
+	      (str "destruct_hex after " ++ Id.print hp ++ spc () ++ Id.print p)
 	      (destruct_hex expr_info ((v,p,hp)::acc) l)
 	  )
 	)
@@ -974,23 +1002,24 @@ 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_lconstr 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_lconstr expr_info.info) (intros_values_eq expr_info [])))
-  else observe_tac (str "equation_others (cont_tac) " ++ Printer.pr_lconstr 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 
     then ((observe_tac (str "intros_values_eq equation_app") (intros_values_eq expr_info [])))
     else continuation_tac infos
 	    
-let equation_app_rec (f,args) expr_info continuation_tac info = 
+let equation_app_rec (f,args) expr_info continuation_tac info g = 
+  let sigma = project g in
   begin
     try
-      let v = List.assoc_f (List.equal Constr.equal) args expr_info.args_assoc in
+      let v = List.assoc_f (List.equal (EConstr.eq_constr sigma)) args expr_info.args_assoc in
       let new_infos = {expr_info with info = v} in
-      observe_tac (str "app_rec found") (continuation_tac new_infos)
+      observe_tac (str "app_rec found") (continuation_tac new_infos) g
     with Not_found ->
       if expr_info.is_final && expr_info.is_main_branch 
       then 
@@ -998,12 +1027,12 @@ let equation_app_rec (f,args) expr_info continuation_tac info =
 	  [ Proofview.V82.of_tactic (simplest_case (mkApp (expr_info.f_terminate,Array.of_list args)));
 	    continuation_tac {expr_info with args_assoc = (args,delayed_force coq_O)::expr_info.args_assoc};
 	    observe_tac (str "app_rec intros_values_eq") (intros_values_eq expr_info [])
-	  ]
+	  ] g
       else 
 	observe_tclTHENLIST (str "equation_app_rec1")[
   	  Proofview.V82.of_tactic (simplest_case (mkApp (expr_info.f_terminate,Array.of_list args)));
 	  observe_tac (str "app_rec not_found") (continuation_tac {expr_info with args_assoc = (args,delayed_force coq_O)::expr_info.args_assoc})
-	]
+	] g
   end
 
 let equation_info = 
@@ -1022,10 +1051,13 @@ let prove_eq = travel equation_info
 (* [compute_terminate_type] computes the type of the Definition f_terminate from the type of f_F
 *)
 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::
@@ -1034,6 +1066,7 @@ let compute_terminate_type nb_args func =
 	 )
   in
   let right = mkRel 5 in
+  let delayed_force c = EConstr.Unsafe.to_constr (delayed_force c) in
   let equality = mkApp(delayed_force eq, [|lift 5 b; left; right|]) in
   let result = (mkProd ((Name def_id) , lift 4 a_arrow_b, equality)) in
   let cond = mkApp(delayed_force lt, [|(mkRel 2); (mkRel 1)|]) in
@@ -1046,7 +1079,7 @@ let compute_terminate_type nb_args func =
 		  delayed_force nat,
 		  (mkProd (Name k_id, delayed_force nat,
 			   mkArrow cond result))))|])in
-  let value = mkApp(constr_of_global (delayed_force coq_sig_ref),
+  let value = mkApp(constr_of_global (Util.delayed_force coq_sig_ref),
 		    [|b;
 		      (mkLambda (Name v_id, b, nb_iter))|]) in
   compose_prod rev_args value
@@ -1130,25 +1163,27 @@ let termination_proof_header is_mes input_type ids args_id relation
 
 
 
-let rec instantiate_lambda t l =
+let rec instantiate_lambda sigma t l =
   match l with
   | [] -> t
   | a::l ->
-      let (_, _, body) = destLambda t in
-      instantiate_lambda (subst1 a body) l
+      let (_, _, body) = destLambda sigma t in
+      instantiate_lambda sigma (subst1 a body) l
 
 let whole_start (concl_tac:tactic) nb_args is_mes func input_type relation rec_arg_num  : tactic =
   begin
     fun g ->
+      let sigma = project g in
       let ids = Termops.ids_of_named_context (pf_hyps g) in
       let func_body = (def_of_const (constr_of_global func)) in
-      let (f_name, _, body1) = destLambda func_body in
+      let func_body = EConstr.of_constr func_body in
+      let (f_name, _, body1) = destLambda sigma func_body in
       let f_id =
 	match f_name with
 	  | Name f_id -> next_ident_away_in_goal f_id ids
-	  | Anonymous -> anomaly (Pp.str "Anonymous function")
+	  | Anonymous -> anomaly (Pp.str "Anonymous function.")
       in
-      let n_names_types,_ = decompose_lam_n nb_args body1 in
+      let n_names_types,_ = decompose_lam_n sigma nb_args body1 in
       let n_ids,ids =
 	List.fold_left
 	  (fun (n_ids,ids) (n_name,_) ->
@@ -1156,13 +1191,13 @@ let whole_start (concl_tac:tactic) nb_args is_mes func input_type relation rec_a
 	       | Name id ->
 		   let n_id = next_ident_away_in_goal id ids in
 		   n_id::n_ids,n_id::ids
-	       | _ -> anomaly (Pp.str "anonymous argument")
+	       | _ -> anomaly (Pp.str "anonymous argument.")
 	  )
 	  ([],(f_id::ids))
 	  n_names_types
       in
       let rec_arg_id = List.nth n_ids (rec_arg_num - 1) in
-      let expr = instantiate_lambda func_body (mkVar f_id::(List.map mkVar n_ids)) in
+      let expr = instantiate_lambda sigma func_body (mkVar f_id::(List.map mkVar n_ids)) in
       termination_proof_header
 	is_mes
 	input_type
@@ -1201,20 +1236,21 @@ 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
 
-let build_and_l l =
-  let and_constr =  Coqlib.build_coq_and () in
+exception EmptySubgoals
+let build_and_l sigma l =
+  let and_constr =  Universes.constr_of_global @@ Coqlib.build_coq_and () in
   let conj_constr = coq_conj () in
   let mk_and p1 p2 =
-    Term.mkApp(and_constr,[|p1;p2|]) in
+    mkApp(EConstr.of_constr and_constr,[|p1;p2|]) in
   let rec is_well_founded t = 
-    match kind_of_term t with 
+    match EConstr.kind sigma t with 
       | Prod(_,_,t') -> is_well_founded t'
       | App(_,_) -> 
-	let (f,_) = decompose_app t in 
-	eq_constr f (well_founded ())
+	let (f,_) = decompose_app sigma t in 
+	EConstr.eq_constr sigma f (well_founded ())
       | _ -> 
 	false
   in
@@ -1225,13 +1261,13 @@ let build_and_l l =
   in
   let l = List.sort compare l in 
   let rec f  = function
-    | [] -> failwith "empty list of subgoals!"
+    | [] -> raise EmptySubgoals
     | [p] -> p,tclIDTAC,1
     | p1::pl ->
 	let c,tac,nb = f pl in
 	mk_and p1 c,
 	tclTHENS
-	  (Proofview.V82.of_tactic (apply (constr_of_global conj_constr)))
+	  (Proofview.V82.of_tactic (apply (EConstr.of_constr (constr_of_global conj_constr))))
 	  [tclIDTAC;
 	   tac
 	  ],nb+1
@@ -1245,16 +1281,16 @@ let is_rec_res id =
     String.equal (String.sub id_name 0 (String.length rec_res_name)) rec_res_name
   with Invalid_argument _ -> false
  
-let clear_goals =
+let clear_goals sigma =
   let rec clear_goal t =
-    match kind_of_term t with
+    match EConstr.kind sigma t with
       | Prod(Name id as na,t',b) ->
 	  let b' = clear_goal b in
-	  if noccurn 1 b' && (is_rec_res id)
-	  then Termops.pop b'
+	  if noccurn sigma 1 b' && (is_rec_res id)
+	  then Vars.lift (-1) b'
 	  else if b' == b then t
 	  else mkProd(na,t',b')
-      | _ -> Term.map_constr clear_goal t
+      | _ -> EConstr.map sigma clear_goal t
   in
   List.map clear_goal
 
@@ -1262,41 +1298,41 @@ let clear_goals =
 let build_new_goal_type () =
   let sigma, sub_gls_types = get_current_subgoals_types () in
   (* Pp.msgnl (str "sub_gls_types1 := " ++ Util.prlist_with_sep (fun () -> Pp.fnl () ++ Pp.fnl ()) Printer.pr_lconstr sub_gls_types); *)
-  let sub_gls_types = clear_goals sub_gls_types in
+  let sub_gls_types = clear_goals sigma sub_gls_types in
   (* Pp.msgnl (str "sub_gls_types2 := " ++ Pp.prlist_with_sep (fun () -> Pp.fnl () ++ Pp.fnl ()) Printer.pr_lconstr sub_gls_types); *)
-  let res = build_and_l sub_gls_types in
+  let res = build_and_l sigma sub_gls_types in
     sigma, res
 
 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)   =
   (* Pp.msgnl (str "gls_type := " ++ Printer.pr_lconstr gls_type); *)
-  let current_proof_name = get_current_proof_name () in
+  let current_proof_name = Proof_global.get_current_proof_name () in
   let name = match goal_name with
     | Some s -> s
     | None   ->
 	try add_suffix current_proof_name "_subproof"
 	with e when CErrors.noncritical e ->
-          anomaly (Pp.str "open_new_goal with an unamed theorem")
+          anomaly (Pp.str "open_new_goal with an unamed theorem.")
   in
-  let na = next_global_ident_away name [] in
-  if Termops.occur_existential gls_type then
-    CErrors.error "\"abstract\" cannot handle existentials";
+  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 _ _ =
     let opacity =
-      let na_ref = Libnames.Ident (Loc.ghost,na) in
+      let na_ref = CAst.make @@ Libnames.Ident na in
       let na_global = Smartlocate.global_with_alias na_ref in
       match na_global with
 	  ConstRef c -> is_opaque_constant c
-	| _ -> anomaly ~label:"equation_lemma" (Pp.str "not a constant")
+	| _ -> anomaly ~label:"equation_lemma" (Pp.str "not a constant.")
     in
     let lemma = mkConst (Names.Constant.make1 (Lib.make_kn na)) in
-    ref_ := Some lemma ;
+    ref_ := Value (EConstr.Unsafe.to_constr lemma);
     let lid = ref [] in
     let h_num = ref (-1) in
     let env = Global.env () in
@@ -1322,8 +1358,9 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
 	       );
 	     ] gls)
       (fun g ->
-	 match kind_of_term (pf_concl g) with
-	   | App(f,_) when eq_constr f (well_founded ()) ->
+        let sigma = project g in
+	 match EConstr.kind sigma (pf_concl g) with
+	   | App(f,_) when EConstr.eq_constr sigma f (well_founded ()) ->
 	       Proofview.V82.of_tactic (Auto.h_auto None [] (Some []))  g
 	   | _ ->
 	       incr h_num;
@@ -1336,7 +1373,7 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
 			  (Proofview.V82.of_tactic e_assumption);
 		      Eauto.eauto_with_bases
 			(true,5)
-			[{ Tacexpr.delayed = fun _ sigma -> Sigma.here (Lazy.force refl_equal) sigma}]
+			[(fun _ sigma -> (sigma, (Lazy.force refl_equal)))]
 			[Hints.Hint_db.empty empty_transparent_state false]
 		      ]
 		    )
@@ -1366,7 +1403,7 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
 	 	     (fun c ->
 	 		Proofview.V82.of_tactic (Tacticals.New.tclTHENLIST 
 	 		  [intros;
-	 		   Simple.apply (fst (interp_constr (Global.env()) Evd.empty c)) (*FIXME*);
+                           Simple.apply (fst (interp_constr (Global.env()) Evd.empty c)) (*FIXME*);
 	 		   Tacticals.New.tclCOMPLETE Auto.default_auto
 	 		  ])
 	 	     )
@@ -1393,10 +1430,10 @@ 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 (compute_terminate_type nb_args fonctional_ref) hook;
+      ctx (EConstr.of_constr (compute_terminate_type nb_args fonctional_ref)) hook;
 
     ignore (by (Proofview.V82.tactic (observe_tac (str "starting_tac") tac_start)));
     ignore (by (Proofview.V82.tactic (observe_tac (str "whole_start") (whole_start tac_end nb_args is_mes fonctional_ref
@@ -1410,8 +1447,9 @@ let com_terminate
       using_lemmas tcc_lemma_ref
       (Some tcc_lemma_name)
       (new_goal_type);
-  with Failure "empty list of subgoals!" ->
+  with EmptySubgoals ->
     (* a non recursive function declared with measure ! *)
+    tcc_lemma_ref := Not_needed;
     defined ()
 
 
@@ -1420,9 +1458,11 @@ let com_terminate
 
 let start_equation (f:global_reference) (term_f:global_reference)
   (cont_tactic:Id.t list -> tactic) g =
+  let sigma = project g in
   let ids = pf_ids_of_hyps g in
   let terminate_constr = constr_of_global term_f in
-  let nargs = nb_prod (fst (type_of_const terminate_constr)) (*FIXME*) in
+  let terminate_constr = EConstr.of_constr terminate_constr in
+  let nargs = nb_prod (project g) (EConstr.of_constr (type_of_const sigma terminate_constr)) in
   let x = n_x_id ids nargs in
   observe_tac (str "start_equation") (observe_tclTHENLIST (str "start_equation") [
     h_intros x;
@@ -1434,34 +1474,35 @@ let start_equation (f:global_reference) (term_f:global_reference)
 
 let (com_eqn : int -> Id.t ->
        global_reference -> global_reference -> global_reference
-	 -> 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 =
       match terminate_ref with
 	| ConstRef c -> is_opaque_constant c
-	| _ -> anomaly ~label:"terminate_lemma" (Pp.str "not a constant")
+	| _ -> 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
-       equation_lemma_type
+       evd
+       (EConstr.of_constr equation_lemma_type)
        (Lemmas.mk_hook (fun _ _ -> ()));
      ignore (by
        (Proofview.V82.tactic (start_equation f_ref terminate_ref
 	  (fun  x ->
 	     prove_eq (fun _ -> tclIDTAC)
 	       {nb_arg=nb_arg;
-		f_terminate = constr_of_global terminate_ref; 
-	        f_constr = f_constr; 
+		f_terminate = EConstr.of_constr (constr_of_global terminate_ref); 
+	        f_constr = EConstr.of_constr f_constr; 
 		concl_tac = tclIDTAC;
 		func=functional_ref;
-		info=(instantiate_lambda
-	       		(def_of_const (constr_of_global functional_ref))
-	       		(f_constr::List.map mkVar x)
+		info=(instantiate_lambda Evd.empty
+	       		(EConstr.of_constr (def_of_const (constr_of_global functional_ref)))
+	       		(EConstr.of_constr f_constr::List.map mkVar x)
 		);
 		is_main_branch = true;
 		is_final = true;
@@ -1484,27 +1525,33 @@ let (com_eqn : int -> Id.t ->
 (*      Pp.msgnl (str "eqn finished"); *)
     );;
 
-
 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 evm, nf = Evarutil.nf_evars_and_universes !evd in
-  let equation_lemma_type = nf_betaiotazeta (nf ty) in
+  let evd, ty = interp_type_evars env evd ~impls:rec_impls eq in
+  let ty = EConstr.Unsafe.to_constr ty 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
  (* Pp.msgnl (str "lemma type := " ++ Printer.pr_lconstr equation_lemma_type ++ fnl ()); *)
   let res_vars,eq' = decompose_prod equation_lemma_type in
   let env_eq' = Environ.push_rel_context (List.map (fun (x,y) -> LocalAssum (x,y)) res_vars) env in
-  let eq' = nf_zeta env_eq' eq'  in
+  let eq' = nf_zeta env_eq' (EConstr.of_constr eq') in
+  let eq' = EConstr.Unsafe.to_constr eq' in
   let res =
 (*     Pp.msgnl (str "res_var :=" ++ Printer.pr_lconstr_env (push_rel_context (List.map (function (x,t) -> (x,None,t)) res_vars) env) eq'); *)
 (*     Pp.msgnl (str "rec_arg_num := " ++ str (string_of_int rec_arg_num)); *)
 (*     Pp.msgnl (str "eq' := " ++ str (string_of_int rec_arg_num)); *)
-    match kind_of_term eq' with
+    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)"
@@ -1515,21 +1562,24 @@ 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 None in
+  let tcc_lemma_constr = ref Undefined in
   (* let _ = Pp.msgnl (str "relation := " ++ Printer.pr_lconstr_env env_with_pre_rec_args relation) in *)
   let hook _ _ = 
     let term_ref = Nametab.locate (qualid_of_ident term_id) in
     let f_ref = declare_f function_name (IsProof Lemma) arg_types term_ref in
-    let _ = Extraction_plugin.Table.extraction_inline true [Ident (Loc.ghost,term_id)] in
+    let _ = Extraction_plugin.Table.extraction_inline true [CAst.make @@ Ident term_id] in
     (*     message "start second proof"; *)
     let stop = 
       try com_eqn (List.length res_vars) equation_id functional_ref f_ref term_ref (subst_var function_name equation_lemma_type);
@@ -1538,7 +1588,7 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
 	begin
 	  if do_observe ()
 	  then Feedback.msg_debug (str "Cannot create equation Lemma " ++ CErrors.print e)
-	  else CErrors.errorlabstrm "Cannot create equation Lemma"
+	  else CErrors.user_err ~hdr:"Cannot create equation Lemma"
                (str "Cannot create equation lemma." ++ spc () ++ 
                 str "This may be because the function is nested-recursive.")
 	  ;
@@ -1552,23 +1602,26 @@ 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 rec_arg_type (nb_prod res) relation;
-      if Flags.is_verbose ()
-      then msgnl (h 1 (Ppconstr.pr_id function_name ++
+        functional_ref eq_ref rec_arg_num
+        (EConstr.of_constr rec_arg_type)
+        (nb_prod evd (EConstr.of_constr res)) relation;
+      Flags.if_verbose
+        msgnl (h 1 (Ppconstr.pr_id function_name ++
 			 spc () ++ str"is defined" )++ fnl () ++
 		    h 1 (Ppconstr.pr_id equation_id ++
 			   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
       is_mes functional_ref
-      rec_arg_type
+      (EConstr.of_constr rec_arg_type)
       relation 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 f60eedbe..b95d64ce 100644
--- a/plugins/funind/recdef.mli
+++ b/plugins/funind/recdef.mli
@@ -1,20 +1,19 @@
+open Constr
 
-
-(* val evaluable_of_global_reference : Libnames.global_reference -> Names.evaluable_global_reference *)
 val tclUSER_if_not_mes : 
-  Proof_type.tactic ->
+  Tacmach.tactic ->
   bool -> 
   Names.Id.t list option -> 
-  Proof_type.tactic
+  Tacmach.tactic
 val recursive_definition :  
 bool ->
            Names.Id.t ->
            Constrintern.internalization_env ->
            Constrexpr.constr_expr ->
            Constrexpr.constr_expr ->
-           int -> Constrexpr.constr_expr -> (Term.pconstant ->
-            Term.constr option ref ->
-            Term.pconstant ->
-            Term.pconstant -> int -> Term.types -> int -> Term.constr -> 'a) -> Constrexpr.constr_expr list -> unit
+           int -> Constrexpr.constr_expr -> (pconstant ->
+            Indfun_common.tcc_lemma_value ref ->
+            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 2b443f2a..755fa4f8 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/funind/vo.itarget b/plugins/funind/vo.itarget
deleted file mode 100644
index 33c96830..00000000
--- a/plugins/funind/vo.itarget
+++ /dev/null
@@ -1 +0,0 @@
-Recdef.vo
diff --git a/plugins/ltac/Ltac.v b/plugins/ltac/Ltac.v
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/plugins/ltac/Ltac.v
diff --git a/ltac/coretactics.ml4 b/plugins/ltac/coretactics.ml4
index 61866675..931633e1 100644
--- a/ltac/coretactics.ml4
+++ b/plugins/ltac/coretactics.ml4
@@ -1,24 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Util
-open Names
 open Locus
 open Misctypes
 open Genredexpr
-open Constrarg
+open Stdarg
 open Extraargs
+open Names
 
-open Sigma.Notations
-
-DECLARE PLUGIN "coretactics"
+DECLARE PLUGIN "ltac_plugin"
 
 (** Basic tactics *)
 
@@ -160,12 +158,12 @@ END
 (** Split *)
 
 let rec delayed_list = function
-| [] -> { Tacexpr.delayed = fun _ sigma -> Sigma.here [] sigma }
+| [] -> fun _ sigma -> (sigma, [])
 | x :: l ->
-  { Tacexpr.delayed = fun env sigma ->
-    let Sigma (x, sigma, p) = x.Tacexpr.delayed env sigma in
-    let Sigma (l, sigma, q) = (delayed_list l).Tacexpr.delayed env sigma in
-    Sigma (x :: l, sigma, p +> q) }
+  fun env sigma ->
+    let (sigma, x) = x env sigma in
+    let (sigma, l) = delayed_list l env sigma in
+    (sigma, x :: l)
 
 TACTIC EXTEND split
   [ "split" ] -> [ Tactics.split_with_bindings false [NoBindings] ]
@@ -243,12 +241,20 @@ END
 
 (** Simple induction / destruct *)
 
+let simple_induct h =
+  Tacticals.New.tclTHEN (Tactics.intros_until h)
+    (Tacticals.New.onLastHyp Tactics.simplest_elim)
+
 TACTIC EXTEND simple_induction
-  [ "simple" "induction" quantified_hypothesis(h) ] -> [ Tactics.simple_induct h ]
+  [ "simple" "induction" quantified_hypothesis(h) ] -> [ simple_induct h ]
 END
 
+let simple_destruct h =
+  Tacticals.New.tclTHEN (Tactics.intros_until h)
+    (Tacticals.New.onLastHyp Tactics.simplest_case)
+
 TACTIC EXTEND simple_destruct
-  [ "simple" "destruct" quantified_hypothesis(h) ] -> [ Tactics.simple_destruct h ]
+  [ "simple" "destruct" quantified_hypothesis(h) ] -> [ simple_destruct h ]
 END
 
 (** Double induction *)
@@ -305,11 +311,10 @@ END
 open Tacexpr
 
 let initial_atomic () =
-  let dloc = Loc.ghost in
   let nocl = {onhyps=Some[];concl_occs=AllOccurrences} in
   let iter (s, t) =
-    let body = TacAtom (dloc, t) in
-    Tacenv.register_ltac false false (Id.of_string s) body
+    let body = TacAtom (Loc.tag t) in
+    Tacenv.register_ltac false false (Names.Id.of_string s) body
   in
   let () = List.iter iter
       [ "red", TacReduce(Red false,nocl);
@@ -319,11 +324,43 @@ let initial_atomic () =
         "intros", TacIntroPattern (false,[]);
       ]
   in
-  let iter (s, t) = Tacenv.register_ltac false false (Id.of_string s) t in
+  let iter (s, t) = Tacenv.register_ltac false false (Names.Id.of_string s) t in
   List.iter iter
       [ "idtac",TacId [];
         "fail", TacFail(TacLocal,ArgArg 0,[]);
-        "fresh", TacArg(dloc,TacFreshId [])
+        "fresh", TacArg(Loc.tag @@ TacFreshId [])
       ]
 
-let () = Mltop.declare_cache_obj initial_atomic "coretactics"
+let () = Mltop.declare_cache_obj initial_atomic "ltac_plugin"
+
+(* First-class Ltac access to primitive blocks *)
+
+let initial_name s = { mltac_plugin = "ltac_plugin"; mltac_tactic = s; }
+let initial_entry s = { mltac_name = initial_name s; mltac_index = 0; }
+
+let register_list_tactical name f =
+  let tac args ist = match args with
+  | [v] ->
+    begin match Tacinterp.Value.to_list v with
+    | None -> Tacticals.New.tclZEROMSG (Pp.str "Expected a list")
+    | Some tacs ->
+      let tacs = List.map (fun tac -> Tacinterp.tactic_of_value ist tac) tacs in
+      f tacs
+    end
+  | _ -> assert false
+  in
+  Tacenv.register_ml_tactic (initial_name name) [|tac|]
+
+let () = register_list_tactical "first" Tacticals.New.tclFIRST
+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 (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])));
+    "solve", TacFun ([Name (idn 0)], TacML (None, (initial_entry "solve", [varn 0])));
+  ]
+
+let () = Mltop.declare_cache_obj initial_tacticals "ltac_plugin"
diff --git a/plugins/ltac/evar_tactics.ml b/plugins/ltac/evar_tactics.ml
new file mode 100644
index 00000000..9382f567
--- /dev/null
+++ b/plugins/ltac/evar_tactics.ml
@@ -0,0 +1,114 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Util
+open Names
+open Term
+open CErrors
+open Evar_refiner
+open Tacmach
+open Tacexpr
+open Refiner
+open Evd
+open Locus
+open Context.Named.Declaration
+open Ltac_pretype
+
+module NamedDecl = Context.Named.Declaration
+
+(* The instantiate tactic *)
+
+let instantiate_evar evk (ist,rawc) sigma =
+  let evi = Evd.find sigma evk in
+  let filtered = Evd.evar_filtered_env evi in
+  let constrvars = Tacinterp.extract_ltac_constr_values ist filtered in
+  let lvar = {
+    ltac_constrs = constrvars;
+    ltac_uconstrs = Names.Id.Map.empty;
+    ltac_idents = Names.Id.Map.empty;
+    ltac_genargs = ist.Geninterp.lfun;
+  } in
+  let sigma' = w_refine (evk,evi) (lvar ,rawc) sigma in
+  tclEVARS sigma'
+
+let evar_list sigma c =
+  let rec evrec acc c =
+    match EConstr.kind sigma c with
+    | Evar (evk, _ as ev) -> ev :: acc
+    | _ -> EConstr.fold sigma evrec acc c in
+  evrec [] c
+
+let instantiate_tac n c ido =
+  Proofview.V82.tactic begin fun gl ->
+  let sigma = gl.sigma in
+  let evl =
+    match ido with
+	ConclLocation () -> evar_list sigma (pf_concl gl)
+      | HypLocation (id,hloc) ->
+	  let decl = Environ.lookup_named_val id (Goal.V82.hyps sigma (sig_it gl)) in
+	    match hloc with
+		InHyp ->
+		  (match decl with
+                    | LocalAssum (_,typ) -> evar_list sigma (EConstr.of_constr typ)
+		    | _ -> user_err Pp.(str "Please be more specific: in type or value?"))
+	      | InHypTypeOnly ->
+		  evar_list sigma (EConstr.of_constr (NamedDecl.get_type decl))
+	      | InHypValueOnly ->
+		  (match decl with
+		    | LocalDef (_,body,_) -> evar_list sigma (EConstr.of_constr body)
+		    | _ -> user_err Pp.(str "Not a defined hypothesis.")) in
+  if List.length evl < n then
+    user_err Pp.(str "Not enough uninstantiated existential variables.");
+  if n <= 0 then user_err Pp.(str "Incorrect existential variable index.");
+  let evk,_ = List.nth evl (n-1) in
+  instantiate_evar evk c sigma gl
+  end
+
+let instantiate_tac_by_name id c =
+  Proofview.V82.tactic begin fun gl ->
+  let sigma = gl.sigma in
+  let evk =
+    try Evd.evar_key id sigma
+    with Not_found -> user_err Pp.(str "Unknown existential variable.") in
+  instantiate_evar evk c sigma gl
+  end
+
+let let_evar name typ =
+  let src = (Loc.tag Evar_kinds.GoalEvar) in
+  Proofview.Goal.enter begin fun gl ->
+    let sigma = Tacmach.New.project gl in
+    let env = Proofview.Goal.env gl in
+    let sigma = ref sigma in
+    let _ = Typing.e_sort_of env sigma typ in
+    let sigma = !sigma in
+    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.vars_of_env env)
+    | Name.Name id -> id
+    in
+    let (sigma, evar) = Evarutil.new_evar env sigma ~src ~naming:(Misctypes.IntroFresh id) typ in
+    Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (Tactics.letin_tac None (Name.Name id) evar None Locusops.nowhere)
+  end
+  
+let hget_evar n =
+  let open EConstr in
+  Proofview.Goal.nf_enter begin fun gl ->
+  let sigma = Tacmach.New.project gl in
+  let concl = Proofview.Goal.concl gl in
+  let evl = evar_list sigma concl in
+  if List.length evl < n then
+    user_err Pp.(str "Not enough uninstantiated existential variables.");
+  if n <= 0 then user_err Pp.(str "Incorrect existential variable index.");
+  let ev = List.nth evl (n-1) in
+  let ev_type = EConstr.existential_type sigma ev in
+  Tactics.change_concl (mkLetIn (Name.Anonymous,mkEvar ev,ev_type,concl))
+  end
diff --git a/plugins/ltac/evar_tactics.mli b/plugins/ltac/evar_tactics.mli
new file mode 100644
index 00000000..b6cfc382
--- /dev/null
+++ b/plugins/ltac/evar_tactics.mli
@@ -0,0 +1,23 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Tacexpr
+open Locus
+
+val instantiate_tac : int -> Tacinterp.interp_sign * Glob_term.glob_constr ->
+  (Id.t * hyp_location_flag, unit) location -> unit Proofview.tactic
+
+val instantiate_tac_by_name : Id.t ->
+  Tacinterp.interp_sign * Glob_term.glob_constr -> unit Proofview.tactic
+
+val let_evar : Name.t -> EConstr.types -> unit Proofview.tactic
+
+val hget_evar : int -> unit Proofview.tactic
diff --git a/ltac/extraargs.ml4 b/plugins/ltac/extraargs.ml4
index 0db1cd7b..702b8303 100644
--- a/ltac/extraargs.ml4
+++ b/plugins/ltac/extraargs.ml4
@@ -1,17 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pp
 open Genarg
 open Stdarg
-open Constrarg
+open Tacarg
 open Pcoq.Prim
 open Pcoq.Constr
 open Names
@@ -31,15 +31,15 @@ let create_generic_quotation name e wit =
 let () = create_generic_quotation "integer" Pcoq.Prim.integer Stdarg.wit_int
 let () = create_generic_quotation "string" Pcoq.Prim.string Stdarg.wit_string
 
-let () = create_generic_quotation "ident" Pcoq.Prim.ident Constrarg.wit_ident
-let () = create_generic_quotation "reference" Pcoq.Prim.reference Constrarg.wit_ref
-let () = create_generic_quotation "uconstr" Pcoq.Constr.lconstr Constrarg.wit_uconstr
-let () = create_generic_quotation "constr" Pcoq.Constr.lconstr Constrarg.wit_constr
-let () = create_generic_quotation "ipattern" Pcoq.Tactic.simple_intropattern Constrarg.wit_intro_pattern
-let () = create_generic_quotation "open_constr" Pcoq.Constr.lconstr Constrarg.wit_open_constr
+let () = create_generic_quotation "ident" Pcoq.Prim.ident Stdarg.wit_ident
+let () = create_generic_quotation "reference" Pcoq.Prim.reference Stdarg.wit_ref
+let () = create_generic_quotation "uconstr" Pcoq.Constr.lconstr Stdarg.wit_uconstr
+let () = create_generic_quotation "constr" Pcoq.Constr.lconstr Stdarg.wit_constr
+let () = create_generic_quotation "ipattern" Pltac.simple_intropattern Stdarg.wit_intro_pattern
+let () = create_generic_quotation "open_constr" Pcoq.Constr.lconstr Stdarg.wit_open_constr
 let () =
   let inject (loc, v) = Tacexpr.Tacexp v in
-  Tacentries.create_ltac_quotation "ltac" inject (Pcoq.Tactic.tactic_expr, Some 5)
+  Tacentries.create_ltac_quotation "ltac" inject (Pltac.tactic_expr, Some 5)
 
 (** Backward-compatible tactic notation entry names *)
 
@@ -83,14 +83,14 @@ 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) -> Nameops.pr_id id
+    | ArgVar { CAst.loc = loc; v=id } -> Id.print id
 
 let occurrences_of = function
   | [] -> NoOccurrences
   | n::_ as nl when n < 0 -> AllOccurrencesBut (List.map abs nl)
   | nl ->
       if List.exists (fun n -> n < 0) nl then
-        CErrors.error "Illegal negative occurrence number.";
+        CErrors.user_err Pp.(str "Illegal negative occurrence number.");
       OnlyOccurrences nl
 
 let coerce_to_int v = match Value.to_int v with
@@ -104,7 +104,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 +133,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 +190,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,8 +201,8 @@ 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) -> Nameops.pr_id id)
-let pr_place _ _ _ = pr_gen_place Nameops.pr_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 () () ()
 
 let intern_place ist = function
@@ -228,15 +230,15 @@ ARGUMENT EXTEND hloc
   |  [ "in" "|-" "*" ] ->
     [ ConclLocation () ]
 | [ "in" ident(id) ] ->
-    [ HypLocation ((Loc.ghost,id),InHyp) ]
+    [ HypLocation ((CAst.make id),InHyp) ]
 | [ "in" "(" "Type" "of" ident(id) ")" ] ->
-    [ HypLocation ((Loc.ghost,id),InHypTypeOnly) ]
+    [ HypLocation ((CAst.make id),InHypTypeOnly) ]
 | [ "in" "(" "Value" "of" ident(id) ")" ] ->
-    [ HypLocation ((Loc.ghost,id),InHypValueOnly) ]
+    [ HypLocation ((CAst.make id),InHypValueOnly) ]
 
  END
 
-let pr_rename _ _ _ (n, m) = Nameops.pr_id n ++ str " into " ++ Nameops.pr_id m
+let pr_rename _ _ _ (n, m) = Id.print n ++ str " into " ++ Id.print m
 
 ARGUMENT EXTEND rename
   TYPED AS ident * ident
@@ -249,7 +251,7 @@ END
 let pr_by_arg_tac _prc _prlc prtac opt_c =
   match opt_c with
     | None -> mt ()
-    | Some t -> hov 2 (str "by" ++ spc () ++ prtac (3,Ppextend.E) t)
+    | Some t -> hov 2 (str "by" ++ spc () ++ prtac (3,Notation_term.E) t)
 
 ARGUMENT EXTEND by_arg_tac
   TYPED AS tactic_opt
@@ -262,7 +264,7 @@ let pr_by_arg_tac prtac opt_c = pr_by_arg_tac () () prtac opt_c
 
 let pr_in_clause _ _ _ cl = Pptactic.pr_in_clause Ppconstr.pr_lident cl
 let pr_in_top_clause _ _ _ cl = Pptactic.pr_in_clause Id.print cl
-let in_clause' = Pcoq.Tactic.in_clause
+let in_clause' = Pltac.in_clause
 
 ARGUMENT EXTEND in_clause
   TYPED AS clause_dft_concl
@@ -274,6 +276,26 @@ ARGUMENT EXTEND in_clause
 | [ in_clause'(cl) ] -> [ cl ]
 END
 
+let local_test_lpar_id_colon =
+  let err () = raise Stream.Failure in
+  Pcoq.Gram.Entry.of_parser "lpar_id_colon"
+    (fun strm ->
+      match Util.stream_nth 0 strm with
+        | Tok.KEYWORD "(" ->
+            (match Util.stream_nth 1 strm with
+              | Tok.IDENT _ ->
+                  (match Util.stream_nth 2 strm with
+                    | Tok.KEYWORD ":" -> ()
+                    | _ -> err ())
+              | _ -> err ())
+        | _ -> err ())
+
+let pr_lpar_id_colon _ _ _ _ = mt ()
+
+ARGUMENT EXTEND test_lpar_id_colon TYPED AS unit PRINTED BY pr_lpar_id_colon
+| [ local_test_lpar_id_colon(x) ] -> [ () ]
+END
+
 (* spiwack: the print functions are incomplete, but I don't know what they are
 	used for *)
 let pr_r_nat_field natf =
diff --git a/ltac/extraargs.mli b/plugins/ltac/extraargs.mli
index b12187e1..e5a4f090 100644
--- a/ltac/extraargs.mli
+++ b/plugins/ltac/extraargs.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Tacexpr
@@ -14,13 +16,13 @@ open Misctypes
 
 val wit_orient : bool Genarg.uniform_genarg_type
 val orient : bool Pcoq.Gram.entry
-val pr_orient : bool -> Pp.std_ppcmds
+val pr_orient : bool -> Pp.t
 
 val wit_rename : (Id.t * Id.t) Genarg.uniform_genarg_type
 
 val occurrences : (int list or_var) Pcoq.Gram.entry
 val wit_occurrences : (int list or_var, int list or_var, int list) Genarg.genarg_type
-val pr_occurrences : int list or_var -> Pp.std_ppcmds
+val pr_occurrences : int list or_var -> Pp.t
 val occurrences_of : int list -> Locus.occurrences
 
 val wit_natural : int Genarg.uniform_genarg_type
@@ -38,24 +40,24 @@ val wit_lglob :
 val wit_lconstr :
   (constr_expr,
   Tacexpr.glob_constr_and_expr,
-  Constr.t) Genarg.genarg_type
+  EConstr.t) Genarg.genarg_type
 
 val wit_casted_constr :
   (constr_expr,
   Tacexpr.glob_constr_and_expr,
-  Constr.t) Genarg.genarg_type
+  EConstr.t) Genarg.genarg_type
 
 val glob : constr_expr Pcoq.Gram.entry
 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
 val hloc : loc_place Pcoq.Gram.entry
-val pr_hloc : loc_place -> Pp.std_ppcmds
+val pr_hloc : loc_place -> Pp.t
 
 val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Gram.entry
 val wit_by_arg_tac :
@@ -64,8 +66,12 @@ val wit_by_arg_tac :
   Geninterp.Val.t option) Genarg.genarg_type
 
 val pr_by_arg_tac : 
-  (int * Ppextend.parenRelation -> raw_tactic_expr -> Pp.std_ppcmds) ->
-  raw_tactic_expr option -> Pp.std_ppcmds
+  (int * Notation_term.parenRelation -> raw_tactic_expr -> Pp.t) ->
+  raw_tactic_expr option -> Pp.t
+
+val test_lpar_id_colon : unit Pcoq.Gram.entry
+
+val wit_test_lpar_id_colon : (unit, unit, unit) Genarg.genarg_type
 
 (** Spiwack: Primitive for retroknowledge registration *)
 
@@ -73,6 +79,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/ltac/extratactics.ml4 b/plugins/ltac/extratactics.ml4
index d88bcd7e..2e90ce90 100644
--- a/ltac/extratactics.ml4
+++ b/plugins/ltac/extratactics.ml4
@@ -1,35 +1,33 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pp
 open Genarg
 open Stdarg
-open Constrarg
+open Tacarg
 open Extraargs
 open Pcoq.Prim
-open Pcoq.Tactic
+open Pltac
 open Mod_subst
 open Names
 open Tacexpr
 open Glob_ops
 open CErrors
 open Util
-open Evd
 open Termops
 open Equality
 open Misctypes
-open Sigma.Notations
 open Proofview.Notations
-open Constrarg
+open Vernacinterp
 
-DECLARE PLUGIN "extratactics"
+DECLARE PLUGIN "ltac_plugin"
 
 (**********************************************************************)
 (* replace, discriminate, injection, simplify_eq                      *)
@@ -39,11 +37,11 @@ let with_delayed_uconstr ist c tac =
   let flags = {
     Pretyping.use_typeclasses = false;
     solve_unification_constraints = true;
-    use_hook = Some Pfedit.solve_by_implicit_tactic;
+    use_hook = Pfedit.solve_by_implicit_tactic ();
     fail_evar = false;
     expand_evars = true
   } in
-  let c = Pretyping.type_uconstr ~flags ist c in
+  let c = Tacinterp.type_uconstr ~flags ist c in
   Tacticals.New.tclDELAYEDWITHHOLES false c tac
 
 let replace_in_clause_maybe_by ist c1 c2 cl tac =
@@ -53,8 +51,6 @@ let replace_in_clause_maybe_by ist c1 c2 cl tac =
 let replace_term ist dir_opt c cl =
   with_delayed_uconstr ist c (fun c -> replace_term dir_opt c cl)
 
-let clause = Pcoq.Tactic.clause_dft_concl
-
 TACTIC EXTEND replace
    ["replace" uconstr(c1) "with" constr(c2) clause(cl) by_arg_tac(tac) ]
 -> [ replace_in_clause_maybe_by ist c1 c2 cl tac ]
@@ -77,31 +73,31 @@ END
 
 let induction_arg_of_quantified_hyp = function
   | AnonHyp n -> None,ElimOnAnonHyp n
-  | NamedHyp id -> None,ElimOnIdent (Loc.ghost,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
    ElimOnIdent and not as "constr" *)
 
 let mytclWithHoles tac with_evars c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Tacmach.New.pf_env gl in
     let sigma = Tacmach.New.project gl in
     let sigma',c = Tactics.force_destruction_arg with_evars env sigma c in
     Tacticals.New.tclWITHHOLES with_evars (tac with_evars (Some c)) sigma'
-  end }
+  end
 
 let elimOnConstrWithHoles tac with_evars c =
   Tacticals.New.tclDELAYEDWITHHOLES with_evars c
     (fun c -> tac with_evars (Some (None,ElimOnConstr c)))
 
 TACTIC EXTEND simplify_eq
-  [ "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
@@ -119,39 +115,39 @@ END
 
 let discrHyp id =
   Proofview.tclEVARMAP >>= fun sigma ->
-  discr_main { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma }
+  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 =
   Proofview.tclEVARMAP >>= fun sigma ->
-  injection_main false { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma }
+  injection_main false (fun env sigma -> (sigma, (EConstr.mkVar id, NoBindings)))
 
 TACTIC EXTEND dependent_rewrite
 | [ "dependent" "rewrite" orient(b) constr(c) ] -> [ rewriteInConcl b c ]
@@ -254,12 +250,12 @@ 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 c = EConstr.to_constr sigma c in
     let ctx =
       let ctx = UState.context_set ctx in
         if poly then ctx
@@ -268,101 +264,129 @@ let add_rewrite_hint bases ort t lcsr =
 	  (Declare.declare_universe_context false ctx;
            Univ.ContextSet.empty)
     in
-      Constrexpr_ops.constr_loc ce, (c, ctx), ort, Option.map (in_gen (rawwit wit_ltac)) t in
+      CAst.make ?loc:(Constrexpr_ops.constr_loc ce) ((c, ctx), ort, Option.map (in_gen (rawwit wit_ltac)) t) in
   let eqs = List.map f lcsr in
   let add_hints base = add_rew_rules base eqs in
   List.iter add_hints bases
 
 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
 
 (**********************************************************************)
 (* Hint Resolve                                                       *)
 
 open Term
+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
   let sigma, c = Evd.fresh_global env sigma gr in
+  let c = EConstr.of_constr c in
   let t = Retyping.get_type_of env sigma c in
   let t =
     Tacred.reduce_to_quantified_ref env sigma (Lazy.force coq_iff_ref) t in
-  let sign,ccl = decompose_prod_assum t in
-  let (a,b) = match snd (decompose_app ccl) with
+  let sign,ccl = decompose_prod_assum sigma t in
+  let (a,b) = match snd (decompose_app sigma ccl) with
     | [a;b] -> (a,b)
     | _ -> assert false in
   let p =
     if l2r then build_coq_iff_left_proj () else build_coq_iff_right_proj () in
-  let c = Reductionops.whd_beta Evd.empty (mkApp (c, Context.Rel.to_extended_vect 0 sign)) in
+  let sigma, p = Evd.fresh_global env sigma p in
+  let p = EConstr.of_constr p in
+  let c = Reductionops.whd_beta sigma (mkApp (c, Context.Rel.to_extended_vect mkRel 0 sign)) in
   let c = it_mkLambda_or_LetIn
     (mkApp (p,[|mkArrow a (lift 1 b);mkArrow b (lift 1 a);c|])) sign in
   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 =
-  Hints.add_hints true 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
 
 (**********************************************************************)
 (* Refine                                                             *)
 
-let constr_flags = {
+open EConstr
+open Vars
+
+let constr_flags () = {
   Pretyping.use_typeclasses = true;
   Pretyping.solve_unification_constraints = true;
-  Pretyping.use_hook = Some Pfedit.solve_by_implicit_tactic;
+  Pretyping.use_hook = Pfedit.solve_by_implicit_tactic ();
   Pretyping.fail_evar = false;
   Pretyping.expand_evars = true }
 
 let refine_tac ist simple with_classes c =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
     let flags =
-      { constr_flags with Pretyping.use_typeclasses = with_classes } in
+      { constr_flags () with Pretyping.use_typeclasses = with_classes } in
     let expected_type = Pretyping.OfType concl in
-    let c = Pretyping.type_uconstr ~flags ~expected_type ist c in
-    let update = { run = fun sigma -> c.delayed env sigma } in
-    let refine = Refine.refine ~unsafe:true update in
+    let c = Tacinterp.type_uconstr ~flags ~expected_type ist c in
+    let update = begin fun sigma ->
+      c env sigma
+    end in
+    let refine = Refine.refine ~typecheck:false update in
     if simple then refine
     else refine <*>
            Tactics.New.reduce_after_refine <*>
            Proofview.shelve_unifiable
-  end }
+  end
 
 TACTIC EXTEND refine
 | [ "refine" uconstr(c) ] ->
@@ -397,42 +421,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
 
-open Term
-
-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
 
 (**********************************************************************)
@@ -458,8 +492,8 @@ open Evar_tactics
 (* TODO: add support for some test similar to g_constr.name_colon so that
    expressions like "evar (list A)" do not raise a syntax error *)
 TACTIC EXTEND evar
-  [ "evar" "(" ident(id) ":" lconstr(typ) ")" ] -> [ let_evar (Name id) typ ]
-| [ "evar" constr(typ) ] -> [ let_evar Anonymous typ ]
+  [ "evar" test_lpar_id_colon "(" ident(id) ":" lconstr(typ) ")" ] -> [ let_evar (Name.Name id) typ ]
+| [ "evar" constr(typ) ] -> [ let_evar Name.Anonymous typ ]
 END
 
 TACTIC EXTEND instantiate
@@ -492,6 +526,7 @@ let transitivity_left_table = Summary.ref [] ~name:"transitivity-steps-l"
 let step left x tac =
   let l =
     List.map (fun lem ->
+      let lem = EConstr.of_constr lem in
       Tacticals.New.tclTHENLAST
         (apply_with_bindings (lem, ImplicitBindings [x]))
         tac)
@@ -509,7 +544,7 @@ let cache_transitivity_lemma (_,(left,lem)) =
 
 let subst_transitivity_lemma (subst,(b,ref)) = (b,subst_mps subst ref)
 
-let inTransitivity : bool * 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);
@@ -522,6 +557,7 @@ let add_transitivity_lemma left lem =
   let env = Global.env () in
   let sigma = Evd.from_env env in
   let lem',ctx (*FIXME*) = Constrintern.interp_constr env sigma lem in
+  let lem' = EConstr.to_constr sigma lem' in
   add_anonymous_leaf (inTransitivity (left,lem'))
 
 (* Vernacular syntax *)
@@ -579,8 +615,10 @@ END
 
 VERNAC COMMAND EXTEND RetroknowledgeRegister CLASSIFIED AS SIDEFF
  | [ "Register" constr(c) "as" retroknowledge_field(f) "by" constr(b)] ->
-           [ let tc,ctx = Constrintern.interp_constr (Global.env ()) Evd.empty c in
-             let tb,ctx(*FIXME*) = Constrintern.interp_constr (Global.env ()) Evd.empty b in
+           [ let tc,_ctx = Constrintern.interp_constr (Global.env ()) Evd.empty c in
+             let tb,_ctx(*FIXME*) = Constrintern.interp_constr (Global.env ()) Evd.empty b in
+             let tc = EConstr.to_constr Evd.empty tc in
+             let tb = EConstr.to_constr Evd.empty tb in
              Global.register f tc tb ]
 END
 
@@ -621,19 +659,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
-    | 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;
-	      GHole (Loc.make_loc (!locref,0),
-		     Evar_kinds.QuestionMark(Evar_kinds.Define true),
+              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'
@@ -641,46 +679,43 @@ 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
-    | GHole (_,Evar_kinds.QuestionMark(Evar_kinds.Define true),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;
-	   GHole (Loc.make_loc (!locref,0),
-		  Evar_kinds.QuestionMark(Evar_kinds.Define true),Misctypes.IntroAnonymous,s))
-    | c -> map_glob_constr_left_to_right substrec c
+           DAst.make ~loc:(Loc.make_loc (!locref,0)) @@
+	   GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),Misctypes.IntroAnonymous,s))
+    | _ -> map_glob_constr_left_to_right substrec c
   in
   substrec t
 
 open Tacmach
 
 let hResolve id c occ t =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
-  let sigma = Sigma.to_evar_map sigma 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
     with
       | Pretype_errors.PretypeError (_,_,Pretype_errors.UnsolvableImplicit _) as e ->
           let (e, info) = CErrors.push e in
-          let loc = match Loc.get_loc info with None -> Loc.ghost | Some loc -> loc in
-          resolve_hole (subst_hole_with_term (fst (Loc.unloc loc)) c_raw t_hole)
+          let loc_begin = Option.cata (fun l -> fst (Loc.unloc l)) 0 (Loc.get_loc info) in
+          resolve_hole (subst_hole_with_term loc_begin c_raw t_hole)
   in
   let t_constr,ctx = resolve_hole (subst_var_with_hole occ id t_raw) in
   let sigma = Evd.merge_universe_context sigma ctx in
   let t_constr_type = Retyping.get_type_of env sigma t_constr in
-  let tac =
-    (change_concl (mkLetIn (Anonymous,t_constr,t_constr_type,concl)))
-  in
-  Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (change_concl (mkLetIn (Name.Anonymous,t_constr,t_constr_type,concl)))
+  end
 
 let hResolve_auto id c t =
   let rec resolve_auto n = 
@@ -701,21 +736,8 @@ END
    hget_evar
 *)
 
-let hget_evar n =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let sigma = Tacmach.New.project gl in
-  let concl = Proofview.Goal.concl gl in
-  let evl = evar_list concl in
-  if List.length evl < n then
-    error "Not enough uninstantiated existential variables.";
-  if n <= 0 then error "Incorrect existential variable index.";
-  let ev = List.nth evl (n-1) in
-  let ev_type = existential_type sigma ev in
-  change_concl (mkLetIn (Anonymous,mkEvar ev,ev_type,concl))
-  end }
-
 TACTIC EXTEND hget_evar
-| [ "hget_evar" int_or_var(n) ] -> [ hget_evar n ]
+| [ "hget_evar" int_or_var(n) ] -> [ Evar_tactics.hget_evar n ]
 END
 
 (**********************************************************************)
@@ -731,17 +753,17 @@ END
 exception Found of unit Proofview.tactic
 
 let rewrite_except h =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let hyps = Tacmach.New.pf_ids_of_hyps gl in
   Tacticals.New.tclMAP (fun id -> if Id.equal id h then Proofview.tclUNIT () else 
       Tacticals.New.tclTRY (Equality.general_rewrite_in true Locus.AllOccurrences true true id (mkVar h) false))
     hyps
-  end }
+  end
 
 
 let refl_equal = 
   let coq_base_constant s =
-    Coqlib.gen_constant_in_modules "RecursiveDefinition"
+    Coqlib.gen_reference_in_modules "RecursiveDefinition"
       (Coqlib.init_modules @ [["Coq";"Arith";"Le"];["Coq";"Arith";"Lt"]]) s in
   function () -> (coq_base_constant "eq_refl")
 
@@ -750,82 +772,99 @@ let refl_equal =
   should be replaced by a call to the tactic but I don't know how to
   call it before it is defined. *)
 let  mkCaseEq a  : unit Proofview.tactic =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let type_of_a = Tacmach.New.of_old (fun g -> Tacmach.pf_unsafe_type_of g a) gl in
-       Tacticals.New.tclTHENLIST
-         [Tactics.generalize [mkApp(delayed_force refl_equal, [| type_of_a; a|])];
-          Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+    let type_of_a = Tacmach.New.pf_unsafe_type_of gl a in
+    Tacticals.New.pf_constr_of_global (delayed_force refl_equal) >>= fun req ->
+    Tacticals.New.tclTHENLIST
+         [Tactics.generalize [(mkApp(req, [| type_of_a; a|]))];
+          Proofview.Goal.enter begin fun gl ->
             let concl = Proofview.Goal.concl gl in
             let env = Proofview.Goal.env gl in
             (** FIXME: this looks really wrong. Does anybody really use this tactic? *)
-            let Sigma (c, _, _) = (Tacred.pattern_occs [Locus.OnlyOccurrences [1], a]).Reductionops.e_redfun env (Sigma.Unsafe.of_evar_map Evd.empty) concl in
+            let (_, c) = Tacred.pattern_occs [Locus.OnlyOccurrences [1], a] env Evd.empty concl in
 	    change_concl c
-          end };
+          end;
 	  simplest_case a]
-  end }
+  end
 
 
 let case_eq_intros_rewrite x =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let n = nb_prod (Proofview.Goal.concl gl) in
+  Proofview.Goal.enter begin fun gl ->
+  let n = nb_prod (Tacmach.New.project gl) (Proofview.Goal.concl gl) in
   (* Pp.msgnl (Printer.pr_lconstr x); *)
   Tacticals.New.tclTHENLIST [
       mkCaseEq x;
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let concl = Proofview.Goal.concl gl in
-      let hyps = Tacmach.New.pf_ids_of_hyps gl in
-      let n' = nb_prod concl in
-      let h = Tacmach.New.of_old (fun g -> fresh_id hyps (Id.of_string "heq") g) 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 [
                     Tacticals.New.tclDO (n'-n-1) intro;
 		    introduction h;
 		    rewrite_except h]
-    end }
+    end
   ]
-  end }
+  end
 
-let rec find_a_destructable_match t =
+let rec find_a_destructable_match sigma t =
   let cl = induction_arg_of_quantified_hyp (NamedHyp (Id.of_string "x")) in
   let cl = [cl, (None, None), None], None in
-  let dest = TacAtom (Loc.ghost, TacInductionDestruct(false, false, cl)) in
-  match kind_of_term t with
-    | Case (_,_,x,_) when closed0 x ->
-	if isVar x then
+  let dest = TacAtom (Loc.tag @@ TacInductionDestruct(false, false, cl)) in
+  match EConstr.kind sigma t with
+    | Case (_,_,x,_) when closed0 sigma x ->
+	if isVar sigma x then
 	  (* TODO check there is no rel n. *)
 	  raise (Found (Tacinterp.eval_tactic dest))
 	else
 	  (* let _ = Pp.msgnl (Printer.pr_lconstr x)  in *)
 	  raise (Found (case_eq_intros_rewrite x))
-    | _ -> iter_constr find_a_destructable_match t
+    | _ -> EConstr.iter sigma (fun c -> find_a_destructable_match sigma c) t
 	
 
 let destauto t =
-  try find_a_destructable_match t;
+  Proofview.tclEVARMAP >>= fun sigma ->
+  try find_a_destructable_match sigma t;
     Tacticals.New.tclZEROMSG (str "No destructable match found")
   with Found tac -> tac
 
 let destauto_in id = 
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let ctype = Tacmach.New.of_old (fun g -> Tacmach.pf_unsafe_type_of g (mkVar id)) gl in
+  Proofview.Goal.enter begin fun gl ->
+  let ctype = Tacmach.New.pf_unsafe_type_of gl (mkVar id) in
 (*  Pp.msgnl (Printer.pr_lconstr (mkVar id)); *)
 (*  Pp.msgnl (Printer.pr_lconstr (ctype)); *)
   destauto ctype
-  end }
+  end
 
 TACTIC EXTEND destauto
-| [ "destauto" ] -> [ Proofview.Goal.nf_enter { enter = begin fun gl -> destauto (Proofview.Goal.concl gl) end } ]
+| [ "destauto" ] -> [ Proofview.Goal.enter begin fun gl -> destauto (Proofview.Goal.concl gl) end ]
 | [ "destauto" "in" hyp(id) ] -> [ destauto_in id ]
 END
 
+(**********************************************************************)
+
+(**********************************************************************)
+(* A version of abstract constructing transparent terms               *)
+(* Introduced by Jason Gross and Benjamin Delaware in June 2016       *)
+(**********************************************************************)
+
+TACTIC EXTEND transparent_abstract
+| [ "transparent_abstract" tactic3(t) ] -> [ Proofview.Goal.nf_enter begin fun gl ->
+      Tactics.tclABSTRACT ~opaque:false None (Tacinterp.tactic_of_value ist t) end ]
+| [ "transparent_abstract" tactic3(t) "using" ident(id) ] -> [ Proofview.Goal.nf_enter begin fun gl ->
+      Tactics.tclABSTRACT ~opaque:false (Some id) (Tacinterp.tactic_of_value ist t) end ]
+END
 
 (* ********************************************************************* *)
 
 let eq_constr x y = 
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+    let env = Tacmach.New.pf_env gl in
     let evd = Tacmach.New.project gl in
-      if Evarutil.eq_constr_univs_test evd evd x y then Proofview.tclUNIT () 
-      else Tacticals.New.tclFAIL 0 (str "Not equal")
-  end }
+      match EConstr.eq_constr_universes env evd x y with
+      | Some _ -> Proofview.tclUNIT () 
+      | None -> Tacticals.New.tclFAIL 0 (str "Not equal")
+  end
 
 TACTIC EXTEND constr_eq
 | [ "constr_eq" constr(x) constr(y) ] -> [ eq_constr x y ]
@@ -833,90 +872,80 @@ END
 
 TACTIC EXTEND constr_eq_nounivs
 | [ "constr_eq_nounivs" constr(x) constr(y) ] -> [
-    if eq_constr_nounivs x y then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (str "Not equal") ]
+    Proofview.tclEVARMAP >>= fun sigma ->
+    if eq_constr_nounivs sigma x y then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (str "Not equal") ]
 END
 
 TACTIC EXTEND is_evar
-| [ "is_evar" constr(x) ] ->
-    [ Proofview.tclBIND Proofview.tclEVARMAP begin fun sigma ->
-      match Evarutil.kind_of_term_upto sigma x with
-        | Evar _ -> Proofview.tclUNIT ()
-        | _ -> Tacticals.New.tclFAIL 0 (str "Not an evar")
-      end
+| [ "is_evar" constr(x) ] -> [
+    Proofview.tclEVARMAP >>= fun sigma ->
+    match EConstr.kind sigma x with
+      | Evar _ -> Proofview.tclUNIT ()
+      | _ -> Tacticals.New.tclFAIL 0 (str "Not an evar")
     ]
 END
 
-let rec has_evar x =
-  match kind_of_term 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
-
 TACTIC EXTEND has_evar
-| [ "has_evar" constr(x) ] ->
-    [ if has_evar x then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (str "No evars") ]
+| [ "has_evar" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  if Evarutil.has_undefined_evars sigma x
+  then Proofview.tclUNIT ()
+  else Tacticals.New.tclFAIL 0 (str "No evars")
+]
 END
 
 TACTIC EXTEND is_hyp
-| [ "is_var" constr(x) ] ->
-  [ match kind_of_term x with
+| [ "is_var" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma x with
     | Var _ ->  Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclFAIL 0 (str "Not a variable or hypothesis") ]
 END
 
 TACTIC EXTEND is_fix
-| [ "is_fix" constr(x) ] ->
-  [ match kind_of_term x with
+| [ "is_fix" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma x with
     | Fix _ -> Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a fix definition") ]
 END;;
 
 TACTIC EXTEND is_cofix
-| [ "is_cofix" constr(x) ] ->
-  [ match kind_of_term x with
+| [ "is_cofix" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma x with
     | CoFix _ -> Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a cofix definition") ]
 END;;
 
 TACTIC EXTEND is_ind
-| [ "is_ind" constr(x) ] ->
-  [ match kind_of_term x with
+| [ "is_ind" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma x with
     | Ind _ -> Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not an (co)inductive datatype") ]
 END;;
 
 TACTIC EXTEND is_constructor
-| [ "is_constructor" constr(x) ] ->
-  [ match kind_of_term x with
+| [ "is_constructor" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma x with
     | Construct _ -> Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a constructor") ]
 END;;
 
 TACTIC EXTEND is_proj
-| [ "is_proj" constr(x) ] ->
-  [ match kind_of_term x with
+| [ "is_proj" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma x with
     | Proj _ -> Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a primitive projection") ]
 END;;
 
 TACTIC EXTEND is_const
-| [ "is_const" constr(x) ] ->
-  [ match kind_of_term x with
+| [ "is_const" constr(x) ] -> [
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma x with
     | Const _ -> Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a constant") ]
 END;;
@@ -950,6 +979,7 @@ TACTIC EXTEND unshelve
 | [ "unshelve" tactic1(t) ] ->
     [
       Proofview.with_shelf (Tacinterp.tactic_of_value ist t) >>= fun (gls, ()) ->
+      let gls = List.map Proofview.with_empty_state gls in
       Proofview.Unsafe.tclGETGOALS >>= fun ogls ->
       Proofview.Unsafe.tclSETGOALS (gls @ ogls)
     ]
@@ -1005,7 +1035,7 @@ let pr_cmp' _prc _prlc _prt = pr_cmp
 let pr_test_gen f (Test(c,x,y)) =
   Pp.(f x ++ pr_cmp c ++ f y)
 
-let pr_test = pr_test_gen (Pptactic.pr_or_var Pp.int)
+let pr_test = pr_test_gen (Pputils.pr_or_var Pp.int)
 
 let pr_test' _prc _prlc _prt = pr_test
 
@@ -1059,14 +1089,15 @@ TACTIC EXTEND guard
 END
 
 let decompose l c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+    let sigma = Tacmach.New.project gl in
     let to_ind c =
-      if isInd c then Univ.out_punivs (destInd c)
-      else error "not an inductive type"
+      if isInd sigma c then fst (destInd sigma c)
+      else user_err Pp.(str "not an inductive type")
     in
     let l = List.map to_ind l in
     Elim.h_decompose l c
-  end }
+  end
 
 TACTIC EXTEND decompose
 | [ "decompose" "[" ne_constr_list(l) "]" constr(c) ] -> [ decompose l c ]
@@ -1075,10 +1106,14 @@ END
 (** library/keys *)
 
 VERNAC COMMAND EXTEND Declare_keys CLASSIFIED AS SIDEFF
-| [ "Declare" "Equivalent" "Keys" constr(c) constr(c') ] -> [ 
-  let it c = snd (Constrintern.interp_open_constr (Global.env ()) Evd.empty c) in 
-  let k1 = Keys.constr_key (it c) in
-  let k2 = Keys.constr_key (it c') in
+| [ "Declare" "Equivalent" "Keys" constr(c) constr(c') ] -> [
+  let get_key c =
+    let (evd, c) = Constrintern.interp_open_constr (Global.env ()) Evd.empty c in
+    let kind c = EConstr.kind evd c in
+    Keys.constr_key kind c
+  in
+  let k1 = get_key c in
+  let k2 = get_key c' in
     match k1, k2 with
     | Some k1, Some k2 -> Keys.declare_equiv_keys k1 k2
     | _ -> () ]
@@ -1095,3 +1130,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/ltac/extratactics.mli b/plugins/ltac/extratactics.mli
index 18334daf..7fb9a19a 100644
--- a/ltac/extratactics.mli
+++ b/plugins/ltac/extratactics.mli
@@ -1,11 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+
 val discrHyp : Names.Id.t -> unit Proofview.tactic
 val injHyp : Names.Id.t -> unit Proofview.tactic
 
diff --git a/ltac/g_auto.ml4 b/plugins/ltac/g_auto.ml4
index 6a8fa8d6..643f7e99 100644
--- a/ltac/g_auto.ml4
+++ b/plugins/ltac/g_auto.ml4
@@ -1,23 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pp
 open Genarg
 open Stdarg
-open Constrarg
 open Pcoq.Prim
 open Pcoq.Constr
-open Pcoq.Tactic
-open Tacexpr
+open Pltac
+open Hints
 
-DECLARE PLUGIN "g_auto"
+DECLARE PLUGIN "ltac_plugin"
 
 (* Hint bases *)
 
@@ -44,15 +43,20 @@ let eval_uconstrs ist cs =
   let flags = {
     Pretyping.use_typeclasses = false;
     solve_unification_constraints = true;
-    use_hook = Some Pfedit.solve_by_implicit_tactic;
+    use_hook = Pfedit.solve_by_implicit_tactic ();
     fail_evar = false;
     expand_evars = true
   } in
-  List.map (fun c -> Pretyping.type_uconstr ~flags ist c) cs
+  let map c env sigma = c env sigma in
+  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
@@ -149,15 +153,6 @@ TACTIC EXTEND autounfold_one
     [ Eauto.autounfold_one (match db with None -> ["core"] | Some x -> "core"::x) None ]
       END
 
-TACTIC EXTEND autounfoldify
-| [ "autounfoldify" constr(x) ] -> [
-    let db = match Term.kind_of_term x with
-      | Term.Const (c,_) -> Names.Label.to_string (Names.con_label c)
-      | _ -> assert false
-    in Eauto.autounfold ["core";db] Locusops.onConcl 
-  ]
-END
-
 TACTIC EXTEND unify
 | ["unify" constr(x) constr(y) ] -> [ Tactics.unify x y ]
 | ["unify" constr(x) constr(y) "with" preident(base)  ] -> [
@@ -195,7 +190,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
 
@@ -219,10 +214,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/ltac/g_class.ml4 b/plugins/ltac/g_class.ml4
index 7e26b5d1..1c2f90b6 100644
--- a/ltac/g_class.ml4
+++ b/plugins/ltac/g_class.ml4
@@ -1,20 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Misctypes
 open Class_tactics
-open Pcoq.Tactic
 open Stdarg
-open Constrarg
+open Tacarg
 
-DECLARE PLUGIN "g_class"
+DECLARE PLUGIN "ltac_plugin"
 
 (** Options: depth, debug and transparency settings. *)
 
@@ -22,7 +20,7 @@ let set_transparency cl b =
   List.iter (fun r ->
     let gr = Smartlocate.global_with_alias r in
     let ev = Tacred.evaluable_of_global_reference (Global.env ()) gr in
-      Classes.set_typeclass_transparency ev false b) cl
+      Classes.set_typeclass_transparency ev (Locality.make_section_locality None) b) cl
 
 VERNAC COMMAND EXTEND Typeclasses_Unfold_Settings CLASSIFIED AS SIDEFF
 | [ "Typeclasses" "Transparent" reference_list(cl) ] -> [
@@ -84,36 +82,37 @@ TACTIC EXTEND not_evar
 END
 
 TACTIC EXTEND is_ground
-  [ "is_ground" constr(ty) ] -> [ Proofview.V82.tactic (is_ground ty) ]
+  [ "is_ground" constr(ty) ] -> [ is_ground ty ]
 END
 
 TACTIC EXTEND autoapply
-  [ "autoapply" constr(c) "using" preident(i) ] -> [ Proofview.V82.tactic (autoapply c i) ]
+  [ "autoapply" constr(c) "using" preident(i) ] -> [ autoapply c i ]
 END
 
 (** TODO: DEPRECATE *)
 (* A progress test that allows to see if the evars have changed *)
-open Term
-open Proofview.Goal
+open Constr
 open Proofview.Notations
 
-let rec eq_constr_mod_evars x y =
-  match kind_of_term x, kind_of_term y with
+let rec eq_constr_mod_evars sigma x y =
+  let open EConstr in
+  match EConstr.kind sigma x, EConstr.kind sigma y with
   | Evar (e1, l1), Evar (e2, l2) when not (Evar.equal e1 e2) -> true
-  | _, _ -> compare_constr eq_constr_mod_evars x y
+  | _, _ -> compare_constr sigma (fun x y -> eq_constr_mod_evars sigma x y) x y
 
 let progress_evars t =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let check =
-      Proofview.Goal.nf_enter { enter = begin fun gl' ->
+      Proofview.Goal.enter begin fun gl' ->
+        let sigma = Tacmach.New.project gl' in
         let newconcl = Proofview.Goal.concl gl' in
-        if eq_constr_mod_evars concl newconcl
+        if eq_constr_mod_evars sigma concl newconcl
         then Tacticals.New.tclFAIL 0 (Pp.str"No progress made (modulo evars)")
         else Proofview.tclUNIT ()
-      end }
+      end
     in t <*> check
-  end }
+  end
 
 TACTIC EXTEND progress_evars
   [ "progress_evars" tactic(t) ] -> [ progress_evars (Tacinterp.tactic_of_value ist t) ]
diff --git a/ltac/g_eqdecide.ml4 b/plugins/ltac/g_eqdecide.ml4
index 90565328..2251a662 100644
--- a/ltac/g_eqdecide.ml4
+++ b/plugins/ltac/g_eqdecide.ml4
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (************************************************************************)
@@ -12,11 +14,10 @@
 (*                           by Eduardo Gimenez                        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Eqdecide
+open Stdarg
 
-DECLARE PLUGIN "g_eqdecide"
+DECLARE PLUGIN "ltac_plugin"
 
 TACTIC EXTEND decide_equality
 | [ "decide" "equality" ] -> [ decideEqualityGoal ]
diff --git a/ltac/g_ltac.ml4 b/plugins/ltac/g_ltac.ml4
index a3ca4ebc..0c42a8bb 100644
--- a/ltac/g_ltac.ml4
+++ b/plugins/ltac/g_ltac.ml4
@@ -1,26 +1,30 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
+DECLARE PLUGIN "ltac_plugin"
 
 open Util
 open Pp
-open Compat
 open Constrexpr
 open Tacexpr
 open Misctypes
 open Genarg
 open Genredexpr
-open Tok (* necessary for camlp4 *)
+open Tok (* necessary for camlp5 *)
+open Names
 
 open Pcoq
+open Pcoq.Constr
+open Pcoq.Vernac_
 open Pcoq.Prim
-open Pcoq.Tactic
+open Pltac
 
 let fail_default_value = ArgArg 0
 
@@ -30,14 +34,15 @@ let arg_of_expr = function
 
 let genarg_of_unit () = in_gen (rawwit Stdarg.wit_unit) ()
 let genarg_of_int n = in_gen (rawwit Stdarg.wit_int) n
-let genarg_of_ipattern pat = in_gen (rawwit Constrarg.wit_intro_pattern) pat
-let genarg_of_uconstr c = in_gen (rawwit Constrarg.wit_uconstr) c
+let genarg_of_ipattern pat = in_gen (rawwit Stdarg.wit_intro_pattern) pat
+let genarg_of_uconstr c = in_gen (rawwit Stdarg.wit_uconstr) c
+let in_tac tac = in_gen (rawwit Tacarg.wit_ltac) tac
 
-let reference_to_id = function
-  | Libnames.Ident (loc, id) -> (loc, id)
-  | Libnames.Qualid (loc,_) ->
-      CErrors.user_err_loc (loc, "",
-        str "This expression should be a simple identifier.")
+let reference_to_id = CAst.map_with_loc (fun ?loc -> function
+  | Libnames.Ident id -> id
+  | Libnames.Qualid _ ->
+    CErrors.user_err ?loc
+      (str "This expression should be a simple identifier."))
 
 let tactic_mode = Gram.entry_create "vernac:tactic_command"
 
@@ -62,23 +67,21 @@ let _ =
 let test_bracket_ident =
   Gram.Entry.of_parser "test_bracket_ident"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
         | KEYWORD "[" ->
-            (match get_tok (stream_nth 1 strm) with
+            (match stream_nth 1 strm with
               | IDENT _ -> ()
 	      | _ -> raise Stream.Failure)
 	| _ -> raise Stream.Failure)
 
 (* Tactics grammar rules *)
 
-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")
+let hint = G_proofs.hint
 
 GEXTEND Gram
-  GLOBAL: tactic tacdef_body tactic_expr binder_tactic tactic_arg
-          tactic_mode constr_may_eval constr_eval toplevel_selector;
+  GLOBAL: tactic tacdef_body tactic_expr binder_tactic tactic_arg command hint
+          tactic_mode constr_may_eval constr_eval toplevel_selector
+          operconstr;
 
   tactic_then_last:
     [ [ "|"; lta = LIST0 OPT tactic_expr SEP "|" ->
@@ -151,9 +154,9 @@ GEXTEND Gram
       | g=failkw; n = [ n = int_or_var -> n | -> fail_default_value ];
 	  l = LIST0 message_token -> TacFail (g,n,l)
       | st = simple_tactic -> st
-      | a = tactic_arg -> TacArg(!@loc,a)
+      | a = tactic_arg -> TacArg(Loc.tag ~loc:!@loc a)
       | r = reference; la = LIST0 tactic_arg_compat ->
-          TacArg(!@loc,TacCall (!@loc,r,la)) ]
+          TacArg(Loc.tag ~loc:!@loc @@ TacCall (Loc.tag ~loc:!@loc (r,la))) ]
     | "0"
       [ "("; a = tactic_expr; ")" -> a
       | "["; ">"; (tf,tail) = tactic_then_gen; "]" ->
@@ -161,7 +164,7 @@ GEXTEND Gram
           | Some (t,tl) -> TacExtendTac(Array.of_list tf,t,tl)
           | None -> TacDispatch tf
           end
-      | a = tactic_atom -> TacArg (!@loc,a) ] ]
+      | a = tactic_atom -> TacArg (Loc.tag ~loc:!@loc a) ] ]
   ;
   failkw:
   [ [ IDENT "fail" -> TacLocal | IDENT "gfail" -> TacGlobal ] ]
@@ -179,7 +182,7 @@ GEXTEND Gram
   (* Tactic arguments to the right of an application *)
   tactic_arg_compat:
     [ [ a = tactic_arg -> a
-      | c = Constr.constr -> (match c with CRef (r,None) -> Reference r | c -> ConstrMayEval (ConstrTerm c))
+      | c = Constr.constr -> (match c with { CAst.v = CRef (r,None) } -> Reference r | c -> ConstrMayEval (ConstrTerm c))
       (* Unambiguous entries: tolerated w/o "ltac:" modifier *)
       | "()" -> TacGeneric (genarg_of_unit ()) ] ]
   ;
@@ -195,7 +198,8 @@ 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,id) ] ]
+        | qid = qualid -> let (_pth,id) = Libnames.repr_qualid qid.CAst.v in
+                          ArgVar (CAst.make ~loc:!@loc id) ] ]
   ;
   constr_eval:
     [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
@@ -211,7 +215,7 @@ GEXTEND Gram
   ;
   tactic_atom:
     [ [ n = integer -> TacGeneric (genarg_of_int n)
-      | r = reference -> TacCall (!@loc,r,[])
+      | r = reference -> TacCall (Loc.tag ~loc:!@loc (r,[]))
       | "()" -> TacGeneric (genarg_of_unit ()) ] ]
   ;
   match_key:
@@ -220,24 +224,21 @@ GEXTEND Gram
       | "multimatch" -> General ] ]
   ;
   input_fun:
-    [ [ "_" -> None
-      | l = ident -> Some l ] ]
+    [ [ "_" -> Name.Anonymous
+      | 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:
@@ -247,10 +248,10 @@ GEXTEND Gram
 	  let t, ty =
 	    match mpv with
 	    | Term t -> (match t with
-	      | CCast (loc, t, (CastConv ty | CastVM ty | CastNative ty)) -> Term t, Some (Term ty)
+	      | { CAst.v = CCast (t, (CastConv ty | CastVM ty | CastNative ty)) } -> Term t, Some (Term ty)
 	      | _ -> mpv, None)
 	    | _ -> mpv, None
-	  in Def (na, t, Option.default (Term (CHole (Loc.ghost, None, IntroAnonymous, None))) ty)
+	  in Def (na, t, Option.default (Term (CAst.make @@ CHole (None, IntroAnonymous, None))) ty)
     ] ]
   ;
   match_context_rule:
@@ -286,15 +287,15 @@ GEXTEND Gram
   (* Definitions for tactics *)
   tacdef_body:
     [ [ name = Constr.global; it=LIST1 input_fun; redef = ltac_def_kind; body = tactic_expr ->
-          if redef then Vernacexpr.TacticRedefinition (name, TacFun (it, body))
+          if redef then Tacexpr.TacticRedefinition (name, TacFun (it, body))
           else
             let id = reference_to_id name in
-            Vernacexpr.TacticDefinition (id, TacFun (it, body))
+            Tacexpr.TacticDefinition (id, TacFun (it, body))
       | name = Constr.global; redef = ltac_def_kind; body = tactic_expr ->
-          if redef then Vernacexpr.TacticRedefinition (name, body)
+          if redef then Tacexpr.TacticRedefinition (name, body)
           else
             let id = reference_to_id name in
-            Vernacexpr.TacticDefinition (id, body)
+            Tacexpr.TacticDefinition (id, body)
     ] ]
   ;
   tactic:
@@ -327,11 +328,31 @@ GEXTEND Gram
     |   IDENT "all"; ":" -> SelectAll ] ]
   ;
   tactic_mode:
-    [ [ g = OPT toplevel_selector; tac = G_vernac.subgoal_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), l)
+      | IDENT "Proof"; "using"; l = G_vernac.section_subset_expr;
+        ta = OPT [ "with"; ta = Pltac.tactic -> in_tac ta ] ->
+          Vernacexpr.VernacProof (ta,Some l) ] ]
+  ;
+  hint:
+    [ [ IDENT "Extern"; n = natural; c = OPT Constr.constr_pattern ; "=>";
+        tac = Pltac.tactic ->
+          Vernacexpr.HintsExtern (n,c, in_tac tac) ] ]
+  ;
+  operconstr: LEVEL "0"
+    [ [ IDENT "ltac"; ":"; "("; tac = Pltac.tactic_expr; ")" ->
+          let arg = Genarg.in_gen (Genarg.rawwit Tacarg.wit_tactic) tac in
+          CAst.make ~loc:!@loc @@ CHole (None, IntroAnonymous, Some arg) ] ]
   ;
   END
 
-open Constrarg
+open Stdarg
+open Tacarg
 open Vernacexpr
 open Vernac_classifier
 open Goptions
@@ -340,7 +361,6 @@ open Libnames
 let print_info_trace = ref None
 
 let _ = declare_int_option {
-  optsync = true;
   optdepr = false;
   optname = "print info trace";
   optkey = ["Info" ; "Level"];
@@ -362,16 +382,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 "[" ++ Nameops.pr_id 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 ]
@@ -404,7 +415,7 @@ let is_explicit_terminator = function TacSolve _ -> true | _ -> false
 VERNAC tactic_mode EXTEND VernacSolve
 | [ - ltac_selector_opt(g) ltac_info_opt(n) tactic(t) ltac_use_default(def) ] =>
     [ classify_as_proofstep ] -> [
-    let g = Option.default (Proof_global.get_default_goal_selector ()) g in
+    let g = Option.default (Proof_bullet.get_default_goal_selector ()) g in
     vernac_solve g n t def
   ]
 | [ - "par" ":" ltac_info_opt(n) tactic(t) ltac_use_default(def) ] =>
@@ -433,32 +444,41 @@ END
 
 let pr_ltac_production_item = function
 | Tacentries.TacTerm s -> quote (str s)
-| Tacentries.TacNonTerm (_, (arg, sep), id) ->
+| Tacentries.TacNonTerm (_, ((arg, None), None)) -> str arg
+| Tacentries.TacNonTerm (_, ((arg, Some _), None)) -> assert false
+| Tacentries.TacNonTerm (_, ((arg, sep), Some id)) ->
   let sep = match sep with
   | None -> mt ()
   | Some sep -> str "," ++ spc () ++ quote (str sep)
   in
-  str arg ++ str "(" ++ Nameops.pr_id id ++ sep ++ str ")"
+  str arg ++ str "(" ++ Id.print id ++ sep ++ str ")"
 
 VERNAC ARGUMENT EXTEND ltac_production_item PRINTED BY pr_ltac_production_item
 | [ string(s) ] -> [ Tacentries.TacTerm s ]
 | [ ident(nt) "(" ident(p) ltac_production_sep_opt(sep) ")" ] ->
-  [ Tacentries.TacNonTerm (loc, (Names.Id.to_string nt, sep), p) ]
+  [ Tacentries.TacNonTerm (Loc.tag ~loc ((Id.to_string nt, sep), Some p)) ]
+| [ ident(nt) ] ->
+  [ 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
 
 VERNAC COMMAND EXTEND VernacPrintLtac CLASSIFIED AS QUERY
 | [ "Print" "Ltac" reference(r) ] ->
-  [ Feedback.msg_notice (Tacintern.print_ltac (snd (Libnames.qualid_of_reference r))) ]
+  [ Feedback.msg_notice (Tacintern.print_ltac (Libnames.qualid_of_reference r).CAst.v) ]
+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
@@ -466,7 +486,7 @@ let pr_ltac_ref = Libnames.pr_reference
 let pr_tacdef_body tacdef_body =
   let id, redef, body =
     match tacdef_body with
-    | TacticDefinition ((_,id), body) -> Nameops.pr_id 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 =
@@ -474,8 +494,8 @@ let pr_tacdef_body tacdef_body =
       | Tacexpr.TacFun (idl,b) -> idl,b
       | _ -> [], body in
   id ++
-    prlist (function None -> str " _"
-      | Some id -> spc () ++ Nameops.pr_id id) idl
+    prlist (function Name.Anonymous -> str " _"
+      | Name.Name id -> spc () ++ Id.print id) idl
   ++ (if redef then str" ::=" else str" :=") ++ brk(1,1)
   ++ Pptactic.pr_raw_tactic body
 
@@ -484,15 +504,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
-      | 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
+      | TacticDefinition ({CAst.v=r},_) -> r
+      | TacticRedefinition ({CAst.v=Ident r},_) -> r
+      | TacticRedefinition ({CAst.v=Qualid q},_) -> snd(repr_qualid q)) l), VtLater
+  ] -> [ fun ~atts ~st -> let open Vernacinterp in
+           Tacentries.register_ltac (Locality.make_module_locality atts.locality) l;
+           st
   ]
 END
 
diff --git a/ltac/g_obligations.ml4 b/plugins/ltac/g_obligations.ml4
index 987b9d53..352e92c2 100644
--- a/ltac/g_obligations.ml4
+++ b/plugins/ltac/g_obligations.ml4
@@ -1,23 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*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
 open Constrexpr_ops
 open Stdarg
-open Constrarg
+open Tacarg
 open Extraargs
 
 let (set_default_tactic, get_default_tactic, print_default_tactic) = 
@@ -30,16 +29,27 @@ let () =
   end in
   Obligations.default_tactic := tac
 
+let with_tac f tac =
+  let env = Genintern.empty_glob_sign (Global.env ()) in
+  let tac = match tac with
+  | None -> None
+  | Some tac ->
+    let tac = Genarg.in_gen (Genarg.rawwit wit_ltac) tac in
+    let _, tac = Genintern.generic_intern env tac in
+    Some tac
+  in
+  f tac
+
 (* We define new entries for programs, with the use of this module
  * Subtac. These entries are named Subtac.<foo>
  *)
 
 module Gram = Pcoq.Gram
-module Tactic = Pcoq.Tactic
+module Tactic = Pltac
 
 open Pcoq
 
-let sigref = mkRefC (Qualid (Loc.ghost, Libnames.qualid_of_string "Coq.Init.Specif.sig"))
+let sigref = mkRefC (CAst.make @@ Qualid (Libnames.qualid_of_string "Coq.Init.Specif.sig"))
 
 type 'a withtac_argtype = (Tacexpr.raw_tactic_expr option, 'a) Genarg.abstract_argument_type
 
@@ -59,13 +69,16 @@ GEXTEND Gram
   Constr.closed_binder:
     [[ "("; id=Prim.name; ":"; t=Constr.lconstr; "|"; c=Constr.lconstr; ")" ->
 	  let typ = mkAppC (sigref, [mkLambdaC ([id], default_binder_kind, t, c)]) in
-          [LocalRawAssum ([id], default_binder_kind, typ)]
+          [CLocalAssum ([id], default_binder_kind, typ)]
     ] ];
 
   END
 
 open Obligations
 
+let obligation obl tac = with_tac (fun t -> Obligations.obligation obl t) tac
+let next_obligation obl tac = with_tac (fun t -> Obligations.next_obligation obl t) tac
+
 let classify_obbl _ = Vernacexpr.(VtStartProof ("Classic",Doesn'tGuaranteeOpacity,[]), VtLater)
 
 VERNAC COMMAND EXTEND Obligations CLASSIFIED BY classify_obbl
@@ -110,11 +123,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
@@ -142,6 +159,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/ltac/g_rewrite.ml4 b/plugins/ltac/g_rewrite.ml4
index 28078efd..fbaa2e58 100644
--- a/ltac/g_rewrite.ml4
+++ b/plugins/ltac/g_rewrite.ml4
@@ -1,13 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 (* Syntax for rewriting with strategies *)
 
 open Names
@@ -18,22 +18,25 @@ open Glob_term
 open Geninterp
 open Extraargs
 open Tacmach
-open Tacticals
 open Rewrite
 open Stdarg
-open Constrarg
+open Pcoq.Vernac_
 open Pcoq.Prim
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
 
-DECLARE PLUGIN "g_rewrite"
+DECLARE PLUGIN "ltac_plugin"
 
 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
@@ -64,13 +67,13 @@ let subst_strategy s str = str
 
 let pr_strategy _ _ _ (s : strategy) = Pp.str "<strategy>"
 let pr_raw_strategy prc prlc _ (s : raw_strategy) =
-  let prr = Pptactic.pr_red_expr (prc, prlc, Pptactic.pr_or_by_notation Libnames.pr_reference, prc) in
+  let prr = Pptactic.pr_red_expr (prc, prlc, Pputils.pr_or_by_notation Libnames.pr_reference, prc) in
   Rewrite.pr_strategy prc prr s
 let pr_glob_strategy prc prlc _ (s : glob_strategy) =
   let prr = Pptactic.pr_red_expr
     (Ppconstr.pr_constr_expr,
     Ppconstr.pr_lconstr_expr,
-    Pptactic.pr_or_by_notation Libnames.pr_reference,
+    Pputils.pr_or_by_notation Libnames.pr_reference,
     Ppconstr.pr_constr_expr)
   in
   Rewrite.pr_strategy prc prr s
@@ -123,15 +126,19 @@ TACTIC EXTEND rewrite_strat
 END
 
 let clsubstitute o c =
-  let is_tac id = match fst (fst (snd c)) with GVar (_, id') when Id.equal id' id -> true | _ -> false in
-    Tacticals.onAllHypsAndConcl
+  Proofview.Goal.enter begin fun gl ->
+  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 ->
         match cl with
-          | Some id when is_tac id -> tclIDTAC
-          | _ -> Proofview.V82.of_tactic (cl_rewrite_clause c o AllOccurrences cl))
+          | Some id when is_tac id -> Tacticals.New.tclIDTAC
+          | _ -> cl_rewrite_clause c o AllOccurrences cl)
+      (None :: List.map (fun id -> Some id) hyps)
+  end
 
 TACTIC EXTEND substitute
-| [ "substitute" orient(o) glob_constr_with_bindings(c) ] -> [ Proofview.V82.tactic (clsubstitute o c) ]
+| [ "substitute" orient(o) glob_constr_with_bindings(c) ] -> [ clsubstitute o c ]
 END
 
 
@@ -183,7 +190,7 @@ VERNAC COMMAND EXTEND AddRelation3 CLASSIFIED AS SIDEFF
       [ declare_relation a aeq n None None (Some lemma3) ]
 END
 
-type binders_argtype = local_binder list
+type binders_argtype = local_binder_expr list
 
 let wit_binders =
  (Genarg.create_arg "binders" : binders_argtype Genarg.uniform_genarg_type)
@@ -192,8 +199,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
 
@@ -237,22 +243,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
@@ -270,5 +291,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/parsing/g_tactic.ml4 b/plugins/ltac/g_tactic.ml4
index 3152afb2..7534e279 100644
--- a/parsing/g_tactic.ml4
+++ b/plugins/ltac/g_tactic.ml4
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -14,7 +16,6 @@ open Genredexpr
 open Constrexpr
 open Libnames
 open Tok
-open Compat
 open Misctypes
 open Locus
 open Decl_kinds
@@ -34,11 +35,11 @@ let err () = raise Stream.Failure
 let test_lpar_id_coloneq =
   Gram.Entry.of_parser "lpar_id_coloneq"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
         | KEYWORD "(" ->
-            (match get_tok (stream_nth 1 strm) with
+            (match stream_nth 1 strm with
               | IDENT _ ->
-                  (match get_tok (stream_nth 2 strm) with
+                  (match stream_nth 2 strm with
 	            | KEYWORD ":=" -> ()
 	            | _ -> err ())
 	      | _ -> err ())
@@ -48,11 +49,11 @@ let test_lpar_id_coloneq =
 let test_lpar_id_rpar =
   Gram.Entry.of_parser "lpar_id_coloneq"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
         | KEYWORD "(" ->
-            (match get_tok (stream_nth 1 strm) with
+            (match stream_nth 1 strm with
               | IDENT _ ->
-                  (match get_tok (stream_nth 2 strm) with
+                  (match stream_nth 2 strm with
 	            | KEYWORD ")" -> ()
 	            | _ -> err ())
 	      | _ -> err ())
@@ -62,125 +63,118 @@ let test_lpar_id_rpar =
 let test_lpar_idnum_coloneq =
   Gram.Entry.of_parser "test_lpar_idnum_coloneq"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
         | KEYWORD "(" ->
-            (match get_tok (stream_nth 1 strm) with
+            (match stream_nth 1 strm with
               | IDENT _ | INT _ ->
-                  (match get_tok (stream_nth 2 strm) with
+                  (match stream_nth 2 strm with
                     | KEYWORD ":=" -> ()
                     | _ -> err ())
               | _ -> err ())
         | _ -> err ())
 
 (* idem for (x:t) *)
-let test_lpar_id_colon =
-  Gram.Entry.of_parser "lpar_id_colon"
-    (fun strm ->
-      match get_tok (stream_nth 0 strm) with
-        | KEYWORD "(" ->
-            (match get_tok (stream_nth 1 strm) with
-              | IDENT _ ->
-                  (match get_tok (stream_nth 2 strm) with
-                    | KEYWORD ":" -> ()
-                    | _ -> err ())
-              | _ -> err ())
-        | _ -> err ())
+open Extraargs
 
 (* idem for (x1..xn:t) [n^2 complexity but exceptional use] *)
 let check_for_coloneq =
   Gram.Entry.of_parser "lpar_id_colon"
     (fun strm ->
       let rec skip_to_rpar p n =
-	match get_tok (List.last (Stream.npeek n strm)) with
+	match List.last (Stream.npeek n strm) with
         | KEYWORD "(" -> skip_to_rpar (p+1) (n+1)
         | KEYWORD ")" -> if Int.equal p 0 then n+1 else skip_to_rpar (p-1) (n+1)
 	| KEYWORD "." -> err ()
 	| _ -> skip_to_rpar p (n+1) in
       let rec skip_names n =
-	match get_tok (List.last (Stream.npeek n strm)) with
+	match List.last (Stream.npeek n strm) with
         | IDENT _ | KEYWORD "_" -> skip_names (n+1)
 	| KEYWORD ":" -> skip_to_rpar 0 (n+1) (* skip a constr *)
 	| _ -> err () in
       let rec skip_binders n =
-	match get_tok (List.last (Stream.npeek n strm)) with
+	match List.last (Stream.npeek n strm) with
         | KEYWORD "(" -> skip_binders (skip_names (n+1))
         | IDENT _ | KEYWORD "_" -> skip_binders (n+1)
 	| KEYWORD ":=" -> ()
 	| _ -> err () in
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
       | KEYWORD "(" -> skip_binders 2
       | _ -> err ())
 
 let lookup_at_as_comma =
   Gram.Entry.of_parser "lookup_at_as_comma"
     (fun strm ->
-      match get_tok (stream_nth 0 strm) with
+      match stream_nth 0 strm with
 	| KEYWORD (","|"at"|"as") -> ()
 	| _ -> err ())
 
 open Constr
 open Prim
-open Tactic
+open Pltac
 
 let mk_fix_tac (loc,id,bl,ann,ty) =
   let n =
     match bl,ann with
         [([_],_,_)], None -> 1
       | _, Some x ->
-          let ids = List.map snd (List.flatten (List.map pi1 bl)) in
-          (try List.index Names.Name.equal (snd x) ids
-          with Not_found -> error "No such fix variable.")
-      | _ -> error "Cannot guess decreasing argument of fix." in
-  (id,n,CProdN(loc,bl,ty))
+          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,"Constr:mk_cofix_tac",
-       Pp.str"Annotation forbidden in cofix expression.")) ann in
-  (id,CProdN(loc,bl,ty))
+  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
 
+let mkNumeral n = Numeral (string_of_int (abs n), 0<=n)
+
 let mkTacCase with_evar = function
   | [(clear,ElimOnConstr cl),(None,None),None],None ->
       TacCase (with_evar,(clear,cl))
   (* Reinterpret numbers as a notation for terms *)
   | [(clear,ElimOnAnonHyp n),(None,None),None],None ->
       TacCase (with_evar,
-        (clear,(CPrim (Loc.ghost, Numeral (Bigint.of_int n)),
-	 NoBindings)))
+        (clear,(CAst.make @@ CPrim (mkNumeral n),
+         NoBindings)))
   (* 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 ->
-      TacCase (with_evar,(clear,(CRef (Ident id,None),NoBindings)))
+      TacCase (with_evar,(clear,(CAst.make @@ CRef (CAst.make ?loc:id.CAst.loc @@ Ident id.CAst.v,None),NoBindings)))
   | ic ->
       if List.exists (function ((_, ElimOnAnonHyp _),_,_) -> true | _ -> false) (fst ic)
       then
-	error "Use of numbers as direct arguments of 'case' is not supported.";
+	user_err Pp.(str "Use of numbers as direct arguments of 'case' is not supported.");
       TacInductionDestruct (false,with_evar,ic)
 
-let rec mkCLambdaN_simple_loc loc bll c =
+let rec mkCLambdaN_simple_loc ?loc bll c =
   match bll with
-  | ((loc1,_)::_ as idl,bk,t) :: bll ->
-      CLambdaN (loc,[idl,bk,t],mkCLambdaN_simple_loc (Loc.merge loc1 loc) bll c)
-  | ([],_,_) :: bll -> mkCLambdaN_simple_loc 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 (fst (List.hd (pi1 h))) (Constrexpr_ops.constr_loc c) in
-    mkCLambdaN_simple_loc loc bl c
+    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 (fst (List.hd l)) (fst (List.last l))
+let loc_of_ne_list l = Loc.merge_opt (List.hd l).CAst.loc (List.last l).CAst.loc
 
 let map_int_or_var f = function
   | ArgArg x -> ArgArg (f x)
@@ -192,7 +186,7 @@ let merge_occurrences loc cl = function
   | None ->
       if Locusops.clause_with_generic_occurrences cl then (None, cl)
       else
-	user_err_loc (loc,"",str "Found an \"at\" clause without \"with\" clause.")
+	user_err ~loc  (str "Found an \"at\" clause without \"with\" clause.")
   | Some (occs, p) ->
     let ans = match occs with
     | AllOccurrences -> cl
@@ -204,9 +198,9 @@ let merge_occurrences loc cl = function
         { cl with onhyps = Some [(occs, id), l] }
       | _ ->
         if Locusops.clause_with_generic_occurrences cl then
-          user_err_loc (loc,"",str "Unable to interpret the \"at\" clause; move it in the \"in\" clause.")
+          user_err ~loc  (str "Unable to interpret the \"at\" clause; move it in the \"in\" clause.")
         else
-          user_err_loc (loc,"",str "Cannot use clause \"at\" twice.")
+          user_err ~loc  (str "Cannot use clause \"at\" twice.")
       end
     in
     (Some p, ans)
@@ -217,6 +211,8 @@ let warn_deprecated_eqn_syntax =
 
 (* Auxiliary grammar rules *)
 
+open Vernac_
+
 GEXTEND Gram
   GLOBAL: simple_tactic constr_with_bindings quantified_hypothesis
   bindings red_expr int_or_var open_constr uconstr
@@ -300,7 +296,7 @@ GEXTEND Gram
 	  (* (A & B & C) is translated into (A,(B,C)) *)
 	  let rec pairify = function
 	    | ([]|[_]|[_;_]) as l -> l
-	    | t::q -> [t;(loc_of_ne_list q,IntroAction (IntroOrAndPattern (IntroAndPattern (pairify q))))]
+            | t::q -> [t; CAst.make ?loc:(loc_of_ne_list q) (IntroAction (IntroOrAndPattern (IntroAndPattern (pairify q))))]
 	  in IntroAndPattern (pairify (si::tc)) ] ]
   ;
   equality_intropattern:
@@ -315,27 +311,28 @@ GEXTEND Gram
   ;
   nonsimple_intropattern:
     [ [ l = simple_intropattern -> l
-      | "*" -> !@loc, IntroForthcoming true
-      | "**" -> !@loc, IntroForthcoming false ]]
+      | "*"  -> CAst.make ~loc:!@loc @@ IntroForthcoming true
+      | "**" -> CAst.make ~loc:!@loc @@ IntroForthcoming false ]]
   ;
   simple_intropattern:
     [ [ pat = simple_intropattern_closed;
         l = LIST0 ["%"; c = operconstr LEVEL "0" -> c] ->
-          let loc0,pat = pat in
+          let {CAst.loc=loc0;v=pat} = pat in
           let f c pat =
-            let loc = Loc.merge loc0 (Constrexpr_ops.constr_loc c) in
-            IntroAction (IntroApplyOn (c,(loc,pat))) in
-          !@loc, List.fold_right f l pat ] ]
+            let loc1 = Constrexpr_ops.constr_loc c in
+            let loc = Loc.merge_opt loc0 loc1 in
+            IntroAction (IntroApplyOn (CAst.(make ?loc:loc1 c),CAst.(make ?loc pat))) in
+          CAst.make ~loc:!@loc @@ List.fold_right f l pat ] ]
   ;
   simple_intropattern_closed:
-    [ [ pat = or_and_intropattern -> !@loc, IntroAction (IntroOrAndPattern pat)
-      | pat = equality_intropattern -> !@loc, IntroAction pat
-      | "_" -> !@loc, IntroAction IntroWildcard 
-      | pat = naming_intropattern -> !@loc, IntroNaming pat ] ]
+    [ [ pat = or_and_intropattern   -> CAst.make ~loc:!@loc @@ IntroAction (IntroOrAndPattern pat)
+      | pat = equality_intropattern -> CAst.make ~loc:!@loc @@ IntroAction pat
+      | "_" -> CAst.make ~loc:!@loc @@ IntroAction IntroWildcard
+      | pat = naming_intropattern -> CAst.make ~loc:!@loc @@ IntroNaming pat ] ]
   ;
   simple_binding:
-    [ [ "("; id = ident; ":="; c = lconstr; ")" -> (!@loc, NamedHyp id, c)
-      | "("; n = natural; ":="; c = lconstr; ")" -> (!@loc, AnonHyp n, c) ] ]
+    [ [ "("; id = ident; ":="; c = lconstr; ")" -> CAst.make ~loc:!@loc (NamedHyp id, c)
+      | "("; n = natural; ":="; c = lconstr; ")" -> CAst.make ~loc:!@loc (AnonHyp n, c) ] ]
   ;
   bindings:
     [ [ test_lpar_idnum_coloneq; bl = LIST1 simple_binding ->
@@ -386,15 +383,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 ->
@@ -438,7 +440,8 @@ GEXTEND Gram
       | -> true ]]
   ;
   simple_binder:
-    [ [ na=name -> ([na],Default Explicit,CHole (!@loc, 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)
     ] ]
   ;
@@ -466,7 +469,7 @@ GEXTEND Gram
       | -> None ] ]
   ;
   or_and_intropattern_loc:
-    [ [ ipat = or_and_intropattern -> ArgArg (!@loc,ipat)
+    [ [ ipat = or_and_intropattern -> ArgArg (CAst.make ~loc:!@loc ipat)
       | locid = identref -> ArgVar locid ] ]
   ;
   as_or_and_ipat:
@@ -474,17 +477,17 @@ GEXTEND Gram
       | -> None ] ]
   ;
   eqn_ipat:
-    [ [ IDENT "eqn"; ":"; pat = naming_intropattern -> Some (!@loc, pat)
+    [ [ IDENT "eqn"; ":"; pat = naming_intropattern -> Some (CAst.make ~loc:!@loc pat)
       | IDENT "_eqn"; ":"; pat = naming_intropattern ->
          let loc = !@loc in
-	 warn_deprecated_eqn_syntax ~loc "H"; Some (loc, pat)
+         warn_deprecated_eqn_syntax ~loc "H"; Some (CAst.make ~loc pat)
       | IDENT "_eqn" ->
          let loc = !@loc in
-	 warn_deprecated_eqn_syntax ~loc "?"; Some (loc, IntroAnonymous)
+         warn_deprecated_eqn_syntax ~loc "?"; Some (CAst.make ~loc IntroAnonymous)
       | -> None ] ]
   ;
   as_name:
-    [ [ "as"; id = ident -> Names.Name id | -> Names.Anonymous ] ]
+    [ [ "as"; id = ident ->Names.Name.Name id | -> Names.Name.Anonymous ] ]
   ;
   by_tactic:
     [ [ "by"; tac = tactic_expr LEVEL "3" -> Some tac
@@ -519,145 +522,177 @@ GEXTEND Gram
     [ [
       (* Basic tactics *)
         IDENT "intros"; pl = ne_intropatterns ->
-          TacAtom (!@loc, TacIntroPattern (false,pl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacIntroPattern (false,pl))
       | IDENT "intros" ->
-          TacAtom (!@loc, TacIntroPattern (false,[!@loc,IntroForthcoming false]))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacIntroPattern (false,[CAst.make ~loc:!@loc @@IntroForthcoming false]))
       | IDENT "eintros"; pl = ne_intropatterns ->
-          TacAtom (!@loc, TacIntroPattern (true,pl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacIntroPattern (true,pl))
 
       | IDENT "apply"; cl = LIST1 constr_with_bindings_arg SEP ",";
-          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (true,false,cl,inhyp))
+          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (true,false,cl,inhyp))
       | IDENT "eapply"; cl = LIST1 constr_with_bindings_arg SEP ",";
-          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (true,true,cl,inhyp))
+          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (true,true,cl,inhyp))
       | IDENT "simple"; IDENT "apply";
           cl = LIST1 constr_with_bindings_arg SEP ",";
-          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (false,false,cl,inhyp))
+          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (false,false,cl,inhyp))
       | IDENT "simple"; IDENT "eapply";
           cl = LIST1 constr_with_bindings_arg SEP",";
-          inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (false,true,cl,inhyp))
+          inhyp = in_hyp_as -> TacAtom (Loc.tag ~loc:!@loc @@ TacApply (false,true,cl,inhyp))
       | IDENT "elim"; cl = constr_with_bindings_arg; el = OPT eliminator ->
-          TacAtom (!@loc, TacElim (false,cl,el))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacElim (false,cl,el))
       | IDENT "eelim"; cl = constr_with_bindings_arg; el = OPT eliminator ->
-          TacAtom (!@loc, TacElim (true,cl,el))
-      | IDENT "case"; icl = induction_clause_list -> TacAtom (!@loc, mkTacCase false icl)
-      | IDENT "ecase"; icl = induction_clause_list -> TacAtom (!@loc, mkTacCase true icl)
+          TacAtom (Loc.tag ~loc:!@loc @@ TacElim (true,cl,el))
+      | IDENT "case"; icl = induction_clause_list -> TacAtom (Loc.tag ~loc:!@loc @@ mkTacCase false icl)
+      | IDENT "ecase"; icl = induction_clause_list -> TacAtom (Loc.tag ~loc:!@loc @@ mkTacCase true icl)
       | "fix"; id = ident; n = natural; "with"; fd = LIST1 fixdecl ->
-	  TacAtom (!@loc, TacMutualFix (id,n,List.map mk_fix_tac fd))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacMutualFix (id,n,List.map mk_fix_tac fd))
       | "cofix"; id = ident; "with"; fd = LIST1 cofixdecl ->
-	  TacAtom (!@loc, TacMutualCofix (id,List.map mk_cofix_tac fd))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacMutualCofix (id,List.map mk_cofix_tac fd))
 
       | IDENT "pose"; (id,b) = bindings_with_parameters ->
-	  TacAtom (!@loc, TacLetTac (Names.Name id,b,Locusops.nowhere,true,None))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,Names.Name.Name id,b,Locusops.nowhere,true,None))
       | IDENT "pose"; b = constr; na = as_name ->
-	  TacAtom (!@loc, TacLetTac (na,b,Locusops.nowhere,true,None))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,na,b,Locusops.nowhere,true,None))
+      | IDENT "epose"; (id,b) = bindings_with_parameters ->
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,Names.Name id,b,Locusops.nowhere,true,None))
+      | IDENT "epose"; b = constr; na = as_name ->
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,na,b,Locusops.nowhere,true,None))
       | IDENT "set"; (id,c) = bindings_with_parameters; p = clause_dft_concl ->
-	  TacAtom (!@loc, TacLetTac (Names.Name id,c,p,true,None))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,Names.Name.Name id,c,p,true,None))
       | IDENT "set"; c = constr; na = as_name; p = clause_dft_concl ->
-          TacAtom (!@loc, TacLetTac (na,c,p,true,None))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,na,c,p,true,None))
+      | IDENT "eset"; (id,c) = bindings_with_parameters; p = clause_dft_concl ->
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,Names.Name id,c,p,true,None))
+      | IDENT "eset"; c = constr; na = as_name; p = clause_dft_concl ->
+          TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,na,c,p,true,None))
       | IDENT "remember"; c = constr; na = as_name; e = eqn_ipat;
           p = clause_dft_all ->
-          TacAtom (!@loc, TacLetTac (na,c,p,false,e))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (false,na,c,p,false,e))
+      | IDENT "eremember"; c = constr; na = as_name; e = eqn_ipat;
+          p = clause_dft_all ->
+          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, TacAssert (true,None,Some (!@loc,IntroNaming (IntroIdentifier id)),c))
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,None,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+      | IDENT "eassert"; test_lpar_id_coloneq; "("; lid = identref; ":=";
+	  c = lconstr; ")" ->
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,None,Some (CAst.make ?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 ->
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+      | IDENT "eassert"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-	  TacAtom (!@loc, TacAssert (true,Some tac,Some (!@loc,IntroNaming (IntroIdentifier id)),c))
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,Some tac,Some (CAst.make ?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 ->
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,false,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
+      | IDENT "eenough"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-	  TacAtom (!@loc, TacAssert (false,Some tac,Some (!@loc,IntroNaming (IntroIdentifier id)),c))
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,false,Some tac,Some (CAst.make ?loc @@ IntroNaming (IntroIdentifier id)),c))
 
       | IDENT "assert"; c = constr; ipat = as_ipat; tac = by_tactic ->
-	  TacAtom (!@loc, TacAssert (true,Some tac,ipat,c))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,true,Some tac,ipat,c))
+      | IDENT "eassert"; c = constr; ipat = as_ipat; tac = by_tactic ->
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,true,Some tac,ipat,c))
       | IDENT "pose"; IDENT "proof"; c = lconstr; ipat = as_ipat ->
-	  TacAtom (!@loc, TacAssert (true,None,ipat,c))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,true,None,ipat,c))
+      | IDENT "epose"; IDENT "proof"; c = lconstr; ipat = as_ipat ->
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,true,None,ipat,c))
       | IDENT "enough"; c = constr; ipat = as_ipat; tac = by_tactic ->
-	  TacAtom (!@loc, TacAssert (false,Some tac,ipat,c))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,false,Some tac,ipat,c))
+      | IDENT "eenough"; c = constr; ipat = as_ipat; tac = by_tactic ->
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,false,Some tac,ipat,c))
 
       | IDENT "generalize"; c = constr ->
-	  TacAtom (!@loc, TacGeneralize [((AllOccurrences,c),Names.Anonymous)])
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacGeneralize [((AllOccurrences,c),Names.Name.Anonymous)])
       | IDENT "generalize"; c = constr; l = LIST1 constr ->
-	  let gen_everywhere c = ((AllOccurrences,c),Names.Anonymous) in
-          TacAtom (!@loc, TacGeneralize (List.map gen_everywhere (c::l)))
+	  let gen_everywhere c = ((AllOccurrences,c),Names.Name.Anonymous) in
+          TacAtom (Loc.tag ~loc:!@loc @@ TacGeneralize (List.map gen_everywhere (c::l)))
       | IDENT "generalize"; c = constr; lookup_at_as_comma; nl = occs;
           na = as_name;
           l = LIST0 [","; c = pattern_occ; na = as_name -> (c,na)] ->
-          TacAtom (!@loc, TacGeneralize (((nl,c),na)::l))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacGeneralize (((nl,c),na)::l))
 
       (* Derived basic tactics *)
       | IDENT "induction"; ic = induction_clause_list ->
-	  TacAtom (!@loc, TacInductionDestruct (true,false,ic))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct (true,false,ic))
       | IDENT "einduction"; ic = induction_clause_list ->
-	  TacAtom (!@loc, TacInductionDestruct(true,true,ic))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct(true,true,ic))
       | IDENT "destruct"; icl = induction_clause_list ->
-	  TacAtom (!@loc, TacInductionDestruct(false,false,icl))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct(false,false,icl))
       | IDENT "edestruct";  icl = induction_clause_list ->
-	  TacAtom (!@loc, TacInductionDestruct(false,true,icl))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacInductionDestruct(false,true,icl))
 
       (* Equality and inversion *)
       | IDENT "rewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=by_tactic -> TacAtom (!@loc, TacRewrite (false,l,cl,t))
+	  cl = clause_dft_concl; t=by_tactic -> TacAtom (Loc.tag ~loc:!@loc @@ TacRewrite (false,l,cl,t))
       | IDENT "erewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=by_tactic -> TacAtom (!@loc, TacRewrite (true,l,cl,t))
+	  cl = clause_dft_concl; t=by_tactic -> TacAtom (Loc.tag ~loc:!@loc @@ TacRewrite (true,l,cl,t))
       | IDENT "dependent"; k =
 	  [ IDENT "simple"; IDENT "inversion" -> SimpleInversion
 	  | IDENT "inversion" -> FullInversion
 	  | IDENT "inversion_clear" -> FullInversionClear ];
 	  hyp = quantified_hypothesis;
 	  ids = as_or_and_ipat; co = OPT ["with"; c = constr -> c] ->
-	    TacAtom (!@loc, TacInversion (DepInversion (k,co,ids),hyp))
+	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (DepInversion (k,co,ids),hyp))
       | IDENT "simple"; IDENT "inversion";
 	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacAtom (!@loc, TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp))
+	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp))
       | IDENT "inversion";
 	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacAtom (!@loc, TacInversion (NonDepInversion (FullInversion, cl, ids), hyp))
+	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (NonDepInversion (FullInversion, cl, ids), hyp))
       | IDENT "inversion_clear";
 	  hyp = quantified_hypothesis; ids = as_or_and_ipat;
 	  cl = in_hyp_list ->
-	    TacAtom (!@loc, TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp))
+	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp))
       | IDENT "inversion"; hyp = quantified_hypothesis;
 	  "using"; c = constr; cl = in_hyp_list ->
-	    TacAtom (!@loc, TacInversion (InversionUsing (c,cl), hyp))
+	    TacAtom (Loc.tag ~loc:!@loc @@ TacInversion (InversionUsing (c,cl), hyp))
 
       (* Conversion *)
       | IDENT "red"; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Red false, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Red false, cl))
       | IDENT "hnf"; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Hnf, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Hnf, cl))
       | IDENT "simpl"; d = delta_flag; po = OPT ref_or_pattern_occ; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Simpl (all_with d, po), cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Simpl (all_with d, po), cl))
       | IDENT "cbv"; s = strategy_flag; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Cbv s, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Cbv s, cl))
       | IDENT "cbn"; s = strategy_flag; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Cbn s, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Cbn s, cl))
       | IDENT "lazy"; s = strategy_flag; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Lazy s, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Lazy s, cl))
       | IDENT "compute"; delta = delta_flag; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Cbv (all_with delta), cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Cbv (all_with delta), cl))
       | IDENT "vm_compute"; po = OPT ref_or_pattern_occ; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (CbvVm po, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (CbvVm po, cl))
       | IDENT "native_compute"; po = OPT ref_or_pattern_occ; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (CbvNative po, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (CbvNative po, cl))
       | IDENT "unfold"; ul = LIST1 unfold_occ SEP ","; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Unfold ul, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Unfold ul, cl))
       | IDENT "fold"; l = LIST1 constr; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Fold l, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Fold l, cl))
       | IDENT "pattern"; pl = LIST1 pattern_occ SEP","; cl = clause_dft_concl ->
-          TacAtom (!@loc, TacReduce (Pattern pl, cl))
+          TacAtom (Loc.tag ~loc:!@loc @@ TacReduce (Pattern pl, cl))
 
       (* Change ne doit pas s'appliquer dans un Definition t := Eval ... *)
       | IDENT "change"; (oc,c) = conversion; cl = clause_dft_concl ->
 	  let p,cl = merge_occurrences (!@loc) cl oc in
-	  TacAtom (!@loc, TacChange (p,c,cl))
+	  TacAtom (Loc.tag ~loc:!@loc @@ TacChange (p,c,cl))
     ] ]
   ;
 END;;
diff --git a/ltac/ltac.mllib b/plugins/ltac/ltac_plugin.mlpack
index fc51e48a..ec96e1bb 100644
--- a/ltac/ltac.mllib
+++ b/plugins/ltac/ltac_plugin.mlpack
@@ -1,10 +1,15 @@
-Taccoerce
+Tacexpr
+Tacarg
 Tacsubst
 Tacenv
+Pptactic
+Pltac
+Taccoerce
 Tactic_debug
 Tacintern
 Tacentries
 Profile_ltac
+Tactic_matching
 Tacinterp
 Evar_tactics
 Tactic_option
@@ -17,6 +22,6 @@ G_auto
 G_class
 Rewrite
 G_rewrite
-Tauto
 G_eqdecide
+G_tactic
 G_ltac
diff --git a/plugins/ltac/pltac.ml b/plugins/ltac/pltac.ml
new file mode 100644
index 00000000..e9711268
--- /dev/null
+++ b/plugins/ltac/pltac.ml
@@ -0,0 +1,66 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pcoq
+
+(* Main entry for extensions *)
+let simple_tactic = Gram.entry_create "tactic:simple_tactic"
+
+let make_gen_entry _ name = Gram.entry_create ("tactic:" ^ name)
+
+(* Entries that can be referred via the string -> Gram.entry table *)
+(* Typically for tactic user extensions *)
+let open_constr =
+  make_gen_entry utactic "open_constr"
+let constr_with_bindings =
+  make_gen_entry utactic "constr_with_bindings"
+let bindings =
+  make_gen_entry utactic "bindings"
+let hypident = Gram.entry_create "hypident"
+let constr_may_eval = make_gen_entry utactic "constr_may_eval"
+let constr_eval = make_gen_entry utactic "constr_eval"
+let uconstr =
+  make_gen_entry utactic "uconstr"
+let quantified_hypothesis =
+  make_gen_entry utactic "quantified_hypothesis"
+let destruction_arg = make_gen_entry utactic "destruction_arg"
+let int_or_var = make_gen_entry utactic "int_or_var"
+let simple_intropattern =
+  make_gen_entry utactic "simple_intropattern"
+let in_clause = make_gen_entry utactic "in_clause"
+let clause_dft_concl = 
+  make_gen_entry utactic "clause"
+
+
+(* Main entries for ltac *)
+let tactic_arg = Gram.entry_create "tactic:tactic_arg"
+let tactic_expr = make_gen_entry utactic "tactic_expr"
+let binder_tactic = make_gen_entry utactic "binder_tactic"
+
+let tactic = make_gen_entry utactic "tactic"
+
+(* Main entry for quotations *)
+let tactic_eoi = eoi_entry tactic
+
+let () =
+  let open Stdarg in
+  let open Tacarg in
+  register_grammar wit_int_or_var (int_or_var);
+  register_grammar wit_intro_pattern (simple_intropattern);
+  register_grammar wit_quant_hyp (quantified_hypothesis);
+  register_grammar wit_uconstr (uconstr);
+  register_grammar wit_open_constr (open_constr);
+  register_grammar wit_constr_with_bindings (constr_with_bindings);
+  register_grammar wit_bindings (bindings);
+  register_grammar wit_tactic (tactic);
+  register_grammar wit_ltac (tactic);
+  register_grammar wit_clause_dft_concl (clause_dft_concl);
+  register_grammar wit_destruction_arg (destruction_arg);
+  ()
diff --git a/plugins/ltac/pltac.mli b/plugins/ltac/pltac.mli
new file mode 100644
index 00000000..6637de74
--- /dev/null
+++ b/plugins/ltac/pltac.mli
@@ -0,0 +1,38 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Ltac parsing entries *)
+
+open Pcoq
+open Libnames
+open Constrexpr
+open Tacexpr
+open Genredexpr
+open Misctypes
+
+val open_constr : constr_expr Gram.entry
+val constr_with_bindings : constr_expr with_bindings Gram.entry
+val bindings : constr_expr bindings Gram.entry
+val hypident : (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
+val quantified_hypothesis : quantified_hypothesis Gram.entry
+val destruction_arg : constr_expr with_bindings destruction_arg Gram.entry
+val int_or_var : int or_var Gram.entry
+val simple_tactic : raw_tactic_expr Gram.entry
+val simple_intropattern : constr_expr intro_pattern_expr CAst.t 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
+val tactic : raw_tactic_expr Gram.entry
+val tactic_eoi : raw_tactic_expr Gram.entry
diff --git a/printing/pptactic.ml b/plugins/ltac/pptactic.ml
index fcc30d70..11bb7a23 100644
--- a/printing/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -12,24 +14,47 @@ open Namegen
 open CErrors
 open Util
 open Constrexpr
-open Tacexpr
 open Genarg
 open Geninterp
-open Constrarg
+open Stdarg
 open Libnames
-open Ppextend
+open Notation_term
 open Misctypes
 open Locus
 open Decl_kinds
 open Genredexpr
+open Pputils
 open Ppconstr
 open Printer
 
+open Tacexpr
+open Tacarg
+
+module Tag =
+struct
+
+  let keyword   = "tactic.keyword"
+  let primitive = "tactic.primitive"
+  let string    = "tactic.string"
+
+end
+
+let tag t s = Pp.tag t s
+let do_not_tag _ x = x
+let tag_keyword                 = tag Tag.keyword
+let tag_primitive               = tag Tag.primitive
+let tag_string                  = tag Tag.string
+let tag_glob_tactic_expr        = do_not_tag
+let tag_glob_atomic_tactic_expr = do_not_tag
+let tag_raw_tactic_expr         = do_not_tag
+let tag_raw_atomic_tactic_expr  = do_not_tag
+let tag_atomic_tactic_expr      = do_not_tag
+
 let pr_global x = Nametab.pr_global_env Id.Set.empty x
 
 type 'a grammar_tactic_prod_item_expr =
 | TacTerm of string
-| TacNonTerm of Loc.t * 'a * Names.Id.t
+| TacNonTerm of ('a * Names.Id.t option) Loc.located
 
 type grammar_terminals = Genarg.ArgT.any Extend.user_symbol grammar_tactic_prod_item_expr list
 
@@ -45,59 +70,48 @@ let declare_notation_tactic_pprule kn pt =
   prnotation_tab := KNmap.add kn pt !prnotation_tab
 
 type 'a raw_extra_genarg_printer =
-    (constr_expr -> std_ppcmds) ->
-    (constr_expr -> std_ppcmds) ->
-    (tolerability -> raw_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
+    (constr_expr -> Pp.t) ->
+    (constr_expr -> Pp.t) ->
+    (tolerability -> raw_tactic_expr -> Pp.t) ->
+    'a -> Pp.t
 
 type 'a glob_extra_genarg_printer =
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
+    (glob_constr_and_expr -> Pp.t) ->
+    (glob_constr_and_expr -> Pp.t) ->
+    (tolerability -> glob_tactic_expr -> Pp.t) ->
+    'a -> Pp.t
 
 type 'a extra_genarg_printer =
-    (Term.constr -> std_ppcmds) ->
-    (Term.constr -> std_ppcmds) ->
-    (tolerability -> Val.t -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-let genarg_pprule = ref String.Map.empty
-
-let declare_extra_genarg_pprule wit f g h =
-  let s = match wit with
-    | ExtraArg s -> ArgT.repr s
-    | _ -> error
-      "Can declare a pretty-printing rule only for extra argument types."
-  in
-  let f prc prlc prtac x = f prc prlc prtac (out_gen (rawwit wit) x) in
-  let g prc prlc prtac x = g prc prlc prtac (out_gen (glbwit wit) x) in
-  let h prc prlc prtac x = h prc prlc prtac (out_gen (topwit wit) x) in
-  genarg_pprule := String.Map.add s (f,g,h) !genarg_pprule
-
-module Make
-  (Ppconstr : Ppconstrsig.Pp)
-  (Taggers : sig
-      val tag_keyword
-        : std_ppcmds -> std_ppcmds
-      val tag_primitive
-        : std_ppcmds -> std_ppcmds
-      val tag_string
-        : std_ppcmds -> std_ppcmds
-      val tag_glob_tactic_expr
-        : glob_tactic_expr -> std_ppcmds -> std_ppcmds
-      val tag_glob_atomic_tactic_expr
-        : glob_atomic_tactic_expr -> std_ppcmds -> std_ppcmds
-      val tag_raw_tactic_expr
-        : raw_tactic_expr -> std_ppcmds -> std_ppcmds
-      val tag_raw_atomic_tactic_expr
-        : raw_atomic_tactic_expr -> std_ppcmds -> std_ppcmds
-      val tag_atomic_tactic_expr
-        : atomic_tactic_expr -> std_ppcmds -> std_ppcmds
-  end)
-= struct
-
-  open Taggers
+    (EConstr.constr -> Pp.t) ->
+    (EConstr.constr -> Pp.t) ->
+    (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)
@@ -111,7 +125,7 @@ module Make
   | None -> assert false
   | Some Refl -> x
 
-  let rec pr_value lev v : std_ppcmds =
+  let rec pr_value lev v : Pp.t =
     if has_type v Val.typ_list then
       pr_sequence (fun x -> pr_value lev x) (unbox v Val.typ_list)
     else if has_type v Val.typ_opt then
@@ -131,84 +145,18 @@ module Make
         | 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
 
-  let pr_with_occurrences pr (occs,c) =
-    match occs with
-      | AllOccurrences ->
-        pr c
-      | NoOccurrences ->
-        failwith "pr_with_occurrences: no occurrences"
-      | OnlyOccurrences nl ->
-        hov 1 (pr c ++ spc () ++ keyword "at" ++ spc () ++
-                 hov 0 (prlist_with_sep spc (pr_or_var int) nl))
-      | AllOccurrencesBut nl ->
-        hov 1 (pr c ++ spc () ++ keyword "at" ++ str" - " ++
-                 hov 0 (prlist_with_sep spc (pr_or_var int) nl))
-
-  exception ComplexRedFlag
-
-  let pr_short_red_flag pr r =
-    if not r.rBeta ||  not r.rMatch || not r.rFix || not r.rCofix || not r.rZeta then
-      raise ComplexRedFlag
-    else if List.is_empty r.rConst then
-      if r.rDelta then mt () else raise ComplexRedFlag
-    else (if r.rDelta then str "-" else mt ()) ++
-	   hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]")
-
-  let pr_red_flag pr r =
-    try pr_short_red_flag pr r
-    with complexRedFlags ->
-      (if r.rBeta then pr_arg str "beta" else mt ()) ++
-	(if r.rMatch && r.rFix && r.rCofix then pr_arg str "iota" else
-           (if r.rMatch then pr_arg str "match" else mt ()) ++
-           (if r.rFix then pr_arg str "fix" else mt ()) ++
-           (if r.rCofix then pr_arg str "cofix" else mt ())) ++
-        (if r.rZeta then pr_arg str "zeta" else mt ()) ++
-        (if List.is_empty r.rConst then
-	   if r.rDelta then pr_arg str "delta"
-	   else mt ()
-	 else
-	   pr_arg str "delta " ++ (if r.rDelta then str "-" else mt ()) ++
-	     hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]"))
-
-  let pr_union pr1 pr2 = function
-    | Inl a -> pr1 a
-    | Inr b -> pr2 b
-
-  let pr_red_expr (pr_constr,pr_lconstr,pr_ref,pr_pattern) = function
-    | Red false -> keyword "red"
-    | Hnf -> keyword "hnf"
-    | Simpl (f,o) -> keyword "simpl" ++ (pr_short_red_flag pr_ref f)
-		     ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern)) o
-    | Cbv f ->
-      if f.rBeta && f.rMatch && f.rFix && f.rCofix &&
-           f.rZeta && f.rDelta && List.is_empty f.rConst then
-        keyword "compute"
-      else
-        hov 1 (keyword "cbv" ++ pr_red_flag pr_ref f)
-    | Lazy f ->
-      hov 1 (keyword "lazy" ++ pr_red_flag pr_ref f)
-    | Cbn f ->
-      hov 1 (keyword "cbn" ++ pr_red_flag pr_ref f)
-    | Unfold l ->
-      hov 1 (keyword "unfold" ++ spc() ++
-               prlist_with_sep pr_comma (pr_with_occurrences pr_ref) l)
-    | Fold l -> hov 1 (keyword "fold" ++ prlist (pr_arg pr_constr) l)
-    | Pattern l ->
-      hov 1 (keyword "pattern" ++
-               pr_arg (prlist_with_sep pr_comma (pr_with_occurrences pr_constr)) l)
-
-    | Red true ->
-      error "Shouldn't be accessible from user."
-    | ExtraRedExpr s ->
-      str s
-    | CbvVm o ->
-      keyword "vm_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern)) o
-    | CbvNative o ->
-      keyword "native_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern)) o
+  let pr_with_occurrences pr c = pr_with_occurrences pr keyword c
+  let pr_red_expr pr c = pr_red_expr pr keyword c
 
   let pr_may_eval test prc prlc pr2 pr3 = function
     | ConstrEval (r,c) ->
@@ -216,7 +164,7 @@ module Make
         (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 " ]")
@@ -232,15 +180,11 @@ module Make
 
   let pr_arg pr x = spc () ++ pr x
 
-  let pr_or_var pr = function
-    | ArgArg x -> pr x
-    | ArgVar (_,s) -> pr_id s
-
   let pr_and_short_name pr (c,_) = pr c
 
-  let pr_or_by_notation f = function
+  let pr_or_by_notation f = CAst.with_val (function
     | AN v -> f v
-    | ByNotation (_,s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
+    | ByNotation (s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc)
 
   let pr_located pr (loc,x) = pr x
 
@@ -252,28 +196,6 @@ module Make
     | AnonHyp n -> int n
     | NamedHyp id -> pr_id id
 
-  let pr_binding prc = function
-    | loc, NamedHyp id, c -> hov 1 (pr_id id ++ str " := " ++ cut () ++ prc c)
-    | loc, AnonHyp n, c -> hov 1 (int n ++ str " := " ++ cut () ++ prc c)
-
-  let pr_bindings prc prlc = function
-    | ImplicitBindings l ->
-      brk (1,1) ++ keyword "with" ++ brk (1,1) ++
-        hv 0 (prlist_with_sep spc prc l)
-    | ExplicitBindings l ->
-      brk (1,1) ++ keyword "with" ++ brk (1,1) ++
-        hv 0 (prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l)
-    | NoBindings -> mt ()
-
-  let pr_bindings_no_with prc prlc = function
-    | ImplicitBindings l ->
-      brk (0,1) ++
-        prlist_with_sep spc prc l
-    | ExplicitBindings l ->
-      brk (0,1) ++
-        prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
-    | NoBindings -> mt ()
-
   let pr_clear_flag clear_flag pp x =
     match clear_flag with
     | Some false -> surround (pp x)
@@ -281,7 +203,7 @@ module Make
     | None -> pp x
 
   let pr_with_bindings prc prlc (c,bl) =
-    prc c ++ pr_bindings prc prlc bl
+    prc c ++ Miscprint.pr_bindings prc prlc bl
 
   let pr_with_bindings_arg prc prlc (clear_flag,c) =
     pr_clear_flag clear_flag (pr_with_bindings prc prlc) c
@@ -300,56 +222,10 @@ module Make
 
   let with_evars ev s = if ev then "e" ^ s else s
 
-  let hov_if_not_empty n p = if Pp.ismt p then p else hov n p
-
-  let rec pr_raw_generic_rec prc prlc prtac prpat prref (GenArg (Rawwit wit, x)) =
-    match wit with
-      | ListArg wit ->
-        let map x = pr_raw_generic_rec prc prlc prtac prpat prref (in_gen (rawwit wit) x) in
-        let ans = pr_sequence map x in
-        hov_if_not_empty 0 ans
-      | OptArg wit ->
-        let ans = match x with
-          | None -> mt ()
-          | Some x -> pr_raw_generic_rec prc prlc prtac prpat prref (in_gen (rawwit wit) x)
-        in
-        hov_if_not_empty 0 ans
-      | PairArg (wit1, wit2) ->
-        let p, q = x in
-        let p = in_gen (rawwit wit1) p in
-        let q = in_gen (rawwit wit2) q in
-        hov_if_not_empty 0 (pr_sequence (pr_raw_generic_rec prc prlc prtac prpat prref) [p; q])
-      | ExtraArg s ->
-        try pi1 (String.Map.find (ArgT.repr s) !genarg_pprule) prc prlc prtac (in_gen (rawwit wit) x)
-        with Not_found -> Genprint.generic_raw_print (in_gen (rawwit wit) x)
-
-
-  let rec pr_glb_generic_rec prc prlc prtac prpat (GenArg (Glbwit wit, x)) =
-    match wit with
-      | ListArg wit ->
-        let map x = pr_glb_generic_rec prc prlc prtac prpat (in_gen (glbwit wit) x) in
-        let ans = pr_sequence map x in
-        hov_if_not_empty 0 ans
-      | OptArg wit ->
-        let ans = match x with
-          | None -> mt ()
-          | Some x -> pr_glb_generic_rec prc prlc prtac prpat (in_gen (glbwit wit) x)
-        in
-        hov_if_not_empty 0 ans
-      | PairArg (wit1, wit2) ->
-        let p, q = x in
-        let p = in_gen (glbwit wit1) p in
-        let q = in_gen (glbwit wit2) q in
-        let ans = pr_sequence (pr_glb_generic_rec prc prlc prtac prpat) [p; q] in
-        hov_if_not_empty 0 ans
-      | ExtraArg s ->
-        try pi2 (String.Map.find (ArgT.repr s) !genarg_pprule) prc prlc prtac (in_gen (glbwit wit) x)
-        with Not_found -> Genprint.generic_glb_print (in_gen (glbwit wit) x)
-
   let rec tacarg_using_rule_token pr_gen = function
     | [] -> []
     | TacTerm s :: l -> keyword s :: tacarg_using_rule_token pr_gen l
-    | TacNonTerm (_, (symb, arg), _) :: l  ->
+    | TacNonTerm (_, ((symb, arg), _)) :: l  ->
       pr_gen symb arg :: tacarg_using_rule_token pr_gen l
 
   let pr_tacarg_using_rule pr_gen l =
@@ -387,9 +263,9 @@ module Make
   let pr_alias_key key =
     try
       let prods = (KNmap.find key !prnotation_tab).pptac_prods in
-      let rec pr = function
+      let pr = function
       | TacTerm s -> primitive s
-      | TacNonTerm (_, symb, _) -> str (Printf.sprintf "(%s)" (pr_user_symbol symb))
+      | TacNonTerm (_, (symb, _)) -> str (Printf.sprintf "(%s)" (pr_user_symbol symb))
       in
       pr_sequence pr prods
     with Not_found ->
@@ -401,8 +277,9 @@ module Make
       let rec pack prods args = match prods, args with
       | [], [] -> []
       | TacTerm s :: prods, args -> TacTerm s :: pack prods args
-      | TacNonTerm (loc, symb, id) :: prods, arg :: args ->
-        TacNonTerm (loc, (symb, arg), id) :: pack prods args
+      | TacNonTerm (_, (_, None)) :: prods, args -> pack prods args
+      | TacNonTerm (loc, (symb, (Some _ as ido))) :: prods, arg :: args ->
+        TacNonTerm (loc, ((symb, arg), ido)) :: pack prods args
       | _ -> raise Not_found
       in
       let prods = pack pp.pptac_prods l in
@@ -412,7 +289,7 @@ module Make
       let pr arg = str "_" in
       KerName.print key ++ spc() ++ pr_sequence pr l ++ str" (* Generic printer *)"
 
-  let pr_farg prtac arg = prtac (1, Any) (TacArg (Loc.ghost, arg))
+  let pr_farg prtac arg = prtac (1, Any) (TacArg (Loc.tag arg))
 
   let is_genarg tag wit =
     let ArgT.Any tag = tag in
@@ -430,7 +307,7 @@ module Make
   | Glbwit (OptArg wit) -> Some (Option.map (in_gen (glbwit wit)) arg)
   | _ -> None
 
-  let rec pr_any_arg : type l. (_ -> l generic_argument -> std_ppcmds) -> _ -> l generic_argument -> std_ppcmds =
+  let rec pr_any_arg : type l. (_ -> l generic_argument -> Pp.t) -> _ -> l generic_argument -> Pp.t =
   fun prtac symb arg -> match symb with
   | Extend.Uentry tag when is_genarg tag (genarg_tag arg) -> prtac (1, Any) arg
   | Extend.Ulist1 s | Extend.Ulist0 s ->
@@ -451,7 +328,7 @@ module Make
   | Extend.Uentry _ | Extend.Uentryl _ ->
     str "ltac:(" ++ prtac (1, Any) arg ++ str ")"
 
-  let rec pr_targ prtac symb arg = match symb with
+  let pr_targ prtac symb arg = match symb with
   | Extend.Uentry tag when is_genarg tag (ArgumentType wit_tactic) ->
     prtac (1, Any) arg
   | Extend.Uentryl (_, l) -> prtac (l, Any) arg
@@ -468,70 +345,47 @@ module Make
     pr_extend_gen (pr_farg prtac)
 
   let pr_raw_alias prc prlc prtac prpat lev key args =
-    pr_alias_gen (pr_targ (fun l a -> prtac l (TacArg (Loc.ghost, a)))) lev key args
+    pr_alias_gen (pr_targ (fun l a -> prtac l (TacArg (Loc.tag a)))) lev key args
   let pr_glob_alias prc prlc prtac prpat lev key args =
-    pr_alias_gen (pr_targ (fun l a -> prtac l (TacArg (Loc.ghost, a)))) lev key args
+    pr_alias_gen (pr_targ (fun l a -> prtac l (TacArg (Loc.tag a)))) lev key args
 
   (**********************************************************************)
   (* The tactic printer                                                 *)
 
   let strip_prod_binders_expr n ty =
     let rec strip_ty acc n ty =
-      match ty 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
+      match ty.CAst.v with
+          Constrexpr.CProdN(bll,a) ->
+            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
-        | _ -> error "Cannot translate fix tactic: not enough products" in
+        | _ -> user_err Pp.(str "Cannot translate fix tactic: not enough products") in
     strip_ty [] n ty
 
   let pr_ltac_or_var pr = function
     | ArgArg x -> pr x
-    | ArgVar (loc,id) -> pr_with_comments loc (pr_id id)
+    | ArgVar {CAst.loc;v=id} -> pr_with_comments ?loc (pr_id id)
 
   let pr_ltac_constant kn =
-    if !Flags.in_debugger then pr_kn 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 "<" ++ pr_kn kn ++ str ">"
+        str "<" ++ KerName.print kn ++ str ">"
 
   let pr_evaluable_reference_env env = function
     | EvalVarRef id -> pr_id id
     | EvalConstRef sp ->
       Nametab.pr_global_env (Termops.vars_of_env env) (Globnames.ConstRef sp)
 
-  let pr_esubst prc l =
-    let pr_qhyp = function
-    (_,AnonHyp n,c) -> str "(" ++ int n ++ str" := " ++ prc c ++ str ")"
-      | (_,NamedHyp id,c) ->
-        str "(" ++ pr_id id ++ str" := " ++ prc c ++ str ")"
-    in
-    prlist_with_sep spc pr_qhyp l
-
-  let pr_bindings_gen for_ex prc prlc = function
-    | ImplicitBindings l ->
-      spc () ++
-        hv 2 ((if for_ex then mt() else keyword "with" ++ spc ()) ++
-                 prlist_with_sep spc prc l)
-    | ExplicitBindings l ->
-      spc () ++
-        hv 2 ((if for_ex then mt() else keyword "with" ++ spc ()) ++
-                 pr_esubst prlc l)
-    | NoBindings -> mt ()
-
-  let pr_bindings prc prlc = pr_bindings_gen false prc prlc
-
-  let pr_with_bindings prc prlc (c,bl) =
-    hov 1 (prc c ++ pr_bindings prc prlc bl)
-
   let pr_as_disjunctive_ipat prc ipatl =
     keyword "as" ++ spc () ++
-      pr_or_var (fun (loc,p) -> Miscprint.pr_or_and_intro_pattern prc p) ipatl
+      pr_or_var (fun {CAst.loc;v=p} -> Miscprint.pr_or_and_intro_pattern prc p) ipatl
 
-  let pr_eqn_ipat (_,ipat) = keyword "eqn:" ++ Miscprint.pr_intro_pattern_naming ipat
+  let pr_eqn_ipat {CAst.v=ipat} = keyword "eqn:" ++ Miscprint.pr_intro_pattern_naming ipat
 
   let pr_with_induction_names prc = function
     | None, None -> mt ()
@@ -553,7 +407,7 @@ module Make
 
   let pr_as_name = function
     | Anonymous -> mt ()
-    | Name id -> spc () ++ keyword "as" ++ spc () ++ pr_lident (Loc.ghost,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
@@ -573,7 +427,7 @@ module Make
   let pr_assumption prc prdc prlc ipat c = match ipat with
     (* Use this "optimisation" or use only the general case ?*)
     (* it seems that this "optimisation" is somehow more natural *)
-    | Some (_,IntroNaming (IntroIdentifier id)) ->
+    | Some {CAst.v=IntroNaming (IntroIdentifier id)} ->
       spc() ++ surround (pr_id id ++ str " :" ++ spc() ++ prlc c)
     | ipat ->
       spc() ++ prc c ++ pr_as_ipat prdc ipat
@@ -614,12 +468,13 @@ module Make
       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 } ->
@@ -644,12 +499,12 @@ module Make
 
   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"
@@ -659,12 +514,14 @@ module Make
     if Int.equal i j then int i
     else int i ++ str "-" ++ int j
 
-  let pr_goal_selector = function
-    | SelectNth i -> int i ++ str ":"
-    | SelectList l -> str "[" ++ prlist_with_sep (fun () -> str ", ") pr_range_selector l ++
-        str "]" ++ str ":"
-    | SelectId id -> str "[" ++ Nameops.pr_id id ++ str "]" ++ str ":"
-    | SelectAll -> str "all" ++ str ":"
+let pr_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"
@@ -673,11 +530,9 @@ module Make
 
   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
@@ -707,20 +562,27 @@ module Make
               str "=>" ++ brk (1,4) ++ pr t))
     | All t -> str "_" ++ spc () ++ str "=>" ++ brk (1,4) ++ pr t
 
-  let pr_funvar = function
-    | None -> spc () ++ str "_"
-    | Some id -> spc () ++ pr_id id
-
-  let pr_let_clause k pr (id,(bl,t)) =
-    hov 0 (keyword k ++ spc () ++ pr_lident id ++ prlist pr_funvar bl ++
-             str " :=" ++ brk (1,1) ++ pr (TacArg (Loc.ghost,t)))
-
-  let pr_let_clauses recflag pr = function
+  let pr_funvar n = spc () ++ Name.print n
+
+  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)
-    | [] -> anomaly (Pp.str "LetIn must declare at least one binding")
+        (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 =
     hv 0 (str "[ " ++
@@ -783,18 +645,18 @@ module Make
       "raw", "glob" and "typed" levels *)
 
   type 'a printer = {
-    pr_tactic    : tolerability -> 'tacexpr -> std_ppcmds;
-    pr_constr    : 'trm -> std_ppcmds;
-    pr_lconstr   : 'trm -> std_ppcmds;
-    pr_dconstr   : 'dtrm -> std_ppcmds;
-    pr_pattern   : 'pat -> std_ppcmds;
-    pr_lpattern  : 'pat -> std_ppcmds;
-    pr_constant  : 'cst -> std_ppcmds;
-    pr_reference : 'ref -> std_ppcmds;
-    pr_name      : 'nam -> std_ppcmds;
-    pr_generic   : 'lev generic_argument -> std_ppcmds;
-    pr_extend    : int -> ml_tactic_entry -> 'a gen_tactic_arg list -> std_ppcmds;
-    pr_alias     : int -> KerName.t -> 'a gen_tactic_arg list -> std_ppcmds;
+    pr_tactic    : tolerability -> 'tacexpr -> Pp.t;
+    pr_constr    : 'trm -> Pp.t;
+    pr_lconstr   : 'trm -> Pp.t;
+    pr_dconstr   : 'dtrm -> Pp.t;
+    pr_pattern   : 'pat -> Pp.t;
+    pr_lpattern  : 'pat -> Pp.t;
+    pr_constant  : 'cst -> Pp.t;
+    pr_reference : 'ref -> Pp.t;
+    pr_name      : 'nam -> Pp.t;
+    pr_generic   : 'lev generic_argument -> Pp.t;
+    pr_extend    : int -> ml_tactic_entry -> 'a gen_tactic_arg list -> Pp.t;
+    pr_alias     : int -> KerName.t -> 'a gen_tactic_arg list -> Pp.t;
   }
 
   constraint 'a = <
@@ -825,7 +687,7 @@ module Make
         (*  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) =
@@ -833,10 +695,10 @@ module Make
         (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
@@ -846,14 +708,14 @@ module Make
         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"}"
@@ -881,8 +743,10 @@ module Make
         | 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
+                    | [{CAst.v=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 ") ++
@@ -906,15 +770,15 @@ module Make
             primitive "cofix" ++ spc () ++ pr_id id ++ spc()
             ++ keyword "with" ++ spc () ++ prlist_with_sep spc pr_cofix_tac l
           )
-        | TacAssert (b,Some tac,ipat,c) ->
+        | TacAssert (ev,b,Some tac,ipat,c) ->
           hov 1 (
-            primitive (if b then "assert" else "enough") ++
+            primitive (if b then if ev then "eassert" else "assert" else if ev then "eenough" else "enough") ++
               pr_assumption pr.pr_constr pr.pr_dconstr pr.pr_lconstr ipat c ++
               pr_non_empty_arg (pr_by_tactic (pr.pr_tactic (ltactical,E))) tac
           )
-        | TacAssert (_,None,ipat,c) ->
+        | TacAssert (ev,_,None,ipat,c) ->
           hov 1 (
-            primitive "pose proof"
+            primitive (if ev then "epose proof" else "pose proof")
             ++ pr_assertion pr.pr_constr pr.pr_dconstr pr.pr_lconstr ipat c
           )
         | TacGeneralize l ->
@@ -924,11 +788,11 @@ module Make
               pr_with_occurrences pr.pr_constr cl ++ pr_as_name na)
               l
           )
-        | TacLetTac (na,c,cl,true,_) when Locusops.is_nowhere cl ->
-          hov 1 (primitive "pose" ++ pr_pose pr.pr_constr pr.pr_lconstr na c)
-        | TacLetTac (na,c,cl,b,e) ->
+        | TacLetTac (ev,na,c,cl,true,_) when Locusops.is_nowhere cl ->
+          hov 1 (primitive (if ev then "epose" else "pose") ++ pr_pose pr.pr_constr pr.pr_lconstr na c)
+        | TacLetTac (ev,na,c,cl,b,e) ->
           hov 1 (
-            (if b then primitive "set" else primitive "remember") ++
+            primitive (if b then if ev then "eset" else "set" else if ev then "eremember" else "remember") ++
               (if b then pr_pose pr.pr_constr pr.pr_lconstr na c
                 else pr_pose_as_style pr.pr_constr na c) ++
               pr_opt (fun p -> pr_eqn_ipat p ++ spc ()) e ++
@@ -1033,7 +897,7 @@ module Make
               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
@@ -1172,13 +1036,13 @@ module Make
               keyword "solve" ++ spc () ++ pr_seq_body (pr_tac ltop) tl, llet
             | TacComplete t ->
               pr_tac (lcomplete,E) t, lcomplete
-            | TacSelect (s, tac) -> pr_goal_selector s ++ spc () ++ pr_tac ltop tac, latom
+            | 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
+              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) ->
@@ -1187,19 +1051,19 @@ module Make
               primitive "fresh" ++ pr_fresh_ids l, latom
             | TacArg(_,TacGeneric arg) ->
               pr.pr_generic arg, latom
-            | TacArg(_,TacCall(loc,f,[])) ->
+            | TacArg(_,TacCall(loc,(f,[]))) ->
               pr.pr_reference f, latom
-            | TacArg(_,TacCall(loc,f,l)) ->
-              pr_with_comments loc (hov 1 (
+            | TacArg(_,TacCall(loc,(f,l))) ->
+              pr_with_comments ?loc (hov 1 (
                 pr.pr_reference f ++ spc ()
                 ++ prlist_with_sep spc pr_tacarg l)),
               lcall
             | TacArg (_,a) ->
               pr_tacarg a, latom
-            | TacML (loc,s,l) ->
-              pr_with_comments loc (pr.pr_extend 1 s l), lcall
-            | TacAlias (loc,kn,l) ->
-              pr_with_comments loc (pr.pr_alias (level_of inherited) kn l), latom
+            | TacML (loc,(s,l)) ->
+              pr_with_comments ?loc (pr.pr_extend 1 s l), lcall
+            | TacAlias (loc,(kn,l)) ->
+              pr_with_comments ?loc (pr.pr_alias (level_of inherited) kn l), latom
           )
           in
           if prec_less prec inherited then strm
@@ -1217,17 +1081,17 @@ module Make
           | TacNumgoals ->
             keyword "numgoals"
           | (TacCall _|Tacexp _ | TacGeneric _) as a ->
-            hov 0 (keyword "ltac:" ++ surround (pr_tac ltop (TacArg (Loc.ghost,a))))
+            hov 0 (keyword "ltac:" ++ surround (pr_tac ltop (TacArg (Loc.tag a))))
 
         in pr_tac
 
   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 with
-            Glob_term.GProd(loc,na,Explicit,a,b) ->
-              strip_ty (([Loc.ghost,na],(a,None))::acc) (n-1) b
-          | _ -> error "Cannot translate fix tactic: not enough products" in
+        match DAst.get ty with
+            Glob_term.GProd(na,Explicit,a,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
 
   let raw_printers =
@@ -1244,7 +1108,7 @@ module Make
       pr_constant = pr_or_by_notation pr_reference;
       pr_reference = pr_reference;
       pr_name = pr_lident;
-      pr_generic = pr_raw_generic_rec pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr pr_reference;
+      pr_generic = (fun arg -> Pputils.pr_raw_generic (Global.env ()) arg);
       pr_extend = pr_raw_extend_rec pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr;
       pr_alias = pr_raw_alias pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr;
     } in
@@ -1274,9 +1138,7 @@ module Make
         pr_constant = pr_or_var (pr_and_short_name (pr_evaluable_reference_env env));
         pr_reference = pr_ltac_or_var (pr_located pr_ltac_constant);
         pr_name = pr_lident;
-        pr_generic = pr_glb_generic_rec
-          (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
-          prtac (pr_pat_and_constr_expr (pr_glob_constr_env env));
+        pr_generic = (fun arg -> Pputils.pr_glb_generic (Global.env ()) arg);
         pr_extend = pr_glob_extend_rec
           (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
           prtac (pr_pat_and_constr_expr (pr_glob_constr_env env));
@@ -1294,23 +1156,24 @@ module Make
   let pr_glob_tactic env = pr_glob_tactic_level env ltop
 
   let strip_prod_binders_constr n ty =
+    let ty = EConstr.Unsafe.to_constr ty in
     let rec strip_ty acc n ty =
-      if n=0 then (List.rev acc, ty) else
-        match Term.kind_of_term ty with
-            Term.Prod(na,a,b) ->
-              strip_ty (([Loc.ghost,na],a)::acc) (n-1) b
-          | _ -> error "Cannot translate fix tactic: not enough products" in
+      if n=0 then (List.rev acc, EConstr.of_constr ty) else
+        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 n t =
+  let pr_atomic_tactic_level env sigma n t =
     let prtac n (t:atomic_tactic_expr) =
       let pr = {
         pr_tactic = (fun _ _ -> str "<tactic>");
-        pr_constr = pr_constr_env env Evd.empty;
+        pr_constr = (fun c -> pr_econstr_env env sigma c);
         pr_dconstr = pr_and_constr_expr (pr_glob_constr_env env);
-        pr_lconstr = pr_lconstr_env env Evd.empty;
-        pr_pattern = pr_constr_pattern_env env Evd.empty;
-        pr_lpattern = pr_lconstr_pattern_env env Evd.empty;
+        pr_lconstr = (fun c -> pr_leconstr_env env sigma c);
+        pr_pattern = pr_constr_pattern_env env sigma;
+        pr_lpattern = pr_lconstr_pattern_env env sigma;
         pr_constant = pr_evaluable_reference_env env;
         pr_reference = pr_located pr_ltac_constant;
         pr_name = pr_id;
@@ -1324,12 +1187,9 @@ module Make
     in
     prtac n t
 
-  let pr_raw_generic env = pr_raw_generic_rec
-    pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr pr_reference
+  let pr_raw_generic = Pputils.pr_raw_generic
 
-  let pr_glb_generic env = pr_glb_generic_rec
-    (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
-    (pr_glob_tactic_level env) (pr_pat_and_constr_expr (pr_glob_constr_env env))
+  let pr_glb_generic = Pputils.pr_glb_generic
 
   let pr_raw_extend env = pr_raw_extend_rec
     pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr
@@ -1344,136 +1204,193 @@ module Make
   let pr_extend pr lev ml args =
     pr_extend_gen pr lev ml args
 
-  let pr_atomic_tactic env = pr_atomic_tactic_level env ltop
+  let pr_atomic_tactic env sigma c = pr_atomic_tactic_level env sigma ltop c
+
+let declare_extra_genarg_pprule wit
+  (f : 'a raw_extra_genarg_printer)
+  (g : 'b glob_extra_genarg_printer)
+  (h : 'c extra_genarg_printer) =
+  begin match wit with
+    | ExtraArg s -> ()
+    | _          -> user_err Pp.(str "Can declare a pretty-printing rule only for extra argument types.")
+  end;
+  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)
+  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
+    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
 
-end
+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
 
-module Tag =
-struct
-  let keyword =
-    let style = Terminal.make ~bold:true () in
-    Ppstyle.make ~style ["tactic"; "keyword"]
+(** Registering *)
 
-  let primitive =
-    let style = Terminal.make ~fg_color:`LIGHT_GREEN () in
-    Ppstyle.make ~style ["tactic"; "primitive"]
+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 string =
-    let style = Terminal.make ~fg_color:`LIGHT_RED () in
-    Ppstyle.make ~style ["tactic"; "string"]
+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)
 
-end
+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)
 
-include Make (Ppconstr) (struct
-    let tag t s = Pp.tag (Pp.Tag.inj t Ppstyle.tag) s
-    let do_not_tag _ x = x
-    let tag_keyword                 = tag Tag.keyword
-    let tag_primitive               = tag Tag.primitive
-    let tag_string                  = tag Tag.string
-    let tag_glob_tactic_expr        = do_not_tag
-    let tag_glob_atomic_tactic_expr = do_not_tag
-    let tag_raw_tactic_expr         = do_not_tag
-    let tag_raw_atomic_tactic_expr  = do_not_tag
-    let tag_atomic_tactic_expr      = do_not_tag
-end)
+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)
 
-(** Registering *)
+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 lift f a = Genprint.PrinterBasic (fun () -> f a)
+let lift_top f a = Genprint.TopPrinterBasic (fun () -> f a)
 
-let run_delayed c =
-  Sigma.run Evd.empty { Sigma.run = fun sigma -> c.delayed (Global.env ()) sigma }
+let register_basic_print0 wit f g h =
+  Genprint.register_print0 wit (lift f) (lift g) (lift_top h)
 
-let run_delayed_destruction_arg = function (* HH: Using Evd.empty looks suspicious *)
-  | clear_flag,ElimOnConstr g -> clear_flag,ElimOnConstr (fst (run_delayed g))
-  | clear_flag,ElimOnAnonHyp n as x -> x
-  | clear_flag,ElimOnIdent id as x -> x
+
+let 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 Constrarg.wit_int_or_var
-    (pr_or_var int) (pr_or_var int) int;
-  Genprint.register_print0 Constrarg.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 Constrarg.wit_ident
-    pr_id pr_id pr_id;
-  Genprint.register_print0 Constrarg.wit_var
-    (pr_located pr_id) (pr_located pr_id) pr_id;
+  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
+    (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
-    Constrarg.wit_intro_pattern
-    (Miscprint.pr_intro_pattern pr_constr_expr)
-    (Miscprint.pr_intro_pattern (fun (c,_) -> pr_glob_constr c))
-    (Miscprint.pr_intro_pattern (fun c -> pr_constr (fst (run_delayed c))));
+    wit_clause_dft_concl
+    (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
-    Constrarg.wit_clause_dft_concl
-    (pr_clauses (Some true) pr_lident)
-    (pr_clauses (Some true) pr_lident)
-    (pr_clauses (Some true) (fun id -> pr_lident (Loc.ghost,id)))
+    wit_constr
+    (lift Ppconstr.pr_lconstr_expr)
+    (lift (fun (c, _) -> pr_lglob_constr_pptac c))
+    (make_constr_printer Printer.pr_econstr_n_env)
   ;
   Genprint.register_print0
-    Constrarg.wit_constr
-    Ppconstr.pr_constr_expr
-    (fun (c, _) -> Printer.pr_glob_constr c)
-    Printer.pr_constr
+    wit_uconstr
+    (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
-    Constrarg.wit_uconstr
-    Ppconstr.pr_constr_expr
-    (fun (c,_) -> Printer.pr_glob_constr c)
-    Printer.pr_closed_glob
+    wit_open_constr
+    (lift Ppconstr.pr_constr_expr)
+    (lift (fun (c, _) -> pr_glob_constr_pptac c))
+    (make_constr_printer Printer.pr_econstr_n_env)
   ;
   Genprint.register_print0
-    Constrarg.wit_open_constr
-    Ppconstr.pr_constr_expr
-    (fun (c, _) -> Printer.pr_glob_constr c)
-    Printer.pr_constr
+    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
   ;
-  Genprint.register_print0 Constrarg.wit_red_expr
-    (pr_red_expr (pr_constr_expr, pr_lconstr_expr, pr_or_by_notation pr_reference, pr_constr_pattern_expr))
-    (pr_red_expr (pr_and_constr_expr pr_glob_constr, pr_lglob_constr, pr_or_var (pr_and_short_name pr_evaluable_reference), pr_pat_and_constr_expr pr_glob_constr))
-    (pr_red_expr (pr_constr, pr_lconstr, pr_evaluable_reference, pr_constr_pattern));
-  Genprint.register_print0 Constrarg.wit_quant_hyp pr_quantified_hypothesis pr_quantified_hypothesis pr_quantified_hypothesis;
-  Genprint.register_print0 Constrarg.wit_bindings
-    (pr_bindings_no_with pr_constr_expr pr_lconstr_expr)
-    (pr_bindings_no_with (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
-    (fun it -> pr_bindings_no_with pr_constr pr_lconstr (fst (run_delayed it)));
-  Genprint.register_print0 Constrarg.wit_constr_with_bindings
-    (pr_with_bindings pr_constr_expr pr_lconstr_expr)
-    (pr_with_bindings (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
-    (fun it -> pr_with_bindings pr_constr pr_lconstr (fst (run_delayed it)));
-  Genprint.register_print0 Constrarg.wit_destruction_arg
-    (pr_destruction_arg pr_constr_expr pr_lconstr_expr)
-    (pr_destruction_arg (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
-    (fun it -> pr_destruction_arg pr_constr pr_lconstr (run_delayed_destruction_arg it));
-  Genprint.register_print0 Stdarg.wit_int int int int;
-  Genprint.register_print0 Stdarg.wit_bool pr_bool pr_bool pr_bool;
-  Genprint.register_print0 Stdarg.wit_unit pr_unit pr_unit pr_unit;
-  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 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
+  ;
+  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
-
-module Richpp = struct
-
-  include Make (Ppconstr.Richpp) (struct
-    open Ppannotation
-    let do_not_tag _ x = x
-    let tag e s = Pp.tag (Pp.Tag.inj e tag) s
-    let tag_keyword                   = tag AKeyword
-    let tag_primitive                 = tag AKeyword
-    let tag_string                    = do_not_tag ()
-    let tag_glob_tactic_expr        e = tag (AGlobTacticExpr e)
-    let tag_glob_atomic_tactic_expr a = tag (AGlobAtomicTacticExpr a)
-    let tag_raw_tactic_expr         e = tag (ARawTacticExpr e)
-    let tag_raw_atomic_tactic_expr  a = tag (ARawAtomicTacticExpr a)
-    let tag_atomic_tactic_expr      a = tag (AAtomicTacticExpr a)
-  end)
-
-end
+  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
new file mode 100644
index 00000000..5951f2b1
--- /dev/null
+++ b/plugins/ltac/pptactic.mli
@@ -0,0 +1,157 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** This module implements pretty-printers for tactic_expr syntactic
+    objects and their subcomponents. *)
+
+open Genarg
+open Geninterp
+open Names
+open Misctypes
+open Environ
+open Constrexpr
+open Notation_term
+open Tacexpr
+
+type 'a grammar_tactic_prod_item_expr =
+| TacTerm of string
+| TacNonTerm of ('a * Names.Id.t option) Loc.located
+
+type 'a raw_extra_genarg_printer =
+    (constr_expr -> Pp.t) ->
+    (constr_expr -> Pp.t) ->
+    (tolerability -> raw_tactic_expr -> Pp.t) ->
+    'a -> Pp.t
+
+type 'a glob_extra_genarg_printer =
+    (glob_constr_and_expr -> Pp.t) ->
+    (glob_constr_and_expr -> Pp.t) ->
+    (tolerability -> glob_tactic_expr -> Pp.t) ->
+    'a -> Pp.t
+
+type 'a extra_genarg_printer =
+    (EConstr.t -> Pp.t) ->
+    (EConstr.t -> Pp.t) ->
+    (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 = {
+  pptac_level : int;
+  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 :
+  ('a -> Pp.t) -> 'a Locus.with_occurrences -> Pp.t
+val pr_red_expr :
+  ('a -> Pp.t) * ('a -> Pp.t) * ('b -> Pp.t) * ('c -> Pp.t) ->
+  ('a,'b,'c) Genredexpr.red_expr_gen -> Pp.t
+val pr_may_eval :
+  ('a -> Pp.t) -> ('a -> Pp.t) -> ('b -> Pp.t) ->
+  ('c -> Pp.t) -> ('a,'b,'c) Genredexpr.may_eval -> Pp.t
+
+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 : (* 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
+
+val pr_glb_generic : env -> glevel generic_argument -> Pp.t
+
+val pr_raw_extend: env -> int ->
+  ml_tactic_entry -> raw_tactic_arg list -> Pp.t
+
+val pr_glob_extend: env -> int ->
+  ml_tactic_entry -> glob_tactic_arg list -> Pp.t
+
+val pr_extend :
+  (Val.t -> Pp.t) -> int -> ml_tactic_entry -> Val.t list -> Pp.t
+
+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 : ltac_constant -> Pp.t
+
+val pr_raw_tactic : raw_tactic_expr -> Pp.t
+
+val pr_raw_tactic_level : tolerability -> raw_tactic_expr -> Pp.t
+
+val pr_glob_tactic : env -> glob_tactic_expr -> Pp.t
+
+val pr_atomic_tactic : env -> Evd.evar_map -> atomic_tactic_expr -> Pp.t
+
+val pr_hintbases : string list option -> Pp.t
+
+val pr_auto_using : ('constr -> Pp.t) -> 'constr list -> Pp.t
+
+val pr_match_pattern : ('a -> Pp.t) -> 'a match_pattern -> Pp.t
+
+val pr_match_rule : bool -> ('a -> Pp.t) -> ('b -> Pp.t) ->
+  ('b, 'a) match_rule -> Pp.t
+
+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/ltac/profile_ltac.ml b/plugins/ltac/profile_ltac.ml
index 2514eded..d22bd496 100644
--- a/ltac/profile_ltac.ml
+++ b/plugins/ltac/profile_ltac.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Unicode
@@ -113,7 +115,7 @@ let rec to_ltacprof_tactic m xml =
          children = List.fold_left to_ltacprof_tactic M.empty xs;
        } in
       M.add name node m
-  | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof_tactic XML")
+  | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof_tactic XML.")
 
 let to_ltacprof_results xml =
   let open Xml_datatype in
@@ -125,18 +127,17 @@ let to_ltacprof_results xml =
        max_total = 0.0;
        local = 0.0;
        children = List.fold_left to_ltacprof_tactic M.empty xs }
-  | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof XML")
+  | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof XML.")
 
 let feedback_results results =
   Feedback.(feedback
-    (Custom (Loc.dummy_loc, "ltacprof_results", of_ltacprof_results results)))
+    (Custom (None, "ltacprof_results", of_ltacprof_results results)))
 
 (* ************** pretty printing ************************************* *)
 
 let format_sec x = (Printf.sprintf "%.3fs" x)
 let format_ratio x = (Printf.sprintf "%.1f%%" (100. *. x))
 let padl n s = ws (max 0 (n - utf8_length s)) ++ str s
-let padr n s = str s ++ ws (max 0 (n - utf8_length s))
 let padr_with c n s =
   let ulength = utf8_length s in
   str (utf8_sub s 0 n) ++ str (String.make (max 0 (n - ulength)) c)
@@ -247,17 +248,17 @@ let string_of_call ck =
     (match ck with
        | Tacexpr.LtacNotationCall s -> Pptactic.pr_alias_key s
        | Tacexpr.LtacNameCall cst -> Pptactic.pr_ltac_constant cst
-       | Tacexpr.LtacVarCall (id, t) -> Nameops.pr_id id
+       | Tacexpr.LtacVarCall (id, t) -> Names.Id.print id
        | Tacexpr.LtacAtomCall te ->
          (Pptactic.pr_glob_tactic (Global.env ())
-            (Tacexpr.TacAtom (Loc.ghost, te)))
+            (Tacexpr.TacAtom (Loc.tag te)))
        | Tacexpr.LtacConstrInterp (c, _) ->
          pr_glob_constr_env (Global.env ()) c
        | Tacexpr.LtacMLCall te ->
          (Pptactic.pr_glob_tactic (Global.env ())
             te)
     ) in
-  for i = 0 to String.length s - 1 do if s.[i] = '\n' then s.[i] <- ' ' done;
+  let s = String.map (fun c -> if c = '\n' then ' ' else c) s in
   let s = try String.sub s 0 (CString.string_index_from s 0 "(*") with Not_found -> s in
   CString.strip s
 
@@ -290,7 +291,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
   | [] | [_] ->
@@ -305,7 +306,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 *)
@@ -342,7 +343,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
@@ -360,7 +361,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
 
@@ -368,33 +369,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 = State 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 =
@@ -412,8 +449,7 @@ let _ = Declaremods.append_end_library_hook do_print_results_at_close
 let _ =
   let open Goptions in
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Ltac Profiling";
       optkey   = ["Ltac"; "Profiling"];
       optread  = get_profiling;
diff --git a/plugins/ltac/profile_ltac.mli b/plugins/ltac/profile_ltac.mli
new file mode 100644
index 00000000..6a67aab5
--- /dev/null
+++ b/plugins/ltac/profile_ltac.mli
@@ -0,0 +1,84 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+
+(** 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 ->
+    ?count_call:bool -> 'b Proofview.tactic -> 'b Proofview.tactic
+
+val set_profiling : bool -> unit
+
+(* Cut off results < than specified cutoff *)
+val print_results : cutoff:float -> unit
+
+val print_results_tactic : string -> unit
+
+val reset_profile : unit -> unit
+
+val 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
+ * instances of a given tactic from its parent. E.g. if tactic 'aaa' calls
+ * 'foo' twice, then 'aaa' will contain just one entry for 'foo' with the
+ * statistics of the two invocations combined, and also combined over all
+ * invocations of 'aaa'.
+ * total:     time spent running this tactic and its subtactics (seconds)
+ * local:      time spent running this tactic, minus its subtactics (seconds)
+ * ncalls: the number of invocations of this tactic that have been made
+ * max_total: the greatest running time of a single invocation (seconds)
+ *)
+type treenode = {
+  name : CString.Map.key;
+  total : float;
+  local : float;
+  ncalls : int;
+  max_total : float;
+  children : treenode CString.Map.t
+}
+
+(* Returns the profiling results known by the current process *)
+val get_local_profiling_results : unit -> treenode
+val feedback_results : treenode -> unit
diff --git a/plugins/ltac/profile_ltac_tactics.ml4 b/plugins/ltac/profile_ltac_tactics.ml4
new file mode 100644
index 00000000..983e1578
--- /dev/null
+++ b/plugins/ltac/profile_ltac_tactics.ml4
@@ -0,0 +1,74 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Ltac profiling entrypoints *)
+
+open Profile_ltac
+open Stdarg
+
+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_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 () ]
+END
+
+VERNAC COMMAND EXTEND ShowLtacProfile CLASSIFIED AS QUERY
+| [ "Show" "Ltac" "Profile" ] -> [ print_results ~cutoff:!Flags.profile_ltac_cutoff ]
+| [ "Show" "Ltac" "Profile" "CutOff" int(n) ] -> [ print_results ~cutoff:(float_of_int n) ]
+END
+
+VERNAC COMMAND EXTEND ShowLtacProfileTactic CLASSIFIED AS QUERY
+  [ "Show" "Ltac" "Profile" string(s) ] -> [ print_results_tactic s ]
+END
diff --git a/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index 44efdd38..d32a2fae 100644
--- a/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -1,22 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Names
 open Pp
 open CErrors
 open Util
+open Names
 open Nameops
 open Namegen
-open Term
+open Constr
+open EConstr
 open Vars
 open Reduction
 open Tacticals.New
-open Tacmach
 open Tactics
 open Pretype_errors
 open Typeclasses
@@ -31,11 +33,14 @@ open Decl_kinds
 open Elimschemes
 open Environ
 open Termops
+open EConstr
 open Libnames
-open Sigma.Notations
 open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+(* module RelDecl = Context.Rel.Declaration *)
+
 (** Typeclass-based generalized rewriting. *)
 
 (** Constants used by the tactic. *)
@@ -51,33 +56,25 @@ let init_setoid () =
   if is_dirpath_prefix_of classes_dirpath (Lib.cwd ()) then ()
   else Coqlib.check_required_library ["Coq";"Setoids";"Setoid"]
 
-let make_dir l = DirPath.make (List.rev_map Id.of_string l)
-
-let try_find_global_reference dir s =
-  let sp = Libnames.make_path (make_dir ("Coq"::dir)) (Id.of_string s) in
-    try Nametab.global_of_path sp
-    with Not_found -> 
-      anomaly (str "Global reference " ++ str s ++ str " not found in generalized rewriting")
+let lazy_find_reference dir s =
+  let gr = lazy (Coqlib.coq_reference "generalized rewriting" dir s) in
+  fun () -> Lazy.force gr
 
-let find_reference dir s =
-  let gr = lazy (try_find_global_reference dir s) in
-    fun () -> Lazy.force gr
+let find_reference dir s = Coqlib.coq_reference "generalized rewriting" dir s
 
 type evars = evar_map * Evar.Set.t (* goal evars, constraint evars *)
 
 let find_global dir s =
-  let gr = lazy (try_find_global_reference dir s) in
+  let gr = lazy (find_reference dir s) in
     fun (evd,cstrs) ->
-      let sigma = Sigma.Unsafe.of_evar_map evd in
-      let Sigma (c, sigma, _) = Evarutil.new_global sigma (Lazy.force gr) in
-      let evd = Sigma.to_evar_map sigma in
+      let (evd, c) = Evarutil.new_global evd (Lazy.force gr) in
 	(evd, cstrs), c
 
 (** Utility for dealing with polymorphic applications *)
 
 (** Global constants. *)
 
-let coq_eq_ref = find_reference ["Init"; "Logic"] "eq"
+let coq_eq_ref = lazy_find_reference ["Init"; "Logic"] "eq"
 let coq_eq = find_global ["Init"; "Logic"] "eq"
 let coq_f_equal = find_global ["Init"; "Logic"] "f_equal"
 let coq_all = find_global ["Init"; "Logic"] "all"
@@ -91,10 +88,8 @@ let cstrevars evars = snd evars
 
 let new_cstr_evar (evd,cstrs) env t =
   let s = Typeclasses.set_resolvable Evd.Store.empty false in
-  let evd = Sigma.Unsafe.of_evar_map evd in
-  let Sigma (t, evd', _) = Evarutil.new_evar ~store:s env evd t in
-  let evd' = Sigma.to_evar_map evd' in
-  let ev, _ = destEvar t in
+  let (evd', t) = Evarutil.new_evar ~store:s env evd t in
+  let ev, _ = destEvar evd' t in
     (evd', Evar.Set.add ev cstrs), t
 
 (** Building or looking up instances. *)
@@ -154,11 +149,11 @@ end) = struct
   let forall_relation = find_global morphisms "forall_relation"
   let pointwise_relation = find_global morphisms "pointwise_relation"
 
-  let forall_relation_ref = find_reference morphisms "forall_relation"
-  let pointwise_relation_ref = find_reference morphisms "pointwise_relation"
+  let forall_relation_ref = lazy_find_reference morphisms "forall_relation"
+  let pointwise_relation_ref = lazy_find_reference morphisms "pointwise_relation"
 
   let respectful = find_global morphisms "respectful"
-  let respectful_ref = find_reference morphisms "respectful"
+  let respectful_ref = lazy_find_reference morphisms "respectful"
 
   let default_relation = find_global ["Classes"; "SetoidTactics"] "DefaultRelation"
 
@@ -170,25 +165,21 @@ end) = struct
 
   let rewrite_relation_class = find_global relation_classes "RewriteRelation"
 
-  let proper_class = lazy (class_info (try_find_global_reference morphisms "Proper"))
-  let proper_proxy_class = lazy (class_info (try_find_global_reference morphisms "ProperProxy"))
+  let proper_class = lazy (class_info (find_reference morphisms "Proper"))
+  let proper_proxy_class = lazy (class_info (find_reference morphisms "ProperProxy"))
     
   let proper_proj = lazy (mkConst (Option.get (pi3 (List.hd (Lazy.force proper_class).cl_projs))))
     
   let proper_type = 
     let l = lazy (Lazy.force proper_class).cl_impl in
       fun (evd,cstrs) -> 
-        let sigma = Sigma.Unsafe.of_evar_map evd in
-        let Sigma (c, sigma, _) = Evarutil.new_global sigma (Lazy.force l) in
-        let evd = Sigma.to_evar_map sigma in
+        let (evd, c) = Evarutil.new_global evd (Lazy.force l) in
 	  (evd, cstrs), c
 	
   let proper_proxy_type = 
     let l = lazy (Lazy.force proper_proxy_class).cl_impl in
       fun (evd,cstrs) -> 
-        let sigma = Sigma.Unsafe.of_evar_map evd in
-        let Sigma (c, sigma, _) = Evarutil.new_global sigma (Lazy.force l) in
-        let evd = Sigma.to_evar_map sigma in
+        let (evd, c) = Evarutil.new_global evd (Lazy.force l) in
 	  (evd, cstrs), c
 
   let proper_proof env evars carrier relation x =
@@ -211,7 +202,7 @@ end) = struct
       match obj with
       | None | Some (_, None) ->
 	let evars, relty = mk_relation env evars ty in
-	  if closed0 ty then 
+	  if closed0 (goalevars evars) ty then 
 	    let env' = Environ.reset_with_named_context (Environ.named_context_val env) env in
 	      new_cstr_evar evars env' relty
 	  else new_cstr_evar evars newenv relty
@@ -219,30 +210,30 @@ end) = struct
     in
     let rec aux env evars ty l =
       let t = Reductionops.whd_all env (goalevars evars) ty in
-	match kind_of_term t, l with
+	match EConstr.kind (goalevars evars) t, l with
 	| Prod (na, ty, b), obj :: cstrs ->
-          let b = Reductionops.nf_betaiota (goalevars evars) b in
-	  if noccurn 1 b (* non-dependent product *) then
-	    let ty = Reductionops.nf_betaiota (goalevars evars) ty 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 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
 	      evars, mkProd(na, ty, b), newarg, (ty, Some relty) :: cstrs
 	  else
 	    let (evars, b, arg, cstrs) =
-	      aux (Environ.push_rel (LocalAssum (na, ty)) env) evars b 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
 	      if Option.is_empty obj then evars, mkProd(na, ty, b), arg', (ty, None) :: cstrs
-	      else error "build_signature: no constraint can apply on a dependent argument"
-	| _, obj :: _ -> anomaly ~label:"build_signature" (Pp.str "not enough products")
+	      else user_err Pp.(str "build_signature: no constraint can apply on a dependent argument")
+	| _, obj :: _ -> anomaly ~label:"build_signature" (Pp.str "not enough products.")
 	| _, [] ->
 	  (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])
@@ -250,30 +241,30 @@ end) = struct
 
   (** Folding/unfolding of the tactic constants. *)
 
-  let unfold_impl t =
-    match kind_of_term t with
+  let unfold_impl sigma t =
+    match EConstr.kind sigma t with
     | App (arrow, [| a; b |])(*  when eq_constr arrow (Lazy.force impl) *) ->
       mkProd (Anonymous, a, lift 1 b)
     | _ -> assert false
 
-  let unfold_all t =
-    match kind_of_term t with
+  let unfold_all sigma t =
+    match EConstr.kind sigma t with
     | App (id, [| a; b |]) (* when eq_constr id (Lazy.force coq_all) *) ->
-      (match kind_of_term b with
+      (match EConstr.kind sigma b with
       | Lambda (n, ty, b) -> mkProd (n, ty, b)
       | _ -> assert false)
     | _ -> assert false
 
-  let unfold_forall t =
-    match kind_of_term t with
+  let unfold_forall sigma t =
+    match EConstr.kind sigma t with
     | App (id, [| a; b |]) (* when eq_constr id (Lazy.force coq_all) *) ->
-      (match kind_of_term b with
+      (match EConstr.kind sigma b with
       | Lambda (n, ty, b) -> mkProd (n, ty, b)
       | _ -> assert false)
     | _ -> assert false
 
   let arrow_morphism env evd ta tb a b =
-    let ap = is_Prop ta and bp = is_Prop tb in
+    let ap = is_Prop (goalevars evd) ta and bp = is_Prop (goalevars evd) tb in
       if ap && bp then app_poly env evd impl [| a; b |], unfold_impl
       else if ap then (* Domain in Prop, CoDomain in Type *)
 	(app_poly env evd arrow [| a; b |]), unfold_impl
@@ -283,28 +274,28 @@ end) = struct
       else (* None in Prop, use arrow *)
 	(app_poly env evd arrow [| a; b |]), unfold_impl
 
-  let rec decomp_pointwise n c =
+  let rec decomp_pointwise sigma n c =
     if Int.equal n 0 then c
     else
-      match kind_of_term c with
-      | App (f, [| a; b; relb |]) when Globnames.is_global (pointwise_relation_ref ()) f ->
-	decomp_pointwise (pred n) relb
-      | App (f, [| a; b; arelb |]) when Globnames.is_global (forall_relation_ref ()) f ->
-	decomp_pointwise (pred n) (Reductionops.beta_applist (arelb, [mkRel 1]))
+      match EConstr.kind sigma c with
+      | App (f, [| a; b; relb |]) when Termops.is_global sigma (pointwise_relation_ref ()) f ->
+	decomp_pointwise sigma (pred n) relb
+      | App (f, [| a; b; arelb |]) when Termops.is_global sigma (forall_relation_ref ()) f ->
+	decomp_pointwise sigma (pred n) (Reductionops.beta_applist sigma (arelb, [mkRel 1]))
       | _ -> invalid_arg "decomp_pointwise"
 
-  let rec apply_pointwise rel = function
+  let rec apply_pointwise sigma rel = function
     | arg :: args ->
-      (match kind_of_term rel with
-      | App (f, [| a; b; relb |]) when Globnames.is_global (pointwise_relation_ref ()) f ->
-	apply_pointwise relb args
-      | App (f, [| a; b; arelb |]) when Globnames.is_global (forall_relation_ref ()) f ->
-	apply_pointwise (Reductionops.beta_applist (arelb, [arg])) args
+      (match EConstr.kind sigma rel with
+      | App (f, [| a; b; relb |]) when Termops.is_global sigma (pointwise_relation_ref ()) f ->
+	apply_pointwise sigma relb args
+      | App (f, [| a; b; arelb |]) when Termops.is_global sigma (forall_relation_ref ()) f ->
+	apply_pointwise sigma (Reductionops.beta_applist sigma (arelb, [arg])) args
       | _ -> invalid_arg "apply_pointwise")
     | [] -> rel
 
   let pointwise_or_dep_relation env evd n t car rel =
-    if noccurn 1 car && noccurn 1 rel then
+    if noccurn (goalevars evd) 1 car && noccurn (goalevars evd) 1 rel then
       app_poly env evd pointwise_relation [| t; lift (-1) car; lift (-1) rel |]
     else
       app_poly env evd forall_relation
@@ -321,14 +312,15 @@ end) = struct
     let rec aux evars env prod n = 
       if Int.equal n 0 then start evars env prod
       else
-	match kind_of_term (Reduction.whd_all env prod) with
+        let sigma = goalevars evars in
+	match EConstr.kind sigma (Reductionops.whd_all env sigma prod) with
 	| Prod (na, ty, b) ->
-	  if noccurn 1 b then
+	  if noccurn sigma 1 b then
 	    let b' = lift (-1) b in
 	    let evars, rb = aux evars env b' (pred n) in
 	      app_poly env evars pointwise_relation [| ty; b'; rb |]
 	  else
-	    let evars, rb = aux evars (Environ.push_rel (LocalAssum (na, ty)) env) b (pred n) in
+	    let evars, rb = aux evars (push_rel (LocalAssum (na, ty)) env) b (pred n) in
 	      app_poly env evars forall_relation
 		[| ty; mkLambda (na, ty, b); mkLambda (na, ty, rb) |]
 	| _ -> raise Not_found
@@ -339,27 +331,26 @@ end) = struct
 	try let evars, found = aux evars env ty (succ (List.length args)) in
 	      Some (evars, found, c, ty, arg :: args)
 	with Not_found ->
-	  let ty = whd_all env ty in
-	  find env (mkApp (c, [| arg |])) (prod_applist ty [arg]) args
+          let sigma = goalevars evars in
+	  let ty = Reductionops.whd_all env sigma ty in
+	  find env (mkApp (c, [| arg |])) (prod_applist sigma ty [arg]) args
     in find env c ty args
 
   let unlift_cstr env sigma = function
     | None -> None
-    | Some codom -> Some (decomp_pointwise 1 codom)
+    | Some codom -> Some (decomp_pointwise (goalevars sigma) 1 codom)
 
   (** Looking up declared rewrite relations (instances of [RewriteRelation]) *)
   let is_applied_rewrite_relation env sigma rels t =
-    match kind_of_term t with
+    match EConstr.kind sigma t with
     | App (c, args) when Array.length args >= 2 ->
-      let head = if isApp c then fst (destApp c) else c in
-	if Globnames.is_global (coq_eq_ref ()) head then None
+      let head = if isApp sigma c then fst (destApp sigma c) else c in
+	if Termops.is_global sigma (coq_eq_ref ()) head then None
 	else
 	  (try
 	   let params, args = Array.chop (Array.length args - 2) args in
-	   let env' = Environ.push_rel_context rels env in
-	   let sigma = Sigma.Unsafe.of_evar_map sigma in
-	   let Sigma ((evar, _), evars, _) = Evarutil.new_type_evar env' sigma Evd.univ_flexible in
-	   let evars = Sigma.to_evar_map evars in
+	   let env' = push_rel_context rels env in
+	   let (evars, (evar, _)) = Evarutil.new_type_evar env' sigma Evd.univ_flexible in
 	   let evars, inst = 
 	     app_poly env (evars,Evar.Set.empty)
 	       rewrite_relation_class [| evar; mkApp (c, params) |] in
@@ -372,8 +363,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 =
@@ -419,15 +410,13 @@ module TypeGlobal = struct
 
 
   let inverse env (evd,cstrs) car rel = 
-    let sigma = Sigma.Unsafe.of_evar_map evd in
-    let Sigma (sort, sigma, _) = Evarutil.new_Type ~rigid:Evd.univ_flexible env sigma in
-    let evd = Sigma.to_evar_map sigma in
+    let (evd, sort) = Evarutil.new_Type ~rigid:Evd.univ_flexible env evd in
       app_poly_check env (evd,cstrs) coq_inverse [| car ; car; sort; rel |]
 
 end
 
 let sort_of_rel env evm rel =
-  Reductionops.sort_of_arity env evm (Retyping.get_type_of env evm rel)
+  ESorts.kind evm (Reductionops.sort_of_arity env evm (Retyping.get_type_of env evm rel))
 
 let is_applied_rewrite_relation = PropGlobal.is_applied_rewrite_relation
 
@@ -472,12 +461,12 @@ type hypinfo = {
 let get_symmetric_proof b = 
   if b then PropGlobal.get_symmetric_proof else TypeGlobal.get_symmetric_proof
 
-let error_no_relation () = error "Cannot find a relation to rewrite."
+let error_no_relation () = user_err Pp.(str "Cannot find a relation to rewrite.")
 
 let rec decompose_app_rel env evd t = 
   (** Head normalize for compatibility with the old meta mechanism *)
   let t = Reductionops.whd_betaiota evd t in
-  match kind_of_term t with
+  match EConstr.kind evd t with
   | App (f, [||]) -> assert false
   | App (f, [|arg|]) ->
     let (f', argl, argr) = decompose_app_rel env evd arg in
@@ -496,7 +485,7 @@ let rec decompose_app_rel env evd t =
 let decompose_app_rel env evd t =
   let (rel, t1, t2) = decompose_app_rel env evd t in
   let ty = Retyping.get_type_of env evd rel in
-  let () = if not (Reduction.is_arity env ty) then error_no_relation () in
+  let () = if not (Reductionops.is_arity env evd ty) then error_no_relation () in
   (rel, t1, t2)
 
 let decompose_applied_relation env sigma (c,l) =
@@ -525,7 +514,7 @@ let decompose_applied_relation env sigma (c,l) =
 	let ctx,t' = Reductionops.splay_prod env sigma ctype in (* Search for underlying eq *)
 	match find_rel (it_mkProd_or_LetIn t' (List.map (fun (n,t) -> LocalAssum (n, t)) ctx)) with
 	| Some c -> c
-	| None -> error "Cannot find an homogeneous relation to rewrite."
+	| None -> user_err Pp.(str "Cannot find an homogeneous relation to rewrite.")
 
 let rewrite_db = "rewrite"
 
@@ -614,9 +603,10 @@ let solve_remaining_by env sigma holes by =
   | Some tac ->
     let map h =
       if h.Clenv.hole_deps then None
-      else
-        let (evk, _) = destEvar (h.Clenv.hole_evar) in
+      else match EConstr.kind sigma h.Clenv.hole_evar with
+      | Evar (evk, _) ->
         Some evk
+      | _ -> None
     in
     (** Only solve independent holes *)
     let indep = List.map_filter map holes in
@@ -636,7 +626,7 @@ let solve_remaining_by env sigma holes by =
         (** Evar should not be defined, but just in case *)
       | Some evi ->
         let env = Environ.reset_with_named_context evi.evar_hyps env in
-        let ty = evi.evar_concl in
+        let ty = EConstr.of_constr evi.evar_concl in
         let c, sigma = Pfedit.refine_by_tactic env sigma ty solve_tac in
         Evd.define evk c sigma
     in
@@ -676,7 +666,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) ;
@@ -711,7 +701,7 @@ let unify_eqn (car, rel, prf, c1, c2, holes, sort) l2r flags env (sigma, cstrs)
     let sigma = Typeclasses.resolve_typeclasses ~filter:(no_constraints cstrs)
       ~fail:true env sigma in
     let evd = solve_remaining_by env sigma holes by in
-    let nf c = Evarutil.nf_evar evd (Reductionops.nf_meta evd c) in
+    let nf c = Reductionops.nf_evar evd (Reductionops.nf_meta evd c) in
     let c1 = nf c1 and c2 = nf c2
     and rew_car = nf car and rel = nf rel
     and prf = nf prf in
@@ -750,23 +740,29 @@ let default_flags = { under_lambdas = true; on_morphisms = true; }
 
 let get_opt_rew_rel = function RewPrf (rel, prf) -> Some rel | _ -> None
 
-let make_eq () =
-(*FIXME*) Universes.constr_of_global (Coqlib.build_coq_eq ())
-let make_eq_refl () =
-(*FIXME*) Universes.constr_of_global (Coqlib.build_coq_eq_refl ())
+let new_global (evars, cstrs) gr =
+  let (sigma,c) = Evarutil.new_global evars gr in
+  (sigma, cstrs), c
+
+let make_eq sigma =
+  new_global sigma (Coqlib.build_coq_eq ())
+let make_eq_refl sigma =
+  new_global sigma (Coqlib.build_coq_eq_refl ())
 
-let get_rew_prf r = match r.rew_prf with
-  | RewPrf (rel, prf) -> rel, prf 
+let get_rew_prf evars r = match r.rew_prf with
+  | RewPrf (rel, prf) -> evars, (rel, prf)
   | RewCast c ->
-    let rel = mkApp (make_eq (), [| r.rew_car |]) in
-      rel, mkCast (mkApp (make_eq_refl (), [| r.rew_car; r.rew_from |]),
-		   c, mkApp (rel, [| r.rew_from; r.rew_to |]))
+    let evars, eq = make_eq evars in
+    let evars, eq_refl = make_eq_refl evars in
+    let rel = mkApp (eq, [| r.rew_car |]) in
+    evars, (rel, mkCast (mkApp (eq_refl, [| r.rew_car; r.rew_from |]),
+		         c, mkApp (rel, [| r.rew_from; r.rew_to |])))
 
 let poly_subrelation sort = 
   if sort then PropGlobal.subrelation else TypeGlobal.subrelation
 
 let resolve_subrelation env avoid car rel sort prf rel' res =
-  if eq_constr rel rel' then res
+  if Termops.eq_constr (fst res.rew_evars) rel rel' then res
   else
     let evars, app = app_poly_check env res.rew_evars (poly_subrelation sort) [|car; rel; rel'|] in
     let evars, subrel = new_cstr_evar evars env app in
@@ -802,7 +798,7 @@ let resolve_morphism env avoid oldt m ?(fnewt=fun x -> x) args args' (b,cstr) ev
 	if b then PropGlobal.do_subrelation, PropGlobal.apply_subrelation 
 	else TypeGlobal.do_subrelation, TypeGlobal.apply_subrelation
       in
-	Environ.push_named
+	EConstr.push_named
 	  (LocalDef (Id.of_string "do_subrelation",
 	             snd (app_poly_sort b env evars dosub [||]),
 	             snd (app_poly_nocheck env evars appsub [||])))
@@ -826,16 +822,17 @@ let resolve_morphism env avoid oldt m ?(fnewt=fun x -> x) args args' (b,cstr) ev
 		      env evars carrier relation x in
 		    [ proof ; x ; x ] @ acc, subst, evars, sigargs, x :: typeargs'
 	      | Some r ->
-		  [ snd (get_rew_prf r); r.rew_to; x ] @ acc, subst, evars, 
+                 let evars, proof = get_rew_prf evars r in
+		 [ snd proof; r.rew_to; x ] @ acc, subst, evars, 
 	      sigargs, r.rew_to :: typeargs')
 	  | None ->
 	      if not (Option.is_empty y) then 
-		error "Cannot rewrite inside dependent arguments of a function";
+		user_err Pp.(str "Cannot rewrite inside dependent arguments of a function");
 	      x :: acc, x :: subst, evars, sigargs, x :: typeargs')
       ([], [], evars, sigargs, []) args args'
   in
-  let proof = applistc proj (List.rev projargs) in
-  let newt = applistc m' (List.rev typeargs) in
+  let proof = applist (proj, List.rev projargs) in
+  let newt = applist (m', List.rev typeargs) in
     match respars with
 	[ a, Some r ] -> evars, proof, substl subst a, substl subst r, oldt, fnewt newt
       | _ -> assert(false)
@@ -846,7 +843,8 @@ let apply_constraint env avoid car rel prf cstr res =
   | Some r -> resolve_subrelation env avoid car rel (fst cstr) prf r res
 
 let coerce env avoid cstr res = 
-  let rel, prf = get_rew_prf res in
+  let evars, (rel, prf) = get_rew_prf res.rew_evars res in
+  let res = { res with rew_evars = evars } in
     apply_constraint env avoid res.rew_car rel prf cstr res
 
 let apply_rule unify loccs : int pure_strategy =
@@ -858,17 +856,16 @@ let apply_rule unify loccs : int pure_strategy =
   in
   { strategy = fun { state = occ ; env ; unfresh ;
 		     term1 = t ; ty1 = ty ; cstr ; evars } ->
-      let unif = if isEvar t then None else unify env evars t in
+      let unif = if isEvar (goalevars evars) t then None else unify env evars t in
 	match unif with
 	| None -> (occ, Fail)
         | Some rew ->
 	  let occ = succ occ in
 	    if not (is_occ occ) then (occ, Fail)
-	    else if eq_constr t rew.rew_to then (occ, Identity)
+	    else if Termops.eq_constr (fst rew.rew_evars) t rew.rew_to then (occ, Identity)
 	    else
 	      let res = { rew with rew_car = ty } in
-              let rel, prf = get_rew_prf res in
-	      let res = Success (apply_constraint env unfresh rew.rew_car rel prf cstr res) in
+	      let res = Success (coerce env unfresh cstr res) in
               (occ, res)
     }
 
@@ -918,23 +915,23 @@ let reset_env env =
     Environ.push_rel_context (Environ.rel_context env) env'
       
 let fold_match ?(force=false) env sigma c =
-  let (ci, p, c, brs) = destCase c in
+  let (ci, p, c, brs) = destCase sigma c in
   let cty = Retyping.get_type_of env sigma c in
   let dep, pred, exists, (sk,eff) = 
     let env', ctx, body =
-      let ctx, pred = decompose_lam_assum p in
-      let env' = Environ.push_rel_context ctx env in
+      let ctx, pred = decompose_lam_assum sigma p in
+      let env' = push_rel_context ctx env in
 	env', ctx, pred
     in
     let sortp = Retyping.get_sort_family_of env' sigma body in
     let sortc = Retyping.get_sort_family_of env sigma cty in
-    let dep = not (noccurn 1 body) in
+    let dep = not (noccurn sigma 1 body) in
     let pred = if dep then p else
 	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 (
@@ -952,7 +949,7 @@ let fold_match ?(force=false) env sigma c =
       else raise Not_found
   in
   let app =
-    let ind, args = Inductive.find_rectype env cty in
+    let ind, args = Inductiveops.find_mrectype env sigma cty in
     let pars, args = List.chop ci.ci_npar args in
     let meths = List.map (fun br -> br) (Array.to_list brs) in
       applist (mkConst sk, pars @ [pred] @ meths @ args @ [c])
@@ -960,9 +957,10 @@ let fold_match ?(force=false) env sigma c =
     sk, (if exists then env else reset_env env), app, eff
 
 let unfold_match env sigma sk app =
-  match kind_of_term app with
-  | App (f', args) when eq_constant (fst (destConst f')) sk ->
+  match EConstr.kind sigma app with
+  | App (f', args) when Constant.equal (fst (destConst sigma f')) sk ->
       let v = Environ.constant_value_in (Global.env ()) (sk,Univ.Instance.empty)(*FIXME*) in
+      let v = EConstr.of_constr v in
 	Reductionops.whd_beta sigma (mkApp (v, args))
   | _ -> app
 
@@ -972,7 +970,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
   let rec aux { state ; env ; unfresh ;
 		term1 = t ; ty1 = ty ; cstr = (prop, cstr) ; evars } =
     let cstr' = Option.map (fun c -> (ty, Some c)) cstr in
-      match kind_of_term t with
+      match EConstr.kind (goalevars evars) t with
       | App (m, args) ->
 	  let rewrite_args state success =
 	    let state, (args', evars', progress) =
@@ -1052,7 +1050,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
 			let app = if prop then PropGlobal.apply_pointwise 
 			  else TypeGlobal.apply_pointwise 
 			in
-			  RewPrf (app rel argsl, mkApp (prf, args))
+			  RewPrf (app (goalevars evars) rel argsl, mkApp (prf, args))
 		      | x -> x
 		    in
 		    let res =
@@ -1069,9 +1067,9 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
 		    in state, res
 	    else rewrite_args state None
 	      
-      | Prod (n, x, b) when noccurn 1 b ->
+      | Prod (n, x, b) when noccurn (goalevars evars) 1 b ->
 	  let b = subst1 mkProp b in
-	  let tx = Retyping.get_type_of env (goalevars evars) x 
+	  let tx = Retyping.get_type_of env (goalevars evars) x
 	  and tb = Retyping.get_type_of env (goalevars evars) b in
 	  let arr = if prop then PropGlobal.arrow_morphism 
 	    else TypeGlobal.arrow_morphism 
@@ -1082,7 +1080,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
 				 cstr = (prop,cstr) ; evars = evars' } in
 	  let res = 
 	    match res with
-	    | Success r -> Success { r with rew_to = unfold r.rew_to }
+	    | Success r -> Success { r with rew_to = unfold (goalevars r.rew_evars) r.rew_to }
 	    | Fail | Identity -> res
 	  in state, res
 
@@ -1103,7 +1101,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
       | Prod (n, dom, codom) ->
 	  let lam = mkLambda (n, dom, codom) in
 	  let (evars', app), unfold = 
-	    if eq_constr ty mkProp then
+	    if eq_constr (fst evars) ty mkProp then
 	      (app_poly_sort prop env evars coq_all [| dom; lam |]), TypeGlobal.unfold_all
 	    else 
 	      let forall = if prop then PropGlobal.coq_forall else TypeGlobal.coq_forall in
@@ -1114,7 +1112,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
 				 cstr = (prop,cstr) ; evars = evars' } in
 	  let res = 
 	    match res with
-	    | Success r -> Success { r with rew_to = unfold r.rew_to }
+	    | Success r -> Success { r with rew_to = unfold (goalevars r.rew_evars) r.rew_to }
 	    | Fail | Identity -> res
 	  in state, res
 
@@ -1147,9 +1145,9 @@ 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' = Environ.push_rel (LocalAssum (n', t)) env in
+	let env' = EConstr.push_rel (LocalAssum (n', t)) env in
 	let bty = Retyping.get_type_of env' (goalevars evars) b in
 	let unlift = if prop then PropGlobal.unlift_cstr else TypeGlobal.unlift_cstr in
 	let state, b' = s.strategy { state ; env = env' ; unfresh ;
@@ -1229,9 +1227,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
 	in 
 	let res = 
 	  match res with
-	  | Success r ->  
-	    let rel, prf = get_rew_prf r in
-	      Success (apply_constraint env unfresh r.rew_car rel prf (prop,cstr) r)
+	  | Success r -> Success (coerce env unfresh (prop,cstr) r)
 	  | Fail | Identity -> res
 	in state, res
       | _ -> state, Fail
@@ -1376,9 +1372,9 @@ module Strategies =
 	fail cs
 
     let inj_open hint = (); fun sigma ->
-      let ctx = Evd.evar_universe_context_of hint.Autorewrite.rew_ctx in
+      let ctx = UState.of_context_set hint.Autorewrite.rew_ctx in
       let sigma = Evd.merge_universe_context sigma ctx in
-      (sigma, (hint.Autorewrite.rew_lemma, NoBindings))
+      (sigma, (EConstr.of_constr hint.Autorewrite.rew_lemma, NoBindings))
 
     let old_hints (db : string) : 'a pure_strategy =
       let rules = Autorewrite.find_rewrites db in
@@ -1388,6 +1384,7 @@ module Strategies =
 
     let hints (db : string) : 'a pure_strategy = { strategy =
       fun ({ term1 = t } as input) ->
+      let t = EConstr.Unsafe.to_constr t in
       let rules = Autorewrite.find_matches db t in
       let lemma hint = (inj_open hint, hint.Autorewrite.rew_l2r,
 			hint.Autorewrite.rew_tac) in
@@ -1398,15 +1395,14 @@ module Strategies =
     let reduce (r : Redexpr.red_expr) : 'a pure_strategy = { strategy =
 	fun { state = state ; env = env ; term1 = t ; ty1 = ty ; cstr = cstr ; evars = evars } ->
           let rfn, ckind = Redexpr.reduction_of_red_expr env r in
-          let sigma = Sigma.Unsafe.of_evar_map (goalevars evars) in
-	  let Sigma (t', sigma, _) = rfn.Reductionops.e_redfun env sigma t in
-	  let evars' = Sigma.to_evar_map sigma in
-	    if eq_constr t' t then
+          let sigma = goalevars evars in
+	  let (sigma, t') = rfn env sigma t in
+	    if Termops.eq_constr sigma t' t then
 	      state, Identity
 	    else
 	      state, Success { rew_car = ty; rew_from = t; rew_to = t';
 			       rew_prf = RewCast ckind; 
-			       rew_evars = evars', cstrevars evars }
+			       rew_evars = sigma, cstrevars evars }
 							   }
 	
     let fold_glob c : 'a pure_strategy = { strategy =
@@ -1416,11 +1412,11 @@ module Strategies =
 	let unfolded =
 	  try Tacred.try_red_product env sigma c
 	  with e when CErrors.noncritical e ->
-            error "fold: the term is not unfoldable !"
+            user_err Pp.(str "fold: the term is not unfoldable!")
 	in
 	  try
 	    let sigma = Unification.w_unify env sigma CONV ~flags:(Unification.elim_flags ()) unfolded t in
-	    let c' = Evarutil.nf_evar sigma c in
+	    let c' = Reductionops.nf_evar sigma c in
 	      state, Success { rew_car = ty; rew_from = t; rew_to = c';
 				  rew_prf = RewCast DEFAULTcast;
 				  rew_evars = (sigma, snd evars) }
@@ -1467,7 +1463,7 @@ let solve_constraints env (evars,cstrs) =
 let nf_zeta =
   Reductionops.clos_norm_flags (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
 
-exception RewriteFailure of Pp.std_ppcmds
+exception RewriteFailure of Pp.t
 
 type result = (evar_map * constr option * types) option option
 
@@ -1477,7 +1473,7 @@ let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : resul
   let evars = (!evdref, Evar.Set.empty) in
   let evars, cstr =
     let prop, (evars, arrow) = 
-      if is_prop_sort sort then true, app_poly_sort true env evars impl [||]
+      if Sorts.is_prop sort then true, app_poly_sort true env evars impl [||]
       else false, app_poly_sort false env evars TypeGlobal.arrow [||]
     in
       match is_hyp with
@@ -1493,28 +1489,28 @@ let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : resul
     | Success res ->
       let (_, cstrs) = res.rew_evars in
       let evars' = solve_constraints env res.rew_evars in
-      let newt = Evarutil.nf_evar evars' res.rew_to in
+      let newt = Reductionops.nf_evar evars' res.rew_to in
       let evars = (* Keep only original evars (potentially instantiated) and goal evars,
 		     the rest has been defined and substituted already. *)
 	Evar.Set.fold 
 	  (fun ev acc -> 
 	   if not (Evd.is_defined acc ev) then 
-	     errorlabstrm "rewrite"
+	     user_err ~hdr:"rewrite"
 			  (str "Unsolved constraint remaining: " ++ spc () ++
-			   Evd.pr_evar_info (Evd.find acc ev))
+			   Termops.pr_evar_info (Evd.find acc ev))
 	   else Evd.remove acc ev) 
 	  cstrs evars'
       in
       let res = match res.rew_prf with
 	| RewCast c -> None
 	| RewPrf (rel, p) ->
-	  let p = nf_zeta env evars' (Evarutil.nf_evar evars' p) in
+	  let p = nf_zeta env evars' (Reductionops.nf_evar evars' p) in
 	  let term =
 	    match abs with
 	    | None -> p
 	    | Some (t, ty) ->
-              let t = Evarutil.nf_evar evars' t in
-              let ty = Evarutil.nf_evar evars' ty in
+              let t = Reductionops.nf_evar evars' t in
+              let ty = Reductionops.nf_evar evars' ty in
 		mkApp (mkLambda (Name (Id.of_string "lemma"), ty, p), [| t |])
 	  in
 	  let proof = match is_hyp with
@@ -1524,36 +1520,37 @@ let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : resul
       in Some (Some (evars, res, newt))
 
 (** Insert a declaration after the last declaration it depends on *)
-let rec insert_dependent env decl accu hyps = match hyps with
+let rec insert_dependent env sigma decl accu hyps = match hyps with
 | [] -> List.rev_append accu [decl]
 | ndecl :: rem ->
-  if occur_var_in_decl env (get_id ndecl) decl then
+  if occur_var_in_decl env sigma (NamedDecl.get_id ndecl) decl then
     List.rev_append accu (decl :: hyps)
   else
-    insert_dependent env decl (ndecl :: accu) rem
+    insert_dependent env sigma decl (ndecl :: accu) rem
 
 let assert_replacing id newt tac = 
-  let prf = Proofview.Goal.nf_enter { enter = begin fun gl ->
+  let prf = Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
-    let ctx = Environ.named_context env in
-    let after, before = List.split_when (Id.equal id % get_id) ctx in
+    let sigma = Tacmach.New.project gl in
+    let ctx = named_context env in
+    let after, before = List.split_when (NamedDecl.get_id %> Id.equal id) ctx in
     let nc = match before with
     | [] -> assert false
-    | d :: rem -> insert_dependent env (LocalAssum (get_id d, newt)) [] after @ rem
+    | d :: rem -> insert_dependent env sigma (LocalAssum (NamedDecl.get_id d, newt)) [] after @ rem
     in
     let env' = Environ.reset_with_named_context (val_of_named_context nc) env in
-    Refine.refine ~unsafe:false { run = begin fun sigma ->
-      let Sigma (ev, sigma, p) = Evarutil.new_evar env' sigma concl in
-      let Sigma (ev', sigma, q) = Evarutil.new_evar env sigma newt in
+    Refine.refine ~typecheck:true begin fun sigma ->
+      let (sigma, ev) = Evarutil.new_evar env' sigma concl in
+      let (sigma, ev') = Evarutil.new_evar env sigma newt in
       let map d =
-        let n = get_id d in
+        let n = NamedDecl.get_id d in
         if Id.equal n id then ev' else mkVar n
       in
-      let (e, _) = destEvar ev in
-      Sigma (mkEvar (e, Array.map_of_list map nc), sigma, p +> q)
-    end }
-  end } in
+      let (e, _) = destEvar sigma ev in
+      (sigma, mkEvar (e, Array.map_of_list map nc))
+    end
+  end in
   Proofview.tclTHEN prf (Proofview.tclFOCUS 2 2 tac)
 
 let newfail n s = 
@@ -1562,9 +1559,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")
@@ -1574,10 +1570,11 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
         let (undef, prf, newt) = res in
         let fold ev _ accu = if Evd.mem sigma ev then accu else ev :: accu in
         let gls = List.rev (Evd.fold_undefined fold undef []) in
-	match clause, prf with
+        let gls = List.map Proofview.with_empty_state gls in
+          match clause, prf with
 	| Some id, Some p ->
             let tac = tclTHENLIST [
-              Refine.refine ~unsafe:false { run = fun h -> Sigma.here p h };
+              Refine.refine ~typecheck:true (fun h -> (h,p));
               Proofview.Unsafe.tclNEWGOALS gls;
             ] in
             Proofview.Unsafe.tclEVARS undef <*>
@@ -1588,38 +1585,38 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
             beta_hyp id
 	| None, Some p ->
             Proofview.Unsafe.tclEVARS undef <*>
-            Proofview.Goal.enter { enter = begin fun gl ->
+            Proofview.Goal.enter begin fun gl ->
             let env = Proofview.Goal.env gl in
-            let make = { run = begin fun sigma ->
-              let Sigma (ev, sigma, q) = Evarutil.new_evar env sigma newt in
-              Sigma (mkApp (p, [| ev |]), sigma, q)
-            end } in
-            Refine.refine ~unsafe:false make <*> Proofview.Unsafe.tclNEWGOALS gls
-            end }
+            let make = begin fun sigma ->
+              let (sigma, ev) = Evarutil.new_evar env sigma newt in
+              (sigma, mkApp (p, [| ev |]))
+            end in
+            Refine.refine ~typecheck:true make <*> Proofview.Unsafe.tclNEWGOALS gls
+            end
 	| None, None ->
             Proofview.Unsafe.tclEVARS undef <*>
             convert_concl_no_check newt DEFAULTcast
   in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     let ty = match clause with
     | None -> concl
-    | Some id -> Environ.named_type id env
+    | Some id -> EConstr.of_constr (Environ.named_type id env)
     in
     let env = match clause with
     | None -> env
     | Some id ->
       (** Only consider variables not depending on [id] *)
-      let ctx = Environ.named_context env in
-      let filter decl = not (occur_var_in_decl env id decl) in
+      let ctx = named_context env in
+      let filter decl = not (occur_var_in_decl env sigma id decl) in
       let nctx = List.filter filter ctx in
-      Environ.reset_with_named_context (Environ.val_of_named_context nctx) env
+      Environ.reset_with_named_context (val_of_named_context nctx) env
     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 <*>
@@ -1628,7 +1625,7 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
     with
     | PretypeError (env, evd, (UnsatisfiableConstraints _ as e)) ->
       raise (RewriteFailure (Himsg.explain_pretype_error env evd e))
-  end }
+  end
 
 let tactic_init_setoid () = 
   try init_setoid (); Proofview.tclUNIT ()
@@ -1776,38 +1773,39 @@ let rec strategy_of_ast = function
 
 (* By default the strategy for "rewrite_db" is top-down *)
 
-let mkappc s l = CAppExpl (Loc.ghost,(None,(Libnames.Ident (Loc.ghost,Id.of_string s)),None),l)
+let mkappc s l = CAst.make @@ CAppExpl ((None,CAst.make @@ Libnames.Ident (Id.of_string s),None),l)
 
 let declare_an_instance n s args =
-  (((Loc.ghost,Name n),None), Explicit,
-  CAppExpl (Loc.ghost, (None, Qualid (Loc.ghost, qualid_of_string s),None),
-	   args))
+  (((CAst.make @@ Name n),None), Explicit,
+   CAst.make @@ CAppExpl ((None, CAst.make @@ Qualid (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 ()) 
-    binders instance (Some (true, CRecord (Loc.ghost,fields)))
+  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
 
 let declare_instance_refl global binders a aeq n lemma =
   let instance = declare_instance a aeq (add_suffix n "_Reflexive") "Coq.Classes.RelationClasses.Reflexive"
   in anew_instance global binders instance
-       [(Ident (Loc.ghost,Id.of_string "reflexivity"),lemma)]
+       [(CAst.make @@ Ident (Id.of_string "reflexivity"),lemma)]
 
 let declare_instance_sym global binders a aeq n lemma =
   let instance = declare_instance a aeq (add_suffix n "_Symmetric") "Coq.Classes.RelationClasses.Symmetric"
   in anew_instance global binders instance
-       [(Ident (Loc.ghost,Id.of_string "symmetry"),lemma)]
+       [(CAst.make @@ Ident (Id.of_string "symmetry"),lemma)]
 
 let declare_instance_trans global binders a aeq n lemma =
   let instance = declare_instance a aeq (add_suffix n "_Transitive") "Coq.Classes.RelationClasses.Transitive"
   in anew_instance global binders instance
-       [(Ident (Loc.ghost,Id.of_string "transitivity"),lemma)]
+       [(CAst.make @@ Ident (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
@@ -1827,16 +1825,16 @@ let declare_relation ?(binders=[]) a aeq n refl symm trans =
 	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PreOrder"
 	in ignore(
 	    anew_instance global binders instance
-	      [(Ident (Loc.ghost,Id.of_string "PreOrder_Reflexive"), lemma1);
-	       (Ident (Loc.ghost,Id.of_string "PreOrder_Transitive"),lemma3)])
+              [(CAst.make @@ Ident (Id.of_string "PreOrder_Reflexive"), lemma1);
+               (CAst.make @@ Ident (Id.of_string "PreOrder_Transitive"),lemma3)])
     | (None, Some lemma2, Some lemma3) ->
 	let _lemma_sym = declare_instance_sym global binders a aeq n lemma2 in
 	let _lemma_trans = declare_instance_trans global binders a aeq n lemma3 in
 	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.PER"
 	in ignore(
 	    anew_instance global binders instance
-	      [(Ident (Loc.ghost,Id.of_string "PER_Symmetric"), lemma2);
-	       (Ident (Loc.ghost,Id.of_string "PER_Transitive"),lemma3)])
+              [(CAst.make @@ Ident (Id.of_string "PER_Symmetric"), lemma2);
+               (CAst.make @@ Ident (Id.of_string "PER_Transitive"),lemma3)])
      | (Some lemma1, Some lemma2, Some lemma3) ->
 	let _lemma_refl = declare_instance_refl global binders a aeq n lemma1 in
 	let _lemma_sym = declare_instance_sym global binders a aeq n lemma2 in
@@ -1844,15 +1842,16 @@ let declare_relation ?(binders=[]) a aeq n refl symm trans =
 	let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
 	in ignore(
 	  anew_instance global binders instance
-	    [(Ident (Loc.ghost,Id.of_string "Equivalence_Reflexive"), lemma1);
-	     (Ident (Loc.ghost,Id.of_string "Equivalence_Symmetric"), lemma2);
-	     (Ident (Loc.ghost,Id.of_string "Equivalence_Transitive"), lemma3)])
+            [(CAst.make @@ Ident (Id.of_string "Equivalence_Reflexive"), lemma1);
+             (CAst.make @@ Ident (Id.of_string "Equivalence_Symmetric"), lemma2);
+             (CAst.make @@ Ident (Id.of_string "Equivalence_Transitive"), lemma3)])
 
-let cHole = CHole (Loc.ghost, None, Misctypes.IntroAnonymous, None)
+let cHole = CAst.make @@ CHole (None, Misctypes.IntroAnonymous, None)
 
-let proper_projection r ty =
-  let ctx, inst = decompose_prod_assum ty in
-  let mor, args = destApp inst in
+let proper_projection sigma r ty =
+  let rel_vect n m = Array.init m (fun i -> mkRel(n+m-i)) in
+  let ctx, inst = decompose_prod_assum sigma ty in
+  let mor, args = destApp sigma inst in
   let instarg = mkApp (r, rel_vect 0 (List.length ctx)) in
   let app = mkApp (Lazy.force PropGlobal.proper_proj,
 		  Array.append args [| instarg |]) in
@@ -1863,33 +1862,36 @@ let declare_projection n instance_id r =
   let env = Global.env () in
   let sigma = Evd.from_env env in
   let sigma,c = Evd.fresh_global env sigma r in
+  let c = EConstr.of_constr c in
   let ty = Retyping.get_type_of env sigma c in
-  let term = proper_projection c ty in
+  let term = proper_projection sigma c ty in
   let sigma, typ = Typing.type_of env sigma term in
-  let ctx, typ = decompose_prod_assum typ in
+  let ctx, typ = decompose_prod_assum sigma typ in
   let typ =
     let n =
       let rec aux t =
-	match kind_of_term t with
+	match EConstr.kind sigma t with
 	| App (f, [| a ; a' ; rel; rel' |]) 
-	    when Globnames.is_global (PropGlobal.respectful_ref ()) f ->
+	    when Termops.is_global sigma (PropGlobal.respectful_ref ()) f ->
 	  succ (aux rel')
 	| _ -> 0
       in
       let init =
-	match kind_of_term typ with
-	    App (f, args) when Globnames.is_global (PropGlobal.respectful_ref ()) f  ->
+	match EConstr.kind sigma typ with
+	    App (f, args) when Termops.is_global sigma (PropGlobal.respectful_ref ()) f  ->
 	      mkApp (f, fst (Array.chop (Array.length args - 2) args))
 	  | _ -> typ
       in aux init
     in
-    let ctx,ccl = Reductionops.splay_prod_n (Global.env()) Evd.empty (3 * n) typ
+    let ctx,ccl = Reductionops.splay_prod_n env sigma (3 * n) typ
     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))
@@ -1900,7 +1902,7 @@ let build_morphism_signature env sigma m =
   let t = Typing.unsafe_type_of env sigma m in
   let cstrs =
     let rec aux t =
-      match kind_of_term t with
+      match EConstr.kind sigma t with
 	| Prod (na, a, b) ->
 	    None :: aux b
 	| _ -> []
@@ -1919,9 +1921,9 @@ let build_morphism_signature env sigma m =
   in
   let morph = e_app_poly env evd PropGlobal.proper_type [| t; sig_; m |] in
   let evd = solve_constraints env !evd in
-  let evd = Evd.nf_constraints evd in
-  let m = Evarutil.nf_evars_universes evd morph in
-  Pretyping.check_evars env Evd.empty evd m;
+  let evd = Evd.minimize_universes evd in
+  let m = Evarutil.nf_evars_universes evd (EConstr.Unsafe.to_constr morph) in
+  Pretyping.check_evars env Evd.empty evd (EConstr.of_constr m);
   Evd.evar_universe_context evd, m
 
 let default_morphism sign m =
@@ -1933,9 +1935,14 @@ let default_morphism sign m =
   in
   let evars, morph = app_poly_check env evars PropGlobal.proper_type [| t; sign; m |] in
   let evars, mor = resolve_one_typeclass env (goalevars evars) morph in
-    mor, proper_projection mor morph
+    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
@@ -1943,19 +1950,23 @@ let add_setoid global binders a aeq t n =
   let instance = declare_instance a aeq n "Coq.Classes.RelationClasses.Equivalence"
   in ignore(
     anew_instance global binders instance
-      [(Ident (Loc.ghost,Id.of_string "Equivalence_Reflexive"), mkappc "Seq_refl" [a;aeq;t]);
-       (Ident (Loc.ghost,Id.of_string "Equivalence_Symmetric"), mkappc "Seq_sym" [a;aeq;t]);
-       (Ident (Loc.ghost,Id.of_string "Equivalence_Transitive"), mkappc "Seq_trans" [a;aeq;t])])
+      [(CAst.make @@ Ident (Id.of_string "Equivalence_Reflexive"), mkappc "Seq_refl" [a;aeq;t]);
+       (CAst.make @@ Ident (Id.of_string "Equivalence_Symmetric"), mkappc "Seq_sym" [a;aeq;t]);
+       (CAst.make @@ Ident (Id.of_string "Equivalence_Transitive"), mkappc "Seq_trans" [a;aeq;t])])
 
 
 let make_tactic name =
   let open Tacexpr in
-  let loc = Loc.ghost in
   let tacpath = Libnames.qualid_of_string name in
-  let tacname = Qualid (loc, tacpath) in
-  TacArg (loc, TacCall (loc, tacname, []))
+  let tacname = CAst.make @@ Qualid 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
@@ -1963,14 +1974,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,Evd.evar_context_universe_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, 
@@ -1981,14 +1992,14 @@ 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
       let hook = Lemmas.mk_hook hook in
 	Flags.silently
 	  (fun () ->
-	    Lemmas.start_proof instance_id kind (Evd.from_ctx uctx) instance hook;
+	    Lemmas.start_proof instance_id kind (Evd.from_ctx uctx) (EConstr.of_constr instance) hook;
 	    ignore (Pfedit.by (Tacinterp.interp tac))) ()
 
 let add_morphism glob binders m s n =
@@ -1996,29 +2007,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.ghost,Name instance_id),None), Explicit,
-    CAppExpl (Loc.ghost,
-	     (None, Qualid (Loc.ghost, Libnames.qualid_of_string "Coq.Classes.Morphisms.Proper"),None),
+    (((CAst.make @@ Name instance_id),None), Explicit,
+    CAst.make @@ CAppExpl (
+             (None, CAst.make @@ Qualid (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, CRecord (Loc.ghost,[])))
-	      ~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) ->
@@ -2049,11 +2063,11 @@ let unification_rewrite l2r c1 c2 sigma prf car rel but env =
         ~flags:rewrite_conv_unif_flags
         env sigma ((if l2r then c1 else c2),but)
   in
-  let nf c = Evarutil.nf_evar sigma c in
+  let nf c = Reductionops.nf_evar sigma c in
   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
@@ -2068,18 +2082,18 @@ let get_hyp gl (c,l) clause l2r =
   let sigma, hi = decompose_applied_relation env evars (c,l) in
   let but = match clause with
     | Some id -> Tacmach.New.pf_get_hyp_typ id gl
-    | None -> Evarutil.nf_evar evars (Tacmach.New.pf_concl gl)
+    | None -> Reductionops.nf_evar evars (Tacmach.New.pf_concl gl)
   in
   unification_rewrite l2r hi.c1 hi.c2 sigma hi.prf hi.car hi.rel but env
 
 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 =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let abs, evd, res, sort = get_hyp gl (c,l) cl l2r in
   let unify env evars t = unify_abs res l2r sort env evars t in
   let app = apply_rule unify occs in
@@ -2101,19 +2115,19 @@ let general_s_rewrite cl l2r occs (c,l) ~new_goals =
     | RewriteFailure e ->
       tclFAIL 0 (str"setoid rewrite failed: " ++ e)
     | e -> Proofview.tclZERO ~info e)
-  end }
+  end
 
 let _ = Hook.set Equality.general_setoid_rewrite_clause general_s_rewrite
 
 (** [setoid_]{reflexivity,symmetry,transitivity} tactics *)
 
-let not_declared env ty rel =
+let not_declared env sigma ty rel =
   tclFAIL 0
-    (str" The relation " ++ Printer.pr_constr_env env Evd.empty rel ++ str" is not a declared " ++
+    (str" The relation " ++ Printer.pr_econstr_env env sigma rel ++ str" is not a declared " ++
      str ty ++ str" relation. Maybe you need to require the Coq.Classes.RelationClasses library")
 
 let setoid_proof ty fn fallback =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     let concl = Proofview.Goal.concl gl in
@@ -2121,9 +2135,8 @@ let setoid_proof ty fn fallback =
       begin
         try
           let rel, _, _ = decompose_app_rel env sigma concl in
-          let open Context.Rel.Declaration in
           let (sigma, t) = Typing.type_of env sigma rel in
-          let car = get_type (List.hd (fst (Reduction.dest_prod env t))) in
+          let car = snd (List.hd (fst (Reductionops.splay_prod env sigma t))) in
 	    (try init_relation_classes () with _ -> raise Not_found);
             fn env sigma car rel
         with e -> Proofview.tclZERO e
@@ -2137,13 +2150,13 @@ let setoid_proof ty fn fallback =
 	            begin match e with
 	            | (Not_found, _) ->
 	                let rel, _, _ = decompose_app_rel env sigma concl in
-		        not_declared env ty rel
+		        not_declared env sigma ty rel
 	            | (e, info) -> Proofview.tclZERO ~info e
                     end
                 | e' -> Proofview.tclZERO ~info e'
               end
       end
-  end }
+  end
 
 let tac_open ((evm,_), c) tac = 
     (tclTHEN (Proofview.Unsafe.tclEVARS evm) (tac c))
@@ -2182,24 +2195,25 @@ let setoid_transitivity c =
     (transitivity_red true c)
     
 let setoid_symmetry_in id =
-  Proofview.V82.tactic (fun gl ->
+  let open Tacmach.New in
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
   let ctype = pf_unsafe_type_of gl (mkVar id) in
-  let binders,concl = decompose_prod_assum ctype in
-  let (equiv, args) = decompose_app concl in
+  let binders,concl = decompose_prod_assum sigma ctype in
+  let (equiv, args) = decompose_app sigma concl in
   let rec split_last_two = function
     | [c1;c2] -> [],(c1, c2)
     | x::y::z -> let l,res = split_last_two (y::z) in x::l, res
-    | _ -> error "Cannot find an equivalence relation to rewrite."
+    | _ -> user_err Pp.(str "Cannot find an equivalence relation to rewrite.")
   in
   let others,(c1,c2) = split_last_two args in
   let he,c1,c2 =  mkApp (equiv, Array.of_list others),c1,c2 in
   let new_hyp' =  mkApp (he, [| c2 ; c1 |]) in
   let new_hyp = it_mkProd_or_LetIn new_hyp'  binders in
-   Proofview.V82.of_tactic
     (tclTHENLAST
       (Tactics.assert_after_replacing id new_hyp)
       (tclTHENLIST [ intros; setoid_symmetry; apply (mkVar id); Tactics.assumption ]))
-      gl)
+  end
 
 let _ = Hook.set Tactics.setoid_reflexivity setoid_reflexivity
 let _ = Hook.set Tactics.setoid_symmetry setoid_symmetry
diff --git a/ltac/rewrite.mli b/plugins/ltac/rewrite.mli
index 35c44835..1e3d4733 100644
--- a/ltac/rewrite.mli
+++ b/plugins/ltac/rewrite.mli
@@ -1,19 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Constr
 open Environ
+open EConstr
 open Constrexpr
 open Tacexpr
 open Misctypes
 open Evd
-open Proof_type
 open Tacinterp
 
 (** TODO: document and clean me! *)
@@ -38,7 +39,7 @@ type ('constr,'redexpr) strategy_ast =
 
 type rewrite_proof = 
   | RewPrf of constr * constr
-  | RewCast of cast_kind
+  | RewCast of Constr.cast_kind
 
 type evars = evar_map * Evar.Set.t (* goal evars, constraint evars *)
 
@@ -62,8 +63,8 @@ val strategy_of_ast : (glob_constr_and_expr, raw_red_expr) strategy_ast -> strat
 val map_strategy : ('a -> 'b) -> ('c -> 'd) ->
   ('a, 'c) strategy_ast -> ('b, 'd) strategy_ast
 
-val pr_strategy : ('a -> Pp.std_ppcmds) -> ('b -> Pp.std_ppcmds) ->
-  ('a, 'b) strategy_ast -> Pp.std_ppcmds
+val pr_strategy : ('a -> Pp.t) -> ('b -> Pp.t) ->
+  ('a, 'b) strategy_ast -> Pp.t
 
 (** Entry point for user-level "rewrite_strat" *)
 val cl_rewrite_clause_strat : strategy -> Id.t option -> unit Proofview.tactic
@@ -74,20 +75,20 @@ val cl_rewrite_clause :
   bool -> Locus.occurrences -> Id.t option -> unit Proofview.tactic
 
 val is_applied_rewrite_relation :
-  env -> evar_map -> Context.Rel.t -> constr -> types option
+  env -> evar_map -> rel_context -> constr -> types option
 
-val declare_relation :
-  ?binders:local_binder list -> constr_expr -> constr_expr -> Id.t ->
+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
 
 val add_setoid :
-  bool -> local_binder list -> constr_expr -> constr_expr -> constr_expr ->
+  bool -> local_binder_expr list -> constr_expr -> constr_expr -> constr_expr ->
   Id.t -> unit
 
 val add_morphism_infer : bool -> constr_expr -> Id.t -> unit
 
 val add_morphism :
-  bool -> local_binder list -> constr_expr -> constr_expr -> Id.t -> unit
+  bool -> local_binder_expr list -> constr_expr -> constr_expr -> Id.t -> unit
 
 val get_reflexive_proof : env -> evar_map -> constr -> constr -> evar_map * constr
 
@@ -111,7 +112,7 @@ val setoid_transitivity : constr option -> unit Proofview.tactic
 val apply_strategy :
   strategy ->
   Environ.env ->
-  Names.Id.t list ->
-  Term.constr ->
-  bool * Term.constr ->
+  Names.Id.Set.t ->
+  constr ->
+  bool * constr ->
   evars -> rewrite_result
diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml
new file mode 100644
index 00000000..6eb482b1
--- /dev/null
+++ b/plugins/ltac/tacarg.ml
@@ -0,0 +1,28 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Generic arguments based on Ltac. *)
+
+open Genarg
+open Geninterp
+open Tacexpr
+
+let make0 ?dyn name =
+  let wit = Genarg.make0 name in
+  let () = Geninterp.register_val0 wit dyn in
+  wit
+
+let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  make0 "tactic"
+
+let wit_ltac = make0 ~dyn:(val_tag (topwit Stdarg.wit_unit)) "ltac"
+
+let wit_destruction_arg =
+  make0 "destruction_arg"
diff --git a/plugins/ltac/tacarg.mli b/plugins/ltac/tacarg.mli
new file mode 100644
index 00000000..5347eda7
--- /dev/null
+++ b/plugins/ltac/tacarg.mli
@@ -0,0 +1,29 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Genarg
+open Tacexpr
+open Constrexpr
+open Misctypes
+
+(** Generic arguments based on Ltac. *)
+
+val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Geninterp.Val.t) genarg_type
+
+(** [wit_ltac] is subtly different from [wit_tactic]: they only change for their
+    toplevel interpretation. The one of [wit_ltac] forces the tactic and
+    discards the result. *)
+val wit_ltac : (raw_tactic_expr, glob_tactic_expr, unit) genarg_type
+
+val wit_destruction_arg :
+  (constr_expr with_bindings Tacexpr.destruction_arg,
+   glob_constr_and_expr with_bindings Tacexpr.destruction_arg,
+   delayed_open_constr_with_bindings Tacexpr.destruction_arg) genarg_type
+
diff --git a/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml
index b0a80ef7..3812a2ba 100644
--- a/ltac/taccoerce.ml
+++ b/plugins/ltac/taccoerce.ml
@@ -1,32 +1,42 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Names
-open Term
-open Pattern
+open Constr
+open EConstr
 open Misctypes
 open Genarg
 open Stdarg
-open Constrarg
 open Geninterp
+open Pp
 
 exception CannotCoerceTo of string
 
-let (wit_constr_context : (Empty.t, Empty.t, constr) Genarg.genarg_type) =
+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 +64,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 +78,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 +85,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
@@ -90,6 +95,38 @@ let to_option v = prj Val.typ_opt v
 
 let to_pair v = prj Val.typ_pair v
 
+let cast_error wit v =
+  let pr_v = Pptactic.pr_value Pptactic.ltop v in
+  let Val.Dyn (tag, _) = v in
+  let tag = Val.pr tag in
+  CErrors.user_err (str "Type error: value " ++ pr_v ++ str " is a " ++ tag
+    ++ str " while type " ++ Val.pr wit ++ str " was expected.")
+
+let unbox wit v ans = match ans with
+| None -> cast_error wit v
+| Some x -> x
+
+let rec prj : type a. a Val.tag -> Val.t -> a = fun tag v -> match tag with
+| Val.List tag -> List.map (fun v -> prj tag v) (unbox Val.typ_list v (to_list v))
+| Val.Opt tag -> Option.map (fun v -> prj tag v) (unbox Val.typ_opt v (to_option v))
+| Val.Pair (tag1, tag2) ->
+  let (x, y) = unbox Val.typ_pair v (to_pair v) in
+  (prj tag1 x, prj tag2 y)
+| Val.Base t ->
+  let Val.Dyn (t', x) = v in
+  match Val.eq t t' with
+  | None -> cast_error t v
+  | Some Refl -> x
+let rec tag_of_arg : type a b c. (a, b, c) genarg_type -> c Val.tag = fun wit -> match wit with
+| ExtraArg _ -> Geninterp.val_tag (topwit wit)
+| ListArg t -> Val.List (tag_of_arg t)
+| OptArg t -> Val.Opt (tag_of_arg t)
+| PairArg (t1, t2) -> Val.Pair (tag_of_arg t1, tag_of_arg t2)
+
+let val_cast arg v = prj (tag_of_arg arg) v
+
+let cast (Topwit wit) v = val_cast wit v
+
 end
 
 let is_variable env id =
@@ -97,22 +134,20 @@ let is_variable env id =
 
 (* Transforms an id into a constr if possible, or fails with Not_found *)
 let constr_of_id env id =
-  Term.mkVar (let _ = Environ.lookup_named id env in id)
+  EConstr.mkVar (let _ = Environ.lookup_named id env in 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 v =
-  let v = Value.normalize v in
+let coerce_var_to_ident fresh env sigma v =
   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
-    | _, IntroNaming (IntroIdentifier id) -> id
+    | { CAst.v=IntroNaming (IntroIdentifier id)} -> id
     | _ -> fail ()
   else if has_type v (topwit wit_var) then
     out_gen (topwit wit_var) v
@@ -120,23 +155,23 @@ let coerce_var_to_ident fresh env v =
   | None -> fail ()
   | Some c ->
     (* We need it fresh for intro e.g. in "Tac H = clear H; intro H" *)
-    if isVar c && not (fresh && is_variable env (destVar c)) then
-      destVar c
+    if isVar sigma c && not (fresh && is_variable env (destVar sigma c)) then
+      destVar sigma c
     else fail ()
 
 
 (* Interprets, if possible, a constr to an identifier which may not
    be fresh but suitable to be given to the fresh tactic. Works for
    vars, constants, inductive, constructors and sorts. *)
-let coerce_to_ident_not_fresh g env v =
+let coerce_to_ident_not_fresh env sigma v =
+let g = sigma in
 let id_of_name = function
-  | Names.Anonymous -> Id.of_string "x"
-  | Names.Name x -> x in
-  let v = Value.normalize v in
+  | Name.Anonymous -> Id.of_string "x"
+  | Name.Name x -> x in
   let fail () = raise (CannotCoerceTo "an identifier") in
   if has_type v (topwit wit_intro_pattern) then
     match out_gen (topwit wit_intro_pattern) v with
-    | _, IntroNaming (IntroIdentifier id) -> id
+    | {CAst.v=IntroNaming (IntroIdentifier id)} -> id
     | _ -> fail ()
   else if has_type v (topwit wit_var) then
     out_gen (topwit wit_var) v
@@ -144,7 +179,7 @@ let id_of_name = function
     match Value.to_constr v with
     | None -> fail ()
     | Some c ->
-       match Constr.kind c with
+       match EConstr.kind sigma c with
        | Var id -> id 
        | Meta m -> id_of_name (Evd.meta_name g m)
        | Evar (kn,_) ->
@@ -163,52 +198,48 @@ let id_of_name = function
 	  basename
        | Sort s ->
 	  begin
-	    match s with
-	    | Prop _ -> Label.to_id (Label.make "Prop")
-	    | Type _ -> Label.to_id (Label.make "Type")
+	    match ESorts.kind sigma s with
+	    | Sorts.Prop _ -> Label.to_id (Label.make "Prop")
+	    | Sorts.Type _ -> Label.to_id (Label.make "Type")
 	  end
        | _ -> fail()
 
 
-let coerce_to_intro_pattern env v =
-  let v = Value.normalize v in
+let coerce_to_intro_pattern env sigma v =
   if has_type v (topwit wit_intro_pattern) then
-    snd (out_gen (topwit wit_intro_pattern) v)
+    (out_gen (topwit wit_intro_pattern) v).CAst.v
   else if has_type v (topwit wit_var) then
     let id = out_gen (topwit wit_var) v in
     IntroNaming (IntroIdentifier id)
   else match Value.to_constr v with
-  | Some c when isVar c ->
+  | Some c when isVar sigma c ->
       (* This happens e.g. in definitions like "Tac H = clear H; intro H" *)
       (* but also in "destruct H as (H,H')" *)
-      IntroNaming (IntroIdentifier (destVar c))
+      IntroNaming (IntroIdentifier (destVar sigma c))
   | _ -> raise (CannotCoerceTo "an introduction pattern")
 
-let coerce_to_intro_pattern_naming env v =
-  match coerce_to_intro_pattern env v with
+let coerce_to_intro_pattern_naming env sigma v =
+  match coerce_to_intro_pattern env sigma v with
   | IntroNaming pat -> pat
   | _ -> 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
+    | {CAst.v=IntroNaming (IntroIdentifier id)} -> Id.to_string id
     | _ -> raise (CannotCoerceTo "a hint base name")
   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
-    | _, IntroNaming (IntroIdentifier id) ->
+    | {CAst.v=IntroNaming (IntroIdentifier id)} ->
       (try ([], constr_of_id env id) with Not_found -> fail ())
     | _ -> fail ()
   else if has_type v (topwit wit_constr) then
@@ -222,7 +253,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
@@ -233,13 +263,12 @@ let coerce_to_closed_constr env v =
   let () = if not (List.is_empty ids) then raise (CannotCoerceTo "a term") in
   c
 
-let coerce_to_evaluable_ref 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
-    | _, IntroNaming (IntroIdentifier id) when is_variable env id -> EvalVarRef id
+    | {CAst.v=IntroNaming (IntroIdentifier id)} when is_variable env id -> EvalVarRef id
     | _ -> fail ()
   else if has_type v (topwit wit_var) then
     let id = out_gen (topwit wit_var) v in
@@ -254,8 +283,8 @@ let coerce_to_evaluable_ref env v =
     | IndRef _ | ConstructRef _ -> fail ()
   else
     match Value.to_constr v with
-    | Some c when isConst c -> EvalConstRef (Univ.out_punivs (destConst c))
-    | Some c when isVar c -> EvalVarRef (destVar c)
+    | Some c when isConst sigma c -> EvalConstRef (fst (destConst sigma c))
+    | Some c when isVar sigma c -> EvalVarRef (destVar sigma c)
     | _ -> fail ()
   in if Tacred.is_evaluable env ev then ev else fail ()
 
@@ -267,54 +296,51 @@ let coerce_to_constr_list env v =
     List.map map l
   | None -> raise (CannotCoerceTo "a term list")
 
-let coerce_to_intro_pattern_list loc env v =
+let coerce_to_intro_pattern_list ?loc env sigma v =
   match Value.to_list v with
   | None -> raise (CannotCoerceTo "an intro pattern list")
   | Some l ->
-    let map v = (loc, coerce_to_intro_pattern env v) in
+    let map v = CAst.make ?loc @@ coerce_to_intro_pattern env sigma v in
     List.map map l
 
-let coerce_to_hyp env 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
+    | {CAst.v=IntroNaming (IntroIdentifier id)} when is_variable env id -> id
     | _ -> fail ()
   else if has_type v (topwit wit_var) then
     let id = out_gen (topwit wit_var) v in
     if is_variable env id then id else fail ()
   else match Value.to_constr v with
-  | Some c when isVar c -> destVar c
+  | Some c when isVar sigma c -> destVar sigma c
   | _ -> fail ()
 
-let coerce_to_hyp_list env v =
+let coerce_to_hyp_list env sigma v =
   let v = Value.to_list v in
   match v with
   | Some l ->
-    let map n = coerce_to_hyp env n in
+    let map n = coerce_to_hyp env sigma n in
     List.map map l
   | None -> raise (CannotCoerceTo "a variable list")
 
 (* Interprets a qualified name *)
-let coerce_to_reference env v =
-  let v = Value.normalize v in
+let coerce_to_reference env sigma v =
   match Value.to_constr v with
   | Some c ->
     begin
-      try Globnames.global_of_constr c
+      try fst (Termops.global_of_constr sigma c)
       with Not_found -> raise (CannotCoerceTo "a reference")
     end
   | None -> raise (CannotCoerceTo "a reference")
 
 (* Quantified named or numbered hypothesis or hypothesis in context *)
 (* (as in Inversion) *)
-let coerce_to_quantified_hypothesis v =
-  let v = Value.normalize v in
+let coerce_to_quantified_hypothesis sigma v =
   if has_type v (topwit wit_intro_pattern) then
     let v = out_gen (topwit wit_intro_pattern) v in
     match v with
-    | _, IntroNaming (IntroIdentifier id) -> NamedHyp id
+    | {CAst.v=IntroNaming (IntroIdentifier id)} -> NamedHyp id
     | _ -> raise (CannotCoerceTo "a quantified hypothesis")
   else if has_type v (topwit wit_var) then
     let id = out_gen (topwit wit_var) v in
@@ -322,17 +348,16 @@ let coerce_to_quantified_hypothesis v =
   else if has_type v (topwit wit_int) then
     AnonHyp (out_gen (topwit wit_int) v)
   else match Value.to_constr v with
-  | Some c when isVar c -> NamedHyp (destVar c)
+  | Some c when isVar sigma c -> NamedHyp (destVar sigma c)
   | _ -> raise (CannotCoerceTo "a quantified hypothesis")
 
 (* Quantified named or numbered hypothesis or hypothesis in context *)
 (* (as in Inversion) *)
-let coerce_to_decl_or_quant_hyp env v =
-  let v = Value.normalize v in
+let coerce_to_decl_or_quant_hyp env sigma v =
   if has_type v (topwit wit_int) then
     AnonHyp (out_gen (topwit wit_int) v)
   else
-    try coerce_to_quantified_hypothesis v
+    try coerce_to_quantified_hypothesis sigma v
     with CannotCoerceTo _ ->
       raise (CannotCoerceTo "a declared or quantified hypothesis")
 
@@ -342,3 +367,46 @@ let coerce_to_int_or_var_list v =
   | Some l ->
     let map n = ArgArg (coerce_to_int n) in
     List.map map l
+
+(** Abstract application, to print ltac functions *)
+type appl =
+  | UnnamedAppl (** For generic applications: nothing is printed *)
+  | GlbAppl of (Names.KerName.t * Val.t list) list
+       (** For calls to global constants, some may alias other. *)
+
+(* Values for interpretation *)
+type tacvalue =
+  | VFun of appl*Tacexpr.ltac_trace * Val.t Id.Map.t *
+      Name.t list * Tacexpr.glob_tactic_expr
+  | VRec of Val.t Id.Map.t ref * Tacexpr.glob_tactic_expr
+
+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 pr_argument_type arg =
+  let Val.Dyn (tag, _) = arg in
+  Val.pr tag
+
+(** TODO: unify printing of generic Ltac values in case of coercion failure. *)
+
+(* Displays a value *)
+let pr_value env v =
+  let pr_with_env pr =
+    match env with
+    | 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 error_ltac_variable ?loc id env v s =
+   CErrors.user_err ?loc  (str "Ltac variable " ++ Id.print id ++
+   strbrk " is bound to" ++ spc () ++ pr_value env v ++ spc () ++
+   strbrk "which cannot be coerced to " ++ str s ++ str".")
diff --git a/plugins/ltac/taccoerce.mli b/plugins/ltac/taccoerce.mli
new file mode 100644
index 00000000..1fa5e3c0
--- /dev/null
+++ b/plugins/ltac/taccoerce.mli
@@ -0,0 +1,113 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Util
+open Names
+open EConstr
+open Misctypes
+open Genarg
+open Geninterp
+
+(** Coercions from highest level generic arguments to actual data used by Ltac
+    interpretation. Those functions examinate dynamic types and try to return
+    something sensible according to the object content. *)
+
+exception CannotCoerceTo of string
+(** Exception raised whenever a coercion failed. *)
+
+(** {5 High-level access to values}
+
+  The [of_*] functions cast a given argument into a value. The [to_*] do the
+  converse, and return [None] if there is a type mismatch.
+
+*)
+
+module Value :
+sig
+  type t = Val.t
+
+  val of_constr : constr -> t
+  val to_constr : t -> 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
+  val to_option : t -> t option option
+  val to_pair : t -> (t * t) option
+  val cast : 'a typed_abstract_argument_type -> Geninterp.Val.t -> 'a
+end
+
+(** {5 Coercion functions} *)
+
+val coerce_to_constr_context : Value.t -> constr
+
+val coerce_var_to_ident : bool -> Environ.env -> Evd.evar_map -> Value.t -> Id.t
+
+val coerce_to_ident_not_fresh : Environ.env -> Evd.evar_map -> Value.t -> Id.t
+
+val coerce_to_intro_pattern : Environ.env -> Evd.evar_map -> Value.t -> Tacexpr.delayed_open_constr intro_pattern_expr
+
+val coerce_to_intro_pattern_naming :
+  Environ.env -> Evd.evar_map -> Value.t -> intro_pattern_naming_expr
+
+val coerce_to_hint_base : Value.t -> string
+
+val coerce_to_int : Value.t -> int
+
+val coerce_to_constr : Environ.env -> Value.t -> Ltac_pretype.constr_under_binders
+
+val coerce_to_uconstr : Environ.env -> Value.t -> Ltac_pretype.closed_glob_constr
+
+val coerce_to_closed_constr : Environ.env -> Value.t -> constr
+
+val coerce_to_evaluable_ref :
+  Environ.env -> Evd.evar_map -> Value.t -> evaluable_global_reference
+
+val coerce_to_constr_list : Environ.env -> Value.t -> constr list
+
+val coerce_to_intro_pattern_list :
+  ?loc:Loc.t -> Environ.env -> Evd.evar_map -> Value.t -> Tacexpr.intro_patterns
+
+val coerce_to_hyp : Environ.env -> Evd.evar_map -> Value.t -> Id.t
+
+val coerce_to_hyp_list : Environ.env -> Evd.evar_map -> Value.t -> Id.t list
+
+val coerce_to_reference : Environ.env -> Evd.evar_map -> Value.t -> Globnames.global_reference
+
+val coerce_to_quantified_hypothesis : Evd.evar_map -> Value.t -> quantified_hypothesis
+
+val coerce_to_decl_or_quant_hyp : Environ.env -> Evd.evar_map -> Value.t -> quantified_hypothesis
+
+val coerce_to_int_or_var_list : Value.t -> int or_var list
+
+(** {5 Missing generic arguments} *)
+
+val wit_constr_context : (Empty.t, Empty.t, EConstr.constr) genarg_type
+
+val wit_constr_under_binders : (Empty.t, Empty.t, Ltac_pretype.constr_under_binders) genarg_type
+
+val error_ltac_variable : ?loc:Loc.t -> Id.t ->
+  (Environ.env * Evd.evar_map) option -> Value.t -> string -> 'a
+
+(** Abstract application, to print ltac functions *)
+type appl =
+  | UnnamedAppl (** For generic applications: nothing is printed *)
+  | GlbAppl of (Names.KerName.t * Val.t list) list
+       (** For calls to global constants, some may alias other. *)
+
+type tacvalue =
+  | VFun of appl*Tacexpr.ltac_trace * Val.t Id.Map.t *
+      Name.t list * Tacexpr.glob_tactic_expr
+  | VRec of Val.t Id.Map.t ref * Tacexpr.glob_tactic_expr
+
+val wit_tacvalue : (Empty.t, tacvalue, tacvalue) Genarg.genarg_type
+
+val pr_value : (Environ.env * Evd.evar_map) option -> Geninterp.Val.t -> Pp.t
diff --git a/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index 673ac832..e510b9f5 100644
--- a/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -15,14 +17,13 @@ open Genarg
 open Extend
 open Pcoq
 open Egramml
-open Egramcoq
 open Vernacexpr
 open Libnames
 open Nameops
 
 type 'a grammar_tactic_prod_item_expr = 'a Pptactic.grammar_tactic_prod_item_expr =
 | TacTerm of string
-| TacNonTerm of Loc.t * 'a * Names.Id.t
+| TacNonTerm of ('a * Names.Id.t option) Loc.located
 
 type raw_argument = string * string option
 type argument = Genarg.ArgT.any Extend.user_symbol
@@ -43,8 +44,8 @@ let coincide s pat off =
   !break
 
 let atactic n =
-  if n = 5 then Aentry Tactic.binder_tactic
-  else Aentryl (Tactic.tactic_expr, n)
+  if n = 5 then Aentry Pltac.binder_tactic
+  else Aentryl (Pltac.tactic_expr, n)
 
 type entry_name = EntryName :
   'a raw_abstract_argument_type * (Tacexpr.raw_tactic_expr, 'a) Extend.symbol -> entry_name
@@ -56,41 +57,47 @@ let get_tacentry n m =
     && not (Int.equal m 5) (* Because tactic5 is at binder_tactic *)
     && not (Int.equal m 0) (* Because tactic0 is at simple_tactic *)
   in
-  if check_lvl n then EntryName (rawwit Constrarg.wit_tactic, Aself)
-  else if check_lvl (n + 1) then EntryName (rawwit Constrarg.wit_tactic, Anext)
-  else EntryName (rawwit Constrarg.wit_tactic, atactic n)
+  if check_lvl n then EntryName (rawwit Tacarg.wit_tactic, Aself)
+  else if check_lvl (n + 1) then EntryName (rawwit Tacarg.wit_tactic, Anext)
+  else EntryName (rawwit Tacarg.wit_tactic, atactic n)
 
 let get_separator = function
-| None -> error "Missing separator."
+| 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 arg_list = function Rawwit t -> Rawwit (ListArg t)
-let arg_opt = function Rawwit t -> Rawwit (OptArg t)
-
 let interp_entry_name interp symb =
   let rec eval = function
   | Ulist1 e -> Ulist1 (eval e)
@@ -108,13 +115,13 @@ let interp_entry_name interp symb =
 
 let get_tactic_entry n =
   if Int.equal n 0 then
-    Tactic.simple_tactic, None
+    Pltac.simple_tactic, None
   else if Int.equal n 5 then
-    Tactic.binder_tactic, None
+    Pltac.binder_tactic, None
   else if 1<=n && n<5 then
-    Tactic.tactic_expr, Some (Extend.Level (string_of_int n))
+    Pltac.tactic_expr, Some (Extend.Level (string_of_int n))
   else
-    error ("Invalid Tactic Notation level: "^(string_of_int n)^".")
+    user_err Pp.(str ("Invalid Tactic Notation level: "^(string_of_int n)^"."))
 
 (**********************************************************************)
 (** State of the grammar extensions                                   *)
@@ -163,24 +170,24 @@ let add_tactic_entry (kn, ml, tg) state =
   let mkact loc l =
     let map arg =
       (** HACK to handle especially the tactic(...) entry *)
-      let wit = Genarg.rawwit Constrarg.wit_tactic in
+      let wit = Genarg.rawwit Tacarg.wit_tactic in
       if Genarg.has_type arg wit && not ml then
         Tacexp (Genarg.out_gen wit arg)
       else
         TacGeneric arg
     in
     let l = List.map map l in
-    (TacAlias (loc,kn,l):raw_tactic_expr)
+    (TacAlias (Loc.tag ~loc (kn,l)):raw_tactic_expr)
   in
   let () =
     if Int.equal tg.tacgram_level 0 && not (head_is_ident tg) then
-      error "Notation for simple tactic must start with an identifier."
+      user_err Pp.(str "Notation for simple tactic must start with an identifier.")
   in
   let map = function
   | TacTerm s -> GramTerminal s
-  | TacNonTerm (loc, s, _) ->
+  | TacNonTerm (loc, (s, ido)) ->
     let EntryName (typ, e) = prod_item_of_symbol tg.tacgram_level s in
-    GramNonTerminal (loc, typ, e)
+    GramNonTerminal (Loc.tag ?loc @@ (Option.map (fun _ -> typ) ido, e))
   in
   let prods = List.map map tg.tacgram_prods in
   let rules = make_rule mkact prods in
@@ -206,25 +213,24 @@ let register_tactic_notation_entry name entry =
 
 let interp_prod_item = function
   | TacTerm s -> TacTerm s
-  | TacNonTerm (loc, (nt, sep), id) ->
-    let symbol = parse_user_entry nt sep in
+  | TacNonTerm (loc, ((nt, sep), ido)) ->
+    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
       else begin match ArgT.name s with
-      | None -> error ("Unknown entry "^s^".")
+      | None -> user_err Pp.(str ("Unknown entry "^s^"."))
       | Some arg -> arg
       end
     | Some n ->
       (** FIXME: do better someday *)
       assert (String.equal s "tactic");
-      begin match Constrarg.wit_tactic with
+      begin match Tacarg.wit_tactic with
       | ExtraArg tag -> ArgT.Any tag
-      | _ -> assert false
       end
     in
     let symbol = interp_entry_name interp symbol in
-    TacNonTerm (loc, symbol, id)
+    TacNonTerm (loc, (symbol, ido))
 
 let make_fresh_key =
   let id = Summary.ref ~name:"TACTIC-NOTATION-COUNTER" 0 in
@@ -257,8 +263,8 @@ let pprule pa = {
 
 let check_key key =
   if Tacenv.check_alias key then
-    error "Conflicting tactic notations keys. This can happen when including \
-    twice the same module."
+    user_err Pp.(str "Conflicting tactic notations keys. This can happen when including \
+    twice the same module.")
 
 let cache_tactic_notation (_, tobj) =
   let key = tobj.tacobj_key in
@@ -300,11 +306,11 @@ let inTacticGrammar : tactic_grammar_obj -> obj =
 
 let cons_production_parameter = function
 | TacTerm _ -> None
-| TacNonTerm (_, _, id) -> Some id
+| TacNonTerm (_, (_, ido)) -> ido
 
-let add_glob_tactic_notation local n prods forml ids tac =
+let add_glob_tactic_notation local ~level prods forml ids tac =
   let parule = {
-    tacgram_level = n;
+    tacgram_level = level;
     tacgram_prods = prods;
   } in
   let tacobj = {
@@ -320,7 +326,7 @@ let add_tactic_notation local n prods e =
   let ids = List.map_filter cons_production_parameter prods in
   let prods = List.map interp_prod_item prods in
   let tac = Tacintern.glob_tactic_env ids (Global.env()) e in
-  add_glob_tactic_notation local n prods false ids tac
+  add_glob_tactic_notation local ~level:n prods false ids tac
 
 (**********************************************************************)
 (* ML Tactic entries                                                  *)
@@ -338,10 +344,10 @@ let extend_atomic_tactic name entries =
     in
     let empty_value = function
     | TacTerm s -> raise NonEmptyArgument
-    | TacNonTerm (_, symb, _) ->
+    | TacNonTerm (_, (symb, _)) ->
       let EntryName (typ, e) = prod_item_of_symbol 0 symb in
       let Genarg.Rawwit wit = typ in
-      let inj x = TacArg (Loc.ghost, TacGeneric (Genarg.in_gen typ x)) in
+      let inj x = TacArg (Loc.tag @@ TacGeneric (Genarg.in_gen typ x)) in
       let default = epsilon_value inj e in
       match default with
       | None -> raise NonEmptyArgument
@@ -355,27 +361,29 @@ let extend_atomic_tactic name entries =
   | Some (id, args) ->
     let args = List.map (fun a -> Tacexp a) args in
     let entry = { mltac_name = name; mltac_index = i } in
-    let body = TacML (Loc.ghost, entry, args) in
+    let body = TacML (Loc.tag (entry, args)) in
     Tacenv.register_ltac false false (Names.Id.of_string id) body
   in
   List.iteri add_atomic entries
 
-let add_ml_tactic_notation name prods =
+let add_ml_tactic_notation name ~level prods =
   let len = List.length prods in
   let iter i prods =
     let open Tacexpr in
     let get_id = function
     | TacTerm s -> None
-    | TacNonTerm (_, _, id) -> Some id
+    | TacNonTerm (_, (_, ido)) -> ido
     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.ghost, id)) in
-    let tac = TacML (Loc.ghost, entry, List.map map ids) in
-    add_glob_tactic_notation false 0 prods true ids tac
+    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
   List.iteri iter (List.rev prods);
-  extend_atomic_tactic name prods
+  (** We call [extend_atomic_tactic] only for "basic tactics" (the ones at
+  tactic_expr level 0) *)
+  if Int.equal level 0 then extend_atomic_tactic name prods
 
 (**********************************************************************)
 (** Ltac quotations                                                   *)
@@ -403,51 +411,50 @@ let create_ltac_quotation name cast (e, l) =
       entry),
       Atoken (CLexer.terminal ")"))
   in
-  let action _ v _ _ _ loc = cast (loc, v) in
+  let action _ v _ _ _ loc = cast (Some loc, v) in
   let gram = (level, assoc, [Rule (rule, action)]) in
-  Pcoq.grammar_extend Tactic.tactic_arg None (None, [gram])
+  Pcoq.grammar_extend Pltac.tactic_arg None (None, [gram])
 
 (** Command *)
 
 
 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
 
 let warn_unusable_identifier =
   CWarnings.create ~name:"unusable-identifier" ~category:"parsing"
-      (fun id -> strbrk "The Ltac name" ++ spc () ++ pr_id id ++ spc () ++
+      (fun id -> strbrk "The Ltac name" ++ spc () ++ Id.print id ++ spc () ++
         strbrk "may be unusable because of a conflict with a notation.")
 
 let register_ltac local tacl =
   let map tactic_body =
     match tactic_body with
-    | TacticDefinition ((loc,id), body) ->
+    | Tacexpr.TacticDefinition ({CAst.loc;v=id}, body) ->
         let kn = Lib.make_kn id in
-        let id_pp = pr_id id in
+        let id_pp = Id.print id in
         let () = if is_defined_tac kn then
-          CErrors.user_err_loc (loc, "",
-            str "There is already an Ltac named " ++ id_pp ++ str".")
+          CErrors.user_err ?loc
+            (str "There is already an Ltac named " ++ id_pp ++ str".")
         in
         let is_shadowed =
           try
-            match Pcoq.parse_string Pcoq.Tactic.tactic (Id.to_string id) with
+            match Pcoq.parse_string Pltac.tactic (Id.to_string id) with
             | Tacexpr.TacArg _ -> false
             | _ -> true (* most probably TacAtom, i.e. a primitive tactic ident *)
           with e when CErrors.noncritical e -> true (* prim tactics with args, e.g. "apply" *)
         in
         let () = if is_shadowed then warn_unusable_identifier id in
         NewTac id, body
-    | TacticRedefinition (ident, body) ->
-        let loc = loc_of_reference ident in
+    | Tacexpr.TacticRedefinition (ident, body) ->
         let kn =
-          try Nametab.locate_tactic (snd (qualid_of_reference ident))
+          try Tacenv.locate_tactic (qualid_of_reference ident).CAst.v
           with Not_found ->
-            CErrors.user_err_loc (loc, "",
-                        str "There is no Ltac named " ++ pr_reference ident ++ str ".")
+            CErrors.user_err ?loc:ident.CAst.loc
+                       (str "There is no Ltac named " ++ pr_reference ident ++ str ".")
         in
         UpdateTac kn, body
   in
@@ -467,18 +474,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 (Nameops.pr_id id ++ str " is defined")
+    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
@@ -491,7 +500,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
@@ -504,10 +513,178 @@ let print_ltacs () =
     | Tacexpr.TacFun (l, t) -> (l, t)
     | _ -> ([], body)
     in
-    let pr_ltac_fun_arg = function
-    | None -> spc () ++ str "_"
-    | Some id -> spc () ++ pr_id id
-    in
+    let pr_ltac_fun_arg n = spc () ++ Name.print n in
     hov 2 (pr_qualid qid ++ prlist pr_ltac_fun_arg l)
   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 entries = [
+    AnyEntry Pltac.tactic_expr;
+    AnyEntry Pltac.binder_tactic;
+    AnyEntry Pltac.simple_tactic;
+    AnyEntry Pltac.tactic_arg;
+  ] in
+  register_grammars_by_name "tactic" entries
+
+type _ ty_sig =
+| TyNil : (Geninterp.interp_sign -> unit Proofview.tactic) ty_sig
+| TyIdent : string * 'r ty_sig -> 'r ty_sig
+| TyArg :
+  (('a, 'b, 'c) Extend.ty_user_symbol * Id.t) Loc.located * 'r ty_sig -> ('c -> 'r) ty_sig
+| TyAnonArg :
+  ('a, 'b, 'c) Extend.ty_user_symbol Loc.located * 'r ty_sig -> 'r ty_sig
+
+type ty_ml = TyML : 'r ty_sig * 'r -> ty_ml
+
+let rec untype_user_symbol : type a b c. (a,b,c) ty_user_symbol -> Genarg.ArgT.any user_symbol = fun tu ->
+  match tu with
+  | TUlist1 l -> Ulist1(untype_user_symbol l)
+  | TUlist1sep(l,s) -> Ulist1sep(untype_user_symbol l, s)
+  | TUlist0 l -> Ulist0(untype_user_symbol l)
+  | TUlist0sep(l,s) -> Ulist0sep(untype_user_symbol l, s)
+  | TUopt(o) -> Uopt(untype_user_symbol o)
+  | TUentry a -> Uentry (Genarg.ArgT.Any a)
+  | TUentryl (a,i) -> Uentryl (Genarg.ArgT.Any a,i)
+
+let rec clause_of_sign : type a. a ty_sig -> Genarg.ArgT.any Extend.user_symbol grammar_tactic_prod_item_expr list =
+  fun sign -> match sign with
+  | TyNil -> []
+  | TyIdent (s, sig') -> TacTerm s :: clause_of_sign sig'
+  | TyArg ((loc,(a,id)),sig') ->
+    TacNonTerm (loc,(untype_user_symbol a,Some id)) :: clause_of_sign sig'
+  | TyAnonArg ((loc,a),sig') ->
+    TacNonTerm (loc,(untype_user_symbol a,None)) :: clause_of_sign sig'
+
+let clause_of_ty_ml = function
+  | TyML (t,_) -> clause_of_sign t
+
+let rec prj : type a b c. (a,b,c) Extend.ty_user_symbol -> (a,b,c) genarg_type = function
+  | TUentry a -> ExtraArg a
+  | TUentryl (a,l) -> ExtraArg a
+  | TUopt(o) -> OptArg (prj o)
+  | TUlist1 l -> ListArg (prj l)
+  | TUlist1sep (l,_) -> ListArg (prj l)
+  | TUlist0 l -> ListArg (prj l)
+  | TUlist0sep (l,_) -> ListArg (prj l)
+
+let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic =
+  fun sign tac ->
+    match sign with
+    | TyNil ->
+      begin fun vals ist -> match vals with
+      | [] -> tac ist
+      | _ :: _ -> assert false
+      end
+    | TyIdent (s, sig') -> eval_sign sig' tac
+    | TyArg ((_loc,(a,id)), sig') ->
+      let f = eval_sign sig' in
+      begin fun tac vals ist -> match vals with
+      | [] -> assert false
+      | v :: vals ->
+        let v' = Taccoerce.Value.cast (topwit (prj a)) v in
+        f (tac v') vals ist
+      end tac
+    | TyAnonArg ((_loc,a), sig') -> eval_sign sig' tac
+
+let eval : ty_ml -> Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic = function
+  | TyML (t,tac) -> eval_sign t tac
+
+let is_constr_entry = function
+| TUentry a -> Option.has_some @@ genarg_type_eq (ExtraArg a) Stdarg.wit_constr
+| _ -> false
+
+let rec only_constr : type a. a ty_sig -> bool = function
+| TyNil -> true
+| TyIdent(_,_) -> false
+| TyArg((_,(u,_)),s) -> if is_constr_entry u then only_constr s else false
+| TyAnonArg((_,u),s) -> if is_constr_entry u then only_constr s else false
+
+let rec mk_sign_vars : type a. a ty_sig -> Name.t list = function
+| TyNil -> []
+| TyIdent (_,s) -> mk_sign_vars s
+| TyArg((_,(_,name)),s) -> Name name :: mk_sign_vars s
+| TyAnonArg((_,_),s) -> Anonymous :: mk_sign_vars s
+
+let dummy_id = Id.of_string "_"
+
+let lift_constr_tac_to_ml_tac vars tac =
+  let tac _ ist = Proofview.Goal.enter begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let sigma = Tacmach.New.project gl in
+    let map = function
+    | Anonymous -> None
+    | Name id ->
+      let c = Id.Map.find id ist.Geninterp.lfun in
+      try Some (Taccoerce.Value.of_constr @@ Taccoerce.coerce_to_closed_constr env c)
+      with Taccoerce.CannotCoerceTo ty ->
+        Taccoerce.error_ltac_variable dummy_id (Some (env,sigma)) c ty
+    in
+    let args = List.map_filter map vars in
+    tac args ist
+  end in
+  tac
+
+let tactic_extend plugin_name tacname ~level sign =
+  let open Tacexpr in
+  let ml_tactic_name =
+    { mltac_tactic = tacname;
+      mltac_plugin = plugin_name }
+  in
+  match sign with
+  | [TyML (TyIdent (name, s),tac) as ml_tac] when only_constr s ->
+  (** 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
+    let vars = List.map make_var rem in
+    let vars = mlexpr_of_list (mlexpr_of_name mlexpr_of_ident) vars in
+       *)
+    let vars = mk_sign_vars s in
+    let ml = { Tacexpr.mltac_name = ml_tactic_name; Tacexpr.mltac_index = 0 } in
+    let tac = match s with
+    | TyNil -> eval ml_tac
+    (** Special handling of tactics without arguments: such tactics do not do
+        a Proofview.Goal.nf_enter to compute their arguments. It matters for some
+        whole-prof tactics like [shelve_unifiable]. *)
+    | _ -> lift_constr_tac_to_ml_tac vars (eval ml_tac)
+    in
+  (** Arguments are not passed directly to the ML tactic in the TacML node,
+      the ML tactic retrieves its arguments in the [ist] environment instead.
+      This is the rôle of the [lift_constr_tac_to_ml_tac] function. *)
+    let body = Tacexpr.TacFun (vars, Tacexpr.TacML (Loc.tag (ml, [])))in
+    let id = Names.Id.of_string name in
+    let obj () = Tacenv.register_ltac true false id body in
+    let () = Tacenv.register_ml_tactic ml_tactic_name [|tac|] in
+    Mltop.declare_cache_obj obj plugin_name
+  | _ ->
+  let obj () = add_ml_tactic_notation ml_tactic_name ~level (List.map clause_of_ty_ml sign) in
+  Tacenv.register_ml_tactic ml_tactic_name @@ Array.of_list (List.map eval sign);
+  Mltop.declare_cache_obj obj plugin_name
diff --git a/ltac/tacentries.mli b/plugins/ltac/tacentries.mli
index 27df819e..3f804ee8 100644
--- a/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Ltac toplevel command entries. *)
@@ -13,14 +15,14 @@ open Tacexpr
 
 (** {5 Tactic Definitions} *)
 
-val register_ltac : locality_flag -> Vernacexpr.tacdef_body list -> unit
+val register_ltac : locality_flag -> Tacexpr.tacdef_body list -> unit
 (** Adds new Ltac definitions to the environment. *)
 
 (** {5 Tactic Notations} *)
 
 type 'a grammar_tactic_prod_item_expr = 'a Pptactic.grammar_tactic_prod_item_expr =
 | TacTerm of string
-| TacNonTerm of Loc.t * 'a * Names.Id.t
+| TacNonTerm of ('a * Names.Id.t option) Loc.located
 
 type raw_argument = string * string option
 (** An argument type as provided in Tactic notations, i.e. a string like
@@ -45,7 +47,7 @@ val register_tactic_notation_entry : string -> ('a, 'b, 'c) Genarg.genarg_type -
     to finding an argument by name (as in {!Genarg}) if there is none
     matching. *)
 
-val add_ml_tactic_notation : ml_tactic_name ->
+val add_ml_tactic_notation : ml_tactic_name -> level:int ->
   argument grammar_tactic_prod_item_expr list list -> unit
 (** A low-level variant of {!add_tactic_notation} used by the TACTIC EXTEND
     ML-side macro. *)
@@ -62,3 +64,18 @@ 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. *)
+
+type _ ty_sig =
+| TyNil : (Geninterp.interp_sign -> unit Proofview.tactic) ty_sig
+| TyIdent : string * 'r ty_sig -> 'r ty_sig
+| TyArg :
+  (('a, 'b, 'c) Extend.ty_user_symbol * Names.Id.t) Loc.located * 'r ty_sig -> ('c -> 'r) ty_sig
+| TyAnonArg :
+  ('a, 'b, 'c) Extend.ty_user_symbol Loc.located * 'r ty_sig -> 'r ty_sig
+
+type ty_ml = TyML : 'r ty_sig * 'r -> ty_ml
+
+val tactic_extend : string -> string -> level:Int.t -> ty_ml list -> unit
diff --git a/ltac/tacenv.ml b/plugins/ltac/tacenv.ml
index c709ab11..d5ab2d69 100644
--- a/ltac/tacenv.ml
+++ b/plugins/ltac/tacenv.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -11,6 +13,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
@@ -24,7 +62,7 @@ let register_alias key tac =
 
 let interp_alias key =
   try KNmap.find key !alias_map
-  with Not_found -> CErrors.anomaly (str "Unknown tactic alias: " ++ KerName.print key)
+  with Not_found -> CErrors.anomaly (str "Unknown tactic alias: " ++ KerName.print key ++ str ".")
 
 let check_alias key = KNmap.mem key !alias_map
 
@@ -65,7 +103,7 @@ let interp_ml_tactic { mltac_name = s; mltac_index = i } =
     let () = if Array.length tacs <= i then raise Not_found in
     tacs.(i)
   with Not_found ->
-    CErrors.errorlabstrm ""
+    CErrors.user_err 
       (str "The tactic " ++ pr_tacname s ++ str " is not installed.")
 
 (***************************************************************************)
@@ -103,19 +141,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 +166,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/ltac/tacenv.mli b/plugins/ltac/tacenv.mli
index 94e14223..e0bac67d 100644
--- a/ltac/tacenv.mli
+++ b/plugins/ltac/tacenv.mli
@@ -1,18 +1,29 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Genarg
 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
@@ -25,7 +36,7 @@ val register_alias : alias -> alias_tactic -> unit
 (** Register a tactic alias. *)
 
 val interp_alias : alias -> alias_tactic
-(** Recover the the body of an alias. Raises an anomaly if it does not exist. *)
+(** Recover the body of an alias. Raises an anomaly if it does not exist. *)
 
 val check_alias : alias -> bool
 (** Returns [true] if an alias is defined, false otherwise. *)
diff --git a/plugins/ltac/tacexpr.ml b/plugins/ltac/tacexpr.ml
new file mode 100644
index 00000000..8b0c4404
--- /dev/null
+++ b/plugins/ltac/tacexpr.ml
@@ -0,0 +1,397 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Loc
+open Names
+open Constrexpr
+open Libnames
+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 *)
+  | Select  (* returns all successes of the first matching branch *)
+  | Once    (* returns the first success in a maching branch
+               (not necessarily the first) *)
+type global_flag = (* [gfail] or [fail] *)
+  | TacGlobal
+  | TacLocal
+type evars_flag = bool     (* true = pose evars       false = fail on evars *)
+type rec_flag = bool       (* true = recursive        false = not recursive *)
+type advanced_flag = bool  (* true = advanced         false = basic *)
+type letin_flag = bool     (* true = use local def    false = use Leibniz *)
+type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *)
+
+type goal_selector = Vernacexpr.goal_selector =
+  | SelectNth of int
+  | SelectList of (int * int) list
+  | SelectId of Id.t
+  | SelectAll
+
+type 'a core_destruction_arg = 'a Misctypes.core_destruction_arg =
+  | ElimOnConstr of 'a
+  | ElimOnIdent of lident
+  | ElimOnAnonHyp of int
+
+type 'a destruction_arg =
+  clear_flag * 'a core_destruction_arg
+
+type inversion_kind = Misctypes.inversion_kind =
+  | SimpleInversion
+  | FullInversion
+  | FullInversionClear
+
+type ('c,'d,'id) inversion_strength =
+  | NonDepInversion of
+      inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option
+  | DepInversion of
+      inversion_kind * 'c option * 'd or_and_intro_pattern_expr CAst.t or_var option
+  | InversionUsing of 'c * 'id list
+
+type ('a,'b) location = HypLocation of 'a | ConclLocation of 'b
+
+type 'id message_token =
+  | MsgString of string
+  | MsgInt of int
+  | MsgIdent of 'id
+
+type ('dconstr,'id) induction_clause =
+    'dconstr with_bindings destruction_arg *
+    (intro_pattern_naming_expr CAst.t option (* eqn:... *)
+    * 'dconstr or_and_intro_pattern_expr CAst.t or_var option) (* as ... *)
+    * 'id clause_expr option (* in ... *)
+
+type ('constr,'dconstr,'id) induction_clause_list =
+    ('dconstr,'id) induction_clause list
+    * 'constr with_bindings option (* using ... *)
+
+type 'a with_bindings_arg = clear_flag * 'a with_bindings
+
+(* Type of patterns *)
+type 'a match_pattern =
+  | Term of 'a
+  | Subterm of Id.t option * 'a
+
+(* Type of hypotheses for a Match Context rule *)
+type 'a match_context_hyps =
+  | 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 =
+  | Pat of 'a match_context_hyps list * 'a match_pattern * 't
+  | All of 't
+
+(** Extension indentifiers for the TACTIC EXTEND mechanism. *)
+type ml_tactic_name = {
+  (** Name of the plugin where the tactic is defined, typically coming from a
+      DECLARE PLUGIN statement in the source. *)
+  mltac_plugin : string;
+  (** Name of the tactic entry where the tactic is defined, typically found
+      after the TACTIC EXTEND statement in the source. *)
+  mltac_tactic : string;
+}
+
+type ml_tactic_entry = {
+  mltac_name : ml_tactic_name;
+  mltac_index : int;
+}
+
+(** Composite types *)
+
+type glob_constr_and_expr = Tactypes.glob_constr_and_expr
+
+type open_constr_expr = unit * constr_expr
+type open_glob_constr = unit * glob_constr_and_expr
+
+type binding_bound_vars = Constr_matching.binding_bound_vars
+type glob_constr_pattern_and_expr = binding_bound_vars * glob_constr_and_expr * constr_pattern
+
+type 'a delayed_open = Environ.env -> Evd.evar_map -> Evd.evar_map * 'a
+
+type delayed_open_constr_with_bindings = EConstr.constr with_bindings delayed_open
+
+type delayed_open_constr = EConstr.constr delayed_open
+
+type intro_pattern = delayed_open_constr intro_pattern_expr CAst.t
+type intro_patterns = delayed_open_constr intro_pattern_expr CAst.t list
+type or_and_intro_pattern = delayed_open_constr or_and_intro_pattern_expr CAst.t
+type intro_pattern_naming = intro_pattern_naming_expr CAst.t
+
+(** Generic expressions for atomic tactics *)
+
+type 'a gen_atomic_tactic_expr =
+  (* Basic tactics *)
+  | TacIntroPattern of evars_flag * 'dtrm intro_pattern_expr CAst.t list
+  | TacApply of advanced_flag * evars_flag * 'trm with_bindings_arg list *
+      ('nam * 'dtrm intro_pattern_expr CAst.t option) option
+  | TacElim of evars_flag * 'trm with_bindings_arg * 'trm with_bindings option
+  | TacCase of evars_flag * 'trm with_bindings_arg
+  | TacMutualFix of Id.t * int * (Id.t * int * 'trm) list
+  | TacMutualCofix of Id.t * (Id.t * 'trm) list
+  | TacAssert of
+      evars_flag * bool * 'tacexpr option option *
+      'dtrm intro_pattern_expr CAst.t option * 'trm
+  | TacGeneralize of ('trm with_occurrences * Name.t) list
+  | TacLetTac of evars_flag * Name.t * 'trm * 'nam clause_expr * letin_flag *
+      intro_pattern_naming_expr CAst.t option
+
+  (* Derived basic tactics *)
+  | TacInductionDestruct of
+      rec_flag * evars_flag * ('trm,'dtrm,'nam) induction_clause_list
+
+  (* Conversion *)
+  | TacReduce of ('trm,'cst,'pat) red_expr_gen * 'nam clause_expr
+  | TacChange of 'pat option * 'dtrm * 'nam clause_expr
+
+  (* Equality and inversion *)
+  | TacRewrite of evars_flag *
+      (bool * multi * 'dtrm with_bindings_arg) list * 'nam clause_expr *
+      (* spiwack: using ['dtrm] here is a small hack, may not be
+         stable by a change in the representation of delayed
+         terms. Because, in fact, it is the whole "with_bindings"
+         which is delayed. But because the "t" level for ['dtrm] is
+         uninterpreted, it works fine here too, and avoid more
+         disruption of this file. *)
+      'tacexpr option
+  | TacInversion of ('trm,'dtrm,'nam) inversion_strength * quantified_hypothesis
+
+constraint 'a = <
+    term:'trm;
+    dterm: 'dtrm;
+    pattern:'pat;
+    constant:'cst;
+    reference:'ref;
+    name:'nam;
+    tacexpr:'tacexpr;
+    level:'lev
+>
+
+(** Possible arguments of a tactic definition *)
+
+type 'a gen_tactic_arg =
+  | TacGeneric     of 'lev generic_argument
+  | ConstrMayEval  of ('trm,'cst,'pat) may_eval
+  | Reference      of 'ref
+  | TacCall    of ('ref * 'a gen_tactic_arg list) Loc.located
+  | TacFreshId of string or_var list
+  | Tacexp of 'tacexpr
+  | TacPretype of 'trm
+  | TacNumgoals
+
+constraint 'a = <
+    term:'trm;
+    dterm: 'dtrm;
+    pattern:'pat;
+    constant:'cst;
+    reference:'ref;
+    name:'nam;
+    tacexpr:'tacexpr;
+    level:'lev
+>
+
+(** Generic ltac expressions.
+    't : terms, 'p : patterns, 'c : constants, 'i : inductive,
+    'r : ltac refs, 'n : idents, 'l : levels *)
+
+and 'a gen_tactic_expr =
+  | TacAtom of ('a gen_atomic_tactic_expr) Loc.located
+  | TacThen of
+      'a gen_tactic_expr *
+      'a gen_tactic_expr
+  | TacDispatch of
+      'a gen_tactic_expr list
+  | TacExtendTac of
+      'a gen_tactic_expr array *
+      'a gen_tactic_expr *
+      'a gen_tactic_expr array
+  | TacThens of
+      'a gen_tactic_expr *
+      'a gen_tactic_expr list
+  | TacThens3parts of
+      'a gen_tactic_expr *
+      'a gen_tactic_expr array *
+      'a gen_tactic_expr *
+      'a gen_tactic_expr array
+  | TacFirst of 'a gen_tactic_expr list
+  | TacComplete of 'a gen_tactic_expr
+  | TacSolve of 'a gen_tactic_expr list
+  | TacTry of 'a gen_tactic_expr
+  | TacOr of
+      'a gen_tactic_expr *
+      'a gen_tactic_expr
+  | TacOnce of
+      'a gen_tactic_expr
+  | TacExactlyOnce of
+      'a gen_tactic_expr
+  | TacIfThenCatch of
+      'a gen_tactic_expr *
+      'a gen_tactic_expr *
+      'a gen_tactic_expr
+  | TacOrelse of
+      'a gen_tactic_expr *
+      'a gen_tactic_expr
+  | TacDo of int or_var * 'a gen_tactic_expr
+  | TacTimeout of int or_var * 'a gen_tactic_expr
+  | TacTime of string option * 'a gen_tactic_expr
+  | TacRepeat of 'a gen_tactic_expr
+  | TacProgress of 'a gen_tactic_expr
+  | TacShowHyps of 'a gen_tactic_expr
+  | TacAbstract of
+      'a gen_tactic_expr * Id.t option
+  | TacId of 'n message_token list
+  | TacFail of global_flag * int or_var * 'n message_token list
+  | TacInfo of 'a gen_tactic_expr
+  | TacLetIn of rec_flag *
+      (lname * 'a gen_tactic_arg) list *
+      'a gen_tactic_expr
+  | TacMatch of lazy_flag *
+      'a gen_tactic_expr *
+      ('p,'a gen_tactic_expr) match_rule list
+  | TacMatchGoal of lazy_flag * direction_flag *
+      ('p,'a gen_tactic_expr) match_rule list
+  | TacFun of 'a gen_tactic_fun_ast
+  | TacArg of 'a gen_tactic_arg located
+  | TacSelect of goal_selector * 'a gen_tactic_expr
+  (* For ML extensions *)
+  | TacML of (ml_tactic_entry * 'a gen_tactic_arg list) Loc.located
+  (* For syntax extensions *)
+  | TacAlias of (KerName.t * 'a gen_tactic_arg list) Loc.located
+
+constraint 'a = <
+    term:'t;
+    dterm: 'dtrm;
+    pattern:'p;
+    constant:'c;
+    reference:'r;
+    name:'n;
+    tacexpr:'tacexpr;
+    level:'l
+>
+
+and 'a gen_tactic_fun_ast =
+    Name.t list * 'a gen_tactic_expr
+
+constraint 'a = <
+    term:'t;
+    dterm: 'dtrm;
+    pattern:'p;
+    constant:'c;
+    reference:'r;
+    name:'n;
+    tacexpr:'te;
+    level:'l
+>
+
+(** Globalized tactics *)
+
+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 = lident
+
+type g_dispatch =  <
+    term:g_trm;
+    dterm:g_trm;
+    pattern:g_pat;
+    constant:g_cst;
+    reference:g_ref;
+    name:g_nam;
+    tacexpr:glob_tactic_expr;
+    level:glevel
+>
+
+and glob_tactic_expr =
+    g_dispatch gen_tactic_expr
+
+type glob_atomic_tactic_expr =
+    g_dispatch gen_atomic_tactic_expr
+
+type glob_tactic_arg =
+    g_dispatch gen_tactic_arg
+
+(** Raw tactics *)
+
+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 = lident
+type r_lev = rlevel
+
+type r_dispatch =  <
+    term:r_trm;
+    dterm:r_trm;
+    pattern:r_pat;
+    constant:r_cst;
+    reference:r_ref;
+    name:r_nam;
+    tacexpr:raw_tactic_expr;
+    level:rlevel
+>
+
+and raw_tactic_expr =
+    r_dispatch gen_tactic_expr
+
+type raw_atomic_tactic_expr =
+    r_dispatch gen_atomic_tactic_expr
+
+type raw_tactic_arg =
+    r_dispatch gen_tactic_arg
+
+(** Interpreted tactics *)
+
+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_dispatch =  <
+    term:t_trm;
+    dterm:g_trm;
+    pattern:t_pat;
+    constant:t_cst;
+    reference:t_ref;
+    name:t_nam;
+    tacexpr:unit;
+    level:tlevel
+>
+
+type atomic_tactic_expr =
+    t_dispatch gen_atomic_tactic_expr
+
+(** Misc *)
+
+type raw_red_expr = (r_trm, r_cst, r_pat) red_expr_gen
+type glob_red_expr = (g_trm, g_cst, g_pat) red_expr_gen
+
+(** Traces *)
+
+type ltac_call_kind =
+  | LtacMLCall of glob_tactic_expr
+  | LtacNotationCall of KerName.t
+  | LtacNameCall of ltac_constant
+  | LtacAtomCall of glob_atomic_tactic_expr
+  | LtacVarCall of Id.t * glob_tactic_expr
+  | 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 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/intf/tacexpr.mli b/plugins/ltac/tacexpr.mli
index 5b5957be..8b0c4404 100644
--- a/intf/tacexpr.mli
+++ b/plugins/ltac/tacexpr.mli
@@ -1,22 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 *)
@@ -32,32 +35,30 @@ type advanced_flag = bool  (* true = advanced         false = basic *)
 type letin_flag = bool     (* true = use local def    false = use Leibniz *)
 type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *)
 
-type debug = Debug | Info | Off (* for trivial / auto / eauto ... *)
-
-type goal_selector =
+type goal_selector = Vernacexpr.goal_selector =
   | SelectNth of int
   | SelectList of (int * int) list
   | SelectId of Id.t
   | SelectAll
 
-type 'a core_destruction_arg =
+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 =
   clear_flag * 'a core_destruction_arg
 
-type inversion_kind =
+type inversion_kind = Misctypes.inversion_kind =
   | SimpleInversion
   | FullInversion
   | FullInversionClear
 
 type ('c,'d,'id) inversion_strength =
   | NonDepInversion of
-      inversion_kind * 'id list * 'd or_and_intro_pattern_expr located or_var option
+      inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option
   | DepInversion of
-      inversion_kind * 'c option * 'd or_and_intro_pattern_expr located or_var option
+      inversion_kind * 'c option * 'd or_and_intro_pattern_expr CAst.t or_var option
   | InversionUsing of 'c * 'id list
 
 type ('a,'b) location = HypLocation of 'a | ConclLocation of 'b
@@ -69,8 +70,8 @@ type 'id message_token =
 
 type ('dconstr,'id) induction_clause =
     'dconstr with_bindings destruction_arg *
-    (intro_pattern_naming_expr located option (* eqn:... *)
-    * 'dconstr or_and_intro_pattern_expr located or_var option) (* as ... *)
+    (intro_pattern_naming_expr CAst.t option (* eqn:... *)
+    * 'dconstr or_and_intro_pattern_expr CAst.t or_var option) (* as ... *)
     * 'id clause_expr option (* in ... *)
 
 type ('constr,'dconstr,'id) induction_clause_list =
@@ -79,21 +80,15 @@ type ('constr,'dconstr,'id) induction_clause_list =
 
 type 'a with_bindings_arg = clear_flag * 'a with_bindings
 
-type multi =
-  | Precisely of int
-  | UpTo of int
-  | RepeatStar
-  | RepeatPlus
-
 (* Type of patterns *)
 type 'a match_pattern =
   | Term of 'a
-  | 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 =
@@ -117,46 +112,42 @@ type ml_tactic_entry = {
 
 (** Composite types *)
 
-(** In globalize tactics, we need to keep the initial [constr_expr] to recompute
-   in the environment by the effective calls to Intro, Inversion, etc 
-   The [constr_expr] field is [None] in TacDef though *)
-type glob_constr_and_expr = Glob_term.glob_constr * constr_expr option
+type glob_constr_and_expr = Tactypes.glob_constr_and_expr
 
 type open_constr_expr = unit * constr_expr
 type open_glob_constr = unit * glob_constr_and_expr
 
-type binding_bound_vars = Id.Set.t
+type binding_bound_vars = Constr_matching.binding_bound_vars
 type glob_constr_pattern_and_expr = binding_bound_vars * glob_constr_and_expr * constr_pattern
 
-type 'a delayed_open = 'a Pretyping.delayed_open =
-  { delayed : 'r. Environ.env -> 'r Sigma.t -> ('a, 'r) Sigma.sigma }
+type 'a delayed_open = Environ.env -> Evd.evar_map -> Evd.evar_map * 'a
 
-type delayed_open_constr_with_bindings = Term.constr with_bindings delayed_open
+type delayed_open_constr_with_bindings = EConstr.constr with_bindings delayed_open
 
-type delayed_open_constr = Term.constr delayed_open
+type delayed_open_constr = EConstr.constr delayed_open
 
-type intro_pattern = delayed_open_constr intro_pattern_expr located
-type intro_patterns = delayed_open_constr intro_pattern_expr located list
-type or_and_intro_pattern = delayed_open_constr or_and_intro_pattern_expr located
-type intro_pattern_naming = intro_pattern_naming_expr located
+type intro_pattern = delayed_open_constr intro_pattern_expr CAst.t
+type intro_patterns = delayed_open_constr intro_pattern_expr CAst.t list
+type or_and_intro_pattern = delayed_open_constr or_and_intro_pattern_expr CAst.t
+type intro_pattern_naming = intro_pattern_naming_expr CAst.t
 
 (** Generic expressions for atomic tactics *)
 
 type 'a gen_atomic_tactic_expr =
   (* Basic tactics *)
-  | TacIntroPattern of evars_flag * 'dtrm intro_pattern_expr located list
+  | TacIntroPattern of evars_flag * 'dtrm intro_pattern_expr CAst.t list
   | TacApply of advanced_flag * evars_flag * 'trm with_bindings_arg list *
-      ('nam * 'dtrm intro_pattern_expr located option) option
+      ('nam * 'dtrm intro_pattern_expr CAst.t option) option
   | TacElim of evars_flag * 'trm with_bindings_arg * 'trm with_bindings option
   | TacCase of evars_flag * 'trm with_bindings_arg
   | TacMutualFix of Id.t * int * (Id.t * int * 'trm) list
   | TacMutualCofix of Id.t * (Id.t * 'trm) list
   | TacAssert of
-      bool * 'tacexpr option option *
-      'dtrm intro_pattern_expr located option * 'trm
+      evars_flag * bool * 'tacexpr option option *
+      'dtrm intro_pattern_expr CAst.t option * 'trm
   | TacGeneralize of ('trm with_occurrences * Name.t) list
-  | TacLetTac of Name.t * 'trm * 'nam clause_expr * letin_flag *
-      intro_pattern_naming_expr located option
+  | TacLetTac of evars_flag * Name.t * 'trm * 'nam clause_expr * letin_flag *
+      intro_pattern_naming_expr CAst.t option
 
   (* Derived basic tactics *)
   | TacInductionDestruct of
@@ -195,8 +186,7 @@ type 'a gen_tactic_arg =
   | TacGeneric     of 'lev generic_argument
   | ConstrMayEval  of ('trm,'cst,'pat) may_eval
   | Reference      of 'ref
-  | TacCall of Loc.t * 'ref *
-      'a gen_tactic_arg list
+  | TacCall    of ('ref * 'a gen_tactic_arg list) Loc.located
   | TacFreshId of string or_var list
   | Tacexp of 'tacexpr
   | TacPretype of 'trm
@@ -218,7 +208,7 @@ constraint 'a = <
     'r : ltac refs, 'n : idents, 'l : levels *)
 
 and 'a gen_tactic_expr =
-  | TacAtom of Loc.t * 'a gen_atomic_tactic_expr
+  | TacAtom of ('a gen_atomic_tactic_expr) Loc.located
   | TacThen of
       'a gen_tactic_expr *
       'a gen_tactic_expr
@@ -266,7 +256,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 *
@@ -277,9 +267,9 @@ and 'a gen_tactic_expr =
   | TacArg of 'a gen_tactic_arg located
   | TacSelect of goal_selector * 'a gen_tactic_expr
   (* For ML extensions *)
-  | TacML of Loc.t * ml_tactic_entry * 'a gen_tactic_arg list
+  | TacML of (ml_tactic_entry * 'a gen_tactic_arg list) Loc.located
   (* For syntax extensions *)
-  | TacAlias of Loc.t * KerName.t * 'a gen_tactic_arg list
+  | TacAlias of (KerName.t * 'a gen_tactic_arg list) Loc.located
 
 constraint 'a = <
     term:'t;
@@ -293,7 +283,7 @@ constraint 'a = <
 >
 
 and 'a gen_tactic_fun_ast =
-    Id.t option list * 'a gen_tactic_expr
+    Name.t list * 'a gen_tactic_expr
 
 constraint 'a = <
     term:'t;
@@ -312,7 +302,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;
@@ -340,7 +330,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 =  <
@@ -365,11 +355,11 @@ type raw_tactic_arg =
 
 (** Interpreted tactics *)
 
-type t_trm = Term.constr
+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;
@@ -398,6 +388,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 * Pretyping.ltac_var_map
+  | LtacConstrInterp of Glob_term.glob_constr * Ltac_pretype.ltac_var_map
+
+type ltac_trace = ltac_call_kind Loc.located list
 
-type ltac_trace = (Loc.t * ltac_call_kind) list
+type tacdef_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/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index c5bb0ed0..9ad9e152 100644
--- a/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pattern
 open Pp
+open CErrors
+open CAst
+open Pattern
 open Genredexpr
 open Glob_term
 open Tacred
-open CErrors
 open Util
 open Names
-open Nameops
 open Libnames
 open Globnames
 open Nametab
@@ -23,33 +25,28 @@ open Constrexpr
 open Termops
 open Tacexpr
 open Genarg
-open Constrarg
+open Stdarg
+open Tacarg
 open Misctypes
 open Locus
 
 (** Globalization of tactic expressions :
     Conversion from [raw_tactic_expr] to [glob_tactic_expr] *)
 
-let dloc = Loc.ghost
-
-let error_global_not_found_loc (loc,qid) =
-  error_global_not_found_loc loc qid
-
-let error_tactic_expected loc =
-  user_err_loc (loc,"",str "Tactic expected.")
+let error_tactic_expected ?loc =
+  user_err ?loc  (str "Tactic expected.")
 
 (** Generic arguments *)
 
 type glob_sign = Genintern.glob_sign = {
   ltacvars : Id.Set.t;
      (* ltac variables and the subset of vars introduced by Intro/Let/... *)
-  genv : Environ.env }
-
-let fully_empty_glob_sign =
-  { ltacvars = Id.Set.empty; genv = Environ.empty_env }
+  genv : Environ.env;
+  extra : Genintern.Store.t;
+}
 
-let make_empty_glob_sign () =
-  { fully_empty_glob_sign with genv = Global.env () }
+let fully_empty_glob_sign = Genintern.empty_glob_sign Environ.empty_env
+let make_empty_glob_sign () = Genintern.empty_glob_sign (Global.env ())
 
 (* We have identifier <| global_reference <| constr *)
 
@@ -76,16 +73,16 @@ let intern_name l ist = function
 
 let strict_check = ref false
 
-let adjust_loc loc = if !strict_check then dloc else loc
+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
-    (dloc,id)
+    make id
   else
-    Pretype_errors.error_var_not_found_loc loc id
+    Pretype_errors.error_var_not_found ?loc id
 
 let intern_or_var f ist = function
   | ArgVar locid -> ArgVar (intern_hyp ist locid)
@@ -95,42 +92,37 @@ 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)
+  | {CAst.loc;v=Ident id} when find_var id ist ->
+    ArgVar (make ?loc id)
   | r ->
-      let loc,_ as lqid = qualid_of_reference r in
-      try ArgArg (loc,locate_global_with_alias lqid)
-      with Not_found -> error_global_not_found_loc lqid
+    let {CAst.loc} as lqid = qualid_of_reference r in
+    try ArgArg (loc,locate_global_with_alias lqid)
+    with Not_found -> error_global_not_found lqid
 
 let intern_ltac_variable ist = function
-  | Ident (loc,id) ->
+  | {loc;v=Ident id} ->
       if find_var id ist then
 	(* A local variable of any type *)
-	ArgVar (loc,id)
+        ArgVar (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 ->
-      GVar (dloc,id), Some (CRef (r,None))
-  | Ident (_,id) as r when find_var id ist ->
-      GVar (dloc,id), if strict then None else Some (CRef (r,None))
+  | {v=Ident id} as r when not strict && find_hyp id ist ->
+      (DAst.make @@ GVar id), Some (make @@ CRef (r,None))
+  | {v=Ident id} as r when find_var id ist ->
+      (DAst.make @@ GVar id), if strict then None else Some (make @@ CRef (r,None))
   | r ->
-      let loc,_ as lqid = qualid_of_reference r in
-      GRef (loc,locate_global_with_alias lqid,None), 
-	if strict then None else Some (CRef (r,None))
-
-let intern_move_location ist = function
-  | MoveAfter id -> MoveAfter (intern_hyp ist id)
-  | MoveBefore id -> MoveBefore (intern_hyp ist id)
-  | MoveFirst -> MoveFirst
-  | MoveLast -> MoveLast
+      let {loc} as lqid = qualid_of_reference r in
+      DAst.make @@ GRef (locate_global_with_alias lqid,None), 
+        if strict then None else Some (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,ArgArg (loc,locate_tactic qid),[])
+  let {loc;v=qid} = qualid_of_reference r in
+  TacCall (Loc.tag ?loc (ArgArg (loc,Tacenv.locate_tactic qid),[]))
 
 let intern_isolated_tactic_reference strict ist r =
   (* An ltac reference *)
@@ -143,13 +135,13 @@ let intern_isolated_tactic_reference strict ist r =
   try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
   with Not_found ->
   (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
+  error_global_not_found (qualid_of_reference r)
 
 (* Internalize an applied tactic reference *)
 
 let intern_applied_global_tactic_reference r =
-  let (loc,qid) = qualid_of_reference r in
-  ArgArg (loc,locate_tactic qid)
+  let {loc;v=qid} = qualid_of_reference r in
+  ArgArg (loc,Tacenv.locate_tactic qid)
 
 let intern_applied_tactic_reference ist r =
   (* An ltac reference *)
@@ -159,7 +151,7 @@ let intern_applied_tactic_reference ist r =
   try intern_applied_global_tactic_reference r
   with Not_found ->
   (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
+  error_global_not_found (qualid_of_reference r)
 
 (* Intern a reference parsed in a non-tactic entry *)
 
@@ -175,12 +167,12 @@ let intern_non_tactic_reference strict ist r =
   with Not_found ->
   (* By convention, use IntroIdentifier for unbound ident, when not in a def *)
   match r with
-  | Ident (loc,id) when not strict ->
-    let ipat = in_gen (glbwit wit_intro_pattern) (loc, IntroNaming (IntroIdentifier id)) in
+  | {loc;v=Ident id} when not strict ->
+    let ipat = in_gen (glbwit wit_intro_pattern) (make ?loc @@ IntroNaming (IntroIdentifier id)) in
     TacGeneric ipat
   | _ ->
   (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
+  error_global_not_found (qualid_of_reference r)
 
 let intern_message_token ist = function
   | (MsgString _ | MsgInt _ as x) -> x
@@ -200,15 +192,16 @@ let intern_binding_name ist x =
      and if a term w/o ltac vars, check the name is indeed quantified *)
   x
 
-let intern_constr_gen allow_patvar isarity {ltacvars=lfun; genv=env} c =
+let intern_constr_gen pattern_mode isarity {ltacvars=lfun; genv=env; extra} c =
   let warn = if !strict_check then fun x -> x else Constrintern.for_grammar in
   let scope = if isarity then Pretyping.IsType else Pretyping.WithoutTypeConstraint in
   let ltacvars = {
     Constrintern.ltac_vars = lfun;
     ltac_bound = Id.Set.empty;
+    ltac_extra = extra;
   } in
   let c' =
-    warn (Constrintern.intern_gen scope ~allow_patvar ~ltacvars env) c
+    warn (Constrintern.intern_gen scope ~pattern_mode ~ltacvars env Evd.(from_env env)) c
   in
   (c',if !strict_check then None else Some c)
 
@@ -216,8 +209,8 @@ let intern_constr = intern_constr_gen false false
 let intern_type = intern_constr_gen false true
 
 (* Globalize bindings *)
-let intern_binding ist (loc,b,c) =
-  (loc,intern_binding_name ist b,intern_constr ist c)
+let intern_binding ist = map (fun (b,c) ->
+    intern_binding_name ist b,intern_constr ist c)
 
 let intern_bindings ist = function
   | NoBindings -> NoBindings
@@ -230,12 +223,12 @@ let intern_constr_with_bindings ist (c,bl) =
 let intern_constr_with_bindings_arg ist (clear,c) =
   (clear,intern_constr_with_bindings ist c)
 
-let rec intern_intro_pattern lf ist = function
-  | loc, IntroNaming pat ->
-      loc, IntroNaming (intern_intro_pattern_naming lf ist pat)
-  | loc, IntroAction pat ->
-      loc, IntroAction (intern_intro_pattern_action lf ist pat)
-  | loc, IntroForthcoming _ as x -> x
+let rec intern_intro_pattern lf ist = map (function
+  | IntroNaming pat ->
+    IntroNaming (intern_intro_pattern_naming lf ist pat)
+  | IntroAction pat ->
+    IntroAction (intern_intro_pattern_action lf ist pat)
+  | IntroForthcoming _ as x -> x)
 
 and intern_intro_pattern_naming lf ist = function
   | IntroIdentifier id ->
@@ -246,12 +239,12 @@ and intern_intro_pattern_naming lf ist = function
 
 and intern_intro_pattern_action lf ist = function
   | IntroOrAndPattern l ->
-      IntroOrAndPattern (intern_or_and_intro_pattern lf ist l)
+    IntroOrAndPattern (intern_or_and_intro_pattern lf ist l)
   | IntroInjection l ->
-      IntroInjection (List.map (intern_intro_pattern lf ist) l)
+    IntroInjection (List.map (intern_intro_pattern lf ist) l)
   | IntroWildcard | IntroRewrite _ as x -> x
-  | IntroApplyOn (c,pat) ->
-      IntroApplyOn (intern_constr ist c, intern_intro_pattern lf ist pat)
+  | IntroApplyOn ({loc;v=c},pat) ->
+    IntroApplyOn (make ?loc @@ intern_constr ist c, intern_intro_pattern lf ist pat)
 
 and intern_or_and_intro_pattern lf ist = function
    | IntroAndPattern l ->
@@ -260,29 +253,30 @@ 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 error "Disjunctive/conjunctive introduction pattern expected."
-  | ArgArg (loc,l) -> ArgArg (loc,intern_or_and_intro_pattern lf ist l)
+      else user_err Pp.(str "Disjunctive/conjunctive introduction pattern expected.")
+  | ArgArg ll -> ArgArg (map (fun l -> intern_or_and_intro_pattern lf ist l) ll)
 
-let intern_intro_pattern_naming_loc lf ist (loc,pat) =
-  (loc,intern_intro_pattern_naming lf ist pat)
+let intern_intro_pattern_naming_loc lf ist = map (fun pat ->
+    intern_intro_pattern_naming lf ist pat)
 
   (* TODO: catch ltac vars *)
 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 (CRef (Ident (dloc,id), None)) with
-	| GVar (loc,id),_ -> clear,ElimOnIdent (loc,id)
-	| c -> clear,ElimOnConstr (c,NoBindings)
+        let c, p = intern_constr ist (make @@ CRef (make @@ Ident id, None)) in
+	match DAst.get c with
+        | GVar id -> clear,ElimOnIdent (make ?loc:c.loc id)
+	| _ -> clear,ElimOnConstr ((c, p), NoBindings)
       else
-	clear,ElimOnIdent (loc,id)
+        clear,ElimOnIdent (make ?loc id)
 
 let short_name = function
-  | AN (Ident (loc,id)) when not !strict_check -> Some (loc,id)
+  | {v=AN {loc;v=Ident id}} when not !strict_check -> Some (make ?loc id)
   | _ -> None
 
 let intern_evaluable_global_reference ist r =
@@ -290,21 +284,21 @@ let intern_evaluable_global_reference ist r =
   try evaluable_of_global_reference ist.genv (locate_global_with_alias ~head:true lqid)
   with Not_found ->
   match r with
-  | Ident (loc,id) when not !strict_check -> EvalVarRef id
-  | _ -> error_global_not_found_loc lqid
+  | {loc;v=Ident id} when not !strict_check -> EvalVarRef id
+  | _ -> error_global_not_found lqid
 
 let intern_evaluable_reference_or_by_notation ist = function
-  | AN r -> intern_evaluable_global_reference ist r
-  | ByNotation (loc,ntn,sc) ->
+  | {v=AN r} -> intern_evaluable_global_reference ist r
+  | {v=ByNotation (ntn,sc);loc} ->
       evaluable_of_global_reference ist.genv
-      (Notation.interp_notation_as_global_reference loc
+      (Notation.interp_notation_as_global_reference ?loc
         (function ConstRef _ | VarRef _ -> true | _ -> false) ntn sc)
 
 (* 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 not !strict_check && find_hyp id ist ->
-      ArgArg (EvalVarRef id, Some (loc,id))
+  | {loc;v=AN {v=Ident id}} when find_var id ist -> ArgVar (make ?loc id)
+  | {loc;v=AN {v=Ident id}} when not !strict_check && find_hyp id ist ->
+      ArgArg (EvalVarRef id, Some (make ?loc id))
   | r ->
       let e = intern_evaluable_reference_or_by_notation ist r in
       let na = short_name r in
@@ -321,9 +315,10 @@ let intern_constr_pattern ist ~as_type ~ltacvars pc =
   let ltacvars = {
     Constrintern.ltac_vars = ltacvars;
     ltac_bound = Id.Set.empty;
+    ltac_extra = ist.extra;
   } in
   let metas,pat = Constrintern.intern_constr_pattern
-    ist.genv ~as_type ~ltacvars pc
+    ist.genv Evd.(from_env ist.genv) ~as_type ~ltacvars pc
   in
   let (glob,_ as c) = intern_constr_gen true false ist pc in
   let bound_names = Glob_ops.bound_glob_vars glob in
@@ -331,13 +326,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 Evd.(from_env 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,16 +353,19 @@ let intern_typed_pattern_or_ref_with_occurrences ist (l,p) =
          ref or a pattern seems interesting, with "head" reduction
          in case of an evaluable ref, and "strong" reduction in the
          subterm matched when a pattern *)
-      let loc = loc_of_smart_reference r in
       let r = match r with
-      | AN r -> r
-      | _ -> Qualid (loc,qualid_of_path (path_of_global (smart_global r))) in
-      let sign = { Constrintern.ltac_vars = ist.ltacvars; Constrintern.ltac_bound = Id.Set.empty } in
+      | {v=AN r} -> r
+      | {loc} -> make ?loc @@ Qualid (qualid_of_path (path_of_global (smart_global r))) in
+      let sign = {
+        Constrintern.ltac_vars = ist.ltacvars;
+        ltac_bound = Id.Set.empty;
+        ltac_extra = ist.extra;
+      } in
       let c = Constrintern.interp_reference sign r in
-      match c with
-      | GRef (_,r,None) ->
+      match DAst.get c with
+      | GRef (r,None) ->
           Inl (ArgArg (evaluable_of_global_reference ist.genv r,None))
-      | GVar (_,id) ->
+      | GVar id ->
           let r = evaluable_of_global_reference ist.genv (VarRef id) in
           Inl (ArgArg (r,None))
       | _ ->
@@ -365,24 +373,24 @@ 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 (CAppExpl(_,(None,r,None),[])) ->
+  | Inr { v = CAppExpl((None,r,None),[]) } ->
       (* We interpret similarly @ref and ref *)
-      interp_ref (AN r)
+      interp_ref (make @@ 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 *)
 let dump_glob_red_expr = function
   | Unfold occs -> List.iter (fun (_, r) ->
     try
-      Dumpglob.add_glob (loc_of_or_by_notation Libnames.loc_of_reference r)
+      Dumpglob.add_glob ?loc:r.loc
 	(Smartlocate.smart_global r)
     with e when CErrors.noncritical e -> ()) occs
   | Cbv grf | Lazy grf ->
     List.iter (fun r ->
       try
-        Dumpglob.add_glob (loc_of_or_by_notation Libnames.loc_of_reference r)
+        Dumpglob.add_glob ?loc:r.loc
 	  (Smartlocate.smart_global r)
       with e when CErrors.noncritical e -> ()) grf.rConst
   | _ -> ()
@@ -395,8 +403,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
@@ -423,9 +431,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
@@ -433,7 +441,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)
 
@@ -447,12 +455,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
@@ -462,10 +470,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
-      (loc, "glob_tactic", str "This variable is bound several times.")
-    else Id.Set.add name accu
+  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 id accu) name accu
   in
   List.fold_left fold Id.Set.empty lrc
 
@@ -494,17 +503,17 @@ let rec intern_atomic lf ist x =
   | TacMutualCofix (id,l) ->
       let f (id,c) = (intern_ident lf ist id,intern_type ist c) in
       TacMutualCofix (intern_ident lf ist id, List.map f l)
-  | TacAssert (b,otac,ipat,c) ->
-      TacAssert (b,Option.map (Option.map (intern_pure_tactic ist)) otac,
+  | TacAssert (ev,b,otac,ipat,c) ->
+      TacAssert (ev,b,Option.map (Option.map (intern_pure_tactic ist)) otac,
                  Option.map (intern_intro_pattern lf ist) ipat,
                  intern_constr_gen false (not (Option.is_empty otac)) ist c)
   | TacGeneralize cl ->
       TacGeneralize (List.map (fun (c,na) ->
 	               intern_constr_with_occurrences ist c,
                        intern_name lf ist na) cl)
-  | TacLetTac (na,c,cls,b,eqpat) ->
+  | TacLetTac (ev,na,c,cls,b,eqpat) ->
       let na = intern_name lf ist na in
-      TacLetTac (na,intern_constr ist c,
+      TacLetTac (ev,na,intern_constr ist c,
                  (clause_app (intern_hyp_location ist) cls),b,
 		 (Option.map (intern_intro_pattern_naming_loc lf ist) eqpat))
 
@@ -534,7 +543,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 *)
@@ -554,7 +568,7 @@ and intern_tactic_seq onlytac ist = function
   | TacAtom (loc,t) ->
       let lf = ref ist.ltacvars in
       let t = intern_atomic lf ist t in
-      !lf, TacAtom (adjust_loc loc, t)
+      !lf, TacAtom (Loc.tag ?loc:(adjust_loc loc) t)
   | TacFun tacfun -> ist.ltacvars, TacFun (intern_tactic_fun ist tacfun)
   | TacLetIn (isrec,l,u) ->
       let ltacvars = Id.Set.union (extract_let_names l) ist.ltacvars in
@@ -628,12 +642,12 @@ and intern_tactic_seq onlytac ist = function
       ist.ltacvars, TacSelect (sel, intern_pure_tactic ist tac)
 
   (* For extensions *)
-  | TacAlias (loc,s,l) ->
+  | TacAlias (loc,(s,l)) ->
       let l = List.map (intern_tacarg !strict_check false ist) l in
-      ist.ltacvars, TacAlias (loc,s,l)
-  | TacML (loc,opn,l) ->
+      ist.ltacvars, TacAlias (Loc.tag ?loc (s,l))
+  | TacML (loc,(opn,l)) ->
       let _ignore = Tacenv.interp_ml_tactic opn in
-      ist.ltacvars, TacML (adjust_loc loc,opn,List.map (intern_tacarg !strict_check false ist) l)
+      ist.ltacvars, TacML (loc, (opn,List.map (intern_tacarg !strict_check false ist) l))
 
 and intern_tactic_as_arg loc onlytac ist a =
   match intern_tacarg !strict_check onlytac ist a with
@@ -641,24 +655,24 @@ and intern_tactic_as_arg loc onlytac ist a =
   | TacGeneric _ as a -> TacArg (loc,a)
   | Tacexp a -> a
   | ConstrMayEval _ | TacFreshId _ | TacPretype _ | TacNumgoals as a ->
-      if onlytac then error_tactic_expected loc else TacArg (loc,a)
+      if onlytac then error_tactic_expected ?loc else TacArg (loc,a)
 
 and intern_tactic_or_tacarg ist = intern_tactic false ist
 
 and intern_pure_tactic ist = intern_tactic true ist
 
 and intern_tactic_fun ist (var,body) =
-  let lfun = List.fold_left opt_cons ist.ltacvars var in
+  let lfun = List.fold_left name_cons ist.ltacvars var in
   (var,intern_tactic_or_tacarg { ist with ltacvars = lfun } body)
 
 and intern_tacarg strict onlytac ist = function
   | Reference r -> intern_non_tactic_reference strict ist r
   | ConstrMayEval c -> ConstrMayEval (intern_constr_may_eval ist c)
-  | TacCall (loc,f,[]) -> intern_isolated_tactic_reference strict ist f
-  | TacCall (loc,f,l) ->
-      TacCall (loc,
+  | TacCall (loc,(f,[])) -> intern_isolated_tactic_reference strict ist f
+  | TacCall (loc,(f,l)) ->
+      TacCall (Loc.tag ?loc (
         intern_applied_tactic_reference ist f,
-        List.map (intern_tacarg !strict_check false ist) l)
+        List.map (intern_tacarg !strict_check false ist) l))
   | TacFreshId x -> TacFreshId (List.map (intern_string_or_var ist) x)
   | TacPretype c -> TacPretype (intern_constr ist c)
   | TacNumgoals -> TacNumgoals
@@ -716,21 +730,18 @@ let glob_tactic_env l env x =
   let ltacvars =
     List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l in
   Flags.with_option strict_check
-  (intern_pure_tactic
-    { ltacvars; genv = env })
+  (intern_pure_tactic { (Genintern.empty_glob_sign env) with ltacvars })
     x
 
 let split_ltac_fun = function
   | TacFun (l,t) -> (l,t)
   | t -> ([],t)
 
-let pr_ltac_fun_arg = function
-  | None -> spc () ++ str "_"
-  | Some id -> spc () ++ pr_id id
+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 =
@@ -751,7 +762,7 @@ let print_ltac id =
     ++ spc() ++ Pptactic.pr_glob_tactic (Global.env ()) t) ++ redefined
  with
   Not_found ->
-   errorlabstrm "print_ltac"
+   user_err ~hdr:"print_ltac"
     (pr_qualid id ++ spc() ++ str "is not a user defined tactic.")
 
 (** Registering *)
@@ -778,13 +789,17 @@ let intern_ident' ist id =
   let lf = ref Id.Set.empty in
   (ist, intern_ident lf ist id)
 
+let intern_ltac ist tac =
+  Flags.with_option strict_check (fun () -> intern_pure_tactic ist tac) ()
+
 let () =
   Genintern.register_intern0 wit_int_or_var (lift intern_int_or_var);
   Genintern.register_intern0 wit_ref (lift intern_global_reference);
+  Genintern.register_intern0 wit_pre_ident (fun ist c -> (ist,c));
   Genintern.register_intern0 wit_ident intern_ident';
   Genintern.register_intern0 wit_var (lift intern_hyp);
   Genintern.register_intern0 wit_tactic (lift intern_tactic_or_tacarg);
-  Genintern.register_intern0 wit_ltac (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_ltac (lift intern_ltac);
   Genintern.register_intern0 wit_quant_hyp (lift intern_quantified_hypothesis);
   Genintern.register_intern0 wit_constr (fun ist c -> (ist,intern_constr ist c));
   Genintern.register_intern0 wit_uconstr (fun ist c -> (ist,intern_constr ist c));
@@ -795,15 +810,17 @@ let () =
   Genintern.register_intern0 wit_destruction_arg (lift intern_destruction_arg);
   ()
 
-(***************************************************************************)
-(* Backwarding recursive needs of tactic glob/interp/eval functions *)
+(** Substitution for notations containing tactic-in-terms *)
 
-let _ =
-  let f l =
-    let ltacvars =
-      List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l
-    in
-    Flags.with_option strict_check
-    (intern_pure_tactic { (make_empty_glob_sign()) with ltacvars })
+let notation_subst bindings tac =
+  let fold id c accu =
+    let loc = Glob_ops.loc_of_glob_constr (fst c) in
+    let c = ConstrMayEval (ConstrTerm c) in
+    (make ?loc @@ Name id, c) :: accu
   in
-  Hook.set Hints.extern_intern_tac f
+  let bindings = Id.Map.fold fold bindings [] in
+  (** This is theoretically not correct due to potential variable capture, but
+      Ltac has no true variables so one cannot simply substitute *)
+  TacLetIn (false, bindings, tac)
+
+let () = Genintern.register_ntn_subst0 wit_tactic notation_subst
diff --git a/ltac/tacintern.mli b/plugins/ltac/tacintern.mli
index 71ca354f..fb32508c 100644
--- a/ltac/tacintern.mli
+++ b/plugins/ltac/tacintern.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open Names
 open Tacexpr
 open Genarg
@@ -18,7 +19,9 @@ open Misctypes
 
 type glob_sign = Genintern.glob_sign = {
   ltacvars : Id.Set.t;
-  genv : Environ.env }
+  genv : Environ.env;
+  extra : Genintern.Store.t;
+}
 
 val fully_empty_glob_sign : glob_sign
 
@@ -46,14 +49,14 @@ 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 *)
 
 val intern_genarg : glob_sign -> raw_generic_argument -> glob_generic_argument
 
 (** printing *)
-val print_ltac : Libnames.qualid -> std_ppcmds
+val print_ltac : Libnames.qualid -> Pp.t
 
 (** Reduction expressions *)
 
diff --git a/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 20dbc2be..c6c4f469 100644
--- a/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -1,14 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Constrintern
 open Patternops
 open Pp
+open CAst
 open Genredexpr
 open Glob_term
 open Glob_ops
@@ -20,27 +23,25 @@ open Nameops
 open Libnames
 open Globnames
 open Nametab
-open Pfedit
 open Refiner
 open Tacmach.New
 open Tactic_debug
 open Constrexpr
-open Term
 open Termops
 open Tacexpr
 open Genarg
 open Geninterp
 open Stdarg
-open Constrarg
+open Tacarg
 open Printer
 open Pretyping
 open Misctypes
 open Locus
 open Tacintern
 open Taccoerce
-open Sigma.Notations
 open Proofview.Notations
 open Context.Named.Declaration
+open Ltac_pretype
 
 let ltac_trace_info = Tactic_debug.ltac_trace_info
 
@@ -89,11 +90,6 @@ let safe_msgnl s =
 
 type value = Val.t
 
-(** Abstract application, to print ltac functions *)
-type appl =
-  | UnnamedAppl (** For generic applications: nothing is printed *)
-  | GlbAppl of (Names.kernel_name * Val.t list) list
-       (** For calls to global constants, some may alias other. *)
 let push_appl appl args =
   match appl with
   | UnnamedAppl -> UnnamedAppl
@@ -117,23 +113,11 @@ let combine_appl appl1 appl2 =
   | UnnamedAppl,a | a,UnnamedAppl -> a
   | GlbAppl l1 , GlbAppl l2 -> GlbAppl (l2@l1)
 
-(* Values for interpretation *)
-type tacvalue =
-  | VFun of appl*ltac_trace * value Id.Map.t *
-      Id.t option list * glob_tactic_expr
-  | VRec of value Id.Map.t ref * glob_tactic_expr
-
-let (wit_tacvalue : (Empty.t, tacvalue, tacvalue) Genarg.genarg_type) =
-  let wit = Genarg.create_arg "tacvalue" in
-  let () = register_val0 wit None in
-  wit
-
 let of_tacvalue v = in_gen (topwit wit_tacvalue) v
 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))
@@ -142,7 +126,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 ()
@@ -164,45 +148,10 @@ module Value = struct
     let closure = VFun (UnnamedAppl,extract_trace ist, ist.lfun, [], tac) in
     of_tacvalue closure
 
-  let cast_error wit v =
-    let pr_v = Pptactic.pr_value Pptactic.ltop v in
-    let Val.Dyn (tag, _) = v in
-    let tag = Val.pr tag in
-    errorlabstrm "" (str "Type error: value " ++ pr_v ++ str " is a " ++ tag
-      ++ str " while type " ++ Val.pr wit ++ str " was expected.")
-
-  let unbox wit v ans = match ans with
-  | None -> cast_error wit v
-  | Some x -> x
-
-  let rec prj : type a. a Val.tag -> Val.t -> a = fun tag v -> match tag with
-  | Val.List tag -> List.map (fun v -> prj tag v) (unbox Val.typ_list v (to_list v))
-  | Val.Opt tag -> Option.map (fun v -> prj tag v) (unbox Val.typ_opt v (to_option v))
-  | Val.Pair (tag1, tag2) ->
-    let (x, y) = unbox Val.typ_pair v (to_pair v) in
-    (prj tag1 x, prj tag2 y)
-  | Val.Base t ->
-    let Val.Dyn (t', x) = v in
-    match Val.eq t t' with
-    | None -> cast_error t v
-    | Some Refl -> x
-
-  let rec tag_of_arg : type a b c. (a, b, c) genarg_type -> c Val.tag = fun wit -> match wit with
-  | ExtraArg _ -> val_tag wit
-  | ListArg t -> Val.List (tag_of_arg t)
-  | OptArg t -> Val.Opt (tag_of_arg t)
-  | PairArg (t1, t2) -> Val.Pair (tag_of_arg t1, tag_of_arg t2)
-
-  let val_cast arg v = prj (tag_of_arg arg) v
-
-  let cast (Topwit wit) v = val_cast wit v
-
 end
 
 let print_top_val env v = Pptactic.pr_value Pptactic.ltop v
 
-let dloc = Loc.ghost
-
 let catching_error call_trace fail (e, info) =
   let inner_trace =
     Option.default [] (Exninfo.get info ltac_trace_info)
@@ -230,36 +179,12 @@ let curr_debug ist = match TacStore.get ist.extra f_debug with
 | None -> DebugOff
 | Some level -> level
 
-(** TODO: unify printing of generic Ltac values in case of coercion failure. *)
-
-(* 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_lconstr_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
-    match env with
-    | Some (env,sigma) -> pr_lconstr_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
-
 let pr_closure env ist body =
   let pp_body = Pptactic.pr_glob_tactic env body in
   let pr_sep () = fnl () in
   let pr_iarg (id, arg) =
     let arg = pr_argument_type arg in
-    hov 0 (pr_id id ++ spc () ++ str ":" ++ spc () ++ arg)
+    hov 0 (Id.print id ++ spc () ++ str ":" ++ spc () ++ arg)
   in
   let pp_iargs = v 0 (prlist_with_sep pr_sep pr_iarg (Id.Map.bindings ist)) in
   pp_body ++ fnl() ++ str "in environment " ++ fnl() ++ pp_iargs
@@ -282,7 +207,7 @@ let pr_inspect env expr result =
 
 (* Transforms an id into a constr if possible, or fails with Not_found *)
 let constr_of_id env id =
-  Term.mkVar (let _ = Environ.lookup_named id env in id)
+  EConstr.mkVar (let _ = Environ.lookup_named id env in id)
 
 (** Generic arguments : table of interpretation functions *)
 
@@ -292,7 +217,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
@@ -305,7 +229,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))
@@ -314,11 +237,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
-    (loc, "", str "Variable " ++ pr_id id ++ str " should be bound to a tactic.")
+  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
@@ -326,7 +247,7 @@ let coerce_to_tactic loc id v =
     | _ -> fail ()
   else fail ()
 
-let intro_pattern_of_ident id = (Loc.ghost, IntroNaming (IntroIdentifier id))
+let intro_pattern_of_ident id = make @@ IntroNaming (IntroIdentifier id)
 let value_of_ident id =
   in_gen (topwit wit_intro_pattern) (intro_pattern_of_ident id)
 
@@ -370,51 +291,45 @@ let debugging_exception_step ist signal_anomaly e pp =
   debugging_step ist (fun () ->
     pp() ++ spc() ++ str "raised the exception" ++ fnl() ++ explain_exc e)
 
-let error_ltac_variable loc id env v s =
-   user_err_loc (loc, "", str "Ltac variable " ++ pr_id id ++
-   strbrk " is bound to" ++ spc () ++ pr_value env v ++ spc () ++
-   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
+  try coerce v with CannotCoerceTo s ->
+    Taccoerce.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) ist (Some (env,sigma)) (dloc,id)
+  try try_interp_ltac_var (coerce_var_to_ident false env sigma) ist (Some (env,sigma)) (make id)
   with Not_found -> id
 
-let pf_interp_ident id gl = interp_ident id (pf_env gl) (project gl)
-
 (* Interprets an optional identifier, bound or fresh *)
 let interp_name ist env sigma = function
   | Anonymous -> Anonymous
   | 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) 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) 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,"interp_int",
-      str "Unbound variable "  ++ pr_id (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]
@@ -423,35 +338,29 @@ 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) ist (Some (env,sigma)) locid
+  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) =
-  try coerce_to_hyp_list env (Id.Map.find id ist.lfun)
+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]
 
 let interp_hyp_list ist env sigma l =
   List.flatten (List.map (interp_hyp_list_as_list ist env sigma) l)
 
-let interp_move_location ist env sigma = function
-  | MoveAfter id -> MoveAfter (interp_hyp ist env sigma id)
-  | MoveBefore id -> MoveBefore (interp_hyp ist env sigma id)
-  | MoveFirst -> MoveFirst
-  | MoveLast -> MoveLast
-
 let interp_reference ist env sigma = function
   | ArgArg (_,r) -> r
-  | ArgVar (loc, id) ->
-    try try_interp_ltac_var (coerce_to_reference env) 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))
-      with Not_found -> error_global_not_found_loc loc (qualid_of_ident id)
+      with Not_found -> error_global_not_found (make ?loc @@ qualid_of_ident id)
 
 let try_interp_evaluable env (loc, id) =
   let v = Environ.lookup_named id env in
@@ -460,21 +369,21 @@ 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)
       with Not_found ->
         match r with
         | EvalConstRef _ -> r
-        | _ -> error_global_not_found_loc loc (qualid_of_ident id)
+        | _ -> error_global_not_found (make ?loc @@ qualid_of_ident id)
     end
   | ArgArg (r,None) -> r
-  | ArgVar (loc, id) ->
-    try try_interp_ltac_var (coerce_to_evaluable_ref env) ist (Some (env,sigma)) (loc, id)
+  | 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 loc (qualid_of_ident id)
+      with Not_found -> error_global_not_found (make ?loc @@ qualid_of_ident id)
 
 (* Interprets an hypothesis name *)
 let interp_occurrences ist occs =
@@ -514,73 +423,71 @@ 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;v=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 ({v=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
+      let {v=ipat} = out_gen (topwit wit_intro_pattern) v in
       if Id.List.mem id ids then accu
-      else accu @ intropattern_ids (dloc, ipat)
+      else intropattern_ids accu (make 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 sigma env)
-			    ist (Some (env,sigma)) (dloc,id)
+    try try_interp_ltac_var (coerce_to_ident_not_fresh env sigma)
+                            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 =
-  let open Glob_term in
-  let add_uconstr id env v map =
+let extract_ltac_constr_context ist env sigma =
+  let add_uconstr id v map =
     try Id.Map.add id (coerce_to_uconstr env v) map
     with CannotCoerceTo _ -> map
   in
-  let add_constr id env v map =
+  let add_constr id v map =
     try Id.Map.add id (coerce_to_constr env v) map
     with CannotCoerceTo _ -> map
   in
-  let add_ident id env v map =
-    try Id.Map.add id (coerce_var_to_ident false env v) map
+  let add_ident id v map =
+    try Id.Map.add id (coerce_var_to_ident false env sigma v) map
     with CannotCoerceTo _ -> map
   in
   let fold id v {idents;typed;untyped} =
-    let idents = add_ident id env v idents in
-    let typed = add_constr id env v typed in
-    let untyped = add_uconstr id env v untyped in
+    let idents = add_ident id v idents in
+    let typed = add_constr id v typed in
+    let untyped = add_uconstr id v untyped in
     { idents ; typed ; untyped }
   in
   let empty =  { idents = Id.Map.empty ;typed = Id.Map.empty ; untyped = Id.Map.empty } in
@@ -588,88 +495,80 @@ let extract_ltac_constr_context ist env =
 
 (** Significantly simpler than [interp_constr], to interpret an
     untyped constr, it suffices to adjoin a closure environment. *)
-let interp_uconstr ist env = function
-  | (term,None) ->
-      { closure = extract_ltac_constr_context ist env ; term }
-  | (_,Some ce) ->
-      let ( {typed ; untyped } as closure) = extract_ltac_constr_context ist env in
-      let ltacvars = {
-        Constrintern.ltac_vars = Id.(Set.union (Map.domain typed) (Map.domain untyped));
-        ltac_bound = Id.Map.domain ist.lfun;
-      } in
-      { closure ; term =  intern_gen WithoutTypeConstraint ~ltacvars env ce }
-
-let interp_gen kind ist allow_patvar flags env sigma (c,ce) =
-  let constrvars = extract_ltac_constr_context ist env in
-  let vars = {
-    Pretyping.ltac_constrs = constrvars.typed;
-    Pretyping.ltac_uconstrs = constrvars.untyped;
-    Pretyping.ltac_idents = constrvars.idents;
-    Pretyping.ltac_genargs = ist.lfun;
-  } in
-  let c = match ce with
-  | None -> c
-    (* If at toplevel (ce<>None), the error can be due to an incorrect
-       context at globalization time: we retype with the now known
-       intros/lettac/inversion hypothesis names *)
-  | Some c ->
+let interp_glob_closure ist env sigma ?(kind=WithoutTypeConstraint) ?(pattern_mode=false) (term,term_expr_opt) =
+  let closure = extract_ltac_constr_context ist env sigma in
+  match term_expr_opt with
+  | None -> { closure ; term }
+  | Some term_expr ->
+     (* If at toplevel (term_expr_opt<>None), the error can be due to
+       an incorrect context at globalization time: we retype with the
+       now known intros/lettac/inversion hypothesis names *)
       let constr_context =
         Id.Set.union
-          (Id.Map.domain constrvars.typed)
-       (Id.Set.union
-          (Id.Map.domain constrvars.untyped)
-          (Id.Map.domain constrvars.idents))
+          (Id.Map.domain closure.typed)
+          (Id.Map.domain closure.untyped)
       in
       let ltacvars = {
         ltac_vars = constr_context;
         ltac_bound = Id.Map.domain ist.lfun;
+        ltac_extra = Genintern.Store.empty;
       } in
-      let kind_for_intern =
-        match kind with OfType _ -> WithoutTypeConstraint | _ -> kind in
-      intern_gen kind_for_intern ~allow_patvar ~ltacvars env c
-  in
+      { closure ; term = intern_gen kind ~pattern_mode ~ltacvars env sigma term_expr }
+
+let interp_uconstr ist env sigma c = interp_glob_closure ist env sigma c
+
+let interp_gen kind ist pattern_mode flags env sigma c =
+  let kind_for_intern = match kind with OfType _ -> WithoutTypeConstraint | _ -> kind in
+  let { closure = constrvars ; term } =
+    interp_glob_closure ist env sigma ~kind:kind_for_intern ~pattern_mode c in
+  let vars = {
+    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
       this with the kludge of an empty proofview, and rely on the
       invariant that running the tactic returned by push_trace does
       not modify sigma. *)
   let (_, dummy_proofview) = Proofview.init sigma [] in
-  let (trace,_,_,_) = Proofview.apply env (push_trace (loc_of_glob_constr c,LtacConstrInterp (c,vars)) ist) dummy_proofview in
+  let (trace,_,_,_) = Proofview.apply env (push_trace (loc_of_glob_constr term,LtacConstrInterp (term,vars)) ist) dummy_proofview in
   let (evd,c) =
-    catch_error trace (understand_ltac flags env sigma vars kind) c
+    catch_error trace (understand_ltac flags env sigma vars kind) term
   in
   (* spiwack: to avoid unnecessary modifications of tacinterp, as this
      function already use effect, I call [run] hoping it doesn't mess
      up with any assumption. *)
-  Proofview.NonLogical.run (db_constr (curr_debug ist) env c);
+  Proofview.NonLogical.run (db_constr (curr_debug ist) env evd c);
   (evd,c)
 
-let constr_flags = {
+let constr_flags () = {
   use_typeclasses = true;
   solve_unification_constraints = true;
-  use_hook = Some solve_by_implicit_tactic;
+  use_hook = Pfedit.solve_by_implicit_tactic ();
   fail_evar = true;
   expand_evars = true }
 
 (* Interprets a constr; expects evars to be solved *)
 let interp_constr_gen kind ist env sigma c =
-  interp_gen kind ist false constr_flags env sigma c
+  interp_gen kind ist false (constr_flags ()) env sigma c
 
 let interp_constr = interp_constr_gen WithoutTypeConstraint
 
 let interp_type = interp_constr_gen IsType
 
-let open_constr_use_classes_flags = {
+let open_constr_use_classes_flags () = {
   use_typeclasses = true;
   solve_unification_constraints = true;
-  use_hook = Some solve_by_implicit_tactic;
+  use_hook = Pfedit.solve_by_implicit_tactic ();
   fail_evar = false;
   expand_evars = true }
 
-let open_constr_no_classes_flags = {
+let open_constr_no_classes_flags () = {
   use_typeclasses = false;
   solve_unification_constraints = true;
-  use_hook = Some solve_by_implicit_tactic;
+  use_hook = Pfedit.solve_by_implicit_tactic ();
   fail_evar = false;
   expand_evars = true }
 
@@ -681,11 +580,11 @@ let pure_open_constr_flags = {
   expand_evars = false }
 
 (* Interprets an open constr *)
-let interp_open_constr ?(expected_type=WithoutTypeConstraint) ist =
-  let flags =
-    if expected_type == WithoutTypeConstraint then open_constr_no_classes_flags
-    else open_constr_use_classes_flags in
-  interp_gen expected_type ist false flags
+let interp_open_constr ?(expected_type=WithoutTypeConstraint) ?(flags=open_constr_no_classes_flags ()) ist env sigma c =
+  interp_gen expected_type ist false flags env sigma c
+
+let interp_open_constr_with_classes ?(expected_type=WithoutTypeConstraint) ist env sigma c =
+  interp_gen expected_type ist false (open_constr_use_classes_flags ()) env sigma c
 
 let interp_pure_open_constr ist =
   interp_gen WithoutTypeConstraint ist false pure_open_constr_flags
@@ -693,16 +592,15 @@ let interp_pure_open_constr ist =
 let interp_typed_pattern ist env sigma (_,c,_) =
   let sigma, c =
     interp_gen WithoutTypeConstraint ist true pure_open_constr_flags env sigma c in
-  pattern_of_constr env sigma c
+  (** FIXME: it is necessary to be unsafe here because of the way we handle
+      evars in the pretyper. Sometimes they get solved eagerly. *)
+  pattern_of_constr env sigma (EConstr.Unsafe.to_constr c)
 
 (* Interprets a constr expression *)
-let pf_interp_constr ist gl =
-  interp_constr ist (pf_env gl) (project gl)
-
 let interp_constr_in_compound_list inj_fun dest_fun interp_fun ist env sigma l =
   let try_expand_ltac_var sigma x =
-    try match dest_fun x with
-    | 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 +609,7 @@ let interp_constr_in_compound_list inj_fun dest_fun interp_fun ist env sigma l =
       (* dest_fun, List.assoc may raise Not_found *)
       let sigma, c = interp_fun ist env sigma x in
       sigma, [c] in
-  let sigma, l = List.fold_map try_expand_ltac_var sigma l in
+  let sigma, l = List.fold_left_map try_expand_ltac_var sigma l in
   sigma, List.flatten l
 
 let interp_constr_list ist env sigma c =
@@ -720,10 +618,6 @@ let interp_constr_list ist env sigma c =
 let interp_open_constr_list =
   interp_constr_in_compound_list (fun x -> x) (fun x -> x) interp_open_constr
 
-(* Interprets a type expression *)
-let pf_interp_type ist env sigma =
-  interp_type ist env sigma
-
 (* Interprets a reduction expression *)
 let interp_unfold ist env sigma (occs,qid) =
   (interp_occurrences ist occs,interp_evaluable ist env sigma qid)
@@ -737,18 +631,18 @@ 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) *)
     let coerce_eval_ref_or_constr x =
-      try Inl (coerce_to_evaluable_ref env x)
+      try Inl (coerce_to_evaluable_ref env sigma x)
       with CannotCoerceTo _ ->
         let c = coerce_to_closed_constr env x in
-        Inr (pattern_of_constr env sigma c) in
-    (try try_interp_ltac_var coerce_eval_ref_or_constr ist (Some (env,sigma)) (loc,id)
+        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)) (make ?loc id)
      with Not_found ->
-       error_global_not_found_loc loc (qualid_of_ident id))
+       error_global_not_found (make ?loc @@ qualid_of_ident id))
   | Inl (ArgArg _ as b) -> Inl (interp_evaluable ist env sigma b)
   | Inr c -> Inr (interp_typed_pattern ist env sigma c) in
   interp_occurrences ist occs, p
@@ -791,24 +685,25 @@ let interp_may_eval f ist env sigma = function
       let (sigma,redexp) = interp_red_expr ist env sigma r in
       let (sigma,c_interp) = f ist env sigma c in
       let (redfun, _) = Redexpr.reduction_of_red_expr env redexp in
-      let sigma = Sigma.Unsafe.of_evar_map sigma in
-      let Sigma (c, sigma, _) = redfun.Reductionops.e_redfun env sigma c_interp in
-      (Sigma.to_evar_map sigma, c)
-  | ConstrContext ((loc,s),c) ->
+      redfun env sigma c_interp
+  | 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
+	let ctxt = EConstr.Unsafe.to_constr ctxt in
 	let evdref = ref sigma in
+	let ic = EConstr.Unsafe.to_constr ic in
 	let c = subst_meta [Constr_matching.special_meta,ic] ctxt in
-	let c = Typing.e_solve_evars env evdref c in
+	let c = Typing.e_solve_evars env evdref (EConstr.of_constr c) in
 	!evdref , c
       with
 	| Not_found ->
-	    user_err_loc (loc, "interp_may_eval",
-	    str "Unbound context identifier" ++ pr_id s ++ str"."))
+	    user_err ?loc ~hdr:"interp_may_eval"
+	    (str "Unbound context identifier" ++ Id.print s ++ str"."))
   | ConstrTypeOf c ->
       let (sigma,c_interp) = f ist env sigma c in
-      Typing.type_of ~refresh:true env sigma c_interp
+      let (sigma, t) = Typing.type_of ~refresh:true env sigma c_interp in
+      (sigma, t)
   | ConstrTerm c ->
      try
 	f ist env sigma c
@@ -838,61 +733,28 @@ let interp_constr_may_eval ist env sigma c =
     (* spiwack: to avoid unnecessary modifications of tacinterp, as this
        function already use effect, I call [run] hoping it doesn't mess
        up with any assumption. *)
-    Proofview.NonLogical.run (db_constr (curr_debug ist) env csr);
+    Proofview.NonLogical.run (db_constr (curr_debug ist) env sigma csr);
     sigma , csr
   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.nf_enter {enter = begin fun gl -> Ftactic.return (pr_constr_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.nf_enter { 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 = pr_constr_env env sigma (fst (Tactics.run_delayed env Evd.empty c)) in
-    Ftactic.nf_enter { 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.nf_enter { enter = begin fun gl -> Ftactic.return (pr_constr_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.nf_enter { 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.nf_enter { enter = begin fun gl -> Ftactic.return (pr_id id) end }
-  else match Value.to_list v with
-  | Some l ->
-    Ftactic.List.map message_of_value l >>= fun l ->
-    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 (pr_id id ++ str" not found."))
+    | None -> Ftactic.lift (Tacticals.New.tclZEROMSG (Id.print id ++ str" not found."))
     | Some v -> message_of_value v
 
 let interp_message ist l =
@@ -900,15 +762,15 @@ let interp_message ist l =
   Ftactic.List.map (interp_message_token ist) l >>= fun l ->
   Ftactic.return (prlist_with_sep spc (fun x -> x) l)
 
-let rec interp_intro_pattern ist env sigma = function
-  | loc, IntroAction pat ->
-      let (sigma,pat) = interp_intro_pattern_action ist env sigma pat in
-      sigma, (loc, IntroAction pat)
-  | loc, IntroNaming (IntroIdentifier id) ->
-      sigma, (loc, interp_intro_pattern_var loc ist env sigma id)
-  | loc, IntroNaming pat ->
-      sigma, (loc, IntroNaming (interp_intro_pattern_naming loc ist env sigma pat))
-  | loc, IntroForthcoming _  as x -> sigma, x
+let rec interp_intro_pattern ist env sigma = with_loc_val (fun ?loc -> function
+  | IntroAction pat ->
+    let (sigma,pat) = interp_intro_pattern_action ist env sigma pat in
+    sigma, make ?loc @@ IntroAction pat
+  | IntroNaming (IntroIdentifier id) ->
+    sigma, make ?loc @@ interp_intro_pattern_var loc ist env sigma id
+  | IntroNaming pat ->
+    sigma, make ?loc @@ IntroNaming (interp_intro_pattern_naming loc ist env sigma pat)
+  | IntroForthcoming _  as x -> sigma, make ?loc x)
 
 and interp_intro_pattern_naming loc ist env sigma = function
   | IntroFresh id -> IntroFresh (interp_ident ist env sigma id)
@@ -922,45 +784,41 @@ and interp_intro_pattern_action ist env sigma = function
   | IntroInjection l ->
       let sigma,l = interp_intro_pattern_list_as_list ist env sigma l in
       sigma, IntroInjection l
-  | IntroApplyOn (c,ipat) ->
-      let c = { delayed = fun env sigma ->
-        let sigma = Sigma.to_evar_map sigma in
-        let (sigma, c) = interp_open_constr ist env sigma c in
-        Sigma.Unsafe.of_pair (c, sigma)
-      } in
+  | IntroApplyOn ({loc;v=c},ipat) ->
+      let c env sigma = interp_open_constr ist env sigma c in
       let sigma,ipat = interp_intro_pattern ist env sigma ipat in
-      sigma, IntroApplyOn (c,ipat)
+      sigma, IntroApplyOn (make ?loc c,ipat)
   | IntroWildcard | IntroRewrite _ as x -> sigma, x
 
 and interp_or_and_intro_pattern ist env sigma = function
   | IntroAndPattern l ->
-      let sigma, l = List.fold_map (interp_intro_pattern ist env) sigma l in
+      let sigma, l = List.fold_left_map (interp_intro_pattern ist env) sigma l in
       sigma, IntroAndPattern l
   | IntroOrPattern ll ->
-      let sigma, ll = List.fold_map (interp_intro_pattern_list_as_list ist env) sigma ll in
+      let sigma, ll = List.fold_left_map (interp_intro_pattern_list_as_list ist env) sigma ll in
       sigma, IntroOrPattern ll
 
 and interp_intro_pattern_list_as_list ist env sigma = function
-  | [loc,IntroNaming (IntroIdentifier id)] as l ->
-      (try sigma, coerce_to_intro_pattern_list loc env (Id.Map.find id ist.lfun)
+  | [{loc;v=IntroNaming (IntroIdentifier id)}] as l ->
+      (try sigma, coerce_to_intro_pattern_list ?loc env sigma (Id.Map.find id ist.lfun)
        with Not_found | CannotCoerceTo _ ->
-         List.fold_map (interp_intro_pattern ist env) sigma l)
-  | l -> List.fold_map (interp_intro_pattern ist env) sigma l
+         List.fold_left_map (interp_intro_pattern ist env) sigma l)
+  | l -> List.fold_left_map (interp_intro_pattern ist env) sigma l
 
 let interp_intro_pattern_naming_option ist env sigma = function
   | None -> None
-  | Some (loc,pat) -> Some (loc, interp_intro_pattern_naming loc ist env sigma pat)
+  | Some lpat -> Some (map_with_loc (fun ?loc pat -> interp_intro_pattern_naming loc ist env sigma pat) lpat)
 
 let interp_or_and_intro_pattern_option ist env sigma = function
   | None -> sigma, None
-  | Some (ArgVar (loc,id)) ->
-      (match coerce_to_intro_pattern env (Id.Map.find id ist.lfun) with
-      | IntroAction (IntroOrAndPattern l) -> sigma, Some (loc,l)
+  | Some (ArgVar {loc;v=id}) ->
+      (match interp_intro_pattern_var loc ist env sigma id with
+      | IntroAction (IntroOrAndPattern l) -> sigma, Some (make ?loc l)
       | _ ->
-        raise (CannotCoerceTo "a disjunctive/conjunctive introduction pattern"))
-  | Some (ArgArg (loc,l)) ->
+        user_err ?loc (str "Cannot coerce to a disjunctive/conjunctive pattern."))
+  | Some (ArgArg {loc;v=l}) ->
       let sigma,l = interp_or_and_intro_pattern ist env sigma l in
-      sigma, Some (loc,l)
+      sigma, Some (make ?loc l)
 
 let interp_intro_pattern_option ist env sigma = function
   | None -> sigma, None
@@ -972,45 +830,39 @@ 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_quantified_hypothesis ist = function
-  | AnonHyp n -> AnonHyp n
-  | NamedHyp id ->
-      try try_interp_ltac_var coerce_to_quantified_hypothesis ist None(dloc,id)
-      with Not_found -> NamedHyp id
-
-let interp_binding_name ist = 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 ist None(dloc,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) ist (Some (env,sigma)) (dloc,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 interp_binding ist env sigma {loc;v=(b,c)} =
   let sigma, c = interp_open_constr ist env sigma c in
-  sigma, (loc,interp_binding_name ist b,c)
+  sigma, (make ?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_map (interp_binding ist env) sigma l in
+    let sigma, l = List.fold_left_map (interp_binding ist env) sigma l in
     sigma, ExplicitBindings l
 
 let interp_constr_with_bindings ist env sigma (c,bl) =
   let sigma, bl = interp_bindings ist env sigma bl in
-  let sigma, c = interp_open_constr ist env sigma c in
+  let sigma, c = interp_constr ist env sigma c in
   sigma, (c,bl)
 
 let interp_open_constr_with_bindings ist env sigma (c,bl) =
@@ -1019,54 +871,47 @@ let interp_open_constr_with_bindings ist env sigma (c,bl) =
   sigma, (c, bl)
 
 let loc_of_bindings = function
-| NoBindings -> Loc.ghost
+| NoBindings         -> None
 | ImplicitBindings l -> loc_of_glob_constr (fst (List.last l))
-| ExplicitBindings l -> pi1 (List.last l)
+| ExplicitBindings l -> (List.last l).loc
 
 let interp_open_constr_with_bindings_loc ist ((c,_),bl as cb) =
   let loc1 = loc_of_glob_constr c in
   let loc2 = loc_of_bindings bl in
-  let loc = if Loc.is_ghost loc2 then loc1 else Loc.merge loc1 loc2 in
-  let f = { delayed = fun env sigma ->
-    let sigma = Sigma.to_evar_map sigma in
-    let (sigma, c) = interp_open_constr_with_bindings ist env sigma cb in
-    Sigma.Unsafe.of_pair (c, sigma)
-  } in
-    (loc,f)
+  let loc  = Loc.merge_opt loc1 loc2 in
+  let f env sigma = interp_open_constr_with_bindings ist env sigma cb in
+  (loc,f)
 
 let interp_destruction_arg ist gl arg =
   match arg with
   | keep,ElimOnConstr c ->
-      keep,ElimOnConstr { delayed = fun env sigma ->
-        let sigma = Sigma.to_evar_map sigma in
-        let (sigma, c) = interp_constr_with_bindings ist env sigma c in
-        Sigma.Unsafe.of_pair (c, sigma)
-      }
+      keep,ElimOnConstr begin fun env sigma ->
+        interp_open_constr_with_bindings ist env sigma c
+      end
   | keep,ElimOnAnonHyp n as x -> x
-  | keep,ElimOnIdent (loc,id) ->
-      let error () = user_err_loc (loc, "",
-        strbrk "Cannot coerce " ++ pr_id 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 (make ?loc id')
         else
-          (keep, ElimOnConstr { delayed = begin fun env sigma ->
-          try Sigma.here (constr_of_id env id', NoBindings) sigma
+          (keep, ElimOnConstr begin fun env sigma ->
+          try (sigma, (constr_of_id env id', NoBindings))
           with Not_found ->
-            user_err_loc (loc, "interp_destruction_arg",
-            pr_id id ++ strbrk " binds to " ++ pr_id id' ++ strbrk " which is neither a declared nor a quantified hypothesis.")
-          end })
+            user_err ?loc  ~hdr:"interp_destruction_arg" (
+            Id.print id ++ strbrk " binds to " ++ Id.print id' ++ strbrk " which is neither a declared nor a quantified hypothesis.")
+          end)
       in
       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
-          | _, IntroNaming (IntroIdentifier id) -> try_cast_id id
+          | {v=IntroNaming (IntroIdentifier id)} -> try_cast_id id
           | _ -> error ()
         else if has_type v (topwit wit_var) then
           let id = out_gen (topwit wit_var) v in
@@ -1075,18 +920,17 @@ let interp_destruction_arg ist gl arg =
           keep,ElimOnAnonHyp (out_gen (topwit wit_int) v)
         else match Value.to_constr v with
         | None -> error ()
-        | Some c -> keep,ElimOnConstr { delayed = fun env sigma -> Sigma ((c,NoBindings), sigma, Sigma.refl) }
+        | Some c -> keep,ElimOnConstr (fun env sigma -> (sigma, (c,NoBindings)))
       with Not_found ->
 	(* We were in non strict (interactive) mode *)
 	if Tactics.is_quantified_hypothesis id gl then
-          keep,ElimOnIdent (loc,id)
+          keep,ElimOnIdent (make ?loc id)
 	else
-          let c = (GVar (loc,id),Some (CRef (Ident (loc,id),None))) in
-          let f = { delayed = fun env sigma ->
-            let sigma = Sigma.to_evar_map sigma in
+          let c = (DAst.make ?loc @@ GVar id,Some (make @@ CRef (make ?loc @@ Ident id,None))) in
+          let f env sigma =
             let (sigma,c) = interp_open_constr ist env sigma c in
-            Sigma.Unsafe.of_pair ((c,NoBindings), sigma)
-          } in
+            (sigma, (c,NoBindings))
+          in
           keep,ElimOnConstr f
 
 (* Associates variables with values and gives the remaining variables and
@@ -1096,8 +940,8 @@ let head_with_value (lvar,lval) =
     | ([],[]) -> (lacc,[],[])
     | (vr::tvr,ve::tve) ->
       (match vr with
-      |	None -> head_with_value_rec lacc (tvr,tve)
-      | Some v -> head_with_value_rec ((v,ve)::lacc) (tvr,tve))
+      |	Anonymous -> head_with_value_rec lacc (tvr,tve)
+      | Name v -> head_with_value_rec ((v,ve)::lacc) (tvr,tve))
     | (vr,[]) -> (lacc,vr,[])
     | ([],ve) -> (lacc,[],ve)
   in
@@ -1117,24 +961,24 @@ 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 *)
 let cons_and_check_name id l =
   if Id.List.mem id l then
-    user_err_loc (dloc,"read_match_goal_hyps",
-      str "Hypothesis pattern-matching variable " ++ pr_id id ++
+    user_err ~hdr:"read_match_goal_hyps" (
+      str "Hypothesis pattern-matching variable " ++ Id.print id ++
       str " used twice in the same pattern.")
   else id::l
 
 let rec read_match_goal_hyps lfun ist env sigma lidh = function
-  | (Hyp ((loc,na) as locna,mp))::tl ->
-      let lidh' = name_fold cons_and_check_name na lidh in
+  | (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 ->
-      let lidh' = name_fold cons_and_check_name na lidh in
+  | (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)
   | [] -> []
@@ -1147,6 +991,20 @@ let rec read_match_rule lfun ist env sigma = function
       :: read_match_rule lfun ist env sigma tl
   | [] -> []
 
+(* Fully evaluate an untyped constr *)
+let type_uconstr ?(flags = {(constr_flags ()) with use_hook = None })
+  ?(expected_type = WithoutTypeConstraint) ist c =
+  begin fun env sigma ->
+  let { closure; term } = c in
+  let vars = {
+    ltac_constrs = closure.typed;
+    ltac_uconstrs = closure.untyped;
+    ltac_idents = closure.idents;
+    ltac_genargs = Id.Map.empty;
+  } in
+  understand_ltac flags env sigma vars expected_type term
+  end
+
 let warn_deprecated_info =
   CWarnings.create ~name:"deprecated-info-tactical" ~category:"deprecated"
          (fun () ->
@@ -1184,7 +1042,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) ->
@@ -1192,8 +1050,7 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
       push_trace(loc,call) ist >>= fun trace ->
       Profile_ltac.do_profile "eval_tactic:2" trace
         (catch_error_tac trace (interp_atomic ist t))
-  | TacFun _ | TacLetIn _ -> assert false
-  | TacMatchGoal _ | TacMatch _ -> assert false
+  | TacFun _ | TacLetIn _ | TacMatchGoal _ | TacMatch _ -> interp_tactic ist tac
   | TacId [] -> Proofview.tclLIFT (db_breakpoint (curr_debug ist) [])
   | TacId s ->
       let msgnl =
@@ -1221,10 +1078,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) ->
-      Proofview.Goal.nf_enter { enter = begin fun gl -> Tactics.tclABSTRACT
-        (Option.map (pf_interp_ident ist gl) ido) (interp_tactic ist tac)
-      end }
+  | 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 t)
+      end end)
   | TacThen (t1,t) ->
       Tacticals.New.tclTHEN (interp_tactic ist t1) (interp_tactic ist t)
   | TacDispatch tl ->
@@ -1264,7 +1125,7 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
       eval_tactic ist tac
   | TacSelect (sel, tac) -> Tacticals.New.tclSELECT sel (interp_tactic ist tac)
   (* For extensions *)
-  | TacAlias (loc,s,l) ->
+  | TacAlias (loc,(s,l)) ->
       let (ids, body) = Tacenv.interp_alias s in
       let (>>=) = Ftactic.bind in
       let interp_vars = Ftactic.List.map (fun v -> interp_tacarg ist v) l in
@@ -1295,8 +1156,8 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
       in
       Ftactic.run tac (fun () -> Proofview.tclUNIT ())
 
-  | TacML (loc,opn,l) ->
-      push_trace (loc,LtacMLCall tac) ist >>= fun trace ->
+  | TacML (loc,(opn,l)) ->
+      push_trace (Loc.tag ?loc @@ LtacMLCall tac) ist >>= fun trace ->
       let ist = { ist with extra = TacStore.set ist.extra f_trace trace; } in
       let tac = Tacenv.interp_ml_tactic opn in
       let args = Ftactic.List.map_right (fun a -> interp_tacarg ist a) l in
@@ -1307,7 +1168,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
@@ -1315,9 +1175,9 @@ and force_vrec ist v : Val.t Ftactic.t =
     | v -> Ftactic.return (of_tacvalue v)
   else Ftactic.return v
 
-and interp_ltac_reference loc' mustbetac ist r : 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
@@ -1328,46 +1188,49 @@ 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 loc_info = ((if Loc.is_ghost loc' then loc else loc'),LtacNameCall r) 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
   | TacGeneric arg -> interp_genarg ist arg
-  | Reference r -> interp_ltac_reference dloc false ist r
+  | Reference r -> interp_ltac_reference false ist r
   | ConstrMayEval c ->
-      Ftactic.s_enter { s_enter = begin fun gl ->
+      Ftactic.enter begin fun gl ->
         let sigma = project gl in
         let env = Proofview.Goal.env gl in
         let (sigma,c_interp) = interp_constr_may_eval ist env sigma c in
-        Sigma.Unsafe.of_pair (Ftactic.return (Value.of_constr c_interp), sigma)
-      end }
-  | TacCall (loc,r,[]) ->
-      interp_ltac_reference loc true ist r
-  | TacCall (loc,f,l) ->
+        Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+        (Ftactic.return (Value.of_constr c_interp))
+      end
+  | TacCall (loc,(r,[])) ->
+      interp_ltac_reference true ist r
+  | TacCall (loc,(f,l)) ->
       let (>>=) = Ftactic.bind in
-      interp_ltac_reference loc true ist f >>= fun fv ->
+      interp_ltac_reference true ist f >>= fun fv ->
       Ftactic.List.map (fun a -> interp_tacarg ist a) l >>= fun largs ->
       interp_app loc ist fv largs
   | TacFreshId l ->
-      Ftactic.enter { enter = begin fun gl ->
+      Ftactic.enter begin fun gl ->
         let id = interp_fresh_id ist (pf_env gl) (project gl) l in
-        Ftactic.return (in_gen (topwit wit_intro_pattern) (dloc, IntroNaming (IntroIdentifier id)))
-      end }
+        Ftactic.return (in_gen (topwit wit_intro_pattern) (make @@ IntroNaming (IntroIdentifier id)))
+      end
   | TacPretype c ->
-      Ftactic.s_enter { s_enter = begin fun gl ->
+      Ftactic.enter begin fun gl ->
         let sigma = Proofview.Goal.sigma gl in
         let env = Proofview.Goal.env gl in
-        let c = interp_uconstr ist env c in
-        let Sigma (c, sigma, p) = (type_uconstr ist c).delayed env sigma in
-        Sigma (Ftactic.return (Value.of_constr c), sigma, p)
-      end }
+        let c = interp_uconstr ist env sigma c in
+        let (sigma, c) = type_uconstr ist c env sigma in
+        Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+        (Ftactic.return (Value.of_constr c))
+      end
   | TacNumgoals ->
       Ftactic.lift begin
         let open Proofview.Notations in
@@ -1380,7 +1243,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
@@ -1399,7 +1261,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) ->
@@ -1409,20 +1272,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) ->
@@ -1431,7 +1303,39 @@ 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 _|VRec _) -> Tacticals.New.tclZEROMSG (str "A fully applied tactic is expected.")
+  | 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
     tactic_of_value ist tac
@@ -1441,9 +1345,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 v = of_tacvalue (VRec (lref, TacArg (dloc, b))) in
-    Id.Map.add id v accu
+  let fold accu ({v=na}, b) =
+    let v = of_tacvalue (VRec (lref, TacArg (Loc.tag b))) in
+    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
@@ -1456,9 +1360,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
 
@@ -1521,16 +1425,16 @@ and interp_match ist lz constr lmr =
           Proofview.tclZERO ~info e
     end
   end >>= fun constr ->
-  Ftactic.enter { enter = begin fun gl ->
+  Ftactic.enter begin fun gl ->
     let sigma = project gl in
     let env = Proofview.Goal.env gl in
     let ilr = read_match_rule (extract_ltac_constr_values ist env) ist env sigma lmr in
     interp_match_successes lz ist (Tactic_matching.match_term env sigma constr ilr)
-  end }
+  end
 
 (* Interprets the Match Context expressions *)
 and interp_match_goal ist lz lr lmr =
-    Ftactic.nf_enter { enter = begin fun gl ->
+    Ftactic.enter begin fun gl ->
       let sigma = project gl in
       let env = Proofview.Goal.env gl in
       let hyps = Proofview.Goal.hyps gl in
@@ -1538,7 +1442,7 @@ and interp_match_goal ist lz lr lmr =
       let concl = Proofview.Goal.concl gl in
       let ilr = read_match_rule (extract_ltac_constr_values ist env) ist env sigma lmr in
       interp_match_successes lz ist (Tactic_matching.match_goal env sigma hyps concl ilr)
-    end }
+    end
 
 (* Interprets extended tactic generic arguments *)
 and interp_genarg ist x : Val.t Ftactic.t =
@@ -1575,33 +1479,34 @@ and interp_genarg ist x : Val.t Ftactic.t =
     independently of goals. *)
 
 and interp_genarg_constr_list ist x =
-  Ftactic.nf_s_enter { s_enter = begin fun gl ->
+  Ftactic.nf_enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+  let sigma = Proofview.Goal.sigma gl in
   let lc = Genarg.out_gen (glbwit (wit_list wit_constr)) x in
   let (sigma,lc) = interp_constr_list ist env sigma lc in
   let lc = in_list (val_tag wit_constr) lc in
-  Sigma.Unsafe.of_pair (Ftactic.return lc, sigma)
-  end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  (Ftactic.return lc)
+  end
 
 and interp_genarg_var_list ist x =
-  Ftactic.enter { enter = begin fun gl ->
+  Ftactic.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+  let sigma = Proofview.Goal.sigma gl in
   let lc = Genarg.out_gen (glbwit (wit_list wit_var)) x in
   let lc = interp_hyp_list ist env sigma lc in
   let lc = in_list (val_tag wit_var) lc in
   Ftactic.return lc
-  end }
+  end
 
 (* Interprets tactic expressions : returns a "constr" *)
-and interp_ltac_constr ist e : constr Ftactic.t =
+and interp_ltac_constr ist e : EConstr.t Ftactic.t =
   let (>>=) = Ftactic.bind in
   begin Proofview.tclORELSE
       (val_interp ist e)
       begin function (err, info) -> match err with
         | Not_found ->
-            Ftactic.enter { enter = begin fun gl ->
+            Ftactic.enter begin fun gl ->
               let env = Proofview.Goal.env gl in
               Proofview.tclLIFT begin
                 debugging_step ist (fun () ->
@@ -1609,28 +1514,27 @@ and interp_ltac_constr ist e : constr Ftactic.t =
                     Pptactic.pr_glob_tactic env e)
               end
             <*> Proofview.tclZERO Not_found
-            end }
+            end
         | err -> Proofview.tclZERO ~info err
       end
   end >>= fun result ->
-  Ftactic.enter { enter = begin fun gl ->
+  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
       debugging_step ist (fun () ->
         Pptactic.pr_glob_tactic env e ++ fnl() ++
           str " has value " ++ fnl() ++
-          pr_constr_env env sigma cresult)
+          pr_econstr_env env sigma cresult)
     end <*>
     Ftactic.return cresult
   with CannotCoerceTo _ ->
     let env = Proofview.Goal.env gl in
     Tacticals.New.tclZEROMSG (str "Must evaluate to a closed term" ++ fnl() ++
       str "offending expression: " ++ fnl() ++ pr_inspect env e result)
-  end }
+  end
 
 
 (* Interprets tactic expressions : returns a "tactic" *)
@@ -1643,7 +1547,8 @@ and name_atomic ?env tacexpr tac : unit Proofview.tactic =
   | Some e -> Proofview.tclUNIT e
   | None -> Proofview.tclENV
   end >>= fun env ->
-  let name () = Pptactic.pr_atomic_tactic env tacexpr in
+  Proofview.tclEVARMAP >>= fun sigma ->
+  let name () = Pptactic.pr_atomic_tactic env sigma tacexpr in
   Proofview.Trace.name_tactic name tac
 
 (* Interprets a primitive tactic *)
@@ -1651,7 +1556,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
   match tac with
   (* Basic tactics *)
   | TacIntroPattern (ev,l) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let sigma,l' = interp_intro_pattern_list_as_list ist env sigma l in
@@ -1661,16 +1566,16 @@ and interp_atomic ist tac : unit Proofview.tactic =
           (* spiwack: print uninterpreted, not sure if it is the
              expected behaviour. *)
           (Tactics.intro_patterns ev l')) sigma
-      end }
+      end
   | TacApply (a,ev,cb,cl) ->
       (* spiwack: until the tactic is in the monad *)
       Proofview.Trace.name_tactic (fun () -> Pp.str"<apply>") begin
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
 	let l = List.map (fun (k,c) ->
           let loc, f = interp_open_constr_with_bindings_loc ist c in
-	    (k,(loc,f))) cb 
+            (k,(make ?loc f))) cb
 	in
         let sigma,tac = match cl with
           | None -> sigma, Tactics.apply_with_delayed_bindings_gen a ev l
@@ -1678,77 +1583,80 @@ and interp_atomic ist tac : unit Proofview.tactic =
               let sigma,(id,cl) = interp_in_hyp_as ist env sigma cl in
               sigma, Tactics.apply_delayed_in a ev id l cl in
         Tacticals.New.tclWITHHOLES ev tac sigma
-      end }
+      end
       end
   | TacElim (ev,(keep,cb),cbo) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in 
-        let sigma, cb = interp_constr_with_bindings ist env sigma cb in
-        let sigma, cbo = Option.fold_map (interp_constr_with_bindings ist env) sigma cbo in
+        let sigma, cb = interp_open_constr_with_bindings ist env sigma cb in
+        let sigma, cbo = Option.fold_left_map (interp_open_constr_with_bindings ist env) sigma cbo in
         let named_tac =
           let tac = Tactics.elim ev keep cb cbo in
           name_atomic ~env (TacElim (ev,(keep,cb),cbo)) tac
         in
         Tacticals.New.tclWITHHOLES ev named_tac sigma
-      end }
+      end
   | TacCase (ev,(keep,cb)) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let sigma = project gl in
         let env = Proofview.Goal.env gl in
-        let sigma, cb = interp_constr_with_bindings ist env sigma cb in
+        let sigma, cb = interp_open_constr_with_bindings ist env sigma cb in
         let named_tac =
           let tac = Tactics.general_case_analysis ev keep cb in
           name_atomic ~env (TacCase(ev,(keep,cb))) tac
         in
         Tacticals.New.tclWITHHOLES ev named_tac sigma
-      end }
+      end
   | TacMutualFix (id,n,l) ->
       (* spiwack: until the tactic is in the monad *)
       Proofview.Trace.name_tactic (fun () -> Pp.str"<mutual fix>") begin
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+      Proofview.Goal.nf_enter begin fun gl ->
         let env = pf_env gl in
         let f sigma (id,n,c) =
-          let (sigma,c_interp) = pf_interp_type ist env sigma c in
+          let (sigma,c_interp) = interp_type ist env sigma c in
 	  sigma , (interp_ident ist env sigma id,n,c_interp) in
         let (sigma,l_interp) =
           Evd.MonadR.List.map_right (fun c sigma -> f sigma c) l (project gl)
         in
-        let tac = Tactics.mutual_fix (interp_ident ist env sigma id) n l_interp 0 in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      end }
+        Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+        (Tactics.mutual_fix (interp_ident ist env sigma id) n l_interp 0)
+      end
       end
   | TacMutualCofix (id,l) ->
       (* spiwack: until the tactic is in the monad *)
       Proofview.Trace.name_tactic (fun () -> Pp.str"<mutual cofix>") begin
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+      Proofview.Goal.nf_enter begin fun gl ->
         let env = pf_env gl in
         let f sigma (id,c) =
-	  let (sigma,c_interp) = pf_interp_type ist env sigma c in
+	  let (sigma,c_interp) = interp_type ist env sigma c in
 	  sigma , (interp_ident ist env sigma id,c_interp) in
         let (sigma,l_interp) =
           Evd.MonadR.List.map_right (fun c sigma -> f sigma c) l (project gl)
         in
-        let tac = Tactics.mutual_cofix (interp_ident ist env sigma id) l_interp 0 in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      end }
+        Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+        (Tactics.mutual_cofix (interp_ident ist env sigma id) l_interp 0)
+      end
       end
-  | TacAssert (b,t,ipat,c) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+  | TacAssert (ev,b,t,ipat,c) ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
-        let (sigma,c) = 
-          (if Option.is_empty t then interp_constr else interp_type) ist env sigma c
+        let (sigma,c) =
+          let expected_type =
+            if Option.is_empty t then WithoutTypeConstraint else IsType in
+          let flags = open_constr_use_classes_flags () in
+          interp_open_constr ~expected_type ~flags ist env sigma c
         in
         let sigma, ipat' = interp_intro_pattern_option ist env sigma ipat in
         let tac = Option.map (Option.map (interp_tactic ist)) t in
-        Tacticals.New.tclWITHHOLES false
+        Tacticals.New.tclWITHHOLES ev
         (name_atomic ~env
-          (TacAssert(b,Option.map (Option.map ignore) t,ipat,c))
+          (TacAssert(ev,b,Option.map (Option.map ignore) t,ipat,c))
           (Tactics.forward b tac ipat' c)) sigma
-      end }
+      end
   | TacGeneralize cl ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let sigma = project gl in
         let env = Proofview.Goal.env gl in
         let sigma, cl = interp_constr_with_occurrences_and_name_as_list ist env sigma cl in
@@ -1756,52 +1664,51 @@ and interp_atomic ist tac : unit Proofview.tactic =
         (name_atomic ~env
           (TacGeneralize cl)
           (Tactics.generalize_gen cl)) sigma
-      end }
-  | TacLetTac (na,c,clp,b,eqpat) ->
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.nf_enter { enter = begin fun gl ->
+      end
+  | TacLetTac (ev,na,c,clp,b,eqpat) ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let clp = interp_clause ist env sigma clp in
         let eqpat = interp_intro_pattern_naming_option ist env sigma eqpat in
-        if Locusops.is_nowhere clp then
+        if Locusops.is_nowhere clp (* typically "pose" *) then
         (* We try to fully-typecheck the term *)
-          let (sigma,c_interp) = pf_interp_constr ist gl c in
+          let flags = open_constr_use_classes_flags () in
+          let (sigma,c_interp) = interp_open_constr ~flags ist env sigma c in
           let let_tac b na c cl eqpat =
-            let id = Option.default (Loc.ghost,IntroAnonymous) eqpat in
+            let id = Option.default (make IntroAnonymous) eqpat in
             let with_eq = if b then None else Some (true,id) in
             Tactics.letin_tac with_eq na c None cl
           in
           let na = interp_name ist env sigma na in
-          Tacticals.New.tclWITHHOLES false
+          Tacticals.New.tclWITHHOLES ev
           (name_atomic ~env
-            (TacLetTac(na,c_interp,clp,b,eqpat))
+            (TacLetTac(ev,na,c_interp,clp,b,eqpat))
             (let_tac b na c_interp clp eqpat)) sigma
         else
         (* We try to keep the pattern structure as much as possible *)
           let let_pat_tac b na c cl eqpat =
-            let id = Option.default (Loc.ghost,IntroAnonymous) eqpat in
+            let id = Option.default (make IntroAnonymous) eqpat in
             let with_eq = if b then None else Some (true,id) in
-            Tactics.letin_pat_tac with_eq na c cl
+            Tactics.letin_pat_tac ev with_eq na c cl
           in
           let (sigma',c) = interp_pure_open_constr ist env sigma c in
           name_atomic ~env
-            (TacLetTac(na,c,clp,b,eqpat))
-	    (Tacticals.New.tclWITHHOLES false (*in hope of a future "eset/epose"*)
+            (TacLetTac(ev,na,c,clp,b,eqpat))
+	    (Tacticals.New.tclWITHHOLES ev
                (let_pat_tac b (interp_name ist env sigma na)
-                  ((sigma,sigma'),c) clp eqpat) sigma')
-      end }
+                  (sigma,c) clp eqpat) sigma')
+      end
 
   (* Derived basic tactics *)
   | TacInductionDestruct (isrec,ev,(l,el)) ->
       (* spiwack: some unknown part of destruct needs the goal to be
          prenormalised. *)
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+      Proofview.Goal.nf_enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let sigma,l =
-          List.fold_map begin fun sigma (c,(ipato,ipats),cls) ->
+          List.fold_left_map begin fun sigma (c,(ipato,ipats),cls) ->
             (* TODO: move sigma as a side-effect *)
              (* spiwack: the [*p] variants are for printing *)
             let cp = c in
@@ -1815,25 +1722,24 @@ and interp_atomic ist tac : unit Proofview.tactic =
         in
         let l,lp = List.split l in
         let sigma,el =
-          Option.fold_map (interp_constr_with_bindings ist env) sigma el in
-        let tac = name_atomic ~env
+          Option.fold_left_map (interp_open_constr_with_bindings ist env) sigma el in
+        Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+        (name_atomic ~env
           (TacInductionDestruct(isrec,ev,(lp,el)))
-            (Tactics.induction_destruct isrec ev (l,el))
-        in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      end }
+            (Tactics.induction_destruct isrec ev (l,el)))
+      end
 
   (* Conversion *)
   | TacReduce (r,cl) ->
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+      Proofview.Goal.nf_enter begin fun gl ->
         let (sigma,r_interp) = interp_red_expr ist (pf_env gl) (project gl) r in
-        Sigma.Unsafe.of_pair (Tactics.reduce r_interp (interp_clause ist (pf_env gl) (project gl) cl), sigma)
-      end }
+        Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+        (Tactics.reduce r_interp (interp_clause ist (pf_env gl) (project gl) cl))
+      end
   | TacChange (None,c,cl) ->
       (* spiwack: until the tactic is in the monad *)
       Proofview.Trace.name_tactic (fun () -> Pp.str"<change>") begin
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.nf_enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let is_onhyps = match cl.onhyps with
           | None | Some [] -> true
           | _ -> false
@@ -1842,59 +1748,50 @@ and interp_atomic ist tac : unit Proofview.tactic =
           | AllOccurrences | NoOccurrences -> true
           | _ -> false
         in
-        let c_interp patvars = { Sigma.run = begin fun sigma ->
+        let c_interp patvars sigma =
 	  let lfun' = Id.Map.fold (fun id c lfun ->
 	    Id.Map.add id (Value.of_constr c) lfun) 
 	    patvars ist.lfun
 	  in
-	  let sigma = Sigma.to_evar_map sigma in
 	  let ist = { ist with lfun = lfun' } in
-	  let (sigma, c) =
             if is_onhyps && is_onconcl
             then interp_type ist (pf_env gl) sigma c
             else interp_constr ist (pf_env gl) sigma c
-          in
-          Sigma.Unsafe.of_pair (c, sigma)
-        end } in
+        in
         Tactics.change None c_interp (interp_clause ist (pf_env gl) (project gl) cl)
-      end }
+      end
       end
   | TacChange (Some op,c,cl) ->
       (* spiwack: until the tactic is in the monad *)
       Proofview.Trace.name_tactic (fun () -> Pp.str"<change>") begin
-      Proofview.V82.nf_evar_goals <*>
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let op = interp_typed_pattern ist env sigma op in
         let to_catch = function Not_found -> true | e -> CErrors.is_anomaly e in
-        let c_interp patvars = { Sigma.run = begin fun sigma ->
+        let c_interp patvars sigma =
           let lfun' = Id.Map.fold (fun id c lfun ->
             Id.Map.add id (Value.of_constr c) lfun) 
             patvars ist.lfun
           in
           let ist = { ist with lfun = lfun' } in
             try
-              let sigma = Sigma.to_evar_map sigma in
-              let (sigma, c) = interp_constr ist env sigma c in
-              Sigma.Unsafe.of_pair (c, sigma)
+              interp_constr ist env sigma c
             with e when to_catch e (* Hack *) ->
-              errorlabstrm "" (strbrk "Failed to get enough information from the left-hand side to type the right-hand side.")
-        end } in
+              user_err  (strbrk "Failed to get enough information from the left-hand side to type the right-hand side.")
+        in
         Tactics.change (Some op) c_interp (interp_clause ist env sigma cl)
-      end }
+      end
       end
 
 
   (* Equality and inversion *)
   | TacRewrite (ev,l,cl,by) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let l' = List.map (fun (b,m,(keep,c)) ->
-          let f = { delayed = fun env sigma ->
-            let sigma = Sigma.to_evar_map sigma in
-            let (sigma, c) = interp_open_constr_with_bindings ist env sigma c in
-            Sigma.Unsafe.of_pair (c, sigma)
-          } in
+          let f env sigma =
+            interp_open_constr_with_bindings ist env sigma c
+          in
 	  (b,m,keep,f)) l in
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
@@ -1905,16 +1802,16 @@ and interp_atomic ist tac : unit Proofview.tactic =
              (Option.map (fun by -> Tacticals.New.tclCOMPLETE (interp_tactic ist by),
                Equality.Naive)
                 by))
-      end }
+      end
   | TacInversion (DepInversion (k,c,ids),hyp) ->
-      Proofview.Goal.nf_enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let (sigma,c_interp) =
           match c with
           | None -> sigma , None
           | Some c ->
-              let (sigma,c_interp) = pf_interp_constr ist gl c in
+              let (sigma,c_interp) = interp_constr ist env sigma c in
               sigma , Some c_interp
         in
         let dqhyps = interp_declared_or_quantified_hypothesis ist env sigma hyp in
@@ -1923,9 +1820,9 @@ and interp_atomic ist tac : unit Proofview.tactic =
         (name_atomic ~env
           (TacInversion(DepInversion(k,c_interp,ids),dqhyps))
           (Inv.dinv k c_interp ids_interp dqhyps)) sigma
-      end }
+      end
   | TacInversion (NonDepInversion (k,idl,ids),hyp) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let hyps = interp_hyp_list ist env sigma idl in
@@ -1935,20 +1832,19 @@ and interp_atomic ist tac : unit Proofview.tactic =
         (name_atomic ~env
           (TacInversion (NonDepInversion (k,hyps,ids),dqhyps))
           (Inv.inv_clause k ids_interp hyps dqhyps)) sigma
-      end }
+      end
   | TacInversion (InversionUsing (c,idl),hyp) ->
-      Proofview.Goal.s_enter { s_enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let (sigma,c_interp) = interp_constr ist env sigma c in
         let dqhyps = interp_declared_or_quantified_hypothesis ist env sigma hyp in
         let hyps = interp_hyp_list ist env sigma idl in
-        let tac = name_atomic ~env
+        Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+        (name_atomic ~env
           (TacInversion (InversionUsing (c_interp,hyps),dqhyps))
-          (Leminv.lemInv_clause dqhyps c_interp hyps)
-        in
-        Sigma.Unsafe.of_pair (tac, sigma)
-      end }
+          (Leminv.lemInv_clause dqhyps c_interp hyps))
+      end
 
 (* Initial call for interpretation *)
 
@@ -1969,25 +1865,23 @@ let eval_tactic_ist ist t =
 
 
 let interp_tac_gen lfun avoid_ids debug t =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let extra = TacStore.set TacStore.empty f_debug debug in
   let extra = TacStore.set extra f_avoid_ids avoid_ids in
   let ist = { lfun = lfun; extra = extra } in
   let ltacvars = Id.Map.domain lfun in
   interp_tactic ist
-    (intern_pure_tactic {
-      ltacvars; genv = env } t)
-  end }
+    (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 _ = Proof_global.set_interp_tac interp
+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. *)
 let hide_interp global t ot =
   let hide_interp env =
-    let ist = { ltacvars = Id.Set.empty; genv = env } in
+    let ist = Genintern.empty_glob_sign env in
     let te = intern_pure_tactic ist t in
     let t = eval_tactic te in
     match ot with
@@ -1998,9 +1892,9 @@ let hide_interp global t ot =
     Proofview.tclENV >>= fun env ->
     hide_interp env
   else
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       hide_interp (Proofview.Goal.env gl)
-    end }
+    end
 
 (***************************************************************************)
 (** Register standard arguments *)
@@ -2033,39 +1927,43 @@ let () =
 let () =
   declare_uniform wit_string
 
-let () =
-  declare_uniform wit_pre_ident
-
-let lift f = (); fun ist x -> Ftactic.enter { enter = begin fun gl ->
+let lift f = (); fun ist x -> Ftactic.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+  let sigma = Proofview.Goal.sigma gl in
   Ftactic.return (f ist env sigma x)
-end }
+end
 
-let lifts f = (); fun ist x -> Ftactic.nf_s_enter { s_enter = begin fun gl ->
+let lifts f = (); fun ist x -> Ftactic.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+  let sigma = Proofview.Goal.sigma gl in
   let (sigma, v) = f ist env sigma x in
-  Sigma.Unsafe.of_pair (Ftactic.return v, sigma)
-end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  (Ftactic.return v)
+end
 
-let interp_bindings' ist bl = Ftactic.return { delayed = fun env sigma ->
-  let (sigma, bl) = interp_bindings ist env (Sigma.to_evar_map sigma) bl in
-  Sigma.Unsafe.of_pair (bl, sigma)
-  }
+let interp_bindings' ist bl = Ftactic.return begin fun env sigma ->
+  interp_bindings ist env sigma bl
+  end
 
-let interp_constr_with_bindings' ist c = Ftactic.return { delayed = fun env sigma ->
-  let (sigma, c) = interp_constr_with_bindings ist env (Sigma.to_evar_map sigma) c in
-  Sigma.Unsafe.of_pair (c, sigma)
-  }
+let interp_constr_with_bindings' ist c = Ftactic.return begin fun env sigma ->
+  interp_constr_with_bindings ist env sigma c
+  end
+
+let interp_open_constr_with_bindings' ist c = Ftactic.return begin fun env sigma ->
+  interp_open_constr_with_bindings ist env sigma c
+  end
 
-let interp_destruction_arg' ist c = Ftactic.nf_enter { enter = begin fun gl ->
+let interp_destruction_arg' ist c = Ftactic.enter begin fun gl ->
   Ftactic.return (interp_destruction_arg ist gl c)
-end }
+end
+
+let interp_pre_ident ist env sigma s =
+  s |> Id.of_string |> interp_ident ist env sigma |> Id.to_string
 
 let () =
   register_interp0 wit_int_or_var (fun ist n -> Ftactic.return (interp_int_or_var ist n));
   register_interp0 wit_ref (lift interp_reference);
+  register_interp0 wit_pre_ident (lift interp_pre_ident);
   register_interp0 wit_ident (lift interp_ident);
   register_interp0 wit_var (lift interp_hyp);
   register_interp0 wit_intro_pattern (lifts interp_intro_pattern);
@@ -2077,6 +1975,7 @@ let () =
   register_interp0 wit_open_constr (lifts interp_open_constr);
   register_interp0 wit_bindings interp_bindings';
   register_interp0 wit_constr_with_bindings interp_constr_with_bindings';
+  register_interp0 wit_open_constr_with_bindings interp_open_constr_with_bindings';
   register_interp0 wit_destruction_arg interp_destruction_arg';
   ()
 
@@ -2089,9 +1988,9 @@ let () =
   register_interp0 wit_ltac interp
 
 let () =
-  register_interp0 wit_uconstr (fun ist c -> Ftactic.nf_enter { enter = begin fun gl ->
-    Ftactic.return (interp_uconstr ist (Proofview.Goal.env gl) c)
-  end })
+  register_interp0 wit_uconstr (fun ist c -> Ftactic.enter begin fun gl ->
+    Ftactic.return (interp_uconstr ist (Proofview.Goal.env gl) (Tacmach.New.project gl) c)
+  end)
 
 (***************************************************************************)
 (* Other entry points *)
@@ -2109,37 +2008,13 @@ let interp_redexp env sigma r =
 (* Backwarding recursive needs of tactic glob/interp/eval functions *)
 
 let _ =
-  let eval ty env sigma lfun arg =
+  let eval lfun env sigma ty tac =
     let ist = { lfun = lfun; extra = TacStore.empty; } in
-    if Genarg.has_type arg (glbwit wit_tactic) then
-      let tac = Genarg.out_gen (glbwit wit_tactic) arg in
-      let tac = interp_tactic ist tac in
-      Pfedit.refine_by_tactic env sigma ty tac
-    else
-      failwith "not a tactic"
+    let tac = interp_tactic ist tac in
+    let (c, sigma) = Pfedit.refine_by_tactic env sigma ty tac in
+    (EConstr.of_constr c, sigma)
   in
-  Hook.set Pretyping.genarg_interp_hook eval
-
-(** Used in tactic extension **)
-
-let dummy_id = Id.of_string "_"
-
-let lift_constr_tac_to_ml_tac vars tac =
-  let tac _ ist = Proofview.Goal.enter { enter = begin fun gl ->
-    let env = Proofview.Goal.env gl in
-    let sigma = project gl in
-    let map = function
-    | None -> None
-    | Some id ->
-      let c = Id.Map.find id ist.lfun in
-      try Some (coerce_to_closed_constr env c)
-      with CannotCoerceTo ty ->
-        error_ltac_variable Loc.ghost dummy_id (Some (env,sigma)) c ty
-    in
-    let args = List.map_filter map vars in
-    tac args ist
-  end } in
-  tac
+  Pretyping.register_constr_interp0 wit_tactic eval
 
 let vernac_debug b =
   set_debug (if b then Tactic_debug.DebugOn 0 else Tactic_debug.DebugOff)
@@ -2147,8 +2022,7 @@ let vernac_debug b =
 let _ =
   let open Goptions in
   declare_bool_option
-    { optsync  = false;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Ltac debug";
       optkey   = ["Ltac";"Debug"];
       optread  = (fun () -> get_debug () != Tactic_debug.DebugOff);
@@ -2157,8 +2031,7 @@ let _ =
 let _ =
   let open Goptions in
   declare_bool_option
-    { optsync  = false;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Ltac debug";
       optkey   = ["Debug";"Ltac"];
       optread  = (fun () -> get_debug () != Tactic_debug.DebugOff);
diff --git a/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index 6f64981e..bd44bdbe 100644
--- a/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Tactic_debug
-open Term
+open EConstr
 open Tacexpr
 open Genarg
 open Redexpr
@@ -40,11 +42,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]. *)
 
@@ -54,6 +56,11 @@ val set_debug : debug_info -> unit
 (** Gives the state of debug *)
 val get_debug : unit -> debug_info
 
+val type_uconstr :
+  ?flags:Pretyping.inference_flags ->
+  ?expected_type:Pretyping.typing_constraint ->
+  Geninterp.interp_sign -> Ltac_pretype.closed_glob_constr -> constr Tactypes.delayed_open
+
 (** Adds an interpretation function for extra generic arguments *)
 
 val interp_genarg : interp_sign -> glob_generic_argument -> Value.t Ftactic.t
@@ -70,16 +77,32 @@ 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 ->
+  Ltac_pretype.closed_glob_constr
+
+val interp_uconstr : interp_sign -> Environ.env -> Evd.evar_map ->
+  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
 
 val interp_bindings : interp_sign -> Environ.env -> Evd.evar_map ->
- glob_constr_and_expr bindings -> Evd.evar_map * constr bindings
+  glob_constr_and_expr bindings -> Evd.evar_map * constr bindings
+
+val interp_open_constr : ?expected_type:Pretyping.typing_constraint ->
+  ?flags:Pretyping.inference_flags ->
+  interp_sign -> Environ.env -> Evd.evar_map ->
+  glob_constr_and_expr -> Evd.evar_map * EConstr.constr
+
+val interp_open_constr_with_classes : ?expected_type:Pretyping.typing_constraint ->
+  interp_sign -> Environ.env -> Evd.evar_map ->
+  glob_constr_and_expr -> Evd.evar_map * EConstr.constr
 
 val interp_open_constr_with_bindings : interp_sign -> Environ.env -> Evd.evar_map ->
-  glob_constr_and_expr with_bindings -> Evd.evar_map * constr with_bindings
+  glob_constr_and_expr with_bindings -> Evd.evar_map * EConstr.constr with_bindings
 
 (** Initial call for interpretation *)
 
@@ -92,7 +115,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
@@ -104,19 +127,11 @@ 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
 
-val error_ltac_variable : Loc.t -> Id.t ->
-  (Environ.env * Evd.evar_map) option -> value -> string -> 'a
-
-(** Transforms a constr-expecting tactic into a tactic finding its arguments in
-    the Ltac environment according to the given names. *)
-val lift_constr_tac_to_ml_tac : Id.t option list ->
-  (constr list -> Geninterp.interp_sign -> unit Proofview.tactic) -> Tacenv.ml_tactic
-
 val default_ist : unit -> Geninterp.interp_sign
 (** Empty ist with debug set on the current value. *)
diff --git a/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml
index cce4382c..a1d8b087 100644
--- a/ltac/tacsubst.ml
+++ b/plugins/ltac/tacsubst.ml
@@ -1,19 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Tacexpr
 open Mod_subst
 open Genarg
-open Constrarg
+open Stdarg
+open Tacarg
 open Misctypes
 open Globnames
-open Term
 open Genredexpr
 open Patternops
 
@@ -31,8 +33,9 @@ let subst_glob_constr_and_expr subst (c, e) =
 
 let subst_glob_constr = subst_glob_constr_and_expr (* shortening *)
 
-let subst_binding subst (loc,b,c) =
-  (loc,subst_quantified_hypothesis subst b,subst_glob_constr subst c)
+let subst_binding subst =
+  CAst.map (fun (b,c) ->
+      subst_quantified_hypothesis subst b,subst_glob_constr subst c)
 
 let subst_bindings subst = function
   | NoBindings -> NoBindings
@@ -45,13 +48,13 @@ let subst_glob_with_bindings subst (c,bl) =
 let subst_glob_with_bindings_arg subst (clear,c) =
   (clear,subst_glob_with_bindings subst c)
 
-let rec subst_intro_pattern subst = function
-  | loc,IntroAction p -> loc, IntroAction (subst_intro_pattern_action subst p)
-  | loc, IntroNaming _ | loc, IntroForthcoming _ as x -> x
+let rec subst_intro_pattern subst = CAst.map (function
+  | IntroAction p -> IntroAction (subst_intro_pattern_action subst p)
+  | IntroNaming _ | IntroForthcoming _ as x -> x)
 
-and subst_intro_pattern_action subst = function
-  | IntroApplyOn (t,pat) ->
-      IntroApplyOn (subst_glob_constr subst t,subst_intro_pattern subst pat)
+and subst_intro_pattern_action subst = let open CAst in function
+  | IntroApplyOn ({loc;v=t},pat) ->
+    IntroApplyOn (make ?loc @@ subst_glob_constr subst t,subst_intro_pattern subst pat)
   | IntroOrAndPattern l ->
       IntroOrAndPattern (subst_intro_or_and_pattern subst l)
   | IntroInjection l -> IntroInjection (List.map (subst_intro_pattern subst) l)
@@ -76,9 +79,7 @@ let subst_or_var f =  function
   | ArgVar _ as x -> x
   | ArgArg x -> ArgArg (f x)
 
-let dloc = Loc.ghost
-
-let subst_located f (_loc,id) = (dloc,f id)
+let subst_located f = Loc.map f
 
 let subst_reference subst =
   subst_or_var (subst_located (subst_kn subst))
@@ -92,10 +93,11 @@ open Printer
 let subst_global_reference subst =
  let subst_global ref =
   let ref',t' = subst_global subst ref in
-   if not (eq_constr (Universes.constr_of_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') ;
+   if not (is_global ref' t') then
+    (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)
@@ -122,7 +124,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
@@ -147,13 +149,13 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
       TacMutualFix(id,n,List.map (fun (id,n,c) -> (id,n,subst_glob_constr subst c)) l)
   | TacMutualCofix (id,l) ->
       TacMutualCofix (id, List.map (fun (id,c) -> (id,subst_glob_constr subst c)) l)
-  | TacAssert (b,otac,na,c) ->
-      TacAssert (b,Option.map (Option.map (subst_tactic subst)) otac,na,
+  | TacAssert (ev,b,otac,na,c) ->
+      TacAssert (ev,b,Option.map (Option.map (subst_tactic subst)) otac,na,
                  subst_glob_constr subst c)
   | TacGeneralize cl ->
       TacGeneralize (List.map (on_fst (subst_constr_with_occurrences subst))cl)
-  | TacLetTac (id,c,clp,b,eqpat) ->
-    TacLetTac (id,subst_glob_constr subst c,clp,b,eqpat)
+  | TacLetTac (ev,id,c,clp,b,eqpat) ->
+    TacLetTac (ev,id,subst_glob_constr subst c,clp,b,eqpat)
 
   (* Derived basic tactics *)
   | TacInductionDestruct (isrec,ev,(l,el)) ->
@@ -181,7 +183,7 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
       TacInversion (InversionUsing (subst_glob_constr subst c,cl),hyp)
 
 and subst_tactic subst (t:glob_tactic_expr) = match t with
-  | TacAtom (_loc,t) -> TacAtom (dloc, subst_atomic subst t)
+  | TacAtom (_loc,t) -> TacAtom (Loc.tag @@ subst_atomic subst t)
   | TacFun tacfun -> TacFun (subst_tactic_fun subst tacfun)
   | TacLetIn (r,l,u) ->
       let l = List.map (fun (n,b) -> (n,subst_tacarg subst b)) l in
@@ -228,22 +230,22 @@ and subst_tactic subst (t:glob_tactic_expr) = match t with
   | TacFirst l -> TacFirst (List.map (subst_tactic subst) l)
   | TacSolve l -> TacSolve (List.map (subst_tactic subst) l)
   | TacComplete tac -> TacComplete (subst_tactic subst tac)
-  | TacArg (_,a) -> TacArg (dloc,subst_tacarg subst a)
+  | TacArg (_,a) -> TacArg (Loc.tag @@ subst_tacarg subst a)
   | TacSelect (s, tac) -> TacSelect (s, subst_tactic subst tac)
 
   (* For extensions *)
-  | TacAlias (_,s,l) ->
+  | TacAlias (_,(s,l)) ->
       let s = subst_kn subst s in
-      TacAlias (dloc,s,List.map (subst_tacarg subst) l)
-  | TacML (_loc,opn,l) -> TacML (dloc,opn,List.map (subst_tacarg subst) l)
+      TacAlias (Loc.tag (s,List.map (subst_tacarg subst) l))
+  | TacML (loc,(opn,l)) -> TacML (loc, (opn,List.map (subst_tacarg subst) l))
 
 and subst_tactic_fun subst (var,body) = (var,subst_tactic subst body)
 
 and subst_tacarg subst = function
   | Reference r -> Reference (subst_reference subst r)
   | ConstrMayEval c -> ConstrMayEval (subst_raw_may_eval subst c)
-  | TacCall (_loc,f,l) ->
-      TacCall (_loc, subst_reference subst f, List.map (subst_tacarg subst) l)
+  | TacCall (loc,(f,l)) ->
+      TacCall (Loc.tag ?loc (subst_reference subst f, List.map (subst_tacarg subst) l))
   | TacFreshId _ as x -> x
   | TacPretype c -> TacPretype (subst_glob_constr subst c)
   | TacNumgoals -> TacNumgoals
@@ -290,6 +292,7 @@ and subst_genarg subst (GenArg (Glbwit wit, x)) =
 let () =
   Genintern.register_subst0 wit_int_or_var (fun _ v -> v);
   Genintern.register_subst0 wit_ref subst_global_reference;
+  Genintern.register_subst0 wit_pre_ident (fun _ v -> v);
   Genintern.register_subst0 wit_ident (fun _ v -> v);
   Genintern.register_subst0 wit_var (fun _ v -> v);
   Genintern.register_subst0 wit_intro_pattern (fun _ v -> v);
diff --git a/ltac/tacsubst.mli b/plugins/ltac/tacsubst.mli
index c1bf2725..0a894791 100644
--- a/ltac/tacsubst.mli
+++ b/plugins/ltac/tacsubst.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Tacexpr
diff --git a/ltac/tactic_debug.ml b/plugins/ltac/tactic_debug.ml
index 5cbddc7f..bb815dcb 100644
--- a/ltac/tactic_debug.ml
+++ b/plugins/ltac/tactic_debug.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -11,9 +13,6 @@ open Names
 open Pp
 open Tacexpr
 open Termops
-open Nameops
-open Proofview.Notations
-
 
 let (ltac_trace_info : ltac_trace Exninfo.t) = Exninfo.make ()
 
@@ -23,7 +22,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
@@ -51,16 +52,16 @@ let db_pr_goal gl =
   let env = Proofview.Goal.env gl in
   let concl = Proofview.Goal.concl gl in
   let penv = print_named_context env in
-  let pc = print_constr_env env concl in
+  let pc = print_constr_env env (Tacmach.New.project gl) concl in
     str"  " ++ hv 0 (penv ++ fnl () ++
                    str "============================" ++ fnl ()  ++
                    str" "  ++ pc) ++ fnl ()
 
 let db_pr_goal =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.nf_enter begin fun gl ->
   let pg = db_pr_goal gl in
   Proofview.tclLIFT (msg_tac_notice (str "Goal:" ++ fnl () ++ pg))
-  end }
+  end
 
 
 (* Prints the commands *)
@@ -85,6 +86,18 @@ let skipped = Proofview.NonLogical.run (Proofview.NonLogical.ref 0)
 let skip = Proofview.NonLogical.run (Proofview.NonLogical.ref 0)
 let breakpoint = Proofview.NonLogical.run (Proofview.NonLogical.ref None)
 
+let batch = ref false
+
+open Goptions
+
+let _ =
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "Ltac batch debug";
+      optkey   = ["Ltac";"Batch";"Debug"];
+      optread  = (fun () -> !batch);
+      optwrite = (fun x -> batch := x) }
+
 let rec drop_spaces inst i =
   if String.length inst > i && inst.[i] == ' ' then drop_spaces inst (i+1)
   else i
@@ -108,6 +121,8 @@ let string_get s i =
   try Proofview.NonLogical.return (String.get s i)
   with e -> Proofview.NonLogical.raise e
 
+let run_invalid_arg () = Proofview.NonLogical.raise (Invalid_argument "run_com")
+
 (* Gives the number of steps or next breakpoint of a run command *)
 let run_com inst =
   let open Proofview.NonLogical in
@@ -118,14 +133,14 @@ let run_com inst =
       let s = String.sub inst i (String.length inst - i) in
       if inst.[0] >= '0' && inst.[0] <= '9' then
         int_of_string s >>= fun num ->
-        (if num<0 then invalid_arg "run_com" else return ()) >>
+        (if num<0 then run_invalid_arg () else return ()) >>
         (skip:=num) >> (skipped:=0)
       else
         breakpoint:=Some (possibly_unquote s)
     else
-      invalid_arg "run_com"
+      run_invalid_arg ()
   else
-    invalid_arg "run_com"
+    run_invalid_arg ()
 
 (* Prints the run counter *)
 let run ini =
@@ -148,6 +163,7 @@ let rec prompt level =
   begin
     let open Proofview.NonLogical in
     Proofview.NonLogical.print_notice (fnl () ++ str "TcDebug (" ++ int level ++ str ") > ") >>
+    if Pervasives.(!batch) then return (DebugOn (level+1)) else
     let exit = (skip:=0) >> (skipped:=0) >> raise Sys.Break in
     Proofview.NonLogical.catch Proofview.NonLogical.read_line
       begin function (e, info) -> match e with
@@ -223,11 +239,11 @@ let is_debug db =
       return (Int.equal skip 0)
 
 (* Prints a constr *)
-let db_constr debug env c =
+let db_constr debug env sigma c =
   let open Proofview.NonLogical in
   is_debug debug >>= fun db ->
   if db then
-    msg_tac_debug (str "Evaluated term: " ++ print_constr_env env c)
+    msg_tac_debug (str "Evaluated term: " ++ print_constr_env env sigma c)
   else return ()
 
 (* Prints the pattern rule *)
@@ -244,23 +260,23 @@ let db_pattern_rule debug num r =
 (* Prints the hypothesis pattern identifier if it exists *)
 let hyp_bound = function
   | Anonymous -> str " (unbound)"
-  | Name id -> str " (bound to " ++ pr_id id ++ str ")"
+  | Name id -> str " (bound to " ++ Id.print id ++ str ")"
 
 (* Prints a matched hypothesis *)
-let db_matched_hyp debug env (id,_,c) ido =
+let db_matched_hyp debug env sigma (id,_,c) ido =
   let open Proofview.NonLogical in
   is_debug debug >>= fun db ->
   if db then
-    msg_tac_debug (str "Hypothesis " ++ pr_id id ++ hyp_bound ido ++
-                str " has been matched: " ++ print_constr_env env c)
+    msg_tac_debug (str "Hypothesis " ++ Id.print id ++ hyp_bound ido ++
+                str " has been matched: " ++ print_constr_env env sigma c)
   else return ()
 
 (* Prints the matched conclusion *)
-let db_matched_concl debug env c =
+let db_matched_concl debug env sigma c =
   let open Proofview.NonLogical in
   is_debug debug >>= fun db ->
   if db then
-    msg_tac_debug (str "Conclusion has been matched: " ++ print_constr_env env c)
+    msg_tac_debug (str "Conclusion has been matched: " ++ print_constr_env env sigma c)
   else return ()
 
 (* Prints a success message when the goal has been matched *)
@@ -346,18 +362,19 @@ let explain_ltac_call_trace last trace loc =
   | Tacexpr.LtacMLCall t ->
       quote (Pptactic.pr_glob_tactic (Global.env()) t)
   | Tacexpr.LtacVarCall (id,t) ->
-      quote (Nameops.pr_id id) ++ strbrk " (bound to " ++
+      quote (Id.print id) ++ strbrk " (bound to " ++
         Pptactic.pr_glob_tactic (Global.env()) t ++ str ")"
   | Tacexpr.LtacAtomCall te ->
       quote (Pptactic.pr_glob_tactic (Global.env())
-              (Tacexpr.TacAtom (Loc.ghost,te)))
-  | Tacexpr.LtacConstrInterp (c, { Pretyping.ltac_constrs = vars }) ->
+              (Tacexpr.TacAtom (Loc.tag te)))
+  | 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) ->
-                pr_id 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
@@ -385,16 +402,14 @@ let skip_extensions trace =
   | [] -> [] in
   List.rev (aux (List.rev trace))
 
-let finer_loc loc1 loc2 = Loc.merge loc1 loc2 = loc2
-
-let extract_ltac_trace trace eloc =
+let extract_ltac_trace ?loc trace =
   let trace = skip_extensions trace in
-  let (loc,c),tail = List.sep_last trace in
+  let (tloc,c),tail = List.sep_last trace in
   if is_defined_ltac trace then
     (* We entered a user-defined tactic,
        we display the trace with location of the call *)
-    let msg = hov 0 (explain_ltac_call_trace c tail eloc ++ fnl()) in
-    Some msg, if finer_loc eloc loc then eloc else loc
+    let msg = hov 0 (explain_ltac_call_trace c tail loc ++ fnl()) in
+    (if Loc.finer loc tloc then loc else tloc), Some msg
   else
     (* We entered a primitive tactic, we don't display trace but
        report on the finest location *)
@@ -402,21 +417,21 @@ let extract_ltac_trace trace eloc =
       (* trace is with innermost call coming first *)
       let rec aux best_loc = function
         | (loc,_)::tail ->
-           if Loc.is_ghost best_loc ||
-              not (Loc.is_ghost loc) && finer_loc loc best_loc
+           if Option.is_empty best_loc ||
+              not (Option.is_empty loc) && Loc.finer loc best_loc
            then
              aux loc tail
            else
              aux best_loc tail
         | [] -> best_loc in
-        aux eloc trace in
-    None, best_loc
+        aux loc trace in
+    best_loc, None
 
 let get_ltac_trace (_, info) =
   let ltac_trace = Exninfo.get info ltac_trace_info in
-  let loc = Option.default Loc.ghost (Loc.get_loc info) in
+  let loc = Loc.get_loc info in
   match ltac_trace with
   | None -> None
-  | Some trace -> Some (extract_ltac_trace trace loc)
+  | Some trace -> Some (extract_ltac_trace ?loc trace)
 
 let () = ExplainErr.register_additional_error_info get_ltac_trace
diff --git a/ltac/tactic_debug.mli b/plugins/ltac/tactic_debug.mli
index 520fb41e..734e76b5 100644
--- a/ltac/tactic_debug.mli
+++ b/plugins/ltac/tactic_debug.mli
@@ -1,16 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Environ
 open Pattern
 open Names
 open Tacexpr
-open Term
+open EConstr
 open Evd
 
 (** TODO: Move those definitions somewhere sensible *)
@@ -34,7 +36,7 @@ val debug_prompt :
 val db_initialize : unit Proofview.NonLogical.t
 
 (** Prints a constr *)
-val db_constr : debug_info -> env -> constr -> unit Proofview.NonLogical.t
+val db_constr : debug_info -> env -> evar_map -> constr -> unit Proofview.NonLogical.t
 
 (** Prints the pattern rule *)
 val db_pattern_rule :
@@ -42,10 +44,10 @@ val db_pattern_rule :
 
 (** Prints a matched hypothesis *)
 val db_matched_hyp :
-  debug_info -> env -> Id.t * constr option * constr -> Name.t -> unit Proofview.NonLogical.t
+  debug_info -> env -> evar_map -> Id.t * constr option * constr -> Name.t -> unit Proofview.NonLogical.t
 
 (** Prints the matched conclusion *)
-val db_matched_concl : debug_info -> env -> constr -> unit Proofview.NonLogical.t
+val db_matched_concl : debug_info -> env -> evar_map -> constr -> unit Proofview.NonLogical.t
 
 (** Prints a success message when the goal has been matched *)
 val db_mc_pattern_success : debug_info -> unit Proofview.NonLogical.t
@@ -58,23 +60,23 @@ val db_hyp_pattern_failure :
 val db_matching_failure : debug_info -> unit Proofview.NonLogical.t
 
 (** Prints an evaluation failure message for a rule *)
-val db_eval_failure : debug_info -> Pp.std_ppcmds -> unit Proofview.NonLogical.t
+val db_eval_failure : debug_info -> Pp.t -> unit Proofview.NonLogical.t
 
 (** An exception handler *)
-val explain_logic_error: exn -> Pp.std_ppcmds
+val explain_logic_error: exn -> Pp.t
 
 (** For use in the Ltac debugger: some exception that are usually
    consider anomalies are acceptable because they are caught later in
    the process that is being debugged.  One should not require
    from users that they report these anomalies. *)
-val explain_logic_error_no_anomaly : exn -> Pp.std_ppcmds
+val explain_logic_error_no_anomaly : exn -> Pp.t
 
 (** Prints a logic failure message for a rule *)
 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 :
-  Tacexpr.ltac_trace -> Loc.t -> Pp.std_ppcmds option * Loc.t
+  ?loc:Loc.t -> Tacexpr.ltac_trace -> Pp.t option Loc.located
diff --git a/tactics/tactic_matching.ml b/plugins/ltac/tactic_matching.ml
index 004492e7..b6462c81 100644
--- a/tactics/tactic_matching.ml
+++ b/plugins/ltac/tactic_matching.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file extends Matching with the main logic for Ltac's
@@ -13,6 +15,8 @@ open Names
 open Tacexpr
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (** [t] is the type of matching successes. It ultimately contains a
     {!Tacexpr.glob_tactic_expr} representing the left-hand side of the
     corresponding matching rule, a matching substitution to be
@@ -20,9 +24,9 @@ open 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 ;
-  context : Term.constr Id.Map.t;
-  terms : Term.constr Id.Map.t;
+  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;
 }
 
@@ -34,8 +38,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)
 
 
@@ -103,7 +107,7 @@ let verify_metas_coherence env sigma (ln1,lcm) (ln,lm) =
   (merged, Id.Map.merge merge lcm lm)
 
 let matching_error =
-  CErrors.UserError ("tactic matching" , Pp.str "No matching clauses for match.")
+  CErrors.UserError (Some "tactic matching" , Pp.str "No matching clauses for match.")
 
 let imatching_error = (matching_error, Exninfo.null)
 
@@ -201,7 +205,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 }
@@ -235,7 +239,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
@@ -250,7 +254,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
@@ -280,10 +284,10 @@ module PatternMatching (E:StaticEnvironment) = struct
       the name of the matched hypothesis. *)
   let hyp_match_type hypname pat hyps =
     pick hyps >>= fun decl ->
-    let id = get_id decl in
+    let id = NamedDecl.get_id decl in
     let refresh = is_local_def decl in
-    pattern_match_term refresh pat (get_type decl) () <*>
-    put_terms (id_map_try_add_name hypname (Term.mkVar id) empty_term_subst) <*>
+    pattern_match_term refresh pat (NamedDecl.get_type decl) () <*>
+    put_terms (id_map_try_add_name hypname (EConstr.mkVar id) empty_term_subst) <*>
     return id
 
   (** [hyp_match_type hypname bodypat typepat hyps] matches a single
@@ -295,7 +299,7 @@ module PatternMatching (E:StaticEnvironment) = struct
       | LocalDef (id,body,hyp) ->
           pattern_match_term false bodypat body () <*>
           pattern_match_term true typepat hyp () <*>
-          put_terms (id_map_try_add_name hypname (Term.mkVar id) empty_term_subst) <*>
+          put_terms (id_map_try_add_name hypname (EConstr.mkVar id) empty_term_subst) <*>
           return id
       | LocalAssum (id,hyp) -> fail
 
@@ -304,9 +308,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
@@ -319,7 +323,7 @@ module PatternMatching (E:StaticEnvironment) = struct
         (* spiwack: alternatively it is possible to return the list
            with the matched hypothesis removed directly in
            [hyp_match]. *)
-        let select_matched_hyp decl = Id.equal (get_id decl) matched_hyp in
+        let select_matched_hyp decl = Id.equal (NamedDecl.get_id decl) matched_hyp in
         let hyps = CList.remove_first select_matched_hyp hyps in
         hyp_pattern_list_match pats hyps lhs
     | [] -> return lhs
diff --git a/tactics/tactic_matching.mli b/plugins/ltac/tactic_matching.mli
index 090207bc..0722c687 100644
--- a/tactics/tactic_matching.mli
+++ b/plugins/ltac/tactic_matching.mli
@@ -1,11 +1,14 @@
- (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(************************************************************************)
+(*         *   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)         *)
 (************************************************************************)
 
+
 (** This file extends Matching with the main logic for Ltac's
     (lazy)match and (lazy)match goal. *)
 
@@ -17,9 +20,9 @@
     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 ;
-  context : Term.constr Names.Id.Map.t;
-  terms : Term.constr Names.Id.Map.t;
+  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;
 }
 
@@ -31,7 +34,7 @@ type 'a t = {
 val match_term :
   Environ.env ->
   Evd.evar_map ->
-  Term.constr ->
+  EConstr.constr ->
   (Tacexpr.binding_bound_vars * Pattern.constr_pattern, Tacexpr.glob_tactic_expr) Tacexpr.match_rule list ->
   Tacexpr.glob_tactic_expr t Proofview.tactic
 
@@ -43,7 +46,7 @@ val match_term :
 val match_goal:
   Environ.env ->
   Evd.evar_map ->
-  Context.Named.t ->
-  Term.constr ->
+  EConstr.named_context ->
+  EConstr.constr ->
   (Tacexpr.binding_bound_vars * Pattern.constr_pattern, Tacexpr.glob_tactic_expr) Tacexpr.match_rule list ->
   Tacexpr.glob_tactic_expr t Proofview.tactic
diff --git a/ltac/tactic_option.ml b/plugins/ltac/tactic_option.ml
index a5ba3b83..f6b2e5b3 100644
--- a/ltac/tactic_option.ml
+++ b/plugins/ltac/tactic_option.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Libobject
diff --git a/plugins/ltac/tactic_option.mli b/plugins/ltac/tactic_option.mli
new file mode 100644
index 00000000..d2f2947c
--- /dev/null
+++ b/plugins/ltac/tactic_option.mli
@@ -0,0 +1,17 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Tacexpr
+open Vernacexpr
+
+val declare_tactic_option : ?default:Tacexpr.glob_tactic_expr -> string -> 
+  (* put *) (locality_flag -> glob_tactic_expr -> unit) *
+  (* get *) (unit -> locality_flag * unit Proofview.tactic) *
+  (* print *) (unit -> Pp.t)
diff --git a/ltac/tauto.ml b/plugins/ltac/tauto.ml
index 756958c2..a51c09ca 100644
--- a/ltac/tauto.ml
+++ b/plugins/ltac/tauto.ml
@@ -1,23 +1,27 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Term
+open EConstr
 open Hipattern
 open Names
-open Pp
 open Geninterp
 open Misctypes
+open Ltac_plugin
 open Tacexpr
 open Tacinterp
 open Util
 open Tacticals.New
+open Proofview.Notations
 
-let tauto_plugin = "tauto"
+let tauto_plugin = "tauto_plugin"
 let () = Mltop.add_known_module tauto_plugin
 
 let assoc_var s ist =
@@ -61,33 +65,17 @@ let assoc_flags ist : tauto_flags =
 (* Whether inner not are unfolded *)
 let negation_unfolding = ref true
 
-(* Whether inner iff are unfolded *)
-let iff_unfolding = ref false
-
-let unfold_iff () = !iff_unfolding || Flags.version_less_or_equal Flags.V8_2
-
 open Goptions
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "unfolding of not in intuition";
       optkey   = ["Intuition";"Negation";"Unfolding"];
       optread  = (fun () -> !negation_unfolding);
       optwrite = (:=) negation_unfolding }
 
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "unfolding of iff in intuition";
-      optkey   = ["Intuition";"Iff";"Unfolding"];
-      optread  = (fun () -> !iff_unfolding);
-      optwrite = (:=) iff_unfolding }
-
 (** Base tactics *)
 
-let loc = Loc.ghost
 let idtac = Proofview.tclUNIT ()
 let fail = Proofview.tclINDEPENDENT (tclFAIL 0 (Pp.mt ()))
 
@@ -111,19 +99,21 @@ let split = Tactics.split_with_bindings false [Misctypes.NoBindings]
 (** Test *)
 
 let is_empty _ ist =
-  if is_empty_type (assoc_var "X1" ist) then idtac else fail
+  Proofview.tclEVARMAP >>= fun sigma ->
+  if is_empty_type sigma (assoc_var "X1" ist) then idtac else fail
 
 (* Strictly speaking, this exceeds the propositional fragment as it
    matches also equality types (and solves them if a reflexivity) *)
 let is_unit_or_eq _ ist =
+  Proofview.tclEVARMAP >>= fun sigma ->
   let flags = assoc_flags ist in
   let test = if flags.strict_unit then is_unit_type else is_unit_or_eq_type in
-  if test (assoc_var "X1" ist) then idtac else fail
+  if test sigma (assoc_var "X1" ist) then idtac else fail
 
-let bugged_is_binary t =
-  isApp t &&
-  let (hdapp,args) = decompose_app t in
-    match (kind_of_term hdapp) with
+let bugged_is_binary sigma t =
+  isApp sigma t &&
+  let (hdapp,args) = decompose_app sigma t in
+    match EConstr.kind sigma hdapp with
     | Ind (ind,u)  ->
         let (mib,mip) = Global.lookup_inductive ind in
          Int.equal mib.Declarations.mind_nparams 2
@@ -132,21 +122,23 @@ let bugged_is_binary t =
 (** Dealing with conjunction *)
 
 let is_conj _ ist =
+  Proofview.tclEVARMAP >>= fun sigma ->
   let flags = assoc_flags ist in
   let ind = assoc_var "X1" ist in
-    if (not flags.binary_mode_bugged_detection || bugged_is_binary ind) &&
-       is_conjunction
+    if (not flags.binary_mode_bugged_detection || bugged_is_binary sigma ind) &&
+       is_conjunction sigma
          ~strict:flags.strict_in_hyp_and_ccl
          ~onlybinary:flags.binary_mode ind
     then idtac
     else fail
 
 let flatten_contravariant_conj _ ist =
+  Proofview.tclEVARMAP >>= fun sigma ->
   let flags = assoc_flags ist in
   let typ = assoc_var "X1" ist in
   let c = assoc_var "X2" ist in
   let hyp = assoc_var "id" ist in
-  match match_with_conjunction
+  match match_with_conjunction sigma
           ~strict:flags.strict_in_contravariant_hyp
           ~onlybinary:flags.binary_mode typ
   with
@@ -154,27 +146,29 @@ let flatten_contravariant_conj _ ist =
     let newtyp = List.fold_right mkArrow args c in
     let intros = tclMAP (fun _ -> intro) args in
     let by = tclTHENLIST [intros; apply hyp; split; assumption] in
-    tclTHENLIST [assert_ ~by newtyp; clear (destVar hyp)]
+    tclTHENLIST [assert_ ~by newtyp; clear (destVar sigma hyp)]
   | _ -> fail
 
 (** Dealing with disjunction *)
 
 let is_disj _ ist =
+  Proofview.tclEVARMAP >>= fun sigma ->
   let flags = assoc_flags ist in
   let t = assoc_var "X1" ist in
-  if (not flags.binary_mode_bugged_detection || bugged_is_binary t) &&
-     is_disjunction
+  if (not flags.binary_mode_bugged_detection || bugged_is_binary sigma t) &&
+     is_disjunction sigma
        ~strict:flags.strict_in_hyp_and_ccl
        ~onlybinary:flags.binary_mode t
   then idtac
   else fail
 
 let flatten_contravariant_disj _ ist =
+  Proofview.tclEVARMAP >>= fun sigma ->
   let flags = assoc_flags ist in
   let typ = assoc_var "X1" ist in
   let c = assoc_var "X2" ist in
   let hyp = assoc_var "id" ist in
-  match match_with_disjunction
+  match match_with_disjunction sigma
           ~strict:flags.strict_in_contravariant_hyp
           ~onlybinary:flags.binary_mode
           typ with
@@ -186,25 +180,22 @@ let flatten_contravariant_disj _ ist =
         assert_ ~by typ
       in
       let tacs = List.mapi map args in
-      let tac0 = clear (destVar hyp) in
+      let tac0 = clear (destVar sigma hyp) in
       tclTHEN (tclTHENLIST tacs) tac0
   | _ -> fail
 
 let make_unfold name =
   let dir = DirPath.make (List.map Id.of_string ["Logic"; "Init"; "Coq"]) in
-  let const = Constant.make2 (MPfile dir) (Label.make name) in
+  let const = Constant.make2 (ModPath.MPfile dir) (Label.make name) in
   (Locus.AllOccurrences, ArgArg (EvalConstRef const, None))
 
-let u_iff = make_unfold "iff"
 let u_not = make_unfold "not"
 
 let reduction_not_iff _ ist =
-  let make_reduce c = TacAtom (loc, TacReduce (Genredexpr.Unfold c, Locusops.allHypsAndConcl)) in
-  let tac = match !negation_unfolding, unfold_iff () with
-    | true, true -> make_reduce [u_not; u_iff]
-    | true, false -> make_reduce [u_not]
-    | false, true -> make_reduce [u_iff]
-    | false, false -> TacId []
+  let make_reduce c = TacAtom (Loc.tag @@ TacReduce (Genredexpr.Unfold c, Locusops.allHypsAndConcl)) in
+  let tac = match !negation_unfolding with
+    | true -> make_reduce [u_not]
+    | false -> TacId []
   in
   eval_tactic_ist ist tac
 
@@ -216,8 +207,7 @@ let apply_nnpp _ ist =
   Proofview.tclBIND
     (Proofview.tclUNIT ())
     begin fun () -> try
-      let nnpp = Universes.constr_of_global (Nametab.global_of_path coq_nnpp_path) in
-      apply nnpp
+      Tacticals.New.pf_constr_of_global (Nametab.global_of_path coq_nnpp_path) >>= apply
     with Not_found -> tclFAIL 0 (Pp.mt ())
     end
 
@@ -233,7 +223,7 @@ let tauto_uniform_unit_flags = {
 }
 
 (* This is the compatibility mode (not used) *)
-let tauto_legacy_flags = {
+let _tauto_legacy_flags = {
   binary_mode = true;
   binary_mode_bugged_detection = true;
   strict_in_contravariant_hyp = true;
@@ -251,19 +241,19 @@ let tauto_power_flags = {
 }
 
 let with_flags flags _ ist =
-  let f = (loc, Id.of_string "f") in
-  let x = (loc, 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
-  eval_tactic_ist ist (TacArg (loc, TacCall (loc, ArgVar f, [Reference (ArgVar x)])))
+  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 =
   let ids = List.map (fun id -> Id.of_string id) args in
-  let ids = List.map (fun id -> Some id) ids in
+  let ids = List.map (fun id -> Name id) ids in
   let name = { mltac_plugin = tauto_plugin; mltac_tactic = name0; } in
   let entry = { mltac_name = name; mltac_index = 0 } in
   let () = Tacenv.register_ml_tactic name [| tac |] in
-  let tac = TacFun (ids, TacML (loc, entry, [])) in
+  let tac = TacFun (ids, TacML (Loc.tag (entry, []))) in
   let obj () = Tacenv.register_ltac true true (Id.of_string name0) tac in
   Mltop.declare_cache_obj obj tauto_plugin
 
diff --git a/plugins/ltac/tauto.mli b/plugins/ltac/tauto.mli
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/plugins/ltac/tauto.mli
diff --git a/plugins/ltac/tauto_plugin.mlpack b/plugins/ltac/tauto_plugin.mlpack
new file mode 100644
index 00000000..b3618018
--- /dev/null
+++ b/plugins/ltac/tauto_plugin.mlpack
@@ -0,0 +1 @@
+Tauto
diff --git a/plugins/micromega/Env.v b/plugins/micromega/Env.v
index 7e3ef892..10326990 100644
--- a/plugins/micromega/Env.v
+++ b/plugins/micromega/Env.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/EnvRing.v b/plugins/micromega/EnvRing.v
index 904ee4da..4042959b 100644
--- a/plugins/micromega/EnvRing.v
+++ b/plugins/micromega/EnvRing.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (* F. Besson: to evaluate polynomials, the original code is using a list.
    For big polynomials, this is inefficient -- linear access.
@@ -56,10 +58,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/Lia.v b/plugins/micromega/Lia.v
index 47b6f7c7..ae05cf54 100644
--- a/plugins/micromega/Lia.v
+++ b/plugins/micromega/Lia.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/Lqa.v b/plugins/micromega/Lqa.v
index acd2751a..caaec541 100644
--- a/plugins/micromega/Lqa.v
+++ b/plugins/micromega/Lqa.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/Lra.v b/plugins/micromega/Lra.v
index 5b97d8ed..4ff483fb 100644
--- a/plugins/micromega/Lra.v
+++ b/plugins/micromega/Lra.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/MExtraction.v b/plugins/micromega/MExtraction.v
index d28bb828..158ddb58 100644
--- a/plugins/micromega/MExtraction.v
+++ b/plugins/micromega/MExtraction.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
@@ -14,6 +16,7 @@
 
 (* Used to generate micromega.ml *)
 
+Require Extraction.
 Require Import ZMicromega.
 Require Import QMicromega.
 Require Import RMicromega.
@@ -38,23 +41,23 @@ Extract Inductive sumor => option [ Some None ].
     Let's rather use the ocaml && *)
 Extract Inlined Constant andb => "(&&)".
 
-Require Import Reals.
+Import Reals.Rdefinitions.
 
-Extract Constant R => "int".  
-Extract Constant R0 => "0".  
-Extract Constant R1 => "1".  
+Extract Constant R => "int".
+Extract Constant R0 => "0".
+Extract Constant R1 => "1".
 Extract Constant Rplus => "( + )".
 Extract Constant Rmult => "( * )".
 Extract Constant Ropp  => "fun x -> - x".
 Extract Constant Rinv   => "fun x -> 1 / x".
 
-Extraction "micromega.ml"
-  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/OrderedRing.v b/plugins/micromega/OrderedRing.v
index 72b4dcb6..62505453 100644
--- a/plugins/micromega/OrderedRing.v
+++ b/plugins/micromega/OrderedRing.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/plugins/micromega/Psatz.v b/plugins/micromega/Psatz.v
index 8acf0ff8..28234e7a 100644
--- a/plugins/micromega/Psatz.v
+++ b/plugins/micromega/Psatz.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/QMicromega.v b/plugins/micromega/QMicromega.v
index b13285f5..ddf4064a 100644
--- a/plugins/micromega/QMicromega.v
+++ b/plugins/micromega/QMicromega.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/RMicromega.v b/plugins/micromega/RMicromega.v
index 2352d78d..c2b40c73 100644
--- a/plugins/micromega/RMicromega.v
+++ b/plugins/micromega/RMicromega.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
@@ -18,7 +20,7 @@ Require Import Refl.
 Require Import Raxioms RIneq Rpow_def DiscrR.
 Require Import QArith.
 Require Import Qfield.
-
+Require Import Qreals.
 
 Require Setoid.
 (*Declare ML Module "micromega_plugin".*)
@@ -38,15 +40,8 @@ Proof.
   exact Rplus_opp_r.
 Qed.
 
-Add Ring Rring : Rsrt.
 Open Scope R_scope.
 
-Lemma Rmult_neutral : forall x:R , 0 * x = 0.
-Proof.
-  intro ; ring.
-Qed.
-
-
 Lemma Rsor : SOR R0 R1 Rplus Rmult Rminus Ropp (@eq R)  Rle Rlt.
 Proof.
   constructor; intros ; subst ; try (intuition (subst; try ring ; auto with real)).
@@ -59,142 +54,41 @@ Proof.
   apply (Rlt_irrefl m) ; auto.
   apply Rnot_le_lt. auto with real.
   destruct (total_order_T n m) as [ [H1 | H1] | H1] ; auto.
-  intros.
-  rewrite <- (Rmult_neutral m).
-  apply (Rmult_lt_compat_r) ; auto.
-Qed.
-
-Definition IQR := fun x : Q => (IZR (Qnum x) * / IZR (' Qden x))%R.
-
-
-Lemma Rinv_elim : forall x y z, 
-  y <> 0 -> (z * y = x <->   x * / y = z).
-Proof.
-  intros.
-  split ; intros.
-  subst.
-  rewrite Rmult_assoc.
-  rewrite Rinv_r; auto.
-  ring.
-  subst.
-  rewrite Rmult_assoc.
-  rewrite (Rmult_comm (/ y)).
-  rewrite Rinv_r ; auto.
-  ring.
-Qed.  
-
-Ltac INR_nat_of_P :=
-  match goal with
-    | H : context[INR (Pos.to_nat ?X)] |- _ =>
-      revert H ; 
-      let HH := fresh in
-        assert (HH := pos_INR_nat_of_P X) ; revert HH ; generalize (INR (Pos.to_nat X))
-    | |- context[INR (Pos.to_nat ?X)] =>
-      let HH := fresh in
-        assert (HH := pos_INR_nat_of_P X) ; revert HH ; generalize (INR (Pos.to_nat X))
-  end.
-
-Ltac add_eq expr val := set (temp := expr) ; 
-  generalize (eq_refl temp) ;
-    unfold temp at 1 ; generalize temp ; intro val ; clear temp.
-
-Ltac Rinv_elim :=
-  match goal with
-    | |- context[?x * / ?y] => 
-      let z := fresh "v" in 
-      add_eq (x * / y) z  ;
-      let H := fresh in intro H ; rewrite <- Rinv_elim in H
-  end.
-
-Lemma Rlt_neq : forall r , 0 < r -> r <> 0.
-Proof.
-  red. intros.
-  subst.
-  apply (Rlt_irrefl 0 H).  
+  now apply Rmult_lt_0_compat.
 Qed.
 
+Notation IQR := Q2R (only parsing).
 
 Lemma Rinv_1 : forall x, x * / 1 = x.
 Proof.
   intro.
-  Rinv_elim.
-  subst ; ring.
-  apply R1_neq_R0.
+  rewrite Rinv_1.
+  apply Rmult_1_r.
 Qed.
 
-Lemma Qeq_true : forall x y,  
-  Qeq_bool x y = true -> 
-   IQR x = IQR y.
+Lemma Qeq_true : forall x y, Qeq_bool x y = true -> IQR x = IQR y.
 Proof.
-  unfold IQR.
-  simpl.
-  intros.
-  apply Qeq_bool_eq in H.
-  unfold Qeq in H.
-  assert (IZR (Qnum x * ' Qden y) = IZR (Qnum y * ' Qden x))%Z.
-     rewrite H. reflexivity.
-  repeat rewrite mult_IZR in H0.
-  simpl in H0.
-  revert H0.
-  repeat INR_nat_of_P.
   intros.
-  apply Rinv_elim in H2 ; [| apply Rlt_neq ; auto].
-  rewrite <- H2.
-  field.
-  split ; apply Rlt_neq ; auto.
+  now apply Qeq_eqR, Qeq_bool_eq.
 Qed.
 
 Lemma Qeq_false : forall x y, Qeq_bool x y = false -> IQR x <> IQR y.
 Proof.
   intros.
-  apply Qeq_bool_neq  in H.
-  intro. apply H.   clear H.
-  unfold Qeq,IQR in *.
-  simpl in *.
-  revert H0.
-  repeat Rinv_elim.
-  intros.
-  subst.
-  assert (IZR (Qnum x * ' Qden y)%Z = IZR (Qnum y * ' Qden x)%Z).
-  repeat rewrite mult_IZR.  
-  simpl.
-  rewrite <- H0. rewrite <- H.
-  ring.
-  apply eq_IZR ; auto.
-  INR_nat_of_P; intros; apply Rlt_neq ; auto. 
-  INR_nat_of_P; intros ; apply Rlt_neq ; auto. 
+  apply Qeq_bool_neq in H.
+  contradict H.
+  now apply eqR_Qeq.
 Qed.
 
-  
-
 Lemma Qle_true : forall x y : Q, Qle_bool x y = true -> IQR x <= IQR y.
 Proof.
   intros.
-  apply Qle_bool_imp_le in H.
-  unfold Qle in H.
-  unfold IQR.
-  simpl in *.
-  apply IZR_le in H.
-  repeat rewrite mult_IZR in H.
-  simpl in H.
-  repeat INR_nat_of_P; intros.
-  assert (Hr := Rlt_neq r H).
-  assert (Hr0 := Rlt_neq r0 H0).
-  replace (IZR (Qnum x) * / r) with ((IZR (Qnum x) * r0) * (/r * /r0)).
-  replace (IZR (Qnum y) * / r0) with ((IZR (Qnum y) * r) * (/r * /r0)).
-  apply Rmult_le_compat_r ; auto.
-  apply Rmult_le_pos.
-  unfold Rle. left. apply Rinv_0_lt_compat ; auto.
-  unfold Rle. left. apply Rinv_0_lt_compat ; auto.
-  field ; intuition.
-  field ; intuition.
+  now apply Qle_Rle, Qle_bool_imp_le.
 Qed.
 
-
-
 Lemma IQR_0 : IQR 0 = 0.
 Proof.
-  compute. apply Rinv_1.
+  apply Rmult_0_l.
 Qed.
 
 Lemma IQR_1 : IQR 1 = 1.
@@ -202,160 +96,6 @@ Proof.
   compute. apply Rinv_1.
 Qed.
 
-Lemma IQR_plus : forall x y, IQR (x + y) = IQR x + IQR y.
-Proof.
-  intros.
-  unfold IQR.
-  simpl in *.
-  rewrite plus_IZR in *.
-  rewrite mult_IZR in *.
-  simpl.  
-  rewrite Pos2Nat.inj_mul.
-  rewrite mult_INR.
-  rewrite mult_IZR.
-  simpl.
-  repeat INR_nat_of_P.
-  intros. field. 
-  split ; apply Rlt_neq ; auto.
-Qed.
-
-Lemma IQR_opp : forall x, IQR (- x) = - IQR x.
-Proof.
-  intros.
-  unfold IQR.
-  simpl.
-  rewrite opp_IZR.
-  ring.  
-Qed.
-
-Lemma IQR_minus : forall x y, IQR (x - y) = IQR x - IQR y.
-Proof.
-  intros.
-  unfold Qminus.
-  rewrite IQR_plus.
-  rewrite IQR_opp.
-  ring.
-Qed.
-
-
-Lemma IQR_mult : forall x y, IQR (x * y) = IQR x * IQR y.
-Proof.
-  unfold IQR ; intros.
-  simpl.
-  repeat rewrite mult_IZR.
-  rewrite Pos2Nat.inj_mul.
-  rewrite mult_INR.
-  repeat INR_nat_of_P.
-  intros. field ; split ; apply Rlt_neq ; auto.
-Qed.
-
-Lemma IQR_inv_lt : forall x, (0 < x)%Q -> 
-  IQR (/ x) =  / IQR x.
-Proof.
-  unfold IQR ; simpl.
-  intros.
-  unfold Qlt in H.
-  revert H.
-  simpl.
-  intros.
-  unfold Qinv.
-  destruct x.
-  destruct Qnum ; simpl in *.
-  exfalso. auto with zarith.
-  clear H.
-  repeat INR_nat_of_P.
-  intros.
-  assert (HH := Rlt_neq _ H).
-  assert (HH0 := Rlt_neq _ H0).
-  rewrite Rinv_mult_distr ; auto.
-  rewrite Rinv_involutive ; auto.
-  ring.
-  apply Rinv_0_lt_compat in H0.
-  apply Rlt_neq ; auto.
-  simpl in H.
-  exfalso.
-  rewrite Pos.mul_comm  in H.
-  compute in H.
-  discriminate.
-Qed.
-
-Lemma Qinv_opp : forall x, (- (/ x) = / ( -x))%Q.
-Proof.
-  destruct x ; destruct Qnum ; reflexivity.
-Qed.
-
-Lemma Qopp_involutive_strong : forall x, (- - x = x)%Q.
-Proof.
-  intros.
-  destruct x.
-  unfold Qopp.
-  simpl.
-  rewrite Z.opp_involutive.
-  reflexivity.
-Qed.
-
-Lemma Ropp_0 : forall r , - r = 0 -> r = 0.
-Proof.
-  intros.
-  rewrite <- (Ropp_involutive r).
-  apply Ropp_eq_0_compat ; auto.
-Qed.
-
-Lemma IQR_x_0 : forall x, IQR x = 0 -> x == 0%Q.
-Proof.
-  destruct x ; simpl.
-  unfold IQR.
-  simpl.
-  INR_nat_of_P.
-  intros.
-  apply Rmult_integral in H0.  
-  destruct H0.
-  apply eq_IZR_R0 in H0.
-  subst.
-  reflexivity.
-  exfalso.
-  apply Rinv_0_lt_compat in H.
-  rewrite <- H0 in H.
-  apply Rlt_irrefl in H. auto.
-Qed.
-  
-
-Lemma IQR_inv_gt : forall x, (0 > x)%Q -> 
-  IQR (/ x) =  / IQR x.
-Proof.
-  intros.
-  rewrite <- (Qopp_involutive_strong x).
-  rewrite <- Qinv_opp.
-  rewrite IQR_opp.
-  rewrite IQR_inv_lt.
-  repeat rewrite IQR_opp.
-  rewrite Ropp_inv_permute.
-  auto.
-  intro.
-  apply Ropp_0 in H0.
-  apply IQR_x_0 in H0.
-  rewrite H0 in H.
-  compute in H. discriminate.
-  unfold Qlt in *.
-  destruct x ; simpl in *.
-  auto with zarith.
-Qed.
-
-Lemma IQR_inv : forall x, ~ x ==  0 -> 
-  IQR (/ x) =  / IQR x.
-Proof.
-  intros.
-  assert ( 0 > x \/ 0 < x)%Q.
-   destruct x ; unfold Qlt, Qeq in * ; simpl in *.
-   rewrite Z.mul_1_r in *.
-   destruct Qnum ; simpl in * ; intuition auto.
-   right. reflexivity.
-   left ; reflexivity.
-  destruct H0.
-  apply IQR_inv_gt ; auto.
-  apply IQR_inv_lt ; auto.
-Qed.
-
 Lemma IQR_inv_ext : forall x, 
   IQR (/ x) = (if Qeq_bool x 0 then 0 else / IQR x).
 Proof.
@@ -366,18 +106,13 @@ Proof.
   destruct x ; simpl.
   unfold Qeq in H.
   simpl in H.
-  replace Qnum with 0%Z.
-  compute. rewrite Rinv_1.
-  reflexivity.
-  rewrite <- H. ring.
+  rewrite Zmult_1_r in H.
+  rewrite H.
+  apply Rmult_0_l.
   intros.
-  apply IQR_inv.
-  intro.
-  rewrite <- Qeq_bool_iff in H0.
-  congruence.
+  now apply Q2R_inv, Qeq_bool_neq.
 Qed.
 
-
 Notation to_nat := N.to_nat.
 
 Lemma QSORaddon :
@@ -391,10 +126,10 @@ Proof.
   constructor ; intros ; try reflexivity.
   apply IQR_0.
   apply IQR_1.
-  apply IQR_plus.
-  apply IQR_minus.
-  apply IQR_mult.
-  apply IQR_opp.
+  apply Q2R_plus.
+  apply Q2R_minus.
+  apply Q2R_mult.
+  apply Q2R_opp.
   apply Qeq_true ; auto.
   apply R_power_theory.
   apply Qeq_false.
@@ -453,13 +188,13 @@ Proof.
     apply IQR_1. 
     reflexivity.
     unfold IQR. simpl. rewrite Rinv_1. reflexivity.
-    apply IQR_plus.
-    apply IQR_minus.
-    apply IQR_mult.
+    apply Q2R_plus.
+    apply Q2R_minus.
+    apply Q2R_mult.
     rewrite <- IHc.
     apply IQR_inv_ext.
     rewrite <- IHc.
-    apply IQR_opp.
+    apply Q2R_opp.
   Qed.
 
 Require Import EnvRing.
diff --git a/plugins/micromega/Refl.v b/plugins/micromega/Refl.v
index 32ddb3cf..952a1b91 100644
--- a/plugins/micromega/Refl.v
+++ b/plugins/micromega/Refl.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/RingMicromega.v b/plugins/micromega/RingMicromega.v
index ed49c3df..f066ea46 100644
--- a/plugins/micromega/RingMicromega.v
+++ b/plugins/micromega/RingMicromega.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
@@ -19,6 +21,7 @@ Require Import List.
 Require Import Bool.
 Require Import OrderedRing.
 Require Import Refl.
+Require Coq.micromega.Tauto.
 
 Set Implicit Arguments.
 
@@ -794,7 +797,7 @@ Definition xnormalise (t:Formula C) : list (NFormula)  :=
       | OpLe => (psub lhs rhs ,Strict) :: nil
     end.
 
-Require Import Coq.micromega.Tauto.
+Import Coq.micromega.Tauto.
 
 Definition cnf_normalise (t:Formula C) : cnf (NFormula) :=
   List.map  (fun x => x::nil) (xnormalise t).
diff --git a/plugins/micromega/Tauto.v b/plugins/micromega/Tauto.v
index 391231af..31f55ae9 100644
--- a/plugins/micromega/Tauto.v
+++ b/plugins/micromega/Tauto.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/ZCoeff.v b/plugins/micromega/ZCoeff.v
index bd425e6b..137453a9 100644
--- a/plugins/micromega/ZCoeff.v
+++ b/plugins/micromega/ZCoeff.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/plugins/micromega/ZMicromega.v b/plugins/micromega/ZMicromega.v
index 5aa8d03f..892858e6 100644
--- a/plugins/micromega/ZMicromega.v
+++ b/plugins/micromega/ZMicromega.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/certificate.ml b/plugins/micromega/certificate.ml
index 459c72f9..9f39191f 100644
--- a/plugins/micromega/certificate.ml
+++ b/plugins/micromega/certificate.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index e4b58a56..168105e8 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
@@ -19,6 +21,8 @@
 open Pp
 open Mutils
 open Goptions
+open Names
+open Constr
 
 (**
   * Debug flag 
@@ -63,7 +67,6 @@ let _ =
  
  let int_opt l vref =
   {
-   optsync = true;
    optdepr = false;
    optname = List.fold_right (^) l "";
    optkey  = l ;
@@ -73,7 +76,6 @@ let _ =
 
  let lia_enum_opt = 
   {
-   optsync = true;
    optdepr = false;
    optname = "Lia Enum";
    optkey  = ["Lia";"Enum"];
@@ -109,8 +111,8 @@ type 'cst atom = 'cst Micromega.formula
 type 'cst formula =
   | TT
   | FF
-  | X of Term.constr
-  | A of 'cst atom * tag * Term.constr
+  | X of EConstr.constr
+  | A of 'cst atom * tag * EConstr.constr
   | C of 'cst formula * 'cst formula
   | D of 'cst formula * 'cst formula
   | N of 'cst formula
@@ -328,9 +330,6 @@ let selecti s m =
 module M =
 struct
 
-  open Coqlib
-  open Term
-
   (**
     * Location of the Coq libraries.
     *)
@@ -355,8 +354,8 @@ struct
       ["LRing_normalise"]]
 
   let coq_modules =
-   init_modules @
-    [logic_dir] @ arith_modules @ zarith_base_modules @ mic_modules
+   Coqlib.(init_modules @
+    [logic_dir] @ arith_modules @ zarith_base_modules @ mic_modules)
 
   let bin_module = [["Coq";"Numbers";"BinNums"]]
 
@@ -364,6 +363,7 @@ struct
     [["Coq";"Reals" ; "Rdefinitions"];
      ["Coq";"Reals" ; "Rpow_def"] ;
      ["Coq";"Reals" ; "Raxioms"] ;
+     ["Coq";"QArith"; "Qreals"] ;
     ]
 
   let z_modules = [["Coq";"ZArith";"BinInt"]]
@@ -373,7 +373,8 @@ struct
     * ZMicromega.v
     *)
 
-  let init_constant = gen_constant_in_modules "ZMicromega" init_modules
+  let gen_constant_in_modules s m n = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.gen_reference_in_modules s m n)
+  let init_constant = gen_constant_in_modules "ZMicromega" Coqlib.init_modules
   let constant = gen_constant_in_modules "ZMicromega" coq_modules
   let bin_constant = gen_constant_in_modules "ZMicromega" bin_module
   let r_constant = gen_constant_in_modules "ZMicromega" r_modules
@@ -383,7 +384,6 @@ struct
   let coq_and = lazy (init_constant "and")
   let coq_or = lazy (init_constant "or")
   let coq_not = lazy (init_constant "not")
-  let coq_not_gl_ref = (Nametab.locate (  Libnames.qualid_of_string "Coq.Init.Logic.not"))
 
   let coq_iff = lazy (init_constant "iff")
   let coq_True = lazy (init_constant "True")
@@ -480,7 +480,7 @@ struct
   let coq_Rinv = lazy (r_constant "Rinv")
   let coq_Rpower = lazy (r_constant "pow")
   let coq_IZR    = lazy (r_constant "IZR")
-  let coq_IQR    = lazy (constant "IQR")
+  let coq_IQR    = lazy (r_constant "Q2R")
 
 
   let coq_PEX = lazy (constant "PEX" )
@@ -583,9 +583,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"
@@ -599,11 +599,11 @@ struct
 
   (* A simple but useful getter function *)
 
-  let get_left_construct term =
-   match Term.kind_of_term term with
+  let get_left_construct sigma term =
+   match EConstr.kind sigma term with
     | Term.Construct((_,i),_) -> (i,[| |])
     | Term.App(l,rst) ->
-       (match Term.kind_of_term l with
+       (match EConstr.kind sigma l with
         | Term.Construct((_,i),_) -> (i,rst)
         |   _     -> raise ParseError
        )
@@ -613,11 +613,11 @@ struct
   
   (* parse/dump/print from numbers up to expressions and formulas *)
 
-  let rec parse_nat term =
-   let (i,c) = get_left_construct term in
+  let rec parse_nat sigma term =
+   let (i,c) = get_left_construct sigma term in
     match i with
      | 1 -> Mc.O
-     | 2 -> Mc.S (parse_nat (c.(0)))
+     | 2 -> Mc.S (parse_nat sigma (c.(0)))
      | i -> raise ParseError
 
   let pp_nat o n = Printf.fprintf o "%i" (CoqToCaml.nat n)
@@ -625,71 +625,71 @@ struct
   let rec dump_nat x =
    match x with
     | Mc.O -> Lazy.force coq_O
-    | Mc.S p -> Term.mkApp(Lazy.force coq_S,[| dump_nat p |])
+    | Mc.S p -> EConstr.mkApp(Lazy.force coq_S,[| dump_nat p |])
 
-  let rec parse_positive term =
-   let (i,c) = get_left_construct term in
+  let rec parse_positive sigma term =
+   let (i,c) = get_left_construct sigma term in
     match i with
-     | 1 -> Mc.XI (parse_positive c.(0))
-     | 2 -> Mc.XO (parse_positive c.(0))
+     | 1 -> Mc.XI (parse_positive sigma c.(0))
+     | 2 -> Mc.XO (parse_positive sigma c.(0))
      | 3 -> Mc.XH
      | i -> raise ParseError
 
   let rec dump_positive x =
    match x with
     | Mc.XH -> Lazy.force coq_xH
-    | Mc.XO p -> Term.mkApp(Lazy.force coq_xO,[| dump_positive p |])
-    | Mc.XI p -> Term.mkApp(Lazy.force coq_xI,[| dump_positive p |])
+    | Mc.XO p -> EConstr.mkApp(Lazy.force coq_xO,[| dump_positive p |])
+    | Mc.XI p -> EConstr.mkApp(Lazy.force coq_xI,[| dump_positive p |])
 
   let pp_positive o x = Printf.fprintf o "%i" (CoqToCaml.positive x)
 
   let dump_n x =
    match x with
     | Mc.N0 -> Lazy.force coq_N0
-    | Mc.Npos p -> Term.mkApp(Lazy.force coq_Npos,[| dump_positive p|])
+    | Mc.Npos p -> EConstr.mkApp(Lazy.force coq_Npos,[| dump_positive p|])
 
   let rec dump_index x =
    match x with
     | Mc.XH -> Lazy.force coq_xH
-    | Mc.XO p -> Term.mkApp(Lazy.force coq_xO,[| dump_index p |])
-    | Mc.XI p -> Term.mkApp(Lazy.force coq_xI,[| dump_index p |])
+    | Mc.XO p -> EConstr.mkApp(Lazy.force coq_xO,[| dump_index p |])
+    | Mc.XI p -> EConstr.mkApp(Lazy.force coq_xI,[| dump_index p |])
 
   let pp_index o x = Printf.fprintf o "%i" (CoqToCaml.index x)
 
   let pp_n o x =  output_string o  (string_of_int (CoqToCaml.n x))
 
   let dump_pair t1 t2 dump_t1 dump_t2 (x,y) =
-   Term.mkApp(Lazy.force coq_pair,[| t1 ; t2 ; dump_t1 x ; dump_t2 y|])
+   EConstr.mkApp(Lazy.force coq_pair,[| t1 ; t2 ; dump_t1 x ; dump_t2 y|])
 
-  let parse_z term =
-   let (i,c) = get_left_construct term in
+  let parse_z sigma term =
+   let (i,c) = get_left_construct sigma term in
     match i with
      | 1 -> Mc.Z0
-     | 2 -> Mc.Zpos (parse_positive c.(0))
-     | 3 -> Mc.Zneg (parse_positive c.(0))
+     | 2 -> Mc.Zpos (parse_positive sigma c.(0))
+     | 3 -> Mc.Zneg (parse_positive sigma c.(0))
      | i -> raise ParseError
 
   let dump_z x =
    match x with
     | Mc.Z0 ->Lazy.force coq_ZERO
-    | Mc.Zpos p -> Term.mkApp(Lazy.force coq_POS,[| dump_positive p|])
-    | Mc.Zneg p -> Term.mkApp(Lazy.force coq_NEG,[| dump_positive p|])
+    | Mc.Zpos p -> EConstr.mkApp(Lazy.force coq_POS,[| dump_positive p|])
+    | Mc.Zneg p -> EConstr.mkApp(Lazy.force coq_NEG,[| dump_positive p|])
 
   let pp_z o x = Printf.fprintf o "%s" (Big_int.string_of_big_int (CoqToCaml.z_big_int x))
 
   let dump_num bd1 =
-   Term.mkApp(Lazy.force coq_Qmake,
-             [|dump_z (CamlToCoq.bigint (numerator bd1)) ;
-               dump_positive (CamlToCoq.positive_big_int (denominator bd1)) |])
+   EConstr.mkApp(Lazy.force coq_Qmake,
+                 [|dump_z (CamlToCoq.bigint (numerator bd1)) ;
+                   dump_positive (CamlToCoq.positive_big_int (denominator bd1)) |])
 
   let dump_q q =
-   Term.mkApp(Lazy.force coq_Qmake,
-             [| dump_z q.Micromega.qnum ; dump_positive q.Micromega.qden|])
+   EConstr.mkApp(Lazy.force coq_Qmake,
+                 [| dump_z q.Micromega.qnum ; dump_positive q.Micromega.qden|])
 
-  let parse_q term =
-     match Term.kind_of_term term with
-       | Term.App(c, args) -> if Constr.equal c (Lazy.force coq_Qmake) then
-             {Mc.qnum = parse_z args.(0) ; Mc.qden = parse_positive args.(1) }
+  let parse_q sigma term =
+     match EConstr.kind sigma term with
+       | Term.App(c, args) -> if EConstr.eq_constr sigma c (Lazy.force coq_Qmake) then
+             {Mc.qnum = parse_z sigma args.(0) ; Mc.qden = parse_positive sigma args.(1) }
        else raise ParseError
    |  _ -> raise ParseError
 
@@ -711,41 +711,41 @@ struct
     match cst with
       | Mc.C0 -> Lazy.force coq_C0 
       | Mc.C1 ->  Lazy.force coq_C1
-      | Mc.CQ q ->  Term.mkApp(Lazy.force coq_CQ, [| dump_q q |])
-      | Mc.CZ z -> Term.mkApp(Lazy.force coq_CZ, [| dump_z z |])
-      | Mc.CPlus(x,y) -> Term.mkApp(Lazy.force coq_CPlus, [| dump_Rcst x ; dump_Rcst y |])
-      | Mc.CMinus(x,y) -> Term.mkApp(Lazy.force coq_CMinus, [| dump_Rcst x ; dump_Rcst y |])
-      | Mc.CMult(x,y) -> Term.mkApp(Lazy.force coq_CMult, [| dump_Rcst x ; dump_Rcst y |])
-      | Mc.CInv t -> Term.mkApp(Lazy.force coq_CInv, [| dump_Rcst t |])
-      | Mc.COpp t -> Term.mkApp(Lazy.force coq_COpp, [| dump_Rcst t |])
-
-  let rec parse_Rcst term = 
-    let (i,c) = get_left_construct term in
+      | Mc.CQ q ->  EConstr.mkApp(Lazy.force coq_CQ, [| dump_q q |])
+      | Mc.CZ z -> EConstr.mkApp(Lazy.force coq_CZ, [| dump_z z |])
+      | Mc.CPlus(x,y) -> EConstr.mkApp(Lazy.force coq_CPlus, [| dump_Rcst x ; dump_Rcst y |])
+      | Mc.CMinus(x,y) -> EConstr.mkApp(Lazy.force coq_CMinus, [| dump_Rcst x ; dump_Rcst y |])
+      | Mc.CMult(x,y) -> EConstr.mkApp(Lazy.force coq_CMult, [| dump_Rcst x ; dump_Rcst y |])
+      | Mc.CInv t -> EConstr.mkApp(Lazy.force coq_CInv, [| dump_Rcst t |])
+      | Mc.COpp t -> EConstr.mkApp(Lazy.force coq_COpp, [| dump_Rcst t |])
+
+  let rec parse_Rcst sigma term = 
+    let (i,c) = get_left_construct sigma term in
       match i with
 	| 1 -> Mc.C0
 	| 2 -> Mc.C1
-	| 3 -> Mc.CQ (parse_q c.(0))
-	| 4 -> Mc.CPlus(parse_Rcst c.(0), parse_Rcst c.(1))
-	| 5 -> Mc.CMinus(parse_Rcst c.(0), parse_Rcst c.(1))
-	| 6 -> Mc.CMult(parse_Rcst  c.(0), parse_Rcst c.(1))
-	| 7 -> Mc.CInv(parse_Rcst c.(0))
-	| 8 -> Mc.COpp(parse_Rcst c.(0))
+	| 3 -> Mc.CQ (parse_q sigma c.(0))
+	| 4 -> Mc.CPlus(parse_Rcst sigma c.(0), parse_Rcst sigma c.(1))
+	| 5 -> Mc.CMinus(parse_Rcst sigma c.(0), parse_Rcst sigma c.(1))
+	| 6 -> Mc.CMult(parse_Rcst sigma c.(0), parse_Rcst sigma c.(1))
+	| 7 -> Mc.CInv(parse_Rcst sigma c.(0))
+	| 8 -> Mc.COpp(parse_Rcst sigma c.(0))
 	| _ -> raise ParseError
 
 
 
 
-  let rec parse_list parse_elt term =
-   let (i,c) = get_left_construct term in
+  let rec parse_list sigma parse_elt term =
+   let (i,c) = get_left_construct sigma term in
     match i with
      | 1 -> []
-     | 2 -> parse_elt c.(1) :: parse_list parse_elt c.(2)
+     | 2 -> parse_elt sigma c.(1) :: parse_list sigma parse_elt c.(2)
      | i -> raise ParseError
 
   let rec dump_list typ dump_elt l =
    match l with
-    | [] -> Term.mkApp(Lazy.force coq_nil,[| typ |])
-    | e :: l -> Term.mkApp(Lazy.force coq_cons,
+    | [] -> EConstr.mkApp(Lazy.force coq_nil,[| typ |])
+    | e :: l -> EConstr.mkApp(Lazy.force coq_cons,
                                 [| typ; dump_elt e;dump_list typ dump_elt l|])
 
   let pp_list op cl elt o l =
@@ -775,27 +775,27 @@ struct
   let dump_expr typ dump_z e =
    let rec dump_expr  e =
    match e with
-    | Mc.PEX n -> mkApp(Lazy.force coq_PEX,[| typ; dump_var n |])
-    | Mc.PEc z -> mkApp(Lazy.force coq_PEc,[| typ ; dump_z z |])
-    | Mc.PEadd(e1,e2) -> mkApp(Lazy.force coq_PEadd,
-                              [| typ; dump_expr e1;dump_expr e2|])
-    | Mc.PEsub(e1,e2) -> mkApp(Lazy.force coq_PEsub,
-                              [| typ; dump_expr  e1;dump_expr  e2|])
-    | Mc.PEopp e -> mkApp(Lazy.force coq_PEopp,
-                         [| typ; dump_expr  e|])
-    | Mc.PEmul(e1,e2) ->  mkApp(Lazy.force coq_PEmul,
-                               [| typ; dump_expr  e1;dump_expr e2|])
-    | Mc.PEpow(e,n) ->  mkApp(Lazy.force coq_PEpow,
-                             [| typ; dump_expr  e; dump_n  n|])
+    | Mc.PEX n -> EConstr.mkApp(Lazy.force coq_PEX,[| typ; dump_var n |])
+    | Mc.PEc z -> EConstr.mkApp(Lazy.force coq_PEc,[| typ ; dump_z z |])
+    | Mc.PEadd(e1,e2) -> EConstr.mkApp(Lazy.force coq_PEadd,
+                                       [| typ; dump_expr e1;dump_expr e2|])
+    | Mc.PEsub(e1,e2) -> EConstr.mkApp(Lazy.force coq_PEsub,
+                                       [| typ; dump_expr  e1;dump_expr  e2|])
+    | Mc.PEopp e -> EConstr.mkApp(Lazy.force coq_PEopp,
+                                  [| typ; dump_expr  e|])
+    | Mc.PEmul(e1,e2) ->  EConstr.mkApp(Lazy.force coq_PEmul,
+                                        [| typ; dump_expr  e1;dump_expr e2|])
+    | Mc.PEpow(e,n) ->  EConstr.mkApp(Lazy.force coq_PEpow,
+                                      [| typ; dump_expr  e; dump_n  n|])
       in
     dump_expr e
 
   let dump_pol typ dump_c e =
     let rec dump_pol e =
       match e with
-        | Mc.Pc n -> mkApp(Lazy.force coq_Pc, [|typ ; dump_c n|])
-        | Mc.Pinj(p,pol) -> mkApp(Lazy.force coq_Pinj , [| typ ; dump_positive p ; dump_pol pol|])
-        | Mc.PX(pol1,p,pol2) -> mkApp(Lazy.force coq_PX, [| typ ; dump_pol pol1 ; dump_positive p ; dump_pol pol2|]) in
+        | Mc.Pc n -> EConstr.mkApp(Lazy.force coq_Pc, [|typ ; dump_c n|])
+        | Mc.Pinj(p,pol) -> EConstr.mkApp(Lazy.force coq_Pinj , [| typ ; dump_positive p ; dump_pol pol|])
+        | Mc.PX(pol1,p,pol2) -> EConstr.mkApp(Lazy.force coq_PX, [| typ ; dump_pol pol1 ; dump_positive p ; dump_pol pol2|]) in
       dump_pol e
 
   let pp_pol pp_c o e =
@@ -814,17 +814,17 @@ struct
    let z = Lazy.force typ in
   let rec dump_cone e =
    match e with
-    | Mc.PsatzIn n -> mkApp(Lazy.force coq_PsatzIn,[| z; dump_nat n |])
-    | Mc.PsatzMulC(e,c) -> mkApp(Lazy.force coq_PsatzMultC,
-                              [| z; dump_pol z dump_z e ; dump_cone c |])
-    | Mc.PsatzSquare e -> mkApp(Lazy.force coq_PsatzSquare,
-                            [| z;dump_pol z dump_z e|])
-    | Mc.PsatzAdd(e1,e2) -> mkApp(Lazy.force coq_PsatzAdd,
-                              [| z; dump_cone e1; dump_cone e2|])
-    | Mc.PsatzMulE(e1,e2) -> mkApp(Lazy.force coq_PsatzMulE,
-                               [| z; dump_cone e1; dump_cone e2|])
-    | Mc.PsatzC p -> mkApp(Lazy.force coq_PsatzC,[| z; dump_z p|])
-    | Mc.PsatzZ    -> mkApp( Lazy.force coq_PsatzZ,[| z|]) in
+    | Mc.PsatzIn n -> EConstr.mkApp(Lazy.force coq_PsatzIn,[| z; dump_nat n |])
+    | Mc.PsatzMulC(e,c) -> EConstr.mkApp(Lazy.force coq_PsatzMultC,
+                                         [| z; dump_pol z dump_z e ; dump_cone c |])
+    | Mc.PsatzSquare e -> EConstr.mkApp(Lazy.force coq_PsatzSquare,
+                                        [| z;dump_pol z dump_z e|])
+    | Mc.PsatzAdd(e1,e2) -> EConstr.mkApp(Lazy.force coq_PsatzAdd,
+                                          [| z; dump_cone e1; dump_cone e2|])
+    | Mc.PsatzMulE(e1,e2) -> EConstr.mkApp(Lazy.force coq_PsatzMulE,
+                                           [| z; dump_cone e1; dump_cone e2|])
+    | Mc.PsatzC p -> EConstr.mkApp(Lazy.force coq_PsatzC,[| z; dump_z p|])
+    | Mc.PsatzZ    -> EConstr.mkApp(Lazy.force coq_PsatzZ,[| z|]) in
    dump_cone e
 
   let  pp_psatz pp_z o e =
@@ -867,14 +867,14 @@ struct
    Printf.fprintf o"(%a %a %a)" (pp_expr pp_z) l pp_op op (pp_expr pp_z) r
 
   let dump_cstr typ dump_constant {Mc.flhs = e1 ; Mc.fop = o ; Mc.frhs = e2} =
-    Term.mkApp(Lazy.force coq_Build,
-              [| typ; dump_expr typ dump_constant e1 ;
-                 dump_op o ;
-                 dump_expr typ dump_constant e2|])
+    EConstr.mkApp(Lazy.force coq_Build,
+                  [| typ; dump_expr typ dump_constant e1 ;
+                     dump_op o ;
+                     dump_expr typ dump_constant e2|])
 
-  let assoc_const x l =
+  let assoc_const sigma x l =
    try
-   snd (List.find (fun (x',y) -> Constr.equal x (Lazy.force x')) l)
+   snd (List.find (fun (x',y) -> EConstr.eq_constr sigma x (Lazy.force x')) l)
    with
      Not_found -> raise ParseError
 
@@ -896,38 +896,37 @@ struct
    coq_Qeq, Mc.OpEq
   ]
 
-  let has_typ gl t1 typ = 
-   let ty = Retyping.get_type_of (Tacmach.pf_env gl) (Tacmach.project gl) t1 in
-   Constr.equal ty typ
-
+  type gl = { env : Environ.env; sigma : Evd.evar_map }
 
   let is_convertible gl t1 t2 = 
-   Reductionops.is_conv (Tacmach.pf_env gl) (Tacmach.project gl) t1 t2
+   Reductionops.is_conv gl.env gl.sigma t1 t2
 
   let parse_zop gl (op,args) =
-   match kind_of_term op with
-    | Const (x,_) -> (assoc_const op zop_table, args.(0) , args.(1))
-    | Ind((n,0),_) ->
-        if Constr.equal op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_Z)
+    let sigma = gl.sigma in
+    match EConstr.kind sigma op with
+    | Term.Const (x,_) -> (assoc_const sigma op zop_table, args.(0) , args.(1))
+    | Term.Ind((n,0),_) ->
+        if EConstr.eq_constr sigma op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_Z)
         then (Mc.OpEq, args.(1), args.(2))
         else raise ParseError
     |   _ -> failwith "parse_zop"
 
   let parse_rop gl (op,args) =
-    match kind_of_term op with
-     | Const (x,_) -> (assoc_const op rop_table, args.(0) , args.(1))
-     | Ind((n,0),_) ->
-        if Constr.equal op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_R)
+    let sigma = gl.sigma in
+    match EConstr.kind sigma op with
+     | Term.Const (x,_) -> (assoc_const sigma op rop_table, args.(0) , args.(1))
+     | Term.Ind((n,0),_) ->
+        if EConstr.eq_constr sigma op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_R)
         then (Mc.OpEq, args.(1), args.(2))
         else raise ParseError
     |   _ -> failwith "parse_zop"
 
   let parse_qop gl (op,args) =
-    (assoc_const op qop_table, args.(0) , args.(1))
+    (assoc_const gl.sigma op qop_table, args.(0) , args.(1))
 
-  let is_constant t = (* This is an approx *)
-   match kind_of_term t with
-    | Construct(i,_) -> true
+  let is_constant sigma t = (* This is an approx *)
+   match EConstr.kind sigma t with
+    | Term.Construct(i,_) -> true
     |   _ -> false
 
   type 'a op =
@@ -936,9 +935,9 @@ struct
     | Power
     | Ukn of string
 
-  let assoc_ops x l =
+  let assoc_ops sigma x l =
    try
-     snd (List.find (fun (x',y) -> Constr.equal x (Lazy.force x')) l)
+     snd (List.find (fun (x',y) -> EConstr.eq_constr sigma x (Lazy.force x')) l)
    with
      Not_found -> Ukn "Oups"
 
@@ -948,14 +947,14 @@ struct
 
   module Env =
   struct
-   type t = constr list
+   type t = EConstr.constr list
 
-   let compute_rank_add env v =
+   let compute_rank_add env sigma v =
     let rec _add env n v =
      match env with
       | [] -> ([v],n)
       | e::l ->
-         if eq_constr e v
+         if EConstr.eq_constr sigma e v
          then (env,n)
          else
           let (env,n) = _add l ( n+1) v in
@@ -963,13 +962,13 @@ struct
     let (env, n) =  _add env 1 v in
      (env, CamlToCoq.positive n)
 
-   let get_rank env v = 
+   let get_rank env sigma v = 
 
      let rec _get_rank env n =
        match env with
        | [] -> raise (Invalid_argument "get_rank")
       | e::l ->
-         if eq_constr e v
+         if EConstr.eq_constr sigma e v
          then n
          else  _get_rank l (n+1)  in 
      _get_rank env 1
@@ -985,9 +984,11 @@ struct
     * This is the big generic function for expression parsers.
     *)
 
-  let parse_expr parse_constant parse_exp ops_spec env term =
+  let parse_expr sigma parse_constant parse_exp ops_spec env term =
     if debug
-    then Feedback.msg_debug (Pp.str "parse_expr: " ++ Printer.prterm 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 =
@@ -998,7 +999,7 @@ struct
        (Mc.PEX  n , env) in
 *)
     let parse_variable env term =
-      let (env,n) = Env.compute_rank_add env term in
+      let (env,n) = Env.compute_rank_add env sigma term in
 	(Mc.PEX  n , env) in
 
     let rec parse_expr env term =
@@ -1009,12 +1010,12 @@ struct
 
        try (Mc.PEc (parse_constant term) , env)
        with ParseError -> 
-	 match kind_of_term term with
-	   | App(t,args) ->
+	 match EConstr.kind sigma term with
+	   | Term.App(t,args) ->
                (
-		 match kind_of_term t with
-		   | Const c ->
-		       ( match assoc_ops t ops_spec  with
+		 match EConstr.kind sigma t with
+		   | Term.Const c ->
+		       ( match assoc_ops sigma t ops_spec  with
 			   | Binop f -> combine env f (args.(0),args.(1))
                    | Opp     -> let (expr,env) = parse_expr env args.(0) in
                        (Mc.PEopp expr, env)
@@ -1026,12 +1027,12 @@ struct
                              (power  , env)
 			 with e when CErrors.noncritical e ->
                            (* if the exponent is a variable *)
-                           let (env,n) = Env.compute_rank_add env term in (Mc.PEX n, env)
+                           let (env,n) = Env.compute_rank_add env sigma term in (Mc.PEX n, env)
                        end
                    | Ukn  s ->
                        if debug
                        then (Printf.printf "unknown op: %s\n" s; flush stdout;);
-                       let (env,n) = Env.compute_rank_add env term in (Mc.PEX n, env)
+                       let (env,n) = Env.compute_rank_add env sigma term in (Mc.PEX n, env)
                )
 		   |   _ -> parse_variable env term
                )
@@ -1074,60 +1075,61 @@ struct
     (*      coq_Rdiv   , (fun x y -> Mc.CMult(x,Mc.CInv y)) ;*)
     ]
 
-  let rec rconstant term =
-   match Term.kind_of_term term with
-    | Const x ->
-        if Constr.equal term (Lazy.force coq_R0)
+  let rec rconstant sigma term =
+   match EConstr.kind sigma term with
+    | Term.Const x ->
+        if EConstr.eq_constr sigma term (Lazy.force coq_R0)
         then Mc.C0
-        else if Constr.equal term (Lazy.force coq_R1)
+        else if EConstr.eq_constr sigma term (Lazy.force coq_R1)
         then Mc.C1
         else raise ParseError
-    | App(op,args) -> 
+    | Term.App(op,args) -> 
 	begin
 	  try
             (* the evaluation order is important in the following *)
-            let f = assoc_const op rconst_assoc in
-            let a = rconstant args.(0) in
-            let b = rconstant args.(1) in
+            let f = assoc_const sigma op rconst_assoc in
+            let a = rconstant sigma args.(0) in
+            let b = rconstant sigma args.(1) in
             f a b
 	  with
 	      ParseError -> 
 		match op with
-		| op when Constr.equal op (Lazy.force coq_Rinv) ->
-                  let arg = rconstant args.(0) in 
+		| op when EConstr.eq_constr sigma op (Lazy.force coq_Rinv) ->
+                  let arg = rconstant sigma args.(0) in 
                   if Mc.qeq_bool (Mc.q_of_Rcst arg) {Mc.qnum = Mc.Z0 ; Mc.qden = Mc.XH}
                   then raise ParseError (* This is a division by zero -- no semantics *)
                   else Mc.CInv(arg) 
-		| op when Constr.equal op (Lazy.force coq_IQR)  -> Mc.CQ (parse_q args.(0))
-		| op when Constr.equal op   (Lazy.force coq_IZR)  -> Mc.CZ (parse_z args.(0))
+		| op when EConstr.eq_constr sigma op (Lazy.force coq_IQR)  -> Mc.CQ (parse_q sigma args.(0))
+		| op when EConstr.eq_constr sigma op   (Lazy.force coq_IZR)  -> Mc.CZ (parse_z sigma args.(0))
 		| _ ->  raise ParseError
 	end
 
     |  _ -> raise ParseError
 
 
-  let rconstant term = 
+  let rconstant sigma term =
+    let _, env = Pfedit.get_current_context () in
     if debug
-    then Feedback.msg_debug (Pp.str "rconstant: " ++ Printer.prterm term ++ fnl ());
-    let res = rconstant term in
+    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) ;
       res
 
 
-  let parse_zexpr =  parse_expr
-    zconstant
+  let parse_zexpr sigma =  parse_expr sigma
+    (zconstant sigma)
     (fun expr x ->
-      let exp = (parse_z x) in
+      let exp = (parse_z sigma x) in
         match exp with
           | Mc.Zneg _ -> Mc.PEc Mc.Z0
           |   _     ->  Mc.PEpow(expr, Mc.Z.to_N exp))
     zop_spec
 
-  let parse_qexpr  =  parse_expr
-   qconstant
+  let parse_qexpr sigma =  parse_expr sigma
+   (qconstant sigma)
     (fun expr x ->
-      let exp = parse_z x in
+      let exp = parse_z sigma x in
         match exp with
           | Mc.Zneg _ ->
               begin
@@ -1139,21 +1141,22 @@ struct
                         Mc.PEpow(expr,exp))
    qop_spec
 
-  let parse_rexpr =  parse_expr
-   rconstant
+  let parse_rexpr sigma =  parse_expr sigma
+   (rconstant sigma)
    (fun expr x ->
-      let exp = Mc.N.of_nat (parse_nat x) in
+      let exp = Mc.N.of_nat (parse_nat sigma x) in
         Mc.PEpow(expr,exp))
    rop_spec
 
   let  parse_arith parse_op parse_expr env cstr gl =
-   if debug
-   then Feedback.msg_debug (Pp.str "parse_arith: " ++ Printer.prterm  cstr ++ fnl ());
-   match kind_of_term cstr with
-    | App(op,args) ->
+    let sigma = gl.sigma in
+    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 env lhs in
-       let (e2,env) = parse_expr env rhs in
+       let (e1,env) = parse_expr sigma env lhs in
+       let (e2,env) = parse_expr sigma env rhs in
         ({Mc.flhs = e1; Mc.fop = op;Mc.frhs = e2},env)
     |  _ -> failwith "error : parse_arith(2)"
 
@@ -1191,6 +1194,7 @@ struct
     *)
   
   let parse_formula gl parse_atom env tg term =
+    let sigma = gl.sigma in
 
     let parse_atom env tg t =
       try
@@ -1199,34 +1203,34 @@ struct
       with e when CErrors.noncritical e -> (X(t),env,tg) in
 
     let is_prop term =
-      let sort  = Retyping.get_sort_of (Tacmach.pf_env gl)  (Tacmach.project gl) term in 
-     Term.is_prop_sort sort in
+      let sort  = Retyping.get_sort_of gl.env gl.sigma term in 
+     Sorts.is_prop sort in
      
     let rec xparse_formula env tg term =
-      match kind_of_term term with
-      | App(l,rst) ->
+      match EConstr.kind sigma term with
+      | Term.App(l,rst) ->
         (match rst with
-        | [|a;b|] when eq_constr l (Lazy.force coq_and) ->
+        | [|a;b|] when EConstr.eq_constr sigma l (Lazy.force coq_and) ->
           let f,env,tg = xparse_formula env tg a in
           let g,env, tg = xparse_formula env tg b  in
           mkformula_binary mkC term f g,env,tg
-        | [|a;b|] when eq_constr l (Lazy.force coq_or) ->
+        | [|a;b|] when EConstr.eq_constr sigma l (Lazy.force coq_or) ->
           let f,env,tg = xparse_formula env tg a in
           let g,env,tg  = xparse_formula env tg b in
           mkformula_binary mkD term f g,env,tg
-        | [|a|] when eq_constr l (Lazy.force coq_not) ->
+        | [|a|] when EConstr.eq_constr sigma l (Lazy.force coq_not) ->
           let (f,env,tg) = xparse_formula env tg a in (N(f), env,tg)
-        | [|a;b|] when eq_constr l (Lazy.force coq_iff) ->
+        | [|a;b|] when EConstr.eq_constr sigma l (Lazy.force coq_iff) ->
           let f,env,tg = xparse_formula env tg a in
           let g,env,tg = xparse_formula env tg b in
           mkformula_binary mkIff term f g,env,tg
         | _ -> parse_atom env tg term)
-      | Prod(typ,a,b) when not (Termops.dependent (mkRel 1) b)->
+      | Term.Prod(typ,a,b) when EConstr.Vars.noccurn sigma 1 b ->
         let f,env,tg = xparse_formula env tg a in
         let g,env,tg = xparse_formula env tg b in
         mkformula_binary mkI term f g,env,tg
-      | _ when eq_constr term (Lazy.force coq_True) -> (TT,env,tg)
-      | _ when eq_constr term (Lazy.force coq_False) -> (FF,env,tg)
+      | _ when EConstr.eq_constr sigma term (Lazy.force coq_True) -> (TT,env,tg)
+      | _ when EConstr.eq_constr sigma term (Lazy.force coq_False) -> (FF,env,tg)
       | _ when is_prop term -> X(term),env,tg
       | _ -> raise ParseError
     in
@@ -1235,21 +1239,21 @@ struct
   let dump_formula typ dump_atom f =
    let rec xdump f =
     match f with
-     | TT  -> mkApp(Lazy.force coq_TT,[|typ|])
-     | FF  -> mkApp(Lazy.force coq_FF,[|typ|])
-     | C(x,y) -> mkApp(Lazy.force coq_And,[|typ ; xdump x ; xdump y|])
-     | D(x,y) -> mkApp(Lazy.force coq_Or,[|typ ; xdump x ; xdump y|])
-     | I(x,_,y) -> mkApp(Lazy.force coq_Impl,[|typ ; xdump x ; xdump y|])
-     | N(x) -> mkApp(Lazy.force coq_Neg,[|typ ; xdump x|])
-     | A(x,_,_) -> mkApp(Lazy.force coq_Atom,[|typ ; dump_atom x|])
-     | X(t) -> mkApp(Lazy.force coq_X,[|typ ; t|])  in
+     | TT  -> EConstr.mkApp(Lazy.force coq_TT,[|typ|])
+     | FF  -> EConstr.mkApp(Lazy.force coq_FF,[|typ|])
+     | C(x,y) -> EConstr.mkApp(Lazy.force coq_And,[|typ ; xdump x ; xdump y|])
+     | D(x,y) -> EConstr.mkApp(Lazy.force coq_Or,[|typ ; xdump x ; xdump y|])
+     | I(x,_,y) -> EConstr.mkApp(Lazy.force coq_Impl,[|typ ; xdump x ; xdump y|])
+     | N(x) -> EConstr.mkApp(Lazy.force coq_Neg,[|typ ; xdump x|])
+     | A(x,_,_) -> EConstr.mkApp(Lazy.force coq_Atom,[|typ ; dump_atom x|])
+     | X(t) -> EConstr.mkApp(Lazy.force coq_X,[|typ ; t|])  in
    xdump f
 
 
-  let prop_env_of_formula form =
+  let prop_env_of_formula sigma form =
     let rec doit env = function
       | TT | FF | A(_,_,_) -> env
-      | X t -> fst (Env.compute_rank_add env t)
+      | X t -> fst (Env.compute_rank_add env sigma t)
       | C(f1,f2) | D(f1,f2) | I(f1,_,f2) -> 
         doit (doit env f1) f2
       | N f -> doit env f in
@@ -1282,15 +1286,15 @@ struct
       
   type 'cst dump_expr =  (* 'cst is the type of the syntactic constants *)
     {
-      interp_typ : constr; 
-      dump_cst : 'cst -> constr; 
-      dump_add : constr; 
-      dump_sub : constr;
-      dump_opp : constr;
-      dump_mul : constr;
-      dump_pow : constr;
-      dump_pow_arg : Mc.n -> constr;
-      dump_op  : (Mc.op2 * Term.constr) list
+      interp_typ : EConstr.constr;
+      dump_cst : 'cst -> EConstr.constr;
+      dump_add : EConstr.constr;
+      dump_sub : EConstr.constr;
+      dump_opp : EConstr.constr;
+      dump_mul : EConstr.constr;
+      dump_pow : EConstr.constr;
+      dump_pow_arg : Mc.n -> EConstr.constr;
+      dump_op  : (Mc.op2 * EConstr.constr) list
     }
 
 let dump_zexpr = lazy
@@ -1324,8 +1328,8 @@ let dump_qexpr = lazy
   let add  = Lazy.force coq_Rplus  in
 
   let one  = Lazy.force coq_R1    in 
-  let mk_add x y  = mkApp(add,[|x;y|]) in
-  let mk_mult x y = mkApp(mult,[|x;y|]) in
+  let mk_add x y  = EConstr.mkApp(add,[|x;y|]) in
+  let mk_mult x y = EConstr.mkApp(mult,[|x;y|]) in
 
   let two  = mk_add one one in 
 
@@ -1348,13 +1352,13 @@ let rec dump_Rcst_as_R cst =
   match cst with
   | Mc.C0 -> Lazy.force coq_R0 
   | Mc.C1 ->  Lazy.force coq_R1
-  | Mc.CQ q ->  Term.mkApp(Lazy.force coq_IQR, [| dump_q q |])
-  | Mc.CZ z -> Term.mkApp(Lazy.force coq_IZR, [| dump_z z |])
-  | Mc.CPlus(x,y) -> Term.mkApp(Lazy.force coq_Rplus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
-  | Mc.CMinus(x,y) -> Term.mkApp(Lazy.force coq_Rminus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
-  | Mc.CMult(x,y) -> Term.mkApp(Lazy.force coq_Rmult, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
-  | Mc.CInv t -> Term.mkApp(Lazy.force coq_Rinv, [| dump_Rcst_as_R t |])
-  | Mc.COpp t -> Term.mkApp(Lazy.force coq_Ropp, [| dump_Rcst_as_R t |])
+  | Mc.CQ q ->  EConstr.mkApp(Lazy.force coq_IQR, [| dump_q q |])
+  | Mc.CZ z -> EConstr.mkApp(Lazy.force coq_IZR, [| dump_z z |])
+  | Mc.CPlus(x,y) -> EConstr.mkApp(Lazy.force coq_Rplus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+  | Mc.CMinus(x,y) -> EConstr.mkApp(Lazy.force coq_Rminus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+  | Mc.CMult(x,y) -> EConstr.mkApp(Lazy.force coq_Rmult, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+  | Mc.CInv t -> EConstr.mkApp(Lazy.force coq_Rinv, [| dump_Rcst_as_R t |])
+  | Mc.COpp t -> EConstr.mkApp(Lazy.force coq_Ropp, [| dump_Rcst_as_R t |])
 
 
 let dump_rexpr = lazy
@@ -1380,41 +1384,49 @@ let dump_rexpr = lazy
 
 *) 
 
-let rec make_goal_of_formula dexpr form =
+let prodn n env b =
+  let rec prodrec = function
+    | (0, env, b)        -> b
+    | (n, ((v,t)::l), b) -> prodrec (n-1,  l, EConstr.mkProd (v,t,b))
+    | _ -> assert false
+  in
+  prodrec (n,env,b)
+
+let make_goal_of_formula sigma dexpr form =
 
   let vars_idx =
     List.mapi (fun i v -> (v, i+1))  (ISet.elements (var_env_of_formula form)) in
 
   (*  List.iter (fun (v,i) -> Printf.fprintf stdout "var %i has index %i\n" v i) vars_idx ;*)
   
-  let props     = prop_env_of_formula form in 
+  let props     = prop_env_of_formula sigma form in 
 
-  let vars_n  = List.map (fun (_,i) -> (Names.id_of_string (Printf.sprintf "__x%i" i)) , dexpr.interp_typ) vars_idx in 
-  let props_n = List.mapi (fun i _ -> (Names.id_of_string (Printf.sprintf "__p%i" (i+1))) , Term.mkProp) props in 
+  let vars_n  = List.map (fun (_,i) -> (Names.Id.of_string (Printf.sprintf "__x%i" i)) , dexpr.interp_typ) vars_idx in 
+  let props_n = List.mapi (fun i _ -> (Names.Id.of_string (Printf.sprintf "__p%i" (i+1))) , EConstr.mkProp) props in 
 
   let var_name_pos = List.map2 (fun (idx,_) (id,_) -> id,idx) vars_idx vars_n in
 
   let  dump_expr i e =
     let rec dump_expr  = function
-    | Mc.PEX n -> mkRel (i+(List.assoc (CoqToCaml.positive n)  vars_idx))
+    | Mc.PEX n -> EConstr.mkRel (i+(List.assoc (CoqToCaml.positive n)  vars_idx))
     | Mc.PEc z -> dexpr.dump_cst z
-    | Mc.PEadd(e1,e2) -> mkApp(dexpr.dump_add,
+    | Mc.PEadd(e1,e2) -> EConstr.mkApp(dexpr.dump_add,
                                [| dump_expr e1;dump_expr e2|])
-    | Mc.PEsub(e1,e2) -> mkApp(dexpr.dump_sub,
+    | Mc.PEsub(e1,e2) -> EConstr.mkApp(dexpr.dump_sub,
                                [| dump_expr  e1;dump_expr  e2|])
-    | Mc.PEopp e -> mkApp(dexpr.dump_opp,
-                          [| dump_expr  e|])
-    | Mc.PEmul(e1,e2) ->  mkApp(dexpr.dump_mul,
-                                [| dump_expr  e1;dump_expr e2|])
-    | Mc.PEpow(e,n) ->  mkApp(dexpr.dump_pow,
-                              [| dump_expr  e; dexpr.dump_pow_arg  n|])
+    | Mc.PEopp e -> EConstr.mkApp(dexpr.dump_opp,
+                                  [| dump_expr  e|])
+    | Mc.PEmul(e1,e2) -> EConstr.mkApp(dexpr.dump_mul,
+                                       [| dump_expr  e1;dump_expr e2|])
+    | Mc.PEpow(e,n) -> EConstr.mkApp(dexpr.dump_pow,
+                                     [| dump_expr  e; dexpr.dump_pow_arg  n|])
     in dump_expr e in
   
   let mkop op e1 e2 =
       try
-        Term.mkApp(List.assoc op dexpr.dump_op, [| e1; e2|])
+        EConstr.mkApp(List.assoc op dexpr.dump_op, [| e1; e2|])
       with Not_found ->
-        Term.mkApp(Lazy.force coq_Eq,[|dexpr.interp_typ ; e1 ;e2|]) in
+        EConstr.mkApp(Lazy.force coq_Eq,[|dexpr.interp_typ ; e1 ;e2|]) in
     
   let dump_cstr i { Mc.flhs ; Mc.fop ; Mc.frhs } =
     mkop fop (dump_expr i flhs) (dump_expr i frhs) in
@@ -1423,13 +1435,13 @@ let rec make_goal_of_formula dexpr form =
     match f with
     | TT  -> Lazy.force coq_True
     | FF  -> Lazy.force coq_False
-    | C(x,y) -> mkApp(Lazy.force coq_and,[|xdump pi xi x ; xdump pi xi y|])
-    | D(x,y) -> mkApp(Lazy.force coq_or,[| xdump pi xi x ; xdump pi xi y|])
-    | I(x,_,y) -> mkArrow (xdump pi xi x) (xdump (pi+1) (xi+1) y)
-    | N(x) -> mkArrow (xdump pi xi x) (Lazy.force coq_False)
+    | C(x,y) -> EConstr.mkApp(Lazy.force coq_and,[|xdump pi xi x ; xdump pi xi y|])
+    | D(x,y) -> EConstr.mkApp(Lazy.force coq_or,[| xdump pi xi x ; xdump pi xi y|])
+    | I(x,_,y) -> EConstr.mkArrow (xdump pi xi x) (xdump (pi+1) (xi+1) y)
+    | N(x) -> EConstr.mkArrow (xdump pi xi x) (Lazy.force coq_False)
     | A(x,_,_) -> dump_cstr xi x
-    | X(t) -> let idx = Env.get_rank props t in
-              mkRel (pi+idx) in 
+    | X(t) -> let idx = Env.get_rank props sigma t in
+              EConstr.mkRel (pi+idx) in 
   
   let nb_vars  = List.length vars_n  in
   let nb_props = List.length props_n in 
@@ -1437,13 +1449,13 @@ let rec make_goal_of_formula dexpr form =
   (*  Printf.fprintf stdout "NBProps : %i\n" nb_props ;*)
   
   let subst_prop p =
-    let idx = Env.get_rank props p in
-    mkVar (Names.id_of_string (Printf.sprintf "__p%i"  idx)) in 
+    let idx = Env.get_rank props sigma p in
+    EConstr.mkVar (Names.Id.of_string (Printf.sprintf "__p%i"  idx)) in 
 
   let form' = map_prop subst_prop   form in
 
-  (Term.prodn nb_props (List.map (fun (x,y) -> Names.Name x,y) props_n)
-     (Term.prodn nb_vars (List.map (fun (x,y) -> Names.Name x,y) vars_n)
+  (prodn nb_props (List.map (fun (x,y) -> Name.Name x,y) props_n)
+     (prodn nb_vars (List.map (fun (x,y) -> Name.Name x,y) vars_n)
         (xdump (List.length vars_n) 0  form)),
    List.rev props_n, List.rev var_name_pos,form')
     
@@ -1458,7 +1470,7 @@ let rec make_goal_of_formula dexpr form =
     | [] -> acc
     | (e::l) ->
        let (name,expr,typ) = e in
-        xset (Term.mkNamedLetIn
+        xset (EConstr.mkNamedLetIn
                (Names.Id.of_string name)
                expr typ acc) l in
     xset concl l
@@ -1515,29 +1527,29 @@ 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
- (Coqlib.gen_constant_in_modules "VarMap"
+let coq_Node = 
+ lazy (gen_constant_in_modules "VarMap"
    [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Node")
-let coq_Leaf = lazy
- (Coqlib.gen_constant_in_modules "VarMap"
+let coq_Leaf = 
+ lazy (gen_constant_in_modules "VarMap"
    [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Leaf")
-let coq_Empty = lazy
- (Coqlib.gen_constant_in_modules "VarMap"
+let coq_Empty = 
+ lazy (gen_constant_in_modules "VarMap"
    [["Coq" ; "micromega" ;"VarMap"];["VarMap"]] "Empty")
 
-let coq_VarMap = lazy
-  (Coqlib.gen_constant_in_modules "VarMap"
+let coq_VarMap = 
+  lazy (gen_constant_in_modules "VarMap"
      [["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t")
  
 
 let rec dump_varmap typ m =
   match m with
-  | Mc.Empty -> Term.mkApp(Lazy.force coq_Empty,[| typ |])
-  | Mc.Leaf v -> Term.mkApp(Lazy.force coq_Leaf,[| typ; v|])
+  | Mc.Empty -> EConstr.mkApp(Lazy.force coq_Empty,[| typ |])
+  | Mc.Leaf v -> EConstr.mkApp(Lazy.force coq_Leaf,[| typ; v|])
   | Mc.Node(l,o,r) ->
-    Term.mkApp (Lazy.force coq_Node, [| typ; dump_varmap typ l; o ; dump_varmap typ r |])
+    EConstr.mkApp (Lazy.force coq_Node, [| typ; dump_varmap typ l; o ; dump_varmap typ r |])
 
 
 let vm_of_list env =
@@ -1559,15 +1571,15 @@ let rec pp_varmap o vm =
 let rec dump_proof_term = function
   | Micromega.DoneProof -> Lazy.force coq_doneProof
   | Micromega.RatProof(cone,rst) ->
-    Term.mkApp(Lazy.force coq_ratProof, [| dump_psatz coq_Z dump_z cone; dump_proof_term rst|])
+    EConstr.mkApp(Lazy.force coq_ratProof, [| dump_psatz coq_Z dump_z cone; dump_proof_term rst|])
  | Micromega.CutProof(cone,prf) ->
-    Term.mkApp(Lazy.force coq_cutProof,
+    EConstr.mkApp(Lazy.force coq_cutProof,
 	      [| dump_psatz coq_Z dump_z cone ;
 		 dump_proof_term prf|])
  | Micromega.EnumProof(c1,c2,prfs) ->
-    Term.mkApp (Lazy.force coq_enumProof,
-	       [|  dump_psatz coq_Z dump_z c1 ; dump_psatz coq_Z dump_z c2 ;
-		  dump_list (Lazy.force coq_proofTerm) dump_proof_term prfs |])
+    EConstr.mkApp (Lazy.force coq_enumProof,
+	           [|  dump_psatz coq_Z dump_z c1 ; dump_psatz coq_Z dump_z c2 ;
+		       dump_list (Lazy.force coq_proofTerm) dump_proof_term prfs |])
 
 
 let rec size_of_psatz = function
@@ -1627,11 +1639,11 @@ let parse_goal gl parse_arith env hyps term =
   * The datastructures that aggregate theory-dependent proof values.
   *)
 type ('synt_c, 'prf) domain_spec = {
-  typ : Term.constr; (* is the type of the interpretation domain - Z, Q, R*)
-  coeff : Term.constr ; (* is the type of the syntactic coeffs - Z , Q , Rcst *)
-  dump_coeff : 'synt_c -> Term.constr ; 
-  proof_typ  : Term.constr ; 
-  dump_proof   : 'prf -> Term.constr
+  typ : EConstr.constr; (* is the type of the interpretation domain - Z, Q, R*)
+  coeff : EConstr.constr ; (* is the type of the syntactic coeffs - Z , Q , Rcst *)
+  dump_coeff : 'synt_c -> EConstr.constr ; 
+  proof_typ  : EConstr.constr ; 
+  dump_proof   : 'prf -> EConstr.constr
 }
 
 let zz_domain_spec  = lazy {
@@ -1658,8 +1670,6 @@ let rcst_domain_spec  = lazy {
  dump_proof = dump_psatz coq_Q dump_q
 }
 
-open Proofview.Notations
-
 (** Naive topological sort of constr according to the subterm-ordering *)
 
 (* An element is minimal x is minimal w.r.t y if 
@@ -1687,7 +1697,8 @@ let rec mk_topo_order le l =
   | (Some v,l') -> v ::  (mk_topo_order le l')
 
     
-let topo_sort_constr l = mk_topo_order Termops.dependent l
+let topo_sort_constr l =
+  mk_topo_order (fun c t -> Termops.dependent Evd.empty (** FIXME *) (EConstr.of_constr c) (EConstr.of_constr t)) l
 
 
 (**
@@ -1697,24 +1708,23 @@ let topo_sort_constr l = mk_topo_order Termops.dependent l
 
 let micromega_order_change spec cert cert_typ env ff  (*: unit Proofview.tactic*) = 
  (* let ids = Util.List.map_i (fun i _ -> (Names.Id.of_string ("__v"^(string_of_int i)))) 0 env in *)
- let formula_typ = (Term.mkApp (Lazy.force coq_Cstr,[|spec.coeff|])) in
+ let formula_typ = (EConstr.mkApp (Lazy.force coq_Cstr,[|spec.coeff|])) in
  let ff  = dump_formula formula_typ (dump_cstr spec.coeff spec.dump_coeff) ff in
  let vm = dump_varmap (spec.typ) (vm_of_list env) in
  (* todo : directly generate the proof term - or generalize before conversion? *)
-  Proofview.Goal.nf_enter { enter = begin fun gl -> 
-   let gl = Tacmach.New.of_old (fun x -> x) gl in
+  Proofview.Goal.nf_enter begin fun gl -> 
    Tacticals.New.tclTHENLIST
     [
      Tactics.change_concl
     (set
       [
-       ("__ff", ff, Term.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
-       ("__varmap", vm, Term.mkApp(Lazy.force coq_VarMap, [|spec.typ|]));
+       ("__ff", ff, EConstr.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
+       ("__varmap", vm, EConstr.mkApp(Lazy.force coq_VarMap, [|spec.typ|]));
        ("__wit", cert, cert_typ)
       ]
-      (Tacmach.pf_concl gl))
+      (Tacmach.New.pf_concl gl))
   ] 
-  end }
+  end
 
 
 (**
@@ -1833,20 +1843,20 @@ let abstract_formula hyps f =
       | A(a,t,term) -> if TagSet.mem t hyps then A(a,t,term) else X(term)
       | C(f1,f2) ->
 	  (match xabs f1 , xabs f2 with
-	    |   X a1    ,  X a2   -> X (Term.mkApp(Lazy.force coq_and, [|a1;a2|]))
+	    |   X a1    ,  X a2   -> X (EConstr.mkApp(Lazy.force coq_and, [|a1;a2|]))
 	    |    f1     , f2      -> C(f1,f2) )
       | D(f1,f2) ->
 	  (match xabs f1 , xabs f2 with
-	    |   X a1    ,  X a2   -> X (Term.mkApp(Lazy.force coq_or, [|a1;a2|]))
+	    |   X a1    ,  X a2   -> X (EConstr.mkApp(Lazy.force coq_or, [|a1;a2|]))
 	    |    f1     , f2      -> D(f1,f2) )
       | N(f) ->
 	  (match xabs f with
-	    |   X a    -> X (Term.mkApp(Lazy.force coq_not, [|a|]))
+	    |   X a    -> X (EConstr.mkApp(Lazy.force coq_not, [|a|]))
 	    |     f     -> N f)
       | I(f1,hyp,f2) ->
 	  (match xabs f1 , hyp, xabs f2 with
 	    | X a1      , Some _ , af2    ->  af2
-	    | X a1      , None   , X a2   -> X (Term.mkArrow a1 a2)
+	    | X a1      , None   , X a2   -> X (EConstr.mkArrow a1 a2)
 	    |   af1     ,  _     , af2    -> I(af1,hyp,af2)
 	  )
       | FF -> FF
@@ -1900,10 +1910,10 @@ let micromega_tauto negate normalise unsat deduce spec prover env polys1 polys2
  if debug then
    begin
      Feedback.msg_notice (Pp.str "Formula....\n") ;
-     let formula_typ = (Term.mkApp(Lazy.force coq_Cstr, [|spec.coeff|])) in
+     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.prterm 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;
 
@@ -1925,11 +1935,11 @@ let micromega_tauto negate normalise unsat deduce spec prover env polys1 polys2
   if debug then
     begin
       Feedback.msg_notice (Pp.str "\nAFormula\n") ;
-      let formula_typ = (Term.mkApp( Lazy.force coq_Cstr,[| spec.coeff|])) in
+      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.prterm  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
@@ -1949,44 +1959,47 @@ let micromega_tauto negate normalise unsat deduce spec prover env polys1 polys2
     Some (ids,ff',res')
 
 
-
 (**
   * Parse the proof environment, and call micromega_tauto
   *)
 
+let fresh_id avoid id gl =
+  Tactics.fresh_id_in_env avoid id (Proofview.Goal.env gl)
+
 let micromega_gen
     parse_arith 
     (negate:'cst atom -> 'cst mc_cnf)
     (normalise:'cst atom -> 'cst mc_cnf)
     unsat deduce 
     spec dumpexpr prover tac =
- Proofview.Goal.nf_enter { enter = begin fun gl -> 
-    let gl = Tacmach.New.of_old (fun x -> x) gl in
-    let concl = Tacmach.pf_concl gl in
-    let hyps  = Tacmach.pf_hyps_types gl in
+ Proofview.Goal.nf_enter begin fun gl -> 
+    let sigma = Tacmach.New.project gl in
+    let concl = Tacmach.New.pf_concl gl in
+    let hyps  = Tacmach.New.pf_hyps_types gl in
     try
-     let (hyps,concl,env) = parse_goal gl parse_arith Env.empty hyps concl in
+     let gl0 = { env = Tacmach.New.pf_env gl; sigma } in
+     let (hyps,concl,env) = parse_goal gl0 parse_arith Env.empty hyps concl in
      let env = Env.elements env in
      let spec = Lazy.force spec in
      let dumpexpr = Lazy.force dumpexpr in
      
-     match micromega_tauto  negate normalise unsat deduce spec prover env hyps concl gl with
+     match micromega_tauto  negate normalise unsat deduce spec prover env hyps concl gl0 with
      | None -> Tacticals.New.tclFAIL 0 (Pp.str " Cannot find witness")
      | Some (ids,ff',res') -> 
-       let (arith_goal,props,vars,ff_arith) = make_goal_of_formula dumpexpr ff' in
+       let (arith_goal,props,vars,ff_arith) = make_goal_of_formula sigma dumpexpr ff' in
        let intro (id,_) = Tactics.introduction id  in 
 
        let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in
        let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
-       let ipat_of_name id = Some (Loc.ghost, Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
-       let goal_name = Tactics.fresh_id [] (Names.Id.of_string "__arith") gl in
-       let env' = List.map (fun (id,i) -> Term.mkVar id,i) vars in 
+       let ipat_of_name id = Some (CAst.make @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) 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 ; 
                                                     micromega_order_change spec res'
-                                                      (Term.mkApp(Lazy.force coq_list, [|spec.proof_typ|])) env' ff_arith ] in
+                                                      (EConstr.mkApp(Lazy.force coq_list, [|spec.proof_typ|])) env' ff_arith ] in
 
-       let goal_props = List.rev (prop_env_of_formula ff') in 
+       let goal_props = List.rev (prop_env_of_formula sigma ff') in 
 
        let goal_vars = List.map (fun (_,i) -> List.nth env (i-1)) vars in 
        
@@ -2003,8 +2016,8 @@ let micromega_gen
          [
            kill_arith;
            (Tacticals.New.tclTHENLIST
-            [(Tactics.generalize (List.map Term.mkVar ids));
-             Tactics.exact_check (Term.applist (Term.mkVar goal_name, arith_args))
+            [(Tactics.generalize (List.map EConstr.mkVar ids));
+             Tactics.exact_check (EConstr.applist (EConstr.mkVar goal_name, arith_args))
             ] )
          ]
     with
@@ -2016,7 +2029,7 @@ let micromega_gen
                             ^ "the use of a specialized external tool called csdp. \n\n" 
                             ^ "Unfortunately Coq isn't aware of the presence of any \"csdp\" executable in the path. \n\n"
                             ^ "Csdp packages are provided by some OS distributions; binaries and source code can be downloaded from https://projects.coin-or.org/Csdp"))
-  end }
+  end
 
 let micromega_gen parse_arith 
     (negate:'cst atom -> 'cst mc_cnf)
@@ -2032,28 +2045,27 @@ let micromega_order_changer cert env ff  =
   let coeff = Lazy.force coq_Rcst in
   let dump_coeff = dump_Rcst in
   let typ  = Lazy.force coq_R in
-  let cert_typ = (Term.mkApp(Lazy.force coq_list, [|Lazy.force coq_QWitness |])) in
+  let cert_typ = (EConstr.mkApp(Lazy.force coq_list, [|Lazy.force coq_QWitness |])) in
  
-  let formula_typ = (Term.mkApp (Lazy.force coq_Cstr,[| coeff|])) in
+  let formula_typ = (EConstr.mkApp (Lazy.force coq_Cstr,[| coeff|])) in
   let ff = dump_formula formula_typ (dump_cstr coeff dump_coeff) ff in
   let vm = dump_varmap (typ) (vm_of_list env) in
-  Proofview.Goal.nf_enter { enter = begin fun gl -> 
-    let gl = Tacmach.New.of_old (fun x -> x) gl in
+  Proofview.Goal.nf_enter begin fun gl -> 
     Tacticals.New.tclTHENLIST
      [
      (Tactics.change_concl
       (set
         [
-         ("__ff", ff, Term.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
-         ("__varmap", vm, Term.mkApp
-          (Coqlib.gen_constant_in_modules "VarMap"
+         ("__ff", ff, EConstr.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
+         ("__varmap", vm, EConstr.mkApp
+          (gen_constant_in_modules "VarMap"
 	    [["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t", [|typ|]));
          ("__wit", cert, cert_typ)
         ]
-        (Tacmach.pf_concl gl)));
+        (Tacmach.New.pf_concl gl)));
      (*      Tacticals.New.tclTHENLIST (List.map (fun id ->  (Tactics.introduction id)) ids)*)
      ]
-  end }
+  end
 
 let micromega_genr prover tac =
   let parse_arith = parse_rarith in
@@ -2068,39 +2080,40 @@ let micromega_genr prover tac =
     proof_typ = Lazy.force coq_QWitness ;
     dump_proof = dump_psatz coq_Q dump_q
   } in
-  Proofview.Goal.nf_enter { enter = begin fun gl -> 
-     let gl = Tacmach.New.of_old (fun x -> x) gl in
-     let concl = Tacmach.pf_concl gl in
-     let hyps  = Tacmach.pf_hyps_types gl in
+  Proofview.Goal.nf_enter begin fun gl -> 
+     let sigma = Tacmach.New.project gl in
+     let concl = Tacmach.New.pf_concl gl in
+     let hyps  = Tacmach.New.pf_hyps_types gl in
 
      try
-      let (hyps,concl,env) = parse_goal gl parse_arith Env.empty hyps concl in
+      let gl0 = { env = Tacmach.New.pf_env gl; sigma } in
+      let (hyps,concl,env) = parse_goal gl0 parse_arith Env.empty hyps concl in
        let env = Env.elements env in
        let spec = Lazy.force spec in
        
        let hyps' = List.map (fun (n,f) -> (n, map_atoms (Micromega.map_Formula Micromega.q_of_Rcst) f)) hyps in
        let concl' = map_atoms (Micromega.map_Formula Micromega.q_of_Rcst) concl in
        
-       match micromega_tauto  negate normalise unsat deduce spec prover env hyps' concl' gl with
+       match micromega_tauto  negate normalise unsat deduce spec prover env hyps' concl' gl0 with
        | None -> Tacticals.New.tclFAIL 0 (Pp.str " Cannot find witness") 
        | Some (ids,ff',res') -> 
          let (ff,ids) = formula_hyps_concl 
 	     (List.filter (fun (n,_) -> List.mem n ids) hyps) concl in
          let ff' = abstract_wrt_formula ff' ff  in
 
-         let (arith_goal,props,vars,ff_arith) = make_goal_of_formula (Lazy.force dump_rexpr)  ff' in
+         let (arith_goal,props,vars,ff_arith) = make_goal_of_formula sigma (Lazy.force dump_rexpr)  ff' in
          let intro (id,_) = Tactics.introduction id  in 
 
        let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in
        let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
-       let ipat_of_name id = Some (Loc.ghost, Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
-       let goal_name = Tactics.fresh_id [] (Names.Id.of_string "__arith") gl in
-       let env' = List.map (fun (id,i) -> Term.mkVar id,i) vars in 
+       let ipat_of_name id = Some (CAst.make @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) 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 ; 
                                                     micromega_order_changer res' env' ff_arith ] in
 
-       let goal_props = List.rev (prop_env_of_formula ff') in 
+       let goal_props = List.rev (prop_env_of_formula sigma ff') in 
 
        let goal_vars = List.map (fun (_,i) -> List.nth env (i-1)) vars in 
        
@@ -2117,8 +2130,8 @@ let micromega_genr prover tac =
          [
            kill_arith;
            (Tacticals.New.tclTHENLIST
-            [(Tactics.generalize (List.map Term.mkVar ids));
-             Tactics.exact_check (Term.applist (Term.mkVar goal_name, arith_args))
+            [(Tactics.generalize (List.map EConstr.mkVar ids));
+             Tactics.exact_check (EConstr.applist (EConstr.mkVar goal_name, arith_args))
             ] )
          ]
 
@@ -2131,7 +2144,7 @@ let micromega_genr prover tac =
                             ^ "the use of a specialized external tool called csdp. \n\n" 
                             ^ "Unfortunately Coq isn't aware of the presence of any \"csdp\" executable in the path. \n\n"
                             ^ "Csdp packages are provided by some OS distributions; binaries and source code can be downloaded from https://projects.coin-or.org/Csdp"))
-  end }
+  end
 
 
 
diff --git a/plugins/micromega/csdpcert.ml b/plugins/micromega/csdpcert.ml
index 2536005e..a1245b7c 100644
--- a/plugins/micromega/csdpcert.ml
+++ b/plugins/micromega/csdpcert.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.ml4
index 027f690f..81140a46 100644
--- a/plugins/micromega/g_micromega.ml4
+++ b/plugins/micromega/g_micromega.ml4
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
@@ -14,9 +16,9 @@
 (*                                                                      *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Constrarg
+open Ltac_plugin
+open Stdarg
+open Tacarg
 
 DECLARE PLUGIN "micromega_plugin"
 
diff --git a/plugins/micromega/mfourier.ml b/plugins/micromega/mfourier.ml
index f4f9b3c2..37799441 100644
--- a/plugins/micromega/mfourier.ml
+++ b/plugins/micromega/mfourier.ml
@@ -99,7 +99,7 @@ module PSet = ISet
 module System = Hashtbl.Make(Vect)
 
 type proof =
-| Hyp of int
+| Assum of int
 | Elim of  var * proof * proof
 | And of proof * proof
 
@@ -134,7 +134,7 @@ exception SystemContradiction of proof
 let hyps prf =
   let rec hyps prf acc =
     match prf with
-      | Hyp i -> ISet.add i acc
+      | Assum i -> ISet.add i acc
       | Elim(_,prf1,prf2)
       | And(prf1,prf2) -> hyps prf1 (hyps prf2 acc) in
     hyps prf ISet.empty
@@ -143,7 +143,7 @@ let hyps prf =
 (** Pretty printing *)
   let rec pp_proof o prf =
     match prf with
-      | Hyp i -> Printf.fprintf o "H%i" i
+      | Assum i -> Printf.fprintf o "H%i" i
       | Elim(v, prf1,prf2) -> Printf.fprintf o "E(%i,%a,%a)" v pp_proof prf1 pp_proof prf2
       | And(prf1,prf2)   -> Printf.fprintf o "A(%a,%a)"  pp_proof prf1 pp_proof prf2
 
@@ -270,7 +270,7 @@ let norm_cstr {coeffs = v ; op = o ; cst = c} idx =
   (match o with
 	| Eq -> Some c , Some c
 	| Ge -> Some c , None) ;
-	    prf = Hyp idx }
+	    prf = Assum idx }
 
 
 (** [load_system l] takes a list of constraints of type [cstr_compat]
@@ -285,7 +285,7 @@ let load_system l =
 
   let vars = List.fold_left (fun vrs (cstr,i) ->
     match norm_cstr cstr i with
-      | Contradiction -> raise (SystemContradiction (Hyp i))
+      | Contradiction -> raise (SystemContradiction (Assum i))
       | Redundant      -> vrs
       | Cstr(vect,info) ->
 	  xadd_cstr  vect info sys ;
@@ -867,7 +867,7 @@ let  mk_proof hyps prf =
 
   let rec mk_proof prf =
     match prf with
-      | Hyp i -> [ ([i, Int 1] , List.nth hyps i) ]
+      | Assum i -> [ ([i, Int 1] , List.nth hyps i) ]
 
       | Elim(v,prf1,prf2) ->
           let prfsl = mk_proof prf1
diff --git a/plugins/micromega/micromega.ml b/plugins/micromega/micromega.ml
index 5cf1da8e..52c6ef98 100644
--- a/plugins/micromega/micromega.ml
+++ b/plugins/micromega/micromega.ml
@@ -1,3 +1,4 @@
+
 (** val negb : bool -> bool **)
 
 let negb = function
@@ -34,8 +35,7 @@ module Coq__1 = struct
    | O -> m
    | S p -> S (add p m)
 end
-let add = Coq__1.add
-
+include Coq__1
 
 type positive =
 | XI of positive
@@ -82,11 +82,10 @@ module Coq_Pos =
        | XI q0 -> XI (add p q0)
        | XO q0 -> XO (add p q0)
        | XH -> XI p)
-    | XH ->
-      (match y with
-       | XI q0 -> XO (succ q0)
-       | XO q0 -> XI q0
-       | XH -> XO XH)
+    | XH -> (match y with
+             | XI q0 -> XO (succ q0)
+             | XO q0 -> XI q0
+             | XH -> XO XH)
 
   (** val add_carry : positive -> positive -> positive **)
 
@@ -154,10 +153,9 @@ module Coq_Pos =
        | XI q0 -> succ_double_mask (sub_mask_carry p q0)
        | XO q0 -> double_mask (sub_mask p q0)
        | XH -> IsPos (pred_double p))
-    | XH ->
-      (match y with
-       | XH -> IsNul
-       | _ -> IsNeg)
+    | XH -> (match y with
+             | XH -> IsNul
+             | _ -> IsNeg)
 
   (** val sub_mask_carry : positive -> positive -> mask **)
 
@@ -197,8 +195,7 @@ module Coq_Pos =
   | XO p2 -> S (size_nat p2)
   | XH -> S O
 
-  (** val compare_cont :
-      comparison -> positive -> positive -> comparison **)
+  (** val compare_cont : comparison -> positive -> positive -> comparison **)
 
   let rec compare_cont r x y =
     match x with
@@ -212,10 +209,9 @@ module Coq_Pos =
        | XI q0 -> compare_cont Lt p q0
        | XO q0 -> compare_cont r p q0
        | XH -> Gt)
-    | XH ->
-      (match y with
-       | XH -> r
-       | _ -> Lt)
+    | XH -> (match y with
+             | XH -> r
+             | _ -> Lt)
 
   (** val compare : positive -> positive -> comparison **)
 
@@ -277,14 +273,12 @@ let rec pow_pos rmul x = function
 
 let rec nth n0 l default =
   match n0 with
-  | O ->
-    (match l with
-     | [] -> default
-     | x::_ -> x)
-  | S m ->
-    (match l with
-     | [] -> default
-     | _::t0 -> nth m t0 default)
+  | O -> (match l with
+          | [] -> default
+          | x::_ -> x)
+  | S m -> (match l with
+            | [] -> default
+            | _::t0 -> nth m t0 default)
 
 (** val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list **)
 
@@ -389,15 +383,13 @@ module Z =
 
   let compare x y =
     match x with
-    | Z0 ->
-      (match y with
-       | Z0 -> Eq
-       | Zpos _ -> Lt
-       | Zneg _ -> Gt)
-    | Zpos x' ->
-      (match y with
-       | Zpos y' -> Coq_Pos.compare x' y'
-       | _ -> Gt)
+    | Z0 -> (match y with
+             | Z0 -> Eq
+             | Zpos _ -> Lt
+             | Zneg _ -> Gt)
+    | Zpos x' -> (match y with
+                  | Zpos y' -> Coq_Pos.compare x' y'
+                  | _ -> Gt)
     | Zneg x' ->
       (match y with
        | Zneg y' -> compOpp (Coq_Pos.compare x' y')
@@ -533,10 +525,9 @@ let p1 cI =
 
 let rec peq ceqb p p' =
   match p with
-  | Pc c ->
-    (match p' with
-     | Pc c' -> ceqb c c'
-     | _ -> false)
+  | Pc c -> (match p' with
+             | Pc c' -> ceqb c c'
+             | _ -> false)
   | Pinj (j, q0) ->
     (match p' with
      | Pinj (j', q') ->
@@ -568,8 +559,7 @@ let mkPinj_pred j p =
   | XH -> p
 
 (** val mkPX :
-    'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1
-    pol **)
+    'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let mkPX cO ceqb p i q0 =
   match p with
@@ -631,8 +621,8 @@ let rec paddI cadd pop q0 j = function
    | XH -> PX (p2, i, (pop q' q0)))
 
 (** val psubI :
-    ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol)
-    -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+    ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
+    'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec psubI cadd copp pop q0 j = function
 | Pc c -> mkPinj j (paddC cadd (popp copp q0) c)
@@ -644,13 +634,12 @@ let rec psubI cadd copp pop q0 j = function
 | PX (p2, i, q') ->
   (match j with
    | XI j0 -> PX (p2, i, (psubI cadd copp pop q0 (XO j0) q'))
-   | XO j0 ->
-     PX (p2, i, (psubI cadd copp pop q0 (Coq_Pos.pred_double j0) q'))
+   | XO j0 -> PX (p2, i, (psubI cadd copp pop q0 (Coq_Pos.pred_double j0) q'))
    | XH -> PX (p2, i, (pop q' q0)))
 
 (** val paddX :
-    'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1
-    pol -> positive -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
+    -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec paddX cO ceqb pop p' i' p = match p with
 | Pc _ -> PX (p', i', p)
@@ -666,16 +655,15 @@ let rec paddX cO ceqb pop p' i' p = match p with
    | Zneg k -> mkPX cO ceqb (paddX cO ceqb pop p' k p2) i q')
 
 (** val psubX :
-    'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol ->
-    'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
+    pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec psubX cO copp ceqb pop p' i' p = match p with
 | Pc _ -> PX ((popp copp p'), i', p)
 | Pinj (j, q') ->
   (match j with
    | XI j0 -> PX ((popp copp p'), i', (Pinj ((XO j0), q')))
-   | XO j0 ->
-     PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q')))
+   | XO j0 -> PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q')))
    | XH -> PX ((popp copp p'), i', q'))
 | PX (p2, i, q') ->
   (match Z.pos_sub i i' with
@@ -684,8 +672,8 @@ let rec psubX cO copp ceqb pop p' i' p = match p with
    | Zneg k -> mkPX cO ceqb (psubX cO copp ceqb pop p' k p2) i q')
 
 (** val padd :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
-    pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
+    -> 'a1 pol **)
 
 let rec padd cO cadd ceqb p = function
 | Pc c' -> paddC cadd p c'
@@ -703,8 +691,7 @@ let rec padd cO cadd ceqb p = function
    | PX (p2, i, q0) ->
      (match Z.pos_sub i i' with
       | Z0 ->
-        mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i
-          (padd cO cadd ceqb q0 q')
+        mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i (padd cO cadd ceqb q0 q')
       | Zpos k ->
         mkPX cO ceqb (padd cO cadd ceqb (PX (p2, k, (p0 cO))) p'0) i'
           (padd cO cadd ceqb q0 q')
@@ -713,8 +700,8 @@ let rec padd cO cadd ceqb p = function
           (padd cO cadd ceqb q0 q')))
 
 (** val psub :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
-    ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+    -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
 
 let rec psub cO cadd csub copp ceqb p = function
 | Pc c' -> psubC csub p c'
@@ -729,39 +716,36 @@ let rec psub cO cadd csub copp ceqb p = function
           (psub cO cadd csub copp ceqb (Pinj ((XO j0), q0)) q'))
       | XO j0 ->
         PX ((popp copp p'0), i',
-          (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0),
-            q0)) q'))
-      | XH ->
-        PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q0 q')))
+          (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0), q0))
+            q'))
+      | XH -> PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q0 q')))
    | PX (p2, i, q0) ->
      (match Z.pos_sub i i' with
       | Z0 ->
         mkPX cO ceqb (psub cO cadd csub copp ceqb p2 p'0) i
           (psub cO cadd csub copp ceqb q0 q')
       | Zpos k ->
-        mkPX cO ceqb
-          (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0) i'
-          (psub cO cadd csub copp ceqb q0 q')
+        mkPX cO ceqb (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0)
+          i' (psub cO cadd csub copp ceqb q0 q')
       | Zneg k ->
         mkPX cO ceqb
           (psubX cO copp ceqb (psub cO cadd csub copp ceqb) p'0 k p2) i
           (psub cO cadd csub copp ceqb q0 q')))
 
 (** val pmulC_aux :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
-    -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
+    'a1 pol **)
 
 let rec pmulC_aux cO cmul ceqb p c =
   match p with
   | Pc c' -> Pc (cmul c' c)
   | Pinj (j, q0) -> mkPinj j (pmulC_aux cO cmul ceqb q0 c)
   | PX (p2, i, q0) ->
-    mkPX cO ceqb (pmulC_aux cO cmul ceqb p2 c) i
-      (pmulC_aux cO cmul ceqb q0 c)
+    mkPX cO ceqb (pmulC_aux cO cmul ceqb p2 c) i (pmulC_aux cO cmul ceqb q0 c)
 
 (** val pmulC :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol
-    -> 'a1 -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
+    'a1 -> 'a1 pol **)
 
 let pmulC cO cI cmul ceqb p c =
   if ceqb c cO
@@ -769,8 +753,8 @@ let pmulC cO cI cmul ceqb p c =
   else if ceqb c cI then p else pmulC_aux cO cmul ceqb p c
 
 (** val pmulI :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol
-    -> 'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
+    'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec pmulI cO cI cmul ceqb pmul0 q0 j = function
 | Pc c -> mkPinj j (pmulC cO cI cmul ceqb q0 c)
@@ -791,13 +775,12 @@ let rec pmulI cO cI cmul ceqb pmul0 q0 j = function
      mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 XH p') i' (pmul0 q' q0))
 
 (** val pmul :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
 
 let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
 | Pc c -> pmulC cO cI cmul ceqb p c
-| Pinj (j', q') ->
-  pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p
+| Pinj (j', q') -> pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p
 | PX (p', i', q') ->
   (match p with
    | Pc c -> pmulC cO cI cmul ceqb p'' c
@@ -806,24 +789,22 @@ let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
        match j with
        | XI j0 -> pmul cO cI cadd cmul ceqb (Pinj ((XO j0), q0)) q'
        | XO j0 ->
-         pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q0))
-           q'
+         pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q0)) q'
        | XH -> pmul cO cI cadd cmul ceqb q0 q'
      in
      mkPX cO ceqb (pmul cO cI cadd cmul ceqb p p') i' qQ'
    | PX (p2, i, q0) ->
      let qQ' = pmul cO cI cadd cmul ceqb q0 q' in
-     let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2
-     in
+     let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2 in
      let qP' = pmul cO cI cadd cmul ceqb (mkPinj XH q0) p' in
      let pP' = pmul cO cI cadd cmul ceqb p2 p' in
      padd cO cadd ceqb
-       (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP')
-         i' (p0 cO)) (mkPX cO ceqb pQ' i qQ'))
+       (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP') i'
+         (p0 cO)) (mkPX cO ceqb pQ' i qQ'))
 
 (** val psquare :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> 'a1 pol -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 pol -> 'a1 pol **)
 
 let rec psquare cO cI cadd cmul ceqb = function
 | Pc c -> Pc (cmul c c)
@@ -852,9 +833,9 @@ let mk_X cO cI j =
   mkPinj_pred j (mkX cO cI)
 
 (** val ppow_pos :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive
-    -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1
+    pol **)
 
 let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
 | XI p3 ->
@@ -868,17 +849,16 @@ let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
 | XH -> subst_l (pmul cO cI cadd cmul ceqb res p)
 
 (** val ppow_N :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
 
 let ppow_N cO cI cadd cmul ceqb subst_l p = function
 | N0 -> p1 cI
 | Npos p2 -> ppow_pos cO cI cadd cmul ceqb subst_l (p1 cI) p p2
 
 (** val norm_aux :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr ->
-    'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
 
 let rec norm_aux cO cI cadd cmul csub copp ceqb = function
 | PEc c -> Pc c
@@ -899,8 +879,7 @@ let rec norm_aux cO cI cadd cmul csub copp ceqb = function
         padd cO cadd ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
           (norm_aux cO cI cadd cmul csub copp ceqb pe2)))
 | PEsub (pe1, pe2) ->
-  psub cO cadd csub copp ceqb
-    (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+  psub cO cadd csub copp ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
     (norm_aux cO cI cadd cmul csub copp ceqb pe2)
 | PEmul (pe1, pe2) ->
   pmul cO cI cadd cmul ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
@@ -947,8 +926,8 @@ let ff =
   []::[]
 
 (** val add_term :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause ->
-    'a1 clause option **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause -> 'a1
+    clause option **)
 
 let rec add_term unsat deduce t0 = function
 | [] ->
@@ -969,8 +948,8 @@ let rec add_term unsat deduce t0 = function
       | None -> None))
 
 (** val or_clause :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1
-    clause -> 'a1 clause option **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause
+    -> 'a1 clause option **)
 
 let rec or_clause unsat deduce cl1 cl2 =
   match cl1 with
@@ -981,8 +960,8 @@ let rec or_clause unsat deduce cl1 cl2 =
      | None -> None)
 
 (** val or_clause_cnf :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf
-    -> 'a1 cnf **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf ->
+    'a1 cnf **)
 
 let or_clause_cnf unsat deduce t0 f =
   fold_right (fun e acc ->
@@ -991,8 +970,8 @@ let or_clause_cnf unsat deduce t0 f =
     | None -> acc) [] f
 
 (** val or_cnf :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf ->
-    'a1 cnf **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
+    cnf **)
 
 let rec or_cnf unsat deduce f f' =
   match f with
@@ -1002,12 +981,12 @@ 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 -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
+    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+    -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
 
 let rec xcnf unsat deduce normalise0 negate0 pol0 = function
 | TT -> if pol0 then tt else ff
@@ -1047,9 +1026,9 @@ let rec cnf_checker checker f l =
      | c::l0 -> if checker e c then cnf_checker checker f0 l0 else false)
 
 (** val tauto_checker :
-    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) ->
-    ('a1 -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3
-    list -> bool **)
+    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+    -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list ->
+    bool **)
 
 let tauto_checker unsat deduce normalise0 negate0 checker f w =
   cnf_checker checker (xcnf unsat deduce normalise0 negate0 true f) w
@@ -1085,10 +1064,9 @@ let opMult o o' =
      | Equal -> Some Equal
      | NonEqual -> Some NonEqual
      | _ -> None)
-  | Strict ->
-    (match o' with
-     | NonEqual -> None
-     | _ -> Some o')
+  | Strict -> (match o' with
+               | NonEqual -> None
+               | _ -> Some o')
   | NonStrict ->
     (match o' with
      | Equal -> Some Equal
@@ -1100,14 +1078,12 @@ let opMult o o' =
 let opAdd o o' =
   match o with
   | Equal -> Some o'
-  | NonEqual ->
-    (match o' with
-     | Equal -> Some NonEqual
-     | _ -> None)
-  | Strict ->
-    (match o' with
-     | NonEqual -> None
-     | _ -> Some Strict)
+  | NonEqual -> (match o' with
+                 | Equal -> Some NonEqual
+                 | _ -> None)
+  | Strict -> (match o' with
+               | NonEqual -> None
+               | _ -> Some Strict)
   | NonStrict ->
     (match o' with
      | Equal -> Some NonStrict
@@ -1134,15 +1110,14 @@ let map_option f = function
 
 let map_option2 f o o' =
   match o with
-  | Some x ->
-    (match o' with
-     | Some x' -> f x x'
-     | None -> None)
+  | Some x -> (match o' with
+               | Some x' -> f x x'
+               | None -> None)
   | None -> None
 
 (** val pexpr_times_nformula :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **)
 
 let pexpr_times_nformula cO cI cplus ctimes ceqb e = function
 | ef,o ->
@@ -1151,8 +1126,8 @@ let pexpr_times_nformula cO cI cplus ctimes ceqb e = function
    | _ -> None)
 
 (** val nformula_times_nformula :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **)
 
 let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 =
   let e1,o1 = f1 in
@@ -1161,8 +1136,8 @@ let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 =
     (opMult o1 o2)
 
 (** val nformula_plus_nformula :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
-    'a1 nFormula -> 'a1 nFormula option **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
+    nFormula -> 'a1 nFormula option **)
 
 let nformula_plus_nformula cO cplus ceqb f1 f2 =
   let e1,o1 = f1 in
@@ -1170,9 +1145,9 @@ let nformula_plus_nformula cO cplus ceqb f1 f2 =
   map_option (fun x -> Some ((padd cO cplus ceqb e1 e2),x)) (opAdd o1 o2)
 
 (** val eval_Psatz :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz
-    -> 'a1 nFormula option **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
+    nFormula option **)
 
 let rec eval_Psatz cO cI cplus ctimes ceqb cleb l = function
 | PsatzIn n0 -> Some (nth n0 l ((Pc cO),Equal))
@@ -1207,9 +1182,8 @@ let check_inconsistent cO ceqb cleb = function
    | _ -> false)
 
 (** val check_normalised_formulas :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz
-    -> bool **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> bool **)
 
 let check_normalised_formulas cO cI cplus ctimes ceqb cleb l cm =
   match eval_Psatz cO cI cplus ctimes ceqb cleb l cm with
@@ -1227,31 +1201,30 @@ type op2 =
 type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
 
 (** val norm :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr ->
-    'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
 
-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 **)
+    '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 **)
+    '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 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
-    'a1 nFormula list **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+    nFormula list **)
 
 let xnormalise cO cI cplus ctimes cminus copp ceqb t0 =
   let { flhs = lhs; fop = o; frhs = rhs } = t0 in
@@ -1259,11 +1232,9 @@ let xnormalise cO cI cplus ctimes cminus copp ceqb t0 =
   let rhs0 = norm cO cI cplus ctimes cminus copp ceqb rhs in
   (match o with
    | OpEq ->
-     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO
-                                                               cplus
+     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO cplus
                                                                cminus copp
-                                                               ceqb rhs0
-                                                               lhs0),Strict)::[])
+                                                               ceqb rhs0 lhs0),Strict)::[])
    | OpNEq -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Equal)::[]
    | OpLe -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::[]
    | OpGe -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),Strict)::[]
@@ -1271,17 +1242,17 @@ let xnormalise cO cI cplus ctimes cminus copp ceqb t0 =
    | OpGt -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),NonStrict)::[])
 
 (** val cnf_normalise :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
-    'a1 nFormula cnf **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+    nFormula cnf **)
 
 let cnf_normalise cO cI cplus ctimes cminus copp ceqb t0 =
   map (fun x -> x::[]) (xnormalise cO cI cplus ctimes cminus copp ceqb t0)
 
 (** val xnegate :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
-    'a1 nFormula list **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+    nFormula list **)
 
 let xnegate cO cI cplus ctimes cminus copp ceqb t0 =
   let { flhs = lhs; fop = o; frhs = rhs } = t0 in
@@ -1290,20 +1261,18 @@ let xnegate cO cI cplus ctimes cminus copp ceqb t0 =
   (match o with
    | OpEq -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Equal)::[]
    | OpNEq ->
-     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO
-                                                               cplus
+     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO cplus
                                                                cminus copp
-                                                               ceqb rhs0
-                                                               lhs0),Strict)::[])
+                                                               ceqb rhs0 lhs0),Strict)::[])
    | OpLe -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),NonStrict)::[]
    | OpGe -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),NonStrict)::[]
    | OpLt -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),Strict)::[]
    | OpGt -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::[])
 
 (** val cnf_negate :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
-    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
-    'a1 nFormula cnf **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+    nFormula cnf **)
 
 let cnf_negate cO cI cplus ctimes cminus copp ceqb t0 =
   map (fun x -> x::[]) (xnegate cO cI cplus ctimes cminus copp ceqb t0)
@@ -1340,8 +1309,8 @@ let map_Formula c_of_S f =
   { flhs = (map_PExpr c_of_S l); fop = o; frhs = (map_PExpr c_of_S r) }
 
 (** val simpl_cone :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz
-    -> 'a1 psatz **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz ->
+    'a1 psatz **)
 
 let simpl_cone cO cI ctimes ceqb e = match e with
 | PsatzSquare t0 ->
@@ -1379,8 +1348,7 @@ let simpl_cone cO cI ctimes ceqb e = match e with
             | PsatzC p2 -> PsatzMulE ((PsatzC (ctimes c p2)), x)
             | _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2)))
       | PsatzAdd (y, z0) ->
-        PsatzAdd ((PsatzMulE ((PsatzC c), y)), (PsatzMulE ((PsatzC c),
-          z0)))
+        PsatzAdd ((PsatzMulE ((PsatzC c), y)), (PsatzMulE ((PsatzC c), z0)))
       | PsatzC c0 -> PsatzC (ctimes c c0)
       | PsatzZ -> PsatzZ
       | _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2))
@@ -1393,10 +1361,9 @@ let simpl_cone cO cI ctimes ceqb e = match e with
 | PsatzAdd (t1, t2) ->
   (match t1 with
    | PsatzZ -> t2
-   | _ ->
-     (match t2 with
-      | PsatzZ -> t1
-      | _ -> PsatzAdd (t1, t2)))
+   | _ -> (match t2 with
+           | PsatzZ -> t1
+           | _ -> PsatzAdd (t1, t2)))
 | _ -> e
 
 type q = { qnum : z; qden : positive }
@@ -1422,8 +1389,7 @@ let qle_bool x y =
 (** val qplus : q -> q -> q **)
 
 let qplus x y =
-  { qnum =
-    (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
+  { qnum = (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
     qden = (Coq_Pos.mul x.qden y.qden) }
 
 (** val qmult : q -> q -> q **)
@@ -1635,8 +1601,7 @@ let genCuttingPlane = function
      then None
      else Some ((makeCuttingPlane e),Equal)
    | NonEqual -> Some ((e,Z0),op)
-   | Strict ->
-     Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict)
+   | Strict -> Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict)
    | NonStrict -> Some ((makeCuttingPlane e),NonStrict))
 
 (** val nformula_of_cutting_plane : ((z polC * z) * op1) -> z nFormula **)
@@ -1647,10 +1612,9 @@ let nformula_of_cutting_plane = function
 (** val is_pol_Z0 : z polC -> bool **)
 
 let is_pol_Z0 = function
-| Pc z0 ->
-  (match z0 with
-   | Z0 -> true
-   | _ -> false)
+| Pc z0 -> (match z0 with
+            | Z0 -> true
+            | _ -> false)
 | _ -> false
 
 (** val eval_Psatz0 : z nFormula list -> zWitness -> z nFormula option **)
@@ -1730,8 +1694,8 @@ let qnormalise =
 (** val qnegate : q formula -> q nFormula cnf **)
 
 let qnegate =
-  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH }
-    qplus qmult qminus qopp qeq_bool
+  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus
+    qmult qminus qopp qeq_bool
 
 (** val qunsat : q nFormula -> bool **)
 
@@ -1789,8 +1753,8 @@ let rnormalise =
 (** val rnegate : q formula -> q nFormula cnf **)
 
 let rnegate =
-  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH }
-    qplus qmult qminus qopp qeq_bool
+  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus
+    qmult qminus qopp qeq_bool
 
 (** val runsat : q nFormula -> bool **)
 
diff --git a/plugins/micromega/micromega.mli b/plugins/micromega/micromega.mli
index beb042f4..96197817 100644
--- a/plugins/micromega/micromega.mli
+++ b/plugins/micromega/micromega.mli
@@ -1,3 +1,4 @@
+
 val negb : bool -> bool
 
 type nat =
@@ -168,44 +169,44 @@ val paddI :
   positive -> 'a1 pol -> 'a1 pol
 
 val psubI :
-  ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol)
-  -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+  ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
+  'a1 pol -> positive -> 'a1 pol -> 'a1 pol
 
 val paddX :
-  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1
-  pol -> positive -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
+  -> positive -> 'a1 pol -> 'a1 pol
 
 val psubX :
-  'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol ->
-  'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
+  pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
 
 val padd :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
-  -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
+  'a1 pol
 
 val psub :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
-  ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+  -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
 
 val pmulC_aux :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
-  'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 -> 'a1
+  pol
 
 val pmulC :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
-  'a1 -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
+  -> 'a1 pol
 
 val pmulI :
   'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
   'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
 
 val pmul :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
 
 val psquare :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> 'a1 pol -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 pol -> 'a1 pol
 
 type 'c pExpr =
 | PEc of 'c
@@ -219,17 +220,16 @@ type 'c pExpr =
 val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol
 
 val ppow_pos :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive ->
-  'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1 pol
 
 val ppow_N :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
 
 val norm_aux :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
 
 type 'a bFormula =
 | TT
@@ -256,34 +256,31 @@ val add_term :
   clause option
 
 val or_clause :
-  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause
-  -> 'a1 clause option
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause ->
+  'a1 clause option
 
 val or_clause_cnf :
-  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf ->
-  'a1 cnf
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf -> 'a1
+  cnf
 
 val or_cnf :
-  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
-  cnf
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1 cnf
 
 val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf
 
 val xcnf :
-  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
-  -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
+  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
+  'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
 
 val cnf_checker : ('a1 list -> 'a2 -> bool) -> 'a1 cnf -> 'a2 list -> bool
 
 val tauto_checker :
-  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
-  -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list ->
-  bool
+  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
+  'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list -> bool
 
 val cneqb : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
 
-val cltb :
-  ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
+val cltb : ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
 
 type 'c polC = 'c pol
 
@@ -314,30 +311,28 @@ val map_option2 :
   ('a1 -> 'a2 -> 'a3 option) -> 'a1 option -> 'a2 option -> 'a3 option
 
 val pexpr_times_nformula :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option
 
 val nformula_times_nformula :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option
 
 val nformula_plus_nformula :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
-  'a1 nFormula -> 'a1 nFormula option
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
+  nFormula -> 'a1 nFormula option
 
 val eval_Psatz :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz ->
-  'a1 nFormula option
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
+  nFormula option
 
 val check_inconsistent :
-  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
-  bool
+  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> bool
 
 val check_normalised_formulas :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz ->
-  bool
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> bool
 
 type op2 =
 | OpEq
@@ -350,36 +345,36 @@ type op2 =
 type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
 
 val norm :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
 
 val psub0 :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
-  ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+  -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
 
 val padd0 :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
-  -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
+  'a1 pol
 
 val xnormalise :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-  nFormula list
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+  list
 
 val cnf_normalise :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-  nFormula cnf
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+  cnf
 
 val xnegate :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-  nFormula list
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+  list
 
 val cnf_negate :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-  nFormula cnf
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+  cnf
 
 val xdenorm : positive -> 'a1 pol -> 'a1 pExpr
 
@@ -390,8 +385,8 @@ val map_PExpr : ('a2 -> 'a1) -> 'a2 pExpr -> 'a1 pExpr
 val map_Formula : ('a2 -> 'a1) -> 'a2 formula -> 'a1 formula
 
 val simpl_cone :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz
-  -> 'a1 psatz
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz ->
+  'a1 psatz
 
 type q = { qnum : z; qden : positive }
 
diff --git a/plugins/micromega/mutils.ml b/plugins/micromega/mutils.ml
index b4c6d032..82367c0b 100644
--- a/plugins/micromega/mutils.ml
+++ b/plugins/micromega/mutils.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/persistent_cache.ml b/plugins/micromega/persistent_cache.ml
index 0e6d346a..ee5a0458 100644
--- a/plugins/micromega/persistent_cache.ml
+++ b/plugins/micromega/persistent_cache.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (*  A persistent hashtable                                              *)
@@ -149,7 +151,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 +197,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/micromega/polynomial.ml b/plugins/micromega/polynomial.ml
index 90a108a3..db8b73a2 100644
--- a/plugins/micromega/polynomial.ml
+++ b/plugins/micromega/polynomial.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
diff --git a/plugins/micromega/sos.ml b/plugins/micromega/sos.ml
index cc89e2b9..e1ceabe9 100644
--- a/plugins/micromega/sos.ml
+++ b/plugins/micromega/sos.ml
@@ -21,8 +21,6 @@ let debugging = ref false;;
 
 exception Sanity;;
 
-exception Unsolvable;;
-
 (* ------------------------------------------------------------------------- *)
 (* Turn a rational into a decimal string with d sig digits.                  *)
 (* ------------------------------------------------------------------------- *)
@@ -99,28 +97,11 @@ let vector_const c n =
   if c =/ Int 0 then vector_0 n
   else (n,itlist (fun k -> k |-> c) (1--n) undefined :vector);;
 
-let vector_1 = vector_const (Int 1);;
-
 let vector_cmul c (v:vector) =
   let n = dim v in
   if c =/ Int 0 then vector_0 n
   else n,mapf (fun x -> c */ x) (snd v)
 
-let vector_neg (v:vector) = (fst v,mapf minus_num (snd v) :vector);;
-
-let vector_add (v1:vector) (v2:vector) =
-  let m = dim v1 and n = dim v2 in
-  if m <> n then failwith "vector_add: incompatible dimensions" else
-  (n,combine (+/) (fun x -> x =/ Int 0) (snd v1) (snd v2) :vector);;
-
-let vector_sub v1 v2 = vector_add v1 (vector_neg v2);;
-
-let vector_dot (v1:vector) (v2:vector) =
-  let m = dim v1 and n = dim v2 in
-  if m <> n then failwith "vector_add: incompatible dimensions" else
-  foldl (fun a i x -> x +/ a) (Int 0)
-        (combine ( */ ) (fun x -> x =/ Int 0) (snd v1) (snd v2));;
-
 let vector_of_list l =
   let n = List.length l in
   (n,itlist2 (|->) (1--n) l undefined :vector);;
@@ -133,13 +114,6 @@ let matrix_0 (m,n) = ((m,n),undefined:matrix);;
 
 let dimensions (m:matrix) = fst m;;
 
-let matrix_const c (m,n as mn) =
-  if m <> n then failwith "matrix_const: needs to be square"
-  else if c =/ Int 0 then matrix_0 mn
-  else (mn,itlist (fun k -> (k,k) |-> c) (1--n) undefined :matrix);;
-
-let matrix_1 = matrix_const (Int 1);;
-
 let matrix_cmul c (m:matrix) =
   let (i,j) = dimensions m in
   if c =/ Int 0 then matrix_0 (i,j)
@@ -152,8 +126,6 @@ let matrix_add (m1:matrix) (m2:matrix) =
   if d1 <> d2 then failwith "matrix_add: incompatible dimensions"
   else (d1,combine (+/) (fun x -> x =/ Int 0) (snd m1) (snd m2) :matrix);;
 
-let matrix_sub m1 m2 = matrix_add m1 (matrix_neg m2);;
-
 let row k (m:matrix) =
   let i,j = dimensions m in
   (j,
@@ -166,20 +138,10 @@ let column k (m:matrix) =
    foldl (fun a (i,j) c -> if j = k then (i |-> c) a else a) undefined (snd m)
    : vector);;
 
-let transp (m:matrix) =
-  let i,j = dimensions m in
-  ((j,i),foldl (fun a (i,j) c -> ((j,i) |-> c) a) undefined (snd m) :matrix);;
-
 let diagonal (v:vector) =
   let n = dim v in
   ((n,n),foldl (fun a i c -> ((i,i) |-> c) a) undefined (snd v) : matrix);;
 
-let matrix_of_list l =
-  let m = List.length l in
-  if m = 0 then matrix_0 (0,0) else
-  let n = List.length (List.hd l) in
-  (m,n),itern 1 l (fun v i -> itern 1 v (fun c j -> (i,j) |-> c)) undefined;;
-
 (* ------------------------------------------------------------------------- *)
 (* Monomials.                                                                *)
 (* ------------------------------------------------------------------------- *)
@@ -195,24 +157,8 @@ let monomial_var x = (x |=> 1 :monomial);;
 let (monomial_mul:monomial->monomial->monomial) =
   combine (+) (fun x -> false);;
 
-let monomial_pow (m:monomial) k =
-  if k = 0 then monomial_1
-  else mapf (fun x -> k * x) m;;
-
-let monomial_divides (m1:monomial) (m2:monomial) =
-  foldl (fun a x k -> tryapplyd m2 x 0 >= k && a) true m1;;
-
-let monomial_div (m1:monomial) (m2:monomial) =
-  let m = combine (+) (fun x -> x = 0) m1 (mapf (fun x -> -x) m2) in
-  if foldl (fun a x k -> k >= 0 && a) true m then m
-  else failwith "monomial_div: non-divisible";;
-
 let monomial_degree x (m:monomial) = tryapplyd m x 0;;
 
-let monomial_lcm (m1:monomial) (m2:monomial) =
-  (itlist (fun x -> x |-> max (monomial_degree x m1) (monomial_degree x m2))
-          (union (dom m1) (dom m2)) undefined :monomial);;
-
 let monomial_multidegree (m:monomial) = foldl (fun a x k -> k + a) 0 m;;
 
 let monomial_variables m = dom m;;
@@ -252,12 +198,6 @@ let poly_cmmul (c,m) (p:poly) =
 let poly_mul (p1:poly) (p2:poly) =
   foldl (fun a m c -> poly_add (poly_cmmul (c,m) p2) a) poly_0 p1;;
 
-let poly_div (p1:poly) (p2:poly) =
-  if not(poly_isconst p2) then failwith "poly_div: non-constant" else
-  let c = eval undefined p2 in
-  if c =/ Int 0 then failwith "poly_div: division by zero"
-  else poly_cmul (Int 1 // c) p1;;
-
 let poly_square p = poly_mul p p;;
 
 let rec poly_pow p k =
@@ -266,10 +206,6 @@ let rec poly_pow p k =
   else let q = poly_square(poly_pow p (k / 2)) in
        if k mod 2 = 1 then poly_mul p q else q;;
 
-let poly_exp p1 p2 =
-  if not(poly_isconst p2) then failwith "poly_exp: not a constant" else
-  poly_pow p1 (Num.int_of_num (eval undefined p2));;
-
 let degree x (p:poly) = foldl (fun a m c -> max (monomial_degree x m) a) 0 p;;
 
 let multidegree (p:poly) =
@@ -282,14 +218,14 @@ let poly_variables (p:poly) =
 (* Order monomials for human presentation.                                   *)
 (* ------------------------------------------------------------------------- *)
 
-let humanorder_varpow (x1,k1) (x2,k2) = x1 < x2 or x1 = x2 && k1 > k2;;
+let humanorder_varpow (x1,k1) (x2,k2) = x1 < x2 || x1 = x2 && k1 > k2;;
 
 let humanorder_monomial =
   let rec ord l1 l2 = match (l1,l2) with
     _,[] -> true
   | [],_ -> false
-  | h1::t1,h2::t2 -> humanorder_varpow h1 h2 or h1 = h2 && ord t1 t2 in
-  fun m1 m2 -> m1 = m2 or
+  | h1::t1,h2::t2 -> humanorder_varpow h1 h2 || h1 = h2 && ord t1 t2 in
+  fun m1 m2 -> m1 = m2 ||
                ord (sort humanorder_varpow (graph m1))
                    (sort humanorder_varpow (graph m2));;
 
@@ -297,42 +233,8 @@ let humanorder_monomial =
 (* Conversions to strings.                                                   *)
 (* ------------------------------------------------------------------------- *)
 
-let string_of_vector min_size max_size (v:vector) =
-  let n_raw = dim v in
-  if n_raw = 0 then "[]" else
-  let n = max min_size (min n_raw max_size) in
-  let xs = List.map ((o) string_of_num (element v)) (1--n) in
-  "[" ^ end_itlist (fun s t -> s ^ ", " ^ t) xs ^
-  (if n_raw > max_size then ", ...]" else "]");;
-
-let string_of_matrix max_size (m:matrix) =
-  let i_raw,j_raw = dimensions m in
-  let i = min max_size i_raw and j = min max_size j_raw in
-  let rstr = List.map (fun k -> string_of_vector j j (row k m)) (1--i) in
-  "["^end_itlist(fun s t -> s^";\n "^t) rstr ^
-  (if j > max_size then "\n ...]" else "]");;
-
 let string_of_vname (v:vname): string = (v: string);;
 
-let rec string_of_term t =
-  match t with
-  Opp t1 -> "(- " ^ string_of_term t1 ^ ")"
-| Add (t1, t2) ->
-   "(" ^ (string_of_term t1) ^ " + " ^ (string_of_term t2) ^ ")"
-| Sub (t1, t2) ->
-   "(" ^ (string_of_term t1) ^ " - " ^ (string_of_term t2) ^ ")"
-| Mul (t1, t2) ->
-   "(" ^ (string_of_term t1) ^ " * " ^ (string_of_term t2) ^ ")"
-| Inv t1 -> "(/ " ^ string_of_term t1 ^ ")"
-| Div (t1, t2) ->
-   "(" ^ (string_of_term t1) ^ " / " ^ (string_of_term t2) ^ ")"
-| Pow (t1, n1) ->
-   "(" ^ (string_of_term t1) ^ " ^ " ^ (string_of_int n1) ^ ")"
-| Zero -> "0"
-| Var v -> "x" ^ (string_of_vname v)
-| Const x -> string_of_num x;;
-
-
 let string_of_varpow x k =
   if k = 1 then string_of_vname x else string_of_vname x^"^"^string_of_int k;;
 
@@ -363,6 +265,7 @@ let string_of_poly (p:poly) =
 (* Printers.                                                                 *)
 (* ------------------------------------------------------------------------- *)
 
+(*
 let print_vector v = Format.print_string(string_of_vector 0 20 v);;
 
 let print_matrix m = Format.print_string(string_of_matrix 20 m);;
@@ -371,7 +274,6 @@ let print_monomial m = Format.print_string(string_of_monomial m);;
 
 let print_poly m = Format.print_string(string_of_poly m);;
 
-(*
 #install_printer print_vector;;
 #install_printer print_matrix;;
 #install_printer print_monomial;;
@@ -411,19 +313,6 @@ let sdpa_of_vector (v:vector) =
   end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";;
 
 (* ------------------------------------------------------------------------- *)
-(* String for block diagonal matrix numbered k.                              *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_of_blockdiagonal k m =
-  let pfx = string_of_int k ^" " in
-  let ents =
-    foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in
-  let entss = sort (increasing fst) ents in
-  itlist (fun ((b,i,j),c) a ->
-     pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^
-     " " ^ decimalize 20 c ^ "\n" ^ a) entss "";;
-
-(* ------------------------------------------------------------------------- *)
 (* String for a matrix numbered k, in SDPA sparse format.                    *)
 (* ------------------------------------------------------------------------- *)
 
@@ -466,6 +355,7 @@ let token s =
   >> (fun ((_,t),_) -> t);;
 
 let decimal =
+  let (||) = parser_or in
   let numeral = some isnum in
   let decimalint = atleast 1 numeral >> ((o) Num.num_of_string  implode) in
   let decimalfrac = atleast 1 numeral
@@ -485,13 +375,12 @@ let mkparser p s =
   let x,rst = p(explode s) in
   if rst = [] then x else failwith "mkparser: unparsed input";;
 
-let parse_decimal = mkparser decimal;;
-
 (* ------------------------------------------------------------------------- *)
 (* Parse back a vector.                                                      *)
 (* ------------------------------------------------------------------------- *)
 
-let parse_sdpaoutput,parse_csdpoutput =
+let _parse_sdpaoutput, parse_csdpoutput =
+  let (||) = parser_or in
   let vector =
     token "{" ++ listof decimal (token ",") "decimal" ++ token "}"
                >> (fun ((_,v),_) -> vector_of_list v) in
@@ -508,23 +397,10 @@ let parse_sdpaoutput,parse_csdpoutput =
   mkparser sdpaoutput,mkparser csdpoutput;;
 
 (* ------------------------------------------------------------------------- *)
-(* Also parse the SDPA output to test success (CSDP yields a return code).   *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_run_succeeded =
-   let rec skipupto dscr prs inp =
-      (dscr ++ prs >> snd
-    || some (fun c -> true) ++ skipupto dscr prs >> snd) inp in
-  let prs = skipupto (word "phase.value" ++ token "=")
-                     (possibly (a "p") ++ possibly (a "d") ++
-                      (word "OPT" || word "FEAS")) in
-  fun s -> try ignore (prs (explode s)); true with Noparse -> false;;
-
-(* ------------------------------------------------------------------------- *)
 (* The default parameters. Unfortunately this goes to a fixed file.          *)
 (* ------------------------------------------------------------------------- *)
 
-let sdpa_default_parameters =
+let _sdpa_default_parameters =
 "100     unsigned int maxIteration;\
 \n1.0E-7  double 0.0 < epsilonStar;\
 \n1.0E2   double 0.0 < lambdaStar;\
@@ -555,7 +431,7 @@ let sdpa_alt_parameters =
 \n1.0E-7  double 0.0 < epsilonDash;\
 \n";;
 
-let sdpa_params = sdpa_alt_parameters;;
+let _sdpa_params = sdpa_alt_parameters;;
 
 (* ------------------------------------------------------------------------- *)
 (* CSDP parameters; so far I'm sticking with the defaults.                   *)
@@ -588,10 +464,10 @@ let run_csdp dbg obj mats =
   let input_file = Filename.temp_file "sos" ".dat-s" in
   let output_file =
     String.sub input_file 0 (String.length input_file - 6) ^ ".out"
-  and params_file = Filename.concat (!temp_path) "param.csdp" in
+  and params_file = Filename.concat temp_path "param.csdp" in
   file_of_string input_file (sdpa_of_problem "" obj mats);
   file_of_string params_file csdp_params;
-  let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^
+  let rv = Sys.command("cd "^temp_path^"; csdp "^input_file ^
                         " " ^ output_file ^
                        (if dbg then "" else "> /dev/null")) in
   let op = string_of_file output_file in
@@ -600,16 +476,6 @@ let run_csdp dbg obj mats =
     else (Sys.remove input_file; Sys.remove output_file));
     rv,res);;
 
-let csdp obj mats =
-  let rv,res = run_csdp (!debugging) obj mats in
-  (if rv = 1 or rv = 2 then failwith "csdp: Problem is infeasible"
-   else if rv = 3 then ()
-    (* Format.print_string "csdp warning: Reduced accuracy";
-     Format.print_newline() *)
-   else if rv <> 0 then failwith("csdp: error "^string_of_int rv)
-   else ());
-  res;;
-
 (* ------------------------------------------------------------------------- *)
 (* Try some apparently sensible scaling first. Note that this is purely to   *)
 (* get a cleaner translation to floating-point, and doesn't affect any of    *)
@@ -653,21 +519,7 @@ let linear_program_basic a =
   let mats =  List.map (fun j -> diagonal (column j a)) (1--n)
   and obj = vector_const (Int 1) m in
   let rv,res = run_csdp false obj mats in
-  if rv = 1 or rv = 2 then false
-  else if rv = 0 then true
-  else failwith "linear_program: An error occurred in the SDP solver";;
-
-(* ------------------------------------------------------------------------- *)
-(* Alternative interface testing A x >= b for matrix A, vector b.            *)
-(* ------------------------------------------------------------------------- *)
-
-let linear_program a b =
-  let m,n = dimensions a in
-  if dim b <> m then failwith "linear_program: incompatible dimensions" else
-  let mats = diagonal b :: List.map (fun j -> diagonal (column j a)) (1--n)
-  and obj = vector_const (Int 1) m in
-  let rv,res = run_csdp false obj mats in
-  if rv = 1 or rv = 2 then false
+  if rv = 1 || rv = 2 then false
   else if rv = 0 then true
   else failwith "linear_program: An error occurred in the SDP solver";;
 
@@ -716,40 +568,6 @@ let equation_eval assig eq =
   foldl (fun a v c -> a +/ value(v) */ c) (Int 0) eq;;
 
 (* ------------------------------------------------------------------------- *)
-(* Eliminate among linear equations: return unconstrained variables and      *)
-(* assignments for the others in terms of them. We give one pseudo-variable  *)
-(* "one" that's used for a constant term.                                    *)
-(* ------------------------------------------------------------------------- *)
-
-let failstore = ref [];;
-
-let eliminate_equations =
-  let rec extract_first p l =
-    match l with
-      [] -> failwith "extract_first"
-    | h::t -> if p(h) then h,t else
-              let k,s = extract_first p t in
-              k,h::s in
-  let rec eliminate vars dun eqs =
-    match vars with
-      [] -> if forall is_undefined eqs then dun
-            else (failstore := [vars,dun,eqs]; raise Unsolvable)
-    | v::vs ->
-            try let eq,oeqs = extract_first (fun e -> defined e v) eqs in
-                let a = apply eq v in
-                let eq' = equation_cmul (Int(-1) // a) (undefine v eq) in
-                let elim e =
-                  let b = tryapplyd e v (Int 0) in
-                  if b =/ Int 0 then e else
-                  equation_add e (equation_cmul (minus_num b // a) eq) in
-                eliminate vs ((v |-> eq') (mapf elim dun)) (List.map elim oeqs)
-            with Failure _ -> eliminate vs dun eqs in
-  fun one vars eqs ->
-    let assig = eliminate vars undefined eqs in
-    let vs = foldl (fun a x f -> subtract (dom f) [one] @ a) [] assig in
-    setify vs,assig;;
-
-(* ------------------------------------------------------------------------- *)
 (* Eliminate all variables, in an essentially arbitrary order.               *)
 (* ------------------------------------------------------------------------- *)
 
@@ -780,18 +598,6 @@ let eliminate_all_equations one =
     setify vs,assig;;
 
 (* ------------------------------------------------------------------------- *)
-(* Solve equations by assigning arbitrary numbers.                           *)
-(* ------------------------------------------------------------------------- *)
-
-let solve_equations one eqs =
-  let vars,assigs = eliminate_all_equations one eqs in
-  let vfn = itlist (fun v -> (v |-> Int 0)) vars (one |=> Int(-1)) in
-  let ass =
-    combine (+/) (fun c -> false) (mapf (equation_eval vfn) assigs) vfn in
-  if forall (fun e -> equation_eval ass e =/ Int 0) eqs
-  then undefine one ass else raise Sanity;;
-
-(* ------------------------------------------------------------------------- *)
 (* Hence produce the "relevant" monomials: those whose squares lie in the    *)
 (* Newton polytope of the monomials in the input. (This is enough according  *)
 (* to Reznik: "Extremal PSD forms with few terms", Duke Math. Journal,       *)
@@ -898,19 +704,6 @@ let epoly_pmul p q acc =
                  a q) acc p;;
 
 (* ------------------------------------------------------------------------- *)
-(* Usual operations on equation-parametrized poly.                           *)
-(* ------------------------------------------------------------------------- *)
-
-let epoly_cmul c l =
-  if c =/ Int 0 then undefined else mapf (equation_cmul c) l;;
-
-let epoly_neg = epoly_cmul (Int(-1));;
-
-let epoly_add = combine equation_add is_undefined;;
-
-let epoly_sub p q = epoly_add p (epoly_neg q);;
-
-(* ------------------------------------------------------------------------- *)
 (* Convert regular polynomial. Note that we treat (0,0,0) as -1.             *)
 (* ------------------------------------------------------------------------- *)
 
@@ -953,11 +746,11 @@ let run_csdp dbg nblocks blocksizes obj mats =
   let input_file = Filename.temp_file "sos" ".dat-s" in
   let output_file =
     String.sub input_file 0 (String.length input_file - 6) ^ ".out"
-  and params_file = Filename.concat (!temp_path) "param.csdp" in
+  and params_file = Filename.concat temp_path "param.csdp" in
   file_of_string input_file
    (sdpa_of_blockproblem "" nblocks blocksizes obj mats);
   file_of_string params_file csdp_params;
-  let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^
+  let rv = Sys.command("cd "^temp_path^"; csdp "^input_file ^
                         " " ^ output_file ^
                        (if dbg then "" else "> /dev/null")) in
   let op = string_of_file output_file in
@@ -968,7 +761,7 @@ let run_csdp dbg nblocks blocksizes obj mats =
 
 let csdp nblocks blocksizes obj mats =
   let rv,res = run_csdp (!debugging) nblocks blocksizes obj mats in
-  (if rv = 1 or rv = 2 then failwith "csdp: Problem is infeasible"
+  (if rv = 1 || rv = 2 then failwith "csdp: Problem is infeasible"
    else if rv = 3 then ()
     (*Format.print_string "csdp warning: Reduced accuracy";
      Format.print_newline() *)
@@ -988,8 +781,6 @@ let bmatrix_cmul c bm =
 
 let bmatrix_neg = bmatrix_cmul (Int(-1));;
 
-let bmatrix_sub m1 m2 = bmatrix_add m1 (bmatrix_neg m2);;
-
 (* ------------------------------------------------------------------------- *)
 (* Smash a block matrix into components.                                     *)
 (* ------------------------------------------------------------------------- *)
@@ -1102,15 +893,6 @@ let real_positivnullstellensatz_general linf d eqs leqs pol =
   cfs,List.map (fun (a,b) -> snd a,b) msq;;
 
 (* ------------------------------------------------------------------------- *)
-(* Iterative deepening.                                                      *)
-(* ------------------------------------------------------------------------- *)
-
-let rec deepen f n =
-  try print_string "Searching with depth limit ";
-      print_int n; print_newline(); f n
-  with Failure _ -> deepen f (n + 1);;
-
-(* ------------------------------------------------------------------------- *)
 (* The ordering so we can create canonical HOL polynomials.                  *)
 (* ------------------------------------------------------------------------- *)
 
@@ -1136,10 +918,6 @@ let monomial_order =
     if deg1 < deg2 then false else if deg1 > deg2 then true
     else lexorder mon1 mon2;;
 
-let dest_poly p =
-  List.map (fun (m,c) -> c,dest_monomial m)
-      (sort (fun (m1,_) (m2,_) -> monomial_order m1 m2) (graph p));;
-
 (* ------------------------------------------------------------------------- *)
 (* Map back polynomials and their composites to HOL.                         *)
 (* ------------------------------------------------------------------------- *)
@@ -1373,9 +1151,6 @@ let rec allpermutations l =
   itlist (fun h acc -> List.map (fun t -> h::t)
                 (allpermutations (subtract l [h])) @ acc) l [];;
 
-let allvarorders l =
-  List.map (fun vlis x -> index x vlis) (allpermutations l);;
-
 let changevariables_monomial zoln (m:monomial) =
   foldl (fun a x k -> (List.assoc x zoln |-> k) a) monomial_1 m;;
 
@@ -1392,15 +1167,6 @@ let sdpa_of_vector (v:vector) =
   let strs = List.map (o (decimalize 20) (element v)) (1--n) in
   end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";;
 
-let sdpa_of_blockdiagonal k m =
-  let pfx = string_of_int k ^" " in
-  let ents =
-    foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in
-  let entss = sort (increasing fst) ents in
-  itlist (fun ((b,i,j),c) a ->
-     pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^
-     " " ^ decimalize 20 c ^ "\n" ^ a) entss "";;
-
 let sdpa_of_matrix k (m:matrix) =
   let pfx = string_of_int k ^ " 1 " in
   let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a)
@@ -1425,10 +1191,10 @@ let run_csdp dbg obj mats =
   let input_file = Filename.temp_file "sos" ".dat-s" in
   let output_file =
     String.sub input_file 0 (String.length input_file - 6) ^ ".out"
-  and params_file = Filename.concat (!temp_path) "param.csdp" in
+  and params_file = Filename.concat temp_path "param.csdp" in
   file_of_string input_file (sdpa_of_problem "" obj mats);
   file_of_string params_file csdp_params;
-  let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^
+  let rv = Sys.command("cd "^temp_path^"; csdp "^input_file ^
                        " " ^ output_file ^
                        (if dbg then "" else "> /dev/null")) in
   let op = string_of_file output_file in
@@ -1439,7 +1205,7 @@ let run_csdp dbg obj mats =
 
 let csdp obj mats =
   let rv,res = run_csdp (!debugging) obj mats in
-  (if rv = 1 or rv = 2 then failwith "csdp: Problem is infeasible"
+  (if rv = 1 || rv = 2 then failwith "csdp: Problem is infeasible"
     else if rv = 3 then ()
 (*    (Format.print_string "csdp warning: Reduced accuracy";
      Format.print_newline()) *)
diff --git a/plugins/micromega/sos.mli b/plugins/micromega/sos.mli
index 1ca27ea2..6e62c563 100644
--- a/plugins/micromega/sos.mli
+++ b/plugins/micromega/sos.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Sos_types
diff --git a/plugins/micromega/sos_lib.ml b/plugins/micromega/sos_lib.ml
index f54914f2..6b8b820a 100644
--- a/plugins/micromega/sos_lib.ml
+++ b/plugins/micromega/sos_lib.ml
@@ -525,7 +525,7 @@ let isspace,issep,isbra,issymb,isalpha,isnum,isalnum =
   and isalnum c = Array.get ctable (charcode c) >= 16 in
   isspace,issep,isbra,issymb,isalpha,isnum,isalnum;;
 
-let (||) parser1 parser2 input =
+let parser_or parser1 parser2 input =
   try parser1 input
   with Noparse -> parser2 input;;
 
@@ -571,7 +571,7 @@ let finished input =
 
 (* ------------------------------------------------------------------------- *)
 
-let temp_path = ref Filename.temp_dir_name;;
+let temp_path = Filename.get_temp_dir_name ();;
 
 (* ------------------------------------------------------------------------- *)
 (* Convenient conversion between files and (lists of) strings.               *)
diff --git a/plugins/micromega/sos_types.ml b/plugins/micromega/sos_types.ml
index 615ac5a2..dde1e6c0 100644
--- a/plugins/micromega/sos_types.ml
+++ b/plugins/micromega/sos_types.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* The type of positivstellensatz -- used to communicate with sos *)
diff --git a/plugins/micromega/sos_types.mli b/plugins/micromega/sos_types.mli
new file mode 100644
index 00000000..050ff1e4
--- /dev/null
+++ b/plugins/micromega/sos_types.mli
@@ -0,0 +1,42 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* The type of positivstellensatz -- used to communicate with sos *)
+
+type vname = string;;
+
+type term =
+| Zero
+| Const of Num.num
+| Var of vname
+| Inv of term
+| Opp of term
+| Add of (term * term)
+| Sub of (term * term)
+| Mul of (term * term)
+| Div of (term * term)
+| Pow of (term * int);;
+
+val output_term : out_channel -> term -> unit
+
+type positivstellensatz =
+   Axiom_eq of int
+ | Axiom_le of int
+ | Axiom_lt of int
+ | Rational_eq of Num.num
+ | Rational_le of Num.num
+ | Rational_lt of Num.num
+ | Square of term
+ | Monoid of int list
+ | Eqmul of term * positivstellensatz
+ | Sum of positivstellensatz * positivstellensatz
+ | Product of positivstellensatz * positivstellensatz;;
+
+val output_psatz : out_channel -> positivstellensatz -> unit
diff --git a/plugins/micromega/vo.itarget b/plugins/micromega/vo.itarget
deleted file mode 100644
index c9009ea4..00000000
--- a/plugins/micromega/vo.itarget
+++ /dev/null
@@ -1,15 +0,0 @@
-EnvRing.vo
-Env.vo
-OrderedRing.vo
-Psatz.vo
-QMicromega.vo
-Refl.vo
-RingMicromega.vo
-RMicromega.vo
-Tauto.vo
-VarMap.vo
-ZCoeff.vo
-ZMicromega.vo
-Lia.vo
-Lqa.vo
-Lra.vo
diff --git a/plugins/nsatz/Nsatz.v b/plugins/nsatz/Nsatz.v
index b11d15e5..c5a09d67 100644
--- a/plugins/nsatz/Nsatz.v
+++ b/plugins/nsatz/Nsatz.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*
@@ -28,6 +30,7 @@ Require Export Ncring_initial.
 Require Export Ncring_tac.
 Require Export Integral_domain.
 Require Import DiscrR.
+Require Import ZArith.
 
 Declare ML Module "nsatz_plugin".
 
@@ -54,9 +57,8 @@ simpl. simpl; cring.
 Qed.
 
 (* adpatation du code de Benjamin aux setoides *)
-Require Import ZArith.
-Require Export Ring_polynom.
-Require Export InitialRing.
+Export Ring_polynom.
+Export InitialRing.
 
 Definition PolZ := Pol Z.
 Definition PEZ := PExpr Z.
@@ -462,6 +464,11 @@ try (try apply Rsth;
 exact Rplus_opp_r.
 Defined.
 
+Class can_compute_Z (z : Z) := dummy_can_compute_Z : True.
+Hint Extern 0 (can_compute_Z ?v) =>
+  match isZcst v with true => exact I end : typeclass_instances.
+Instance reify_IZR z lvar {_ : can_compute_Z z} : reify (PEc z) lvar (IZR z).
+
 Lemma R_one_zero: 1%R <> 0%R.
 discrR.
 Qed.
diff --git a/plugins/nsatz/g_nsatz.ml4 b/plugins/nsatz/g_nsatz.ml4
index 5f906a8d..4ac49adb 100644
--- a/plugins/nsatz/g_nsatz.ml4
+++ b/plugins/nsatz/g_nsatz.ml4
@@ -1,17 +1,18 @@
-DECLARE PLUGIN "nsatz_plugin"
-
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
+open Ltac_plugin
+open Stdarg
 
 DECLARE PLUGIN "nsatz_plugin"
 
 TACTIC EXTEND nsatz_compute
-| [ "nsatz_compute"  constr(lt) ] -> [ Nsatz.nsatz_compute lt ]
+| [ "nsatz_compute"  constr(lt) ] -> [ Nsatz.nsatz_compute (EConstr.Unsafe.to_constr lt) ]
 END
diff --git a/plugins/nsatz/ideal.ml b/plugins/nsatz/ideal.ml
index 48bdad82..f8fc9437 100644
--- a/plugins/nsatz/ideal.ml
+++ b/plugins/nsatz/ideal.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Nullstellensatz with Groebner basis computation
@@ -23,7 +25,6 @@ exception NotInIdeal
    Global options
 *)
 let lexico = ref false
-let use_hmon = ref false
 
 (* division of tail monomials *)
 
@@ -33,31 +34,30 @@ let reduire_les_queues = false
 
 let nouveaux_pol_en_tete = false
 
-(***********************************************************************
-   Functor
-*)
-
-module Make (P:Polynom.S) = struct
-
-  type coef = P.t
-  let coef0 = P.of_num (Num.Int 0)
-  let coef1 = P.of_num (Num.Int 1)
-  let coefm1 = P.of_num (Num.Int (-1))
-  let string_of_coef c = "["^(P.to_string c)^"]"
-
-(***********************************************************************
-   Monomials
- array of integers, first is the degree
-*)
-
-type mon = int array
-type deg = int
-type poly = (coef * mon) list
-type polynom = 
-   {pol : poly ref;
-    num : int;
-    sugar : int}
-
+type metadata = {
+  name_var : string list;
+}
+
+module Monomial :
+sig
+type t
+val repr : t -> int array
+val make : int array -> t
+val deg : t -> int
+val nvar : t -> int
+val var_mon : int -> int -> t
+val mult_mon : t -> t -> t
+val compare_mon : t -> t -> int
+val div_mon : t -> t -> t
+val div_mon_test : t -> t -> bool
+val ppcm_mon : t -> t -> t
+val const_mon : int -> t
+end =
+struct
+type t = int array
+type mon = t
+let repr m = m
+let make m = m
 let nvar (m : mon) =  Array.length m - 1
 
 let deg (m : mon) = m.(0)
@@ -104,9 +104,6 @@ let div_mon m m' =
   done;
   m''
 
-let div_pol_coef p c =
-  List.map (fun (a,m) -> (P.divP a c,m)) p
-
 (* m' divides m  *)
 let div_mon_test m m' =
   let d = nvar m in
@@ -135,7 +132,45 @@ let ppcm_mon m m' =
   done;
   set_deg m''
 
+(* returns a constant polynom ial with d variables *)
+let const_mon d =
+  let m = Array.make (d+1) 0 in
+  let m = set_deg m in 
+  m
+
+let var_mon d i =
+  let m = Array.make (d+1) 0 in
+  m.(i) <- 1;
+  let m = set_deg m in 
+  m
+
+end
 
+(***********************************************************************
+   Functor
+*)
+
+module Make (P:Polynom.S) = struct
+
+  type coef = P.t
+  let coef0 = P.of_num (Num.Int 0)
+  let coef1 = P.of_num (Num.Int 1)
+  let string_of_coef c = "["^(P.to_string c)^"]"
+
+(***********************************************************************
+   Monomials
+ array of integers, first is the degree
+*)
+
+open Monomial
+
+type mon = Monomial.t
+type deg = int
+type poly = (coef * mon) list
+type polynom = {
+  pol : poly;
+  num : int;
+}
 
 (**********************************************************************
   Polynomials
@@ -163,8 +198,6 @@ module Hashpol = Hashtbl.Make(
 
 (* A pretty printer for polynomials, with Maple-like syntax. *)
 
-open Format
-
 let getvar lv i =
   try (List.nth lv i)
   with Failure _ -> (List.fold_left (fun r x -> r^" "^x) "lv= " lv)
@@ -179,8 +212,8 @@ let string_of_pol zeroP hdP tlP coefterm monterm string_of_coef
     for i=1 to (dimmon m) do
       (match (string_of_exp m i) with
         "0" -> ()
-      | "1" -> s:= (!s) @ [(getvar !lvar (i-1))]
-      | e -> s:= (!s) @ [((getvar !lvar (i-1)) ^ "^" ^ e)]);
+      | "1" -> s:= (!s) @ [(getvar lvar (i-1))]
+      | e -> s:= (!s) @ [((getvar lvar (i-1)) ^ "^" ^ e)]);
     done;
     (match !s with
       [] -> if coefone 
@@ -218,62 +251,7 @@ let string_of_pol zeroP hdP tlP coefterm monterm string_of_coef
   in 
   (stringP p true)
 
-
-
-let print_pol zeroP hdP tlP coefterm monterm string_of_coef
-    dimmon string_of_exp lvar p =
-
-  let rec print_mon m coefone =
-    let s=ref [] in
-    for i=1 to (dimmon m) do
-      (match (string_of_exp m i) with
-        "0" -> ()
-      | "1" -> s:= (!s) @ [(getvar !lvar (i-1))]
-      | e -> s:= (!s) @ [((getvar !lvar (i-1)) ^ "^" ^ e)]);
-    done;
-    (match !s with
-      [] -> if coefone 
-      then print_string "1"
-      else ()
-    | l -> if coefone 
-    then print_string (String.concat "*" l)
-    else (print_string "*"; 
-          print_string (String.concat "*" l)))
-  and print_term t start = let a = coefterm t and m = monterm t in
-  match (string_of_coef a) with
-    "0" -> ()
-  | "1" ->(match start with
-      true -> print_mon m true
-    |false -> (print_string "+ ";
-               print_mon m true))
-  | "-1" ->(print_string "-";print_space();print_mon m true)
-  | c -> if (String.get c 0)='-'
-  then (print_string "- ";
-        print_string (String.sub c 1 
-                        ((String.length c)-1));
-        print_mon m false)
-  else (match start with
-    true -> (print_string c;print_mon m false)
-  |false -> (print_string "+ ";
-             print_string c;print_mon m false))
-  and printP p start = 
-    if (zeroP p)
-    then (if start 
-    then print_string("0")
-    else ())
-    else (print_term (hdP p) start;
-          if start then open_hovbox 0;
-          print_space();
-          print_cut();
-          printP (tlP p) false)
-  in open_hovbox 3;
-  printP p true;
-  print_flush()
-
-
-let name_var= ref []
-
-let stringP p =
+let stringP metadata (p : poly) =
   string_of_pol 
     (fun p -> match p with [] -> true | _ -> false)
     (fun p -> match p with (t::p) -> t |_ -> failwith "print_pol dans dansideal")
@@ -281,55 +259,29 @@ let stringP p =
     (fun (a,m) -> a)
     (fun (a,m) -> m)
     string_of_coef
-    (fun m -> (Array.length m)-1)
-    (fun m i -> (string_of_int (m.(i))))
-    name_var
+    (fun m -> (Array.length (Monomial.repr m))-1)
+    (fun m i -> (string_of_int ((Monomial.repr m).(i))))
+    metadata.name_var
     p
 
-let nsP2 = ref max_int
+let nsP2 = 10
 
-let stringPcut p =
+let stringPcut metadata (p : poly) =
   (*Polynomesrec.nsP1:=20;*)
-  nsP2:=10;
   let res =
-    if (List.length p)> !nsP2
-    then (stringP [List.hd p])^" + "^(string_of_int (List.length p))^" terms"
-    else  stringP p in
+    if (List.length p)> nsP2
+    then (stringP metadata [List.hd p])^" + "^(string_of_int (List.length p))^" terms"
+    else  stringP metadata p in
   (*Polynomesrec.nsP1:= max_int;*)
-  nsP2:= max_int;
   res
 
-let rec lstringP l =
-  match l with
-    [] -> ""
-  |p::l -> (stringP p)^("\n")^(lstringP l)
-
-let printP = print_pol 
-    (fun p -> match p with [] -> true | _ -> false)
-    (fun p -> match p with (t::p) -> t |_ -> failwith "print_pol dans dansideal")
-    (fun p -> match p with (t::p) -> p |_ -> failwith "print_pol dans dansideal")
-    (fun (a,m) -> a)
-    (fun (a,m) -> m)
-    string_of_coef
-    (fun m -> (Array.length m)-1)
-    (fun m i -> (string_of_int (m.(i))))
-    name_var
-
-
-let rec lprintP l =
-  match l with
-    [] -> ()
-  |p::l -> printP p;print_string "\n"; lprintP l
-
-
 (* Operations *)
 
 let zeroP = []
 
 (* returns a constant polynom ial with d variables *)
 let polconst d c =
-  let m = Array.make (d+1) 0 in
-  let m = set_deg m in 
+  let m = const_mon d in
   [(c,m)]
 
 let plusP p q =
@@ -357,9 +309,7 @@ let coef_of_int x = P.of_num (Num.Int x)
 
 (* variable i *)
 let gen d i =
-  let m = Array.make (d+1) 0 in
-  m.(i) <- 1;
-  let m = set_deg m in 
+  let m = var_mon d i in 
   [((coef_of_int 1),m)]
 
 let oppP p =
@@ -390,7 +340,7 @@ let puisP p n=
   |_ ->
     if n = 0 then
       let d = nvar (snd (List.hd p)) in
-      [coef1, Array.make (d+1) 0]
+      [coef1, const_mon d]
     else
       let rec puisP p n =
         if n = 1 then p
@@ -400,49 +350,34 @@ let puisP p n=
           if n mod 2 = 0 then q else multP p q
       in puisP p n
 	
-let rec contentP p =
-  match p with
-  |[] -> coef1
-  |[a,m] -> a
-  |(a,m)::p1 ->
-      if P.equal a coef1 || P.equal a coefm1
-      then a
-      else P.pgcdP a (contentP p1)
-
-let contentPlist lp =
-  match lp with
-  |[] -> coef1
-  |p::l1 ->
-      List.fold_left
-	(fun r q ->
-	  if P.equal r coef1 || P.equal r coefm1
-	  then r
-	  else P.pgcdP r (contentP q))
-	(contentP p) l1
-	
 (***********************************************************************
    Division of polynomials
  *)
 
+type table = {
+  hmon : (mon, poly) Hashtbl.t option;
+  (* coefficients of polynomials when written with initial polynomials *)
+  coefpoldep : ((int * int), poly) Hashtbl.t;
+  mutable nallpol : int;
+  mutable allpol : polynom array;
+  (* list of initial polynomials *)
+}
+
 let pgcdpos a b  = P.pgcdP a b
 
-let polynom0 =  {pol = ref []; num = 0; sugar = 0}
+let polynom0 = { pol = []; num = 0 }
    
-let ppol p = !(p.pol)
+let ppol p = p.pol
 
 let lm p = snd (List.hd (ppol p))
 
-let nallpol = ref 0
-
-let allpol = ref (Array.make 1000 polynom0)
-
-let new_allpol p s =
-  nallpol := !nallpol + 1;
-  if !nallpol >= Array.length !allpol
+let new_allpol table p =
+  table.nallpol <- table.nallpol + 1;
+  if table.nallpol >= Array.length table.allpol
   then
-    allpol := Array.append !allpol (Array.make !nallpol polynom0);
-  let p = {pol = ref p; num = !nallpol; sugar = s} in
-  !allpol.(!nallpol)<- p;
+    table.allpol <- Array.append table.allpol (Array.make table.nallpol polynom0);
+  let p = { pol = p; num = table.nallpol } in
+  table.allpol.(table.nallpol) <- p;
   p
 
 (* returns a polynomial of l whose head monomial divides m, else [] *)
@@ -456,43 +391,42 @@ let rec selectdiv m l =
     |false -> selectdiv m r
 
 let div_pol p q a b m = 
-(*  info ".";*)
   plusP (emultP a p) (mult_t_pol b m q)
 
-let hmon = Hashtbl.create 1000
-
-let use_hmon = ref false
-
-let find_hmon m =
-  if !use_hmon
-  then Hashtbl.find hmon m
-  else raise Not_found
-
-let add_hmon m q =
-  if !use_hmon
-  then Hashtbl.add hmon m q
-  else ()
+let find_hmon table m = match table.hmon with
+| None -> raise Not_found
+| Some hmon -> Hashtbl.find hmon m
+
+let add_hmon table m q =
+match table.hmon with
+| None -> ()
+| Some hmon -> Hashtbl.add hmon m q
+
+let selectdiv table m l =
+  try find_hmon table m
+  with Not_found ->
+    let q = selectdiv m l in
+    let q = ppol q in
+    match q with
+    | [] -> q
+    | _ :: _ ->
+      let () = add_hmon table m q in
+      q
 
 let div_coef a b = P.divP a b
 
 
 (* remainder r of the division of p by polynomials of l, returns (c,r) where c is the coefficient for pseudo-division : c p = sum_i q_i p_i + r *)
 
-let reduce2 p l =
+let reduce2 table p l =
   let l = if nouveaux_pol_en_tete then List.rev l else l in
   let rec reduce p =
     match p with
       [] -> (coef1,[])
     |t::p' ->
 	let (a,m)=t in
-      let q = (try find_hmon m 
-      with Not_found -> 
-	let q = selectdiv m l in
-	match (ppol q) with 
-          t'::q' -> (add_hmon m q;
-		     q)
-	|[] -> q) in
-      match (ppol q) with
+      let q = selectdiv table m l in
+      match q with
 	[] -> if reduire_les_queues
 	then
 	  let (c,r)=(reduce p') in
@@ -508,37 +442,19 @@ let reduce2 p l =
   in let (c,r) = reduce p in
   (c,r)
 
-(* trace of divisions *)
-
-(* list of initial polynomials *)
-let poldep = ref [] 
-let poldepcontent = ref []
-
-(* coefficients of polynomials when written with initial polynomials *)
-let coefpoldep = Hashtbl.create 51
-
 (* coef of q in p = sum_i c_i*q_i *)
-let coefpoldep_find p q =
-  try (Hashtbl.find coefpoldep (p.num,q.num))
+let coefpoldep_find table p q =
+  try (Hashtbl.find table.coefpoldep (p.num,q.num))
   with Not_found -> []
 
-let coefpoldep_remove p q =
-  Hashtbl.remove coefpoldep (p.num,q.num)
-
-let coefpoldep_set p q c =
-  Hashtbl.add coefpoldep (p.num,q.num) c
-
-let initcoefpoldep d lp =
-  poldep:=lp;
-  poldepcontent:= List.map (fun p -> contentP (ppol p)) lp;
-  List.iter
-    (fun p -> coefpoldep_set p p (polconst d (coef_of_int 1)))
-    lp
+let coefpoldep_set table p q c =
+  Hashtbl.add table.coefpoldep (p.num,q.num) c
 
 (* keeps trace in coefpoldep 
    divides without pseudodivisions *)
 
-let reduce2_trace p l lcp =
+let reduce2_trace table p l lcp =
+  let lp = l in
   let l = if nouveaux_pol_en_tete then List.rev l else l in
   (* rend (lq,r), ou r = p + sum(lq) *)
   let rec reduce p =
@@ -546,15 +462,8 @@ let reduce2_trace p l lcp =
       [] -> ([],[])
     |t::p' ->
 	let (a,m)=t in
-      let q =
-	(try find_hmon m 
-	with Not_found -> 
-	  let q = selectdiv m l in
-	  match (ppol q) with 
-            t'::q' -> (add_hmon m q;
-		       q)
-          |[] -> q) in
-      match (ppol q) with
+      let q = selectdiv table m l in
+      match q with
 	[] ->
 	  if reduire_les_queues
 	  then
@@ -568,19 +477,12 @@ let reduce2_trace p l lcp =
           let (lq,r)=reduce p1 in
           ((b',m'',q)::lq, r)
   in let (lq,r) = reduce p in
-  (*info "reduce2_trace:\n";
-     iter
-     (fun (a,m,s) ->
-     let x = mult_t_pol a m s in
-     info ((stringP x)^"\n"))
-     lq;
-     info "ok\n";*)
   (List.map2
      (fun c0 q ->
        let c =
 	 List.fold_left
 	   (fun x (a,m,s) ->
-	     if equal (ppol s) (ppol q)
+	     if equal s (ppol q)
 	     then
 	       plusP x (mult_t_pol a m (polconst (nvar m) (coef_of_int 1)))
 	     else x)
@@ -588,25 +490,14 @@ let reduce2_trace p l lcp =
 	   lq in
        c)
      lcp
-     !poldep,
+     lp,
    r)     
 
-let homogeneous = ref false
-let pol_courant = ref polynom0
-
 (***********************************************************************
    Completion
  *)
 
-let sugar_flag = ref true
-
-let compute_sugar p =
-  List.fold_left (fun s (a,m) -> max s m.(0)) 0 p
-
-let mk_polynom p = 
-  new_allpol p (compute_sugar p)
-
-let spol ps qs=
+let spol0 ps qs=
   let p = ppol ps in
   let q = ppol qs in
   let m = snd (List.hd p) in
@@ -628,14 +519,9 @@ let spol ps qs=
 	 (P.oppP (div_coef a c))
          m2 q') in
   let sp = fsp p' q' in
-  let sps =
-    new_allpol
-      sp
-      (max (m1.(0) + ps.sugar) (m2.(0) + qs.sugar)) in
-  coefpoldep_set sps ps (fsp (polconst (nvar m) (coef_of_int 1)) []);
-  coefpoldep_set sps qs (fsp [] (polconst (nvar m) (coef_of_int 1)));
-  sps
-  
+  let p0 = fsp (polconst (nvar m) (coef_of_int 1)) [] in
+  let q0 = fsp [] (polconst (nvar m) (coef_of_int 1)) in
+  (sp, p0, q0)
 
 let etrangers p p'=
   let m = snd (List.hd p) in
@@ -644,301 +530,183 @@ let etrangers p p'=
   let res=ref true in
   let i=ref 1 in
   while (!res) && (!i<=d) do
-    res:= (m.(!i) = 0) || (m'.(!i)=0);
+    res:= ((Monomial.repr m).(!i) = 0) || ((Monomial.repr m').(!i)=0);
       i:=!i+1;
   done;
   !res
 
-(* teste if head monomial of p'' divides lcm of lhead monomials of p and p' *)
-
-let div_ppcm p p' p'' =
-  let m = snd (List.hd p) in
-  let m'= snd (List.hd p') in
-  let m''= snd (List.hd p'') in
-  let d = nvar m in
-  let res=ref true in
-  let i=ref 1 in
-  while (!res) && (!i<=d) do
-    res:= ((max m.(!i) m'.(!i)) >= m''.(!i));
-    i:=!i+1;
-  done;
-  !res
-
-(* code from extraction of Laurent Théry Coq program *)
-
-type 'poly cpRes =
-    Keep of ('poly list)
-  | DontKeep of ('poly list)
-
-let list_rec f0 f1 =
-  let rec f2 = function
-      [] -> f0
-    | a0::l0 -> f1 a0 l0 (f2 l0)
-  in f2
-
-let addRes i = function
-    Keep h'0 -> Keep (i::h'0)
-  | DontKeep h'0 -> DontKeep (i::h'0)
-
-let slice i a q =
-  list_rec
-    (match etrangers (ppol i) (ppol a) with
-      true -> DontKeep []
-    | false -> Keep [])
-    (fun b q1 rec_ren ->
-      match div_ppcm (ppol i) (ppol a) (ppol b) with
-	true ->  DontKeep (b::q1)
-      | false ->
-          (match div_ppcm (ppol i) (ppol b) (ppol a) with
-            true -> rec_ren
-          | false -> addRes b rec_ren)) q
-
-(* sugar strategy *)
-
 let addS x l =    l @ [x] (* oblige de mettre en queue sinon le certificat deconne *)
-			  
-let addSsugar x l =
-  if !sugar_flag
-  then 
-    let sx = x.sugar in
-    let rec insere l  =
-      match l with
-      | [] -> [x]
-      | y::l1 ->
-	  if sx <= y.sugar
-	  then x::l
-	  else y::(insere l1)
-    in insere l
-  else addS x l
-
-(* ajoute les spolynomes de i avec la liste de polynomes aP, 
-   a la liste q *)
-
-let genPcPf i aP q =
-  (let rec genPc aP0 =
-    match aP0 with
-      [] -> (fun r -> r)
-    | a::l1 -> 
-	(fun l ->
-          (match slice i a l1 with
-            Keep l2 -> addSsugar (spol i a) (genPc l2 l)
-          | DontKeep l2 -> genPc l2 l))
-  in genPc aP) q
-
-let genOCPf h' =
-  list_rec [] (fun a l rec_ren ->
-    genPcPf a l rec_ren) h'
-    
+
 (***********************************************************************
  critical pairs/s-polynomials
  *)
-    
-let ordcpair ((i1,j1),m1) ((i2,j2),m2) =
-(*  let s1 = (max
-	      (!allpol.(i1).sugar + m1.(0)
-		   - (snd (hd (ppol !allpol.(i1)))).(0))
-	      (!allpol.(j1).sugar + m1.(0)
-		   - (snd (hd (ppol !allpol.(j1)))).(0))) in 
-  let s2 = (max
-	      (!allpol.(i2).sugar + m2.(0)
-		   - (snd (hd (ppol !allpol.(i2)))).(0))
-	      (!allpol.(j2).sugar + m2.(0)
-		   - (snd (hd (ppol !allpol.(j2)))).(0))) in 
-  match compare s1 s2 with
-  | 1 -> 1
-  |(-1) -> -1
-  |0 ->  compare_mon m1 m2*)
-
-  compare_mon m1 m2 
-
-let sortcpairs lcp = 
-  List.sort ordcpair lcp
-
-let mergecpairs l1 l2 =
-  List.merge ordcpair l1 l2 
+
+module CPair =
+struct
+type t = (int * int) * Monomial.t
+let compare ((i1, j1), m1) ((i2, j2), m2) = compare_mon m2 m1
+end
+
+module Heap :
+sig
+  type elt = (int * int) * Monomial.t
+  type t
+  val length : t -> int
+  val empty : t
+  val add : elt -> t -> t
+  val pop : t -> (elt * t) option
+end =
+struct
+  include Heap.Functional(CPair)
+  let length h = fold (fun _ accu -> accu + 1) h 0
+  let pop h = try Some (maximum h, remove h) with Heap.EmptyHeap -> None
+end
 
 let ord i j =
   if i<j then (i,j) else (j,i)
     
-let cpair p q =
-  if etrangers (ppol p) (ppol q)
-  then []
-  else [(ord p.num q.num,
-	 ppcm_mon (lm p) (lm q))]
-      
-let cpairs1 p lq =
-  sortcpairs (List.fold_left (fun r q -> r @ (cpair p q)) [] lq)
-    
-let cpairs lp =
-  let rec aux l =
-    match l with
-      []|[_] -> []
-    |p::l1 -> mergecpairs (cpairs1 p l1) (aux l1)
-  in aux lp
-    
-    
-let critere2 ((i,j),m) lp lcp =
-  List.exists
-    (fun h ->
-      h.num <> i && h.num <> j
-        && (div_mon_test m (lm h))
-	&& (let c1 = ord i h.num in
-	not (List.exists (fun (c,_) -> c1 = c) lcp))
-	&& (let c1 = ord j h.num in
-	not (List.exists (fun (c,_) -> c1 = c) lcp)))
-    lp
+let cpair p q accu =
+  if etrangers (ppol p) (ppol q) then accu
+  else Heap.add (ord p.num q.num, ppcm_mon (lm p) (lm q)) accu
+
+let cpairs1 p lq accu =
+  List.fold_left (fun r q -> cpair p q r) accu lq
 
-let critere3 ((i,j),m) lp lcp =
+let rec cpairs l accu = match l with
+| [] | [_] -> accu
+| p :: l ->
+  cpairs l (cpairs1 p l accu)
+
+let critere3 table ((i,j),m) lp lcp =
   List.exists
     (fun h ->
       h.num <> i && h.num <> j
         && (div_mon_test m (lm h))
 	&& (h.num < j
 	   || not (m = ppcm_mon 
-		   (lm (!allpol.(i)))
+		   (lm (table.allpol.(i)))
 		   (lm h)))
 	&& (h.num < i
 	  || not (m = ppcm_mon 
-		   (lm (!allpol.(j)))
+		   (lm (table.allpol.(j)))
 		   (lm h))))
     lp
 
-let add_cpairs p lp lcp =
-  mergecpairs (cpairs1 p lp) lcp 
-
-let step = ref 0
-
 let infobuch p q =
-  if !step = 0 
-  then (info ("[" ^ (string_of_int (List.length p))
-              ^ "," ^  (string_of_int (List.length q))
-              ^ "]"))
+  (info (fun () -> Printf.sprintf "[%i,%i]" (List.length p) (Heap.length q)))
 
 (* in lp new polynomials are at the end *)
 
-let coef_courant = ref coef1
-
 type certificate =
     { coef : coef; power : int;
       gb_comb : poly list list; last_comb : poly list }
 
-let test_dans_ideal p lp lp0 =
-  let (c,r) = reduce2 (ppol !pol_courant) lp in
-  info ("remainder: "^(stringPcut r)^"\n");
-  coef_courant:= P.multP !coef_courant c;
-  pol_courant:= mk_polynom r;
-  if r=[]
-  then (info "polynomial reduced to 0\n";
-	let lcp = List.map (fun q -> []) !poldep in
-	let c = !coef_courant in
-	let (lcq,r) = reduce2_trace (emultP c p) lp lcp in
-	info "r ok\n";
-	info ("r: "^(stringP r)^"\n");
-        let res=ref  (emultP c p) in
-	List.iter2
-	  (fun cq q -> res:=plusP (!res) (multP cq (ppol q));
-	  )
-	  lcq !poldep;
-	info ("verif sum: "^(stringP (!res))^"\n");
-	info ("coefficient: "^(stringP (polconst 1 c))^"\n");
-	let rec aux lp =
-	  match lp with
-	  |[] -> []
-	  |p::lp ->
-	      (List.map
-		 (fun q -> coefpoldep_find p q)
-		 lp)::(aux lp)
-	in
-	let coefficient_multiplicateur = c in
-	let liste_polynomes_de_depart = List.rev lp0 in
-	let polynome_a_tester = p in
-	let liste_des_coefficients_intermediaires =
-	  (let lci = List.rev (aux (List.rev lp)) in
-	  let lci = ref lci (* (map rev lci) *) in
-	  List.iter (fun x -> lci := List.tl (!lci)) lp0;
-	  !lci) in
-	let liste_des_coefficients =
-	  List.map
-	    (fun cq -> emultP (coef_of_int (-1)) cq)
-	    (List.rev lcq) in
-	(liste_polynomes_de_depart,
-	 polynome_a_tester,
-	 {coef = coefficient_multiplicateur;
-	  power = 1;
-	  gb_comb = liste_des_coefficients_intermediaires;
-	  last_comb = liste_des_coefficients})
-       )
-  else ((*info "polynomial not reduced to 0\n";
-	   info ("\nremainder: "^(stringPcut r)^"\n");*)
-    raise NotInIdeal)
-      
-let divide_rem_with_critical_pair = ref false
-
-let list_diff l x =
-  List.filter (fun y -> y <> x) l
+type current_problem = {
+  cur_poly : poly;
+  cur_coef : coef;
+}
+
+exception NotInIdealUpdate of current_problem
+
+let test_dans_ideal cur_pb table metadata p lp len0 =
+  (** Invariant: [lp] is [List.tl (Array.to_list table.allpol)] *)
+  let (c,r) = reduce2 table cur_pb.cur_poly lp in
+  info (fun () -> "remainder: "^(stringPcut metadata r));
+  let cur_pb = {
+    cur_coef = P.multP cur_pb.cur_coef c;
+    cur_poly = r;
+  } in
+  match r with
+  | [] ->
+    sinfo "polynomial reduced to 0";
+    let lcp = List.map (fun q -> []) lp in
+    let c = cur_pb.cur_coef in
+    let (lcq,r) = reduce2_trace table (emultP c p) lp lcp in
+    sinfo "r ok";
+    info (fun () -> "r: "^(stringP metadata r));
+    info (fun () ->
+      let fold res cq q = plusP res (multP cq (ppol q)) in
+      let res = List.fold_left2 fold (emultP c p) lcq lp in
+      "verif sum: "^(stringP metadata res)
+    );
+    info (fun () -> "coefficient: "^(stringP metadata (polconst 1 c)));
+    let coefficient_multiplicateur = c in
+    let liste_des_coefficients_intermediaires =
+      let rec aux accu lp =
+        match lp with
+        | [] -> accu
+        | p :: lp ->
+          let elt = List.map (fun q -> coefpoldep_find table p q) lp in
+          aux (elt :: accu) lp
+      in
+      let lci = aux [] (List.rev lp) in
+      CList.skipn len0 lci
+    in
+    let liste_des_coefficients =
+      List.rev_map (fun cq -> emultP (coef_of_int (-1)) cq) lcq
+    in
+      {coef = coefficient_multiplicateur;
+      power = 1;
+      gb_comb = liste_des_coefficients_intermediaires;
+      last_comb = liste_des_coefficients}
+  | _ -> raise (NotInIdealUpdate cur_pb)
 
 let deg_hom p =
   match p with
   | [] -> -1
-  | (a,m)::_ -> m.(0)
-
-let pbuchf pq p lp0=
-  info "computation of the Groebner basis\n";
-  step:=0;
-  Hashtbl.clear hmon;
-  let rec pbuchf (lp, lpc) =
+  | (a,m)::_ -> Monomial.deg m
+
+let pbuchf table metadata cur_pb homogeneous (lp, lpc) p =
+  (** Invariant: [lp] is [List.tl (Array.to_list table.allpol)] *)
+  sinfo "computation of the Groebner basis";
+  let () = match table.hmon with
+  | None -> ()
+  | Some hmon -> Hashtbl.clear hmon
+  in
+  let len0 = List.length lp in
+  let rec pbuchf cur_pb (lp, lpc) =
       infobuch lp lpc;
-(*      step:=(!step+1)mod 10;*)
-      match lpc with
-        [] ->
-	  
-	 (* info ("List of polynomials:\n"^(fold_left (fun r p -> r^(stringP p)^"\n") "" lp));
-	  info "--------------------\n";*)
-	  test_dans_ideal (ppol p) lp lp0
-      | ((i,j),m) :: lpc2 ->
-(*          info "choosen pair\n";*)
-	  if critere3 ((i,j),m) lp lpc2
-	  then (info "c"; pbuchf (lp, lpc2))
+      match Heap.pop lpc with
+      | None ->
+	  test_dans_ideal cur_pb table metadata p lp len0
+      | Some (((i, j), m), lpc2) ->
+	  if critere3 table ((i,j),m) lp lpc2
+	  then (sinfo "c"; pbuchf cur_pb (lp, lpc2))
 	  else    
-	    let a = spol !allpol.(i) !allpol.(j) in
-	    if !homogeneous && (ppol a)<>[] && deg_hom (ppol a)
-		> deg_hom (ppol !pol_courant)
-	    then (info "h"; pbuchf (lp, lpc2))
+	    let (a0, p0, q0) = spol0 table.allpol.(i) table.allpol.(j) in
+	    if homogeneous && a0 <>[] && deg_hom a0 > deg_hom cur_pb.cur_poly
+	    then (sinfo "h"; pbuchf cur_pb (lp, lpc2))
 	    else
 (*	      let sa = a.sugar in*)
-              let (ca,a0)= reduce2 (ppol a) lp in
-              match a0 with
-		[] -> info "0";pbuchf (lp, lpc2)
-              | _ ->
+              match reduce2 table a0 lp with
+		_, [] -> sinfo "0";pbuchf cur_pb (lp, lpc2)
+              | ca, _ :: _ ->
 (*		info "pair reduced\n";*)
-		  a.pol := emultP ca (ppol a);
-		  let (lca,a0) = reduce2_trace (ppol a) lp
-		      (List.map (fun q -> emultP ca (coefpoldep_find a q))
-			 !poldep) in
+                  let map q =
+                    let r =
+                      if q.num == i then p0 else if q.num == j then q0 else []
+                    in
+                    emultP ca r
+                  in
+                  let lcp = List.map map lp in
+                  let (lca, a0) = reduce2_trace table (emultP ca a0) lp lcp in
 (*		info "paire re-reduced";*)
-		  a.pol := a0;
-(*		  let a0 = new_allpol a0 sa in*)
-		  List.iter2 (fun c q ->
-		    coefpoldep_remove a q;
-		    coefpoldep_set a q c) lca !poldep;
+                  let a = new_allpol table a0 in
+		  List.iter2 (fun c q -> coefpoldep_set table a q c) lca lp;
 		  let a0 = a in
-		  info ("\nnew polynomial: "^(stringPcut (ppol a0))^"\n");
-		  let ct = coef1 (* contentP a0 *) in
-		  (*info ("content: "^(string_of_coef ct)^"\n");*)
-		  poldep:=addS a0 lp;
-		  poldepcontent:=addS ct (!poldepcontent);
-		  
-		  try test_dans_ideal (ppol p) (addS a0 lp) lp0
-		  with NotInIdeal ->
-		    let newlpc = add_cpairs a0 lp lpc2 in
-		    pbuchf (((addS a0 lp), newlpc))
-  in pbuchf pq
+		  info (fun () -> "new polynomial: "^(stringPcut metadata (ppol a0)));
+                  let nlp = addS a0 lp in
+		  try test_dans_ideal cur_pb table metadata p nlp len0
+		  with NotInIdealUpdate cur_pb ->
+		    let newlpc = cpairs1 a0 lp lpc2 in
+		    pbuchf cur_pb (nlp, newlpc)
+  in pbuchf cur_pb (lp, lpc)
     
 let is_homogeneous p =
   match p with
   | [] -> true
-  | (a,m)::p1 -> let d = m.(0) in
-    List.for_all (fun (b,m') -> m'.(0)=d) p1
+  | (a,m)::p1 -> let d = deg m in
+    List.for_all (fun (b,m') -> deg m' =d) p1
     
 (* returns
    c
@@ -955,33 +723,33 @@ let is_homogeneous p =
    where pn+k = a(n+k,n+k-1)*pn+k-1 + ... + a(n+k,1)* p1
  *)
 
-let in_ideal d lp p =
-  Hashtbl.clear hmon;
-  Hashtbl.clear coefpoldep;
-  nallpol := 0;
-  allpol := Array.make 1000 polynom0;
-  homogeneous := List.for_all is_homogeneous (p::lp);
-  if !homogeneous then info "homogeneous polynomials\n";
-  info ("p: "^(stringPcut p)^"\n");
-  info ("lp:\n"^(List.fold_left (fun r p -> r^(stringPcut p)^"\n") "" lp));
-  (*info ("p: "^(stringP p)^"\n");
-  info ("lp:\n"^(fold_left (fun r p -> r^(stringP p)^"\n") "" lp));*)
-
-  let lp = List.map mk_polynom lp in
-  let p = mk_polynom p in
-  initcoefpoldep d lp;
-  coef_courant:=coef1;
-  pol_courant:=p;
-
-  let (lp1,p1,cert) =
-    try test_dans_ideal (ppol p) lp lp
-    with NotInIdeal -> pbuchf (lp, (cpairs lp)) p lp in
-  info "computed\n";
-
-  (List.map ppol lp1, p1, cert)
-    
-(* *)
-end
-
-	
+let in_ideal metadata d lp p =
+  let table = {
+    hmon = None;
+    coefpoldep = Hashtbl.create 51;
+    nallpol = 0;
+    allpol = Array.make 1000 polynom0;
+  } in
+  let homogeneous = List.for_all is_homogeneous (p::lp) in
+  if homogeneous then sinfo "homogeneous polynomials";
+  info (fun () -> "p: "^(stringPcut metadata p));
+  info (fun () -> "lp:\n"^(List.fold_left (fun r p -> r^(stringPcut metadata p)^"\n") "" lp));
+
+  let lp = List.map (fun c -> new_allpol table c) lp in
+  List.iter (fun p -> coefpoldep_set table p p (polconst d (coef_of_int 1))) lp;
+  let cur_pb = {
+    cur_poly = p;
+    cur_coef = coef1;
+  } in
+
+  let cert =
+    try pbuchf table metadata cur_pb homogeneous (lp, Heap.empty) p
+    with NotInIdealUpdate cur_pb ->
+      try pbuchf table metadata cur_pb homogeneous (lp, cpairs lp Heap.empty) p
+      with NotInIdealUpdate _ -> raise NotInIdeal
+    in
+  sinfo "computed";
+
+  cert
 
+end
diff --git a/plugins/nsatz/ideal.mli b/plugins/nsatz/ideal.mli
index d1a2a0a7..96572808 100644
--- a/plugins/nsatz/ideal.mli
+++ b/plugins/nsatz/ideal.mli
@@ -1,11 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+type metadata = {
+  name_var : string list;
+}
+
+module Monomial :
+sig
+type t
+val repr : t -> int array
+val make : int array -> t
+end
+
 module Make (P : Polynom.S) :
 sig
 (* Polynomials *)
@@ -14,32 +27,26 @@ type deg = int
 type coef = P.t
 type poly
 
-val repr : poly -> (coef * int array) list
+val repr : poly -> (coef * Monomial.t) list
 val polconst : int -> coef -> poly
 val zeroP : poly
 val gen : int -> int -> poly
 
 val equal : poly -> poly -> bool
-val name_var : string list ref
 
 val plusP : poly -> poly -> poly
 val oppP : poly -> poly
 val multP : poly -> poly -> poly
 val puisP : poly -> int -> poly
 
-val poldepcontent : coef list ref
-
 type certificate =
     { coef : coef; power : int;
       gb_comb : poly list list; last_comb : poly list }
 
-val in_ideal : deg -> poly list -> poly -> poly list * poly * certificate
+val in_ideal : metadata -> deg -> poly list -> poly -> certificate
 
 module Hashpol : Hashtbl.S with type key = poly
 
-val sugar_flag : bool ref
-val divide_rem_with_critical_pair : bool ref
-
 end
 
 exception NotInIdeal
diff --git a/plugins/nsatz/nsatz.ml b/plugins/nsatz/nsatz.ml
index 36bce780..81b44ffa 100644
--- a/plugins/nsatz/nsatz.ml
+++ b/plugins/nsatz/nsatz.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
-open Term
+open Constr
 open Tactics
 open Coqlib
 
@@ -22,7 +24,6 @@ open Utile
 let num_0 = Int 0
 and num_1 = Int 1
 and num_2 = Int 2
-and num_10 = Int 10
 
 let numdom r =
   let r' = Ratio.normalize_ratio (ratio_of_num r) in
@@ -35,7 +36,6 @@ module BigInt = struct
   type t = big_int
   let of_int = big_int_of_int
   let coef0 = of_int 0
-  let coef1 = of_int 1
   let of_num = Num.big_int_of_num
   let to_num = Num.num_of_big_int
   let equal = eq_big_int
@@ -49,7 +49,6 @@ module BigInt = struct
   let div = div_big_int
   let modulo = mod_big_int
   let to_string = string_of_big_int
-  let to_int x = int_of_big_int x
   let hash x =
     try (int_of_big_int x)
     with Failure _ -> 1
@@ -61,15 +60,6 @@ module BigInt = struct
     then a
     else if lt a b then pgcd b a else pgcd b (modulo a b)
 
-
-  (* signe du pgcd = signe(a)*signe(b) si non nuls. *)
-  let pgcd2 a b =
-    if equal a coef0 then b
-    else if equal b coef0 then a
-    else let c = pgcd (abs a) (abs b) in
-    if ((lt coef0 a)&&(lt b coef0))
-      ||((lt coef0 b)&&(lt a coef0))
-    then opp c else c
 end
 
 (*
@@ -146,10 +136,10 @@ let mul = function
   | (Const n,q) when eq_num n num_1 -> q
   | (p,q) -> Mul(p,q)
 
-let unconstr = mkRel 1
+let gen_constant msg path s = Universes.constr_of_global @@
+  coq_reference msg path s
 
-let tpexpr =
-  lazy (gen_constant "CC" ["setoid_ring";"Ring_polynom"] "PExpr")
+let tpexpr  = lazy (gen_constant "CC" ["setoid_ring";"Ring_polynom"] "PExpr")
 let ttconst = lazy (gen_constant "CC" ["setoid_ring";"Ring_polynom"] "PEc")
 let ttvar = lazy (gen_constant "CC" ["setoid_ring";"Ring_polynom"] "PEX")
 let ttadd = lazy (gen_constant "CC" ["setoid_ring";"Ring_polynom"] "PEadd")
@@ -216,76 +206,60 @@ 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)
     |_-> assert false
 
-let nvars = ref 0
-
-let set_nvars_term t =
-  let rec aux t =
+let set_nvars_term nvars t =
+  let rec aux t nvars =
     match t with
-    | Zero -> ()
-    | Const r -> ()
+    | Zero -> nvars
+    | Const r -> nvars
     | Var v -> let n = int_of_string v in
-      nvars:= max (!nvars) n
-    | Opp t1 -> aux t1
-    | Add (t1,t2) -> aux t1; aux t2
-    | Sub (t1,t2) -> aux t1; aux t2
-    | Mul (t1,t2) -> aux t1; aux t2
-    | Pow (t1,n) ->  aux t1
-  in aux t
-
-let string_of_term p =
-  let rec aux p =
-    match p with
-    | Zero -> "0"
-    | Const r -> string_of_num r
-    | Var v -> "x"^v
-    | Opp t1 -> "(-"^(aux t1)^")"
-    | Add (t1,t2) -> "("^(aux t1)^"+"^(aux t2)^")"
-    | Sub (t1,t2) ->  "("^(aux t1)^"-"^(aux t2)^")"
-    | Mul (t1,t2) ->  "("^(aux t1)^"*"^(aux t2)^")"
-    | Pow (t1,n) ->  (aux t1)^"^"^(string_of_int n)
-  in aux p
-
+      max nvars n
+    | Opp t1 -> aux t1 nvars
+    | Add (t1,t2) -> aux t2 (aux t1 nvars)
+    | Sub (t1,t2) -> aux t2 (aux t1 nvars)
+    | Mul (t1,t2) -> aux t2 (aux t1 nvars)
+    | Pow (t1,n) ->  aux t1 nvars
+  in aux t nvars
 
 (***********************************************************************
    Coefficients: recursive polynomials
@@ -301,8 +275,8 @@ open PIdeal
    varaibles <=np are in the coefficients
 *)
 
-let term_pol_sparse np t=
-  let d = !nvars in
+let term_pol_sparse nvars np t=
+  let d = nvars in
   let rec aux t =
 (*    info ("conversion de: "^(string_of_term t)^"\n");*)
     let res =
@@ -336,14 +310,8 @@ let polrec_to_term p =
   match p with
    |Poly.Pint n -> const (Coef.to_num n)
    |Poly.Prec (v,coefs) ->
-     let res = ref Zero in
-     Array.iteri
-      (fun i c ->
-	 res:=add(!res, mul(aux c,
-			    pow (Var (string_of_int v),
-				 i))))
-      coefs;
-     !res
+    let fold i c res = add (res, mul (aux c, pow (Var (string_of_int v), i))) in
+    Array.fold_right_i fold coefs Zero
   in aux p
 
 (* approximation of the Horner form used in the tactic ring *)
@@ -355,9 +323,11 @@ let pol_sparse_to_term n2 p =
     match p with
       [] -> const (num_of_string "0")
     | (a,m)::p1 ->
+      let m = Ideal.Monomial.repr m in
       let n = (Array.length m)-1 in
       let (i0,e0) =
 	List.fold_left (fun (r,d) (a,m) ->
+              let m = Ideal.Monomial.repr m in
 	      let i0= ref 0 in
 	      for k=1 to n do
 		if m.(k)>0
@@ -374,45 +344,28 @@ let pol_sparse_to_term n2 p =
 	  p in
       if Int.equal i0 0
       then
-	let mp = ref (polrec_to_term a) in
-        if List.is_empty p1
-	then !mp
-	else add(!mp,aux p1)
-      else (
-	let p1=ref [] in
-	let p2=ref [] in
-	List.iter
-	  (fun (a,m) ->
-	     if m.(i0)>=e0
-	     then (m.(i0)<-m.(i0)-e0;
-		   p1:=(a,m)::(!p1))
-	     else p2:=(a,m)::(!p2))
-	  p;
+	let mp = polrec_to_term a in
+        if List.is_empty p1 then mp else add (mp, aux p1)
+      else
+        let fold (p1, p2) (a, m) =
+          if (Ideal.Monomial.repr m).(i0) >= e0 then begin
+            let m0 = Array.copy (Ideal.Monomial.repr m) in
+            let () = m0.(i0) <- m0.(i0) - e0 in
+            let m0 = Ideal.Monomial.make m0 in
+            ((a, m0) :: p1, p2)
+          end else
+            (p1, (a, m) :: p2)
+        in
+        let (p1, p2) = List.fold_left fold ([], []) p in
 	let vm =
 	  if Int.equal e0 1
 	  then Var (string_of_int (i0))
 	  else pow (Var (string_of_int (i0)),e0) in
-	add(mul(vm, aux (List.rev (!p1))), aux (List.rev (!p2))))
+	add (mul(vm, aux (List.rev p1)), aux (List.rev p2))
   in   (*info "-> pol_sparse_to_term\n";*)
   aux p
 
 
-let remove_list_tail l i =
-  let rec aux l i =
-    if List.is_empty l
-    then []
-    else if i<0
-    then l
-    else if Int.equal i 0
-    then List.tl l
-    else
-      match l with
-      |(a::l1) ->
-	  a::(aux l1 (i-1))
-      |_ -> assert false
-  in
-  List.rev (aux (List.rev l) i)
-
 (*
    lq = [cn+m+1 n+m ...cn+m+1 1]
    lci=[[cn+1 n,...,cn1 1]
@@ -422,49 +375,35 @@ let remove_list_tail l i =
    removes intermediate polynomials not useful to compute the last one.
  *)
 
-let remove_zeros zero lci =
-  let n = List.length (List.hd lci) in
-  let m=List.length lci in
+let remove_zeros lci =
+  let m = List.length lci in
   let u = Array.make m false in
   let rec utiles k =
-    if k>=m
-    then ()
-    else (
-      u.(k)<-true;
+    (** TODO: Find a more reasonable implementation of this traversal. *)
+    if k >= m || u.(k) then ()
+    else
+      let () = u.(k) <- true in
       let lc = List.nth lci k in
-      for i=0 to List.length lc - 1 do
-	if not (zero (List.nth lc i))
-	then utiles (i+k+1);
-      done)
-  in utiles 0;
-  let lr = ref [] in
-  for i=0 to m-1 do
-    if u.(i)
-    then lr:=(List.nth lci i)::(!lr)
-  done;
-  let lr=List.rev !lr in
-  let lr = List.map
-      (fun lc ->
-	let lcr=ref lc in
-	for i=0 to m-1 do
-	  if not u.(i)
-	  then lcr:=remove_list_tail !lcr (m-i+(n-m))
-	done;
-	!lcr)
-      lr in
-  info ("useless spolynomials: "
-	^string_of_int (m-List.length lr)^"\n");
-  info ("useful spolynomials: "
-	^string_of_int (List.length lr)^"\n");
+      let iter i c = if not (PIdeal.equal c zeroP) then utiles (i + k + 1) in
+      List.iteri iter lc
+  in
+  let () = utiles 0 in
+  let filter i l =
+    let f j l = if m <= i + j + 1 then true else u.(i + j + 1) in
+    if u.(i) then Some (List.filteri f l)
+    else None
+  in
+  let lr = CList.map_filter_i filter lci in
+  info (fun () -> Printf.sprintf "useless spolynomials: %i" (m-List.length lr));
+  info (fun () -> Printf.sprintf "useful spolynomials: %i " (List.length lr));
   lr
 
-let theoremedeszeros lpol p =
+let theoremedeszeros metadata nvars lpol p =
   let t1 = Unix.gettimeofday() in
-  let m = !nvars in
-  let (lp0,p,cert) = in_ideal m lpol p in
-  let lpc = List.rev !poldepcontent in
-  info ("time: "^Format.sprintf "@[%10.3f@]s\n" (Unix.gettimeofday ()-.t1));
-  (cert,lp0,p,lpc)
+  let m = nvars in
+  let cert = in_ideal metadata m lpol p in
+  info (fun () -> Printf.sprintf "time: @[%10.3f@]s" (Unix.gettimeofday ()-.t1));
+  cert
 
 open Ideal
 
@@ -474,7 +413,7 @@ open Ideal
    that has the same size than lp and where true indicates an
    element that has been removed
  *)
-let rec clean_pol lp =
+let clean_pol lp =
   let t = Hashpol.create 12 in
   let find p = try Hashpol.find t p 
                with 
@@ -507,51 +446,33 @@ let expand_pol lb lp =
   in List.rev (aux lb (List.rev lp))
 
 let theoremedeszeros_termes lp =
-  nvars:=0;(* mise a jour par term_pol_sparse *)
-  List.iter set_nvars_term  lp;
+  let nvars = List.fold_left set_nvars_term 0 lp in
   match lp with
   | Const (Int sugarparam)::Const (Int nparam)::lp ->
       ((match sugarparam with
-      |0 -> info "computation without sugar\n";
+      |0 -> sinfo "computation without sugar";
 	  lexico:=false;
-	  sugar_flag := false;
-	  divide_rem_with_critical_pair := false
-      |1 -> info "computation with sugar\n";
+      |1 -> sinfo "computation with sugar";
 	  lexico:=false;
-	  sugar_flag := true;
-	  divide_rem_with_critical_pair := false
-      |2 -> info "ordre lexico computation without sugar\n";
+      |2 -> sinfo "ordre lexico computation without sugar";
 	  lexico:=true;
-	  sugar_flag := false;
-	  divide_rem_with_critical_pair := false
-      |3 -> info "ordre lexico computation with sugar\n";
+      |3 -> sinfo "ordre lexico computation with sugar";
 	  lexico:=true;
-	  sugar_flag := true;
-	  divide_rem_with_critical_pair := false
-      |4 -> info "computation without sugar, division by pairs\n";
+      |4 -> sinfo "computation without sugar, division by pairs";
 	  lexico:=false;
-	  sugar_flag := false;
-	  divide_rem_with_critical_pair := true
-      |5 -> info "computation with sugar, division by pairs\n";
+      |5 -> sinfo "computation with sugar, division by pairs";
 	  lexico:=false;
-	  sugar_flag := true;
-	  divide_rem_with_critical_pair := true
-      |6 -> info "ordre lexico computation without sugar, division by pairs\n";
+      |6 -> sinfo "ordre lexico computation without sugar, division by pairs";
 	  lexico:=true;
-	  sugar_flag := false;
-	  divide_rem_with_critical_pair := true
-      |7 -> info "ordre lexico computation with sugar, division by pairs\n";
+      |7 -> sinfo "ordre lexico computation with sugar, division by pairs";
 	  lexico:=true;
-	  sugar_flag := true;
-	  divide_rem_with_critical_pair := true
-      | _ -> error "nsatz: bad parameter"
+      | _ -> user_err Pp.(str "nsatz: bad parameter")
        );
-      let m= !nvars in
-      let lvar=ref [] in
-      for i=m downto 1 do lvar:=["x"^(string_of_int i)^""]@(!lvar); done;
-      lvar:=["a";"b";"c";"d";"e";"f";"g";"h";"i";"j";"k";"l";"m";"n";"o";"p";"q";"r";"s";"t";"u";"v";"w";"x";"y";"z"] @ (!lvar); (* pour macaulay *)
-      name_var:=!lvar;
-      let lp = List.map (term_pol_sparse nparam) lp in
+      let lvar = List.init nvars (fun i -> Printf.sprintf "x%i" (i + 1)) in
+      let lvar = ["a";"b";"c";"d";"e";"f";"g";"h";"i";"j";"k";"l";"m";"n";"o";"p";"q";"r";"s";"t";"u";"v";"w";"x";"y";"z"] @ lvar in
+      (* pour macaulay *)
+      let metadata = { name_var = lvar } in
+      let lp = List.map (term_pol_sparse nvars nparam) lp in
       match lp with
       | [] -> assert false
       | p::lp1 ->
@@ -561,16 +482,16 @@ let theoremedeszeros_termes lp =
              lb is kept in order to fix the certificate in the post-processing 
           *)
 	  let lpol, lb  = clean_pol lpol in
-	  let (cert,lp0,p,_lct) = theoremedeszeros lpol p in
-          info "cert ok\n";
+	  let cert = theoremedeszeros metadata nvars lpol p in
+          sinfo "cert ok";
 	  let lc = cert.last_comb::List.rev cert.gb_comb in
-	  match remove_zeros (fun x -> equal x zeroP) lc with
+	  match remove_zeros lc with
 	  | [] -> assert false
 	  | (lq::lci) ->
               (* post-processing : we apply the correction for the last line *)
               let lq = expand_pol lb lq in
 	      (* lci commence par les nouveaux polynomes *)
-	      let m = !nvars in
+	      let m = nvars in
 	      let c = pol_sparse_to_term m (polconst m cert.coef) in
 	      let r = Pow(Zero,cert.power) in
 	      let lci = List.rev lci in
@@ -578,8 +499,8 @@ let theoremedeszeros_termes lp =
 	      let lci = List.map (expand_pol lb) lci in
 	      let lci = List.map (List.map (pol_sparse_to_term m)) lci in
 	      let lq = List.map (pol_sparse_to_term m) lq in
-	      info ("number of parameters: "^string_of_int nparam^"\n");
-	      info "term computed\n";
+	      info (fun () -> Printf.sprintf "number of parameters: %i" nparam);
+	      sinfo "term computed";
 	      (c,r,lci,lq)
       )
   |_ -> assert false
@@ -619,19 +540,18 @@ let nsatz lpol =
 	 mkt_app lcons [tlp ();ltterm;r])
       res
       (mkt_app lnil [tlp ()]) in
-  info "term computed\n";
+  sinfo "term computed";
   res
 
 let return_term t =
   let a =
-    mkApp(gen_constant "CC" ["Init";"Logic"] "refl_equal",[|tllp ();t|]) in
+    mkApp(gen_constant "CC" ["Init";"Logic"] "eq_refl",[|tllp ();t|]) in
+  let a = EConstr.of_constr a in
   generalize [a]
 
 let nsatz_compute t =
   let lpol =
     try nsatz t
     with Ideal.NotInIdeal ->
-      error "nsatz cannot solve this problem" in
+      user_err Pp.(str "nsatz cannot solve this problem") in
   return_term lpol
-
-
diff --git a/plugins/nsatz/nsatz.mli b/plugins/nsatz/nsatz.mli
index e876ccfa..c97c9908 100644
--- a/plugins/nsatz/nsatz.mli
+++ b/plugins/nsatz/nsatz.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val nsatz_compute : Constr.t -> unit Proofview.tactic
diff --git a/plugins/nsatz/polynom.ml b/plugins/nsatz/polynom.ml
index dbd9005c..5db587b9 100644
--- a/plugins/nsatz/polynom.ml
+++ b/plugins/nsatz/polynom.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Recursive polynomials: R[x1]...[xn]. *)
diff --git a/plugins/nsatz/polynom.mli b/plugins/nsatz/polynom.mli
index 433ab591..d45a0505 100644
--- a/plugins/nsatz/polynom.mli
+++ b/plugins/nsatz/polynom.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Building recursive polynom operations from a type of coefficients *)
diff --git a/plugins/nsatz/utile.ml b/plugins/nsatz/utile.ml
index 92243246..d3cfd75e 100644
--- a/plugins/nsatz/utile.ml
+++ b/plugins/nsatz/utile.ml
@@ -11,8 +11,8 @@ let prt0 s = () (* print_string s;flush(stdout)*)
 let prt s =
   if !Flags.debug then (print_string (s^"\n");flush(stdout)) else ()
 
-let info s =
-  Flags.if_verbose prerr_string s
+let sinfo s = if !Flags.debug then Feedback.msg_debug (Pp.str s)
+let info s = if !Flags.debug then Feedback.msg_debug (Pp.str (s ()))
 
 (* Lists *)
 
diff --git a/plugins/nsatz/utile.mli b/plugins/nsatz/utile.mli
index 1f841575..9308577e 100644
--- a/plugins/nsatz/utile.mli
+++ b/plugins/nsatz/utile.mli
@@ -4,7 +4,8 @@ val pr : string -> unit
 val prn : string -> unit
 val prt0 : 'a -> unit
 val prt : string -> unit
-val info : string -> unit
+val info : (unit -> string) -> unit
+val sinfo : string -> unit
 
 (* Listes *)
 val list_mem_eq : ('a -> 'b -> bool) -> 'a -> 'b list -> bool
diff --git a/plugins/nsatz/vo.itarget b/plugins/nsatz/vo.itarget
deleted file mode 100644
index 06fc8834..00000000
--- a/plugins/nsatz/vo.itarget
+++ /dev/null
@@ -1 +0,0 @@
-Nsatz.vo
diff --git a/plugins/omega/Omega.v b/plugins/omega/Omega.v
index 9988c858..6c8f23a0 100644
--- a/plugins/omega/Omega.v
+++ b/plugins/omega/Omega.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/plugins/omega/OmegaLemmas.v b/plugins/omega/OmegaLemmas.v
index 1872f576..dc86a989 100644
--- a/plugins/omega/OmegaLemmas.v
+++ b/plugins/omega/OmegaLemmas.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import BinInt Znat.
 Local Open Scope Z_scope.
diff --git a/plugins/omega/OmegaPlugin.v b/plugins/omega/OmegaPlugin.v
index cd162498..3c339c8b 100644
--- a/plugins/omega/OmegaPlugin.v
+++ b/plugins/omega/OmegaPlugin.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* To strictly import the omega tactic *)
diff --git a/plugins/omega/OmegaTactic.v b/plugins/omega/OmegaTactic.v
index cd162498..3c339c8b 100644
--- a/plugins/omega/OmegaTactic.v
+++ b/plugins/omega/OmegaTactic.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* To strictly import the omega tactic *)
diff --git a/plugins/omega/PreOmega.v b/plugins/omega/PreOmega.v
index 5f5f548f..59fd9b80 100644
--- a/plugins/omega/PreOmega.v
+++ b/plugins/omega/PreOmega.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Arith Max Min BinInt BinNat Znat Nnat.
@@ -26,7 +28,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
 *)
 
 
@@ -48,10 +50,13 @@ Ltac zify_unop_var_or_term t thm a :=
  (remember a as za; zify_unop_core t thm za).
 
 Ltac zify_unop t thm a :=
- (* if a is a scalar, we can simply reduce the unop *)
+ (* If a is a scalar, we can simply reduce the unop. *)
+ (* Note that simpl wasn't enough to reduce [Z.max 0 0] (#5439) *)
  let isz := isZcst a in
  match isz with
-  | true => simpl (t a) in *
+  | true =>
+    let u := eval compute in (t a) in
+    change (t a) with u in *
   | _ => zify_unop_var_or_term t thm a
  end.
 
@@ -165,21 +170,31 @@ Ltac zify_nat_op :=
         rewrite (Nat2Z.inj_mul a b) in *
 
   (* O -> Z0 *)
-  | H : context [ Z.of_nat O ] |- _ => simpl (Z.of_nat O) in H
-  | |- context [ Z.of_nat O ] => simpl (Z.of_nat O)
+  | H : context [ Z.of_nat O ] |- _ => change (Z.of_nat O) with Z0 in H
+  | |- context [ Z.of_nat O ] => change (Z.of_nat O) with Z0
 
   (* S -> number or Z.succ *)
   | H : context [ Z.of_nat (S ?a) ] |- _ =>
      let isnat := isnatcst a in
      match isnat with
-      | true => simpl (Z.of_nat (S a)) in H
+      | true =>
+        let t := eval compute in (Z.of_nat (S a)) in
+        change (Z.of_nat (S a)) with t in H
       | _ => rewrite (Nat2Z.inj_succ a) in H
+      | _ => (* if the [rewrite] fails (most likely a dependent occurence of [Z.of_nat (S a)]),
+                hide [Z.of_nat (S a)] in this one hypothesis *)
+        change (Z.of_nat (S a)) with (Z_of_nat' (S a)) in H
      end
   | |- context [ Z.of_nat (S ?a) ] =>
      let isnat := isnatcst a in
      match isnat with
-      | true => simpl (Z.of_nat (S a))
+      | true =>
+        let t := eval compute in (Z.of_nat (S a)) in
+        change (Z.of_nat (S a)) with t
       | _ => rewrite (Nat2Z.inj_succ a)
+      | _ => (* if the [rewrite] fails (most likely a dependent occurence of [Z.of_nat (S a)]),
+                hide [Z.of_nat (S a)] in the goal *)
+        change (Z.of_nat (S a)) with (Z_of_nat' (S a))
      end
 
   (* atoms of type nat : we add a positivity condition (if not already there) *)
@@ -258,8 +273,8 @@ Ltac zify_positive_op :=
   | |- context [ Zpos (Pos.max ?a ?b) ] => rewrite (Pos2Z.inj_max a b)
 
   (* Pos.sub -> Z.max 1 (Z.sub ... ...) *)
-  | H : context [ Zpos (Pos.sub ?a ?b) ] |- _ => rewrite (Pos2Z.inj_sub a b) in H
-  | |- context [ Zpos (Pos.sub ?a ?b) ] => rewrite (Pos2Z.inj_sub a b)
+  | H : context [ Zpos (Pos.sub ?a ?b) ] |- _ => rewrite (Pos2Z.inj_sub_max a b) in H
+  | |- context [ Zpos (Pos.sub ?a ?b) ] => rewrite (Pos2Z.inj_sub_max a b)
 
   (* Pos.succ -> Z.succ *)
   | H : context [ Zpos (Pos.succ ?a) ] |- _ => rewrite (Pos2Z.inj_succ a) in H
@@ -378,6 +393,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)
@@ -401,4 +420,3 @@ Ltac zify_N := repeat zify_N_rel; repeat zify_N_op; unfold Z_of_N' in *.
 (** The complete Z-ification tactic *)
 
 Ltac zify := repeat (zify_nat; zify_positive; zify_N); zify_op.
-
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index d625e307..51cd665f 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (**************************************************************************)
 (*                                                                        *)
@@ -18,8 +20,9 @@ open Util
 open Names
 open Nameops
 open Term
-open Tacticals
-open Tacmach
+open EConstr
+open Tacticals.New
+open Tacmach.New
 open Tactics
 open Logic
 open Libnames
@@ -27,19 +30,21 @@ open Globnames
 open Nametab
 open Contradiction
 open Misctypes
-open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
 module OmegaSolver = Omega.MakeOmegaSolver (Bigint)
 open OmegaSolver
 
 (* Added by JCF, 09/03/98 *)
 
 let elim_id id =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    simplest_elim (Tacmach.New.pf_global id gl)
-  end }
-let resolve_id id gl = Proofview.V82.of_tactic (apply (pf_global gl id)) gl
+  Proofview.Goal.enter begin fun gl ->
+    simplest_elim (mkVar id)
+  end
+let resolve_id id = Proofview.Goal.enter begin fun gl ->
+  apply (mkVar id)
+end
 
 let timing timer_name f arg = f arg
 
@@ -47,6 +52,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 ? *)
 
@@ -67,8 +73,7 @@ open Goptions
 
 let _ =
   declare_bool_option
-    { optsync  = false;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Omega system time displaying flag";
       optkey   = ["Omega";"System"];
       optread  = read display_system_flag;
@@ -76,8 +81,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = false;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Omega action display flag";
       optkey   = ["Omega";"Action"];
       optread  = read display_action_flag;
@@ -85,8 +89,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = false;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Omega old style flag";
       optkey   = ["Omega";"OldStyle"];
       optread  = read old_style_flag;
@@ -94,13 +97,20 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
+    { optdepr  = true;
       optname  = "Omega automatic reset of generated names";
       optkey   = ["Stable";"Omega"];
       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),
@@ -144,14 +154,14 @@ let intern_id,unintern_id,reset_intern_tables =
        Hashtbl.add table v idx; Hashtbl.add co_table idx v; v),
   (fun () -> cpt := 0; Hashtbl.clear table)
 
-let mk_then = tclTHENLIST
+let mk_then tacs = tclTHENLIST tacs
 
 let exists_tac c = constructor_tac false (Some 1) 1 (ImplicitBindings [c])
 
 let generalize_tac t = generalize t
 let elim t = simplest_elim t
-let exact t = Tacmach.refine t
 let unfold s = Tactics.unfold_in_concl [Locus.AllOccurrences, Lazy.force s]
+let pf_nf gl c = pf_apply Tacred.simpl gl c
 
 let rev_assoc k =
   let rec loop = function
@@ -171,8 +181,8 @@ let tag_hypothesis,tag_of_hyp, hyp_of_tag, clear_tags =
 let hide_constr,find_constr,clear_constr_tables,dump_tables =
   let l = ref ([]:(constr * (Id.t * Id.t * bool)) list) in
   (fun h id eg b -> l := (h,(id,eg,b)):: !l),
-  (fun h ->
-    try List.assoc_f eq_constr_nounivs h !l with Not_found -> failwith "find_contr"),
+  (fun sigma h ->
+    try List.assoc_f (eq_constr_nounivs sigma) h !l with Not_found -> failwith "find_contr"),
   (fun () -> l := []),
   (fun () -> !l)
 
@@ -196,6 +206,7 @@ let coq_modules =
   init_modules @arith_modules @ [logic_dir] @ zarith_base_modules
     @ [["Coq"; "omega"; "OmegaLemmas"]]
 
+let gen_constant_in_modules n m s = EConstr.of_constr (Universes.constr_of_global @@ gen_reference_in_modules n m s)
 let init_constant = gen_constant_in_modules "Omega" init_modules
 let constant = gen_constant_in_modules "Omega" coq_modules
 
@@ -347,14 +358,21 @@ let coq_not_iff = lazy (constant "not_iff")
 let coq_not_not = lazy (constant "not_not")
 let coq_imp_simp = lazy (constant "imp_simp")
 let coq_iff = lazy (constant "iff")
+let coq_not = lazy (init_constant "not")
+let coq_and = lazy (init_constant "and")
+let coq_or = lazy (init_constant "or")
+let coq_eq = lazy (init_constant "eq")
+let coq_ex = lazy (init_constant "ex")
+let coq_False = lazy (init_constant "False")
+let coq_True = lazy (init_constant "True")
 
 (* uses build_coq_and, build_coq_not, build_coq_or, build_coq_ex *)
 
 (* For unfold *)
-let evaluable_ref_of_constr s c = match kind_of_term (Lazy.force c) with
+let evaluable_ref_of_constr s c = match EConstr.kind Evd.empty (Lazy.force c) with
   | Const (kn,u) when Tacred.is_evaluable (Global.env()) (EvalConstRef kn) ->
       EvalConstRef kn
-  | _ -> anomaly ~label:"Coq_omega" (Pp.str (s^" is not an evaluable constant"))
+  | _ -> anomaly ~label:"Coq_omega" (Pp.str (s^" is not an evaluable constant."))
 
 let sp_Zsucc =     lazy (evaluable_ref_of_constr "Z.succ" coq_Zsucc)
 let sp_Zpred =     lazy (evaluable_ref_of_constr "Z.pred" coq_Zpred)
@@ -363,22 +381,21 @@ let sp_Zle = lazy (evaluable_ref_of_constr "Z.le" coq_Zle)
 let sp_Zgt = lazy (evaluable_ref_of_constr "Z.gt" coq_Zgt)
 let sp_Zge = lazy (evaluable_ref_of_constr "Z.ge" coq_Zge)
 let sp_Zlt = lazy (evaluable_ref_of_constr "Z.lt" coq_Zlt)
-let sp_not = lazy (evaluable_ref_of_constr "not" (lazy (build_coq_not ())))
+let sp_not = lazy (evaluable_ref_of_constr "not" coq_not)
 
 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 (Universes.constr_of_global (build_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 (build_coq_and (), [| t1; t2 |])
-let mk_or t1 t2 =  mkApp (build_coq_or (), [| t1; t2 |])
-let mk_not t = mkApp (build_coq_not (), [| t |])
-let mk_eq_rel t1 t2 = mkApp (Universes.constr_of_global (build_coq_eq ()),
-			     [| Lazy.force coq_comparison; t1; t2 |])
+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 = 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 =
@@ -419,22 +436,23 @@ type result =
    the term parts that we manipulate, but rather Var's.
    Said otherwise: all constr manipulated here are closed *)
 
-let destructurate_prop t =
-  let c, args = decompose_app t in
-  match kind_of_term c, args with
-    | _, [_;_;_] when is_global (build_coq_eq ()) c -> Kapp (Eq,args)
+let destructurate_prop sigma t =
+  let eq_constr c1 c2 = eq_constr sigma c1 c2 in
+  let c, args = decompose_app sigma t in
+  match EConstr.kind sigma c, args with
+    | _, [_;_;_] when eq_constr (Lazy.force coq_eq) c -> Kapp (Eq,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_neq) -> Kapp (Neq,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_Zne) -> Kapp (Zne,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_Zle) -> Kapp (Zle,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_Zlt) -> Kapp (Zlt,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_Zge) -> Kapp (Zge,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_Zgt) -> Kapp (Zgt,args)
-    | _, [_;_] when eq_constr c (build_coq_and ()) -> Kapp (And,args)
-    | _, [_;_] when eq_constr c (build_coq_or ()) -> Kapp (Or,args)
+    | _, [_;_] when eq_constr c (Lazy.force coq_and) -> Kapp (And,args)
+    | _, [_;_] when eq_constr c (Lazy.force coq_or) -> Kapp (Or,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_iff) -> Kapp (Iff, args)
-    | _, [_] when eq_constr c (build_coq_not ()) -> Kapp (Not,args)
-    | _, [] when eq_constr c (build_coq_False ()) -> Kapp (False,args)
-    | _, [] when eq_constr c (build_coq_True ()) -> Kapp (True,args)
+    | _, [_] when eq_constr c (Lazy.force coq_not) -> Kapp (Not,args)
+    | _, [] when eq_constr c (Lazy.force coq_False) -> Kapp (False,args)
+    | _, [] when eq_constr c (Lazy.force coq_True) -> Kapp (True,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_le) -> Kapp (Le,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_lt) -> Kapp (Lt,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_ge) -> Kapp (Ge,args)
@@ -447,19 +465,23 @@ let destructurate_prop t =
 	Kapp (Other (string_of_path (path_of_global (IndRef isp))),args)
     | Var id,[] -> Kvar id
     | Prod (Anonymous,typ,body), [] -> Kimp(typ,body)
-    | Prod (Name _,_,_),[] -> error "Omega: Not a quantifier-free goal"
+    | Prod (Name _,_,_),[] -> CErrors.user_err Pp.(str "Omega: Not a quantifier-free goal")
     | _ -> Kufo
 
-let destructurate_type t =
-  let c, args = decompose_app t in
-  match kind_of_term 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)
+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 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 t =
-  let c, args = decompose_app t in
-  match kind_of_term c, args with
+let destructurate_term sigma t =
+  let eq_constr c1 c2 = eq_constr sigma c1 c2 in
+  let c, args = decompose_app sigma t in
+  match EConstr.kind sigma c, args with
     | _, [_;_] when eq_constr c (Lazy.force coq_Zplus) -> Kapp (Zplus,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_Zmult) -> Kapp (Zmult,args)
     | _, [_;_] when eq_constr c (Lazy.force coq_Zminus) -> Kapp (Zminus,args)
@@ -479,15 +501,16 @@ let destructurate_term t =
     | Var id,[] -> Kvar id
     | _ -> Kufo
 
-let recognize_number t =
+let recognize_number sigma t =
+  let eq_constr c1 c2 = eq_constr sigma c1 c2 in
   let rec loop t =
-    match decompose_app t with
+    match decompose_app sigma t with
       | f, [t] when eq_constr f (Lazy.force coq_xI) -> one + two * loop t
       | f, [t] when eq_constr f (Lazy.force coq_xO) -> two * loop t
       | f, [] when eq_constr f (Lazy.force coq_xH) -> one
       | _ -> failwith "not a number"
   in
-  match decompose_app t with
+  match decompose_app sigma t with
     | f, [t] when eq_constr f (Lazy.force coq_Zpos) -> loop t
     | f, [t] when eq_constr f (Lazy.force coq_Zneg) -> neg (loop t)
     | f, [] when eq_constr f (Lazy.force coq_Z0) -> zero
@@ -503,9 +526,9 @@ type constr_path =
   | P_ARITY
   | P_ARG
 
-let context operation path (t : constr) =
+let context sigma operation path (t : constr) =
   let rec loop i p0 t =
-    match (p0,kind_of_term t) with
+    match (p0,EConstr.kind sigma t) with
       | (p, Cast (c,k,t)) -> mkCast (loop i p c,k,t)
       | ([], _) -> operation i t
       | ((P_APP n :: p),  App (f,v)) ->
@@ -516,7 +539,7 @@ let context operation path (t : constr) =
 	  let v' = Array.copy v in
 	  v'.(n) <- loop i p v'.(n); (mkCase (ci,q,c,v'))
       | ((P_ARITY :: p),  App (f,l)) ->
-	  appvect (loop i p f,l)
+	  mkApp (loop i p f,l)
       | ((P_ARG :: p),  App (f,v)) ->
 	  let v' = Array.copy v in
 	  v'.(0) <- loop i p v'.(0); mkApp (f,v')
@@ -541,8 +564,8 @@ let context operation path (t : constr) =
   in
   loop 1 path t
 
-let occurrence path (t : constr) =
-  let rec loop p0 t = match (p0,kind_of_term t) with
+let occurrence sigma path (t : constr) =
+  let rec loop p0 t = match (p0,EConstr.kind sigma t) with
     | (p, Cast (c,_,_)) -> loop p c
     | ([], _) -> t
     | ((P_APP n :: p),  App (f,v)) -> loop p v.(pred n)
@@ -561,14 +584,17 @@ let occurrence path (t : constr) =
   in
   loop path t
 
-let abstract_path typ path t =
+let abstract_path sigma typ path t =
   let term_occur = ref (mkRel 0) in
-  let abstract = context (fun i t -> term_occur:= t; mkRel i) path t in
+  let abstract = context sigma (fun i t -> term_occur:= t; mkRel i) path t in
   mkLambda (Name (Id.of_string "x"), typ, abstract), !term_occur
 
-let focused_simpl path gl =
-  let newc = context (fun i t -> pf_nf gl t) (List.rev path) (pf_concl gl) in
-  Proofview.V82.of_tactic (convert_concl_no_check newc DEFAULTcast) gl
+let focused_simpl path =
+  let open Tacmach.New in
+  Proofview.Goal.nf_enter begin fun gl ->
+  let newc = context (project gl) (fun i t -> pf_nf gl t) (List.rev path) (pf_concl gl) in
+  convert_concl_no_check newc DEFAULTcast
+  end
 
 let focused_simpl path = focused_simpl path
 
@@ -615,7 +641,7 @@ let compile name kind =
 	let id = new_id () in
 	tag_hypothesis name id;
 	{kind = kind; body = List.rev accu; constant = n; id = id}
-    | _ -> anomaly (Pp.str "compile_equation")
+    | _ -> anomaly (Pp.str "compile_equation.")
   in
   loop []
 
@@ -626,11 +652,18 @@ let decompile af =
   in
   loop af.body
 
-let mkNewMeta () = mkMeta (Evarutil.new_meta())
+(** Backward compat to emulate the old Refine: normalize the goal conclusion *)
+let new_hole env sigma c =
+  let c = Reductionops.nf_betaiota env sigma c in
+  Evarutil.new_evar env sigma c
 
-let clever_rewrite_base_poly typ p result theorem gl =
+let clever_rewrite_base_poly typ p result theorem =
+  let open Tacmach.New in
+  Proofview.Goal.nf_enter begin fun gl ->
   let full = pf_concl gl in
-  let (abstracted,occ) = abstract_path typ (List.rev p) full in
+  let env = pf_env gl in
+  let (abstracted,occ) = abstract_path (project gl) typ (List.rev p) full in
+  Refine.refine ~typecheck:false begin fun sigma ->
   let t =
     applist
       (mkLambda
@@ -643,13 +676,17 @@ let clever_rewrite_base_poly typ p result theorem gl =
 		       [| typ; result; mkRel 2; mkRel 1; occ; theorem |]))),
        [abstracted])
   in
-  exact (applist(t,[mkNewMeta()])) gl
+  let argt = mkApp (abstracted, [|result|]) in
+  let (sigma, hole) = new_hole env sigma argt in
+  (sigma, applist (t, [hole]))
+  end
+  end
 
-let clever_rewrite_base p result theorem gl =
-  clever_rewrite_base_poly (Lazy.force coq_Z) p result theorem gl
+let clever_rewrite_base p result theorem =
+  clever_rewrite_base_poly (Lazy.force coq_Z) p result theorem
 
-let clever_rewrite_base_nat p result theorem gl =
-  clever_rewrite_base_poly (Lazy.force coq_nat) p result theorem gl
+let clever_rewrite_base_nat p result theorem =
+  clever_rewrite_base_poly (Lazy.force coq_nat) p result theorem
 
 let clever_rewrite_gen p result (t,args) =
   let theorem = applist(t, args) in
@@ -659,12 +696,61 @@ let clever_rewrite_gen_nat p result (t,args) =
   let theorem = applist(t, args) in
   clever_rewrite_base_nat p result theorem
 
-let clever_rewrite p vpath t gl =
+(** Solve using the term the term [t _] *)
+let refine_app gl t =
+  let open Tacmach.New in
+  Refine.refine ~typecheck:false begin fun sigma ->
+  let env = pf_env gl in
+  let ht = match EConstr.kind sigma (pf_get_type_of gl t) with
+  | Prod (_, t, _) -> t
+  | _ -> assert false
+  in
+  let (sigma, hole) = new_hole env sigma ht in
+  (sigma, applist (t, [hole]))
+  end
+
+let clever_rewrite p vpath t =
+  let open Tacmach.New in
+  Proofview.Goal.nf_enter begin fun gl ->
   let full = pf_concl gl in
-  let (abstracted,occ) = abstract_path (Lazy.force coq_Z) (List.rev p) full in
-  let vargs = List.map (fun p -> occurrence p occ) vpath in
+  let (abstracted,occ) = abstract_path (project gl) (Lazy.force coq_Z) (List.rev p) full in
+  let vargs = List.map (fun p -> occurrence (project gl) p occ) vpath in
   let t' = applist(t, (vargs @ [abstracted])) in
-  exact (applist(t',[mkNewMeta()])) gl
+  refine_app gl t'
+  end
+
+(** simpl_coeffs :
+    The subterm at location [path_init] in the current goal should
+    look like [(v1*c1 + (v2*c2 + ... (vn*cn + k)))], and we reduce
+    via "simpl" each [ci] and the final constant [k].
+    The path [path_k] gives the location of constant [k].
+    Earlier, the whole was a mere call to [focused_simpl],
+    leading to reduction inside the atoms [vi], which is bad,
+    for instance when the atom is an evaluable definition
+    (see #4132). *)
+
+let simpl_coeffs path_init path_k =
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
+  let rec loop n t =
+    if Int.equal n 0 then pf_nf gl t
+    else
+      (* t should be of the form ((v * c) + ...) *)
+      match EConstr.kind sigma t with
+      | App(f,[|t1;t2|]) ->
+         (match EConstr.kind sigma t1 with
+          | App (g,[|v;c|]) ->
+             let c' = pf_nf gl c in
+             let t2' = loop (pred n) t2 in
+             mkApp (f,[|mkApp (g,[|v;c'|]);t2'|])
+          | _ -> assert false)
+      | _ -> assert false
+  in
+  let n = Pervasives.(-) (List.length path_k) (List.length path_init) in
+  let newc = context sigma (fun _ t -> loop n t) (List.rev path_init) (pf_concl gl)
+  in
+  convert_concl_no_check newc DEFAULTcast
+  end
 
 let rec shuffle p (t1,t2) =
   match t1,t2 with
@@ -728,7 +814,7 @@ let shuffle_mult p_init k1 e1 k2 e2 =
             let tac' =
 	      clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 2]]
                 (Lazy.force coq_fast_Zred_factor5) in
-	    tac :: focused_simpl (P_APP 1::P_APP 2:: p) :: tac' ::
+	    tac :: focused_simpl (P_APP 2::P_APP 1:: p) :: tac' ::
 	    loop p (l1,l2)
           else tac :: loop (P_APP 2 :: p) (l1,l2)
 	else if v1 > v2 then
@@ -763,7 +849,7 @@ let shuffle_mult p_init k1 e1 k2 e2 =
                            [P_APP 2; P_APP 2]]
           (Lazy.force coq_fast_OMEGA12) ::
         loop (P_APP 2 :: p) ([],l2)
-    | [],[] -> [focused_simpl p_init]
+    | [],[] -> [simpl_coeffs p_init p]
   in
   loop p_init (e1,e2)
 
@@ -786,7 +872,7 @@ let shuffle_mult_right p_init e1 k2 e2 =
               clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 2]]
                 (Lazy.force coq_fast_Zred_factor5)
 	    in
-            tac :: focused_simpl (P_APP 1::P_APP 2:: p) :: tac' ::
+            tac :: focused_simpl (P_APP 2::P_APP 1:: p) :: tac' ::
             loop p (l1,l2)
           else tac :: loop (P_APP 2 :: p) (l1,l2)
 	else if v1 > v2 then
@@ -813,7 +899,7 @@ let shuffle_mult_right p_init e1 k2 e2 =
                           [P_APP 2; P_APP 2]]
           (Lazy.force coq_fast_OMEGA12) ::
         loop (P_APP 2 :: p) ([],l2)
-    | [],[] -> [focused_simpl p_init]
+    | [],[] -> [simpl_coeffs p_init p]
   in
   loop p_init (e1,e2)
 
@@ -847,14 +933,14 @@ let rec scalar p n = function
          (Lazy.force coq_fast_Zmult_assoc_reverse);
        focused_simpl (P_APP 2 :: p)],
       Otimes(t1,Oz (n*x))
-  | Otimes(t1,t2) -> error "Omega: Can't solve a goal with non-linear products"
+  | Otimes(t1,t2) -> CErrors.user_err Pp.(str "Omega: Can't solve a goal with non-linear products")
   | (Oatom _ as t) -> [], Otimes(t,Oz n)
   | Oz i -> [focused_simpl p],Oz(n*i)
   | Oufo c -> [], Oufo (mkApp (Lazy.force coq_Zmult, [| mk_integer n; c |]))
 
 let scalar_norm p_init =
   let rec loop p = function
-    | [] -> [focused_simpl p_init]
+    | [] -> [simpl_coeffs p_init p]
     | (_::l) ->
 	clever_rewrite p
           [[P_APP 1; P_APP 1; P_APP 1];[P_APP 1; P_APP 1; P_APP 2];
@@ -865,7 +951,7 @@ let scalar_norm p_init =
 
 let norm_add p_init =
   let rec loop p = function
-    | [] -> [focused_simpl p_init]
+    | [] -> [simpl_coeffs p_init p]
     | _:: l ->
 	clever_rewrite p [[P_APP 1;P_APP 1]; [P_APP 1; P_APP 2];[P_APP 2]]
           (Lazy.force coq_fast_Zplus_assoc_reverse) ::
@@ -875,7 +961,7 @@ let norm_add p_init =
 
 let scalar_norm_add p_init =
   let rec loop p = function
-    | [] -> [focused_simpl p_init]
+    | [] -> [simpl_coeffs p_init p]
     | _ :: l ->
 	clever_rewrite p
           [[P_APP 1; P_APP 1; P_APP 1; P_APP 1];
@@ -899,17 +985,17 @@ let rec negate p = function
       [clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 1;P_APP 2]]
          (Lazy.force coq_fast_Zopp_mult_distr_r);
        focused_simpl (P_APP 2 :: p)], Otimes(t1,Oz (neg x))
-  | Otimes(t1,t2) -> error "Omega: Can't solve a goal with non-linear products"
+  | Otimes(t1,t2) -> CErrors.user_err Pp.(str "Omega: Can't solve a goal with non-linear products")
   | (Oatom _ as t) ->
       let r = Otimes(t,Oz(negone)) in
       [clever_rewrite p [[P_APP 1]] (Lazy.force coq_fast_Zopp_eq_mult_neg_1)], r
   | Oz i -> [focused_simpl p],Oz(neg i)
   | Oufo c -> [], Oufo (mkApp (Lazy.force coq_Zopp, [| c |]))
 
-let rec transform p t =
+let rec transform sigma p t =
   let default isnat t' =
     try
-      let v,th,_ = find_constr t' in
+      let v,th,_ = find_constr sigma t' in
       [clever_rewrite_base p (mkVar v) (mkVar th)], Oatom v
     with e when CErrors.noncritical e ->
       let v = new_identifier_var ()
@@ -917,29 +1003,29 @@ let rec transform p t =
       hide_constr t' v th isnat;
       [clever_rewrite_base p (mkVar v) (mkVar th)], Oatom v
   in
-  try match destructurate_term t with
+  try match destructurate_term sigma t with
     | Kapp(Zplus,[t1;t2]) ->
-	let tac1,t1' = transform (P_APP 1 :: p) t1
-	and tac2,t2' = transform (P_APP 2 :: p) t2 in
+	let tac1,t1' = transform sigma (P_APP 1 :: p) t1
+	and tac2,t2' = transform sigma (P_APP 2 :: p) t2 in
 	let tac,t' = shuffle p (t1',t2') in
 	tac1 @ tac2 @ tac, t'
     | Kapp(Zminus,[t1;t2]) ->
 	let tac,t =
-	  transform p
+	  transform sigma p
 	    (mkApp (Lazy.force coq_Zplus,
 		     [| t1; (mkApp (Lazy.force coq_Zopp, [| t2 |])) |])) in
-	Proofview.V82.of_tactic (unfold sp_Zminus) :: tac,t
+	unfold sp_Zminus :: tac,t
     | Kapp(Zsucc,[t1]) ->
-	let tac,t = transform p (mkApp (Lazy.force coq_Zplus,
+	let tac,t = transform sigma p (mkApp (Lazy.force coq_Zplus,
 					 [| t1; mk_integer one |])) in
-	Proofview.V82.of_tactic (unfold sp_Zsucc) :: tac,t
+	unfold sp_Zsucc :: tac,t
     | Kapp(Zpred,[t1]) ->
-	let tac,t = transform p (mkApp (Lazy.force coq_Zplus,
+	let tac,t = transform sigma p (mkApp (Lazy.force coq_Zplus,
 					 [| t1; mk_integer negone |])) in
-	Proofview.V82.of_tactic (unfold sp_Zpred) :: tac,t
+	unfold sp_Zpred :: tac,t
    | Kapp(Zmult,[t1;t2]) ->
-       let tac1,t1' = transform (P_APP 1 :: p) t1
-       and tac2,t2' = transform (P_APP 2 :: p) t2 in
+       let tac1,t1' = transform sigma (P_APP 1 :: p) t1
+       and tac2,t2' = transform sigma (P_APP 2 :: p) t2 in
        begin match t1',t2' with
          | (_,Oz n) -> let tac,t' = scalar p n t1' in tac1 @ tac2 @ tac,t'
          | (Oz n,_) ->
@@ -950,11 +1036,11 @@ let rec transform p t =
          | _ -> default false t
        end
    | Kapp((Zpos|Zneg|Z0),_) ->
-       (try ([],Oz(recognize_number t))
+       (try ([],Oz(recognize_number sigma t))
         with e when CErrors.noncritical e -> default false t)
    | Kvar s -> [],Oatom s
    | Kapp(Zopp,[t]) ->
-       let tac,t' = transform (P_APP 1 :: p) t in
+       let tac,t' = transform sigma (P_APP 1 :: p) t in
        let tac',t'' = negate p t' in
        tac @ tac', t''
    | Kapp(Z_of_nat,[t']) -> default true t'
@@ -982,7 +1068,7 @@ let shrink_pair p f1 f2 =
     | t1,t2 ->
 	begin
 	  oprint t1; print_newline (); oprint t2; print_newline ();
-	  flush Pervasives.stdout; error "shrink.1"
+	  flush Pervasives.stdout; CErrors.user_err Pp.(str "shrink.1")
 	end
 
 let reduce_factor p = function
@@ -994,10 +1080,10 @@ let reduce_factor p = function
       let rec compute = function
         | Oz n -> n
 	| Oplus(t1,t2) -> Bigint.add (compute t1) (compute t2)
-	| _ -> error "condense.1"
+	| _ -> CErrors.user_err Pp.(str "condense.1")
       in
       [focused_simpl (P_APP 2 :: p)], Otimes(Oatom v,Oz(compute c))
-  | t -> oprint t; error "reduce_factor.1"
+  | t -> oprint t; CErrors.user_err Pp.(str "reduce_factor.1")
 
 let rec condense p = function
   | Oplus(f1,(Oplus(f2,r) as t)) ->
@@ -1054,7 +1140,7 @@ let replay_history tactic_normalisation =
       | HYP e :: l ->
 	  begin
 	    try
-	      Tacticals.New.tclTHEN
+	      tclTHEN
 		(Id.List.assoc (hyp_of_tag e.id) tactic_normalisation)
 		(loop l)
 	    with Not_found -> loop l end
@@ -1066,16 +1152,16 @@ let replay_history tactic_normalisation =
 	  let k = if b then negone else one in
 	  let p_initial = [P_APP 1;P_TYPE] in
 	  let tac= shuffle_mult_right p_initial e1.body k e2.body in
-	  Tacticals.New.tclTHENLIST [
+	  tclTHENLIST [
 	    generalize_tac
 	      [mkApp (Lazy.force coq_OMEGA17, [|
 		val_of eq1;
 		val_of eq2;
 		mk_integer k;
 		mkVar id1; mkVar id2 |])];
-	    Proofview.V82.tactic (mk_then tac);
+	    mk_then tac;
 	    (intros_using [aux]);
-	    Proofview.V82.tactic (resolve_id aux);
+	    resolve_id aux;
             reflexivity
           ]
       | CONTRADICTION (e1,e2) :: l ->
@@ -1084,14 +1170,14 @@ let replay_history tactic_normalisation =
 	  let p_initial = [P_APP 2;P_TYPE] in
 	  let tac = shuffle_cancel p_initial e1.body in
 	  let solve_le =
-            let not_sup_sup = mkApp (Universes.constr_of_global (build_coq_eq ()),
+            let not_sup_sup = mkApp (Lazy.force coq_eq,
 				     [|
 					Lazy.force coq_comparison;
 					Lazy.force coq_Gt;
 					Lazy.force coq_Gt |])
 	    in
-            Tacticals.New.tclTHENS
-	      (Tacticals.New.tclTHENLIST [
+            tclTHENS
+	      (tclTHENLIST [
 		unfold sp_Zle;
 		simpl_in_concl;
 		intro;
@@ -1104,7 +1190,7 @@ let replay_history tactic_normalisation =
 		      mkVar (hyp_of_tag e1.id);
 		      mkVar (hyp_of_tag e2.id) |])
 	  in
-	  Proofview.tclTHEN (Proofview.V82.tactic (tclTHEN (Proofview.V82.of_tactic (generalize_tac [theorem])) (mk_then tac))) (solve_le)
+	  Proofview.tclTHEN (tclTHEN (generalize_tac [theorem]) (mk_then tac)) solve_le
       | DIVIDE_AND_APPROX (e1,e2,k,d) :: l ->
 	  let id = hyp_of_tag e1.id in
 	  let eq1 = val_of(decompile e1)
@@ -1114,10 +1200,10 @@ let replay_history tactic_normalisation =
 	  let rhs = mk_plus (mk_times eq2 kk) dd in
 	  let state_eg = mk_eq eq1 rhs in
 	  let tac = scalar_norm_add [P_APP 3] e2.body in
-	  Tacticals.New.tclTHENS
+	  tclTHENS
 	    (cut state_eg)
-	    [ Tacticals.New.tclTHENS
-	        (Tacticals.New.tclTHENLIST [
+	    [ tclTHENS
+	        (tclTHENLIST [
 		  (intros_using [aux]);
 		  (generalize_tac
 		    [mkApp (Lazy.force coq_OMEGA1,
@@ -1125,9 +1211,9 @@ let replay_history tactic_normalisation =
 		  (clear [aux;id]);
 		  (intros_using [id]);
 		  (cut (mk_gt kk dd)) ])
-	        [ Tacticals.New.tclTHENS
+	        [ tclTHENS
 		    (cut (mk_gt kk izero))
-		    [ Tacticals.New.tclTHENLIST [
+		    [ tclTHENLIST [
 		        (intros_using [aux1; aux2]);
 		        (generalize_tac
 			  [mkApp (Lazy.force coq_Zmult_le_approx,
@@ -1135,13 +1221,13 @@ let replay_history tactic_normalisation =
 		        (clear [aux1;aux2;id]);
 		        (intros_using [id]);
 		        (loop l) ];
-		      Tacticals.New.tclTHENLIST [
+		      tclTHENLIST [
 			(unfold sp_Zgt);
 			simpl_in_concl;
 			reflexivity ] ];
-		  Tacticals.New.tclTHENLIST [ unfold sp_Zgt; simpl_in_concl; reflexivity ]
+		  tclTHENLIST [ unfold sp_Zgt; simpl_in_concl; reflexivity ]
                 ];
-	      Tacticals.New.tclTHEN (Proofview.V82.tactic (mk_then tac)) reflexivity ]
+	      tclTHEN (mk_then tac) reflexivity ]
 
       | NOT_EXACT_DIVIDE (e1,k) :: l ->
 	  let c = floor_div e1.constant k in
@@ -1152,10 +1238,10 @@ let replay_history tactic_normalisation =
 	  let kk = mk_integer k
 	  and dd = mk_integer d in
 	  let tac = scalar_norm_add [P_APP 2] e2.body in
-	  Tacticals.New.tclTHENS
+	  tclTHENS
 	    (cut (mk_gt dd izero))
-	    [ Tacticals.New.tclTHENS (cut (mk_gt kk dd))
-		[Tacticals.New.tclTHENLIST [
+	    [ tclTHENS (cut (mk_gt kk dd))
+		[tclTHENLIST [
 		  (intros_using [aux2;aux1]);
 		  (generalize_tac
 		    [mkApp (Lazy.force coq_OMEGA4,
@@ -1163,14 +1249,14 @@ let replay_history tactic_normalisation =
 		  (clear [aux1;aux2]);
 		  unfold sp_not;
 		  (intros_using [aux]);
-		  Proofview.V82.tactic (resolve_id aux);
-		  Proofview.V82.tactic (mk_then tac);
+		  resolve_id aux;
+		  mk_then tac;
 		  assumption ] ;
-		 Tacticals.New.tclTHENLIST [
+		 tclTHENLIST [
 		   unfold sp_Zgt;
 		   simpl_in_concl;
 		   reflexivity ] ];
-              Tacticals.New.tclTHENLIST [
+              tclTHENLIST [
 		unfold sp_Zgt;
                 simpl_in_concl;
 		reflexivity ] ]
@@ -1183,9 +1269,9 @@ let replay_history tactic_normalisation =
 	  let state_eq = mk_eq eq1 (mk_times eq2 kk) in
 	  if e1.kind == DISE then
             let tac = scalar_norm [P_APP 3] e2.body in
-            Tacticals.New.tclTHENS
+            tclTHENS
 	      (cut state_eq)
-	      [Tacticals.New.tclTHENLIST [
+	      [tclTHENLIST [
 		(intros_using [aux1]);
 		(generalize_tac
 		  [mkApp (Lazy.force coq_OMEGA18,
@@ -1193,14 +1279,14 @@ let replay_history tactic_normalisation =
 		(clear [aux1;id]);
 		(intros_using [id]);
 		(loop l) ];
-	       Tacticals.New.tclTHEN (Proofview.V82.tactic (mk_then tac)) reflexivity ]
+	       tclTHEN (mk_then tac) reflexivity ]
 	  else
             let tac = scalar_norm [P_APP 3] e2.body in
-            Tacticals.New.tclTHENS (cut state_eq)
+            tclTHENS (cut state_eq)
 	      [
-		Tacticals.New.tclTHENS
+		tclTHENS
 		 (cut (mk_gt kk izero))
-		 [Tacticals.New.tclTHENLIST [
+		 [tclTHENLIST [
 		   (intros_using [aux2;aux1]);
 		   (generalize_tac
 		     [mkApp (Lazy.force coq_OMEGA3,
@@ -1208,11 +1294,11 @@ let replay_history tactic_normalisation =
 		   (clear [aux1;aux2;id]);
 		   (intros_using [id]);
 		   (loop l) ];
-		  Tacticals.New.tclTHENLIST [
+		  tclTHENLIST [
 		    unfold sp_Zgt;
                     simpl_in_concl;
 		    reflexivity ] ];
-		Tacticals.New.tclTHEN (Proofview.V82.tactic (mk_then tac)) reflexivity ]
+		tclTHEN (mk_then tac) reflexivity ]
       | (MERGE_EQ(e3,e1,e2)) :: l ->
 	  let id = new_identifier () in
 	  tag_hypothesis id e3;
@@ -1225,16 +1311,16 @@ let replay_history tactic_normalisation =
 	      (Lazy.force coq_fast_Zopp_eq_mult_neg_1) ::
             scalar_norm [P_APP 3] e1.body
 	  in
-	  Tacticals.New.tclTHENS
+	  tclTHENS
 	    (cut (mk_eq eq1 (mk_inv eq2)))
-	    [Tacticals.New.tclTHENLIST [
+	    [tclTHENLIST [
 	      (intros_using [aux]);
 	      (generalize_tac [mkApp (Lazy.force coq_OMEGA8,
 	        [| eq1;eq2;mkVar id1;mkVar id2; mkVar aux|])]);
 	      (clear [id1;id2;aux]);
 	      (intros_using [id]);
 	      (loop l) ];
-            Tacticals.New.tclTHEN (Proofview.V82.tactic (mk_then tac)) reflexivity]
+            tclTHEN (mk_then tac) reflexivity]
 
       | STATE {st_new_eq=e;st_def=def;st_orig=orig;st_coef=m;st_var=v} :: l ->
 	  let id = new_identifier ()
@@ -1244,7 +1330,7 @@ let replay_history tactic_normalisation =
 	  and eq2 = val_of(decompile orig) in
 	  let vid = unintern_id v in
 	  let theorem =
-            mkApp (build_coq_ex (), [|
+            mkApp (Lazy.force coq_ex, [|
 		      Lazy.force coq_Z;
 		      mkLambda
 			(Name vid,
@@ -1258,9 +1344,9 @@ let replay_history tactic_normalisation =
               [[P_APP 1]] (Lazy.force coq_fast_Zopp_eq_mult_neg_1) ::
             shuffle_mult_right p_initial
               orig.body m ({c= negone;v= v}::def.body) in
-	  Tacticals.New.tclTHENS
+	  tclTHENS
 	    (cut theorem)
-	    [Tacticals.New.tclTHENLIST [
+	    [tclTHENLIST [
 	      (intros_using [aux]);
 	      (elim_id aux);
 	      (clear [aux]);
@@ -1268,11 +1354,11 @@ let replay_history tactic_normalisation =
 	      (generalize_tac
 		[mkApp (Lazy.force coq_OMEGA9,
 		  [| mkVar vid;eq2;eq1;mm; mkVar id2;mkVar aux |])]);
-	      Proofview.V82.tactic (mk_then tac);
+	      mk_then tac;
 	      (clear [aux]);
 	      (intros_using [id]);
 	      (loop l) ];
-            Tacticals.New.tclTHEN (exists_tac eq1) reflexivity ]
+            tclTHEN (exists_tac eq1) reflexivity ]
       | SPLIT_INEQ(e,(e1,act1),(e2,act2)) :: l ->
 	  let id1 = new_identifier ()
 	  and id2 = new_identifier () in
@@ -1281,10 +1367,10 @@ let replay_history tactic_normalisation =
 	  let tac1 = norm_add [P_APP 2;P_TYPE] e.body in
 	  let tac2 = scalar_norm_add [P_APP 2;P_TYPE] e.body in
 	  let eq = val_of(decompile e) in
-	  Tacticals.New.tclTHENS
+	  tclTHENS
 	    (simplest_elim (applist (Lazy.force coq_OMEGA19, [eq; mkVar id])))
-	    [Tacticals.New.tclTHENLIST [ Proofview.V82.tactic (mk_then tac1); (intros_using [id1]); (loop act1) ];
-             Tacticals.New.tclTHENLIST [ Proofview.V82.tactic (mk_then tac2); (intros_using [id2]); (loop act2) ]]
+	    [tclTHENLIST [ mk_then tac1; (intros_using [id1]); (loop act1) ];
+             tclTHENLIST [ mk_then tac2; (intros_using [id2]); (loop act2) ]]
       | SUM(e3,(k1,e1),(k2,e2)) :: l ->
 	  let id = new_identifier () in
 	  tag_hypothesis id e3;
@@ -1303,10 +1389,10 @@ let replay_history tactic_normalisation =
             let p_initial =
               if e1.kind == DISE then [P_APP 1; P_TYPE] else [P_APP 2; P_TYPE] in
             let tac = shuffle_mult_right p_initial e1.body k2 e2.body in
-            Tacticals.New.tclTHENLIST [
+            tclTHENLIST [
 	      (generalize_tac
                 [mkApp (tac_thm, [| eq1; eq2; kk; mkVar id1; mkVar id2 |])]);
-	      Proofview.V82.tactic (mk_then tac);
+	      mk_then tac;
 	      (intros_using [id]);
 	      (loop l)
             ]
@@ -1315,10 +1401,10 @@ let replay_history tactic_normalisation =
 	    and kk2 = mk_integer k2 in
 	    let p_initial = [P_APP 2;P_TYPE] in
 	    let tac= shuffle_mult p_initial k1 e1.body k2 e2.body in
-            Tacticals.New.tclTHENS (cut (mk_gt kk1 izero))
-	      [Tacticals.New.tclTHENS
+            tclTHENS (cut (mk_gt kk1 izero))
+	      [tclTHENS
 		 (cut (mk_gt kk2 izero))
-		 [Tacticals.New.tclTHENLIST [
+		 [tclTHENLIST [
 		   (intros_using [aux2;aux1]);
 		   (generalize_tac
 		     [mkApp (Lazy.force coq_OMEGA7, [|
@@ -1326,102 +1412,102 @@ let replay_history tactic_normalisation =
 		       mkVar aux1;mkVar aux2;
 		       mkVar id1;mkVar id2 |])]);
 		   (clear [aux1;aux2]);
-		   Proofview.V82.tactic (mk_then tac);
+		   mk_then tac;
 		   (intros_using [id]);
 		   (loop l) ];
-		 Tacticals.New.tclTHENLIST [
+		 tclTHENLIST [
 		   unfold sp_Zgt;
                    simpl_in_concl;
 		   reflexivity ] ];
-	      Tacticals.New.tclTHENLIST [
+	      tclTHENLIST [
 		unfold sp_Zgt;
                 simpl_in_concl;
 		reflexivity ] ]
       | CONSTANT_NOT_NUL(e,k) :: l ->
-	  Tacticals.New.tclTHEN ((generalize_tac [mkVar (hyp_of_tag e)])) Equality.discrConcl
+	  tclTHEN ((generalize_tac [mkVar (hyp_of_tag e)])) Equality.discrConcl
       | CONSTANT_NUL(e) :: l ->
-	  Tacticals.New.tclTHEN (Proofview.V82.tactic (resolve_id (hyp_of_tag e))) reflexivity
+	  tclTHEN (resolve_id (hyp_of_tag e)) reflexivity
       | CONSTANT_NEG(e,k) :: l ->
-	  Tacticals.New.tclTHENLIST [
+	  tclTHENLIST [
 	    (generalize_tac [mkVar (hyp_of_tag e)]);
             unfold sp_Zle;
 	    simpl_in_concl;
 	    unfold sp_not;
 	    (intros_using [aux]);
-	    Proofview.V82.tactic (resolve_id aux);
+	    resolve_id aux;
 	    reflexivity
           ]
       | _ -> Proofview.tclUNIT ()
   in
   loop
 
-let normalize p_initial t =
-  let (tac,t') = transform p_initial t in
+let normalize sigma p_initial t =
+  let (tac,t') = transform sigma p_initial t in
   let (tac',t'') = condense p_initial t' in
   let (tac'',t''') = clear_zero p_initial t'' in
   tac @ tac' @ tac'' , t'''
 
-let normalize_equation id flag theorem pos t t1 t2 (tactic,defs) =
+let normalize_equation sigma id flag theorem pos t t1 t2 (tactic,defs) =
   let p_initial = [P_APP pos ;P_TYPE] in
-  let (tac,t') = normalize p_initial t in
+  let (tac,t') = normalize sigma p_initial t in
   let shift_left =
     tclTHEN
-      (Proofview.V82.of_tactic (generalize_tac [mkApp (theorem, [| t1; t2; mkVar id |]) ]))
-      (tclTRY (Proofview.V82.of_tactic (clear [id])))
+      (generalize_tac [mkApp (theorem, [| t1; t2; mkVar id |]) ])
+      (tclTRY (clear [id]))
   in
   if not (List.is_empty tac) then
     let id' = new_identifier () in
-    ((id',(Tacticals.New.tclTHENLIST [ Proofview.V82.tactic (shift_left); Proofview.V82.tactic (mk_then tac); (intros_using [id']) ]))
+    ((id',(tclTHENLIST [ shift_left; mk_then tac; (intros_using [id']) ]))
           :: tactic,
      compile id' flag t' :: defs)
   else
     (tactic,defs)
 
-let destructure_omega gl tac_def (id,c) =
+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 c with
+    try match destructurate_prop sigma c with
       | Kapp(Eq,[typ;t1;t2])
-	when begin match destructurate_type (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
+	  normalize_equation sigma
 	    id EQUA (Lazy.force coq_Zegal_left) 2 t t1 t2 tac_def
       | Kapp(Zne,[t1;t2]) ->
 	  let t = mk_plus t1 (mk_inv t2) in
-	  normalize_equation
+	  normalize_equation sigma
 	    id DISE (Lazy.force coq_Zne_left) 1 t t1 t2 tac_def
       | Kapp(Zle,[t1;t2]) ->
 	  let t = mk_plus t2 (mk_inv t1) in
-	  normalize_equation
+	  normalize_equation sigma
 	    id INEQ (Lazy.force coq_Zle_left) 2 t t1 t2 tac_def
       | Kapp(Zlt,[t1;t2]) ->
 	  let t = mk_plus (mk_plus t2 (mk_integer negone)) (mk_inv t1) in
-	  normalize_equation
+	  normalize_equation sigma
 	    id INEQ (Lazy.force coq_Zlt_left) 2 t t1 t2 tac_def
       | Kapp(Zge,[t1;t2]) ->
 	  let t = mk_plus t1 (mk_inv t2) in
-	  normalize_equation
+	  normalize_equation sigma
 	    id INEQ (Lazy.force coq_Zge_left) 2 t t1 t2 tac_def
       | Kapp(Zgt,[t1;t2]) ->
 	  let t = mk_plus (mk_plus t1 (mk_integer negone)) (mk_inv t2) in
-	  normalize_equation
+	  normalize_equation sigma
 	    id INEQ (Lazy.force coq_Zgt_left) 2 t t1 t2 tac_def
       | _ -> tac_def
     with e when catchable_exception e -> tac_def
 
 let reintroduce id =
   (* [id] cannot be cleared if dependent: protect it by a try *)
-  Tacticals.New.tclTHEN (Tacticals.New.tclTRY (clear [id])) (intro_using id)
+  tclTHEN (tclTRY (clear [id])) (intro_using id)
 
 
 open Proofview.Notations
 
 let coq_omega =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   clear_constr_tables ();
   let hyps_types = Tacmach.New.pf_hyps_types gl in
-  let destructure_omega = Tacmach.New.of_old 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 =
@@ -1431,7 +1517,7 @@ let coq_omega =
            let id = new_identifier () in
            let i = new_id () in
            tag_hypothesis id i;
-           (Tacticals.New.tclTHENLIST [
+           (tclTHENLIST [
 	     (simplest_elim (applist (Lazy.force coq_intro_Z, [t])));
 	     (intros_using [v; id]);
 	     (elim_id id);
@@ -1442,7 +1528,7 @@ let coq_omega =
 	    body = [{v=intern_id v; c=one}];
             constant = zero; id = i} :: sys
 	 else
-           (Tacticals.New.tclTHENLIST [
+           (tclTHENLIST [
 	     (simplest_elim (applist (Lazy.force coq_new_var, [t])));
 	     (intros_using [v;th]);
 	     tac ]),
@@ -1458,94 +1544,96 @@ let coq_omega =
     with UNSOLVABLE ->
       let _,path = depend [] [] (history ()) in
       if !display_action_flag then display_action display_var path;
-      (Tacticals.New.tclTHEN prelude (replay_history tactic_normalisation path))
+      (tclTHEN prelude (replay_history tactic_normalisation path))
   end else begin
     try
       let path = simplify_strong (new_id,new_var_num,display_var) system in
       if !display_action_flag then display_action display_var path;
-      Tacticals.New.tclTHEN prelude (replay_history tactic_normalisation path)
-    with NO_CONTRADICTION -> Tacticals.New.tclZEROMSG (Pp.str"Omega can't solve this system")
+      tclTHEN prelude (replay_history tactic_normalisation path)
+    with NO_CONTRADICTION -> tclZEROMSG (Pp.str"Omega can't solve this system")
+  end
   end
-  end }
 
 let coq_omega = coq_omega
 
 let nat_inject =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let is_conv = Tacmach.New.pf_apply Reductionops.is_conv gl in
   let rec explore p t : unit Proofview.tactic =
-    try match destructurate_term t with
+    Proofview.tclEVARMAP >>= fun sigma ->
+    try match destructurate_term sigma t with
       | Kapp(Plus,[t1;t2]) ->
-          Tacticals.New.tclTHENLIST [
-	    Proofview.V82.tactic (clever_rewrite_gen p (mk_plus (mk_inj t1) (mk_inj t2))
+          tclTHENLIST [
+	    (clever_rewrite_gen p (mk_plus (mk_inj t1) (mk_inj t2))
               ((Lazy.force coq_inj_plus),[t1;t2]));
 	    (explore (P_APP 1 :: p) t1);
 	    (explore (P_APP 2 :: p) t2)
           ]
       | Kapp(Mult,[t1;t2]) ->
-          Tacticals.New.tclTHENLIST [
-	    Proofview.V82.tactic (clever_rewrite_gen p (mk_times (mk_inj t1) (mk_inj t2))
+          tclTHENLIST [
+	    (clever_rewrite_gen p (mk_times (mk_inj t1) (mk_inj t2))
               ((Lazy.force coq_inj_mult),[t1;t2]));
 	    (explore (P_APP 1 :: p) t1);
 	    (explore (P_APP 2 :: p) t2)
           ]
       | Kapp(Minus,[t1;t2]) ->
           let id = new_identifier () in
-          Tacticals.New.tclTHENS
-            (Tacticals.New.tclTHEN
+          tclTHENS
+            (tclTHEN
 	       (simplest_elim (applist (Lazy.force coq_le_gt_dec, [t2;t1])))
 	       (intros_using [id]))
 	    [
-	      Tacticals.New.tclTHENLIST [
-	        Proofview.V82.tactic (clever_rewrite_gen p
+	      tclTHENLIST [
+	        (clever_rewrite_gen p
 		  (mk_minus (mk_inj t1) (mk_inj t2))
                   ((Lazy.force coq_inj_minus1),[t1;t2;mkVar id]));
 		(loop [id,mkApp (Lazy.force coq_le, [| t2;t1 |])]);
 		(explore (P_APP 1 :: p) t1);
 		(explore (P_APP 2 :: p) t2) ];
-	      (Tacticals.New.tclTHEN
-		 (Proofview.V82.tactic (clever_rewrite_gen p (mk_integer zero)
-                    ((Lazy.force coq_inj_minus2),[t1;t2;mkVar id])))
+	      (tclTHEN
+		 (clever_rewrite_gen p (mk_integer zero)
+                    ((Lazy.force coq_inj_minus2),[t1;t2;mkVar id]))
 		 (loop [id,mkApp (Lazy.force coq_gt, [| t2;t1 |])]))
 	    ]
       | Kapp(S,[t']) ->
           let rec is_number t =
-            try match destructurate_term t with
+            try match destructurate_term sigma t with
 		Kapp(S,[t]) -> is_number t
               | Kapp(O,[]) -> true
               | _ -> false
             with e when catchable_exception e -> false
 	  in
           let rec loop p t : unit Proofview.tactic =
-            try match destructurate_term t with
+            try match destructurate_term sigma t with
 		Kapp(S,[t]) ->
-                  (Tacticals.New.tclTHEN
-                     (Proofview.V82.tactic (clever_rewrite_gen p
+                  (tclTHEN
+                     (clever_rewrite_gen p
 			(mkApp (Lazy.force coq_Zsucc, [| mk_inj t |]))
-			((Lazy.force coq_inj_S),[t])))
+			((Lazy.force coq_inj_S),[t]))
 		     (loop (P_APP 1 :: p) t))
               | _ -> explore p t
             with e when catchable_exception e -> explore p t
 	  in
-          if is_number t' then Proofview.V82.tactic (focused_simpl p) else loop p t
+          if is_number t' then focused_simpl p else loop p t
       | Kapp(Pred,[t]) ->
           let t_minus_one =
 	    mkApp (Lazy.force coq_minus, [| t;
 		      mkApp (Lazy.force coq_S, [| Lazy.force coq_O |]) |]) in
-          Tacticals.New.tclTHEN
-            (Proofview.V82.tactic (clever_rewrite_gen_nat (P_APP 1 :: p) t_minus_one
-               ((Lazy.force coq_pred_of_minus),[t])))
+          tclTHEN
+            (clever_rewrite_gen_nat (P_APP 1 :: p) t_minus_one
+               ((Lazy.force coq_pred_of_minus),[t]))
             (explore p t_minus_one)
-      | Kapp(O,[]) -> Proofview.V82.tactic (focused_simpl p)
+      | Kapp(O,[]) -> focused_simpl p
       | _ -> Proofview.tclUNIT ()
     with e when catchable_exception e -> Proofview.tclUNIT ()
 
   and loop = function
     | [] -> Proofview.tclUNIT ()
     | (i,t)::lit ->
-	  begin try match destructurate_prop t with
+        Proofview.tclEVARMAP >>= fun sigma ->
+	  begin try match destructurate_prop sigma t with
               Kapp(Le,[t1;t2]) ->
-		Tacticals.New.tclTHENLIST [
+		tclTHENLIST [
 		  (generalize_tac
 		    [mkApp (Lazy.force coq_inj_le, [| t1;t2;mkVar i |]) ]);
 		  (explore [P_APP 1; P_TYPE] t1);
@@ -1554,7 +1642,7 @@ let nat_inject =
 		  (loop lit)
                 ]
             | Kapp(Lt,[t1;t2]) ->
-		Tacticals.New.tclTHENLIST [
+		tclTHENLIST [
 		  (generalize_tac
 		    [mkApp (Lazy.force coq_inj_lt, [| t1;t2;mkVar i |]) ]);
 		  (explore [P_APP 1; P_TYPE] t1);
@@ -1563,7 +1651,7 @@ let nat_inject =
 		  (loop lit)
                 ]
             | Kapp(Ge,[t1;t2]) ->
-		Tacticals.New.tclTHENLIST [
+		tclTHENLIST [
 		  (generalize_tac
 		    [mkApp (Lazy.force coq_inj_ge, [| t1;t2;mkVar i |]) ]);
 		  (explore [P_APP 1; P_TYPE] t1);
@@ -1572,7 +1660,7 @@ let nat_inject =
 		  (loop lit)
                 ]
             | Kapp(Gt,[t1;t2]) ->
-		Tacticals.New.tclTHENLIST [
+		tclTHENLIST [
 		  (generalize_tac
                     [mkApp (Lazy.force coq_inj_gt, [| t1;t2;mkVar i |]) ]);
 		  (explore [P_APP 1; P_TYPE] t1);
@@ -1581,7 +1669,7 @@ let nat_inject =
 		  (loop lit)
                 ]
             | Kapp(Neq,[t1;t2]) ->
-		Tacticals.New.tclTHENLIST [
+		tclTHENLIST [
 		  (generalize_tac
 		    [mkApp (Lazy.force coq_inj_neq, [| t1;t2;mkVar i |]) ]);
 		  (explore [P_APP 1; P_TYPE] t1);
@@ -1591,7 +1679,7 @@ let nat_inject =
                 ]
             | Kapp(Eq,[typ;t1;t2]) ->
 		if is_conv typ (Lazy.force coq_nat) then
-                  Tacticals.New.tclTHENLIST [
+                  tclTHENLIST [
 		    (generalize_tac
 		      [mkApp (Lazy.force coq_inj_eq, [| t1;t2;mkVar i |]) ]);
 		    (explore [P_APP 2; P_TYPE] t1);
@@ -1605,7 +1693,7 @@ let nat_inject =
   in
   let hyps_types = Tacmach.New.pf_hyps_types gl in
   loop (List.rev hyps_types)
-  end }
+  end
 
 let dec_binop = function
   | Zne -> coq_dec_Zne
@@ -1639,26 +1727,26 @@ let not_binop = function
 
 exception Undecidable
 
-let rec decidability gl t =
-  match destructurate_prop 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 (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
@@ -1670,59 +1758,78 @@ let rec decidability gl t =
     | Kapp(True,[]) -> Lazy.force coq_dec_True
     | _ -> raise Undecidable
 
+let fresh_id avoid id gl =
+  fresh_id_in_env avoid id (Proofview.Goal.env gl)
+
 let onClearedName id tac =
   (* We cannot ensure that hyps can be cleared (because of dependencies), *)
   (* so renaming may be necessary *)
-  Tacticals.New.tclTHEN
-    (Tacticals.New.tclTRY (clear [id]))
-    (Proofview.Goal.nf_enter { enter = begin fun gl ->
-     let id = Tacmach.New.of_old (fresh_id [] id) gl in
-     Tacticals.New.tclTHEN (introduction id) (tac id)
-    end })
+  tclTHEN
+    (tclTRY (clear [id]))
+    (Proofview.Goal.nf_enter begin fun gl ->
+     let id = fresh_id Id.Set.empty id gl in
+     tclTHEN (introduction id) (tac id)
+    end)
 
 let onClearedName2 id tac =
-  Tacticals.New.tclTHEN
-    (Tacticals.New.tclTRY (clear [id]))
-    (Proofview.Goal.nf_enter { enter = begin fun gl ->
-     let id1 = Tacmach.New.of_old (fresh_id [] (add_suffix id "_left")) gl in
-     let id2 = Tacmach.New.of_old (fresh_id [] (add_suffix id "_right")) gl in
-      Tacticals.New.tclTHENLIST [ introduction id1; introduction id2; tac id1 id2 ]
-    end })
+  tclTHEN
+    (tclTRY (clear [id]))
+    (Proofview.Goal.nf_enter begin fun gl ->
+     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 destructure_hyps =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let type_of = Tacmach.New.pf_unsafe_type_of gl in
-  let decidability = Tacmach.New.of_old decidability gl in
-  let pf_nf = Tacmach.New.of_old pf_nf gl in
-    let rec loop = function
-      | [] -> (Tacticals.New.tclTHEN nat_inject coq_omega)
-      | decl::lit ->
-          let (i,_,t) = to_tuple decl in
-	  begin try match destructurate_prop t with
+  let 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
           | Kapp(Or,[t1;t2]) ->
-              (Tacticals.New.tclTHENS
+              (tclTHENS
                  (elim_id i)
                  [ onClearedName i (fun i -> (loop (LocalAssum (i,t1)::lit)));
                    onClearedName i (fun i -> (loop (LocalAssum (i,t2)::lit))) ])
           | Kapp(And,[t1;t2]) ->
-              Tacticals.New.tclTHEN
+              tclTHEN
 		(elim_id i)
 		(onClearedName2 i (fun i1 i2 ->
 		  loop (LocalAssum (i1,t1) :: LocalAssum (i2,t2) :: lit)))
           | Kapp(Iff,[t1;t2]) ->
-	      Tacticals.New.tclTHEN
+	      tclTHEN
 		(elim_id i)
 		(onClearedName2 i (fun i1 i2 ->
 		  loop (LocalAssum (i1,mkArrow t1 t2) :: LocalAssum (i2,mkArrow t2 t1) :: lit)))
           | 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 (type_of t2)
+              if Termops.is_Prop sigma (type_of t2)
               then
 		let d1 = decidability t1 in
-		Tacticals.New.tclTHENLIST [
+		tclTHENLIST [
 		  (generalize_tac [mkApp (Lazy.force coq_imp_simp,
                                                                [| t1; t2; d1; mkVar i|])]);
 		  (onClearedName i (fun i ->
@@ -1731,9 +1838,9 @@ let destructure_hyps =
               else
 		loop lit
           | Kapp(Not,[t]) ->
-              begin match destructurate_prop t with
+              begin match destructurate_prop sigma t with
 		Kapp(Or,[t1;t2]) ->
-                  Tacticals.New.tclTHENLIST [
+                  tclTHENLIST [
 		    (generalize_tac
                                             [mkApp (Lazy.force coq_not_or,[| t1; t2; mkVar i |])]);
 		    (onClearedName i (fun i ->
@@ -1741,7 +1848,7 @@ let destructure_hyps =
                   ]
 	      | Kapp(And,[t1;t2]) ->
 		  let d1 = decidability t1 in
-                  Tacticals.New.tclTHENLIST [
+                  tclTHENLIST [
 		    (generalize_tac
 		                            [mkApp (Lazy.force coq_not_and,
 				                    [| t1; t2; d1; mkVar i |])]);
@@ -1751,7 +1858,7 @@ let destructure_hyps =
 	      | Kapp(Iff,[t1;t2]) ->
 		  let d1 = decidability t1 in
 		  let d2 = decidability t2 in
-                  Tacticals.New.tclTHENLIST [
+                  tclTHENLIST [
 		    (generalize_tac
 		                            [mkApp (Lazy.force coq_not_iff,
 				                    [| t1; t2; d1; d2; mkVar i |])]);
@@ -1763,7 +1870,7 @@ let destructure_hyps =
 		    (* t2 must be in Prop otherwise ~(t1->t2) wouldn't be ok.
 		       For t1, being decidable implies being Prop. *)
 		  let d1 = decidability t1 in
-                  Tacticals.New.tclTHENLIST [
+                  tclTHENLIST [
 		    (generalize_tac
 		                            [mkApp (Lazy.force coq_not_imp,
 				                    [| t1; t2; d1; mkVar i |])]);
@@ -1772,7 +1879,7 @@ let destructure_hyps =
                   ]
 	      | Kapp(Not,[t]) ->
 		  let d = decidability t in
-                  Tacticals.New.tclTHENLIST [
+                  tclTHENLIST [
 		    (generalize_tac
 			                    [mkApp (Lazy.force coq_not_not, [| t; d; mkVar i |])]);
 		    (onClearedName i (fun i -> (loop (LocalAssum (i,t) :: lit))))
@@ -1780,7 +1887,7 @@ let destructure_hyps =
 	      | Kapp(op,[t1;t2]) ->
 		  (try
 		     let thm = not_binop op in
-                     Tacticals.New.tclTHENLIST [
+                     tclTHENLIST [
 		       (generalize_tac
 			                       [mkApp (Lazy.force thm, [| t1;t2;mkVar i|])]);
 		       (onClearedName i (fun _ -> loop lit))
@@ -1788,16 +1895,16 @@ let destructure_hyps =
 		   with Not_found -> loop lit)
 	      | Kapp(Eq,[typ;t1;t2]) ->
                   if !old_style_flag then begin
-		    match destructurate_type (pf_nf typ) with
+                    match destructurate_type env sigma typ with
 		    | Kapp(Nat,_) ->
-                        Tacticals.New.tclTHENLIST [
+                        tclTHENLIST [
 			  (simplest_elim
 			     (mkApp
                                 (Lazy.force coq_not_eq, [|t1;t2;mkVar i|])));
 			  (onClearedName i (fun _ -> loop lit))
                         ]
 		    | Kapp(Z,_) ->
-                        Tacticals.New.tclTHENLIST [
+                        tclTHENLIST [
 			  (simplest_elim
 			     (mkApp
 				(Lazy.force coq_not_Zeq, [|t1;t2;mkVar i|])));
@@ -1805,16 +1912,16 @@ let destructure_hyps =
                         ]
 		    | _ -> loop lit
                   end else begin
-		    match destructurate_type (pf_nf typ) with
+                    match destructurate_type env sigma typ with
 		    | Kapp(Nat,_) ->
-                        (Tacticals.New.tclTHEN
-			   (convert_hyp_no_check (set_type (mkApp (Lazy.force coq_neq, [| t1;t2|]))
-                                                           decl))
+                        (tclTHEN
+			   (convert_hyp_no_check (NamedDecl.set_type (mkApp (Lazy.force coq_neq, [| t1;t2|]))
+                                                                     decl))
 			   (loop lit))
 		    | Kapp(Z,_) ->
-                        (Tacticals.New.tclTHEN
-			   (convert_hyp_no_check (set_type (mkApp (Lazy.force coq_Zne, [| t1;t2|]))
-                                                           decl))
+                        (tclTHEN
+			   (convert_hyp_no_check (NamedDecl.set_type (mkApp (Lazy.force coq_Zne, [| t1;t2|]))
+                                                                     decl))
 			   (loop lit))
 		    | _ -> loop lit
                   end
@@ -1828,34 +1935,41 @@ let destructure_hyps =
     in
     let hyps = Proofview.Goal.hyps gl in
     loop hyps
-  end }
+  end
 
 let destructure_goal =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
-    let decidability = Tacmach.New.of_old 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 =
-      match destructurate_prop t with
+      Proofview.tclEVARMAP >>= fun sigma ->
+      let prop () = Proofview.tclUNIT (destructurate_prop sigma t) in
+      Proofview.V82.wrap_exceptions prop >>= fun prop ->
+      match prop with
       | Kapp(Not,[t]) ->
-          (Tacticals.New.tclTHEN
-	     (Tacticals.New.tclTHEN (unfold sp_not) intro)
+          (tclTHEN
+	     (tclTHEN (unfold sp_not) intro)
 	     destructure_hyps)
-      | Kimp(a,b) -> (Tacticals.New.tclTHEN intro (loop b))
+      | Kimp(a,b) -> (tclTHEN intro (loop b))
       | Kapp(False,[]) -> destructure_hyps
       | _ ->
 	  let goal_tac =
 	    try
 	      let dec = decidability t in
-	      Tacticals.New.tclTHEN
-                (Proofview.V82.tactic (Tacmach.refine
-		                         (mkApp (Lazy.force coq_dec_not_not, [| t; dec; mkNewMeta () |]))))
+	      tclTHEN
+                (Proofview.Goal.nf_enter begin fun gl ->
+		                         refine_app gl (mkApp (Lazy.force coq_dec_not_not, [| t; dec |]))
+		                         end)
 	        intro
-	    with Undecidable -> Tactics.elim_type (build_coq_False ())
+	    with Undecidable -> Tactics.elim_type (Lazy.force coq_False)
+	    | e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
 	  in
-	  Tacticals.New.tclTHEN goal_tac destructure_hyps
+	  tclTHEN goal_tac destructure_hyps
     in
     (loop concl)
-  end }
+  end
 
 let destructure_goal = destructure_goal
 
diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.ml4
index 5647fbf9..170b937c 100644
--- a/plugins/omega/g_omega.ml4
+++ b/plugins/omega/g_omega.ml4
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (**************************************************************************)
 (*                                                                        *)
@@ -13,17 +15,17 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
 
 DECLARE PLUGIN "omega_plugin"
 
+open Ltac_plugin
 open Names
 open Coq_omega
-open Constrarg
+open Stdarg
 
 let eval_tactic name =
   let dp = DirPath.make (List.map Id.of_string ["PreOmega"; "omega"; "Coq"]) in
-  let kn = KerName.make2 (MPfile dp) (Label.make name) in
+  let kn = KerName.make2 (ModPath.MPfile dp) (Label.make name) in
   let tac = Tacenv.interp_ltac kn in
   Tacinterp.eval_tactic tac
 
@@ -34,7 +36,7 @@ let omega_tactic l =
        | "positive" -> eval_tactic "zify_positive"
        | "N" -> eval_tactic "zify_N"
        | "Z" -> eval_tactic "zify_op"
-       | s -> CErrors.error ("No Omega knowledge base for type "^s))
+       | s -> CErrors.user_err Pp.(str ("No Omega knowledge base for type "^s)))
     (Util.List.sort_uniquize String.compare l)
   in
   Tacticals.New.tclTHEN
diff --git a/plugins/omega/omega.ml b/plugins/omega/omega.ml
index bd991a95..2510c169 100644
--- a/plugins/omega/omega.ml
+++ b/plugins/omega/omega.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (**************************************************************************)
 (*                                                                        *)
@@ -96,7 +98,7 @@ type afine = {
 
 type state_action = {
   st_new_eq : afine;
-  st_def    : afine;
+  st_def    : afine; (* /!\ this represents [st_def = st_var] *)
   st_orig   : afine;
   st_coef   : bigint;
   st_var    : int }
@@ -330,11 +332,13 @@ let omega_mod a b = a - b * floor_div (two * a + b) (two * b)
 let banerjee_step (new_eq_id,new_var_id,print_var) original l1 l2 =
   let e = original.body in
   let sigma = new_var_id () in
+  if e == [] then begin
+    display_system print_var [original] ; failwith "TL"
+    end;
   let smallest,var =
-    try
-      List.fold_left (fun (v,p) c ->  if v >? (abs c.c) then abs c.c,c.v else (v,p))
-              (abs (List.hd e).c, (List.hd e).v) (List.tl e)
-    with Failure "tl" -> display_system print_var [original] ; failwith "TL" in
+    List.fold_left (fun (v,p) c ->  if v >? (abs c.c) then abs c.c,c.v else (v,p))
+      (abs (List.hd e).c, (List.hd e).v) (List.tl e)
+  in
   let m = smallest + one in
   let new_eq =
     { constant = omega_mod original.constant m;
@@ -585,10 +589,6 @@ let rec depend relie_on accu = function
       end
   | [] -> relie_on, accu
 
-let solve (new_eq_id,new_eq_var,print_var) system =
-  try let _ = simplify new_eq_id false system in failwith "no contradiction"
-  with UNSOLVABLE -> display_action print_var (snd (depend [] [] (history ())))
-
 let negation (eqs,ineqs) =
   let diseq,_ = List.partition (fun e -> e.kind = DISE) ineqs in
   let normal = function
diff --git a/plugins/omega/vo.itarget b/plugins/omega/vo.itarget
deleted file mode 100644
index 842210e2..00000000
--- a/plugins/omega/vo.itarget
+++ /dev/null
@@ -1,5 +0,0 @@
-OmegaLemmas.vo
-OmegaPlugin.vo
-OmegaTactic.vo
-Omega.vo
-PreOmega.vo
diff --git a/plugins/quote/Quote.v b/plugins/quote/Quote.v
index 2d154adc..2d3d9170 100644
--- a/plugins/quote/Quote.v
+++ b/plugins/quote/Quote.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Declare ML Module "quote_plugin".
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4
index fd87d5b7..c35e0fe1 100644
--- a/plugins/quote/g_quote.ml4
+++ b/plugins/quote/g_quote.ml4
@@ -1,31 +1,32 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
+open Ltac_plugin
 open Names
 open Misctypes
 open Tacexpr
 open Geninterp
 open Quote
-open Constrarg
+open Stdarg
+open Tacarg
 
 DECLARE PLUGIN "quote_plugin"
 
-let loc = Loc.ghost
 let cont = Id.of_string "cont"
 let x = Id.of_string "x"
 
-let make_cont (k : Val.t) (c : Constr.t) =
+let make_cont (k : Val.t) (c : EConstr.t) =
   let c = Tacinterp.Value.of_constr c in
-  let tac = TacCall (loc, ArgVar (loc, cont), [Reference (ArgVar (loc, 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, tac))
+  Tacinterp.eval_tactic_ist ist (TacArg (Loc.tag tac))
 
 TACTIC EXTEND quote
   [ "quote" ident(f) ] -> [ quote f [] ]
diff --git a/plugins/quote/quote.ml b/plugins/quote/quote.ml
index b3ea4335..912429c3 100644
--- a/plugins/quote/quote.ml
+++ b/plugins/quote/quote.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* The `Quote' tactic *)
 
-(* The basic idea is to automatize the inversion of interpetation functions
+(* The basic idea is to automatize the inversion of interpretation functions
    in 2-level approach
 
    Examples are given in \texttt{theories/DEMOS/DemoQuote.v}
@@ -104,7 +106,8 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
+open EConstr
 open Pattern
 open Patternops
 open Constr_matching
@@ -116,7 +119,9 @@ open Proofview.Notations
   We do that lazily, because this code can be linked before
   the constants are loaded in the environment *)
 
-let constant dir s = Coqlib.gen_constant "Quote" ("quote"::dir) s
+let constant dir s =
+  EConstr.of_constr @@ Universes.constr_of_global @@
+    Coqlib.coq_reference "Quote" ("quote"::dir) s
 
 let coq_Empty_vm = lazy (constant ["Quote"] "Empty_vm")
 let coq_Node_vm = lazy (constant ["Quote"] "Node_vm")
@@ -163,11 +168,7 @@ exchange ?1 and ?2 in the example above)
 
 *)
 
-module ConstrSet = Set.Make(
-  struct
-    type t = constr
-    let compare = constr_ord
-  end)
+module ConstrSet = Set.Make(Constr)
 
 type inversion_scheme = {
   normal_lhs_rhs : (constr * constr_pattern) list;
@@ -181,9 +182,9 @@ type inversion_scheme = {
   goal [gl]. This function uses the auxiliary functions
   [i_can't_do_that], [decomp_term], [compute_lhs] and [compute_rhs]. *)
 
-let i_can't_do_that () = error "Quote: not a simple fixpoint"
+let i_can't_do_that () = user_err Pp.(str "Quote: not a simple fixpoint")
 
-let decomp_term c = kind_of_term (strip_outer_cast c)
+let decomp_term sigma c = EConstr.kind sigma (Termops.strip_outer_cast sigma c)
 
 (*s [compute_lhs typ i nargsi] builds the term \texttt{(C ?nargsi ...
   ?2 ?1)}, where \texttt{C} is the [i]-th constructor of inductive
@@ -195,8 +196,8 @@ let coerce_meta_out id =
 let coerce_meta_in n =
   Id.of_string ("M" ^ string_of_int n)
 
-let compute_lhs typ i nargsi =
-  match kind_of_term typ with
+let compute_lhs sigma typ i nargsi =
+  match EConstr.kind sigma typ with
     | Ind((sp,0),u) ->
         let argsi = Array.init nargsi (fun j -> mkMeta (nargsi - j)) in
         mkApp (mkConstructU (((sp,0),i+1),u), argsi)
@@ -205,60 +206,62 @@ let compute_lhs typ i nargsi =
 (*s This function builds the pattern from the RHS. Recursive calls are
   replaced by meta-variables ?i corresponding to those in the LHS *)
 
-let compute_rhs bodyi index_of_f =
+let compute_rhs env sigma bodyi index_of_f =
   let rec aux c =
-    match kind_of_term c with
-      | App (j, args) when isRel j && Int.equal (destRel j) index_of_f (* recursive call *) ->
-          let i = destRel (Array.last args) in
+    match EConstr.kind sigma c with
+      | App (j, args) when isRel sigma j && Int.equal (destRel sigma j) index_of_f (* recursive call *) ->
+          let i = destRel sigma (Array.last args) in
 	  PMeta (Some (coerce_meta_in i))
       | App (f,args) ->
-          PApp (pattern_of_constr (Global.env()) Evd.empty f, Array.map aux args)
+          PApp (pattern_of_constr env sigma (EConstr.to_constr sigma f), Array.map aux args)
       | Cast (c,_,_) -> aux c
-      | _ -> pattern_of_constr (Global.env())(*FIXME*) Evd.empty c
+      | _ -> pattern_of_constr env sigma (EConstr.to_constr sigma c)
   in
   aux bodyi
 
 (*s Now the function [compute_ivs] itself *)
 
 let compute_ivs f cs gl =
-  let cst = try destConst f with DestKO -> i_can't_do_that () in
-  let body = Environ.constant_value_in (Global.env()) cst in
-  match decomp_term body with
+  let env = Proofview.Goal.env gl in
+  let sigma = Tacmach.New.project gl in
+  let (cst, u) = try destConst sigma f with DestKO -> i_can't_do_that () in
+  let u = EInstance.kind sigma u in
+  let body = Environ.constant_value_in (Global.env()) (cst, u) in
+  let body = EConstr.of_constr body in
+  match decomp_term sigma body with
     | Fix(([| len |], 0), ([| name |], [| typ |], [| body2 |])) ->
-        let (args3, body3) = decompose_lam body2 in
+        let (args3, body3) = decompose_lam sigma body2 in
         let nargs3 = List.length args3 in
-        let env = Proofview.Goal.env gl in
-        let sigma = Tacmach.New.project gl in
         let is_conv = Reductionops.is_conv env sigma in
-          begin match decomp_term body3 with
+          begin match decomp_term sigma body3 with
           | Case(_,p,c,lci) -> (* <p> Case c of c1 ... cn end *)
               let n_lhs_rhs = ref []
               and v_lhs = ref (None : constr option)
               and c_lhs = ref (None : constr option) in
               Array.iteri
                 (fun i ci ->
-                   let argsi, bodyi = decompose_lam ci in
+                   let argsi, bodyi = decompose_lam sigma ci in
                    let nargsi = List.length argsi in
            (* REL (narg3 + nargsi + 1) is f *)
            (* REL nargsi+1 to REL nargsi + nargs3 are arguments of f *)
            (* REL 1 to REL nargsi are argsi (reverse order) *)
            (* First we test if the RHS is the RHS for constants *)
-                   if isRel bodyi && Int.equal (destRel bodyi) 1 then
-                     c_lhs := Some (compute_lhs (snd (List.hd args3))
+                   if isRel sigma bodyi && Int.equal (destRel sigma bodyi) 1 then
+                     c_lhs := Some (compute_lhs sigma (snd (List.hd args3))
                                       i nargsi)
            (* Then we test if the RHS is the RHS for variables *)
-                   else begin match decompose_app bodyi with
+                   else begin match decompose_app sigma bodyi with
                      | vmf, [_; _; a3; a4 ]
-                         when isRel a3 && isRel a4 && is_conv vmf
-                           (Lazy.force coq_varmap_find)->
-                             v_lhs := Some (compute_lhs
+                         when isRel sigma a3 && isRel sigma a4 && is_conv vmf
+                           (Lazy.force coq_varmap_find) ->
+                             v_lhs := Some (compute_lhs sigma
                                               (snd (List.hd args3))
                                               i nargsi)
            (* Third case: this is a normal LHS-RHS *)
                      | _ ->
                          n_lhs_rhs :=
-                         (compute_lhs (snd (List.hd args3)) i nargsi,
-                          compute_rhs bodyi (nargs3 + nargsi + 1))
+                         (compute_lhs sigma (snd (List.hd args3)) i nargsi,
+                          compute_rhs env sigma bodyi (nargs3 + nargsi + 1))
                          :: !n_lhs_rhs
                    end)
                 lci;
@@ -266,7 +269,7 @@ let compute_ivs f cs gl =
               if Option.is_empty !c_lhs && Option.is_empty !v_lhs then i_can't_do_that ();
 
 	      (* The Cases predicate is a lambda; we assume no dependency *)
-	      let p = match kind_of_term p with
+	      let p = match EConstr.kind sigma p with
 		| Lambda (_,_,p) -> Termops.pop p
 		| _ -> p
 	      in
@@ -297,11 +300,11 @@ binary search trees (see file \texttt{Quote.v}) *)
 (* First the function to distinghish between constants (closed terms)
    and variables (open terms) *)
 
-let rec closed_under cset t =
-  (ConstrSet.mem t cset) ||
-  (match (kind_of_term t) with
-     | Cast(c,_,_) -> closed_under cset c
-     | App(f,l) -> closed_under cset f && Array.for_all (closed_under cset) l
+let rec closed_under sigma cset t =
+  (ConstrSet.mem (EConstr.Unsafe.to_constr t) cset) ||
+  (match EConstr.kind sigma t with
+     | Cast(c,_,_) -> closed_under sigma cset c
+     | App(f,l) -> closed_under sigma cset f && Array.for_all (closed_under sigma cset) l
      | _ -> false)
 
 (*s [btree_of_array [| c1; c2; c3; c4; c5 |]] builds the complete
@@ -361,7 +364,7 @@ let path_of_int n =
 
 let rec subterm gl (t : constr) (t' : constr) =
   (pf_conv_x gl t t') ||
-  (match (kind_of_term t) with
+  (match EConstr.kind (project gl) t with
      | App (f,args) -> Array.exists (fun t -> subterm gl t t') args
      | Cast(t,_,_) -> (subterm gl t t')
      | _ -> false)
@@ -370,20 +373,21 @@ let rec subterm gl (t : constr) (t' : constr) =
 (* Since it's a partial order the algoritm of Sort.list won't work !! *)
 
 let rec sort_subterm gl l =
+  let sigma = project gl in
   let rec insert c = function
     | [] -> [c]
-    | (h::t as l) when eq_constr c h -> l (* Avoid doing the same work twice *)
+    | (h::t as l) when EConstr.eq_constr sigma c h -> l (* Avoid doing the same work twice *)
     | h::t -> if subterm gl c h then c::h::t else h::(insert c t)
   in
   match l with
     | [] -> []
     | h::t -> insert h (sort_subterm gl t)
 
-module Constrhash = Hashtbl.Make
-  (struct type t = constr
-	  let equal = eq_constr
-	  let hash = 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
+  EConstr.of_constr (Termops.subst_meta subst (EConstr.Unsafe.to_constr c))
 
 (*s Now we are able to do the inversion itself.
   We destructurate the term and use an imperative hashtable
@@ -392,7 +396,7 @@ module Constrhash = Hashtbl.Make
   [ivs : inversion_scheme]\\
   [lc: constr list]\\
   [gl: goal sigma]\\ *)
-let quote_terms ivs lc =
+let quote_terms env sigma ivs lc =
   Coqlib.check_required_library ["Coq";"quote";"Quote"];
   let varhash  = (Constrhash.create 17 : constr Constrhash.t) in
   let varlist = ref ([] : constr list) in (* list of variables *)
@@ -402,34 +406,34 @@ let quote_terms ivs lc =
       match l with
         | (lhs, rhs)::tail ->
             begin try
-              let s1 = Id.Map.bindings (matches (Global.env ()) Evd.empty rhs c) in
+              let s1 = Id.Map.bindings (matches env sigma rhs c) in
               let s2 = List.map (fun (i,c_i) -> (coerce_meta_out i,aux c_i)) s1
 	      in
-              Termops.subst_meta s2 lhs
+              subst_meta s2 lhs
             with PatternMatchingFailure -> auxl tail
             end
         |  [] ->
              begin match ivs.variable_lhs with
                | None ->
                    begin match ivs.constant_lhs with
-                     | Some c_lhs -> Termops.subst_meta [1, c] c_lhs
-                     | None -> anomaly (Pp.str "invalid inversion scheme for quote")
+                     | Some c_lhs -> subst_meta [1, c] c_lhs
+                     | None -> anomaly (Pp.str "invalid inversion scheme for quote.")
                    end
                | Some var_lhs ->
                    begin match ivs.constant_lhs with
-                     | Some c_lhs when closed_under ivs.constants c ->
-			 Termops.subst_meta [1, c] c_lhs
+                     | Some c_lhs when closed_under sigma ivs.constants c ->
+			 subst_meta [1, c] c_lhs
                      | _ ->
 			 begin
-                           try Constrhash.find varhash c
+                           try Constrhash.find varhash (EConstr.Unsafe.to_constr c)
                            with Not_found ->
                              let newvar =
-                               Termops.subst_meta [1, (path_of_int !counter)]
+                               subst_meta [1, (path_of_int !counter)]
 				 var_lhs in
                              begin
                                incr counter;
                                varlist := c :: !varlist;
-                               Constrhash.add varhash c newvar;
+                               Constrhash.add varhash (EConstr.Unsafe.to_constr c) newvar;
                                newvar
                              end
 			 end
@@ -446,36 +450,57 @@ let quote_terms ivs lc =
   term. Ring for example needs that, but Ring doesn't use Quote
   yet. *)
 
+let pf_constrs_of_globals l =
+  let rec aux l acc =
+    match l with
+      [] -> Proofview.tclUNIT (List.rev acc)
+    | hd :: tl ->
+       Tacticals.New.pf_constr_of_global hd >>= fun g -> aux tl (g :: acc)
+  in aux l []
+
 let quote f lid =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let f = Tacmach.New.pf_global f gl in
-    let cl = List.map (fun id -> Tacmach.New.pf_global id gl) lid in
-    let ivs = compute_ivs f cl gl in
-    let concl = Proofview.Goal.concl gl in
-    let quoted_terms = quote_terms ivs [concl] in
-    let (p, vm) = match quoted_terms with
+  Proofview.Goal.enter begin fun gl ->
+    let fg = Tacmach.New.pf_global f gl in
+    let clg = List.map (fun id -> Tacmach.New.pf_global id gl) lid in
+    Tacticals.New.pf_constr_of_global fg >>= fun f ->
+    pf_constrs_of_globals clg >>= fun cl ->
+    Proofview.Goal.nf_enter begin fun gl ->
+      let env = Proofview.Goal.env gl in
+      let sigma = Tacmach.New.project gl in
+      let ivs = compute_ivs f (List.map (EConstr.to_constr sigma) cl) gl in
+      let concl = Proofview.Goal.concl gl in
+      let quoted_terms = quote_terms env sigma ivs [concl] in
+      let (p, vm) = match quoted_terms with
       | [p], vm -> (p,vm)
       | _ -> assert false
-    in
-    match ivs.variable_lhs with
-    | None -> Tactics.convert_concl (mkApp (f, [| p |])) DEFAULTcast
-    | Some _ -> Tactics.convert_concl (mkApp (f, [| vm; p |])) DEFAULTcast
-  end }
+      in
+      match ivs.variable_lhs with
+      | None -> Tactics.convert_concl (mkApp (f, [| p |])) DEFAULTcast
+      | Some _ -> Tactics.convert_concl (mkApp (f, [| vm; p |])) DEFAULTcast
+    end
+  end
 
 let gen_quote cont c f lid =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let f = Tacmach.New.pf_global f gl in
-  let cl = List.map (fun id -> Tacmach.New.pf_global id gl) lid in
-  let ivs = compute_ivs f cl gl in
-  let quoted_terms = quote_terms ivs [c] in
-  let (p, vm) = match quoted_terms with
-    | [p], vm -> (p,vm)
-    | _ -> assert false
-  in
-  match ivs.variable_lhs with
-    | None -> cont (mkApp (f, [| p |]))
-    | Some _ -> cont (mkApp (f, [| vm; p |]))
-  end }
+  Proofview.Goal.enter begin fun gl ->
+    let fg = Tacmach.New.pf_global f gl in
+    let clg = List.map (fun id -> Tacmach.New.pf_global id gl) lid in
+    Tacticals.New.pf_constr_of_global fg >>= fun f ->
+    pf_constrs_of_globals clg >>= fun cl ->
+    Proofview.Goal.nf_enter begin fun gl ->
+      let env = Proofview.Goal.env gl in
+      let sigma = Tacmach.New.project gl in
+      let cl = List.map (EConstr.to_constr sigma) cl in
+      let ivs = compute_ivs f cl gl in
+      let quoted_terms = quote_terms env sigma ivs [c] in
+      let (p, vm) = match quoted_terms with
+        | [p], vm -> (p,vm)
+        | _ -> assert false
+      in
+      match ivs.variable_lhs with
+      | None -> cont (mkApp (f, [| p |]))
+      | Some _ -> cont (mkApp (f, [| vm; p |]))
+    end
+  end
 
 (*i
 
diff --git a/plugins/quote/vo.itarget b/plugins/quote/vo.itarget
deleted file mode 100644
index 7a44fc5a..00000000
--- a/plugins/quote/vo.itarget
+++ /dev/null
@@ -1 +0,0 @@
-Quote.vo
\ No newline at end of file
diff --git a/plugins/romega/ROmega.v b/plugins/romega/ROmega.v
index 3ddb6bed..657aae90 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/ReflOmegaCore.v b/plugins/romega/ReflOmegaCore.v
index 187601fc..51b99b99 100644
--- a/plugins/romega/ReflOmegaCore.v
+++ b/plugins/romega/ReflOmegaCore.v
@@ -10,18 +10,20 @@
 Require Import List Bool Sumbool EqNat Setoid Ring_theory Decidable ZArith_base.
 Delimit Scope Int_scope with I.
 
-(* Abstract Integers. *)
+(** * Abstract Integers. *)
 
 Module Type Int.
 
   Parameter t : Set.
 
-  Parameter zero : t.
-  Parameter one : t.
-  Parameter plus : t -> t -> t.
-  Parameter opp : t -> t.
-  Parameter minus : t -> t -> t.
-  Parameter mult : t -> t -> t.
+  Bind Scope Int_scope with t.
+
+  Parameter Inline zero : t.
+  Parameter Inline one : t.
+  Parameter Inline plus : t -> t -> t.
+  Parameter Inline opp : t -> t.
+  Parameter Inline minus : t -> t -> t.
+  Parameter Inline mult : t -> t -> t.
 
   Notation "0" := zero : Int_scope.
   Notation "1" := one : Int_scope.
@@ -32,15 +34,15 @@ Module Type Int.
 
   Open Scope Int_scope.
 
-  (* First, int is a ring: *)
+  (** First, Int is a ring: *)
   Axiom ring : @ring_theory t 0 1 plus mult minus opp (@eq t).
 
-  (* int should also be ordered: *)
+  (** Int should also be ordered: *)
 
-  Parameter le : t -> t -> Prop.
-  Parameter lt : t -> t -> Prop.
-  Parameter ge : t -> t -> Prop.
-  Parameter gt : t -> t -> Prop.
+  Parameter Inline le : t -> t -> Prop.
+  Parameter Inline lt : t -> t -> Prop.
+  Parameter Inline ge : t -> t -> Prop.
+  Parameter Inline gt : t -> t -> Prop.
   Notation "x <= y" := (le x y): Int_scope.
   Notation "x < y" := (lt x y) : Int_scope.
   Notation "x >= y" := (ge x y) : Int_scope.
@@ -49,35 +51,47 @@ Module Type Int.
   Axiom ge_le_iff : forall i j, (i>=j) <-> (j<=i).
   Axiom gt_lt_iff : forall i j, (i>j) <-> (j<i).
 
-  (* Basic properties of this order *)
+  (** Basic properties of this order *)
   Axiom lt_trans : forall i j k, i<j -> j<k -> i<k.
   Axiom lt_not_eq : forall i j, i<j -> i<>j.
 
-  (* Compatibilities *)
+  (** Compatibilities *)
   Axiom lt_0_1 : 0<1.
   Axiom plus_le_compat : forall i j k l, i<=j -> k<=l -> i+k<=j+l.
   Axiom opp_le_compat : forall i j, i<=j -> (-j)<=(-i).
   Axiom mult_lt_compat_l :
    forall i j k, 0 < k -> i < j -> k*i<k*j.
 
-  (* We should have a way to decide the equality and the order*)
+  (** We should have a way to decide the equality and the order*)
   Parameter compare : t -> t -> comparison.
   Infix "?=" := compare (at level 70, no associativity) : Int_scope.
   Axiom compare_Eq : forall i j, compare i j = Eq <-> i=j.
   Axiom compare_Lt : forall i j, compare i j = Lt <-> i<j.
   Axiom compare_Gt : forall i j, compare i j = Gt <-> i>j.
 
-  (* Up to here, these requirements could be fulfilled
+  (** Up to here, these requirements could be fulfilled
      by any totally ordered ring. Let's now be int-specific: *)
   Axiom le_lt_int : forall x y, x<y <-> x<=y+-(1).
 
-  (* Btw, lt_0_1 could be deduced from this last axiom *)
+  (** Btw, lt_0_1 could be deduced from this last axiom *)
+
+  (** Now we also require a division function.
+      It is deliberately underspecified, since that's enough
+      for the proofs below. But the most appropriate variant
+      (and the one needed to stay in sync with the omega engine)
+      is "Floor" (the historical version of Coq's [Z.div]). *)
+
+  Parameter diveucl : t -> t -> t * t.
+  Notation "i / j" := (fst (diveucl i j)).
+  Notation "i 'mod' j" := (snd (diveucl i j)).
+  Axiom diveucl_spec :
+    forall i j, j<>0 -> i = j * (i/j) + (i mod j).
 
 End Int.
 
 
 
-(* Of course, Z is a model for our abstract int *)
+(** Of course, Z is a model for our abstract int *)
 
 Module Z_as_Int <: Int.
 
@@ -131,21 +145,24 @@ Module Z_as_Int <: Int.
 
   Definition le_lt_int := Z.lt_le_pred.
 
-End Z_as_Int.
+  Definition diveucl := Z.div_eucl.
+  Definition diveucl_spec := Z.div_mod.
 
+End Z_as_Int.
 
 
+(** * Properties of abstract integers *)
 
 Module IntProperties (I:Int).
  Import I.
  Local Notation int := I.t.
 
- (* Primo, some consequences of being a ring theory... *)
+ (** Primo, some consequences of being a ring theory... *)
 
  Definition two := 1+1.
  Notation "2" := two : Int_scope.
 
- (* Aliases for properties packed in the ring record. *)
+ (** Aliases for properties packed in the ring record. *)
 
  Definition plus_assoc := ring.(Radd_assoc).
  Definition plus_comm := ring.(Radd_comm).
@@ -160,31 +177,22 @@ Module IntProperties (I:Int).
  Opaque plus_assoc plus_comm plus_0_l mult_assoc mult_comm mult_1_l
   mult_plus_distr_r opp_def minus_def.
 
- (* More facts about plus *)
+ (** More facts about [plus] *)
 
  Lemma plus_0_r : forall x, x+0 = x.
  Proof. intros; rewrite plus_comm; apply plus_0_l. Qed.
 
- Lemma plus_0_r_reverse : forall x, x = x+0.
- Proof. intros; symmetry; apply plus_0_r. Qed.
-
- Lemma plus_assoc_reverse : forall x y z, x+y+z = x+(y+z).
- Proof. intros; symmetry; apply plus_assoc. Qed.
-
  Lemma plus_permute : forall x y z, x+(y+z) = y+(x+z).
  Proof. intros; do 2 rewrite plus_assoc; f_equal; apply plus_comm. Qed.
 
  Lemma plus_reg_l : forall x y z, x+y = x+z -> y = z.
  Proof.
   intros.
-  rewrite (plus_0_r_reverse y), (plus_0_r_reverse z), <-(opp_def x).
+  rewrite <- (plus_0_r y), <- (plus_0_r z), <-(opp_def x).
   now rewrite plus_permute, plus_assoc, H, <- plus_assoc, plus_permute.
  Qed.
 
- (* More facts about mult *)
-
- Lemma mult_assoc_reverse : forall x y z, x*y*z = x*(y*z).
- Proof. intros; symmetry; apply mult_assoc. Qed.
+ (** More facts about [mult] *)
 
  Lemma mult_plus_distr_l : forall x y z, x*(y+z)=x*y+x*z.
  Proof.
@@ -193,18 +201,25 @@ Module IntProperties (I:Int).
   apply mult_plus_distr_r.
  Qed.
 
- Lemma mult_0_l : forall x, 0*x = 0.
+ Lemma mult_0_l x : 0*x = 0.
  Proof.
-  intros.
-  generalize (mult_plus_distr_r 0 1 x).
-  rewrite plus_0_l, mult_1_l, plus_comm; intros.
+  assert (H := mult_plus_distr_r 0 1 x).
+  rewrite plus_0_l, mult_1_l, plus_comm in H.
   apply plus_reg_l with x.
-  rewrite <- H.
-  apply plus_0_r_reverse.
+  now rewrite <- H, plus_0_r.
+ Qed.
+
+ Lemma mult_0_r x : x*0 = 0.
+ Proof.
+   rewrite mult_comm. apply mult_0_l.
  Qed.
 
+ Lemma mult_1_r x : x*1 = x.
+ Proof.
+   rewrite mult_comm. apply mult_1_l.
+ Qed.
 
- (* More facts about opp *)
+ (** More facts about [opp] *)
 
  Definition plus_opp_r := opp_def.
 
@@ -249,104 +264,47 @@ Module IntProperties (I:Int).
   now rewrite opp_def, <-mult_plus_distr_r, opp_def, mult_0_l.
  Qed.
 
- Lemma egal_left : forall n m, n=m -> n+-m = 0.
- Proof. intros; subst; apply opp_def. Qed.
-
- Lemma ne_left_2 : forall x y : int, x<>y -> 0<>(x + - y).
- Proof.
- intros; contradict H.
- apply (plus_reg_l (-y)).
- now rewrite plus_opp_l, plus_comm, H.
- Qed.
-
- (* Special lemmas for factorisation. *)
-
- Lemma red_factor0 : forall n, n = n*1.
- Proof. symmetry; rewrite mult_comm; apply mult_1_l. Qed.
-
- Lemma red_factor1 : forall n, n+n = n*2.
- Proof.
-  intros; unfold two.
-  now rewrite mult_comm, mult_plus_distr_r, mult_1_l.
- Qed.
-
- Lemma red_factor2 : forall n m, n + n*m = n * (1+m).
- Proof.
-  intros; rewrite mult_plus_distr_l.
-  f_equal; now rewrite mult_comm, mult_1_l.
- Qed.
-
- Lemma red_factor3 : forall n m, n*m + n = n*(1+m).
- Proof. intros; now rewrite plus_comm, red_factor2. Qed.
-
- Lemma red_factor4 : forall n m p, n*m + n*p = n*(m+p).
+ Lemma egal_left n m : 0 = n+-m <-> n = m.
  Proof.
-  intros; now rewrite mult_plus_distr_l.
+  split; intros.
+  - apply plus_reg_l with (-m).
+    rewrite plus_comm, <- H. symmetry. apply plus_opp_l.
+  - symmetry. subst; apply opp_def.
  Qed.
 
- Lemma red_factor5 : forall n m , n * 0 + m = m.
- Proof. intros; now rewrite mult_comm, mult_0_l, plus_0_l. Qed.
-
- Definition red_factor6 := plus_0_r_reverse.
-
-
- (* Specialized distributivities *)
+ (** Specialized distributivities *)
 
  Hint Rewrite mult_plus_distr_l mult_plus_distr_r mult_assoc : int.
  Hint Rewrite <- plus_assoc : int.
 
- Lemma OMEGA10 :
-  forall v c1 c2 l1 l2 k1 k2 : int,
-  (v * c1 + l1) * k1 + (v * c2 + l2) * k2 =
-  v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2).
- Proof.
-  intros; autorewrite with int; f_equal; now rewrite plus_permute.
- Qed.
-
- Lemma OMEGA11 :
-  forall v1 c1 l1 l2 k1 : int,
-  (v1 * c1 + l1) * k1 + l2 = v1 * (c1 * k1) + (l1 * k1 + l2).
- Proof.
-  intros; now autorewrite with int.
- Qed.
+ Hint Rewrite plus_0_l plus_0_r mult_0_l mult_0_r mult_1_l mult_1_r : int.
 
- Lemma OMEGA12 :
-  forall v2 c2 l1 l2 k2 : int,
-  l1 + (v2 * c2 + l2) * k2 = v2 * (c2 * k2) + (l1 + l2 * k2).
+ Lemma OMEGA10 v c1 c2 l1 l2 k1 k2 :
+  v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2) =
+  (v * c1 + l1) * k1 + (v * c2 + l2) * k2.
  Proof.
-  intros; autorewrite with int; now rewrite plus_permute.
+  autorewrite with int; f_equal; now rewrite plus_permute.
  Qed.
 
- Lemma OMEGA13 :
-  forall v l1 l2 x : int,
-  v * -x + l1 + (v * x + l2) = l1 + l2.
+ Lemma OMEGA11 v1 c1 l1 l2 k1 :
+  v1 * (c1 * k1) + (l1 * k1 + l2) = (v1 * c1 + l1) * k1 + l2.
  Proof.
- intros; autorewrite with int.
- rewrite plus_permute; f_equal.
- rewrite plus_assoc.
- now rewrite <- mult_plus_distr_l, plus_opp_l, mult_comm, mult_0_l, plus_0_l.
+  now autorewrite with int.
  Qed.
 
- Lemma OMEGA15 :
-  forall v c1 c2 l1 l2 k2 : int,
-  v * c1 + l1 + (v * c2 + l2) * k2 = v * (c1 + c2 * k2) + (l1 + l2 * k2).
+ Lemma OMEGA12 v2 c2 l1 l2 k2 :
+   v2 * (c2 * k2) + (l1 + l2 * k2) = l1 + (v2 * c2 + l2) * k2.
  Proof.
-  intros; autorewrite with int; f_equal; now rewrite plus_permute.
+  autorewrite with int; now rewrite plus_permute.
  Qed.
 
- Lemma OMEGA16 : forall v c l k : int, (v * c + l) * k = v * (c * k) + l * k.
+ Lemma sum1 a b c d : 0 = a -> 0 = b -> 0 = a * c + b * d.
  Proof.
-  intros; now autorewrite with int.
- Qed.
-
- Lemma sum1 : forall a b c d : int, 0 = a -> 0 = b -> 0 = a * c + b * d.
- Proof.
- intros; elim H; elim H0; simpl; auto.
- now rewrite mult_0_l, mult_0_l, plus_0_l.
+ intros; subst. now autorewrite with int.
  Qed.
 
 
- (* Secondo, some results about order (and equality) *)
+ (** Secondo, some results about order (and equality) *)
 
  Lemma lt_irrefl : forall n, ~ n<n.
  Proof.
@@ -413,86 +371,74 @@ Module IntProperties (I:Int).
 
  Definition beq i j := match compare i j with Eq => true | _ => false end.
 
- Lemma beq_iff : forall i j, beq i j = true <-> i=j.
- Proof.
- intros; unfold beq; generalize (compare_Eq i j).
- destruct compare; intuition discriminate.
- Qed.
+ Infix "=?" := beq : Int_scope.
 
- Lemma beq_true : forall i j, beq i j = true -> i=j.
+ Lemma beq_iff i j : (i =? j) = true <-> i=j.
  Proof.
- intros.
- rewrite <- beq_iff; auto.
+ unfold beq. rewrite <- (compare_Eq i j). now destruct compare.
  Qed.
 
- Lemma beq_false : forall i j, beq i j = false -> i<>j.
+ Lemma beq_reflect i j : reflect (i=j) (i =? j).
  Proof.
- intros.
- intro H'.
- rewrite <- beq_iff in H'; rewrite H' in H; discriminate.
+ apply iff_reflect. symmetry. apply beq_iff.
  Qed.
 
  Lemma eq_dec : forall n m:int, { n=m } + { n<>m }.
  Proof.
-  intros; generalize (beq_iff n m); destruct beq; [left|right]; intuition.
+  intros n m; generalize (beq_iff n m); destruct beq; [left|right]; intuition.
  Qed.
 
- Definition bgt i j := match compare i j with Gt => true | _ => false end.
+ Definition blt i j := match compare i j with Lt => true | _ => false end.
+
+ Infix "<?" := blt : Int_scope.
 
- Lemma bgt_iff : forall i j, bgt i j = true <-> i>j.
+ Lemma blt_iff i j : (i <? j) = true <-> i<j.
  Proof.
- intros; unfold bgt; generalize (compare_Gt i j).
- destruct compare; intuition discriminate.
+ unfold blt. rewrite <- (compare_Lt i j). now destruct compare.
  Qed.
 
- Lemma bgt_true : forall i j, bgt i j = true -> i>j.
- Proof. intros; now rewrite <- bgt_iff. Qed.
-
- Lemma bgt_false : forall i j, bgt i j = false -> i<=j.
+ Lemma blt_reflect i j : reflect (i<j) (i <? j).
  Proof.
-  intros.
-  rewrite le_lt_iff, <-gt_lt_iff, <-bgt_iff; intro H'; now rewrite H' in H.
+ apply iff_reflect. symmetry. apply blt_iff.
  Qed.
 
  Lemma le_is_lt_or_eq : forall n m, n<=m -> { n<m } + { n=m }.
  Proof.
-  intros.
+  intros n m Hnm.
   destruct (eq_dec n m) as [H'|H'].
-  right; intuition.
-  left; rewrite lt_le_iff.
-  contradict H'.
-  apply le_antisym; auto.
+  - right; intuition.
+  - left; rewrite lt_le_iff.
+    contradict H'.
+    now apply le_antisym.
  Qed.
 
  Lemma le_neq_lt : forall n m, n<=m -> n<>m -> n<m.
  Proof.
-  intros.
-  destruct (le_is_lt_or_eq _ _ H); intuition.
+  intros n m H. now destruct (le_is_lt_or_eq _ _ H).
  Qed.
 
  Lemma le_trans : forall n m p, n<=m -> m<=p -> n<=p.
  Proof.
-  intros n m p; do 3 rewrite le_lt_iff; intros A B C.
+  intros n m p; rewrite 3 le_lt_iff; intros A B C.
   destruct (lt_eq_lt_dec p m) as [[H|H]|H]; subst; auto.
   generalize (lt_trans _ _ _ H C); intuition.
  Qed.
 
- (* order and operations *)
-
- Lemma le_0_neg : forall n, 0 <= n <-> -n <= 0.
+ Lemma not_eq (a b:int) : ~ a <> b <-> a = b.
  Proof.
- intros.
- pattern 0 at 2; rewrite <- (mult_0_l (-(1))).
- rewrite <- opp_eq_mult_neg_1.
- split; intros.
- apply opp_le_compat; auto.
- rewrite <-(opp_involutive 0), <-(opp_involutive n).
- apply opp_le_compat; auto.
+  destruct (eq_dec a b); intuition.
  Qed.
 
- Lemma le_0_neg' : forall n, n <= 0 <-> 0 <= -n.
+ (** Order and operations *)
+
+ Lemma le_0_neg n : n <= 0 <-> 0 <= -n.
  Proof.
- intros; rewrite le_0_neg, opp_involutive; intuition.
+ rewrite <- (mult_0_l (-(1))) at 2.
+ rewrite <- opp_eq_mult_neg_1.
+ split; intros.
+ - now apply opp_le_compat.
+ - rewrite <-(opp_involutive 0), <-(opp_involutive n).
+   now apply opp_le_compat.
  Qed.
 
  Lemma plus_le_reg_r : forall n m p, n + p <= m + p -> n <= m.
@@ -534,20 +480,14 @@ Module IntProperties (I:Int).
  apply opp_le_compat; auto.
  Qed.
 
- Lemma lt_0_neg : forall n, 0 < n <-> -n < 0.
+ Lemma lt_0_neg n : n < 0 <-> 0 < -n.
  Proof.
- intros.
- pattern 0 at 2; rewrite <- (mult_0_l (-(1))).
+ rewrite <- (mult_0_l (-(1))) at 2.
  rewrite <- opp_eq_mult_neg_1.
  split; intros.
- apply opp_lt_compat; auto.
- rewrite <-(opp_involutive 0), <-(opp_involutive n).
- apply opp_lt_compat; auto.
- Qed.
-
- Lemma lt_0_neg' : forall n, n < 0 <-> 0 < -n.
- Proof.
- intros; rewrite lt_0_neg, opp_involutive; intuition.
+ - now apply opp_lt_compat.
+ - rewrite <-(opp_involutive 0), <-(opp_involutive n).
+   now apply opp_lt_compat.
  Qed.
 
  Lemma mult_lt_0_compat : forall n m, 0 < n -> 0 < m -> 0 < n*m.
@@ -557,111 +497,70 @@ Module IntProperties (I:Int).
  apply mult_lt_compat_l; auto.
  Qed.
 
- Lemma mult_integral : forall n m, n * m = 0 -> n = 0 \/ m = 0.
+ Lemma mult_integral_r n m : 0 < n -> n * m = 0 -> m = 0.
  Proof.
- intros.
- destruct (lt_eq_lt_dec n 0) as [[Hn|Hn]|Hn]; auto;
-  destruct (lt_eq_lt_dec m 0) as [[Hm|Hm]|Hm]; auto; exfalso.
-
- rewrite lt_0_neg' in Hn.
- rewrite lt_0_neg' in Hm.
- generalize (mult_lt_0_compat _ _ Hn Hm).
- rewrite <- opp_mult_distr_r, mult_comm, <- opp_mult_distr_r, opp_involutive.
- rewrite mult_comm, H.
- exact (lt_irrefl 0).
-
- rewrite lt_0_neg' in Hn.
- generalize (mult_lt_0_compat _ _ Hn Hm).
- rewrite mult_comm, <- opp_mult_distr_r, mult_comm.
- rewrite H.
- rewrite opp_eq_mult_neg_1, mult_0_l.
- exact (lt_irrefl 0).
-
- rewrite lt_0_neg' in Hm.
- generalize (mult_lt_0_compat _ _ Hn Hm).
- rewrite <- opp_mult_distr_r.
- rewrite H.
- rewrite opp_eq_mult_neg_1, mult_0_l.
- exact (lt_irrefl 0).
-
- generalize (mult_lt_0_compat _ _ Hn Hm).
- rewrite H.
- exact (lt_irrefl 0).
+ intros Hn H.
+ destruct (lt_eq_lt_dec 0 m) as [[Hm| <- ]|Hm]; auto; exfalso.
+ - generalize (mult_lt_0_compat _ _ Hn Hm).
+   rewrite H.
+   exact (lt_irrefl 0).
+ - rewrite lt_0_neg in Hm.
+   generalize (mult_lt_0_compat _ _ Hn Hm).
+   rewrite <- opp_mult_distr_r, opp_eq_mult_neg_1, H, mult_0_l.
+   exact (lt_irrefl 0).
  Qed.
 
- Lemma mult_le_compat :
-   forall i j k l, i<=j -> k<=l -> 0<=i -> 0<=k -> i*k<=j*l.
+ Lemma mult_integral n m : n * m = 0 -> n = 0 \/ m = 0.
  Proof.
- intros.
- destruct (le_is_lt_or_eq _ _ H1).
-
- apply le_trans with (i*l).
- destruct (le_is_lt_or_eq _ _ H0); [ | subst; apply le_refl].
- apply lt_le_weak.
- apply mult_lt_compat_l; auto.
-
- generalize (le_trans _ _ _ H2 H0); clear H0 H1 H2; intros.
- rewrite (mult_comm i), (mult_comm j).
- destruct (le_is_lt_or_eq _ _ H0);
-  [ | subst; do 2 rewrite mult_0_l; apply le_refl].
- destruct (le_is_lt_or_eq _ _ H);
-  [ | subst; apply le_refl].
- apply lt_le_weak.
- apply mult_lt_compat_l; auto.
-
- subst i.
- rewrite mult_0_l.
- generalize (le_trans _ _ _ H2 H0); clear H0 H1 H2; intros.
- destruct (le_is_lt_or_eq _ _ H);
-  [ | subst; rewrite mult_0_l; apply le_refl].
- destruct (le_is_lt_or_eq _ _ H0);
-  [ | subst; rewrite mult_comm, mult_0_l; apply le_refl].
- apply lt_le_weak.
- apply mult_lt_0_compat; auto.
+ intros H.
+ destruct (lt_eq_lt_dec 0 n) as [[Hn|Hn]|Hn].
+ - right; apply (mult_integral_r n m); trivial.
+ - now left.
+ - right; apply (mult_integral_r (-n) m).
+   + now apply lt_0_neg.
+   + rewrite mult_comm, <- opp_mult_distr_r, mult_comm, H.
+     now rewrite opp_eq_mult_neg_1, mult_0_l.
  Qed.
 
- Lemma sum5 :
- forall a b c d : int, c <> 0 -> 0 <> a -> 0 = b -> 0 <> a * c + b * d.
+ Lemma mult_le_compat_l i j k :
+   0<=k -> i<=j -> k*i <= k*j.
  Proof.
- intros.
- subst b; rewrite mult_0_l, plus_0_r.
- contradict H.
- symmetry in H; destruct (mult_integral _ _ H); congruence.
+ intros Hk Hij.
+ apply le_is_lt_or_eq in Hk. apply le_is_lt_or_eq in Hij.
+ destruct Hk as [Hk | <-], Hij as [Hij | <-];
+  rewrite ? mult_0_l; try apply le_refl.
+ now apply lt_le_weak, mult_lt_compat_l.
  Qed.
 
- Lemma one_neq_zero : 1 <> 0.
+ Lemma mult_le_compat i j k l :
+   i<=j -> k<=l -> 0<=i -> 0<=k -> i*k<=j*l.
  Proof.
- red; intro.
- symmetry in H.
- apply (lt_not_eq 0 1); auto.
- apply lt_0_1.
+ intros Hij Hkl Hi Hk.
+ apply le_trans with (i*l).
+ - now apply mult_le_compat_l.
+ - rewrite (mult_comm i), (mult_comm j).
+   apply mult_le_compat_l; trivial.
+   now apply le_trans with k.
  Qed.
 
- Lemma minus_one_neq_zero : -(1) <> 0.
+ Lemma sum5 a b c d : 0 <> c -> 0 <> a -> 0 = b -> 0 <> a * c + b * d.
  Proof.
- apply lt_not_eq.
- rewrite <- lt_0_neg.
- apply lt_0_1.
+ intros Hc Ha <-. autorewrite with int. contradict Hc.
+ symmetry in Hc. destruct (mult_integral _ _ Hc); congruence.
  Qed.
 
- Lemma le_left : forall n m, n <= m -> 0 <= m + - n.
+ Lemma le_left n m : n <= m <-> 0 <= m + - n.
  Proof.
-  intros.
-  rewrite <- (opp_def m).
-  apply plus_le_compat.
-  apply le_refl.
-  apply opp_le_compat; auto.
+  split; intros.
+  - rewrite <- (opp_def m).
+    apply plus_le_compat.
+    apply le_refl.
+    apply opp_le_compat; auto.
+  - apply plus_le_reg_r with (-n).
+    now rewrite plus_opp_r.
  Qed.
 
- Lemma OMEGA2 : forall x y, 0 <= x -> 0 <= y -> 0 <= x + y.
- Proof.
- intros.
- replace 0 with (0+0).
- apply plus_le_compat; auto.
- rewrite plus_0_l; auto.
- Qed.
-
- Lemma OMEGA8 : forall x y, 0 <= x -> 0 <= y -> x = - y -> x = 0.
+ Lemma OMEGA8 x y : 0 <= x -> 0 <= y -> x = - y -> x = 0.
  Proof.
  intros.
  assert (y=-x).
@@ -675,17 +574,15 @@ Module IntProperties (I:Int).
  elim (lt_not_eq _ _ H1); auto.
  Qed.
 
- Lemma sum2 :
- forall a b c d : int, 0 <= d -> 0 = a -> 0 <= b -> 0 <= a * c + b * d.
+ Lemma sum2 a b c d :
+   0 <= d -> 0 = a -> 0 <= b -> 0 <= a * c + b * d.
  Proof.
- intros.
- subst a; rewrite mult_0_l, plus_0_l.
+ intros Hd <- Hb. autorewrite with int.
  rewrite <- (mult_0_l 0).
  apply mult_le_compat; auto; apply le_refl.
  Qed.
 
- Lemma sum3 :
- forall a b c d : int,
+ Lemma sum3 a b c d :
   0 <= c -> 0 <= d -> 0 <= a -> 0 <= b -> 0 <= a * c + b * d.
  Proof.
  intros.
@@ -697,56 +594,39 @@ Module IntProperties (I:Int).
  apply mult_le_compat; auto; apply le_refl.
  Qed.
 
- Lemma sum4 : forall k : int, k>0 -> 0 <= k.
- Proof.
- intros k; rewrite gt_lt_iff; apply lt_le_weak.
- Qed.
-
- (* Lemmas specific to integers (they use lt_le_int) *)
-
- Lemma lt_left : forall n m, n < m -> 0 <= m + -(1) + - n.
- Proof.
- intros; apply le_left.
- now rewrite <- le_lt_int.
- Qed.
+ (** Lemmas specific to integers (they use [le_lt_int]) *)
 
- Lemma lt_left_inv : forall x y, 0 <= y + -(1) + - x -> x < y.
+ Lemma lt_left n m : n < m <-> 0 <= m + -n + -(1).
  Proof.
- intros.
- generalize (plus_le_compat _ _ _ _ H (le_refl x)); clear H.
- now rewrite plus_0_l, <-plus_assoc, plus_opp_l, plus_0_r, le_lt_int.
+ rewrite <- plus_assoc, (plus_comm (-n)), plus_assoc.
+ rewrite <- le_left.
+ apply le_lt_int.
  Qed.
 
- Lemma OMEGA4 : forall x y z, x > 0 -> y > x -> z * y + x <> 0.
+ Lemma OMEGA4 x y z : 0 < x -> x < y -> z * y + x <> 0.
  Proof.
- intros.
- intro H'.
- rewrite gt_lt_iff in H,H0.
+ intros H H0 H'.
+ assert (0 < y) by now apply lt_trans with x.
  destruct (lt_eq_lt_dec z 0) as [[G|G]|G].
 
- rewrite lt_0_neg' in G.
- generalize (plus_le_lt_compat _ _ _ _ (le_refl (z*y)) H0).
- rewrite H'.
- pattern y at 2; rewrite <-(mult_1_l y), <-mult_plus_distr_r.
- intros.
- rewrite le_lt_int in G.
- rewrite <- opp_plus_distr in G.
- assert (0 < y) by (apply lt_trans with x; auto).
- generalize (mult_le_compat _ _ _ _ G (lt_le_weak _ _ H2) (le_refl 0) (le_refl 0)).
- rewrite mult_0_l, mult_comm, <- opp_mult_distr_r, mult_comm, <-le_0_neg', le_lt_iff.
- intuition.
+ - generalize (plus_le_lt_compat _ _ _ _ (le_refl (z*y)) H0).
+   rewrite H'.
+   rewrite <-(mult_1_l y) at 2. rewrite <-mult_plus_distr_r.
+   apply le_lt_iff.
+   rewrite mult_comm. rewrite <- (mult_0_r y).
+   apply mult_le_compat_l; auto using lt_le_weak.
+   apply le_0_neg. rewrite opp_plus_distr.
+   apply le_lt_int. now apply lt_0_neg.
 
- subst; rewrite mult_0_l, plus_0_l in H'; subst.
- apply (lt_not_eq _ _ H); auto.
+ - apply (lt_not_eq 0 (z*y+x)); auto.
+   subst. now autorewrite with int.
 
- apply (lt_not_eq 0 (z*y+x)); auto.
- rewrite <- (plus_0_l 0).
- apply plus_lt_compat; auto.
- apply mult_lt_0_compat; auto.
- apply lt_trans with x; auto.
+ - apply (lt_not_eq 0 (z*y+x)); auto.
+   rewrite <- (plus_0_l 0).
+   auto using plus_lt_compat, mult_lt_0_compat.
  Qed.
 
- Lemma OMEGA19 : forall x, x<>0 -> 0 <= x + -(1) \/ 0 <= x * -(1) + -(1).
+ Lemma OMEGA19 x : x<>0 -> 0 <= x + -(1) \/ 0 <= x * -(1) + -(1).
  Proof.
  intros.
  do 2 rewrite <- le_lt_int.
@@ -759,35 +639,22 @@ Module IntProperties (I:Int).
  apply opp_lt_compat; auto.
  Qed.
 
- Lemma mult_le_approx :
-  forall n m p, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m.
+ Lemma mult_le_approx n m p :
+  0 < n -> p < n -> 0 <= m * n + p -> 0 <= m.
  Proof.
- intros n m p.
- do 2 rewrite gt_lt_iff.
- do 2 rewrite le_lt_iff; intros.
- contradict H1.
- rewrite lt_0_neg' in H1.
- rewrite lt_0_neg'.
- rewrite opp_plus_distr.
- rewrite mult_comm, opp_mult_distr_r.
+ do 2 rewrite le_lt_iff; intros Hn Hpn H Hm. destruct H.
+ apply lt_0_neg, le_lt_int, le_left in Hm.
+ rewrite lt_0_neg.
+ rewrite opp_plus_distr, mult_comm, opp_mult_distr_r.
+ rewrite le_lt_int. apply lt_left.
  rewrite le_lt_int.
- rewrite <- plus_assoc, (plus_comm (-p)), plus_assoc.
- apply lt_left.
- rewrite le_lt_int.
- rewrite le_lt_int in H0.
- apply le_trans with (n+-(1)); auto.
+ apply le_trans with (n+-(1)); [ now apply le_lt_int | ].
  apply plus_le_compat; [ | apply le_refl ].
- rewrite le_lt_int in H1.
- generalize (mult_le_compat _ _ _ _ (lt_le_weak _ _ H) H1 (le_refl 0) (le_refl 0)).
- rewrite mult_0_l.
- rewrite mult_plus_distr_l.
- rewrite <- opp_eq_mult_neg_1.
- intros.
- generalize (plus_le_compat _ _ _ _ (le_refl n) H2).
- now rewrite plus_permute, opp_def, plus_0_r, plus_0_r.
+ rewrite <- (mult_1_r n) at 1.
+ apply mult_le_compat_l; auto using lt_le_weak.
  Qed.
 
- (* Some decidabilities *)
+ (** Some decidabilities *)
 
  Lemma dec_eq : forall i j:int, decidable (i=j).
  Proof.
@@ -822,7 +689,7 @@ Module IntProperties (I:Int).
 End IntProperties.
 
 
-
+(** * The Coq side of the romega tactic *)
 
 Module IntOmega (I:Int).
 Import I.
@@ -830,13 +697,16 @@ Module IP:=IntProperties(I).
 Import IP.
 Local Notation int := I.t.
 
-(* \subsubsection{Definition of reified integer expressions}
+(* ** Definition of reified integer expressions
+
    Terms are either:
-   \begin{itemize}
-   \item integers [Tint]
-   \item variables [Tvar]
-   \item operation over integers (addition, product, opposite, subtraction)
-   The last two are translated in additions and products. *)
+   - integers [Tint]
+   - variables [Tvar]
+   - operation over integers (addition, product, opposite, subtraction)
+
+   Opposite and subtraction are translated in additions and products.
+   Note that we'll only deal with products for which at least one side
+   is [Tint]. *)
 
 Inductive term : Set :=
   | Tint : int -> term
@@ -844,8 +714,9 @@ Inductive term : Set :=
   | Tmult : term -> term -> term
   | Tminus : term -> term -> term
   | Topp : term -> term
-  | Tvar : nat -> term.
+  | Tvar : N -> term.
 
+Bind Scope romega_scope with term.
 Delimit Scope romega_scope with term.
 Arguments Tint _%I.
 Arguments Tplus (_ _)%term.
@@ -859,400 +730,212 @@ Infix "-" := Tminus : romega_scope.
 Notation "- x" := (Topp x) : romega_scope.
 Notation "[ x ]" := (Tvar x) (at level 0) : romega_scope.
 
-(* \subsubsection{Definition of reified goals} *)
+(* ** Definition of reified goals
 
-(* Very restricted definition of handled predicates that should be extended
+   Very restricted definition of handled predicates that should be extended
    to cover a wider set of operations.
    Taking care of negations and disequations require solving more than a
    goal in parallel. This is a major improvement over previous versions. *)
 
 Inductive proposition : Set :=
-  | EqTerm : term -> term -> proposition (* equality between terms *)
-  | LeqTerm : term -> term -> proposition (* less or equal on terms *)
-  | TrueTerm : proposition (* true *)
-  | FalseTerm : proposition (* false *)
-  | Tnot : proposition -> proposition (* negation *)
+  (** First, basic equations, disequations, inequations *)
+  | EqTerm : term -> term -> proposition
+  | NeqTerm : term -> term -> proposition
+  | LeqTerm : term -> term -> proposition
   | GeqTerm : term -> term -> proposition
   | GtTerm : term -> term -> proposition
   | LtTerm : term -> term -> proposition
-  | NeqTerm : term -> term -> proposition
+  (** Then, the supported logical connectors *)
+  | TrueTerm : proposition
+  | FalseTerm : proposition
+  | Tnot : proposition -> proposition
   | Tor : proposition -> proposition -> proposition
   | Tand : proposition -> proposition -> proposition
   | Timp : proposition -> proposition -> proposition
+  (** Everything else is left as a propositional atom (and ignored). *)
   | Tprop : nat -> proposition.
 
-(* Definition of goals as a list of hypothesis *)
+(** Definition of goals as a list of hypothesis *)
 Notation hyps := (list proposition).
 
-(* Definition of lists of subgoals  (set of open goals) *)
+(** Definition of lists of subgoals (set of open goals) *)
 Notation lhyps := (list hyps).
 
-(* a single goal packed in a subgoal list *)
+(** A single goal packed in a subgoal list *)
 Notation singleton := (fun a : hyps => a :: nil).
 
-(* an absurd goal *)
+(** An absurd goal *)
 Definition absurd := FalseTerm :: nil.
 
-(* \subsubsection{Traces for merging equations}
-   This inductive type describes how the monomial of two equations should be
-   merged when the equations are added.
-
-   For [F_equal], both equations have the same head variable and coefficient
-   must be added, furthermore if coefficients are opposite, [F_cancel] should
-   be used to collapse the term. [F_left] and [F_right] indicate which monomial
-   should be put first in the result *)
-
-Inductive t_fusion : Set :=
-  | F_equal : t_fusion
-  | F_cancel : t_fusion
-  | F_left : t_fusion
-  | F_right : t_fusion.
-
-(* \subsubsection{Rewriting steps to normalize terms} *)
-Inductive step : Set :=
-  (* apply the rewriting steps to both subterms of an operation *)
-  | C_DO_BOTH : step -> step -> step
-  (* apply the rewriting step to the first branch *)
-  | C_LEFT : step -> step
-  (* apply the rewriting step to the second branch *)
-  | C_RIGHT : step -> step
-  (* apply two steps consecutively to a term *)
-  | C_SEQ : step -> step -> step
-  (* empty step *)
-  | C_NOP : step
-  (* the following operations correspond to actual rewriting *)
-  | C_OPP_PLUS : step
-  | C_OPP_OPP : step
-  | C_OPP_MULT_R : step
-  | C_OPP_ONE : step
-  (* This is a special step that reduces the term (computation) *)
-  | C_REDUCE : step
-  | C_MULT_PLUS_DISTR : step
-  | C_MULT_OPP_LEFT : step
-  | C_MULT_ASSOC_R : step
-  | C_PLUS_ASSOC_R : step
-  | C_PLUS_ASSOC_L : step
-  | C_PLUS_PERMUTE : step
-  | C_PLUS_COMM : step
-  | C_RED0 : step
-  | C_RED1 : step
-  | C_RED2 : step
-  | C_RED3 : step
-  | C_RED4 : step
-  | C_RED5 : step
-  | C_RED6 : step
-  | C_MULT_ASSOC_REDUCED : step
-  | C_MINUS : step
-  | C_MULT_COMM : step.
-
-(* \subsubsection{Omega steps} *)
-(* The following inductive type describes steps as they can be found in
-   the trace coming from the decision procedure Omega. *)
-
-Inductive t_omega : Set :=
-  (* n = 0 and n!= 0 *)
-  | O_CONSTANT_NOT_NUL : nat -> t_omega
-  | O_CONSTANT_NEG : nat -> t_omega
-  (* division and approximation of an equation *)
-  | O_DIV_APPROX : int -> int -> term -> nat -> t_omega -> nat -> t_omega
-  (* no solution because no exact division *)
-  | O_NOT_EXACT_DIVIDE : int -> int -> term -> nat -> nat -> t_omega
-  (* exact division *)
-  | O_EXACT_DIVIDE : int -> term -> nat -> t_omega -> nat -> t_omega
-  | O_SUM : int -> nat -> int -> nat -> list t_fusion -> t_omega -> t_omega
-  | O_CONTRADICTION : nat -> nat -> nat -> t_omega
-  | O_MERGE_EQ : nat -> nat -> nat -> t_omega -> t_omega
-  | O_SPLIT_INEQ : nat -> nat -> t_omega -> t_omega -> t_omega
-  | O_CONSTANT_NUL : nat -> t_omega
-  | O_NEGATE_CONTRADICT : nat -> nat -> t_omega
-  | O_NEGATE_CONTRADICT_INV : nat -> nat -> nat -> t_omega
-  | O_STATE : int -> step -> nat -> nat -> t_omega -> t_omega.
-
-(* \subsubsection{Rules for normalizing the hypothesis} *)
-(* These rules indicate how to normalize useful propositions
-   of each useful hypothesis before the decomposition of hypothesis.
-   The rules include the inversion phase for negation removal. *)
-
-Inductive p_step : Set :=
-  | P_LEFT : p_step -> p_step
-  | P_RIGHT : p_step -> p_step
-  | P_INVERT : step -> p_step
-  | P_STEP : step -> p_step
-  | P_NOP : p_step.
-
-(* List of normalizations to perform : if the type [p_step] had a constructor
-   that indicated visiting both left and right branches, we would be able to
-   restrict ourselves to the case of only one normalization by hypothesis.
-   And since all hypothesis are useful (otherwise they wouldn't be included),
-   we would be able to replace [h_step] by a simple list. *)
-
-Inductive h_step : Set :=
-    pair_step : nat -> p_step -> h_step.
-
-(* \subsubsection{Rules for decomposing the hypothesis} *)
-(* This type allows navigation in the logical constructors that
-   form the predicats of the hypothesis in order to decompose them.
-   This allows in particular to extract one hypothesis from a
-   conjunction with possibly the right level of negations. *)
-
-Inductive direction : Set :=
-  | D_left : direction
-  | D_right : direction
-  | D_mono : direction.
-
-(* This type allows extracting useful components from hypothesis, either
-   hypothesis generated by splitting a disjonction, or equations.
-   The last constructor indicates how to solve the obtained system
-   via the use of the trace type of Omega [t_omega] *)
-
-Inductive e_step : Set :=
-  | E_SPLIT : nat -> list direction -> e_step -> e_step -> e_step
-  | E_EXTRACT : nat -> list direction -> e_step -> e_step
-  | E_SOLVE : t_omega -> e_step.
-
-(* \subsection{Efficient decidable equality} *)
-(* For each reified data-type, we define an efficient equality test.
-   It is not the one produced by [Decide Equality].
-
-   Then we prove two theorem allowing elimination of such equalities :
-   \begin{verbatim}
-   (t1,t2: typ) (eq_typ t1 t2) = true -> t1 = t2.
-   (t1,t2: typ) (eq_typ t1 t2) = false -> ~ t1 = t2.
-   \end{verbatim} *)
-
-(* \subsubsection{Reified terms} *)
-
-Open Scope romega_scope.
+(** ** Decidable equality on terms *)
 
 Fixpoint eq_term (t1 t2 : term) {struct t2} : bool :=
   match t1, t2 with
-  | Tint st1, Tint st2 => beq st1 st2
-  | (st11 + st12), (st21 + st22) => eq_term st11 st21 && eq_term st12 st22
-  | (st11 * st12), (st21 * st22) => eq_term st11 st21 && eq_term st12 st22
-  | (st11 - st12), (st21 - st22) => eq_term st11 st21 && eq_term st12 st22
-  | (- st1), (- st2) => eq_term st1 st2
-  | [st1], [st2] => beq_nat st1 st2
+  | Tint i1, Tint i2 => i1 =? i2
+  | (t11 + t12), (t21 + t22) => eq_term t11 t21 && eq_term t12 t22
+  | (t11 * t12), (t21 * t22) => eq_term t11 t21 && eq_term t12 t22
+  | (t11 - t12), (t21 - t22) => eq_term t11 t21 && eq_term t12 t22
+  | (- t1), (- t2) => eq_term t1 t2
+  | [v1], [v2] => N.eqb v1 v2
   | _, _ => false
-  end.
-
-Close Scope romega_scope.
+  end%term.
 
-Theorem eq_term_true : forall t1 t2 : term, eq_term t1 t2 = true -> t1 = t2.
-Proof.
- induction t1; destruct t2; simpl in *; try discriminate;
- (rewrite andb_true_iff; intros (H1,H2)) || intros H; f_equal;
- auto using beq_true, beq_nat_true.
-Qed.
+Infix "=?" := eq_term : romega_scope.
 
-Theorem eq_term_refl : forall t0 : term, eq_term t0 t0 = true.
+Theorem eq_term_iff (t t' : term) :
+ (t =? t')%term = true <-> t = t'.
 Proof.
- induction t0; simpl in *; try (apply andb_true_iff; split); trivial.
- - now apply beq_iff.
- - now apply beq_nat_true_iff.
+ revert t'. induction t; destruct t'; simpl in *;
+ rewrite ?andb_true_iff, ?beq_iff, ?N.eqb_eq, ?IHt, ?IHt1, ?IHt2;
+  intuition congruence.
 Qed.
 
-Ltac trivial_case := unfold not; intros; discriminate.
-
-Theorem eq_term_false :
- forall t1 t2 : term, eq_term t1 t2 = false -> t1 <> t2.
+Theorem eq_term_reflect (t t' : term) : reflect (t=t') (t =? t')%term.
 Proof.
- intros t1 t2 H E. subst t2. now rewrite eq_term_refl in H.
+ apply iff_reflect. symmetry. apply eq_term_iff.
 Qed.
 
-(* \subsubsection{Tactiques pour éliminer ces tests}
-
-   Si on se contente de faire un [Case (eq_typ t1 t2)] on perd
-   totalement dans chaque branche le fait que [t1=t2] ou [~t1=t2].
-
-   Initialement, les développements avaient été réalisés avec les
-   tests rendus par [Decide Equality], c'est à dire un test rendant
-   des termes du type [{t1=t2}+{~t1=t2}]. Faire une élimination sur un
-   tel test préserve bien l'information voulue mais calculatoirement de
-   telles fonctions sont trop lentes. *)
-
-(* Les tactiques définies si après se comportent exactement comme si on
-   avait utilisé le test précédent et fait une elimination dessus. *)
-
-Ltac elim_eq_term t1 t2 :=
-  let Aux := fresh "Aux" in
-  pattern (eq_term t1 t2); apply bool_eq_ind; intro Aux;
-   [ generalize (eq_term_true t1 t2 Aux); clear Aux
-   | generalize (eq_term_false t1 t2 Aux); clear Aux ].
-
-Ltac elim_beq t1 t2 :=
-  let Aux := fresh "Aux" in
-  pattern (beq t1 t2); apply bool_eq_ind; intro Aux;
-   [ generalize (beq_true t1 t2 Aux); clear Aux
-   | generalize (beq_false t1 t2 Aux); clear Aux ].
-
-Ltac elim_bgt t1 t2 :=
-  let Aux := fresh "Aux" in
-  pattern (bgt t1 t2); apply bool_eq_ind; intro Aux;
-  [ generalize (bgt_true t1 t2 Aux); clear Aux
-  | generalize (bgt_false t1 t2 Aux); clear Aux ].
-
+(** ** Interpretations of terms (as integers). *)
 
-(* \subsection{Interprétations}
-   \subsubsection{Interprétation des termes dans Z} *)
+Fixpoint Nnth {A} (n:N)(l:list A)(default:A) :=
+ match n, l with
+   | _, nil => default
+   | 0%N, x::_ => x
+   | _, _::l => Nnth (N.pred n) l default
+ end.
 
-Fixpoint interp_term (env : list int) (t : term) {struct t} : int :=
+Fixpoint interp_term (env : list int) (t : term) : int :=
   match t with
   | Tint x => x
   | (t1 + t2)%term => interp_term env t1 + interp_term env t2
   | (t1 * t2)%term => interp_term env t1 * interp_term env t2
   | (t1 - t2)%term => interp_term env t1 - interp_term env t2
   | (- t)%term => - interp_term env t
-  | [n]%term => nth n env 0
+  | [n]%term => Nnth n env 0
   end.
 
-(* \subsubsection{Interprétation des prédicats} *)
+(** ** Interpretation of predicats (as Coq propositions) *)
 
-Fixpoint interp_proposition (envp : list Prop) (env : list int)
- (p : proposition) {struct p} : Prop :=
+Fixpoint interp_prop (envp : list Prop) (env : list int)
+ (p : proposition) : Prop :=
   match p with
   | EqTerm t1 t2 => interp_term env t1 = interp_term env t2
+  | NeqTerm t1 t2 => (interp_term env t1) <> (interp_term env t2)
   | LeqTerm t1 t2 => interp_term env t1 <= interp_term env t2
-  | TrueTerm => True
-  | FalseTerm => False
-  | Tnot p' => ~ interp_proposition envp env p'
   | GeqTerm t1 t2 => interp_term env t1 >= interp_term env t2
   | GtTerm t1 t2 => interp_term env t1 > interp_term env t2
   | LtTerm t1 t2 => interp_term env t1 < interp_term env t2
-  | NeqTerm t1 t2 => (interp_term env t1)<>(interp_term env t2)
-  | Tor p1 p2 =>
-      interp_proposition envp env p1 \/ interp_proposition envp env p2
-  | Tand p1 p2 =>
-      interp_proposition envp env p1 /\ interp_proposition envp env p2
-  | Timp p1 p2 =>
-      interp_proposition envp env p1 -> interp_proposition envp env p2
+  | TrueTerm => True
+  | FalseTerm => False
+  | Tnot p' => ~ interp_prop envp env p'
+  | Tor p1 p2 => interp_prop envp env p1 \/ interp_prop envp env p2
+  | Tand p1 p2 => interp_prop envp env p1 /\ interp_prop envp env p2
+  | Timp p1 p2 => interp_prop envp env p1 -> interp_prop envp env p2
   | Tprop n => nth n envp True
   end.
 
-(* \subsubsection{Inteprétation des listes d'hypothèses}
-   \paragraph{Sous forme de conjonction}
-   Interprétation sous forme d'une conjonction d'hypothèses plus faciles
-   à manipuler individuellement *)
+(** ** Intepretation of hypothesis lists (as Coq conjunctions) *)
 
-Fixpoint interp_hyps (envp : list Prop) (env : list int)
- (l : hyps) {struct l} : Prop :=
+Fixpoint interp_hyps (envp : list Prop) (env : list int) (l : hyps)
+  : Prop :=
   match l with
   | nil => True
-  | p' :: l' => interp_proposition envp env p' /\ interp_hyps envp env l'
+  | p' :: l' => interp_prop envp env p' /\ interp_hyps envp env l'
   end.
 
-(* \paragraph{sous forme de but}
-   C'est cette interpétation que l'on utilise sur le but (car on utilise
-   [Generalize] et qu'une conjonction est forcément lourde (répétition des
-   types dans les conjonctions intermédiaires) *)
+(** ** Interpretation of conclusion + hypotheses
+
+   Here we use Coq implications : it's less easy to manipulate,
+   but handy to relate to the Coq original goal (cf. the use of
+   [generalize], and lighter (no repetition of types in intermediate
+   conjunctions). *)
 
 Fixpoint interp_goal_concl (c : proposition) (envp : list Prop)
- (env : list int) (l : hyps) {struct l} : Prop :=
+ (env : list int) (l : hyps) : Prop :=
   match l with
-  | nil => interp_proposition envp env c
+  | nil => interp_prop envp env c
   | p' :: l' =>
-      interp_proposition envp env p' -> interp_goal_concl c envp env l'
+      interp_prop envp env p' -> interp_goal_concl c envp env l'
   end.
 
 Notation interp_goal := (interp_goal_concl FalseTerm).
 
-(* Les théorèmes qui suivent assurent la correspondance entre les deux
-   interprétations. *)
+(** Equivalence between these two interpretations. *)
 
 Theorem goal_to_hyps :
  forall (envp : list Prop) (env : list int) (l : hyps),
  (interp_hyps envp env l -> False) -> interp_goal envp env l.
 Proof.
- simple induction l;
- [ simpl; auto
- | simpl; intros a l1 H1 H2 H3; apply H1; intro H4; apply H2; auto ].
+ induction l; simpl; auto.
 Qed.
 
 Theorem hyps_to_goal :
  forall (envp : list Prop) (env : list int) (l : hyps),
  interp_goal envp env l -> interp_hyps envp env l -> False.
 Proof.
- simple induction l; simpl; [ auto | intros; apply H; elim H1; auto ].
-Qed.
-
-(* \subsection{Manipulations sur les hypothèses} *)
-
-(* \subsubsection{Définitions de base de stabilité pour la réflexion} *)
-(* Une opération laisse un terme stable si l'égalité est préservée *)
-Definition term_stable (f : term -> term) :=
-  forall (e : list int) (t : term), interp_term e t = interp_term e (f t).
-
-(* Une opération est valide sur une hypothèse, si l'hypothèse implique le
-   résultat de l'opération. \emph{Attention : cela ne concerne que des
-   opérations sur les hypothèses et non sur les buts (contravariance)}.
-   On définit la validité pour une opération prenant une ou deux propositions
-   en argument (cela suffit pour omega). *)
-
-Definition valid1 (f : proposition -> proposition) :=
-  forall (ep : list Prop) (e : list int) (p1 : proposition),
-  interp_proposition ep e p1 -> interp_proposition ep e (f p1).
-
-Definition valid2 (f : proposition -> proposition -> proposition) :=
-  forall (ep : list Prop) (e : list int) (p1 p2 : proposition),
-  interp_proposition ep e p1 ->
-  interp_proposition ep e p2 -> interp_proposition ep e (f p1 p2).
-
-(* Dans cette notion de validité, la fonction prend directement une
-   liste de propositions et rend une nouvelle liste de proposition.
-   On reste contravariant *)
-
-Definition valid_hyps (f : hyps -> hyps) :=
-  forall (ep : list Prop) (e : list int) (lp : hyps),
-  interp_hyps ep e lp -> interp_hyps ep e (f lp).
-
-(* Enfin ce théorème élimine la contravariance et nous ramène à une
-   opération sur les buts *)
-
-Theorem valid_goal :
-  forall (ep : list Prop) (env : list int) (l : hyps) (a : hyps -> hyps),
-  valid_hyps a -> interp_goal ep env (a l) -> interp_goal ep env l.
-Proof.
- intros; simpl; apply goal_to_hyps; intro H1;
- apply (hyps_to_goal ep env (a l) H0); apply H; assumption.
+ induction l; simpl; auto.
+ intros H (H1,H2). auto.
 Qed.
 
-(* \subsubsection{Généralisation a des listes de buts (disjonctions)} *)
+(** ** Interpretations of list of goals
 
+    Here again, two flavours... *)
 
 Fixpoint interp_list_hyps (envp : list Prop) (env : list int)
- (l : lhyps) {struct l} : Prop :=
+ (l : lhyps) : Prop :=
   match l with
   | nil => False
   | h :: l' => interp_hyps envp env h \/ interp_list_hyps envp env l'
   end.
 
 Fixpoint interp_list_goal (envp : list Prop) (env : list int)
- (l : lhyps) {struct l} : Prop :=
+ (l : lhyps) : Prop :=
   match l with
   | nil => True
   | h :: l' => interp_goal envp env h /\ interp_list_goal envp env l'
   end.
 
+(** Equivalence between the two flavours. *)
+
 Theorem list_goal_to_hyps :
  forall (envp : list Prop) (env : list int) (l : lhyps),
  (interp_list_hyps envp env l -> False) -> interp_list_goal envp env l.
 Proof.
- simple induction l; simpl;
- [ auto
- | intros h1 l1 H H1; split;
-    [ apply goal_to_hyps; intro H2; apply H1; auto
-    | apply H; intro H2; apply H1; auto ] ].
+ induction l; simpl; intuition. now apply goal_to_hyps.
 Qed.
 
 Theorem list_hyps_to_goal :
  forall (envp : list Prop) (env : list int) (l : lhyps),
  interp_list_goal envp env l -> interp_list_hyps envp env l -> False.
 Proof.
- simple induction l; simpl;
- [ auto
- | intros h1 l1 H (H1, H2) H3; elim H3; intro H4;
-    [ apply hyps_to_goal with (1 := H1); assumption | auto ] ].
+ induction l; simpl; intuition. eapply hyps_to_goal; eauto.
 Qed.
 
+(** ** Stabiliy and validity of operations *)
+
+(** An operation on terms is stable if the interpretation is unchanged. *)
+
+Definition term_stable (f : term -> term) :=
+  forall (e : list int) (t : term), interp_term e t = interp_term e (f t).
+
+(** An operation on one hypothesis is valid if this hypothesis implies
+    the result of this operation. *)
+
+Definition valid1 (f : proposition -> proposition) :=
+  forall (ep : list Prop) (e : list int) (p1 : proposition),
+  interp_prop ep e p1 -> interp_prop ep e (f p1).
+
+Definition valid2 (f : proposition -> proposition -> proposition) :=
+  forall (ep : list Prop) (e : list int) (p1 p2 : proposition),
+  interp_prop ep e p1 ->
+  interp_prop ep e p2 -> interp_prop ep e (f p1 p2).
+
+(** Same for lists of hypotheses, and for list of goals *)
+
+Definition valid_hyps (f : hyps -> hyps) :=
+  forall (ep : list Prop) (e : list int) (lp : hyps),
+  interp_hyps ep e lp -> interp_hyps ep e (f lp).
+
 Definition valid_list_hyps (f : hyps -> lhyps) :=
   forall (ep : list Prop) (e : list int) (lp : hyps),
   interp_hyps ep e lp -> interp_list_hyps ep e (f lp).
@@ -1261,6 +944,16 @@ Definition valid_list_goal (f : hyps -> lhyps) :=
   forall (ep : list Prop) (e : list int) (lp : hyps),
   interp_list_goal ep e (f lp) -> interp_goal ep e lp.
 
+(** Some results about these validities. *)
+
+Theorem valid_goal :
+  forall (ep : list Prop) (env : list int) (l : hyps) (a : hyps -> hyps),
+  valid_hyps a -> interp_goal ep env (a l) -> interp_goal ep env l.
+Proof.
+ intros; simpl; apply goal_to_hyps; intro H1;
+ apply (hyps_to_goal ep env (a l) H0); apply H; assumption.
+Qed.
+
 Theorem goal_valid :
  forall f : hyps -> lhyps, valid_list_hyps f -> valid_list_goal f.
 Proof.
@@ -1274,33 +967,31 @@ Theorem append_valid :
  interp_list_hyps ep e l1 \/ interp_list_hyps ep e l2 ->
  interp_list_hyps ep e (l1 ++ l2).
 Proof.
- intros ep e; simple induction l1;
- [ simpl; intros l2 [H| H]; [ contradiction | trivial ]
- | simpl; intros h1 t1 HR l2 [[H| H]| H];
-    [ auto
-    | right; apply (HR l2); left; trivial
-    | right; apply (HR l2); right; trivial ] ].
-
+ induction l1; simpl in *.
+ - now intros l2 [H| H].
+ - intros l2 [[H| H]| H].
+   + auto.
+   + right; apply IHl1; now left.
+   + right; apply IHl1; now right.
 Qed.
 
-(* \subsubsection{Opérateurs valides sur les hypothèses} *)
+(** ** Valid operations on hypotheses *)
+
+(** Extract an hypothesis from the list *)
 
-(* Extraire une hypothèse de la liste *)
 Definition nth_hyps (n : nat) (l : hyps) := nth n l TrueTerm.
-Unset Printing Notations.
+
 Theorem nth_valid :
  forall (ep : list Prop) (e : list int) (i : nat) (l : hyps),
- interp_hyps ep e l -> interp_proposition ep e (nth_hyps i l).
+ interp_hyps ep e l -> interp_prop ep e (nth_hyps i l).
 Proof.
- unfold nth_hyps; simple induction i;
- [ simple induction l; simpl; [ auto | intros; elim H0; auto ]
- | intros n H; simple induction l;
-    [ simpl; trivial
-    | intros; simpl; apply H; elim H1; auto ] ].
+ unfold nth_hyps. induction i; destruct l; simpl in *; try easy.
+ intros (H1,H2). now apply IHi.
 Qed.
 
-(* Appliquer une opération (valide) sur deux hypothèses extraites de
-   la liste et ajouter le résultat à la liste. *)
+(** Apply a valid operation on two hypotheses from the list, and
+    store the result in the list. *)
+
 Definition apply_oper_2 (i j : nat)
   (f : proposition -> proposition -> proposition) (l : hyps) :=
   f (nth_hyps i l) (nth_hyps j l) :: l.
@@ -1310,15 +1001,18 @@ Theorem apply_oper_2_valid :
  valid2 f -> valid_hyps (apply_oper_2 i j f).
 Proof.
  intros i j f Hf; unfold apply_oper_2, valid_hyps; simpl;
- intros lp Hlp; split; [ apply Hf; apply nth_valid; assumption | assumption ].
+ intros lp Hlp; split.
+ - apply Hf; apply nth_valid; assumption.
+ - assumption.
 Qed.
 
-(* Modifier une hypothèse par application d'une opération valide *)
+(** In-place modification of an hypothesis by application of
+    a valid operation. *)
 
 Fixpoint apply_oper_1 (i : nat) (f : proposition -> proposition)
  (l : hyps) {struct i} : hyps :=
   match l with
-  | nil => nil (A:=proposition)
+  | nil => nil
   | p :: l' =>
       match i with
       | O => f p :: l'
@@ -1330,105 +1024,11 @@ Theorem apply_oper_1_valid :
  forall (i : nat) (f : proposition -> proposition),
  valid1 f -> valid_hyps (apply_oper_1 i f).
 Proof.
- unfold valid_hyps; intros i f Hf ep e; elim i;
- [ intro lp; case lp;
-    [ simpl; trivial
-    | simpl; intros p l' (H1, H2); split;
-       [ apply Hf with (1 := H1) | assumption ] ]
- | intros n Hrec lp; case lp;
-    [ simpl; auto
-    | simpl; intros p l' (H1, H2); split;
-       [ assumption | apply Hrec; assumption ] ] ].
+ unfold valid_hyps.
+ induction i; intros f Hf ep e [ | p lp]; simpl; intuition.
 Qed.
 
-(* \subsubsection{Manipulations de termes} *)
-(* Les fonctions suivantes permettent d'appliquer une fonction de
-   réécriture sur un sous terme du terme principal. Avec la composition,
-   cela permet de construire des réécritures complexes proches des
-   tactiques de conversion *)
-
-Definition apply_left (f : term -> term) (t : term) :=
-  match t with
-  | (x + y)%term => (f x + y)%term
-  | (x * y)%term => (f x * y)%term
-  | (- x)%term => (- f x)%term
-  | x => x
-  end.
-
-Definition apply_right (f : term -> term) (t : term) :=
-  match t with
-  | (x + y)%term => (x + f y)%term
-  | (x * y)%term => (x * f y)%term
-  | x => x
-  end.
-
-Definition apply_both (f g : term -> term) (t : term) :=
-  match t with
-  | (x + y)%term => (f x + g y)%term
-  | (x * y)%term => (f x * g y)%term
-  | x => x
-  end.
-
-(* Les théorèmes suivants montrent la stabilité (conditionnée) des
-   fonctions. *)
-
-Theorem apply_left_stable :
- forall f : term -> term, term_stable f -> term_stable (apply_left f).
-Proof.
- unfold term_stable; intros f H e t; case t; auto; simpl;
- intros; elim H; trivial.
-Qed.
-
-Theorem apply_right_stable :
- forall f : term -> term, term_stable f -> term_stable (apply_right f).
-Proof.
- unfold term_stable; intros f H e t; case t; auto; simpl;
- intros t0 t1; elim H; trivial.
-Qed.
-
-Theorem apply_both_stable :
- forall f g : term -> term,
- term_stable f -> term_stable g -> term_stable (apply_both f g).
-Proof.
- unfold term_stable; intros f g H1 H2 e t; case t; auto; simpl;
- intros t0 t1; elim H1; elim H2; trivial.
-Qed.
-
-Theorem compose_term_stable :
- forall f g : term -> term,
- term_stable f -> term_stable g -> term_stable (fun t : term => f (g t)).
-Proof.
- unfold term_stable; intros f g Hf Hg e t; elim Hf; apply Hg.
-Qed.
-
-(* \subsection{Les règles de réécriture} *)
-(* Chacune des règles de réécriture est accompagnée par sa preuve de
-   stabilité. Toutes ces preuves ont la même forme : il faut analyser
-   suivant la forme du terme (élimination de chaque Case). On a besoin d'une
-   élimination uniquement dans les cas d'utilisation d'égalité décidable.
-
-   Cette tactique itère la décomposition des Case. Elle est
-   constituée de deux fonctions s'appelant mutuellement :
-   \begin{itemize}
-    \item une fonction d'enrobage qui lance la recherche sur le but,
-    \item une fonction récursive qui décompose ce but. Quand elle a trouvé un
-          Case, elle l'élimine.
-   \end{itemize}
-   Les motifs sur les cas sont très imparfaits et dans certains cas, il
-   semble que cela ne marche pas. On aimerait plutot un motif de la
-   forme [ Case (?1 :: T) of _ end ] permettant de s'assurer que l'on
-   utilise le bon type.
-
-   Chaque élimination introduit correctement exactement le nombre d'hypothèses
-   nécessaires et conserve dans le cas d'une égalité la connaissance du
-   résultat du test en faisant la réécriture. Pour un test de comparaison,
-   on conserve simplement le résultat.
-
-   Cette fonction déborde très largement la résolution des réécritures
-   simples et fait une bonne partie des preuves des pas de Omega.
-*)
-
-(* \subsubsection{La tactique pour prouver la stabilité} *)
+(** ** A tactic for proving stability *)
 
 Ltac loop t :=
   match t with
@@ -1438,54 +1038,33 @@ Ltac loop t :=
   (* Interpretations *)
   | (interp_hyps _ _ ?X1) => loop X1
   | (interp_list_hyps _ _ ?X1) => loop X1
-  | (interp_proposition _ _ ?X1) => loop X1
+  | (interp_prop _ _ ?X1) => loop X1
   | (interp_term _ ?X1) => loop X1
   (* Propositions *)
   | (EqTerm ?X1 ?X2) => loop X1 || loop X2
   | (LeqTerm ?X1 ?X2) => loop X1 || loop X2
-  (* Termes *)
+  (* Terms *)
   | (?X1 + ?X2)%term => loop X1 || loop X2
   | (?X1 - ?X2)%term => loop X1 || loop X2
   | (?X1 * ?X2)%term => loop X1 || loop X2
   | (- ?X1)%term => loop X1
   | (Tint ?X1) => loop X1
   (* Eliminations *)
-  | match ?X1 with
-    | EqTerm _ _ => _
-    | LeqTerm _ _ => _
-    | TrueTerm => _
-    | FalseTerm => _
-    | Tnot _ => _
-    | GeqTerm _ _ => _
-    | GtTerm _ _ => _
-    | LtTerm _ _ => _
-    | NeqTerm _ _ => _
-    | Tor _ _ => _
-    | Tand _ _ => _
-    | Timp _ _ => _
-    | Tprop _ => _
-    end => destruct X1; auto; Simplify
-  | match ?X1 with
-    | Tint _ => _
-    | (_ + _)%term => _
-    | (_ * _)%term => _
-    | (_ - _)%term => _
-    | (- _)%term => _
-    | [_]%term => _
-    end => destruct X1; auto; Simplify
-  | (if beq ?X1 ?X2 then _ else _) =>
+  | (if ?X1 =? ?X2 then _ else _) =>
       let H := fresh "H" in
-      elim_beq X1 X2; intro H; try (rewrite H in *; clear H);
-       simpl; auto; Simplify
-  | (if bgt ?X1 ?X2 then _ else _) =>
+      case (beq_reflect X1 X2); intro H;
+      try (rewrite H in *; clear H); simpl; auto; Simplify
+  | (if ?X1 <? ?X2 then _ else _) =>
+      case (blt_reflect X1 X2); intro; simpl; auto; Simplify
+  | (if (?X1 =? ?X2)%term then _ else _) =>
       let H := fresh "H" in
-      elim_bgt X1 X2; intro H; simpl; auto; Simplify
-  | (if eq_term ?X1 ?X2 then _ else _) =>
-      let H := fresh "H" in
-      elim_eq_term X1 X2; intro H; try (rewrite H in *; clear H);
-       simpl; auto; Simplify
+      case (eq_term_reflect X1 X2); intro H;
+      try (rewrite H in *; clear H); simpl; auto; Simplify
   | (if _ && _ then _ else _) => rewrite andb_if; Simplify
   | (if negb _ then _ else _) => rewrite negb_if; Simplify
+  | match N.compare ?X1 ?X2 with _ => _ end =>
+    destruct (N.compare_spec X1 X2); Simplify
+  | match ?X1 with _ => _ end => destruct X1; auto; Simplify
   | _ => fail
   end
 
@@ -1494,875 +1073,529 @@ with Simplify := match goal with
   | _ => idtac
   end.
 
-Ltac prove_stable x th :=
-  match constr:(x) with
-  | ?X1 =>
-      unfold term_stable, X1; intros; Simplify; simpl;
-       apply th
-  end.
-
-(* \subsubsection{Les règles elle mêmes} *)
-Definition Tplus_assoc_l (t : term) :=
-  match t with
-  | (n + (m + p))%term => (n + m + p)%term
-  | _ => t
-  end.
-
-Theorem Tplus_assoc_l_stable : term_stable Tplus_assoc_l.
-Proof.
- prove_stable Tplus_assoc_l (ring.(Radd_assoc)).
-Qed.
-
-Definition Tplus_assoc_r (t : term) :=
-  match t with
-  | (n + m + p)%term => (n + (m + p))%term
-  | _ => t
-  end.
-
-Theorem Tplus_assoc_r_stable : term_stable Tplus_assoc_r.
-Proof.
- prove_stable Tplus_assoc_r plus_assoc_reverse.
-Qed.
-
-Definition Tmult_assoc_r (t : term) :=
-  match t with
-  | (n * m * p)%term => (n * (m * p))%term
-  | _ => t
-  end.
-
-Theorem Tmult_assoc_r_stable : term_stable Tmult_assoc_r.
-Proof.
- prove_stable Tmult_assoc_r mult_assoc_reverse.
-Qed.
-
-Definition Tplus_permute (t : term) :=
-  match t with
-  | (n + (m + p))%term => (m + (n + p))%term
-  | _ => t
-  end.
-
-Theorem Tplus_permute_stable : term_stable Tplus_permute.
-Proof.
- prove_stable Tplus_permute plus_permute.
-Qed.
-
-Definition Tplus_comm (t : term) :=
-  match t with
-  | (x + y)%term => (y + x)%term
-  | _ => t
-  end.
-
-Theorem Tplus_comm_stable : term_stable Tplus_comm.
-Proof.
- prove_stable Tplus_comm plus_comm.
-Qed.
-
-Definition Tmult_comm (t : term) :=
-  match t with
-  | (x * y)%term => (y * x)%term
-  | _ => t
-  end.
-
-Theorem Tmult_comm_stable : term_stable Tmult_comm.
-Proof.
- prove_stable Tmult_comm mult_comm.
-Qed.
-
-Definition T_OMEGA10 (t : term) :=
-  match t with
-  | ((v * Tint c1 + l1) * Tint k1 + (v' * Tint c2 + l2) * Tint k2)%term =>
-      if eq_term v v'
-      then (v * Tint (c1 * k1 + c2 * k2)%I + (l1 * Tint k1 + l2 * Tint k2))%term
-      else t
-  | _ => t
-  end.
-
-Theorem T_OMEGA10_stable : term_stable T_OMEGA10.
-Proof.
- prove_stable T_OMEGA10 OMEGA10.
-Qed.
-
-Definition T_OMEGA11 (t : term) :=
-  match t with
-  | ((v1 * Tint c1 + l1) * Tint k1 + l2)%term =>
-      (v1 * Tint (c1 * k1) + (l1 * Tint k1 + l2))%term
-  | _ => t
-  end.
-
-Theorem T_OMEGA11_stable : term_stable T_OMEGA11.
-Proof.
- prove_stable T_OMEGA11 OMEGA11.
-Qed.
-
-Definition T_OMEGA12 (t : term) :=
-  match t with
-  | (l1 + (v2 * Tint c2 + l2) * Tint k2)%term =>
-      (v2 * Tint (c2 * k2) + (l1 + l2 * Tint k2))%term
-  | _ => t
-  end.
-
-Theorem T_OMEGA12_stable : term_stable T_OMEGA12.
-Proof.
- prove_stable T_OMEGA12 OMEGA12.
-Qed.
-
-Definition T_OMEGA13 (t : term) :=
-  match t with
-  | (v * Tint x + l1 + (v' * Tint x' + l2))%term =>
-      if eq_term v v' && beq x (-x')
-      then (l1+l2)%term
-      else t
-  | _ => t
-  end.
-
-Theorem T_OMEGA13_stable : term_stable T_OMEGA13.
-Proof.
- unfold term_stable, T_OMEGA13; intros; Simplify; simpl;
- apply OMEGA13.
-Qed.
-
-Definition T_OMEGA15 (t : term) :=
-  match t with
-  | (v * Tint c1 + l1 + (v' * Tint c2 + l2) * Tint k2)%term =>
-      if eq_term v v'
-      then (v * Tint (c1 + c2 * k2)%I + (l1 + l2 * Tint k2))%term
-      else t
-  | _ => t
-  end.
-
-Theorem T_OMEGA15_stable : term_stable T_OMEGA15.
-Proof.
- prove_stable T_OMEGA15 OMEGA15.
-Qed.
-
-Definition T_OMEGA16 (t : term) :=
-  match t with
-  | ((v * Tint c + l) * Tint k)%term => (v * Tint (c * k) + l * Tint k)%term
-  | _ => t
-  end.
-
-
-Theorem T_OMEGA16_stable : term_stable T_OMEGA16.
-Proof.
- prove_stable T_OMEGA16 OMEGA16.
-Qed.
-
-Definition Tred_factor5 (t : term) :=
-  match t with
-  | (x * Tint c + y)%term => if beq c 0 then y else t
-  | _ => t
-  end.
-
-Theorem Tred_factor5_stable : term_stable Tred_factor5.
-Proof.
- prove_stable Tred_factor5 red_factor5.
-Qed.
-
-Definition Topp_plus (t : term) :=
-  match t with
-  | (- (x + y))%term => (- x + - y)%term
-  | _ => t
-  end.
-
-Theorem Topp_plus_stable : term_stable Topp_plus.
-Proof.
- prove_stable Topp_plus opp_plus_distr.
-Qed.
-
-
-Definition Topp_opp (t : term) :=
-  match t with
-  | (- - x)%term => x
-  | _ => t
-  end.
-
-Theorem Topp_opp_stable : term_stable Topp_opp.
-Proof.
- prove_stable Topp_opp opp_involutive.
-Qed.
-
-Definition Topp_mult_r (t : term) :=
-  match t with
-  | (- (x * Tint k))%term => (x * Tint (- k))%term
-  | _ => t
-  end.
-
-Theorem Topp_mult_r_stable : term_stable Topp_mult_r.
-Proof.
- prove_stable Topp_mult_r opp_mult_distr_r.
-Qed.
-
-Definition Topp_one (t : term) :=
-  match t with
-  | (- x)%term => (x * Tint (-(1)))%term
-  | _ => t
-  end.
-
-Theorem Topp_one_stable : term_stable Topp_one.
-Proof.
- prove_stable Topp_one opp_eq_mult_neg_1.
-Qed.
-
-Definition Tmult_plus_distr (t : term) :=
-  match t with
-  | ((n + m) * p)%term => (n * p + m * p)%term
-  | _ => t
-  end.
-
-Theorem Tmult_plus_distr_stable : term_stable Tmult_plus_distr.
-Proof.
- prove_stable Tmult_plus_distr mult_plus_distr_r.
-Qed.
-
-Definition Tmult_opp_left (t : term) :=
-  match t with
-  | (- x * Tint y)%term => (x * Tint (- y))%term
-  | _ => t
-  end.
-
-Theorem Tmult_opp_left_stable : term_stable Tmult_opp_left.
-Proof.
- prove_stable Tmult_opp_left mult_opp_comm.
-Qed.
+(** ** Operations on equation bodies *)
 
-Definition Tmult_assoc_reduced (t : term) :=
-  match t with
-  | (n * Tint m * Tint p)%term => (n * Tint (m * p))%term
-  | _ => t
-  end.
+(** The operations below handle in priority _normalized_ terms, i.e.
+    terms of the form:
+      [([v1]*Tint k1 + ([v2]*Tint k2 + (... + Tint cst)))]
+    with [v1>v2>...] and all [ki<>0].
+    See [normalize] below for a way to put terms in this form.
 
-Theorem Tmult_assoc_reduced_stable : term_stable Tmult_assoc_reduced.
-Proof.
- prove_stable Tmult_assoc_reduced mult_assoc_reverse.
-Qed.
+    These operations also produce a correct (but suboptimal)
+    result in case of non-normalized input terms, but this situation
+    should normally not happen when running [romega].
 
-Definition Tred_factor0 (t : term) := (t * Tint 1)%term.
+     /!\ Do not modify this section (especially [fusion] and [normalize])
+    without tweaking the corresponding functions in [refl_omega.ml].
+*)
 
-Theorem Tred_factor0_stable : term_stable Tred_factor0.
-Proof.
- prove_stable Tred_factor0 red_factor0.
-Qed.
+(** Multiplication and sum by two constants. Invariant: [k1<>0]. *)
 
-Definition Tred_factor1 (t : term) :=
+Fixpoint scalar_mult_add (t : term) (k1 k2 : int) : term :=
   match t with
-  | (x + y)%term =>
-      if eq_term x y
-      then (x * Tint 2)%term
-      else t
-  | _ => t
-  end.
+  | v1 * Tint x1 + l1 =>
+    v1 * Tint (x1 * k1) + scalar_mult_add l1 k1 k2
+  | Tint x => Tint (k1 * x + k2)
+  | _ => t * Tint k1 + Tint k2 (* shouldn't happen *)
+  end%term.
 
-Theorem Tred_factor1_stable : term_stable Tred_factor1.
+Theorem scalar_mult_add_stable e t k1 k2 :
+ interp_term e (scalar_mult_add t k1 k2) =
+ interp_term e (t * Tint k1 + Tint k2).
 Proof.
- prove_stable Tred_factor1 red_factor1.
+ induction t; simpl; Simplify; simpl; auto. f_equal. apply mult_comm.
+ rewrite IHt2. simpl. apply OMEGA11.
 Qed.
 
-Definition Tred_factor2 (t : term) :=
-  match t with
-  | (x + y * Tint k)%term =>
-      if eq_term x y
-      then (x * Tint (1 + k))%term
-      else t
-  | _ => t
-  end.
-
-Theorem Tred_factor2_stable : term_stable Tred_factor2.
-Proof.
- prove_stable Tred_factor2 red_factor2.
-Qed.
+(** Multiplication by a (non-nul) constant. *)
 
-Definition Tred_factor3 (t : term) :=
-  match t with
-  | (x * Tint k + y)%term =>
-      if eq_term x y
-      then (x * Tint (1 + k))%term
-      else t
-  | _ => t
-  end.
+Definition scalar_mult (t : term) (k : int) := scalar_mult_add t k 0.
 
-Theorem Tred_factor3_stable : term_stable Tred_factor3.
+Theorem scalar_mult_stable e t k :
+ interp_term e (scalar_mult t k) =
+ interp_term e (t * Tint k).
 Proof.
- prove_stable Tred_factor3 red_factor3.
+ unfold scalar_mult. rewrite scalar_mult_add_stable. simpl.
+ apply plus_0_r.
 Qed.
 
+(** Adding a constant
 
-Definition Tred_factor4 (t : term) :=
-  match t with
-  | (x * Tint k1 + y * Tint k2)%term =>
-      if eq_term x y
-      then (x * Tint (k1 + k2))%term
-      else t
-  | _ => t
-  end.
-
-Theorem Tred_factor4_stable : term_stable Tred_factor4.
-Proof.
- prove_stable Tred_factor4 red_factor4.
-Qed.
-
-Definition Tred_factor6 (t : term) := (t + Tint 0)%term.
-
-Theorem Tred_factor6_stable : term_stable Tred_factor6.
-Proof.
- prove_stable Tred_factor6 red_factor6.
-Qed.
+    Instead of using [scalar_norm_add t 1 k], the following
+    definition spares some computations.
+ *)
 
-Definition Tminus_def (t : term) :=
+Fixpoint scalar_add (t : term) (k : int) : term :=
   match t with
-  | (x - y)%term => (x + - y)%term
-  | _ => t
-  end.
+  | m + l => m + scalar_add l k
+  | Tint x => Tint (x + k)
+  | _ => t + Tint k
+  end%term.
 
-Theorem Tminus_def_stable : term_stable Tminus_def.
+Theorem scalar_add_stable e t k :
+ interp_term e (scalar_add t k) = interp_term e (t + Tint k).
 Proof.
- prove_stable Tminus_def minus_def.
+ induction t; simpl; Simplify; simpl; auto.
+ rewrite IHt2. simpl. apply plus_assoc.
 Qed.
 
-(* \subsection{Fonctions de réécriture complexes} *)
+(** Division by a constant
 
-(* \subsubsection{Fonction de réduction} *)
-(* Cette fonction réduit un terme dont la forme normale est un entier. Il
-   suffit pour cela d'échanger le constructeur [Tint] avec les opérateurs
-   réifiés. La réduction est ``gratuite''.  *)
+    All the non-constant coefficients should be exactly dividable *)
 
-Fixpoint reduce (t : term) : term :=
+Fixpoint scalar_div (t : term) (k : int) : option (term * int) :=
   match t with
-  | (x + y)%term =>
-      match reduce x with
-      | Tint x' =>
-          match reduce y with
-          | Tint y' => Tint (x' + y')
-          | y' => (Tint x' + y')%term
-          end
-      | x' => (x' + reduce y)%term
-      end
-  | (x * y)%term =>
-      match reduce x with
-      | Tint x' =>
-          match reduce y with
-          | Tint y' => Tint (x' * y')
-          | y' => (Tint x' * y')%term
-          end
-      | x' => (x' * reduce y)%term
-      end
-  | (x - y)%term =>
-      match reduce x with
-      | Tint x' =>
-          match reduce y with
-          | Tint y' => Tint (x' - y')
-          | y' => (Tint x' - y')%term
-          end
-      | x' => (x' - reduce y)%term
+  | v * Tint x + l =>
+    let (q,r) := diveucl x k in
+    if (r =? 0)%I then
+      match scalar_div l k with
+      | None => None
+      | Some (u,c) => Some (v * Tint q + u, c)
       end
-  | (- x)%term =>
-      match reduce x with
-      | Tint x' => Tint (- x')
-      | x' => (- x')%term
-      end
-  | _ => t
-  end.
+    else None
+  | Tint x =>
+    let (q,r) := diveucl x k in
+    Some (Tint q, r)
+  | _ => None
+  end%term.
+
+Lemma scalar_div_stable e t k u c : k<>0 ->
+  scalar_div t k = Some (u,c) ->
+  interp_term e (u * Tint k + Tint c) = interp_term e t.
+Proof.
+ revert u c.
+ induction t; simpl; Simplify; try easy.
+ - intros u c Hk. assert (H := diveucl_spec t0 k Hk).
+   simpl in H.
+   destruct diveucl as (q,r). simpl in H. rewrite H.
+   injection 1 as <- <-. simpl. f_equal. apply mult_comm.
+ - intros u c Hk.
+   destruct t1; simpl; Simplify; try easy.
+   destruct t1_2; simpl; Simplify; try easy.
+   assert (H := diveucl_spec t0 k Hk).
+   simpl in H.
+   destruct diveucl as (q,r). simpl in H. rewrite H.
+   case beq_reflect; [intros -> | easy].
+   destruct (scalar_div t2 k) as [(u',c')|] eqn:E; [|easy].
+   injection 1 as <- ->. simpl.
+   rewrite <- (IHt2 u' c Hk); simpl; auto.
+   rewrite plus_0_r , (mult_comm k q). symmetry. apply OMEGA11.
+Qed.
+
+
+(** Fusion of two equations.
+
+    From two normalized equations, this fusion will produce
+    a normalized output corresponding to the coefficiented sum.
+    Invariant: [k1<>0] and [k2<>0].
+*)
 
-Theorem reduce_stable : term_stable reduce.
-Proof.
- unfold term_stable; intros e t; elim t; auto;
- try
-  (intros t0 H0 t1 H1; simpl; rewrite H0; rewrite H1;
-    (case (reduce t0);
-      [ intro z0; case (reduce t1); intros; auto
-      | intros; auto
-      | intros; auto
-      | intros; auto
-      | intros; auto
-      | intros; auto ])); intros t0 H0; simpl;
- rewrite H0; case (reduce t0); intros; auto.
-Qed.
+Fixpoint fusion (t1 t2 : term) (k1 k2 : int) : term :=
+  match t1 with
+  | [v1] * Tint x1 + l1 =>
+    (fix fusion_t1 t2 : term :=
+       match t2 with
+         | [v2] * Tint x2 + l2 =>
+           match N.compare v1 v2 with
+             | Eq =>
+               let k := (k1 * x1 + k2 * x2)%I in
+               if (k =? 0)%I then fusion l1 l2 k1 k2
+               else [v1] * Tint k + fusion l1 l2 k1 k2
+             | Lt => [v2] * Tint (k2 * x2) + fusion_t1 l2
+             | Gt => [v1] * Tint (k1 * x1) + fusion l1 t2 k1 k2
+           end
+         | Tint x2 => [v1] * Tint (k1 * x1) + fusion l1 t2 k1 k2
+         | _ => t1 * Tint k1 + t2 * Tint k2 (* shouldn't happen *)
+       end) t2
+  | Tint x1 => scalar_mult_add t2 k2 (k1 * x1)
+  | _ => t1 * Tint k1 + t2 * Tint k2 (* shouldn't happen *)
+  end%term.
+
+Theorem fusion_stable e t1 t2 k1 k2 :
+ interp_term e (fusion t1 t2 k1 k2) =
+ interp_term e (t1 * Tint k1 + t2 * Tint k2).
+Proof.
+ revert t2; induction t1; simpl; Simplify; simpl; auto.
+ - intros; rewrite scalar_mult_add_stable. simpl.
+   rewrite plus_comm. f_equal. apply mult_comm.
+ - intros. Simplify. induction t2; simpl; Simplify; simpl; auto.
+   + rewrite IHt1_2. simpl. rewrite (mult_comm k1); apply OMEGA11.
+   + rewrite IHt1_2. simpl. subst n0.
+     rewrite (mult_comm k1), (mult_comm k2) in H0.
+     rewrite <- OMEGA10, H0. now autorewrite with int.
+   + rewrite IHt1_2. simpl. subst n0.
+     rewrite (mult_comm k1), (mult_comm k2); apply OMEGA10.
+   + rewrite IHt2_2. simpl. rewrite (mult_comm k2); apply OMEGA12.
+   + rewrite IHt1_2. simpl. rewrite (mult_comm k1); apply OMEGA11.
+Qed.
+
+(** Term normalization.
+
+   Precondition: all [Tmult] should be on at least one [Tint].
+   Postcondition: a normalized equivalent term (see below).
+*)
 
-(* \subsubsection{Fusions}
-    \paragraph{Fusion de deux équations} *)
-(* On donne une somme de deux équations qui sont supposées normalisées.
-   Cette fonction prend une trace de fusion en argument et transforme
-   le terme en une équation normalisée. C'est une version très simplifiée
-   du moteur de réécriture [rewrite]. *)
-
-Fixpoint fusion (trace : list t_fusion) (t : term) {struct trace} : term :=
-  match trace with
-  | nil => reduce t
-  | step :: trace' =>
-      match step with
-      | F_equal => apply_right (fusion trace') (T_OMEGA10 t)
-      | F_cancel => fusion trace' (Tred_factor5 (T_OMEGA10 t))
-      | F_left => apply_right (fusion trace') (T_OMEGA11 t)
-      | F_right => apply_right (fusion trace') (T_OMEGA12 t)
-      end
+Fixpoint normalize t :=
+  match t with
+  | Tint n => Tint n
+  | [n]%term => ([n] * Tint 1 + Tint 0)%term
+  | (t + t')%term => fusion (normalize t) (normalize t') 1 1
+  | (- t)%term => scalar_mult (normalize t) (-(1))
+  | (t - t')%term => fusion (normalize t) (normalize t') 1 (-(1))
+  | (Tint k * t)%term | (t * Tint k)%term =>
+    if k =? 0 then Tint 0 else scalar_mult (normalize t) k
+  | (t1 * t2)%term => (t1 * t2)%term (* shouldn't happen *)
   end.
 
-Theorem fusion_stable : forall trace : list t_fusion, term_stable (fusion trace).
+Theorem normalize_stable : term_stable normalize.
 Proof.
- simple induction trace; simpl;
- [ exact reduce_stable
- | intros stp l H; case stp;
-    [ apply compose_term_stable;
-       [ apply apply_right_stable; assumption | exact T_OMEGA10_stable ]
-    | unfold term_stable; intros e t1; rewrite T_OMEGA10_stable;
-       rewrite Tred_factor5_stable; apply H
-    | apply compose_term_stable;
-       [ apply apply_right_stable; assumption | exact T_OMEGA11_stable ]
-    | apply compose_term_stable;
-       [ apply apply_right_stable; assumption | exact T_OMEGA12_stable ] ] ].
+ intros e t.
+ induction t; simpl; Simplify; simpl;
+ rewrite ?scalar_mult_stable; simpl in *; rewrite <- ?IHt1;
+ rewrite ?fusion_stable; simpl; autorewrite with int; auto.
+ - now f_equal.
+ - rewrite mult_comm. now f_equal.
+ - rewrite <- opp_eq_mult_neg_1, <-minus_def. now f_equal.
+ - rewrite <- opp_eq_mult_neg_1. now f_equal.
 Qed.
 
-(* \paragraph{Fusion de deux équations dont une sans coefficient} *)
-
-Definition fusion_right (trace : list t_fusion) (t : term) : term :=
-  match trace with
-  | nil => reduce t (* Il faut mettre un compute *)
-  | step :: trace' =>
-      match step with
-      | F_equal => apply_right (fusion trace') (T_OMEGA15 t)
-      | F_cancel => fusion trace' (Tred_factor5 (T_OMEGA15 t))
-      | F_left => apply_right (fusion trace') (Tplus_assoc_r t)
-      | F_right => apply_right (fusion trace') (T_OMEGA12 t)
-      end
-  end.
+(** ** Normalization of a proposition.
 
-(* \paragraph{Fusion avec annihilation} *)
-(* Normalement le résultat est une constante *)
+    The only basic facts left after normalization are
+    [0 = ...] or [0 <> ...] or [0 <= ...].
+    When a fact is in negative position, we factorize a [Tnot]
+    out of it, and normalize the reversed fact inside.
 
-Fixpoint fusion_cancel (trace : nat) (t : term) {struct trace} : term :=
-  match trace with
-  | O => reduce t
-  | S trace' => fusion_cancel trace' (T_OMEGA13 t)
-  end.
+    /!\ Here again, do not change this code without corresponding
+    modifications in [refl_omega.ml].
+*)
 
-Theorem fusion_cancel_stable : forall t : nat, term_stable (fusion_cancel t).
+Fixpoint normalize_prop (negated:bool)(p:proposition) :=
+  match p with
+  | EqTerm t1 t2 =>
+    if negated then Tnot (NeqTerm (Tint 0) (normalize (t1-t2)))
+    else EqTerm (Tint 0) (normalize (t1-t2))
+  | NeqTerm t1 t2 =>
+    if negated then Tnot (EqTerm (Tint 0) (normalize (t1-t2)))
+    else NeqTerm (Tint 0) (normalize (t1-t2))
+  | LeqTerm t1 t2 =>
+    if negated then Tnot (LeqTerm (Tint 0) (normalize (t1-t2+Tint (-(1)))))
+    else LeqTerm (Tint 0) (normalize (t2-t1))
+  | GeqTerm t1 t2 =>
+    if negated then Tnot (LeqTerm (Tint 0) (normalize (t2-t1+Tint (-(1)))))
+    else LeqTerm (Tint 0) (normalize (t1-t2))
+  | LtTerm t1 t2 =>
+    if negated then Tnot (LeqTerm (Tint 0) (normalize (t1-t2)))
+    else LeqTerm (Tint 0) (normalize (t2-t1+Tint (-(1))))
+  | GtTerm t1 t2 =>
+    if negated then Tnot (LeqTerm (Tint 0) (normalize (t2-t1)))
+    else LeqTerm (Tint 0) (normalize (t1-t2+Tint (-(1))))
+  | Tnot p => Tnot (normalize_prop (negb negated) p)
+  | Tor p p' => Tor (normalize_prop negated p) (normalize_prop negated p')
+  | Tand p p' => Tand (normalize_prop negated p) (normalize_prop negated p')
+  | Timp p p' => Timp (normalize_prop (negb negated) p)
+                      (normalize_prop negated p')
+  | Tprop _ | TrueTerm | FalseTerm => p
+  end.
+
+Definition normalize_hyps := List.map (normalize_prop false).
+
+Local Ltac simp := cbn -[normalize].
+
+Theorem normalize_prop_valid b e ep p :
+  interp_prop e ep (normalize_prop b p) <-> interp_prop e ep p.
+Proof.
+ revert b.
+ induction p; intros; simp; try tauto.
+ - destruct b; simp;
+   rewrite <- ?normalize_stable; simpl; rewrite ?minus_def.
+   + rewrite not_eq. apply egal_left.
+   + apply egal_left.
+ - destruct b; simp;
+   rewrite <- ?normalize_stable; simpl; rewrite ?minus_def;
+   apply not_iff_compat, egal_left.
+ - destruct b; simp;
+   rewrite <- ? normalize_stable; simpl; rewrite ?minus_def.
+   + symmetry. rewrite le_lt_iff. apply not_iff_compat, lt_left.
+   + now rewrite <- le_left.
+ - destruct b; simp;
+   rewrite <- ? normalize_stable; simpl; rewrite ?minus_def.
+   + symmetry. rewrite ge_le_iff, le_lt_iff.
+     apply not_iff_compat, lt_left.
+   + rewrite ge_le_iff. now rewrite <- le_left.
+ - destruct b; simp;
+   rewrite <- ? normalize_stable; simpl; rewrite ?minus_def.
+   + rewrite gt_lt_iff, lt_le_iff. apply not_iff_compat.
+     now rewrite <- le_left.
+   + symmetry. rewrite gt_lt_iff. apply lt_left.
+ - destruct b; simp;
+   rewrite <- ? normalize_stable; simpl; rewrite ?minus_def.
+   + rewrite lt_le_iff. apply not_iff_compat.
+     now rewrite <- le_left.
+   + symmetry. apply lt_left.
+ - now rewrite IHp.
+ - now rewrite IHp1, IHp2.
+ - now rewrite IHp1, IHp2.
+ - now rewrite IHp1, IHp2.
+Qed.
+
+Theorem normalize_hyps_valid : valid_hyps normalize_hyps.
+Proof.
+ intros e ep l. induction l; simpl; intuition.
+ now rewrite normalize_prop_valid.
+Qed.
+
+Theorem normalize_hyps_goal (ep : list Prop) (env : list int) (l : hyps) :
+ interp_goal ep env (normalize_hyps l) -> interp_goal ep env l.
 Proof.
- unfold term_stable, fusion_cancel; intros trace e; elim trace;
- [ exact (reduce_stable e)
- | intros n H t; elim H; exact (T_OMEGA13_stable e t) ].
+ intros; apply valid_goal with (2 := H); apply normalize_hyps_valid.
 Qed.
 
-(* \subsubsection{Opérations affines sur une équation} *)
-(* \paragraph{Multiplication scalaire et somme d'une constante} *)
-
-Fixpoint scalar_norm_add (trace : nat) (t : term) {struct trace} : term :=
-  match trace with
-  | O => reduce t
-  | S trace' => apply_right (scalar_norm_add trace') (T_OMEGA11 t)
-  end.
+(** ** A simple decidability checker
 
-Theorem scalar_norm_add_stable :
- forall t : nat, term_stable (scalar_norm_add t).
-Proof.
- unfold term_stable, scalar_norm_add; intros trace; elim trace;
- [ exact reduce_stable
- | intros n H e t; elim apply_right_stable;
-    [ exact (T_OMEGA11_stable e t) | exact H ] ].
-Qed.
+   For us, everything is considered decidable except
+   propositional atoms [Tprop _]. *)
 
-(* \paragraph{Multiplication scalaire} *)
-Fixpoint scalar_norm (trace : nat) (t : term) {struct trace} : term :=
-  match trace with
-  | O => reduce t
-  | S trace' => apply_right (scalar_norm trace') (T_OMEGA16 t)
+Fixpoint decidability (p : proposition) : bool :=
+  match p with
+  | Tnot t => decidability t
+  | Tand t1 t2 => decidability t1 && decidability t2
+  | Timp t1 t2 => decidability t1 && decidability t2
+  | Tor t1 t2 => decidability t1 && decidability t2
+  | Tprop _ => false
+  | _ => true
   end.
 
-Theorem scalar_norm_stable : forall t : nat, term_stable (scalar_norm t).
-Proof.
- unfold term_stable, scalar_norm; intros trace; elim trace;
- [ exact reduce_stable
- | intros n H e t; elim apply_right_stable;
-    [ exact (T_OMEGA16_stable e t) | exact H ] ].
-Qed.
-
-(* \paragraph{Somme d'une constante} *)
-Fixpoint add_norm (trace : nat) (t : term) {struct trace} : term :=
-  match trace with
-  | O => reduce t
-  | S trace' => apply_right (add_norm trace') (Tplus_assoc_r t)
-  end.
+Theorem decidable_correct :
+ forall (ep : list Prop) (e : list int) (p : proposition),
+ decidability p = true -> decidable (interp_prop ep e p).
+Proof.
+ induction p; simpl; intros Hp; try destruct (andb_prop _ _ Hp).
+ - apply dec_eq.
+ - apply dec_ne.
+ - apply dec_le.
+ - apply dec_ge.
+ - apply dec_gt.
+ - apply dec_lt.
+ - left; auto.
+ - right; unfold not; auto.
+ - apply dec_not; auto.
+ - apply dec_or; auto.
+ - apply dec_and; auto.
+ - apply dec_imp; auto.
+ - discriminate.
+Qed.
+
+(** ** Omega steps
+
+   The following inductive type describes steps as they can be
+   found in the trace coming from the decision procedure Omega.
+   We consider here only normalized equations [0=...], disequations
+   [0<>...] or inequations [0<=...].
+
+   First, the final steps leading to a contradiction:
+   - [O_BAD_CONSTANT i] : hypothesis i has a constant body
+     and this constant is not compatible with the kind of i.
+   - [O_NOT_EXACT_DIVIDE i k] :
+     equation i can be factorized as some [k*t+c] with [0<c<k].
+
+   Now, the intermediate steps leading to a new hypothesis:
+   - [O_DIVIDE i k cont] :
+     the body of hypothesis i could be factorized as [k*t+c]
+     with either [k<>0] and [c=0] for a (dis)equation, or
+     [0<k] and [c<k] for an inequation. We change in-place the
+     body of i for [t].
+   - [O_SUM k1 i1 k2 i2 cont] : creates a new hypothesis whose
+     kind depends on the kind of hypotheses [i1] and [i2], and
+     whose body is [k1*body(i1) + k2*body(i2)]. Depending of the
+     situation, [k1] or [k2] might have to be positive or non-nul.
+   - [O_MERGE_EQ i j cont] :
+     inequations i and j have opposite bodies, we add an equation
+     with one these bodies.
+   - [O_SPLIT_INEQ i cont1 cont2] :
+     disequation i is split into a disjonction of inequations.
+*)
 
-Theorem add_norm_stable : forall t : nat, term_stable (add_norm t).
-Proof.
- unfold term_stable, add_norm; intros trace; elim trace;
- [ exact reduce_stable
- | intros n H e t; elim apply_right_stable;
-    [ exact (Tplus_assoc_r_stable e t) | exact H ] ].
-Qed.
+Definition idx := nat. (** Index of an hypothesis in the list *)
 
-(* \subsection{La fonction de normalisation des termes (moteur de réécriture)} *)
+Inductive t_omega : Set :=
+  | O_BAD_CONSTANT : idx -> t_omega
+  | O_NOT_EXACT_DIVIDE : idx -> int -> t_omega
 
+  | O_DIVIDE : idx -> int -> t_omega -> t_omega
+  | O_SUM : int -> idx -> int -> idx -> t_omega -> t_omega
+  | O_MERGE_EQ : idx -> idx -> t_omega -> t_omega
+  | O_SPLIT_INEQ : idx -> t_omega -> t_omega -> t_omega.
 
-Fixpoint t_rewrite (s : step) : term -> term :=
-  match s with
-  | C_DO_BOTH s1 s2 => apply_both (t_rewrite s1) (t_rewrite s2)
-  | C_LEFT s => apply_left (t_rewrite s)
-  | C_RIGHT s => apply_right (t_rewrite s)
-  | C_SEQ s1 s2 => fun t : term => t_rewrite s2 (t_rewrite s1 t)
-  | C_NOP => fun t : term => t
-  | C_OPP_PLUS => Topp_plus
-  | C_OPP_OPP => Topp_opp
-  | C_OPP_MULT_R => Topp_mult_r
-  | C_OPP_ONE => Topp_one
-  | C_REDUCE => reduce
-  | C_MULT_PLUS_DISTR => Tmult_plus_distr
-  | C_MULT_OPP_LEFT => Tmult_opp_left
-  | C_MULT_ASSOC_R => Tmult_assoc_r
-  | C_PLUS_ASSOC_R => Tplus_assoc_r
-  | C_PLUS_ASSOC_L => Tplus_assoc_l
-  | C_PLUS_PERMUTE => Tplus_permute
-  | C_PLUS_COMM => Tplus_comm
-  | C_RED0 => Tred_factor0
-  | C_RED1 => Tred_factor1
-  | C_RED2 => Tred_factor2
-  | C_RED3 => Tred_factor3
-  | C_RED4 => Tred_factor4
-  | C_RED5 => Tred_factor5
-  | C_RED6 => Tred_factor6
-  | C_MULT_ASSOC_REDUCED => Tmult_assoc_reduced
-  | C_MINUS => Tminus_def
-  | C_MULT_COMM => Tmult_comm
-  end.
+(** ** Actual resolution steps of an omega normalized goal *)
 
-Theorem t_rewrite_stable : forall s : step, term_stable (t_rewrite s).
-Proof.
- simple induction s; simpl;
- [ intros; apply apply_both_stable; auto
- | intros; apply apply_left_stable; auto
- | intros; apply apply_right_stable; auto
- | unfold term_stable; intros; elim H0; apply H
- | unfold term_stable; auto
- | exact Topp_plus_stable
- | exact Topp_opp_stable
- | exact Topp_mult_r_stable
- | exact Topp_one_stable
- | exact reduce_stable
- | exact Tmult_plus_distr_stable
- | exact Tmult_opp_left_stable
- | exact Tmult_assoc_r_stable
- | exact Tplus_assoc_r_stable
- | exact Tplus_assoc_l_stable
- | exact Tplus_permute_stable
- | exact Tplus_comm_stable
- | exact Tred_factor0_stable
- | exact Tred_factor1_stable
- | exact Tred_factor2_stable
- | exact Tred_factor3_stable
- | exact Tred_factor4_stable
- | exact Tred_factor5_stable
- | exact Tred_factor6_stable
- | exact Tmult_assoc_reduced_stable
- | exact Tminus_def_stable
- | exact Tmult_comm_stable ].
-Qed.
+(** First, the final steps, leading to a contradiction *)
 
-(* \subsection{tactiques de résolution d'un but omega normalisé}
-   Trace de la procédure
-\subsubsection{Tactiques générant une contradiction}
-\paragraph{[O_CONSTANT_NOT_NUL]} *)
+(** [O_BAD_CONSTANT] *)
 
-Definition constant_not_nul (i : nat) (h : hyps) :=
+Definition bad_constant (i : nat) (h : hyps) :=
   match nth_hyps i h with
-  | EqTerm (Tint Nul) (Tint n) =>
-      if beq n Nul then h else absurd
+  | EqTerm (Tint Nul) (Tint n) => if n =? Nul then h else absurd
+  | NeqTerm (Tint Nul) (Tint n) => if n =? Nul then absurd else h
+  | LeqTerm (Tint Nul) (Tint n) => if n <? Nul then absurd else h
   | _ => h
   end.
 
-Theorem constant_not_nul_valid :
- forall i : nat, valid_hyps (constant_not_nul i).
+Theorem bad_constant_valid i : valid_hyps (bad_constant i).
 Proof.
- unfold valid_hyps, constant_not_nul; intros i ep e lp H.
+ unfold valid_hyps, bad_constant; intros ep e lp H.
  generalize (nth_valid ep e i lp H); Simplify.
+ rewrite le_lt_iff. intuition.
 Qed.
 
-(* \paragraph{[O_CONSTANT_NEG]} *)
+(** [O_NOT_EXACT_DIVIDE] *)
 
-Definition constant_neg (i : nat) (h : hyps) :=
-  match nth_hyps i h with
-  | LeqTerm (Tint Nul) (Tint Neg) =>
-     if bgt Nul Neg then absurd else h
-  | _ => h
-  end.
-
-Theorem constant_neg_valid : forall i : nat, valid_hyps (constant_neg i).
-Proof.
- unfold valid_hyps, constant_neg; intros;
- generalize (nth_valid ep e i lp); Simplify; simpl.
- rewrite gt_lt_iff in H0; rewrite le_lt_iff; intuition.
-Qed.
-
-(* \paragraph{[NOT_EXACT_DIVIDE]} *)
-Definition not_exact_divide (k1 k2 : int) (body : term)
-  (t i : nat) (l : hyps) :=
+Definition not_exact_divide (i : nat) (k : int) (l : hyps) :=
   match nth_hyps i l with
   | EqTerm (Tint Nul) b =>
-      if beq Nul 0 &&
-         eq_term (scalar_norm_add t (body * Tint k1 + Tint k2)%term) b &&
-         bgt k2 0 &&
-         bgt k1 k2
-      then absurd
+    match scalar_div b k with
+    | Some (body,c) =>
+      if (Nul =? 0) && (0 <? c) && (c <? k) then absurd
       else l
+    | None => l
+    end
   | _ => l
   end.
 
-Theorem not_exact_divide_valid :
- forall (k1 k2 : int) (body : term) (t0 i : nat),
- valid_hyps (not_exact_divide k1 k2 body t0 i).
+Theorem not_exact_divide_valid i k :
+ valid_hyps (not_exact_divide i k).
 Proof.
- unfold valid_hyps, not_exact_divide; intros;
- generalize (nth_valid ep e i lp); Simplify.
- rewrite (scalar_norm_add_stable t0 e), <-H1.
- do 2 rewrite <- scalar_norm_add_stable; simpl in *; intros.
- absurd (interp_term e body * k1 + k2 = 0);
- [ now apply OMEGA4 | symmetry; auto ].
+ unfold valid_hyps, not_exact_divide; intros.
+ generalize (nth_valid ep e i lp).
+ destruct (nth_hyps i lp); simpl; auto.
+ destruct t0; auto.
+ destruct (scalar_div t1 k) as [(body,c)|] eqn:E; auto.
+ Simplify.
+ assert (k <> 0).
+ { intro. apply (lt_not_eq 0 k); eauto using lt_trans. }
+ apply (scalar_div_stable e) in E; auto. simpl in E.
+ intros H'; rewrite <- H' in E; auto.
+ exfalso. revert E. now apply OMEGA4.
 Qed.
 
-(* \paragraph{[O_CONTRADICTION]} *)
+(** Now, the steps generating a new equation. *)
 
-Definition contradiction (t i j : nat) (l : hyps) :=
-  match nth_hyps i l with
-  | LeqTerm (Tint Nul) b1 =>
-      match nth_hyps j l with
-      | LeqTerm (Tint Nul') b2 =>
-          match fusion_cancel t (b1 + b2)%term with
-          | Tint k => if beq Nul 0 && beq Nul' 0 && bgt 0 k
-                      then absurd
-                      else l
-          | _ => l
-          end
-      | _ => l
-      end
-  | _ => l
-  end.
-
-Theorem contradiction_valid :
- forall t i j : nat, valid_hyps (contradiction t i j).
-Proof.
- unfold valid_hyps, contradiction; intros t i j ep e l H;
- generalize (nth_valid _ _ i _ H); generalize (nth_valid _ _ j _ H);
- case (nth_hyps i l); auto; intros t1 t2; case t1;
- auto; case (nth_hyps j l);
- auto; intros t3 t4; case t3; auto;
- simpl; intros z z' H1 H2;
- generalize (eq_refl (interp_term e (fusion_cancel t (t2 + t4)%term)));
- pattern (fusion_cancel t (t2 + t4)%term) at 2 3;
- case (fusion_cancel t (t2 + t4)%term); simpl;
- auto; intro k; elim (fusion_cancel_stable t); simpl.
- Simplify; intro H3.
- generalize (OMEGA2 _ _ H2 H1); rewrite H3.
- rewrite gt_lt_iff in H0; rewrite le_lt_iff; intuition.
-Qed.
+(** [O_DIVIDE] *)
 
-(* \paragraph{[O_NEGATE_CONTRADICT]} *)
-
-Definition negate_contradict (i1 i2 : nat) (h : hyps) :=
-  match nth_hyps i1 h with
-  | EqTerm (Tint Nul) b1 =>
-      match nth_hyps i2 h with
-      | NeqTerm (Tint Nul') b2 =>
-          if beq Nul 0 && beq Nul' 0 && eq_term b1 b2
-          then absurd
-          else h
-      | _ => h
-      end
-  | NeqTerm (Tint Nul) b1 =>
-      match nth_hyps i2 h with
-      | EqTerm (Tint Nul') b2 =>
-          if beq Nul 0 && beq Nul' 0 && eq_term b1 b2
-          then absurd
-          else h
-      | _ => h
-      end
-  | _ => h
-  end.
-
-Definition negate_contradict_inv (t i1 i2 : nat) (h : hyps) :=
-  match nth_hyps i1 h with
-  | EqTerm (Tint Nul) b1 =>
-      match nth_hyps i2 h with
-      | NeqTerm (Tint Nul') b2 =>
-          if beq Nul 0 && beq Nul' 0 &&
-             eq_term b1 (scalar_norm t (b2 * Tint (-(1)))%term)
-          then absurd
-          else h
-      | _ => h
-      end
-  | NeqTerm (Tint Nul) b1 =>
-      match nth_hyps i2 h with
-      | EqTerm (Tint Nul') b2 =>
-          if beq Nul 0 && beq Nul' 0 &&
-             eq_term b1 (scalar_norm t (b2 * Tint (-(1)))%term)
-          then absurd
-          else h
-      | _ => h
-      end
-  | _ => h
+Definition divide (k : int) (prop : proposition) :=
+  match prop with
+  | EqTerm (Tint o) b =>
+    match scalar_div b k with
+    | Some (body,c) =>
+      if (o =? 0) && (c =? 0) && negb (k =? 0)
+      then EqTerm (Tint 0) body
+      else TrueTerm
+    | None => TrueTerm
+    end
+  | NeqTerm (Tint o) b =>
+    match scalar_div b k with
+    | Some (body,c) =>
+      if (o =? 0) && (c =? 0) && negb (k =? 0)
+      then NeqTerm (Tint 0) body
+      else TrueTerm
+    | None => TrueTerm
+    end
+  | LeqTerm (Tint o) b =>
+    match scalar_div b k with
+    | Some (body,c) =>
+      if (o =? 0) && (0 <? k) && (c <? k)
+      then LeqTerm (Tint 0) body
+      else prop
+    | None => prop
+    end
+  | _ => TrueTerm
   end.
 
-Theorem negate_contradict_valid :
- forall i j : nat, valid_hyps (negate_contradict i j).
-Proof.
- unfold valid_hyps, negate_contradict; intros i j ep e l H;
- generalize (nth_valid _ _ i _ H); generalize (nth_valid _ _ j _ H);
- case (nth_hyps i l); auto; intros t1 t2; case t1;
- auto; intros z; auto; case (nth_hyps j l);
- auto; intros t3 t4; case t3; auto; intros z';
- auto; simpl; intros H1 H2; Simplify.
-Qed.
-
-Theorem negate_contradict_inv_valid :
- forall t i j : nat, valid_hyps (negate_contradict_inv t i j).
+Theorem divide_valid k : valid1 (divide k).
 Proof.
- unfold valid_hyps, negate_contradict_inv; intros t i j ep e l H;
- generalize (nth_valid _ _ i _ H); generalize (nth_valid _ _ j _ H);
- case (nth_hyps i l); auto; intros t1 t2; case t1;
- auto; intros z; auto; case (nth_hyps j l);
- auto; intros t3 t4; case t3; auto; intros z';
- auto; simpl; intros H1 H2; Simplify;
- [
- rewrite <- scalar_norm_stable in H2; simpl in *;
- elim (mult_integral (interp_term e t4) (-(1))); intuition;
- elim minus_one_neq_zero; auto
- |
- elim H2; clear H2;
- rewrite <- scalar_norm_stable; simpl in *;
- now rewrite <- H1, mult_0_l
- ].
+ unfold valid1, divide; intros ep e p;
+ destruct p; simpl; auto;
+ destruct t0; simpl; auto;
+ destruct scalar_div as [(body,c)|] eqn:E; simpl; Simplify; auto.
+ - apply (scalar_div_stable e) in E; auto. simpl in E.
+   intros H'; rewrite <- H' in E. rewrite plus_0_r in E.
+   apply mult_integral in E. intuition.
+ - apply (scalar_div_stable e) in E; auto. simpl in E.
+   intros H' H''. now rewrite <- H'', mult_0_l, plus_0_l in E.
+ - assert (k <> 0).
+   { intro. apply (lt_not_eq 0 k); eauto using lt_trans. }
+   apply (scalar_div_stable e) in E; auto. simpl in E. rewrite <- E.
+   intro H'. now apply mult_le_approx with (3 := H').
 Qed.
 
-(* \subsubsection{Tactiques générant une nouvelle équation} *)
-(* \paragraph{[O_SUM]}
- C'est une oper2 valide mais elle traite plusieurs cas à la fois (suivant
- les opérateurs de comparaison des deux arguments) d'où une
- preuve un peu compliquée. On utilise quelques lemmes qui sont des
- généralisations des théorèmes utilisés par OMEGA. *)
+(** [O_SUM]. Invariant: [k1] and [k2] non-nul. *)
 
-Definition sum (k1 k2 : int) (trace : list t_fusion)
-  (prop1 prop2 : proposition) :=
+Definition sum (k1 k2 : int) (prop1 prop2 : proposition) :=
   match prop1 with
-  | EqTerm (Tint Null) b1 =>
+  | EqTerm (Tint o) b1 =>
       match prop2 with
-      | EqTerm (Tint Null') b2 =>
-          if beq Null 0 && beq Null' 0
-          then EqTerm (Tint 0) (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
+      | EqTerm (Tint o') b2 =>
+          if (o =? 0) && (o' =? 0)
+          then EqTerm (Tint 0) (fusion b1 b2 k1 k2)
+          else TrueTerm
+      | LeqTerm (Tint o') b2 =>
+          if (o =? 0) && (o' =? 0) && (0 <? k2)
+          then LeqTerm (Tint 0) (fusion b1 b2 k1 k2)
           else TrueTerm
-      | LeqTerm (Tint Null') b2 =>
-          if beq Null 0 && beq Null' 0 && bgt k2 0
-          then LeqTerm (Tint 0)
-                (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
+      | NeqTerm (Tint o') b2 =>
+          if (o =? 0) && (o' =? 0) && negb (k2 =? 0)
+          then NeqTerm (Tint 0) (fusion b1 b2 k1 k2)
           else TrueTerm
       | _ => TrueTerm
       end
-  | LeqTerm (Tint Null) b1 =>
-      if beq Null 0 && bgt k1 0
+  | LeqTerm (Tint o) b1 =>
+      if (o =? 0) && (0 <? k1)
       then match prop2 with
-          | EqTerm (Tint Null') b2 =>
-              if beq Null' 0 then
-              LeqTerm (Tint 0)
-                (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
+          | EqTerm (Tint o') b2 =>
+              if o' =? 0 then
+              LeqTerm (Tint 0) (fusion b1 b2 k1 k2)
               else TrueTerm
-          | LeqTerm (Tint Null') b2 =>
-              if beq Null' 0 && bgt k2 0
-              then LeqTerm (Tint 0)
-                    (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
+          | LeqTerm (Tint o') b2 =>
+              if (o' =? 0) && (0 <? k2)
+              then LeqTerm (Tint 0) (fusion b1 b2 k1 k2)
               else TrueTerm
           | _ => TrueTerm
           end
       else TrueTerm
-  | NeqTerm (Tint Null) b1 =>
+  | NeqTerm (Tint o) b1 =>
       match prop2 with
-      | EqTerm (Tint Null') b2 =>
-          if beq Null 0 && beq Null' 0 && (negb (beq k1 0))
-          then NeqTerm (Tint 0)
-                 (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
+      | EqTerm (Tint o') b2 =>
+          if (o =? 0) && (o' =? 0) && negb (k1 =? 0)
+          then NeqTerm (Tint 0) (fusion b1 b2 k1 k2)
           else TrueTerm
       | _ => TrueTerm
       end
   | _ => TrueTerm
   end.
 
-
 Theorem sum_valid :
- forall (k1 k2 : int) (t : list t_fusion), valid2 (sum k1 k2 t).
+ forall (k1 k2 : int), valid2 (sum k1 k2).
 Proof.
  unfold valid2; intros k1 k2 t ep e p1 p2; unfold sum;
- Simplify; simpl; auto; try elim (fusion_stable t);
- simpl; intros;
- [ apply sum1; assumption
- | apply sum2; try assumption; apply sum4; assumption
- | rewrite plus_comm; apply sum2; try assumption; apply sum4; assumption
- | apply sum3; try assumption; apply sum4; assumption
- | apply sum5; auto ].
-Qed.
-
-(* \paragraph{[O_EXACT_DIVIDE]}
-   c'est une oper1 valide mais on préfère une substitution a ce point la *)
-
-Definition exact_divide (k : int) (body : term) (t : nat)
-  (prop : proposition) :=
-  match prop with
-  | EqTerm (Tint Null) b =>
-      if beq Null 0 &&
-         eq_term (scalar_norm t (body * Tint k)%term) b &&
-         negb (beq k 0)
-      then EqTerm (Tint 0) body
-      else TrueTerm
-  | NeqTerm (Tint Null) b =>
-      if beq Null 0 &&
-         eq_term (scalar_norm t (body * Tint k)%term) b &&
-         negb (beq k 0)
-      then NeqTerm (Tint 0) body
-      else TrueTerm
-  | _ => TrueTerm
-  end.
-
-Theorem exact_divide_valid :
- forall (k : int) (t : term) (n : nat), valid1 (exact_divide k t n).
-Proof.
- unfold valid1, exact_divide; intros k1 k2 t ep e p1;
- Simplify; simpl; auto; subst;
- rewrite <- scalar_norm_stable; simpl; intros;
- [ destruct (mult_integral _ _ (eq_sym H0)); intuition
- | contradict H0; rewrite <- H0, mult_0_l; auto
- ].
+ Simplify; simpl; rewrite ?fusion_stable;
+ simpl; intros; auto.
+ - apply sum1; auto.
+ - rewrite plus_comm. apply sum5; auto.
+ - apply sum2; auto using lt_le_weak.
+ - apply sum5; auto.
+ - rewrite plus_comm. apply sum2; auto using lt_le_weak.
+ - apply sum3; auto using lt_le_weak.
 Qed.
 
+(** [MERGE_EQ] *)
 
-(* \paragraph{[O_DIV_APPROX]}
-  La preuve reprend le schéma de la précédente mais on
-  est sur une opération de type valid1 et non sur une opération terminale. *)
-
-Definition divide_and_approx (k1 k2 : int) (body : term)
-  (t : nat) (prop : proposition) :=
-  match prop with
-  | LeqTerm (Tint Null) b =>
-      if beq Null 0 &&
-         eq_term (scalar_norm_add t (body * Tint k1 + Tint k2)%term) b &&
-         bgt k1 0 &&
-         bgt k1 k2
-      then LeqTerm (Tint 0) body
-      else prop
-  | _ => prop
-  end.
-
-Theorem divide_and_approx_valid :
- forall (k1 k2 : int) (body : term) (t : nat),
- valid1 (divide_and_approx k1 k2 body t).
-Proof.
- unfold valid1, divide_and_approx; intros k1 k2 body t ep e p1;
- Simplify; simpl; auto; subst;
- elim (scalar_norm_add_stable t e); simpl.
- intro H2; apply mult_le_approx with (3 := H2); assumption.
-Qed.
-
-(* \paragraph{[MERGE_EQ]} *)
-
-Definition merge_eq (t : nat) (prop1 prop2 : proposition) :=
+Definition merge_eq (prop1 prop2 : proposition) :=
   match prop1 with
-  | LeqTerm (Tint Null) b1 =>
+  | LeqTerm (Tint o) b1 =>
       match prop2 with
-      | LeqTerm (Tint Null') b2 =>
-          if beq Null 0 && beq Null' 0 &&
-             eq_term b1 (scalar_norm t (b2 * Tint (-(1)))%term)
+      | LeqTerm (Tint o') b2 =>
+          if (o =? 0) && (o' =? 0) &&
+             (b1 =? scalar_mult b2 (-(1)))%term
           then EqTerm (Tint 0) b1
           else TrueTerm
       | _ => TrueTerm
@@ -2370,680 +1603,153 @@ Definition merge_eq (t : nat) (prop1 prop2 : proposition) :=
   | _ => TrueTerm
   end.
 
-Theorem merge_eq_valid : forall n : nat, valid2 (merge_eq n).
-Proof.
- unfold valid2, merge_eq; intros n ep e p1 p2; Simplify; simpl;
- auto; elim (scalar_norm_stable n e); simpl;
- intros; symmetry ; apply OMEGA8 with (2 := H0);
- [ assumption | elim opp_eq_mult_neg_1; trivial ].
-Qed.
-
-
-
-(* \paragraph{[O_CONSTANT_NUL]} *)
-
-Definition constant_nul (i : nat) (h : hyps) :=
-  match nth_hyps i h with
-  | NeqTerm (Tint Null) (Tint Null') =>
-      if beq Null Null' then absurd else h
-  | _ => h
-  end.
-
-Theorem constant_nul_valid : forall i : nat, valid_hyps (constant_nul i).
-Proof.
- unfold valid_hyps, constant_nul; intros;
- generalize (nth_valid ep e i lp); Simplify; simpl;
- intro H1; absurd (0 = 0); intuition.
-Qed.
-
-(* \paragraph{[O_STATE]} *)
-
-Definition state (m : int) (s : step) (prop1 prop2 : proposition) :=
-  match prop1 with
-  | EqTerm (Tint Null) b1 =>
-      match prop2 with
-      | EqTerm b2 b3 =>
-          if beq Null 0
-          then EqTerm (Tint 0) (t_rewrite s (b1 + (- b3 + b2) * Tint m)%term)
-          else TrueTerm
-      | _ => TrueTerm
-      end
-  | _ => TrueTerm
-  end.
-
-Theorem state_valid : forall (m : int) (s : step), valid2 (state m s).
+Theorem merge_eq_valid : valid2 merge_eq.
 Proof.
- unfold valid2; intros m s ep e p1 p2; unfold state; Simplify;
- simpl; auto; elim (t_rewrite_stable s e); simpl;
- intros H1 H2; elim H1.
- now rewrite H2, plus_opp_l, plus_0_l, mult_0_l.
+ unfold valid2, merge_eq; intros ep e p1 p2; Simplify; simpl; auto.
+ rewrite scalar_mult_stable. simpl.
+ intros; symmetry ; apply OMEGA8 with (2 := H0).
+ - assumption.
+ - elim opp_eq_mult_neg_1; trivial.
 Qed.
 
-(* \subsubsection{Tactiques générant plusieurs but}
-   \paragraph{[O_SPLIT_INEQ]}
-   La seule pour le moment (tant que la normalisation n'est pas réfléchie). *)
+(** [O_SPLIT_INEQ] (only step to produce two subgoals). *)
 
-Definition split_ineq (i t : nat) (f1 f2 : hyps -> lhyps)
-  (l : hyps) :=
+Definition split_ineq (i : nat) (f1 f2 : hyps -> lhyps) (l : hyps) :=
   match nth_hyps i l with
-  | NeqTerm (Tint Null) b1 =>
-      if beq Null 0 then
-      f1 (LeqTerm (Tint 0) (add_norm t (b1 + Tint (-(1)))%term) :: l) ++
-      f2
-        (LeqTerm (Tint 0)
-           (scalar_norm_add t (b1 * Tint (-(1)) + Tint (-(1)))%term) :: l)
-       else l :: nil
+  | NeqTerm (Tint o) b1 =>
+      if o =? 0 then
+       f1 (LeqTerm (Tint 0) (scalar_add b1 (-(1))) :: l) ++
+       f2 (LeqTerm (Tint 0) (scalar_mult_add b1 (-(1)) (-(1))) :: l)
+      else l :: nil
   | _ => l :: nil
   end.
 
 Theorem split_ineq_valid :
- forall (i t : nat) (f1 f2 : hyps -> lhyps),
+ forall (i : nat) (f1 f2 : hyps -> lhyps),
  valid_list_hyps f1 ->
- valid_list_hyps f2 -> valid_list_hyps (split_ineq i t f1 f2).
+ valid_list_hyps f2 -> valid_list_hyps (split_ineq i f1 f2).
 Proof.
- unfold valid_list_hyps, split_ineq; intros i t f1 f2 H1 H2 ep e lp H;
+ unfold valid_list_hyps, split_ineq; intros i f1 f2 H1 H2 ep e lp H;
  generalize (nth_valid _ _ i _ H); case (nth_hyps i lp);
  simpl; auto; intros t1 t2; case t1; simpl;
  auto; intros z; simpl; auto; intro H3.
  Simplify.
- apply append_valid; elim (OMEGA19 (interp_term e t2));
- [ intro H4; left; apply H1; simpl; elim (add_norm_stable t);
-    simpl; auto
- | intro H4; right; apply H2; simpl; elim (scalar_norm_add_stable t);
-    simpl; auto
- | generalize H3; unfold not; intros E1 E2; apply E1;
-    symmetry ; trivial ].
+ apply append_valid; elim (OMEGA19 (interp_term e t2)).
+ - intro H4; left; apply H1; simpl; rewrite scalar_add_stable;
+    simpl; auto.
+ - intro H4; right; apply H2; simpl; rewrite scalar_mult_add_stable;
+    simpl; auto.
+ - generalize H3; unfold not; intros E1 E2; apply E1;
+    symmetry ; trivial.
 Qed.
 
+(** ** Replaying the resolution trace *)
 
-(* \subsection{La fonction de rejeu de la trace} *)
-
-Fixpoint execute_omega (t : t_omega) (l : hyps) {struct t} : lhyps :=
+Fixpoint execute_omega (t : t_omega) (l : hyps) : lhyps :=
   match t with
-  | O_CONSTANT_NOT_NUL n => singleton (constant_not_nul n l)
-  | O_CONSTANT_NEG n => singleton (constant_neg n l)
-  | O_DIV_APPROX k1 k2 body t cont n =>
-      execute_omega cont (apply_oper_1 n (divide_and_approx k1 k2 body t) l)
-  | O_NOT_EXACT_DIVIDE k1 k2 body t i =>
-      singleton (not_exact_divide k1 k2 body t i l)
-  | O_EXACT_DIVIDE k body t cont n =>
-      execute_omega cont (apply_oper_1 n (exact_divide k body t) l)
-  | O_SUM k1 i1 k2 i2 t cont =>
-      execute_omega cont (apply_oper_2 i1 i2 (sum k1 k2 t) l)
-  | O_CONTRADICTION t i j => singleton (contradiction t i j l)
-  | O_MERGE_EQ t i1 i2 cont =>
-      execute_omega cont (apply_oper_2 i1 i2 (merge_eq t) l)
-  | O_SPLIT_INEQ t i cont1 cont2 =>
-      split_ineq i t (execute_omega cont1) (execute_omega cont2) l
-  | O_CONSTANT_NUL i => singleton (constant_nul i l)
-  | O_NEGATE_CONTRADICT i j => singleton (negate_contradict i j l)
-  | O_NEGATE_CONTRADICT_INV t i j =>
-      singleton (negate_contradict_inv t i j l)
-  | O_STATE m s i1 i2 cont =>
-      execute_omega cont (apply_oper_2 i1 i2 (state m s) l)
+  | O_BAD_CONSTANT i => singleton (bad_constant i l)
+  | O_NOT_EXACT_DIVIDE i k => singleton (not_exact_divide i k l)
+  | O_DIVIDE i k cont =>
+      execute_omega cont (apply_oper_1 i (divide k) l)
+  | O_SUM k1 i1 k2 i2 cont =>
+      execute_omega cont (apply_oper_2 i1 i2 (sum k1 k2) l)
+  | O_MERGE_EQ i1 i2 cont =>
+      execute_omega cont (apply_oper_2 i1 i2 merge_eq l)
+  | O_SPLIT_INEQ i cont1 cont2 =>
+      split_ineq i (execute_omega cont1) (execute_omega cont2) l
   end.
 
 Theorem omega_valid : forall tr : t_omega, valid_list_hyps (execute_omega tr).
 Proof.
- simple induction tr; simpl;
- [ unfold valid_list_hyps; simpl; intros; left;
-    apply (constant_not_nul_valid n ep e lp H)
- | unfold valid_list_hyps; simpl; intros; left;
-    apply (constant_neg_valid n ep e lp H)
- | unfold valid_list_hyps, valid_hyps;
-    intros k1 k2 body n t' Ht' m ep e lp H; apply Ht';
-    apply
-     (apply_oper_1_valid m (divide_and_approx k1 k2 body n)
-        (divide_and_approx_valid k1 k2 body n) ep e lp H)
- | unfold valid_list_hyps; simpl; intros; left;
-    apply (not_exact_divide_valid _ _ _ _ _ ep e lp H)
- | unfold valid_list_hyps, valid_hyps;
-    intros k body n t' Ht' m ep e lp H; apply Ht';
+ simple induction tr; unfold valid_list_hyps, valid_hyps; simpl.
+ - intros; left; now apply bad_constant_valid.
+ - intros; left; now apply not_exact_divide_valid.
+ - intros m k t' Ht' ep e lp H; apply Ht';
     apply
-     (apply_oper_1_valid m (exact_divide k body n)
-        (exact_divide_valid k body n) ep e lp H)
- | unfold valid_list_hyps, valid_hyps;
-    intros k1 i1 k2 i2 trace t' Ht' ep e lp H; apply Ht';
+     (apply_oper_1_valid m (divide k)
+        (divide_valid k) ep e lp H).
+ - intros k1 i1 k2 i2 t' Ht' ep e lp H; apply Ht';
     apply
-     (apply_oper_2_valid i1 i2 (sum k1 k2 trace) (sum_valid k1 k2 trace) ep e
-        lp H)
- | unfold valid_list_hyps; simpl; intros; left;
-    apply (contradiction_valid n n0 n1 ep e lp H)
- | unfold valid_list_hyps, valid_hyps;
-    intros trace i1 i2 t' Ht' ep e lp H; apply Ht';
+     (apply_oper_2_valid i1 i2 (sum k1 k2) (sum_valid k1 k2) ep e
+        lp H).
+ - intros i1 i2 t' Ht' ep e lp H; apply Ht';
     apply
-     (apply_oper_2_valid i1 i2 (merge_eq trace) (merge_eq_valid trace) ep e
-        lp H)
- | intros t' i k1 H1 k2 H2; unfold valid_list_hyps; simpl;
-    intros ep e lp H;
+     (apply_oper_2_valid i1 i2 merge_eq merge_eq_valid ep e
+        lp H).
+ - intros i k1 H1 k2 H2 ep e lp H;
     apply
-     (split_ineq_valid i t' (execute_omega k1) (execute_omega k2) H1 H2 ep e
-        lp H)
- | unfold valid_list_hyps; simpl; intros i ep e lp H; left;
-    apply (constant_nul_valid i ep e lp H)
- | unfold valid_list_hyps; simpl; intros i j ep e lp H; left;
-    apply (negate_contradict_valid i j ep e lp H)
- | unfold valid_list_hyps; simpl; intros n i j ep e lp H;
-    left; apply (negate_contradict_inv_valid n i j ep e lp H)
- | unfold valid_list_hyps, valid_hyps;
-    intros m s i1 i2 t' Ht' ep e lp H; apply Ht';
-    apply (apply_oper_2_valid i1 i2 (state m s) (state_valid m s) ep e lp H) ].
-Qed.
-
-
-(* \subsection{Les opérations globales sur le but}
-   \subsubsection{Normalisation} *)
-
-Definition move_right (s : step) (p : proposition) :=
-  match p with
-  | EqTerm t1 t2 => EqTerm (Tint 0) (t_rewrite s (t1 + - t2)%term)
-  | LeqTerm t1 t2 => LeqTerm (Tint 0) (t_rewrite s (t2 + - t1)%term)
-  | GeqTerm t1 t2 => LeqTerm (Tint 0) (t_rewrite s (t1 + - t2)%term)
-  | LtTerm t1 t2 => LeqTerm (Tint 0) (t_rewrite s (t2 + Tint (-(1)) + - t1)%term)
-  | GtTerm t1 t2 => LeqTerm (Tint 0) (t_rewrite s (t1 + Tint (-(1)) + - t2)%term)
-  | NeqTerm t1 t2 => NeqTerm (Tint 0) (t_rewrite s (t1 + - t2)%term)
-  | p => p
-  end.
-
-Theorem move_right_valid : forall s : step, valid1 (move_right s).
-Proof.
- unfold valid1, move_right; intros s ep e p; Simplify; simpl;
- elim (t_rewrite_stable s e); simpl;
- [ symmetry ; apply egal_left; assumption
- | intro; apply le_left; assumption
- | intro; apply le_left; rewrite <- ge_le_iff; assumption
- | intro; apply lt_left; rewrite <- gt_lt_iff; assumption
- | intro; apply lt_left; assumption
- | intro; apply ne_left_2; assumption ].
-Qed.
-
-Definition do_normalize (i : nat) (s : step) := apply_oper_1 i (move_right s).
-
-Theorem do_normalize_valid :
- forall (i : nat) (s : step), valid_hyps (do_normalize i s).
-Proof.
- intros; unfold do_normalize; apply apply_oper_1_valid;
- apply move_right_valid.
-Qed.
-
-Fixpoint do_normalize_list (l : list step) (i : nat)
- (h : hyps) {struct l} : hyps :=
-  match l with
-  | s :: l' => do_normalize_list l' (S i) (do_normalize i s h)
-  | nil => h
-  end.
-
-Theorem do_normalize_list_valid :
- forall (l : list step) (i : nat), valid_hyps (do_normalize_list l i).
-Proof.
- simple induction l; simpl; unfold valid_hyps;
- [ auto
- | intros a l' Hl' i ep e lp H; unfold valid_hyps in Hl'; apply Hl';
-    apply (do_normalize_valid i a ep e lp); assumption ].
-Qed.
-
-Theorem normalize_goal :
- forall (s : list step) (ep : list Prop) (env : list int) (l : hyps),
- interp_goal ep env (do_normalize_list s 0 l) -> interp_goal ep env l.
-Proof.
- intros; apply valid_goal with (2 := H); apply do_normalize_list_valid.
+     (split_ineq_valid i (execute_omega k1) (execute_omega k2) H1 H2 ep e
+        lp H).
 Qed.
 
-(* \subsubsection{Exécution de la trace} *)
 
-Theorem execute_goal :
- forall (tr : t_omega) (ep : list Prop) (env : list int) (l : hyps),
- interp_list_goal ep env (execute_omega tr l) -> interp_goal ep env l.
-Proof.
- intros; apply (goal_valid (execute_omega tr) (omega_valid tr) ep env l H).
-Qed.
+(** ** Rules for decomposing the hypothesis
 
+   This type allows navigation in the logical constructors that
+   form the predicats of the hypothesis in order to decompose them.
+   This allows in particular to extract one hypothesis from a conjunction.
+   NB: negations are now silently traversed. *)
 
-Theorem append_goal :
- forall (ep : list Prop) (e : list int) (l1 l2 : lhyps),
- interp_list_goal ep e l1 /\ interp_list_goal ep e l2 ->
- interp_list_goal ep e (l1 ++ l2).
-Proof.
- intros ep e; simple induction l1;
- [ simpl; intros l2 (H1, H2); assumption
- | simpl; intros h1 t1 HR l2 ((H1, H2), H3); split; auto ].
-Qed.
-
-(* A simple decidability checker : if the proposition belongs to the
-   simple grammar describe below then it is decidable. Proof is by
-   induction and uses well known theorem about arithmetic and propositional
-   calculus *)
-
-Fixpoint decidability (p : proposition) : bool :=
-  match p with
-  | EqTerm _ _ => true
-  | LeqTerm _ _ => true
-  | GeqTerm _ _ => true
-  | GtTerm _ _ => true
-  | LtTerm _ _ => true
-  | NeqTerm _ _ => true
-  | FalseTerm => true
-  | TrueTerm => true
-  | Tnot t => decidability t
-  | Tand t1 t2 => decidability t1 && decidability t2
-  | Timp t1 t2 => decidability t1 && decidability t2
-  | Tor t1 t2 => decidability t1 && decidability t2
-  | Tprop _ => false
-  end.
-
-Theorem decidable_correct :
- forall (ep : list Prop) (e : list int) (p : proposition),
- decidability p = true -> decidable (interp_proposition ep e p).
-Proof.
- simple induction p; simpl; intros;
- [ apply dec_eq
- | apply dec_le
- | left; auto
- | right; unfold not; auto
- | apply dec_not; auto
- | apply dec_ge
- | apply dec_gt
- | apply dec_lt
- | apply dec_ne
- | apply dec_or; elim andb_prop with (1 := H1); auto
- | apply dec_and; elim andb_prop with (1 := H1); auto
- | apply dec_imp; elim andb_prop with (1 := H1); auto
- | discriminate H ].
-Qed.
-
-(* An interpretation function for a complete goal with an explicit
-   conclusion. We use an intermediate fixpoint. *)
-
-Fixpoint interp_full_goal (envp : list Prop) (env : list int)
- (c : proposition) (l : hyps) {struct l} : Prop :=
-  match l with
-  | nil => interp_proposition envp env c
-  | p' :: l' =>
-      interp_proposition envp env p' -> interp_full_goal envp env c l'
-  end.
-
-Definition interp_full (ep : list Prop) (e : list int)
-  (lc : hyps * proposition) : Prop :=
-  match lc with
-  | (l, c) => interp_full_goal ep e c l
-  end.
-
-(* Relates the interpretation of a complete goal with the interpretation
-   of its hypothesis and conclusion *)
-
-Theorem interp_full_false :
- forall (ep : list Prop) (e : list int) (l : hyps) (c : proposition),
- (interp_hyps ep e l -> interp_proposition ep e c) -> interp_full ep e (l, c).
-Proof.
- simple induction l; unfold interp_full; simpl;
- [ auto | intros a l1 H1 c H2 H3; apply H1; auto ].
-Qed.
-
-(* Push the conclusion in the list of hypothesis using a double negation
-   If the decidability cannot be "proven", then just forget about the
-   conclusion (equivalent of replacing it with false) *)
-
-Definition to_contradict (lc : hyps * proposition) :=
-  match lc with
-  | (l, c) => if decidability c then Tnot c :: l else l
-  end.
-
-(* The previous operation is valid in the sense that the new list of
-   hypothesis implies the original goal *)
-
-Theorem to_contradict_valid :
- forall (ep : list Prop) (e : list int) (lc : hyps * proposition),
- interp_goal ep e (to_contradict lc) -> interp_full ep e lc.
-Proof.
- intros ep e lc; case lc; intros l c; simpl;
- pattern (decidability c); apply bool_eq_ind;
- [ simpl; intros H H1; apply interp_full_false; intros H2;
-    apply not_not;
-    [ apply decidable_correct; assumption
-    | unfold not at 1; intro H3; apply hyps_to_goal with (2 := H2);
-       auto ]
- | intros H1 H2; apply interp_full_false; intro H3;
-    elim hyps_to_goal with (1 := H2); assumption ].
-Qed.
-
-(* [map_cons x l] adds [x] at the head of each list in [l] (which is a list
-   of lists *)
-
-Fixpoint map_cons (A : Set) (x : A) (l : list (list A)) {struct l} :
- list (list A) :=
-  match l with
-  | nil => nil
-  | l :: ll => (x :: l) :: map_cons A x ll
-  end.
-
-(* This function breaks up a list of hypothesis in a list of simpler
-   list of hypothesis that together implie the original one. The goal
-   of all this is to transform the goal in a list of solvable problems.
-   Note that :
-	- we need a way to drive the analysis as some hypotheis may not
-          require a split.
-        - this procedure must be perfectly mimicked by the ML part otherwise
-          hypothesis will get desynchronised and this will be a mess.
- *)
-
-Fixpoint destructure_hyps (nn : nat) (ll : hyps) {struct nn} : lhyps :=
-  match nn with
-  | O => ll :: nil
-  | S n =>
-      match ll with
-      | nil => nil :: nil
-      | Tor p1 p2 :: l =>
-          destructure_hyps n (p1 :: l) ++ destructure_hyps n (p2 :: l)
-      | Tand p1 p2 :: l => destructure_hyps n (p1 :: p2 :: l)
-      | Timp p1 p2 :: l =>
-          if decidability p1
-          then
-           destructure_hyps n (Tnot p1 :: l) ++ destructure_hyps n (p2 :: l)
-          else map_cons _ (Timp p1 p2) (destructure_hyps n l)
-      | Tnot p :: l =>
-          match p with
-          | Tnot p1 =>
-              if decidability p1
-              then destructure_hyps n (p1 :: l)
-              else map_cons _ (Tnot (Tnot p1)) (destructure_hyps n l)
-          | Tor p1 p2 => destructure_hyps n (Tnot p1 :: Tnot p2 :: l)
-          | Tand p1 p2 =>
-              if decidability p1
-              then
-               destructure_hyps n (Tnot p1 :: l) ++
-               destructure_hyps n (Tnot p2 :: l)
-              else map_cons _ (Tnot p) (destructure_hyps n l)
-          | _ => map_cons _ (Tnot p) (destructure_hyps n l)
-          end
-      | x :: l => map_cons _ x (destructure_hyps n l)
-      end
-  end.
-
-Theorem map_cons_val :
- forall (ep : list Prop) (e : list int) (p : proposition) (l : lhyps),
- interp_proposition ep e p ->
- interp_list_hyps ep e l -> interp_list_hyps ep e (map_cons _ p l).
-Proof.
- simple induction l; simpl; [ auto | intros; elim H1; intro H2; auto ].
-Qed.
-
-Hint Resolve map_cons_val append_valid decidable_correct.
-
-Theorem destructure_hyps_valid :
- forall n : nat, valid_list_hyps (destructure_hyps n).
-Proof.
- simple induction n;
- [ unfold valid_list_hyps; simpl; auto
- | unfold valid_list_hyps at 2; intros n1 H ep e lp; case lp;
-    [ simpl; auto
-    | intros p l; case p;
-       try
-        (simpl; intros; apply map_cons_val; simpl; elim H0;
-          auto);
-       [ intro p'; case p';
-          try
-           (simpl; intros; apply map_cons_val; simpl; elim H0;
-             auto);
-          [ simpl; intros p1 (H1, H2);
-             pattern (decidability p1); apply bool_eq_ind;
-             intro H3;
-             [ apply H; simpl; split;
-                [ apply not_not; auto | assumption ]
-             | auto ]
-          | simpl; intros p1 p2 (H1, H2); apply H; simpl;
-             elim not_or with (1 := H1); auto
-          | simpl; intros p1 p2 (H1, H2);
-             pattern (decidability p1); apply bool_eq_ind;
-             intro H3;
-             [ apply append_valid; elim not_and with (2 := H1);
-                [ intro; left; apply H; simpl; auto
-                | intro; right; apply H; simpl; auto
-                | auto ]
-             | auto ] ]
-       | simpl; intros p1 p2 (H1, H2); apply append_valid;
-          (elim H1; intro H3; simpl; [ left | right ]);
-          apply H; simpl; auto
-       | simpl; intros; apply H; simpl; tauto
-       | simpl; intros p1 p2 (H1, H2);
-          pattern (decidability p1); apply bool_eq_ind;
-          intro H3;
-          [ apply append_valid; elim imp_simp with (2 := H1);
-             [ intro H4; left; simpl; apply H; simpl; auto
-             | intro H4; right; simpl; apply H; simpl; auto
-             | auto ]
-          | auto ] ] ] ].
-Qed.
-
-Definition prop_stable (f : proposition -> proposition) :=
-  forall (ep : list Prop) (e : list int) (p : proposition),
-  interp_proposition ep e p <-> interp_proposition ep e (f p).
-
-Definition p_apply_left (f : proposition -> proposition)
-  (p : proposition) :=
-  match p with
-  | Timp x y => Timp (f x) y
-  | Tor x y => Tor (f x) y
-  | Tand x y => Tand (f x) y
-  | Tnot x => Tnot (f x)
-  | x => x
-  end.
-
-Theorem p_apply_left_stable :
- forall f : proposition -> proposition,
- prop_stable f -> prop_stable (p_apply_left f).
-Proof.
- unfold prop_stable; intros f H ep e p; split;
- (case p; simpl; auto; intros p1; elim (H ep e p1); tauto).
-Qed.
-
-Definition p_apply_right (f : proposition -> proposition)
-  (p : proposition) :=
-  match p with
-  | Timp x y => Timp x (f y)
-  | Tor x y => Tor x (f y)
-  | Tand x y => Tand x (f y)
-  | Tnot x => Tnot (f x)
-  | x => x
-  end.
-
-Theorem p_apply_right_stable :
- forall f : proposition -> proposition,
- prop_stable f -> prop_stable (p_apply_right f).
-Proof.
- unfold prop_stable; intros f H ep e p; split;
- (case p; simpl; auto;
-   [ intros p1; elim (H ep e p1); tauto
-   | intros p1 p2; elim (H ep e p2); tauto
-   | intros p1 p2; elim (H ep e p2); tauto
-   | intros p1 p2; elim (H ep e p2); tauto ]).
-Qed.
-
-Definition p_invert (f : proposition -> proposition)
-  (p : proposition) :=
-  match p with
-  | EqTerm x y => Tnot (f (NeqTerm x y))
-  | LeqTerm x y => Tnot (f (GtTerm x y))
-  | GeqTerm x y => Tnot (f (LtTerm x y))
-  | GtTerm x y => Tnot (f (LeqTerm x y))
-  | LtTerm x y => Tnot (f (GeqTerm x y))
-  | NeqTerm x y => Tnot (f (EqTerm x y))
-  | x => x
-  end.
-
-Theorem p_invert_stable :
- forall f : proposition -> proposition,
- prop_stable f -> prop_stable (p_invert f).
-Proof.
- unfold prop_stable; intros f H ep e p; split;
- (case p; simpl; auto;
-   [ intros t1 t2; elim (H ep e (NeqTerm t1 t2)); simpl;
-      generalize (dec_eq (interp_term e t1) (interp_term e t2));
-      unfold decidable; tauto
-   | intros t1 t2; elim (H ep e (GtTerm t1 t2)); simpl;
-      generalize (dec_gt (interp_term e t1) (interp_term e t2));
-      unfold decidable; rewrite le_lt_iff, <- gt_lt_iff; tauto
-   | intros t1 t2; elim (H ep e (LtTerm t1 t2)); simpl;
-      generalize (dec_lt (interp_term e t1) (interp_term e t2));
-      unfold decidable; rewrite ge_le_iff, le_lt_iff; tauto
-   | intros t1 t2; elim (H ep e (LeqTerm t1 t2)); simpl;
-      generalize (dec_gt (interp_term e t1) (interp_term e t2));
-      unfold decidable; repeat rewrite le_lt_iff;
-      repeat rewrite gt_lt_iff; tauto
-   | intros t1 t2; elim (H ep e (GeqTerm t1 t2)); simpl;
-      generalize (dec_lt (interp_term e t1) (interp_term e t2));
-      unfold decidable; repeat rewrite ge_le_iff;
-      repeat rewrite le_lt_iff; tauto
-   | intros t1 t2; elim (H ep e (EqTerm t1 t2)); simpl;
-      generalize (dec_eq (interp_term e t1) (interp_term e t2));
-      unfold decidable; tauto ]).
-Qed.
-
-Theorem move_right_stable : forall s : step, prop_stable (move_right s).
-Proof.
- unfold move_right, prop_stable; intros s ep e p; split;
- [ Simplify; simpl; elim (t_rewrite_stable s e); simpl;
-    [ symmetry ; apply egal_left; assumption
-    | intro; apply le_left; assumption
-    | intro; apply le_left; rewrite <- ge_le_iff; assumption
-    | intro; apply lt_left; rewrite <- gt_lt_iff; assumption
-    | intro; apply lt_left; assumption
-    | intro; apply ne_left_2; assumption ]
- | case p; simpl; intros; auto; generalize H; elim (t_rewrite_stable s);
-    simpl; intro H1;
-    [ rewrite (plus_0_r_reverse (interp_term e t1)); rewrite H1;
-       rewrite plus_permute; rewrite plus_opp_r;
-       rewrite plus_0_r; trivial
-    | apply (fun a b => plus_le_reg_r a b (- interp_term e t0));
-       rewrite plus_opp_r; assumption
-    | rewrite ge_le_iff;
-       apply (fun a b => plus_le_reg_r a b (- interp_term e t1));
-       rewrite plus_opp_r; assumption
-    | rewrite gt_lt_iff; apply lt_left_inv; assumption
-    | apply lt_left_inv; assumption
-    | unfold not; intro H2; apply H1;
-       rewrite H2; rewrite plus_opp_r; trivial ] ].
-Qed.
-
-
-Fixpoint p_rewrite (s : p_step) : proposition -> proposition :=
-  match s with
-  | P_LEFT s => p_apply_left (p_rewrite s)
-  | P_RIGHT s => p_apply_right (p_rewrite s)
-  | P_STEP s => move_right s
-  | P_INVERT s => p_invert (move_right s)
-  | P_NOP => fun p : proposition => p
-  end.
-
-Theorem p_rewrite_stable : forall s : p_step, prop_stable (p_rewrite s).
-Proof.
- simple induction s; simpl;
- [ intros; apply p_apply_left_stable; trivial
- | intros; apply p_apply_right_stable; trivial
- | intros; apply p_invert_stable; apply move_right_stable
- | apply move_right_stable
- | unfold prop_stable; simpl; intros; split; auto ].
-Qed.
+Inductive direction : Set :=
+  | D_left : direction
+  | D_right : direction.
 
-Fixpoint normalize_hyps (l : list h_step) (lh : hyps) {struct l} : hyps :=
-  match l with
-  | nil => lh
-  | pair_step i s :: r => normalize_hyps r (apply_oper_1 i (p_rewrite s) lh)
-  end.
+(** This type allows extracting useful components from hypothesis, either
+   hypothesis generated by splitting a disjonction, or equations.
+   The last constructor indicates how to solve the obtained system
+   via the use of the trace type of Omega [t_omega] *)
 
-Theorem normalize_hyps_valid :
- forall l : list h_step, valid_hyps (normalize_hyps l).
-Proof.
- simple induction l; unfold valid_hyps; simpl;
- [ auto
- | intros n_s r; case n_s; intros n s H ep e lp H1; apply H;
-    apply apply_oper_1_valid;
-    [ unfold valid1; intros ep1 e1 p1 H2;
-       elim (p_rewrite_stable s ep1 e1 p1); auto
-    | assumption ] ].
-Qed.
+Inductive e_step : Set :=
+  | E_SPLIT : nat -> list direction -> e_step -> e_step -> e_step
+  | E_EXTRACT : nat -> list direction -> e_step -> e_step
+  | E_SOLVE : t_omega -> e_step.
 
-Theorem normalize_hyps_goal :
- forall (s : list h_step) (ep : list Prop) (env : list int) (l : hyps),
- interp_goal ep env (normalize_hyps s l) -> interp_goal ep env l.
-Proof.
- intros; apply valid_goal with (2 := H); apply normalize_hyps_valid.
-Qed.
+(** Selection of a basic fact inside an hypothesis. *)
 
-Fixpoint extract_hyp_pos (s : list direction) (p : proposition) {struct s} :
+Fixpoint extract_hyp_pos (s : list direction) (p : proposition) :
  proposition :=
-  match s with
-  | D_left :: l =>
-      match p with
-      | Tand x y => extract_hyp_pos l x
-      | _ => p
-      end
-  | D_right :: l =>
-      match p with
-      | Tand x y => extract_hyp_pos l y
-      | _ => p
-      end
-  | D_mono :: l => match p with
-                   | Tnot x => extract_hyp_neg l x
-                   | _ => p
-                   end
-  | _ => p
+  match p, s with
+  | Tand x y, D_left :: l => extract_hyp_pos l x
+  | Tand x y, D_right :: l => extract_hyp_pos l y
+  | Tnot x, _ => extract_hyp_neg s x
+  | _, _ => p
   end
 
- with extract_hyp_neg (s : list direction) (p : proposition) {struct s} :
+ with extract_hyp_neg (s : list direction) (p : proposition) :
  proposition :=
-  match s with
-  | D_left :: l =>
-      match p with
-      | Tor x y => extract_hyp_neg l x
-      | Timp x y => if decidability x then extract_hyp_pos l x else Tnot p
-      | _ => Tnot p
-      end
-  | D_right :: l =>
-      match p with
-      | Tor x y => extract_hyp_neg l y
-      | Timp x y => extract_hyp_neg l y
-      | _ => Tnot p
-      end
-  | D_mono :: l =>
-      match p with
-      | Tnot x => if decidability x then extract_hyp_pos l x else Tnot p
-      | _ => Tnot p
-      end
-  | _ =>
-      match p with
-      | Tnot x => if decidability x then x else Tnot p
-      | _ => Tnot p
-      end
+  match p, s with
+  | Tor x y, D_left :: l => extract_hyp_neg l x
+  | Tor x y, D_right :: l => extract_hyp_neg l y
+  | Timp x y, D_left :: l =>
+    if decidability x then extract_hyp_pos l x else Tnot p
+  | Timp x y, D_right :: l => extract_hyp_neg l y
+  | Tnot x, _ => if decidability x then extract_hyp_pos s x else Tnot p
+  | _, _ => Tnot p
   end.
 
-Definition co_valid1 (f : proposition -> proposition) :=
-  forall (ep : list Prop) (e : list int) (p1 : proposition),
-  interp_proposition ep e (Tnot p1) -> interp_proposition ep e (f p1).
-
 Theorem extract_valid :
- forall s : list direction,
- valid1 (extract_hyp_pos s) /\ co_valid1 (extract_hyp_neg s).
+ forall s : list direction, valid1 (extract_hyp_pos s).
 Proof.
- unfold valid1, co_valid1; simple induction s;
- [ split;
-    [ simpl; auto
-    | intros ep e p1; case p1; simpl; auto; intro p;
-       pattern (decidability p); apply bool_eq_ind;
-       [ intro H; generalize (decidable_correct ep e p H);
-          unfold decidable; tauto
-       | simpl; auto ] ]
- | intros a s' (H1, H2); simpl in H2; split; intros ep e p; case a; auto;
-    case p; auto; simpl; intros;
-    (apply H1; tauto) ||
-      (apply H2; tauto) ||
-        (pattern (decidability p0); apply bool_eq_ind;
-          [ intro H3; generalize (decidable_correct ep e p0 H3);
-             unfold decidable; intro H4; apply H1;
-             tauto
-          | intro; tauto ]) ].
+ assert (forall p s ep e,
+         (interp_prop ep e p ->
+          interp_prop ep e (extract_hyp_pos s p)) /\
+         (interp_prop ep e (Tnot p) ->
+          interp_prop ep e (extract_hyp_neg s p))).
+ { induction p; destruct s; simpl; auto; split; try destruct d; try easy;
+   intros; (apply IHp || apply IHp1 || apply IHp2 || idtac); simpl; try tauto;
+   destruct decidability eqn:D; auto;
+   apply (decidable_correct ep e) in D; unfold decidable in D;
+   (apply IHp || apply IHp1); tauto. }
+ red. intros. now apply H.
 Qed.
 
-Fixpoint decompose_solve (s : e_step) (h : hyps) {struct s} : lhyps :=
+(** Attempt to shorten error messages if romega goes rogue...
+    NB: [interp_list_goal _ _ BUG = False /\ True]. *)
+Definition BUG : lhyps := nil :: nil.
+
+(** Split and extract in hypotheses *)
+
+Fixpoint decompose_solve (s : e_step) (h : hyps) : lhyps :=
   match s with
   | E_SPLIT i dl s1 s2 =>
       match extract_hyp_pos dl (nth_hyps i h) with
@@ -3053,50 +1759,45 @@ Fixpoint decompose_solve (s : e_step) (h : hyps) {struct s} : lhyps :=
           then
            decompose_solve s1 (Tnot x :: h) ++
            decompose_solve s2 (Tnot y :: h)
-          else h :: nil
+          else BUG
       | Timp x y =>
           if decidability x then
             decompose_solve s1 (Tnot x :: h) ++ decompose_solve s2 (y :: h)
-          else h::nil
-      | _ => h :: nil
+          else BUG
+      | _ => BUG
       end
   | E_EXTRACT i dl s1 =>
       decompose_solve s1 (extract_hyp_pos dl (nth_hyps i h) :: h)
   | E_SOLVE t => execute_omega t h
   end.
 
-Theorem decompose_solve_valid :
- forall s : e_step, valid_list_goal (decompose_solve s).
-Proof.
- intro s; apply goal_valid; unfold valid_list_hyps; elim s;
- simpl; intros;
- [ cut (interp_proposition ep e1 (extract_hyp_pos l (nth_hyps n lp)));
-    [ case (extract_hyp_pos l (nth_hyps n lp)); simpl; auto;
-       [ intro p; case p; simpl; auto; intros p1 p2 H2;
-          pattern (decidability p1); apply bool_eq_ind;
-          [ intro H3; generalize (decidable_correct ep e1 p1 H3); intro H4;
-             apply append_valid; elim H4; intro H5;
-             [ right; apply H0; simpl; tauto
-             | left; apply H; simpl; tauto ]
-          | simpl; auto ]
-       | intros p1 p2 H2; apply append_valid; simpl; elim H2;
-          [ intros H3; left; apply H; simpl; auto
-          | intros H3; right; apply H0; simpl; auto ]
-       | intros p1 p2 H2;
-         pattern (decidability p1); apply bool_eq_ind;
-          [ intro H3; generalize (decidable_correct ep e1 p1 H3); intro H4;
-             apply append_valid; elim H4; intro H5;
-             [ right; apply H0; simpl; tauto
-             | left; apply H; simpl; tauto ]
-          | simpl; auto ] ]
-    | elim (extract_valid l); intros H2 H3; apply H2; apply nth_valid; auto ]
- | intros; apply H; simpl; split;
-    [ elim (extract_valid l); intros H2 H3; apply H2; apply nth_valid; auto
-    | auto ]
- | apply omega_valid with (1 := H) ].
-Qed.
-
-(* \subsection{La dernière étape qui élimine tous les séquents inutiles} *)
+Theorem decompose_solve_valid (s : e_step) :
+ valid_list_goal (decompose_solve s).
+Proof.
+ apply goal_valid. red. induction s; simpl; intros ep e lp H.
+ - assert (H' : interp_prop ep e (extract_hyp_pos l (nth_hyps n lp))).
+   { now apply extract_valid, nth_valid. }
+   destruct extract_hyp_pos; simpl in *; auto.
+   + destruct p; simpl; auto.
+     destruct decidability eqn:D; [ | simpl; auto].
+     apply (decidable_correct ep e) in D.
+     apply append_valid. simpl in *. destruct D.
+     * right. apply IHs2. simpl; auto.
+     * left. apply IHs1. simpl; auto.
+   + apply append_valid. destruct H'.
+     * left. apply IHs1. simpl; auto.
+     * right. apply IHs2. simpl; auto.
+   + destruct decidability eqn:D; [ | simpl; auto].
+     apply (decidable_correct ep e) in D.
+     apply append_valid. destruct D.
+     * right. apply IHs2. simpl; auto.
+     * left. apply IHs1. simpl; auto.
+ - apply IHs; simpl; split; auto.
+   now apply extract_valid, nth_valid.
+ - now apply omega_valid.
+Qed.
+
+(** Reduction of subgoal list by discarding the contradictory subgoals. *)
 
 Definition valid_lhyps (f : lhyps -> lhyps) :=
   forall (ep : list Prop) (e : list int) (lp : lhyps),
@@ -3104,18 +1805,18 @@ Definition valid_lhyps (f : lhyps -> lhyps) :=
 
 Fixpoint reduce_lhyps (lp : lhyps) : lhyps :=
   match lp with
+  | nil => nil
   | (FalseTerm :: nil) :: lp' => reduce_lhyps lp'
-  | x :: lp' => x :: reduce_lhyps lp'
-  | nil => nil (A:=hyps)
+  | x :: lp' => BUG
   end.
 
 Theorem reduce_lhyps_valid : valid_lhyps reduce_lhyps.
 Proof.
- unfold valid_lhyps; intros ep e lp; elim lp;
- [ simpl; auto
- | intros a l HR; elim a;
-    [ simpl; tauto
-    | intros a1 l1; case l1; case a1; simpl; try tauto ] ].
+ unfold valid_lhyps; intros ep e lp; elim lp.
+ - simpl; auto.
+ - intros a l HR; elim a.
+    + simpl; tauto.
+    + intros a1 l1; case l1; case a1; simpl; tauto.
 Qed.
 
 Theorem do_reduce_lhyps :
@@ -3127,6 +1828,8 @@ Proof.
  assumption.
 Qed.
 
+(** Pushing the conclusion into the hypotheses. *)
+
 Definition concl_to_hyp (p : proposition) :=
   if decidability p then Tnot p else TrueTerm.
 
@@ -3135,33 +1838,35 @@ Definition do_concl_to_hyp :
   interp_goal envp env (concl_to_hyp c :: l) ->
   interp_goal_concl c envp env l.
 Proof.
- simpl; intros envp env c l; induction l as [| a l Hrecl];
- [ simpl; unfold concl_to_hyp;
-    pattern (decidability c); apply bool_eq_ind;
-    [ intro H; generalize (decidable_correct envp env c H);
-       unfold decidable; simpl; tauto
-    | simpl; intros H1 H2; elim H2; trivial ]
- | simpl; tauto ].
+ induction l; simpl.
+ - unfold concl_to_hyp; simpl.
+   destruct decidability eqn:D; [ | simpl; tauto ].
+   apply (decidable_correct envp env) in D. unfold decidable in D.
+   simpl. tauto.
+ - simpl in *; tauto.
 Qed.
 
-Definition omega_tactic (t1 : e_step) (t2 : list h_step)
-  (c : proposition) (l : hyps) :=
-  reduce_lhyps (decompose_solve t1 (normalize_hyps t2 (concl_to_hyp c :: l))).
+(** The omega tactic : all steps together *)
+
+Definition omega_tactic (t1 : e_step) (c : proposition) (l : hyps) :=
+  reduce_lhyps (decompose_solve t1 (normalize_hyps (concl_to_hyp c :: l))).
 
 Theorem do_omega :
- forall (t1 : e_step) (t2 : list h_step) (envp : list Prop)
+ forall (t : e_step) (envp : list Prop)
    (env : list int) (c : proposition) (l : hyps),
- interp_list_goal envp env (omega_tactic t1 t2 c l) ->
+ interp_list_goal envp env (omega_tactic t c l) ->
  interp_goal_concl c envp env l.
 Proof.
- unfold omega_tactic; intros; apply do_concl_to_hyp;
- apply (normalize_hyps_goal t2); apply (decompose_solve_valid t1);
- apply do_reduce_lhyps; assumption.
+ unfold omega_tactic; intros t ep e c l H.
+ apply do_concl_to_hyp.
+ apply normalize_hyps_goal.
+ apply (decompose_solve_valid t).
+ now apply do_reduce_lhyps.
 Qed.
 
 End IntOmega.
 
-(* For now, the above modular construction is instanciated on Z,
-   in order to retrieve the initial ROmega. *)
+(** For now, the above modular construction is instanciated on Z,
+    in order to retrieve the initial ROmega. *)
 
 Module ZOmega := IntOmega(Z_as_Int).
diff --git a/plugins/romega/const_omega.ml b/plugins/romega/const_omega.ml
index 4935fe4b..ad3afafd 100644
--- a/plugins/romega/const_omega.ml
+++ b/plugins/romega/const_omega.ml
@@ -6,14 +6,16 @@
 
  *************************************************************************)
 
+open Names
+
 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
- | Kufo;;
+  | Kvar of string
+  | Kapp of string * EConstr.t list
+  | Kimp of EConstr.t * EConstr.t
+  | Kufo
 
 let meaningful_submodule = [ "Z"; "N"; "Pos" ]
 
@@ -27,32 +29,32 @@ let string_of_global r =
   in
   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 ->
-	Kapp (string_of_global (Globnames.ConstRef sp), args)
-    | Term.Construct (csp,_) , args ->
-	Kapp (string_of_global (Globnames.ConstructRef csp), args)
-    | Term.Ind (isp,_), args ->
-	Kapp (string_of_global (Globnames.IndRef isp), args)
-    | Term.Var id,[] -> Kvar(Names.Id.to_string id)
-    | Term.Prod (Names.Anonymous,typ,body), [] -> Kimp(typ,body)
-    | Term.Prod (Names.Name _,_,_),[] ->
-	CErrors.error "Omega: Not a quantifier-free goal"
-    | _ -> Kufo
-
-exception Destruct
-
-let dest_const_apply t =
-  let f,args = Term.decompose_app t in
+let destructurate sigma t =
+  let c, args = EConstr.decompose_app sigma t in
+  let open Constr in
+  match EConstr.kind sigma c, args with
+  | Const (sp,_), args ->
+     Kapp (string_of_global (Globnames.ConstRef sp), args)
+  | Construct (csp,_) , args ->
+     Kapp (string_of_global (Globnames.ConstructRef csp), args)
+  | Ind (isp,_), args ->
+     Kapp (string_of_global (Globnames.IndRef isp), args)
+  | Var id, [] -> Kvar(Names.Id.to_string id)
+  | Prod (Anonymous,typ,body), [] -> Kimp(typ,body)
+  | _ -> Kufo
+
+exception DestConstApp
+
+let dest_const_apply sigma t =
+  let open Constr in
+  let f,args = EConstr.decompose_app sigma 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
-    | _ -> raise Destruct
-  in  Nametab.basename_of_global ref, args
+  match EConstr.kind sigma 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
 
 let logic_dir = ["Coq";"Logic";"Decidable"]
 
@@ -65,13 +67,25 @@ let coq_modules =
 let bin_module = [["Coq";"Numbers";"BinNums"]]
 let z_module = [["Coq";"ZArith";"BinInt"]]
 
-let init_constant = Coqlib.gen_constant_in_modules "Omega" Coqlib.init_modules
-let constant = Coqlib.gen_constant_in_modules "Omega" coq_modules
-let z_constant = Coqlib.gen_constant_in_modules "Omega" z_module
-let bin_constant = Coqlib.gen_constant_in_modules "Omega" bin_module
+let init_constant x =
+  EConstr.of_constr @@
+  Universes.constr_of_global @@
+  Coqlib.gen_reference_in_modules "Omega" Coqlib.init_modules x
+let constant x =
+  EConstr.of_constr @@
+  Universes.constr_of_global @@
+  Coqlib.gen_reference_in_modules "Omega" coq_modules x
+let z_constant x =
+  EConstr.of_constr @@
+  Universes.constr_of_global @@
+  Coqlib.gen_reference_in_modules "Omega" z_module x
+let bin_constant x =
+  EConstr.of_constr @@
+  Universes.constr_of_global @@
+  Coqlib.gen_reference_in_modules "Omega" bin_module x
 
 (* Logic *)
-let coq_refl_equal = lazy(init_constant  "eq_refl")
+let coq_refl_equal = lazy(init_constant "eq_refl")
 let coq_and = lazy(init_constant "and")
 let coq_not = lazy(init_constant "not")
 let coq_or = lazy(init_constant "or")
@@ -81,13 +95,6 @@ let coq_I = lazy(init_constant "I")
 
 (* ReflOmegaCore/ZOmega *)
 
-let coq_h_step = lazy (constant "h_step")
-let coq_pair_step = lazy (constant  "pair_step")
-let coq_p_left = lazy (constant  "P_LEFT")
-let coq_p_right = lazy (constant  "P_RIGHT")
-let coq_p_invert = lazy (constant  "P_INVERT")
-let coq_p_step = lazy (constant  "P_STEP")
-
 let coq_t_int = lazy (constant  "Tint")
 let coq_t_plus = lazy (constant  "Tplus")
 let coq_t_mult = lazy (constant  "Tmult")
@@ -110,62 +117,17 @@ let coq_p_and = lazy (constant  "Tand")
 let coq_p_imp = lazy (constant  "Timp")
 let coq_p_prop = lazy (constant  "Tprop")
 
-(* Constructors for shuffle tactic *)
-let coq_t_fusion =  lazy (constant  "t_fusion")
-let coq_f_equal =  lazy (constant  "F_equal")
-let coq_f_cancel =  lazy (constant  "F_cancel")
-let coq_f_left =  lazy (constant  "F_left")
-let coq_f_right =  lazy (constant  "F_right")
-
-(* Constructors for reordering tactics *)
-let coq_c_do_both = lazy (constant  "C_DO_BOTH")
-let coq_c_do_left = lazy (constant  "C_LEFT")
-let coq_c_do_right = lazy (constant  "C_RIGHT")
-let coq_c_do_seq = lazy (constant  "C_SEQ")
-let coq_c_nop = lazy (constant  "C_NOP")
-let coq_c_opp_plus = lazy (constant  "C_OPP_PLUS")
-let coq_c_opp_opp = lazy (constant  "C_OPP_OPP")
-let coq_c_opp_mult_r = lazy (constant  "C_OPP_MULT_R")
-let coq_c_opp_one = lazy (constant  "C_OPP_ONE")
-let coq_c_reduce = lazy (constant  "C_REDUCE")
-let coq_c_mult_plus_distr = lazy (constant  "C_MULT_PLUS_DISTR")
-let coq_c_opp_left = lazy (constant  "C_MULT_OPP_LEFT")
-let coq_c_mult_assoc_r = lazy (constant  "C_MULT_ASSOC_R")
-let coq_c_plus_assoc_r = lazy (constant  "C_PLUS_ASSOC_R")
-let coq_c_plus_assoc_l = lazy (constant  "C_PLUS_ASSOC_L")
-let coq_c_plus_permute = lazy (constant  "C_PLUS_PERMUTE")
-let coq_c_plus_comm = lazy (constant  "C_PLUS_COMM")
-let coq_c_red0 = lazy (constant  "C_RED0")
-let coq_c_red1 = lazy (constant  "C_RED1")
-let coq_c_red2 = lazy (constant  "C_RED2")
-let coq_c_red3 = lazy (constant  "C_RED3")
-let coq_c_red4 = lazy (constant  "C_RED4")
-let coq_c_red5 = lazy (constant  "C_RED5")
-let coq_c_red6 = lazy (constant  "C_RED6")
-let coq_c_mult_opp_left = lazy (constant  "C_MULT_OPP_LEFT")
-let coq_c_mult_assoc_reduced = lazy (constant  "C_MULT_ASSOC_REDUCED")
-let coq_c_minus = lazy (constant  "C_MINUS")
-let coq_c_mult_comm = lazy (constant  "C_MULT_COMM")
-
-let coq_s_constant_not_nul = lazy (constant  "O_CONSTANT_NOT_NUL")
-let coq_s_constant_neg = lazy (constant  "O_CONSTANT_NEG")
-let coq_s_div_approx = lazy (constant  "O_DIV_APPROX")
+let coq_s_bad_constant = lazy (constant  "O_BAD_CONSTANT")
+let coq_s_divide = lazy (constant  "O_DIVIDE")
 let coq_s_not_exact_divide = lazy (constant  "O_NOT_EXACT_DIVIDE")
-let coq_s_exact_divide = lazy (constant  "O_EXACT_DIVIDE")
 let coq_s_sum = lazy (constant  "O_SUM")
-let coq_s_state = lazy (constant  "O_STATE")
-let coq_s_contradiction = lazy (constant  "O_CONTRADICTION")
 let coq_s_merge_eq = lazy (constant  "O_MERGE_EQ")
 let coq_s_split_ineq =lazy (constant  "O_SPLIT_INEQ")
-let coq_s_constant_nul =lazy (constant  "O_CONSTANT_NUL")
-let coq_s_negate_contradict =lazy (constant  "O_NEGATE_CONTRADICT")
-let coq_s_negate_contradict_inv =lazy (constant  "O_NEGATE_CONTRADICT_INV")
 
 (* construction for the [extract_hyp] tactic *)
 let coq_direction = lazy  (constant  "direction")
 let coq_d_left = lazy  (constant  "D_left")
 let coq_d_right = lazy  (constant  "D_right")
-let coq_d_mono = lazy  (constant  "D_mono")
 
 let coq_e_split = lazy  (constant  "E_SPLIT")
 let coq_e_extract = lazy  (constant  "E_EXTRACT")
@@ -174,31 +136,6 @@ let coq_e_solve = lazy  (constant  "E_SOLVE")
 let coq_interp_sequent = lazy (constant  "interp_goal_concl")
 let coq_do_omega = lazy (constant  "do_omega")
 
-(* \subsection{Construction d'expressions} *)
-
-let do_left t =
-  if Term.eq_constr t (Lazy.force coq_c_nop) then Lazy.force coq_c_nop
-  else Term.mkApp (Lazy.force coq_c_do_left, [|t |] )
-
-let do_right t =
-  if Term.eq_constr t (Lazy.force coq_c_nop) then Lazy.force coq_c_nop
-  else Term.mkApp (Lazy.force coq_c_do_right, [|t |])
-
-let do_both t1 t2 =
-  if Term.eq_constr t1 (Lazy.force coq_c_nop) then do_right t2
-  else if Term.eq_constr t2 (Lazy.force coq_c_nop) then do_left t1
-  else Term.mkApp (Lazy.force coq_c_do_both , [|t1; t2 |])
-
-let do_seq t1 t2 =
-  if Term.eq_constr t1 (Lazy.force coq_c_nop) then t2
-  else if Term.eq_constr t2 (Lazy.force coq_c_nop) then t1
-  else Term.mkApp (Lazy.force coq_c_do_seq, [|t1; t2 |])
-
-let rec do_list = function
-  | [] -> Lazy.force coq_c_nop
-  | [x] -> x
-  | (x::l) -> do_seq x (do_list l)
-
 (* Nat *)
 
 let coq_S = lazy(init_constant "S")
@@ -206,168 +143,190 @@ 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 -> EConstr.mkApp (Lazy.force coq_S, [| mk_nat (n-1) |])
 
 (* Lists *)
 
-let mkListConst c = 
-  let r = 
-    Coqlib.gen_reference "" ["Init";"Datatypes"] c
-  in 
-  let inst = 
-    if Global.is_polymorphic r then fun u -> Univ.Instance.of_array [|u|]
-    else fun _ -> Univ.Instance.empty
+let mkListConst c =
+  let r =
+    Coqlib.coq_reference "" ["Init";"Datatypes"] c
+  in
+  let inst =
+    if Global.is_polymorphic r then
+      fun u -> EConstr.EInstance.make (Univ.Instance.of_array [|u|])
+    else
+      fun _ -> EConstr.EInstance.empty
   in
-    fun u -> Term.mkConstructU (Globnames.destConstructRef r, inst u)
+    fun u -> EConstr.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 = EConstr.mkApp (mkListConst "cons" univ, [|typ|])
+let coq_nil univ typ =  EConstr.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
+       EConstr.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 mk_plist =
+  let type1lev = Universes.new_univ_level () in
+  fun l -> mk_list type1lev EConstr.mkProp l
 
 let mk_list = mk_list Univ.Level.set
-let mk_shuffle_list l = mk_list (Lazy.force coq_t_fusion) l
-
 
 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 EConstr.t * EConstr.t
+  | Tmult of EConstr.t * EConstr.t
+  | Tminus of EConstr.t * EConstr.t
+  | Topp of EConstr.t
+  | Tsucc of EConstr.t
   | 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 EConstr.t * EConstr.t
+  | Rne of EConstr.t * EConstr.t
+  | Rlt of EConstr.t * EConstr.t
+  | Rle of EConstr.t * EConstr.t
+  | Rgt of EConstr.t * EConstr.t
+  | Rge of EConstr.t * EConstr.t
   | 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 EConstr.t
+  | Ror of EConstr.t * EConstr.t
+  | Rand of EConstr.t * EConstr.t
+  | Rimp of EConstr.t * EConstr.t
+  | Riff of EConstr.t * EConstr.t
   | Rother
 
-let parse_logic_rel c =
- try match destructurate c with
-   | Kapp("True",[]) -> Rtrue
-   | Kapp("False",[]) -> Rfalse
-   | Kapp("not",[t]) -> Rnot t
-   | Kapp("or",[t1;t2]) -> Ror (t1,t2)
-   | Kapp("and",[t1;t2]) -> Rand (t1,t2)
-   | Kimp(t1,t2) -> Rimp (t1,t2)
-   | Kapp("iff",[t1;t2]) -> Riff (t1,t2)
-   | _ -> Rother
- with e when Logic.catchable_exception e -> Rother
+let parse_logic_rel sigma c = match destructurate sigma c with
+  | Kapp("True",[]) -> Rtrue
+  | Kapp("False",[]) -> Rfalse
+  | Kapp("not",[t]) -> Rnot t
+  | Kapp("or",[t1;t2]) -> Ror (t1,t2)
+  | Kapp("and",[t1;t2]) -> Rand (t1,t2)
+  | Kimp(t1,t2) -> Rimp (t1,t2)
+  | Kapp("iff",[t1;t2]) -> Riff (t1,t2)
+  | _ -> Rother
+
+(* 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")
+let coq_Z0 = lazy (bin_constant "Z0")
+let coq_Zpos = lazy (bin_constant "Zpos")
+let coq_Zneg = lazy (bin_constant "Zneg")
+let coq_N0 = lazy (bin_constant "N0")
+let coq_Npos = lazy (bin_constant "Npos")
+
+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
+    EConstr.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 -> EConstr.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 : Proof_type.goal Tacmach.sigma -> Term.constr -> parse_rel
+  val typ : EConstr.t Lazy.t
+  val is_int_typ : Proofview.Goal.t -> EConstr.t -> bool
+  val plus : EConstr.t Lazy.t
+  val mult : EConstr.t Lazy.t
+  val opp : EConstr.t Lazy.t
+  val minus : EConstr.t Lazy.t
+
+  val mk : Bigint.bigint -> EConstr.t
+  val parse_term : Evd.evar_map -> EConstr.t -> parse_term
+  val parse_rel : Proofview.Goal.t -> EConstr.t -> parse_rel
   (* check whether t is built only with numbers and + * - *)
-  val is_scalar : Term.constr -> bool
+  val get_scalar : Evd.evar_map -> EConstr.t -> 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")
 let minus = lazy (z_constant "Z.sub")
 
-let coq_xH = lazy (bin_constant "xH")
-let coq_xO = lazy (bin_constant "xO")
-let coq_xI = lazy (bin_constant "xI")
-let coq_Z0 = lazy (bin_constant "Z0")
-let coq_Zpos = lazy (bin_constant "Zpos")
-let coq_Zneg = lazy (bin_constant "Zneg")
-
-let recognize t =
+let recognize_pos sigma t =
   let rec loop t =
-    let f,l = dest_const_apply t in
-    match Names.Id.to_string f,l with
-       "xI",[t] -> Bigint.add Bigint.one (Bigint.mult Bigint.two (loop t))
-     | "xO",[t] -> Bigint.mult Bigint.two (loop t)
-     | "xH",[] -> Bigint.one
-     | _ -> failwith "not a number" in
-  let f,l = dest_const_apply t in
-    match Names.Id.to_string f,l with
-        "Zpos",[t] -> loop t
-      | "Zneg",[t] -> Bigint.neg (loop t)
-      | "Z0",[] -> Bigint.zero
-      | _ -> failwith "not a number";;
-
-let rec mk_positive n =
-  if n=Bigint.one then Lazy.force coq_xH
-  else
-    let (q,r) = Bigint.euclid n Bigint.two in
-    Term.mkApp
-      ((if r = Bigint.zero then Lazy.force coq_xO else Lazy.force coq_xI),
-       [| mk_positive q |])
+    let f,l = dest_const_apply sigma t in
+    match Id.to_string f,l with
+    | "xI",[t] -> Bigint.add Bigint.one (Bigint.mult Bigint.two (loop t))
+    | "xO",[t] -> Bigint.mult Bigint.two (loop t)
+    | "xH",[] -> Bigint.one
+    | _ -> raise DestConstApp
+  in
+  try Some (loop t) with DestConstApp -> None
+
+let recognize_Z sigma t =
+  try
+    let f,l = dest_const_apply sigma t in
+    match Id.to_string f,l with
+    | "Zpos",[t] -> recognize_pos sigma t
+    | "Zneg",[t] -> Option.map Bigint.neg (recognize_pos sigma t)
+    | "Z0",[] -> Some Bigint.zero
+    | _ -> None
+  with DestConstApp -> None
 
 let mk_Z n =
-  if n = Bigint.zero then Lazy.force coq_Z0
+  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 |])
+    EConstr.mkApp (Lazy.force coq_Zpos, [| mk_positive n |])
   else
-    Term.mkApp (Lazy.force coq_Zneg, [| mk_positive (Bigint.neg n) |])
+    EConstr.mkApp (Lazy.force coq_Zneg, [| mk_positive (Bigint.neg n) |])
 
 let mk = mk_Z
 
-let parse_term t =
-  try match destructurate t with
-    | Kapp("Z.add",[t1;t2]) -> Tplus (t1,t2)
-    | Kapp("Z.sub",[t1;t2]) -> Tminus (t1,t2)
-    | Kapp("Z.mul",[t1;t2]) -> Tmult (t1,t2)
-    | Kapp("Z.opp",[t]) -> Topp t
-    | Kapp("Z.succ",[t]) -> Tsucc t
-    | Kapp("Z.pred",[t]) -> Tplus(t, mk_Z (Bigint.neg Bigint.one))
-    | Kapp(("Zpos"|"Zneg"|"Z0"),_) ->
-	(try Tnum (recognize t) with e when CErrors.noncritical e -> Tother)
-    | _ -> Tother
-  with e when Logic.catchable_exception e -> Tother
+let parse_term sigma t =
+  match destructurate sigma t with
+  | Kapp("Z.add",[t1;t2]) -> Tplus (t1,t2)
+  | Kapp("Z.sub",[t1;t2]) -> Tminus (t1,t2)
+  | Kapp("Z.mul",[t1;t2]) -> Tmult (t1,t2)
+  | Kapp("Z.opp",[t]) -> Topp t
+  | Kapp("Z.succ",[t]) -> Tsucc t
+  | Kapp("Z.pred",[t]) -> Tplus(t, mk_Z (Bigint.neg Bigint.one))
+  | Kapp(("Zpos"|"Zneg"|"Z0"),_) ->
+     (match recognize_Z sigma t with Some t -> Tnum t | None -> Tother)
+  | _ -> Tother
+
+let is_int_typ gl t =
+  Tacmach.New.pf_apply Reductionops.is_conv gl t (Lazy.force coq_Z)
 
 let parse_rel gl t =
-  try match destructurate t with
-    | Kapp("eq",[typ;t1;t2])
-      when destructurate (Tacmach.pf_nf gl typ) = Kapp("Z",[]) -> 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)
-    | Kapp("Z.ge",[t1;t2]) -> Rge (t1,t2)
-    | Kapp("Z.gt",[t1;t2]) -> Rgt (t1,t2)
-    | _ -> parse_logic_rel t
-  with e when Logic.catchable_exception e -> Rother
-
-let is_scalar t =
-  let rec aux t = match destructurate t with
-    | Kapp(("Z.add"|"Z.sub"|"Z.mul"),[t1;t2]) -> aux t1 && aux t2
-    | Kapp(("Z.opp"|"Z.succ"|"Z.pred"),[t]) -> aux t
-    | Kapp(("Zpos"|"Zneg"|"Z0"),_) -> let _ = recognize t in true
-    | _ -> false in
-  try aux t with e when CErrors.noncritical e -> false
+  let sigma = Proofview.Goal.sigma gl in
+  match destructurate sigma t with
+  | 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)
+  | Kapp("Z.ge",[t1;t2]) -> Rge (t1,t2)
+  | Kapp("Z.gt",[t1;t2]) -> Rgt (t1,t2)
+  | _ -> parse_logic_rel sigma t
+
+let rec get_scalar sigma t =
+  match destructurate sigma t with
+  | Kapp("Z.add", [t1;t2]) ->
+     Option.lift2 Bigint.add (get_scalar sigma t1) (get_scalar sigma t2)
+  | Kapp ("Z.sub",[t1;t2]) ->
+     Option.lift2 Bigint.sub (get_scalar sigma t1) (get_scalar sigma t2)
+  | Kapp ("Z.mul",[t1;t2]) ->
+     Option.lift2 Bigint.mult (get_scalar sigma t1) (get_scalar sigma t2)
+  | Kapp("Z.opp", [t]) -> Option.map Bigint.neg (get_scalar sigma t)
+  | Kapp("Z.succ", [t]) -> Option.map Bigint.add_1 (get_scalar sigma t)
+  | Kapp("Z.pred", [t]) -> Option.map Bigint.sub_1 (get_scalar sigma t)
+  | Kapp(("Zpos"|"Zneg"|"Z0"),_) -> recognize_Z sigma t
+  | _ -> None
 
 end
diff --git a/plugins/romega/const_omega.mli b/plugins/romega/const_omega.mli
index af50ea0f..64668df0 100644
--- a/plugins/romega/const_omega.mli
+++ b/plugins/romega/const_omega.mli
@@ -10,167 +10,114 @@
 (** Coq objects used in romega *)
 
 (* 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 : EConstr.t lazy_t
+val coq_and : EConstr.t lazy_t
+val coq_not : EConstr.t lazy_t
+val coq_or : EConstr.t lazy_t
+val coq_True : EConstr.t lazy_t
+val coq_False : EConstr.t lazy_t
+val coq_I : EConstr.t lazy_t
 
 (* from ReflOmegaCore/ZOmega *)
-val coq_h_step : Term.constr lazy_t
-val coq_pair_step : Term.constr lazy_t
-val coq_p_left : Term.constr lazy_t
-val coq_p_right : Term.constr lazy_t
-val coq_p_invert : Term.constr lazy_t
-val coq_p_step : Term.constr lazy_t
-
-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_f_equal : Term.constr lazy_t
-val coq_f_cancel : Term.constr lazy_t
-val coq_f_left : Term.constr lazy_t
-val coq_f_right : Term.constr lazy_t
-
-val coq_c_do_both : Term.constr lazy_t
-val coq_c_do_left : Term.constr lazy_t
-val coq_c_do_right : Term.constr lazy_t
-val coq_c_do_seq : Term.constr lazy_t
-val coq_c_nop : Term.constr lazy_t
-val coq_c_opp_plus : Term.constr lazy_t
-val coq_c_opp_opp : Term.constr lazy_t
-val coq_c_opp_mult_r : Term.constr lazy_t
-val coq_c_opp_one : Term.constr lazy_t
-val coq_c_reduce : Term.constr lazy_t
-val coq_c_mult_plus_distr : Term.constr lazy_t
-val coq_c_opp_left : Term.constr lazy_t
-val coq_c_mult_assoc_r : Term.constr lazy_t
-val coq_c_plus_assoc_r : Term.constr lazy_t
-val coq_c_plus_assoc_l : Term.constr lazy_t
-val coq_c_plus_permute : Term.constr lazy_t
-val coq_c_plus_comm : Term.constr lazy_t
-val coq_c_red0 : Term.constr lazy_t
-val coq_c_red1 : Term.constr lazy_t
-val coq_c_red2 : Term.constr lazy_t
-val coq_c_red3 : Term.constr lazy_t
-val coq_c_red4 : Term.constr lazy_t
-val coq_c_red5 : Term.constr lazy_t
-val coq_c_red6 : Term.constr lazy_t
-val coq_c_mult_opp_left : Term.constr lazy_t
-val coq_c_mult_assoc_reduced : Term.constr lazy_t
-val coq_c_minus : Term.constr lazy_t
-val coq_c_mult_comm : Term.constr lazy_t
-
-val coq_s_constant_not_nul : Term.constr lazy_t
-val coq_s_constant_neg : Term.constr lazy_t
-val coq_s_div_approx : Term.constr lazy_t
-val coq_s_not_exact_divide : Term.constr lazy_t
-val coq_s_exact_divide : Term.constr lazy_t
-val coq_s_sum : Term.constr lazy_t
-val coq_s_state : Term.constr lazy_t
-val coq_s_contradiction : Term.constr lazy_t
-val coq_s_merge_eq : Term.constr lazy_t
-val coq_s_split_ineq : Term.constr lazy_t
-val coq_s_constant_nul : Term.constr lazy_t
-val coq_s_negate_contradict : Term.constr lazy_t
-val coq_s_negate_contradict_inv : 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_d_mono : 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
-
-(** Building expressions *)
-
-val do_left : Term.constr -> Term.constr
-val do_right : Term.constr -> Term.constr
-val do_both : Term.constr -> Term.constr -> Term.constr
-val do_seq : Term.constr -> Term.constr -> Term.constr
-val do_list : Term.constr list -> Term.constr
-
-val mk_nat : int -> Term.constr
+
+val coq_t_int : EConstr.t lazy_t
+val coq_t_plus : EConstr.t lazy_t
+val coq_t_mult : EConstr.t lazy_t
+val coq_t_opp : EConstr.t lazy_t
+val coq_t_minus : EConstr.t lazy_t
+val coq_t_var : EConstr.t lazy_t
+
+val coq_proposition : EConstr.t lazy_t
+val coq_p_eq : EConstr.t lazy_t
+val coq_p_leq : EConstr.t lazy_t
+val coq_p_geq : EConstr.t lazy_t
+val coq_p_lt : EConstr.t lazy_t
+val coq_p_gt : EConstr.t lazy_t
+val coq_p_neq : EConstr.t lazy_t
+val coq_p_true : EConstr.t lazy_t
+val coq_p_false : EConstr.t lazy_t
+val coq_p_not : EConstr.t lazy_t
+val coq_p_or : EConstr.t lazy_t
+val coq_p_and : EConstr.t lazy_t
+val coq_p_imp : EConstr.t lazy_t
+val coq_p_prop : EConstr.t lazy_t
+
+val coq_s_bad_constant : EConstr.t lazy_t
+val coq_s_divide : EConstr.t lazy_t
+val coq_s_not_exact_divide : EConstr.t lazy_t
+val coq_s_sum : EConstr.t lazy_t
+val coq_s_merge_eq : EConstr.t lazy_t
+val coq_s_split_ineq : EConstr.t lazy_t
+
+val coq_direction : EConstr.t lazy_t
+val coq_d_left : EConstr.t lazy_t
+val coq_d_right : EConstr.t lazy_t
+
+val coq_e_split : EConstr.t lazy_t
+val coq_e_extract : EConstr.t lazy_t
+val coq_e_solve : EConstr.t lazy_t
+
+val coq_interp_sequent : EConstr.t lazy_t
+val coq_do_omega : EConstr.t lazy_t
+
+val mk_nat : int -> EConstr.t
+val mk_N : int -> EConstr.t
+
 (** 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_shuffle_list : Term.constr list -> Term.constr
+val mk_list : EConstr.t -> EConstr.t list -> EConstr.t
+val mk_plist : EConstr.types list -> EConstr.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 EConstr.t * EConstr.t
+  | Tmult of EConstr.t * EConstr.t
+  | Tminus of EConstr.t * EConstr.t
+  | Topp of EConstr.t
+  | Tsucc of EConstr.t
   | 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 EConstr.t * EConstr.t
+  | Rne of EConstr.t * EConstr.t
+  | Rlt of EConstr.t * EConstr.t
+  | Rle of EConstr.t * EConstr.t
+  | Rgt of EConstr.t * EConstr.t
+  | Rge of EConstr.t * EConstr.t
   | 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 EConstr.t
+  | Ror of EConstr.t * EConstr.t
+  | Rand of EConstr.t * EConstr.t
+  | Rimp of EConstr.t * EConstr.t
+  | Riff of EConstr.t * EConstr.t
   | 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 : EConstr.t Lazy.t
+    (* Is a constr expands to the type of these numbers *)
+    val is_int_typ : Proofview.Goal.t -> EConstr.t -> 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 : EConstr.t Lazy.t
+    val mult : EConstr.t Lazy.t
+    val opp : EConstr.t Lazy.t
+    val minus : EConstr.t Lazy.t
     (* building a coq number *)
-    val mk : Bigint.bigint -> Term.constr
+    val mk : Bigint.bigint -> EConstr.t
     (* parsing a term (one level, except if a number is found) *)
-    val parse_term : Term.constr -> parse_term
+    val parse_term : Evd.evar_map -> EConstr.t -> parse_term
     (* parsing a relation expression, including = < <= >= > *)
-    val parse_rel : Proof_type.goal Tacmach.sigma -> Term.constr -> parse_rel
+    val parse_rel : Proofview.Goal.t -> EConstr.t -> parse_rel
     (* Is a particular term only made of numbers and + * - ? *)
-    val is_scalar : Term.constr -> bool
+    val get_scalar : Evd.evar_map -> EConstr.t -> 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 830dc54d..5b77d08d 100644
--- a/plugins/romega/g_romega.ml4
+++ b/plugins/romega/g_romega.ml4
@@ -6,28 +6,28 @@
 
  *************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
 
 DECLARE PLUGIN "romega_plugin"
 
+open Ltac_plugin
 open Names
 open Refl_omega
-open Constrarg
+open Stdarg
 
 let eval_tactic name =
   let dp = DirPath.make (List.map Id.of_string ["PreOmega"; "omega"; "Coq"]) in
-  let kn = KerName.make2 (MPfile dp) (Label.make name) in
+  let kn = KerName.make2 (ModPath.MPfile dp) (Label.make name) in
   let tac = Tacenv.interp_ltac kn in
   Tacinterp.eval_tactic tac
 
-let romega_tactic l =
+let romega_tactic unsafe l =
   let tacs = List.map
     (function
        | "nat" -> eval_tactic "zify_nat"
        | "positive" -> eval_tactic "zify_positive"
        | "N" -> eval_tactic "zify_N"
        | "Z" -> eval_tactic "zify_op"
-       | s -> CErrors.error ("No ROmega knowledge base for type "^s))
+       | s -> CErrors.user_err Pp.(str ("No ROmega knowledge base for type "^s)))
     (Util.List.sort_uniquize String.compare l)
   in
   Tacticals.New.tclTHEN
@@ -37,15 +37,15 @@ let romega_tactic l =
           we'd better leave as little as possible in the conclusion,
           for an easier decidability argument. *)
        (Tactics.intros)
-       (Proofview.V82.tactic total_reflexive_omega_tactic))
-
+       (total_reflexive_omega_tactic unsafe))
 
 TACTIC EXTEND romega
-|  [ "romega" ] -> [ romega_tactic [] ]
+|  [ "romega" ] -> [ romega_tactic false [] ]
+|  [ "unsafe_romega" ] -> [ romega_tactic true [] ]
 END
 
 TACTIC EXTEND romega'
 | [ "romega" "with" ne_ident_list(l) ] ->
-    [ romega_tactic (List.map Names.Id.to_string l) ]
-| [ "romega" "with" "*" ] -> [ romega_tactic ["nat";"positive";"N";"Z"] ]
+    [ romega_tactic false (List.map Names.Id.to_string l) ]
+| [ "romega" "with" "*" ] -> [ romega_tactic false ["nat";"positive";"N";"Z"] ]
 END
diff --git a/plugins/romega/refl_omega.ml b/plugins/romega/refl_omega.ml
index ba882e39..d1824978 100644
--- a/plugins/romega/refl_omega.ml
+++ b/plugins/romega/refl_omega.ml
@@ -12,19 +12,20 @@ open Const_omega
 module OmegaSolver = Omega_plugin.Omega.MakeOmegaSolver (Bigint)
 open OmegaSolver
 
+module Id = Names.Id
+module IntSet = Int.Set
+module IntHtbl = Hashtbl.Make(Int)
+
 (* \section{Useful functions and flags} *)
 (* Especially useful debugging functions *)
 let debug = ref false
 
-let show_goal gl =
-  if !debug then (); Tacticals.tclIDTAC gl
+let show_goal = Tacticals.New.tclIDTAC
 
 let pp i = print_int i; print_newline (); flush stdout
 
 (* More readable than the prefix notation *)
-let (>>) = Tacticals.tclTHEN
-
-let mkApp = Term.mkApp
+let (>>) = Tacticals.New.tclTHEN
 
 (* \section{Types}
   \subsection{How to walk in a term}
@@ -38,13 +39,11 @@ type direction = Left of int | Right of int
 type occ_step = O_left | O_right | O_mono
 type occ_path = occ_step list
 
-let occ_step_eq s1 s2 = match s1, s2 with
-| O_left, O_left | O_right, O_right | O_mono, O_mono -> true
-| _ -> false
-
 (* chemin identifiant une proposition sous forme du nom de l'hypothèse et
    d'une liste de pas à partir de la racine de l'hypothèse *)
-type occurrence = {o_hyp : Names.Id.t; o_path : occ_path}
+type occurrence = {o_hyp : Id.t; o_path : occ_path}
+
+type atom_index = int
 
 (* \subsection{reifiable formulas} *)
 type oformula =
@@ -52,42 +51,42 @@ type oformula =
   | Oint of Bigint.bigint
     (* recognized binary and unary operations *)
   | Oplus of oformula * oformula
-  | Omult of oformula * oformula
+  | Omult of oformula * oformula (* Invariant : one side is [Oint] *)
   | Ominus of oformula * oformula
   | Oopp of  oformula
     (* an atom in the environment *)
-  | Oatom of int
-    (* weird expression that cannot be translated *)
-  | Oufo of oformula
+  | Oatom of atom_index
 
 (* Operators for comparison recognized by Omega *)
 type comparaison = Eq | Leq | Geq | Gt | Lt | Neq
 
-(* Type des prédicats réifiés (fragment de calcul propositionnel. Les
- * quantifications sont externes au langage) *)
+(* Representation of reified predicats (fragment of propositional calculus,
+   no quantifier here). *)
+(* Note : in [Pprop p], the non-reified constr [p] should be closed
+   (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
+    Pequa of EConstr.t * 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 EConstr.t
 
-(* Les équations ou propositions atomiques utiles du calcul *)
+(* The equations *)
 and oequation = {
     e_comp: comparaison;		(* comparaison *)
     e_left: oformula;			(* formule brute gauche *)
     e_right: oformula;			(* formule brute droite *)
-    e_trace: Term.constr;		(* tactique de normalisation *)
     e_origin: occurrence;		(* l'hypothèse dont vient le terme *)
     e_negated: bool;			(* vrai si apparait en position nié
 					   après normalisation *)
-    e_depends: direction  list;		(* liste des points de disjonction dont
+    e_depends: direction list;		(* liste des points de disjonction dont
 					   dépend l'accès à l'équation avec la
 					   direction (branche) pour y accéder *)
-    e_omega: afine		(* la fonction normalisée *)
+    e_omega: OmegaSolver.afine (* normalized formula *)
   }
 
 (* \subsection{Proof context}
@@ -101,27 +100,25 @@ and oequation = {
 
 type environment = {
   (* La liste des termes non reifies constituant l'environnement global *)
-  mutable terms : Term.constr list;
+  mutable terms : EConstr.t list;
   (* La meme chose pour les propositions *)
-  mutable props : Term.constr list;
-  (* Les variables introduites par omega *)
-  mutable om_vars : (oformula * int) list;
+  mutable props : EConstr.t 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,int) Hashtbl.t;
+  real_indices : int IntHtbl.t;
   mutable cnt_connectors : int;
-  equations : (int,oequation) Hashtbl.t;
-  constructors : (int, occurrence) Hashtbl.t
+  equations : oequation IntHtbl.t;
+  constructors : occurrence IntHtbl.t
 }
 
 (* \subsection{Solution tree}
    Définition d'une solution trouvée par Omega sous la forme d'un identifiant,
    d'un ensemble d'équation dont dépend la solution et d'une trace *)
-(* La liste des dépendances est triée et sans redondance *)
+
 type solution = {
   s_index : int;
-  s_equa_deps : int list;
-  s_trace : action list }
+  s_equa_deps : IntSet.t;
+  s_trace : OmegaSolver.action list }
 
 (* Arbre de solution résolvant complètement un ensemble de systèmes *)
 type solution_tree =
@@ -139,16 +136,35 @@ type context_content =
     CCHyp of occurrence
   | CCEqua of int
 
+(** Some dedicated equality tests *)
+
+let occ_step_eq s1 s2 = match s1, s2 with
+| O_left, O_left | O_right, O_right | O_mono, O_mono -> true
+| _ -> false
+
+let rec oform_eq f f' = match f,f' with
+  | Oint i, Oint i' -> Bigint.equal i i'
+  | Oplus (f1,f2), Oplus (f1',f2')
+  | Omult (f1,f2), Omult (f1',f2')
+  | Ominus (f1,f2), Ominus (f1',f2') -> oform_eq f1 f1' && oform_eq f2 f2'
+  | Oopp f, Oopp f' -> oform_eq f f'
+  | Oatom a, Oatom a' -> Int.equal a a'
+  | _ -> false
+
+let dir_eq d d' = match d, d' with
+  | Left i, Left i' | Right i, Right i' -> Int.equal i i'
+  | _ -> false
+
 (* \section{Specific utility functions to handle base types} *)
 (* Nom arbitraire de l'hypothèse codant la négation du but final *)
-let id_concl = Names.Id.of_string "__goal__"
+let id_concl = Id.of_string "__goal__"
 
 (* Initialisation de l'environnement de réification de la tactique *)
 let new_environment () = {
-  terms = []; props = []; om_vars = []; cnt_connectors = 0;
-  real_indices = Hashtbl.create 7;
-  equations = Hashtbl.create 7;
-  constructors = Hashtbl.create 7;
+  terms = []; props = []; cnt_connectors = 0;
+  real_indices = IntHtbl.create 7;
+  equations = IntHtbl.create 7;
+  constructors = IntHtbl.create 7;
 }
 
 (* Génération d'un nom d'équation *)
@@ -166,8 +182,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_econstr_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
@@ -178,52 +195,30 @@ let print_env_reification env =
 (* generation d'identifiant d'equation pour Omega *)
 
 let new_omega_eq, rst_omega_eq =
-  let cpt = ref 0 in
+  let cpt = ref (-1) in
   (function () -> incr cpt; !cpt),
-  (function () -> cpt:=0)
+  (function () -> cpt:=(-1))
 
 (* generation d'identifiant de variable pour Omega *)
 
-let new_omega_var, rst_omega_var =
-  let cpt = ref 0 in
+let new_omega_var, rst_omega_var, set_omega_maxvar =
+  let cpt = ref (-1) in
   (function () -> incr cpt; !cpt),
-  (function () -> cpt:=0)
+  (function () -> cpt:=(-1)),
+  (function n -> cpt:=n)
 
 (* Affichage des variables d'un système *)
 
 let display_omega_var i = Printf.sprintf "OV%d" i
 
-(* Recherche la variable codant un terme pour Omega et crée la variable dans
-   l'environnement si il n'existe pas. Cas ou la variable dans Omega représente
-   le terme d'un monome (le plus souvent un atome) *)
-
-let intern_omega env t =
-  begin try List.assoc_f Pervasives.(=) t env.om_vars (* FIXME *)
-  with Not_found ->
-    let v = new_omega_var () in
-    env.om_vars <- (t,v) :: env.om_vars; v
-  end
-
-(* Ajout forcé d'un lien entre un terme et une variable  Cas où la
-   variable est créée par Omega et où il faut la lier après coup à un atome
-   réifié introduit de force *)
-let intern_omega_force env t v = env.om_vars <- (t,v) :: env.om_vars
-
-(* Récupère le terme associé à une variable *)
-let unintern_omega env id =
-  let rec loop = function
-	[] -> failwith "unintern"
-      | ((t,j)::l) -> if Int.equal id j then t else loop l in
-  loop env.om_vars
-
 (* \subsection{Gestion des environnements de variable pour la réflexion}
    Gestion des environnements de traduction entre termes des constructions
    non réifiés et variables des termes reifies. Attention il s'agit de
    l'environnement initial contenant tout. Il faudra le réduire après
    calcul des variables utiles. *)
 
-let add_reified_atom t env =
-  try List.index0 Term.eq_constr t env.terms
+let add_reified_atom sigma t env =
+  try List.index0 (EConstr.eq_constr sigma) t env.terms
   with Not_found ->
     let i = List.length env.terms in
     env.terms <- env.terms @ [t]; i
@@ -231,10 +226,17 @@ let add_reified_atom t env =
 let get_reified_atom env =
   try List.nth env.terms with Invalid_argument _ -> failwith "get_reified_atom"
 
+(** When the omega resolution has created a variable [v], we re-sync
+    the environment with this new variable. To be done in the right order. *)
+
+let set_reified_atom v t env =
+  assert (Int.equal v (List.length env.terms));
+  env.terms <- env.terms @ [t]
+
 (* \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
+let add_prop sigma env t =
+  try List.index0 (EConstr.eq_constr sigma) t env.props
   with Not_found ->
     let i = List.length env.props in  env.props <- env.props @ [t]; i
 
@@ -246,12 +248,11 @@ let get_prop v env =
 (* Ajout d'une equation dans l'environnement de reification *)
 let add_equation env e =
   let id = e.e_omega.id in
-  try let _ = Hashtbl.find env.equations id in ()
-  with Not_found -> Hashtbl.add env.equations id e
+  if IntHtbl.mem env.equations id then () else IntHtbl.add env.equations id e
 
 (* accès a une equation *)
 let get_equation env id =
-  try Hashtbl.find env.equations id
+  try IntHtbl.find env.equations id
   with Not_found as e ->
     Printf.printf "Omega Equation %d non trouvée\n" id; raise e
 
@@ -263,15 +264,14 @@ let rec oprint ch = function
   | Ominus(t1,t2) -> Printf.fprintf ch "(%a - %a)" oprint t1 oprint t2
   | Oopp t1 ->Printf.fprintf ch "~ %a" oprint t1
   | Oatom n -> Printf.fprintf ch "V%02d" n
-  | Oufo x ->  Printf.fprintf ch "?"
+
+let print_comp = function
+  | Eq -> "=" | Leq -> "<=" | Geq -> ">="
+  | Gt -> ">" | Lt -> "<" | Neq -> "!="
 
 let rec pprint ch = function
     Pequa (_,{ e_comp=comp; e_left=t1; e_right=t2 })  ->
-      let connector =
-	match comp with
-	  Eq -> "=" | Leq -> "<=" | Geq -> ">="
-	| Gt -> ">" | Lt -> "<" | Neq -> "!=" in
-      Printf.fprintf ch "%a %s %a" oprint t1 connector oprint t2
+      Printf.fprintf ch "%a %s %a" oprint t1 (print_comp comp) oprint t2
   | Ptrue -> Printf.fprintf ch "TT"
   | Pfalse -> Printf.fprintf ch "FF"
   | Pnot t -> Printf.fprintf ch "not(%a)" pprint t
@@ -280,41 +280,16 @@ let rec pprint ch = function
   | Pimp(_,t1,t2) -> Printf.fprintf ch "(%a => %a)" pprint t1 pprint t2
   | Pprop c -> Printf.fprintf ch "Prop"
 
-let rec weight env = function
-  | Oint _ -> -1
-  | Oopp c -> weight env c
-  | Omult(c,_) -> weight env c
-  | Oplus _ -> failwith "weight"
-  | Ominus _ -> failwith "weight minus"
-  | Oufo _ -> -1
-  | Oatom _ as c -> (intern_omega env c)
-
-(* \section{Passage entre oformules et représentation interne de Omega} *)
-
-(* \subsection{Oformula vers Omega} *)
-
-let omega_of_oformula env kind =
-  let rec loop accu = function
-    | Oplus(Omult(v,Oint n),r) ->
-	loop ({v=intern_omega env v; c=n} :: accu) r
-    | Oint n ->
-	let id = new_omega_eq () in
-	(*i tag_equation name id; i*)
-	{kind = kind; body = List.rev accu;
-	 constant = n; id = id}
-    | t -> print_string "CO"; oprint stdout t; failwith "compile_equation" in
-  loop []
-
 (* \subsection{Omega vers Oformula} *)
 
-let oformula_of_omega env af =
+let oformula_of_omega af =
   let rec loop = function
-    | ({v=v; c=n}::r) ->
-	Oplus(Omult(unintern_omega env v,Oint n),loop r)
-    | [] -> Oint af.constant in
+    | ({v=v; c=n}::r) -> Oplus(Omult(Oatom v,Oint n),loop r)
+    | [] -> Oint af.constant
+  in
   loop af.body
 
-let app f v = mkApp(Lazy.force f,v)
+let app f v = EConstr.mkApp(Lazy.force f,v)
 
 (* \subsection{Oformula vers COQ reel} *)
 
@@ -324,7 +299,6 @@ let coq_of_formula env t =
   | Oopp t -> app Z.opp [| loop t |]
   | Omult(t1,t2) -> app Z.mult [| loop t1; loop t2 |]
   | Oint v ->   Z.mk v
-  | Oufo t -> loop t
   | Oatom var ->
       (* attention ne traite pas les nouvelles variables si on ne les
        * met pas dans env.term *)
@@ -335,77 +309,60 @@ let coq_of_formula env t =
 (* \subsection{Oformula vers COQ reifié} *)
 
 let reified_of_atom env i =
-  try Hashtbl.find env.real_indices i
+  try IntHtbl.find env.real_indices i
   with Not_found ->
     Printf.printf "Atome %d non trouvé\n" i;
-    Hashtbl.iter (fun k v -> Printf.printf "%d -> %d\n" k v) env.real_indices;
+    IntHtbl.iter (fun k v -> Printf.printf "%d -> %d\n" k v) env.real_indices;
     raise Not_found
 
-let rec reified_of_formula env = function
-  | Oplus (t1,t2) ->
-      app coq_t_plus [| reified_of_formula env t1; reified_of_formula env t2 |]
-  | Oopp t ->
-      app coq_t_opp [| reified_of_formula env t |]
-  | Omult(t1,t2) ->
-      app coq_t_mult [| reified_of_formula env t1; reified_of_formula env t2 |]
-  | Oint v ->  app coq_t_int [| Z.mk v |]
-  | Oufo t -> reified_of_formula env t
-  | Oatom i -> app coq_t_var [| mk_nat (reified_of_atom env i) |]
-  | Ominus(t1,t2) ->
-      app coq_t_minus [| reified_of_formula env t1; reified_of_formula env t2 |]
+let reified_binop = function
+  | Oplus _ -> app coq_t_plus
+  | Ominus _ -> app coq_t_minus
+  | Omult _ -> app coq_t_mult
+  | _ -> assert false
+
+let rec reified_of_formula env t = match t with
+  | Oplus (t1,t2) | Omult (t1,t2) | Ominus (t1,t2) ->
+     reified_binop t [| reified_of_formula env t1; reified_of_formula env t2 |]
+  | Oopp t -> app coq_t_opp [| reified_of_formula env t |]
+  | Oint v -> app coq_t_int [| Z.mk v |]
+  | Oatom i -> app coq_t_var [| mk_N (reified_of_atom env i) |]
 
 let reified_of_formula env f =
   try reified_of_formula env f
   with reraise -> oprint stderr f; raise reraise
 
-let rec reified_of_proposition env = function
-    Pequa (_,{ e_comp=Eq; e_left=t1; e_right=t2 }) ->
-      app coq_p_eq [| reified_of_formula env t1; reified_of_formula env t2 |]
-  | Pequa (_,{ e_comp=Leq; e_left=t1; e_right=t2 }) ->
-      app coq_p_leq [| reified_of_formula env t1; reified_of_formula env t2 |]
-  | Pequa(_,{ e_comp=Geq; e_left=t1; e_right=t2 }) ->
-      app coq_p_geq [| reified_of_formula env t1; reified_of_formula env t2 |]
-  | Pequa(_,{ e_comp=Gt; e_left=t1; e_right=t2 }) ->
-      app coq_p_gt [| reified_of_formula env t1; reified_of_formula env t2 |]
-  | Pequa(_,{ e_comp=Lt; e_left=t1; e_right=t2 }) ->
-      app coq_p_lt [| reified_of_formula env t1; reified_of_formula env t2 |]
-  | Pequa(_,{ e_comp=Neq; e_left=t1; e_right=t2 }) ->
-      app coq_p_neq [| reified_of_formula env t1; reified_of_formula env t2 |]
+let reified_cmp = function
+  | Eq -> app coq_p_eq
+  | Leq -> app coq_p_leq
+  | Geq -> app coq_p_geq
+  | Gt -> app coq_p_gt
+  | Lt -> app coq_p_lt
+  | Neq -> app coq_p_neq
+
+let reified_conn = function
+  | Por _ -> app coq_p_or
+  | Pand _ -> app coq_p_and
+  | Pimp _ -> app coq_p_imp
+  | _ -> assert false
+
+let rec reified_of_oprop sigma env t = match t with
+  | Pequa (_,{ e_comp=cmp; e_left=t1; e_right=t2 }) ->
+     reified_cmp cmp [| reified_of_formula env t1; reified_of_formula env t2 |]
   | Ptrue -> Lazy.force coq_p_true
   | Pfalse -> Lazy.force coq_p_false
-  | Pnot t ->
-      app coq_p_not [| reified_of_proposition env t |]
-  | Por (_,t1,t2) ->
-      app coq_p_or
-	[| reified_of_proposition env t1; reified_of_proposition env t2 |]
-  | Pand(_,t1,t2) ->
-      app coq_p_and
-	[| reified_of_proposition env t1; reified_of_proposition env t2 |]
-  | Pimp(_,t1,t2) ->
-      app coq_p_imp
-	[| reified_of_proposition env t1; reified_of_proposition env t2 |]
-  | Pprop t -> app coq_p_prop [| mk_nat (add_prop env t) |]
-
-let reified_of_proposition env f =
-  try reified_of_proposition env f
+  | Pnot t -> app coq_p_not [| reified_of_oprop sigma env t |]
+  | Por (_,t1,t2) | Pand (_,t1,t2) | Pimp (_,t1,t2) ->
+     reified_conn t
+      [| reified_of_oprop sigma env t1; reified_of_oprop sigma env t2 |]
+  | Pprop t -> app coq_p_prop [| mk_nat (add_prop sigma env t) |]
+
+let reified_of_proposition sigma env f =
+  try reified_of_oprop sigma env f
   with reraise -> pprint stderr f; raise reraise
 
-(* \subsection{Omega vers COQ réifié} *)
-
-let reified_of_omega env body constant =
-  let coeff_constant =
-    app coq_t_int [| Z.mk constant |] in
-  let mk_coeff {c=c; v=v} t =
-    let coef =
-      app coq_t_mult
-	[| reified_of_formula env (unintern_omega env v);
-	   app coq_t_int [| Z.mk c |] |] in
-    app coq_t_plus [|coef; t |] in
-  List.fold_right mk_coeff body coeff_constant
-
-let reified_of_omega env body c  =
-  try reified_of_omega env body c
-  with reraise -> display_eq display_omega_var (body,c); raise reraise
+let reified_of_eq env (l,r) =
+  app coq_p_eq [| reified_of_formula env l; reified_of_formula env r |]
 
 (* \section{Opérations sur les équations}
 Ces fonctions préparent les traces utilisées par la tactique réfléchie
@@ -415,19 +372,18 @@ pour faire des opérations de normalisation sur les équations.  *)
 (* Extraction des variables d'une équation. *)
 (* Chaque fonction retourne une liste triée sans redondance *)
 
-let (@@) = List.merge_uniq compare
+let (@@) = IntSet.union
 
 let rec vars_of_formula = function
-  | Oint _ -> []
+  | Oint _ -> IntSet.empty
   | Oplus (e1,e2) -> (vars_of_formula e1) @@ (vars_of_formula e2)
   | Omult (e1,e2) -> (vars_of_formula e1) @@ (vars_of_formula e2)
   | Ominus (e1,e2) -> (vars_of_formula e1) @@ (vars_of_formula e2)
   | Oopp e -> vars_of_formula e
-  | Oatom i -> [i]
-  | Oufo _ -> []
+  | Oatom i -> IntSet.singleton i
 
 let rec vars_of_equations = function
-  | [] -> []
+  | [] -> IntSet.empty
   | e::l ->
       (vars_of_formula e.e_left) @@
       (vars_of_formula e.e_right) @@
@@ -439,385 +395,226 @@ let rec vars_of_prop = function
   | Por(_,p1,p2) -> (vars_of_prop p1) @@ (vars_of_prop p2)
   | Pand(_,p1,p2) -> (vars_of_prop p1) @@ (vars_of_prop p2)
   | Pimp(_,p1,p2) -> (vars_of_prop p1) @@ (vars_of_prop p2)
-  | Pprop _ | Ptrue | Pfalse -> []
-
-(* \subsection{Multiplication par un scalaire} *)
-
-let rec scalar n = function
-   Oplus(t1,t2) ->
-     let tac1,t1' = scalar  n t1 and
-         tac2,t2' = scalar  n t2 in
-     do_list [Lazy.force coq_c_mult_plus_distr; do_both tac1 tac2],
-     Oplus(t1',t2')
- | Oopp t ->
-     do_list [Lazy.force coq_c_mult_opp_left], Omult(t,Oint(Bigint.neg n))
- | Omult(t1,Oint x) ->
-     do_list [Lazy.force coq_c_mult_assoc_reduced], Omult(t1,Oint (n*x))
- | Omult(t1,t2) ->
-     CErrors.error "Omega: Can't solve a goal with non-linear products"
- | (Oatom _ as t) -> do_list [], Omult(t,Oint n)
- | Oint i -> do_list [Lazy.force coq_c_reduce],Oint(n*i)
- | (Oufo _ as t)-> do_list [], Oufo (Omult(t,Oint n))
- | Ominus _ -> failwith "scalar minus"
-
-(* \subsection{Propagation de l'inversion} *)
-
-let rec negate = function
-   Oplus(t1,t2) ->
-     let tac1,t1' = negate t1 and
-         tac2,t2' = negate t2 in
-     do_list [Lazy.force coq_c_opp_plus ; (do_both tac1 tac2)],
-     Oplus(t1',t2')
- | Oopp t ->
-     do_list [Lazy.force coq_c_opp_opp], t
- | Omult(t1,Oint x) ->
-     do_list [Lazy.force coq_c_opp_mult_r], Omult(t1,Oint (Bigint.neg x))
- | Omult(t1,t2) ->
-     CErrors.error "Omega: Can't solve a goal with non-linear products"
- | (Oatom _ as t) ->
-     do_list [Lazy.force coq_c_opp_one], Omult(t,Oint(negone))
- | Oint i -> do_list [Lazy.force coq_c_reduce] ,Oint(Bigint.neg i)
- | Oufo c -> do_list [], Oufo (Oopp c)
- | Ominus _ -> failwith "negate minus"
-
-let norm l = (List.length l)
-
-(* \subsection{Mélange (fusion) de deux équations} *)
-(* \subsubsection{Version avec coefficients} *)
-let shuffle_path k1 e1 k2 e2 =
-  let rec loop = function
-      (({c=c1;v=v1}::l1) as l1'),
-      (({c=c2;v=v2}::l2) as l2') ->
-	if Int.equal v1 v2 then
-          if Bigint.equal (k1 * c1 + k2 * c2) zero then (
-            Lazy.force coq_f_cancel :: loop (l1,l2))
-          else (
-            Lazy.force coq_f_equal :: loop (l1,l2) )
-	else if v1 > v2 then (
-	  Lazy.force coq_f_left :: loop(l1,l2'))
-	else (
-	  Lazy.force coq_f_right :: loop(l1',l2))
-    | ({c=c1;v=v1}::l1), [] ->
-	  Lazy.force coq_f_left :: loop(l1,[])
-    | [],({c=c2;v=v2}::l2) ->
-	  Lazy.force coq_f_right :: loop([],l2)
-    | [],[] -> flush stdout; [] in
-  mk_shuffle_list (loop (e1,e2))
-
-(* \subsubsection{Version sans coefficients} *)
-let rec shuffle env (t1,t2) =
-  match t1,t2 with
-    Oplus(l1,r1), Oplus(l2,r2) ->
-      if weight env l1 > weight env l2 then
-	let l_action,t' = shuffle env (r1,t2) in
-	do_list [Lazy.force coq_c_plus_assoc_r;do_right l_action], Oplus(l1,t')
-      else
-	let l_action,t' = shuffle env (t1,r2) in
-	do_list [Lazy.force coq_c_plus_permute;do_right l_action], Oplus(l2,t')
-  | Oplus(l1,r1), t2 ->
-      if weight env l1 > weight env t2 then
-        let (l_action,t') = shuffle env (r1,t2) in
-	do_list [Lazy.force coq_c_plus_assoc_r;do_right l_action],Oplus(l1, t')
-      else do_list [Lazy.force coq_c_plus_comm], Oplus(t2,t1)
-  | t1,Oplus(l2,r2) ->
-      if weight env l2 > weight env t1 then
-        let (l_action,t') = shuffle env (t1,r2) in
-	do_list [Lazy.force coq_c_plus_permute;do_right l_action], Oplus(l2,t')
-      else do_list [],Oplus(t1,t2)
-  | Oint t1,Oint t2 ->
-      do_list [Lazy.force coq_c_reduce], Oint(t1+t2)
-  | t1,t2 ->
-      if weight env t1 < weight env t2 then
-	do_list [Lazy.force coq_c_plus_comm], Oplus(t2,t1)
-      else do_list [],Oplus(t1,t2)
-
-(* \subsection{Fusion avec réduction} *)
-
-let shrink_pair f1 f2 =
-  begin match f1,f2 with
-     Oatom v,Oatom _ ->
-       Lazy.force coq_c_red1, Omult(Oatom v,Oint two)
-   | Oatom v, Omult(_,c2) ->
-       Lazy.force coq_c_red2, Omult(Oatom v,Oplus(c2,Oint one))
-   | Omult (v1,c1),Oatom v ->
-       Lazy.force coq_c_red3, Omult(Oatom v,Oplus(c1,Oint one))
-   | Omult (Oatom v,c1),Omult (v2,c2) ->
-       Lazy.force coq_c_red4, Omult(Oatom v,Oplus(c1,c2))
-   | t1,t2 ->
-       oprint stdout t1; print_newline (); oprint stdout t2; print_newline ();
-       flush Pervasives.stdout; CErrors.error "shrink.1"
-  end
+  | Pprop _ | Ptrue | Pfalse -> IntSet.empty
+
+(* Normalized formulas :
+
+   - sorted list of monomials, largest index first,
+     with non-null coefficients
+   - a constant coefficient
+
+   /!\ Keep in sync with the corresponding functions in ReflOmegaCore !
+*)
+
+type nformula =
+  { coefs : (atom_index * Bigint.bigint) list;
+    cst : Bigint.bigint }
+
+let scale n { coefs; cst } =
+  { coefs = List.map (fun (v,k) -> (v,k*n)) coefs;
+    cst = cst*n }
+
+let shuffle nf1 nf2 =
+  let rec merge l1 l2 = match l1,l2 with
+    | [],_ -> l2
+    | _,[] -> l1
+    | (v1,k1)::r1,(v2,k2)::r2 ->
+       if Int.equal v1 v2 then
+         let k = k1+k2 in
+         if Bigint.equal k Bigint.zero then merge r1 r2
+         else (v1,k) :: merge r1 r2
+       else if v1 > v2 then (v1,k1) :: merge r1 l2
+       else (v2,k2) :: merge l1 r2
+  in
+  { coefs = merge nf1.coefs nf2.coefs;
+    cst = nf1.cst + nf2.cst }
+
+let rec normalize = function
+  | Oplus(t1,t2) -> shuffle (normalize t1) (normalize t2)
+  | Ominus(t1,t2) -> normalize (Oplus (t1, Oopp(t2)))
+  | Oopp(t) -> scale negone (normalize t)
+  | Omult(t,Oint n) | Omult (Oint n, t) ->
+     if Bigint.equal n Bigint.zero then { coefs = []; cst = zero }
+     else scale n (normalize t)
+  | Omult _ -> assert false (* invariant on Omult *)
+  | Oint n -> { coefs = []; cst = n }
+  | Oatom v -> { coefs = [v,Bigint.one]; cst=Bigint.zero}
+
+(* From normalized formulas to omega representations *)
+
+let omega_of_nformula env kind nf =
+  { id = new_omega_eq ();
+    kind;
+    constant=nf.cst;
+    body = List.map (fun (v,c) -> { v; c }) nf.coefs }
+
 
-(* \subsection{Calcul d'une sous formule constante} *)
-
-let reduce_factor = function
-   Oatom v ->
-     let r = Omult(Oatom v,Oint one) in
-       [Lazy.force coq_c_red0],r
-  | Omult(Oatom v,Oint n) as f -> [],f
-  | Omult(Oatom v,c) ->
-      let rec compute = function
-          Oint n -> n
-	| Oplus(t1,t2) -> compute t1 + compute t2
-	| _ -> CErrors.error "condense.1" in
-	[Lazy.force coq_c_reduce], Omult(Oatom v,Oint(compute c))
-  | t -> CErrors.error "reduce_factor.1"
-
-(* \subsection{Réordonnancement} *)
-
-let rec condense env = function
-    Oplus(f1,(Oplus(f2,r) as t)) ->
-      if Int.equal (weight env f1) (weight env f2) then begin
-	let shrink_tac,t = shrink_pair f1 f2 in
-	let assoc_tac = Lazy.force coq_c_plus_assoc_l in
-	let tac_list,t' = condense env (Oplus(t,r)) in
-	assoc_tac :: do_left (do_list [shrink_tac]) :: tac_list, t'
-      end else begin
-	let tac,f = reduce_factor f1 in
-	let tac',t' = condense env t in
-	[do_both (do_list tac) (do_list tac')], Oplus(f,t')
-      end
-  | Oplus(f1,Oint n) ->
-      let tac,f1' = reduce_factor f1 in
-      [do_left (do_list tac)],Oplus(f1',Oint n)
-  | Oplus(f1,f2) ->
-      if Int.equal (weight env f1) (weight env f2) then begin
-	let tac_shrink,t = shrink_pair f1 f2 in
-	let tac,t' = condense env t in
-	tac_shrink :: tac,t'
-      end else begin
-	let tac,f = reduce_factor f1 in
-	let tac',t' = condense env f2 in
-	[do_both (do_list tac) (do_list tac')],Oplus(f,t')
-      end
-  | (Oint _ as t)-> [],t
-  | t ->
-      let tac,t' = reduce_factor t in
-      let final = Oplus(t',Oint zero) in
-      tac @ [Lazy.force coq_c_red6], final
-
-(* \subsection{Elimination des zéros} *)
-
-let rec clear_zero = function
-   Oplus(Omult(Oatom v,Oint n),r) when Bigint.equal n zero ->
-     let tac',t = clear_zero r in
-     Lazy.force coq_c_red5 :: tac',t
-  | Oplus(f,r) ->
-      let tac,t = clear_zero r in
-      (if List.is_empty tac then [] else [do_right (do_list tac)]),Oplus(f,t)
-  | t -> [],t;;
-
-(* \subsection{Transformation des hypothèses} *)
-
-let rec reduce env = function
-    Oplus(t1,t2) ->
-      let t1', trace1 = reduce env t1 in
-      let t2', trace2 = reduce env t2 in
-      let trace3,t' = shuffle env (t1',t2') in
-      t', do_list [do_both trace1 trace2; trace3]
-  | Ominus(t1,t2) ->
-      let t,trace = reduce env (Oplus(t1, Oopp t2)) in
-      t, do_list [Lazy.force coq_c_minus; trace]
-  | Omult(t1,t2) as t ->
-      let t1', trace1 = reduce env t1 in
-      let t2', trace2 = reduce env t2 in
-      begin match t1',t2' with
-      | (_, Oint n) ->
-	  let tac,t' = scalar n t1' in
-	  t', do_list [do_both trace1 trace2; tac]
-      | (Oint n,_) ->
-	  let tac,t' = scalar n t2' in
-	  t', do_list [do_both trace1 trace2; Lazy.force coq_c_mult_comm; tac]
-      | _ -> Oufo t, Lazy.force coq_c_nop
-      end
-  | Oopp t ->
-      let t',trace = reduce env  t in
-      let trace',t'' = negate t' in
-      t'', do_list [do_left trace; trace']
-  | (Oint _ | Oatom _ | Oufo _) as t -> t, Lazy.force coq_c_nop
-
-let normalize_linear_term env t =
-  let t1,trace1 = reduce env t in
-  let trace2,t2 = condense env t1 in
-  let trace3,t3 = clear_zero t2 in
-  do_list [trace1; do_list trace2; do_list trace3], t3
-
-(* Cette fonction reproduit très exactement le comportement de [p_invert] *)
 let negate_oper = function
     Eq -> Neq | Neq -> Eq | Leq -> Gt | Geq -> Lt | Lt -> Geq | Gt -> Leq
 
-let normalize_equation env (negated,depends,origin,path) (oper,t1,t2) =
-  let mk_step t1 t2 f kind =
-    let t = f t1 t2 in
-    let trace, oterm = normalize_linear_term env t in
-    let equa = omega_of_oformula env kind oterm in
+let normalize_equation env (negated,depends,origin,path) oper t1 t2 =
+  let mk_step t kind =
+    let equa = omega_of_nformula env kind (normalize t) in
     { e_comp = oper; e_left = t1; e_right = t2;
       e_negated = negated; e_depends = depends;
       e_origin = { o_hyp = origin; o_path = List.rev path };
-      e_trace = trace; e_omega = equa } in
+      e_omega = equa }
+  in
   try match (if negated then (negate_oper oper) else oper) with
-    | Eq  -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) EQUA
-    | Neq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) DISE
-    | Leq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o2,Oopp o1)) INEQ
-    | Geq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) INEQ
-    | Lt  ->
-        mk_step t1 t2 (fun o1 o2 -> Oplus (Oplus(o2,Oint negone),Oopp o1))
-	  INEQ
-    | Gt ->
-        mk_step t1 t2 (fun o1 o2 -> Oplus (Oplus(o1,Oint negone),Oopp o2))
-	  INEQ
+    | Eq  -> mk_step (Oplus (t1,Oopp t2)) EQUA
+    | Neq -> mk_step (Oplus (t1,Oopp t2)) DISE
+    | Leq -> mk_step (Oplus (t2,Oopp t1)) INEQ
+    | Geq -> mk_step (Oplus (t1,Oopp t2)) INEQ
+    | Lt  -> mk_step (Oplus (Oplus(t2,Oint negone),Oopp t1)) INEQ
+    | Gt -> mk_step (Oplus (Oplus(t1,Oint negone),Oopp t2)) INEQ
   with e when Logic.catchable_exception e -> raise e
 
 (* \section{Compilation des hypothèses} *)
 
-let rec oformula_of_constr env t =
-  match Z.parse_term t with
-    | Tplus (t1,t2) -> binop env (fun x y -> Oplus(x,y)) t1 t2
-    | Tminus (t1,t2) -> binop env (fun x y -> Ominus(x,y)) t1 t2
-    | Tmult (t1,t2) when Z.is_scalar t1 || Z.is_scalar t2 ->
-	binop env (fun x y -> Omult(x,y)) t1 t2
-    | Topp t -> Oopp(oformula_of_constr env t)
-    | Tsucc t -> Oplus(oformula_of_constr env t, Oint one)
+let mkPor i x y = Por (i,x,y)
+let mkPand i x y = Pand (i,x,y)
+let mkPimp i x y = Pimp (i,x,y)
+
+let rec oformula_of_constr sigma env t =
+  match Z.parse_term sigma t with
+    | Tplus (t1,t2) -> binop sigma env (fun x y -> Oplus(x,y)) t1 t2
+    | Tminus (t1,t2) -> binop sigma env (fun x y -> Ominus(x,y)) t1 t2
+    | Tmult (t1,t2) ->
+       (match Z.get_scalar sigma t1 with
+        | Some n -> Omult (Oint n,oformula_of_constr sigma env t2)
+        | None ->
+           match Z.get_scalar sigma t2 with
+           | Some n -> Omult (oformula_of_constr sigma env t1, Oint n)
+           | None -> Oatom (add_reified_atom sigma t env))
+    | Topp t -> Oopp(oformula_of_constr sigma env t)
+    | Tsucc t -> Oplus(oformula_of_constr sigma env t, Oint one)
     | Tnum n -> Oint n
-    | _ -> Oatom (add_reified_atom t env)
+    | Tother -> Oatom (add_reified_atom sigma t env)
 
-and binop env c t1 t2 =
-  let t1' = oformula_of_constr env t1 in
-  let t2' = oformula_of_constr env t2 in
+and binop sigma env c t1 t2 =
+  let t1' = oformula_of_constr sigma env t1 in
+  let t2' = oformula_of_constr sigma env t2 in
   c t1' t2'
 
-and binprop env (neg2,depends,origin,path)
+and binprop sigma env (neg2,depends,origin,path)
              add_to_depends neg1 gl c t1 t2 =
   let i = new_connector_id env in
   let depends1 = if add_to_depends then Left i::depends else depends in
   let depends2 = if add_to_depends then Right i::depends else depends in
   if add_to_depends then
-    Hashtbl.add env.constructors i {o_hyp = origin; o_path = List.rev path};
+    IntHtbl.add env.constructors i {o_hyp = origin; o_path = List.rev path};
   let t1' =
-    oproposition_of_constr env (neg1,depends1,origin,O_left::path) gl t1 in
+    oproposition_of_constr sigma env (neg1,depends1,origin,O_left::path) gl t1 in
   let t2' =
-    oproposition_of_constr env (neg2,depends2,origin,O_right::path) gl t2 in
+    oproposition_of_constr sigma env (neg2,depends2,origin,O_right::path) gl t2 in
   (* On numérote le connecteur dans l'environnement. *)
   c i t1' t2'
 
-and mk_equation env ctxt c connector t1 t2 =
-  let t1' = oformula_of_constr env t1 in
-  let t2' = oformula_of_constr env t2 in
+and mk_equation sigma env ctxt c connector t1 t2 =
+  let t1' = oformula_of_constr sigma env t1 in
+  let t2' = oformula_of_constr sigma env t2 in
   (* On ajoute l'equation dans l'environnement. *)
-  let omega = normalize_equation env ctxt (connector,t1',t2') in
+  let omega = normalize_equation env ctxt connector t1' t2' in
   add_equation env omega;
   Pequa (c,omega)
 
-and oproposition_of_constr env ((negated,depends,origin,path) as ctxt) gl c =
+and oproposition_of_constr sigma env ((negated,depends,origin,path) as ctxt) gl c =
   match Z.parse_rel gl c with
-    | Req (t1,t2) -> mk_equation env ctxt c Eq t1 t2
-    | Rne (t1,t2) -> mk_equation env ctxt c Neq t1 t2
-    | Rle (t1,t2) -> mk_equation env ctxt c Leq t1 t2
-    | Rlt (t1,t2) -> mk_equation env ctxt c Lt t1 t2
-    | Rge (t1,t2) -> mk_equation env ctxt c Geq t1 t2
-    | Rgt (t1,t2) -> mk_equation env ctxt c Gt t1 t2
+    | Req (t1,t2) -> mk_equation sigma env ctxt c Eq t1 t2
+    | Rne (t1,t2) -> mk_equation sigma env ctxt c Neq t1 t2
+    | Rle (t1,t2) -> mk_equation sigma env ctxt c Leq t1 t2
+    | Rlt (t1,t2) -> mk_equation sigma env ctxt c Lt t1 t2
+    | Rge (t1,t2) -> mk_equation sigma env ctxt c Geq t1 t2
+    | Rgt (t1,t2) -> mk_equation sigma env ctxt c Gt t1 t2
     | Rtrue -> Ptrue
     | Rfalse -> Pfalse
     | Rnot t ->
-	let t' =
-	  oproposition_of_constr
-	    env (not negated, depends, origin,(O_mono::path)) gl t in
-	Pnot t'
-    | Ror (t1,t2) ->
-	binprop env ctxt (not negated) negated gl (fun i x y -> Por(i,x,y)) t1 t2
-    | Rand (t1,t2) ->
-	binprop env ctxt negated negated gl
-	  (fun i x y -> Pand(i,x,y)) t1 t2
+       let ctxt' = (not negated, depends, origin,(O_mono::path)) in
+       Pnot (oproposition_of_constr sigma env ctxt' gl t)
+    | Ror (t1,t2) -> binprop sigma env ctxt (not negated) negated gl mkPor t1 t2
+    | Rand (t1,t2) -> binprop sigma env ctxt negated negated gl mkPand t1 t2
     | Rimp (t1,t2) ->
-	binprop env ctxt (not negated) (not negated) gl
-	  (fun i x y -> Pimp(i,x,y)) t1 t2
+       binprop sigma env ctxt (not negated) (not negated) gl mkPimp t1 t2
     | Riff (t1,t2) ->
-	binprop env ctxt negated negated gl
-	  (fun i x y -> Pand(i,x,y)) (Term.mkArrow t1 t2) (Term.mkArrow t2 t1)
+       (* No lifting here, since Omega only works on closed propositions. *)
+       binprop sigma env ctxt negated negated gl mkPand
+         (EConstr.mkArrow t1 t2) (EConstr.mkArrow t2 t1)
     | _ -> Pprop c
 
 (* Destructuration des hypothèses et de la conclusion *)
 
+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)
+    t_lhyps;
+  print_env_reification env
+
+type defined = Defined | Assumed
+
+let reify_hyp sigma 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 t ->
+     let dummy = Lazy.force coq_True in
+     let p = mk_equation sigma env ctxt dummy Eq (EConstr.mkVar i) d in
+     i,Defined,p
+  | LocalDef (_,_,t) | LocalAssum (_,t) ->
+     let p = oproposition_of_constr sigma env ctxt gl t in
+     i,Assumed,p
+
 let reify_gl env gl =
-  let concl = Tacmach.pf_concl gl in
-  let t_concl =
-    Pnot (oproposition_of_constr env (true,[],id_concl,[O_mono]) gl concl) in
-  if !debug then begin
-    Printf.printf "REIFED PROBLEM\n\n";
-    Printf.printf "  CONCL: "; pprint stdout t_concl; Printf.printf "\n"
-  end;
-  let rec loop = function
-      (i,t) :: lhyps ->
-	let t' = oproposition_of_constr env (false,[],i,[]) gl t in
-	if !debug then begin
-	  Printf.printf "  %s: " (Names.Id.to_string i);
-	  pprint stdout t';
-	  Printf.printf "\n"
-	end;
-	(i,t') :: loop lhyps
-    | [] ->
-	if !debug then print_env_reification env;
-	[] in
-  let t_lhyps = loop (Tacmach.pf_hyps_types gl) in
-  (id_concl,t_concl) :: t_lhyps
-
-let rec destructurate_pos_hyp orig list_equations list_depends = function
-  | Pequa (_,e) -> [e :: list_equations]
-  | Ptrue | Pfalse | Pprop _ -> [list_equations]
-  | Pnot t -> destructurate_neg_hyp orig list_equations list_depends t
-  | Por (i,t1,t2) ->
-      let s1 =
-	destructurate_pos_hyp orig list_equations (i::list_depends) t1 in
-      let s2 =
-	destructurate_pos_hyp orig list_equations (i::list_depends) t2 in
+  let sigma = Proofview.Goal.sigma gl in
+  let concl = Tacmach.New.pf_concl gl 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 sigma env ctxt_concl gl concl in
+  let t_lhyps = List.map (reify_hyp sigma env gl) hyps in
+  let () = if !debug then display_gl env t_concl t_lhyps in
+  t_concl, t_lhyps
+
+let rec destruct_pos_hyp eqns = function
+  | Pequa (_,e) -> [e :: eqns]
+  | Ptrue | Pfalse | Pprop _ -> [eqns]
+  | Pnot t -> destruct_neg_hyp eqns t
+  | Por (_,t1,t2) ->
+      let s1 = destruct_pos_hyp eqns t1 in
+      let s2 = destruct_pos_hyp eqns t2 in
       s1 @ s2
-  | Pand(i,t1,t2) ->
-      let list_s1 =
-	destructurate_pos_hyp orig list_equations (list_depends) t1 in
-      let rec loop = function
-	  le1 :: ll -> destructurate_pos_hyp orig le1 list_depends t2 @ loop ll
-	| [] -> [] in
-      loop list_s1
-  | Pimp(i,t1,t2) ->
-      let s1 =
-	destructurate_neg_hyp orig list_equations (i::list_depends) t1 in
-      let s2 =
-	destructurate_pos_hyp orig list_equations (i::list_depends) t2 in
+  | Pand(_,t1,t2) ->
+      List.map_append
+        (fun le1 -> destruct_pos_hyp le1 t2)
+        (destruct_pos_hyp eqns t1)
+  | Pimp(_,t1,t2) ->
+      let s1 = destruct_neg_hyp eqns t1 in
+      let s2 = destruct_pos_hyp eqns t2 in
       s1 @ s2
 
-and destructurate_neg_hyp orig list_equations list_depends = function
-  | Pequa (_,e) -> [e :: list_equations]
-  | Ptrue | Pfalse | Pprop _ -> [list_equations]
-  | Pnot t -> destructurate_pos_hyp orig list_equations list_depends t
-  | Pand (i,t1,t2) ->
-      let s1 =
-	destructurate_neg_hyp orig list_equations (i::list_depends) t1 in
-      let s2 =
-	destructurate_neg_hyp orig list_equations (i::list_depends) t2 in
+and destruct_neg_hyp eqns = function
+  | Pequa (_,e) -> [e :: eqns]
+  | Ptrue | Pfalse | Pprop _ -> [eqns]
+  | Pnot t -> destruct_pos_hyp eqns t
+  | Pand (_,t1,t2) ->
+      let s1 = destruct_neg_hyp eqns t1 in
+      let s2 = destruct_neg_hyp eqns t2 in
       s1 @ s2
   | Por(_,t1,t2) ->
-      let list_s1 =
-	destructurate_neg_hyp orig list_equations list_depends t1 in
-      let rec loop = function
-	  le1 :: ll -> destructurate_neg_hyp orig le1 list_depends t2 @ loop ll
-	| [] -> [] in
-      loop list_s1
+      List.map_append
+        (fun le1 -> destruct_neg_hyp le1 t2)
+        (destruct_neg_hyp eqns t1)
   | Pimp(_,t1,t2) ->
-      let list_s1 =
-	destructurate_pos_hyp orig list_equations list_depends t1 in
-      let rec loop = function
-	  le1 :: ll -> destructurate_neg_hyp orig le1 list_depends t2 @ loop ll
-	| [] -> [] in
-      loop list_s1
-
-let destructurate_hyps syst =
-  let rec loop = function
-      (i,t) :: l ->
-	let l_syst1 = destructurate_pos_hyp i []  [] t in
-	let l_syst2 = loop l in
-	List.cartesian (@) l_syst1 l_syst2
-    | [] -> [[]] in
-  loop syst
+      List.map_append
+        (fun le1 -> destruct_neg_hyp le1 t2)
+        (destruct_pos_hyp eqns t1)
+
+let rec destructurate_hyps = function
+  | [] -> [[]]
+  | (i,_,t) :: l ->
+     let l_syst1 = destruct_pos_hyp [] t in
+     let l_syst2 = destructurate_hyps l in
+     List.cartesian (@) l_syst1 l_syst2
 
 (* \subsection{Affichage d'un système d'équation} *)
 
@@ -835,7 +632,7 @@ let display_systems syst_list =
       (operator_of_eq om_e.kind) in
 
   let display_equation oformula_eq =
-    pprint stdout (Pequa (Lazy.force coq_c_nop,oformula_eq)); print_newline ();
+    pprint stdout (Pequa (Lazy.force coq_I,oformula_eq)); print_newline ();
     display_omega oformula_eq.e_omega;
     Printf.printf "  Depends on:";
     List.iter display_depend oformula_eq.e_depends;
@@ -844,7 +641,7 @@ let display_systems syst_list =
 	 (List.map (function O_left -> "L" | O_right -> "R" | O_mono -> "M")
 	    oformula_eq.e_origin.o_path));
     Printf.printf "\n  Origin: %s (negated : %s)\n\n"
-      (Names.Id.to_string oformula_eq.e_origin.o_hyp)
+      (Id.to_string oformula_eq.e_origin.o_hyp)
       (if oformula_eq.e_negated then "yes" else "no") in
 
   let display_system syst =
@@ -856,59 +653,61 @@ let display_systems syst_list =
    calcul des hypothèses *)
 
 let rec hyps_used_in_trace = function
+  | [] -> IntSet.empty
   | act :: l ->
-      begin match act with
-	| HYP e -> [e.id] @@ (hyps_used_in_trace l)
-	| SPLIT_INEQ (_,(_,act1),(_,act2)) ->
-	    hyps_used_in_trace act1 @@ hyps_used_in_trace act2
-	| _ -> hyps_used_in_trace l
-      end
-  | [] -> []
-
-(* Extraction des variables déclarées dans une équation. Permet ensuite
-   de les déclarer dans l'environnement de la procédure réflexive et
-   éviter les créations de variable au vol *)
-
-let rec variable_stated_in_trace = function
-  | act :: l ->
-      begin match act with
-	| STATE action ->
-	    (*i nlle_equa: afine, def: afine, eq_orig: afine, i*)
-            (*i coef: int, var:int                            i*)
-	    action :: variable_stated_in_trace l
-	| SPLIT_INEQ (_,(_,act1),(_,act2)) ->
-	    variable_stated_in_trace act1 @ variable_stated_in_trace act2
-	| _ -> variable_stated_in_trace l
-      end
-  | [] -> []
-;;
-
-let add_stated_equations env tree =
-  (* Il faut trier les variables par ordre d'introduction pour ne pas risquer
-     de définir dans le mauvais ordre *)
-  let stated_equations =
-    let cmpvar x y = Pervasives.(-) x.st_var y.st_var in
-    let rec loop = function
-      | Tree(_,t1,t2) -> List.merge cmpvar (loop t1) (loop t2)
-      | Leaf s -> List.sort cmpvar (variable_stated_in_trace s.s_trace)
-    in loop tree
-  in
-  let add_env st =
-    (* On retransforme la définition de v en formule reifiée *)
-    let v_def = oformula_of_omega env st.st_def in
-    (* Notez que si l'ordre de création des variables n'est pas respecté,
-     * ca va planter *)
+     match act with
+     | HYP e -> IntSet.add e.id (hyps_used_in_trace l)
+     | SPLIT_INEQ (_,(_,act1),(_,act2)) ->
+        hyps_used_in_trace act1 @@ hyps_used_in_trace act2
+     | _ -> hyps_used_in_trace l
+
+(** Retreive variables declared as extra equations during resolution
+    and declare them into the environment.
+    We should consider these variables in their introduction order,
+    otherwise really bad things will happen. *)
+
+let state_cmp x y = Int.compare x.st_var y.st_var
+
+module StateSet =
+  Set.Make (struct type t = state_action let compare = state_cmp end)
+
+let rec stated_in_trace = function
+  | [] -> StateSet.empty
+  | [SPLIT_INEQ (_,(_,t1),(_,t2))] ->
+     StateSet.union (stated_in_trace t1) (stated_in_trace t2)
+  | STATE action :: l -> StateSet.add action (stated_in_trace l)
+  | _ :: l -> stated_in_trace l
+
+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 = 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]
+        - into a reified formula : *)
+    let v_def = oformula_of_omega st.st_def in
+    (** - into a concrete Coq formula
+          (this uses only older vars already in env) : *)
     let coq_v = coq_of_formula env v_def in
-    let v = add_reified_atom coq_v env in
-    (* Le terme qu'il va falloir introduire *)
-    let term_to_generalize = app coq_refl_equal [|Lazy.force Z.typ; coq_v|] in
-    (* sa représentation sous forme d'équation mais non réifié car on n'a pas
-     * l'environnement pour le faire correctement *)
-    let term_to_reify = (v_def,Oatom v) in
-    (* enregistre le lien entre la variable omega et la variable Coq *)
-    intern_omega_force env (Oatom v) st.st_var;
-    (v, term_to_generalize,term_to_reify,st.st_def.id) in
- List.map add_env stated_equations
+    (** We then update the environment *)
+    set_reified_atom st.st_var coq_v env;
+    (** The term we'll introduce *)
+    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
+    (st.st_var::vars,
+     term_to_generalize::gens,
+     term_to_reify::eqns,
+     CCEqua st.st_def.id :: ids)
+  in
+  let (vars,gens,eqns,ids) =
+    StateSet.fold do_equation (stated_in_tree tree) ([],[],[],[])
+  in
+  (List.rev vars, List.rev gens, List.rev eqns, List.rev ids)
 
 (* Calcule la liste des éclatements à réaliser sur les hypothèses
    nécessaires pour extraire une liste d'équations donnée *)
@@ -919,22 +718,22 @@ let add_stated_equations env tree =
    arg, then second arg), unless you know what you're doing. *)
 
 let rec get_eclatement env = function
-    i :: r ->
-      let l = try (get_equation env i).e_depends with Not_found -> [] in
-      List.union Pervasives.(=) (List.rev l) (get_eclatement env r)
   | [] -> []
+  | i :: r ->
+     let l = try (get_equation env i).e_depends with Not_found -> [] in
+     List.union dir_eq (List.rev l) (get_eclatement env r)
 
 let select_smaller l =
-  let comp (_,x) (_,y) = Pervasives.(-) (List.length x) (List.length y) in
+  let comp (_,x) (_,y) = Int.compare (List.length x) (List.length y) in
   try List.hd (List.sort comp l) with Failure _ -> failwith "select_smaller"
 
 let filter_compatible_systems required systems =
   let rec select = function
-      (x::l) ->
-	if List.mem x required then select l
-	else if List.mem (barre x) required then raise Exit
-	else x :: select l
     | [] -> []
+    | (x::l) ->
+       if List.mem_f dir_eq x required then select l
+       else if List.mem_f dir_eq (barre x) required then raise Exit
+       else x :: select l
   in
   List.map_filter
     (function (sol, splits) ->
@@ -942,54 +741,51 @@ let filter_compatible_systems required systems =
     systems
 
 let rec equas_of_solution_tree = function
-    Tree(_,t1,t2) -> (equas_of_solution_tree t1)@@(equas_of_solution_tree t2)
+  | Tree(_,t1,t2) ->
+     (equas_of_solution_tree t1)@@(equas_of_solution_tree t2)
   | Leaf s -> s.s_equa_deps
 
-(* [really_useful_prop] pushes useless props in a new Pprop variable *)
-(* Things get shorter, but may also get wrong, since a Prop is considered
-   to be undecidable in ReflOmegaCore.concl_to_hyp, whereas for instance
-   Pfalse is decidable. So should not be used on conclusion (??) *)
-
-let really_useful_prop l_equa c =
-  let rec real_of = function
-      Pequa(t,_) -> t
-    | Ptrue ->  app  coq_True [||]
-    | Pfalse -> app  coq_False [||]
-    | Pnot t1 -> app coq_not [|real_of t1|]
-    | Por(_,t1,t2) -> app coq_or [|real_of t1; real_of t2|]
-    | Pand(_,t1,t2) -> app coq_and [|real_of t1; real_of t2|]
-    (* Attention : implications sur le lifting des variables à comprendre ! *)
-    | Pimp(_,t1,t2) -> Term.mkArrow (real_of t1) (real_of t2)
-    | Pprop t -> t in
-  let rec loop c =
-    match c with
-      Pequa(_,e) ->
-	if List.mem e.e_omega.id l_equa then Some c else None
-    | Ptrue -> None
-    | Pfalse -> None
-    | Pnot t1 ->
-	begin match loop t1 with None -> None | Some t1' -> Some (Pnot t1') end
-    | Por(i,t1,t2) -> binop (fun (t1,t2) -> Por(i,t1,t2)) t1 t2
-    | Pand(i,t1,t2) -> binop (fun (t1,t2) -> Pand(i,t1,t2)) t1 t2
-    | Pimp(i,t1,t2) -> binop (fun (t1,t2) -> Pimp(i,t1,t2)) t1 t2
-    | Pprop t -> None
-  and binop f t1 t2 =
-    begin match loop t1, loop t2 with
-      None, None -> None
-    | Some t1',Some t2' -> Some (f(t1',t2'))
-    | Some t1',None -> Some (f(t1',Pprop (real_of t2)))
-    | None,Some t2' -> Some (f(Pprop (real_of t1),t2'))
-    end in
-  match loop c with
-    None -> Pprop (real_of c)
-  | Some t -> t
+(** [maximize_prop] pushes useless props in a new Pprop atom.
+  The reified formulas get shorter, but be careful with decidabilities.
+  For instance, anything that contains a Pprop is considered to be
+  undecidable in [ReflOmegaCore], whereas a Pfalse for instance at
+  the same spot will lead to a decidable formula.
+  In particular, do not use this function on the conclusion.
+  Even in hypotheses, we could probably build pathological examples
+  that romega won't handle correctly, but they should be pretty rare.
+*)
+
+let maximize_prop equas c =
+  let rec loop c = match c with
+    | Pequa(t,e) -> if IntSet.mem e.e_omega.id equas then c else Pprop t
+    | Pnot t ->
+       (match loop t with
+        | Pprop p -> Pprop (app coq_not [|p|])
+        | t' -> Pnot t')
+    | Por(i,t1,t2) ->
+       (match loop t1, loop t2 with
+        | Pprop p1, Pprop p2 -> Pprop (app coq_or [|p1;p2|])
+        | t1', t2' -> Por(i,t1',t2'))
+    | Pand(i,t1,t2) ->
+       (match loop t1, loop t2 with
+        | Pprop p1, Pprop p2 -> Pprop (app coq_and [|p1;p2|])
+        | t1', t2' -> Pand(i,t1',t2'))
+    | Pimp(i,t1,t2) ->
+       (match loop t1, loop t2 with
+        | Pprop p1, Pprop p2 -> Pprop (EConstr.mkArrow p1 p2) (* no lift (closed) *)
+        | t1', t2' -> Pimp(i,t1',t2'))
+    | Ptrue -> Pprop (app coq_True [||])
+    | Pfalse -> Pprop (app coq_False [||])
+    | Pprop _ -> c
+  in loop c
 
 let rec display_solution_tree ch = function
     Leaf t ->
       output_string ch
        (Printf.sprintf "%d[%s]"
-	 t.s_index
-         (String.concat " " (List.map string_of_int t.s_equa_deps)))
+         t.s_index
+         (String.concat " " (List.map string_of_int
+                                      (IntSet.elements t.s_equa_deps))))
   | Tree(i,t1,t2) ->
       Printf.fprintf ch "S%d(%a,%a)" i
 	display_solution_tree t1 display_solution_tree t2
@@ -1021,7 +817,7 @@ let find_path {o_hyp=id;o_path=p} env =
     | (x1::l1,x2::l2) when occ_step_eq x1 x2 -> loop_path (l1,l2)
     | _ -> None in
   let rec loop_id i = function
-      CCHyp{o_hyp=id';o_path=p'} :: l when Names.Id.equal id id' ->
+      CCHyp{o_hyp=id';o_path=p'} :: l when Id.equal id id' ->
 	begin match loop_path (p',p) with
 	  Some r -> i,r
 	| None -> loop_id (succ i) l
@@ -1032,110 +828,81 @@ let find_path {o_hyp=id;o_path=p} env =
 
 let mk_direction_list l =
   let trans = function
-      O_left -> coq_d_left | O_right -> coq_d_right | O_mono -> coq_d_mono in
-  mk_list (Lazy.force coq_direction) (List.map (fun d-> Lazy.force(trans d)) l)
+    | O_left -> Some (Lazy.force coq_d_left)
+    | O_right -> Some (Lazy.force coq_d_right)
+    | O_mono -> None (* No more [D_mono] constructor now *)
+  in
+  mk_list (Lazy.force coq_direction) (List.map_filter trans l)
 
 
 (* \section{Rejouer l'historique} *)
 
-let get_hyp env_hyp i =
-  try List.index0 Pervasives.(=) (CCEqua i) env_hyp
-  with Not_found -> failwith (Printf.sprintf "get_hyp %d" i)
-
-let replay_history env env_hyp =
-  let rec loop env_hyp t =
-    match t with
-      | CONTRADICTION (e1,e2) :: l ->
-	  let trace = mk_nat (List.length e1.body) in
-	  mkApp (Lazy.force coq_s_contradiction,
-		 [| trace ; mk_nat (get_hyp env_hyp e1.id);
-		    mk_nat (get_hyp env_hyp e2.id) |])
-      | DIVIDE_AND_APPROX (e1,e2,k,d) :: l ->
-	  mkApp (Lazy.force coq_s_div_approx,
-		 [| Z.mk k; Z.mk d;
-		    reified_of_omega env e2.body e2.constant;
-		    mk_nat (List.length e2.body);
-		    loop env_hyp l; mk_nat (get_hyp env_hyp e1.id) |])
-      | NOT_EXACT_DIVIDE (e1,k) :: l ->
-	  let e2_constant = floor_div e1.constant k in
-	  let d = e1.constant - e2_constant * k in
-	  let e2_body = map_eq_linear (fun c -> c / k) e1.body in
-          mkApp (Lazy.force coq_s_not_exact_divide,
-		 [|Z.mk k; Z.mk d;
-		   reified_of_omega env e2_body e2_constant;
-		   mk_nat (List.length e2_body);
-		   mk_nat (get_hyp env_hyp e1.id)|])
-      | EXACT_DIVIDE (e1,k) :: l ->
-	  let e2_body =
-	    map_eq_linear (fun c -> c / k) e1.body in
-	  let e2_constant = floor_div e1.constant k in
-          mkApp (Lazy.force coq_s_exact_divide,
-		 [|Z.mk k;
-		   reified_of_omega env e2_body e2_constant;
-		   mk_nat (List.length e2_body);
-		   loop env_hyp l; mk_nat (get_hyp env_hyp e1.id)|])
-      | (MERGE_EQ(e3,e1,e2)) :: l ->
-	  let n1 = get_hyp env_hyp e1.id and n2 = get_hyp env_hyp e2 in
-          mkApp (Lazy.force coq_s_merge_eq,
-		 [| mk_nat (List.length e1.body);
-		    mk_nat n1; mk_nat n2;
-		    loop (CCEqua e3:: env_hyp) l |])
-      | SUM(e3,(k1,e1),(k2,e2)) :: l ->
-	  let n1 = get_hyp env_hyp e1.id
-	  and n2 = get_hyp env_hyp e2.id in
-	  let trace = shuffle_path k1 e1.body k2 e2.body in
-          mkApp (Lazy.force coq_s_sum,
-		 [| Z.mk k1; mk_nat n1; Z.mk k2;
-		    mk_nat n2; trace; (loop (CCEqua e3 :: env_hyp) l) |])
-      | CONSTANT_NOT_NUL(e,k) :: l ->
-          mkApp (Lazy.force coq_s_constant_not_nul,
-		 [|  mk_nat (get_hyp env_hyp e) |])
-      | CONSTANT_NEG(e,k) :: l ->
-          mkApp (Lazy.force coq_s_constant_neg,
-		 [|  mk_nat (get_hyp env_hyp e) |])
-      | STATE {st_new_eq=new_eq; st_def =def;
-		      st_orig=orig; st_coef=m;
-                      st_var=sigma } :: l ->
-	  let n1 = get_hyp env_hyp orig.id
-	  and n2 = get_hyp env_hyp def.id in
-	  let v = unintern_omega env sigma in
-	  let o_def = oformula_of_omega env def in
-	  let o_orig = oformula_of_omega env orig in
-	  let body =
-	     Oplus (o_orig,Omult (Oplus (Oopp v,o_def), Oint m)) in
-          let trace,_ = normalize_linear_term env body in
-	  mkApp (Lazy.force coq_s_state,
-		 [| Z.mk m; trace; mk_nat n1; mk_nat n2;
-		    loop (CCEqua new_eq.id :: env_hyp) l |])
-      |	HYP _ :: l -> loop env_hyp l
-      |	CONSTANT_NUL e :: l ->
-	  mkApp (Lazy.force coq_s_constant_nul,
-		 [|  mk_nat (get_hyp env_hyp e) |])
-      |	NEGATE_CONTRADICT(e1,e2,true) :: l ->
-	  mkApp (Lazy.force coq_s_negate_contradict,
-		 [|  mk_nat (get_hyp env_hyp e1.id);
-		     mk_nat (get_hyp env_hyp e2.id) |])
-      |	NEGATE_CONTRADICT(e1,e2,false) :: l ->
-	  mkApp (Lazy.force coq_s_negate_contradict_inv,
-		 [|  mk_nat (List.length e2.body);
-		     mk_nat (get_hyp env_hyp e1.id);
-		     mk_nat (get_hyp env_hyp e2.id) |])
-      | SPLIT_INEQ(e,(e1,l1),(e2,l2)) :: l ->
-	  let i =  get_hyp env_hyp e.id in
-	  let r1 = loop (CCEqua e1 :: env_hyp) l1 in
-	  let r2 = loop (CCEqua e2 :: env_hyp) l2 in
-	  mkApp (Lazy.force coq_s_split_ineq,
-                  [| mk_nat (List.length e.body); mk_nat i; r1 ; r2 |])
-      |	(FORGET_C _ | FORGET _ | FORGET_I _) :: l ->
-	  loop env_hyp l
-      | (WEAKEN  _ ) :: l -> failwith "not_treated"
-      |	[] -> failwith "no contradiction"
-  in loop env_hyp
+let hyp_idx env_hyp i =
+  let rec loop count = function
+    | [] -> failwith (Printf.sprintf "get_hyp %d" i)
+    | CCEqua i' :: _ when Int.equal i i' -> mk_nat count
+    | _ :: l -> loop (succ count) l
+  in loop 0 env_hyp
+
+
+(* We now expand NEGATE_CONTRADICT and CONTRADICTION into
+   a O_SUM followed by a O_BAD_CONSTANT *)
+
+let sum_bad inv i1 i2 =
+  let open EConstr in
+  mkApp (Lazy.force coq_s_sum,
+         [| Z.mk Bigint.one; i1;
+            Z.mk (if inv then negone else Bigint.one); i2;
+            mkApp (Lazy.force coq_s_bad_constant, [| mk_nat 0 |])|])
+
+let rec reify_trace env env_hyp =
+  let open EConstr in
+  function
+  | CONSTANT_NOT_NUL(e,_) :: []
+  | CONSTANT_NEG(e,_) :: []
+  | CONSTANT_NUL e :: [] ->
+     mkApp (Lazy.force coq_s_bad_constant,[| hyp_idx env_hyp e |])
+  | NEGATE_CONTRADICT(e1,e2,direct) :: [] ->
+     sum_bad direct (hyp_idx env_hyp e1.id) (hyp_idx env_hyp e2.id)
+  | CONTRADICTION (e1,e2) :: [] ->
+     sum_bad false (hyp_idx env_hyp e1.id) (hyp_idx env_hyp e2.id)
+  | NOT_EXACT_DIVIDE (e1,k) :: [] ->
+     mkApp (Lazy.force coq_s_not_exact_divide,
+            [| hyp_idx env_hyp e1.id; Z.mk k |])
+  | DIVIDE_AND_APPROX (e1,_,k,_) :: l
+  | EXACT_DIVIDE (e1,k) :: l ->
+     mkApp (Lazy.force coq_s_divide,
+            [| hyp_idx env_hyp e1.id; Z.mk k;
+               reify_trace env env_hyp l |])
+  | MERGE_EQ(e3,e1,e2) :: l ->
+     mkApp (Lazy.force coq_s_merge_eq,
+            [| hyp_idx env_hyp e1.id; hyp_idx env_hyp e2;
+               reify_trace env (CCEqua e3:: env_hyp) l |])
+  | SUM(e3,(k1,e1),(k2,e2)) :: l ->
+     mkApp (Lazy.force coq_s_sum,
+            [| Z.mk k1; hyp_idx env_hyp e1.id;
+               Z.mk k2; hyp_idx env_hyp e2.id;
+               reify_trace env (CCEqua e3 :: env_hyp) l |])
+  | STATE {st_new_eq; st_def; st_orig; st_coef } :: l ->
+     (* we now produce a [O_SUM] here *)
+     mkApp (Lazy.force coq_s_sum,
+            [| Z.mk Bigint.one; hyp_idx env_hyp st_orig.id;
+               Z.mk st_coef; hyp_idx env_hyp st_def.id;
+               reify_trace env (CCEqua st_new_eq.id :: env_hyp) l |])
+  | HYP _ :: l -> reify_trace env env_hyp l
+  | SPLIT_INEQ(e,(e1,l1),(e2,l2)) :: _ ->
+     let r1 = reify_trace env (CCEqua e1 :: env_hyp) l1 in
+     let r2 = reify_trace env (CCEqua e2 :: env_hyp) l2 in
+     mkApp (Lazy.force coq_s_split_ineq,
+            [| hyp_idx env_hyp e.id; r1 ; r2 |])
+  | (FORGET_C _ | FORGET _ | FORGET_I _) :: l -> reify_trace env env_hyp l
+  | WEAKEN  _ :: l -> failwith "not_treated"
+  | _ -> failwith "bad history"
 
 let rec decompose_tree env ctxt = function
    Tree(i,left,right) ->
      let org =
-       try Hashtbl.find env.constructors i
+       try IntHtbl.find env.constructors i
        with Not_found ->
 	 failwith (Printf.sprintf "Cannot find constructor %d" i) in
      let (index,path) = find_path org ctxt in
@@ -1147,22 +914,41 @@ let rec decompose_tree env ctxt = function
 	  decompose_tree env (left_hyp::ctxt) left;
 	  decompose_tree env (right_hyp::ctxt) right |]
   | Leaf s ->
-      decompose_tree_hyps s.s_trace env ctxt  s.s_equa_deps
+      decompose_tree_hyps s.s_trace env ctxt (IntSet.elements s.s_equa_deps)
 and decompose_tree_hyps trace env ctxt = function
-    [] -> app coq_e_solve [| replay_history env ctxt trace |]
+    [] -> app coq_e_solve [| reify_trace env ctxt trace |]
   | (i::l) ->
       let equation =
-        try Hashtbl.find env.equations i
+        try IntHtbl.find env.equations i
         with Not_found ->
 	  failwith (Printf.sprintf "Cannot find equation %d" i) in
       let (index,path) = find_path equation.e_origin ctxt in
-      let full_path = if equation.e_negated then path @ [O_mono] else path in
       let cont =
 	decompose_tree_hyps trace env
 	   (CCEqua equation.e_omega.id :: ctxt) l in
-      app coq_e_extract [|mk_nat index;
-			  mk_direction_list full_path;
-			  cont |]
+      app coq_e_extract [|mk_nat index; mk_direction_list path; cont |]
+
+let solve_system env index list_eq =
+  let system = List.map (fun eq -> eq.e_omega) list_eq in
+  let trace =
+    OmegaSolver.simplify_strong
+      (new_omega_eq,new_omega_var,display_omega_var)
+      system
+  in
+  (* Hypotheses used for this solution *)
+  let vars = hyps_used_in_trace trace in
+  let splits = get_eclatement env (IntSet.elements vars) in
+  if !debug then
+    begin
+      Printf.printf "SYSTEME %d\n" index;
+      display_action display_omega_var trace;
+      print_string "\n  Depend :";
+      IntSet.iter (fun i -> Printf.printf " %d" i) vars;
+      print_string "\n  Split points :";
+      List.iter display_depend splits;
+      Printf.printf "\n------------------------------------\n"
+    end;
+  {s_index = index; s_trace = trace; s_equa_deps = vars}, splits
 
 (* \section{La fonction principale} *)
  (* Cette fonction construit la
@@ -1172,141 +958,113 @@ l'extraction d'un ensemble minimal de solutions permettant la
 résolution globale du système et enfin construit la trace qui permet
 de faire rejouer cette solution par la tactique réflexive. *)
 
-let resolution env full_reified_goal systems_list =
-  let num = ref 0 in
-  let solve_system list_eq =
-    let index = !num in
-    let system = List.map (fun eq -> eq.e_omega) list_eq in
-    let trace =
-      simplify_strong
-	(new_omega_eq,new_omega_var,display_omega_var)
-	system in
-    (* calcule les hypotheses utilisées pour la solution *)
-    let vars = hyps_used_in_trace trace in
-    let splits = get_eclatement env vars in
-    if !debug then begin
-      Printf.printf "SYSTEME %d\n" index;
-      display_action display_omega_var trace;
-      print_string "\n  Depend :";
-      List.iter (fun i -> Printf.printf " %d" i) vars;
-      print_string "\n  Split points :";
-      List.iter display_depend splits;
-      Printf.printf "\n------------------------------------\n"
-    end;
-    incr num;
-    {s_index = index; s_trace = trace; s_equa_deps = vars}, splits  in
+let resolution unsafe sigma env (reified_concl,reified_hyps) systems_list =
   if !debug then Printf.printf "\n====================================\n";
-  let all_solutions = List.map solve_system systems_list in
+  let all_solutions = List.mapi (solve_system env) systems_list in
   let solution_tree = solve_with_constraints all_solutions [] in
   if !debug then  begin
     display_solution_tree stdout solution_tree;
     print_newline()
   end;
-  (* calcule la liste de toutes les hypothèses utilisées dans l'arbre de solution *)
-  let useful_equa_id = equas_of_solution_tree solution_tree in
-  (* recupere explicitement ces equations *)
-  let equations = List.map (get_equation env) useful_equa_id in
-  let l_hyps' = List.uniquize (List.map (fun e -> e.e_origin.o_hyp) equations) in
-  let l_hyps = id_concl :: List.remove Names.Id.equal id_concl l_hyps' in
-  let useful_hyps =
-    List.map
-      (fun id -> List.assoc_f Names.Id.equal id full_reified_goal) l_hyps
+  (** Collect all hypotheses and variables used in the solution tree *)
+  let useful_equa_ids = equas_of_solution_tree solution_tree in
+  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 useful_vars =
-    let really_useful_vars = vars_of_equations equations in
-    let concl_vars =
-      vars_of_prop (List.assoc_f Names.Id.equal id_concl full_reified_goal)
-    in
-    really_useful_vars @@ concl_vars
+  let useful_hypnames =
+    Id.Set.elements (Id.Set.remove id_concl useful_hypnames)
+  in
+
+  (** Parts coming from equations introduced by omega: *)
+  let stated_vars, l_generalize_arg, to_reify_stated, hyp_stated_vars =
+    digest_stated_equations env solution_tree
+  in
+  (** The final variables are either coming from:
+     - useful hypotheses (and conclusion)
+     - equations introduced during resolution *)
+  let all_vars_env = (IntSet.elements useful_vars) @ stated_vars
   in
-  (* variables a introduire *)
-  let to_introduce = add_stated_equations env solution_tree in
-  let stated_vars =  List.map (fun (v,_,_,_) -> v) to_introduce in
-  let l_generalize_arg = List.map (fun (_,t,_,_) -> t) to_introduce in
-  let hyp_stated_vars = List.map (fun (_,_,_,id) -> CCEqua id) to_introduce in
-  (* L'environnement de base se construit en deux morceaux :
-     - les variables des équations utiles (et de la conclusion)
-     - les nouvelles variables declarées durant les preuves *)
-  let all_vars_env = useful_vars @ stated_vars in
-  let basic_env =
+  (** We prepare the renumbering from all variables to useful ones.
+      Since [all_var_env] is sorted, this renumbering will preserve
+      order: this way, the equations in ReflOmegaCore will have
+      the same normal forms as here. *)
+  let reduced_term_env =
     let rec loop i = function
-	var :: l ->
-	  let t = get_reified_atom env var in
-	  Hashtbl.add env.real_indices var i; t :: loop (succ i) l
-      |	[] -> [] in
-    loop 0 all_vars_env in
-  let env_terms_reified = mk_list (Lazy.force Z.typ) basic_env in
-  (* On peut maintenant généraliser le but : env est a jour *)
-  let l_reified_stated =
-     List.map (fun (_,_,(l,r),_) ->
-                 app coq_p_eq [| reified_of_formula env l;
-                                 reified_of_formula env r |])
-              to_introduce in
-  let reified_concl =
-    match useful_hyps with
-      (Pnot p) :: _ -> reified_of_proposition env p
-    | _ ->  reified_of_proposition env Pfalse in
+      | [] -> []
+      | var :: l ->
+         let t = get_reified_atom env var in
+         IntHtbl.add env.real_indices var i; t :: loop (succ i) l
+    in
+    mk_list (Lazy.force Z.typ) (loop 0 all_vars_env)
+  in
+  (** The environment [env] (and especially [env.real_indices]) is now
+      ready for the coming reifications: *)
+  let l_reified_stated = List.map (reified_of_eq env) to_reify_stated in
+  let reified_concl = reified_of_proposition sigma env reified_concl in
   let l_reified_terms =
-    (List.map
-      (fun p ->
-         reified_of_proposition env (really_useful_prop useful_equa_id p))
-      (List.tl useful_hyps)) in
+    List.map
+      (fun id ->
+        match Id.Map.find id reified_hyps with
+        | Defined,p ->
+           reified_of_proposition sigma env p, mk_refl (EConstr.mkVar id)
+        | Assumed,p ->
+           reified_of_proposition sigma 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)
             (l_reified_stated @ l_reified_terms) in
   let reified =
     app coq_interp_sequent
-       [| reified_concl;env_props_reified;env_terms_reified;reified_goal|] in
-  let normalize_equation e =
-    let rec loop = function
-	[] -> app (if e.e_negated then coq_p_invert else coq_p_step)
-	          [| e.e_trace |]
-      |	((O_left | O_mono) :: l) -> app coq_p_left [| loop l |]
-      |	(O_right :: l) -> app coq_p_right [| loop l |] in
-    let correct_index =
-      let i = List.index0 Names.Id.equal e.e_origin.o_hyp l_hyps in
-      (* PL: it seems that additionally introduced hyps are in the way during
-             normalization, hence this index shifting... *)
-      if Int.equal i 0 then 0 else Pervasives.(+) i (List.length to_introduce)
-    in
-    app coq_pair_step [| mk_nat correct_index; loop e.e_origin.o_path |] in
-  let normalization_trace =
-    mk_list (Lazy.force coq_h_step) (List.map normalize_equation equations) in
-
+       [| 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=[]}) (List.tl l_hyps) 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
 
-  Proofview.V82.of_tactic (Tactics.generalize
-    (l_generalize_arg @ List.map Term.mkVar (List.tl l_hyps))) >>
-  Proofview.V82.of_tactic (Tactics.change_concl reified) >>
-  Proofview.V82.of_tactic (Tactics.apply (app coq_do_omega [|decompose_tactic; normalization_trace|])) >>
+  Tactics.generalize (l_generalize_arg @ l_reified_hypnames) >>
+  Tactics.convert_concl_no_check reified Term.DEFAULTcast >>
+  Tactics.apply (app coq_do_omega [|decompose_tactic|]) >>
   show_goal >>
-  Proofview.V82.of_tactic (Tactics.normalise_vm_in_concl) >>
-  (*i Alternatives to the previous line:
-   - Normalisation without VM:
-      Tactics.normalise_in_concl
-   - Skip the conversion check and rely directly on the QED:
-      Tacmach.convert_concl_no_check (Lazy.force coq_True) Term.VMcast >>
-  i*)
-  Proofview.V82.of_tactic (Tactics.apply (Lazy.force coq_I))
-
-let total_reflexive_omega_tactic gl =
+  (if unsafe then
+     (* Trust the produced term. Faster, but might fail later at Qed.
+        Also handy when debugging, e.g. via a Show Proof after romega. *)
+     Tactics.convert_concl_no_check (Lazy.force coq_True) Term.VMcast
+   else
+     Tactics.normalise_vm_in_concl) >>
+  Tactics.apply (Lazy.force coq_I)
+
+let total_reflexive_omega_tactic unsafe =
+  Proofview.Goal.nf_enter begin fun gl ->
   Coqlib.check_required_library ["Coq";"romega";"ROmega"];
   rst_omega_eq ();
   rst_omega_var ();
   try
   let env = new_environment () in
-  let full_reified_goal = reify_gl env gl in
+  let (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,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 env full_reified_goal systems_list gl
-  with NO_CONTRADICTION -> CErrors.error "ROmega can't solve this system"
-
-
-(*i let tester = Tacmach.hide_atomic_tactic "TestOmega" test_tactic i*)
-
+  let sigma = Proofview.Goal.sigma gl in
+  resolution unsafe sigma env (concl,hyps) systems_list
+  with NO_CONTRADICTION -> CErrors.user_err Pp.(str "ROmega can't solve this system")
+  end
 
diff --git a/plugins/romega/vo.itarget b/plugins/romega/vo.itarget
deleted file mode 100644
index f7a3c41c..00000000
--- a/plugins/romega/vo.itarget
+++ /dev/null
@@ -1,2 +0,0 @@
-ReflOmegaCore.vo
-ROmega.vo
diff --git a/plugins/rtauto/Bintree.v b/plugins/rtauto/Bintree.v
index 36460187..600e8993 100644
--- a/plugins/rtauto/Bintree.v
+++ b/plugins/rtauto/Bintree.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export List.
diff --git a/plugins/rtauto/Rtauto.v b/plugins/rtauto/Rtauto.v
index 0dc6e31b..06cdf76b 100644
--- a/plugins/rtauto/Rtauto.v
+++ b/plugins/rtauto/Rtauto.v
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
 Require Export List.
 Require Export Bintree.
-Require Import Bool.
+Require Import Bool BinPos.
 
 Declare ML Module "rtauto_plugin".
 
@@ -96,8 +98,6 @@ match F with
 | F_push H hyps0 F0 =>  interp_ctx hyps0 F0  ([[H]] -> G)
 end.
 
-Require Export BinPos.
-
 Ltac wipe := intros;simpl;constructor.
 
 Lemma compose0 :
@@ -255,122 +255,115 @@ Theorem interp_proof:
 forall p hyps F gl,
 check_proof hyps gl p = true -> interp_ctx hyps F [[gl]].
 
-induction p;intros hyps F gl.
-
-(* cas Axiom *)
-Focus 1.
-simpl;case_eq (get p hyps);clean.
-intros f nth_f e;rewrite <- (form_eq_refl e).
-apply project with p;trivial.
-
-(* Cas Arrow_Intro *)
-Focus 1.
-destruct gl;clean.
-simpl;intros.
-change (interp_ctx (hyps\gl1)  (F_push gl1 hyps F) [[gl2]]).
-apply IHp;try constructor;trivial.
-
-(* Cas Arrow_Elim *)
-Focus 1.
-simpl check_proof;case_eq (get p hyps);clean.
-intros f ef;case_eq (get p0 hyps);clean.
-intros f0 ef0;destruct f0;clean.
-case_eq (form_eq f f0_1);clean.
-simpl;intros e check_p1.
-generalize  (project  F ef) (project  F ef0)
-(IHp (hyps \ f0_2) (F_push f0_2 hyps F) gl check_p1);
-clear check_p1 IHp p p0 p1 ef ef0.
-simpl.
-apply compose3.
-rewrite (form_eq_refl e).
-auto.
-
-(* cas Arrow_Destruct *)
-Focus 1.
-simpl;case_eq (get p1 hyps);clean.
-intros f ef;destruct f;clean.
-destruct f1;clean.
-case_eq (check_proof (hyps \ f1_2 =>> f2 \ f1_1) f1_2 p2);clean.
-intros check_p1 check_p2.
-generalize (project F ef)
-(IHp1 (hyps \ f1_2 =>> f2 \ f1_1)
-(F_push f1_1 (hyps \ f1_2 =>> f2)
- (F_push (f1_2 =>> f2) hyps F)) f1_2 check_p1)
-(IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2).
-simpl;apply compose3;auto.
-
-(* Cas False_Elim *)
-Focus 1.
-simpl;case_eq (get p hyps);clean.
-intros f ef;destruct f;clean.
-intros _; generalize (project F ef).
-apply compose1;apply False_ind.
-
-(* Cas And_Intro *)
-Focus 1.
-simpl;destruct gl;clean.
-case_eq (check_proof hyps gl1 p1);clean.
-intros Hp1 Hp2;generalize (IHp1 hyps F gl1 Hp1) (IHp2 hyps F gl2 Hp2).
-apply compose2 ;simpl;auto.
-
-(* cas And_Elim *)
-Focus 1.
-simpl;case_eq (get p hyps);clean.
-intros f ef;destruct f;clean.
-intro check_p;generalize  (project F ef)
-(IHp (hyps \ f1 \ f2) (F_push f2 (hyps \ f1) (F_push f1 hyps F)) gl check_p).
-simpl;apply compose2;intros [h1 h2];auto.
-
-(* cas And_Destruct *)
-Focus 1.
-simpl;case_eq (get p hyps);clean.
-intros f ef;destruct f;clean.
-destruct f1;clean.
-intro H;generalize  (project F ef)
-(IHp (hyps \ f1_1 =>> f1_2 =>> f2)
-(F_push (f1_1 =>> f1_2 =>> f2) hyps F) gl H);clear H;simpl.
-apply compose2;auto.
-
-(* cas Or_Intro_left *)
-Focus 1.
-destruct gl;clean.
-intro Hp;generalize (IHp hyps F gl1 Hp).
-apply compose1;simpl;auto.
-
-(* cas Or_Intro_right *)
-Focus 1.
-destruct gl;clean.
-intro Hp;generalize (IHp hyps F gl2 Hp).
-apply compose1;simpl;auto.
-
-(* cas Or_elim *)
-Focus 1.
-simpl;case_eq (get p1 hyps);clean.
-intros f ef;destruct f;clean.
-case_eq (check_proof (hyps \ f1) gl p2);clean.
-intros check_p1 check_p2;generalize (project F ef)
-(IHp1 (hyps \ f1) (F_push f1 hyps F) gl check_p1)
-(IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2);
-simpl;apply compose3;simpl;intro h;destruct h;auto.
-
-(* cas Or_Destruct *)
-Focus 1.
-simpl;case_eq (get p hyps);clean.
-intros f ef;destruct f;clean.
-destruct f1;clean.
-intro check_p0;generalize (project F ef)
-(IHp (hyps \ f1_1 =>> f2 \ f1_2 =>> f2)
-(F_push (f1_2 =>> f2) (hyps \ f1_1 =>> f2)
- (F_push (f1_1 =>> f2) hyps F)) gl check_p0);simpl.
-apply compose2;auto.
-
-(* cas Cut *)
-Focus 1.
-simpl;case_eq (check_proof hyps f p1);clean.
-intros check_p1 check_p2;
-generalize (IHp1 hyps F f check_p1)
-(IHp2 (hyps\f) (F_push f hyps F) gl check_p2);
-simpl; apply compose2;auto.
+induction p; intros hyps F gl.
+
+- (* Axiom *)
+  simpl;case_eq (get p hyps);clean.
+  intros f nth_f e;rewrite <- (form_eq_refl e).
+  apply project with p;trivial.
+
+- (* Arrow_Intro *)
+  destruct gl; clean.
+  simpl; intros.
+  change (interp_ctx (hyps\gl1)  (F_push gl1 hyps F) [[gl2]]).
+  apply IHp; try constructor; trivial.
+
+- (* Arrow_Elim *)
+  simpl check_proof; case_eq (get p hyps); clean.
+  intros f ef; case_eq (get p0 hyps); clean.
+  intros f0 ef0; destruct f0; clean.
+  case_eq (form_eq f f0_1); clean.
+  simpl; intros e check_p1.
+  generalize  (project  F ef) (project  F ef0)
+              (IHp (hyps \ f0_2) (F_push f0_2 hyps F) gl check_p1);
+    clear check_p1 IHp p p0 p1 ef ef0.
+  simpl.
+  apply compose3.
+  rewrite (form_eq_refl e).
+  auto.
+
+- (* Arrow_Destruct *)
+  simpl; case_eq (get p1 hyps); clean.
+  intros f ef; destruct f; clean.
+  destruct f1; clean.
+  case_eq (check_proof (hyps \ f1_2 =>> f2 \ f1_1) f1_2 p2); clean.
+  intros check_p1 check_p2.
+  generalize (project F ef)
+             (IHp1 (hyps \ f1_2 =>> f2 \ f1_1)
+                   (F_push f1_1 (hyps \ f1_2 =>> f2)
+                           (F_push (f1_2 =>> f2) hyps F)) f1_2 check_p1)
+             (IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2).
+  simpl; apply compose3; auto.
+
+- (* False_Elim *)
+  simpl; case_eq (get p hyps); clean.
+  intros f ef; destruct f; clean.
+  intros _; generalize (project F ef).
+  apply compose1; apply False_ind.
+
+- (* And_Intro *)
+  simpl; destruct gl; clean.
+  case_eq (check_proof hyps gl1 p1); clean.
+  intros Hp1 Hp2;generalize (IHp1 hyps F gl1 Hp1) (IHp2 hyps F gl2 Hp2).
+  apply compose2 ; simpl; auto.
+
+- (* And_Elim *)
+  simpl; case_eq (get p hyps); clean.
+  intros f ef; destruct f; clean.
+  intro check_p;
+    generalize  (project F ef)
+                (IHp (hyps \ f1 \ f2) (F_push f2 (hyps \ f1) (F_push f1 hyps F)) gl check_p).
+  simpl; apply compose2; intros [h1 h2]; auto.
+
+- (* And_Destruct*)
+  simpl; case_eq (get p hyps); clean.
+  intros f ef; destruct f; clean.
+  destruct f1; clean.
+  intro H;
+    generalize (project F ef)
+               (IHp (hyps \ f1_1 =>> f1_2 =>> f2)
+                    (F_push (f1_1 =>> f1_2 =>> f2) hyps F) gl H);
+    clear H; simpl.
+  apply compose2; auto.
+
+- (* Or_Intro_left *)
+  destruct gl; clean.
+  intro Hp; generalize (IHp hyps F gl1 Hp).
+  apply compose1; simpl; auto.
+
+- (* Or_Intro_right *)
+  destruct gl; clean.
+  intro Hp; generalize (IHp hyps F gl2 Hp).
+  apply compose1; simpl; auto.
+
+- (* Or_elim *)
+  simpl; case_eq (get p1 hyps); clean.
+  intros f ef; destruct f; clean.
+  case_eq (check_proof (hyps \ f1) gl p2); clean.
+  intros check_p1 check_p2;
+    generalize (project F ef)
+               (IHp1 (hyps \ f1) (F_push f1 hyps F) gl check_p1)
+               (IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2);
+    simpl; apply compose3; simpl; intro h; destruct h; auto.
+
+- (* Or_Destruct *)
+  simpl; case_eq (get p hyps); clean.
+  intros f ef; destruct f; clean.
+  destruct f1; clean.
+  intro check_p0;
+    generalize (project F ef)
+               (IHp (hyps \ f1_1 =>> f2 \ f1_2 =>> f2)
+                    (F_push (f1_2 =>> f2) (hyps \ f1_1 =>> f2)
+                            (F_push (f1_1 =>> f2) hyps F)) gl check_p0);
+    simpl.
+  apply compose2; auto.
+
+- (* Cut *)
+  simpl; case_eq (check_proof hyps f p1); clean.
+  intros check_p1 check_p2;
+    generalize (IHp1 hyps F f check_p1)
+               (IHp2 (hyps\f) (F_push f hyps F) gl check_p2);
+    simpl; apply compose2; auto.
 Qed.
 
 Theorem Reflect: forall gl prf, if check_proof empty gl prf then [[gl]] else True.
diff --git a/plugins/rtauto/g_rtauto.ml4 b/plugins/rtauto/g_rtauto.ml4
index d27b0483..aa675763 100644
--- a/plugins/rtauto/g_rtauto.ml4
+++ b/plugins/rtauto/g_rtauto.ml4
@@ -1,12 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma"  i*)
+
+open Ltac_plugin
 
 DECLARE PLUGIN "rtauto_plugin"
 
diff --git a/plugins/rtauto/proof_search.ml b/plugins/rtauto/proof_search.ml
index 8b926111..3de59239 100644
--- a/plugins/rtauto/proof_search.ml
+++ b/plugins/rtauto/proof_search.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -46,8 +48,7 @@ let reset_info () =
 let pruning = ref true
 
 let opt_pruning=
-  {optsync=true;
-   optdepr=false;
+  {optdepr=false;
    optname="Rtauto Pruning";
    optkey=["Rtauto";"Pruning"];
    optread=(fun () -> !pruning);
@@ -146,7 +147,7 @@ let add_step s sub =
     | SI_Or_r,[p] -> I_Or_r p
     | SE_Or i,[p1;p2] -> E_Or(i,p1,p2)
     | SD_Or i,[p] -> D_Or(i,p)
-    | _,_ -> anomaly ~label:"add_step" (Pp.str "wrong arity")
+    | _,_ -> anomaly ~label:"add_step" (Pp.str "wrong arity.")
 
 type 'a with_deps =
     {dep_it:'a;
@@ -168,7 +169,7 @@ type state =
 
 let project = function
     Complete prf -> prf
-  | Incomplete (_,_) -> anomaly (Pp.str "not a successful state")
+  | Incomplete (_,_) -> anomaly (Pp.str "not a successful state.")
 
 let pop n prf =
   let nprf=
@@ -362,7 +363,7 @@ let search_norev seq=
 		     (Arrow(f2,f3)))
 		  f1;
 		add_hyp (embed nseq) f3]):: !goals
-      | _ -> anomaly ~label:"search_no_rev" (Pp.str "can't happen") in
+      | _ -> anomaly ~label:"search_no_rev" (Pp.str "can't happen.") in
     Int.Map.iter add_one seq.norev_hyps;
     List.rev !goals
 
@@ -387,7 +388,7 @@ let search_in_rev_hyps seq=
 	| Arrow (Disjunct (f1,f2),f0) ->
 	    [make_step (SD_Or(i)),
 	     [add_hyp (add_hyp (embed nseq) (Arrow(f1,f0))) (Arrow (f2,f0))]]
-	| _ -> anomaly ~label:"search_in_rev_hyps" (Pp.str "can't happen")
+	| _ -> anomaly ~label:"search_in_rev_hyps" (Pp.str "can't happen.")
   with
       Not_found -> search_norev seq
 
@@ -465,7 +466,7 @@ let branching = function
 	  | _::next ->
 	      s_info.nd_branching<-s_info.nd_branching+List.length next in
 	List.map (append stack) successors
-  | Complete prf -> anomaly (Pp.str "already succeeded")
+  | Complete prf -> anomaly (Pp.str "already succeeded.")
 
 open Pp
 
@@ -505,12 +506,12 @@ let pp_mapint map =
 		pp_form obj ++ str " => " ++
 				 pp_list (fun (i,f) -> pp_form f) l ++
 				 cut ()) ) map;
-    str "{ " ++ vb 0 ++  (!pp) ++ str " }" ++ close ()
+    str "{ " ++ hv 0 (!pp ++ str " }")
 
 let pp_connect (i,j,f1,f2) = pp_form f1 ++ str " => " ++ pp_form f2
 
 let pp_gl gl= cut () ++
-  str "{ " ++ vb 0 ++
+  str "{ " ++ hv 0 (
 	      begin
 		match gl.abs with
 		    None -> str ""
@@ -520,7 +521,7 @@ let pp_gl gl= cut () ++
   str "norev =" ++ pp_intmap gl.norev_hyps ++ cut () ++
   str "arrows=" ++ pp_mapint gl.right ++ cut () ++
   str "cnx   =" ++ pp_list pp_connect gl.cnx ++ cut () ++
-  str "goal  =" ++ pp_form gl.gl ++ str " }" ++ close ()
+  str "goal  =" ++ pp_form gl.gl ++ str " }")
 
 let pp =
   function
diff --git a/plugins/rtauto/proof_search.mli b/plugins/rtauto/proof_search.mli
index 31f8e7b5..607cdc95 100644
--- a/plugins/rtauto/proof_search.mli
+++ b/plugins/rtauto/proof_search.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type form=
@@ -38,9 +40,9 @@ val branching: state -> state list
 
 val success: state -> bool
 
-val pp: state -> Pp.std_ppcmds
+val pp: state -> Pp.t
 
-val pr_form : form -> Pp.std_ppcmds
+val pr_form : form -> Pp.t
 
 val reset_info : unit -> unit
 
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 4ed90795..946b6dff 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -1,16 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+
 module Search = Explore.Make(Proof_search)
 
+open Ltac_plugin
 open CErrors
 open Util
 open Term
+open Constr
 open Tacmach
 open Proof_search
 open Context.Named.Declaration
@@ -21,28 +26,28 @@ let step_count = ref 0
 
 let node_count = ref 0
 
-let logic_constant =
-  Coqlib.gen_constant "refl_tauto" ["Init";"Logic"]
+let logic_constant s = Universes.constr_of_global @@
+  Coqlib.coq_reference "refl_tauto" ["Init";"Logic"] s
 
 let li_False = lazy (destInd (logic_constant "False"))
-let li_and = lazy (destInd (logic_constant "and"))
-let li_or =  lazy (destInd (logic_constant "or"))
+let li_and   = lazy (destInd (logic_constant "and"))
+let li_or    = lazy (destInd (logic_constant "or"))
 
-let pos_constant =
-  Coqlib.gen_constant "refl_tauto" ["Numbers";"BinNums"]
+let pos_constant s = Universes.constr_of_global @@
+  Coqlib.coq_reference "refl_tauto" ["Numbers";"BinNums"] s
 
 let l_xI = lazy (pos_constant "xI")
 let l_xO = lazy (pos_constant "xO")
 let l_xH = lazy (pos_constant "xH")
 
-let store_constant =
-  Coqlib.gen_constant "refl_tauto" ["rtauto";"Bintree"]
+let store_constant s = Universes.constr_of_global @@
+  Coqlib.coq_reference "refl_tauto" ["rtauto";"Bintree"] s
 
 let l_empty = lazy (store_constant "empty")
 let l_push = lazy (store_constant "push")
 
-let constant=
-  Coqlib.gen_constant "refl_tauto" ["rtauto";"Rtauto"]
+let constant s = Universes.constr_of_global @@
+  Coqlib.coq_reference "refl_tauto" ["rtauto";"Rtauto"] s
 
 let l_Reflect = lazy (constant "Reflect")
 
@@ -66,22 +71,21 @@ let l_E_Or = lazy (constant "E_Or")
 let l_D_Or = lazy (constant "D_Or")
 
 
-let special_whd gl=
-  let infos=CClosure.create_clos_infos CClosure.all (pf_env gl) in
-    (fun t -> CClosure.whd_val infos (CClosure.inject t))
+let special_whd gl c =
+  Reductionops.clos_whd_flags CClosure.all (pf_env gl) (Tacmach.project gl) c
 
-let special_nf gl=
-  let infos=CClosure.create_clos_infos CClosure.betaiotazeta (pf_env gl) in
-    (fun t -> CClosure.norm_val infos (CClosure.inject t))
+let special_nf gl c =
+  Reductionops.clos_norm_flags CClosure.betaiotazeta (pf_env gl) (Tacmach.project gl) c
 
 type atom_env=
     {mutable next:int;
      mutable env:(constr*int) list}
 
 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
@@ -90,13 +94,16 @@ let make_atom atom_env term=
       Atom i
 
 let rec make_form atom_env gls term =
+  let open EConstr in
+  let open Vars in
   let normalize=special_nf gls in
   let cciterm=special_whd gls term  in
-    match kind_of_term cciterm with
+  let sigma = Tacmach.project gls in
+    match EConstr.kind sigma cciterm with
 	Prod(_,a,b) ->
-	  if not (Termops.dependent (mkRel 1) b) &&
+	  if noccurn sigma 1 b &&
 	    Retyping.get_sort_family_of
-	    (pf_env gls) (Tacmach.project gls) a == InProp
+	    (pf_env gls) sigma a == InProp
 	  then
 	    let fa=make_form atom_env gls a in
 	    let fb=make_form atom_env gls b in
@@ -113,7 +120,7 @@ let rec make_form atom_env gls term =
       | App(hd,argv) when Int.equal (Array.length argv) 2 ->
 	  begin
 	    try
-	      let ind, _ = destInd hd in
+	      let ind, _ = destInd sigma hd in
 		if Names.eq_ind ind (fst (Lazy.force li_and)) then
 		  let fa=make_form atom_env gls argv.(0) in
 		  let fb=make_form atom_env gls argv.(1) in
@@ -134,7 +141,7 @@ let rec make_hyps atom_env gls lenv = function
   | LocalAssum (id,typ)::rest ->
       let hrec=
 	make_hyps atom_env gls (typ::lenv) rest in
-	if List.exists (Termops.dependent (mkVar id)) lenv ||
+	if List.exists (fun c -> Termops.local_occur_var Evd.empty (** FIXME *) id c) lenv ||
 	  (Retyping.get_sort_family_of
 	     (pf_env gls) (Tacmach.project gls) typ != InProp)
 	then
@@ -233,8 +240,7 @@ open Goptions
 let verbose = ref false
 
 let opt_verbose=
-  {optsync=true;
-   optdepr=false;
+  {optdepr=false;
    optname="Rtauto Verbose";
    optkey=["Rtauto";"Verbose"];
    optread=(fun () -> !verbose);
@@ -245,8 +251,7 @@ let _ = declare_bool_option opt_verbose
 let check = ref false
 
 let opt_check=
-  {optsync=true;
-   optdepr=false;
+  {optdepr=false;
    optname="Rtauto Check";
    optkey=["Rtauto";"Check"];
    optread=(fun () -> !check);
@@ -263,7 +268,7 @@ let rtauto_tac gls=
   let _=
     if Retyping.get_sort_family_of
       (pf_env gls) (Tacmach.project gls) gl != InProp
-    then errorlabstrm "rtauto" (Pp.str "goal should be in Prop") in
+    then user_err ~hdr:"rtauto" (Pp.str "goal should be in Prop") in
   let glf=make_form gamma gls gl in
   let hyps=make_hyps gamma gls [gl] (pf_hyps gls) in
   let formula=
@@ -282,7 +287,7 @@ let rtauto_tac gls=
   let prf =
     try project (search_fun (init_state [] formula))
     with Not_found ->
-      errorlabstrm "rtauto" (Pp.str "rtauto couldn't find any proof") in
+      user_err ~hdr:"rtauto" (Pp.str "rtauto couldn't find any proof") in
   let search_end_time = System.get_time () in
   let _ = if !verbose then
     begin
@@ -298,7 +303,7 @@ let rtauto_tac gls=
 		      build_form formula;
 		      build_proof [] 0 prf|]) in
   let term=
-    applist (main,List.rev_map (fun (id,_) -> mkVar id) hyps) in
+    applistc main (List.rev_map (fun (id,_) -> mkVar id) hyps) in
   let build_end_time=System.get_time () in
   let _ = if !verbose then
     begin
@@ -312,6 +317,7 @@ let rtauto_tac gls=
 	     str "Giving proof term to Coq ... ")
     end in
   let tac_start_time = System.get_time () in
+  let term = EConstr.of_constr term in
   let result=
     if !check then
       Proofview.V82.of_tactic (Tactics.exact_check term) gls
diff --git a/plugins/rtauto/refl_tauto.mli b/plugins/rtauto/refl_tauto.mli
index 9a14ac6c..a91dd666 100644
--- a/plugins/rtauto/refl_tauto.mli
+++ b/plugins/rtauto/refl_tauto.mli
@@ -1,24 +1,27 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (* raises Not_found if no proof is found *)
 
+
 type atom_env=
     {mutable next:int;
-     mutable env:(Term.constr*int) list}
+     mutable env:(Constr.t*int) list}
 
 val make_form : atom_env ->
-    Proof_type.goal Tacmach.sigma -> Term.types -> Proof_search.form
+    Goal.goal Evd.sigma -> EConstr.types -> Proof_search.form
 
 val make_hyps :
     atom_env ->
-    Proof_type.goal Tacmach.sigma ->
-    Term.types list ->
-    Context.Named.t ->
+    Goal.goal Evd.sigma ->
+    EConstr.types list ->
+    EConstr.named_context ->
     (Names.Id.t * Proof_search.form) list
 
-val rtauto_tac : Proof_type.tactic
+val rtauto_tac : Tacmach.tactic
diff --git a/plugins/rtauto/vo.itarget b/plugins/rtauto/vo.itarget
deleted file mode 100644
index 4c9364ad..00000000
--- a/plugins/rtauto/vo.itarget
+++ /dev/null
@@ -1,2 +0,0 @@
-Bintree.vo
-Rtauto.vo
diff --git a/plugins/setoid_ring/Algebra_syntax.v b/plugins/setoid_ring/Algebra_syntax.v
index e896554e..1204bbd2 100644
--- a/plugins/setoid_ring/Algebra_syntax.v
+++ b/plugins/setoid_ring/Algebra_syntax.v
@@ -1,3 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Class Zero (A : Type) := zero : A.
 Notation "0" := zero.
diff --git a/plugins/setoid_ring/ArithRing.v b/plugins/setoid_ring/ArithRing.v
index 5f5b9792..bb1eca49 100644
--- a/plugins/setoid_ring/ArithRing.v
+++ b/plugins/setoid_ring/ArithRing.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Mult.
@@ -41,9 +43,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 +57,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/BinList.v b/plugins/setoid_ring/BinList.v
index d639f608..b02b7484 100644
--- a/plugins/setoid_ring/BinList.v
+++ b/plugins/setoid_ring/BinList.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinPos.
diff --git a/plugins/setoid_ring/Cring.v b/plugins/setoid_ring/Cring.v
index 17a57e62..7cb930ba 100644
--- a/plugins/setoid_ring/Cring.v
+++ b/plugins/setoid_ring/Cring.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export List.
diff --git a/plugins/setoid_ring/Field.v b/plugins/setoid_ring/Field.v
index 73a13139..a8ec1717 100644
--- a/plugins/setoid_ring/Field.v
+++ b/plugins/setoid_ring/Field.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Field_theory.
diff --git a/plugins/setoid_ring/Field_tac.v b/plugins/setoid_ring/Field_tac.v
index babbb86a..73acce22 100644
--- a/plugins/setoid_ring/Field_tac.v
+++ b/plugins/setoid_ring/Field_tac.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Ring_tac BinList Ring_polynom InitialRing.
diff --git a/plugins/setoid_ring/Field_theory.v b/plugins/setoid_ring/Field_theory.v
index 2932d379..d9e32dbb 100644
--- a/plugins/setoid_ring/Field_theory.v
+++ b/plugins/setoid_ring/Field_theory.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Ring.
@@ -56,11 +58,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 +1614,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 9c690e2b..f5db2754 100644
--- a/plugins/setoid_ring/InitialRing.v
+++ b/plugins/setoid_ring/InitialRing.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Zbool.
@@ -48,12 +50,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 +112,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 +161,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 +266,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 +280,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 +391,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 +580,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 +892,3 @@ Ltac isZcst t :=
   (* *)
   | _ => constr:(false)
   end.
-
-
-
-
-
diff --git a/plugins/setoid_ring/Integral_domain.v b/plugins/setoid_ring/Integral_domain.v
index 0c16fe1a..98407cb6 100644
--- a/plugins/setoid_ring/Integral_domain.v
+++ b/plugins/setoid_ring/Integral_domain.v
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 Require Export Cring.
 
 
diff --git a/plugins/setoid_ring/NArithRing.v b/plugins/setoid_ring/NArithRing.v
index 54e2789b..36a92505 100644
--- a/plugins/setoid_ring/NArithRing.v
+++ b/plugins/setoid_ring/NArithRing.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Ring.
diff --git a/plugins/setoid_ring/Ncring.v b/plugins/setoid_ring/Ncring.v
index cd3bef43..2ca0d609 100644
--- a/plugins/setoid_ring/Ncring.v
+++ b/plugins/setoid_ring/Ncring.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* non commutative rings *)
diff --git a/plugins/setoid_ring/Ncring_initial.v b/plugins/setoid_ring/Ncring_initial.v
index 20022c00..523c7b02 100644
--- a/plugins/setoid_ring/Ncring_initial.v
+++ b/plugins/setoid_ring/Ncring_initial.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZArith_base.
diff --git a/plugins/setoid_ring/Ncring_polynom.v b/plugins/setoid_ring/Ncring_polynom.v
index 109808ee..12208ff6 100644
--- a/plugins/setoid_ring/Ncring_polynom.v
+++ b/plugins/setoid_ring/Ncring_polynom.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*  A <X1,...,Xn>: non commutative polynomials on a commutative ring A *)
diff --git a/plugins/setoid_ring/Ncring_tac.v b/plugins/setoid_ring/Ncring_tac.v
index 5e30a130..79585078 100644
--- a/plugins/setoid_ring/Ncring_tac.v
+++ b/plugins/setoid_ring/Ncring_tac.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import List.
diff --git a/plugins/setoid_ring/RealField.v b/plugins/setoid_ring/RealField.v
index 29372212..38bc58a6 100644
--- a/plugins/setoid_ring/RealField.v
+++ b/plugins/setoid_ring/RealField.v
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 Require Import Nnat.
 Require Import ArithRing.
 Require Export Ring Field.
@@ -59,11 +69,12 @@ Notation Rset := (Eqsth R).
 Notation Rext := (Eq_ext Rplus Rmult Ropp).
 
 Lemma Rlt_0_2 : 0 < 2.
+Proof.
 apply Rlt_trans with (0 + 1).
  apply Rlt_n_Sn.
  rewrite Rplus_comm.
    apply Rplus_lt_compat_l.
-    replace 1 with (0 + 1).
+    replace R1 with (0 + 1).
   apply Rlt_n_Sn.
   apply Rplus_0_l.
 Qed.
@@ -126,9 +137,17 @@ Ltac Rpow_tac t :=
   | _ => constr:(N.of_nat t)
   end.
 
-Add Field RField : Rfield
-   (completeness Zeq_bool_complete, power_tac R_power_theory [Rpow_tac]).
-
-
-
+Ltac IZR_tac t :=
+  match t with
+  | R0 => constr:(0%Z)
+  | R1 => constr:(1%Z)
+  | IZR ?u =>
+    match isZcst u with
+    | true => u
+    | _ => constr:(InitialRing.NotConstant)
+    end
+  | _ => constr:(InitialRing.NotConstant)
+  end.
 
+Add Field RField : Rfield
+   (completeness Zeq_bool_complete, constants [IZR_tac], power_tac R_power_theory [Rpow_tac]).
diff --git a/plugins/setoid_ring/Ring.v b/plugins/setoid_ring/Ring.v
index 77576cb9..b83e1c67 100644
--- a/plugins/setoid_ring/Ring.v
+++ b/plugins/setoid_ring/Ring.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool.
diff --git a/plugins/setoid_ring/Ring_base.v b/plugins/setoid_ring/Ring_base.v
index dc7c10cc..a9b4d9d6 100644
--- a/plugins/setoid_ring/Ring_base.v
+++ b/plugins/setoid_ring/Ring_base.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This module gathers the necessary base to build an instance of the
diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v
index b6919667..33df36d8 100644
--- a/plugins/setoid_ring/Ring_polynom.v
+++ b/plugins/setoid_ring/Ring_polynom.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
@@ -59,10 +61,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 fc02cef1..e8efb362 100644
--- a/plugins/setoid_ring/Ring_tac.v
+++ b/plugins/setoid_ring/Ring_tac.v
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 Set Implicit Arguments.
 Require Import Setoid.
 Require Import BinPos.
@@ -427,19 +437,37 @@ Tactic Notation "ring_simplify" constr_list(rl) "in" hyp(H):=
   let t := type of H in
   let g := fresh "goal" in
   set (g:= G);
-  generalize H;clear H;
+  generalize H;
   ring_lookup (PackRing Ring_simplify) [] rl t;
-  intro H;
+  (* 
+     Correction of bug 1859:
+     we want to leave H at its initial position
+     this is obtained by adding a copy of H (H'), 
+     move it just after H, remove H and finally 
+     rename H into H'
+   *)
+  let H' := fresh "H" in
+  intro H';
+  move H' after H;
+  clear H;rename H' into H;
   unfold g;clear g.
 
-Tactic Notation
-  "ring_simplify" "["constr_list(lH)"]" constr_list(rl) "in" hyp(H):=
+Tactic Notation "ring_simplify" "["constr_list(lH)"]" constr_list(rl) "in" hyp(H):=
   let G := Get_goal in
   let t := type of H in
   let g := fresh "goal" in
   set (g:= G);
-  generalize H;clear H;
+  generalize H;
   ring_lookup (PackRing Ring_simplify) [lH] rl t;
-  intro H;
+  (* 
+     Correction of bug 1859:
+     we want to leave H at its initial position
+     this is obtained by adding a copy of H (H'), 
+     move it just after H, remove H and finally 
+     rename H into H'
+   *)
+  let H' := fresh "H" in
+  intro H';
+  move H' after H;
+  clear H;rename H' into H;
   unfold g;clear g.
-
diff --git a/plugins/setoid_ring/Ring_theory.v b/plugins/setoid_ring/Ring_theory.v
index f7757a18..d67a8d8d 100644
--- a/plugins/setoid_ring/Ring_theory.v
+++ b/plugins/setoid_ring/Ring_theory.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Setoid Morphisms BinPos BinNat.
@@ -254,12 +256,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 +329,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 +405,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/Rings_Q.v b/plugins/setoid_ring/Rings_Q.v
index fd765471..ae91ee16 100644
--- a/plugins/setoid_ring/Rings_Q.v
+++ b/plugins/setoid_ring/Rings_Q.v
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 Require Export Cring.
 Require Export Integral_domain.
 
diff --git a/plugins/setoid_ring/Rings_R.v b/plugins/setoid_ring/Rings_R.v
index fd219c23..901b36ed 100644
--- a/plugins/setoid_ring/Rings_R.v
+++ b/plugins/setoid_ring/Rings_R.v
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 Require Export Cring.
 Require Export Integral_domain.
 
diff --git a/plugins/setoid_ring/Rings_Z.v b/plugins/setoid_ring/Rings_Z.v
index 605a23a9..75e77ab6 100644
--- a/plugins/setoid_ring/Rings_Z.v
+++ b/plugins/setoid_ring/Rings_Z.v
@@ -1,3 +1,13 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 Require Export Cring.
 Require Export Integral_domain.
 Require Export Ncring_initial.
diff --git a/plugins/setoid_ring/ZArithRing.v b/plugins/setoid_ring/ZArithRing.v
index 23784cf3..19eaddc1 100644
--- a/plugins/setoid_ring/ZArithRing.v
+++ b/plugins/setoid_ring/ZArithRing.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Ring.
diff --git a/plugins/setoid_ring/g_newring.ml4 b/plugins/setoid_ring/g_newring.ml4
index 216eb8b3..5e4c9214 100644
--- a/plugins/setoid_ring/g_newring.ml4
+++ b/plugins/setoid_ring/g_newring.ml4
@@ -1,13 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
+open Ltac_plugin
 open Pp
 open Util
 open Libnames
@@ -15,9 +16,9 @@ open Printer
 open Newring_ast
 open Newring
 open Stdarg
-open Constrarg
+open Tacarg
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
 
 DECLARE PLUGIN "newring_plugin"
 
@@ -77,22 +78,21 @@ END
 
 VERNAC COMMAND EXTEND AddSetoidRing CLASSIFIED AS SIDEFF
   | [ "Add" "Ring" ident(id) ":" constr(t) ring_mods_opt(l) ] ->
-    [ let l = match l with None -> [] | Some l -> l in
-      let (k,set,cst,pre,post,power,sign, div) = process_ring_mods l in
-      add_theory id (ic t) set k cst (pre,post) power sign div]
+    [ let l = match l with None -> [] | Some l -> l in add_theory id t l]
   | [ "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
 
 TACTIC EXTEND ring_lookup
 | [ "ring_lookup" tactic0(f) "[" constr_list(lH) "]" ne_constr_list(lrt) ] ->
-    [ let (t,lr) = List.sep_last lrt in ring_lookup f lH lr t]
+    [ let (t,lr) = List.sep_last lrt in ring_lookup f lH lr t ]
 END
 
 let pr_field_mod = function
@@ -114,16 +114,15 @@ END
 
 VERNAC COMMAND EXTEND AddSetoidField CLASSIFIED AS SIDEFF
 | [ "Add" "Field" ident(id) ":" constr(t) field_mods_opt(l) ] ->
-  [ let l = match l with None -> [] | Some l -> l in
-    let (k,set,inj,cst_tac,pre,post,power,sign,div) = process_field_mods l in
-    add_field_theory id (ic t) set k cst_tac inj (pre,post) power sign div]
+  [ let l = match l with None -> [] | Some l -> l in add_field_theory id t l ]
 | [ "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 90f5f8e6..99bb8440 100644
--- a/plugins/setoid_ring/newring.ml
+++ b/plugins/setoid_ring/newring.ml
@@ -1,23 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+open Ltac_plugin
 open Pp
-open CErrors
 open Util
 open Names
-open Term
+open Constr
+open EConstr
 open Vars
 open CClosure
 open Environ
 open Libnames
 open Globnames
 open Glob_term
-open Tacticals
 open Tacexpr
 open Coqlib
 open Mod_subst
@@ -31,6 +33,8 @@ open Misctypes
 open Newring_ast
 open Proofview.Notations
 
+let error msg = CErrors.user_err Pp.(str msg)
+
 (****************************************************************************)
 (* controlled reduction *)
 
@@ -42,25 +46,27 @@ let tag_arg tag_rec map subs i c =
     | Prot -> mk_atom c
     | Rec -> if Int.equal i (-1) then mk_clos subs c else tag_rec c
 
-let global_head_of_constr c = 
-  let f, args = decompose_app c in
-    try global_of_constr f
-    with Not_found -> anomaly (str "global_head_of_constr")
+let global_head_of_constr sigma c = 
+  let f, args = decompose_app sigma c in
+    try fst (Termops.global_of_constr sigma f)
+    with Not_found -> CErrors.anomaly (str "global_head_of_constr.")
 
 let global_of_constr_nofail c = 
   try global_of_constr c
   with Not_found -> VarRef (Id.of_string "dummy")
 
 let rec mk_clos_but f_map subs t =
+  let open Term in
   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 Constr in
   if n >= Array.length args then mk_atom(mkApp(f, args))
   else
     let fargs, args' = Array.chop n args in
@@ -79,11 +85,13 @@ let add_map s m = protect_maps := String.Map.add s m !protect_maps
 let lookup_map map =
   try String.Map.find map !protect_maps
   with Not_found ->
-    errorlabstrm"lookup_map"(str"map "++qs map++str"not found")
+    CErrors.user_err ~hdr:"lookup_map" (str"map "++qs map++str"not found")
 
-let protect_red map env sigma c =
-  kl (create_clos_infos all env)
-    (mk_clos_but (lookup_map map c) (Esubst.subs_id 0) c);;
+let protect_red map env sigma c0 =
+  let evars ev = Evarutil.safe_evar_value sigma ev in
+  let c = EConstr.Unsafe.to_constr c0 in
+  EConstr.of_constr (kl (create_clos_infos ~evars all env) (create_tab ())
+    (mk_clos_but (lookup_map map sigma c0) (Esubst.subs_id 0) c));;
 
 let protect_tac map =
   Tactics.reduct_option (protect_red map,DEFAULTcast) None
@@ -96,9 +104,10 @@ let protect_tac_in map id =
 
 let closed_term t l =
   let open Quote_plugin in
+  Proofview.tclEVARMAP >>= fun sigma ->
   let l = List.map Universes.constr_of_global l in
   let cs = List.fold_right Quote.ConstrSet.add l Quote.ConstrSet.empty in
-  if Quote.closed_under cs t then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (mt())
+  if Quote.closed_under sigma cs t then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (mt())
 
 (* TACTIC EXTEND echo
 | [ "echo" constr(t) ] ->
@@ -121,11 +130,11 @@ let closed_term_ast l =
     mltac_name = tacname;
     mltac_index = 0;
   } in
-  let l = List.map (fun gr -> ArgArg(Loc.ghost,gr)) l in
-  TacFun([Some(Id.of_string"t")],
-  TacML(Loc.ghost,tacname,
-  [TacGeneric (Genarg.in_gen (Genarg.glbwit Constrarg.wit_constr) (GVar(Loc.ghost,Id.of_string"t"),None));
-   TacGeneric (Genarg.in_gen (Genarg.glbwit (Genarg.wit_list Constrarg.wit_ref)) l)]))
+  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) (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"
 *)
@@ -135,33 +144,36 @@ let _ = add_tacdef false ((Loc.ghost,Id.of_string"ring_closed_term"
 let ic c =
   let env = Global.env() in
   let sigma = Evd.from_env env in
-  Constrintern.interp_open_constr env sigma c
+  let sigma, c = Constrintern.interp_open_constr env sigma c in
+  (sigma, c)
 
 let ic_unsafe c = (*FIXME remove *)
   let env = Global.env() in
   let sigma = Evd.from_env env in
-    fst (Constrintern.interp_constr env sigma c)
-
-let decl_constant na ctx c =
-  let vars = Universes.universes_of_constr c in
-  let ctx = Universes.restrict_universe_context (Univ.ContextSet.of_context ctx) vars in
+  fst (Constrintern.interp_constr env sigma c)
+
+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 *)
 let ltac_call tac (args:glob_tactic_arg list) =
-  TacArg(Loc.ghost,TacCall(Loc.ghost, ArgArg(Loc.ghost, Lazy.force tac),args))
+  TacArg(Loc.tag @@ TacCall (Loc.tag (ArgArg(Loc.tag @@ Lazy.force tac),args)))
 
 (* Calling a locally bound tactic *)
 let ltac_lcall tac args =
-  TacArg(Loc.ghost,TacCall(Loc.ghost, ArgVar(Loc.ghost, 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.ghost, 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
@@ -171,11 +183,11 @@ let ltac_apply (f : Value.t) (args: Tacinterp.Value.t list) =
 
 let dummy_goal env sigma =
   let (gl,_,sigma) = 
-    Goal.V82.mk_goal sigma (named_context_val env) mkProp Evd.Store.empty in
+    Goal.V82.mk_goal sigma (named_context_val env) EConstr.mkProp Evd.Store.empty in
   {Evd.it = gl; Evd.sigma = sigma}
 
 let constr_of v = match Value.to_constr v with
-  | Some c -> c
+  | Some c -> EConstr.Unsafe.to_constr c
   | None -> failwith "Ring.exec_tactic: anomaly"
 
 let tactic_res = ref [||]
@@ -196,7 +208,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.ghost, 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
@@ -204,13 +216,14 @@ let exec_tactic env evd n f args =
   (** Build the getter *)
   let lid = List.init n (fun i -> Id.of_string("x"^string_of_int i)) in
   let n = Genarg.in_gen (Genarg.glbwit Stdarg.wit_int) n in
-  let get_res = TacML (Loc.ghost, get_res, [TacGeneric n]) in
-  let getter = Tacexp (TacFun (List.map (fun id -> Some id) lid, get_res)) in
+  let get_res = TacML (Loc.tag (get_res, [TacGeneric n])) in
+  let getter = Tacexp (TacFun (List.map (fun n -> Name n) lid, get_res)) in
   (** Evaluate the whole result *)
   let gl = dummy_goal env evd in
   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
-    Array.map (fun x -> nf (constr_of x)) !tactic_res, snd (Evd.universe_context evd)
+  let nf c = nf (constr_of c) in
+  Array.map nf !tactic_res, Evd.universe_context_set evd
 
 let stdlib_modules =
   [["Coq";"Setoids";"Setoid"];
@@ -220,7 +233,7 @@ let stdlib_modules =
   ]
 
 let coq_constant c =
-  lazy (Coqlib.gen_constant_in_modules "Ring" stdlib_modules c)
+  lazy (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.gen_reference_in_modules "Ring" stdlib_modules c))
 let coq_reference c =
   lazy (Coqlib.gen_reference_in_modules "Ring" stdlib_modules c)
 
@@ -238,19 +251,19 @@ let plapp evd f args =
   let fc = Evarutil.e_new_global evd (Lazy.force f) in
     mkApp(fc,args)
 
-let dest_rel0 t =
-  match kind_of_term t with
+let dest_rel0 sigma t =
+  match EConstr.kind sigma t with
   | App(f,args) when Array.length args >= 2 ->
       let rel = mkApp(f,Array.sub args 0 (Array.length args - 2)) in
-      if closed0 rel then
+      if closed0 sigma rel then
         (rel,args.(Array.length args - 2),args.(Array.length args - 1))
       else error "ring: cannot find relation (not closed)"
   | _ -> error "ring: cannot find relation"
 
-let rec dest_rel t =
-  match kind_of_term t with
-  | Prod(_,_,c) -> dest_rel c
-  | _ -> dest_rel0 t
+let rec dest_rel sigma t =
+  match EConstr.kind sigma t with
+  | Prod(_,_,c) -> dest_rel sigma c
+  | _ -> dest_rel0 sigma t
 
 (****************************************************************************)
 (* Library linking *)
@@ -265,18 +278,16 @@ let plugin_modules =
     ]
 
 let my_constant c =
-  lazy (Coqlib.gen_constant_in_modules "Ring" plugin_modules c)
+  lazy (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.gen_reference_in_modules "Ring" plugin_modules c))
 let my_reference c =
   lazy (Coqlib.gen_reference_in_modules "Ring" plugin_modules c)
 
-let new_ring_path =
-  DirPath.make (List.map Id.of_string ["Ring_tac";plugin_dir;"Coq"])
 let znew_ring_path =
   DirPath.make (List.map Id.of_string ["InitialRing";plugin_dir;"Coq"])
 let zltac s =
-  lazy(make_kn (MPfile znew_ring_path) DirPath.empty (Label.make s))
+  lazy(KerName.make (ModPath.MPfile znew_ring_path) DirPath.empty (Label.make s))
 
-let mk_cst l s = lazy (Coqlib.gen_reference "newring" l s);;
+let mk_cst l s = lazy (Coqlib.coq_reference "newring" l s);;
 let pol_cst s = mk_cst [plugin_dir;"Ring_polynom"] s ;;
 
 (* Ring theory *)
@@ -309,27 +320,29 @@ let coq_mkhypo = my_reference "mkhypo"
 let coq_hypo = my_reference "hypo"
 
 (* Equality: do not evaluate but make recursive call on both sides *)
-let map_with_eq arg_map c =
-  let (req,_,_) = dest_rel c in
+let map_with_eq arg_map sigma c =
+  let (req,_,_) = dest_rel sigma c in
   interp_map
-    ((global_head_of_constr req,(function -1->Prot|_->Rec))::
+    ((global_head_of_constr sigma req,(function -1->Prot|_->Rec))::
     List.map (fun (c,map) -> (Lazy.force c,map)) arg_map)
 
-let map_without_eq arg_map _ =
+let map_without_eq arg_map _ _ =
   interp_map (List.map (fun (c,map) -> (Lazy.force c,map)) arg_map)
 
 let _ = add_map "ring"
   (map_with_eq
     [coq_cons,(function -1->Eval|2->Rec|_->Prot);
     coq_nil, (function -1->Eval|_ -> Prot);
+    my_reference "IDphi", (function _->Eval);
+    my_reference "gen_phiZ", (function _->Eval);
     (* Pphi_dev: evaluate polynomial and coef operations, protect
        ring operations and make recursive call on the var map *)
-    pol_cst "Pphi_dev", (function -1|8|9|10|11|12|14->Eval|13->Rec|_->Prot);
+    pol_cst "Pphi_dev", (function -1|8|9|10|12|14->Eval|11|13->Rec|_->Prot);
     pol_cst "Pphi_pow",
-          (function -1|8|9|10|11|13|15|17->Eval|16->Rec|_->Prot);
-    (* PEeval: evaluate morphism and polynomial, protect ring
+          (function -1|8|9|10|13|15|17->Eval|11|16->Rec|_->Prot);
+    (* PEeval: evaluate polynomial, protect ring
        operations and make recursive call on the var map *)
-    pol_cst "PEeval", (function -1|7|9|12->Eval|11->Rec|_->Prot)])
+    pol_cst "PEeval", (function -1|10|13->Eval|8|12->Rec|_->Prot)])
 
 (****************************************************************************)
 (* Ring database *)
@@ -348,15 +361,15 @@ let find_ring_structure env sigma l =
         let check c =
           let ty' = Retyping.get_type_of env sigma c in
           if not (Reductionops.is_conv env sigma ty ty') then
-            errorlabstrm "ring"
+            CErrors.user_err ~hdr:"ring"
               (str"arguments of ring_simplify do not have all the same type")
         in
         List.iter check cl';
-        (try ring_for_carrier ty
+        (try ring_for_carrier (EConstr.to_constr sigma ty)
         with Not_found ->
-          errorlabstrm "ring"
+          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 =
@@ -379,7 +392,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 &&
-     eq_constr set' th.ring_setoid &&
+     Constr.equal set' th.ring_setoid &&
      ext' == th.ring_ext &&
      morph' == th.ring_morph &&
      th' == th.ring_th &&
@@ -485,8 +498,8 @@ let op_smorph r add mul req m1 m2 =
 (*         (setoid,op_morph) *)
 
 let ring_equality env evd (r,add,mul,opp,req) =
-  match kind_of_term req with
-    | App (f, [| _ |]) when eq_constr_nounivs f (Lazy.force coq_eq) ->
+  match EConstr.kind !evd req with
+    | App (f, [| _ |]) when eq_constr_nounivs !evd f (Lazy.force coq_eq) ->
 	let setoid = plapp evd coq_eq_setoid [|r|] in
 	let op_morph =
 	  match opp with
@@ -517,19 +530,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)
 
@@ -540,15 +553,15 @@ let build_setoid_params env evd r add mul opp req eqth =
 
 let dest_ring env sigma th_spec =
   let th_typ = Retyping.get_type_of env sigma th_spec in
-  match kind_of_term th_typ with
+  match EConstr.kind sigma th_typ with
       App(f,[|r;zero;one;add;mul;sub;opp;req|])
-        when eq_constr_nounivs f (Lazy.force coq_almost_ring_theory) ->
+        when eq_constr_nounivs sigma f (Lazy.force coq_almost_ring_theory) ->
           (None,r,zero,one,add,mul,Some sub,Some opp,req)
     | App(f,[|r;zero;one;add;mul;req|])
-        when eq_constr_nounivs f (Lazy.force coq_semi_ring_theory) ->
+        when eq_constr_nounivs sigma f (Lazy.force coq_semi_ring_theory) ->
         (Some true,r,zero,one,add,mul,None,None,req)
     | App(f,[|r;zero;one;add;mul;sub;opp;req|])
-        when eq_constr_nounivs f (Lazy.force coq_ring_theory) ->
+        when eq_constr_nounivs sigma f (Lazy.force coq_ring_theory) ->
         (Some false,r,zero,one,add,mul,Some sub,Some opp,req)
     | _ -> error "bad ring structure"
 
@@ -566,8 +579,8 @@ let interp_cst_tac env sigma rk kind (zero,one,add,mul,opp) cst_tac =
     | Some (Closed lc) ->
         closed_term_ast (List.map Smartlocate.global_with_alias lc)
     | None ->
-        let t = ArgArg(Loc.ghost,Lazy.force ltac_inv_morph_nothing) in
-              TacArg(Loc.ghost,TacCall(Loc.ghost,t,[]))
+        let t = ArgArg(Loc.tag @@ Lazy.force ltac_inv_morph_nothing) in
+              TacArg(Loc.tag (TacCall(Loc.tag (t,[]))))
 
 let make_hyp env evd c =
   let t = Retyping.get_type_of env !evd c in
@@ -581,14 +594,15 @@ let make_hyp_list env evd lH =
       (plapp evd coq_nil [|carrier|])
   in 
   let l' = Typing.e_solve_evars env evd l in
+  let l' = EConstr.Unsafe.to_constr l' in
     Evarutil.nf_evars_universes !evd l'
 
 let interp_power env evd pow =
   let carrier = Evarutil.e_new_global evd (Lazy.force coq_hypo) in
   match pow with
   | None ->
-      let t = ArgArg(Loc.ghost, Lazy.force ltac_inv_morph_nothing) in
-      (TacArg(Loc.ghost,TacCall(Loc.ghost,t,[])), plapp evd coq_None [|carrier|])
+      let t = ArgArg(Loc.tag (Lazy.force ltac_inv_morph_nothing)) in
+      (TacArg(Loc.tag (TacCall(Loc.tag (t,[])))), plapp evd coq_None [|carrier|])
   | Some (tac, spec) ->
       let tac =
         match tac with
@@ -616,7 +630,7 @@ let interp_div env evd div =
       plapp evd coq_Some [|carrier;spec|]
        (* Same remark on ill-typed terms ... *)
 
-let add_theory name (sigma,rth) eqth morphth cst_tac (pre,post) power sign div =
+let add_theory0 name (sigma, rth) eqth morphth cst_tac (pre,post) power sign div =
   check_required_library (cdir@["Ring_base"]);
   let env = Global.env() in
   let (kind,r,zero,one,add,mul,sub,opp,req) = dest_ring env sigma rth in
@@ -646,6 +660,9 @@ let add_theory name (sigma,rth) eqth morphth cst_tac (pre,post) power sign div =
     match post with
         Some t -> Tacintern.glob_tactic t
       | _ -> TacId [] in
+  let r = EConstr.to_constr sigma r in
+  let req = EConstr.to_constr sigma req in
+  let sth = EConstr.to_constr sigma sth in
   let _ =
     Lib.add_leaf name
       (theory_to_obj
@@ -693,13 +710,18 @@ let process_ring_mods l =
   let k = match !kind with Some k -> k | None -> Abstract in
   (k, !set, !cst_tac, !pre, !post, !power, !sign, !div)
 
+let add_theory id rth l =
+  let (sigma, rth) = ic rth in
+  let (k,set,cst,pre,post,power,sign, div) = process_ring_mods l in
+  add_theory0 id (sigma, rth) set k cst (pre,post) power sign div
+
 (*****************************************************************************)
 (* The tactics consist then only in a lookup in the ring database and
    call the appropriate ltac. *)
 
-let make_args_list rl t =
+let make_args_list sigma rl t =
   match rl with
-  | [] -> let (_,t1,t2) = dest_rel0 t in [t1;t2]
+  | [] -> let (_,t1,t2) = dest_rel0 sigma t in [t1;t2]
   | _ -> rl
 
 let make_term_list env evd carrier rl =
@@ -708,7 +730,7 @@ let make_term_list env evd carrier rl =
     (plapp evd coq_nil [|carrier|])
   in Typing.e_solve_evars env evd l
 
-let carg = Tacinterp.Value.of_constr
+let carg c = Tacinterp.Value.of_constr (EConstr.of_constr c)
 let tacarg expr =
   Tacinterp.Value.of_closure (Tacinterp.default_ist ()) expr
 
@@ -722,25 +744,25 @@ let ltac_ring_structure e =
   let pow_tac = tacarg e.ring_pow_tac in
   let lemma1 = carg e.ring_lemma1 in
   let lemma2 = carg e.ring_lemma2 in
-  let pretac = tacarg (TacFun([None],e.ring_pre_tac)) in
-  let posttac = tacarg (TacFun([None],e.ring_post_tac)) in
+  let pretac = tacarg (TacFun([Anonymous],e.ring_pre_tac)) in
+  let posttac = tacarg (TacFun([Anonymous],e.ring_post_tac)) in
   [req;sth;ext;morph;th;cst_tac;pow_tac;
    lemma1;lemma2;pretac;posttac]
 
 let ring_lookup (f : Value.t) lH rl t =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     try (* find_ring_strucure can raise an exception *)
+      let rl = make_args_list sigma rl t in
       let evdref = ref sigma in
-      let rl = make_args_list rl t in
       let e = find_ring_structure env sigma rl in
-      let rl = carg (make_term_list env evdref e.ring_carrier rl) in
+      let rl = Value.of_constr (make_term_list env evdref (EConstr.of_constr e.ring_carrier) rl) in
       let lH = carg (make_hyp_list env evdref lH) in
       let ring = ltac_ring_structure e in
       Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref) (ltac_apply f (ring@[lH;rl]))
     with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
-  end }
+  end
 
 (***********************************************************************)
 
@@ -748,39 +770,42 @@ let new_field_path =
   DirPath.make (List.map Id.of_string ["Field_tac";plugin_dir;"Coq"])
 
 let field_ltac s =
-  lazy(make_kn (MPfile new_field_path) DirPath.empty (Label.make s))
+  lazy(KerName.make (ModPath.MPfile new_field_path) DirPath.empty (Label.make s))
 
 
 let _ = add_map "field"
   (map_with_eq
     [coq_cons,(function -1->Eval|2->Rec|_->Prot);
     coq_nil, (function -1->Eval|_ -> Prot);
+    my_reference "IDphi", (function _->Eval);
+    my_reference "gen_phiZ", (function _->Eval);
     (* display_linear: evaluate polynomials and coef operations, protect
        field operations and make recursive call on the var map *)
     my_reference "display_linear",
-      (function -1|9|10|11|12|13|15|16->Eval|14->Rec|_->Prot);
+      (function -1|9|10|11|13|15|16->Eval|12|14->Rec|_->Prot);
     my_reference "display_pow_linear",
-     (function -1|9|10|11|12|13|14|16|18|19->Eval|17->Rec|_->Prot);
+     (function -1|9|10|11|14|16|18|19->Eval|12|17->Rec|_->Prot);
    (* Pphi_dev: evaluate polynomial and coef operations, protect
        ring operations and make recursive call on the var map *)
-    pol_cst "Pphi_dev", (function -1|8|9|10|11|12|14->Eval|13->Rec|_->Prot);
+    pol_cst "Pphi_dev", (function -1|8|9|10|12|14->Eval|11|13->Rec|_->Prot);
     pol_cst "Pphi_pow",
-          (function -1|8|9|10|11|13|15|17->Eval|16->Rec|_->Prot);
-    (* PEeval: evaluate morphism and polynomial, protect ring
+          (function -1|8|9|10|13|15|17->Eval|11|16->Rec|_->Prot);
+    (* PEeval: evaluate polynomial, protect ring
        operations and make recursive call on the var map *)
-    pol_cst "PEeval", (function -1|7|9|12->Eval|11->Rec|_->Prot);
-    (* FEeval: evaluate morphism, protect field
+    pol_cst "PEeval", (function -1|10|13->Eval|8|12->Rec|_->Prot);
+    (* FEeval: evaluate polynomial, protect field
        operations and make recursive call on the var map *)
-    my_reference "FEeval", (function -1|8|9|10|11|14->Eval|13->Rec|_->Prot)]);;
+    my_reference "FEeval", (function -1|12|15->Eval|10|14->Rec|_->Prot)]);;
 
 let _ = add_map "field_cond"
   (map_without_eq
     [coq_cons,(function -1->Eval|2->Rec|_->Prot);
      coq_nil, (function -1->Eval|_ -> Prot);
-    (* PCond: evaluate morphism and denum list, protect ring
+     my_reference "IDphi", (function _->Eval);
+     my_reference "gen_phiZ", (function _->Eval);
+    (* PCond: evaluate denum list, protect ring
        operations and make recursive call on the var map *)
-     my_reference "PCond", (function -1|9|11|14->Eval|13->Rec|_->Prot)]);;
-(*                       (function -1|9|11->Eval|10->Rec|_->Prot)]);;*)
+     my_reference "PCond", (function -1|11|14->Eval|9|13->Rec|_->Prot)]);;
 
 
 let _ = Redexpr.declare_reduction "simpl_field_expr"
@@ -795,21 +820,22 @@ let af_ar = my_reference"AF_AR"
 let f_r = my_reference"F_R"
 let sf_sr = my_reference"SF_SR"
 let dest_field env evd th_spec =
+  let open Termops in
   let th_typ = Retyping.get_type_of env !evd th_spec in
-  match kind_of_term th_typ with
+  match EConstr.kind !evd th_typ with
     | App(f,[|r;zero;one;add;mul;sub;opp;div;inv;req|])
-        when is_global (Lazy.force afield_theory) f ->
+        when is_global !evd (Lazy.force afield_theory) f ->
         let rth = plapp evd af_ar
           [|r;zero;one;add;mul;sub;opp;div;inv;req;th_spec|] in
         (None,r,zero,one,add,mul,Some sub,Some opp,div,inv,req,rth)
     | App(f,[|r;zero;one;add;mul;sub;opp;div;inv;req|])
-        when is_global (Lazy.force field_theory) f ->
+        when is_global !evd (Lazy.force field_theory) f ->
         let rth =
           plapp evd f_r
             [|r;zero;one;add;mul;sub;opp;div;inv;req;th_spec|] in
         (Some false,r,zero,one,add,mul,Some sub,Some opp,div,inv,req,rth)
     | App(f,[|r;zero;one;add;mul;div;inv;req|])
-        when is_global (Lazy.force sfield_theory) f ->
+        when is_global !evd (Lazy.force sfield_theory) f ->
         let rth = plapp evd sf_sr
           [|r;zero;one;add;mul;div;inv;req;th_spec|] in
         (Some true,r,zero,one,add,mul,None,None,div,inv,req,rth)
@@ -828,15 +854,15 @@ let find_field_structure env sigma l =
         let check c =
           let ty' = Retyping.get_type_of env sigma c in
           if not (Reductionops.is_conv env sigma ty ty') then
-            errorlabstrm "field"
+            CErrors.user_err ~hdr:"field"
               (str"arguments of field_simplify do not have all the same type")
         in
         List.iter check cl';
-        (try field_for_carrier ty
+        (try field_for_carrier (EConstr.to_constr sigma ty)
         with Not_found ->
-          errorlabstrm "field"
+          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 =
@@ -889,9 +915,11 @@ let ftheory_to_obj : field_info -> obj =
       classify_function = (fun x -> Substitute x) }
 
 let field_equality evd r inv req =
-  match kind_of_term req with
-    | App (f, [| _ |]) when eq_constr_nounivs f (Lazy.force coq_eq) ->
-        mkApp(Universes.constr_of_global (Coqlib.build_coq_eq_data()).congr,[|r;r;inv|])
+  match EConstr.kind !evd req with
+    | App (f, [| _ |]) when eq_constr_nounivs !evd f (Lazy.force coq_eq) ->
+        let c = Universes.constr_of_global (Coqlib.build_coq_eq_data()).congr in
+        let c = EConstr.of_constr c in
+        mkApp(c,[|r;r;inv|])
     | _ ->
 	let _setoid = setoid_of_relation (Global.env ()) evd r req in
 	let signature = [Some (r,Some req)],Some(r,Some req) in
@@ -901,15 +929,17 @@ let field_equality evd r inv req =
             error "field inverse should be declared as a morphism" in
 	  inv_m_lem
 
-let add_field_theory name (sigma,fth) eqth morphth cst_tac inj (pre,post) power sign odiv =
+let add_field_theory0 name fth eqth morphth cst_tac inj (pre,post) power sign odiv =
+  let open Constr in
   check_required_library (cdir@["Field_tac"]);
+  let (sigma,fth) = ic fth in
   let env = Global.env() in
   let evd = ref sigma in
   let (kind,r,zero,one,add,mul,sub,opp,div,inv,req,rth) =
     dest_field env evd fth in
   let (sth,ext) = build_setoid_params env evd r add mul opp req eqth in
   let eqth = Some(sth,ext) in
-  let _ = add_theory name (!evd,rth) eqth morphth cst_tac (None,None) power sign odiv in
+  let _ = add_theory0 name (!evd,rth) eqth morphth cst_tac (None,None) power sign odiv in
   let (pow_tac, pspec) = interp_power env evd power in
   let sspec = interp_sign env evd sign in
   let dspec = interp_div env evd odiv in
@@ -924,7 +954,7 @@ let add_field_theory name (sigma,fth) eqth morphth cst_tac inj (pre,post) power
   let lemma4 = params.(6) in
   let cond_lemma =
     match inj with
-      | Some thm -> mkApp(params.(8),[|thm|])
+      | Some thm -> mkApp(params.(8),[|EConstr.to_constr sigma thm|])
       | None -> params.(7) in
   let lemma1 = decl_constant (Id.to_string name^"_field_lemma1")
     ctx lemma1 in
@@ -946,6 +976,8 @@ let add_field_theory name (sigma,fth) eqth morphth cst_tac inj (pre,post) power
     match post with
         Some t -> Tacintern.glob_tactic t
       | _ -> TacId [] in
+  let r = EConstr.to_constr sigma r in
+  let req = EConstr.to_constr sigma req in
   let _ =
     Lib.add_leaf name
       (ftheory_to_obj
@@ -985,6 +1017,10 @@ let process_field_mods l =
   let k = match !kind with Some k -> k | None -> Abstract in
   (k, !set, !inj, !cst_tac, !pre, !post, !power, !sign, !div)
 
+let add_field_theory id t mods =
+  let (k,set,inj,cst_tac,pre,post,power,sign,div) = process_field_mods mods in
+  add_field_theory0 id t set k cst_tac inj (pre,post) power sign div
+
 let ltac_field_structure e =
   let req = carg e.field_req in
   let cst_tac = tacarg e.field_cst_tac in
@@ -994,22 +1030,22 @@ let ltac_field_structure e =
   let field_simpl_eq_ok = carg e.field_simpl_eq_ok in
   let field_simpl_eq_in_ok = carg e.field_simpl_eq_in_ok in
   let cond_ok = carg e.field_cond in
-  let pretac = tacarg (TacFun([None],e.field_pre_tac)) in
-  let posttac = tacarg (TacFun([None],e.field_post_tac)) in
+  let pretac = tacarg (TacFun([Anonymous],e.field_pre_tac)) in
+  let posttac = tacarg (TacFun([Anonymous],e.field_post_tac)) in
   [req;cst_tac;pow_tac;field_ok;field_simpl_ok;field_simpl_eq_ok;
    field_simpl_eq_in_ok;cond_ok;pretac;posttac]
 
 let field_lookup (f : Value.t) lH rl t =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     try
+      let rl = make_args_list sigma rl t in
       let evdref = ref sigma in
-      let rl = make_args_list rl t in
       let e = find_field_structure env sigma rl in
-      let rl = carg (make_term_list env evdref e.field_carrier rl) in
+      let rl = Value.of_constr (make_term_list env evdref (EConstr.of_constr e.field_carrier) rl) in
       let lH = carg (make_hyp_list env evdref lH) in
       let field = ltac_field_structure e in
       Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref) (ltac_apply f (field@[lH;rl]))
     with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
-  end }
+  end
diff --git a/plugins/setoid_ring/newring.mli b/plugins/setoid_ring/newring.mli
index f417c87c..1d1557b1 100644
--- a/plugins/setoid_ring/newring.mli
+++ b/plugins/setoid_ring/newring.mli
@@ -1,46 +1,30 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Constr
+open EConstr
 open Libnames
 open Globnames
 open Constrexpr
-open Tacexpr
-open Proof_type
 open Newring_ast
 
 val protect_tac_in : string -> Id.t -> unit Proofview.tactic
 
 val protect_tac : string -> unit Proofview.tactic
 
-val closed_term : constr -> global_reference list -> unit Proofview.tactic
-
-val process_ring_mods :
-  constr_expr ring_mod list ->
-  constr coeff_spec * (constr * constr) option *
-  cst_tac_spec option * raw_tactic_expr option *
-  raw_tactic_expr option *
-  (cst_tac_spec * constr_expr) option *
-  constr_expr option * constr_expr option
+val closed_term : EConstr.constr -> global_reference list -> unit Proofview.tactic
 
 val add_theory :
   Id.t ->
-  Evd.evar_map * constr ->
-  (constr * constr) option ->
-  constr coeff_spec ->
-  cst_tac_spec option ->
-  raw_tactic_expr option * raw_tactic_expr option ->
-  (cst_tac_spec * constr_expr) option ->
-  constr_expr option ->
-  constr_expr option -> unit
-
-val ic : constr_expr -> Evd.evar_map * constr
+  constr_expr ->
+  constr_expr ring_mod list -> unit
 
 val from_name : ring_info Spmap.t ref
 
@@ -49,26 +33,10 @@ val ring_lookup :
   constr list ->
   constr list -> constr -> unit Proofview.tactic
 
-val process_field_mods :
-  constr_expr field_mod list ->
-  constr coeff_spec *
-  (constr * constr) option * constr option *
-  cst_tac_spec option * raw_tactic_expr option *
-  raw_tactic_expr option *
-  (cst_tac_spec * constr_expr) option *
-  constr_expr option * constr_expr option
-
 val add_field_theory :
   Id.t ->
-  Evd.evar_map * constr ->
-  (constr * constr) option ->
-  constr coeff_spec ->
-  cst_tac_spec option ->
-  constr option ->
-  raw_tactic_expr option * raw_tactic_expr option ->
-  (cst_tac_spec * constr_expr) option ->
-  constr_expr option ->
-  constr_expr option -> unit
+  constr_expr ->
+  constr_expr field_mod list -> unit
 
 val field_from_name : field_info Spmap.t ref
 
diff --git a/plugins/setoid_ring/newring_ast.ml b/plugins/setoid_ring/newring_ast.ml
new file mode 100644
index 00000000..3eb68b51
--- /dev/null
+++ b/plugins/setoid_ring/newring_ast.ml
@@ -0,0 +1,67 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Constr
+open Libnames
+open Constrexpr
+
+open Ltac_plugin
+open Tacexpr
+
+type 'constr coeff_spec =
+    Computational of 'constr (* equality test *)
+  | Abstract (* coeffs = Z *)
+  | Morphism of 'constr (* general morphism *)
+
+type cst_tac_spec =
+    CstTac of raw_tactic_expr
+  | Closed of reference list
+
+type 'constr ring_mod =
+    Ring_kind of 'constr coeff_spec
+  | Const_tac of cst_tac_spec
+  | Pre_tac of raw_tactic_expr
+  | Post_tac of raw_tactic_expr
+  | Setoid of constr_expr * constr_expr
+  | Pow_spec of cst_tac_spec * constr_expr
+           (* Syntaxification tactic , correctness lemma *)
+  | Sign_spec of constr_expr
+  | Div_spec of constr_expr
+
+type 'constr field_mod =
+    Ring_mod of 'constr ring_mod
+  | Inject of constr_expr
+
+type ring_info =
+    { ring_carrier : types;
+      ring_req : constr;
+      ring_setoid : constr;
+      ring_ext : constr;
+      ring_morph : constr;
+      ring_th : constr;
+      ring_cst_tac : glob_tactic_expr;
+      ring_pow_tac : glob_tactic_expr;
+      ring_lemma1 : constr;
+      ring_lemma2 : constr;
+      ring_pre_tac : glob_tactic_expr;
+      ring_post_tac : glob_tactic_expr }
+
+type field_info =
+    { field_carrier : types;
+      field_req : constr;
+      field_cst_tac : glob_tactic_expr;
+      field_pow_tac : glob_tactic_expr;
+      field_ok : constr;
+      field_simpl_eq_ok : constr;
+      field_simpl_ok : constr;
+      field_simpl_eq_in_ok : constr;
+      field_cond : constr;
+      field_pre_tac : glob_tactic_expr;
+      field_post_tac : glob_tactic_expr }
diff --git a/plugins/setoid_ring/newring_ast.mli b/plugins/setoid_ring/newring_ast.mli
index c26fcc8d..3eb68b51 100644
--- a/plugins/setoid_ring/newring_ast.mli
+++ b/plugins/setoid_ring/newring_ast.mli
@@ -1,14 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Constr
 open Libnames
 open Constrexpr
+
+open Ltac_plugin
 open Tacexpr
 
 type 'constr coeff_spec =
diff --git a/plugins/setoid_ring/newring_plugin.mlpack b/plugins/setoid_ring/newring_plugin.mlpack
index 23663b40..5aa79b58 100644
--- a/plugins/setoid_ring/newring_plugin.mlpack
+++ b/plugins/setoid_ring/newring_plugin.mlpack
@@ -1,2 +1,3 @@
+Newring_ast
 Newring
 G_newring
diff --git a/plugins/setoid_ring/vo.itarget b/plugins/setoid_ring/vo.itarget
deleted file mode 100644
index 595ba55e..00000000
--- a/plugins/setoid_ring/vo.itarget
+++ /dev/null
@@ -1,24 +0,0 @@
-ArithRing.vo
-BinList.vo
-Field_tac.vo
-Field_theory.vo
-Field.vo
-InitialRing.vo
-NArithRing.vo
-RealField.vo
-Ring_base.vo
-Ring_polynom.vo
-Ring_tac.vo
-Ring_theory.vo
-Ring.vo
-ZArithRing.vo
-Algebra_syntax.vo
-Cring.vo
-Ncring.vo
-Ncring_polynom.vo
-Ncring_initial.vo
-Ncring_tac.vo
-Rings_Z.vo
-Rings_R.vo
-Rings_Q.vo
-Integral_domain.vo
\ No newline at end of file
diff --git a/plugins/ssr/ssrast.mli b/plugins/ssr/ssrast.mli
new file mode 100644
index 00000000..7f5f2f63
--- /dev/null
+++ b/plugins/ssr/ssrast.mli
@@ -0,0 +1,175 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Names
+open Ltac_plugin
+
+(* Names of variables to be cleared (automatic check: not a section var) *)
+type ssrhyp = SsrHyp of Id.t Loc.located
+(* Variant of the above *)
+type ssrhyp_or_id = Hyp of ssrhyp | Id of ssrhyp
+
+(* Variant of the above *)
+type ssrhyps = ssrhyp list
+
+(* Direction to be used for rewriting as in -> or rewrite flag *)
+type ssrdir = Ssrmatching_plugin.Ssrmatching.ssrdir = L2R | R2L
+
+(* simpl: "/=", cut: "//", simplcut: "//=" nop: commodity placeholder *)
+type ssrsimpl = Simpl of int | Cut of int | SimplCut of int * int | Nop
+
+(* modality for rewrite and do: ! ? *)
+type ssrmmod = May | Must | Once
+
+(* modality with a bound for rewrite and do: !n ?n *)
+type ssrmult = int * ssrmmod
+
+(** Occurrence switch {1 2}, all is Some(false,[]) *)
+type ssrocc = (bool * int list) option
+
+(* index MAYBE REMOVE ONLY INTERNAL stuff between {} *)
+type ssrindex = int Misctypes.or_var
+
+(* clear switch {H G} *)
+type ssrclear = ssrhyps
+
+(* Discharge occ switch (combined occurrence / clear switch) *)
+type ssrdocc = ssrclear option * ssrocc
+
+(* OLD ssr terms *)
+type ssrtermkind = char (* FIXME, make algebraic *)
+type ssrterm = ssrtermkind * Tacexpr.glob_constr_and_expr
+
+(* NEW ssr term *)
+
+(* These terms are raw but closed with the intenalization/interpretation
+ * context.  It is up to the tactic receiving it to decide if such contexts
+ * are useful or not, and eventually manipulate the term before turning it
+ * into a constr *)
+type ast_closure_term = {
+  body : Constrexpr.constr_expr;
+  glob_env : Genintern.glob_sign option; (* for Tacintern.intern_constr *)
+  interp_env :  Geninterp.interp_sign option; (* for Tacinterp.interp_open_constr_with_bindings *)
+  annotation : [ `None | `Parens | `DoubleParens | `At ];
+}
+
+type ssrview = ast_closure_term list
+
+(* TODO
+type id_mod = Hat | HatTilde | Sharp
+ *)
+
+(* Only [One] forces an introduction, possibly reducing the goal. *)
+type anon_iter =
+  | One
+  | Drop
+  | All
+(* TODO
+  | Dependent (* fast mode *)
+  | UntilMark
+  | Temporary (* "+" *)
+ *)
+
+type ssripat =
+  | IPatNoop
+  | IPatId of (*TODO id_mod option * *) Id.t
+  | IPatAnon of anon_iter (* inaccessible name *)
+(* TODO  | IPatClearMark *)
+  | IPatDispatch of ssripatss (* /[..|..] *)
+  | IPatCase of (* ipats_mod option * *) ssripatss (* this is not equivalent to /case /[..|..] if there are already multiple goals *)
+  | IPatInj of ssripatss
+  | IPatRewrite of (*occurrence option * rewrite_pattern **) ssrocc * ssrdir
+  | IPatView of ssrview (* /view *)
+  | IPatClear of ssrclear (* {H1 H2} *)
+  | IPatSimpl of ssrsimpl
+  | IPatAbstractVars of Id.t list
+  | IPatTac of unit Proofview.tactic
+
+and ssripats = ssripat list
+and ssripatss = ssripats list
+type ssrhpats = ((ssrclear * ssripats) * ssripats) * ssripats
+type ssrhpats_wtransp = bool * ssrhpats
+
+(* tac => inpats *)
+type ssrintrosarg = Tacexpr.raw_tactic_expr * ssripats
+
+
+type ssrfwdid = Id.t
+(** Binders (for fwd tactics) *)
+type 'term ssrbind =
+  | Bvar of Name.t
+  | Bdecl of Name.t list * 'term
+  | Bdef of Name.t * 'term option * 'term
+  | Bstruct of Name.t
+  | Bcast of 'term
+(* We use an intermediate structure to correctly render the binder list  *)
+(* abbreviations. We use a list of hints to extract the binders and      *)
+(* base term from a term, for the two first levels of representation of  *)
+(* of constr terms.                                                      *)
+type ssrbindfmt =
+  | BFvar
+  | BFdecl of int        (* #xs *)
+  | BFcast               (* final cast *)
+  | BFdef                (* has cast? *)
+  | BFrec of bool * bool (* has struct? * has cast? *)
+type 'term ssrbindval = 'term ssrbind list * 'term
+
+(** Forward chaining argument *)
+(* There are three kinds of forward definitions:           *)
+(*   - Hint: type only, cast to Type, may have proof hint. *)
+(*   - Have: type option + value, no space before type     *)
+(*   - Pose: binders + value, space before binders.        *)
+type ssrfwdkind = FwdHint of string * bool | FwdHave | FwdPose
+type ssrfwdfmt = ssrfwdkind * ssrbindfmt list
+
+(* in *)
+type ssrclseq = InGoal | InHyps
+ | InHypsGoal | InHypsSeqGoal | InSeqGoal | InHypsSeq | InAll | InAllHyps
+
+type 'tac ssrhint = bool * 'tac option list
+
+type 'tac fwdbinders =
+        bool * (ssrhpats * ((ssrfwdfmt * ast_closure_term) * 'tac ssrhint))
+
+type clause =
+  (ssrclear * ((ssrhyp_or_id * string) *
+              Ssrmatching_plugin.Ssrmatching.cpattern option) option)
+type clauses = clause list * ssrclseq
+
+type wgen =
+           (ssrclear *
+            ((ssrhyp_or_id * string) *
+             Ssrmatching_plugin.Ssrmatching.cpattern option)
+            option)
+
+type 'a ssrdoarg = ((ssrindex * ssrmmod) * 'a ssrhint) * clauses
+type 'a ssrseqarg = ssrindex * ('a ssrhint * 'a option)
+
+
+open Ssrmatching_plugin
+open Ssrmatching
+
+type 'a ssrcasearg = ssripat option * ('a * ssripats)
+type 'a ssrmovearg = ssrview * 'a ssrcasearg
+
+type ssrdgens = { dgens : (ssrdocc * cpattern) list;
+                  gens  : (ssrdocc * cpattern) list;
+                  clr  : ssrclear }
+type 'a ssragens = (ssrdocc * 'a) list list * ssrclear
+type ssrapplyarg = ssrterm list * (ssrterm ssragens * ssripats)
+
+(* OOP : these are general shortcuts *)
+type gist = Tacintern.glob_sign
+type ist = Tacinterp.interp_sign
+type goal = Goal.goal
+type 'a sigma = 'a Evd.sigma
+type v82tac = Tacmach.tactic
diff --git a/plugins/ssr/ssrbool.v b/plugins/ssr/ssrbool.v
new file mode 100644
index 00000000..7d05b643
--- /dev/null
+++ b/plugins/ssr/ssrbool.v
@@ -0,0 +1,1873 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+Require Bool.
+Require Import ssreflect ssrfun.
+
+(******************************************************************************)
+(* A theory of boolean predicates and operators. A large part of this file is *)
+(* concerned with boolean reflection.                                         *)
+(* Definitions and notations:                                                 *)
+(*               is_true b == the coercion of b : bool to Prop (:= b = true). *)
+(*                            This is just input and displayed as `b''.       *)
+(*             reflect P b == the reflection inductive predicate, asserting   *)
+(*                            that the logical proposition P : prop with the  *)
+(*                            formula b : bool. Lemmas asserting reflect P b  *)
+(*                            are often referred to as "views".               *)
+(*  iffP, appP, sameP, rwP :: lemmas for direct manipulation of reflection    *)
+(*                            views: iffP is used to prove reflection from    *)
+(*                            logical equivalence, appP to compose views, and *)
+(*                            sameP and rwP to perform boolean and setoid     *)
+(*                            rewriting.                                      *)
+(*                   elimT :: coercion reflect >-> Funclass, which allows the *)
+(*                            direct application of `reflect' views to        *)
+(*                            boolean assertions.                             *)
+(*             decidable P <-> P is effectively decidable (:= {P} + {~ P}.    *)
+(*    contra, contraL, ... :: contraposition lemmas.                          *)
+(*           altP my_viewP :: natural alternative for reflection; given       *)
+(*                            lemma myviewP: reflect my_Prop my_formula,      *)
+(*                              have [myP | not_myP] := altP my_viewP.        *)
+(*                            generates two subgoals, in which my_formula has *)
+(*                            been replaced by true and false, resp., with    *)
+(*                            new assumptions myP : my_Prop and               *)
+(*                            not_myP: ~~ my_formula.                         *)
+(*                            Caveat: my_formula must be an APPLICATION, not  *)
+(*                            a variable, constant, let-in, etc. (due to the  *)
+(*                            poor behaviour of dependent index matching).    *)
+(*        boolP my_formula :: boolean disjunction, equivalent to              *)
+(*                            altP (idP my_formula) but circumventing the     *)
+(*                            dependent index capture issue; destructing      *)
+(*                            boolP my_formula generates two subgoals with    *)
+(*                            assumtions my_formula and ~~ myformula. As      *)
+(*                            with altP, my_formula must be an application.   *)
+(*            \unless C, P <-> we can assume property P when a something that *)
+(*                            holds under condition C (such as C itself).     *)
+(*                         := forall G : Prop, (C -> G) -> (P -> G) -> G.     *)
+(*                            This is just C \/ P or rather its impredicative *)
+(*                            encoding, whose usage better fits the above     *)
+(*                            description: given a lemma UCP whose conclusion *)
+(*                            is \unless C, P we can assume P by writing:     *)
+(*                              wlog hP: / P by apply/UCP; (prove C -> goal). *)
+(*                           or even apply: UCP id _ => hP if the goal is C.  *)
+(*           classically P <-> we can assume P when proving is_true b.        *)
+(*                         := forall b : bool, (P -> b) -> b.                 *)
+(*                            This is equivalent to ~ (~ P) when P : Prop.    *)
+(*             implies P Q == wrapper coinductive type that coerces to P -> Q *)
+(*                            and can be used as a P -> Q view unambigously.  *)
+(*                            Useful to avoid spurious insertion of <-> views *)
+(*                            when Q is a conjunction of foralls, as in Lemma *)
+(*                            all_and2 below; conversely, avoids confusion in *)
+(*                            apply views for impredicative properties, such  *)
+(*                            as \unless C, P. Also supports contrapositives. *)
+(*                  a && b == the boolean conjunction of a and b.             *)
+(*                  a || b == the boolean disjunction of a and b.             *)
+(*                 a ==> b == the boolean implication of b by a.              *)
+(*                    ~~ a == the boolean negation of a.                      *)
+(*                 a (+) b == the boolean exclusive or (or sum) of a and b.   *)
+(*     [ /\ P1 , P2 & P3 ] == multiway logical conjunction, up to 5 terms.    *)
+(*     [ \/ P1 , P2 | P3 ] == multiway logical disjunction, up to 4 terms.    *)
+(*        [&& a, b, c & d] == iterated, right associative boolean conjunction *)
+(*                            with arbitrary arity.                           *)
+(*        [|| a, b, c | d] == iterated, right associative boolean disjunction *)
+(*                            with arbitrary arity.                           *)
+(*      [==> a, b, c => d] == iterated, right associative boolean implication *)
+(*                            with arbitrary arity.                           *)
+(*              and3P, ... == specific reflection lemmas for iterated         *)
+(*                            connectives.                                    *)
+(*       andTb, orbAC, ... == systematic names for boolean connective         *)
+(*                            properties (see suffix conventions below).      *)
+(*              prop_congr == a tactic to move a boolean equality from        *)
+(*                            its coerced form in Prop to the equality        *)
+(*                            in bool.                                        *)
+(*              bool_congr == resolution tactic for blindly weeding out       *)
+(*                            like terms from boolean equalities (can fail).  *)
+(* This file provides a theory of boolean predicates and relations:           *)
+(*                  pred T == the type of bool predicates (:= T -> bool).     *)
+(*            simpl_pred T == the type of simplifying bool predicates, using  *)
+(*                            the simpl_fun from ssrfun.v.                    *)
+(*                   rel T == the type of bool relations.                     *)
+(*                         := T -> pred T or T -> T -> bool.                  *)
+(*             simpl_rel T == type of simplifying relations.                  *)
+(*                predType == the generic predicate interface, supported for  *)
+(*                            for lists and sets.                             *)
+(*              pred_class == a coercion class for the predType projection to *)
+(*                            pred; declaring a coercion to pred_class is an  *)
+(*                            alternative way of equipping a type with a      *)
+(*                            predType structure, which interoperates better  *)
+(*                            with coercion subtyping. This is used, e.g.,    *)
+(*                            for finite sets, so that finite groups inherit  *)
+(*                            the membership operation by coercing to sets.   *)
+(* If P is a predicate the proposition "x satisfies P" can be written         *)
+(* applicatively as (P x), or using an explicit connective as (x \in P); in   *)
+(* the latter case we say that P is a "collective" predicate. We use A, B     *)
+(* rather than P, Q for collective predicates:                                *)
+(*                 x \in A == x satisfies the (collective) predicate A.       *)
+(*              x \notin A == x doesn't satisfy the (collective) predicate A. *)
+(* The pred T type can be used as a generic predicate type for either kind,   *)
+(* but the two kinds of predicates should not be confused. When a "generic"   *)
+(* pred T value of one type needs to be passed as the other the following     *)
+(* conversions should be used explicitly:                                     *)
+(*             SimplPred P == a (simplifying) applicative equivalent of P.    *)
+(*                   mem A == an applicative equivalent of A:                 *)
+(*                            mem A x simplifies to x \in A.                  *)
+(* Alternatively one can use the syntax for explicit simplifying predicates   *)
+(* and relations (in the following x is bound in E):                          *)
+(*            [pred x | E] == simplifying (see ssrfun) predicate x => E.      *)
+(*        [pred x : T | E] == predicate x => E, with a cast on the argument.  *)
+(*          [pred : T | P] == constant predicate P on type T.                 *)
+(*      [pred x | E1 & E2] == [pred x | E1 && E2]; an x : T cast is allowed.  *)
+(*           [pred x in A] == [pred x | x in A].                              *)
+(*       [pred x in A | E] == [pred x | x in A & E].                          *)
+(* [pred x in A | E1 & E2] == [pred x in A | E1 && E2].                       *)
+(*           [predU A & B] == union of two collective predicates A and B.     *)
+(*           [predI A & B] == intersection of collective predicates A and B.  *)
+(*           [predD A & B] == difference of collective predicates A and B.    *)
+(*               [predC A] == complement of the collective predicate A.       *)
+(*          [preim f of A] == preimage under f of the collective predicate A. *)
+(*          predU P Q, ... == union, etc of applicative predicates.           *)
+(*                   pred0 == the empty predicate.                            *)
+(*                   predT == the total (always true) predicate.              *)
+(*                            if T : predArgType, then T coerces to predT.    *)
+(*                   {: T} == T cast to predArgType (e.g., {: bool * nat})    *)
+(* In the following, x and y are bound in E:                                  *)
+(*           [rel x y | E] == simplifying relation x, y => E.                 *)
+(*       [rel x y : T | E] == simplifying relation with arguments cast.       *)
+(*  [rel x y in A & B | E] == [rel x y | [&& x \in A, y \in B & E]].          *)
+(*      [rel x y in A & B] == [rel x y | (x \in A) && (y \in B)].             *)
+(*      [rel x y in A | E] == [rel x y in A & A | E].                         *)
+(*          [rel x y in A] == [rel x y in A & A].                             *)
+(*                relU R S == union of relations R and S.                     *)
+(* Explicit values of type pred T (i.e., lamdba terms) should always be used  *)
+(* applicatively, while values of collection types implementing the predType  *)
+(* interface, such as sequences or sets should always be used as collective   *)
+(* predicates. Defined constants and functions of type pred T or simpl_pred T *)
+(* as well as the explicit simpl_pred T values described below, can generally *)
+(* be used either way. Note however that x \in A will not auto-simplify when  *)
+(* A is an explicit simpl_pred T value; the generic simplification rule inE   *)
+(* must be used (when A : pred T, the unfold_in rule can be used). Constants  *)
+(* of type pred T with an explicit simpl_pred value do not auto-simplify when *)
+(* used applicatively, but can still be expanded with inE. This behavior can  *)
+(* be controlled as follows:                                                  *)
+(*   Let A : collective_pred T := [pred x | ... ].                            *)
+(*     The collective_pred T type is just an alias for pred T, but this cast  *)
+(*     stops rewrite inE from expanding the definition of A, thus treating A  *)
+(*     into an abstract collection (unfold_in or in_collective can be used to *)
+(*     expand manually).                                                      *)
+(*   Let A : applicative_pred T := [pred x | ...].                            *)
+(*     This cast causes inE to turn x \in A into the applicative A x form;    *)
+(*     A will then have to unfolded explicitly with the /A rule. This will    *)
+(*     also apply to any definition that reduces to A (e.g., Let B := A).     *)
+(*   Canonical A_app_pred := ApplicativePred A.                               *)
+(*     This declaration, given after definition of A, similarly causes inE to *)
+(*     turn x \in A into A x, but in addition allows the app_predE rule to    *)
+(*     turn A x back into x \in A; it can be used for any definition of type  *)
+(*     pred T, which makes it especially useful for ambivalent predicates     *)
+(*     as the relational transitive closure connect, that are used in both    *)
+(*     applicative and collective styles.                                     *)
+(* Purely for aesthetics, we provide a subtype of collective predicates:      *)
+(*   qualifier q T == a pred T pretty-printing wrapper. An A : qualifier q T  *)
+(*                    coerces to pred_class and thus behaves as a collective  *)
+(*                    predicate, but x \in A and x \notin A are displayed as: *)
+(*             x \is A and x \isn't A when q = 0,                             *)
+(*         x \is a A and x \isn't a A when q = 1,                             *)
+(*       x \is an A and x \isn't an A when q = 2, respectively.               *)
+(*   [qualify x | P] := Qualifier 0 (fun x => P), constructor for the above.  *)
+(* [qualify x : T | P], [qualify a x | P], [qualify an X | P], etc.           *)
+(*                  variants of the above with type constraints and different *)
+(*                  values of q.                                              *)
+(* We provide an internal interface to support attaching properties (such as  *)
+(* being multiplicative) to predicates:                                       *)
+(*    pred_key p == phantom type that will serve as a support for properties  *)
+(*                  to be attached to p : pred_class; instances should be     *)
+(*                  created with Fact/Qed so as to be opaque.                 *)
+(* KeyedPred k_p == an instance of the interface structure that attaches      *)
+(*                  (k_p : pred_key P) to P; the structure projection is a    *)
+(*                  coercion to pred_class.                                   *)
+(* KeyedQualifier k_q == an instance of the interface structure that attaches *)
+(*                  (k_q : pred_key q) to (q : qualifier n T).                *)
+(* DefaultPredKey p == a default value for pred_key p; the vernacular command *)
+(*                  Import DefaultKeying attaches this key to all predicates  *)
+(*                  that are not explicitly keyed.                            *)
+(* Keys can be used to attach properties to predicates, qualifiers and        *)
+(* generic nouns in a way that allows them to be used transparently. The key  *)
+(* projection of a predicate property structure such as unsignedPred should   *)
+(* be a pred_key, not a pred, and corresponding lemmas will have the form     *)
+(*    Lemma rpredN R S (oppS : @opprPred R S) (kS : keyed_pred oppS) :        *)
+(*       {mono -%R: x / x \in kS}.                                            *)
+(* Because x \in kS will be displayed as x \in S (or x \is S, etc), the       *)
+(* canonical instance of opprPred will not normally be exposed (it will also  *)
+(* be erased by /= simplification). In addition each predicate structure      *)
+(* should have a DefaultPredKey Canonical instance that simply issues the     *)
+(* property as a proof obligation (which can be caught by the Prop-irrelevant *)
+(* feature of the ssreflect plugin).                                          *)
+(*   Some properties of predicates and relations:                             *)
+(*                  A =i B <-> A and B are extensionally equivalent.          *)
+(*         {subset A <= B} <-> A is a (collective) subpredicate of B.         *)
+(*             subpred P Q <-> P is an (applicative) subpredicate or Q.       *)
+(*              subrel R S <-> R is a subrelation of S.                       *)
+(* In the following R is in rel T:                                            *)
+(*             reflexive R <-> R is reflexive.                                *)
+(*           irreflexive R <-> R is irreflexive.                              *)
+(*             symmetric R <-> R (in rel T) is symmetric (equation).          *)
+(*         pre_symmetric R <-> R is symmetric (implication).                  *)
+(*         antisymmetric R <-> R is antisymmetric.                            *)
+(*                 total R <-> R is total.                                    *)
+(*            transitive R <-> R is transitive.                               *)
+(*       left_transitive R <-> R is a congruence on its left hand side.       *)
+(*      right_transitive R <-> R is a congruence on its right hand side.      *)
+(*       equivalence_rel R <-> R is an equivalence relation.                  *)
+(* Localization of (Prop) predicates; if P1 is convertible to forall x, Qx,   *)
+(* P2 to forall x y, Qxy and P3 to forall x y z, Qxyz :                       *)
+(*            {for y, P1} <-> Qx{y / x}.                                      *)
+(*             {in A, P1} <-> forall x, x \in A -> Qx.                        *)
+(*       {in A1 & A2, P2} <-> forall x y, x \in A1 -> y \in A2 -> Qxy.        *)
+(*           {in A &, P2} <-> forall x y, x \in A -> y \in A -> Qxy.          *)
+(*  {in A1 & A2 & A3, Q3} <-> forall x y z,                                   *)
+(*                            x \in A1 -> y \in A2 -> z \in A3 -> Qxyz.       *)
+(*     {in A1 & A2 &, Q3} == {in A1 & A2 & A2, Q3}.                           *)
+(*      {in A1 && A3, Q3} == {in A1 & A1 & A3, Q3}.                           *)
+(*          {in A &&, Q3} == {in A & A & A, Q3}.                              *)
+(*    {in A, bijective f} == f has a right inverse in A.                      *)
+(*             {on C, P1} == forall x, (f x) \in C -> Qx                      *)
+(*                           when P1 is also convertible to Pf f.             *)
+(*           {on C &, P2} == forall x y, f x \in C -> f y \in C -> Qxy        *)
+(*                           when P2 is also convertible to Pf f.             *)
+(*        {on C, P1' & g} == forall x, (f x) \in cd -> Qx                     *)
+(*                           when P1' is convertible to Pf f                  *)
+(*                           and P1' g is convertible to forall x, Qx.        *)
+(*    {on C, bijective f} == f has a right inverse on C.                      *)
+(* This file extends the lemma name suffix conventions of ssrfun as follows:  *)
+(*   A -- associativity, as in andbA : associative andb.                      *)
+(*  AC -- right commutativity.                                                *)
+(* ACA -- self-interchange (inner commutativity), e.g.,                       *)
+(*        orbACA : (a || b) || (c || d) = (a || c) || (b || d).               *)
+(*   b -- a boolean argument, as in andbb : idempotent andb.                  *)
+(*   C -- commutativity, as in andbC : commutative andb,                      *)
+(*        or predicate complement, as in predC.                               *)
+(*  CA -- left commutativity.                                                 *)
+(*   D -- predicate difference, as in predD.                                  *)
+(*   E -- elimination, as in negbFE : ~~ b = false -> b.                      *)
+(*   F or f -- boolean false, as in andbF : b && false = false.               *)
+(*   I -- left/right injectivity, as in addbI : right_injective addb,         *)
+(*        or predicate intersection, as in predI.                             *)
+(*   l -- a left-hand operation, as andb_orl : left_distributive andb orb.    *)
+(*   N or n -- boolean negation, as in andbN : a && (~~ a) = false.           *)
+(*   P -- a characteristic property, often a reflection lemma, as in          *)
+(*        andP : reflect (a /\ b) (a && b).                                   *)
+(*   r -- a right-hand operation, as orb_andr : rightt_distributive orb andb. *)
+(*   T or t -- boolean truth, as in andbT: right_id true andb.                *)
+(*   U -- predicate union, as in predU.                                       *)
+(*   W -- weakening, as in in1W : {in D, forall x, P} -> forall x, P.         *)
+(******************************************************************************)
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+Set Warnings "-projection-no-head-constant".
+
+Notation reflect := Bool.reflect.
+Notation ReflectT := Bool.ReflectT.
+Notation ReflectF := Bool.ReflectF.
+
+Reserved Notation "~~ b" (at level 35, right associativity).
+Reserved Notation "b ==> c" (at level 55, right associativity).
+Reserved Notation "b1  (+)  b2" (at level 50, left associativity).
+Reserved Notation "x \in A"
+  (at level 70, format "'[hv' x '/ '  \in  A ']'", no associativity).
+Reserved Notation "x \notin A"
+  (at level 70, format "'[hv' x '/ '  \notin  A ']'", no associativity).
+Reserved Notation "p1 =i p2"
+  (at level 70, format "'[hv' p1 '/ '  =i  p2 ']'", no associativity).
+
+(* We introduce a number of n-ary "list-style" notations that share a common  *)
+(* format, namely                                                             *)
+(*    [op arg1, arg2, ... last_separator last_arg]                            *)
+(* This usually denotes a right-associative applications of op, e.g.,         *)
+(*  [&& a, b, c & d] denotes a && (b && (c && d))                             *)
+(* The last_separator must be a non-operator token. Here we use &, | or =>;   *)
+(* our default is &, but we try to match the intended meaning of op. The      *)
+(* separator is a workaround for limitations of the parsing engine; the same  *)
+(* limitations mean the separator cannot be omitted even when last_arg can.   *)
+(*   The Notation declarations are complicated by the separate treatment for  *)
+(* some fixed arities (binary for bool operators, and all arities for Prop    *)
+(* operators).                                                                *)
+(*   We also use the square brackets in comprehension-style notations         *)
+(*    [type var separator expr]                                               *)
+(* where "type" is the type of the comprehension (e.g., pred) and "separator" *)
+(* is | or => . It is important that in other notations a leading square      *)
+(* bracket [ is always followed by an operator symbol or a fixed identifier.  *)
+
+Reserved Notation "[ /\ P1 & P2 ]" (at level 0, only parsing).
+Reserved Notation "[ /\ P1 , P2 & P3 ]" (at level 0, format
+  "'[hv' [ /\ '['  P1 , '/'  P2 ']' '/ '  &  P3 ] ']'").
+Reserved Notation "[ /\ P1 , P2 , P3 & P4 ]" (at level 0, format
+  "'[hv' [ /\ '['  P1 , '/'  P2 , '/'  P3 ']' '/ '  &  P4 ] ']'").
+Reserved Notation "[ /\ P1 , P2 , P3 , P4 & P5 ]" (at level 0, format
+  "'[hv' [ /\ '['  P1 , '/'  P2 , '/'  P3 , '/'  P4 ']' '/ '  &  P5 ] ']'").
+
+Reserved Notation "[ \/ P1 | P2 ]" (at level 0, only parsing).
+Reserved Notation "[ \/ P1 , P2 | P3 ]" (at level 0, format
+  "'[hv' [ \/ '['  P1 , '/'  P2 ']' '/ '  |  P3 ] ']'").
+Reserved Notation "[ \/ P1 , P2 , P3 | P4 ]" (at level 0, format
+  "'[hv' [ \/ '['  P1 , '/'  P2 , '/'  P3 ']' '/ '  |  P4 ] ']'").
+
+Reserved Notation "[ && b1 & c ]" (at level 0, only parsing).
+Reserved Notation "[ && b1 , b2 , .. , bn & c ]" (at level 0, format
+  "'[hv' [ && '['  b1 , '/'  b2 , '/'  .. , '/'  bn ']' '/ '  &  c ] ']'").
+
+Reserved Notation "[ || b1 | c ]" (at level 0, only parsing).
+Reserved Notation "[ || b1 , b2 , .. , bn | c ]" (at level 0, format
+  "'[hv' [ || '['  b1 , '/'  b2 , '/'  .. , '/'  bn ']' '/ '  |  c ] ']'").
+
+Reserved Notation "[ ==> b1 => c ]" (at level 0, only parsing).
+Reserved Notation "[ ==> b1 , b2 , .. , bn => c ]" (at level 0, format
+  "'[hv' [ ==> '['  b1 , '/'  b2 , '/'  .. , '/'  bn ']' '/'  =>  c ] ']'").
+
+Reserved Notation "[ 'pred' : T => E ]" (at level 0, format
+  "'[hv' [ 'pred' :  T  => '/ '  E ] ']'").
+Reserved Notation "[ 'pred' x => E ]" (at level 0, x at level 8, format
+  "'[hv' [ 'pred'  x  => '/ '  E ] ']'").
+Reserved Notation "[ 'pred' x : T => E ]" (at level 0, x at level 8, format
+  "'[hv' [ 'pred'  x  :  T  => '/ '  E ] ']'").
+
+Reserved Notation "[ 'rel' x y => E ]" (at level 0, x, y at level 8, format
+  "'[hv' [ 'rel'  x   y  => '/ '  E ] ']'").
+Reserved Notation "[ 'rel' x y : T => E ]" (at level 0, x, y at level 8, format
+  "'[hv' [ 'rel'  x  y :  T  => '/ '  E ] ']'").
+
+(* Shorter delimiter *)
+Delimit Scope bool_scope with B.
+Open Scope bool_scope.
+
+(* An alternative to xorb that behaves somewhat better wrt simplification.    *)
+Definition addb b := if b then negb else id.
+
+(* Notation for && and || is declared in Init.Datatypes. *)
+Notation "~~ b" := (negb b) : bool_scope.
+Notation "b ==> c" := (implb b c) : bool_scope.
+Notation "b1 (+) b2" := (addb b1 b2) : bool_scope.
+
+(* Constant is_true b := b = true is defined in Init.Datatypes. *)
+Coercion is_true : bool >-> Sortclass. (* Prop *)
+
+Lemma prop_congr : forall b b' : bool, b = b' -> b = b' :> Prop.
+Proof. by move=> b b' ->. Qed.
+
+Ltac prop_congr := apply: prop_congr.
+
+(* Lemmas for trivial. *)
+Lemma is_true_true : true.               Proof. by []. Qed.
+Lemma not_false_is_true : ~ false.       Proof. by []. Qed.
+Lemma is_true_locked_true : locked true. Proof. by unlock. Qed.
+Hint Resolve is_true_true not_false_is_true is_true_locked_true.
+
+(* Shorter names. *)
+Definition isT := is_true_true.
+Definition notF := not_false_is_true.
+
+(* Negation lemmas. *)
+
+(* We generally take NEGATION as the standard form of a false condition:      *)
+(* negative boolean hypotheses should be of the form ~~ b, rather than ~ b or *)
+(* b = false, as much as possible.                                            *)
+
+Lemma negbT b : b = false -> ~~ b.          Proof. by case: b. Qed.
+Lemma negbTE b : ~~ b -> b = false.         Proof. by case: b. Qed.
+Lemma negbF b : (b : bool) -> ~~ b = false. Proof. by case: b. Qed.
+Lemma negbFE b : ~~ b = false -> b.         Proof. by case: b. Qed.
+Lemma negbK : involutive negb.              Proof. by case. Qed.
+Lemma negbNE b : ~~ ~~ b -> b.              Proof. by case: b. Qed.
+
+Lemma negb_inj : injective negb. Proof. exact: can_inj negbK. Qed.
+Lemma negbLR b c : b = ~~ c -> ~~ b = c. Proof. exact: canLR negbK. Qed.
+Lemma negbRL b c : ~~ b = c -> b = ~~ c. Proof. exact: canRL negbK. Qed.
+
+Lemma contra (c b : bool) : (c -> b) -> ~~ b -> ~~ c.
+Proof. by case: b => //; case: c. Qed.
+Definition contraNN := contra.
+
+Lemma contraL (c b : bool) : (c -> ~~ b) -> b -> ~~ c.
+Proof. by case: b => //; case: c. Qed.
+Definition contraTN := contraL.
+
+Lemma contraR (c b : bool) : (~~ c -> b) -> ~~ b -> c.
+Proof. by case: b => //; case: c. Qed.
+Definition contraNT := contraR.
+
+Lemma contraLR (c b : bool) : (~~ c -> ~~ b) -> b -> c.
+Proof. by case: b => //; case: c. Qed.
+Definition contraTT := contraLR.
+
+Lemma contraT b : (~~ b -> false) -> b. Proof. by case: b => // ->. Qed.
+
+Lemma wlog_neg b : (~~ b -> b) -> b. Proof. by case: b => // ->. Qed.
+
+Lemma contraFT (c b : bool) : (~~ c -> b) -> b = false -> c.
+Proof. by move/contraR=> notb_c /negbT. Qed.
+
+Lemma contraFN (c b : bool) : (c -> b) -> b = false -> ~~ c.
+Proof. by move/contra=> notb_notc /negbT. Qed.
+
+Lemma contraTF (c b : bool) : (c -> ~~ b) -> b -> c = false.
+Proof. by move/contraL=> b_notc /b_notc/negbTE. Qed.
+
+Lemma contraNF (c b : bool) : (c -> b) -> ~~ b -> c = false.
+Proof. by move/contra=> notb_notc /notb_notc/negbTE. Qed.
+
+Lemma contraFF (c b : bool) : (c -> b) -> b = false -> c = false.
+Proof. by move/contraFN=> bF_notc /bF_notc/negbTE. Qed.
+
+(* Coercion of sum-style datatypes into bool, which makes it possible *)
+(* to use ssr's boolean if rather than Coq's "generic" if.            *)
+
+Coercion isSome T (u : option T) := if u is Some _ then true else false.
+
+Coercion is_inl A B (u : A + B) := if u is inl _ then true else false.
+
+Coercion is_left A B (u : {A} + {B}) := if u is left _ then true else false.
+
+Coercion is_inleft A B (u : A + {B}) := if u is inleft _ then true else false.
+
+Prenex Implicits  isSome is_inl is_left is_inleft.
+
+Definition decidable P := {P} + {~ P}.
+
+(* Lemmas for ifs with large conditions, which allow reasoning about the  *)
+(* condition without repeating it inside the proof (the latter IS         *)
+(* preferable when the condition is short).                               *)
+(* Usage :                                                                *)
+(*   if the goal contains (if cond then ...) = ...                        *)
+(*     case: ifP => Hcond.                                                *)
+(*   generates two subgoal, with the assumption Hcond : cond = true/false *)
+(*     Rewrite if_same  eliminates redundant ifs                          *)
+(*     Rewrite (fun_if f) moves a function f inside an if                 *)
+(*     Rewrite if_arg moves an argument inside a function-valued if       *)
+
+Section BoolIf.
+
+Variables (A B : Type) (x : A) (f : A -> B) (b : bool) (vT vF : A).
+
+CoInductive if_spec (not_b : Prop) : bool -> A -> Set :=
+  | IfSpecTrue  of      b : if_spec not_b true vT
+  | IfSpecFalse of  not_b : if_spec not_b false vF.
+
+Lemma ifP : if_spec (b = false) b (if b then vT else vF).
+Proof. by case def_b: b; constructor. Qed.
+
+Lemma ifPn : if_spec (~~ b) b (if b then vT else vF).
+Proof. by case def_b: b; constructor; rewrite ?def_b. Qed.
+
+Lemma ifT : b -> (if b then vT else vF) = vT. Proof. by move->. Qed.
+Lemma ifF : b = false -> (if b then vT else vF) = vF. Proof. by move->. Qed.
+Lemma ifN : ~~ b -> (if b then vT else vF) = vF. Proof. by move/negbTE->. Qed.
+
+Lemma if_same : (if b then vT else vT) = vT.
+Proof. by case b. Qed.
+
+Lemma if_neg : (if ~~ b then vT else vF) = if b then vF else vT.
+Proof. by case b. Qed.
+
+Lemma fun_if : f (if b then vT else vF) = if b then f vT else f vF.
+Proof. by case b. Qed.
+
+Lemma if_arg (fT fF : A -> B) :
+  (if b then fT else fF) x = if b then fT x else fF x.
+Proof. by case b. Qed.
+
+(* Turning a boolean "if" form into an application.                           *)
+Definition if_expr := if b then vT else vF.
+Lemma ifE : (if b then vT else vF) = if_expr. Proof. by []. Qed.
+
+End BoolIf.
+
+(* Core (internal) reflection lemmas, used for the three kinds of views. *)
+
+Section ReflectCore.
+
+Variables (P Q : Prop) (b c : bool).
+
+Hypothesis Hb : reflect P b.
+
+Lemma introNTF : (if c then ~ P else P) -> ~~ b = c.
+Proof. by case c; case Hb. Qed.
+
+Lemma introTF : (if c then P else ~ P) -> b = c.
+Proof. by case c; case Hb. Qed.
+
+Lemma elimNTF : ~~ b = c -> if c then ~ P else P.
+Proof. by move <-; case Hb. Qed.
+
+Lemma elimTF : b = c -> if c then P else ~ P.
+Proof. by move <-; case Hb. Qed.
+
+Lemma equivPif : (Q -> P) -> (P -> Q) -> if b then Q else ~ Q.
+Proof. by case Hb; auto. Qed.
+
+Lemma xorPif : Q \/ P -> ~ (Q /\ P) -> if b then ~ Q else Q.
+Proof. by case Hb => [? _ H ? | ? H _]; case: H. Qed.
+
+End ReflectCore.
+
+(* Internal negated reflection lemmas *)
+Section ReflectNegCore.
+
+Variables (P Q : Prop) (b c : bool).
+Hypothesis Hb : reflect P (~~ b).
+
+Lemma introTFn : (if c then ~ P else P) -> b = c.
+Proof. by move/(introNTF Hb) <-; case b. Qed.
+
+Lemma elimTFn : b = c -> if c then ~ P else P.
+Proof. by move <-; apply: (elimNTF Hb); case b. Qed.
+
+Lemma equivPifn : (Q -> P) -> (P -> Q) -> if b then ~ Q else Q.
+Proof. by rewrite -if_neg; apply: equivPif. Qed.
+
+Lemma xorPifn : Q \/ P -> ~ (Q /\ P) -> if b then Q else ~ Q.
+Proof. by rewrite -if_neg; apply: xorPif. Qed.
+
+End ReflectNegCore.
+
+(* User-oriented reflection lemmas *)
+Section Reflect.
+
+Variables (P Q : Prop) (b b' c : bool).
+Hypotheses (Pb : reflect P b) (Pb' : reflect P (~~ b')).
+
+Lemma introT  : P -> b.            Proof. exact: introTF true _. Qed.
+Lemma introF  : ~ P -> b = false.  Proof. exact: introTF false _. Qed.
+Lemma introN  : ~ P -> ~~ b.       Proof. exact: introNTF true _. Qed.
+Lemma introNf : P -> ~~ b = false. Proof. exact: introNTF false _. Qed.
+Lemma introTn : ~ P -> b'.         Proof. exact: introTFn true _. Qed.
+Lemma introFn : P -> b' = false.   Proof. exact: introTFn false _. Qed.
+
+Lemma elimT  : b -> P.             Proof. exact: elimTF true _. Qed.
+Lemma elimF  : b = false -> ~ P.   Proof. exact: elimTF false _. Qed.
+Lemma elimN  : ~~ b -> ~P.         Proof. exact: elimNTF true _. Qed.
+Lemma elimNf : ~~ b = false -> P.  Proof. exact: elimNTF false _. Qed.
+Lemma elimTn : b' -> ~ P.          Proof. exact: elimTFn true _. Qed.
+Lemma elimFn : b' = false -> P.    Proof. exact: elimTFn false _. Qed.
+
+Lemma introP : (b -> Q) -> (~~ b -> ~ Q) -> reflect Q b.
+Proof. by case b; constructor; auto. Qed.
+
+Lemma iffP : (P -> Q) -> (Q -> P) -> reflect Q b.
+Proof. by case: Pb; constructor; auto. Qed.
+
+Lemma equivP : (P <-> Q) -> reflect Q b.
+Proof. by case; apply: iffP. Qed.
+
+Lemma sumboolP (decQ : decidable Q) : reflect Q decQ.
+Proof. by case: decQ; constructor. Qed.
+
+Lemma appP : reflect Q b -> P -> Q.
+Proof. by move=> Qb; move/introT; case: Qb. Qed.
+
+Lemma sameP : reflect P c -> b = c.
+Proof. by case; [apply: introT | apply: introF]. Qed.
+
+Lemma decPcases : if b then P else ~ P. Proof. by case Pb. Qed.
+
+Definition decP : decidable P. by case: b decPcases; [left | right]. Defined.
+
+Lemma rwP : P <-> b. Proof. by split; [apply: introT | apply: elimT]. Qed.
+
+Lemma rwP2 : reflect Q b -> (P <-> Q).
+Proof. by move=> Qb; split=> ?; [apply: appP | apply: elimT; case: Qb]. Qed.
+
+(*  Predicate family to reflect excluded middle in bool.                      *)
+CoInductive alt_spec : bool -> Type :=
+  | AltTrue of     P : alt_spec true
+  | AltFalse of ~~ b : alt_spec false.
+
+Lemma altP : alt_spec b.
+Proof. by case def_b: b / Pb; constructor; rewrite ?def_b. Qed.
+
+End Reflect.
+
+Hint View for move/ elimTF|3 elimNTF|3 elimTFn|3 introT|2 introTn|2 introN|2.
+
+Hint View for apply/ introTF|3 introNTF|3 introTFn|3 elimT|2 elimTn|2 elimN|2.
+
+Hint View for apply// equivPif|3 xorPif|3 equivPifn|3 xorPifn|3.
+
+(* Allow the direct application of a reflection lemma to a boolean assertion. *)
+Coercion elimT : reflect >-> Funclass.
+
+CoInductive implies P Q := Implies of P -> Q.
+Lemma impliesP P Q : implies P Q -> P -> Q. Proof. by case. Qed.
+Lemma impliesPn (P Q : Prop) : implies P Q -> ~ Q -> ~ P.
+Proof. by case=> iP ? /iP. Qed.
+Coercion impliesP : implies >-> Funclass.
+Hint View for move/ impliesPn|2 impliesP|2.
+Hint View for apply/ impliesPn|2 impliesP|2.
+
+(* Impredicative or, which can emulate a classical not-implies. *)
+Definition unless condition property : Prop :=
+ forall goal : Prop, (condition -> goal) -> (property -> goal) -> goal.
+
+Notation "\unless C , P" := (unless C P)
+  (at level 200, C at level 100,
+   format "'[' \unless  C , '/ '  P ']'") : type_scope.
+
+Lemma unlessL C P : implies C (\unless C, P).
+Proof. by split=> hC G /(_ hC). Qed.
+
+Lemma unlessR C P : implies P (\unless C, P).
+Proof. by split=> hP G _ /(_ hP). Qed.
+
+Lemma unless_sym C P : implies (\unless C, P) (\unless P, C).
+Proof. by split; apply; [apply/unlessR | apply/unlessL]. Qed.
+
+Lemma unlessP (C P : Prop) : (\unless C, P) <-> C \/ P.
+Proof. by split=> [|[/unlessL | /unlessR]]; apply; [left | right]. Qed.
+
+Lemma bind_unless C P {Q} : implies (\unless C, P) (\unless (\unless C, Q), P).
+Proof. by split; apply=> [hC|hP]; [apply/unlessL/unlessL | apply/unlessR]. Qed.
+
+Lemma unless_contra b C : implies (~~ b -> C) (\unless C, b).
+Proof. by split; case: b => [_ | hC]; [apply/unlessR | apply/unlessL/hC]. Qed.
+
+(* Classical reasoning becomes directly accessible for any bool subgoal.      *)
+(* Note that we cannot use "unless" here for lack of universe polymorphism.   *)
+Definition classically P : Prop := forall b : bool, (P -> b) -> b.
+
+Lemma classicP (P : Prop) : classically P <-> ~ ~ P.
+Proof.
+split=> [cP nP | nnP [] // nP]; last by case nnP; move/nP.
+by have: P -> false; [move/nP | move/cP].
+Qed.
+
+Lemma classicW P : P -> classically P. Proof. by move=> hP _ ->. Qed.
+
+Lemma classic_bind P Q : (P -> classically Q) -> classically P -> classically Q.
+Proof. by move=> iPQ cP b /iPQ-/cP. Qed.
+
+Lemma classic_EM P : classically (decidable P).
+Proof.
+by case=> // undecP; apply/undecP; right=> notP; apply/notF/undecP; left.
+Qed.
+
+Lemma classic_pick T P : classically ({x : T | P x} + (forall x, ~ P x)).
+Proof.
+case=> // undecP; apply/undecP; right=> x Px.
+by apply/notF/undecP; left; exists x.
+Qed.
+
+Lemma classic_imply P Q : (P -> classically Q) -> classically (P -> Q).
+Proof.
+move=> iPQ []// notPQ; apply/notPQ=> /iPQ-cQ.
+by case: notF; apply: cQ => hQ; apply: notPQ.
+Qed.
+
+(* List notations for wider connectives; the Prop connectives have a fixed    *)
+(* width so as to avoid iterated destruction (we go up to width 5 for /\, and *)
+(* width 4 for or). The bool connectives have arbitrary widths, but denote    *)
+(* expressions that associate to the RIGHT. This is consistent with the right *)
+(* associativity of list expressions and thus more convenient in most proofs. *)
+
+Inductive and3 (P1 P2 P3 : Prop) : Prop := And3 of P1 & P2 & P3.
+
+Inductive and4 (P1 P2 P3 P4 : Prop) : Prop := And4 of P1 & P2 & P3 & P4.
+
+Inductive and5 (P1 P2 P3 P4 P5 : Prop) : Prop :=
+  And5 of P1 & P2 & P3 & P4 & P5.
+
+Inductive or3 (P1 P2 P3 : Prop) : Prop := Or31 of P1 | Or32 of P2 | Or33 of P3.
+
+Inductive or4 (P1 P2 P3 P4 : Prop) : Prop :=
+  Or41 of P1 | Or42 of P2 | Or43 of P3 | Or44 of P4.
+
+Notation "[ /\ P1 & P2 ]" := (and P1 P2) (only parsing) : type_scope.
+Notation "[ /\ P1 , P2 & P3 ]" := (and3 P1 P2 P3) : type_scope.
+Notation "[ /\ P1 , P2 , P3 & P4 ]" := (and4 P1 P2 P3 P4) : type_scope.
+Notation "[ /\ P1 , P2 , P3 , P4 & P5 ]" := (and5 P1 P2 P3 P4 P5) : type_scope.
+
+Notation "[ \/ P1 | P2 ]" := (or P1 P2) (only parsing) : type_scope.
+Notation "[ \/ P1 , P2 | P3 ]" := (or3 P1 P2 P3) : type_scope.
+Notation "[ \/ P1 , P2 , P3 | P4 ]" := (or4 P1 P2 P3 P4) : type_scope.
+
+Notation "[ && b1 & c ]" := (b1 && c) (only parsing) : bool_scope.
+Notation "[ && b1 , b2 , .. , bn & c ]" := (b1 && (b2 && .. (bn && c) .. ))
+  : bool_scope.
+
+Notation "[ || b1 | c ]" := (b1 || c) (only parsing) : bool_scope.
+Notation "[ || b1 , b2 , .. , bn | c ]" := (b1 || (b2 || .. (bn || c) .. ))
+  : bool_scope.
+
+Notation "[ ==> b1 , b2 , .. , bn => c ]" :=
+   (b1 ==> (b2 ==> .. (bn ==> c) .. )) : bool_scope.
+Notation "[ ==> b1 => c ]" := (b1 ==> c) (only parsing) : bool_scope.
+
+Section AllAnd.
+
+Variables (T : Type) (P1 P2 P3 P4 P5 : T -> Prop).
+Local Notation a P := (forall x, P x).
+
+Lemma all_and2 : implies (forall x, [/\ P1 x & P2 x]) [/\ a P1 & a P2].
+Proof. by split=> haveP; split=> x; case: (haveP x). Qed.
+
+Lemma all_and3 : implies (forall x, [/\ P1 x, P2 x & P3 x])
+                         [/\ a P1, a P2 & a P3].
+Proof. by split=> haveP; split=> x; case: (haveP x). Qed.
+
+Lemma all_and4 : implies (forall x, [/\ P1 x, P2 x, P3 x & P4 x])
+                         [/\ a P1, a P2, a P3 & a P4].
+Proof. by split=> haveP; split=> x; case: (haveP x). Qed.
+
+Lemma all_and5 : implies (forall x, [/\ P1 x, P2 x, P3 x, P4 x & P5 x])
+                         [/\ a P1, a P2, a P3, a P4 & a P5].
+Proof. by split=> haveP; split=> x; case: (haveP x). Qed.
+
+End AllAnd.
+
+Arguments all_and2 {T P1 P2}.
+Arguments all_and3 {T P1 P2 P3}.
+Arguments all_and4 {T P1 P2 P3 P4}.
+Arguments all_and5 {T P1 P2 P3 P4 P5}.
+
+Lemma pair_andP P Q : P /\ Q <-> P * Q. Proof. by split; case. Qed.
+
+Section ReflectConnectives.
+
+Variable b1 b2 b3 b4 b5 : bool.
+
+Lemma idP : reflect b1 b1.
+Proof. by case b1; constructor. Qed.
+
+Lemma boolP : alt_spec b1 b1 b1.
+Proof. exact: (altP idP). Qed.
+
+Lemma idPn : reflect (~~ b1) (~~ b1).
+Proof. by case b1; constructor. Qed.
+
+Lemma negP : reflect (~ b1) (~~ b1).
+Proof. by case b1; constructor; auto. Qed.
+
+Lemma negPn : reflect b1 (~~ ~~ b1).
+Proof. by case b1; constructor. Qed.
+
+Lemma negPf : reflect (b1 = false) (~~ b1).
+Proof. by case b1; constructor. Qed.
+
+Lemma andP : reflect (b1 /\ b2) (b1 && b2).
+Proof. by case b1; case b2; constructor=> //; case. Qed.
+
+Lemma and3P : reflect [/\ b1, b2 & b3] [&& b1, b2 & b3].
+Proof. by case b1; case b2; case b3; constructor; try by case. Qed.
+
+Lemma and4P : reflect [/\ b1, b2, b3 & b4] [&& b1, b2, b3 & b4].
+Proof. by case b1; case b2; case b3; case b4; constructor; try by case. Qed.
+
+Lemma and5P : reflect [/\ b1, b2, b3, b4 & b5] [&& b1, b2, b3, b4 & b5].
+Proof.
+by case b1; case b2; case b3; case b4; case b5; constructor; try by case.
+Qed.
+
+Lemma orP : reflect (b1 \/ b2) (b1 || b2).
+Proof. by case b1; case b2; constructor; auto; case. Qed.
+
+Lemma or3P : reflect [\/ b1, b2 | b3] [|| b1, b2 | b3].
+Proof.
+case b1; first by constructor; constructor 1.
+case b2; first by constructor; constructor 2.
+case b3; first by constructor; constructor 3.
+by constructor; case.
+Qed.
+
+Lemma or4P : reflect [\/ b1, b2, b3 | b4] [|| b1, b2, b3 | b4].
+Proof.
+case b1; first by constructor; constructor 1.
+case b2; first by constructor; constructor 2.
+case b3; first by constructor; constructor 3.
+case b4; first by constructor; constructor 4.
+by constructor; case.
+Qed.
+
+Lemma nandP : reflect (~~ b1 \/ ~~ b2) (~~ (b1 && b2)).
+Proof. by case b1; case b2; constructor; auto; case; auto. Qed.
+
+Lemma norP : reflect (~~ b1 /\ ~~ b2) (~~ (b1 || b2)).
+Proof. by case b1; case b2; constructor; auto; case; auto. Qed.
+
+Lemma implyP : reflect (b1 -> b2) (b1 ==> b2).
+Proof. by case b1; case b2; constructor; auto. Qed.
+
+End ReflectConnectives.
+
+Arguments idP [b1].
+Arguments idPn [b1].
+Arguments negP [b1].
+Arguments negPn [b1].
+Arguments negPf [b1].
+Arguments andP [b1 b2].
+Arguments and3P [b1 b2 b3].
+Arguments and4P [b1 b2 b3 b4].
+Arguments and5P [b1 b2 b3 b4 b5].
+Arguments orP [b1 b2].
+Arguments or3P [b1 b2 b3].
+Arguments or4P [b1 b2 b3 b4].
+Arguments nandP [b1 b2].
+Arguments norP [b1 b2].
+Arguments implyP [b1 b2].
+Prenex Implicits idP idPn negP negPn negPf.
+Prenex Implicits andP and3P and4P and5P orP or3P or4P nandP norP implyP.
+
+(* Shorter, more systematic names for the boolean connectives laws.       *)
+
+Lemma andTb : left_id true andb.       Proof. by []. Qed.
+Lemma andFb : left_zero false andb.    Proof. by []. Qed.
+Lemma andbT : right_id true andb.      Proof. by case. Qed.
+Lemma andbF : right_zero false andb.   Proof. by case. Qed.
+Lemma andbb : idempotent andb.         Proof. by case. Qed.
+Lemma andbC : commutative andb.        Proof. by do 2!case. Qed.
+Lemma andbA : associative andb.        Proof. by do 3!case. Qed.
+Lemma andbCA : left_commutative andb.  Proof. by do 3!case. Qed.
+Lemma andbAC : right_commutative andb. Proof. by do 3!case. Qed.
+Lemma andbACA : interchange andb andb. Proof. by do 4!case. Qed.
+
+Lemma orTb : forall b, true || b.      Proof. by []. Qed.
+Lemma orFb : left_id false orb.        Proof. by []. Qed.
+Lemma orbT : forall b, b || true.      Proof. by case. Qed.
+Lemma orbF : right_id false orb.       Proof. by case. Qed.
+Lemma orbb : idempotent orb.           Proof. by case. Qed.
+Lemma orbC : commutative orb.          Proof. by do 2!case. Qed.
+Lemma orbA : associative orb.          Proof. by do 3!case. Qed.
+Lemma orbCA : left_commutative orb.    Proof. by do 3!case. Qed.
+Lemma orbAC : right_commutative orb.   Proof. by do 3!case. Qed.
+Lemma orbACA : interchange orb orb.    Proof. by do 4!case. Qed.
+
+Lemma andbN b : b && ~~ b = false. Proof. by case: b. Qed.
+Lemma andNb b : ~~ b && b = false. Proof. by case: b. Qed.
+Lemma orbN b : b || ~~ b = true.   Proof. by case: b. Qed.
+Lemma orNb b : ~~ b || b = true.   Proof. by case: b. Qed.
+
+Lemma andb_orl : left_distributive andb orb.  Proof. by do 3!case. Qed.
+Lemma andb_orr : right_distributive andb orb. Proof. by do 3!case. Qed.
+Lemma orb_andl : left_distributive orb andb.  Proof. by do 3!case. Qed.
+Lemma orb_andr : right_distributive orb andb. Proof. by do 3!case. Qed.
+
+Lemma andb_idl (a b : bool) : (b -> a) -> a && b = b.
+Proof. by case: a; case: b => // ->. Qed.
+Lemma andb_idr (a b : bool) : (a -> b) -> a && b = a.
+Proof. by case: a; case: b => // ->. Qed.
+Lemma andb_id2l (a b c : bool) : (a -> b = c) -> a && b = a && c.
+Proof. by case: a; case: b; case: c => // ->. Qed.
+Lemma andb_id2r (a b c : bool) : (b -> a = c) -> a && b = c && b.
+Proof. by case: a; case: b; case: c => // ->. Qed.
+
+Lemma orb_idl (a b : bool) : (a -> b) -> a || b = b.
+Proof. by case: a; case: b => // ->. Qed.
+Lemma orb_idr (a b : bool) : (b -> a) -> a || b = a.
+Proof. by case: a; case: b => // ->. Qed.
+Lemma orb_id2l (a b c : bool) : (~~ a -> b = c) -> a || b = a || c.
+Proof. by case: a; case: b; case: c => // ->. Qed.
+Lemma orb_id2r (a b c : bool) : (~~ b -> a = c) -> a || b = c || b.
+Proof. by case: a; case: b; case: c => // ->. Qed.
+
+Lemma negb_and (a b : bool) : ~~ (a && b) = ~~ a || ~~ b.
+Proof. by case: a; case: b. Qed.
+
+Lemma negb_or (a b : bool) : ~~ (a || b) = ~~ a && ~~ b.
+Proof. by case: a; case: b. Qed.
+
+(* Pseudo-cancellation -- i.e, absorbtion *)
+
+Lemma andbK a b : a && b || a = a.  Proof. by case: a; case: b. Qed.
+Lemma andKb a b : a || b && a = a.  Proof. by case: a; case: b. Qed.
+Lemma orbK a b : (a || b) && a = a. Proof. by case: a; case: b. Qed.
+Lemma orKb a b : a && (b || a) = a. Proof. by case: a; case: b. Qed.
+
+(* Imply *)
+
+Lemma implybT b : b ==> true.           Proof. by case: b. Qed.
+Lemma implybF b : (b ==> false) = ~~ b. Proof. by case: b. Qed.
+Lemma implyFb b : false ==> b.          Proof. by []. Qed.
+Lemma implyTb b : (true ==> b) = b.     Proof. by []. Qed.
+Lemma implybb b : b ==> b.              Proof. by case: b. Qed.
+
+Lemma negb_imply a b : ~~ (a ==> b) = a && ~~ b.
+Proof. by case: a; case: b. Qed.
+
+Lemma implybE a b : (a ==> b) = ~~ a || b.
+Proof. by case: a; case: b. Qed.
+
+Lemma implyNb a b : (~~ a ==> b) = a || b.
+Proof. by case: a; case: b. Qed.
+
+Lemma implybN a b : (a ==> ~~ b) = (b ==> ~~ a).
+Proof. by case: a; case: b. Qed.
+
+Lemma implybNN a b : (~~ a ==> ~~ b) = b ==> a.
+Proof. by case: a; case: b. Qed.
+
+Lemma implyb_idl (a b : bool) : (~~ a -> b) -> (a ==> b) = b.
+Proof. by case: a; case: b => // ->. Qed.
+Lemma implyb_idr (a b : bool) : (b -> ~~ a) -> (a ==> b) = ~~ a.
+Proof. by case: a; case: b => // ->. Qed.
+Lemma implyb_id2l (a b c : bool) : (a -> b = c) -> (a ==> b) = (a ==> c).
+Proof. by case: a; case: b; case: c => // ->. Qed.
+
+(* Addition (xor) *)
+
+Lemma addFb : left_id false addb.               Proof. by []. Qed.
+Lemma addbF : right_id false addb.              Proof. by case. Qed.
+Lemma addbb : self_inverse false addb.          Proof. by case. Qed.
+Lemma addbC : commutative addb.                 Proof. by do 2!case. Qed.
+Lemma addbA : associative addb.                 Proof. by do 3!case. Qed.
+Lemma addbCA : left_commutative addb.           Proof. by do 3!case. Qed.
+Lemma addbAC : right_commutative addb.          Proof. by do 3!case. Qed.
+Lemma addbACA : interchange addb addb.          Proof. by do 4!case. Qed.
+Lemma andb_addl : left_distributive andb addb.  Proof. by do 3!case. Qed.
+Lemma andb_addr : right_distributive andb addb. Proof. by do 3!case. Qed.
+Lemma addKb : left_loop id addb.                Proof. by do 2!case. Qed.
+Lemma addbK : right_loop id addb.               Proof. by do 2!case. Qed.
+Lemma addIb : left_injective addb.              Proof. by do 3!case. Qed.
+Lemma addbI : right_injective addb.             Proof. by do 3!case. Qed.
+
+Lemma addTb b : true (+) b = ~~ b. Proof. by []. Qed.
+Lemma addbT b : b (+) true = ~~ b. Proof. by case: b. Qed.
+
+Lemma addbN a b : a (+) ~~ b = ~~ (a (+) b).
+Proof. by case: a; case: b. Qed.
+Lemma addNb a b : ~~ a (+) b = ~~ (a (+) b).
+Proof. by case: a; case: b. Qed.
+
+Lemma addbP a b : reflect (~~ a = b) (a (+) b).
+Proof. by case: a; case: b; constructor. Qed.
+Arguments addbP [a b].
+
+(* Resolution tactic for blindly weeding out common terms from boolean       *)
+(* equalities. When faced with a goal of the form (andb/orb/addb b1 b2) = b3 *)
+(* they will try to locate b1 in b3 and remove it. This can fail!            *)
+
+Ltac bool_congr :=
+  match goal with
+  | |- (?X1 && ?X2 = ?X3) => first
+  [ symmetry; rewrite -1?(andbC X1) -?(andbCA X1); congr 1 (andb X1); symmetry
+  | case: (X1); [ rewrite ?andTb ?andbT // | by rewrite ?andbF /= ] ]
+  | |- (?X1 || ?X2 = ?X3) => first
+  [ symmetry; rewrite -1?(orbC X1) -?(orbCA X1); congr 1 (orb X1); symmetry
+  | case: (X1); [ by rewrite ?orbT //= | rewrite ?orFb ?orbF ] ]
+  | |- (?X1 (+) ?X2 = ?X3) =>
+    symmetry; rewrite -1?(addbC X1) -?(addbCA X1); congr 1 (addb X1); symmetry
+  | |- (~~ ?X1 = ?X2) => congr 1 negb
+  end.
+
+(******************************************************************************)
+(* Predicates, i.e., packaged functions to bool.                              *)
+(* - pred T, the basic type for predicates over a type T, is simply an alias  *)
+(* for T -> bool.                                                             *)
+(* We actually distinguish two kinds of predicates, which we call applicative *)
+(* and collective, based on the syntax used to test them at some x in T:      *)
+(* - For an applicative predicate P, one uses prefix syntax:                  *)
+(*     P x                                                                    *)
+(*   Also, most operations on applicative predicates use prefix syntax as     *)
+(*   well (e.g., predI P Q).                                                  *)
+(* - For a collective predicate A, one uses infix syntax:                     *)
+(*     x \in A                                                                *)
+(*   and all operations on collective predicates use infix syntax as well     *)
+(*   (e.g., [predI A & B]).                                                   *)
+(* There are only two kinds of applicative predicates:                        *)
+(* - pred T, the alias for T -> bool mentioned above                          *)
+(* - simpl_pred T, an alias for simpl_fun T bool with a coercion to pred T    *)
+(*   that auto-simplifies on application (see ssrfun).                        *)
+(* On the other hand, the set of collective predicate types is open-ended via *)
+(* - predType T, a Structure that can be used to put Canonical collective     *)
+(*   predicate interpretation on other types, such as lists, tuples,          *)
+(*   finite sets, etc.                                                        *)
+(* Indeed, we define such interpretations for applicative predicate types,    *)
+(* which can therefore also be used with the infix syntax, e.g.,              *)
+(*     x \in predI P Q                                                        *)
+(* Moreover these infix forms are convertible to their prefix counterpart     *)
+(* (e.g., predI P Q x which in turn simplifies to P x && Q x). The converse   *)
+(* is not true, however; collective predicate types cannot, in general, be    *)
+(* general, be used applicatively, because of the "uniform inheritance"       *)
+(* restriction on implicit coercions.                                         *)
+(*   However, we do define an explicit generic coercion                       *)
+(* - mem : forall (pT : predType), pT -> mem_pred T                           *)
+(*   where mem_pred T is a variant of simpl_pred T that preserves the infix   *)
+(*   syntax, i.e., mem A x auto-simplifies to x \in A.                        *)
+(* Indeed, the infix "collective" operators are notation for a prefix         *)
+(* operator with arguments of type mem_pred T or pred T, applied to coerced   *)
+(* collective predicates, e.g.,                                               *)
+(*      Notation "x \in A" := (in_mem x (mem A)).                             *)
+(* This prevents the variability in the predicate type from interfering with  *)
+(* the application of generic lemmas. Moreover this also makes it much easier *)
+(* to define generic lemmas, because the simplest type -- pred T -- can be    *)
+(* used as the type of generic collective predicates, provided one takes care *)
+(* not to use it applicatively; this avoids the burden of having to declare a *)
+(* different predicate type for each predicate parameter of each section or   *)
+(* lemma.                                                                     *)
+(*   This trick is made possible by the fact that the constructor of the      *)
+(* mem_pred T type aligns the unification process, forcing a generic          *)
+(* "collective" predicate A : pred T to unify with the actual collective B,   *)
+(* which mem has coerced to pred T via an internal, hidden implicit coercion, *)
+(* supplied by the predType structure for B. Users should take care not to    *)
+(* inadvertently "strip" (mem B) down to the coerced B, since this will       *)
+(* expose the internal coercion: Coq will display a term B x that cannot be   *)
+(* typed as such. The topredE lemma can be used to restore the x \in B        *)
+(* syntax in this case. While -topredE can conversely be used to change       *)
+(* x \in P into P x, it is safer to use the inE and memE lemmas instead, as   *)
+(* they do not run the risk of exposing internal coercions. As a consequence  *)
+(* it is better to explicitly cast a generic applicative pred T to simpl_pred *)
+(* using the SimplPred constructor, when it is used as a collective predicate *)
+(* (see, e.g., Lemma eq_big in bigop).                                        *)
+(*   We also sometimes "instantiate" the predType structure by defining a     *)
+(* coercion to the sort of the predPredType structure. This works better for  *)
+(* types such as {set T} that have subtypes that coerce to them, since the    *)
+(* same coercion will be inserted by the application of mem. It also lets us  *)
+(* turn any Type aT : predArgType into the total predicate over that type,    *)
+(* i.e., fun _: aT => true. This allows us to write, e.g., #|'I_n| for the    *)
+(* cardinal of the (finite) type of integers less than n.                     *)
+(*   Collective predicates have a specific extensional equality,              *)
+(*   - A =i B,                                                                *)
+(* while applicative predicates use the extensional equality of functions,    *)
+(*   - P =1 Q                                                                 *)
+(* The two forms are convertible, however.                                    *)
+(* We lift boolean operations to predicates, defining:                        *)
+(* - predU (union), predI (intersection), predC (complement),                 *)
+(*   predD (difference), and preim (preimage, i.e., composition)              *)
+(* For each operation we define three forms, typically:                       *)
+(* - predU : pred T -> pred T -> simpl_pred T                                 *)
+(* - [predU A & B], a Notation for predU (mem A) (mem B)                      *)
+(* - xpredU, a Notation for the lambda-expression inside predU,               *)
+(*     which is mostly useful as an argument of =1, since it exposes the head *)
+(*     head constant of the expression to the ssreflect matching algorithm.   *)
+(* The syntax for the preimage of a collective predicate A is                 *)
+(* - [preim f of A]                                                           *)
+(* Finally, the generic syntax for defining a simpl_pred T is                 *)
+(* - [pred x : T | P(x)], [pred x | P(x)], [pred x in A | P(x)], etc.         *)
+(* We also support boolean relations, but only the applicative form, with     *)
+(* types                                                                      *)
+(* - rel T, an alias for T -> pred T                                          *)
+(* - simpl_rel T, an auto-simplifying version, and syntax                     *)
+(*   [rel x y | P(x,y)], [rel x y in A & B | P(x,y)], etc.                    *)
+(* The notation [rel of fA] can be used to coerce a function returning a      *)
+(* collective predicate to one returning pred T.                              *)
+(*   Finally, note that there is specific support for ambivalent predicates   *)
+(* that can work in either style, as per this file's head descriptor.         *)
+(******************************************************************************)
+
+Definition pred T := T -> bool.
+
+Identity Coercion fun_of_pred : pred >-> Funclass.
+
+Definition rel T := T -> pred T.
+
+Identity Coercion fun_of_rel : rel >-> Funclass.
+
+Notation xpred0 := (fun _ => false).
+Notation xpredT := (fun _ => true).
+Notation xpredI := (fun (p1 p2 : pred _) x => p1 x && p2 x).
+Notation xpredU := (fun (p1 p2 : pred _) x => p1 x || p2 x).
+Notation xpredC := (fun (p : pred _) x => ~~ p x).
+Notation xpredD := (fun (p1 p2 : pred _) x => ~~ p2 x && p1 x).
+Notation xpreim := (fun f (p : pred _) x => p (f x)).
+Notation xrelU := (fun (r1 r2 : rel _) x y => r1 x y || r2 x y).
+
+Section Predicates.
+
+Variables T : Type.
+
+Definition subpred (p1 p2 : pred T) := forall x, p1 x -> p2 x.
+
+Definition subrel (r1 r2 : rel T) := forall x y, r1 x y -> r2 x y.
+
+Definition simpl_pred := simpl_fun T bool.
+Definition applicative_pred := pred T.
+Definition collective_pred := pred T.
+
+Definition SimplPred (p : pred T) : simpl_pred := SimplFun p.
+
+Coercion pred_of_simpl (p : simpl_pred) : pred T := fun_of_simpl p.
+Coercion applicative_pred_of_simpl (p : simpl_pred) : applicative_pred :=
+  fun_of_simpl p.
+Coercion collective_pred_of_simpl (p : simpl_pred) : collective_pred :=
+  fun x => (let: SimplFun f := p in fun _ => f x) x.
+(* Note: applicative_of_simpl is convertible to pred_of_simpl, while *)
+(* collective_of_simpl is not. *)
+
+Definition pred0 := SimplPred xpred0.
+Definition predT := SimplPred xpredT.
+Definition predI p1 p2 := SimplPred (xpredI p1 p2).
+Definition predU p1 p2 := SimplPred (xpredU p1 p2).
+Definition predC p := SimplPred (xpredC p).
+Definition predD p1 p2 := SimplPred (xpredD p1 p2).
+Definition preim rT f (d : pred rT) := SimplPred (xpreim f d).
+
+Definition simpl_rel := simpl_fun T (pred T).
+
+Definition SimplRel (r : rel T) : simpl_rel := [fun x => r x].
+
+Coercion rel_of_simpl_rel (r : simpl_rel) : rel T := fun x y => r x y.
+
+Definition relU r1 r2 := SimplRel (xrelU r1 r2).
+
+Lemma subrelUl r1 r2 : subrel r1 (relU r1 r2).
+Proof. by move=> *; apply/orP; left. Qed.
+
+Lemma subrelUr r1 r2 : subrel r2 (relU r1 r2).
+Proof. by move=> *; apply/orP; right. Qed.
+
+CoInductive mem_pred := Mem of pred T.
+
+Definition isMem pT topred mem := mem = (fun p : pT => Mem [eta topred p]).
+
+Structure predType := PredType {
+  pred_sort :> Type;
+  topred : pred_sort -> pred T;
+  _ : {mem | isMem topred mem}
+}.
+
+Definition mkPredType pT toP := PredType (exist (@isMem pT toP) _ (erefl _)).
+
+Canonical predPredType := Eval hnf in @mkPredType (pred T) id.
+Canonical simplPredType := Eval hnf in mkPredType pred_of_simpl.
+Canonical boolfunPredType := Eval hnf in @mkPredType (T -> bool) id.
+
+Coercion pred_of_mem mp : pred_sort predPredType := let: Mem p := mp in [eta p].
+Canonical memPredType := Eval hnf in mkPredType pred_of_mem.
+
+Definition clone_pred U :=
+  fun pT & pred_sort pT -> U =>
+  fun a mP (pT' := @PredType U a mP) & phant_id pT' pT => pT'.
+
+End Predicates.
+
+Arguments pred0 [T].
+Arguments predT [T].
+Prenex Implicits pred0 predT predI predU predC predD preim relU.
+
+Notation "[ 'pred' : T | E ]" := (SimplPred (fun _ : T => E%B))
+  (at level 0, format "[ 'pred' :  T  |  E ]") : fun_scope.
+Notation "[ 'pred' x | E ]" := (SimplPred (fun x => E%B))
+  (at level 0, x ident, format "[ 'pred'  x  |  E ]") : fun_scope.
+Notation "[ 'pred' x | E1 & E2 ]" := [pred x | E1 && E2 ]
+  (at level 0, x ident, format "[ 'pred'  x  |  E1  &  E2 ]") : fun_scope.
+Notation "[ 'pred' x : T | E ]" := (SimplPred (fun x : T => E%B))
+  (at level 0, x ident, only parsing) : fun_scope.
+Notation "[ 'pred' x : T | E1 & E2 ]" := [pred x : T | E1 && E2 ]
+  (at level 0, x ident, only parsing) : fun_scope.
+Notation "[ 'rel' x y | E ]" := (SimplRel (fun x y => E%B))
+  (at level 0, x ident, y ident, format "[ 'rel'  x  y  |  E ]") : fun_scope.
+Notation "[ 'rel' x y : T | E ]" := (SimplRel (fun x y : T => E%B))
+  (at level 0, x ident, y ident, only parsing) : fun_scope.
+
+Notation "[ 'predType' 'of' T ]" := (@clone_pred _ T _ id _ _ id)
+  (at level 0, format "[ 'predType'  'of'  T ]") : form_scope.
+
+(* This redundant coercion lets us "inherit" the simpl_predType canonical    *)
+(* instance by declaring a coercion to simpl_pred. This hack is the only way *)
+(* to put a predType structure on a predArgType. We use simpl_pred rather    *)
+(* than pred to ensure that /= removes the identity coercion. Note that the  *)
+(* coercion will never be used directly for simpl_pred, since the canonical  *)
+(* instance should always be resolved.                                       *)
+
+Notation pred_class := (pred_sort (predPredType _)).
+Coercion sort_of_simpl_pred T (p : simpl_pred T) : pred_class := p : pred T.
+
+(* This lets us use some types as a synonym for their universal predicate.    *)
+(* Unfortunately, this won't work for existing types like bool, unless we     *)
+(* redefine bool, true, false and all bool ops.                               *)
+Definition predArgType := Type.
+Bind Scope type_scope with predArgType.
+Identity Coercion sort_of_predArgType : predArgType >-> Sortclass.
+Coercion pred_of_argType (T : predArgType) : simpl_pred T := predT.
+
+Notation "{ : T }" := (T%type : predArgType)
+  (at level 0, format "{ :  T }") : type_scope.
+
+(* These must be defined outside a Section because "cooking" kills the        *)
+(* nosimpl tag.                                                               *)
+
+Definition mem T (pT : predType T) : pT -> mem_pred T :=
+  nosimpl (let: @PredType _ _ _ (exist _ mem _) := pT return pT -> _ in mem).
+Definition in_mem T x mp := nosimpl pred_of_mem T mp x.
+
+Prenex Implicits mem.
+
+Coercion pred_of_mem_pred T mp := [pred x : T | in_mem x mp].
+
+Definition eq_mem T p1 p2 := forall x : T, in_mem x p1 = in_mem x p2.
+Definition sub_mem T p1 p2 := forall x : T, in_mem x p1 -> in_mem x p2.
+
+Typeclasses Opaque eq_mem.
+
+Lemma sub_refl T (p : mem_pred T) : sub_mem p p. Proof. by []. Qed.
+Arguments sub_refl {T p}.
+
+Notation "x \in A" := (in_mem x (mem A)) : bool_scope.
+Notation "x \in A" := (in_mem x (mem A)) : bool_scope.
+Notation "x \notin A" := (~~ (x \in A)) : bool_scope.
+Notation "A =i B" := (eq_mem (mem A) (mem B)) : type_scope.
+Notation "{ 'subset' A <= B }" := (sub_mem (mem A) (mem B))
+  (at level 0, A, B at level 69,
+   format "{ '[hv' 'subset'  A '/   '  <=  B ']' }") : type_scope.
+Notation "[ 'mem' A ]" := (pred_of_simpl (pred_of_mem_pred (mem A)))
+  (at level 0, only parsing) : fun_scope.
+Notation "[ 'rel' 'of' fA ]" := (fun x => [mem (fA x)])
+  (at level 0, format "[ 'rel'  'of'  fA ]") : fun_scope.
+Notation "[ 'predI' A & B ]" := (predI [mem A] [mem B])
+  (at level 0, format "[ 'predI'  A  &  B ]") : fun_scope.
+Notation "[ 'predU' A & B ]" := (predU [mem A] [mem B])
+  (at level 0, format "[ 'predU'  A  &  B ]") : fun_scope.
+Notation "[ 'predD' A & B ]" := (predD [mem A] [mem B])
+  (at level 0, format "[ 'predD'  A  &  B ]") : fun_scope.
+Notation "[ 'predC' A ]" := (predC [mem A])
+  (at level 0, format "[ 'predC'  A ]") : fun_scope.
+Notation "[ 'preim' f 'of' A ]" := (preim f [mem A])
+  (at level 0, format "[ 'preim'  f  'of'  A ]") : fun_scope.
+
+Notation "[ 'pred' x 'in' A ]" := [pred x | x \in A]
+  (at level 0, x ident, format "[ 'pred'  x  'in'  A ]") : fun_scope.
+Notation "[ 'pred' x 'in' A | E ]" := [pred x | x \in A & E]
+  (at level 0, x ident, format "[ 'pred'  x  'in'  A  |  E ]") : fun_scope.
+Notation "[ 'pred' x 'in' A | E1 & E2 ]" := [pred x | x \in A & E1 && E2 ]
+  (at level 0, x ident,
+   format "[ 'pred'  x  'in'  A  |  E1  &  E2 ]") : fun_scope.
+Notation "[ 'rel' x y 'in' A & B | E ]" :=
+  [rel x y | (x \in A) && (y \in B) && E]
+  (at level 0, x ident, y ident,
+   format "[ 'rel'  x  y  'in'  A  &  B  |  E ]") : fun_scope.
+Notation "[ 'rel' x y 'in' A & B ]" := [rel x y | (x \in A) && (y \in B)]
+  (at level 0, x ident, y ident,
+   format "[ 'rel'  x  y  'in'  A  &  B ]") : fun_scope.
+Notation "[ 'rel' x y 'in' A | E ]" := [rel x y in A & A | E]
+  (at level 0, x ident, y ident,
+   format "[ 'rel'  x  y  'in'  A  |  E ]") : fun_scope.
+Notation "[ 'rel' x y 'in' A ]" := [rel x y in A & A]
+  (at level 0, x ident, y ident,
+   format "[ 'rel'  x  y  'in'  A ]") : fun_scope.
+
+Section simpl_mem.
+
+Variables (T : Type) (pT : predType T).
+Implicit Types (x : T) (p : pred T) (sp : simpl_pred T) (pp : pT).
+
+(* Bespoke structures that provide fine-grained control over matching the     *)
+(* various forms of the \in predicate; note in particular the different forms *)
+(* of hoisting that are used. We had to work around several bugs in the       *)
+(* implementation of unification, notably improper expansion of telescope     *)
+(* projections and overwriting of a variable assignment by a later            *)
+(* unification (probably due to conversion cache cross-talk).                 *)
+Structure manifest_applicative_pred p := ManifestApplicativePred {
+  manifest_applicative_pred_value :> pred T;
+  _ : manifest_applicative_pred_value = p
+}.
+Definition ApplicativePred p := ManifestApplicativePred (erefl p).
+Canonical applicative_pred_applicative sp :=
+  ApplicativePred (applicative_pred_of_simpl sp).
+
+Structure manifest_simpl_pred p := ManifestSimplPred {
+  manifest_simpl_pred_value :> simpl_pred T;
+  _ : manifest_simpl_pred_value = SimplPred p
+}.
+Canonical expose_simpl_pred p := ManifestSimplPred (erefl (SimplPred p)).
+
+Structure manifest_mem_pred p := ManifestMemPred {
+  manifest_mem_pred_value :> mem_pred T;
+  _ : manifest_mem_pred_value= Mem [eta p]
+}.
+Canonical expose_mem_pred p :=  @ManifestMemPred p _ (erefl _).
+
+Structure applicative_mem_pred p :=
+  ApplicativeMemPred {applicative_mem_pred_value :> manifest_mem_pred p}.
+Canonical check_applicative_mem_pred p (ap : manifest_applicative_pred p) mp :=
+  @ApplicativeMemPred ap mp.
+
+Lemma mem_topred (pp : pT) : mem (topred pp) = mem pp.
+Proof. by rewrite /mem; case: pT pp => T1 app1 [mem1 /= ->]. Qed.
+
+Lemma topredE x (pp : pT) : topred pp x = (x \in pp).
+Proof. by rewrite -mem_topred. Qed.
+
+Lemma app_predE x p (ap : manifest_applicative_pred p) : ap x = (x \in p).
+Proof. by case: ap => _ /= ->. Qed.
+
+Lemma in_applicative x p (amp : applicative_mem_pred p) : in_mem x amp = p x.
+Proof. by case: amp => [[_ /= ->]]. Qed.
+
+Lemma in_collective x p (msp : manifest_simpl_pred p) :
+  (x \in collective_pred_of_simpl msp) = p x.
+Proof. by case: msp => _ /= ->. Qed.
+
+Lemma in_simpl x p (msp : manifest_simpl_pred p) :
+  in_mem x (Mem [eta fun_of_simpl (msp : simpl_pred T)]) = p x.
+Proof. by case: msp => _ /= ->. Qed.
+
+(* Because of the explicit eta expansion in the left-hand side, this lemma    *)
+(* should only be used in a right-to-left direction. The 8.3 hack allowing    *)
+(* partial right-to-left use does not work with the improved expansion        *)
+(* heuristics in 8.4.                                                         *)
+Lemma unfold_in x p : (x \in ([eta p] : pred T)) = p x.
+Proof. by []. Qed.
+
+Lemma simpl_predE p : SimplPred p =1 p.
+Proof. by []. Qed.
+
+Definition inE := (in_applicative, in_simpl, simpl_predE). (* to be extended *)
+
+Lemma mem_simpl sp : mem sp = sp :> pred T.
+Proof. by []. Qed.
+
+Definition memE := mem_simpl. (* could be extended *)
+
+Lemma mem_mem (pp : pT) : (mem (mem pp) = mem pp) * (mem [mem pp] = mem pp).
+Proof. by rewrite -mem_topred. Qed.
+
+End simpl_mem.
+
+(* Qualifiers and keyed predicates. *)
+
+CoInductive qualifier (q : nat) T := Qualifier of predPredType T.
+
+Coercion has_quality n T (q : qualifier n T) : pred_class :=
+  fun x => let: Qualifier _ p := q in p x.
+Arguments has_quality n [T].
+
+Lemma qualifE n T p x : (x \in @Qualifier n T p) = p x. Proof. by []. Qed.
+
+Notation "x \is A" := (x \in has_quality 0 A)
+  (at level 70, no associativity,
+   format "'[hv' x '/ '  \is  A ']'") : bool_scope.
+Notation "x \is 'a' A" := (x \in has_quality 1 A)
+  (at level 70, no associativity,
+   format "'[hv' x '/ '  \is  'a'  A ']'") : bool_scope.
+Notation "x \is 'an' A" := (x \in has_quality 2 A)
+  (at level 70, no associativity,
+   format "'[hv' x '/ ' \is  'an'  A ']'") : bool_scope.
+Notation "x \isn't A" := (x \notin has_quality 0 A)
+  (at level 70, no associativity,
+   format "'[hv' x '/ '  \isn't  A ']'") : bool_scope.
+Notation "x \isn't 'a' A" := (x \notin has_quality 1 A)
+  (at level 70, no associativity,
+   format "'[hv' x '/ '  \isn't  'a'  A ']'") : bool_scope.
+Notation "x \isn't 'an' A" := (x \notin has_quality 2 A)
+  (at level 70, no associativity,
+   format "'[hv' x '/ ' \isn't  'an'  A ']'") : bool_scope.
+Notation "[ 'qualify' x | P ]" := (Qualifier 0 (fun x => P%B))
+  (at level 0, x at level 99,
+   format "'[hv' [  'qualify'  x  | '/ '  P ] ']'") : form_scope.
+Notation "[ 'qualify' x : T | P ]" := (Qualifier 0 (fun x : T => P%B))
+  (at level 0, x at level 99, only parsing) : form_scope.
+Notation "[ 'qualify' 'a' x | P ]" := (Qualifier 1 (fun x => P%B))
+  (at level 0, x at level 99,
+   format "'[hv' [ 'qualify'  'a'  x  | '/ '  P ] ']'") : form_scope.
+Notation "[ 'qualify' 'a' x : T | P ]" := (Qualifier 1 (fun x : T => P%B))
+  (at level 0, x at level 99, only parsing) : form_scope.
+Notation "[ 'qualify' 'an' x | P ]" := (Qualifier 2 (fun x => P%B))
+  (at level 0, x at level 99,
+   format "'[hv' [ 'qualify'  'an'  x  | '/ '  P ] ']'") : form_scope.
+Notation "[ 'qualify' 'an' x : T | P ]" := (Qualifier 2 (fun x : T => P%B))
+  (at level 0, x at level 99, only parsing) : form_scope.
+
+(* Keyed predicates: support for property-bearing predicate interfaces. *)
+
+Section KeyPred.
+
+Variable T : Type.
+CoInductive pred_key (p : predPredType T) := DefaultPredKey.
+
+Variable p : predPredType T.
+Structure keyed_pred (k : pred_key p) :=
+  PackKeyedPred {unkey_pred :> pred_class; _ : unkey_pred =i p}.
+
+Variable k : pred_key p.
+Definition KeyedPred := @PackKeyedPred k p (frefl _).
+
+Variable k_p : keyed_pred k.
+Lemma keyed_predE : k_p =i p. Proof. by case: k_p. Qed.
+
+(* Instances that strip the mem cast; the first one has "pred_of_mem" as its  *)
+(* projection head value, while the second has "pred_of_simpl". The latter    *)
+(* has the side benefit of preempting accidental misdeclarations.             *)
+(* Note: pred_of_mem is the registered mem >-> pred_class coercion, while     *)
+(* simpl_of_mem; pred_of_simpl is the mem >-> pred >=> Funclass coercion. We  *)
+(* must write down the coercions explicitly as the Canonical head constant    *)
+(* computation does not strip casts !!                                        *)
+Canonical keyed_mem :=
+  @PackKeyedPred k (pred_of_mem (mem k_p)) keyed_predE.
+Canonical keyed_mem_simpl :=
+  @PackKeyedPred k (pred_of_simpl (mem k_p)) keyed_predE.
+
+End KeyPred.
+
+Notation "x \i 'n' S" := (x \in @unkey_pred _ S _ _)
+  (at level 70, format "'[hv' x '/ '  \i 'n'  S ']'") : bool_scope.
+
+Section KeyedQualifier.
+
+Variables (T : Type) (n : nat) (q : qualifier n T).
+
+Structure keyed_qualifier (k : pred_key q) :=
+  PackKeyedQualifier {unkey_qualifier; _ : unkey_qualifier = q}.
+Definition KeyedQualifier k := PackKeyedQualifier k (erefl q).
+Variables (k : pred_key q) (k_q : keyed_qualifier k).
+Fact keyed_qualifier_suproof : unkey_qualifier k_q =i q.
+Proof. by case: k_q => /= _ ->. Qed.
+Canonical keyed_qualifier_keyed := PackKeyedPred k keyed_qualifier_suproof.
+
+End KeyedQualifier.
+
+Notation "x \i 's' A" := (x \i n has_quality 0 A)
+  (at level 70, format "'[hv' x '/ '  \i 's'  A ']'") : bool_scope.
+Notation "x \i 's' 'a' A" := (x \i n has_quality 1 A)
+  (at level 70, format "'[hv' x '/ '  \i 's'  'a'  A ']'") : bool_scope.
+Notation "x \i 's' 'an' A" := (x \i n has_quality 2 A)
+  (at level 70, format "'[hv' x '/ '  \i 's'  'an'  A ']'") : bool_scope.
+
+Module DefaultKeying.
+
+Canonical default_keyed_pred T p := KeyedPred (@DefaultPredKey T p).
+Canonical default_keyed_qualifier T n (q : qualifier n T) :=
+  KeyedQualifier (DefaultPredKey q).
+
+End DefaultKeying.
+
+(* Skolemizing with conditions. *)
+
+Lemma all_tag_cond_dep I T (C : pred I) U :
+    (forall x, T x) -> (forall x, C x -> {y : T x & U x y}) ->
+  {f : forall x, T x & forall x, C x -> U x (f x)}.
+Proof.
+move=> f0 fP; apply: all_tag (fun x y => C x -> U x y) _ => x.
+by case Cx: (C x); [case/fP: Cx => y; exists y | exists (f0 x)].
+Qed.
+
+Lemma all_tag_cond I T (C : pred I) U :
+    T -> (forall x, C x -> {y : T & U x y}) ->
+  {f : I -> T & forall x, C x -> U x (f x)}.
+Proof. by move=> y0; apply: all_tag_cond_dep. Qed.
+
+Lemma all_sig_cond_dep I T (C : pred I) P :
+    (forall x, T x) -> (forall x, C x -> {y : T x | P x y}) ->
+  {f : forall x, T x | forall x, C x -> P x (f x)}.
+Proof. by move=> f0 /(all_tag_cond_dep f0)[f]; exists f. Qed.
+
+Lemma all_sig_cond I T (C : pred I) P :
+    T -> (forall x, C x -> {y : T | P x y}) ->
+  {f : I -> T | forall x, C x -> P x (f x)}.
+Proof. by move=> y0; apply: all_sig_cond_dep. Qed.
+
+Section RelationProperties.
+
+(* Caveat: reflexive should not be used to state lemmas, as auto and trivial  *)
+(* will not expand the constant.                                              *)
+
+Variable T : Type.
+
+Variable R : rel T.
+
+Definition total := forall x y, R x y || R y x.
+Definition transitive := forall y x z, R x y -> R y z -> R x z.
+
+Definition symmetric := forall x y, R x y = R y x.
+Definition antisymmetric := forall x y, R x y && R y x -> x = y.
+Definition pre_symmetric := forall x y, R x y -> R y x.
+
+Lemma symmetric_from_pre : pre_symmetric -> symmetric.
+Proof. by move=> symR x y; apply/idP/idP; apply: symR. Qed.
+
+Definition reflexive := forall x, R x x.
+Definition irreflexive := forall x, R x x = false.
+
+Definition left_transitive := forall x y, R x y -> R x =1 R y.
+Definition right_transitive := forall x y, R x y -> R^~ x =1 R^~ y.
+
+Section PER.
+
+Hypotheses (symR : symmetric) (trR : transitive).
+
+Lemma sym_left_transitive : left_transitive.
+Proof. by move=> x y Rxy z; apply/idP/idP; apply: trR; rewrite // symR. Qed.
+
+Lemma sym_right_transitive : right_transitive.
+Proof. by move=> x y /sym_left_transitive Rxy z; rewrite !(symR z) Rxy. Qed.
+
+End PER.
+
+(* We define the equivalence property with prenex quantification so that it   *)
+(* can be localized using the {in ..., ..} form defined below.                *)
+
+Definition equivalence_rel := forall x y z, R z z * (R x y -> R x z = R y z).
+
+Lemma equivalence_relP : equivalence_rel <-> reflexive /\ left_transitive.
+Proof.
+split=> [eqiR | [Rxx trR] x y z]; last by split=> [|/trR->].
+by split=> [x | x y Rxy z]; [rewrite (eqiR x x x) | rewrite (eqiR x y z)].
+Qed.
+
+End RelationProperties.
+
+Lemma rev_trans T (R : rel T) : transitive R -> transitive (fun x y => R y x).
+Proof. by move=> trR x y z Ryx Rzy; apply: trR Rzy Ryx. Qed.
+
+(* Property localization *)
+
+Local Notation "{ 'all1' P }" := (forall x, P x : Prop) (at level 0).
+Local Notation "{ 'all2' P }" := (forall x y, P x y : Prop) (at level 0).
+Local Notation "{ 'all3' P }" := (forall x y z, P x y z: Prop) (at level 0).
+Local Notation ph := (phantom _).
+
+Section LocalProperties.
+
+Variables T1 T2 T3 : Type.
+
+Variables (d1 : mem_pred T1) (d2 : mem_pred T2) (d3 : mem_pred T3).
+Local Notation ph := (phantom Prop).
+
+Definition prop_for (x : T1) P & ph {all1 P} := P x.
+
+Lemma forE x P phP : @prop_for x P phP = P x. Proof. by []. Qed.
+
+Definition prop_in1 P & ph {all1 P} :=
+  forall x, in_mem x d1 -> P x.
+
+Definition prop_in11 P & ph {all2 P} :=
+  forall x y, in_mem x d1 -> in_mem y d2 -> P x y.
+
+Definition prop_in2 P & ph {all2 P} :=
+  forall x y, in_mem x d1 -> in_mem y d1 -> P x y.
+
+Definition prop_in111 P & ph {all3 P} :=
+  forall x y z, in_mem x d1 -> in_mem y d2 -> in_mem z d3 -> P x y z.
+
+Definition prop_in12 P & ph {all3 P} :=
+  forall x y z, in_mem x d1 -> in_mem y d2 -> in_mem z d2 -> P x y z.
+
+Definition prop_in21 P & ph {all3 P} :=
+  forall x y z, in_mem x d1 -> in_mem y d1 -> in_mem z d2 -> P x y z.
+
+Definition prop_in3 P & ph {all3 P} :=
+  forall x y z, in_mem x d1 -> in_mem y d1 -> in_mem z d1 -> P x y z.
+
+Variable f : T1 -> T2.
+
+Definition prop_on1 Pf P & phantom T3 (Pf f) & ph {all1 P} :=
+  forall x, in_mem (f x) d2 -> P x.
+
+Definition prop_on2 Pf P & phantom T3 (Pf f) & ph {all2 P} :=
+  forall x y, in_mem (f x) d2 -> in_mem (f y) d2 -> P x y.
+
+End LocalProperties.
+
+Definition inPhantom := Phantom Prop.
+Definition onPhantom T P (x : T) := Phantom Prop (P x).
+
+Definition bijective_in aT rT (d : mem_pred aT) (f : aT -> rT) :=
+  exists2 g, prop_in1 d (inPhantom (cancel f g))
+           & prop_on1 d (Phantom _ (cancel g)) (onPhantom (cancel g) f).
+
+Definition bijective_on aT rT (cd : mem_pred rT) (f : aT -> rT) :=
+  exists2 g, prop_on1 cd (Phantom _ (cancel f)) (onPhantom (cancel f) g)
+           & prop_in1 cd (inPhantom (cancel g f)).
+
+Notation "{ 'for' x , P }" :=
+  (prop_for x (inPhantom P))
+  (at level 0, format "{ 'for'  x ,  P }") : type_scope.
+
+Notation "{ 'in' d , P }" :=
+  (prop_in1 (mem d) (inPhantom P))
+  (at level 0, format "{ 'in'  d ,  P }") : type_scope.
+
+Notation "{ 'in' d1 & d2 , P }" :=
+  (prop_in11 (mem d1) (mem d2) (inPhantom P))
+  (at level 0, format "{ 'in'  d1  &  d2 ,  P }") : type_scope.
+
+Notation "{ 'in' d & , P }" :=
+  (prop_in2 (mem d) (inPhantom P))
+  (at level 0, format "{ 'in'  d  & ,  P }") : type_scope.
+
+Notation "{ 'in' d1 & d2 & d3 , P }" :=
+  (prop_in111 (mem d1) (mem d2) (mem d3) (inPhantom P))
+  (at level 0, format "{ 'in'  d1  &  d2  &  d3 ,  P }") : type_scope.
+
+Notation "{ 'in' d1 & & d3 , P }" :=
+  (prop_in21 (mem d1) (mem d3) (inPhantom P))
+  (at level 0, format "{ 'in'  d1  &  &  d3 ,  P }") : type_scope.
+
+Notation "{ 'in' d1 & d2 & , P }" :=
+  (prop_in12 (mem d1) (mem d2) (inPhantom P))
+  (at level 0, format "{ 'in'  d1  &  d2  & ,  P }") : type_scope.
+
+Notation "{ 'in' d & & , P }" :=
+  (prop_in3 (mem d) (inPhantom P))
+  (at level 0, format "{ 'in'  d  &  & ,  P }") : type_scope.
+
+Notation "{ 'on' cd , P }" :=
+  (prop_on1 (mem cd) (inPhantom P) (inPhantom P))
+  (at level 0, format "{ 'on'  cd ,  P }") : type_scope.
+
+Notation "{ 'on' cd & , P }" :=
+  (prop_on2 (mem cd) (inPhantom P) (inPhantom P))
+  (at level 0, format "{ 'on'  cd  & ,  P }") : type_scope.
+
+Local Arguments onPhantom {_%type_scope} _ _.
+
+Notation "{ 'on' cd , P & g }" :=
+  (prop_on1 (mem cd) (Phantom (_ -> Prop) P) (onPhantom P g))
+  (at level 0, format "{ 'on'  cd ,  P  &  g }") : type_scope.
+
+Notation "{ 'in' d , 'bijective' f }" := (bijective_in (mem d) f)
+  (at level 0, f at level 8,
+   format "{ 'in'  d ,  'bijective'  f }") : type_scope.
+
+Notation "{ 'on' cd , 'bijective' f }" := (bijective_on (mem cd) f)
+  (at level 0, f at level 8,
+   format "{ 'on'  cd ,  'bijective'  f }") : type_scope.
+
+(* Weakening and monotonicity lemmas for localized predicates.                *)
+(* Note that using these lemmas in backward reasoning will force expansion of *)
+(* the predicate definition, as Coq needs to expose the quantifier to apply   *)
+(* these lemmas. We define a few specialized variants to avoid this for some  *)
+(* of the ssrfun predicates.                                                  *)
+
+Section LocalGlobal.
+
+Variables T1 T2 T3 : predArgType.
+Variables (D1 : pred T1) (D2 : pred T2) (D3 : pred T3).
+Variables (d1 d1' : mem_pred T1) (d2 d2' : mem_pred T2) (d3 d3' : mem_pred T3).
+Variables (f f' : T1 -> T2) (g : T2 -> T1) (h : T3).
+Variables (P1 : T1 -> Prop) (P2 : T1 -> T2 -> Prop).
+Variable P3 : T1 -> T2 -> T3 -> Prop.
+Variable Q1 : (T1 -> T2) -> T1 -> Prop.
+Variable Q1l : (T1 -> T2) -> T3 -> T1 -> Prop.
+Variable Q2 : (T1 -> T2) -> T1 -> T1 -> Prop.
+
+Hypothesis sub1 : sub_mem d1 d1'.
+Hypothesis sub2 : sub_mem d2 d2'.
+Hypothesis sub3 : sub_mem d3 d3'.
+
+Lemma in1W : {all1 P1} -> {in D1, {all1 P1}}.
+Proof. by move=> ? ?. Qed.
+Lemma in2W : {all2 P2} -> {in D1 & D2, {all2 P2}}.
+Proof. by move=> ? ?. Qed.
+Lemma in3W : {all3 P3} -> {in D1 & D2 & D3, {all3 P3}}.
+Proof. by move=> ? ?. Qed.
+
+Lemma in1T : {in T1, {all1 P1}} -> {all1 P1}.
+Proof. by move=> ? ?; auto. Qed.
+Lemma in2T : {in T1 & T2, {all2 P2}} -> {all2 P2}.
+Proof. by move=> ? ?; auto. Qed.
+Lemma in3T : {in T1 & T2 & T3, {all3 P3}} -> {all3 P3}.
+Proof. by move=> ? ?; auto. Qed.
+
+Lemma sub_in1 (Ph : ph {all1 P1}) : prop_in1 d1' Ph -> prop_in1 d1 Ph.
+Proof. by move=> allP x /sub1; apply: allP. Qed.
+
+Lemma sub_in11 (Ph : ph {all2 P2}) : prop_in11 d1' d2' Ph -> prop_in11 d1 d2 Ph.
+Proof. by move=> allP x1 x2 /sub1 d1x1 /sub2; apply: allP. Qed.
+
+Lemma sub_in111 (Ph : ph {all3 P3}) :
+  prop_in111 d1' d2' d3' Ph -> prop_in111 d1 d2 d3 Ph.
+Proof. by move=> allP x1 x2 x3 /sub1 d1x1 /sub2 d2x2 /sub3; apply: allP. Qed.
+
+Let allQ1 f'' := {all1 Q1 f''}.
+Let allQ1l f'' h' := {all1 Q1l f'' h'}.
+Let allQ2 f'' := {all2 Q2 f''}.
+
+Lemma on1W : allQ1 f -> {on D2, allQ1 f}. Proof. by move=> ? ?. Qed.
+
+Lemma on1lW : allQ1l f h -> {on D2, allQ1l f & h}. Proof. by move=> ? ?. Qed.
+
+Lemma on2W : allQ2 f -> {on D2 &, allQ2 f}. Proof. by move=> ? ?. Qed.
+
+Lemma on1T : {on T2, allQ1 f} -> allQ1 f. Proof. by move=> ? ?; auto. Qed.
+
+Lemma on1lT : {on T2, allQ1l f & h} -> allQ1l f h.
+Proof. by move=> ? ?; auto. Qed.
+
+Lemma on2T : {on T2 &, allQ2 f} -> allQ2 f.
+Proof. by move=> ? ?; auto. Qed.
+
+Lemma subon1 (Phf : ph (allQ1 f)) (Ph : ph (allQ1 f)) :
+  prop_on1 d2' Phf Ph -> prop_on1 d2 Phf Ph.
+Proof. by move=> allQ x /sub2; apply: allQ. Qed.
+
+Lemma subon1l (Phf : ph (allQ1l f)) (Ph : ph (allQ1l f h)) :
+  prop_on1 d2' Phf Ph -> prop_on1 d2 Phf Ph.
+Proof. by move=> allQ x /sub2; apply: allQ. Qed.
+
+Lemma subon2 (Phf : ph (allQ2 f)) (Ph : ph (allQ2 f)) :
+  prop_on2 d2' Phf Ph -> prop_on2 d2 Phf Ph.
+Proof. by move=> allQ x y /sub2=> d2fx /sub2; apply: allQ. Qed.
+
+Lemma can_in_inj : {in D1, cancel f g} -> {in D1 &, injective f}.
+Proof. by move=> fK x y /fK{2}<- /fK{2}<- ->. Qed.
+
+Lemma canLR_in x y : {in D1, cancel f g} -> y \in D1 -> x = f y -> g x = y.
+Proof. by move=> fK D1y ->; rewrite fK. Qed.
+
+Lemma canRL_in x y : {in D1, cancel f g} -> x \in D1 -> f x = y -> x = g y.
+Proof. by move=> fK D1x <-; rewrite fK. Qed.
+
+Lemma on_can_inj : {on D2, cancel f & g} -> {on D2 &, injective f}.
+Proof. by move=> fK x y /fK{2}<- /fK{2}<- ->. Qed.
+
+Lemma canLR_on x y : {on D2, cancel f & g} -> f y \in D2 -> x = f y -> g x = y.
+Proof. by move=> fK D2fy ->; rewrite fK. Qed.
+
+Lemma canRL_on x y : {on D2, cancel f & g} -> f x \in D2 -> f x = y -> x = g y.
+Proof. by move=> fK D2fx <-; rewrite fK. Qed.
+
+Lemma inW_bij : bijective f -> {in D1, bijective f}.
+Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.
+
+Lemma onW_bij : bijective f -> {on D2, bijective f}.
+Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.
+
+Lemma inT_bij : {in T1, bijective f} -> bijective f.
+Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.
+
+Lemma onT_bij : {on T2, bijective f} -> bijective f.
+Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.
+
+Lemma sub_in_bij (D1' : pred T1) :
+  {subset D1 <= D1'} -> {in D1', bijective f} -> {in D1, bijective f}.
+Proof.
+by move=> subD [g' fK g'K]; exists g' => x; move/subD; [apply: fK | apply: g'K].
+Qed.
+
+Lemma subon_bij (D2' : pred T2) :
+  {subset D2 <= D2'} -> {on D2', bijective f} -> {on D2, bijective f}.
+Proof.
+by move=> subD [g' fK g'K]; exists g' => x; move/subD; [apply: fK | apply: g'K].
+Qed.
+
+End LocalGlobal.
+
+Lemma sub_in2 T d d' (P : T -> T -> Prop) :
+  sub_mem d d' -> forall Ph : ph {all2 P}, prop_in2 d' Ph -> prop_in2 d Ph.
+Proof. by move=> /= sub_dd'; apply: sub_in11. Qed.
+
+Lemma sub_in3 T d d' (P : T -> T -> T -> Prop) :
+  sub_mem d d' -> forall Ph : ph {all3 P}, prop_in3 d' Ph -> prop_in3 d Ph.
+Proof. by move=> /= sub_dd'; apply: sub_in111. Qed.
+
+Lemma sub_in12 T1 T d1 d1' d d' (P : T1 -> T -> T -> Prop) :
+  sub_mem d1 d1' -> sub_mem d d' ->
+  forall Ph : ph {all3 P}, prop_in12 d1' d' Ph -> prop_in12 d1 d Ph.
+Proof. by move=> /= sub1 sub; apply: sub_in111. Qed.
+
+Lemma sub_in21 T T3 d d' d3 d3' (P : T -> T -> T3 -> Prop) :
+  sub_mem d d' -> sub_mem d3 d3' ->
+  forall Ph : ph {all3 P}, prop_in21 d' d3' Ph -> prop_in21 d d3 Ph.
+Proof. by move=> /= sub sub3; apply: sub_in111. Qed.
+
+Lemma equivalence_relP_in T (R : rel T) (A : pred T) :
+  {in A & &, equivalence_rel R}
+   <-> {in A, reflexive R} /\ {in A &, forall x y, R x y -> {in A, R x =1 R y}}.
+Proof.
+split=> [eqiR | [Rxx trR] x y z *]; last by split=> [|/trR-> //]; apply: Rxx.
+by split=> [x Ax|x y Ax Ay Rxy z Az]; [rewrite (eqiR x x) | rewrite (eqiR x y)].
+Qed.
+
+Section MonoHomoMorphismTheory.
+
+Variables (aT rT sT : Type) (f : aT -> rT) (g : rT -> aT).
+Variables (aP : pred aT) (rP : pred rT) (aR : rel aT) (rR : rel rT).
+
+Lemma monoW : {mono f : x / aP x >-> rP x} -> {homo f : x / aP x >-> rP x}.
+Proof. by move=> hf x ax; rewrite hf. Qed.
+
+Lemma mono2W :
+  {mono f : x y / aR x y >-> rR x y} -> {homo f : x y / aR x y >-> rR x y}.
+Proof. by move=> hf x y axy; rewrite hf. Qed.
+
+Hypothesis fgK : cancel g f.
+
+Lemma homoRL :
+  {homo f : x y / aR x y >-> rR x y} -> forall x y, aR (g x) y -> rR x (f y).
+Proof. by move=> Hf x y /Hf; rewrite fgK. Qed.
+
+Lemma homoLR :
+  {homo f : x y / aR x y >-> rR x y} -> forall x y, aR x (g y) -> rR (f x) y.
+Proof. by move=> Hf x y /Hf; rewrite fgK. Qed.
+
+Lemma homo_mono :
+    {homo f : x y / aR x y >-> rR x y} -> {homo g : x y / rR x y >-> aR x y} ->
+  {mono g : x y / rR x y >-> aR x y}.
+Proof.
+move=> mf mg x y; case: (boolP (rR _ _))=> [/mg //|].
+by apply: contraNF=> /mf; rewrite !fgK.
+Qed.
+
+Lemma monoLR :
+  {mono f : x y / aR x y >-> rR x y} -> forall x y, rR (f x) y = aR x (g y).
+Proof. by move=> mf x y; rewrite -{1}[y]fgK mf. Qed.
+
+Lemma monoRL :
+  {mono f : x y / aR x y >-> rR x y} -> forall x y, rR x (f y) = aR (g x) y.
+Proof. by move=> mf x y; rewrite -{1}[x]fgK mf. Qed.
+
+Lemma can_mono :
+  {mono f : x y / aR x y >-> rR x y} -> {mono g : x y / rR x y >-> aR x y}.
+Proof. by move=> mf x y /=; rewrite -mf !fgK. Qed.
+
+End MonoHomoMorphismTheory.
+
+Section MonoHomoMorphismTheory_in.
+
+Variables (aT rT sT : predArgType) (f : aT -> rT) (g : rT -> aT).
+Variable (aD : pred aT).
+Variable (aP : pred aT) (rP : pred rT) (aR : rel aT) (rR : rel rT).
+
+Notation rD := [pred x | g x \in aD].
+
+Lemma monoW_in :
+    {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
+  {in aD &, {homo f : x y / aR x y >-> rR x y}}.
+Proof. by move=> hf x y hx hy axy; rewrite hf. Qed.
+
+Lemma mono2W_in :
+    {in aD, {mono f : x / aP x >-> rP x}} ->
+  {in aD, {homo f : x / aP x >-> rP x}}.
+Proof. by move=> hf x hx ax; rewrite hf. Qed.
+
+Hypothesis fgK_on : {on aD, cancel g & f}.
+
+Lemma homoRL_in :
+    {in aD &, {homo f : x y / aR x y >-> rR x y}} ->
+  {in rD & aD, forall x y, aR (g x) y -> rR x (f y)}.
+Proof. by move=> Hf x y hx hy /Hf; rewrite fgK_on //; apply. Qed.
+
+Lemma homoLR_in :
+    {in aD &, {homo f : x y / aR x y >-> rR x y}} ->
+  {in aD & rD, forall x y, aR x (g y) -> rR (f x) y}.
+Proof. by move=> Hf x y hx hy /Hf; rewrite fgK_on //; apply. Qed.
+
+Lemma homo_mono_in :
+    {in aD &, {homo f : x y / aR x y >-> rR x y}} ->
+    {in rD &, {homo g : x y / rR x y >-> aR x y}} ->
+  {in rD &, {mono g : x y / rR x y >-> aR x y}}.
+Proof.
+move=> mf mg x y hx hy; case: (boolP (rR _ _))=> [/mg //|]; first exact.
+by apply: contraNF=> /mf; rewrite !fgK_on //; apply.
+Qed.
+
+Lemma monoLR_in :
+    {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
+  {in aD & rD, forall x y, rR (f x) y = aR x (g y)}.
+Proof. by move=> mf x y hx hy; rewrite -{1}[y]fgK_on // mf. Qed.
+
+Lemma monoRL_in :
+    {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
+  {in rD & aD, forall x y, rR x (f y) = aR (g x) y}.
+Proof. by move=> mf x y hx hy; rewrite -{1}[x]fgK_on // mf. Qed.
+
+Lemma can_mono_in :
+    {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
+  {in rD &, {mono g : x y / rR x y >-> aR x y}}.
+Proof. by move=> mf x y hx hy /=; rewrite -mf // !fgK_on. Qed.
+
+End MonoHomoMorphismTheory_in.
diff --git a/plugins/ssr/ssrbwd.ml b/plugins/ssr/ssrbwd.ml
new file mode 100644
index 00000000..1c4508ab
--- /dev/null
+++ b/plugins/ssr/ssrbwd.ml
@@ -0,0 +1,160 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Printer
+open Pretyping
+open Globnames
+open Glob_term
+open Tacmach
+
+open Ssrmatching_plugin
+open Ssrmatching
+
+open Ssrast
+open Ssrprinters
+open Ssrcommon
+
+let char_to_kind = function
+  | '(' -> xInParens
+  | '@' -> xWithAt
+  | ' ' -> xNoFlag
+  | 'x' -> xCpattern
+  | _ -> assert false
+
+(** Backward chaining tactics: apply, exact, congr. *)
+
+(** The "apply" tactic *)
+
+let interp_agen ist gl ((goclr, _), (k, gc as c)) (clr, rcs) =
+(* ppdebug(lazy(str"sigma@interp_agen=" ++ pr_evar_map None (project gl))); *)
+  let k = char_to_kind k in
+  let rc = pf_intern_term ist gl c in
+  let rcs' = rc :: rcs in
+  match goclr with
+  | None -> clr, rcs'
+  | Some ghyps ->
+    let clr' = snd (interp_hyps ist gl ghyps) @ clr in
+    if k <> xNoFlag then clr', rcs' else
+    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'
+
+let pf_pr_glob_constr gl = pr_glob_constr_env (pf_env gl)
+
+let interp_nbargs ist gl rc =
+  try
+    let rc6 = mkRApp rc (mkRHoles 6) in
+    let sigma, t = interp_open_constr ist gl (rc6, None) in
+    let si = sig_it gl in
+    let gl = re_sig si sigma in
+    6 + Ssrcommon.nbargs_open_constr gl t
+  with _ -> 5
+
+let interp_view_nbimps ist gl rc =
+  try
+    let sigma, t = interp_open_constr ist gl (rc, None) in
+    let si = sig_it gl in
+    let gl = re_sig si sigma in
+    let pl, c = splay_open_constr gl t in
+    if Ssrcommon.isAppInd (pf_env gl) (project gl) c then List.length pl else (-(List.length pl))
+  with _ -> 0
+
+let interp_agens ist gl gagens =
+  match List.fold_right (interp_agen ist gl) gagens ([], []) with
+  | clr, rlemma :: args ->
+    let n = interp_nbargs ist gl rlemma - List.length args in
+    let rec loop i =
+      if i > n then
+         errorstrm Pp.(str "Cannot apply lemma " ++ pf_pr_glob_constr gl rlemma)
+      else
+        try interp_refine ist gl (mkRApp rlemma (mkRHoles i @ args))
+        with _ -> loop (i + 1) in
+    clr, loop 0
+  | _ -> assert false
+
+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 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
+  let cl = pf_concl gl in
+  let rec loop i =
+    if i > n then
+      errorstrm Pp.(str"Cannot apply lemma "++pf_pr_glob_constr gl t)
+    else try pf_match gl (mkRlemma i) (OfType cl) with _ -> loop (i + 1) in
+  refine_with (loop 0) gl
+
+let mkRAppView ist gl rv gv =
+  let nb_view_imps = interp_view_nbimps ist gl rv in
+  mkRApp rv (mkRHoles (abs nb_view_imps))
+
+let prof_apply_interp_with = mk_profiler "ssrapplytac.interp_with";;
+
+let refine_interp_apply_view dbl ist gl gv =
+  let pair i = List.map (fun x -> i, x) in
+  let rv = pf_intern_term ist gl gv in
+  let v = mkRAppView ist gl rv gv in
+  let interp_with (dbl, hint) =
+    let i = if dbl = Ssrview.AdaptorDb.Equivalence then 2 else 1 in
+    interp_refine ist gl (mkRApp hint (v :: mkRHoles i)) in
+  let interp_with x = prof_apply_interp_with.profile interp_with x in
+  let rec loop = function
+  | [] -> (try apply_rconstr ~ist rv gl with _ -> view_error "apply" gv)
+  | h :: hs -> (try refine_with (snd (interp_with h)) gl with _ -> loop hs) in
+  loop (pair dbl (Ssrview.AdaptorDb.get dbl) @
+        if dbl = Ssrview.AdaptorDb.Equivalence
+        then pair Ssrview.AdaptorDb.Backward (Ssrview.AdaptorDb.(get Backward))
+        else [])
+
+let apply_top_tac =
+  Tacticals.tclTHENLIST [
+    introid top_id;
+    apply_rconstr (mkRVar top_id);
+    old_cleartac [SsrHyp(None,top_id)]
+  ]
+
+let inner_ssrapplytac gviews (ggenl, gclr) ist = Proofview.V82.tactic ~nf_evars:false (fun gl ->
+ let _, clr = interp_hyps ist gl gclr in
+ let vtac gv i gl' = refine_interp_apply_view i ist gl' gv in
+ let ggenl, tclGENTAC =
+   if gviews <> [] && ggenl <> [] then
+     let ggenl= List.map (fun (x,g) -> x, cpattern_of_term g ist) (List.hd ggenl) in
+     [], Tacticals.tclTHEN (genstac (ggenl,[]))
+   else ggenl, Tacticals.tclTHEN Tacticals.tclIDTAC in
+ tclGENTAC (fun gl ->
+  match gviews, ggenl with
+  | v :: tl, [] ->
+    let dbl =
+      if List.length tl = 1
+      then Ssrview.AdaptorDb.Equivalence
+      else Ssrview.AdaptorDb.Backward in
+    Tacticals.tclTHEN
+      (List.fold_left (fun acc v ->
+         Tacticals.tclTHENLAST acc (vtac v dbl))
+        (vtac v Ssrview.AdaptorDb.Backward) tl)
+      (old_cleartac clr) gl
+  | [], [agens] ->
+    let clr', (sigma, lemma) = interp_agens ist gl agens in
+    let gl = pf_merge_uc_of sigma gl in
+    Tacticals.tclTHENLIST [old_cleartac clr; refine_with ~beta:true lemma; old_cleartac clr'] gl
+  | _, _ ->
+     Tacticals.tclTHENLIST [apply_top_tac; old_cleartac clr] gl) gl
+)
+
+let apply_top_tac = Proofview.V82.tactic ~nf_evars:false apply_top_tac
diff --git a/plugins/ssr/ssrbwd.mli b/plugins/ssr/ssrbwd.mli
new file mode 100644
index 00000000..694ecfa3
--- /dev/null
+++ b/plugins/ssr/ssrbwd.mli
@@ -0,0 +1,16 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Ssrast
+open Proofview
+
+val apply_top_tac : unit tactic
+
+val inner_ssrapplytac : ssrterm list -> ssrterm ssragens -> ist -> unit tactic
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
new file mode 100644
index 00000000..82cae439
--- /dev/null
+++ b/plugins/ssr/ssrcommon.ml
@@ -0,0 +1,1572 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Util
+open Names
+open Evd
+open Term
+open Constr
+open Termops
+open Printer
+open Locusops
+
+open Ltac_plugin
+open Tacmach
+open Refiner
+open Libnames
+open Ssrmatching_plugin
+open Ssrmatching
+open Ssrast
+open Ssrprinters
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
+(* Defining grammar rules with "xx" in it automatically declares keywords too,
+ * we thus save the lexer to restore it at the end of the file *)
+let frozen_lexer = CLexer.get_keyword_state () ;;
+
+let errorstrm x = CErrors.user_err ~hdr:"ssreflect" x
+
+let allocc = Some(false,[])
+
+(** Bound assumption argument *)
+
+(* The Ltac API does have a type for assumptions but it is level-dependent *)
+(* and therefore impractical to use for complex arguments, so we substitute *)
+(* our own to have a uniform representation. Also, we refuse to intern     *)
+(* idents that match global/section constants, since this would lead to    *)
+(* fragile Ltac scripts.                                                   *)
+
+let hyp_id (SsrHyp (_, id)) = id
+
+let hyp_err ?loc msg id =
+  CErrors.user_err ?loc ~hdr:"ssrhyp" Pp.(str msg ++ Id.print id)
+
+let not_section_id id = not (Termops.is_section_variable id)
+
+let hyps_ids = List.map hyp_id
+
+let rec check_hyps_uniq ids = function
+  | SsrHyp (loc, id) :: _ when List.mem id ids ->
+    hyp_err ?loc "Duplicate assumption " id
+  | SsrHyp (_, id) :: hyps -> check_hyps_uniq (id :: ids) hyps
+  | [] -> ()
+
+let check_hyp_exists hyps (SsrHyp(_, id)) =
+  try ignore(Context.Named.lookup id hyps)
+  with Not_found -> errorstrm Pp.(str"No assumption is named " ++ Id.print id)
+
+let test_hypname_exists hyps id =
+  try ignore(Context.Named.lookup id hyps); true
+  with Not_found -> false
+
+let hoik f = function Hyp x -> f x | Id x -> f x
+let hoi_id = hoik hyp_id
+
+let mk_hint tac = false, [Some tac]
+let mk_orhint tacs = true, tacs
+let nullhint = true, []
+let nohint = false, []
+
+type 'a tac_a = (goal * 'a) sigma -> (goal * 'a) list sigma
+
+let push_ctx  a gl = re_sig (sig_it gl, a) (project gl)
+let push_ctxs a gl =
+  re_sig (List.map (fun x -> x,a) (sig_it gl)) (project gl)
+let pull_ctx gl = let g, a = sig_it gl in re_sig g (project gl), a
+let pull_ctxs gl = let g, a = List.split (sig_it gl) in re_sig g (project gl), a
+
+let with_ctx f gl =
+  let gl, ctx = pull_ctx gl in
+  let rc, ctx = f ctx in
+  rc, push_ctx ctx gl
+let without_ctx f gl =
+  let gl, _ctx = pull_ctx gl in
+  f gl
+let tac_ctx t gl =
+  let gl, a = pull_ctx gl in
+  let gl = t gl in
+  push_ctxs a gl
+
+let tclTHEN_ia t1 t2 gl =
+  let gal = t1 gl in
+  let goals, sigma = sig_it gal, project gal in
+  let _, opened, sigma =
+    List.fold_left (fun (i,opened,sigma) g ->
+      let gl = t2 i (re_sig g sigma) in
+      i+1, sig_it gl :: opened, project gl)
+      (1,[],sigma) goals in
+  re_sig (List.flatten (List.rev opened)) sigma
+
+let tclTHEN_a t1 t2 gl = tclTHEN_ia t1 (fun _ -> t2) gl
+
+let tclTHENS_a t1 tl gl = tclTHEN_ia t1
+  (fun i -> List.nth tl (i-1)) gl
+
+let rec tclTHENLIST_a = function
+  | [] -> tac_ctx tclIDTAC
+  | t1::tacl -> tclTHEN_a t1 (tclTHENLIST_a tacl)
+
+(* like  tclTHEN_i but passes to the tac "i of n" and not just i *)
+let tclTHEN_i_max tac taci gl =
+  let maxi = ref 0 in
+  tclTHEN_ia (tclTHEN_ia tac (fun i -> maxi := max i !maxi; tac_ctx tclIDTAC))
+    (fun i gl -> taci i !maxi gl) gl
+
+let tac_on_all gl tac =
+  let goals = sig_it gl in
+  let opened, sigma =
+    List.fold_left (fun (opened,sigma) g ->
+      let gl = tac (re_sig g sigma) in
+      sig_it gl :: opened, project gl)
+      ([],project gl) goals in
+  re_sig (List.flatten (List.rev opened)) sigma
+
+(* Used to thread data between intro patterns at run time *)
+type tac_ctx = {
+  tmp_ids : (Id.t * Name.t ref) list;
+  wild_ids : Id.t list;
+  delayed_clears : Id.t list;
+}
+
+let new_ctx () =
+  { tmp_ids = []; wild_ids = []; delayed_clears = [] }
+
+let with_fresh_ctx t gl =
+  let gl = push_ctx (new_ctx()) gl in
+  let gl = t gl in
+  fst (pull_ctxs gl)
+
+open Genarg
+open Stdarg
+open Pp
+
+let errorstrm x = CErrors.user_err ~hdr:"ssreflect" x
+let anomaly s = CErrors.anomaly (str s)
+
+(* Tentative patch from util.ml *)
+
+let array_fold_right_from n f v a =
+  let rec fold n =
+    if n >= Array.length v then a else f v.(n) (fold (succ n))
+  in
+  fold n
+
+let array_app_tl v l =
+  if Array.length v = 0 then invalid_arg "array_app_tl";
+  array_fold_right_from 1 (fun e l -> e::l) v l
+
+let array_list_of_tl v =
+  if Array.length v = 0 then invalid_arg "array_list_of_tl";
+  array_fold_right_from 1 (fun e l -> e::l) v []
+
+(* end patch *)
+
+let option_assert_get o msg =
+  match o with
+  | None -> CErrors.anomaly msg
+  | Some x -> x
+
+
+(** Constructors for rawconstr *)
+open Glob_term
+open Globnames
+open Misctypes
+open Decl_kinds
+
+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 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 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 ->
+    let vars = Id.Map.fold (fun x _ accu -> Id.Set.add x accu) ist.Tacinterp.lfun Id.Set.empty in
+    let ltacvars = {
+      Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in
+    Constrintern.intern_gen Pretyping.WithoutTypeConstraint ~ltacvars genv Evd.(from_env genv) ce
+  | rc, None -> rc
+
+let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) c
+let intern_term ist env (_, c) = glob_constr ist env c
+
+(* Estimate a bound on the number of arguments of a raw constr. *)
+(* This is not perfect, because the unifier may fail to         *)
+(* typecheck the partial application, so we use a minimum of 5. *)
+(* Also, we don't handle delayed or iterated coercions to       *)
+(* FUNCLASS, which is probably just as well since these can     *)
+(* lead to infinite arities.                                    *)
+
+let splay_open_constr gl (sigma, c) =
+  let env = pf_env gl in let t = Retyping.get_type_of env sigma c in
+  Reductionops.splay_prod env sigma t
+
+let isAppInd env sigma c =
+  let c = Reductionops.clos_whd_flags CClosure.all env sigma c in
+  let c, _ = decompose_app_vect sigma c in
+  EConstr.isInd sigma c
+
+(** Generic argument-based globbing/typing utilities *)
+
+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
+    Ltac_pretype.ltac_constrs = constrvars; ltac_genargs = ist.Tacinterp.lfun
+  } in
+  let kind = Pretyping.OfType (pf_concl gl) in
+  let flags = {
+    Pretyping.use_typeclasses = true;
+    solve_unification_constraints = true;
+    use_hook = None;
+    fail_evar = false;
+    expand_evars = true }
+  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_env (pf_env gl) sigma c));
+  (sigma, (sigma, c))
+
+
+let interp_open_constr ist gl gc =
+  let (sigma, (c, _)) = Tacinterp.interp_open_constr_with_bindings ist (pf_env gl) (project gl) (gc, Misctypes.NoBindings) in
+  (project gl, (sigma, c))
+
+let interp_term ist gl (_, c) = snd (interp_open_constr ist gl c)
+
+let of_ftactic ftac gl =
+  let r = ref None in
+  let tac = Ftactic.run ftac (fun ans -> r := Some ans; Proofview.tclUNIT ()) in
+  let tac = Proofview.V82.of_tactic tac in
+  let { sigma = sigma } = tac gl in
+  let ans = match !r with
+  | None -> assert false (** If the tactic failed we should not reach this point *)
+  | Some ans -> ans
+  in
+  (sigma, ans)
+
+let interp_wit wit ist gl x = 
+  let globarg = in_gen (glbwit wit) x in
+  let arg = Tacinterp.interp_genarg ist globarg in
+  let (sigma, arg) = of_ftactic arg gl in
+  sigma, Tacinterp.Value.cast (topwit wit) arg
+
+let interp_hyp ist gl (SsrHyp (loc, id)) =
+  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'
+
+let interp_hyps ist gl ghyps =
+  let hyps = List.map snd (List.map (interp_hyp ist gl) ghyps) in
+  check_hyps_uniq [] hyps; Tacmach.project gl, hyps
+
+(* Old terms *)
+let mk_term k c = k, (mkRHole, Some c)
+let mk_lterm c = mk_term xNoFlag c
+
+(* New terms *)
+
+let mk_ast_closure_term a t = {
+  annotation = a;
+  body = t;
+  interp_env = None;
+  glob_env = None;
+}
+
+let glob_ast_closure_term (ist : Genintern.glob_sign) t =
+  { t with glob_env = Some ist }
+let subst_ast_closure_term (_s : Mod_subst.substitution) t =
+  (* _s makes sense only for glob constr *)
+  t
+let interp_ast_closure_term (ist : Geninterp.interp_sign) (gl : 'goal Evd.sigma) t =
+  (* gl is only useful if we want to interp *now*, later we have
+   * a potentially different gl.sigma *)
+  Tacmach.project gl, { t with interp_env = Some ist }
+
+let ssrterm_of_ast_closure_term { body; annotation } =
+  let c = match annotation with
+    | `Parens -> xInParens
+    | `At -> xWithAt
+    | _ -> xNoFlag in
+  mk_term c body
+
+let ssrdgens_of_parsed_dgens = function
+  | [], clr -> { dgens = []; gens = []; clr }
+  | [gens], clr -> { dgens = []; gens; clr }
+  | [dgens;gens], clr -> { dgens; gens; clr }
+  | _ -> assert false
+
+
+let nbargs_open_constr gl oc =
+  let pl, _ = splay_open_constr gl oc in List.length pl
+
+let pf_nbargs gl c = nbargs_open_constr gl (project gl, c)
+
+let internal_names = ref []
+let add_internal_name pt = internal_names := pt :: !internal_names
+let is_internal_name s = List.exists (fun p -> p s) !internal_names
+
+let tmp_tag = "_the_"
+let tmp_post = "_tmp_"
+let mk_tmp_id i =
+  Id.of_string (Printf.sprintf "%s%s%s" tmp_tag (CString.ordinal i) tmp_post)
+let new_tmp_id ctx =
+  let id = mk_tmp_id (1 + List.length ctx.tmp_ids) in
+  let orig = ref Anonymous in
+  (id, orig), { ctx with tmp_ids = (id, orig) :: ctx.tmp_ids }
+;;
+
+let mk_internal_id s =
+  let s' = Printf.sprintf "_%s_" s in
+  let s' = String.map (fun c -> if c = ' ' then '_' else c) s' in
+  add_internal_name ((=) s'); Id.of_string s'
+
+let same_prefix s t n =
+  let rec loop i = i = n || s.[i] = t.[i] && loop (i + 1) in loop 0
+
+let skip_digits s =
+  let n = String.length s in 
+  let rec loop i = if i < n && is_digit s.[i] then loop (i + 1) else i in loop
+
+let mk_tagged_id t i = Id.of_string (Printf.sprintf "%s%d_" t i)
+let is_tagged t s =
+  let n = String.length s - 1 and m = String.length t in
+  m < n && s.[n] = '_' && same_prefix s t m && skip_digits s m = n
+
+let evar_tag = "_evar_"
+let _ = add_internal_name (is_tagged evar_tag)
+let mk_evar_name n = Name (mk_tagged_id evar_tag n)
+
+let ssr_anon_hyp = "Hyp"
+
+let wildcard_tag = "_the_"
+let wildcard_post = "_wildcard_"
+let mk_wildcard_id i =
+  Id.of_string (Printf.sprintf "%s%s%s" wildcard_tag (CString.ordinal i) wildcard_post)
+let has_wildcard_tag s = 
+  let n = String.length s in let m = String.length wildcard_tag in
+  let m' = String.length wildcard_post in
+  n < m + m' + 2 && same_prefix s wildcard_tag m &&
+  String.sub s (n - m') m' = wildcard_post &&
+  skip_digits s m = n - m' - 2
+let _ = add_internal_name has_wildcard_tag
+
+let new_wild_id ctx =
+  let i = 1 + List.length ctx.wild_ids in
+  let id = mk_wildcard_id i in
+  id, { ctx with wild_ids = id :: ctx.wild_ids }
+
+let discharged_tag = "_discharged_"
+let mk_discharged_id id =
+  Id.of_string (Printf.sprintf "%s%s_" discharged_tag (Id.to_string id))
+let has_discharged_tag s =
+  let m = String.length discharged_tag and n = String.length s - 1 in
+  m < n && s.[n] = '_' && same_prefix s discharged_tag m
+let _ = add_internal_name has_discharged_tag
+let is_discharged_id id = has_discharged_tag (Id.to_string id)
+
+let max_suffix m (t, j0 as tj0) id  =
+  let s = Id.to_string id in let n = String.length s - 1 in
+  let dn = String.length t - 1 - n in let i0 = j0 - dn in
+  if not (i0 >= m && s.[n] = '_' && same_prefix s t m) then tj0 else
+  let rec loop i =
+    if i < i0 && s.[i] = '0' then loop (i + 1) else
+    if (if i < i0 then skip_digits s i = n else le_s_t i) then s, i else tj0
+  and le_s_t i =
+    let ds = s.[i] and dt = t.[i + dn] in
+    if ds = dt then i = n || le_s_t (i + 1) else
+    dt < ds && skip_digits s i = n in
+  loop m
+
+let mk_anon_id t gl_ids =
+  let m, si0, id0 =
+    let s = ref (Printf.sprintf  "_%s_" t) in
+    if is_internal_name !s then s := "_" ^ !s;
+    let n = String.length !s - 1 in
+    let rec loop i j =
+      let d = !s.[i] in if not (is_digit d) then i + 1, j else
+      loop (i - 1) (if d = '0' then j else i) in
+    let m, j = loop (n - 1) n in m, (!s, j), Id.of_string !s in
+  if not (List.mem id0 gl_ids) then id0 else
+  let s, i = List.fold_left (max_suffix m) si0 gl_ids in
+  let open Bytes in
+  let s = of_string s in
+  let n = length s - 1 in
+  let rec loop i =
+    if get s i = '9' then (set s i '0'; loop (i - 1)) else
+    if i < m then (set s n '0'; set s m '1'; cat s (of_string "_")) else
+    (set s i (Char.chr (Char.code (get s i) + 1)); s) in
+  Id.of_bytes (loop (n - 1))
+
+let convert_concl_no_check t = Tactics.convert_concl_no_check t Term.DEFAULTcast
+let convert_concl t = Tactics.convert_concl t Term.DEFAULTcast
+
+let rename_hd_prod orig_name_ref gl =
+  match EConstr.kind (project gl) (pf_concl gl) with
+  | Term.Prod(_,src,tgt) ->
+      Proofview.V82.of_tactic (convert_concl_no_check (EConstr.mkProd (!orig_name_ref,src,tgt))) gl
+  | _ -> CErrors.anomaly (str "gentac creates no product")
+
+(* Reduction that preserves the Prod/Let spine of the "in" tactical. *)
+
+let inc_safe n = if n = 0 then n else n + 1
+let rec safe_depth s c = match EConstr.kind s c with
+| LetIn (Name x, _, _, c') when is_discharged_id x -> safe_depth s c' + 1
+| LetIn (_, _, _, c') | Prod (_, _, c') -> inc_safe (safe_depth s c')
+| _ -> 0 
+
+let red_safe (r : Reductionops.reduction_function) e s c0 =
+  let rec red_to e c n = match EConstr.kind s c with
+  | Prod (x, t, c') when n > 0 ->
+    let t' = r e s t in let e' = EConstr.push_rel (RelDecl.LocalAssum (x, t')) e in
+    EConstr.mkProd (x, t', red_to e' c' (n - 1))
+  | LetIn (x, b, t, c') when n > 0 ->
+    let t' = r e s t in let e' = EConstr.push_rel (RelDecl.LocalAssum (x, t')) e in
+    EConstr.mkLetIn (x, r e s b, t', red_to e' c' (n - 1))
+  | _ -> r e s c in
+  red_to e c0 (safe_depth s c0)
+
+let is_id_constr sigma c = match EConstr.kind sigma c with
+  | Lambda(_,_,c) when EConstr.isRel sigma c -> 1 = EConstr.destRel sigma c
+  | _ -> false
+
+let red_product_skip_id env sigma c = match EConstr.kind sigma c with
+  | App(hd,args) when Array.length args = 1 && is_id_constr sigma hd -> args.(0)
+  | _ -> try Tacred.red_product env sigma c with _ -> c
+
+let ssrevaltac ist gtac = Tacinterp.tactic_of_value ist gtac
+
+(** Open term to lambda-term coercion  *)(* {{{ ************************************)
+
+(* This operation takes a goal gl and an open term (sigma, t), and   *)
+(* returns a term t' where all the new evars in sigma are abstracted *)
+(* with the mkAbs argument, i.e., for mkAbs = mkLambda then there is *)
+(* some duplicate-free array args of evars of sigma such that the    *)
+(* term mkApp (t', args) is convertible to t.                        *)
+(* This makes a useful shorthand for local definitions in proofs,    *)
+(* i.e., pose succ := _ + 1 means pose succ := fun n : nat => n + 1, *)
+(* and, in context of the 4CT library, pose mid := maps id means *)
+(*    pose mid := fun d : detaSet => @maps d d (@id (datum d))       *)
+(* Note that this facility does not extend to set, which tries       *)
+(* instead to fill holes by matching a goal subterm.                 *)
+(* The argument to "have" et al. uses product abstraction, e.g.      *)
+(*    have Hmid: forall s, (maps id s) = s.                          *)
+(* stands for                                                        *)
+(*    have Hmid: forall (d : dataSet) (s : seq d), (maps id s) = s.  *)
+(* We also use this feature for rewrite rules, so that, e.g.,        *)
+(*   rewrite: (plus_assoc _ 3).                                      *)
+(* will execute as                                                   *)
+(*   rewrite (fun n => plus_assoc n 3)                               *)
+(* i.e., it will rewrite some subterm .. + (3 + ..) to .. + 3 + ...  *)
+(* The convention is also used for the argument of the congr tactic, *)
+(* e.g., congr (x + _ * 1).                                          *)
+
+(* Replace new evars with lambda variables, retaining local dependencies *)
+(* but stripping global ones. We use the variable names to encode the    *)
+(* the number of dependencies, so that the transformation is reversible. *)
+
+let env_size env = List.length (Environ.named_context env)
+
+let pf_concl gl = EConstr.Unsafe.to_constr (pf_concl gl)
+let pf_get_hyp gl x = EConstr.Unsafe.to_named_decl (pf_get_hyp gl x)
+
+let pf_e_type_of gl t =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let sigma, ty = Typing.type_of env sigma t in
+  re_sig it sigma, ty
+
+let nf_evar sigma t = 
+  EConstr.Unsafe.to_constr (Evarutil.nf_evar sigma (EConstr.of_constr t))
+
+let pf_abs_evars2 gl rigid (sigma, c0) =
+  let c0 = EConstr.to_constr sigma c0 in
+  let sigma0, ucst = project gl, Evd.evar_universe_context sigma in
+  let nenv = env_size (pf_env gl) in
+  let abs_evar n k =
+    let evi = Evd.find sigma k in
+    let dc = CList.firstn n (evar_filtered_context evi) in
+    let abs_dc c = function
+    | NamedDecl.LocalDef (x,b,t) -> mkNamedLetIn x b t (mkArrow t c)
+    | 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 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
+  | _ -> 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 Constr.kind c with
+  | Evar (ev, a) ->
+    let j, n = lookup ev i evlist in
+    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)))
+  | _ -> 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
+  | [] -> c in
+  List.length evlist, EConstr.of_constr (loop (get 1 c0) 1 evlist), List.map fst evlist, ucst
+
+let pf_abs_evars gl t = pf_abs_evars2 gl [] t
+
+
+(* As before but if (?i : T(?j)) and (?j : P : Prop), then the lambda for i
+ * looks like (fun evar_i : (forall pi : P. T(pi))) thanks to "loopP" and all 
+ * occurrences of evar_i are replaced by (evar_i evar_j) thanks to "app".
+ *
+ * If P can be solved by ssrautoprop (that defaults to trivial), then
+ * the corresponding lambda looks like (fun evar_i : T(c)) where c is 
+ * the solution found by ssrautoprop.
+ *)
+let ssrautoprop_tac = ref (fun gl -> assert false)
+
+(* Thanks to Arnaud Spiwack for this snippet *)
+let call_on_evar tac e s =
+  let { it = gs ; sigma = s } =
+    tac { it = e ; sigma = s; } in
+  gs, s
+
+open Pp
+let pp _ = () (* FIXME *)
+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_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
+  let abs_evar n k =
+    let evi = Evd.find sigma k in
+    let dc = CList.firstn n (evar_filtered_context evi) in
+    let abs_dc c = function
+    | NamedDecl.LocalDef (x,b,t) -> mkNamedLetIn x b t (mkArrow t c)
+    | 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 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
+    let k_ty = 
+      Retyping.get_sort_family_of 
+        (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
+  | _ -> Constr.fold put evlist c in
+  let evlist = put [] c0 in
+  if evlist = [] then 0, c0 else
+  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,_) -> Evar.print k) evlist));
+  let evplist = 
+    let depev = List.fold_left (fun evs (_,(_,t,_)) -> 
+        let t = EConstr.of_constr t in
+        Intset.union evs (Evarutil.undefined_evars_of_term sigma t)) Intset.empty evlist in
+    List.filter (fun (i,(_,_,b)) -> b && Intset.mem i depev) evlist in
+  let evlist, evplist, sigma = 
+    if evplist = [] then evlist, [], sigma else
+    List.fold_left (fun (ev, evp, sigma) (i, (_,t,_) as p) ->
+      try 
+        let ng, sigma = call_on_evar !ssrautoprop_tac i sigma in
+        if (ng <> []) then errorstrm (str "Should we tell the user?");
+        List.filter (fun (j,_) -> j <> i) ev, evp, sigma
+      with _ -> ev, p::evp, sigma) (evlist, [], sigma) (List.rev evplist) in
+  let c0 = nf_evar sigma c0 in
+  let evlist = 
+    List.map (fun (x,(y,t,z)) -> x,(y,nf_evar sigma t,z)) evlist in
+  let evplist = 
+    List.map (fun (x,(y,t,z)) -> x,(y,nf_evar sigma t,z)) evplist in
+  pp(lazy(str"c0= " ++ pr_constr 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 Constr.kind c with
+  | Evar (ev, a) ->
+    let j, n = lookup ev i evlist in
+    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)))
+  | _ -> 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))
+  | _ -> 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
+    let n = Name (Id.of_string (ssr_anon_hyp ^ string_of_int n)) in 
+    loopP evlist (mkProd (n, t, c)) (i - 1) evl
+  | [] -> c in
+  let rec loop c i = function
+  | (_, (n, t, _)) :: evl ->
+    let evs = Evarutil.undefined_evars_of_term sigma (EConstr.of_constr t) in
+    let t_evplist = List.filter (fun (k,_) -> Intset.mem k evs) evplist in
+    let t = loopP t_evplist (get t_evplist 1 t) 1 t_evplist in
+    let t = get evlist (i - 1) t in
+    let extra_args = 
+      List.map (fun (k,_) -> mkRel (fst (lookup k i evlist))) 
+        (List.rev t_evplist) in
+    let c = if extra_args = [] then c else app extra_args 1 c in
+    loop (mkLambda (mk_evar_name n, t, c)) (i - 1) evl
+  | [] -> c in
+  let res = loop (get evlist 1 c0) 1 evlist in
+  pp(lazy(str"res= " ++ pr_constr res));
+  List.length evlist, res
+
+(* Strip all non-essential dependencies from an abstracted term, generating *)
+(* standard names for the abstracted holes.                                 *)
+
+let nb_evar_deps = function
+  | Name id ->
+    let s = Id.to_string id in
+    if not (is_tagged evar_tag s) then 0 else
+    let m = String.length evar_tag in
+    (try int_of_string (String.sub s m (String.length s - 1 - m)) with _ -> 0)
+  | _ -> 0
+
+let pf_type_id gl t = Id.of_string (Namegen.hdchar (pf_env gl) (project gl) t)
+let pfe_type_of gl t =
+  let sigma, ty = pf_type_of gl t in
+  re_sig (sig_it gl) sigma, ty
+let pf_type_of gl t =
+  let sigma, ty = pf_type_of gl (EConstr.of_constr t) in
+  re_sig (sig_it gl)  sigma, EConstr.Unsafe.to_constr ty
+
+let pf_abs_cterm gl n c0 =
+  if n <= 0 then c0 else
+  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 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
+    let dp = eva.(j) in
+    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)
+  | _ -> 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
+    i :: dl, mkProd (x, strip i t, c2)
+  | LetIn (x, b, t, c1) when i < j ->
+    let _, _, c1' = destProd c1 in
+    let dl, c2 = strip_ndeps j (i + 1) c1' in
+    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 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
+      let na' = List.length dl in
+      eva.(i) <- Array.of_list (na - na' :: dl);
+      let x' =
+        if na' = 0 then Name (pf_type_id gl (EConstr.of_constr t2)) else mk_evar_name na' in
+      mkLambda (x', t2, strip_evars (i + 1) c1)
+(*      if noccurn 1 c2 then lift (-1) c2 else
+      mkLambda (Name (pf_type_id gl t2), t2, c2) *)
+    | _ -> strip i c in
+  EConstr.of_constr (strip_evars 0 c0)
+
+(* }}} *)
+
+let pf_merge_uc uc gl =
+  re_sig (sig_it gl) (Evd.merge_universe_context (Refiner.project gl) uc)
+let pf_merge_uc_of sigma gl =
+  let ucst = Evd.evar_universe_context sigma in
+  pf_merge_uc ucst gl
+
+
+let rec constr_name sigma c = match EConstr.kind sigma c with
+  | Var id -> Name id
+  | Cast (c', _, _) -> constr_name sigma c'
+  | Const (cn,_) -> Name (Label.to_id (Constant.label cn))
+  | App (c', _) -> constr_name sigma c'
+  | _ -> Anonymous
+
+let pf_mkprod gl c ?(name=constr_name (project gl) c) cl =
+  let gl, t = pfe_type_of gl c in
+  if name <> Anonymous || EConstr.Vars.noccurn (project gl) 1 cl then gl, EConstr.mkProd (name, t, cl) else
+  gl, EConstr.mkProd (Name (pf_type_id gl t), t, cl)
+
+let pf_abs_prod name gl c cl = pf_mkprod gl c ~name (Termops.subst_term (project gl) c cl)
+
+(** look up a name in the ssreflect internals module *)
+let ssrdirpath = DirPath.make [Id.of_string "ssreflect"]
+let ssrqid name = Libnames.make_qualid ssrdirpath (Id.of_string name) 
+let ssrtopqid name = Libnames.qualid_of_ident (Id.of_string name) 
+let locate_reference qid =
+  Smartlocate.global_of_extended_global (Nametab.locate_extended qid)
+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 = (DAst.make @@ GRef (mkSsrRef name,None)), None
+let mkSsrConst name env sigma =
+  EConstr.fresh_global env sigma (mkSsrRef name)
+let pf_mkSsrConst name gl =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let (sigma, t) = mkSsrConst name env sigma in
+  t, re_sig it sigma
+let pf_fresh_global name gl =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let sigma,t  = Evd.fresh_global env sigma name in
+  t, re_sig it sigma
+
+let mkProt t c gl =
+  let prot, gl = pf_mkSsrConst "protect_term" gl in
+  EConstr.mkApp (prot, [|t; c|]), gl
+
+let mkEtaApp c n imin =
+  let open EConstr in
+  if n = 0 then c else
+  let nargs, mkarg =
+    if n < 0 then -n, (fun i -> mkRel (imin + i)) else
+    let imax = imin + n - 1 in n, (fun i -> mkRel (imax - i)) in
+  mkApp (c, Array.init nargs mkarg)
+
+let mkRefl t c gl =
+  let sigma = project gl in
+  let (sigma, refl) = EConstr.fresh_global (pf_env gl) sigma Coqlib.((build_coq_eq_data()).refl) in
+  EConstr.mkApp (refl, [|t; c|]), { gl with sigma }
+
+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 ~typecheck:true (EConstr.of_constr (mkProd (Name id', t, cl')))
+       [EConstr.of_constr (mkVar id)]) gl
+  | NamedDecl.LocalDef (_, v, t), _ ->
+     Proofview.V82.of_tactic
+       (convert_concl (EConstr.of_constr (mkLetIn (Name id', v, t, cl')))) gl
+
+(* wildcard names *)
+let clear_wilds wilds gl =
+  Proofview.V82.of_tactic (Tactics.clear (List.filter (fun id -> List.mem id wilds) (pf_ids_of_hyps gl))) gl
+
+let clear_with_wilds wilds clr0 gl =
+  let extend_clr clr nd =
+    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' = 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
+
+let clear_wilds_and_tmp_and_delayed_ids gl =
+  let _, ctx = pull_ctx gl in
+  tac_ctx
+   (tclTHEN
+    (clear_with_wilds ctx.wild_ids ctx.delayed_clears)
+    (clear_wilds (List.map fst ctx.tmp_ids @ ctx.wild_ids))) gl
+
+let rec is_name_in_ipats name = function
+  | IPatClear clr :: tl -> 
+      List.exists (function SsrHyp(_,id) -> id = name) clr 
+      || is_name_in_ipats name tl
+  | IPatId id :: tl -> id = name || is_name_in_ipats name tl
+  | IPatAbstractVars ids :: tl ->
+      CList.mem_f Id.equal name ids || is_name_in_ipats name tl
+  | (IPatCase l | IPatDispatch l | IPatInj l) :: tl ->
+      List.exists (is_name_in_ipats name) l || is_name_in_ipats name tl
+  | (IPatView _ | IPatAnon _ | IPatSimpl _ | IPatRewrite _ | IPatTac _ | IPatNoop) :: tl -> is_name_in_ipats name tl
+  | [] -> false
+
+let view_error s gv =
+  errorstrm (str ("Cannot " ^ s ^ " view ") ++ pr_term gv)
+
+
+open Locus
+(****************************** tactics ***********************************)
+
+let rewritetac dir c =
+  (* Due to the new optional arg ?tac, application shouldn't be too partial *)
+  Proofview.V82.of_tactic begin
+    Equality.general_rewrite (dir = L2R) AllOccurrences true false c
+  end
+
+(**********************`:********* hooks ************************************)
+
+type name_hint = (int * EConstr.types array) option ref
+
+let pf_abs_ssrterm ?(resolve_typeclasses=false) ist gl t =
+  let sigma, ct as t = interp_term ist gl t in
+  let sigma, _ as t =
+    let env = pf_env gl in
+    if not resolve_typeclasses then t
+    else
+       let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
+       sigma, Evarutil.nf_evar sigma ct in
+  let n, c, abstracted_away, ucst = pf_abs_evars gl t in
+  List.fold_left Evd.remove sigma abstracted_away, pf_abs_cterm gl n c, ucst, n
+
+let top_id = mk_internal_id "top assumption"
+
+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 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
+  let tacexpr = Loc.tag @@ Tacexpr.Reference (ArgArg (Loc.tag @@ tacname)) in
+  Proofview.V82.of_tactic (Tacinterp.eval_tactic (Tacexpr.TacArg tacexpr)) gl
+
+let donetac n gl = ssr_n_tac "done" n gl
+
+open Constrexpr
+open Util
+
+(** Constructors for constr_expr *)
+let mkCProp loc = CAst.make ?loc @@ CSort GProp
+let mkCType loc = CAst.make ?loc @@ CSort (GType [])
+let mkCVar ?loc id = CAst.make ?loc @@ CRef (CAst.make ?loc @@ Ident id, None)
+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 ([CLocalAssum([CAst.make ?loc name], Default Explicit, ty)], t)
+let mkCArrow ?loc ty t = CAst.make ?loc @@
+   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 = []
+let rec isCxHoles = function ({ CAst.v = CHole _ }, None) :: ch -> isCxHoles ch | _ -> false
+
+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 = 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)
+     | _ -> 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 (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
+     mk_term ' ' (force_type ty) in
+   let strip_cast (sigma, t) =
+     let rec aux t = match EConstr.kind_of_type sigma t with
+     | CastType (t, ty) when !n_binders = 0 && EConstr.isSort sigma ty -> t
+     | ProdType(n,s,t) -> decr n_binders; EConstr.mkProd (n, s, aux t)
+     | LetInType(n,v,ty,t) -> decr n_binders; EConstr.mkLetIn (n, v, ty, aux t)
+     | _ -> anomaly "pf_interp_ty: ssr Type cast deleted by typecheck" in
+     sigma, aux t in
+   let sigma, cty as ty = strip_cast (interp_term ist gl ty) in
+   let ty =
+     let env = pf_env gl in
+     if not resolve_typeclasses then ty
+     else
+       let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
+       sigma, Evarutil.nf_evar sigma cty in
+   let n, c, _, ucst = pf_abs_evars gl ty in
+   let lam_c = pf_abs_cterm gl n c in
+   let ctx, c = EConstr.decompose_lam_n_assum sigma n lam_c in
+   n, EConstr.it_mkProd_or_LetIn c ctx, lam_c, ucst
+;;
+
+(* TASSI: given (c : ty), generates (c ??? : ty[???/...]) with m evars *)
+exception NotEnoughProducts
+let saturate ?(beta=false) ?(bi_types=false) env sigma c ?(ty=Retyping.get_type_of env sigma c) m 
+=
+  let rec loop ty args sigma n = 
+  if n = 0 then 
+    let args = List.rev args in
+     (if beta then Reductionops.whd_beta sigma else fun x -> x)
+      (EConstr.mkApp (c, Array.of_list (List.map snd args))), ty, args, sigma 
+  else match EConstr.kind_of_type sigma ty with
+  | ProdType (_, src, tgt) ->
+      let sigma = create_evar_defs sigma in
+      let (sigma, x) =
+        Evarutil.new_evar env sigma
+          (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
+  | SortType _ -> assert false
+  | AtomicType _ ->
+      let ty =  (* FIXME *)
+        (Reductionops.whd_all env sigma) ty in
+      match EConstr.kind_of_type sigma ty with
+      | ProdType _ -> loop ty args sigma n
+      | _ -> raise NotEnoughProducts
+  in
+   loop ty [] sigma m
+
+let pf_saturate ?beta ?bi_types gl c ?ty m = 
+  let env, sigma, si = pf_env gl, project gl, sig_it gl in
+  let t, ty, args, sigma = saturate ?beta ?bi_types env sigma c ?ty m in
+  t, ty, args, re_sig si sigma 
+
+let pf_partial_solution gl t evl =
+  let sigma, g = project gl, sig_it gl in
+  let sigma = Goal.V82.partial_solution sigma g t in
+  re_sig (List.map (fun x -> (fst (EConstr.destEvar sigma x))) evl) sigma
+
+let dependent_apply_error =
+  try CErrors.user_err (Pp.str "Could not fill dependent hole in \"apply\"")
+  with err -> err
+
+(* TASSI: Sometimes Coq's apply fails. According to my experience it may be
+ * related to goals that are products and with beta redexes. In that case it
+ * guesses the wrong number of implicit arguments for your lemma. What follows
+ * is just like apply, but with a user-provided number n of implicits.
+ *
+ * Refine.refine function that handles type classes and evars but fails to
+ * handle "dependently typed higher order evars". 
+ *
+ * Refiner.refiner that does not handle metas with a non ground type but works
+ * with dependently typed higher order metas. *)
+let applyn ~with_evars ?beta ?(with_shelve=false) n t gl =
+  if with_evars then
+    let refine gl =
+      let t, ty, args, gl = pf_saturate ?beta ~bi_types:true gl t n in
+(*       pp(lazy(str"sigma@saturate=" ++ pr_evar_map None (project gl))); *)
+      let gl = pf_unify_HO gl ty (Tacmach.pf_concl gl) in
+      let gs = CList.map_filter (fun (_, e) ->
+        if EConstr.isEvar (project gl) e then Some e else None)
+        args in
+      pf_partial_solution gl t gs
+    in
+    Proofview.(V82.of_tactic
+      (tclTHEN (V82.tactic refine)
+        (if with_shelve then shelve_unifiable else tclUNIT ()))) gl
+  else
+    let t, gl = if n = 0 then t, gl else
+      let sigma, si = project gl, sig_it gl in
+      let rec loop sigma bo args = function (* saturate with metas *)
+        | 0 -> EConstr.mkApp (t, Array.of_list (List.rev args)), re_sig si sigma 
+        | n -> match EConstr.kind sigma bo with
+          | Lambda (_, ty, bo) -> 
+              if not (EConstr.Vars.closed0 sigma ty) then
+                raise dependent_apply_error;
+              let m = Evarutil.new_meta () in
+              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_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 =
+  let rec mkRels = function 1 -> [] | n -> mkRel n :: mkRels (n-1) in
+  let uct = Evd.evar_universe_context (fst oc) in
+  let n, oc = pf_abs_evars_pirrel gl (fst oc, EConstr.Unsafe.to_constr (snd oc)) in
+  let gl = pf_unsafe_merge_uc uct gl in
+  let oc = if not first_goes_last || n <= 1 then oc else
+    let l, c = decompose_lam oc in
+    if not (List.for_all_i (fun i (_,t) -> Vars.closedn ~-i t) (1-n) l) then oc else
+    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_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
+
+(** Profiling *)(* {{{ *************************************************************)
+type profiler = { 
+  profile : 'a 'b. ('a -> 'b) -> 'a -> 'b;
+  reset : unit -> unit;
+  print : unit -> unit }
+let profile_now = ref false
+let something_profiled = ref false
+let profilers = ref []
+let add_profiler f = profilers := f :: !profilers;;
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optname  = "ssreflect profiling";
+      Goptions.optkey   = ["SsrProfiling"];
+      Goptions.optread  = (fun _ -> !profile_now);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b -> 
+        Ssrmatching.profile b;
+        profile_now := b;
+        if b then List.iter (fun f -> f.reset ()) !profilers;
+        if not b then List.iter (fun f -> f.print ()) !profilers) }
+let () =
+  let prof_total = 
+    let init = ref 0.0 in { 
+    profile = (fun f x -> assert false);
+    reset = (fun () -> init := Unix.gettimeofday ());
+    print = (fun () -> if !something_profiled then
+        prerr_endline 
+           (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f"
+           "total" 0 (Unix.gettimeofday() -. !init) 0.0 0.0)) } in
+  let prof_legenda = {
+    profile = (fun f x -> assert false);
+    reset = (fun () -> ());
+    print = (fun () -> if !something_profiled then begin
+        prerr_endline 
+           (Printf.sprintf "!! %39s ---------- --------- --------- ---------" 
+           (String.make 39 '-'));
+        prerr_endline 
+           (Printf.sprintf "!! %-39s %10s %9s %9s %9s" 
+           "function" "#calls" "total" "max" "average") end) } in
+  add_profiler prof_legenda;
+  add_profiler prof_total
+;;
+
+let mk_profiler s =
+  let total, calls, max = ref 0.0, ref 0, ref 0.0 in
+  let reset () = total := 0.0; calls := 0; max := 0.0 in
+  let profile f x =
+    if not !profile_now then f x else
+    let before = Unix.gettimeofday () in
+    try
+      incr calls;
+      let res = f x in
+      let after = Unix.gettimeofday () in
+      let delta = after -. before in
+      total := !total +. delta;
+      if delta > !max then max := delta;
+      res
+    with exc ->
+      let after = Unix.gettimeofday () in
+      let delta = after -. before in
+      total := !total +. delta;
+      if delta > !max then max := delta;
+      raise exc in
+  let print () =
+     if !calls <> 0 then begin
+       something_profiled := true;
+       prerr_endline
+         (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f" 
+         s !calls !total !max (!total /. (float_of_int !calls))) end in
+  let prof = { profile = profile; reset = reset; print = print } in
+  add_profiler prof;
+  prof
+;;
+(* }}} *)
+
+(* We wipe out all the keywords generated by the grammar rules we defined. *)
+(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
+(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
+(* consequence the extended ssreflect grammar.                             *)
+let () = CLexer.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 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.")
+         else Tacticals.New.tclTHEN Tactics.hnf_in_concl (fst_prod true tac)
+end
+
+let introid ?(orig=ref Anonymous) name = tclTHEN (fun gl ->
+   let g, env = Tacmach.pf_concl gl, pf_env gl in
+   let sigma = project gl in
+   match EConstr.kind sigma g with
+   | App (hd, _) when EConstr.isLambda sigma hd -> 
+      Proofview.V82.of_tactic (convert_concl_no_check (Reductionops.whd_beta sigma g)) gl
+   | _ -> tclIDTAC gl)
+  (Proofview.V82.of_tactic
+    (fst_prod false (fun id -> orig := id; Tactics.intro_mustbe_force name)))
+;;
+
+let anontac decl gl =
+  let id =  match RelDecl.get_name decl with
+  | Name id ->
+    if is_discharged_id id then id else mk_anon_id (Id.to_string id) (Tacmach.pf_ids_of_hyps gl)
+  | _ -> mk_anon_id ssr_anon_hyp (Tacmach.pf_ids_of_hyps gl) in
+  introid id gl
+
+let rec intro_anon gl =
+  try anontac (List.hd (fst (EConstr.decompose_prod_n_assum (project gl) 1 (Tacmach.pf_concl gl)))) gl
+  with err0 -> try tclTHEN (Proofview.V82.of_tactic Tactics.red_in_concl) intro_anon gl with e when CErrors.noncritical e -> raise err0
+  (* with _ -> CErrors.error "No product even after reduction" *)
+
+let is_pf_var sigma c =
+  EConstr.isVar sigma c && not_section_id (EConstr.destVar sigma c)
+
+let hyp_of_var sigma v = SsrHyp (Loc.tag @@ EConstr.destVar sigma v)
+
+let interp_clr sigma = function
+| Some clr, (k, c) 
+  when (k = xNoFlag  || k = xWithAt) && is_pf_var sigma c ->
+   hyp_of_var sigma c :: clr 
+| Some clr, _ -> clr
+| None, _ -> []
+
+(** Basic tacticals *)
+
+(** Multipliers *)(* {{{ ***********************************************************)
+
+(* tactical *)
+
+let tclID tac = tac
+
+let tclDOTRY n tac =
+  if n <= 0 then tclIDTAC else
+  let rec loop i gl =
+    if i = n then tclTRY tac gl else
+    tclTRY (tclTHEN tac (loop (i + 1))) gl in
+  loop 1
+
+let tclDO n tac =
+  let prefix i = str"At iteration " ++ int i ++ str": " in
+  let tac_err_at i gl =
+    try tac gl
+    with 
+    | CErrors.UserError (l, s) as e ->
+        let _, info = CErrors.push e in
+        let e' = CErrors.UserError (l, prefix i ++ s) in
+        Util.iraise (e', info)
+    | Ploc.Exc(loc, CErrors.UserError (l, s))  -> 
+        raise (Ploc.Exc(loc, CErrors.UserError (l, prefix i ++ s))) in
+  let rec loop i gl =
+    if i = n then tac_err_at i gl else
+    (tclTHEN (tac_err_at i) (loop (i + 1))) gl in
+  loop 1
+
+let tclMULT = function
+  | 0, May  -> tclREPEAT
+  | 1, May  -> tclTRY
+  | n, May  -> tclDOTRY n
+  | 0, Must -> tclAT_LEAST_ONCE
+  | n, Must when n > 1 -> tclDO n
+  | _       -> tclID
+
+let old_cleartac clr = check_hyps_uniq [] clr; Proofview.V82.of_tactic (Tactics.clear (hyps_ids clr))
+let cleartac clr = check_hyps_uniq [] clr; Tactics.clear (hyps_ids clr)
+
+(* }}} *)
+
+(** Generalize tactic *)
+
+(* XXX the k of the redex should percolate out *)
+let pf_interp_gen_aux gl to_ind ((oclr, occ), t) =
+  let pat = interp_cpattern gl t None in (* UGLY API *)
+  let cl, env, sigma = Tacmach.pf_concl gl, pf_env gl, project gl in
+  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
+  if not(occur_existential sigma c) then
+    if tag_of_cpattern t = xWithAt then 
+      if not (EConstr.isVar sigma c) then
+	errorstrm (str "@ can be used with variables only")
+      else match Tacmach.pf_get_hyp gl (EConstr.destVar sigma c) with
+      | NamedDecl.LocalAssum _ -> errorstrm (str "@ can be used with let-ins only")
+      | NamedDecl.LocalDef (name, b, ty) -> true, pat, EConstr.mkLetIn (Name name,b,ty,cl),c,clr,ucst,gl
+    else let gl, ccl =  pf_mkprod gl c cl in false, pat, ccl, c, clr,ucst,gl
+  else if to_ind && occ = None then
+    let nv, p, _, ucst' = pf_abs_evars gl (fst pat, c) in
+    let ucst = UState.union ucst ucst' in
+    if nv = 0 then anomaly "occur_existential but no evars" else
+    let gl, pty = pfe_type_of gl p in
+    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 ~typecheck:true x xs)
+
+let genclrtac cl cs clr =
+  let tclmyORELSE tac1 tac2 gl =
+    try tac1 gl
+    with e when CErrors.noncritical e -> tac2 e gl in
+  (* apply_type may give a type error, but the useful message is
+   * the one of clear.  You type "move: x" and you get
+   * "x is used in hyp H" instead of
+   * "The term H has type T x but is expected to have type T x0". *)
+  tclTHEN
+    (tclmyORELSE
+      (apply_type cl cs)
+      (fun type_err gl ->
+         tclTHEN
+           (tclTHEN (Proofview.V82.of_tactic (Tactics.elim_type (EConstr.of_constr
+             (Universes.constr_of_global @@ Coqlib.build_coq_False ())))) (old_cleartac clr))
+           (fun gl -> raise type_err)
+           gl))
+    (old_cleartac clr)
+
+let gentac gen gl =
+(*   ppdebug(lazy(str"sigma@gentac=" ++ pr_evar_map None (project gl))); *)
+  let conv, _, cl, c, clr, ucst,gl = pf_interp_gen_aux gl false gen in
+  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)) (old_cleartac clr) gl
+  else genclrtac cl [c] clr gl
+
+let genstac (gens, clr) =
+  tclTHENLIST (old_cleartac clr :: List.rev_map gentac gens)
+
+let gen_tmp_ids
+  ?(ist=Geninterp.({ lfun = Id.Map.empty; extra = Tacinterp.TacStore.empty })) gl
+=
+  let gl, ctx = pull_ctx gl in
+  push_ctxs ctx
+    (tclTHENLIST
+      (List.map (fun (id,orig_ref) ->
+        tclTHEN 
+        (gentac ((None,Some(false,[])),cpattern_of_id id))
+        (rename_hd_prod orig_ref))
+      ctx.tmp_ids) gl)
+;;
+
+let pf_interp_gen gl to_ind gen =
+  let _, _, a, b, c, ucst,gl = pf_interp_gen_aux gl to_ind gen in
+  a, b ,c, pf_merge_uc ucst gl
+
+(* TASSI: This version of unprotects inlines the unfold tactic definition, 
+ * since we don't want to wipe out let-ins, and it seems there is no flag
+ * to change that behaviour in the standard unfold code *)
+let unprotecttac gl =
+  let c, gl = pf_mkSsrConst "protect_term" gl in
+  let prot, _ = EConstr.destConst (project gl) c in
+  Tacticals.onClause (fun idopt ->
+    let hyploc = Option.map (fun id -> id, InHyp) idopt in
+    Proofview.V82.of_tactic (Tactics.reduct_option 
+      (Reductionops.clos_norm_flags 
+        (CClosure.RedFlags.mkflags 
+          [CClosure.RedFlags.fBETA;
+           CClosure.RedFlags.fCONST prot;
+           CClosure.RedFlags.fMATCH;
+           CClosure.RedFlags.fFIX;
+           CClosure.RedFlags.fCOFIX]), DEFAULTcast) hyploc))
+    allHypsAndConcl gl
+
+let is_protect hd env sigma =
+  let _, protectC = mkSsrConst "protect_term" env sigma in
+  EConstr.eq_constr_nounivs sigma hd protectC
+
+let abs_wgen keep_let f gen (gl,args,c) =
+  let sigma, env = project gl, pf_env gl in
+  let evar_closed t p =
+    if occur_existential sigma t then
+      CErrors.user_err ?loc:(loc_of_cpattern p) ~hdr:"ssreflect"
+        (pr_constr_pat (EConstr.Unsafe.to_constr t) ++
+        str" contains holes and matches no subterm of the goal") in
+  match gen with
+  | _, Some ((x, mode), None) when mode = "@" || (mode = " " && keep_let) ->
+     let x = hoi_id x in
+     let decl = Tacmach.pf_get_hyp gl x in
+     gl,
+     (if NamedDecl.is_local_def decl then args else EConstr.mkVar x :: args),
+     EConstr.mkProd_or_LetIn (decl |> NamedDecl.to_rel_decl |> RelDecl.set_name (Name (f x)))
+                     (EConstr.Vars.subst_var x c)
+  | _, Some ((x, _), None) ->
+     let x = hoi_id x in
+     gl, EConstr.mkVar x :: args, EConstr.mkProd (Name (f x),Tacmach.pf_get_hyp_typ gl x, EConstr.Vars.subst_var x c)
+  | _, Some ((x, "@"), Some p) -> 
+     let x = hoi_id x in
+     let cp = interp_cpattern gl p None in
+     let (t, ucst), c =
+       try fill_occ_pattern ~raise_NoMatch:true env sigma (EConstr.Unsafe.to_constr c) cp None 1
+       with NoMatch -> redex_of_pattern env cp, (EConstr.Unsafe.to_constr c) in
+     let c = EConstr.of_constr c in
+     let t = EConstr.of_constr t in
+     evar_closed t p;
+     let ut = red_product_skip_id env sigma t in
+     let gl, ty = pfe_type_of gl t in
+     pf_merge_uc ucst gl, args, EConstr.mkLetIn(Name (f x), ut, ty, c)
+  | _, Some ((x, _), Some p) ->
+     let x = hoi_id x in
+     let cp = interp_cpattern gl p None in
+     let (t, ucst), c =
+       try fill_occ_pattern ~raise_NoMatch:true env sigma (EConstr.Unsafe.to_constr c) cp None 1
+       with NoMatch -> redex_of_pattern env cp, (EConstr.Unsafe.to_constr c) in
+     let c = EConstr.of_constr c in
+     let t = EConstr.of_constr t in
+     evar_closed t p;
+     let gl, ty = pfe_type_of gl t in
+     pf_merge_uc ucst gl, t :: args, EConstr.mkProd(Name (f x), ty, c)
+  | _ -> gl, args, c
+
+let clr_of_wgen gen clrs = match gen with
+  | clr, Some ((x, _), None) ->
+     let x = hoi_id x in
+     old_cleartac clr :: old_cleartac [SsrHyp(Loc.tag x)] :: clrs
+  | clr, _ -> old_cleartac clr :: clrs
+
+
+let reduct_in_concl t = Tactics.reduct_in_concl (t, DEFAULTcast)
+let unfold cl =
+  let module R = Reductionops in let module F = CClosure.RedFlags in
+  reduct_in_concl (R.clos_norm_flags (F.mkflags
+    (List.map (fun c -> F.fCONST (fst (destConst (EConstr.Unsafe.to_constr c)))) cl @
+       [F.fBETA; F.fMATCH; F.fFIX; F.fCOFIX])))
+
+open Proofview
+open Notations
+
+let tacSIGMA = Goal.enter_one begin fun g ->
+  let k = Goal.goal g in
+  let sigma = Goal.sigma g in
+  tclUNIT (Tacmach.re_sig k sigma)
+end
+
+let tclINTERP_AST_CLOSURE_TERM_AS_CONSTR c =
+  tclINDEPENDENTL begin tacSIGMA >>= fun gl ->
+  let old_ssrterm = mkRHole, Some c.Ssrast.body in
+  let ist =
+    option_assert_get c.Ssrast.interp_env
+      Pp.(str "tclINTERP_AST_CLOSURE_TERM_AS_CONSTR: term with no ist") in
+  let sigma, t =
+    interp_wit Stdarg.wit_constr ist gl old_ssrterm in
+  Unsafe.tclEVARS sigma <*>
+  tclUNIT t
+end
+
+let tacREDUCE_TO_QUANTIFIED_IND ty =
+  tacSIGMA >>= fun gl ->
+  tclUNIT (Tacmach.pf_reduce_to_quantified_ind gl ty)
+
+let tacTYPEOF c = Goal.enter_one ~__LOC__ (fun g ->
+  let sigma, env = Goal.sigma g, Goal.env g in
+  let sigma, ty = Typing.type_of env sigma c in
+  Unsafe.tclEVARS sigma <*> tclUNIT ty)
+
+(** This tactic creates a partial proof realizing the introduction rule, but
+    does not check anything. *)
+let unsafe_intro env store decl b =
+  let open Context.Named.Declaration in
+  Refine.refine ~typecheck:false begin fun sigma ->
+    let ctx = Environ.named_context_val env in
+    let nctx = EConstr.push_named_context_val decl ctx in
+    let inst = List.map (get_id %> EConstr.mkVar) (Environ.named_context env) in
+    let ninst = EConstr.mkRel 1 :: inst in
+    let nb = EConstr.Vars.subst1 (EConstr.mkVar (get_id decl)) b in
+    let sigma, ev =
+      Evarutil.new_evar_instance nctx sigma nb ~principal:true ~store ninst in
+    sigma, EConstr.mkNamedLambda_or_LetIn decl ev
+  end
+
+let set_decl_id id = let open Context in function
+  | Rel.Declaration.LocalAssum(name,ty) -> Named.Declaration.LocalAssum(id,ty)
+  | Rel.Declaration.LocalDef(name,ty,t) -> Named.Declaration.LocalDef(id,ty,t)
+
+let rec decompose_assum env sigma orig_goal =
+  let open Context in
+  match EConstr.kind sigma orig_goal with
+  | Prod(name,ty,t) ->
+      Rel.Declaration.LocalAssum(name,ty), t, true
+  | LetIn(name,ty,t1,t2) -> Rel.Declaration.LocalDef(name, ty, t1), t2, true
+  | _ ->
+      let goal = Reductionops.whd_allnolet env sigma orig_goal in
+      match EConstr.kind sigma goal with
+      | Prod(name,ty,t) -> Rel.Declaration.LocalAssum(name,ty), t, false
+      | LetIn(name,ty,t1,t2) -> Rel.Declaration.LocalDef(name,ty,t1), t2, false
+      | App(hd,args) when EConstr.isLetIn sigma hd -> (* hack *)
+          let _,v,_,b = EConstr.destLetIn sigma hd in
+          let ctx, t, _ =
+            decompose_assum env sigma
+              (EConstr.mkApp (EConstr.Vars.subst1 v b, args)) in
+          ctx, t, false
+      | _ -> CErrors.user_err
+          Pp.(str "No assumption in " ++ Printer.pr_econstr_env env sigma goal)
+
+let tclFULL_BETAIOTA = Goal.enter begin fun gl ->
+  let r, _ = Redexpr.reduction_of_red_expr (Goal.env gl)
+    Genredexpr.(Lazy {
+      rBeta=true; rMatch=true; rFix=true; rCofix=true;
+      rZeta=false; rDelta=false; rConst=[]}) in
+  Tactics.e_reduct_in_concl ~check:false (r,Constr.DEFAULTcast)
+end
+
+(** [intro id k] introduces the first premise (product or let-in) of the goal
+    under the name [id], reducing the head of the goal (using beta, iota, delta
+    but not zeta) if necessary. If [id] is None, a name is generated, that will
+    not be user accessible. If the goal does not start with a product or a
+let-in even after reduction, it fails. In case of success, the original name
+and final id are passed to the continuation [k] which gets evaluated. *)
+let tclINTRO ~id ~conclusion:k = Goal.enter begin fun gl ->
+  let open Context in
+  let env, sigma, extra, g = Goal.(env gl, sigma gl, extra gl, concl gl) in
+  let decl, t, no_red = decompose_assum env sigma g in
+  let original_name = Rel.Declaration.get_name decl in
+  let already_used = Tacmach.New.pf_ids_of_hyps gl in
+  let id = match id, original_name with
+    | Some id, _ -> id
+    | _, Name id ->
+       if is_discharged_id id then id
+       else mk_anon_id (Id.to_string id) already_used
+    | _, _ ->
+       let ids = Tacmach.New.pf_ids_of_hyps gl in
+       mk_anon_id ssr_anon_hyp ids
+  in
+  if List.mem id already_used then
+    errorstrm Pp.(Id.print id ++ str" already used");
+  unsafe_intro env extra (set_decl_id id decl) t <*>
+  (if no_red then tclUNIT () else tclFULL_BETAIOTA) <*>
+  k ~orig_name:original_name ~new_name:id
+end
+
+let return ~orig_name:_ ~new_name:_ = tclUNIT ()
+
+let tclINTRO_ID id = tclINTRO ~id:(Some id) ~conclusion:return
+let tclINTRO_ANON = tclINTRO ~id:None ~conclusion:return
+
+let tclRENAME_HD_PROD name = Goal.enter begin fun gl ->
+  let convert_concl_no_check t =
+    Tactics.convert_concl_no_check t Term.DEFAULTcast in
+  let concl = Goal.concl gl in
+  let sigma = Goal.sigma gl in
+  match EConstr.kind sigma concl with
+  | Prod(_,src,tgt) ->
+      convert_concl_no_check EConstr.(mkProd (name,src,tgt))
+  | _ -> CErrors.anomaly (Pp.str "rename_hd_prod: no head product")
+end
+
+let tcl0G tac =
+  numgoals >>= fun ng -> if ng = 0 then tclUNIT () else tac
+
+let rec tclFIRSTa = function
+  | [] -> Tacticals.New.tclZEROMSG Pp.(str"No applicable tactic.")
+  | tac :: rest -> tclORELSE tac (fun _ -> tclFIRSTa rest)
+
+let rec tclFIRSTi tac n =
+  if n < 0 then Tacticals.New.tclZEROMSG Pp.(str "tclFIRSTi")
+  else tclORELSE (tclFIRSTi tac (n-1)) (fun _ -> tac n)
+
+let tacCONSTR_NAME ?name c =
+  match name with
+  | Some n -> tclUNIT n
+  | None ->
+      Goal.enter_one ~__LOC__ (fun g ->
+        let sigma = Goal.sigma g in
+        tclUNIT (constr_name sigma c))
+
+let tacMKPROD c ?name cl =
+  tacTYPEOF c >>= fun t ->
+  tacCONSTR_NAME ?name c >>= fun name ->
+  Goal.enter_one ~__LOC__ begin fun g ->
+    let sigma, env = Goal.sigma g, Goal.env g in
+    if name <> Names.Name.Anonymous || EConstr.Vars.noccurn sigma  1 cl
+    then tclUNIT (EConstr.mkProd (name, t, cl))
+    else
+      let name = Names.Id.of_string (Namegen.hdchar env sigma t) in
+      tclUNIT (EConstr.mkProd (Names.Name.Name name, t, cl))
+end
+
+let tacINTERP_CPATTERN cp =
+  tacSIGMA >>= begin fun gl ->
+  tclUNIT (Ssrmatching.interp_cpattern gl cp None)
+end
+
+let tacUNIFY a b =
+  tacSIGMA >>= begin fun gl ->
+  let gl = Ssrmatching.pf_unify_HO gl a b in
+  Unsafe.tclEVARS (Tacmach.project gl)
+end
+
+let tclOPTION o d =
+  match o with
+  | None -> d >>= tclUNIT
+  | Some x -> tclUNIT x
+
+let tacIS_INJECTION_CASE ?ty t = begin
+  tclOPTION ty (tacTYPEOF t) >>= fun ty ->
+  tacREDUCE_TO_QUANTIFIED_IND ty >>= fun ((mind,_),_) ->
+  tclUNIT (Globnames.eq_gr (Globnames.IndRef mind) (Coqlib.build_coq_eq ()))
+end
+
+let tclWITHTOP tac = Goal.enter begin fun gl ->
+  let top =
+    mk_anon_id "top_assumption" (Tacmach.New.pf_ids_of_hyps gl) in
+  tclINTRO_ID top <*>
+  tac (EConstr.mkVar top) <*>
+  Tactics.clear [top]
+end
+
+let tacMK_SSR_CONST name = Goal.enter_one ~__LOC__ begin fun g ->
+  let sigma, env = Goal.(sigma g, env g) in
+  let sigma, c = mkSsrConst name env sigma in
+  Unsafe.tclEVARS sigma <*>
+  tclUNIT c
+end
+
+module type StateType = sig
+  type state
+  val init : state
+end
+
+module MakeState(S : StateType) = struct
+
+let state_field : S.state Proofview_monad.StateStore.field =
+  Proofview_monad.StateStore.field ()
+
+(* FIXME: should not inject fresh_state, but initialize it at the beginning *)
+let lift_upd_state upd s =
+  let open Proofview_monad.StateStore in
+  let old_state = Option.default S.init (get s state_field) in
+  upd old_state >>= fun new_state ->
+  tclUNIT (set s state_field new_state)
+
+let tacUPDATE upd = Goal.enter begin fun gl ->
+  let s0 = Goal.state gl in
+  Goal.enter_one ~__LOC__ (fun _ -> lift_upd_state upd s0) >>= fun s ->
+  Unsafe.tclGETGOALS >>= fun gls ->
+  let gls = List.map (fun gs ->
+    let g = Proofview_monad.drop_state gs in
+    Proofview_monad.goal_with_state g s) gls in
+  Unsafe.tclSETGOALS gls
+end
+
+let tclGET k = Goal.enter begin fun gl ->
+  let open Proofview_monad.StateStore in
+  k (Option.default S.init (get (Goal.state gl) state_field))
+end
+
+let tclSET new_s =
+  let open Proofview_monad.StateStore in
+  Unsafe.tclGETGOALS >>= fun gls ->
+  let gls = List.map (fun gs ->
+    let g = Proofview_monad.drop_state gs in
+    let s = Proofview_monad.get_state gs in
+    Proofview_monad.goal_with_state g (set s state_field new_s)) gls in
+  Unsafe.tclSETGOALS gls
+
+let get g =
+  Option.default S.init
+    (Proofview_monad.StateStore.get (Goal.state g) state_field)
+
+end
+
+
+(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli
new file mode 100644
index 00000000..2b8f1d54
--- /dev/null
+++ b/plugins/ssr/ssrcommon.mli
@@ -0,0 +1,482 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Tacmach
+open Names
+open Environ
+open Evd
+open Constrexpr
+open Ssrast
+
+open Ltac_plugin
+open Genarg
+
+open Ssrmatching_plugin
+
+val allocc : ssrocc
+
+(******************************** hyps ************************************)
+
+val hyp_id : ssrhyp -> Id.t
+val hyps_ids : ssrhyps -> Id.t list
+val check_hyp_exists : ('a, 'b) Context.Named.pt -> ssrhyp -> unit
+val test_hypname_exists : ('a, 'b) Context.Named.pt -> Id.t -> bool
+val check_hyps_uniq : Id.t list -> ssrhyps -> unit
+val not_section_id : Id.t -> bool
+val hyp_err : ?loc:Loc.t -> string -> Id.t -> 'a
+val hoik : (ssrhyp -> 'a) -> ssrhyp_or_id -> 'a
+val hoi_id : ssrhyp_or_id -> Id.t
+
+(******************************* hints ***********************************)
+
+val mk_hint : 'a -> 'a ssrhint 
+val mk_orhint : 'a -> bool * 'a
+val nullhint : bool * 'a list
+val nohint : 'a ssrhint
+
+(******************************** misc ************************************)
+
+val errorstrm : Pp.t -> 'a
+val anomaly : string -> 'a
+
+val array_app_tl : 'a array -> 'a list -> 'a list
+val array_list_of_tl : 'a array -> 'a list
+val array_fold_right_from : int -> ('a -> 'b -> 'b) -> 'a array -> 'b -> 'b
+
+val option_assert_get : 'a option -> Pp.t -> 'a
+
+(**************************** lifted tactics ******************************)
+
+(* tactics with extra data attached to each goals, e.g. the list of
+ * temporary variables to be cleared *)
+type 'a tac_a = (goal * 'a) sigma -> (goal * 'a) list sigma
+
+(* Thread around names to be cleared or generalized back, and the speed *)
+type tac_ctx = {
+  tmp_ids : (Id.t * Name.t ref) list;
+  wild_ids : Id.t list;
+  (* List of variables to be cleared at the end of the sentence *)
+  delayed_clears : Id.t list;
+}
+
+val new_ctx : unit -> tac_ctx (* REMOVE *)
+val pull_ctxs : ('a * tac_ctx) list  sigma -> 'a list sigma * tac_ctx list (* REMOVE *)
+
+val with_fresh_ctx : tac_ctx tac_a -> tactic
+
+val pull_ctx : ('a * tac_ctx) sigma -> 'a sigma * tac_ctx
+val push_ctx : tac_ctx -> 'a sigma -> ('a * tac_ctx) sigma
+val push_ctxs : tac_ctx -> 'a list sigma -> ('a * tac_ctx) list sigma
+val tac_ctx : tactic -> tac_ctx tac_a
+val with_ctx :
+  (tac_ctx -> 'b * tac_ctx) -> ('a * tac_ctx) sigma -> 'b * ('a * tac_ctx) sigma
+val without_ctx : ('a sigma -> 'b) -> ('a * tac_ctx) sigma -> 'b
+
+(* Standard tacticals lifted to the tac_a type *)
+val tclTHENLIST_a : tac_ctx tac_a list -> tac_ctx tac_a
+val tclTHEN_i_max :
+  tac_ctx tac_a -> (int -> int -> tac_ctx tac_a) -> tac_ctx tac_a
+val tclTHEN_a : tac_ctx tac_a -> tac_ctx tac_a -> tac_ctx tac_a
+val tclTHENS_a : tac_ctx tac_a -> tac_ctx tac_a list -> tac_ctx tac_a
+
+val tac_on_all :
+  (goal * tac_ctx) list sigma -> tac_ctx tac_a -> (goal * tac_ctx) list sigma
+(************************ ssr tactic arguments ******************************)
+
+
+(*********************** Misc helpers *****************************)
+val mkRHole : Glob_term.glob_constr
+val mkRHoles : int -> Glob_term.glob_constr list
+val isRHoles : Glob_term.glob_constr list -> bool
+val mkRApp : Glob_term.glob_constr -> Glob_term.glob_constr list -> Glob_term.glob_constr
+val mkRVar : Id.t -> Glob_term.glob_constr
+val mkRltacVar : Id.t -> Glob_term.glob_constr
+val mkRCast : Glob_term.glob_constr ->  Glob_term.glob_constr ->  Glob_term.glob_constr
+val mkRType : Glob_term.glob_constr
+val mkRProp : Glob_term.glob_constr
+val mkRArrow : Glob_term.glob_constr ->  Glob_term.glob_constr ->  Glob_term.glob_constr
+val mkRConstruct : Names.constructor -> Glob_term.glob_constr
+val mkRInd : Names.inductive -> Glob_term.glob_constr
+val mkRLambda : Name.t -> Glob_term.glob_constr ->  Glob_term.glob_constr ->  Glob_term.glob_constr
+val mkRnat : int -> Glob_term.glob_constr
+
+
+val mkCHole : Loc.t option -> constr_expr
+val mkCHoles : ?loc:Loc.t -> int -> constr_expr list
+val mkCVar : ?loc:Loc.t -> Id.t -> constr_expr
+val mkCCast : ?loc:Loc.t -> constr_expr ->  constr_expr ->  constr_expr
+val mkCType : Loc.t option -> constr_expr
+val mkCProp : Loc.t option -> constr_expr
+val mkCArrow : ?loc:Loc.t -> constr_expr ->  constr_expr ->  constr_expr
+val mkCLambda : ?loc:Loc.t -> Name.t -> constr_expr ->  constr_expr ->  constr_expr
+
+val isCHoles : constr_expr list -> bool
+val isCxHoles : (constr_expr * 'a option) list -> bool
+
+val intern_term : 
+  Tacinterp.interp_sign -> env ->
+    ssrterm -> Glob_term.glob_constr
+
+val pf_intern_term :
+  Tacinterp.interp_sign -> Goal.goal Evd.sigma ->
+    ssrterm -> Glob_term.glob_constr
+
+val interp_term :
+  Tacinterp.interp_sign -> Goal.goal Evd.sigma ->
+    ssrterm -> evar_map * EConstr.t
+
+val interp_wit :
+  ('a, 'b, 'c) genarg_type -> ist -> goal sigma -> 'b -> evar_map * 'c
+
+val interp_hyp : ist -> goal sigma -> ssrhyp -> evar_map * ssrhyp
+val interp_hyps : ist -> goal sigma -> ssrhyps -> evar_map * ssrhyps
+
+val interp_refine :
+  Tacinterp.interp_sign -> Goal.goal Evd.sigma ->
+    Glob_term.glob_constr -> evar_map * (evar_map * EConstr.constr)
+
+val interp_open_constr :
+  Tacinterp.interp_sign -> Goal.goal Evd.sigma ->
+    Tacexpr.glob_constr_and_expr -> evar_map * (evar_map * EConstr.t)
+
+val pf_e_type_of :
+  Goal.goal Evd.sigma ->
+  EConstr.constr -> Goal.goal Evd.sigma * EConstr.types
+
+val splay_open_constr : 
+           Goal.goal Evd.sigma ->
+           evar_map * EConstr.t ->
+           (Names.Name.t * EConstr.t) list * EConstr.t
+val isAppInd : Environ.env -> Evd.evar_map -> EConstr.types -> bool
+
+val mk_term : ssrtermkind -> constr_expr -> ssrterm
+val mk_lterm : constr_expr -> ssrterm
+
+val mk_ast_closure_term :
+  [ `None | `Parens | `DoubleParens | `At ] ->
+  Constrexpr.constr_expr -> ast_closure_term
+val interp_ast_closure_term : Geninterp.interp_sign -> Proof_type.goal
+Evd.sigma -> ast_closure_term -> Evd.evar_map * ast_closure_term
+val subst_ast_closure_term : Mod_subst.substitution -> ast_closure_term -> ast_closure_term
+val glob_ast_closure_term : Genintern.glob_sign -> ast_closure_term -> ast_closure_term
+val ssrterm_of_ast_closure_term : ast_closure_term -> ssrterm
+
+val ssrdgens_of_parsed_dgens :
+  (ssrdocc * Ssrmatching.cpattern) list list * ssrclear -> ssrdgens
+
+val is_internal_name : string -> bool
+val add_internal_name : (string -> bool) -> unit
+val mk_internal_id : string -> Id.t
+val mk_tagged_id : string -> int -> Id.t
+val mk_evar_name : int -> Name.t
+val ssr_anon_hyp : string
+val pf_type_id :  Goal.goal Evd.sigma -> EConstr.types -> Id.t
+
+val pf_abs_evars : 
+           Goal.goal Evd.sigma ->
+           evar_map * EConstr.t ->
+           int * EConstr.t * Evar.t list *
+           UState.t
+val pf_abs_evars2 : (* ssr2 *)
+           Goal.goal Evd.sigma -> Evar.t list ->
+           evar_map * EConstr.t ->
+           int * EConstr.t * Evar.t list *
+           UState.t
+val pf_abs_cterm :
+           Goal.goal Evd.sigma -> int -> EConstr.t -> EConstr.t
+
+val pf_merge_uc :
+           UState.t -> 'a Evd.sigma -> 'a Evd.sigma
+val pf_merge_uc_of :
+           evar_map -> 'a Evd.sigma -> 'a Evd.sigma
+val constr_name : evar_map -> EConstr.t -> Name.t
+val pf_type_of :
+           Goal.goal Evd.sigma ->
+           Constr.constr -> Goal.goal Evd.sigma * Constr.types
+val pfe_type_of :
+           Goal.goal Evd.sigma ->
+           EConstr.t -> Goal.goal Evd.sigma * EConstr.types
+val pf_abs_prod :
+           Name.t ->
+           Goal.goal Evd.sigma ->
+           EConstr.t ->
+           EConstr.t -> Goal.goal Evd.sigma * EConstr.types
+
+val mkSsrRRef : string -> Glob_term.glob_constr * 'a option
+val mkSsrRef : string -> Globnames.global_reference
+val mkSsrConst : 
+           string ->
+           env -> evar_map -> evar_map * EConstr.t
+val pf_mkSsrConst :
+           string ->
+           Goal.goal Evd.sigma ->
+           EConstr.t * Goal.goal Evd.sigma
+val new_wild_id : tac_ctx -> Names.Id.t * tac_ctx
+
+
+val pf_fresh_global :
+           Globnames.global_reference ->
+           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
+val is_tagged : string -> string -> bool
+val has_discharged_tag : string -> bool
+val ssrqid : string -> Libnames.qualid 
+val new_tmp_id :
+  tac_ctx -> (Names.Id.t * Name.t ref) * tac_ctx
+val mk_anon_id : string -> Id.t list -> Id.t
+val pf_abs_evars_pirrel :
+           Goal.goal Evd.sigma ->
+           evar_map * Constr.constr -> int * Constr.constr
+val nbargs_open_constr : Goal.goal Evd.sigma -> Evd.evar_map * EConstr.t -> int
+val pf_nbargs : Goal.goal Evd.sigma -> EConstr.t -> int
+val gen_tmp_ids : 
+           ?ist:Geninterp.interp_sign ->
+           (Goal.goal * tac_ctx) Evd.sigma ->
+           (Goal.goal * tac_ctx) list Evd.sigma
+
+val ssrevaltac :
+  Tacinterp.interp_sign -> Tacinterp.Value.t -> unit Proofview.tactic
+
+val convert_concl_no_check : EConstr.t -> unit Proofview.tactic
+val convert_concl : EConstr.t -> unit Proofview.tactic
+
+val red_safe :
+  Reductionops.reduction_function ->
+  env -> evar_map -> EConstr.t -> EConstr.t
+
+val red_product_skip_id :
+  env -> evar_map -> EConstr.t -> EConstr.t
+
+val ssrautoprop_tac :
+           (Evar.t Evd.sigma -> Evar.t list Evd.sigma) ref
+
+val mkProt :
+  EConstr.t ->
+  EConstr.t ->
+  Goal.goal Evd.sigma ->
+  EConstr.t * Goal.goal Evd.sigma
+
+val mkEtaApp : EConstr.t -> int -> int -> EConstr.t
+
+val mkRefl :
+  EConstr.t ->
+  EConstr.t ->
+  Goal.goal Evd.sigma -> EConstr.t * Goal.goal Evd.sigma
+
+val discharge_hyp :
+           Id.t * (Id.t * string) ->
+           Goal.goal Evd.sigma -> Evar.t list Evd.sigma
+
+val clear_wilds_and_tmp_and_delayed_ids :
+           (Goal.goal * tac_ctx) Evd.sigma ->
+           (Goal.goal * tac_ctx) list Evd.sigma
+
+val view_error : string -> ssrterm -> 'a
+
+
+val top_id : Id.t
+
+val pf_abs_ssrterm :
+           ?resolve_typeclasses:bool ->
+           ist ->
+           Goal.goal Evd.sigma ->
+           ssrterm ->
+           evar_map * EConstr.t * UState.t * int
+
+val pf_interp_ty :
+           ?resolve_typeclasses:bool ->
+           Tacinterp.interp_sign ->
+           Goal.goal Evd.sigma ->
+           Ssrast.ssrtermkind *
+           (Glob_term.glob_constr * Constrexpr.constr_expr option) ->
+           int * EConstr.t * EConstr.t * UState.t
+
+val ssr_n_tac : string -> int -> v82tac
+val donetac : int -> v82tac
+
+val applyn :
+           with_evars:bool ->
+           ?beta:bool ->
+           ?with_shelve:bool ->
+           int ->
+           EConstr.t -> v82tac
+exception NotEnoughProducts
+val pf_saturate :
+           ?beta:bool ->
+           ?bi_types:bool ->
+           Goal.goal Evd.sigma ->
+           EConstr.constr ->
+           ?ty:EConstr.types ->
+           int ->
+           EConstr.constr * EConstr.types * (int * EConstr.constr) list *
+           Goal.goal Evd.sigma
+val saturate :
+           ?beta:bool ->
+           ?bi_types:bool ->
+           env ->
+           evar_map ->
+           EConstr.constr ->
+           ?ty:EConstr.types ->
+           int ->
+           EConstr.constr * EConstr.types * (int * EConstr.constr) list * evar_map
+val refine_with :
+           ?first_goes_last:bool ->
+           ?beta:bool ->
+           ?with_evars:bool ->
+           evar_map * EConstr.t -> v82tac
+(*********************** Wrapped Coq  tactics *****************************)
+
+val rewritetac : ssrdir -> EConstr.t -> tactic
+
+type name_hint = (int * EConstr.types array) option ref
+
+val gentac :
+   Ssrast.ssrdocc * Ssrmatching.cpattern -> v82tac
+
+val genstac :
+  ((Ssrast.ssrhyp list option * Ssrmatching.occ) *
+     Ssrmatching.cpattern)
+    list * Ssrast.ssrhyp list ->
+  Tacmach.tactic
+
+val pf_interp_gen :
+  Goal.goal Evd.sigma ->
+  bool ->
+  (Ssrast.ssrhyp list option * Ssrmatching.occ) *
+    Ssrmatching.cpattern ->
+  EConstr.t * EConstr.t * Ssrast.ssrhyp list *
+    Goal.goal Evd.sigma
+
+val pf_interp_gen_aux :
+  Goal.goal Evd.sigma ->
+  bool ->
+  (Ssrast.ssrhyp list option * Ssrmatching.occ) *
+    Ssrmatching.cpattern ->
+  bool * Ssrmatching.pattern * EConstr.t *
+    EConstr.t * Ssrast.ssrhyp list * UState.t *
+      Goal.goal Evd.sigma
+
+val is_name_in_ipats :
+           Id.t -> ssripats -> bool
+
+type profiler = { 
+  profile : 'a 'b. ('a -> 'b) -> 'a -> 'b;
+  reset : unit -> unit;
+  print : unit -> unit }
+
+val mk_profiler : string -> profiler
+
+(** Basic tactics *)
+
+val introid : ?orig:Name.t ref -> Id.t -> v82tac
+val intro_anon : v82tac
+
+val interp_clr :
+  evar_map -> ssrhyps option * (ssrtermkind * EConstr.t) -> ssrhyps
+
+val genclrtac :
+  EConstr.constr ->
+  EConstr.constr list -> Ssrast.ssrhyp list -> Tacmach.tactic
+val old_cleartac : ssrhyps -> v82tac
+val cleartac : ssrhyps -> unit Proofview.tactic
+
+val tclMULT : int * ssrmmod -> Tacmach.tactic -> Tacmach.tactic
+
+val unprotecttac : Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+val is_protect : EConstr.t -> Environ.env -> Evd.evar_map -> bool
+
+val abs_wgen :
+  bool ->
+  (Id.t -> Id.t) ->
+  'a *
+    ((Ssrast.ssrhyp_or_id * string) *
+       Ssrmatching.cpattern option)
+      option ->
+  Goal.goal Evd.sigma * EConstr.t list * EConstr.t ->
+  Goal.goal Evd.sigma * EConstr.t list * EConstr.t
+
+val clr_of_wgen :
+  ssrhyps * ((ssrhyp_or_id * 'a) * 'b option) option ->
+  Proofview.V82.tac list -> Proofview.V82.tac list
+
+
+val unfold : EConstr.t list -> unit Proofview.tactic
+
+val apply_type : EConstr.types -> EConstr.t list -> Proofview.V82.tac
+
+(* New code ****************************************************************)
+
+(* To call old code *)
+val tacSIGMA : Goal.goal Evd.sigma Proofview.tactic
+
+val tclINTERP_AST_CLOSURE_TERM_AS_CONSTR :
+  ast_closure_term -> EConstr.t list Proofview.tactic
+
+val tacREDUCE_TO_QUANTIFIED_IND :
+  EConstr.types ->
+    ((Names.inductive * EConstr.EInstance.t) * EConstr.types) Proofview.tactic
+
+val tacTYPEOF : EConstr.t -> EConstr.types Proofview.tactic
+
+val tclINTRO_ID : Id.t -> unit Proofview.tactic
+val tclINTRO_ANON : unit Proofview.tactic
+
+(* Lower level API, calls conclusion with the name taken from the prod *)
+val tclINTRO :
+  id:Id.t option ->
+  conclusion:(orig_name:Name.t -> new_name:Id.t -> unit Proofview.tactic) ->
+  unit Proofview.tactic
+
+val tclRENAME_HD_PROD : Name.t -> unit Proofview.tactic
+
+(* calls the tactic only if there are more than 0 goals *)
+val tcl0G : unit Proofview.tactic -> unit Proofview.tactic
+
+(* like tclFIRST but with 'a tactic *)
+val tclFIRSTa : 'a Proofview.tactic list -> 'a Proofview.tactic
+val tclFIRSTi : (int -> 'a Proofview.tactic) -> int -> 'a Proofview.tactic
+
+val tacCONSTR_NAME : ?name:Name.t -> EConstr.t -> Name.t Proofview.tactic
+
+(* [tacMKPROD t name ctx] (where ctx is a term possibly containing an unbound
+ * Rel 1) builds [forall name : ty_t, ctx] *)
+val tacMKPROD :
+  EConstr.t -> ?name:Name.t -> EConstr.types -> EConstr.types Proofview.tactic
+
+val tacINTERP_CPATTERN : Ssrmatching.cpattern -> Ssrmatching.pattern Proofview.tactic
+val tacUNIFY : EConstr.t -> EConstr.t -> unit Proofview.tactic
+
+(* if [(t : eq _ _ _)] then we can inject it *)
+val tacIS_INJECTION_CASE : ?ty:EConstr.types -> EConstr.t -> bool Proofview.tactic
+
+(** 1 shot, hands-on the top of the stack, eg for [=> ->] *)
+val tclWITHTOP : (EConstr.t -> unit Proofview.tactic) -> unit Proofview.tactic
+
+val tacMK_SSR_CONST : string -> EConstr.t Proofview.tactic
+
+module type StateType = sig
+  type state
+  val init : state
+end
+
+module MakeState(S : StateType) : sig
+
+  val tclGET : (S.state -> unit Proofview.tactic) -> unit Proofview.tactic
+  val tclSET : S.state -> unit Proofview.tactic
+  val tacUPDATE : (S.state -> S.state Proofview.tactic) -> unit Proofview.tactic
+
+  val get : Proofview.Goal.t -> S.state
+
+end
diff --git a/plugins/ssr/ssreflect.v b/plugins/ssr/ssreflect.v
new file mode 100644
index 00000000..b0a94413
--- /dev/null
+++ b/plugins/ssr/ssreflect.v
@@ -0,0 +1,453 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+Require Import Bool. (* For bool_scope delimiter 'bool'. *)
+Require Import ssrmatching.
+Declare ML Module "ssreflect_plugin".
+
+(******************************************************************************)
+(* This file is the Gallina part of the ssreflect plugin implementation.      *)
+(* Files that use the ssreflect plugin should always Require ssreflect and    *)
+(* either Import ssreflect or Import ssreflect.SsrSyntax.                     *)
+(*   Part of the contents of this file is technical and will only interest    *)
+(* advanced developers; in addition the following are defined:                *)
+(*   [the str of v by f] == the Canonical s : str such that f s = v.          *)
+(*        [the str of v] == the Canonical s : str that coerces to v.          *)
+(*        argumentType c == the T such that c : forall x : T, P x.            *)
+(*          returnType c == the R such that c : T -> R.                       *)
+(*     {type of c for s} == P s where c : forall x : T, P x.                  *)
+(*           phantom T v == singleton type with inhabitant Phantom T v.       *)
+(*               phant T == singleton type with inhabitant Phant v.           *)
+(*                 =^~ r == the converse of rewriting rule r (e.g., in a      *)
+(*                          rewrite multirule).                               *)
+(*             unkeyed t == t, but treated as an unkeyed matching pattern by  *)
+(*                          the ssreflect matching algorithm.                 *)
+(*             nosimpl t == t, but on the right-hand side of Definition C :=  *)
+(*                          nosimpl disables expansion of C by /=.            *)
+(*              locked t == t, but locked t is not convertible to t.          *)
+(*       locked_with k t == t, but not convertible to t or locked_with k' t   *)
+(*                          unless k = k' (with k : unit). Coq type-checking  *)
+(*                          will be much more efficient if locked_with with a *)
+(*                          bespoke k is used for sealed definitions.         *)
+(*          unlockable v == interface for sealed constant definitions of v.   *)
+(*        Unlockable def == the unlockable that registers def : C = v.        *)
+(*     [unlockable of C] == a clone for C of the canonical unlockable for the *)
+(*                          definition of C (e.g., if it uses locked_with).   *)
+(*    [unlockable fun C] == [unlockable of C] with the expansion forced to be *)
+(*                          an explicit lambda expression.                    *)
+(*  -> The usage pattern for ADT operations is:                               *)
+(*       Definition foo_def x1 .. xn := big_foo_expression.                   *)
+(*       Fact foo_key : unit. Proof. by []. Qed.                              *)
+(*       Definition foo := locked_with foo_key foo_def.                       *)
+(*       Canonical foo_unlockable := [unlockable fun foo].                    *)
+(*     This minimizes the comparison overhead for foo, while still allowing   *)
+(*     rewrite unlock to expose big_foo_expression.                           *)
+(* More information about these definitions and their use can be found in the *)
+(* ssreflect manual, and in specific comments below.                          *)
+(******************************************************************************)
+
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Module SsrSyntax.
+
+(* Declare Ssr keywords: 'is' 'of' '//' '/=' and '//='. We also declare the   *)
+(* parsing level 8, as a workaround for a notation grammar factoring problem. *)
+(* Arguments of application-style notations (at level 10) should be declared  *)
+(* at level 8 rather than 9 or the camlp5 grammar will not factor properly.   *)
+
+Reserved Notation "(* x 'is' y 'of' z 'isn't' // /= //= *)" (at level 8).
+Reserved Notation "(* 69 *)" (at level 69).
+
+(* Non ambiguous keyword to check if the SsrSyntax module is imported *)
+Reserved Notation "(* Use to test if 'SsrSyntax_is_Imported' *)" (at level 8).
+
+Reserved Notation "<hidden n >" (at level 200).
+Reserved Notation "T (* n *)" (at level 200, format "T  (* n *)").
+
+End SsrSyntax.
+
+Export SsrMatchingSyntax.
+Export SsrSyntax.
+
+(* Make the general "if" into a notation, so that we can override it below.   *)
+(* The notations are "only parsing" because the Coq decompiler will not       *)
+(* recognize the expansion of the boolean if; using the default printer       *)
+(* avoids a spurrious trailing %GEN_IF.                                       *)
+
+Delimit Scope general_if_scope with GEN_IF.
+
+Notation "'if' c 'then' v1 'else' v2" :=
+  (if c then v1 else v2)
+  (at level 200, c, v1, v2 at level 200, only parsing) : general_if_scope.
+
+Notation "'if' c 'return' t 'then' v1 'else' v2" :=
+  (if c return t then v1 else v2)
+  (at level 200, c, t, v1, v2 at level 200, only parsing) : general_if_scope.
+
+Notation "'if' c 'as' x 'return' t 'then' v1 'else' v2" :=
+  (if c as x return t then v1 else v2)
+  (at level 200, c, t, v1, v2 at level 200, x ident, only parsing)
+     : general_if_scope.
+
+(* Force boolean interpretation of simple if expressions.                     *)
+
+Delimit Scope boolean_if_scope with BOOL_IF.
+
+Notation "'if' c 'return' t 'then' v1 'else' v2" :=
+  (if c%bool is true in bool return t then v1 else v2) : boolean_if_scope.
+
+Notation "'if' c 'then' v1 'else' v2" :=
+  (if c%bool is true in bool return _ then v1 else v2) : boolean_if_scope.
+
+Notation "'if' c 'as' x 'return' t 'then' v1 'else' v2" :=
+  (if c%bool is true as x in bool return t then v1 else v2) : boolean_if_scope.
+
+Open Scope boolean_if_scope.
+
+(* To allow a wider variety of notations without reserving a large number of  *)
+(* of identifiers, the ssreflect library systematically uses "forms" to       *)
+(* enclose complex mixfix syntax. A "form" is simply a mixfix expression      *)
+(* enclosed in square brackets and introduced by a keyword:                   *)
+(*      [keyword ... ]                                                        *)
+(* Because the keyword follows a bracket it does not need to be reserved.     *)
+(* Non-ssreflect libraries that do not respect the form syntax (e.g., the Coq *)
+(* Lists library) should be loaded before ssreflect so that their notations   *)
+(* do not mask all ssreflect forms.                                           *)
+Delimit Scope form_scope with FORM.
+Open Scope form_scope.
+
+(* Allow overloading of the cast (x : T) syntax, put whitespace around the    *)
+(* ":" symbol to avoid lexical clashes (and for consistency with the parsing  *)
+(* precedence of the notation, which binds less tightly than application),    *)
+(* and put printing boxes that print the type of a long definition on a       *)
+(* separate line rather than force-fit it at the right margin.                *)
+Notation "x : T" := (x : T)
+  (at level 100, right associativity,
+   format "'[hv' x '/ '  :  T ']'") : core_scope.
+
+(* Allow the casual use of notations like nat * nat for explicit Type         *)
+(* declarations. Note that (nat * nat : Type) is NOT equivalent to            *)
+(* (nat * nat)%type, whose inferred type is legacy type "Set".                *)
+Notation "T : 'Type'" := (T%type : Type)
+  (at level 100, only parsing) : core_scope.
+(* Allow similarly Prop annotation for, e.g., rewrite multirules.             *)
+Notation "P : 'Prop'" := (P%type : Prop)
+  (at level 100, only parsing) : core_scope.
+
+(* Constants for abstract: and [: name ] intro pattern *)
+Definition abstract_lock := unit.
+Definition abstract_key := tt.
+
+Definition abstract (statement : Type) (id : nat) (lock : abstract_lock) :=
+  let: tt := lock in statement.
+
+Notation "<hidden n >" := (abstract _ n _).
+Notation "T (* n *)" := (abstract T n abstract_key).
+
+(* Constants for tactic-views *)
+Inductive external_view : Type := tactic_view of Type.
+
+(* Syntax for referring to canonical structures:                              *)
+(*      [the struct_type of proj_val by proj_fun]                             *)
+(* This form denotes the Canonical instance s of the Structure type           *)
+(* struct_type whose proj_fun projection is proj_val, i.e., such that         *)
+(*      proj_fun s = proj_val.                                                *)
+(* Typically proj_fun will be A record field accessors of struct_type, but    *)
+(* this need not be the case; it can be, for instance, a field of a record    *)
+(* type to which struct_type coerces; proj_val will likewise be coerced to    *)
+(* the return type of proj_fun. In all but the simplest cases, proj_fun       *)
+(* should be eta-expanded to allow for the insertion of implicit arguments.   *)
+(*   In the common case where proj_fun itself is a coercion, the "by" part    *)
+(* can be omitted entirely; in this case it is inferred by casting s to the   *)
+(* inferred type of proj_val. Obviously the latter can be fixed by using an   *)
+(* explicit cast on proj_val, and it is highly recommended to do so when the  *)
+(* return type intended for proj_fun is "Type", as the type inferred for      *)
+(* proj_val may vary because of sort polymorphism (it could be Set or Prop).  *)
+(*   Note when using the [the _ of _] form to generate a substructure from a  *)
+(* telescopes-style canonical hierarchy (implementing inheritance with        *)
+(* coercions), one should always project or coerce the value to the BASE      *)
+(* structure, because Coq will only find a Canonical derived structure for    *)
+(* the Canonical base structure -- not for a base structure that is specific  *)
+(* to proj_value.                                                             *)
+
+Module TheCanonical.
+
+CoInductive put vT sT (v1 v2 : vT) (s : sT) := Put.
+
+Definition get vT sT v s (p : @put vT sT v v s) := let: Put _ _ _ := p in s.
+
+Definition get_by vT sT of sT -> vT := @get vT sT.
+
+End TheCanonical.
+
+Import TheCanonical. (* Note: no export. *)
+
+Local Arguments get_by _%type_scope _%type_scope _ _ _ _.
+
+Notation "[ 'the' sT 'of' v 'by' f ]" :=
+  (@get_by _ sT f _ _ ((fun v' (s : sT) => Put v' (f s) s) v _))
+  (at level 0, only parsing) : form_scope.
+
+Notation "[ 'the' sT 'of' v ]" := (get ((fun s : sT => Put v (*coerce*)s s) _))
+  (at level 0, only parsing) : form_scope.
+
+(* The following are "format only" versions of the above notations. Since Coq *)
+(* doesn't provide this facility, we fake it by splitting the "the" keyword.  *)
+(* We need to do this to prevent the formatter from being be thrown off by    *)
+(* application collapsing, coercion insertion and beta reduction in the right *)
+(* hand side of the notations above.                                          *)
+
+Notation "[ 'th' 'e' sT 'of' v 'by' f ]" := (@get_by _ sT f v _ _)
+  (at level 0,  format "[ 'th' 'e'  sT  'of'  v  'by'  f ]") : form_scope.
+
+Notation "[ 'th' 'e' sT 'of' v ]" := (@get _ sT v _ _)
+  (at level 0, format "[ 'th' 'e'  sT  'of'  v ]") : form_scope.
+
+(* We would like to recognize
+Notation "[ 'th' 'e' sT 'of' v : 'Type' ]" := (@get Type sT v _ _)
+  (at level 0, format "[ 'th' 'e'  sT   'of'  v  :  'Type' ]") : form_scope.
+*)
+
+(* Helper notation for canonical structure inheritance support.               *)
+(* This is a workaround for the poor interaction between delta reduction and  *)
+(* canonical projections in Coq's unification algorithm, by which transparent *)
+(* definitions hide canonical instances, i.e., in                             *)
+(*   Canonical a_type_struct := @Struct a_type ...                            *)
+(*   Definition my_type := a_type.                                            *)
+(* my_type doesn't effectively inherit the struct structure from a_type. Our  *)
+(* solution is to redeclare the instance as follows                           *)
+(*   Canonical my_type_struct := Eval hnf in [struct of my_type].             *)
+(* The special notation [str of _] must be defined for each Strucure "str"    *)
+(* with constructor "Str", typically as follows                               *)
+(*   Definition clone_str s :=                                                *)
+(*      let: Str _ x y ... z := s return {type of Str for s} -> str in        *)
+(*      fun k => k _ x y ... z.                                               *)
+(*    Notation "[ 'str' 'of' T 'for' s ]" := (@clone_str s (@Str T))          *)
+(*      (at level 0, format "[ 'str'  'of'  T  'for'  s ]") : form_scope.     *)
+(*    Notation "[ 'str' 'of' T ]" := (repack_str (fun x => @Str T x))         *)
+(*      (at level 0, format "[ 'str'  'of'  T ]") : form_scope.               *)
+(* The notation for the match return predicate is defined below; the eta      *)
+(* expansion in the second form serves both to distinguish it from the first  *)
+(* and to avoid the delta reduction problem.                                  *)
+(*   There are several variations on the notation and the definition of the   *)
+(* the "clone" function, for telescopes, mixin classes, and join (multiple    *)
+(* inheritance) classes. We describe a different idiom for clones in ssrfun;  *)
+(* it uses phantom types (see below) and static unification; see fintype and  *)
+(* ssralg for examples.                                                       *)
+
+Definition argumentType T P & forall x : T, P x := T.
+Definition dependentReturnType T P & forall x : T, P x := P.
+Definition returnType aT rT & aT -> rT := rT.
+
+Notation "{ 'type' 'of' c 'for' s }" := (dependentReturnType c s)
+  (at level 0, format "{ 'type'  'of'  c  'for'  s }") : type_scope.
+
+(* A generic "phantom" type (actually, a unit type with a phantom parameter). *)
+(* This type can be used for type definitions that require some Structure     *)
+(* on one of their parameters, to allow Coq to infer said structure so it     *)
+(* does not have to be supplied explicitly or via the "[the _ of _]" notation *)
+(* (the latter interacts poorly with other Notation).                         *)
+(*   The definition of a (co)inductive type with a parameter p : p_type, that *)
+(* needs to use the operations of a structure                                 *)
+(*  Structure p_str : Type := p_Str {p_repr :> p_type; p_op : p_repr -> ...}  *)
+(* should be given as                                                         *)
+(*  Inductive indt_type (p : p_str) := Indt ... .                             *)
+(*  Definition indt_of (p : p_str) & phantom p_type p := indt_type p.         *)
+(*  Notation "{ 'indt' p }" := (indt_of (Phantom p)).                         *)
+(*  Definition indt p x y ... z : {indt p} := @Indt p x y ... z.              *)
+(*  Notation "[ 'indt' x y ... z ]" := (indt x y ... z).                      *)
+(* That is, the concrete type and its constructor should be shadowed by       *)
+(* definitions that use a phantom argument to infer and display the true      *)
+(* value of p (in practice, the "indt" constructor often performs additional  *)
+(* functions, like "locking" the representation -- see below).                *)
+(*   We also define a simpler version ("phant" / "Phant") of phantom for the  *)
+(* common case where p_type is Type.                                          *)
+
+CoInductive phantom T (p : T) := Phantom.
+Arguments phantom : clear implicits.
+Arguments Phantom : clear implicits.
+CoInductive phant (p : Type) := Phant.
+
+(* Internal tagging used by the implementation of the ssreflect elim.         *)
+
+Definition protect_term (A : Type) (x : A) : A := x.
+
+(* The ssreflect idiom for a non-keyed pattern:                               *)
+(*  - unkeyed t wiil match any subterm that unifies with t, regardless of     *)
+(*    whether it displays the same head symbol as t.                          *)
+(*  - unkeyed t a b will match any application of a term f unifying with t,   *)
+(*    to two arguments unifying with with a and b, repectively, regardless of *)
+(*    apparent head symbols.                                                  *)
+(*  - unkeyed x where x is a variable will match any subterm with the same    *)
+(*    type as x (when x would raise the 'indeterminate pattern' error).       *)
+
+Notation unkeyed x := (let flex := x in flex).
+
+(* Ssreflect converse rewrite rule rule idiom. *)
+Definition ssr_converse R (r : R) := (Logic.I, r).
+Notation "=^~ r" := (ssr_converse r) (at level 100) : form_scope.
+
+(* Term tagging (user-level).                                                 *)
+(* The ssreflect library uses four strengths of term tagging to restrict      *)
+(* convertibility during type checking:                                       *)
+(*  nosimpl t simplifies to t EXCEPT in a definition; more precisely, given   *)
+(*    Definition foo := nosimpl bar, foo (or foo t') will NOT be expanded by  *)
+(*    the /= and //= switches unless it is in a forcing context (e.g., in     *)
+(*    match foo t' with ... end, foo t' will be reduced if this allows the    *)
+(*    match to be reduced). Note that nosimpl bar is simply notation for a    *)
+(*    a term that beta-iota reduces to bar; hence rewrite /foo will replace   *)
+(*    foo by bar, and rewrite -/foo will replace bar by foo.                  *)
+(*    CAVEAT: nosimpl should not be used inside a Section, because the end of *)
+(*    section "cooking" removes the iota redex.                               *)
+(*  locked t is provably equal to t, but is not convertible to t; 'locked'    *)
+(*    provides support for selective rewriting, via the lock t : t = locked t *)
+(*    Lemma, and the ssreflect unlock tactic.                                 *)
+(*  locked_with k t is equal but not convertible to t, much like locked t,    *)
+(*    but supports explicit tagging with a value k : unit. This is used to    *)
+(*    mitigate a flaw in the term comparison heuristic of the Coq kernel,     *)
+(*    which treats all terms of the form locked t as equal and conpares their *)
+(*    arguments recursively, leading to an exponential blowup of comparison.  *)
+(*    For this reason locked_with should be used rather than locked when      *)
+(*    defining ADT operations. The unlock tactic does not support locked_with *)
+(*    but the unlock rewrite rule does, via the unlockable interface.         *)
+(*  we also use Module Type ascription to create truly opaque constants,      *)
+(*    because simple expansion of constants to reveal an unreducible term     *)
+(*    doubles the time complexity of a negative comparison. Such opaque       *)
+(*    constants can be expanded generically with the unlock rewrite rule.     *)
+(*    See the definition of card and subset in fintype for examples of this.  *)
+
+Notation nosimpl t := (let: tt := tt in t).
+
+Lemma master_key : unit. Proof. exact tt. Qed.
+Definition locked A := let: tt := master_key in fun x : A => x.
+
+Lemma lock A x : x = locked x :> A. Proof. unlock; reflexivity. Qed.
+
+(* Needed for locked predicates, in particular for eqType's.                  *)
+Lemma not_locked_false_eq_true : locked false <> true.
+Proof. unlock; discriminate. Qed.
+
+(* The basic closing tactic "done".                                           *)
+Ltac done :=
+  trivial; hnf; intros; solve
+   [ do ![solve [trivial | apply: sym_equal; trivial]
+         | discriminate | contradiction | split]
+   | case not_locked_false_eq_true; assumption
+   | match goal with H : ~ _ |- _ => solve [case H; trivial] end ].
+
+(* Quicker done tactic not including split, syntax: /0/ *)
+Ltac ssrdone0 :=
+  trivial; hnf; intros; solve
+   [ do ![solve [trivial | apply: sym_equal; trivial]
+         | discriminate | contradiction ]
+   | case not_locked_false_eq_true; assumption
+   | match goal with H : ~ _ |- _ => solve [case H; trivial] end ].
+
+(* To unlock opaque constants. *)
+Structure unlockable T v := Unlockable {unlocked : T; _ : unlocked = v}.
+Lemma unlock T x C : @unlocked T x C = x. Proof. by case: C. Qed.
+
+Notation "[ 'unlockable' 'of' C ]" := (@Unlockable _ _ C (unlock _))
+  (at level 0, format "[ 'unlockable'  'of'  C ]") : form_scope.
+
+Notation "[ 'unlockable' 'fun' C ]" := (@Unlockable _ (fun _ => _) C (unlock _))
+  (at level 0, format "[ 'unlockable'  'fun'  C ]") : form_scope.
+
+(* Generic keyed constant locking. *)
+
+(* The argument order ensures that k is always compared before T. *)
+Definition locked_with k := let: tt := k in fun T x => x : T.
+
+(* This can be used as a cheap alternative to cloning the unlockable instance *)
+(* below, but with caution as unkeyed matching can be expensive.              *)
+Lemma locked_withE T k x : unkeyed (locked_with k x) = x :> T.
+Proof. by case: k. Qed.
+
+(* Intensionaly, this instance will not apply to locked u. *)
+Canonical locked_with_unlockable T k x :=
+  @Unlockable T x (locked_with k x) (locked_withE k x).
+
+(* More accurate variant of unlock, and safer alternative to locked_withE. *)
+Lemma unlock_with T k x : unlocked (locked_with_unlockable k x) = x :> T.
+Proof. exact: unlock. Qed.
+
+(* The internal lemmas for the have tactics.                                  *)
+
+Definition ssr_have Plemma Pgoal (step : Plemma) rest : Pgoal := rest step.
+Arguments ssr_have Plemma [Pgoal].
+
+Definition ssr_have_let Pgoal Plemma step
+  (rest : let x : Plemma := step in Pgoal) : Pgoal := rest.
+Arguments ssr_have_let [Pgoal].
+
+Definition ssr_suff Plemma Pgoal step (rest : Plemma) : Pgoal := step rest.
+Arguments ssr_suff Plemma [Pgoal].
+
+Definition ssr_wlog := ssr_suff.
+Arguments ssr_wlog Plemma [Pgoal].
+
+(* Internal N-ary congruence lemmas for the congr tactic.                     *)
+
+Fixpoint nary_congruence_statement (n : nat)
+         : (forall B, (B -> B -> Prop) -> Prop) -> Prop :=
+  match n with
+  | O => fun k => forall B, k B (fun x1 x2 : B => x1 = x2)
+  | S n' =>
+    let k' A B e (f1 f2 : A -> B) :=
+      forall x1 x2, x1 = x2 -> (e (f1 x1) (f2 x2) : Prop) in
+    fun k => forall A, nary_congruence_statement n' (fun B e => k _ (k' A B e))
+  end.
+
+Lemma nary_congruence n (k := fun B e => forall y : B, (e y y : Prop)) :
+  nary_congruence_statement n k.
+Proof.
+have: k _ _ := _; rewrite {1}/k.
+elim: n k  => [|n IHn] k k_P /= A; first exact: k_P.
+by apply: IHn => B e He; apply: k_P => f x1 x2 <-.
+Qed.
+
+Lemma ssr_congr_arrow Plemma Pgoal : Plemma = Pgoal -> Plemma -> Pgoal.
+Proof. by move->. Qed.
+Arguments ssr_congr_arrow : clear implicits.
+
+(* View lemmas that don't use reflection.                                     *)
+
+Section ApplyIff.
+
+Variables P Q : Prop.
+Hypothesis eqPQ : P <-> Q.
+
+Lemma iffLR : P -> Q. Proof. by case: eqPQ. Qed.
+Lemma iffRL : Q -> P. Proof. by case: eqPQ. Qed.
+
+Lemma iffLRn : ~P -> ~Q. Proof. by move=> nP tQ; case: nP; case: eqPQ tQ. Qed.
+Lemma iffRLn : ~Q -> ~P. Proof. by move=> nQ tP; case: nQ; case: eqPQ tP. Qed.
+
+End ApplyIff.
+
+Hint View for move/ iffLRn|2 iffRLn|2 iffLR|2 iffRL|2.
+Hint View for apply/ iffRLn|2 iffLRn|2 iffRL|2 iffLR|2.
+
+(* To focus non-ssreflect tactics on a subterm, eg vm_compute. *)
+(* Usage:                                                      *)
+(*   elim/abstract_context: (pattern) => G defG.               *)
+(*   vm_compute; rewrite {}defG {G}.                           *)
+(* Note that vm_cast are not stored in the proof term          *)
+(* for reductions occuring in the context, hence               *)
+(*   set here := pattern; vm_compute in (value of here)        *)
+(* blows up at Qed time.                                       *)
+Lemma abstract_context T (P : T -> Type) x :
+  (forall Q, Q = P -> Q x) -> P x.
+Proof. by move=> /(_ P); apply. Qed.
diff --git a/plugins/ssr/ssreflect_plugin.mlpack b/plugins/ssr/ssreflect_plugin.mlpack
new file mode 100644
index 00000000..824348fe
--- /dev/null
+++ b/plugins/ssr/ssreflect_plugin.mlpack
@@ -0,0 +1,13 @@
+Ssrast
+Ssrprinters
+Ssrcommon
+Ssrtacticals
+Ssrelim
+Ssrview
+Ssrbwd
+Ssrequality
+Ssripats
+Ssrfwd
+Ssrparser
+Ssrvernac
+
diff --git a/plugins/ssr/ssrelim.ml b/plugins/ssr/ssrelim.ml
new file mode 100644
index 00000000..40af5187
--- /dev/null
+++ b/plugins/ssr/ssrelim.ml
@@ -0,0 +1,445 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Util
+open Names
+open Printer
+open Term
+open Termops
+open Globnames
+open Misctypes
+open Tacmach
+
+open Ssrmatching_plugin
+open Ssrmatching
+
+open Ssrast
+open Ssrprinters
+open Ssrcommon
+
+module RelDecl = Context.Rel.Declaration
+
+(** The "case" and "elim" tactic *)
+
+(* 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
+ * checks if the eliminator is recursive or not *)
+let analyze_eliminator elimty env sigma =
+  let rec loop ctx t = match EConstr.kind_of_type sigma t with
+  | AtomicType (hd, args) when EConstr.isRel sigma hd -> 
+    ctx, EConstr.destRel sigma hd, not (EConstr.Vars.noccurn sigma 1 t), Array.length args, t
+  | CastType (t, _) -> loop ctx t
+  | ProdType (x, ty, t) -> loop (RelDecl.LocalAssum (x, ty) :: ctx) t
+  | LetInType (x,b,ty,t) -> loop (RelDecl.LocalDef (x, b, ty) :: ctx) (EConstr.Vars.subst1 b t)
+  | _ ->
+    let env' = EConstr.push_rel_context ctx env in
+    let t' = Reductionops.whd_all env' sigma t in
+    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_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 = 
+     let count_occurn n term =
+       let count = ref 0 in
+       let rec occur_rec n c = match EConstr.kind sigma c with
+         | Rel m -> if m = n then incr count
+         | _ -> EConstr.iter_with_binders sigma succ occur_rec n c
+       in
+       occur_rec n term; !count in
+     let occurr2 n t = count_occurn n t > 1 in
+     not (List.for_all_i 
+       (fun i (_,rd) -> pred_id <= i || not (occurr2 (pred_id - i) rd))
+       1 (assums_of_rel_context ctx))
+  in
+  n_elim_args - pred_id, n_elim_args, is_rec_elim, elim_is_dep, n_pred_args,
+  (ctx,concl)
+
+let subgoals_tys sigma (relctx, concl) =
+  let rec aux cur_depth acc = function
+    | hd :: rest -> 
+        let ty = Context.Rel.Declaration.get_type hd in
+        if EConstr.Vars.noccurn sigma cur_depth concl &&
+           List.for_all_i (fun i -> function
+             | Context.Rel.Declaration.LocalAssum(_, t) ->
+                EConstr.Vars.noccurn sigma i t
+             | Context.Rel.Declaration.LocalDef (_, b, t) ->
+                EConstr.Vars.noccurn sigma i t && EConstr.Vars.noccurn sigma i b) 1 rest
+        then aux (cur_depth - 1) (ty :: acc) rest
+        else aux (cur_depth - 1) acc rest
+    | [] -> Array.of_list (List.rev acc)
+  in
+    aux (List.length relctx) [] (List.rev relctx)
+
+(* A case without explicit dependent terms but with both a view and an    *)
+(* occurrence switch and/or an equation is treated as dependent, with the *)
+(* viewed term as the dependent term (the occurrence switch would be      *)
+(* meaningless otherwise). When both a view and explicit dependents are   *)
+(* present, it is forbidden to put a (meaningless) occurrence switch on   *)
+(* the viewed term.                                                       *)
+
+(* This is both elim and case (defaulting to the former). If ~elim is omitted
+ * the standard eliminator is chosen. The code is made of 4 parts:
+ * 1. find the eliminator if not given as ~elim and analyze it
+ * 2. build the patterns to be matched against the conclusion, looking at
+ *    (occ, c), deps and the pattern inferred from the type of the eliminator
+ * 3. build the new predicate matching the patterns, and the tactic to 
+ *    generalize the equality in case eqid is not None
+ * 4. build the tactic handle intructions and clears as required in ipats and
+ *    by eqid *)
+let ssrelim ?(ind=ref None) ?(is_case=false) deps what ?elim eqid elim_intro_tac gl =
+  (* some sanity checks *)
+  let oc, orig_clr, occ, c_gen, gl = match what with
+  | `EConstr(_,_,t) when EConstr.isEvar (project gl) t ->
+    anomaly "elim called on a constr evar"
+  | `EGen (_, g) when elim = None && is_wildcard g ->
+       errorstrm Pp.(str"Indeterminate pattern and no eliminator")
+  | `EGen ((Some clr,occ), g) when is_wildcard g ->
+       None, clr, occ, None, gl
+  | `EGen ((None, occ), g) when is_wildcard g -> None,[],occ,None,gl
+  | `EGen ((_, occ), p as gen) ->
+       let _, c, clr,gl = pf_interp_gen gl true gen in
+       Some c, clr, occ, Some p,gl
+  | `EConstr (clr, occ, c) -> Some c, clr, occ, None,gl in
+  let orig_gl, concl, env = gl, pf_concl gl, pf_env gl in
+  ppdebug(lazy(Pp.str(if is_case then "==CASE==" else "==ELIM==")));
+  let fire_subst gl t = Reductionops.nf_evar (project gl) t in
+  let eq, gl = pf_fresh_global (Coqlib.build_coq_eq ()) gl in
+  let eq = EConstr.of_constr eq in
+  let is_undef_pat = function
+  | sigma, T t -> EConstr.isEvar sigma (EConstr.of_constr t)
+  | _ -> false in
+  let match_pat env p occ h cl = 
+    let sigma0 = project orig_gl in
+    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_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 
+    let t, _, _, sigma = saturate ~beta:true env (project gl) t n in
+    Evd.merge_universe_context sigma ucst, T (EConstr.Unsafe.to_constr t) in
+  let unif_redex gl (sigma, r as p) t = (* t is a hint for the redex of p *)
+    let n, t, _, ucst = pf_abs_evars orig_gl (project gl, fire_subst gl t) in 
+    let t, _, _, sigma = saturate ~beta:true env sigma t n in
+    let sigma = Evd.merge_universe_context sigma ucst in
+    match r with
+    | X_In_T (e, p) -> sigma, E_As_X_In_T (EConstr.Unsafe.to_constr t, e, p)
+    | _ ->
+       try unify_HO env sigma t (EConstr.of_constr (fst (redex_of_pattern env p))), r
+       with e when CErrors.noncritical e -> p in
+  (* finds the eliminator applies it to evars and c saturated as needed  *)
+  (* obtaining "elim ??? (c ???)". pred is the higher order evar         *)
+  (* cty is None when the user writes _ (hence we can't make a pattern *)
+  let cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl =
+    match elim with
+    | Some elim ->
+      let gl, elimty = pf_e_type_of gl elim in
+      let pred_id, n_elim_args, is_rec, elim_is_dep, n_pred_args,ctx_concl =
+        analyze_eliminator elimty env (project gl) in
+      ind := Some (0, subgoals_tys (project gl) ctx_concl);
+      let elim, elimty, elim_args, gl =
+        pf_saturate ~beta:is_case gl elim ~ty:elimty n_elim_args in
+      let pred = List.assoc pred_id elim_args in
+      let elimty = Reductionops.whd_all env (project gl) elimty in
+      let cty, gl =
+        if Option.is_empty oc then None, gl
+        else
+          let c = Option.get oc in let gl, c_ty = pfe_type_of gl c in
+          let pc = match c_gen with
+            | Some p -> interp_cpattern orig_gl p None
+            | _ -> mkTpat gl c in
+          Some(c, c_ty, pc), gl in
+      cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl
+    | None ->
+      let c = Option.get oc in let gl, c_ty = pfe_type_of gl c in
+      let ((kn, i),_ as indu), unfolded_c_ty =
+        pf_reduce_to_quantified_ind gl c_ty in
+      let sort = Tacticals.elimination_sort_of_goal gl in
+      let gl, elim =
+        if not is_case then
+          let t,gl= pf_fresh_global (Indrec.lookup_eliminator (kn,i) sort) gl in
+          gl, t
+        else
+          Tacmach.pf_eapply (fun env sigma () ->
+            let indu = (fst indu, EConstr.EInstance.kind sigma (snd indu)) in
+            let (sigma, ind) = Indrec.build_case_analysis_scheme env sigma indu true sort in
+            (sigma, ind)) gl () in
+      let elim = EConstr.of_constr elim in
+      let gl, elimty = pfe_type_of gl elim in
+      let pred_id,n_elim_args,is_rec,elim_is_dep,n_pred_args,ctx_concl =
+        analyze_eliminator elimty env (project gl) in
+      if is_case then
+       let mind,indb = Inductive.lookup_mind_specif env (kn,i) in
+       ind := Some(mind.Declarations.mind_nparams,Array.map EConstr.of_constr indb.Declarations.mind_nf_lc);
+      else
+       ind := Some (0, subgoals_tys (project gl) ctx_concl);
+      let rctx = fst (EConstr.decompose_prod_assum (project gl) unfolded_c_ty) in
+      let n_c_args = Context.Rel.length rctx in
+      let c, c_ty, t_args, gl = pf_saturate gl c ~ty:c_ty n_c_args in
+      let elim, elimty, elim_args, gl =
+        pf_saturate ~beta:is_case gl elim ~ty:elimty n_elim_args in
+      let pred = List.assoc pred_id elim_args in
+      let pc = match n_c_args, c_gen with
+        | 0, Some p -> interp_cpattern orig_gl p None
+        | _ -> mkTpat gl c in
+      let cty = Some (c, c_ty, pc) in
+      let elimty = Reductionops.whd_all env (project gl) elimty in
+      cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl
+  in
+  ppdebug(lazy Pp.(str"elim= "++ pr_constr_pat (EConstr.Unsafe.to_constr elim)));
+  ppdebug(lazy Pp.(str"elimty= "++ pr_constr_pat (EConstr.Unsafe.to_constr elimty)));
+  let inf_deps_r = match EConstr.kind_of_type (project gl) elimty with
+    | AtomicType (_, args) -> List.rev (Array.to_list args)
+    | _ -> assert false in
+  let saturate_until gl c c_ty f =
+    let rec loop n = try
+      let c, c_ty, _, gl = pf_saturate gl c ~ty:c_ty n in
+      let gl' = f c c_ty gl in
+      Some (c, c_ty, gl, gl')
+    with
+    | NotEnoughProducts -> None
+    | e when CErrors.noncritical e -> loop (n+1) in loop 0 in
+  (* Here we try to understand if the main pattern/term the user gave is
+   * the first pattern to be matched (i.e. if elimty ends in P t1 .. tn,
+   * weather tn is the t the user wrote in 'elim: t' *)
+  let c_is_head_p, gl = match cty with
+    | None -> true, gl  (* The user wrote elim: _ *)
+    | Some (c, c_ty, _) ->
+    let res = 
+      (* we try to see if c unifies with the last arg of elim *)
+      if elim_is_dep then None else
+      let arg = List.assoc (n_elim_args - 1) elim_args in
+      let gl, arg_ty = pfe_type_of gl arg in
+      match saturate_until gl c c_ty (fun c c_ty gl ->
+        pf_unify_HO (pf_unify_HO gl c_ty arg_ty) arg c) with
+      | Some (c, _, _, gl) -> Some (false, gl)
+      | None -> None in
+    match res with
+    | Some x -> x
+    | None ->
+      (* we try to see if c unifies with the last inferred pattern *)
+      let inf_arg = List.hd inf_deps_r in
+      let gl, inf_arg_ty = pfe_type_of gl inf_arg in
+      match saturate_until gl c c_ty (fun _ c_ty gl ->
+              pf_unify_HO gl c_ty inf_arg_ty) with
+      | Some (c, _, _,gl) -> true, gl
+      | None ->
+        errorstrm Pp.(str"Unable to apply the eliminator to the term"++
+          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
+   * looking at the ones provided by the user and the inferred ones looking at
+   * the type of the elimination principle *)
+  let pp_pat (_,p,_,occ) = Pp.(pr_occ occ ++ pp_pattern p) in
+  let pp_inf_pat gl (_,_,t,_) = pr_constr_pat (EConstr.Unsafe.to_constr (fire_subst gl t)) in
+  let patterns, clr, gl =
+    let rec loop patterns clr i = function
+      | [],[] -> patterns, clr, gl
+      | ((oclr, occ), t):: deps, inf_t :: inf_deps ->
+          let p = interp_cpattern orig_gl t None in
+          let clr_t =
+            interp_clr (project gl) (oclr,(tag_of_cpattern t,EConstr.of_constr (fst (redex_of_pattern env p)))) in
+          (* if we are the index for the equation we do not clear *)
+          let clr_t = if deps = [] && eqid <> None then [] else clr_t in
+          let p = if is_undef_pat p then mkTpat gl inf_t else p in
+          loop (patterns @ [i, p, inf_t, occ]) 
+            (clr_t @ clr) (i+1) (deps, inf_deps)
+      | [], c :: inf_deps -> 
+          ppdebug(lazy Pp.(str"adding inf pattern " ++ pr_constr_pat (EConstr.Unsafe.to_constr c)));
+          loop (patterns @ [i, mkTpat gl c, c, allocc]) 
+            clr (i+1) ([], inf_deps)
+      | _::_, [] -> errorstrm Pp.(str "Too many dependent abstractions") in
+    let deps, head_p, inf_deps_r = match what, c_is_head_p, cty with
+    | `EConstr _, _, None -> anomaly "Simple elim with no term"
+    | _, false, _ -> deps, [], inf_deps_r
+    | `EGen gen, true, None -> deps @ [gen], [], inf_deps_r
+    | _, true, Some (c, _, pc) ->
+         let occ = if occ = None then allocc else occ in
+         let inf_p, inf_deps_r = List.hd inf_deps_r, List.tl inf_deps_r in
+         deps, [1, pc, inf_p, occ], inf_deps_r in
+    let patterns, clr, gl = 
+      loop [] orig_clr (List.length head_p+1) (List.rev deps, inf_deps_r) in
+    head_p @ patterns, Util.List.uniquize clr, gl
+  in
+  ppdebug(lazy Pp.(pp_concat (str"patterns=") (List.map pp_pat patterns)));
+  ppdebug(lazy Pp.(pp_concat (str"inf. patterns=") (List.map (pp_inf_pat gl) patterns)));
+  (* Predicate generation, and (if necessary) tactic to generalize the
+   * equation asked by the user *)
+  let elim_pred, gen_eq_tac, clr, gl = 
+    let error gl t inf_t = errorstrm Pp.(str"The given pattern matches the term"++
+      spc()++pp_term gl t++spc()++str"while the inferred pattern"++
+      spc()++pr_constr_pat (EConstr.Unsafe.to_constr (fire_subst gl inf_t))++spc()++ str"doesn't") in
+    let match_or_postpone (cl, gl, post) (h, p, inf_t, occ) =
+      let p = unif_redex gl p inf_t in
+      if is_undef_pat p then
+        let () = ppdebug(lazy Pp.(str"postponing " ++ pp_pattern p)) in
+        cl, gl, post @ [h, p, inf_t, occ]
+      else try
+        let c, cl, ucst = match_pat env p occ h cl in
+        let gl = pf_merge_uc ucst gl in
+        let c = EConstr.of_constr c in
+        let gl = try pf_unify_HO gl inf_t c
+                 with exn when CErrors.noncritical exn -> error gl c inf_t in
+        cl, gl, post
+      with 
+      | NoMatch | NoProgress ->
+          let e, ucst = redex_of_pattern env p in
+          let gl = pf_merge_uc ucst gl in
+          let e = EConstr.of_constr e in
+          let n, e, _, _ucst =  pf_abs_evars gl (fst p, e) in
+          let e, _, _, gl = pf_saturate ~beta:true gl e n in 
+          let gl = try pf_unify_HO gl inf_t e
+                   with exn when CErrors.noncritical exn -> error gl e inf_t in
+          cl, gl, post
+    in        
+    let rec match_all concl gl patterns =
+      let concl, gl, postponed = 
+        List.fold_left match_or_postpone (concl, gl, []) patterns in
+      if postponed = [] then concl, gl
+      else if List.length postponed = List.length patterns then
+        errorstrm Pp.(str "Some patterns are undefined even after all"++spc()++
+          str"the defined ones matched")
+      else match_all concl gl postponed in
+    let concl, gl = match_all concl gl patterns in
+    let pred_rctx, _ = EConstr.decompose_prod_assum (project gl) (fire_subst gl predty) in
+    let concl, gen_eq_tac, clr, gl = match eqid with 
+    | Some (IPatId _) when not is_rec -> 
+        let k = List.length deps in
+        let c = fire_subst gl (List.assoc (n_elim_args - k - 1) elim_args) in
+        let gl, t = pfe_type_of gl c in
+        let gen_eq_tac, gl =
+          let refl = EConstr.mkApp (eq, [|t; c; c|]) in
+          let new_concl = EConstr.mkArrow refl (EConstr.Vars.lift 1 (pf_concl orig_gl)) in 
+          let new_concl = fire_subst gl new_concl in
+          let erefl, gl = mkRefl t c gl in
+          let erefl = fire_subst gl erefl in
+          apply_type new_concl [erefl], gl in
+        let rel = k + if c_is_head_p then 1 else 0 in
+        let src, gl = mkProt EConstr.mkProp EConstr.(mkApp (eq,[|t; c; mkRel rel|])) gl in
+        let concl = EConstr.mkArrow src (EConstr.Vars.lift 1 concl) in
+        let clr = if deps <> [] then clr else [] in
+        concl, gen_eq_tac, clr, gl
+    | _ -> concl, Tacticals.tclIDTAC, clr, gl in
+    let mk_lam t r = EConstr.mkLambda_or_LetIn r t in
+    let concl = List.fold_left mk_lam concl pred_rctx in
+    let gl, concl = 
+      if eqid <> None && is_rec then
+        let gl, concls = pfe_type_of gl concl in
+        let concl, gl = mkProt concls concl gl in
+        let gl, _ = pfe_type_of gl concl in
+        gl, concl
+      else gl, concl in
+    concl, gen_eq_tac, clr, gl in
+  let gl, pty = pf_e_type_of gl elim_pred in
+  ppdebug(lazy Pp.(str"elim_pred=" ++ pp_term gl elim_pred));
+  ppdebug(lazy Pp.(str"elim_pred_ty=" ++ pp_term gl pty));
+  let gl = pf_unify_HO gl pred elim_pred in
+  let elim = fire_subst gl elim in
+  let gl, _ = pf_e_type_of gl elim in
+  (* check that the patterns do not contain non instantiated dependent metas *)
+  let () = 
+    let evars_of_term = Evarutil.undefined_evars_of_term (project gl) in
+    let patterns = List.map (fun (_,_,t,_) -> fire_subst gl t) patterns in
+    let patterns_ev = List.map evars_of_term patterns in 
+    let ev = List.fold_left Evar.Set.union Evar.Set.empty patterns_ev in
+    let ty_ev = Evar.Set.fold (fun i e ->
+         let ex = i in
+         let i_ty = EConstr.of_constr (Evd.evar_concl (Evd.find (project gl) ex)) in
+         Evar.Set.union e (evars_of_term i_ty))
+      ev Evar.Set.empty in
+    let inter = Evar.Set.inter ev ty_ev in
+    if not (Evar.Set.is_empty inter) then begin
+      let i = Evar.Set.choose inter in
+      let pat = List.find (fun t -> Evar.Set.mem i (evars_of_term t)) patterns in
+      errorstrm Pp.(str"Pattern"++spc()++pr_constr_pat (EConstr.Unsafe.to_constr pat)++spc()++
+        str"was not completely instantiated and one of its variables"++spc()++
+        str"occurs in the type of another non-instantiated pattern variable");
+    end
+  in
+  (* the elim tactic, with the eliminator and the predicated we computed *)
+  let elim = project gl, elim in 
+  let elim_tac gl =
+    Tacticals.tclTHENLIST [refine_with ~with_evars:false elim; old_cleartac clr] gl in
+  Tacticals.tclTHENLIST [gen_eq_tac; elim_intro_tac what eqid elim_tac is_rec clr] orig_gl
+
+let no_intro ?ist what eqid elim_tac is_rec clr = elim_tac
+
+let elimtac x =
+  Proofview.V82.tactic ~nf_evars:false
+    (ssrelim ~is_case:false [] (`EConstr ([],None,x)) None no_intro)
+let casetac x = ssrelim ~is_case:true [] (`EConstr ([],None,x)) None no_intro
+
+let pf_nb_prod gl = nb_prod (project gl) (pf_concl gl)
+
+let rev_id = mk_internal_id "rev concl"
+let injecteq_id = mk_internal_id "injection equation"
+
+let revtoptac n0 gl =
+  let n = pf_nb_prod gl - n0 in
+  let dc, cl = EConstr.decompose_prod_n_assum (project gl) n (pf_concl gl) in
+  let dc' = dc @ [Context.Rel.Declaration.LocalAssum(Name rev_id, EConstr.it_mkProd_or_LetIn cl (List.rev dc))] in
+  let f = EConstr.it_mkLambda_or_LetIn (mkEtaApp (EConstr.mkRel (n + 1)) (-n) 1) dc' in
+  refine (EConstr.mkApp (f, [|Evarutil.mk_new_meta ()|])) gl
+
+let equality_inj l b id c gl =
+  let msg = ref "" in
+  try Proofview.V82.of_tactic (Equality.inj None l b None c) gl
+  with
+    | Ploc.Exc(_,CErrors.UserError (_,s))
+    | CErrors.UserError (_,s)
+  when msg := Pp.string_of_ppcmds s;
+       !msg = "Not a projectable equality but a discriminable one." ||
+       !msg = "Nothing to inject." ->
+    Feedback.msg_warning (Pp.str !msg);
+    discharge_hyp (id, (id, "")) gl
+
+let injectidl2rtac id c gl =
+  Tacticals.tclTHEN (equality_inj None true id c) (revtoptac (pf_nb_prod gl)) gl
+
+let injectl2rtac sigma c = match EConstr.kind sigma c with
+| Var id -> injectidl2rtac id (EConstr.mkVar id, NoBindings)
+| _ ->
+  let id = injecteq_id in
+  let xhavetac id c = Proofview.V82.of_tactic (Tactics.pose_proof (Name id) c) in
+  Tacticals.tclTHENLIST [xhavetac id c; injectidl2rtac id (EConstr.mkVar id, NoBindings); Proofview.V82.of_tactic (Tactics.clear [id])]
+
+let is_injection_case c gl =
+  let gl, cty = pfe_type_of gl c in
+  let (mind,_), _ = pf_reduce_to_quantified_ind gl cty in
+  eq_gr (IndRef mind) (Coqlib.build_coq_eq ())
+
+let perform_injection c gl =
+  let gl, cty = pfe_type_of gl c in
+  let mind, t = pf_reduce_to_quantified_ind gl cty in
+  let dc, eqt = EConstr.decompose_prod (project gl) t in
+  if dc = [] then injectl2rtac (project gl) c gl else
+  if not (EConstr.Vars.closed0 (project gl) eqt) then
+    CErrors.user_err (Pp.str "can't decompose a quantified equality") else
+  let cl = pf_concl gl in let n = List.length dc in
+  let c_eq = mkEtaApp c n 2 in
+  let cl1 = EConstr.mkLambda EConstr.(Anonymous, mkArrow eqt cl, mkApp (mkRel 1, [|c_eq|])) in
+  let id = injecteq_id in
+  let id_with_ebind = (EConstr.mkVar id, NoBindings) in
+  let injtac = Tacticals.tclTHEN (introid id) (injectidl2rtac id id_with_ebind) in 
+  Tacticals.tclTHENLAST (Proofview.V82.of_tactic (Tactics.apply (EConstr.compose_lam dc cl1))) injtac gl
+
+let ssrscase_or_inj_tac c = Proofview.V82.tactic ~nf_evars:false (fun gl ->
+  if is_injection_case c gl then perform_injection c gl
+  else casetac c gl)
+
+let ssrscasetac c =
+  Proofview.V82.tactic ~nf_evars:false (fun gl -> casetac c gl)
diff --git a/plugins/ssr/ssrelim.mli b/plugins/ssr/ssrelim.mli
new file mode 100644
index 00000000..c7ffba91
--- /dev/null
+++ b/plugins/ssr/ssrelim.mli
@@ -0,0 +1,55 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Ssrmatching_plugin
+
+val ssrelim :
+  ?ind:(int * EConstr.types array) option ref ->
+  ?is_case:bool ->
+  ((Ssrast.ssrhyps option * Ssrast.ssrocc) *
+     Ssrmatching.cpattern)
+    list ->
+  ([< `EConstr of
+        Ssrast.ssrhyp list * Ssrmatching.occ *
+          EConstr.constr &
+          'b
+   | `EGen of
+       (Ssrast.ssrhyp list option *
+          Ssrmatching.occ) *
+         Ssrmatching.cpattern ]
+   as 'a) ->
+  ?elim:EConstr.constr ->
+  Ssrast.ssripat option ->
+  ( 'a ->
+   Ssrast.ssripat option ->
+   (Goal.goal Evd.sigma -> Goal.goal list Evd.sigma) ->
+   bool -> Ssrast.ssrhyp list -> Tacmach.tactic) ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+
+val elimtac : EConstr.constr -> unit Proofview.tactic
+
+val casetac :
+  EConstr.constr ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+
+val is_injection_case : EConstr.t -> Goal.goal Evd.sigma -> bool
+val perform_injection :
+  EConstr.constr ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+
+val ssrscasetac :
+  EConstr.constr ->
+  unit Proofview.tactic
+
+val ssrscase_or_inj_tac :
+  EConstr.constr ->
+  unit Proofview.tactic
diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
new file mode 100644
index 00000000..c29203de
--- /dev/null
+++ b/plugins/ssr/ssrequality.ml
@@ -0,0 +1,653 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Ltac_plugin
+open Util
+open Names
+open Term
+open Constr
+open Vars
+open Locus
+open Printer
+open Globnames
+open Termops
+open Tacinterp
+
+open Ssrmatching_plugin
+open Ssrmatching
+
+open Ssrast
+open Ssrprinters
+open Ssrcommon
+open Tacticals
+open Tacmach
+
+let ssroldreworder = Summary.ref ~name:"SSR:oldreworder" false
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optname  = "ssreflect 1.3 compatibility flag";
+      Goptions.optkey   = ["SsrOldRewriteGoalsOrder"];
+      Goptions.optread  = (fun _ -> !ssroldreworder);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b -> ssroldreworder := b) }
+
+(** The "simpl" tactic *)
+
+(* We must avoid zeta-converting any "let"s created by the "in" tactical. *)
+
+let tacred_simpl gl =
+  let simpl_expr =
+    Genredexpr.(
+      Simpl(Redops.make_red_flag[FBeta;FMatch;FZeta;FDeltaBut []],None)) in
+  let esimpl, _ = Redexpr.reduction_of_red_expr (pf_env gl) simpl_expr in
+  let esimpl e sigma c =
+    let (_,t) = esimpl e sigma c in
+    t in
+  let simpl env sigma c = (esimpl env sigma c) in
+  simpl
+
+let safe_simpltac n gl =
+  if n = ~-1 then
+    let cl= red_safe (tacred_simpl gl) (pf_env gl) (project gl) (pf_concl gl) in
+    Proofview.V82.of_tactic (convert_concl_no_check cl) gl
+  else
+    ssr_n_tac "simpl" n gl
+
+let simpltac = function
+  | Simpl n -> safe_simpltac n
+  | Cut n -> tclTRY (donetac n)
+  | SimplCut (n,m) -> tclTHEN (safe_simpltac m) (tclTRY (donetac n))
+  | Nop -> tclIDTAC
+
+(** The "congr" tactic *)
+
+let interp_congrarg_at ist gl n rf ty m =
+  ppdebug(lazy Pp.(str"===interp_congrarg_at==="));
+  let congrn, _ = mkSsrRRef "nary_congruence" in
+  let args1 = mkRnat n :: mkRHoles n @ [ty] in
+  let args2 = mkRHoles (3 * n) in
+  let rec loop i =
+    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_env (pf_env gl) rt));
+      Some (interp_refine ist gl rt)
+    with _ -> loop (i + 1) in
+  loop 0
+
+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_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
+  let ist' = {ist with lfun =
+    Id.Map.add pattern_id (Tacinterp.Value.of_constr f) Id.Map.empty } in
+  let rf = mkRltacVar pattern_id in
+  let m = pf_nbargs gl f in
+  let _, cf = if n > 0 then
+    match interp_congrarg_at ist' gl n rf ty m with
+    | Some cf -> cf
+    | None -> errorstrm Pp.(str "No " ++ int n ++ str "-congruence with "
+                         ++ pr_term t)
+    else let rec loop i =
+      if i > m then errorstrm Pp.(str "No congruence with " ++ pr_term t)
+      else match interp_congrarg_at ist' gl i rf ty m with
+      | Some cf -> cf
+      | None -> loop (i + 1) in
+      loop 1 in
+  tclTHEN (refine_with cf) (tclTRY (Proofview.V82.of_tactic Tactics.reflexivity)) gl
+
+let newssrcongrtac arg ist gl =
+  ppdebug(lazy Pp.(str"===newcongr==="));
+  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 =
+    match try Some (pf_unify_HO gl_c (pf_concl gl) c)
+          with exn when CErrors.noncritical exn -> None with
+    | Some gl_c ->
+        tclTHEN (Proofview.V82.of_tactic (convert_concl (fs gl_c c)))
+          (t_ok (proj gl_c)) gl
+    | None -> t_fail () gl in 
+  let mk_evar gl ty = 
+    let env, sigma, si = pf_env gl, project gl, sig_it gl in
+    let sigma = Evd.create_evar_defs sigma in
+    let (sigma, x) = Evarutil.new_evar env sigma ty in
+    x, re_sig si sigma in
+  let arr, gl = pf_mkSsrConst "ssr_congr_arrow" gl in
+  let ssr_congr lr = EConstr.mkApp (arr, lr) in
+  (* here thw two cases: simple equality or arrow *)
+  let equality, _, eq_args, 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 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
+    tclMATCH_GOAL (arrow, gl') (fun gl' -> [|fs gl' lhs;fs gl' rhs|])
+    (fun lr -> tclTHEN (Proofview.V82.of_tactic (Tactics.apply (ssr_congr lr))) (congrtac (arg, mkRType) ist))
+    (fun _ _ -> errorstrm Pp.(str"Conclusion is not an equality nor an arrow")))
+    gl
+
+(** 7. Rewriting tactics (rewrite, unlock) *)
+
+(** Rewrite rules *)
+
+type ssrwkind = RWred of ssrsimpl | RWdef | RWeq
+type ssrrule = ssrwkind * ssrterm
+
+(** Rewrite arguments *)
+
+type ssrrwarg = (ssrdir * ssrmult) * ((ssrdocc * rpattern option) * ssrrule)
+
+let notimes = 0
+let nomult = 1, Once
+
+let mkocc occ = None, occ
+let noclr = mkocc None
+let mkclr clr  = Some clr, None
+let nodocc = mkclr []
+
+let is_rw_cut = function RWred (Cut _) -> true | _ -> false
+
+let mk_rwarg (d, (n, _ as m)) ((clr, occ as docc), rx) (rt, _ as r) : ssrrwarg =   
+ if rt <> RWeq then begin
+   if rt = RWred Nop && not (m = nomult && occ = None && rx = None)
+                     && (clr = None || clr = Some []) then
+     anomaly "Improper rewrite clear switch";
+   if d = R2L && rt <> RWdef then
+     CErrors.user_err (Pp.str "Right-to-left switch on simplification");
+   if n <> 1 && is_rw_cut rt then
+     CErrors.user_err (Pp.str "Bad or useless multiplier");
+   if occ <> None && rx = None && rt <> RWdef then
+     CErrors.user_err (Pp.str "Missing redex for simplification occurrence")
+ end; (d, m), ((docc, rx), r)
+
+let norwmult = L2R, nomult
+let norwocc = noclr, None
+
+let simplintac occ rdx sim gl = 
+  let simptac m gl =
+    if m <> ~-1 then
+      CErrors.user_err (Pp.str "Localized custom simpl tactic not supported");
+    let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in
+    let simp env c _ _ = EConstr.Unsafe.to_constr (red_safe Tacred.simpl env sigma0 (EConstr.of_constr c)) in
+    Proofview.V82.of_tactic
+      (convert_concl_no_check (EConstr.of_constr (eval_pattern env0 sigma0 (EConstr.Unsafe.to_constr concl0) rdx occ simp)))
+      gl in
+  match sim with
+  | Simpl m -> simptac m gl
+  | SimplCut (n,m) -> tclTHEN (simptac m) (tclTRY (donetac n)) gl
+  | _ -> simpltac sim gl
+
+let rec get_evalref sigma c = match EConstr.kind sigma c with
+  | Var id -> EvalVarRef id
+  | Const (k,_) -> EvalConstRef k
+  | App (c', _) -> get_evalref sigma c'
+  | Cast (c', _, _) -> get_evalref sigma c'
+  | Proj(c,_) -> EvalConstRef(Projection.constant c)
+  | _ -> errorstrm Pp.(str "The term " ++ pr_constr_pat (EConstr.Unsafe.to_constr c) ++ str " is not unfoldable")
+
+(* Strip a pattern generated by a prenex implicit to its constant. *)
+let strip_unfold_term _ ((sigma, t) as p) kt = match EConstr.kind sigma t with
+  | App (f, a) when kt = xNoFlag && Array.for_all (EConstr.isEvar sigma) a && EConstr.isConst sigma f -> 
+    (sigma, f), true
+  | Const _ | Var _ -> p, true
+  | Proj _ -> p, true
+  | _ -> p, false
+
+let same_proj sigma t1 t2 =
+  match EConstr.kind sigma t1, EConstr.kind sigma t2 with
+  | Proj(c1,_), Proj(c2, _) -> Projection.equal c1 c2
+  | _ -> false
+
+let all_ok _ _ = true
+
+let fake_pmatcher_end () =
+  mkProp, L2R, (Evd.empty, UState.empty, mkProp)
+
+let unfoldintac occ rdx t (kt,_) gl = 
+  let fs sigma x = Reductionops.nf_evar sigma x in
+  let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in
+  let (sigma, t), const = strip_unfold_term env0 t kt in
+  let body env t c =
+    Tacred.unfoldn [AllOccurrences, get_evalref sigma t] env sigma0 c in
+  let easy = occ = None && rdx = None in
+  let red_flags = if easy then CClosure.betaiotazeta else CClosure.betaiota in
+  let beta env = Reductionops.clos_norm_flags red_flags env sigma0 in
+  let unfold, conclude = match rdx with
+  | Some (_, (In_T _ | In_X_In_T _)) | None ->
+    let ise = Evd.create_evar_defs sigma in
+    let ise, u = mk_tpattern env0 sigma0 (ise,EConstr.Unsafe.to_constr t) all_ok L2R (EConstr.Unsafe.to_constr t) in
+    let find_T, end_T =
+      mk_tpattern_matcher ~raise_NoMatch:true sigma0 occ (ise,[u]) in
+    (fun env c _ h -> 
+      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_env env sigma c)),
+    (fun () -> try end_T () with 
+      | NoMatch when easy -> fake_pmatcher_end () 
+      | NoMatch -> anomaly "unfoldintac")
+  | _ -> 
+    (fun env (c as orig_c) _ h ->
+      if const then
+        let rec aux c = 
+          match EConstr.kind sigma0 c with
+          | Const _ when EConstr.eq_constr sigma0 c t -> body env t t
+          | App (f,a) when EConstr.eq_constr sigma0 f t -> EConstr.mkApp (body env f f,a)
+          | Proj _ when same_proj sigma0 c t -> body env t c
+          | _ ->
+            let c = Reductionops.whd_betaiotazeta sigma0 c in
+            match EConstr.kind sigma0 c with
+            | Const _ when EConstr.eq_constr sigma0 c t -> body env t t
+            | App (f,a) when EConstr.eq_constr sigma0 f t -> EConstr.mkApp (body env f f,a)
+            | 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_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_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
+    try beta env0 (EConstr.of_constr (eval_pattern env0 sigma0 concl0 rdx occ unfold)) 
+    with Option.IsNone -> errorstrm Pp.(str"Failed to unfold " ++ pr_constr_pat (EConstr.Unsafe.to_constr t)) in
+  let _ = conclude () in
+  Proofview.V82.of_tactic (convert_concl concl) gl
+;;
+
+let foldtac occ rdx ft gl = 
+  let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in
+  let sigma, t = ft in
+  let t = EConstr.to_constr sigma t in
+  let fold, conclude = match rdx with
+  | Some (_, (In_T _ | In_X_In_T _)) | None ->
+    let ise = Evd.create_evar_defs sigma in
+    let ut = EConstr.Unsafe.to_constr (red_product_skip_id env0 sigma (EConstr.of_constr t)) in
+    let ise, ut = mk_tpattern env0 sigma0 (ise,t) all_ok L2R ut in
+    let find_T, end_T =
+      mk_tpattern_matcher ~raise_NoMatch:true sigma0 occ (ise,[ut]) in
+    (fun env c _ h -> try find_T env c h ~k:(fun env t _ _ -> t) with NoMatch ->c),
+    (fun () -> try end_T () with NoMatch -> fake_pmatcher_end ())
+  | _ -> 
+    (fun env c _ h -> try let sigma = unify_HO env sigma (EConstr.of_constr c) (EConstr.of_constr t) in EConstr.to_constr sigma (EConstr.of_constr t)
+    with _ -> errorstrm Pp.(str "fold pattern " ++ pr_constr_pat t ++ spc ()
+      ++ str "does not match redex " ++ pr_constr_pat c)), 
+    fake_pmatcher_end in
+  let concl0 = EConstr.Unsafe.to_constr concl0 in
+  let concl = eval_pattern env0 sigma0 concl0 rdx occ fold in
+  let _ = conclude () in
+  Proofview.V82.of_tactic (convert_concl (EConstr.of_constr concl)) gl
+;;
+
+let converse_dir = function L2R -> R2L | R2L -> L2R
+
+let rw_progress rhs lhs ise = not (EConstr.eq_constr ise lhs (Evarutil.nf_evar ise rhs))
+
+(* Coq has a more general form of "equation" (any type with a single *)
+(* constructor with no arguments with_rect_r elimination lemmas).    *)
+(* However there is no clear way of determining the LHS and RHS of   *)
+(* such a generic Leibnitz equation -- short of inspecting the type  *)
+(* of the elimination lemmas.                                        *)
+
+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'
+  | _ -> c
+
+let rule_id = mk_internal_id "rewrite rule"
+
+exception PRtype_error
+
+let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
+(*   ppdebug(lazy(str"sigma@pirrel_rewrite=" ++ pr_evar_map None sigma)); *)
+  let env = pf_env gl in
+  let beta = Reductionops.clos_norm_flags CClosure.beta env sigma in
+  let sigma, p = 
+    let sigma = Evd.create_evar_defs sigma in
+    let (sigma, ev) = Evarutil.new_evar env sigma (beta (EConstr.Vars.subst1 new_rdx pred)) in
+    (sigma, ev)
+  in
+  let pred = EConstr.mkNamedLambda pattern_id rdx_ty pred in
+  let elim, gl = 
+    let ((kn, i) as ind, _), unfolded_c_ty = pf_reduce_to_quantified_ind gl c_ty in
+    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, _ = 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
+    mkConst c1', gl in
+  let elim = EConstr.of_constr elim in
+  let proof = EConstr.mkApp (elim, [| rdx_ty; new_rdx; pred; p; rdx; c |]) in
+  (* 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_env env sigma proof_ty));
+  try refine_with 
+    ~first_goes_last:(not !ssroldreworder) ~with_evars:false (sigma, proof) gl
+  with _ -> 
+    (* we generate a msg like: "Unable to find an instance for the variable" *)
+    let hd_ty, miss = match EConstr.kind sigma c with
+    | App (hd, args) -> 
+        let hd_ty = Retyping.get_type_of env sigma hd in
+        let names = let rec aux t = function 0 -> [] | n ->
+          let t = Reductionops.whd_all env sigma t in
+          match EConstr.kind_of_type sigma t with
+          | ProdType (name, _, t) -> name :: aux t (n-1)
+          | _ -> assert false in aux hd_ty (Array.length args) in
+        hd_ty, Util.List.map_filter (fun (t, name) ->
+          let evs = Evar.Set.elements (Evarutil.undefined_evars_of_term sigma t) in
+          let open_evs = List.filter (fun k ->
+            Sorts.InProp <> Retyping.get_sort_family_of
+              env sigma (EConstr.of_constr (Evd.evar_concl (Evd.find sigma k))))
+            evs in
+          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 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 rwcltac cl rdx dir sr gl =
+  let n, r_n,_, ucst = pf_abs_evars gl sr in
+  let r_n' = pf_abs_cterm gl n r_n in
+  let r' = EConstr.Vars.subst_var pattern_id r_n' in
+  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_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_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
+          pirrel_rewrite cl rdx rdxt new_rdx dir (sigma,c) c_ty, tclIDTAC, gl
+      | _ -> 
+          let cl' = EConstr.mkApp (EConstr.mkNamedLambda pattern_id rdxt cl, [|rdx|]) in
+          let sigma, _ = Typing.type_of env sigma cl' in
+          let gl = pf_merge_uc_of sigma gl in
+          Proofview.V82.of_tactic (convert_concl cl'), rewritetac dir r', gl
+    else
+      let dc, r2 = EConstr.decompose_lam_n_assum (project gl) n r' in
+      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_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
+      let cltac = Proofview.V82.of_tactic (Tactics.clear [pattern_id; rule_id]) in
+      let rwtacs = [rewritetac dir (EConstr.mkVar rule_id); cltac] in
+      apply_type cl'' [rdx; EConstr.it_mkLambda_or_LetIn r3 dc], tclTHENLIST (itacs @ rwtacs), gl
+  in
+  let cvtac' _ =
+    try cvtac gl with
+    | PRtype_error ->
+      if occur_existential (project gl) (Tacmach.pf_concl gl)
+      then errorstrm Pp.(str "Rewriting impacts evars")
+      else errorstrm Pp.(str "Dependent type error in rewrite of "
+        ++ pr_constr_env (pf_env gl) (project gl) (Term.mkNamedLambda pattern_id (EConstr.Unsafe.to_constr rdxt) (EConstr.Unsafe.to_constr cl)))
+    | CErrors.UserError _ as e -> raise e
+    | e -> anomaly ("cvtac's exception: " ^ Printexc.to_string e);
+  in
+  tclTHEN cvtac' rwtac gl
+
+let prof_rwcltac = mk_profiler "rwrxtac.rwcltac";;
+let rwcltac cl rdx dir sr gl =
+  prof_rwcltac.profile (rwcltac cl rdx dir sr) gl
+;;
+
+
+let lz_coq_prod =
+  let prod = lazy (Coqlib.build_prod ()) in fun () -> Lazy.force prod
+
+let lz_setoid_relation =
+  let sdir = ["Classes"; "RelationClasses"] in
+  let last_srel = ref (Environ.empty_env, None) in
+  fun env -> match !last_srel with
+  | env', srel when env' == env -> srel
+  | _ ->
+    let srel =
+       try Some (Universes.constr_of_global @@
+                   Coqlib.coq_reference "Class_setoid" sdir "RewriteRelation")
+       with _ -> None in
+    last_srel := (env, srel); srel
+
+let ssr_is_setoid env =
+  match lz_setoid_relation env with
+  | None -> fun _ _ _ -> false
+  | Some srel ->
+  fun sigma r args ->
+    Rewrite.is_applied_rewrite_relation env 
+      sigma [] (EConstr.mkApp (r, args)) <> None
+
+let prof_rwxrtac_find_rule = mk_profiler "rwrxtac.find_rule";;
+
+let closed0_check cl p gl =
+  if closed0 cl then
+    errorstrm Pp.(str"No occurrence of redex "++ pr_constr_env (pf_env gl) (project gl) p)
+
+let dir_org = function L2R -> 1 | R2L -> 2
+
+let rwprocess_rule dir rule gl =
+  let env = pf_env gl in
+  let coq_prod = lz_coq_prod () in
+  let is_setoid = ssr_is_setoid env in
+  let r_sigma, rules =
+    let rec loop d sigma r t0 rs red =
+      let t =
+        if red = 1 then Tacred.hnf_constr env sigma t0
+        else Reductionops.whd_betaiotazeta sigma t0 in
+      ppdebug(lazy Pp.(str"rewrule="++pr_constr_pat (EConstr.Unsafe.to_constr t)));
+      match EConstr.kind sigma t with
+      | Prod (_, xt, at) ->
+        let sigma = Evd.create_evar_defs sigma in
+        let (sigma, x) = Evarutil.new_evar env sigma xt in
+        loop d sigma EConstr.(mkApp (r, [|x|])) (EConstr.Vars.subst1 x at) rs 0
+      | App (pr, a) when is_ind_ref sigma pr coq_prod.Coqlib.typ ->
+        let sr sigma = match EConstr.kind sigma (Tacred.hnf_constr env sigma r) with
+        | App (c, ra) when is_construct_ref sigma c coq_prod.Coqlib.intro ->
+          fun i -> ra.(i + 1), sigma
+        | _ -> let ra = Array.append a [|r|] in
+          function 1 ->
+            let sigma, pi1 = Evd.fresh_global env sigma coq_prod.Coqlib.proj1 in
+            EConstr.mkApp (EConstr.of_constr pi1, ra), sigma
+          | _ ->
+            let sigma, pi2 = Evd.fresh_global env sigma coq_prod.Coqlib.proj2 in
+            EConstr.mkApp (EConstr.of_constr pi2, ra), sigma in
+        if EConstr.eq_constr sigma a.(0) (EConstr.of_constr (Universes.constr_of_global @@ Coqlib.build_coq_True ())) then
+         let s, sigma = sr sigma 2 in
+         loop (converse_dir d) sigma s a.(1) rs 0
+        else
+         let s, sigma = sr sigma 2 in
+         let sigma, rs2 = loop d sigma s a.(1) rs 0 in
+         let s, sigma = sr sigma 1 in
+         loop d sigma s a.(0) rs2 0
+      | App (r_eq, a) when Hipattern.match_with_equality_type sigma t != None ->
+        let (ind, u) = EConstr.destInd sigma r_eq and rhs = Array.last a in
+        let np = Inductiveops.inductive_nparamdecls ind in
+        let indu = (ind, EConstr.EInstance.kind sigma u) in
+        let ind_ct = Inductiveops.type_of_constructors env indu in
+        let lhs0 = last_arg sigma (EConstr.of_constr (strip_prod_assum ind_ct.(0))) in
+        let rdesc = match EConstr.kind sigma lhs0 with
+        | Rel i ->
+          let lhs = a.(np - i) in
+          let lhs, rhs = if d = L2R then lhs, rhs else rhs, lhs in
+(* msgnl (str "RW: " ++ pr_rwdir d ++ str " " ++ pr_constr_pat r ++ str " : "
+            ++ pr_constr_pat lhs ++ str " ~> " ++ pr_constr_pat rhs); *)
+          d, r, lhs, rhs
+(*
+          let l_i, r_i = if d = L2R then i, 1 - ndep else 1 - ndep, i in
+          let lhs = a.(np - l_i) and rhs = a.(np - r_i) in
+          let a' = Array.copy a in let _ = a'.(np - l_i) <- mkVar pattern_id in
+          let r' = mkCast (r, DEFAULTcast, mkApp (r_eq, a')) in
+          (d, r', lhs, rhs)
+*)
+        | _ ->
+          let lhs = EConstr.Vars.substl (array_list_of_tl (Array.sub a 0 np)) lhs0 in
+          let lhs, rhs = if d = R2L then lhs, rhs else rhs, lhs in
+          let d' = if Array.length a = 1 then d else converse_dir d in
+          d', r, lhs, rhs in
+        sigma, rdesc :: rs
+      | App (s_eq, a) when is_setoid sigma s_eq a ->
+        let np = Array.length a and i = 3 - dir_org d in
+        let lhs = a.(np - i) and rhs = a.(np + i - 3) in
+        let a' = Array.copy a in let _ = a'.(np - i) <- EConstr.mkVar pattern_id in
+        let r' = EConstr.mkCast (r, DEFAULTcast, EConstr.mkApp (s_eq, a')) in
+        sigma, (d, r', lhs, rhs) :: rs
+      | _ ->
+        if red = 0 then loop d sigma r t rs 1
+        else errorstrm Pp.(str "not a rewritable relation: " ++ pr_constr_pat (EConstr.Unsafe.to_constr t)
+                        ++ spc() ++ str "in rule " ++ pr_constr_pat  (EConstr.Unsafe.to_constr (snd rule)))
+        in
+    let sigma, r = rule in
+    let t = Retyping.get_type_of env sigma r in
+    loop dir sigma r t [] 0
+  in
+    r_sigma, rules
+
+let rwrxtac occ rdx_pat dir rule gl =
+  let env = pf_env gl in
+  let r_sigma, rules = rwprocess_rule dir rule gl in
+  let find_rule rdx =
+    let rec rwtac = function
+      | [] ->
+        errorstrm Pp.(str "pattern " ++ pr_constr_pat (EConstr.Unsafe.to_constr rdx) ++
+                   str " does not match " ++ pr_dir_side dir ++
+                   str " of " ++ pr_constr_pat (EConstr.Unsafe.to_constr (snd rule)))
+      | (d, r, lhs, rhs) :: rs ->
+        try
+          let ise = unify_HO env (Evd.create_evar_defs r_sigma) lhs rdx in
+          if not (rw_progress rhs rdx ise) then raise NoMatch else
+          d, (ise, Evd.evar_universe_context ise, Reductionops.nf_evar ise r)
+        with _ -> rwtac rs in
+     rwtac rules in
+  let find_rule rdx = prof_rwxrtac_find_rule.profile find_rule rdx in
+  let sigma0, env0, concl0 = project gl, pf_env gl, pf_concl gl in
+  let find_R, conclude = match rdx_pat with
+  | Some (_, (In_T _ | In_X_In_T _)) | None ->
+      let upats_origin = dir, EConstr.Unsafe.to_constr (snd rule) in
+      let rpat env sigma0 (sigma, pats) (d, r, lhs, rhs) =
+        let sigma, pat =
+          let rw_progress rhs t evd = rw_progress rhs (EConstr.of_constr t) evd in
+          mk_tpattern env sigma0 (sigma,EConstr.to_constr sigma r) (rw_progress rhs) d (EConstr.to_constr sigma lhs) in
+        sigma, pats @ [pat] in
+      let rpats = List.fold_left (rpat env0 sigma0) (r_sigma,[]) rules in
+      let find_R, end_R = mk_tpattern_matcher sigma0 occ ~upats_origin rpats in
+      (fun e c _ i -> find_R ~k:(fun _ _ _ h -> mkRel h) e c i), 
+      fun cl -> let rdx,d,r = end_R () in closed0_check cl rdx gl; (d,r),rdx
+  | Some(_, (T e | X_In_T (_,e) | E_As_X_In_T (e,_,_) | E_In_X_In_T (e,_,_))) ->
+      let r = ref None in
+      (fun env c _ h -> do_once r (fun () -> find_rule (EConstr.of_constr c), c); mkRel h),
+      (fun concl -> closed0_check concl e gl;
+        let (d,(ev,ctx,c)) , x = assert_done r in (d,(ev,ctx, EConstr.to_constr ev c)) , x) in
+  let concl0 = EConstr.Unsafe.to_constr concl0 in
+  let concl = eval_pattern env0 sigma0 concl0 rdx_pat occ find_R in
+  let (d, r), rdx = conclude concl in
+  let r = Evd.merge_universe_context (pi1 r) (pi2 r), EConstr.of_constr (pi3 r) in
+  rwcltac (EConstr.of_constr concl) (EConstr.of_constr rdx) d r gl
+;;
+
+let prof_rwxrtac = mk_profiler "rwrxtac";;
+let rwrxtac occ rdx_pat dir rule gl =
+  prof_rwxrtac.profile (rwrxtac occ rdx_pat dir rule) gl
+;;
+
+let ssrinstancesofrule ist dir arg gl =
+  let sigma0, env0, concl0 = project gl, pf_env gl, pf_concl gl in
+  let rule = interp_term ist gl arg in
+  let r_sigma, rules = rwprocess_rule dir rule gl in
+  let find, conclude =
+    let upats_origin = dir, EConstr.Unsafe.to_constr (snd rule) in
+    let rpat env sigma0 (sigma, pats) (d, r, lhs, rhs) =
+      let sigma, pat =
+        let rw_progress rhs t evd = rw_progress rhs (EConstr.of_constr t) evd in
+        mk_tpattern env sigma0 (sigma,EConstr.to_constr sigma r) (rw_progress rhs) d (EConstr.to_constr sigma lhs) in
+      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_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
+      ignore(find env0 (EConstr.Unsafe.to_constr concl0) 1 ~k:print)
+    done; raise NoMatch
+  with NoMatch -> Feedback.msg_info Pp.(str"END INSTANCES"); tclIDTAC gl
+
+let ipat_rewrite occ dir c gl = rwrxtac occ None dir (project gl, c) gl
+
+let rwargtac ist ((dir, mult), (((oclr, occ), grx), (kind, gt))) gl =
+  let fail = ref false in
+  let interp_rpattern gl gc =
+    try interp_rpattern gl gc
+    with _ when snd mult = May -> fail := true; project gl, T mkProp in
+  let interp gc gl =
+    try interp_term ist gl gc
+    with _ when snd mult = May -> fail := true; (project gl, EConstr.mkProp) in
+  let rwtac gl = 
+    let rx = Option.map (interp_rpattern gl) grx in
+    let t = interp gt gl in
+    (match kind with
+    | RWred sim -> simplintac occ rx sim
+    | RWdef -> if dir = R2L then foldtac occ rx t else unfoldintac occ rx t gt
+    | RWeq -> rwrxtac occ rx dir t) gl in
+  let ctac = old_cleartac (interp_clr (project gl) (oclr, (fst gt, snd (interp gt gl)))) in
+  if !fail then ctac gl else tclTHEN (tclMULT mult rwtac) ctac gl
+
+(** Rewrite argument sequence *)
+
+(* type ssrrwargs = ssrrwarg list *)
+
+(** The "rewrite" tactic *)
+
+let ssrrewritetac ist rwargs =
+  tclTHENLIST (List.map (rwargtac ist) rwargs)
+
+(** The "unlock" tactic *)
+
+let unfoldtac occ ko t kt gl =
+  let env = pf_env gl in
+  let cl, c = pf_fill_occ_term gl occ (fst (strip_unfold_term env t kt)) in
+  let cl' = EConstr.Vars.subst1 (pf_unfoldn [OnlyOccurrences [1], get_evalref (project gl) c] gl c) cl in
+  let f = if ko = None then CClosure.betaiotazeta else CClosure.betaiota in
+  Proofview.V82.of_tactic
+    (convert_concl (pf_reduce (Reductionops.clos_norm_flags f) gl cl')) gl
+
+let unlocktac ist args gl =
+  let utac (occ, gt) gl =
+    unfoldtac occ occ (interp_term ist gl gt) (fst gt) gl in
+  let locked, gl = pf_mkSsrConst "locked" gl in
+  let key, gl = pf_mkSsrConst "master_key" gl in
+  let ktacs = [
+    (fun gl -> unfoldtac None None (project gl,locked) xInParens gl); 
+    Ssrelim.casetac key ] in
+  tclTHENLIST (List.map utac args @ ktacs) gl
+
diff --git a/plugins/ssr/ssrequality.mli b/plugins/ssr/ssrequality.mli
new file mode 100644
index 00000000..bbcd6b90
--- /dev/null
+++ b/plugins/ssr/ssrequality.mli
@@ -0,0 +1,64 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Ssrmatching_plugin
+open Ssrast
+
+type ssrwkind = RWred of ssrsimpl | RWdef | RWeq
+type ssrrule = ssrwkind * ssrterm
+type ssrrwarg = (ssrdir * ssrmult) * ((ssrdocc * Ssrmatching.rpattern option) * ssrrule)
+
+val dir_org : ssrdir -> int
+
+val notimes : int
+val nomult : ssrmult
+val mkocc : ssrocc -> ssrdocc
+val mkclr : ssrclear -> ssrdocc
+val nodocc : ssrdocc
+val noclr : ssrdocc
+
+val simpltac : Ssrast.ssrsimpl -> Tacmach.tactic
+
+val newssrcongrtac :
+  int * Ssrast.ssrterm ->
+  Ltac_plugin.Tacinterp.interp_sign ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+
+
+val mk_rwarg :
+  Ssrast.ssrdir * (int * Ssrast.ssrmmod) ->
+  (Ssrast.ssrclear option * Ssrast.ssrocc) * Ssrmatching.rpattern option ->
+  ssrwkind * Ssrast.ssrterm -> ssrrwarg
+
+val norwmult : ssrdir * ssrmult
+val norwocc : (Ssrast.ssrclear option * Ssrast.ssrocc) * Ssrmatching.rpattern option
+
+val ssrinstancesofrule :
+  Ltac_plugin.Tacinterp.interp_sign ->
+  Ssrast.ssrdir ->
+  Ssrast.ssrterm ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+
+val ssrrewritetac :
+  Ltac_plugin.Tacinterp.interp_sign ->
+  ((Ssrast.ssrdir * (int * Ssrast.ssrmmod)) *
+     (((Ssrast.ssrhyps option * Ssrmatching.occ) *
+         Ssrmatching.rpattern option) *
+        (ssrwkind * Ssrast.ssrterm)))
+           list -> Tacmach.tactic
+
+val ipat_rewrite : ssrocc -> ssrdir -> EConstr.t -> Tacmach.tactic
+
+val unlocktac :
+  Ltac_plugin.Tacinterp.interp_sign ->
+  (Ssrmatching.occ * Ssrast.ssrterm) list ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
diff --git a/plugins/ssr/ssrfun.v b/plugins/ssr/ssrfun.v
new file mode 100644
index 00000000..ac2c7824
--- /dev/null
+++ b/plugins/ssr/ssrfun.v
@@ -0,0 +1,796 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+Require Import ssreflect.
+
+(******************************************************************************)
+(* This file contains the basic definitions and notations for working with    *)
+(* functions. The definitions provide for:                                    *)
+(*                                                                            *)
+(* - Pair projections:                                                        *)
+(*    p.1  == first element of a pair                                         *)
+(*    p.2  == second element of a pair                                        *)
+(*   These notations also apply to p : P /\ Q, via an and >-> pair coercion.  *)
+(*                                                                            *)
+(* - Simplifying functions, beta-reduced by /= and simpl:                     *)
+(*           [fun : T => E] == constant function from type T that returns E   *)
+(*             [fun x => E] == unary function                                 *)
+(*         [fun x : T => E] == unary function with explicit domain type       *)
+(*           [fun x y => E] == binary function                                *)
+(*       [fun x y : T => E] == binary function with common domain type        *)
+(*         [fun (x : T) y => E] \                                             *)
+(* [fun (x : xT) (y : yT) => E] | == binary function with (some) explicit,    *)
+(*         [fun x (y : T) => E] / independent domain types for each argument  *)
+(*                                                                            *)
+(* - Partial functions using option type:                                     *)
+(*     oapp f d ox == if ox is Some x returns f x,        d otherwise         *)
+(*      odflt d ox == if ox is Some x returns x,          d otherwise         *)
+(*      obind f ox == if ox is Some x returns f x,        None otherwise      *)
+(*       omap f ox == if ox is Some x returns Some (f x), None otherwise      *)
+(*                                                                            *)
+(* - Singleton types:                                                         *)
+(*  all_equal_to x0 == x0 is the only value in its type, so any such value    *)
+(*                     can be rewritten to x0.                                *)
+(*                                                                            *)
+(* - A generic wrapper type:                                                  *)
+(*       wrapped T == the inductive type with values Wrap x for x : T.        *)
+(*        unwrap w == the projection of w : wrapped T on T.                   *)
+(*          wrap x == the canonical injection of x : T into wrapped T; it is  *)
+(*                    equivalent to Wrap x, but is declared as a (default)    *)
+(*                    Canonical Structure, which lets the Coq HO unification  *)
+(*                    automatically expand x into unwrap (wrap x). The delta  *)
+(*                    reduction of wrap x to Wrap can be exploited to         *)
+(*                    introduce controlled nondeterminism in Canonical        *)
+(*                    Structure inference, as in the implementation of        *)
+(*                    the mxdirect predicate in matrix.v.                     *)
+(*                                                                            *)
+(* - Sigma types:                                                             *)
+(*           tag w == the i of w : {i : I & T i}.                             *)
+(*        tagged w == the T i component of w : {i : I & T i}.                 *)
+(*      Tagged T x == the {i : I & T i} with component x : T i.               *)
+(*          tag2 w == the i of w : {i : I & T i & U i}.                       *)
+(*       tagged2 w == the T i component of w : {i : I & T i & U i}.           *)
+(*      tagged2' w == the U i component of w : {i : I & T i & U i}.           *)
+(* Tagged2 T U x y == the {i : I & T i} with components x : T i and y : U i.  *)
+(*          sval u == the x of u : {x : T | P x}.                             *)
+(*         s2val u == the x of u : {x : T | P x & Q x}.                       *)
+(*   The properties of sval u, s2val u are given by lemmas svalP, s2valP, and *)
+(*   s2valP'. We provide coercions sigT2 >-> sigT and sig2 >-> sig >-> sigT.  *)
+(*   A suite of lemmas (all_sig, ...) let us skolemize sig, sig2, sigT, sigT2 *)
+(*   and pair, e.g.,                                                          *)
+(*     have /all_sig[f fP] (x : T): {y : U | P y} by ...                      *)
+(*   yields an f : T -> U such that fP : forall x, P (f x).                   *)
+(* - Identity functions:                                                      *)
+(*    id           == NOTATION for the explicit identity function fun x => x. *)
+(*    @id T        == notation for the explicit identity at type T.           *)
+(*    idfun        == an expression with a head constant, convertible to id;  *)
+(*                    idfun x simplifies to x.                                *)
+(*    @idfun T     == the expression above, specialized to type T.            *)
+(*    phant_id x y == the function type phantom _ x -> phantom _ y.           *)
+(* *** In addition to their casual use in functional programming, identity    *)
+(* functions are often used to trigger static unification as part of the      *)
+(* construction of dependent Records and Structures. For example, if we need  *)
+(* a structure sT over a type T, we take as arguments T, sT, and a "dummy"    *)
+(* function T -> sort sT:                                                     *)
+(*   Definition foo T sT & T -> sort sT := ...                                *)
+(* We can avoid specifying sT directly by calling foo (@id T), or specify     *)
+(* the call completely while still ensuring the consistency of T and sT, by   *)
+(* calling @foo T sT idfun. The phant_id type allows us to extend this trick  *)
+(* to non-Type canonical projections. It also allows us to sidestep           *)
+(* dependent type constraints when building explicit records, e.g., given     *)
+(*    Record r := R {x; y : T(x)}.                                            *)
+(* if we need to build an r from a given y0 while inferring some x0, such     *)
+(* that y0 : T(x0), we pose                                                   *)
+(*    Definition mk_r .. y .. (x := ...) y' & phant_id y y' := R x y'.        *)
+(* Calling @mk_r .. y0 .. id will cause Coq to use y' := y0, while checking   *)
+(* the dependent type constraint y0 : T(x0).                                  *)
+(*                                                                            *)
+(* - Extensional equality for functions and relations (i.e. functions of two  *)
+(*   arguments):                                                              *)
+(*    f1 =1 f2      ==  f1 x is equal to f2 x for all x.                      *)
+(*    f1 =1 f2 :> A ==    ... and f2 is explicitly typed.                     *)
+(*    f1 =2 f2      ==  f1 x y is equal to f2 x y for all x y.                *)
+(*    f1 =2 f2 :> A ==    ... and f2 is explicitly typed.                     *)
+(*                                                                            *)
+(* - Composition for total and partial functions:                             *)
+(*            f^~ y == function f with second argument specialised to y,      *)
+(*                     i.e., fun x => f x y                                   *)
+(*                     CAVEAT: conditional (non-maximal) implicit arguments   *)
+(*                     of f are NOT inserted in this context                  *)
+(*            @^~ x == application at x, i.e., fun f => f x                   *)
+(*          [eta f] == the explicit eta-expansion of f, i.e., fun x => f x    *)
+(*                     CAVEAT: conditional (non-maximal) implicit arguments   *)
+(*                     of f are NOT inserted in this context.                 *)
+(*          fun=> v := the constant function fun _ => v.                      *)
+(*        f1 \o f2  == composition of f1 and f2.                              *)
+(*                     Note: (f1 \o f2) x simplifies to f1 (f2 x).            *)
+(*         f1 \; f2 == categorical composition of f1 and f2. This expands to  *)
+(*                     to f2 \o f1 and (f1 \; f2) x simplifies to f2 (f1 x).  *)
+(*      pcomp f1 f2 == composition of partial functions f1 and f2.            *)
+(*                                                                            *)
+(*                                                                            *)
+(* - Properties of functions:                                                 *)
+(*      injective f <-> f is injective.                                       *)
+(*       cancel f g <-> g is a left inverse of f / f is a right inverse of g. *)
+(*      pcancel f g <-> g is a left inverse of f where g is partial.          *)
+(*      ocancel f g <-> g is a left inverse of f where f is partial.          *)
+(*      bijective f <-> f is bijective (has a left and right inverse).        *)
+(*     involutive f <-> f is involutive.                                      *)
+(*                                                                            *)
+(* - Properties for operations.                                               *)
+(*              left_id e op <-> e is a left identity for op (e op x = x).    *)
+(*             right_id e op <-> e is a right identity for op (x op e = x).   *)
+(*     left_inverse e inv op <-> inv is a left inverse for op wrt identity e, *)
+(*                               i.e., (inv x) op x = e.                      *)
+(*    right_inverse e inv op <-> inv is a right inverse for op wrt identity e *)
+(*                               i.e., x op (i x) = e.                        *)
+(*         self_inverse e op <-> each x is its own op-inverse (x op x = e).   *)
+(*             idempotent op <-> op is idempotent for op (x op x = x).        *)
+(*              associative op <-> op is associative, i.e.,                   *)
+(*                               x op (y op z) = (x op y) op z.               *)
+(*            commutative op <-> op is commutative (x op y = y op x).         *)
+(*       left_commutative op <-> op is left commutative, i.e.,                *)
+(*                                   x op (y op z) = y op (x op z).           *)
+(*      right_commutative op <-> op is right commutative, i.e.,               *)
+(*                                   (x op y) op z = (x op z) op y.           *)
+(*            left_zero z op <-> z is a left zero for op (z op x = z).        *)
+(*           right_zero z op <-> z is a right zero for op (x op z = z).       *)
+(*  left_distributive op1 op2 <-> op1 distributes over op2 to the left:       *)
+(*                             (x op2 y) op1 z = (x op1 z) op2 (y op1 z).     *)
+(* right_distributive op1 op2 <-> op distributes over add to the right:       *)
+(*                             x op1 (y op2 z) = (x op1 z) op2 (x op1 z).     *)
+(*        interchange op1 op2 <-> op1 and op2 satisfy an interchange law:     *)
+(*                        (x op2 y) op1 (z op2 t) = (x op1 z) op2 (y op1 t).  *)
+(*  Note that interchange op op is a commutativity property.                  *)
+(*         left_injective op <-> op is injective in its left argument:        *)
+(*                             x op y = z op y -> x = z.                      *)
+(*        right_injective op <-> op is injective in its right argument:       *)
+(*                             x op y = x op z -> y = z.                      *)
+(*          left_loop inv op <-> op, inv obey the inverse loop left axiom:    *)
+(*                              (inv x) op (x op y) = y for all x, y, i.e.,   *)
+(*                              op (inv x) is always a left inverse of op x   *)
+(*      rev_left_loop inv op <-> op, inv obey the inverse loop reverse left   *)
+(*                              axiom: x op ((inv x) op y) = y, for all x, y. *)
+(*         right_loop inv op <-> op, inv obey the inverse loop right axiom:   *)
+(*                              (x op y) op (inv y) = x for all x, y.         *)
+(*     rev_right_loop inv op <-> op, inv obey the inverse loop reverse right  *)
+(*                              axiom: (x op y) op (inv y) = x for all x, y.  *)
+(*   Note that familiar "cancellation" identities like x + y - y = x or       *)
+(* x - y + y = x are respectively instances of right_loop and rev_right_loop  *)
+(* The corresponding lemmas will use the K and NK/VK suffixes, respectively.  *)
+(*                                                                            *)
+(* - Morphisms for functions and relations:                                   *)
+(*    {morph f : x / a >-> r} <-> f is a morphism with respect to functions   *)
+(*                               (fun x => a) and (fun x => r); if r == R[x], *)
+(*                               this states that f a = R[f x] for all x.     *)
+(*          {morph f : x / a} <-> f is a morphism with respect to the         *)
+(*                               function expression (fun x => a). This is    *)
+(*                               shorthand for {morph f : x / a >-> a}; note  *)
+(*                               that the two instances of a are often        *)
+(*                               interpreted at different types.              *)
+(*  {morph f : x y / a >-> r} <-> f is a morphism with respect to functions   *)
+(*                               (fun x y => a) and (fun x y => r).           *)
+(*        {morph f : x y / a} <-> f is a morphism with respect to the         *)
+(*                               function expression (fun x y => a).          *)
+(*     {homo f : x / a >-> r} <-> f is a homomorphism with respect to the     *)
+(*                               predicates (fun x => a) and (fun x => r);    *)
+(*                               if r == R[x], this states that a -> R[f x]   *)
+(*                               for all x.                                   *)
+(*           {homo f : x / a} <-> f is a homomorphism with respect to the     *)
+(*                               predicate expression (fun x => a).           *)
+(*   {homo f : x y / a >-> r} <-> f is a homomorphism with respect to the     *)
+(*                               relations (fun x y => a) and (fun x y => r). *)
+(*         {homo f : x y / a} <-> f is a homomorphism with respect to the     *)
+(*                               relation expression (fun x y => a).          *)
+(*     {mono f : x / a >-> r} <-> f is monotone with respect to projectors    *)
+(*                               (fun x => a) and (fun x => r); if r == R[x], *)
+(*                               this states that R[f x] = a for all x.       *)
+(*           {mono f : x / a} <-> f is monotone with respect to the projector *)
+(*                               expression (fun x => a).                     *)
+(*   {mono f : x y / a >-> r} <-> f is monotone with respect to relators      *)
+(*                               (fun x y => a) and (fun x y => r).           *)
+(*         {mono f : x y / a} <-> f is monotone with respect to the relator   *)
+(*                               expression (fun x y => a).                   *)
+(*                                                                            *)
+(* The file also contains some basic lemmas for the above concepts.           *)
+(* Lemmas relative to cancellation laws use some abbreviated suffixes:        *)
+(*   K - a cancellation rule like esymK : cancel (@esym T x y) (@esym T y x). *)
+(*  LR - a lemma moving an operation from the left hand side of a relation to *)
+(*       the right hand side, like canLR: cancel g f -> x = g y -> f x = y.   *)
+(*  RL - a lemma moving an operation from the right to the left, e.g., canRL. *)
+(* Beware that the LR and RL orientations refer to an "apply" (back chaining) *)
+(* usage; when using the same lemmas with "have" or "move" (forward chaining) *)
+(* the directions will be reversed!.                                          *)
+(******************************************************************************)
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Delimit Scope fun_scope with FUN.
+Open Scope fun_scope.
+
+(* Notations for argument transpose *)
+Notation "f ^~ y" := (fun x => f x y)
+  (at level 10, y at level 8, no associativity, format "f ^~  y") : fun_scope.
+Notation "@^~ x" := (fun f => f x)
+  (at level 10, x at level 8, no associativity, format "@^~  x") : fun_scope.
+
+Delimit Scope pair_scope with PAIR.
+Open Scope pair_scope.
+
+(* Notations for pair/conjunction projections *)
+Notation "p .1" := (fst p)
+  (at level 2, left associativity, format "p .1") : pair_scope.
+Notation "p .2" := (snd p)
+  (at level 2, left associativity, format "p .2") : pair_scope.
+
+Coercion pair_of_and P Q (PandQ : P /\ Q) := (proj1 PandQ, proj2 PandQ).
+
+Definition all_pair I T U (w : forall i : I, T i * U i) :=
+  (fun i => (w i).1, fun i => (w i).2).
+
+(* Complements on the option type constructor, used below to  *)
+(* encode partial functions.                                  *)
+
+Module Option.
+
+Definition apply aT rT (f : aT -> rT) x u := if u is Some y then f y else x.
+
+Definition default T := apply (fun x : T => x).
+
+Definition bind aT rT (f : aT -> option rT) := apply f None.
+
+Definition map aT rT (f : aT -> rT) := bind (fun x => Some (f x)).
+
+End Option.
+
+Notation oapp := Option.apply.
+Notation odflt := Option.default.
+Notation obind := Option.bind.
+Notation omap := Option.map.
+Notation some := (@Some _) (only parsing).
+
+(* Shorthand for some basic equality lemmas. *)
+
+Notation erefl := refl_equal.
+Notation ecast i T e x := (let: erefl in _ = i := e return T in x).
+Definition esym := sym_eq.
+Definition nesym := sym_not_eq.
+Definition etrans := trans_eq.
+Definition congr1 := f_equal.
+Definition congr2 := f_equal2.
+(* Force at least one implicit when used as a view. *)
+Prenex Implicits esym nesym.
+
+(* A predicate for singleton types.                                           *)
+Definition all_equal_to T (x0 : T) := forall x, unkeyed x = x0.
+
+Lemma unitE : all_equal_to tt. Proof. by case. Qed.
+
+(* A generic wrapper type *)
+
+Structure wrapped T := Wrap {unwrap : T}.
+Canonical wrap T x := @Wrap T x.
+
+Prenex Implicits unwrap wrap Wrap.
+
+(* Syntax for defining auxiliary recursive function.          *)
+(*  Usage:                                                    *)
+(* Section FooDefinition.                                     *)
+(* Variables (g1 : T1) (g2 : T2).  (globals)                  *)
+(* Fixoint foo_auxiliary (a3 : T3) ... :=                     *)
+(*        body, using [rec e3, ...] for recursive calls       *)
+(* where "[ 'rec' a3 , a4 , ... ]" := foo_auxiliary.          *)
+(* Definition foo x y .. := [rec e1, ...].                    *)
+(* + proofs about foo                                         *)
+(* End FooDefinition.                                         *)
+
+Reserved Notation "[ 'rec' a0 ]"
+  (at level 0, format "[ 'rec'  a0 ]").
+Reserved Notation "[ 'rec' a0 , a1 ]"
+  (at level 0, format "[ 'rec'  a0 ,  a1 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 ]"
+  (at level 0, format "[ 'rec'  a0 ,  a1 ,  a2 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 ]"
+  (at level 0, format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 , a4 ]"
+  (at level 0, format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ,  a4 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 , a4 , a5 ]"
+  (at level 0, format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ,  a4 ,  a5 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 , a4 , a5 , a6 ]"
+  (at level 0, format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ,  a4 ,  a5 ,  a6 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 , a4 , a5 , a6 , a7 ]"
+  (at level 0,
+  format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ,  a4 ,  a5 ,  a6 ,  a7 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 , a4 , a5 , a6 , a7 , a8 ]"
+  (at level 0,
+  format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ,  a4 ,  a5 ,  a6 ,  a7 ,  a8 ]").
+Reserved Notation "[ 'rec' a0 , a1 , a2 , a3 , a4 , a5 , a6 , a7 , a8 , a9 ]"
+  (at level 0,
+  format "[ 'rec'  a0 ,  a1 ,  a2 ,  a3 ,  a4 ,  a5 ,  a6 ,  a7 ,  a8 ,  a9 ]").
+
+(* Definitions and notation for explicit functions with simplification,     *)
+(* i.e., which simpl and /= beta expand (this is complementary to nosimpl). *)
+
+Section SimplFun.
+
+Variables aT rT : Type.
+
+CoInductive simpl_fun := SimplFun of aT -> rT.
+
+Definition fun_of_simpl f := fun x => let: SimplFun lam := f in lam x.
+
+Coercion fun_of_simpl : simpl_fun >-> Funclass.
+
+End SimplFun.
+
+Notation "[ 'fun' : T => E ]" := (SimplFun (fun _ : T => E))
+  (at level 0,
+   format "'[hv' [ 'fun' :  T  => '/ '  E ] ']'") : fun_scope.
+
+Notation "[ 'fun' x => E ]" := (SimplFun (fun x => E))
+  (at level 0, x ident,
+   format "'[hv' [ 'fun'  x  => '/ '  E ] ']'") : fun_scope.
+
+Notation "[ 'fun' x : T => E ]" := (SimplFun (fun x : T => E))
+  (at level 0, x ident, only parsing) : fun_scope.
+
+Notation "[ 'fun' x y => E ]" := (fun x => [fun y => E])
+  (at level 0, x ident, y ident,
+   format "'[hv' [ 'fun'  x  y  => '/ '  E ] ']'") : fun_scope.
+
+Notation "[ 'fun' x y : T => E ]" := (fun x : T => [fun y : T => E])
+  (at level 0, x ident, y ident, only parsing) : fun_scope.
+
+Notation "[ 'fun' ( x : T ) y => E ]" := (fun x : T => [fun y => E])
+  (at level 0, x ident, y ident, only parsing) : fun_scope.
+
+Notation "[ 'fun' x ( y : T ) => E ]" := (fun x => [fun y : T => E])
+  (at level 0, x ident, y ident, only parsing) : fun_scope.
+
+Notation "[ 'fun' ( x : xT ) ( y : yT ) => E ]" :=
+    (fun x : xT => [fun y : yT => E])
+  (at level 0, x ident, y ident, only parsing) : fun_scope.
+
+(* For delta functions in eqtype.v. *)
+Definition SimplFunDelta aT rT (f : aT -> aT -> rT) := [fun z => f z z].
+
+(* Extensional equality, for unary and binary functions, including syntactic  *)
+(* sugar.                                                                     *)
+
+Section ExtensionalEquality.
+
+Variables A B C : Type.
+
+Definition eqfun (f g : B -> A) : Prop := forall x, f x = g x.
+
+Definition eqrel (r s : C -> B -> A) : Prop := forall x y, r x y = s x y.
+
+Lemma frefl f : eqfun f f. Proof. by []. Qed.
+Lemma fsym f g : eqfun f g -> eqfun g f. Proof. by move=> eq_fg x. Qed.
+
+Lemma ftrans f g h : eqfun f g -> eqfun g h -> eqfun f h.
+Proof. by move=> eq_fg eq_gh x; rewrite eq_fg. Qed.
+
+Lemma rrefl r : eqrel r r. Proof. by []. Qed.
+
+End ExtensionalEquality.
+
+Typeclasses Opaque eqfun.
+Typeclasses Opaque eqrel.
+
+Hint Resolve frefl rrefl.
+
+Notation "f1 =1 f2" := (eqfun f1 f2)
+  (at level 70, no associativity) : fun_scope.
+Notation "f1 =1 f2 :> A" := (f1 =1 (f2 : A))
+  (at level 70, f2 at next level, A at level 90) : fun_scope.
+Notation "f1 =2 f2" := (eqrel f1 f2)
+  (at level 70, no associativity) : fun_scope.
+Notation "f1 =2 f2 :> A" := (f1 =2 (f2 : A))
+  (at level 70, f2 at next level, A at level 90) : fun_scope.
+
+Section Composition.
+
+Variables A B C : Type.
+
+Definition funcomp u (f : B -> A) (g : C -> B) x := let: tt := u in f (g x).
+Definition catcomp u g f := funcomp u f g.
+Local Notation comp := (funcomp tt).
+
+Definition pcomp (f : B -> option A) (g : C -> option B) x := obind f (g x).
+
+Lemma eq_comp f f' g g' : f =1 f' -> g =1 g' -> comp f g =1 comp f' g'.
+Proof. by move=> eq_ff' eq_gg' x; rewrite /= eq_gg' eq_ff'. Qed.
+
+End Composition.
+
+Notation comp := (funcomp tt).
+Notation "@ 'comp'" := (fun A B C => @funcomp A B C tt).
+Notation "f1 \o f2" := (comp f1 f2)
+  (at level 50, format "f1  \o '/ '  f2") : fun_scope.
+Notation "f1 \; f2" := (catcomp tt f1 f2)
+  (at level 60, right associativity, format "f1  \; '/ '  f2") : fun_scope.
+
+Notation "[ 'eta' f ]" := (fun x => f x)
+  (at level 0, format "[ 'eta'  f ]") : fun_scope.
+
+Notation "'fun' => E" := (fun _ => E) (at level 200, only parsing) : fun_scope.
+
+Notation id := (fun x => x).
+Notation "@ 'id' T" := (fun x : T => x)
+  (at level 10, T at level 8, only parsing) : fun_scope.
+
+Definition id_head T u x : T := let: tt := u in x.
+Definition explicit_id_key := tt.
+Notation idfun := (id_head tt).
+Notation "@ 'idfun' T " := (@id_head T explicit_id_key)
+  (at level 10, T at level 8, format "@ 'idfun'  T") : fun_scope.
+
+Definition phant_id T1 T2 v1 v2 := phantom T1 v1 -> phantom T2 v2.
+
+(* Strong sigma types. *)
+
+Section Tag.
+
+Variables (I : Type) (i : I) (T_ U_ : I -> Type).
+
+Definition tag := projT1.
+Definition tagged : forall w, T_(tag w) := @projT2 I [eta T_].
+Definition Tagged x := @existT I [eta T_] i x.
+
+Definition tag2 (w : @sigT2 I T_ U_) := let: existT2 _ _ i _ _ := w in i.
+Definition tagged2 w : T_(tag2 w) := let: existT2 _ _ _ x _ := w in x.
+Definition tagged2' w : U_(tag2 w) := let: existT2 _ _ _ _ y := w in y.
+Definition Tagged2 x y := @existT2 I [eta T_] [eta U_] i x y.
+
+End Tag.
+
+Arguments Tagged [I i].
+Arguments Tagged2 [I i].
+Prenex Implicits tag tagged Tagged tag2 tagged2 tagged2' Tagged2.
+
+Coercion tag_of_tag2 I T_ U_ (w : @sigT2 I T_ U_) :=
+  Tagged (fun i => T_ i * U_ i)%type (tagged2 w, tagged2' w).
+
+Lemma all_tag I T U :
+   (forall x : I, {y : T x & U x y}) ->
+  {f : forall x, T x & forall x, U x (f x)}.
+Proof. by move=> fP; exists (fun x => tag (fP x)) => x; case: (fP x). Qed.
+
+Lemma all_tag2 I T U V :
+    (forall i : I, {y : T i & U i y & V i y}) ->
+  {f : forall i, T i & forall i, U i (f i) & forall i, V i (f i)}.
+Proof. by case/all_tag=> f /all_pair[]; exists f. Qed.
+
+(* Refinement types. *)
+
+(* Prenex Implicits and renaming. *)
+Notation sval := (@proj1_sig _ _).
+Notation "@ 'sval'" := (@proj1_sig) (at level 10, format "@ 'sval'").
+
+Section Sig.
+
+Variables (T : Type) (P Q : T -> Prop).
+
+Lemma svalP (u : sig P) : P (sval u). Proof. by case: u. Qed.
+
+Definition s2val (u : sig2 P Q) := let: exist2 _ _ x _ _ := u in x.
+
+Lemma s2valP u : P (s2val u). Proof. by case: u. Qed.
+
+Lemma s2valP' u : Q (s2val u). Proof. by case: u. Qed.
+
+End Sig.
+
+Prenex Implicits svalP s2val s2valP s2valP'.
+
+Coercion tag_of_sig I P (u : @sig I P) := Tagged P (svalP u).
+
+Coercion sig_of_sig2 I P Q (u : @sig2 I P Q) :=
+  exist (fun i => P i /\ Q i) (s2val u) (conj (s2valP u) (s2valP' u)).
+
+Lemma all_sig I T P :
+    (forall x : I, {y : T x | P x y}) ->
+  {f : forall x, T x | forall x, P x (f x)}.
+Proof. by case/all_tag=> f; exists f. Qed.
+
+Lemma all_sig2 I T P Q :
+    (forall x : I, {y : T x | P x y & Q x y}) ->
+  {f : forall x, T x | forall x, P x (f x) & forall x, Q x (f x)}.
+Proof. by case/all_sig=> f /all_pair[]; exists f. Qed.
+
+Section Morphism.
+
+Variables (aT rT sT : Type) (f : aT -> rT).
+
+(* Morphism property for unary and binary functions *)
+Definition morphism_1 aF rF := forall x, f (aF x) = rF (f x).
+Definition morphism_2 aOp rOp := forall x y, f (aOp x y) = rOp (f x) (f y).
+
+(* Homomorphism property for unary and binary relations *)
+Definition homomorphism_1 (aP rP : _ -> Prop) := forall x, aP x -> rP (f x).
+Definition homomorphism_2 (aR rR : _ -> _ -> Prop) :=
+  forall x y, aR x y -> rR (f x) (f y).
+
+(* Stability property for unary and binary relations *)
+Definition monomorphism_1 (aP rP : _ -> sT) := forall x, rP (f x) = aP x.
+Definition monomorphism_2 (aR rR : _ -> _ -> sT) :=
+  forall x y, rR (f x) (f y) = aR x y.
+
+End Morphism.
+
+Notation "{ 'morph' f : x / a >-> r }" :=
+  (morphism_1 f (fun x => a) (fun x => r))
+  (at level 0, f at level 99, x ident,
+   format "{ 'morph'  f  :  x  /  a  >->  r }") : type_scope.
+
+Notation "{ 'morph' f : x / a }" :=
+  (morphism_1 f (fun x => a) (fun x => a))
+  (at level 0, f at level 99, x ident,
+   format "{ 'morph'  f  :  x  /  a }") : type_scope.
+
+Notation "{ 'morph' f : x y / a >-> r }" :=
+  (morphism_2 f (fun x y => a) (fun x y => r))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'morph'  f  :  x  y  /  a  >->  r }") : type_scope.
+
+Notation "{ 'morph' f : x y / a }" :=
+  (morphism_2 f (fun x y => a) (fun x y => a))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'morph'  f  :  x  y  /  a }") : type_scope.
+
+Notation "{ 'homo' f : x / a >-> r }" :=
+  (homomorphism_1 f (fun x => a) (fun x => r))
+  (at level 0, f at level 99, x ident,
+   format "{ 'homo'  f  :  x  /  a  >->  r }") : type_scope.
+
+Notation "{ 'homo' f : x / a }" :=
+  (homomorphism_1 f (fun x => a) (fun x => a))
+  (at level 0, f at level 99, x ident,
+   format "{ 'homo'  f  :  x  /  a }") : type_scope.
+
+Notation "{ 'homo' f : x y / a >-> r }" :=
+  (homomorphism_2 f (fun x y => a) (fun x y => r))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'homo'  f  :  x  y  /  a  >->  r }") : type_scope.
+
+Notation "{ 'homo' f : x y / a }" :=
+  (homomorphism_2 f (fun x y => a) (fun x y => a))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'homo'  f  :  x  y  /  a }") : type_scope.
+
+Notation "{ 'homo' f : x y /~ a }" :=
+  (homomorphism_2 f (fun y x => a) (fun x y => a))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'homo'  f  :  x  y  /~  a }") : type_scope.
+
+Notation "{ 'mono' f : x / a >-> r }" :=
+  (monomorphism_1 f (fun x => a) (fun x => r))
+  (at level 0, f at level 99, x ident,
+   format "{ 'mono'  f  :  x  /  a  >->  r }") : type_scope.
+
+Notation "{ 'mono' f : x / a }" :=
+  (monomorphism_1 f (fun x => a) (fun x => a))
+  (at level 0, f at level 99, x ident,
+   format "{ 'mono'  f  :  x  /  a }") : type_scope.
+
+Notation "{ 'mono' f : x y / a >-> r }" :=
+  (monomorphism_2 f (fun x y => a) (fun x y => r))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'mono'  f  :  x  y  /  a  >->  r }") : type_scope.
+
+Notation "{ 'mono' f : x y / a }" :=
+  (monomorphism_2 f (fun x y => a) (fun x y => a))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'mono'  f  :  x  y  /  a }") : type_scope.
+
+Notation "{ 'mono' f : x y /~ a }" :=
+  (monomorphism_2 f (fun y x => a) (fun x y => a))
+  (at level 0, f at level 99, x ident, y ident,
+   format "{ 'mono'  f  :  x  y  /~  a }") : type_scope.
+
+(* In an intuitionistic setting, we have two degrees of injectivity. The     *)
+(* weaker one gives only simplification, and the strong one provides a left  *)
+(* inverse (we show in `fintype' that they coincide for finite types).       *)
+(* We also define an intermediate version where the left inverse is only a   *)
+(* partial function.                                                         *)
+
+Section Injections.
+
+(* rT must come first so we can use @ to mitigate the Coq 1st order   *)
+(* unification bug (e..g., Coq can't infer rT from a "cancel" lemma). *)
+Variables (rT aT : Type) (f : aT -> rT).
+
+Definition injective := forall x1 x2, f x1 = f x2 -> x1 = x2.
+
+Definition cancel g := forall x, g (f x) = x.
+
+Definition pcancel g := forall x, g (f x) = Some x.
+
+Definition ocancel (g : aT -> option rT) h := forall x, oapp h x (g x) = x.
+
+Lemma can_pcan g : cancel g -> pcancel (fun y => Some (g y)).
+Proof. by move=> fK x; congr (Some _). Qed.
+
+Lemma pcan_inj g : pcancel g -> injective.
+Proof. by move=> fK x y /(congr1 g); rewrite !fK => [[]]. Qed.
+
+Lemma can_inj g : cancel g -> injective.
+Proof. by move/can_pcan; apply: pcan_inj. Qed.
+
+Lemma canLR g x y : cancel g -> x = f y -> g x = y.
+Proof. by move=> fK ->. Qed.
+
+Lemma canRL g x y : cancel g -> f x = y -> x = g y.
+Proof. by move=> fK <-. Qed.
+
+End Injections.
+
+Lemma Some_inj {T} : injective (@Some T). Proof. by move=> x y []. Qed.
+
+(* Force implicits to use as a view. *)
+Prenex Implicits Some_inj.
+
+(* cancellation lemmas for dependent type casts.                             *)
+Lemma esymK T x y : cancel (@esym T x y) (@esym T y x).
+Proof. by case: y /. Qed.
+
+Lemma etrans_id T x y (eqxy : x = y :> T) : etrans (erefl x) eqxy = eqxy.
+Proof. by case: y / eqxy. Qed.
+
+Section InjectionsTheory.
+
+Variables (A B C : Type) (f g : B -> A) (h : C -> B).
+
+Lemma inj_id : injective (@id A).
+Proof. by []. Qed.
+
+Lemma inj_can_sym f' : cancel f f' -> injective f' -> cancel f' f.
+Proof. by move=> fK injf' x; apply: injf'. Qed.
+
+Lemma inj_comp : injective f -> injective h -> injective (f \o h).
+Proof. by move=> injf injh x y /injf; apply: injh. Qed.
+
+Lemma can_comp f' h' : cancel f f' -> cancel h h' -> cancel (f \o h) (h' \o f').
+Proof. by move=> fK hK x; rewrite /= fK hK. Qed.
+
+Lemma pcan_pcomp f' h' :
+  pcancel f f' -> pcancel h h' -> pcancel (f \o h) (pcomp h' f').
+Proof. by move=> fK hK x; rewrite /pcomp fK /= hK. Qed.
+
+Lemma eq_inj : injective f -> f =1 g -> injective g.
+Proof. by move=> injf eqfg x y; rewrite -2!eqfg; apply: injf. Qed.
+
+Lemma eq_can f' g' : cancel f f' -> f =1 g -> f' =1 g' -> cancel g g'.
+Proof. by move=> fK eqfg eqfg' x; rewrite -eqfg -eqfg'. Qed.
+
+Lemma inj_can_eq f' : cancel f f' -> injective f' -> cancel g f' -> f =1 g.
+Proof. by move=> fK injf' gK x; apply: injf'; rewrite fK. Qed.
+
+End InjectionsTheory.
+
+Section Bijections.
+
+Variables (A B : Type) (f : B -> A).
+
+CoInductive bijective : Prop := Bijective g of cancel f g & cancel g f.
+
+Hypothesis bijf : bijective.
+
+Lemma bij_inj : injective f.
+Proof. by case: bijf => g fK _; apply: can_inj fK. Qed.
+
+Lemma bij_can_sym f' : cancel f' f <-> cancel f f'.
+Proof.
+split=> fK; first exact: inj_can_sym fK bij_inj.
+by case: bijf => h _ hK x; rewrite -[x]hK fK.
+Qed.
+
+Lemma bij_can_eq f' f'' : cancel f f' -> cancel f f'' -> f' =1 f''.
+Proof.
+by move=> fK fK'; apply: (inj_can_eq _ bij_inj); apply/bij_can_sym.
+Qed.
+
+End Bijections.
+
+Section BijectionsTheory.
+
+Variables (A B C : Type) (f : B -> A) (h : C -> B).
+
+Lemma eq_bij : bijective f -> forall g, f =1 g -> bijective g.
+Proof. by case=> f' fK f'K g eqfg; exists f'; eapply eq_can; eauto. Qed.
+
+Lemma bij_comp : bijective f -> bijective h -> bijective (f \o h).
+Proof.
+by move=> [f' fK f'K] [h' hK h'K]; exists (h' \o f'); apply: can_comp; auto.
+Qed.
+
+Lemma bij_can_bij : bijective f -> forall f', cancel f f' -> bijective f'.
+Proof. by move=> bijf; exists f; first by apply/(bij_can_sym bijf). Qed.
+
+End BijectionsTheory.
+
+Section Involutions.
+
+Variables (A : Type) (f : A -> A).
+
+Definition involutive := cancel f f.
+
+Hypothesis Hf : involutive.
+
+Lemma inv_inj : injective f. Proof. exact: can_inj Hf. Qed.
+Lemma inv_bij : bijective f. Proof. by exists f. Qed.
+
+End Involutions.
+
+Section OperationProperties.
+
+Variables S T R : Type.
+
+Section SopTisR.
+Implicit Type op :  S -> T -> R.
+Definition left_inverse e inv op := forall x, op (inv x) x = e.
+Definition right_inverse e inv op := forall x, op x (inv x) = e.
+Definition left_injective op := forall x, injective (op^~ x).
+Definition right_injective op := forall y, injective (op y).
+End SopTisR.
+
+
+Section SopTisS.
+Implicit Type op :  S -> T -> S.
+Definition right_id e op := forall x, op x e = x.
+Definition left_zero z op := forall x, op z x = z.
+Definition right_commutative op := forall x y z, op (op x y) z = op (op x z) y.
+Definition left_distributive op add :=
+  forall x y z, op (add x y) z = add (op x z) (op y z).
+Definition right_loop inv op := forall y, cancel (op^~ y) (op^~ (inv y)).
+Definition rev_right_loop inv op := forall y, cancel (op^~ (inv y)) (op^~ y).
+End SopTisS.
+
+Section SopTisT.
+Implicit Type op :  S -> T -> T.
+Definition left_id e op := forall x, op e x = x.
+Definition right_zero z op := forall x, op x z = z.
+Definition left_commutative op := forall x y z, op x (op y z) = op y (op x z).
+Definition right_distributive op add :=
+  forall x y z, op x (add y z) = add (op x y) (op x z).
+Definition left_loop inv op := forall x, cancel (op x) (op (inv x)).
+Definition rev_left_loop inv op := forall x, cancel (op (inv x)) (op x).
+End SopTisT.
+
+Section SopSisT.
+Implicit Type op :  S -> S -> T.
+Definition self_inverse e op := forall x, op x x = e.
+Definition commutative op := forall x y, op x y = op y x.
+End SopSisT.
+
+Section SopSisS.
+Implicit Type op :  S -> S -> S.
+Definition idempotent op := forall x, op x x = x.
+Definition associative op := forall x y z, op x (op y z) = op (op x y) z.
+Definition interchange op1 op2 :=
+  forall x y z t, op1 (op2 x y) (op2 z t) = op2 (op1 x z) (op1 y t).
+End SopSisS.
+
+End OperationProperties.
+
+
+
+
+
+
+
+
+
+
diff --git a/plugins/ssr/ssrfwd.ml b/plugins/ssr/ssrfwd.ml
new file mode 100644
index 00000000..a5765feb
--- /dev/null
+++ b/plugins/ssr/ssrfwd.ml
@@ -0,0 +1,319 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* 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
+
+module RelDecl = Context.Rel.Declaration
+
+(** 8. Forward chaining tactics (pose, set, have, suffice, wlog) *)
+(** Defined identifier *)
+
+
+let settac id c = Tactics.letin_tac None (Name id) c None
+let posetac id cl = Proofview.V82.of_tactic (settac id cl Locusops.nowhere)
+
+let ssrposetac (id, (_, t)) gl =
+  let ist, t =
+    match t.Ssrast.interp_env with
+    | Some ist -> ist, Ssrcommon.ssrterm_of_ast_closure_term t
+    | None -> assert false in
+  let sigma, t, ucst, _ = pf_abs_ssrterm ist gl t in
+  posetac id t (pf_merge_uc ucst gl)
+
+let ssrsettac id ((_, (pat, pty)), (_, occ)) gl =
+  let pty = Option.map (fun { Ssrast.body; interp_env } ->
+    let ist = Option.get interp_env in
+    (mkRHole, Some body), ist) pty in
+  let pat = interp_cpattern gl pat pty in
+  let cl, sigma, env = pf_concl gl, project gl, pf_env gl in
+  let (c, ucst), cl = 
+    let cl = EConstr.Unsafe.to_constr cl in
+    try fill_occ_pattern ~raise_NoMatch:true env sigma cl pat occ 1
+    with NoMatch -> redex_of_pattern ~resolve_typeclasses:true env pat, cl in
+  let gl = pf_merge_uc ucst gl in
+  let c = EConstr.of_constr c in
+  let cl = EConstr.of_constr cl in
+  if Termops.occur_existential sigma c then errorstrm(str"The pattern"++spc()++
+    pr_constr_pat (EConstr.Unsafe.to_constr c)++spc()++str"did not match and has holes."++spc()++
+    str"Did you mean pose?") else
+  let c, (gl, cty) =  match EConstr.kind sigma c with
+  | Cast(t, DEFAULTcast, ty) -> t, (gl, ty)
+  | _ -> c, pfe_type_of gl c in
+  let cl' = EConstr.mkLetIn (Name id, c, cty, cl) in
+  Tacticals.tclTHEN (Proofview.V82.of_tactic (convert_concl cl')) (introid id) gl
+
+open Util
+
+open Printer
+
+open Ssrast
+open Ssripats
+
+let ssrhaveNOtcresolution = Summary.ref ~name:"SSR:havenotcresolution" false
+
+let inHaveTCResolution = Libobject.declare_object {
+  (Libobject.default_object "SSRHAVETCRESOLUTION") with
+  Libobject.cache_function = (fun (_,v) -> ssrhaveNOtcresolution := v);
+  Libobject.load_function = (fun _ (_,v) -> ssrhaveNOtcresolution := v);
+  Libobject.classify_function = (fun v -> Libobject.Keep v);
+}
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optname  = "have type classes";
+      Goptions.optkey   = ["SsrHave";"NoTCResolution"];
+      Goptions.optread  = (fun _ -> !ssrhaveNOtcresolution);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b ->
+        Lib.add_anonymous_leaf (inHaveTCResolution b)) }
+
+
+open Constrexpr 
+open Glob_term 
+open Misctypes
+
+let combineCG t1 t2 f g = match t1, t2 with
+ | (x, (t1, None)), (_, (t2, None)) -> x, (g t1 t2, None)
+ | (x, (_, Some t1)), (_, (_, Some t2)) -> x, (mkRHole, Some (f t1 t2))
+ | _, (_, (_, None)) -> anomaly "have: mixed C-G constr"
+ | _ -> anomaly "have: mixed G-C constr"
+
+let basecuttac name c gl =
+  let hd, gl = pf_mkSsrConst name gl in
+  let t = EConstr.mkApp (hd, [|c|]) in
+  let gl, _ = pf_e_type_of gl t in
+  Proofview.V82.of_tactic (Tactics.apply t) gl
+
+let introstac ipats = Proofview.V82.of_tactic (tclIPAT ipats)
+
+let havetac ist
+  (transp,((((clr, pats), binders), simpl), (((fk, _), t), hint)))
+  suff namefst gl 
+=
+ let concl = pf_concl gl in
+ let skols, pats =
+   List.partition (function IPatAbstractVars _ -> true | _ -> false) pats in
+ let itac_mkabs = introstac skols in
+ let itac_c = introstac (IPatClear clr :: pats) in
+ let itac, id, clr = introstac pats, Tacticals.tclIDTAC, old_cleartac clr in
+ let binderstac n =
+   let rec aux = function 0 -> [] | n -> IPatAnon One :: aux (n-1) in
+   Tacticals.tclTHEN (if binders <> [] then introstac (aux n) else Tacticals.tclIDTAC)
+     (introstac binders) in
+ let simpltac = introstac simpl in
+ let fixtc =
+   not !ssrhaveNOtcresolution &&
+   match fk with FwdHint(_,true) -> false | _ -> true in
+ let hint = hinttac ist true hint in
+ let cuttac t gl =
+   if transp then
+     let have_let, gl = pf_mkSsrConst "ssr_have_let" gl in
+     let step = EConstr.mkApp (have_let, [|concl;t|]) in
+     let gl, _ = pf_e_type_of gl step in
+     applyn ~with_evars:true ~with_shelve:false 2 step gl
+   else basecuttac "ssr_have" t gl in
+ (* Introduce now abstract constants, so that everything sees them *)
+ let abstract_key, gl = pf_mkSsrConst "abstract_key" gl in
+ let unlock_abs (idty,args_id) gl =
+    let gl, _ = pf_e_type_of gl idty in
+    pf_unify_HO gl args_id.(2) abstract_key in
+ Tacticals.tclTHENFIRST itac_mkabs (fun gl ->
+  let mkt t = mk_term xNoFlag t in
+  let mkl t = (xNoFlag, (t, None)) in
+  let interp gl rtc t = pf_abs_ssrterm ~resolve_typeclasses:rtc ist gl t in
+  let interp_ty gl rtc t =
+    let a,b,_,u = pf_interp_ty ~resolve_typeclasses:rtc ist gl t in a,b,u in
+  let open CAst in
+  let ct, cty, hole, loc = match Ssrcommon.ssrterm_of_ast_closure_term t with
+    | _, (_, Some { loc; v = CCast (ct, CastConv cty)}) ->
+      mkt ct, mkt cty, mkt (mkCHole None), loc
+    | _, (_, Some ct) ->
+      mkt ct, mkt (mkCHole None), mkt (mkCHole None), None
+    | _, (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 ->
+     errorstrm (str"Suff have does not accept a proof term")
+   | FwdHave, false, true ->
+     let cty = combineCG cty hole (mkCArrow ?loc) mkRArrow in
+     let _,t,uc,_ = interp gl false (combineCG ct cty (mkCCast ?loc) mkRCast) in
+     let gl = pf_merge_uc uc gl in
+     let gl, ty = pfe_type_of gl t in
+     let ctx, _ = EConstr.decompose_prod_n_assum (project gl) 1 ty in
+     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_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
+       | IPatAbstractVars ids -> ids
+       | _ -> assert false) skols) in
+     let skols_args =
+       List.map (fun id -> Ssripats.Internal.examine_abstract (EConstr.mkVar id) gl) skols in
+     let gl = List.fold_right unlock_abs skols_args gl in
+     let sigma, t, uc, n_evars =
+       interp gl false (combineCG ct cty (mkCCast ?loc) mkRCast) in
+     if skols <> [] && n_evars <> 0 then
+       CErrors.user_err (Pp.strbrk @@ "Automatic generalization of unresolved implicit "^
+                     "arguments together with abstract variables is "^
+                     "not supported");
+     let gl = re_sig (sig_it gl) (Evd.merge_universe_context sigma uc) in
+     let gs =
+       List.map (fun (_,a) ->
+         Ssripats.Internal.pf_find_abstract_proof false gl (EConstr.Unsafe.to_constr a.(1))) skols_args in
+     let tacopen_skols gl =
+        let stuff, g = Refiner.unpackage gl in
+        Refiner.repackage stuff (gs @ [g]) in
+     let gl, ty = pf_e_type_of gl t in
+     gl, ty, Proofview.V82.of_tactic (Tactics.apply t), id,
+       Tacticals.tclTHEN (Tacticals.tclTHEN itac_c simpltac)
+         (Tacticals.tclTHEN tacopen_skols (fun gl ->
+            let abstract, gl = pf_mkSsrConst "abstract" gl in
+            Proofview.V82.of_tactic (unfold [abstract; abstract_key]) gl))
+   | _,true,true  ->
+     let _, ty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in
+     gl, EConstr.mkArrow ty concl, hint, itac, clr
+   | _,false,true ->
+     let _, ty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in
+     gl, EConstr.mkArrow ty concl, hint, id, itac_c
+   | _, false, false -> 
+     let n, cty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in
+     gl, cty, Tacticals.tclTHEN (binderstac n) hint, id, Tacticals.tclTHEN itac_c simpltac
+   | _, true, false -> assert false in
+  Tacticals.tclTHENS (cuttac cut) [ Tacticals.tclTHEN sol itac1; itac2 ] gl)
+ gl
+;;
+
+let destProd_or_LetIn sigma c =
+  match EConstr.kind sigma c with
+  | Prod (n,ty,c) -> RelDecl.LocalAssum (n, ty), c
+  | LetIn (n,bo,ty,c) -> RelDecl.LocalDef (n, bo, ty), c
+  | _ -> raise DestKO
+
+let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
+  let mkabs gen = abs_wgen false (fun x -> x) gen in
+  let mkclr gen clrs = clr_of_wgen gen clrs in
+  let mkpats = function
+  | _, Some ((x, _), _) -> fun pats -> IPatId (hoi_id x) :: pats
+  | _ -> fun x -> x in
+  let ct = match Ssrcommon.ssrterm_of_ast_closure_term ct with
+  | (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
+    let concl = pf_concl gl in
+    let c = EConstr.mkProp in
+    let c = if cut_implies_goal then EConstr.mkArrow c concl else c in
+    let gl, args, c = List.fold_right mkabs gens (gl,[],c) in
+    let env, _ =
+      List.fold_left (fun (env, c) _ ->
+        let rd, c = destProd_or_LetIn (project gl) c in
+        EConstr.push_rel rd env, c) (pf_env gl, c) gens in
+    let sigma = project gl in
+    let (sigma, ev) = Evarutil.new_evar env sigma EConstr.mkProp in
+    let k, _ = EConstr.destEvar sigma ev in
+    let fake_gl = {Evd.it = k; Evd.sigma = sigma} in
+    let _, ct, _, uc = pf_interp_ty ist fake_gl ct in
+    let rec var2rel c g s = match EConstr.kind sigma c, g with
+      | Prod(Anonymous,_,c), [] -> EConstr.mkProd(Anonymous, EConstr.Vars.subst_vars s ct, c)
+      | 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_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_env env sigma c) in
+    c, args, pired c args, pf_merge_uc uc gl in
+  let tacipat pats = introstac pats in
+  let tacigens = 
+    Tacticals.tclTHEN
+      (Tacticals.tclTHENLIST(List.rev(List.fold_right mkclr gens [old_cleartac clr0])))
+      (introstac (List.fold_right mkpats gens [])) in
+  let hinttac = hinttac ist true hint in
+  let cut_kind, fst_goal_tac, snd_goal_tac =
+    match suff, ghave with
+    | true, `NoGen -> "ssr_wlog", Tacticals.tclTHEN hinttac (tacipat pats), tacigens
+    | false, `NoGen -> "ssr_wlog", hinttac, Tacticals.tclTHEN tacigens (tacipat pats)
+    | true, `Gen _ -> assert false
+    | false, `Gen id ->
+      if gens = [] then errorstrm(str"gen have requires some generalizations");
+      let clear0 = old_cleartac clr0 in
+      let id, name_general_hyp, cleanup, pats = match id, pats with
+      | None, (IPatId id as ip)::pats -> Some id, tacipat [ip], clear0, pats
+      | None, _ -> None, Tacticals.tclIDTAC, clear0, pats
+      | Some (Some id),_ -> Some id, introid id, clear0, pats
+      | Some _,_ ->
+          let id = mk_anon_id "tmp" (Tacmach.pf_ids_of_hyps gl) in
+          Some id, introid id, Tacticals.tclTHEN clear0 (Proofview.V82.of_tactic (Tactics.clear [id])), pats in
+      let tac_specialize = match id with
+      | None -> Tacticals.tclIDTAC
+      | Some id ->
+        if pats = [] then Tacticals.tclIDTAC else
+        let args = Array.of_list args in
+        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",
+      (if hint = nohint then tacigens else hinttac),
+      Tacticals.tclTHENLIST [name_general_hyp; tac_specialize; tacipat pats; cleanup]
+  in
+  Tacticals.tclTHENS (basecuttac cut_kind c) [fst_goal_tac; snd_goal_tac] gl
+
+(** The "suffice" tactic *)
+
+let sufftac ist ((((clr, pats),binders),simpl), ((_, c), hint)) =
+  let htac = Tacticals.tclTHEN (introstac pats) (hinttac ist true hint) in
+  let c = match Ssrcommon.ssrterm_of_ast_closure_term c with
+  | (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
+  Tacticals.tclTHENS ctac [htac; Tacticals.tclTHEN (old_cleartac clr) (introstac (binders@simpl))]
diff --git a/plugins/ssr/ssrfwd.mli b/plugins/ssr/ssrfwd.mli
new file mode 100644
index 00000000..8a05e255
--- /dev/null
+++ b/plugins/ssr/ssrfwd.mli
@@ -0,0 +1,59 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Names
+
+open Ltac_plugin
+
+open Ssrast
+
+val ssrsettac :  Id.t -> ((ssrfwdfmt * (Ssrmatching_plugin.Ssrmatching.cpattern * ast_closure_term option)) * ssrdocc) -> v82tac
+
+val ssrposetac : Id.t * (ssrfwdfmt * ast_closure_term) -> v82tac
+
+val havetac : ist ->
+           bool *
+           ((((Ssrast.ssrclear * Ssrast.ssripat list) * Ssrast.ssripats) *
+             Ssrast.ssripats) *
+            (((Ssrast.ssrfwdkind * 'a) * ast_closure_term) *
+             (bool * Tacinterp.Value.t option list))) ->
+           bool ->
+           bool -> v82tac
+
+val basecuttac :
+           string ->
+           EConstr.t -> Goal.goal Evd.sigma -> Evar.t list Evd.sigma
+
+val wlogtac :
+  Ltac_plugin.Tacinterp.interp_sign ->
+  ((Ssrast.ssrhyps * Ssrast.ssripats) * 'a) * 'b ->
+  (Ssrast.ssrhyps *
+     ((Ssrast.ssrhyp_or_id * string) *
+        Ssrmatching_plugin.Ssrmatching.cpattern option)
+       option)
+    list *
+    ('c *
+       ast_closure_term) ->
+  Ltac_plugin.Tacinterp.Value.t Ssrast.ssrhint ->
+  bool ->
+  [< `Gen of Names.Id.t option option | `NoGen > `NoGen ] ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+
+val sufftac :
+  Ssrast.ist ->
+  (((Ssrast.ssrhyps * Ssrast.ssripats) * Ssrast.ssripat list) *
+     Ssrast.ssripat list) *
+    (('a *
+        ast_closure_term) *
+       (bool * Tacinterp.Value.t option list)) ->
+  Tacmach.tactic
+
diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml
new file mode 100644
index 00000000..35036b6c
--- /dev/null
+++ b/plugins/ssr/ssripats.ml
@@ -0,0 +1,712 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Ssrmatching_plugin
+
+open Util
+open Names
+
+open Proofview
+open Proofview.Notations
+
+open Ssrast
+
+module IpatMachine : sig
+
+  (* the => tactical.  ?eqtac is a tactic to be eventually run
+   * after the first [..] block.  first_case_is_dispatch is the
+   * ssr exception to elim: and case: *)
+  val main : ?eqtac:unit tactic -> first_case_is_dispatch:bool ->
+        ssripats -> unit tactic
+
+end = struct (* {{{ *)
+
+module State : sig
+
+  (* to_clear API *)
+  val isCLR_PUSH    : Id.t -> unit tactic
+  val isCLR_PUSHL   : Id.t list -> unit tactic
+  val isCLR_CONSUME : unit tactic
+
+  (* Some data may expire *)
+  val isTICK : ssripat -> unit tactic
+
+  val isPRINT : Proofview.Goal.t -> Pp.t
+
+end = struct (* {{{ *)
+
+type istate = {
+
+  (* Delayed clear *)
+  to_clear : Id.t list;
+
+}
+
+let empty_state = {
+  to_clear = [];
+}
+
+include Ssrcommon.MakeState(struct
+  type state = istate
+  let init = empty_state
+end)
+
+let isPRINT g =
+  let state = get g in
+  Pp.(str"{{ to_clear: " ++
+        prlist_with_sep spc Id.print state.to_clear ++ spc () ++
+      str" }}")
+
+
+let isCLR_PUSH id =
+  tclGET (fun { to_clear = ids } ->
+  tclSET { to_clear = id :: ids })
+
+let isCLR_PUSHL more_ids =
+  tclGET (fun { to_clear = ids } ->
+  tclSET { to_clear = more_ids @ ids })
+
+let isCLR_CONSUME =
+  tclGET (fun { to_clear = ids } ->
+  tclSET { to_clear = [] } <*>
+  Tactics.clear ids)
+
+
+let isTICK _ = tclUNIT ()
+
+end (* }}} *************************************************************** *)
+
+open State
+
+(** [=> *] ****************************************************************)
+(** [nb_assums] returns the number of dependent premises *)
+(** Warning: unlike [nb_deps_assums], it does not perform reduction *)
+let rec nb_assums cur env sigma t =
+  match EConstr.kind sigma t with
+  | Term.Prod(name,ty,body) ->
+     nb_assums (cur+1) env sigma body
+  | Term.LetIn(name,ty,t1,t2) ->
+    nb_assums (cur+1) env sigma t2
+  | Term.Cast(t,_,_) ->
+     nb_assums cur env sigma t
+  | _ -> cur
+let nb_assums = nb_assums 0
+
+let intro_anon_all = Goal.enter begin fun gl ->
+  let env = Goal.env gl in
+  let sigma = Goal.sigma gl in
+  let g = Goal.concl gl in
+  let n = nb_assums env sigma g in
+  Tacticals.New.tclDO n Ssrcommon.tclINTRO_ANON
+end
+
+(** [intro_drop] behaves like [intro_anon] but registers the id of the
+    introduced assumption for a delayed clear. *)
+let intro_drop =
+  Ssrcommon.tclINTRO ~id:None
+    ~conclusion:(fun ~orig_name:_ ~new_name -> isCLR_PUSH new_name)
+
+(** [intro_end] performs the actions that have been delayed. *)
+let intro_end =
+  Ssrcommon.tcl0G (isCLR_CONSUME)
+
+(** [=> _] *****************************************************************)
+let intro_clear ids future_ipats =
+  Goal.enter begin fun gl ->
+    let _, clear_ids, ren =
+      List.fold_left (fun (used_ids, clear_ids, ren) id ->
+          if not(Ssrcommon.is_name_in_ipats id future_ipats) then begin
+            used_ids, id :: clear_ids, ren
+          end else
+            let new_id = Ssrcommon.mk_anon_id (Id.to_string id) used_ids in
+            (new_id :: used_ids, new_id :: clear_ids, (id, new_id) :: ren))
+                     (Tacmach.New.pf_ids_of_hyps gl, [], []) ids
+    in
+    Tactics.rename_hyp ren <*>
+    isCLR_PUSHL clear_ids
+end
+
+let tacCHECK_HYPS_EXIST hyps = Goal.enter begin fun gl ->
+  let ctx = Goal.hyps gl in
+  List.iter (Ssrcommon.check_hyp_exists ctx) hyps;
+  tclUNIT ()
+end
+
+(** [=> []] *****************************************************************)
+let tac_case t =
+  Goal.enter begin fun _ ->
+    Ssrcommon.tacTYPEOF t >>= fun ty ->
+    Ssrcommon.tacIS_INJECTION_CASE ~ty t >>= fun is_inj ->
+    if is_inj then
+      V82.tactic ~nf_evars:false (Ssrelim.perform_injection t)
+    else
+      Ssrelim.ssrscasetac t
+end
+
+(** [=> [: id]] ************************************************************)
+let mk_abstract_id =
+  let open Coqlib in
+  let ssr_abstract_id = Summary.ref ~name:"SSR:abstractid" 0 in
+begin fun () ->
+  let rec nat_of_n n =
+    if n = 0 then EConstr.mkConstruct path_of_O
+    else EConstr.mkApp (EConstr.mkConstruct path_of_S, [|nat_of_n (n-1)|]) in
+  incr ssr_abstract_id; nat_of_n !ssr_abstract_id
+end
+
+let tcltclMK_ABSTRACT_VAR id = Goal.enter begin fun gl ->
+  let env, concl = Goal.(env gl, concl gl) in
+  let step = begin fun sigma ->
+    let (sigma, (abstract_proof, abstract_ty)) =
+      let (sigma, (ty, _)) =
+        Evarutil.new_type_evar env sigma Evd.univ_flexible_alg in
+      let (sigma, ablock) = Ssrcommon.mkSsrConst "abstract_lock" env sigma in
+      let (sigma, lock) = Evarutil.new_evar env sigma ablock in
+      let (sigma, abstract) = Ssrcommon.mkSsrConst "abstract" env sigma in
+      let abstract_ty =
+        EConstr.mkApp(abstract, [|ty;mk_abstract_id ();lock|]) in
+      let sigma, m = Evarutil.new_evar env sigma abstract_ty in
+      sigma, (m, abstract_ty) in
+    let sigma, kont =
+      let rd = Context.Rel.Declaration.LocalAssum (Name id, abstract_ty) in
+      let sigma, ev = Evarutil.new_evar (EConstr.push_rel rd env) sigma concl in
+      sigma, ev
+    in
+    let term =
+      EConstr.(mkApp (mkLambda(Name id,abstract_ty,kont),[|abstract_proof|])) in
+    let sigma, _ = Typing.type_of env sigma term in
+    sigma, term
+  end in
+  Tactics.New.refine ~typecheck:false step <*>
+  tclFOCUS 1 3 Proofview.shelve
+end
+
+let tclMK_ABSTRACT_VARS ids =
+  List.fold_right (fun id tac ->
+    Tacticals.New.tclTHENFIRST (tcltclMK_ABSTRACT_VAR id) tac) ids (tclUNIT ())
+
+(* Debugging *)
+let tclLOG p t =
+  tclUNIT () >>= begin fun () ->
+    Ssrprinters.ppdebug (lazy Pp.(str "exec: " ++ Ssrprinters.pr_ipat p));
+    tclUNIT ()
+  end <*>
+  Goal.enter begin fun g ->
+    Ssrprinters.ppdebug (lazy Pp.(str" on state:" ++ spc () ++
+      isPRINT g ++
+      str" goal:" ++ spc () ++ Printer.pr_goal (Goal.print g)));
+    tclUNIT ()
+  end
+  <*>
+    t p
+  <*>
+  Goal.enter begin fun g ->
+    Ssrprinters.ppdebug (lazy Pp.(str "done: " ++ isPRINT g));
+    tclUNIT ()
+  end
+
+let rec ipat_tac1 future_ipats ipat : unit tactic =
+  match ipat with
+  | IPatView l ->
+      Ssrview.tclIPAT_VIEWS ~views:l
+        ~conclusion:(fun ~to_clear:clr -> intro_clear clr future_ipats)
+  | IPatDispatch ipatss ->
+      tclEXTEND (List.map (ipat_tac future_ipats) ipatss) (tclUNIT ()) []
+
+  | IPatId id -> Ssrcommon.tclINTRO_ID id
+
+  | IPatCase ipatss ->
+     tclIORPAT (Ssrcommon.tclWITHTOP tac_case) future_ipats ipatss
+  | IPatInj ipatss ->
+     tclIORPAT (Ssrcommon.tclWITHTOP
+       (fun t -> V82.tactic  ~nf_evars:false (Ssrelim.perform_injection t)))
+       future_ipats ipatss
+
+  | IPatAnon Drop -> intro_drop
+  | IPatAnon One -> Ssrcommon.tclINTRO_ANON
+  | IPatAnon All -> intro_anon_all
+
+  | IPatNoop -> tclUNIT ()
+  | IPatSimpl Nop -> tclUNIT ()
+
+  | IPatClear ids ->
+      tacCHECK_HYPS_EXIST ids <*>
+      intro_clear (List.map Ssrcommon.hyp_id ids) future_ipats
+
+  | IPatSimpl (Simpl n) ->
+       V82.tactic ~nf_evars:false (Ssrequality.simpltac (Simpl n))
+  | IPatSimpl (Cut n) ->
+       V82.tactic ~nf_evars:false (Ssrequality.simpltac (Cut n))
+  | IPatSimpl (SimplCut (n,m)) ->
+       V82.tactic ~nf_evars:false (Ssrequality.simpltac (SimplCut (n,m)))
+
+  | IPatRewrite (occ,dir) ->
+     Ssrcommon.tclWITHTOP
+       (fun x -> V82.tactic  ~nf_evars:false (Ssrequality.ipat_rewrite occ dir x))
+
+  | IPatAbstractVars ids -> tclMK_ABSTRACT_VARS ids
+
+  | IPatTac t -> t
+
+and ipat_tac future_ipats pl : unit tactic =
+  match pl with
+  | [] -> tclUNIT ()
+  | pat :: pl ->
+      Ssrcommon.tcl0G (tclLOG pat (ipat_tac1 (pl @ future_ipats))) <*>
+      isTICK pat <*>
+      ipat_tac future_ipats pl
+
+and tclIORPAT tac future_ipats = function
+  | [[]] -> tac
+  | p -> Tacticals.New.tclTHENS tac (List.map (ipat_tac future_ipats) p)
+
+let split_at_first_case ipats =
+  let rec loop acc = function
+    | (IPatSimpl _ | IPatClear _) as x :: rest -> loop (x :: acc) rest
+    | IPatCase _ as x :: xs -> CList.rev acc, Some x, xs
+    | pats -> CList.rev acc, None, pats
+  in
+    loop [] ipats
+
+let ssr_exception is_on = function
+  | Some (IPatCase l) when is_on -> Some (IPatDispatch l)
+  | x -> x
+
+let option_to_list = function None -> [] | Some x -> [x]
+
+let main ?eqtac ~first_case_is_dispatch ipats =
+  let ip_before, case, ip_after = split_at_first_case ipats in
+  let case = ssr_exception first_case_is_dispatch case in
+  let case = option_to_list case in
+  let eqtac = option_to_list (Option.map (fun x -> IPatTac x) eqtac) in
+  Ssrcommon.tcl0G (ipat_tac [] (ip_before @ case @ eqtac @ ip_after) <*> intro_end)
+
+end (* }}} *)
+
+let tclIPAT_EQ eqtac ip =
+  Ssrprinters.ppdebug (lazy Pp.(str "ipat@run: " ++ Ssrprinters.pr_ipats ip));
+  IpatMachine.main ~eqtac ~first_case_is_dispatch:true ip
+
+let tclIPATssr ip =
+  Ssrprinters.ppdebug (lazy Pp.(str "ipat@run: " ++ Ssrprinters.pr_ipats ip));
+  IpatMachine.main ~first_case_is_dispatch:true ip
+
+(* Common code to handle generalization lists along with the defective case *)
+let with_defective maintac deps clr = Goal.enter begin fun g ->
+  let sigma, concl = Goal.(sigma g, concl g) in
+  let top_id =
+    match EConstr.kind_of_type sigma concl with
+    | Term.ProdType (Name id, _, _)
+      when Ssrcommon.is_discharged_id id -> id
+    | _ -> Ssrcommon.top_id in
+  let top_gen = Ssrequality.mkclr clr, Ssrmatching.cpattern_of_id top_id in
+  Ssrcommon.tclINTRO_ID top_id <*> maintac deps top_gen
+end
+
+let with_dgens { dgens; gens; clr } maintac = match gens with
+  | [] -> with_defective maintac dgens clr
+  | gen :: gens ->
+      V82.tactic ~nf_evars:false (Ssrcommon.genstac (gens, clr)) <*> maintac dgens gen
+
+let mkCoqEq env sigma =
+  let eq = Coqlib.((build_coq_eq_data ()).eq) in
+  let sigma, eq = EConstr.fresh_global env sigma eq in
+  eq, sigma
+
+let mkCoqRefl t c env sigma =
+  let refl = Coqlib.((build_coq_eq_data()).refl) in
+  let sigma, refl = EConstr.fresh_global env sigma refl in
+  EConstr.mkApp (refl, [|t; c|]), sigma
+
+(** Intro patterns processing for elim tactic, in particular when used in
+    conjunction with equation generation as in [elim E: x] *)
+let elim_intro_tac ipats ?ist what eqid ssrelim is_rec clr =
+  let intro_eq =
+    match eqid with
+    | Some (IPatId ipat) when not is_rec ->
+       let rec intro_eq () = Goal.enter begin fun g ->
+         let sigma, env, concl = Goal.(sigma g, env g, concl g) in
+         match EConstr.kind_of_type sigma concl with
+         | Term.ProdType (_, src, tgt) -> begin
+             match EConstr.kind_of_type sigma src with
+             | Term.AtomicType (hd, _) when Ssrcommon.is_protect hd env sigma ->
+                V82.tactic ~nf_evars:false Ssrcommon.unprotecttac <*>
+                Ssrcommon.tclINTRO_ID ipat
+             | _ -> Ssrcommon.tclINTRO_ANON <*> intro_eq ()
+             end
+         |_ -> Ssrcommon.errorstrm (Pp.str "Too many names in intro pattern")
+       end in
+       intro_eq ()
+    | Some (IPatId ipat) ->
+       let intro_lhs = Goal.enter begin fun g ->
+         let sigma = Goal.sigma g in
+         let elim_name = match clr, what with
+           | [SsrHyp(_, x)], _ -> x
+           | _, `EConstr(_,_,t) when EConstr.isVar sigma t ->
+              EConstr.destVar sigma t
+           | _ -> Ssrcommon.mk_anon_id "K" (Tacmach.New.pf_ids_of_hyps g) in
+         let elim_name =
+           if Ssrcommon.is_name_in_ipats elim_name ipats then
+             Ssrcommon.mk_anon_id "K" (Tacmach.New.pf_ids_of_hyps g)
+           else elim_name
+         in
+         Ssrcommon.tclINTRO_ID elim_name
+       end in
+       let rec gen_eq_tac () = Goal.enter begin fun g ->
+         let sigma, env, concl = Goal.(sigma g, env g, concl g) in
+         let sigma, eq =
+           EConstr.fresh_global env sigma (Coqlib.build_coq_eq ()) in
+         let ctx, last = EConstr.decompose_prod_assum sigma concl in
+         let args = match EConstr.kind_of_type sigma last with
+           | Term.AtomicType (hd, args) ->
+               assert(Ssrcommon.is_protect hd env sigma);
+               args
+           | _ -> assert false in
+         let case = args.(Array.length args-1) in
+         if not(EConstr.Vars.closed0 sigma case)
+         then Ssrcommon.tclINTRO_ANON <*> gen_eq_tac ()
+         else
+           Ssrcommon.tacTYPEOF case >>= fun case_ty ->
+           let open EConstr in
+           let refl =
+             mkApp (eq, [|Vars.lift 1 case_ty; mkRel 1; Vars.lift 1 case|]) in
+           let name = Ssrcommon.mk_anon_id "K" (Tacmach.New.pf_ids_of_hyps g) in
+
+           let new_concl =
+             mkProd (Name name, case_ty, mkArrow refl (Vars.lift 2 concl)) in
+           let erefl, sigma = mkCoqRefl case_ty case env sigma in
+           Proofview.Unsafe.tclEVARS sigma <*>
+           Tactics.apply_type ~typecheck:true new_concl [case;erefl]
+       end in
+       gen_eq_tac () <*>
+       intro_lhs <*>
+       Ssrcommon.tclINTRO_ID ipat
+    | _ -> tclUNIT () in
+  let unprot =
+    if eqid <> None && is_rec
+    then V82.tactic ~nf_evars:false Ssrcommon.unprotecttac else tclUNIT () in
+  V82.of_tactic begin
+    V82.tactic ~nf_evars:false ssrelim <*>
+    tclIPAT_EQ (intro_eq <*> unprot) ipats
+  end
+
+let mkEq dir cl c t n env sigma =
+  let open EConstr in
+  let eqargs = [|t; c; c|] in
+  eqargs.(Ssrequality.dir_org dir) <- mkRel n;
+  let eq, sigma = mkCoqEq env sigma in
+  let refl, sigma = mkCoqRefl t c env sigma in
+  mkArrow (mkApp (eq, eqargs)) (Vars.lift 1 cl), refl, sigma
+
+(** in [tac/v: last gens..] the first (last to be run) generalization is
+    "special" in that is it also the main argument of [tac] and is eventually
+    to be processed forward with view [v]. The behavior implemented is
+    very close to [tac: (v last) gens..] but:
+    - [v last] may use a view adaptor
+    - eventually clear for [last] is taken into account
+    - [tac/v {clr}] is also supported, and [{clr}] is to be run later
+    The code here does not "grab" [v last] nor apply [v] to [last], see the
+    [tacVIEW_THEN_GRAB] combinator. *)
+let tclLAST_GEN ~to_ind ((oclr, occ), t) conclusion = tclINDEPENDENTL begin
+  Ssrcommon.tacSIGMA >>= fun sigma0 ->
+  Goal.enter_one begin fun g ->
+  let pat = Ssrmatching.interp_cpattern sigma0 t None in
+  let cl0, env, sigma, hyps = Goal.(concl g, env g, sigma g, hyps g) in
+  let cl = EConstr.to_constr sigma cl0 in
+  let (c, ucst), cl =
+    try Ssrmatching.fill_occ_pattern ~raise_NoMatch:true env sigma cl pat occ 1
+    with Ssrmatching.NoMatch -> Ssrmatching.redex_of_pattern env pat, cl in
+  let sigma = Evd.merge_universe_context sigma ucst in
+  let c, cl = EConstr.of_constr c, EConstr.of_constr cl in
+  let clr =
+    Ssrcommon.interp_clr sigma (oclr, (Ssrmatching.tag_of_cpattern t,c)) in
+  (* Historically in Coq, and hence in ssr, [case t] accepts [t] of type
+     [A.. -> Ind] and opens new goals for [A..] as well as for the branches
+     of [Ind], see the [~to_ind] argument *)
+  if not(Termops.occur_existential sigma c) then
+    if Ssrmatching.tag_of_cpattern t = Ssrprinters.xWithAt then
+      if not (EConstr.isVar sigma c) then
+        Ssrcommon.errorstrm Pp.(str "@ can be used with variables only")
+      else match Context.Named.lookup (EConstr.destVar sigma c) hyps with
+      | Context.Named.Declaration.LocalAssum _ ->
+          Ssrcommon.errorstrm Pp.(str "@ can be used with let-ins only")
+      | Context.Named.Declaration.LocalDef (name, b, ty) ->
+          Unsafe.tclEVARS sigma <*>
+          tclUNIT (true, EConstr.mkLetIn (Name name,b,ty,cl), c, clr)
+    else
+      Unsafe.tclEVARS sigma <*>
+      Ssrcommon.tacMKPROD c cl >>= fun ccl ->
+      tclUNIT (false, ccl, c, clr)
+  else
+    if to_ind && occ = None then
+      let _, p, _, ucst' =
+        (* TODO: use abs_evars2 *)
+        Ssrcommon.pf_abs_evars sigma0 (fst pat, c) in
+      let sigma = Evd.merge_universe_context sigma ucst' in
+      Unsafe.tclEVARS sigma <*>
+      Ssrcommon.tacTYPEOF p >>= fun pty ->
+      (* TODO: check bug: cl0 no lift? *)
+      let ccl = EConstr.mkProd (Ssrcommon.constr_name sigma c, pty, cl0) in
+      tclUNIT (false, ccl, p, clr)
+  else
+    Ssrcommon.errorstrm Pp.(str "generalized term didn't match")
+end end >>= begin
+  fun infos -> tclDISPATCH (infos |> List.map conclusion)
+end
+
+(** a typical mate of [tclLAST_GEN] doing the job of applying the views [cs]
+    to [c] and generalizing the resulting term *)
+let tacVIEW_THEN_GRAB ?(simple_types=true)
+  vs ~conclusion (is_letin, new_concl, c, clear)
+=
+  Ssrview.tclWITH_FWD_VIEWS ~simple_types ~subject:c ~views:vs
+  ~conclusion:(fun t ->
+    Ssrcommon.tacCONSTR_NAME c >>= fun name ->
+    Goal.enter_one ~__LOC__ begin fun g ->
+      let sigma, env = Goal.sigma g, Goal.env g in
+      Ssrcommon.tacMKPROD t ~name
+        (Termops.subst_term sigma t (* NOTE: we grab t here *)
+          (Termops.prod_applist sigma new_concl [c])) >>=
+      conclusion is_letin t clear
+    end)
+
+(* Elim views are elimination lemmas, so the eliminated term is not added *)
+(* to the dependent terms as for "case", unless it actually occurs in the  *)
+(* goal, the "all occurrences" {+} switch is used, or the equation switch  *)
+(* is used and there are no dependents.                                    *)
+
+let ssrelimtac (view, (eqid, (dgens, ipats))) =
+  let ndefectelimtac view eqid ipats deps gen =
+    match view with
+    | [v] ->
+      Ssrcommon.tclINTERP_AST_CLOSURE_TERM_AS_CONSTR v >>= fun cs ->
+      tclDISPATCH (List.map (fun elim ->
+        V82.tactic ~nf_evars:false
+          (Ssrelim.ssrelim deps (`EGen gen) ~elim eqid (elim_intro_tac ipats)))
+        cs)
+    | [] ->
+      tclINDEPENDENT
+        (V82.tactic ~nf_evars:false
+          (Ssrelim.ssrelim deps (`EGen gen) eqid (elim_intro_tac ipats)))
+    | _ ->
+      Ssrcommon.errorstrm
+        Pp.(str "elim: only one elimination lemma can be provided")
+  in
+  with_dgens dgens (ndefectelimtac view eqid ipats)
+
+let ssrcasetac (view, (eqid, (dgens, ipats))) =
+  let ndefectcasetac view eqid ipats deps ((_, occ), _ as gen) =
+    tclLAST_GEN ~to_ind:true gen (fun (_, cl, c, clear as info) ->
+      let conclusion _ vc _clear _cl =
+        Ssrcommon.tacIS_INJECTION_CASE vc >>= fun inj ->
+        let simple = (eqid = None && deps = [] && occ = None) in
+        if simple && inj then
+          V82.tactic ~nf_evars:false (Ssrelim.perform_injection vc) <*>
+          Tactics.clear (List.map Ssrcommon.hyp_id clear) <*>
+          tclIPATssr ipats
+        else
+        (* macro for "case/v E: x" ---> "case E: x / (v x)" *)
+          let deps, clear, occ =
+            if view <> [] && eqid <> None && deps = []
+            then [gen], [], None
+            else deps, clear, occ in
+          V82.tactic ~nf_evars:false
+            (Ssrelim.ssrelim ~is_case:true deps (`EConstr (clear, occ, vc))
+              eqid (elim_intro_tac ipats))
+      in
+      if view = [] then conclusion false c clear c
+      else tacVIEW_THEN_GRAB ~simple_types:false view ~conclusion info)
+  in
+  with_dgens dgens (ndefectcasetac view eqid ipats)
+
+let ssrscasetoptac = Ssrcommon.tclWITHTOP Ssrelim.ssrscase_or_inj_tac
+let ssrselimtoptac = Ssrcommon.tclWITHTOP Ssrelim.elimtac
+
+(** [move] **************************************************************)
+let pushmoveeqtac cl c = Goal.enter begin fun g ->
+  let env, sigma = Goal.(env g, sigma g) in
+  let x, t, cl1 = EConstr.destProd sigma cl in
+  let cl2, eqc, sigma = mkEq R2L cl1 c t 1 env sigma in
+  Unsafe.tclEVARS sigma <*>
+  Tactics.apply_type ~typecheck:true (EConstr.mkProd (x, t, cl2)) [c; eqc]
+end
+
+let eqmovetac _ gen = Goal.enter begin fun g ->
+  Ssrcommon.tacSIGMA >>= fun gl ->
+  let cl, c, _, gl = Ssrcommon.pf_interp_gen gl false gen in
+  Unsafe.tclEVARS (Tacmach.project gl) <*>
+  pushmoveeqtac cl c
+end
+
+let rec eqmoveipats eqpat = function
+  | (IPatSimpl _ | IPatClear _ as ipat) :: ipats ->
+       ipat :: eqmoveipats eqpat ipats
+  | (IPatAnon All :: _ | []) as ipats ->
+       IPatAnon One :: eqpat :: ipats
+  | ipat :: ipats ->
+       ipat :: eqpat :: ipats
+
+let ssrsmovetac = Goal.enter begin fun g ->
+  let sigma, concl = Goal.(sigma g, concl g) in
+  match EConstr.kind sigma concl with
+  | Term.Prod _ | Term.LetIn _ -> tclUNIT ()
+  | _ -> Tactics.hnf_in_concl
+end
+
+let tclIPAT ip =
+  Ssrprinters.ppdebug (lazy Pp.(str "ipat@run: " ++ Ssrprinters.pr_ipats ip));
+  IpatMachine.main ~first_case_is_dispatch:false ip
+
+let ssrmovetac = function
+  | _::_ as view, (_, ({ gens = lastgen :: gens; clr }, ipats)) ->
+     let gentac = V82.tactic ~nf_evars:false (Ssrcommon.genstac (gens, [])) in
+     let conclusion _ t clear ccl =
+       Tactics.apply_type ~typecheck:true ccl [t] <*>
+       Tactics.clear (List.map Ssrcommon.hyp_id clear) in
+     gentac <*>
+     tclLAST_GEN ~to_ind:false lastgen
+       (tacVIEW_THEN_GRAB view ~conclusion) <*>
+     tclIPAT (IPatClear clr :: ipats)
+  | _::_ as view, (_, ({ gens = []; clr }, ipats)) ->
+     tclIPAT (IPatView view :: IPatClear clr :: ipats)
+  | _, (Some pat, (dgens, ipats)) ->
+    let dgentac = with_dgens dgens eqmovetac in
+    dgentac <*> tclIPAT (eqmoveipats pat ipats)
+  | _, (_, ({ gens = (_ :: _ as gens); dgens = []; clr}, ipats)) ->
+    let gentac = V82.tactic ~nf_evars:false (Ssrcommon.genstac (gens, clr)) in
+    gentac <*> tclIPAT ipats
+  | _, (_, ({ clr }, ipats)) ->
+    Tacticals.New.tclTHENLIST [ssrsmovetac; Tactics.clear (List.map Ssrcommon.hyp_id clr); tclIPAT ipats]
+
+(** [abstract: absvar gens] **************************************************)
+let rec is_Evar_or_CastedMeta sigma x =
+  EConstr.isEvar sigma x ||
+  EConstr.isMeta sigma x ||
+  (EConstr.isCast sigma x &&
+    is_Evar_or_CastedMeta sigma (pi1 (EConstr.destCast sigma x)))
+
+let occur_existential_or_casted_meta sigma c =
+  let rec occrec c = match EConstr.kind sigma c with
+    | Term.Evar _ -> raise Not_found
+    | Term.Cast (m,_,_) when EConstr.isMeta sigma m -> raise Not_found
+    | _ -> EConstr.iter sigma occrec c
+  in
+  try occrec c; false
+  with Not_found -> true
+
+let tacEXAMINE_ABSTRACT id = Ssrcommon.tacTYPEOF id >>= begin fun tid ->
+  Ssrcommon.tacMK_SSR_CONST "abstract" >>= fun abstract ->
+  Goal.enter_one ~__LOC__ begin fun g ->
+  let sigma, env = Goal.(sigma g, env g) in
+  let err () =
+    Ssrcommon.errorstrm
+      Pp.(strbrk"not a proper abstract constant: "++
+        Printer.pr_econstr_env env sigma id) in
+  if not (EConstr.isApp sigma tid) then err ();
+  let hd, args_id = EConstr.destApp sigma tid in
+  if not (EConstr.eq_constr_nounivs sigma hd abstract) then err ();
+  if Array.length args_id <> 3 then err ();
+  if not (is_Evar_or_CastedMeta sigma args_id.(2)) then
+    Ssrcommon.errorstrm Pp.(strbrk"abstract constant "++
+      Printer.pr_econstr_env env sigma id++str" already used");
+  tclUNIT (tid, args_id)
+end end
+
+let tacFIND_ABSTRACT_PROOF check_lock abstract_n =
+  Ssrcommon.tacMK_SSR_CONST "abstract" >>= fun abstract ->
+  Goal.enter_one ~__LOC__ begin fun g ->
+    let sigma, env = Goal.(sigma g, env g) in
+    let l = Evd.fold_undefined (fun e ei l ->
+      match EConstr.kind sigma (EConstr.of_constr ei.Evd.evar_concl) with
+      | Term.App(hd, [|ty; n; lock|])
+        when (not check_lock ||
+                   (occur_existential_or_casted_meta sigma ty &&
+                    is_Evar_or_CastedMeta sigma lock)) &&
+             EConstr.eq_constr_nounivs sigma hd abstract &&
+             EConstr.eq_constr_nounivs sigma n abstract_n -> e :: l
+      | _ -> l) sigma [] in
+    match l with
+    | [e] -> tclUNIT e
+    | _ -> Ssrcommon.errorstrm
+       Pp.(strbrk"abstract constant "++
+         Printer.pr_econstr_env env sigma abstract_n ++
+           strbrk" not found in the evar map exactly once. "++
+           strbrk"Did you tamper with it?")
+end
+
+let ssrabstract dgens =
+  let main _ (_,cid) = Goal.enter begin fun g ->
+    Ssrcommon.tacMK_SSR_CONST "abstract" >>= fun abstract ->
+    Ssrcommon.tacMK_SSR_CONST "abstract_key" >>= fun abstract_key ->
+    Ssrcommon.tacINTERP_CPATTERN cid >>= fun cid ->
+    let id = EConstr.mkVar (Option.get (Ssrmatching.id_of_pattern cid)) in
+    tacEXAMINE_ABSTRACT id >>= fun (idty, args_id) ->
+    let abstract_n = args_id.(1) in
+    tacFIND_ABSTRACT_PROOF true abstract_n >>= fun abstract_proof ->
+    let tacFIND_HOLE = Goal.enter_one ~__LOC__ begin fun g ->
+      let sigma, env, concl = Goal.(sigma g, env g, concl g) in
+      let t = args_id.(0) in
+      match EConstr.kind sigma t with
+      | (Term.Evar _ | Term.Meta _) -> Ssrcommon.tacUNIFY concl t <*> tclUNIT id
+      | Term.Cast(m,_,_)
+        when EConstr.isEvar sigma m || EConstr.isMeta sigma m ->
+          Ssrcommon.tacUNIFY concl t <*> tclUNIT id
+      | _ ->
+          Ssrcommon.errorstrm
+            Pp.(strbrk"abstract constant "++
+               Printer.pr_econstr_env env sigma abstract_n ++
+               strbrk" has an unexpected shape. Did you tamper with it?")
+      end in
+    tacFIND_HOLE >>= fun proof ->
+    Ssrcommon.tacUNIFY abstract_key args_id.(2) <*>
+    Ssrcommon.tacTYPEOF idty >>= fun _ ->
+    Unsafe.tclGETGOALS >>= fun goals ->
+    (* Here we jump in the proof tree: we move from the current goal to
+       the evar that inhabits the abstract variable with the current goal *)
+    Unsafe.tclSETGOALS
+      (goals @ [Proofview_monad.with_empty_state abstract_proof]) <*>
+    tclDISPATCH [
+      Tacticals.New.tclSOLVE [Tactics.apply proof];
+      Ssrcommon.unfold[abstract;abstract_key]
+    ]
+  end in
+  let interp_gens { gens } ~conclusion = Goal.enter begin fun g ->
+   Ssrcommon.tacSIGMA >>= fun gl0 ->
+     let open Ssrmatching in
+     let ipats = List.map (fun (_,cp) ->
+       match id_of_pattern (interp_cpattern gl0 cp None) with
+       | None -> IPatAnon One
+       | Some id -> IPatId id)
+       (List.tl gens) in
+     conclusion ipats
+  end in
+  interp_gens dgens ~conclusion:(fun ipats ->
+  with_dgens dgens main <*>
+  tclIPATssr ipats)
+
+module Internal = struct
+
+  let pf_find_abstract_proof b gl t =
+    let res = ref None in
+    let _ = V82.of_tactic (tacFIND_ABSTRACT_PROOF b (EConstr.of_constr t) >>= fun x -> res := Some x; tclUNIT ()) gl in
+    match !res with
+    | None -> assert false
+    | Some x -> x
+
+  let examine_abstract t gl =
+    let res = ref None in
+    let _ = V82.of_tactic (tacEXAMINE_ABSTRACT t >>= fun x -> res := Some x; tclUNIT ()) gl in
+    match !res with
+    | None -> assert false
+    | Some x -> x
+
+end
+
+(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssripats.mli b/plugins/ssr/ssripats.mli
new file mode 100644
index 00000000..89cba4be
--- /dev/null
+++ b/plugins/ssr/ssripats.mli
@@ -0,0 +1,50 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file implements:
+   - the [=>] tactical
+   - the [:] pseudo-tactical for move, case, elim and abstract
+
+   Putting these two features in the same file lets one hide much of the
+   interaction between [tac E:] and [=>] ([E] has to be processed by [=>],
+   not by [:]
+*)
+
+open Ssrast
+
+(* The => tactical *)
+val tclIPAT : ssripats -> unit Proofview.tactic
+
+(* As above but with the SSR exception: first case is dispatch *)
+val tclIPATssr : ssripats -> unit Proofview.tactic
+
+(* Wrappers to deal with : and eqn generation/naming:
+     [tac E: gens => ipats]
+   where [E] is injected into [ipats] (at the right place) and [gens] are
+   generalized before calling [tac] *)
+val ssrmovetac : ssrdgens ssrmovearg -> unit Proofview.tactic
+val ssrsmovetac : unit Proofview.tactic
+val ssrelimtac : ssrdgens ssrmovearg -> unit Proofview.tactic
+val ssrselimtoptac : unit Proofview.tactic
+val ssrcasetac : ssrdgens ssrmovearg -> unit Proofview.tactic
+val ssrscasetoptac : unit Proofview.tactic
+
+(* The implementation of abstract: is half here, for the [[: var ]]
+ * ipat, and in ssrfwd for the integration with [have] *)
+val ssrabstract : ssrdgens -> unit Proofview.tactic
+
+(* Handling of [[:var]], needed in ssrfwd. Since ssrfwd is still outside the
+ * tactic monad we export code with the V82 interface *)
+module Internal : sig
+val examine_abstract :
+  EConstr.t -> Goal.goal Evd.sigma -> EConstr.types * EConstr.t array
+val pf_find_abstract_proof :
+  bool -> Goal.goal Evd.sigma -> Constr.constr -> Evar.t
+end
diff --git a/plugins/ssr/ssrparser.ml4 b/plugins/ssr/ssrparser.ml4
new file mode 100644
index 00000000..5f396744
--- /dev/null
+++ b/plugins/ssr/ssrparser.ml4
@@ -0,0 +1,2337 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Names
+open Pp
+open Pcoq
+open Ltac_plugin
+open Genarg
+open Stdarg
+open Tacarg
+open Term
+open Libnames
+open Tactics
+open Tacmach
+open Util
+open Tacexpr
+open Tacinterp
+open Pltac
+open Extraargs
+open Ppconstr
+
+open Misctypes
+open Decl_kinds
+open Constrexpr
+open Constrexpr_ops
+
+open Proofview
+open Proofview.Notations
+
+open Ssrprinters
+open Ssrcommon
+open Ssrtacticals
+open Ssrbwd
+open Ssrequality
+open Ssripats
+
+(** Ssreflect load check. *)
+
+(* To allow ssrcoq to be fully compatible with the "plain" Coq, we only *)
+(* turn on its incompatible features (the new rewrite syntax, and the   *)
+(* reserved identifiers) when the theory library (ssreflect.v) has      *)
+(* has actually been required, or is being defined. Because this check  *)
+(* needs to be done often (for each identifier lookup), we implement    *)
+(* some caching, repeating the test only when the environment changes.  *)
+(*   We check for protect_term because it is the first constant loaded; *)
+(* ssr_have would ultimately be a better choice.                        *)
+let ssr_loaded = Summary.ref ~name:"SSR:loaded" false
+let is_ssr_loaded () =
+  !ssr_loaded ||
+  (if CLexer.is_keyword "SsrSyntax_is_Imported" then ssr_loaded:=true;
+   !ssr_loaded)
+
+DECLARE PLUGIN "ssreflect_plugin"
+(* Defining grammar rules with "xx" in it automatically declares keywords too,
+ * we thus save the lexer to restore it at the end of the file *)
+let frozen_lexer = CLexer.get_keyword_state () ;;
+
+let tacltop = (5,Notation_term.E)
+
+let pr_ssrtacarg _ _ prt = prt tacltop
+ARGUMENT EXTEND ssrtacarg TYPED AS tactic PRINTED BY pr_ssrtacarg
+| [ "YouShouldNotTypeThis" ] -> [ CErrors.anomaly (Pp.str "Grammar placeholder match") ]
+END
+GEXTEND Gram
+  GLOBAL: ssrtacarg;
+  ssrtacarg: [[ tac = tactic_expr LEVEL "5" -> tac ]];
+END
+
+(* Lexically closed tactic for tacticals. *)
+let pr_ssrtclarg _ _ prt tac = prt tacltop tac
+ARGUMENT EXTEND ssrtclarg TYPED AS ssrtacarg
+    PRINTED BY pr_ssrtclarg
+| [ ssrtacarg(tac) ] -> [ tac ]
+END
+
+open Genarg
+
+(** Adding a new uninterpreted generic argument type *)
+let add_genarg tag pr =
+  let wit = Genarg.make0 tag in
+  let tag = Geninterp.Val.create tag in
+  let glob ist x = (ist, x) in
+  let subst _ x = x in
+  let interp ist x = Ftactic.return (Geninterp.Val.Dyn (tag, x)) in
+  let gen_pr _ _ _ = pr in
+  let () = Genintern.register_intern0 wit glob in
+  let () = Genintern.register_subst0 wit subst in
+  let () = Geninterp.register_interp0 wit interp in
+  let () = Geninterp.register_val0 wit (Some (Geninterp.Val.Base tag)) in
+  Pptactic.declare_extra_genarg_pprule wit gen_pr gen_pr gen_pr;
+  wit
+
+(** Primitive parsing to avoid syntax conflicts with basic tactics. *)
+
+let accept_before_syms syms strm =
+  match Util.stream_nth 1 strm with
+  | Tok.KEYWORD sym when List.mem sym syms -> ()
+  | _ -> raise Stream.Failure
+
+let accept_before_syms_or_any_id syms strm =
+  match Util.stream_nth 1 strm with
+  | Tok.KEYWORD sym when List.mem sym syms -> ()
+  | Tok.IDENT _ -> ()
+  | _ -> raise Stream.Failure
+
+let accept_before_syms_or_ids syms ids strm =
+  match Util.stream_nth 1 strm with
+  | Tok.KEYWORD sym when List.mem sym syms -> ()
+  | Tok.IDENT id when List.mem id ids -> ()
+  | _ -> raise Stream.Failure
+
+open Ssrast
+let pr_id = Ppconstr.pr_id
+let pr_name = function Name id -> pr_id id | Anonymous -> str "_"
+let pr_spc () = str " "
+let pr_list = prlist_with_sep
+
+(**************************** ssrhyp **************************************) 
+
+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) CAst.(make ?loc id)) in
+  if not_section_id id then hyp else
+  hyp_err ?loc "Can't clear section hypothesis " id
+
+open Pcoq.Prim
+
+ARGUMENT EXTEND ssrhyp TYPED AS ssrhyprep PRINTED BY pr_ssrhyp
+                       INTERPRETED BY interp_hyp
+                       GLOBALIZED BY intern_hyp
+  | [ ident(id) ] -> [ SsrHyp (Loc.tag ~loc id) ]
+END
+
+
+let pr_hoi = hoik pr_hyp
+let pr_ssrhoi _ _ _ = pr_hoi
+
+let wit_ssrhoirep = add_genarg "ssrhoirep" pr_hoi
+
+let intern_ssrhoi ist = function
+  | Hyp h -> Hyp (intern_hyp ist h)
+  | Id (SsrHyp (_, id)) as hyp ->
+    let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_ident) id) in
+    hyp
+
+let interp_ssrhoi ist gl = function
+  | Hyp h -> let s, h' = interp_hyp ist gl h in s, Hyp h'
+  | Id (SsrHyp (loc, id)) ->
+    let s, id' = interp_wit wit_ident ist gl id in
+    s, Id (SsrHyp (loc, id'))
+
+ARGUMENT EXTEND ssrhoi_hyp TYPED AS ssrhoirep PRINTED BY pr_ssrhoi
+                       INTERPRETED BY interp_ssrhoi
+                       GLOBALIZED BY intern_ssrhoi
+  | [ ident(id) ] -> [ Hyp (SsrHyp(Loc.tag ~loc id)) ]
+END
+ARGUMENT EXTEND ssrhoi_id TYPED AS ssrhoirep PRINTED BY pr_ssrhoi
+                       INTERPRETED BY interp_ssrhoi
+                       GLOBALIZED BY intern_ssrhoi
+  | [ ident(id) ] -> [ Id (SsrHyp(Loc.tag ~loc id)) ]
+END
+
+
+let pr_ssrhyps _ _ _ = pr_hyps
+
+ARGUMENT EXTEND ssrhyps TYPED AS ssrhyp list PRINTED BY pr_ssrhyps
+                        INTERPRETED BY interp_hyps
+  | [ ssrhyp_list(hyps) ] -> [ check_hyps_uniq [] hyps; hyps ]
+END
+
+(** Rewriting direction *)
+
+
+let pr_rwdir = function L2R -> mt() | R2L -> str "-"
+
+let wit_ssrdir = add_genarg "ssrdir" pr_dir
+
+(** Simpl switch *)
+
+let pr_ssrsimpl _ _ _ = pr_simpl
+
+let wit_ssrsimplrep = add_genarg "ssrsimplrep" pr_simpl
+
+let test_ssrslashnum b1 b2 strm =
+  match Util.stream_nth 0 strm with
+  | Tok.KEYWORD "/" ->
+      (match Util.stream_nth 1 strm with
+      | Tok.INT _ when b1 ->
+         (match Util.stream_nth 2 strm with
+         | Tok.KEYWORD "=" | Tok.KEYWORD "/=" when not b2 -> ()
+         | Tok.KEYWORD "/" ->
+             if not b2 then () else begin
+               match Util.stream_nth 3 strm with
+               | Tok.INT _ -> ()
+               | _ -> raise Stream.Failure
+             end
+         | _ -> raise Stream.Failure)
+      | Tok.KEYWORD "/" when not b1 ->
+         (match Util.stream_nth 2 strm with
+         | Tok.KEYWORD "=" when not b2 -> ()
+         | Tok.INT _ when b2 ->
+           (match Util.stream_nth 3 strm with
+           | Tok.KEYWORD "=" -> ()
+           | _ -> raise Stream.Failure)
+         | _ when not b2 -> ()
+         | _ -> raise Stream.Failure)
+      | Tok.KEYWORD "=" when not b1 && not b2 -> ()
+      | _ -> raise Stream.Failure)
+  | Tok.KEYWORD "//" when not b1 ->
+         (match Util.stream_nth 1 strm with
+         | Tok.KEYWORD "=" when not b2 -> ()
+         | Tok.INT _ when b2 ->
+           (match Util.stream_nth 2 strm with
+           | Tok.KEYWORD "=" -> ()
+           | _ -> raise Stream.Failure)
+         | _ when not b2 -> ()
+         | _ -> raise Stream.Failure)
+  | _ -> raise Stream.Failure
+
+let test_ssrslashnum10 = test_ssrslashnum true false
+let test_ssrslashnum11 = test_ssrslashnum true true
+let test_ssrslashnum01 = test_ssrslashnum false true
+let test_ssrslashnum00 = test_ssrslashnum false false
+
+let negate_parser f x =
+  let rc = try Some (f x) with Stream.Failure -> None in
+  match rc with
+  | None -> ()
+  | Some _ -> raise Stream.Failure 
+
+let test_not_ssrslashnum =
+  Pcoq.Gram.Entry.of_parser
+    "test_not_ssrslashnum" (negate_parser test_ssrslashnum10)
+let test_ssrslashnum00 =
+  Pcoq.Gram.Entry.of_parser "test_ssrslashnum01" test_ssrslashnum00
+let test_ssrslashnum10 =
+  Pcoq.Gram.Entry.of_parser "test_ssrslashnum10" test_ssrslashnum10
+let test_ssrslashnum11 =
+  Pcoq.Gram.Entry.of_parser "test_ssrslashnum11" test_ssrslashnum11
+let test_ssrslashnum01 =
+  Pcoq.Gram.Entry.of_parser "test_ssrslashnum01" test_ssrslashnum01
+
+
+ARGUMENT EXTEND ssrsimpl_ne TYPED AS ssrsimplrep PRINTED BY pr_ssrsimpl
+| [ "//=" ] -> [ SimplCut (~-1,~-1) ]
+| [ "/=" ] -> [ Simpl ~-1 ]
+END
+
+Pcoq.(Prim.(
+GEXTEND Gram
+  GLOBAL: ssrsimpl_ne;
+  ssrsimpl_ne: [
+    [ test_ssrslashnum11; "/"; n = natural; "/"; m = natural; "=" -> SimplCut(n,m)
+    | test_ssrslashnum10; "/"; n = natural; "/" -> Cut n 
+    | test_ssrslashnum10; "/"; n = natural; "=" -> Simpl n 
+    | test_ssrslashnum10; "/"; n = natural; "/=" -> SimplCut (n,~-1) 
+    | test_ssrslashnum10; "/"; n = natural; "/"; "=" -> SimplCut (n,~-1) 
+    | test_ssrslashnum01; "//"; m = natural; "=" -> SimplCut (~-1,m)
+    | test_ssrslashnum00; "//" -> Cut ~-1
+    ]];
+
+END
+))
+
+ARGUMENT EXTEND ssrsimpl TYPED AS ssrsimplrep PRINTED BY pr_ssrsimpl
+| [ ssrsimpl_ne(sim) ] -> [ sim ]
+| [ ] -> [ Nop ]
+END
+
+
+let pr_ssrclear _ _ _ = pr_clear mt
+
+ARGUMENT EXTEND ssrclear_ne TYPED AS ssrhyps PRINTED BY pr_ssrclear
+| [ "{" ne_ssrhyp_list(clr) "}" ] -> [ check_hyps_uniq [] clr; clr ]
+END
+
+ARGUMENT EXTEND ssrclear TYPED AS ssrclear_ne PRINTED BY pr_ssrclear
+| [ ssrclear_ne(clr) ] -> [ clr ]
+| [ ] -> [ [] ]
+END
+
+(** Indexes *)
+
+(* Since SSR indexes are always positive numbers, we use the 0 value *)
+(* to encode an omitted index. We reuse the in or_var type, but we   *)
+(* supply our own interpretation function, which checks for non      *)
+(* positive values, and allows the use of constr numerals, so that   *)
+(* e.g., "let n := eval compute in (1 + 3) in (do n!clear)" works.   *)
+
+
+let pr_index = function
+  | Misctypes.ArgVar {CAst.v=id} -> pr_id id
+  | Misctypes.ArgArg n when n > 0 -> int n
+  | _ -> mt ()
+let pr_ssrindex _ _ _ = pr_index
+
+let noindex = Misctypes.ArgArg 0
+
+let check_index ?loc i =
+  if i > 0 then i else CErrors.user_err ?loc (str"Index not positive")
+let mk_index ?loc = function
+  | Misctypes.ArgArg i -> Misctypes.ArgArg (check_index ?loc i)
+  | iv -> iv
+
+let interp_index ist gl idx =
+  Tacmach.project gl,
+  match idx with
+  | Misctypes.ArgArg _ -> idx
+  | Misctypes.ArgVar id ->
+    let i =
+      try
+        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 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
+          | _ -> raise Not_found
+          end
+        | None -> raise Not_found
+        end end
+    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
+
+ARGUMENT EXTEND ssrindex TYPED AS ssrindex PRINTED BY pr_ssrindex
+  INTERPRETED BY interp_index
+| [ int_or_var(i) ] -> [ mk_index ~loc i ]
+END
+
+
+(** Occurrence switch *)
+
+(* The standard syntax of complemented occurrence lists involves a single *)
+(* initial "-", e.g., {-1 3 5}. An initial                                *)
+(* "+" may be used to indicate positive occurrences (the default). The    *)
+(* "+" is optional, except if the list of occurrences starts with a       *)
+(* variable or is empty (to avoid confusion with a clear switch). The     *)
+(* empty positive switch "{+}" selects no occurrences, while the empty    *)
+(* negative switch "{-}" selects all occurrences explicitly; this is the  *)
+(* default, but "{-}" prevents the implicit clear, and can be used to     *)
+(* force dependent elimination -- see ndefectelimtac below.               *)
+
+
+let pr_ssrocc _ _ _ = pr_occ
+
+open Pcoq.Prim
+
+ARGUMENT EXTEND ssrocc TYPED AS (bool * int list) option PRINTED BY pr_ssrocc
+| [ natural(n) natural_list(occ) ] -> [
+     Some (false, List.map (check_index ~loc) (n::occ)) ]
+| [ "-" natural_list(occ) ]     -> [ Some (true, occ) ]
+| [ "+" natural_list(occ) ]     -> [ Some (false, occ) ]
+END
+
+
+(* modality *)
+
+
+let pr_mmod = function May -> str "?" | Must -> str "!" | Once -> mt ()
+
+let wit_ssrmmod = add_genarg "ssrmmod" pr_mmod
+let ssrmmod = Pcoq.create_generic_entry Pcoq.utactic "ssrmmod" (Genarg.rawwit wit_ssrmmod);;
+
+GEXTEND Gram
+  GLOBAL: ssrmmod;
+  ssrmmod: [[ "!" -> Must | LEFTQMARK -> May | "?" -> May]];
+END
+
+(** Rewrite multiplier: !n ?n *)
+
+let pr_mult (n, m) =
+  if n > 0 && m <> Once then int n ++ pr_mmod m else pr_mmod m
+
+let pr_ssrmult _ _ _ = pr_mult
+
+ARGUMENT EXTEND ssrmult_ne TYPED AS int * ssrmmod PRINTED BY pr_ssrmult
+  | [ natural(n) ssrmmod(m) ] -> [ check_index ~loc n, m ]
+  | [ ssrmmod(m) ]            -> [ notimes, m ]
+END
+
+ARGUMENT EXTEND ssrmult TYPED AS ssrmult_ne PRINTED BY pr_ssrmult
+  | [ ssrmult_ne(m) ] -> [ m ]
+  | [ ] -> [ nomult ]
+END
+
+(** Discharge occ switch (combined occurrence / clear switch *)
+
+let pr_docc = function
+  | None, occ -> pr_occ occ
+  | Some clr, _ -> pr_clear mt clr
+
+let pr_ssrdocc _ _ _ = pr_docc
+
+ARGUMENT EXTEND ssrdocc TYPED AS ssrclear option * ssrocc PRINTED BY pr_ssrdocc
+| [ "{" ne_ssrhyp_list(clr) "}" ] -> [ mkclr clr ]
+| [ "{" ssrocc(occ) "}" ] -> [ mkocc occ ]
+END
+
+(* Old kinds of terms *)
+
+let input_ssrtermkind strm = match Util.stream_nth 0 strm with
+  | Tok.KEYWORD "(" -> xInParens
+  | Tok.KEYWORD "@" -> xWithAt
+  | _ -> xNoFlag
+
+let ssrtermkind = Pcoq.Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
+
+(* New kinds of terms *)
+
+let input_term_annotation strm =
+  match Stream.npeek 2 strm with
+  | Tok.KEYWORD "(" :: Tok.KEYWORD "(" :: _ -> `DoubleParens
+  | Tok.KEYWORD "(" :: _ -> `Parens
+  | Tok.KEYWORD "@" :: _ -> `At
+  | _ -> `None
+let term_annotation =
+  Gram.Entry.of_parser "term_annotation" input_term_annotation
+
+(* terms *)
+
+(** Terms parsing. ********************************************************)
+
+(* Because we allow wildcards in term references, we need to stage the *)
+(* interpretation of terms so that it occurs at the right time during  *)
+(* the execution of the tactic (e.g., so that we don't report an error *)
+(* for a term that isn't actually used in the execution).              *)
+(*   The term representation tracks whether the concrete initial term  *)
+(* started with an opening paren, which might avoid a conflict between *)
+(* the ssrreflect term syntax and Gallina notation.                    *)
+
+(* Old terms *)
+let pr_ssrterm _ _ _ = pr_term
+let glob_ssrterm gs = function
+  | k, (_, Some c) -> k, Tacintern.intern_constr gs c
+  | ct -> ct
+let subst_ssrterm s (k, c) = k, Tacsubst.subst_glob_constr_and_expr s c
+let interp_ssrterm _ gl t = Tacmach.project gl, t
+
+open Pcoq.Constr
+
+ARGUMENT EXTEND ssrterm
+     PRINTED BY pr_ssrterm
+     INTERPRETED BY interp_ssrterm
+     GLOBALIZED BY glob_ssrterm SUBSTITUTED BY subst_ssrterm
+     RAW_PRINTED BY pr_ssrterm
+     GLOB_PRINTED BY pr_ssrterm
+| [ "YouShouldNotTypeThis" constr(c) ] -> [ mk_lterm c ]
+END
+
+
+GEXTEND Gram
+  GLOBAL: ssrterm;
+  ssrterm: [[ k = ssrtermkind; c = Pcoq.Constr.constr -> mk_term k c ]];
+END
+
+(* New terms *)
+
+let pp_ast_closure_term _ _ _ = pr_ast_closure_term
+
+ARGUMENT EXTEND ast_closure_term
+     PRINTED BY pp_ast_closure_term
+     INTERPRETED BY interp_ast_closure_term
+     GLOBALIZED BY glob_ast_closure_term
+     SUBSTITUTED BY subst_ast_closure_term
+     RAW_PRINTED BY pp_ast_closure_term
+     GLOB_PRINTED BY pp_ast_closure_term
+  | [ term_annotation(a) constr(c) ] -> [ mk_ast_closure_term a c ]
+END
+ARGUMENT EXTEND ast_closure_lterm
+     PRINTED BY pp_ast_closure_term
+     INTERPRETED BY interp_ast_closure_term
+     GLOBALIZED BY glob_ast_closure_term
+     SUBSTITUTED BY subst_ast_closure_term
+     RAW_PRINTED BY pp_ast_closure_term
+     GLOB_PRINTED BY pp_ast_closure_term
+  | [ term_annotation(a) lconstr(c) ] -> [ mk_ast_closure_term a c ]
+END
+
+(* Old Views *)
+
+let pr_view = pr_list mt (fun c -> str "/" ++ pr_term c)
+
+let pr_ssrbwdview _ _ _ = pr_view
+
+ARGUMENT EXTEND ssrbwdview TYPED AS ssrterm list
+   PRINTED BY pr_ssrbwdview
+| [ "YouShouldNotTypeThis" ] -> [ [] ]
+END
+
+Pcoq.(
+GEXTEND Gram
+  GLOBAL: ssrbwdview;
+  ssrbwdview: [
+    [  test_not_ssrslashnum; "/"; c = Pcoq.Constr.constr -> [mk_term xNoFlag c]
+    |  test_not_ssrslashnum; "/"; c = Pcoq.Constr.constr; w = ssrbwdview ->
+                    (mk_term xNoFlag c) :: w ]];
+END
+)
+
+(* New Views *)
+
+
+let pr_ssrfwdview _ _ _ = pr_view2
+
+ARGUMENT EXTEND ssrfwdview TYPED AS ast_closure_term list
+   PRINTED BY pr_ssrfwdview
+| [ "YouShouldNotTypeThis" ] -> [ [] ]
+END
+
+Pcoq.(
+GEXTEND Gram
+  GLOBAL: ssrfwdview;
+  ssrfwdview: [
+    [  test_not_ssrslashnum; "/"; c = Pcoq.Constr.constr ->
+            [mk_ast_closure_term `None c]
+    |  test_not_ssrslashnum; "/"; c = Pcoq.Constr.constr; w = ssrfwdview ->
+                    (mk_ast_closure_term `None c) :: w ]];
+END
+)
+
+(* }}} *)
+ 
+(* ipats *)
+
+
+let remove_loc x = x.CAst.v
+
+let ipat_of_intro_pattern p = Misctypes.(
+  let rec ipat_of_intro_pattern = function
+    | IntroNaming (IntroIdentifier id) -> IPatId id
+    | IntroAction IntroWildcard -> IPatAnon Drop
+    | IntroAction (IntroOrAndPattern (IntroOrPattern iorpat)) ->
+      IPatCase 
+       (List.map (List.map ipat_of_intro_pattern) 
+ 	 (List.map (List.map remove_loc) iorpat))
+    | IntroAction (IntroOrAndPattern (IntroAndPattern iandpat)) ->
+      IPatCase 
+       [List.map ipat_of_intro_pattern (List.map remove_loc iandpat)]
+    | IntroNaming IntroAnonymous -> IPatAnon One
+    | IntroAction (IntroRewrite b) -> IPatRewrite (allocc, if b then L2R else R2L)
+    | IntroNaming (IntroFresh id) -> IPatAnon One
+    | IntroAction (IntroApplyOn _) -> (* to do *) CErrors.user_err (Pp.str "TO DO")
+    | IntroAction (IntroInjection ips) ->
+        IPatInj [List.map ipat_of_intro_pattern (List.map remove_loc ips)]
+    | IntroForthcoming _ ->
+        (* Unable to determine which kind of ipat interp_introid could
+         * return [HH] *)
+        assert false
+  in
+  ipat_of_intro_pattern p
+)
+
+let rec map_ipat map_id map_ssrhyp map_ast_closure_term = function
+  | (IPatSimpl _ | IPatAnon _ | IPatRewrite _ | IPatNoop) as x -> x
+  | IPatId id -> IPatId (map_id id)
+  | IPatAbstractVars l -> IPatAbstractVars (List.map map_id l)
+  | IPatClear clr -> IPatClear (List.map map_ssrhyp clr)
+  | IPatCase iorpat -> IPatCase (List.map (List.map (map_ipat map_id map_ssrhyp map_ast_closure_term)) iorpat)
+  | IPatDispatch iorpat -> IPatDispatch (List.map (List.map (map_ipat map_id map_ssrhyp map_ast_closure_term)) iorpat)
+  | IPatInj iorpat -> IPatInj (List.map (List.map (map_ipat map_id map_ssrhyp map_ast_closure_term)) iorpat)
+  | IPatView v -> IPatView (List.map map_ast_closure_term v)
+  | IPatTac _ -> assert false (*internal usage only *)
+
+let wit_ssripatrep = add_genarg "ssripatrep" pr_ipat
+
+let pr_ssripat _ _ _ = pr_ipat
+let pr_ssripats _ _ _ = pr_ipats
+let pr_ssriorpat _ _ _ = pr_iorpat
+
+let intern_ipat ist =
+  map_ipat
+    (fun id -> id)
+    (intern_hyp ist)
+    (glob_ast_closure_term ist)
+
+let intern_ipats ist = List.map (intern_ipat ist)
+
+let interp_intro_pattern = interp_wit wit_intro_pattern
+
+let interp_introid ist gl id = Misctypes.(
+ try IntroNaming (IntroIdentifier (hyp_id (snd (interp_hyp ist gl (SsrHyp (Loc.tag id))))))
+ with _ -> (snd (interp_intro_pattern ist gl (CAst.make @@ IntroNaming (IntroIdentifier id)))).CAst.v
+)
+
+let get_intro_id = function
+  | IntroNaming (IntroIdentifier id) -> id
+  | _ -> assert false
+
+let rec add_intro_pattern_hyps ipat hyps = Misctypes.(
+  let {CAst.loc=loc;v=ipat} = ipat in
+  match ipat with
+  | IntroNaming (IntroIdentifier id) ->
+    if not_section_id id then SsrHyp (loc, id) :: hyps else
+    hyp_err ?loc "Can't delete section hypothesis " id
+  | IntroAction IntroWildcard -> hyps
+  | IntroAction (IntroOrAndPattern (IntroOrPattern iorpat)) ->
+     List.fold_right (List.fold_right add_intro_pattern_hyps) iorpat hyps
+  | IntroAction (IntroOrAndPattern (IntroAndPattern iandpat)) ->
+    List.fold_right add_intro_pattern_hyps iandpat hyps
+  | IntroNaming IntroAnonymous -> []
+  | IntroNaming (IntroFresh _) -> []
+  | IntroAction (IntroRewrite _) -> hyps
+  | IntroAction (IntroInjection ips) -> List.fold_right add_intro_pattern_hyps ips hyps
+  | IntroAction (IntroApplyOn (c,pat)) -> add_intro_pattern_hyps pat hyps
+  | IntroForthcoming _ -> 
+    (* As in ipat_of_intro_pattern, was unable to determine which kind
+      of ipat interp_introid could return [HH] *) assert false
+)
+
+(* We interp the ipat using the standard ltac machinery for ids, since
+ * we have no clue what a name could be bound to (maybe another ipat) *)
+let interp_ipat ist gl =
+  let ltacvar id = Id.Map.mem id ist.Tacinterp.lfun in
+  let rec interp = function
+  | IPatId id when ltacvar id ->
+    ipat_of_intro_pattern (interp_introid ist gl id)
+  | IPatId _ as x -> x
+  | IPatClear clr ->
+    let add_hyps (SsrHyp (loc, id) as hyp) hyps =
+      if not (ltacvar id) then hyp :: hyps else
+      add_intro_pattern_hyps CAst.(make ?loc (interp_introid ist gl id)) hyps in
+    let clr' = List.fold_right add_hyps clr [] in
+    check_hyps_uniq [] clr'; IPatClear clr'
+  | IPatCase(iorpat) ->
+      IPatCase(List.map (List.map interp) iorpat)
+  | IPatDispatch(iorpat) ->
+      IPatDispatch(List.map (List.map interp) iorpat)
+  | IPatInj iorpat -> IPatInj (List.map (List.map interp) iorpat)
+  | IPatAbstractVars l ->
+     IPatAbstractVars (List.map get_intro_id (List.map (interp_introid ist gl) l))
+  | IPatView l -> IPatView (List.map (fun x -> snd(interp_ast_closure_term ist
+     gl x)) l)
+  | (IPatSimpl _ | IPatAnon _ | IPatRewrite _ | IPatNoop) as x -> x
+  | IPatTac _ -> assert false (*internal usage only *)
+    in
+  interp
+
+let interp_ipats ist gl l = project gl, List.map (interp_ipat ist gl) l
+
+let pushIPatRewrite = function
+  | pats :: orpat -> (IPatRewrite (allocc, L2R) :: pats) :: orpat
+  | [] -> []
+
+let pushIPatNoop = function
+  | pats :: orpat -> (IPatNoop :: pats) :: orpat
+  | [] -> []
+
+ARGUMENT EXTEND ssripat TYPED AS ssripatrep list PRINTED BY pr_ssripats
+  INTERPRETED BY interp_ipats
+  GLOBALIZED BY intern_ipats
+  | [ "_" ] -> [ [IPatAnon Drop] ]
+  | [ "*" ] -> [ [IPatAnon All] ]
+             (*
+  | [ "^" "*" ] -> [ [IPatFastMode] ]
+  | [ "^" "_" ] -> [ [IPatSeed `Wild] ]
+  | [ "^_" ] -> [ [IPatSeed `Wild] ]
+  | [ "^" "?" ] -> [ [IPatSeed `Anon] ]
+  | [ "^?" ] -> [ [IPatSeed `Anon] ]
+  | [ "^" ident(id) ] -> [ [IPatSeed (`Id(id,`Pre))] ]
+  | [ "^" "~" ident(id) ] -> [ [IPatSeed (`Id(id,`Post))] ]
+  | [ "^~" ident(id) ] -> [ [IPatSeed (`Id(id,`Post))] ]
+              *)
+  | [ ident(id) ] -> [ [IPatId id] ]
+  | [ "?" ] -> [ [IPatAnon One] ]
+(* TODO  | [ "+" ] -> [ [IPatAnon Temporary] ] *)
+  | [ ssrsimpl_ne(sim) ] -> [ [IPatSimpl sim] ]
+  | [ ssrdocc(occ) "->" ] -> [ match occ with
+      | None, occ -> [IPatRewrite (occ, L2R)]
+      | Some clr, _ -> [IPatClear clr; IPatRewrite (allocc, L2R)]]
+  | [ ssrdocc(occ) "<-" ] -> [ match occ with
+      | None, occ ->  [IPatRewrite (occ, R2L)]
+      | Some clr, _ -> [IPatClear clr; IPatRewrite (allocc, R2L)]]
+  | [ ssrdocc(occ) ] -> [ match occ with
+      | Some cl, _ -> check_hyps_uniq [] cl; [IPatClear cl]
+      | _ -> CErrors.user_err ~loc (str"Only identifiers are allowed here")]
+  | [ "->" ] -> [ [IPatRewrite (allocc, L2R)] ]
+  | [ "<-" ] -> [ [IPatRewrite (allocc, R2L)] ]
+  | [ "-" ] -> [ [IPatNoop] ]
+  | [ "-/" "=" ] -> [ [IPatNoop;IPatSimpl(Simpl ~-1)] ]
+  | [ "-/=" ] -> [ [IPatNoop;IPatSimpl(Simpl ~-1)] ]
+  | [ "-/" "/" ] -> [ [IPatNoop;IPatSimpl(Cut ~-1)] ]
+  | [ "-//" ] -> [ [IPatNoop;IPatSimpl(Cut ~-1)] ]
+  | [ "-/" integer(n) "/" ] -> [ [IPatNoop;IPatSimpl(Cut n)] ]
+  | [ "-/" "/=" ] -> [ [IPatNoop;IPatSimpl(SimplCut (~-1,~-1))] ]
+  | [ "-//" "=" ] -> [ [IPatNoop;IPatSimpl(SimplCut (~-1,~-1))] ]
+  | [ "-//=" ] -> [ [IPatNoop;IPatSimpl(SimplCut (~-1,~-1))] ]
+  | [ "-/" integer(n) "/=" ] -> [ [IPatNoop;IPatSimpl(SimplCut (n,~-1))] ]
+  | [ "-/" integer(n) "/" integer (m) "=" ] ->
+      [ [IPatNoop;IPatSimpl(SimplCut(n,m))] ]
+  | [ ssrfwdview(v) ] -> [ [IPatView v] ]
+  | [ "[" ":" ident_list(idl) "]" ] -> [ [IPatAbstractVars idl] ]
+  | [ "[:" ident_list(idl) "]" ] -> [ [IPatAbstractVars idl] ]
+END
+
+ARGUMENT EXTEND ssripats TYPED AS ssripat PRINTED BY pr_ssripats
+  | [ ssripat(i) ssripats(tl) ] -> [ i @ tl ]
+  | [ ] -> [ [] ]
+END
+
+ARGUMENT EXTEND ssriorpat TYPED AS ssripat list PRINTED BY pr_ssriorpat
+| [ ssripats(pats) "|" ssriorpat(orpat) ] -> [ pats :: orpat ]
+| [ ssripats(pats) "|-" ">" ssriorpat(orpat) ] -> [ pats :: pushIPatRewrite orpat ]
+| [ ssripats(pats) "|-" ssriorpat(orpat) ] -> [ pats :: pushIPatNoop orpat ]
+| [ ssripats(pats) "|->" ssriorpat(orpat) ] -> [ pats :: pushIPatRewrite orpat ]
+| [ ssripats(pats) "||" ssriorpat(orpat) ] -> [ pats :: [] :: orpat ]
+| [ ssripats(pats) "|||" ssriorpat(orpat) ] -> [ pats :: [] :: [] :: orpat ]
+| [ ssripats(pats) "||||" ssriorpat(orpat) ] -> [ [pats; []; []; []] @ orpat ]
+| [ ssripats(pats) ] -> [ [pats] ]
+END
+
+let reject_ssrhid strm =
+  match Util.stream_nth 0 strm with
+  | Tok.KEYWORD "[" ->
+      (match Util.stream_nth 1 strm with
+      | Tok.KEYWORD ":" -> raise Stream.Failure
+      | _ -> ())
+  | _ -> ()
+
+let test_nohidden = Pcoq.Gram.Entry.of_parser "test_ssrhid" reject_ssrhid
+
+ARGUMENT EXTEND ssrcpat TYPED AS ssripatrep PRINTED BY pr_ssripat
+  | [ "YouShouldNotTypeThis" ssriorpat(x) ] -> [ IPatCase(x) ]
+END
+
+Pcoq.(
+GEXTEND Gram
+  GLOBAL: ssrcpat;
+  ssrcpat: [
+   [ test_nohidden; "["; iorpat = ssriorpat; "]" ->
+(*      check_no_inner_seed !@loc false iorpat;
+      IPatCase (understand_case_type iorpat) *)
+      IPatCase iorpat
+(*
+   | test_nohidden; "("; iorpat = ssriorpat; ")" ->
+(*      check_no_inner_seed !@loc false iorpat;
+      IPatCase (understand_case_type iorpat) *)
+      IPatDispatch iorpat
+*)
+   | test_nohidden; "[="; iorpat = ssriorpat; "]" ->
+(*      check_no_inner_seed !@loc false iorpat; *)
+      IPatInj iorpat ]];
+END
+);;
+
+Pcoq.(
+GEXTEND Gram
+  GLOBAL: ssripat;
+  ssripat: [[ pat = ssrcpat -> [pat] ]];
+END
+)
+
+ARGUMENT EXTEND ssripats_ne TYPED AS ssripat PRINTED BY pr_ssripats
+  | [ ssripat(i) ssripats(tl) ] -> [ i @ tl ]
+                                     END
+
+(* subsets of patterns *)
+
+(* TODO: review what this function does, it looks suspicious *)
+let check_ssrhpats loc w_binders ipats =
+  let err_loc s = CErrors.user_err ~loc ~hdr:"ssreflect" s in
+  let clr, ipats =
+    let rec aux clr = function
+      | IPatClear cl :: tl -> aux (clr @ cl) tl
+(*      | IPatSimpl (cl, sim) :: tl -> clr @ cl, IPatSimpl ([], sim) :: tl *)
+      | tl -> clr, tl
+    in aux [] ipats in
+  let simpl, ipats = 
+    match List.rev ipats with
+    | IPatSimpl _ as s :: tl -> [s], List.rev tl
+    | _ -> [],  ipats in
+  if simpl <> [] && not w_binders then
+    err_loc (str "No s-item allowed here: " ++ pr_ipats simpl);
+  let ipat, binders =
+    let rec loop ipat = function
+      | [] -> ipat, []
+      | ( IPatId _| IPatAnon _| IPatCase _ | IPatDispatch _ | IPatRewrite _ as i) :: tl ->
+        if w_binders then
+          if simpl <> [] && tl <> [] then 
+            err_loc(str"binders XOR s-item allowed here: "++pr_ipats(tl@simpl))
+          else if not (List.for_all (function IPatId _ -> true | _ -> false) tl)
+          then err_loc (str "Only binders allowed here: " ++ pr_ipats tl)
+          else ipat @ [i], tl
+        else
+          if tl = [] then  ipat @ [i], []
+          else err_loc (str "No binder or s-item allowed here: " ++ pr_ipats tl)
+      | hd :: tl -> loop (ipat @ [hd]) tl
+    in loop [] ipats in
+  ((clr, ipat), binders), simpl
+
+let pr_hpats (((clr, ipat), binders), simpl) =
+   pr_clear mt clr ++ pr_ipats ipat ++ pr_ipats binders ++ pr_ipats simpl
+let pr_ssrhpats _ _ _ = pr_hpats
+let pr_ssrhpats_wtransp _ _ _ (_, x) = pr_hpats x
+
+ARGUMENT EXTEND ssrhpats TYPED AS ((ssrclear * ssripat) * ssripat) * ssripat
+PRINTED BY pr_ssrhpats
+  | [ ssripats(i) ] -> [ check_ssrhpats loc true i ]
+END
+
+ARGUMENT EXTEND ssrhpats_wtransp
+  TYPED AS bool * (((ssrclear * ssripats) * ssripats) * ssripats)
+  PRINTED BY pr_ssrhpats_wtransp
+  | [ ssripats(i) ] -> [ false,check_ssrhpats loc true i ]
+  | [ ssripats(i) "@" ssripats(j) ] -> [ true,check_ssrhpats loc true (i @ j) ]
+END
+
+ARGUMENT EXTEND ssrhpats_nobs 
+TYPED AS ((ssrclear * ssripats) * ssripats) * ssripats PRINTED BY pr_ssrhpats
+  | [ ssripats(i) ] -> [ check_ssrhpats loc false i ]
+END
+
+ARGUMENT EXTEND ssrrpat TYPED AS ssripatrep PRINTED BY pr_ssripat
+  | [ "->" ] -> [ IPatRewrite (allocc, L2R) ]
+  | [ "<-" ] -> [ IPatRewrite (allocc, R2L) ]
+END
+
+let pr_intros sep intrs =
+  if intrs = [] then mt() else sep () ++ str "=>" ++ pr_ipats intrs
+let pr_ssrintros _ _ _ = pr_intros mt
+
+ARGUMENT EXTEND ssrintros_ne TYPED AS ssripat
+ PRINTED BY pr_ssrintros
+  | [ "=>" ssripats_ne(pats) ] -> [ pats ]
+(*  TODO | [ "=>" ">" ssripats_ne(pats) ] -> [ IPatFastMode :: pats ]
+  | [ "=>>" ssripats_ne(pats) ] -> [ IPatFastMode :: pats ] *)
+END
+
+ARGUMENT EXTEND ssrintros TYPED AS ssrintros_ne PRINTED BY pr_ssrintros
+  | [ ssrintros_ne(intrs) ] -> [ intrs ]
+  | [ ] -> [ [] ]
+END
+
+let pr_ssrintrosarg _ _ prt (tac, ipats) =
+  prt tacltop tac ++ pr_intros spc ipats
+
+ARGUMENT EXTEND ssrintrosarg TYPED AS tactic * ssrintros
+   PRINTED BY pr_ssrintrosarg
+| [ "YouShouldNotTypeThis" ssrtacarg(arg) ssrintros_ne(ipats) ] -> [ arg, ipats ]
+END
+
+TACTIC EXTEND ssrtclintros
+| [ "YouShouldNotTypeThis" ssrintrosarg(arg) ] ->
+  [ let tac, intros = arg in
+    ssrevaltac ist tac <*> tclIPATssr intros ]
+END
+
+(** Defined identifier *)
+let pr_ssrfwdid id = pr_spc () ++ pr_id id
+
+let pr_ssrfwdidx _ _ _ = pr_ssrfwdid
+
+(* We use a primitive parser for the head identifier of forward *)
+(* tactis to avoid syntactic conflicts with basic Coq tactics. *)
+ARGUMENT EXTEND ssrfwdid TYPED AS ident PRINTED BY pr_ssrfwdidx
+  | [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let accept_ssrfwdid strm =
+  match stream_nth 0 strm with
+  | Tok.IDENT id -> accept_before_syms_or_any_id [":"; ":="; "("] strm
+  | _ -> raise Stream.Failure
+
+
+let test_ssrfwdid = Gram.Entry.of_parser "test_ssrfwdid" accept_ssrfwdid
+
+GEXTEND Gram
+  GLOBAL: ssrfwdid;
+  ssrfwdid: [[ test_ssrfwdid; id = Prim.ident -> id ]];
+  END
+
+  
+(* by *)
+(** Tactical arguments. *)
+
+(* We have four kinds: simple tactics, [|]-bracketed lists, hints, and swaps *)
+(* The latter two are used in forward-chaining tactics (have, suffice, wlog) *)
+(* and subgoal reordering tacticals (; first & ; last), respectively.        *)
+
+
+let pr_ortacs prt = 
+  let rec pr_rec = function
+  | [None]           -> spc() ++ str "|" ++ spc()
+  | None :: tacs     -> spc() ++ str "|" ++ pr_rec tacs
+  | Some tac :: tacs -> spc() ++ str "| " ++ prt tacltop tac ++  pr_rec tacs
+  | []                -> mt() in
+  function
+  | [None]           -> spc()
+  | None :: tacs     -> pr_rec tacs
+  | Some tac :: tacs -> prt tacltop tac ++ pr_rec tacs
+  | []                -> mt()
+let pr_ssrortacs _ _ = pr_ortacs
+
+ARGUMENT EXTEND ssrortacs TYPED AS tactic option list PRINTED BY pr_ssrortacs
+| [ ssrtacarg(tac) "|" ssrortacs(tacs) ] -> [ Some tac :: tacs ]
+| [ ssrtacarg(tac) "|" ] -> [ [Some tac; None] ]
+| [ ssrtacarg(tac) ] -> [ [Some tac] ]
+| [ "|" ssrortacs(tacs) ] -> [ None :: tacs ]
+| [ "|" ] -> [ [None; None] ]
+END
+
+let pr_hintarg prt = function
+  | true, tacs -> hv 0 (str "[ " ++ pr_ortacs prt tacs ++ str " ]")
+  | false, [Some tac] -> prt tacltop tac
+  | _, _ -> mt()
+
+let pr_ssrhintarg _ _ = pr_hintarg
+
+
+ARGUMENT EXTEND ssrhintarg TYPED AS bool * ssrortacs PRINTED BY pr_ssrhintarg
+| [ "[" "]" ] -> [ nullhint ]
+| [ "[" ssrortacs(tacs) "]" ] -> [ mk_orhint tacs ]
+| [ ssrtacarg(arg) ] -> [ mk_hint arg ]
+END
+
+ARGUMENT EXTEND ssrortacarg TYPED AS ssrhintarg PRINTED BY pr_ssrhintarg
+| [ "[" ssrortacs(tacs) "]" ] -> [ mk_orhint tacs ]
+END
+
+
+let pr_hint prt arg =
+  if arg = nohint then mt() else str "by " ++ pr_hintarg prt arg
+let pr_ssrhint _ _ = pr_hint
+
+ARGUMENT EXTEND ssrhint TYPED AS ssrhintarg PRINTED BY pr_ssrhint
+| [ ]                       -> [ nohint ]
+END
+(** The "in" pseudo-tactical *)(* {{{ **********************************************)
+
+(* We can't make "in" into a general tactical because this would create a  *)
+(* crippling conflict with the ltac let .. in construct. Hence, we add     *)
+(* explicitly an "in" suffix to all the extended tactics for which it is   *)
+(* relevant (including move, case, elim) and to the extended do tactical   *)
+(* below, which yields a general-purpose "in" of the form do [...] in ...  *)
+
+(* This tactical needs to come before the intro tactics because the latter *)
+(* must take precautions in order not to interfere with the discharged     *)
+(* assumptions. This is especially difficult for discharged "let"s, which  *)
+(* the default simpl and unfold tactics would erase blindly.               *)
+
+open Ssrmatching_plugin.Ssrmatching
+
+let pr_wgen = function 
+  | (clr, Some((id,k),None)) -> spc() ++ pr_clear mt clr ++ str k ++ pr_hoi id
+  | (clr, Some((id,k),Some p)) ->
+      spc() ++ pr_clear mt clr ++ str"(" ++ str k ++ pr_hoi id ++ str ":=" ++
+        pr_cpattern p ++ str ")"
+  | (clr, None) -> spc () ++ pr_clear mt clr
+let pr_ssrwgen _ _ _ = pr_wgen
+
+(* no globwith for char *)
+ARGUMENT EXTEND ssrwgen
+  TYPED AS ssrclear * ((ssrhoi_hyp * string) * cpattern option) option
+  PRINTED BY pr_ssrwgen
+| [ ssrclear_ne(clr) ] -> [ clr, None ]
+| [ ssrhoi_hyp(hyp) ] -> [ [], Some((hyp, " "), None) ]
+| [ "@" ssrhoi_hyp(hyp) ] -> [ [], Some((hyp, "@"), None) ]
+| [ "(" ssrhoi_id(id) ":=" lcpattern(p) ")" ] ->
+  [ [], Some ((id," "),Some p) ]
+| [ "(" ssrhoi_id(id) ")" ] -> [ [], Some ((id,"("), None) ]
+| [ "(@" ssrhoi_id(id) ":=" lcpattern(p) ")" ] ->
+  [ [], Some ((id,"@"),Some p) ]
+| [ "(" "@" ssrhoi_id(id) ":=" lcpattern(p) ")" ] ->
+  [ [], Some ((id,"@"),Some p) ]
+END
+
+let pr_clseq = function
+  | InGoal | InHyps -> mt ()
+  | InSeqGoal       -> str "|- *"
+  | InHypsSeqGoal   -> str " |- *"
+  | InHypsGoal      -> str " *"
+  | InAll           -> str "*"
+  | InHypsSeq       -> str " |-"
+  | InAllHyps       -> str "* |-"
+
+let wit_ssrclseq = add_genarg "ssrclseq" pr_clseq
+let pr_clausehyps = pr_list pr_spc pr_wgen
+let pr_ssrclausehyps _ _ _ = pr_clausehyps
+
+ARGUMENT EXTEND ssrclausehyps 
+TYPED AS ssrwgen list PRINTED BY pr_ssrclausehyps
+| [ ssrwgen(hyp) "," ssrclausehyps(hyps) ] -> [ hyp :: hyps ]
+| [ ssrwgen(hyp) ssrclausehyps(hyps) ] -> [ hyp :: hyps ]
+| [ ssrwgen(hyp) ] -> [ [hyp] ]
+END
+
+(* type ssrclauses = ssrahyps * ssrclseq *)
+
+let pr_clauses (hyps, clseq) = 
+  if clseq = InGoal then mt ()
+  else str "in " ++ pr_clausehyps hyps ++ pr_clseq clseq
+let pr_ssrclauses _ _ _ = pr_clauses
+
+ARGUMENT EXTEND ssrclauses TYPED AS ssrwgen list * ssrclseq
+    PRINTED BY pr_ssrclauses
+  | [ "in" ssrclausehyps(hyps) "|-" "*" ] -> [ hyps, InHypsSeqGoal ]
+  | [ "in" ssrclausehyps(hyps) "|-" ]     -> [ hyps, InHypsSeq ]
+  | [ "in" ssrclausehyps(hyps) "*" ]      -> [ hyps, InHypsGoal ]
+  | [ "in" ssrclausehyps(hyps) ]          -> [ hyps, InHyps ]
+  | [ "in" "|-" "*" ]                     -> [ [], InSeqGoal ]
+  | [ "in" "*" ]                          -> [ [], InAll ]
+  | [ "in" "*" "|-" ]                     -> [ [], InAllHyps ]
+  | [ ]                                   -> [ [], InGoal ]
+END
+
+
+
+
+(** Definition value formatting *)
+
+(* We use an intermediate structure to correctly render the binder list  *)
+(* abbreviations. We use a list of hints to extract the binders and      *)
+(* base term from a term, for the two first levels of representation of  *)
+(* of constr terms.                                                      *)
+
+let pr_binder prl = function
+  | Bvar x ->
+    pr_name x
+  | Bdecl (xs, t) ->
+    str "(" ++ pr_list pr_spc pr_name xs ++ str " : " ++ prl t ++ str ")"
+  | Bdef (x, None, v) ->
+    str "(" ++ pr_name x ++ str " := " ++ prl v ++ str ")"
+  | Bdef (x, Some t, v) ->
+    str "(" ++ pr_name x ++ str " : " ++ prl t ++
+                            str " := " ++ prl v ++ str ")"
+  | Bstruct x ->
+    str "{struct " ++ pr_name x ++ str "}"
+  | Bcast t ->
+    str ": " ++ prl t
+
+let rec format_local_binders h0 bl0 = match h0, bl0 with
+  | BFvar :: h, CLocalAssum ([{CAst.v=x}], _,  _) :: bl ->
+    Bvar x :: format_local_binders h bl
+  | BFdecl _ :: h, CLocalAssum (lxs, _, t) :: 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 ([CLocalAssum([{CAst.v=x}], _, _)], c) } ->
+    let bs, c' = format_constr_expr h c in
+    Bvar x :: bs, c'
+  | BFdecl _:: h, { v = CLambdaN ([CLocalAssum(lxs, _, t)], c) } ->
+    let bs, c' = format_constr_expr h c in
+    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) } ->
+    [Bcast t], c
+  | 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 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
+  | _, c ->
+    [], c
+
+(** Forward chaining argument *)
+
+(* There are three kinds of forward definitions:           *)
+(*   - Hint: type only, cast to Type, may have proof hint. *)
+(*   - Have: type option + value, no space before type     *)
+(*   - Pose: binders + value, space before binders.        *)
+
+let pr_fwdkind = function
+  | FwdHint (s,_) -> str (s ^ " ") | _ -> str " :=" ++ spc ()
+let pr_fwdfmt (fk, _ : ssrfwdfmt) = pr_fwdkind fk
+
+let wit_ssrfwdfmt = add_genarg "ssrfwdfmt" pr_fwdfmt
+
+(* type ssrfwd = ssrfwdfmt * ssrterm *)
+
+let mkFwdVal fk c = ((fk, []), c)
+let mkssrFwdVal fk c = ((fk, []), (c,None))
+let dC t = CastConv t
+
+let same_ist { interp_env = x } { interp_env = y } =
+  match x,y with
+  | None, None -> true
+  | Some a, Some b -> a == b
+  | _ -> false
+
+let mkFwdCast fk ?loc ?c t =
+  let c = match c with
+    | None -> mkCHole loc
+    | Some c -> assert (same_ist t c); c.body in
+  ((fk, [BFcast]),
+   { t with annotation = `None;
+            body = (CAst.make ?loc @@ CCast (c, dC t.body)) })
+
+let mkssrFwdCast fk loc t c = ((fk, [BFcast]), (c, Some t))
+
+let mkFwdHint s t =
+  let loc =  Constrexpr_ops.constr_loc t.body in
+  mkFwdCast (FwdHint (s,false)) ?loc t
+let mkFwdHintNoTC s t =
+  let loc =  Constrexpr_ops.constr_loc t.body in
+  mkFwdCast (FwdHint (s,true)) ?loc t
+
+let pr_gen_fwd prval prc prlc fk (bs, c) =
+  let prc s = str s ++ spc () ++ prval prc prlc c in
+  match fk, bs with
+  | FwdHint (s,_), [Bcast t] -> str s ++ spc () ++ prlc t
+  | FwdHint (s,_), _ ->  prc (s ^ "(* typeof *)")
+  | FwdHave, [Bcast t] -> str ":" ++ spc () ++ prlc t ++ prc " :="
+  | _, [] -> prc " :="
+  | _, _ -> spc () ++ pr_list spc (pr_binder prlc) bs ++ prc " :="
+
+let pr_fwd_guarded prval prval' = function
+| (fk, h), c ->
+  pr_gen_fwd prval pr_constr_expr prl_constr_expr fk (format_constr_expr h c.body)
+
+let pr_unguarded prc prlc = prlc
+
+let pr_fwd = pr_fwd_guarded pr_unguarded pr_unguarded
+let pr_ssrfwd _ _ _ = pr_fwd
+ 
+ARGUMENT EXTEND ssrfwd TYPED AS (ssrfwdfmt * ast_closure_lterm) PRINTED BY pr_ssrfwd
+  | [ ":=" ast_closure_lterm(c) ] -> [ mkFwdVal FwdPose c ]
+  | [ ":" ast_closure_lterm (t) ":=" ast_closure_lterm(c) ] -> [ mkFwdCast FwdPose ~loc t ~c ]
+END
+
+(** Independent parsing for binders *)
+
+(* The pose, pose fix, and pose cofix tactics use these internally to  *)
+(* parse argument fragments.                                           *)
+
+let pr_ssrbvar prc _ _ v = prc v
+
+ARGUMENT EXTEND ssrbvar TYPED AS constr PRINTED BY pr_ssrbvar
+| [ ident(id) ] -> [ mkCVar ~loc id ]
+| [ "_" ] -> [ mkCHole (Some loc) ]
+END
+
+let bvar_lname = let open CAst in function
+  | { v = CRef ({loc;v=Ident 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 { CAst.loc=xloc } as x = bvar_lname bv in
+     (FwdPose, [BFvar]),
+     CAst.make ~loc @@ CLambdaN ([CLocalAssum([x],Default Explicit,mkCHole xloc)],mkCHole (Some loc)) ]
+ | [ "(" ssrbvar(bv) ")" ] ->
+   [ let { CAst.loc=xloc } as x = bvar_lname bv in
+     (FwdPose, [BFvar]),
+     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 ([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 ([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) ")" ] ->
+   [ (FwdPose,[BFdef]), CAst.make ~loc @@ CLetIn (bvar_lname id, v, None, mkCHole (Some loc)) ]
+     END
+
+GEXTEND Gram
+  GLOBAL: ssrbinder;
+  ssrbinder: [
+  [  ["of" | "&"]; c = operconstr LEVEL "99" ->
+     let loc = !@loc in
+     (FwdPose, [BFvar]),
+     CAst.make ~loc @@ CLambdaN ([CLocalAssum ([CAst.make ~loc Anonymous],Default Explicit,c)],mkCHole (Some loc)) ]
+  ];
+END
+
+let rec binders_fmts = function
+  | ((_, h), _) :: bs -> h @ binders_fmts bs
+  | _ -> []
+
+let push_binders c2 bs =
+  let loc2 = constr_loc c2 in let mkloc loc1 = Loc.merge_opt loc1 loc2 in
+  let open CAst in
+  let rec loop ty c = function
+  | (_, { loc = loc1; v = CLambdaN (b, _) } ) :: bs when ty ->
+      CAst.make ?loc:(mkloc loc1) @@ CProdN (b, loop ty c bs)
+  | (_, { loc = loc1; v = CLambdaN (b, _) } ) :: bs ->
+      CAst.make ?loc:(mkloc loc1) @@ CLambdaN (b, loop ty c bs)
+  | (_, { loc = loc1; v = CLetIn (x, v, oty, _) } ) :: bs ->
+      CAst.make ?loc:(mkloc loc1) @@ CLetIn (x, v, oty, loop ty c bs)
+  | [] -> c
+  | _ -> anomaly "binder not a lambda nor a let in" in
+  match c2 with
+  | { loc; v = CCast (ct, CastConv cty) } ->
+      CAst.make ?loc @@ (CCast (loop false ct bs, CastConv (loop true cty bs)))
+  | ct -> loop false ct bs
+
+let rec fix_binders = let open CAst in function
+  | (_, { 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
+  | _ -> []
+
+let pr_ssrstruct _ _ _ = function
+  | Some id -> str "{struct " ++ pr_id id ++ str "}"
+  | None -> mt ()
+
+ARGUMENT EXTEND ssrstruct TYPED AS ident option PRINTED BY pr_ssrstruct
+| [ "{" "struct" ident(id) "}" ] -> [ Some id ]
+| [ ] -> [ None ]
+END
+
+(** The "pose" tactic *)
+
+(* The plain pose form. *)
+
+let bind_fwd bs ((fk, h), c) =
+ (fk,binders_fmts bs @ h), { c with body = push_binders c.body bs }
+
+ARGUMENT EXTEND ssrposefwd TYPED AS ssrfwd PRINTED BY pr_ssrfwd
+  | [ ssrbinder_list(bs) ssrfwd(fwd) ] -> [ bind_fwd bs fwd ]
+END
+
+(* The pose fix form. *)
+
+let pr_ssrfixfwd _ _ _ (id, fwd) = str " fix " ++ pr_id id ++ pr_fwd fwd
+
+let bvar_locid = function
+  | { CAst.v = CRef ({CAst.loc=loc;v=Ident 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 { CAst.v=id } as lid = bvar_locid bv in
+      let (fk, h), ac = fwd in
+      let c = ac.body in
+      let has_cast, t', c' = match format_constr_expr h c with
+      | [Bcast t'], c' -> true, t', c'
+      | _ -> false, mkCHole (constr_loc c), c in
+      let lb = fix_binders bs in
+      let has_struct, i =
+        let rec loop = function
+          | {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
+      let h' = BFrec (has_struct, has_cast) :: binders_fmts bs in
+      let fix = CAst.make ~loc @@ CFix (lid, [lid, (Some i, CStructRec), lb, t', c']) in
+      id, ((fk, h'),  { ac with body = fix }) ]
+END
+
+
+(* The pose cofix form. *)
+
+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 { CAst.v=id } as lid = bvar_locid bv in
+      let (fk, h), ac = fwd in
+      let c = ac.body in
+      let has_cast, t', c' = match format_constr_expr h c with
+      | [Bcast t'], c' -> true, t', c'
+      | _ -> false, mkCHole (constr_loc c), c in
+      let h' = BFrec (false, has_cast) :: binders_fmts bs in
+      let cofix = CAst.make ~loc @@ CCoFix (lid, [lid, fix_binders bs, t', c']) in
+      id, ((fk, h'), { ac with body = cofix })
+    ]
+END
+
+(* This does not print the type, it should be fixed... *)
+let pr_ssrsetfwd _ _ _ (((fk,_),(t,_)), docc) =
+  pr_gen_fwd (fun _ _ -> pr_cpattern)
+    (fun _ -> mt()) (fun _ -> mt()) fk ([Bcast ()],t)
+
+ARGUMENT EXTEND ssrsetfwd
+TYPED AS (ssrfwdfmt * (lcpattern * ast_closure_lterm option)) * ssrdocc
+PRINTED BY pr_ssrsetfwd
+| [ ":" ast_closure_lterm(t) ":=" "{" ssrocc(occ) "}" cpattern(c) ] ->
+  [ mkssrFwdCast FwdPose loc t c, mkocc occ ]
+| [ ":" ast_closure_lterm(t) ":=" lcpattern(c) ] ->
+  [ mkssrFwdCast FwdPose loc t c, nodocc ]
+| [ ":=" "{" ssrocc(occ) "}" cpattern(c) ] ->
+  [ mkssrFwdVal FwdPose c, mkocc occ ]
+| [ ":=" lcpattern(c) ] -> [ mkssrFwdVal FwdPose c, nodocc ]
+END
+
+
+let pr_ssrhavefwd _ _ prt (fwd, hint) = pr_fwd fwd ++ pr_hint prt hint
+
+ARGUMENT EXTEND ssrhavefwd TYPED AS ssrfwd * ssrhint PRINTED BY pr_ssrhavefwd
+| [ ":" ast_closure_lterm(t) ssrhint(hint) ] -> [ mkFwdHint ":" t, hint ]
+| [ ":" ast_closure_lterm(t) ":=" ast_closure_lterm(c) ] -> [ mkFwdCast FwdHave ~loc t ~c, nohint ]
+| [ ":" ast_closure_lterm(t) ":=" ] -> [ mkFwdHintNoTC ":" t, nohint ]
+| [ ":=" ast_closure_lterm(c) ] -> [ mkFwdVal FwdHave c, nohint ]
+END
+
+let intro_id_to_binder = List.map (function 
+  | IPatId id ->
+      let { CAst.loc=xloc } as x = bvar_lname (mkCVar id) in
+      (FwdPose, [BFvar]),
+        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 ([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)))) =
+  pr_hpats hpats ++ pr_fwd fwd ++ pr_hint prt hint
+
+ARGUMENT EXTEND ssrhavefwdwbinders
+  TYPED AS bool * (ssrhpats * (ssrfwd * ssrhint))
+  PRINTED BY pr_ssrhavefwdwbinders
+| [ ssrhpats_wtransp(trpats) ssrbinder_list(bs) ssrhavefwd(fwd) ] ->
+  [ let tr, pats = trpats in
+    let ((clr, pats), binders), simpl = pats in
+    let allbs = intro_id_to_binder binders @ bs in
+    let allbinders = binders @ List.flatten (binder_to_intro_id bs) in
+    let hint = bind_fwd allbs (fst fwd), snd fwd in
+    tr, ((((clr, pats), allbinders), simpl), hint) ]
+END
+
+
+let pr_ssrdoarg prc _ prt (((n, m), tac), clauses) =
+  pr_index n ++ pr_mmod m ++ pr_hintarg prt tac ++ pr_clauses clauses
+
+ARGUMENT EXTEND ssrdoarg
+  TYPED AS ((ssrindex * ssrmmod) * ssrhintarg) * ssrclauses
+  PRINTED BY pr_ssrdoarg
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+(* type ssrseqarg = ssrindex * (ssrtacarg * ssrtac option) *)
+
+let pr_seqtacarg prt = function
+  | (is_first, []), _ -> str (if is_first then "first" else "last")
+  | tac, Some dtac ->
+    hv 0 (pr_hintarg prt tac ++ spc() ++ str "|| " ++ prt tacltop dtac)
+  | tac, _ -> pr_hintarg prt tac
+
+let pr_ssrseqarg _ _ prt = function
+  | ArgArg 0, tac -> pr_seqtacarg prt tac
+  | i, tac -> pr_index i ++ str " " ++ pr_seqtacarg prt tac
+
+(* We must parse the index separately to resolve the conflict with *)
+(* an unindexed tactic.                                            *)
+ARGUMENT EXTEND ssrseqarg TYPED AS ssrindex * (ssrhintarg * tactic option)
+                          PRINTED BY pr_ssrseqarg
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let sq_brace_tacnames =
+   ["first"; "solve"; "do"; "rewrite"; "have"; "suffices"; "wlog"]
+   (* "by" is a keyword *)
+let accept_ssrseqvar strm =
+  match stream_nth 0 strm with
+  | Tok.IDENT id when not (List.mem id sq_brace_tacnames) ->
+     accept_before_syms_or_ids ["["] ["first";"last"] strm
+  | _ -> raise Stream.Failure
+
+let test_ssrseqvar = Gram.Entry.of_parser "test_ssrseqvar" accept_ssrseqvar
+
+let swaptacarg (loc, b) = (b, []), Some (TacId [])
+
+let check_seqtacarg dir arg = match snd arg, dir with
+  | ((true, []), Some (TacAtom (loc, _))), L2R ->
+    CErrors.user_err ?loc (str "expected \"last\"")
+  | ((false, []), Some (TacAtom (loc, _))), R2L ->
+    CErrors.user_err ?loc (str "expected \"first\"")
+  | _, _ -> arg
+
+let ssrorelse = Gram.entry_create "ssrorelse"
+GEXTEND Gram
+  GLOBAL: ssrorelse ssrseqarg;
+  ssrseqidx: [
+    [ 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 ]];
+  ssrorelse: [[ "||"; tac = tactic_expr LEVEL "2" -> tac ]];
+  ssrseqarg: [
+    [ arg = ssrswap -> noindex, swaptacarg arg
+    | i = ssrseqidx; tac = ssrortacarg; def = OPT ssrorelse -> i, (tac, def)
+    | i = ssrseqidx; arg = ssrswap -> i, swaptacarg arg
+    | tac = tactic_expr LEVEL "3" -> noindex, (mk_hint tac, None)
+    ] ];
+END
+
+let tactic_expr = Pltac.tactic_expr
+
+(** 1. Utilities *)
+
+(** Tactic-level diagnosis *)
+
+(* debug *)
+
+(* Let's play with the new proof engine API *)
+let old_tac = V82.tactic
+
+
+(** Name generation *)(* {{{ *******************************************************)
+
+(* Since Coq now does repeated internal checks of its external lexical *)
+(* rules, we now need to carve ssreflect reserved identifiers out of   *)
+(* out of the user namespace. We use identifiers of the form _id_ for  *)
+(* this purpose, e.g., we "anonymize" an identifier id as _id_, adding *)
+(* an extra leading _ if this might clash with an internal identifier. *)
+(*    We check for ssreflect identifiers in the ident grammar rule;    *)
+(* when the ssreflect Module is present this is normally an error,     *)
+(* but we provide a compatibility flag to reduce this to a warning.    *)
+
+let ssr_reserved_ids = Summary.ref ~name:"SSR:idents" true
+
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optname  = "ssreflect identifiers";
+      Goptions.optkey   = ["SsrIdents"];
+      Goptions.optdepr  = false;
+      Goptions.optread  = (fun _ -> !ssr_reserved_ids);
+      Goptions.optwrite = (fun b -> ssr_reserved_ids := b)
+    }
+
+let is_ssr_reserved s =
+  let n = String.length s in n > 2 && s.[0] = '_' && s.[n - 1] = '_'
+
+let ssr_id_of_string loc s =
+  if is_ssr_reserved s && is_ssr_loaded () then begin
+    if !ssr_reserved_ids then
+      CErrors.user_err ~loc (str ("The identifier " ^ s ^ " is reserved."))
+    else if is_internal_name s then
+      Feedback.msg_warning (str ("Conflict between " ^ s ^ " and ssreflect internal names."))
+    else Feedback.msg_warning (str (
+     "The name " ^ s ^ " fits the _xxx_ format used for anonymous variables.\n"
+  ^ "Scripts with explicit references to anonymous variables are fragile."))
+    end; Id.of_string s
+
+let ssr_null_entry = Gram.Entry.of_parser "ssr_null" (fun _ -> ())
+
+let (!@) = Pcoq.to_coqloc
+
+GEXTEND Gram 
+  GLOBAL: Prim.ident;
+  Prim.ident: [[ s = IDENT; ssr_null_entry -> ssr_id_of_string !@loc s ]];
+END
+
+let perm_tag = "_perm_Hyp_"
+let _ = add_internal_name (is_tagged perm_tag)
+  
+(* }}} *)
+
+(* We must not anonymize context names discharged by the "in" tactical. *)
+
+(** Tactical extensions. *)(* {{{ **************************************************)
+
+(* The TACTIC EXTEND facility can't be used for defining new user   *)
+(* tacticals, because:                                              *)
+(*  - the concrete syntax must start with a fixed string            *)
+(*   We use the following workaround:                               *)
+(*  - We use the (unparsable) "YouShouldNotTypeThis"  token for tacticals that      *)
+(*    don't start with a token, then redefine the grammar and       *)
+(*    printer using GEXTEND and set_pr_ssrtac, respectively.        *)
+
+type ssrargfmt = ArgSsr of string | ArgSep of string
+
+let ssrtac_name name = {
+  mltac_plugin = "ssreflect_plugin";
+  mltac_tactic = "ssr" ^ name;
+}
+
+let ssrtac_entry name n = {
+  mltac_name = ssrtac_name name; 
+  mltac_index = n;
+}
+
+let set_pr_ssrtac name prec afmt = (* FIXME *) () (*
+  let fmt = List.map (function
+    | ArgSep s -> Egramml.GramTerminal s
+    | ArgSsr s -> Egramml.GramTerminal s
+    | ArgCoq at -> Egramml.GramTerminal "COQ_ARG") afmt in
+  let tacname = ssrtac_name name in () *)
+
+let ssrtac_atom ?loc name args = TacML (Loc.tag ?loc (ssrtac_entry name 0, args))
+let ssrtac_expr ?loc name args = ssrtac_atom ?loc name args
+
+let tclintros_expr ?loc tac ipats =
+  let args = [Tacexpr.TacGeneric (in_gen (rawwit wit_ssrintrosarg) (tac, ipats))] in
+  ssrtac_expr ?loc "tclintros" args
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  tactic_expr: LEVEL "1" [ RIGHTA
+    [ tac = tactic_expr; intros = ssrintros_ne -> tclintros_expr ~loc:!@loc tac intros
+    ] ];
+END
+
+(* }}} *)
+
+
+(** Bracketing tactical *)
+
+(* The tactic pretty-printer doesn't know that some extended tactics *)
+(* are actually tacticals. To prevent it from improperly removing    *)
+(* parentheses we override the parsing rule for bracketed tactic     *)
+(* expressions so that the pretty-print always reflects the input.   *)
+(* (Removing user-specified parentheses is dubious anyway).          *)
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  ssrparentacarg: [[ "("; tac = tactic_expr; ")" -> Loc.tag ~loc:!@loc (Tacexp tac) ]];
+  tactic_expr: LEVEL "0" [[ arg = ssrparentacarg -> TacArg arg ]];
+END
+
+(** The internal "done" and "ssrautoprop" tactics. *)
+
+(* For additional flexibility, "done" and "ssrautoprop" are  *)
+(* defined in Ltac.                                          *)
+(* Although we provide a default definition in ssreflect,    *)
+(* we look up the definition dynamically at each call point, *)
+(* to allow for user extensions. "ssrautoprop" defaults to   *)
+(* trivial.                                                  *)
+
+let ssrautoprop gl =
+  try 
+    let tacname = 
+      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
+    V82.of_tactic (eval_tactic (Tacexpr.TacArg tacexpr)) gl
+  with Not_found -> V82.of_tactic (Auto.full_trivial []) gl
+
+let () = ssrautoprop_tac := ssrautoprop
+
+let tclBY tac = Tacticals.tclTHEN tac (donetac ~-1)
+
+(** Tactical arguments. *)
+
+(* We have four kinds: simple tactics, [|]-bracketed lists, hints, and swaps *)
+(* The latter two are used in forward-chaining tactics (have, suffice, wlog) *)
+(* and subgoal reordering tacticals (; first & ; last), respectively.        *)
+
+(* Force use of the tactic_expr parsing entry, to rule out tick marks. *)
+
+(** The "by" tactical. *)
+
+
+open Ssrfwd
+
+TACTIC EXTEND ssrtclby
+| [ "by" ssrhintarg(tac) ] -> [ V82.tactic (hinttac ist true tac) ]
+END
+
+(* }}} *)
+(* We can't parse "by" in ARGUMENT EXTEND because it will only be made *)
+(* into a keyword in ssreflect.v; so we anticipate this in GEXTEND.    *)
+
+GEXTEND Gram
+  GLOBAL: ssrhint simple_tactic;
+  ssrhint: [[ "by"; arg = ssrhintarg -> arg ]];
+END
+
+(** The "do" tactical. ********************************************************)
+
+(*
+type ssrdoarg = ((ssrindex * ssrmmod) * ssrhint) * ssrclauses
+*)
+TACTIC EXTEND ssrtcldo
+| [ "YouShouldNotTypeThis" "do" ssrdoarg(arg) ] -> [ V82.tactic (ssrdotac ist arg) ]
+END
+set_pr_ssrtac "tcldo" 3 [ArgSep "do "; ArgSsr "doarg"]
+
+let ssrdotac_expr ?loc n m tac clauses =
+  let arg = ((n, m), tac), clauses in
+  ssrtac_expr ?loc "tcldo" [Tacexpr.TacGeneric (in_gen (rawwit wit_ssrdoarg) arg)]
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  ssrdotac: [
+    [ tac = tactic_expr LEVEL "3" -> mk_hint tac
+    | tacs = ssrortacarg -> tacs
+  ] ];
+  tactic_expr: LEVEL "3" [ RIGHTA
+    [ IDENT "do"; m = ssrmmod; tac = ssrdotac; clauses = ssrclauses ->
+      ssrdotac_expr ~loc:!@loc noindex m tac clauses
+    | IDENT "do"; tac = ssrortacarg; clauses = ssrclauses ->
+      ssrdotac_expr ~loc:!@loc noindex Once tac clauses
+    | IDENT "do"; n = int_or_var; m = ssrmmod;
+                  tac = ssrdotac; clauses = ssrclauses ->
+      ssrdotac_expr ~loc:!@loc (mk_index ~loc:!@loc n) m tac clauses
+    ] ];
+END
+(* }}} *)
+
+
+(* We can't actually parse the direction separately because this   *)
+(* would introduce conflicts with the basic ltac syntax.           *)
+let pr_ssrseqdir _ _ _ = function
+  | L2R -> str ";" ++ spc () ++ str "first "
+  | R2L -> str ";" ++ spc () ++ str "last "
+
+ARGUMENT EXTEND ssrseqdir TYPED AS ssrdir PRINTED BY pr_ssrseqdir
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+TACTIC EXTEND ssrtclseq
+| [ "YouShouldNotTypeThis" ssrtclarg(tac) ssrseqdir(dir) ssrseqarg(arg) ] ->
+  [ V82.tactic (tclSEQAT ist tac dir arg) ]
+END
+set_pr_ssrtac "tclseq" 5 [ArgSsr "tclarg"; ArgSsr "seqdir"; ArgSsr "seqarg"]
+
+let tclseq_expr ?loc tac dir arg =
+  let arg1 = in_gen (rawwit wit_ssrtclarg) tac in
+  let arg2 = in_gen (rawwit wit_ssrseqdir) dir in
+  let arg3 = in_gen (rawwit wit_ssrseqarg) (check_seqtacarg dir arg) in
+  ssrtac_expr ?loc "tclseq" (List.map (fun x -> Tacexpr.TacGeneric x) [arg1; arg2; arg3])
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  ssr_first: [
+    [ tac = ssr_first; ipats = ssrintros_ne -> tclintros_expr ~loc:!@loc tac ipats
+    | "["; tacl = LIST0 tactic_expr SEP "|"; "]" -> TacFirst tacl
+    ] ];
+  ssr_first_else: [
+    [ tac1 = ssr_first; tac2 = ssrorelse -> TacOrelse (tac1, tac2)
+    | tac = ssr_first -> tac ]];
+  tactic_expr: LEVEL "4" [ LEFTA
+    [ tac1 = tactic_expr; ";"; IDENT "first"; tac2 = ssr_first_else ->
+      TacThen (tac1, tac2)
+    | tac = tactic_expr; ";"; IDENT "first"; arg = ssrseqarg ->
+      tclseq_expr ~loc:!@loc tac L2R arg
+    | tac = tactic_expr; ";"; IDENT "last"; arg = ssrseqarg ->
+      tclseq_expr ~loc:!@loc tac R2L arg
+    ] ];
+END
+(* }}} *)
+
+(** 5. Bookkeeping tactics (clear, move, case, elim) *)
+
+(** Generalization (discharge) item *)
+
+(* An item is a switch + term pair.                                     *)
+
+(* type ssrgen = ssrdocc * ssrterm *)
+
+let pr_gen (docc, dt) = pr_docc docc ++ pr_cpattern dt
+
+let pr_ssrgen _ _ _ = pr_gen
+
+ARGUMENT EXTEND ssrgen TYPED AS ssrdocc * cpattern PRINTED BY pr_ssrgen
+| [ ssrdocc(docc) cpattern(dt) ] -> [ docc, dt ]
+| [ cpattern(dt) ] -> [ nodocc, dt ]
+END
+
+let has_occ ((_, occ), _) = occ <> None
+
+(** Generalization (discharge) sequence *)
+
+(* A discharge sequence is represented as a list of up to two   *)
+(* lists of d-items, plus an ident list set (the possibly empty *)
+(* final clear switch). The main list is empty iff the command  *)
+(* is defective, and has length two if there is a sequence of   *)
+(* dependent terms (and in that case it is the first of the two *)
+(* lists). Thus, the first of the two lists is never empty.     *)
+
+(* type ssrgens = ssrgen list *)
+(* type ssrdgens = ssrgens list * ssrclear *)
+
+let gens_sep = function [], [] -> mt | _ -> spc
+
+let pr_dgens pr_gen (gensl, clr) =
+  let prgens s gens = str s ++ pr_list spc pr_gen gens in
+  let prdeps deps = prgens ": " deps ++ spc () ++ str "/" in
+  match gensl with
+  | [deps; []] -> prdeps deps ++ pr_clear pr_spc clr
+  | [deps; gens] -> prdeps deps ++ prgens " " gens ++ pr_clear spc clr
+  | [gens] -> prgens ": " gens ++ pr_clear spc clr
+  | _ -> pr_clear pr_spc clr
+
+let pr_ssrdgens _ _ _ = pr_dgens pr_gen
+
+let cons_gen gen = function
+  | gens :: gensl, clr -> (gen :: gens) :: gensl, clr
+  | _ -> anomaly "missing gen list"
+
+let cons_dep (gensl, clr) =
+  if List.length gensl = 1 then ([] :: gensl, clr) else
+  CErrors.user_err (Pp.str "multiple dependents switches '/'")
+
+ARGUMENT EXTEND ssrdgens_tl TYPED AS ssrgen list list * ssrclear
+                            PRINTED BY pr_ssrdgens
+| [ "{" ne_ssrhyp_list(clr) "}" cpattern(dt) ssrdgens_tl(dgens) ] ->
+  [ cons_gen (mkclr clr, dt) dgens ]
+| [ "{" ne_ssrhyp_list(clr) "}" ] ->
+  [ [[]], clr ]
+| [ "{" ssrocc(occ) "}" cpattern(dt) ssrdgens_tl(dgens) ] ->
+  [ cons_gen (mkocc occ, dt) dgens ]
+| [ "/" ssrdgens_tl(dgens) ] ->
+  [ cons_dep dgens ]
+| [ cpattern(dt) ssrdgens_tl(dgens) ] ->
+  [ cons_gen (nodocc, dt) dgens ]
+| [ ] ->
+  [ [[]], [] ]
+END
+
+ARGUMENT EXTEND ssrdgens TYPED AS ssrdgens_tl PRINTED BY pr_ssrdgens
+| [ ":" ssrgen(gen) ssrdgens_tl(dgens) ] -> [ cons_gen gen dgens ]
+END
+
+(** Equations *)
+
+(* argument *)
+
+let pr_eqid = function Some pat -> str " " ++ pr_ipat pat | None -> mt ()
+let pr_ssreqid _ _ _ = pr_eqid
+
+(* We must use primitive parsing here to avoid conflicts with the  *)
+(* basic move, case, and elim tactics.                             *)
+ARGUMENT EXTEND ssreqid TYPED AS ssripatrep option PRINTED BY pr_ssreqid
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let accept_ssreqid strm =
+  match Util.stream_nth 0 strm with
+  | Tok.IDENT _ -> accept_before_syms [":"] strm
+  | Tok.KEYWORD ":" -> ()
+  | Tok.KEYWORD pat when List.mem pat ["_"; "?"; "->"; "<-"] ->
+                      accept_before_syms [":"] strm
+  | _ -> raise Stream.Failure
+
+let test_ssreqid = Gram.Entry.of_parser "test_ssreqid" accept_ssreqid
+
+GEXTEND Gram
+  GLOBAL: ssreqid;
+  ssreqpat: [
+    [ id = Prim.ident -> IPatId id
+    | "_" -> IPatAnon Drop
+    | "?" -> IPatAnon One
+    | occ = ssrdocc; "->" -> (match occ with
+      | None, occ -> IPatRewrite (occ, L2R)
+      | _ -> CErrors.user_err ~loc:!@loc (str"Only occurrences are allowed here"))
+    | occ = ssrdocc; "<-" -> (match occ with
+      | None, occ ->  IPatRewrite (occ, R2L)
+      | _ -> CErrors.user_err ~loc:!@loc (str "Only occurrences are allowed here"))
+    | "->" -> IPatRewrite (allocc, L2R)
+    | "<-" -> IPatRewrite (allocc, R2L)
+    ]];
+  ssreqid: [
+    [ test_ssreqid; pat = ssreqpat -> Some pat
+    | test_ssreqid -> None
+    ]];
+END
+
+(** Bookkeeping (discharge-intro) argument *)
+
+(* Since all bookkeeping ssr commands have the same discharge-intro    *)
+(* argument format we use a single grammar entry point to parse them.  *)
+(* the entry point parses only non-empty arguments to avoid conflicts  *)
+(* with the basic Coq tactics.                                         *)
+
+(* type ssrarg = ssrbwdview * (ssreqid * (ssrdgens * ssripats)) *)
+
+let pr_ssrarg _ _ _ (view, (eqid, (dgens, ipats))) =
+  let pri = pr_intros (gens_sep dgens) in
+  pr_view2 view ++ pr_eqid eqid ++ pr_dgens pr_gen dgens ++ pri ipats
+
+ARGUMENT EXTEND ssrarg TYPED AS ssrfwdview * (ssreqid * (ssrdgens * ssrintros))
+   PRINTED BY pr_ssrarg
+| [ ssrfwdview(view) ssreqid(eqid) ssrdgens(dgens) ssrintros(ipats) ] ->
+  [ view, (eqid, (dgens, ipats)) ]
+| [ ssrfwdview(view) ssrclear(clr) ssrintros(ipats) ] ->
+  [ view, (None, (([], clr), ipats)) ]
+| [ ssreqid(eqid) ssrdgens(dgens) ssrintros(ipats) ] ->
+  [ [], (eqid, (dgens, ipats)) ]
+| [ ssrclear_ne(clr) ssrintros(ipats) ] ->
+  [ [], (None, (([], clr), ipats)) ]
+| [ ssrintros_ne(ipats) ] ->
+  [ [], (None, (([], []), ipats)) ]
+END
+
+(** The "clear" tactic *)
+
+(* We just add a numeric version that clears the n top assumptions. *)
+
+TACTIC EXTEND ssrclear
+  | [ "clear" natural(n) ] -> [ tclIPAT (List.init n (fun _ -> IPatAnon Drop)) ]
+END
+
+(** The "move" tactic *)
+
+(* TODO: review this, in particular the => _ and => [] cases *)
+let rec improper_intros = function
+  | IPatSimpl _ :: ipats -> improper_intros ipats
+  | (IPatId _ | IPatAnon _ | IPatCase _ | IPatDispatch _) :: _ -> false
+  | _ -> true (* FIXME *)
+
+let check_movearg = function
+  | view, (eqid, _) when view <> [] && eqid <> None ->
+    CErrors.user_err (Pp.str "incompatible view and equation in move tactic")
+  | view, (_, (([gen :: _], _), _)) when view <> [] && has_occ gen ->
+    CErrors.user_err (Pp.str "incompatible view and occurrence switch in move tactic")
+  | _, (_, ((dgens, _), _)) when List.length dgens > 1 ->
+    CErrors.user_err (Pp.str "dependents switch `/' in move tactic")
+  | _, (eqid, (_, ipats)) when eqid <> None && improper_intros ipats ->
+    CErrors.user_err (Pp.str "no proper intro pattern for equation in move tactic")
+  | arg -> arg
+
+ARGUMENT EXTEND ssrmovearg TYPED AS ssrarg PRINTED BY pr_ssrarg
+| [ ssrarg(arg) ] -> [ check_movearg arg ]
+END
+
+let movearg_of_parsed_movearg (v,(eq,(dg,ip))) =
+  (v,(eq,(ssrdgens_of_parsed_dgens dg,ip)))
+
+TACTIC EXTEND ssrmove
+| [ "move" ssrmovearg(arg) ssrrpat(pat) ] ->
+  [ ssrmovetac (movearg_of_parsed_movearg arg) <*> tclIPAT [pat] ]
+| [ "move" ssrmovearg(arg) ssrclauses(clauses) ] ->
+  [ tclCLAUSES (ssrmovetac (movearg_of_parsed_movearg arg)) clauses ]
+| [ "move" ssrrpat(pat) ] -> [ tclIPAT [pat] ]
+| [ "move" ] -> [ ssrsmovetac ]
+END
+
+let check_casearg = function
+| view, (_, (([_; gen :: _], _), _)) when view <> [] && has_occ gen ->
+  CErrors.user_err (Pp.str "incompatible view and occurrence switch in dependent case tactic")
+| arg -> arg
+
+ARGUMENT EXTEND ssrcasearg TYPED AS ssrarg PRINTED BY pr_ssrarg
+| [ ssrarg(arg) ] -> [ check_casearg arg ]
+END
+
+TACTIC EXTEND ssrcase
+| [ "case" ssrcasearg(arg) ssrclauses(clauses) ] ->
+  [ tclCLAUSES (ssrcasetac (movearg_of_parsed_movearg arg)) clauses ]
+| [ "case" ] -> [ ssrscasetoptac ]
+END
+
+(** The "elim" tactic *)
+
+TACTIC EXTEND ssrelim
+| [ "elim" ssrarg(arg) ssrclauses(clauses) ] ->
+  [ tclCLAUSES (ssrelimtac (movearg_of_parsed_movearg arg)) clauses ]
+| [ "elim" ] -> [ ssrselimtoptac ]
+END
+
+(** 6. Backward chaining tactics: apply, exact, congr. *)
+
+(** The "apply" tactic *)
+
+let pr_agen (docc, dt) = pr_docc docc ++ pr_term dt
+let pr_ssragen _ _ _ = pr_agen
+let pr_ssragens _ _ _ = pr_dgens pr_agen
+
+ARGUMENT EXTEND ssragen TYPED AS ssrdocc * ssrterm PRINTED BY pr_ssragen
+| [ "{" ne_ssrhyp_list(clr) "}" ssrterm(dt) ] -> [ mkclr clr, dt ]
+| [ ssrterm(dt) ] -> [ nodocc, dt ]
+END
+
+ARGUMENT EXTEND ssragens TYPED AS ssragen list list * ssrclear 
+PRINTED BY pr_ssragens
+| [ "{" ne_ssrhyp_list(clr) "}" ssrterm(dt) ssragens(agens) ] ->
+  [ cons_gen (mkclr clr, dt) agens ]
+| [ "{" ne_ssrhyp_list(clr) "}" ] -> [ [[]], clr]
+| [ ssrterm(dt) ssragens(agens) ] ->
+  [ cons_gen (nodocc, dt) agens ]
+| [ ] -> [ [[]], [] ]
+END
+
+let mk_applyarg views agens intros = views, (agens, intros)
+
+let pr_ssraarg _ _ _ (view, (dgens, ipats)) =
+  let pri = pr_intros (gens_sep dgens) in
+  pr_view view ++ pr_dgens pr_agen dgens ++ pri ipats
+
+ARGUMENT EXTEND ssrapplyarg 
+TYPED AS ssrbwdview * (ssragens * ssrintros)
+PRINTED BY pr_ssraarg
+| [ ":" ssragen(gen) ssragens(dgens) ssrintros(intros) ] ->
+  [ mk_applyarg [] (cons_gen gen dgens) intros ]
+| [ ssrclear_ne(clr) ssrintros(intros) ] ->
+  [ mk_applyarg [] ([], clr) intros ]
+| [ ssrintros_ne(intros) ] ->
+  [ mk_applyarg [] ([], []) intros ]
+| [ ssrbwdview(view) ":" ssragen(gen) ssragens(dgens) ssrintros(intros) ] ->
+  [ mk_applyarg view (cons_gen gen dgens) intros ]
+| [ ssrbwdview(view) ssrclear(clr) ssrintros(intros) ] ->
+  [ mk_applyarg view ([], clr) intros ]
+    END
+
+TACTIC EXTEND ssrapply
+| [ "apply" ssrapplyarg(arg) ] -> [
+     let views, (gens_clr, intros) = arg in
+     inner_ssrapplytac views gens_clr ist <*> tclIPATssr intros ]
+| [ "apply" ] -> [ apply_top_tac ]
+END
+
+(** The "exact" tactic *)
+
+let mk_exactarg views dgens = mk_applyarg views dgens []
+
+ARGUMENT EXTEND ssrexactarg TYPED AS ssrapplyarg PRINTED BY pr_ssraarg
+| [ ":" ssragen(gen) ssragens(dgens) ] ->
+  [ mk_exactarg [] (cons_gen gen dgens) ]
+| [ ssrbwdview(view) ssrclear(clr) ] ->
+  [ mk_exactarg view ([], clr) ]
+| [ ssrclear_ne(clr) ] ->
+  [ mk_exactarg [] ([], clr) ]
+END
+
+let vmexacttac pf =
+  Goal.nf_enter begin fun gl ->
+  exact_no_check (EConstr.mkCast (pf, VMcast, Tacmach.New.pf_concl gl))
+  end
+
+TACTIC EXTEND ssrexact
+| [ "exact" ssrexactarg(arg) ] -> [
+     let views, (gens_clr, _) = arg in
+     V82.tactic (tclBY (V82.of_tactic (inner_ssrapplytac views gens_clr ist))) ]
+| [ "exact" ] -> [
+     V82.tactic (Tacticals.tclORELSE (donetac ~-1) (tclBY (V82.of_tactic apply_top_tac))) ]
+| [ "exact" "<:" lconstr(pf) ] -> [ vmexacttac pf ]
+END
+
+(** The "congr" tactic *)
+
+(* type ssrcongrarg = open_constr * (int * constr) *)
+
+let pr_ssrcongrarg _ _ _ ((n, f), dgens) =
+  (if n <= 0 then mt () else str " " ++ int n) ++
+  str " " ++ pr_term f ++ pr_dgens pr_gen dgens
+
+ARGUMENT EXTEND ssrcongrarg TYPED AS (int * ssrterm) * ssrdgens
+  PRINTED BY pr_ssrcongrarg
+| [ natural(n) constr(c) ssrdgens(dgens) ] -> [ (n, mk_term xNoFlag c), dgens ]
+| [ natural(n) constr(c) ] -> [ (n, mk_term xNoFlag c),([[]],[]) ]
+| [ constr(c) ssrdgens(dgens) ] -> [ (0, mk_term xNoFlag c), dgens ]
+| [ constr(c) ] -> [ (0, mk_term xNoFlag c), ([[]],[]) ]
+END
+
+
+
+TACTIC EXTEND ssrcongr
+| [ "congr" ssrcongrarg(arg) ] ->
+[ let arg, dgens = arg in
+  V82.tactic begin
+    match dgens with
+    | [gens], clr -> Tacticals.tclTHEN (genstac (gens,clr)) (newssrcongrtac arg ist)
+    | _ -> errorstrm (str"Dependent family abstractions not allowed in congr")
+  end]
+END
+
+(** 7. Rewriting tactics (rewrite, unlock) *)
+
+(** Coq rewrite compatibility flag *)
+
+(** Rewrite clear/occ switches *)
+
+let pr_rwocc = function
+  | None, None -> mt ()
+  | None, occ -> pr_occ occ
+  | Some clr,  _ ->  pr_clear_ne clr
+
+let pr_ssrrwocc _ _ _ = pr_rwocc
+
+ARGUMENT EXTEND ssrrwocc TYPED AS ssrdocc PRINTED BY pr_ssrrwocc
+| [ "{" ssrhyp_list(clr) "}" ] -> [ mkclr clr ]
+| [ "{" ssrocc(occ) "}" ] -> [ mkocc occ ]
+| [ ] -> [ noclr ]
+END
+
+(** Rewrite rules *)
+
+let pr_rwkind = function
+  | RWred s -> pr_simpl s
+  | RWdef -> str "/"
+  | RWeq -> mt ()
+
+let wit_ssrrwkind = add_genarg "ssrrwkind" pr_rwkind
+
+let pr_rule = function
+  | RWred s, _ -> pr_simpl s
+  | RWdef, r-> str "/" ++ pr_term r
+  | RWeq, r -> pr_term r
+
+let pr_ssrrule _ _ _ = pr_rule
+
+let noruleterm loc = mk_term xNoFlag (mkCProp loc)
+
+ARGUMENT EXTEND ssrrule_ne TYPED AS ssrrwkind * ssrterm PRINTED BY pr_ssrrule
+  | [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+GEXTEND Gram
+  GLOBAL: ssrrule_ne;
+  ssrrule_ne : [
+    [ test_not_ssrslashnum; x =
+        [ "/"; t = ssrterm -> RWdef, t
+        | t = ssrterm -> RWeq, t 
+        | s = ssrsimpl_ne -> RWred s, noruleterm (Some !@loc)
+        ] -> x
+    | s = ssrsimpl_ne -> RWred s, noruleterm (Some !@loc)
+  ]];
+END
+
+ARGUMENT EXTEND ssrrule TYPED AS ssrrule_ne PRINTED BY pr_ssrrule
+  | [ ssrrule_ne(r) ] -> [ r ]
+  | [ ] -> [ RWred Nop, noruleterm (Some loc) ]
+END
+
+(** Rewrite arguments *)
+
+let pr_option f = function None -> mt() | Some x -> f x
+let pr_pattern_squarep= pr_option (fun r -> str "[" ++ pr_rpattern r ++ str "]")
+let pr_ssrpattern_squarep _ _ _ = pr_pattern_squarep
+let pr_rwarg ((d, m), ((docc, rx), r)) =
+  pr_rwdir d ++ pr_mult m ++ pr_rwocc docc ++ pr_pattern_squarep rx ++ pr_rule r
+
+let pr_ssrrwarg _ _ _ = pr_rwarg
+
+ARGUMENT EXTEND ssrpattern_squarep
+TYPED AS rpattern option PRINTED BY pr_ssrpattern_squarep
+  | [ "[" rpattern(rdx) "]" ] -> [ Some rdx ]
+  | [ ] -> [ None ]
+END
+
+ARGUMENT EXTEND ssrpattern_ne_squarep
+TYPED AS rpattern option PRINTED BY pr_ssrpattern_squarep
+  | [ "[" rpattern(rdx) "]" ] -> [ Some rdx ]
+END
+
+
+ARGUMENT EXTEND ssrrwarg
+  TYPED AS (ssrdir * ssrmult) * ((ssrdocc * rpattern option) * ssrrule)
+  PRINTED BY pr_ssrrwarg
+  | [ "-" ssrmult(m) ssrrwocc(docc) ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg (R2L, m) (docc, rx) r ]
+  | [ "-/" ssrterm(t) ] ->     (* just in case '-/' should become a token *)
+    [ mk_rwarg (R2L, nomult) norwocc (RWdef, t) ]
+  | [ ssrmult_ne(m) ssrrwocc(docc) ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg (L2R, m) (docc, rx) r ]
+  | [ "{" ne_ssrhyp_list(clr) "}" ssrpattern_ne_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (mkclr clr, rx) r ]
+  | [ "{" ne_ssrhyp_list(clr) "}" ssrrule(r) ] ->
+    [ mk_rwarg norwmult (mkclr clr, None) r ]
+  | [ "{" ssrocc(occ) "}" ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (mkocc occ, rx) r ]
+  | [ "{" "}" ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (nodocc, rx) r ]
+  | [ ssrpattern_ne_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (noclr, rx) r ]
+  | [ ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult norwocc r ]
+END
+
+TACTIC EXTEND ssrinstofruleL2R
+| [ "ssrinstancesofruleL2R" ssrterm(arg) ] -> [ V82.tactic (ssrinstancesofrule ist L2R arg) ]
+END
+TACTIC EXTEND ssrinstofruleR2L
+| [ "ssrinstancesofruleR2L" ssrterm(arg) ] -> [ V82.tactic (ssrinstancesofrule ist R2L arg) ]
+END
+
+(** Rewrite argument sequence *)
+
+(* type ssrrwargs = ssrrwarg list *)
+
+let pr_ssrrwargs _ _ _ rwargs = pr_list spc pr_rwarg rwargs
+
+ARGUMENT EXTEND ssrrwargs TYPED AS ssrrwarg list PRINTED BY pr_ssrrwargs
+  | [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let ssr_rw_syntax = Summary.ref ~name:"SSR:rewrite" true
+
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optname  = "ssreflect rewrite";
+      Goptions.optkey   = ["SsrRewrite"];
+      Goptions.optread  = (fun _ -> !ssr_rw_syntax);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b -> ssr_rw_syntax := b) }
+
+let test_ssr_rw_syntax =
+  let test strm  =
+    if not !ssr_rw_syntax then raise Stream.Failure else
+    if is_ssr_loaded () then () else
+    match Util.stream_nth 0 strm with
+    | Tok.KEYWORD key when List.mem key.[0] ['{'; '['; '/'] -> ()
+    | _ -> raise Stream.Failure in
+  Gram.Entry.of_parser "test_ssr_rw_syntax" test
+
+GEXTEND Gram
+  GLOBAL: ssrrwargs;
+  ssrrwargs: [[ test_ssr_rw_syntax; a = LIST1 ssrrwarg -> a ]];
+END
+
+(** The "rewrite" tactic *)
+
+TACTIC EXTEND ssrrewrite
+  | [ "rewrite" ssrrwargs(args) ssrclauses(clauses) ] ->
+    [ tclCLAUSES (old_tac (ssrrewritetac ist args)) clauses ]
+END
+
+(** The "unlock" tactic *)
+
+let pr_unlockarg (occ, t) = pr_occ occ ++ pr_term t
+let pr_ssrunlockarg _ _ _ = pr_unlockarg
+
+ARGUMENT EXTEND ssrunlockarg TYPED AS ssrocc * ssrterm
+  PRINTED BY pr_ssrunlockarg
+  | [  "{" ssrocc(occ) "}" ssrterm(t) ] -> [ occ, t ]
+  | [  ssrterm(t) ] -> [ None, t ]
+END
+
+let pr_ssrunlockargs _ _ _ args = pr_list spc pr_unlockarg args
+
+ARGUMENT EXTEND ssrunlockargs TYPED AS ssrunlockarg list
+  PRINTED BY pr_ssrunlockargs
+  | [  ssrunlockarg_list(args) ] -> [ args ]
+END
+
+TACTIC EXTEND ssrunlock
+  | [ "unlock" ssrunlockargs(args) ssrclauses(clauses) ] ->
+    [ tclCLAUSES (old_tac (unlocktac ist args)) clauses ]
+END
+
+(** 8. Forward chaining tactics (pose, set, have, suffice, wlog) *)
+
+
+TACTIC EXTEND ssrpose
+| [ "pose" ssrfixfwd(ffwd) ] -> [ V82.tactic (ssrposetac ffwd) ]
+| [ "pose" ssrcofixfwd(ffwd) ] -> [ V82.tactic (ssrposetac ffwd) ]
+| [ "pose" ssrfwdid(id) ssrposefwd(fwd) ] -> [ V82.tactic (ssrposetac (id, fwd)) ]
+END
+
+(** The "set" tactic *)
+
+(* type ssrsetfwd = ssrfwd * ssrdocc *)
+
+TACTIC EXTEND ssrset
+| [ "set" ssrfwdid(id) ssrsetfwd(fwd) ssrclauses(clauses) ] ->
+  [ tclCLAUSES (old_tac (ssrsettac id fwd)) clauses ]
+END
+
+(** The "have" tactic *)
+
+(* type ssrhavefwd = ssrfwd * ssrhint *)
+
+
+(* Pltac. *)
+
+(* The standard TACTIC EXTEND does not work for abstract *)
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  tactic_expr: LEVEL "3"
+    [ RIGHTA [ IDENT "abstract"; gens = ssrdgens ->
+               ssrtac_expr ~loc:!@loc "abstract"
+                [Tacexpr.TacGeneric (Genarg.in_gen (Genarg.rawwit wit_ssrdgens) gens)] ]];
+END
+TACTIC EXTEND ssrabstract
+| [ "abstract" ssrdgens(gens) ] -> [
+    if List.length (fst gens) <> 1 then
+      errorstrm (str"dependents switches '/' not allowed here");
+    Ssripats.ssrabstract (ssrdgens_of_parsed_dgens gens) ]
+END
+
+TACTIC EXTEND ssrhave
+| [ "have" ssrhavefwdwbinders(fwd) ] ->
+  [ V82.tactic (havetac ist fwd false false) ]
+END
+
+TACTIC EXTEND ssrhavesuff
+| [ "have" "suff" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ V82.tactic (havetac ist (false,(pats,fwd)) true false) ]
+END
+
+TACTIC EXTEND ssrhavesuffices
+| [ "have" "suffices" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ V82.tactic (havetac ist (false,(pats,fwd)) true false) ]
+END
+
+TACTIC EXTEND ssrsuffhave
+| [ "suff" "have" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ V82.tactic (havetac ist (false,(pats,fwd)) true true) ]
+END
+
+TACTIC EXTEND ssrsufficeshave
+| [ "suffices" "have" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ V82.tactic (havetac ist (false,(pats,fwd)) true true) ]
+END
+
+(** The "suffice" tactic *)
+
+let pr_ssrsufffwdwbinders _ _ prt (hpats, (fwd, hint)) =
+  pr_hpats hpats ++ pr_fwd fwd ++ pr_hint prt hint
+
+ARGUMENT EXTEND ssrsufffwd
+  TYPED AS ssrhpats * (ssrfwd * ssrhint) PRINTED BY pr_ssrsufffwdwbinders
+| [ ssrhpats(pats) ssrbinder_list(bs)  ":" ast_closure_lterm(t) ssrhint(hint) ] ->
+  [ let ((clr, pats), binders), simpl = pats in
+    let allbs = intro_id_to_binder binders @ bs in
+    let allbinders = binders @ List.flatten (binder_to_intro_id bs) in
+    let fwd = mkFwdHint ":" t in
+    (((clr, pats), allbinders), simpl), (bind_fwd allbs fwd, hint) ]
+END
+
+
+TACTIC EXTEND ssrsuff
+| [ "suff" ssrsufffwd(fwd) ] -> [ V82.tactic (sufftac ist fwd) ]
+END
+
+TACTIC EXTEND ssrsuffices
+| [ "suffices" ssrsufffwd(fwd) ] -> [ V82.tactic (sufftac ist fwd) ]
+END
+
+(** The "wlog" (Without Loss Of Generality) tactic *)
+
+(* type ssrwlogfwd = ssrwgen list * ssrfwd *)
+
+let pr_ssrwlogfwd _ _ _ (gens, t) =
+  str ":" ++ pr_list mt pr_wgen gens ++ spc() ++ pr_fwd t
+
+ARGUMENT EXTEND ssrwlogfwd TYPED AS ssrwgen list * ssrfwd
+                         PRINTED BY pr_ssrwlogfwd
+| [ ":" ssrwgen_list(gens) "/" ast_closure_lterm(t) ] -> [ gens, mkFwdHint "/" t]
+END
+
+        
+TACTIC EXTEND ssrwlog
+| [ "wlog" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ V82.tactic (wlogtac ist pats fwd hint false `NoGen) ]
+END
+
+TACTIC EXTEND ssrwlogs
+| [ "wlog" "suff" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+TACTIC EXTEND ssrwlogss
+| [ "wlog" "suffices" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ]->
+  [ V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+TACTIC EXTEND ssrwithoutloss
+| [ "without" "loss" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ V82.tactic (wlogtac ist pats fwd hint false `NoGen) ]
+END
+
+TACTIC EXTEND ssrwithoutlosss
+| [ "without" "loss" "suff" 
+    ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+TACTIC EXTEND ssrwithoutlossss
+| [ "without" "loss" "suffices" 
+    ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ]->
+  [ V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+(* Generally have *)
+let pr_idcomma _ _ _ = function
+  | None -> mt()
+  | Some None -> str"_, "
+  | Some (Some id) -> pr_id id ++ str", "
+
+ARGUMENT EXTEND ssr_idcomma TYPED AS ident option option PRINTED BY pr_idcomma
+  | [ ] -> [ None ]
+END
+
+let accept_idcomma strm =
+  match stream_nth 0 strm with
+  | Tok.IDENT _ | Tok.KEYWORD "_" -> accept_before_syms [","] strm
+  | _ -> raise Stream.Failure
+
+let test_idcomma = Gram.Entry.of_parser "test_idcomma" accept_idcomma
+
+GEXTEND Gram
+  GLOBAL: ssr_idcomma;
+  ssr_idcomma: [ [ test_idcomma; 
+    ip = [ id = IDENT -> Some (Id.of_string id) | "_" -> None ]; "," ->
+    Some ip
+  ] ];
+END
+
+let augment_preclr clr1 (((clr0, x),y),z) = (((clr1 @ clr0, x),y),z)
+
+TACTIC EXTEND ssrgenhave
+| [ "gen" "have" ssrclear(clr)
+    ssr_idcomma(id) ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ let pats = augment_preclr clr pats in
+    V82.tactic (wlogtac ist pats fwd hint false (`Gen id)) ]
+END
+
+TACTIC EXTEND ssrgenhave2
+| [ "generally" "have" ssrclear(clr)
+    ssr_idcomma(id) ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ let pats = augment_preclr clr pats in
+    V82.tactic (wlogtac ist pats fwd hint false (`Gen id)) ]
+END
+
+(* We wipe out all the keywords generated by the grammar rules we defined. *)
+(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
+(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
+(* consequence the extended ssreflect grammar.                             *)
+let () = CLexer.set_keyword_state frozen_lexer ;;
+
+
+(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrparser.mli b/plugins/ssr/ssrparser.mli
new file mode 100644
index 00000000..2ac7c7e2
--- /dev/null
+++ b/plugins/ssr/ssrparser.mli
@@ -0,0 +1,37 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Ltac_plugin
+
+val ssrtacarg : Tacexpr.raw_tactic_expr Pcoq.Gram.entry
+val wit_ssrtacarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type
+val pr_ssrtacarg : 'a -> 'b -> (Notation_term.tolerability -> 'c) -> 'c
+
+val ssrtclarg : Tacexpr.raw_tactic_expr Pcoq.Gram.entry
+val wit_ssrtclarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type
+val pr_ssrtclarg : 'a -> 'b -> (Notation_term.tolerability -> 'c -> 'd) -> 'c -> 'd
+
+val add_genarg : string -> ('a -> Pp.t) -> 'a Genarg.uniform_genarg_type
+
+(* Parsing witnesses, needed to serialize ssreflect syntax *)
+open Ssrmatching_plugin
+open Ssrmatching
+open Ssrast
+open Ssrequality
+
+val wit_ssrrwargs : ssrrwarg list Genarg.uniform_genarg_type
+val wit_ssrclauses : clauses Genarg.uniform_genarg_type
+val wit_ssrcasearg : (cpattern ssragens) ssrmovearg Genarg.uniform_genarg_type
+val wit_ssrmovearg : (cpattern ssragens) ssrmovearg Genarg.uniform_genarg_type
+val wit_ssrapplyarg : ssrapplyarg Genarg.uniform_genarg_type
+val wit_ssrhavefwdwbinders :
+  (Tacexpr.raw_tactic_expr fwdbinders, Tacexpr.glob_tactic_expr fwdbinders, Tacinterp.Value.t fwdbinders) Genarg.genarg_type
diff --git a/plugins/ssr/ssrprinters.ml b/plugins/ssr/ssrprinters.ml
new file mode 100644
index 00000000..11369228
--- /dev/null
+++ b/plugins/ssr/ssrprinters.ml
@@ -0,0 +1,130 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Pp
+open Names
+open Printer
+open Tacmach
+
+open Ssrmatching_plugin
+open Ssrast
+
+let pr_spc () = str " "
+let pr_bar () = Pp.cut() ++ str "|"
+let pr_list = prlist_with_sep
+
+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_env (pf_env gl) (project gl) t
+
+(* FIXME *)
+(* terms are pre constr, the kind is parsing/printing flag to distinguish
+ * between x, @x and (x). It affects automatic clear and let-in preservation.
+ * Cpattern is a temporary flag that becomes InParens ASAP. *)
+(* type ssrtermkind = InParens | WithAt | NoFlag | Cpattern *)
+let xInParens = '('
+let xWithAt = '@'
+let xNoFlag = ' '
+let xCpattern = 'x'
+
+(* Term printing utilities functions for deciding bracketing.  *)
+let pr_paren prx x = hov 1 (str "(" ++ prx x ++ str ")")
+(* String lexing utilities *)
+let skip_wschars s =
+  let rec loop i = match s.[i] with '\n'..' ' -> loop (i + 1) | _ -> i in loop
+(* We also guard characters that might interfere with the ssreflect   *)
+(* tactic syntax.                                                     *)
+let guard_term ch1 s i = match s.[i] with
+  | '(' -> false
+  | '{' | '/' | '=' -> true
+  | _ -> ch1 = xInParens
+
+(* We also guard characters that might interfere with the ssreflect   *)
+(* tactic syntax.                                                     *)
+let pr_guarded guard prc c =
+  pp_with Format.str_formatter (prc c);
+  let s = Format.flush_str_formatter () ^ "$" in
+  if guard s (skip_wschars s 0) then pr_paren prc c else prc c
+
+let prl_constr_expr = Ppconstr.pr_lconstr_expr
+let pr_glob_constr c = Printer.pr_glob_constr_env (Global.env ()) c
+let prl_glob_constr c = Printer.pr_lglob_constr_env (Global.env ()) c
+let pr_glob_constr_and_expr = function
+  | _, Some c -> Ppconstr.pr_constr_expr c
+  | c, None -> pr_glob_constr c
+let pr_term (k, c) = pr_guarded (guard_term k) pr_glob_constr_and_expr c
+
+let pr_hyp (SsrHyp (_, id)) = Id.print id
+let pr_hyps = pr_list pr_spc pr_hyp
+
+let pr_occ = function
+  | Some (true, occ) -> str "{-" ++ pr_list pr_spc int occ ++ str "}"
+  | Some (false, occ) -> str "{+" ++ pr_list pr_spc int occ ++ str "}"
+  | None -> str "{}"
+
+let pr_clear_ne clr = str "{" ++ pr_hyps clr ++ str "}"
+let pr_clear sep clr = if clr = [] then mt () else sep () ++ pr_clear_ne clr
+
+let pr_dir = function L2R -> str "->" | R2L -> str "<-"
+
+let pr_simpl = function
+  | Simpl -1 -> str "/="
+  | Cut -1 -> str "//"
+  | Simpl n -> str "/" ++ int n ++ str "="
+  | Cut n -> str "/" ++ int n ++ str"/"
+  | SimplCut (-1,-1) -> str "//="
+  | SimplCut (n,-1) -> str "/" ++ int n ++ str "/="
+  | SimplCut (-1,n) -> str "//" ++ int n ++ str "="
+  | SimplCut (n,m) -> str "/" ++ int n ++ str "/" ++ int m ++ str "="
+  | Nop -> mt ()
+
+(* New terms *)
+
+let pr_ast_closure_term { body } = Ppconstr.pr_constr_expr body
+
+let pr_view2 = pr_list mt (fun c -> str "/" ++ pr_ast_closure_term c)
+
+let rec pr_ipat p =
+  match p with
+  | IPatId id -> Id.print id
+  | IPatSimpl sim -> pr_simpl sim
+  | IPatClear clr -> pr_clear mt clr
+  | IPatCase iorpat -> hov 1 (str "[" ++ pr_iorpat iorpat ++ str "]")
+  | IPatDispatch iorpat -> hov 1 (str "/[" ++ pr_iorpat iorpat ++ str "]")
+  | IPatInj iorpat -> hov 1 (str "[=" ++ pr_iorpat iorpat ++ str "]")
+  | IPatRewrite (occ, dir) -> pr_occ occ ++ pr_dir dir
+  | IPatAnon All -> str "*"
+  | IPatAnon Drop -> str "_"
+  | IPatAnon One -> str "?"
+  | IPatView v -> pr_view2 v
+  | IPatNoop -> str "-"
+  | IPatAbstractVars l -> str "[:" ++ pr_list spc Id.print l ++ str "]"
+  | IPatTac _ -> str "<tac>"
+(* TODO  | IPatAnon Temporary -> str "+" *)
+and pr_ipats ipats = pr_list spc pr_ipat ipats
+and pr_iorpat iorpat = pr_list pr_bar pr_ipats iorpat
+
+(* 0 cost pp function. Active only if Debug Ssreflect is Set *)
+let ppdebug_ref = ref (fun _ -> ())
+let ssr_pp s = Feedback.msg_debug (str"SSR: "++Lazy.force s)
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optname  = "ssreflect debugging";
+      Goptions.optkey   = ["Debug";"Ssreflect"];
+      Goptions.optdepr  = false;
+      Goptions.optread  = (fun _ -> !ppdebug_ref == ssr_pp);
+      Goptions.optwrite = (fun b -> 
+        Ssrmatching.debug b;
+        if b then ppdebug_ref := ssr_pp else ppdebug_ref := fun _ -> ()) }
+let ppdebug s = !ppdebug_ref s
diff --git a/plugins/ssr/ssrprinters.mli b/plugins/ssr/ssrprinters.mli
new file mode 100644
index 00000000..31c360ad
--- /dev/null
+++ b/plugins/ssr/ssrprinters.mli
@@ -0,0 +1,59 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Ssrast
+
+val pp_term :
+  Goal.goal Evd.sigma -> EConstr.constr -> Pp.t
+
+val pr_spc : unit -> Pp.t
+val pr_bar : unit -> Pp.t
+val pr_list : 
+  (unit -> Pp.t) -> ('a -> Pp.t) -> 'a list -> Pp.t
+
+val pp_concat :
+  Pp.t ->
+  ?sep:Pp.t -> Pp.t list -> Pp.t
+
+val xInParens : ssrtermkind
+val xWithAt : ssrtermkind
+val xNoFlag : ssrtermkind
+val xCpattern : ssrtermkind
+
+val pr_clear : (unit -> Pp.t) -> ssrclear -> Pp.t
+val pr_clear_ne : ssrclear -> Pp.t
+val pr_dir : ssrdir -> Pp.t
+val pr_simpl : ssrsimpl -> Pp.t
+
+val pr_term :
+  ssrtermkind * (Glob_term.glob_constr * Constrexpr.constr_expr option) ->
+  Pp.t
+
+val pr_ast_closure_term : ast_closure_term -> Pp.t
+val pr_view2 : ast_closure_term list -> Pp.t
+val pr_ipat : ssripat -> Pp.t
+val pr_ipats : ssripats -> Pp.t
+val pr_iorpat : ssripatss -> Pp.t
+
+val pr_hyp : ssrhyp -> Pp.t
+val pr_hyps : ssrhyps -> Pp.t
+
+val prl_constr_expr : Constrexpr.constr_expr -> Pp.t
+val prl_glob_constr : Glob_term.glob_constr -> Pp.t
+
+val pr_guarded :
+  (string -> int -> bool) -> ('a -> Pp.t) -> 'a -> Pp.t
+
+val pr_occ : ssrocc -> Pp.t
+
+val ppdebug : Pp.t Lazy.t -> unit
+
diff --git a/plugins/ssr/ssrtacticals.ml b/plugins/ssr/ssrtacticals.ml
new file mode 100644
index 00000000..9cc4f5ce
--- /dev/null
+++ b/plugins/ssr/ssrtacticals.ml
@@ -0,0 +1,165 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Names
+open Termops
+open Tacmach
+open Misctypes
+open Locusops
+
+open Ssrast
+open Ssrcommon
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
+(** Tacticals (+, -, *, done, by, do, =>, first, and last). *)
+
+let get_index = function ArgArg i -> i | _ ->
+  anomaly "Uninterpreted index"
+(* Toplevel constr must be globalized twice ! *)
+
+(** The "first" and "last" tacticals. *)
+
+let tclPERM perm tac gls =
+  let subgls = tac gls in
+  let sigma, subgll = Refiner.unpackage subgls in
+  let subgll' = perm subgll in
+  Refiner.repackage sigma subgll'
+
+let rot_hyps dir i hyps =
+  let n = List.length hyps in
+  if i = 0 then List.rev hyps else
+  if i > n then CErrors.user_err (Pp.str "Not enough subgoals") else
+  let rec rot i l_hyps = function
+    | hyp :: hyps' when i > 0 -> rot (i - 1) (hyp :: l_hyps) hyps'
+    | hyps' -> hyps' @ (List.rev l_hyps) in
+  rot (match dir with L2R -> i | R2L -> n - i) [] hyps
+
+let tclSEQAT ist atac1 dir (ivar, ((_, atacs2), atac3)) =
+  let i = get_index ivar in
+  let evtac t = Proofview.V82.of_tactic (ssrevaltac ist t) in
+  let tac1 = evtac atac1 in
+  if atacs2 = [] && atac3 <> None then tclPERM (rot_hyps dir i) tac1  else
+  let evotac = function Some atac -> evtac atac | _ -> Tacticals.tclIDTAC in
+  let tac3 = evotac atac3 in
+  let rec mk_pad n = if n > 0 then tac3 :: mk_pad (n - 1) else [] in
+  match dir, mk_pad (i - 1), List.map evotac atacs2 with
+  | L2R, [], [tac2] when atac3 = None -> Tacticals.tclTHENFIRST tac1 tac2
+  | L2R, [], [tac2] when atac3 = None -> Tacticals.tclTHENLAST tac1 tac2
+  | L2R, pad, tacs2 -> Tacticals.tclTHENSFIRSTn tac1 (Array.of_list (pad @ tacs2)) tac3
+  | R2L, pad, tacs2 -> Tacticals.tclTHENSLASTn tac1 tac3 (Array.of_list (tacs2 @ pad))
+
+(** The "in" pseudo-tactical *)(* {{{ **********************************************)
+
+let hidden_goal_tag = "the_hidden_goal"
+
+let check_wgen_uniq gens =
+  let clears = List.flatten (List.map fst gens) in
+  check_hyps_uniq [] clears;
+  let ids = CList.map_filter
+    (function (_,Some ((id,_),_)) -> Some (hoi_id id) | _ -> None) gens in
+  let rec check ids = function
+  | id :: _ when List.mem id ids ->
+    errorstrm Pp.(str"Duplicate generalization " ++ Id.print id)
+  | id :: hyps -> check (id :: ids) hyps
+  | [] -> () in
+  check [] ids
+
+let pf_clauseids gl gens clseq =
+  let keep_clears = List.map (fun (x, _) -> x, None) in
+  if gens <> [] then (check_wgen_uniq gens; gens) else
+  if clseq <> InAll && clseq <> InAllHyps then keep_clears gens else
+  CErrors.user_err (Pp.str "assumptions should be named explicitly")
+
+let hidden_clseq = function InHyps | InHypsSeq | InAllHyps -> true | _ -> false
+
+let settac id c = Tactics.letin_tac None (Name id) c None
+let posetac id cl = Proofview.V82.of_tactic (settac id cl nowhere)
+
+let hidetacs clseq idhide cl0 =
+  if not (hidden_clseq clseq) then  [] else
+  [posetac idhide cl0;
+   Proofview.V82.of_tactic (convert_concl_no_check (EConstr.mkVar idhide))]
+
+let endclausestac id_map clseq gl_id cl0 gl =
+  let not_hyp' id = not (List.mem_assoc id id_map) in
+  let orig_id id = try List.assoc id id_map with Not_found -> id in
+  let dc, c = EConstr.decompose_prod_assum (project gl) (pf_concl gl) in
+  let hide_goal = hidden_clseq clseq in
+  let c_hidden =
+    hide_goal && EConstr.eq_constr (project gl) c (EConstr.mkVar gl_id) in
+  let rec fits forced = function
+  | (id, _) :: ids, decl :: dc' when RelDecl.get_name decl = Name id ->
+    fits true (ids, dc')
+  | ids, dc' ->
+    forced && ids = [] && (not hide_goal || dc' = [] && c_hidden) in
+  let rec unmark c = match EConstr.kind (project gl) c with
+  | Term.Var id when hidden_clseq clseq && id = gl_id -> cl0
+  | Term.Prod (Name id, t, c') when List.mem_assoc id id_map ->
+    EConstr.mkProd (Name (orig_id id), unmark t, unmark c')
+  | Term.LetIn (Name id, v, t, c') when List.mem_assoc id id_map ->
+    EConstr.mkLetIn (Name (orig_id id), unmark v, unmark t, unmark c')
+  | _ -> EConstr.map (project gl) unmark c in
+  let utac hyp =
+    Proofview.V82.of_tactic 
+     (Tactics.convert_hyp_no_check (NamedDecl.map_constr unmark hyp)) in
+  let utacs = List.map utac (pf_hyps gl) in
+  let ugtac gl' =
+    Proofview.V82.of_tactic
+      (convert_concl_no_check (unmark (pf_concl gl'))) gl' in
+  let ctacs =
+    if hide_goal then [Proofview.V82.of_tactic (Tactics.clear [gl_id])]
+    else [] in
+  let mktac itacs = Tacticals.tclTHENLIST (itacs @ utacs @ ugtac :: ctacs) in
+  let itac (_, id) = Proofview.V82.of_tactic (Tactics.introduction id) in
+  if fits false (id_map, List.rev dc) then mktac (List.map itac id_map) gl else
+  let all_ids = ids_of_rel_context dc @ pf_ids_of_hyps gl in
+  if List.for_all not_hyp' all_ids && not c_hidden then mktac [] gl else
+  errorstrm Pp.(str "tampering with discharged assumptions of \"in\" tactical")
+
+let tclCLAUSES tac (gens, clseq) gl =
+  if clseq = InGoal || clseq = InSeqGoal then tac gl else
+  let clr_gens = pf_clauseids gl gens clseq in
+  let clear = Tacticals.tclTHENLIST (List.rev(List.fold_right clr_of_wgen clr_gens [])) in
+  let gl_id = mk_anon_id hidden_goal_tag (Tacmach.pf_ids_of_hyps gl) in
+  let cl0 = pf_concl gl in
+  let dtac gl =
+    let c = pf_concl gl in
+    let gl, args, c =
+      List.fold_right (abs_wgen true mk_discharged_id) gens (gl,[], c) in
+    apply_type c args gl in
+  let endtac =
+    let id_map = CList.map_filter (function
+      | _, Some ((x,_),_) -> let id = hoi_id x in Some (mk_discharged_id id, id)
+      | _, None -> None) gens in
+    endclausestac id_map clseq gl_id cl0 in
+  Tacticals.tclTHENLIST (hidetacs clseq gl_id cl0 @ [dtac; clear; tac; endtac]) gl
+
+(** The "do" tactical. ********************************************************)
+
+let hinttac ist is_by (is_or, atacs) =
+  let dtac = if is_by then donetac ~-1 else Tacticals.tclIDTAC in
+  let mktac = function
+  | Some atac -> Tacticals.tclTHEN (Proofview.V82.of_tactic (ssrevaltac ist atac)) dtac
+  | _ -> dtac in
+  match List.map mktac atacs with
+  | [] -> if is_or then dtac else Tacticals.tclIDTAC
+  | [tac] -> tac
+  | tacs -> Tacticals.tclFIRST tacs
+
+let ssrdotac ist (((n, m), tac), clauses) =
+  let mul = get_index n, m in
+  tclCLAUSES (tclMULT mul (hinttac ist false tac)) clauses
+
+let tclCLAUSES tac g_c =
+  Proofview.V82.(tactic (tclCLAUSES (of_tactic tac) g_c))
diff --git a/plugins/ssr/ssrtacticals.mli b/plugins/ssr/ssrtacticals.mli
new file mode 100644
index 00000000..a5636ad0
--- /dev/null
+++ b/plugins/ssr/ssrtacticals.mli
@@ -0,0 +1,48 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Ltac_plugin
+open Ssrmatching_plugin
+
+val tclSEQAT :
+  Tacinterp.interp_sign ->
+  Tacinterp.Value.t ->
+  Ssrast.ssrdir ->
+  int Misctypes.or_var *
+    (('a * Tacinterp.Value.t option list) *
+       Tacinterp.Value.t option) ->
+  Tacmach.tactic
+
+val tclCLAUSES :
+  unit Proofview.tactic ->
+  (Ssrast.ssrhyps *
+     ((Ssrast.ssrhyp_or_id * string) *
+        Ssrmatching.cpattern option)
+       option)
+    list * Ssrast.ssrclseq ->
+  unit Proofview.tactic
+
+val hinttac :
+           Tacinterp.interp_sign ->
+           bool -> bool * Tacinterp.Value.t option list -> Ssrast.v82tac
+
+val ssrdotac :
+  Tacinterp.interp_sign ->
+  ((int Misctypes.or_var * Ssrast.ssrmmod) *
+     (bool * Tacinterp.Value.t option list)) *
+    ((Ssrast.ssrhyps *
+        ((Ssrast.ssrhyp_or_id * string) *
+           Ssrmatching.cpattern option)
+          option)
+       list * Ssrast.ssrclseq) ->
+  Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
+
diff --git a/plugins/ssr/ssrvernac.ml4 b/plugins/ssr/ssrvernac.ml4
new file mode 100644
index 00000000..05dbf0a8
--- /dev/null
+++ b/plugins/ssr/ssrvernac.ml4
@@ -0,0 +1,627 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+open Names
+module CoqConstr = Constr
+open CoqConstr
+open Termops
+open Constrexpr
+open Constrexpr_ops
+open Pcoq
+open Pcoq.Prim
+open Pcoq.Constr
+open Pcoq.Vernac_
+open Ltac_plugin
+open Notation_ops
+open Notation_term
+open Glob_term
+open Globnames
+open Stdarg
+open Genarg
+open Misctypes
+open Decl_kinds
+open Libnames
+open Pp
+open Ppconstr
+open Printer
+open Util
+open Extraargs
+open Evar_kinds
+open Ssrprinters
+open Ssrcommon
+open Ssrparser
+DECLARE PLUGIN "ssreflect_plugin"
+
+let (!@) = Pcoq.to_coqloc
+
+(* Defining grammar rules with "xx" in it automatically declares keywords too,
+ * we thus save the lexer to restore it at the end of the file *)
+let frozen_lexer = CLexer.get_keyword_state () ;;
+
+(* global syntactic changes and vernacular commands *)
+
+(** Alternative notations for "match" and anonymous arguments. *)(* {{{ ************)
+
+(* Syntax:                                                        *)
+(*  if <term> is <pattern> then ... else ...                      *)
+(*  if <term> is <pattern> [in ..] return ... then ... else ...   *)
+(*  let: <pattern> := <term> in ...                               *)
+(*  let: <pattern> [in ...] := <term> return ... in ...           *)
+(* The scope of a top-level 'as' in the pattern extends over the  *)
+(* 'return' type (dependent if/let).                              *)
+(* Note that the optional "in ..." appears next to the <pattern>  *)
+(* rather than the <term> in then "let:" syntax. The alternative  *)
+(* would lead to ambiguities in, e.g.,                            *)
+(* let: p1 := (*v---INNER LET:---v *)                             *)
+(*   let: p2 := let: p3 := e3 in k return t in k2 in k1 return t' *)
+(* in b       (*^--ALTERNATIVE INNER LET--------^ *)              *)
+
+(* Caveat : There is no pretty-printing support, since this would *)
+(* require a modification to the Coq kernel (adding a new match   *)
+(* display style -- why aren't these strings?); also, the v8.1    *)
+(* pretty-printer only allows extension hooks for printing        *)
+(* integer or string literals.                                    *)
+(*   Also note that in the v8 grammar "is" needs to be a keyword; *)
+(* as this can't be done from an ML extension file, the new       *)
+(* syntax will only work when ssreflect.v is imported.            *)
+
+let no_ct = None, None and no_rt = None in 
+let aliasvar = function
+  | [[{ 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 = (CAst.make ?loc (mp, c)), ct, rt in
+let mk_let ?loc rt ct mp c1 =
+  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 -> [[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" -> [[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 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
+    | "let"; ":"; mp = ssr_mpat; ":="; c = lconstr;
+      rt = ssr_rtype; "in"; c1 = lconstr ->
+      mk_let ~loc:!@loc rt [mk_pat c (mk_cnotype mp)] mp c1
+    | "let"; ":"; mp = ssr_mpat; "in"; t = pattern; ":="; c = lconstr;
+      rt = ssr_rtype; "in"; c1 = lconstr ->
+      mk_let ~loc:!@loc rt [mk_pat c (mk_ctype mp t)] mp c1
+  ] ];
+END
+
+GEXTEND Gram
+  GLOBAL: closed_binder;
+  closed_binder: [
+    [ ["of" | "&"]; c = operconstr LEVEL "99" ->
+      [CLocalAssum ([CAst.make ~loc:!@loc Anonymous], Default Explicit, c)]
+  ] ];
+END
+(* }}} *)
+
+(** Vernacular commands: Prenex Implicits and Search *)(* {{{ **********************)
+
+(* This should really be implemented as an extension to the implicit   *)
+(* arguments feature, but unfortuately that API is sealed. The current *)
+(* workaround uses a combination of notations that works reasonably,   *)
+(* with the following caveats:                                         *)
+(*  - The pretty-printing always elides prenex implicits, even when    *)
+(*    they are obviously needed.                                       *)
+(*  - Prenex Implicits are NEVER exported from a module, because this  *)
+(*    would lead to faulty pretty-printing and scoping errors.         *)
+(*  - The command "Import Prenex Implicits" can be used to reassert    *)
+(*    Prenex Implicits for all the visible constants that had been     *)
+(*    declared as Prenex Implicits.                                    *)
+
+let declare_one_prenex_implicit locality f =
+  let fref =
+    try Smartlocate.global_with_alias f 
+    with _ -> errorstrm (pr_reference f ++ str " is not declared") in
+  let rec loop = function
+  | a :: args' when Impargs.is_status_implicit a ->
+    (ExplByName (Impargs.name_of_implicit a), (true, true, true)) :: loop args'
+  | args' when List.exists Impargs.is_status_implicit args' ->
+      errorstrm (str "Expected prenex implicits for " ++ pr_reference f)
+  | _ -> [] in
+  let impls =
+    match Impargs.implicits_of_global fref  with
+    | [cond,impls] -> impls
+    | [] -> errorstrm (str "Expected some implicits for " ++ pr_reference f)
+    | _ -> errorstrm (str "Multiple implicits not supported") in
+  match loop impls  with
+  | [] ->
+    errorstrm (str "Expected some implicits for " ++ pr_reference f)
+  | impls ->
+    Impargs.declare_manual_implicits locality fref ~enriching:false [impls]
+
+VERNAC COMMAND FUNCTIONAL EXTEND Ssrpreneximplicits CLASSIFIED AS SIDEFF
+  | [ "Prenex" "Implicits" ne_global_list(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 *)
+
+GEXTEND Gram
+  GLOBAL: gallina_ext;
+  gallina_ext:
+   [ [ IDENT "Import"; IDENT "Prenex"; IDENT "Implicits" ->
+      Vernacexpr.VernacUnsetOption (false, ["Printing"; "Implicit"; "Defensive"])
+   ] ]
+  ;
+END
+
+(** Extend Search to subsume SearchAbout, also adding hidden Type coercions. *)
+
+(* Main prefilter *)
+
+type raw_glob_search_about_item =
+  | RGlobSearchSubPattern of constr_expr
+  | RGlobSearchString of Loc.t * string * string option
+
+let pr_search_item = function
+  | RGlobSearchString (_,s,_) -> str s
+  | RGlobSearchSubPattern p -> pr_constr_expr p
+
+let wit_ssr_searchitem = add_genarg "ssr_searchitem" pr_search_item
+
+let pr_ssr_search_item _ _ _ = pr_search_item
+
+(* Workaround the notation API that can only print notations *)
+
+let is_ident s = try CLexer.check_ident s; true with _ -> false
+
+let is_ident_part s = is_ident ("H" ^ s)
+
+let interp_search_notation ?loc tag okey =
+  let err msg = CErrors.user_err ?loc ~hdr:"interp_search_notation" msg in
+  let mk_pntn s for_key =
+    let n = String.length s in
+    let s' = Bytes.make (n + 2) ' ' in
+    let rec loop i i' =
+      if i >= n then s', i' - 2 else if s.[i] = ' ' then loop (i + 1) i' else
+      let j = try String.index_from s (i + 1) ' ' with _ -> n in
+      let m = j - i in
+      if s.[i] = '\'' && i < j - 2 && s.[j - 1] = '\'' then
+        (String.blit s (i + 1) s' i' (m - 2); loop (j + 1) (i' + m - 1))
+      else if for_key && is_ident (String.sub s i m) then
+         (Bytes.set s' i' '_'; loop (j + 1) (i' + 2))
+      else (String.blit s i s' i' m; loop (j + 1) (i' + m + 1)) in
+    loop 0 1 in
+  let trim_ntn (pntn, m) = Bytes.sub_string pntn 1 (max 0 m) in
+  let pr_ntn ntn = str "(" ++ str ntn ++ str ")" in
+  let pr_and_list pr = function
+    | [x] -> pr x
+    | x :: lx -> pr_list pr_comma pr lx ++ pr_comma () ++ str "and " ++ pr x
+    | [] -> mt () in
+  let pr_sc sc = str (if sc = "" then "independently" else sc) in
+  let pr_scs = function
+    | [""] -> pr_sc ""
+    | scs -> str "in " ++ pr_and_list pr_sc scs in
+  let generator, pr_tag_sc =
+    let ign _ = mt () in match okey with
+  | Some key ->
+    let sc = Notation.find_delimiters_scope ?loc key in
+    let pr_sc s_in = str s_in ++ spc() ++ str sc ++ pr_comma() in
+    Notation.pr_scope ign sc, pr_sc
+  | None -> Notation.pr_scopes ign, ign in
+  let qtag s_in = pr_tag_sc s_in ++ qstring tag ++ spc()in
+  let ptag, ttag =
+    let ptag, m = mk_pntn tag false in
+    if m <= 0 then err (str "empty notation fragment");
+    ptag, trim_ntn (ptag, m) in
+  let last = ref "" and last_sc = ref "" in
+  let scs = ref [] and ntns = ref [] in
+  let push_sc sc = match !scs with
+  | "" :: scs' ->  scs := "" :: sc :: scs'
+  | scs' -> scs := sc :: scs' in
+  let get s _ _ = match !last with
+  | "Scope " -> last_sc := s; last := ""
+  | "Lonely notation" -> last_sc := ""; last := ""
+  | "\"" ->
+      let pntn, m = mk_pntn s true in
+      if String.string_contains ~where:(Bytes.to_string pntn) ~what:(Bytes.to_string ptag) then begin
+        let ntn = trim_ntn (pntn, m) in
+        match !ntns with
+        | [] -> ntns := [ntn]; scs := [!last_sc]
+        | ntn' :: _ when ntn' = ntn -> push_sc !last_sc
+        | _ when ntn = ttag -> ntns := ntn :: !ntns; scs := [!last_sc]
+        | _ :: ntns' when List.mem ntn ntns' -> ()
+        | ntn' :: ntns' -> ntns := ntn' :: ntn :: ntns'
+      end;
+      last := ""
+  | _ -> last := s in
+  pp_with (Format.make_formatter get (fun _ -> ())) generator;
+  let ntn = match !ntns with
+  | [] ->
+    err (hov 0 (qtag "in" ++ str "does not occur in any notation"))
+  | ntn :: ntns' when ntn = ttag ->
+    if ntns' <> [] then begin
+      let pr_ntns' = pr_and_list pr_ntn ntns' in
+      Feedback.msg_warning (hov 4 (qtag "In" ++ str "also occurs in " ++ pr_ntns'))
+    end; ntn
+  | [ntn] ->
+    Feedback.msg_info (hov 4 (qtag "In" ++ str "is part of notation " ++ pr_ntn ntn)); ntn
+  | ntns' ->
+    let e = str "occurs in" ++ spc() ++ pr_and_list pr_ntn ntns' in
+    err (hov 4 (str "ambiguous: " ++ qtag "in" ++ e)) in
+  let (nvars, body), ((_, pat), osc) = match !scs with
+  | [sc] -> Notation.interp_notation ?loc ntn (None, [sc])
+  | scs' ->
+    try Notation.interp_notation ?loc ntn (None, []) with _ ->
+    let e = pr_ntn ntn ++ spc() ++ str "is defined " ++ pr_scs scs' in
+    err (hov 4 (str "ambiguous: " ++ pr_tag_sc "in" ++ e)) in
+  let sc = Option.default "" osc in
+  let _ =
+    let m_sc =
+      if osc <> None then str "In " ++ str sc ++ pr_comma() else mt() in
+    let ntn_pat = trim_ntn (mk_pntn pat false) in
+    let rbody = glob_constr_of_notation_constr ?loc body in
+    let m_body = hov 0 (Constrextern.without_symbols prl_glob_constr rbody) in
+    let m = m_sc ++ pr_ntn ntn_pat ++ spc () ++ str "denotes " ++ m_body in
+    Feedback.msg_info (hov 0 m) in
+  if List.length !scs > 1 then
+    let scs' = List.remove (=) sc !scs in
+    let w = pr_ntn ntn ++ str " is also defined " ++ pr_scs scs' in
+    Feedback.msg_warning (hov 4 w)
+  else if String.string_contains ~where:ntn ~what:" .. " then
+    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 -> DAst.make ?loc @@ GPatVar (FirstOrderPatVar x)
+  | c ->
+    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
+
+ARGUMENT EXTEND ssr_search_item TYPED AS ssr_searchitem
+  PRINTED BY pr_ssr_search_item
+  | [ string(s) ] -> [ RGlobSearchString (loc,s,None) ]
+  | [ string(s) "%" preident(key) ] -> [ RGlobSearchString (loc,s,Some key) ]
+  | [ constr_pattern(p) ] -> [ RGlobSearchSubPattern p ]
+END
+
+let pr_ssr_search_arg _ _ _ =
+  let pr_item (b, p) = str (if b then "-" else "") ++ pr_search_item p in
+  pr_list spc pr_item
+
+ARGUMENT EXTEND ssr_search_arg TYPED AS (bool * ssr_searchitem) list
+  PRINTED BY pr_ssr_search_arg
+  | [ "-" ssr_search_item(p) ssr_search_arg(a) ] -> [ (false, p) :: a ]
+  | [ ssr_search_item(p) ssr_search_arg(a) ] -> [ (true, p) :: a ]
+  | [ ] -> [ [] ]
+END
+
+(* Main type conclusion pattern filter *)
+
+let rec splay_search_pattern na = function 
+  | Pattern.PApp (fp, args) -> splay_search_pattern (na + Array.length args) fp
+  | Pattern.PLetIn (_, _, _, bp) -> splay_search_pattern na bp
+  | Pattern.PRef hr -> hr, na
+  | _ -> CErrors.user_err (Pp.str "no head constant in head search pattern")
+
+let push_rels_assum l e =
+  let l = List.map (fun (n,t) -> n, EConstr.Unsafe.to_constr t) l in
+  push_rels_assum l e
+
+let coerce_search_pattern_to_sort hpat =
+  let env = Global.env () in
+  let sigma = Evd.(from_env env) in
+  let mkPApp fp n_imps args =
+    let args' = Array.append (Array.make n_imps (Pattern.PMeta None)) args in
+    Pattern.PApp (fp, args') in
+  let hr, na = splay_search_pattern 0 hpat in
+  let dc, ht =
+    let hr, _ = Global.type_of_global_in_context (Global.env ()) hr (** FIXME *) in
+    Reductionops.splay_prod env sigma (EConstr.of_constr hr) in
+  let np = List.length dc in
+  if np < na then CErrors.user_err (Pp.str "too many arguments in head search pattern") else
+  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_env env sigma hpat') in
+  if EConstr.isSort sigma ht then begin warn (); true, hpat' end else
+  let filter_head, coe_path =
+    try 
+      let _, cp =
+        Classops.lookup_path_to_sort_from (push_rels_assum dc env) sigma ht in
+      warn ();
+      true, cp
+    with _ -> false, [] in
+  let coerce hp coe_index =
+    let coe = Classops.get_coercion_value coe_index in
+    try
+      let coe_ref = global_of_constr coe in
+      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_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 CoqConstr.kind c with
+  | Cast (c', _, _) -> loop c'
+  | Prod (_, _, c') -> loop c'
+  | LetIn (_, _, _, c') -> loop c'
+  | _ -> Constr_matching.is_matching (Global.env()) Evd.empty p (EConstr.of_constr c) in
+  filter_head, loop
+
+let all_true _ = true
+
+let rec interp_search_about args accu = match args with
+| [] -> accu
+| (flag, arg) :: rem ->
+  fun gr env typ ->
+    let ans = Search.search_about_filter arg gr env typ in
+    (if flag then ans else not ans) && interp_search_about rem accu gr env typ
+
+let interp_search_arg arg =
+  let arg = List.map (fun (x,arg) -> x, match arg with
+  | RGlobSearchString (loc,s,key) ->
+      if is_ident_part s then Search.GlobSearchString s else
+      interp_search_notation ~loc s key
+  | RGlobSearchSubPattern p ->
+      try
+        let env = Global.env () in
+        let _, p = Constrintern.intern_constr_pattern env (Evd.from_env env) p in
+        Search.GlobSearchSubPattern p
+      with e -> let e = CErrors.push e in iraise (ExplainErr.process_vernac_interp_error e)) arg in
+  let hpat, a1 = match arg with
+  | (_, Search.GlobSearchSubPattern (Pattern.PMeta _)) :: a' -> all_true, a'
+  | (true, Search.GlobSearchSubPattern p) :: a' ->
+     let filter_head, p = interp_head_pat p in
+     if filter_head then p, a' else all_true, arg
+  | _ -> all_true, arg in
+  let is_string =
+    function (_, Search.GlobSearchString _) -> true | _ -> false in
+  let a2, a3 = List.partition is_string a1 in
+  interp_search_about (a2 @ a3) (fun gr env typ -> hpat typ)
+
+(* Module path postfilter *)
+
+let pr_modloc (b, m) = if b then str "-" ++ pr_reference m else pr_reference m
+
+let wit_ssrmodloc = add_genarg "ssrmodloc" pr_modloc
+
+let pr_ssr_modlocs _ _ _ ml =
+  if ml = [] then str "" else spc () ++ str "in " ++ pr_list spc pr_modloc ml
+
+ARGUMENT EXTEND ssr_modlocs TYPED AS ssrmodloc list PRINTED BY pr_ssr_modlocs
+  | [ ] -> [ [] ]
+END
+
+GEXTEND Gram
+  GLOBAL: ssr_modlocs;
+  modloc: [[ "-"; m = global -> true, m | m = global -> false, m]];
+  ssr_modlocs: [[ "in"; ml = LIST1 modloc -> ml ]];
+END
+
+let interp_modloc mr =
+  let interp_mod (_, mr) =
+    let {CAst.loc=loc; v=qid} = qualid_of_reference mr in
+    try Nametab.full_name_module qid with Not_found ->
+    CErrors.user_err ?loc (str "No Module " ++ pr_qualid qid) in
+  let mr_out, mr_in = List.partition fst mr in
+  let interp_bmod b = function
+  | [] -> fun _ _ _ -> true
+  | rmods -> Search.module_filter (List.map interp_mod rmods, b) in
+  let is_in = interp_bmod false mr_in and is_out = interp_bmod true mr_out in
+  fun gr env typ -> is_in gr env typ && is_out gr env typ
+
+(* The unified, extended vernacular "Search" command *)
+
+let ssrdisplaysearch gr env t =
+  let pr_res = pr_global gr ++ spc () ++ str " " ++ pr_lconstr_env env Evd.empty t in
+  Feedback.msg_info (hov 2 pr_res ++ fnl ())
+
+VERNAC COMMAND EXTEND SsrSearchPattern CLASSIFIED AS QUERY
+| [ "Search" ssr_search_arg(a) ssr_modlocs(mr) ] ->
+  [ let hpat = interp_search_arg a in
+    let in_mod = interp_modloc mr in
+    let post_filter gr env typ = in_mod gr env typ && hpat gr env typ in
+    let display gr env typ =
+      if post_filter gr env typ then ssrdisplaysearch gr env typ
+    in
+    Search.generic_search None display ]
+END
+
+(* }}} *)
+
+(** View hint database and View application. *)(* {{{ ******************************)
+
+(* There are three databases of lemmas used to mediate the application  *)
+(* of reflection lemmas: one for forward chaining, one for backward     *)
+(* chaining, and one for secondary backward chaining.                   *)
+
+(* View hints *)
+
+let pr_raw_ssrhintref prc _ _ = let open CAst in function
+  | { v = CAppExpl ((None, r,x), args) } when isCHoles args ->
+    prc (CAst.make @@ CRef (r,x)) ++ str "|" ++ int (List.length args)
+  | { v = CApp ((_, { v = CRef _ }), _) } as c -> prc c
+  | { v = CApp ((_, c), args) } when isCxHoles args ->
+    prc c ++ str "|" ++ int (List.length args)
+  | c -> prc 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
+
+let pr_ssrhintref prc _ _ = prc
+
+let mkhintref ?loc c n = match c.CAst.v with
+  | CRef (r,x) -> CAst.make ?loc @@ CAppExpl ((None, r, x), mkCHoles ?loc n)
+  | _ -> mkAppC (c, mkCHoles ?loc n)
+
+ARGUMENT EXTEND ssrhintref
+                             PRINTED BY pr_ssrhintref
+    RAW_TYPED AS constr  RAW_PRINTED BY pr_raw_ssrhintref
+   GLOB_TYPED AS constr GLOB_PRINTED BY pr_glob_ssrhintref
+  | [ constr(c) ] -> [ c ]
+  | [ constr(c) "|" natural(n) ] -> [ mkhintref ~loc c n ]
+END
+
+(* View purpose *)
+
+let pr_viewpos = function
+  | Some Ssrview.AdaptorDb.Forward -> str " for move/"
+  | Some Ssrview.AdaptorDb.Backward -> str " for apply/"
+  | Some Ssrview.AdaptorDb.Equivalence -> str " for apply//"
+  | None -> mt ()
+
+let pr_ssrviewpos _ _ _ = pr_viewpos
+
+ARGUMENT EXTEND ssrviewpos PRINTED BY pr_ssrviewpos
+  | [ "for" "move" "/" ] -> [ Some Ssrview.AdaptorDb.Forward ]
+  | [ "for" "apply" "/" ] -> [ Some Ssrview.AdaptorDb.Backward ]
+  | [ "for" "apply" "/" "/" ] -> [ Some Ssrview.AdaptorDb.Equivalence ]
+  | [ "for" "apply" "//" ] -> [ Some Ssrview.AdaptorDb.Equivalence ]
+  | [ ] -> [ None ]
+END
+
+let pr_ssrviewposspc _ _ _ i = pr_viewpos i ++ spc ()
+
+ARGUMENT EXTEND ssrviewposspc TYPED AS ssrviewpos PRINTED BY pr_ssrviewposspc
+  | [ ssrviewpos(i) ] -> [ i ]
+END
+
+let print_view_hints kind l =
+  let pp_viewname = str "Hint View" ++ pr_viewpos (Some kind) ++ str " " in
+  let pp_hints = pr_list spc pr_rawhintref l in
+  Feedback.msg_info  (pp_viewname ++ hov 0 pp_hints ++ Pp.cut ())
+
+VERNAC COMMAND EXTEND PrintView CLASSIFIED AS QUERY
+| [ "Print" "Hint" "View" ssrviewpos(i) ] ->
+  [ match i with
+    | Some k -> print_view_hints k (Ssrview.AdaptorDb.get k)
+    | None ->
+        List.iter (fun k -> print_view_hints k (Ssrview.AdaptorDb.get k))
+          [ Ssrview.AdaptorDb.Forward;
+            Ssrview.AdaptorDb.Backward;
+            Ssrview.AdaptorDb.Equivalence ]
+  ]
+END
+
+let glob_view_hints lvh =
+  List.map (Constrintern.intern_constr (Global.env ()) (Evd.from_env (Global.env ()))) lvh
+
+VERNAC COMMAND EXTEND HintView CLASSIFIED AS SIDEFF
+  |  [ "Hint" "View" ssrviewposspc(n) ne_ssrhintref_list(lvh) ] ->
+     [ let hints = glob_view_hints lvh in
+       match n with
+       | None ->
+          Ssrview.AdaptorDb.declare Ssrview.AdaptorDb.Forward hints;
+          Ssrview.AdaptorDb.declare Ssrview.AdaptorDb.Backward hints
+       | Some k ->
+          Ssrview.AdaptorDb.declare k hints ]
+END
+
+(* }}} *)
+
+(** Canonical Structure alias *)
+
+GEXTEND Gram
+  GLOBAL: gallina_ext;
+
+  gallina_ext:
+      (* Canonical structure *)
+     [[ IDENT "Canonical"; qid = Constr.global ->
+          Vernacexpr.VernacCanonical (CAst.make @@ AN qid)
+      | IDENT "Canonical"; ntn = Prim.by_notation ->
+          Vernacexpr.VernacCanonical (CAst.make @@ ByNotation ntn)
+      | IDENT "Canonical"; qid = Constr.global;
+          d = G_vernac.def_body ->
+          let s = coerce_reference_to_id qid in
+    Vernacexpr.VernacDefinition
+      ((Decl_kinds.NoDischarge,Decl_kinds.CanonicalStructure),
+          ((CAst.make (Name s)),None), d)
+  ]];
+END
+
+(** Keyword compatibility fixes. *)
+
+(* Coq v8.1 notation uses "by" and "of" quasi-keywords, i.e., reserved *)
+(* identifiers used as keywords. This is incompatible with ssreflect.v *)
+(* which makes "by" and "of" true keywords, because of technicalities  *)
+(* in the internal lexer-parser API of Coq. We patch this here by      *)
+(* adding new parsing rules that recognize the new keywords.           *)
+(*   To make matters worse, the Coq grammar for tactics fails to       *)
+(* export the non-terminals we need to patch. Fortunately, the CamlP5  *)
+(* API provides a backdoor access (with loads of Obj.magic trickery).  *)
+
+(* Coq v8.3 defines "by" as a keyword, some hacks are not needed any   *)
+(* longer and thus comment out. Such comments are marked with v8.3     *)
+
+open Pltac
+
+GEXTEND Gram
+  GLOBAL: hypident;
+  hypident: [
+  [ "("; IDENT "type"; "of"; id = Prim.identref; ")" -> id, Locus.InHypTypeOnly
+  | "("; IDENT "value"; "of"; id = Prim.identref; ")" -> id, Locus.InHypValueOnly
+  ] ];
+END
+
+GEXTEND Gram
+  GLOBAL: hloc;
+hloc: [
+  [ "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
+
+GEXTEND Gram
+  GLOBAL: constr_eval;
+  constr_eval: [
+    [ IDENT "type"; "of"; c = Constr.constr -> Genredexpr.ConstrTypeOf c ]
+  ];
+END
+
+(* We wipe out all the keywords generated by the grammar rules we defined. *)
+(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
+(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
+(* consequence the extended ssreflect grammar.                             *)
+let () = CLexer.set_keyword_state frozen_lexer ;;
+
+(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrvernac.mli b/plugins/ssr/ssrvernac.mli
new file mode 100644
index 00000000..aa6e02d3
--- /dev/null
+++ b/plugins/ssr/ssrvernac.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
diff --git a/plugins/ssr/ssrview.ml b/plugins/ssr/ssrview.ml
new file mode 100644
index 00000000..aa614fbc
--- /dev/null
+++ b/plugins/ssr/ssrview.ml
@@ -0,0 +1,332 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Util
+open Names
+
+open Ltac_plugin
+
+open Proofview
+open Notations
+
+open Ssrcommon
+open Ssrast
+
+module AdaptorDb = struct
+
+  type kind = Forward | Backward | Equivalence
+
+  module AdaptorKind = struct
+    type t = kind
+    let compare = Pervasives.compare
+  end
+  module AdaptorMap = Map.Make(AdaptorKind)
+
+  let term_view_adaptor_db =
+    Summary.ref ~name:"view_adaptor_db" AdaptorMap.empty
+
+  let get k =
+    try AdaptorMap.find k !term_view_adaptor_db
+    with Not_found -> []
+
+  let cache_adaptor (_, (k, t)) =
+    let lk = get k in
+    if not (List.exists (Glob_ops.glob_constr_eq t) lk) then
+      term_view_adaptor_db := AdaptorMap.add k (t :: lk) !term_view_adaptor_db
+
+  let subst_adaptor ( subst, (k, t as a)) =
+    let t' = Detyping.subst_glob_constr subst t in
+    if t' == t then a else k, t'
+
+  let classify_adaptor x = Libobject.Substitute x
+
+  let in_db =
+    Libobject.declare_object {
+       (Libobject.default_object "VIEW_ADAPTOR_DB")
+    with
+       Libobject.open_function = (fun i o -> if i = 1 then cache_adaptor o);
+       Libobject.cache_function = cache_adaptor;
+       Libobject.subst_function = subst_adaptor;
+       Libobject.classify_function = classify_adaptor }
+
+  let declare kind terms =
+    List.iter (fun term -> Lib.add_anonymous_leaf (in_db (kind,term)))
+      (List.rev terms)
+
+end
+
+(* Forward View application code *****************************************)
+
+module State : sig
+
+  (* View storage API *)
+  val vsINIT    : EConstr.t -> unit tactic
+  val vsPUSH    : (EConstr.t -> EConstr.t tactic) -> unit tactic
+  val vsCONSUME : (Id.t option -> EConstr.t -> unit tactic) -> unit tactic
+  val vsASSERT_EMPTY : unit tactic
+
+end = struct (* {{{ *)
+
+type vstate = {
+  subject_name : Id.t option;   (* top *)
+    (* None if views are being applied to a term *)
+  view : EConstr.t;  (* v2 (v1 top) *)
+}
+
+include Ssrcommon.MakeState(struct
+  type state = vstate option
+  let init = None
+end)
+
+let vsINIT view = tclSET (Some { subject_name = None; view })
+
+let vsPUSH k =
+  tacUPDATE (fun s -> match s with
+  | Some { subject_name; view } ->
+      k view >>= fun view ->
+      tclUNIT (Some { subject_name; view })
+  | None ->
+      Goal.enter_one ~__LOC__ begin fun gl ->
+        let concl = Goal.concl gl in
+        let id = (* We keep the orig name for checks in "in" tcl *)
+          match EConstr.kind_of_type (Goal.sigma gl) concl with
+          | Term.ProdType(Name.Name id, _, _)
+            when Ssrcommon.is_discharged_id id -> id
+          | _ -> mk_anon_id "view_subject" (Tacmach.New.pf_ids_of_hyps gl) in
+        let view = EConstr.mkVar id in
+        Ssrcommon.tclINTRO_ID id <*>
+        k view >>= fun view ->
+        tclUNIT (Some { subject_name = Some id; view })
+      end)
+
+let vsCONSUME k =
+  tclGET (fun s -> match s with
+  | Some { subject_name; view } ->
+        tclSET None <*>
+        k subject_name view
+  | None -> anomaly "vsCONSUME: empty storage")
+
+let vsASSERT_EMPTY =
+  tclGET (function
+  | Some _ -> anomaly ("vsASSERT_EMPTY: not empty")
+  | _ -> tclUNIT ())
+
+end (* }}} *)
+
+let intern_constr_expr { Genintern.genv; ltacvars = vars } sigma ce =
+  let ltacvars = {
+    Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in
+  Constrintern.intern_gen Pretyping.WithoutTypeConstraint ~ltacvars genv sigma ce
+
+(* Disambiguation of /t
+    - t is ltac:(tactic args)
+    - t is a term
+   To allow for t being a notation, like "Notation foo x := ltac:(foo x)", we
+   need to internalize t.
+*)
+let is_tac_in_term { body; glob_env; interp_env } =
+  Goal.(enter_one ~__LOC__ begin fun goal ->
+    let genv = env goal in
+    let sigma = sigma goal in
+    let ist = Ssrcommon.option_assert_get glob_env (Pp.str"not a term") in
+    (* We use the env of the goal, not the global one *)
+    let ist = { ist with Genintern.genv } in
+    (* We unravel notations *)
+    let g = intern_constr_expr ist sigma body in
+    match DAst.get g with
+    | Glob_term.GHole (_,_, Some x)
+      when Genarg.has_type x (Genarg.glbwit Tacarg.wit_tactic)
+        -> tclUNIT (`Tac (Genarg.out_gen (Genarg.glbwit Tacarg.wit_tactic) x))
+    | _ -> tclUNIT (`Term (interp_env, g))
+end)
+
+(* To inject a constr into a glob_constr we use an Ltac variable *)
+let tclINJ_CONSTR_IST ist p =
+  let fresh_id = Ssrcommon.mk_internal_id "ssr_inj_constr_in_glob" in
+  let ist = {
+    ist with Geninterp.lfun =
+      Id.Map.add fresh_id (Taccoerce.Value.of_constr p) ist.Geninterp.lfun} in
+  tclUNIT (ist,Glob_term.GVar fresh_id)
+
+let mkGHole =
+  DAst.make
+    (Glob_term.GHole(Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None))
+let rec mkGHoles n = if n > 0 then mkGHole :: mkGHoles (n - 1) else []
+let mkGApp f args =
+  if args = [] then f
+  else DAst.make (Glob_term.GApp (f, args))
+
+(* From glob_constr to open_constr === (env,sigma,constr) *)
+let interp_glob ist glob = Goal.enter_one ~__LOC__ begin fun goal ->
+  let env = Goal.env goal in
+  let sigma = Goal.sigma goal in
+  Ssrprinters.ppdebug (lazy
+    Pp.(str"interp-in: " ++ Printer.pr_glob_constr_env env glob));
+  try
+    let sigma,term = Tacinterp.interp_open_constr ist env sigma (glob,None) in
+    Ssrprinters.ppdebug (lazy
+      Pp.(str"interp-out: " ++ Printer.pr_econstr_env env sigma term));
+    tclUNIT (env,sigma,term)
+  with e ->
+    Ssrprinters.ppdebug (lazy
+    Pp.(str"interp-err: " ++ Printer.pr_glob_constr_env env glob));
+     tclZERO e
+end
+
+(* Commits the term to the monad *)
+(* I think we should make the API safe by storing here the original evar map,
+ * so that one cannot commit it wrongly.
+ * We could also commit the term automatically, but this makes the code less
+ * modular, see the 2 functions below that would need to "uncommit" *)
+let tclKeepOpenConstr (_env, sigma, t) = Unsafe.tclEVARS sigma <*> tclUNIT t
+
+(* The ssr heuristic : *)
+(* Estimate a bound on the number of arguments of a raw constr. *)
+(* This is not perfect, because the unifier may fail to         *)
+(* typecheck the partial application, so we use a minimum of 5. *)
+(* Also, we don't handle delayed or iterated coercions to       *)
+(* FUNCLASS, which is probably just as well since these can     *)
+(* lead to infinite arities.                                    *)
+let guess_max_implicits ist glob =
+  Proofview.tclORELSE
+    (interp_glob ist (mkGApp glob (mkGHoles 6)) >>= fun (env,sigma,term) ->
+     let term_ty = Retyping.get_type_of env sigma term in
+     let ctx, _ = Reductionops.splay_prod env sigma term_ty in
+     tclUNIT (List.length ctx + 6))
+  (fun _ -> tclUNIT 5)
+
+let pad_to_inductive ist glob = Goal.enter_one ~__LOC__ begin fun goal ->
+  interp_glob ist glob >>= fun (env, sigma, term) ->
+  let term_ty = Retyping.get_type_of env sigma term in
+  let ctx, i = Reductionops.splay_prod env sigma term_ty in
+  let rel_ctx =
+    List.map (fun (a,b) -> Context.Rel.Declaration.LocalAssum(a,b)) ctx in
+  if Ssrcommon.isAppInd (EConstr.push_rel_context rel_ctx env) sigma i
+  then tclUNIT (mkGApp glob (mkGHoles (List.length ctx)))
+  else Tacticals.New.tclZEROMSG Pp.(str"not an inductive")
+end
+
+(* There are two ways of "applying" a view to term:            *)
+(*  1- using a view hint if the view is an instance of some    *)
+(*     (reflection) inductive predicate.                       *)
+(*  2- applying the view if it coerces to a function, adding   *)
+(*     implicit arguments.                                     *)
+(* They require guessing the view hints and the number of      *)
+(* implicits, respectively, which we do by brute force.        *)
+(* Builds v p *)
+let interp_view ist v p =
+  let is_specialize hd =
+    match DAst.get hd with Glob_term.GHole _ -> true | _ -> false in
+  (* We cast the pile of views p into a term p_id *)
+  tclINJ_CONSTR_IST ist p >>= fun (ist, p_id) ->
+  let p_id = DAst.make p_id in
+  match DAst.get v with
+  | Glob_term.GApp (hd, rargs) when is_specialize hd ->
+     Ssrprinters.ppdebug (lazy Pp.(str "specialize"));
+     interp_glob ist (mkGApp p_id rargs) >>= tclKeepOpenConstr
+  | _ ->
+     Ssrprinters.ppdebug (lazy Pp.(str "view"));
+     (* We find out how to build (v p) eventually using an adaptor *)
+     let adaptors = AdaptorDb.(get Forward) in
+     Proofview.tclORELSE
+       (pad_to_inductive ist v >>= fun vpad ->
+        Ssrcommon.tclFIRSTa (List.map
+          (fun a -> interp_glob ist (mkGApp a [vpad; p_id])) adaptors))
+       (fun _ ->
+        guess_max_implicits ist v >>= fun n ->
+        Ssrcommon.tclFIRSTi (fun n ->
+           interp_glob ist (mkGApp v (mkGHoles n @ [p_id]))) n)
+     >>= tclKeepOpenConstr
+
+(* we store in the state (v top), then (v1 (v2 top))... *)
+let pile_up_view (ist, v) =
+  let ist = Ssrcommon.option_assert_get ist (Pp.str"not a term") in
+  State.vsPUSH (fun p -> interp_view ist v p)
+
+let finalize_view s0 ?(simple_types=true) p =
+Goal.enter_one ~__LOC__ begin fun g ->
+  let env = Goal.env g in
+  let sigma = Goal.sigma g in
+  let evars_of_p = Evd.evars_of_term (EConstr.to_constr sigma p) in
+  let filter x _ = Evar.Set.mem x evars_of_p in
+  let sigma = Typeclasses.resolve_typeclasses ~fail:false ~filter env sigma in
+  let p = Reductionops.nf_evar sigma p in
+  let get_body = function Evd.Evar_defined x -> x | _ -> assert false in
+  let evars_of_econstr sigma t =
+    Evd.evars_of_term (EConstr.to_constr sigma (EConstr.of_constr t)) in
+  let rigid_of s =
+    List.fold_left (fun l k ->
+      if Evd.is_defined sigma k then
+        let bo = get_body Evd.(evar_body (find sigma k)) in
+          k :: l @ Evar.Set.elements (evars_of_econstr sigma bo)
+      else l
+    ) [] s in
+  let und0 = (* Unassigned evars in the initial goal *)
+    let sigma0 = Tacmach.project s0 in
+    let g0info = Evd.find sigma0 (Tacmach.sig_it s0) in
+    let g0 = Evd.evars_of_filtered_evar_info g0info in
+    List.filter (fun k -> Evar.Set.mem k g0)
+      (List.map fst (Evar.Map.bindings (Evd.undefined_map sigma0))) in
+  let rigid = rigid_of und0 in
+  let n, p, to_prune, _ucst = pf_abs_evars2 s0 rigid (sigma, p) in
+  let p = if simple_types then pf_abs_cterm s0 n p else p in
+  Ssrprinters.ppdebug (lazy Pp.(str"view@finalized: " ++
+    Printer.pr_econstr_env env sigma p));
+  let sigma = List.fold_left Evd.remove sigma to_prune in
+  Unsafe.tclEVARS sigma <*>
+  tclUNIT p
+end
+
+let pose_proof subject_name p =
+  Tactics.generalize [p] <*>
+  Option.cata
+    (fun id -> Ssrcommon.tclRENAME_HD_PROD (Name.Name id)) (tclUNIT())
+    subject_name
+  <*>
+  Tactics.New.reduce_after_refine
+
+let rec apply_all_views ending vs s0 =
+  match vs with
+  | [] -> ending s0
+  | v :: vs ->
+      Ssrprinters.ppdebug (lazy Pp.(str"piling..."));
+      is_tac_in_term v >>= function
+      | `Tac tac ->
+           Ssrprinters.ppdebug (lazy Pp.(str"..a tactic"));
+           ending s0 <*> Tacinterp.eval_tactic tac <*>
+           Ssrcommon.tacSIGMA >>= apply_all_views ending vs
+      | `Term v ->
+           Ssrprinters.ppdebug (lazy Pp.(str"..a term"));
+           pile_up_view v <*> apply_all_views ending vs s0
+
+(* Entry points *********************************************************)
+
+let tclIPAT_VIEWS ~views:vs ~conclusion:tac =
+  let end_view_application s0 =
+    State.vsCONSUME (fun name t ->
+      finalize_view s0 t >>= pose_proof name <*>
+      tac ~to_clear:(Option.cata (fun x -> [x]) [] name)) in
+  tclINDEPENDENT begin
+    State.vsASSERT_EMPTY <*>
+    Ssrcommon.tacSIGMA >>= apply_all_views end_view_application vs <*>
+    State.vsASSERT_EMPTY
+  end
+
+let tclWITH_FWD_VIEWS ~simple_types ~subject ~views:vs ~conclusion:tac =
+  let ending_tac s0 =
+    State.vsCONSUME (fun _ t -> finalize_view s0 ~simple_types t >>= tac) in
+  tclINDEPENDENT begin
+    State.vsASSERT_EMPTY <*>
+    State.vsINIT subject <*>
+    Ssrcommon.tacSIGMA >>= apply_all_views ending_tac vs <*>
+    State.vsASSERT_EMPTY
+  end
+
+(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrview.mli b/plugins/ssr/ssrview.mli
new file mode 100644
index 00000000..be51fe7f
--- /dev/null
+++ b/plugins/ssr/ssrview.mli
@@ -0,0 +1,39 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Ssrast
+
+(* Adaptor DB (Hint View) *)
+module AdaptorDb : sig
+
+  type kind = Forward | Backward | Equivalence
+
+  val get : kind -> Glob_term.glob_constr list
+  val declare : kind -> Glob_term.glob_constr list -> unit
+
+end
+
+(* Apply views to the top of the stack (intro pattern) *)
+val tclIPAT_VIEWS :
+    views:ast_closure_term list ->
+    conclusion:(to_clear:Names.Id.t list -> unit Proofview.tactic) ->
+  unit Proofview.tactic
+
+(* Apply views to a given subject (as if was the top of the stack), then
+   call conclusion on the obtained term (something like [v2 (v1 subject)]).
+   The term being passed to conclusion is abstracted over non-resolved evars:
+   if [simple_types] then all unnecessary dependencies among the abstracted
+   evars are pruned *)
+val tclWITH_FWD_VIEWS :
+  simple_types:bool ->
+    subject:EConstr.t ->
+    views:ast_closure_term list ->
+    conclusion:(EConstr.t -> unit Proofview.tactic) ->
+  unit Proofview.tactic
diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml4
index d21223d4..307bc21a 100644
--- a/plugins/ssrmatching/ssrmatching.ml4
+++ b/plugins/ssrmatching/ssrmatching.ml4
@@ -1,68 +1,55 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
 (* Defining grammar rules with "xx" in it automatically declares keywords too,
  * we thus save the lexer to restore it at the end of the file *)
-let frozen_lexer = CLexer.freeze () ;;
-
-(*i camlp4use: "pa_extend.cmo" i*)
-(*i camlp4deps: "grammar/grammar.cma" i*)
+let frozen_lexer = CLexer.get_keyword_state () ;;
 
+open Ltac_plugin
 open Names
 open Pp
-open Pcoq
 open Genarg
-open Constrarg
+open Stdarg
 open Term
+module CoqConstr = Constr
+open CoqConstr
+open Pcoq
+open Pcoq.Constr
 open Vars
-open Topconstr
 open Libnames
 open Tactics
 open Tacticals
 open Termops
-open Namegen
 open Recordops
 open Tacmach
-open Coqlib
 open Glob_term
 open Util
 open Evd
-open Extend
-open Goptions
 open Tacexpr
-open Proofview.Notations
 open Tacinterp
 open Pretyping
-open Constr
-open Tactic
-open Extraargs
 open Ppconstr
 open Printer
-
 open Globnames
 open Misctypes
 open Decl_kinds
 open Evar_kinds
 open Constrexpr
 open Constrexpr_ops
-open Notation_term
-open Notation_ops
-open Locus
-open Locusops
 
 DECLARE PLUGIN "ssrmatching_plugin"
 
-type loc = Loc.t
-let dummy_loc = Loc.ghost
-let errorstrm = CErrors.errorlabstrm "ssrmatching"
-let loc_error loc msg = CErrors.user_err_loc (loc, msg, str msg)
+let errorstrm = CErrors.user_err ~hdr:"ssrmatching"
+let loc_error loc msg = CErrors.user_err ?loc ~hdr:msg (str msg)
 let ppnl = Feedback.msg_info
 
 (* 0 cost pp function. Active only if env variable SSRDEBUG is set *)
@@ -76,27 +63,25 @@ let debug b =
   if b then pp_ref := ssr_pp else pp_ref := fun _ -> ()
 let _ =
   Goptions.declare_bool_option
-    { Goptions.optsync  = false;
-      Goptions.optname  = "ssrmatching debugging";
+    { Goptions.optname  = "ssrmatching debugging";
       Goptions.optkey   = ["Debug";"SsrMatching"];
       Goptions.optdepr  = false;
       Goptions.optread  = (fun _ -> !pp_ref == ssr_pp);
       Goptions.optwrite = debug }
 let pp s = !pp_ref s
 
-(** Utils {{{ *****************************************************************)
+(** Utils *)(* {{{ *****************************************************************)
 let env_size env = List.length (Environ.named_context env)
 let safeDestApp c =
-  match kind_of_term c with App (f, a) -> f, a | _ -> c, [| |]
-let get_index = function ArgArg i -> i | _ ->
-  CErrors.anomaly (str"Uninterpreted index")
+  match kind c with App (f, a) -> f, a | _ -> c, [| |]
 (* Toplevel constr must be globalized twice ! *)
-let glob_constr ist genv = function
-  | _, Some ce ->
+let glob_constr ist genv sigma t = match t, ist with
+  | (_, Some ce), Some ist ->
     let vars = Id.Map.fold (fun x _ accu -> Id.Set.add x accu) ist.lfun Id.Set.empty in
     let ltacvars = { Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in
-    Constrintern.intern_gen WithoutTypeConstraint ~ltacvars:ltacvars genv ce
-  | rc, None -> rc
+    Constrintern.intern_gen WithoutTypeConstraint ~ltacvars:ltacvars genv sigma ce
+  | (rc, None), _ -> rc
+  | (_, Some _), None -> CErrors.anomaly Pp.(str"glob_constr: term with no ist")
 
 (* Term printing utilities functions for deciding bracketing.  *)
 let pr_paren prx x = hov 1 (str "(" ++ prx x ++ str ")")
@@ -115,7 +100,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
@@ -126,8 +110,8 @@ let prl_glob_constr_and_expr = function
 let pr_glob_constr_and_expr = function
   | _, Some c -> pr_constr_expr c
   | c, None -> pr_glob_constr c
-let pr_term (k, c) = pr_guarded (guard_term k) pr_glob_constr_and_expr c
-let prl_term (k, c) = pr_guarded (guard_term k) prl_glob_constr_and_expr c
+let pr_term (k, c, _) = pr_guarded (guard_term k) pr_glob_constr_and_expr c
+let prl_term (k, c, _) = pr_guarded (guard_term k) prl_glob_constr_and_expr c
 
 (** Adding a new uninterpreted generic argument type *)
 let add_genarg tag pr =
@@ -147,39 +131,55 @@ let add_genarg tag pr =
 (** Constructors for cast type *)
 let dC t = CastConv t
 (** Constructors for constr_expr *)
-let isCVar = function CRef (Ident _, _) -> true | _ -> false
-let destCVar = function CRef (Ident (_, id), _) -> id | _ ->
-  CErrors.anomaly (str"not a CRef")
-let mkCHole loc = CHole (loc, None, IntroAnonymous, None)
-let mkCLambda loc name ty t = 
-   CLambdaN (loc, [[loc, name], Default Explicit, ty], t)
-let mkCLetIn loc name bo t = 
-   CLetIn (loc, (loc, name), bo, t)
-let mkCCast loc t ty = CCast (loc,t, dC ty)
+let isCVar   = function { CAst.v = CRef ({CAst.v=Ident _},_) } -> true | _ -> false
+let destCVar = function { CAst.v = CRef ({CAst.v=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 ([CLocalAssum([CAst.make ?loc name], Default Explicit, ty)], t)
+let mkCLetIn ?loc name bo t = CAst.make ?loc @@
+   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 = GHole (dummy_loc, InternalHole, IntroAnonymous, None)
-let mkRApp f args = if args = [] then f else GApp (dummy_loc, f, args)
-let mkRCast rc rt =  GCast (dummy_loc, rc, dC rt)
-let mkRLambda n s t = GLambda (dummy_loc, n, Explicit, s, t)
+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
- | (x, (t1, None)), (_, (t2, None)) -> x, (g t1 t2, None)
- | (x, (_, Some t1)), (_, (_, Some t2)) -> x, (mkRHole, Some (f t1 t2))
- | _, (_, (_, None)) -> CErrors.anomaly (str"have: mixed C-G constr")
- | _ -> CErrors.anomaly (str"have: mixed G-C constr")
+let combineCG t1 t2 f g =
+ let mk_ist i1 i2 = match i1, i2 with
+ | None, Some i -> Some i
+ | Some i, None -> Some i
+ | None, None -> None
+ | Some i, Some j when i == j -> Some i
+ | _ -> CErrors.anomaly (Pp.str "combineCG: different ist") in
+ match t1, t2 with
+ | (x, (t1, None), i1), (_, (t2, None), i2) ->
+      x, (g t1 t2, None), mk_ist i1 i2
+ | (x, (_, Some t1), i1), (_, (_, Some t2), i2) ->
+      x, (mkRHole, Some (f t1 t2)), mk_ist i1 i2
+ | _, (_, (_, None), _) -> CErrors.anomaly (str"have: mixed C-G constr.")
+ | _ -> CErrors.anomaly (str"have: mixed G-C constr.")
 let loc_ofCG = function
- | (_, (s, None)) -> Glob_ops.loc_of_glob_constr s
- | (_, (_, Some s)) -> Constrexpr_ops.constr_loc s
+ | (_, (s, None), _) -> Glob_ops.loc_of_glob_constr s
+ | (_, (_, Some s), _) -> Constrexpr_ops.constr_loc s
 
-let mk_term k c = k, (mkRHole, Some c)
+let mk_term k c ist = k, (mkRHole, Some c), ist
 let mk_lterm = mk_term ' '
 
 let pf_type_of gl t = let sigma, ty = pf_type_of gl t in re_sig (sig_it gl)  sigma, ty
 
+let nf_evar sigma c =
+  EConstr.Unsafe.to_constr (Evarutil.nf_evar sigma (EConstr.of_constr c))
+
 (* }}} *)
 
-(** Profiling {{{ *************************************************************)
+(** Profiling *)(* {{{ *************************************************************)
 type profiler = { 
   profile : 'a 'b. ('a -> 'b) -> 'a -> 'b;
   reset : unit -> unit;
@@ -195,8 +195,7 @@ let profile b =
 ;;
 let _ =
   Goptions.declare_bool_option
-    { Goptions.optsync  = false;
-      Goptions.optname  = "ssrmatching profiling";
+    { Goptions.optname  = "ssrmatching profiling";
       Goptions.optkey   = ["SsrMatchingProfiling"];
       Goptions.optread  = (fun _ -> !profile_now);
       Goptions.optdepr  = false;
@@ -297,14 +296,15 @@ let unif_EQ_args env sigma pa a =
   prof_unif_eq_args.profile (unif_EQ_args env sigma pa) a 
 ;;
 
-let unif_HO env ise p c = Evarconv.the_conv_x env p c ise
-
-let unif_HOtype env ise p c = Evarconv.the_conv_x_leq env p c ise
+let unif_HO env ise p c =
+  try Evarconv.the_conv_x env p c ise
+  with Evarconv.UnableToUnify(ise, err) ->
+    raise Pretype_errors.(PretypeError(env,ise,CannotUnify(p,c,Some err)))
 
 let unif_HO_args env ise0 pa i ca =
   let n = Array.length pa in
   let rec loop ise j =
-    if j = n then ise else loop (unif_HO env ise pa.(j) ca.(i + j)) (j + 1) in
+    if j = n then ise else loop (unif_HO env ise (EConstr.of_constr pa.(j)) (EConstr.of_constr ca.(i + j))) (j + 1) in
   loop ise0 0
 
 (* FO unification should boil down to calling w_unify with no_delta, but  *)
@@ -331,12 +331,13 @@ let flags_FO =
       (Unification.default_no_delta_unify_flags ()).Unification.resolve_evars
   }
 let unif_FO env ise p c =
-  Unification.w_unify env ise Reduction.CONV ~flags:flags_FO p c
+  Unification.w_unify env ise Reduction.CONV ~flags:flags_FO (EConstr.of_constr p) (EConstr.of_constr c)
 
 (* Perform evar substitution in main term and prune substitution. *)
 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
@@ -344,14 +345,14 @@ 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
     | Evar_defined c' -> s' := Evd.define k (nf c') !s'
     | _ -> () in
   let c' = nf c in let _ = Evd.fold copy_def sigma0 () in
-  !s', Evd.evar_universe_context s, c'
+  !s', Evd.evar_universe_context s, EConstr.of_constr c'
 
 let unif_end env sigma0 ise0 pt ok =
   let ise = Evarconv.solve_unif_constraints_with_heuristics env ise0 in
@@ -363,12 +364,7 @@ let unif_end env sigma0 ise0 pt ok =
   if ise2 == ise1 then (s, uc, t)
   else
     let s, uc', t = nf_open_term sigma0 ise2 t in
-    s, Evd.union_evar_universe_context uc uc', t
-
-let pf_unif_HO gl sigma pt p c =
-  let env = pf_env gl in
-  let ise = unif_HO env (create_evar_defs sigma) p c in
-  unif_end env (project gl) ise pt (fun _ -> true)
+    s, UState.union uc uc', t
 
 let unify_HO env sigma0 t1 t2 =
   let sigma = unif_HO env sigma0 t1 t2 in
@@ -381,7 +377,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
@@ -412,12 +408,12 @@ let inv_dir = function L2R -> R2L | R2L -> L2R
 type pattern_class =
   | KpatFixed
   | KpatConst
-  | KpatEvar of existential_key
+  | KpatEvar of Evar.t
   | KpatLet
   | KpatLam
   | KpatRigid
   | KpatFlex
-  | KpatProj of constant
+  | KpatProj of Constant.t
 
 type tpattern = {
   up_k : pattern_class;
@@ -426,7 +422,7 @@ type tpattern = {
   up_a : constr array;
   up_t : constr;                      (* equation proof term or matched term *)
   up_dir : ssrdir;                    (* direction of the rule *)
-  up_ok : constr -> evar_map -> bool; (* progess test for rewrite *)
+  up_ok : constr -> evar_map -> bool; (* progress test for rewrite *)
   }
 
 let all_ok _ _ = true
@@ -434,32 +430,27 @@ let all_ok _ _ = true
 let proj_nparams c =
   try 1 + Recordops.find_projection_nparams (ConstRef c) with _ -> 0
 
-let isFixed c = match kind_of_term c with
-  | Var _ | Ind _ | Construct _ | Const _ | Proj _ -> true
-  | _ -> false
-
-let isRigid c = match kind_of_term c with
+let isRigid c = match kind c with
   | Prod _ | Sort _ | Lambda _ | Case _ | Fix _ | CoFix _ -> true
   | _ -> false
 
-exception UndefPat
-
-let hole_var = mkVar (id_of_string "_")
+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
@@ -471,28 +462,30 @@ let evars_for_FO ~hack env sigma0 (ise0:evar_map) c0 =
       Context.Named.fold_inside abs_dc ~init:([], (put evi.evar_concl)) dc in
     let m = Evarutil.new_meta () in
     ise := meta_declare m t !ise;
-    sigma := Evd.define k (applist (mkMeta m, a)) !sigma;
+    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. *)
 (* p_origin can be passed to obtain a better error message     *)
 let mk_tpattern ?p_origin ?(hack=false) env sigma0 (ise, t) ok dir p =
   let k, f, a =
-    let f, a = Reductionops.whd_betaiota_stack ise p in
-    match kind_of_term f with
+    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 f with
     | Const (p,_) ->
       let np = proj_nparams p in
       if np = 0 || np > List.length a then KpatConst, f, a else
-      let a1, a2 = List.chop np a in KpatProj p, applist(f, a1), a2
+      let a1, a2 = List.chop np a in KpatProj p, (applistc f a1), a2
     | Proj (p,arg) -> KpatProj (Projection.constant p), f, a
     | Var _ | Ind _ | Construct _ -> KpatFixed, f, a
     | Evar (k, _) ->
       if Evd.mem sigma0 k then KpatEvar k, f, a else
       if a <> [] then KpatFlex, f, a else 
-      (match p_origin with None -> CErrors.error "indeterminate pattern"
+      (match p_origin with None -> CErrors.user_err Pp.(str "indeterminate pattern")
       | Some (dir, rule) ->
 	errorstrm (str "indeterminate " ++ pr_dir_side dir
           ++ str " in " ++ pr_constr_pat rule))
@@ -510,7 +503,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
@@ -522,37 +515,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, [| |]
@@ -561,8 +554,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 eq_constr_nounivs u.up_f f -> na
+  | KpatFixed when eq_constr_nounivs u.up_f f -> na
   | KpatEvar k when isEvar_k k f -> na
   | KpatLet when isLetIn f -> na
   | KpatLam when isLambda f -> na
@@ -574,7 +567,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
 
@@ -582,17 +575,17 @@ 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 -> eq_constr_nounivs u.up_f f
+  | KpatFixed -> eq_constr_nounivs 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
 
-exception FoundUnif of (evar_map * evar_universe_context * tpattern)
+exception FoundUnif of (evar_map * UState.t * tpattern)
 (* Note: we don't update env as we descend into the term, as the primitive *)
 (* unification procedure always rejects subterms with bound variables.     *)
 
@@ -638,17 +631,18 @@ let match_upats_FO upats env sigma0 ise orig_c =
            | _ -> unif_FO env ise u.up_FO c' in
            let ise' = (* Unify again using HO to assign evars *)
              let p = mkApp (u.up_f, u.up_a) in
-             try unif_HO env ise p c' with _ -> raise NoMatch in
+             try unif_HO env ise (EConstr.of_constr p) (EConstr.of_constr c') with e when CErrors.noncritical e -> raise NoMatch in
            let lhs = mkSubApp f i a in
-           let pt' = unif_end env sigma0 ise' u.up_t (u.up_ok lhs) in
+           let pt' = unif_end env sigma0 ise' (EConstr.of_constr u.up_t) (u.up_ok lhs) in
+           let pt' = pi1 pt', pi2 pt', EConstr.Unsafe.to_constr (pi3 pt') in
            raise (FoundUnif (ungen_upat lhs pt' u))
        with FoundUnif (s,_,_) as sig_u when dont_impact_evars s -> raise sig_u
-       | Not_found -> CErrors.anomaly (str"incomplete ise in match_upats_FO")
-       | _ -> () in
+       | Not_found -> CErrors.anomaly (str"incomplete ise in match_upats_FO.")
+       | e when CErrors.noncritical e -> () in
     List.iter one_match fpats
   done;
   iter_constr_LR loop f; Array.iter loop a in
-  try loop orig_c with Invalid_argument _ -> CErrors.anomaly (str"IN FO")
+  try loop orig_c with Invalid_argument _ -> CErrors.anomaly (str"IN FO.")
 
 let prof_FO = mk_profiler "match_upats_FO";;
 let match_upats_FO upats env sigma0 ise c =
@@ -657,7 +651,7 @@ let match_upats_FO upats env sigma0 ise c =
 
 
 let match_upats_HO ~on_instance upats env sigma0 ise c =
-  let dont_impact_evars = dont_impact_evars_in c in
+ let dont_impact_evars = dont_impact_evars_in c in
  let it_did_match = ref false in
  let failed_because_of_TC = ref false in
  let rec aux upats env sigma0 ise c =
@@ -679,16 +673,17 @@ let match_upats_HO ~on_instance upats env sigma0 ise c =
         | KpatLet ->
           let x, v, t, b = destLetIn f in
           let _, pv, _, pb = destLetIn u.up_f in
-          let ise' = unif_HO env ise pv v in
+          let ise' = unif_HO env ise (EConstr.of_constr pv) (EConstr.of_constr v) in
           unif_HO
             (Environ.push_rel (Context.Rel.Declaration.LocalAssum(x, t)) env)
-            ise' pb b
+            ise' (EConstr.of_constr pb) (EConstr.of_constr b)
         | KpatFlex | KpatProj _ ->
-          unif_HO env ise u.up_f (mkSubApp f (i - Array.length u.up_a) a)
-        | _ -> unif_HO env ise u.up_f f in
+          unif_HO env ise (EConstr.of_constr u.up_f) (EConstr.of_constr(mkSubApp f (i - Array.length u.up_a) a))
+        | _ -> unif_HO env ise (EConstr.of_constr u.up_f) (EConstr.of_constr f) in
         let ise'' = unif_HO_args env ise' u.up_a (i - Array.length u.up_a) a in
         let lhs = mkSubApp f i a in
-        let pt' = unif_end env sigma0 ise'' u.up_t (u.up_ok lhs) in
+        let pt' = unif_end env sigma0 ise'' (EConstr.of_constr u.up_t) (u.up_ok lhs) in
+        let pt' = pi1 pt', pi2 pt', EConstr.Unsafe.to_constr (pi3 pt') in
         on_instance (ungen_upat lhs pt' u)
       with FoundUnif (s,_,_) as sig_u when dont_impact_evars s -> raise sig_u
       | NoProgress -> it_did_match := true
@@ -713,27 +708,27 @@ let match_upats_HO ~on_instance upats env sigma0 ise c =
 
 let fixed_upat = function
 | {up_k = KpatFlex | KpatEvar _ | KpatProj _} -> false 
-| {up_t = t} -> not (occur_existential t)
+| {up_t = t} -> not (occur_existential Evd.empty (EConstr.of_constr t)) (** FIXME *)
 
 let do_once r f = match !r with Some _ -> () | None -> r := Some (f ())
 
 let assert_done r = 
-  match !r with Some x -> x | None -> CErrors.anomaly (str"do_once never called")
+  match !r with Some x -> x | None -> CErrors.anomaly (str"do_once never called.")
 
 let assert_done_multires r = 
   match !r with
-  | None -> CErrors.anomaly (str"do_once never called")
+  | None -> CErrors.anomaly (str"do_once never called.")
   | Some (n, xs) ->
       r := Some (n+1,xs);
       try List.nth xs n with Failure _ -> raise NoMatch
 
-type subst = Environ.env -> Term.constr -> Term.constr -> int -> Term.constr
+type subst = Environ.env -> constr -> constr -> int -> constr
 type find_P = 
-  Environ.env -> Term.constr -> int ->
+  Environ.env -> constr -> int ->
   k:subst ->
-     Term.constr
+     constr
 type conclude = unit ->
-  Term.constr * ssrdir * (Evd.evar_map * Evd.evar_universe_context * Term.constr)
+  constr * ssrdir * (Evd.evar_map * UState.t * constr)
 
 (* upats_origin makes a better error message only            *)
 let mk_tpattern_matcher ?(all_instances=false)
@@ -759,13 +754,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 -> eq_constr_nounivs u.up_f
+    | KpatConst -> eq_constr_nounivs 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
@@ -779,7 +774,7 @@ let source () = match upats_origin, upats with
   | Some (dir,rule), _ -> str"The " ++ pr_dir_side dir ++ str" of " ++ 
       pr_constr_pat rule ++ spc()
   | _, [] | None, _::_::_ ->
-      CErrors.anomaly (str"mk_tpattern_matcher with no upats_origin") in
+      CErrors.anomaly (str"mk_tpattern_matcher with no upats_origin.") in
 let on_instance, instances =
   let instances = ref [] in
   (fun x ->
@@ -789,15 +784,15 @@ let on_instance, instances =
 let rec uniquize = function
   | [] -> []
   | (sigma,_,{ up_f = f; up_a = a; up_t = t } as x) :: xs ->
-    let t = Reductionops.nf_evar sigma t in
-    let f = Reductionops.nf_evar sigma f in
-    let a = Array.map (Reductionops.nf_evar sigma) a in
+    let t = nf_evar sigma t in
+    let f = nf_evar sigma f in
+    let a = Array.map (nf_evar sigma) a in
     let neq (sigma1,_,{ up_f = f1; up_a = a1; up_t = t1 }) =
-      let t1 = Reductionops.nf_evar sigma1 t1 in
-      let f1 = Reductionops.nf_evar sigma1 f1 in
-      let a1 = Array.map (Reductionops.nf_evar sigma1) a1 in
-      not (Term.eq_constr t t1 &&
-           Term.eq_constr f f1 && CArray.for_all2 Term.eq_constr a a1) in
+      let t1 = nf_evar sigma1 t1 in
+      let f1 = nf_evar sigma1 f1 in
+      let a1 = Array.map (nf_evar sigma1) 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 -> 
@@ -817,7 +812,7 @@ let rec uniquize = function
         errorstrm (source () ++ str "does not match any subterm of the goal")
     | NoProgress when (not raise_NoMatch) ->
         let dir = match upats_origin with Some (d,_) -> d | _ ->
-          CErrors.anomaly (str"mk_tpattern_matcher with no upats_origin") in
+          CErrors.anomaly (str"mk_tpattern_matcher with no upats_origin.") in
         errorstrm (str"all matches of "++source()++
           str"are equal to the " ++ pr_dir_side (inv_dir dir))
     | NoProgress -> raise NoMatch);
@@ -844,15 +839,18 @@ let rec uniquize = function
           | Context.Rel.Declaration.LocalAssum _ as x -> x
           | Context.Rel.Declaration.LocalDef (x,_,y) ->
               Context.Rel.Declaration.LocalAssum(x,y) in
-        Environ.push_rel ctx_item env, h' + 1 in
-      let f' = map_constr_with_binders_left_to_right inc_h subst_loop acc f in
+        EConstr.push_rel ctx_item env, h' + 1 in
+      let self acc c = EConstr.of_constr (subst_loop acc (EConstr.Unsafe.to_constr c)) in
+      let f = EConstr.of_constr f in
+      let f' = map_constr_with_binders_left_to_right sigma inc_h self acc f in
+      let f' = EConstr.Unsafe.to_constr f' in
       mkApp (f', Array.map_left (subst_loop acc) a) in
   subst_loop (env,h) c) : find_P),
 ((fun () ->
   let sigma, uc, ({up_f = pf; up_a = pa} as u) =
     match !upat_that_matched with
     | Some (_,x) -> List.hd x | None when raise_NoMatch -> raise NoMatch
-    | None -> CErrors.anomaly (str"companion function never called") in
+    | None -> CErrors.anomaly (str"companion function never called.") in
   let p' = mkApp (pf, pa) in
   if max_occ <= !nocc then p', u.up_dir, (sigma, uc, u.up_t)
   else errorstrm (str"Only " ++ int !nocc ++ str" < " ++ int max_occ ++
@@ -900,23 +898,16 @@ let pr_pattern_aux pr_constr = function
   | E_As_X_In_T (e,x,t) ->
       pr_constr e ++ str " as " ++ pr_constr x ++ str " in " ++ pr_constr t
 let pp_pattern (sigma, p) =
-  pr_pattern_aux (fun t -> pr_constr_pat (pi3 (nf_open_term sigma sigma t))) p
+  pr_pattern_aux (fun t -> pr_constr_pat (EConstr.Unsafe.to_constr (pi3 (nf_open_term sigma sigma (EConstr.of_constr t))))) p
 let pr_cpattern = pr_term
 let pr_rpattern _ _ _ = pr_pattern
 
-let pr_option f = function None -> mt() | Some x -> f x
-let pr_ssrpattern _ _ _ = pr_option pr_pattern
-let pr_pattern_squarep = pr_option (fun r -> str "[" ++ pr_pattern r ++ str "]")
-let pr_ssrpattern_squarep _ _ _ = pr_pattern_squarep
-let pr_pattern_roundp = pr_option (fun r -> str "(" ++ pr_pattern r ++ str ")")
-let pr_ssrpattern_roundp  _ _ _ = pr_pattern_roundp
-
 let wit_rpatternty = add_genarg "rpatternty" pr_pattern
 
 let glob_ssrterm gs = function
-  | k, (_, Some c) -> k,
+  | k, (_, Some c), None ->
       let x = Tacintern.intern_constr gs c in
-      fst x, Some c
+      k, (fst x, Some c), None
   | ct -> ct
 
 (* This piece of code asserts the following notations are reserved *)
@@ -926,33 +917,33 @@ let glob_ssrterm gs = function
 (* Reserved Notation "( a 'as' b 'in' c )" (at level 0).           *)
 let glob_cpattern gs p =
   pp(lazy(str"globbing pattern: " ++ pr_term p));
-  let glob x = snd (glob_ssrterm gs (mk_lterm x)) in
+  let glob x = pi2 (glob_ssrterm gs (mk_lterm x None)) in
   let encode k s l =
-    let name = Name (id_of_string ("_ssrpat_" ^ s)) in
-    k, (mkRCast mkRHole (mkRLambda name mkRHole (mkRApp mkRHole l)), None) in
+    let name = Name (Id.of_string ("_ssrpat_" ^ s)) in
+    k, (mkRCast mkRHole (mkRLambda name mkRHole (mkRApp mkRHole l)), None), None in
   let bind_in t1 t2 =
-    let d = dummy_loc in let n = Name (destCVar t1) in
-    fst (glob (mkCCast d (mkCHole d) (mkCLambda d n (mkCHole d) t2))) in
+    let mkCHole = mkCHole ~loc:None in let n = Name (destCVar t1) in
+    fst (glob (mkCCast mkCHole (mkCLambda n mkCHole t2))) in
   let check_var t2 = if not (isCVar t2) then
     loc_error (constr_loc t2) "Only identifiers are allowed here" in
   match p with
-  | _, (_, None) as x -> x
-  | k, (v, Some t) as orig ->
-     if k = 'x' then glob_ssrterm gs ('(', (v, Some t)) else
-     match t with
-     | CNotation(_, "( _ in _ )", ([t1; t2], [], [])) ->
+  | _, (_, None), _ as x -> x
+  | k, (v, Some t), _ as orig ->
+     if k = 'x' then glob_ssrterm gs ('(', (v, Some t), None) else
+     match t.CAst.v with
+     | CNotation("( _ in _ )", ([t1; t2], [], [], [])) ->
          (try match glob t1, glob t2 with
          | (r1, None), (r2, None) -> encode k "In" [r1;r2]
          | (r1, Some _), (r2, Some _) when isCVar t1 ->
              encode k "In" [r1; r2; bind_in t1 t2]
          | (r1, Some _), (r2, Some _) -> encode k "In" [r1; r2]
-         | _ -> CErrors.anomaly (str"where are we?")
+         | _ -> 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
 ;;
@@ -966,7 +957,8 @@ let glob_rpattern s p =
   | E_In_X_In_T(e,x,t) -> E_In_X_In_T (glob_ssrterm s e,x,glob_ssrterm s t)
   | E_As_X_In_T(e,x,t) -> E_As_X_In_T (glob_ssrterm s e,x,glob_ssrterm s t)
 
-let subst_ssrterm s (k, c) = k, Tacsubst.subst_glob_constr_and_expr s c
+let subst_ssrterm s (k, c, ist) =
+  k, Tacsubst.subst_glob_constr_and_expr s c, ist
 
 let subst_rpattern s = function
   | T t -> T (subst_ssrterm s t)
@@ -976,41 +968,56 @@ let subst_rpattern s = function
   | E_In_X_In_T(e,x,t) -> E_In_X_In_T (subst_ssrterm s e,x,subst_ssrterm s t)
   | E_As_X_In_T(e,x,t) -> E_As_X_In_T (subst_ssrterm s e,x,subst_ssrterm s t)
 
+let interp_ssrterm ist (k,t,_) = k, t, Some ist
+
+let interp_rpattern s = function
+  | T t -> T (interp_ssrterm s t)
+  | In_T t -> In_T (interp_ssrterm s t)
+  | X_In_T(x,t) -> X_In_T (interp_ssrterm s x,interp_ssrterm s t)
+  | In_X_In_T(x,t) -> In_X_In_T (interp_ssrterm s x,interp_ssrterm s t)
+  | E_In_X_In_T(e,x,t) ->
+      E_In_X_In_T (interp_ssrterm s e,interp_ssrterm s x,interp_ssrterm s t)
+  | E_As_X_In_T(e,x,t) ->
+      E_As_X_In_T (interp_ssrterm s e,interp_ssrterm s x,interp_ssrterm s t)
+
+let interp_rpattern ist gl t = Tacmach.project gl, interp_rpattern ist t
+
 ARGUMENT EXTEND rpattern
   TYPED AS rpatternty
   PRINTED BY pr_rpattern
+  INTERPRETED BY interp_rpattern
   GLOBALIZED BY glob_rpattern
   SUBSTITUTED BY subst_rpattern
-  | [ lconstr(c) ] -> [ T (mk_lterm c) ]
-  | [ "in" lconstr(c) ] -> [ In_T (mk_lterm c) ]
+  | [ lconstr(c) ] -> [ T (mk_lterm c None) ]
+  | [ "in" lconstr(c) ] -> [ In_T (mk_lterm c None) ]
   | [ lconstr(x) "in" lconstr(c) ] -> 
-    [ X_In_T (mk_lterm x, mk_lterm c) ]
+    [ X_In_T (mk_lterm x None, mk_lterm c None) ]
   | [ "in" lconstr(x) "in" lconstr(c) ] -> 
-    [ In_X_In_T (mk_lterm x, mk_lterm c) ]
+    [ In_X_In_T (mk_lterm x None, mk_lterm c None) ]
   | [ lconstr(e) "in" lconstr(x) "in" lconstr(c) ] -> 
-    [ E_In_X_In_T (mk_lterm e, mk_lterm x, mk_lterm c) ]
+    [ E_In_X_In_T (mk_lterm e None, mk_lterm x None, mk_lterm c None) ]
   | [ lconstr(e) "as" lconstr(x) "in" lconstr(c) ] -> 
-    [ E_As_X_In_T (mk_lterm e, mk_lterm x, mk_lterm c) ]
+    [ E_As_X_In_T (mk_lterm e None, mk_lterm x None, mk_lterm c None) ]
 END
 
 
 
-type cpattern = char * glob_constr_and_expr
-let tag_of_cpattern = fst
+type cpattern = char * glob_constr_and_expr * Geninterp.interp_sign option
+let tag_of_cpattern = pi1
 let loc_of_cpattern = loc_ofCG
-let cpattern_of_term t = t
+let cpattern_of_term (c, t) ist = c, t, Some ist
 type occ = (bool * int list) option
 
 type rpattern = (cpattern, cpattern) ssrpattern
-let pr_rpattern = pr_pattern
 
-type pattern = Evd.evar_map * (Term.constr, Term.constr) ssrpattern
+type pattern = Evd.evar_map * (constr, constr) ssrpattern
 
-
-let id_of_cpattern = function
-  | _,(_,Some (CRef (Ident (_, x), _))) -> Some x
-  | _,(_,Some (CAppExpl (_, (_, Ident (_, x), _), []))) -> Some x
-  | _,(GRef (_, VarRef x, _) ,None) -> Some x
+let id_of_cpattern (_, (c1, c2), _) =
+  let open CAst in
+  match DAst.get c1, c2 with
+  | _, Some { v = CRef ({CAst.v=Ident x}, _) } -> Some x
+  | _, Some { v = CAppExpl ((_, {CAst.v=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
@@ -1032,19 +1039,17 @@ let interp_wit wit ist gl x =
   let arg = interp_genarg ist globarg in
   let (sigma, arg) = of_ftactic arg gl in
   sigma, Value.cast (topwit wit) arg
-let interp_constr = interp_wit wit_constr
 let interp_open_constr ist gl gc =
   interp_wit wit_open_constr ist gl gc
-let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) c
-let interp_term ist gl (_, c) = (interp_open_constr ist gl c)
+let pf_intern_term gl (_, c, ist) = glob_constr ist (pf_env gl) (project gl) c
 let pr_ssrterm _ _ _ = pr_term
-let input_ssrtermkind strm = match Compat.get_tok (stream_nth 0 strm) with
+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
+let interp_ssrterm ist gl t = Tacmach.project gl, interp_ssrterm ist t
 
 ARGUMENT EXTEND cpattern
      PRINTED BY pr_ssrterm
@@ -1052,16 +1057,16 @@ ARGUMENT EXTEND cpattern
      GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
      RAW_PRINTED BY pr_ssrterm
      GLOB_PRINTED BY pr_ssrterm
-| [ "Qed" constr(c) ] -> [ mk_lterm c ]
+| [ "Qed" constr(c) ] -> [ mk_lterm c None ]
 END
 
-let (!@) = Compat.to_coqloc
-
 GEXTEND Gram
   GLOBAL: cpattern;
   cpattern: [[ k = ssrtermkind; c = constr ->
-    let pattern = mk_term k c in
-    if loc_ofCG pattern <> !@loc && k = '(' then mk_term 'x' c else pattern ]];
+    let pattern = mk_term k c None in
+    if loc_ofCG pattern <> Some !@loc && k = '('
+    then mk_term 'x' c None
+    else pattern ]];
 END
 
 ARGUMENT EXTEND lcpattern
@@ -1071,16 +1076,23 @@ ARGUMENT EXTEND lcpattern
      GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
      RAW_PRINTED BY pr_ssrterm
      GLOB_PRINTED BY pr_ssrterm
-| [ "Qed" lconstr(c) ] -> [ mk_lterm c ]
+| [ "Qed" lconstr(c) ] -> [ mk_lterm c None ]
 END
 
 GEXTEND Gram
   GLOBAL: lcpattern;
   lcpattern: [[ k = ssrtermkind; c = lconstr ->
-    let pattern = mk_term k c in
-    if loc_ofCG pattern <> !@loc && k = '(' then mk_term 'x' c else pattern ]];
+    let pattern = mk_term k c None in
+    if loc_ofCG pattern <> Some !@loc && k = '('
+    then mk_term 'x' c None
+    else pattern ]];
 END
 
+let interp_term gl = function
+  | (_, c, Some ist) ->
+      on_snd EConstr.Unsafe.to_constr (interp_open_constr ist gl c)
+  | _ -> errorstrm (str"interpreting a term with no ist")
+
 let thin id sigma goal =
   let ids = Id.Set.singleton id in
   let env = Goal.V82.env sigma goal in
@@ -1098,33 +1110,38 @@ let thin id sigma goal =
     let sigma = Goal.V82.partial_solution_to sigma goal gl ev in
     sigma
 
+(*
 let pr_ist { lfun= lfun } =
   prlist_with_sep spc
     (fun (id, Geninterp.Val.Dyn(ty,_)) ->
         pr_id id ++ str":" ++ Geninterp.Val.pr ty) (Id.Map.bindings lfun)
+*)
 
-let interp_pattern ?wit_ssrpatternarg ist gl red redty =
+let interp_pattern ?wit_ssrpatternarg gl red redty =
   pp(lazy(str"interpreting: " ++ pr_pattern red));
-  pp(lazy(str" in ist: " ++ pr_ist ist));
   let xInT x y = X_In_T(x,y) and inXInT x y = In_X_In_T(x,y) in
   let inT x = In_T x and eInXInT e x t = E_In_X_In_T(e,x,t) in
   let eAsXInT e x t = E_As_X_In_T(e,x,t) in
-  let mkG ?(k=' ') x = k,(x,None) in
-  let decode ist t ?reccall f g =
-    try match (pf_intern_term ist gl t) with
-    | GCast(_,GHole _,CastConv(GLambda(_,Name x,_,_,c))) -> f x (' ',(c,None))
-    | GVar(_,id)
-      when Id.Map.mem id ist.lfun &&
+  let mkG ?(k=' ') x ist = k,(x,None), ist in
+  let ist_of (_,_,ist) = ist in
+  let decode (_,_,ist as t) ?reccall f g =
+    try match DAst.get (pf_intern_term gl t) with
+    | GCast(t,CastConv c) when isGHole t && isGLambda c->
+      let (x, c) = destGLambda c in
+      f x (' ',(c,None),ist)
+    | GVar id
+      when Option.has_some ist && let ist = Option.get ist in
+           Id.Map.mem id ist.lfun &&
            not(Option.is_empty reccall) &&
            not(Option.is_empty wit_ssrpatternarg) ->
-        let v = Id.Map.find id ist.lfun in
+        let v = Id.Map.find id (Option.get ist).lfun in
         Option.get reccall
           (Value.cast (topwit (Option.get wit_ssrpatternarg)) v)
     | it -> g t with e when CErrors.noncritical e -> g t in
-  let decodeG t f g = decode ist (mkG t) f g in
-  let bad_enc id _ = CErrors.anomaly (str"bad encoding for pattern "++str id) in
+  let decodeG ist t f g = decode (mkG t ist) 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
@@ -1139,12 +1156,12 @@ 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 
-      aux [] (Evarutil.nf_evar sigma rp) in
+      | _ -> CoqConstr.fold aux acc t in 
+      aux [] (nf_evar sigma rp) in
     let sigma = 
       List.fold_left (fun sigma e ->
         if Evd.is_defined sigma e then sigma else (* clear may be recursive *)
@@ -1154,71 +1171,82 @@ 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) = match red with
-    | T(k,(GCast (_,GHole _,(CastConv(GLambda (_,Name id,_,_,t)))),None))
-        when let id = string_of_id id in let len = String.length id in
+  let red = let rec decode_red = function
+    | T(k,(t,None),ist) ->
+      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 = string_of_id id in let len = String.length id in
-        (match String.sub id 8 (len - 8), t with
-        | "In", GApp(_, _, [t]) -> decodeG t xInT (fun x -> T x)
-        | "In", GApp(_, _, [e; t]) -> decodeG t (eInXInT (mkG e)) (bad_enc id)
-        | "In", GApp(_, _, [e; t; e_in_t]) ->
-            decodeG t (eInXInT (mkG e))
-              (fun _ -> decodeG e_in_t xInT (fun _ -> assert false))
-        | "As", GApp(_, _, [e; t]) -> decodeG t (eAsXInT (mkG e)) (bad_enc id)
+        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), DAst.get t with
+        | "In", GApp( _, [t]) -> decodeG ist t xInT (fun x -> T x)
+        | "In", GApp( _, [e; t]) -> decodeG ist t (eInXInT (mkG e ist)) (bad_enc id)
+        | "In", GApp( _, [e; t; e_in_t]) ->
+            decodeG ist t (eInXInT (mkG e ist))
+              (fun _ -> decodeG ist e_in_t xInT (fun _ -> assert false))
+        | "As", GApp(_, [e; t]) -> decodeG ist t (eAsXInT (mkG e ist)) (bad_enc id)
         | _ -> bad_enc id ())
-    | T t -> decode ist ~reccall:decode_red t xInT (fun x -> T x)
-    | In_T t -> decode ist t inXInT inT
-    | X_In_T (e,t) -> decode ist t (eInXInT e) (fun x -> xInT (id_of_Cterm e) x)
+      | _ ->
+        decode ~reccall:decode_red (mkG ~k t ist) xInT (fun x -> T x)
+      end
+    | T t -> decode ~reccall:decode_red t xInT (fun x -> T x)
+    | In_T t -> decode t inXInT inT
+    | X_In_T (e,t) ->  decode t (eInXInT e) (fun x -> xInT (id_of_Cterm e) x)
     | In_X_In_T (e,t) -> inXInT (id_of_Cterm e) t
     | E_In_X_In_T (e,x,rp) -> eInXInT e (id_of_Cterm x) rp
     | E_As_X_In_T (e,x,rp) -> eAsXInT e (id_of_Cterm x) rp in
-    decode_red (ist,red) in
+    decode_red red in
   pp(lazy(str"decoded as: " ++ pr_pattern_w_ids red));
-  let red = match redty with None -> red | Some ty -> let ty = ' ', ty in
+  let red =
+    match redty with
+    | None -> red
+    | Some (ty, ist) -> let ty = ' ', ty, Some ist in
   match red with
-  | T t -> T (combineCG t ty (mkCCast (loc_ofCG t)) mkRCast)
+  | T t -> T (combineCG t ty (mkCCast ?loc:(loc_ofCG t)) mkRCast)
   | X_In_T (x,t) ->
-      let ty = pf_intern_term ist gl ty in
-      E_As_X_In_T (mkG (mkRCast mkRHole ty), x, t)
+      let gty = pf_intern_term gl ty in
+      E_As_X_In_T (mkG (mkRCast mkRHole gty) (ist_of ty), x, t)
   | E_In_X_In_T (e,x,t) ->
-      let ty = mkG (pf_intern_term ist gl ty) in
-      E_In_X_In_T (combineCG e ty (mkCCast (loc_ofCG t)) mkRCast, x, t)
+      let ty = mkG (pf_intern_term gl ty) (ist_of ty) in
+      E_In_X_In_T (combineCG e ty (mkCCast ?loc:(loc_ofCG t)) mkRCast, x, t)
   | E_As_X_In_T (e,x,t) ->
-      let ty = mkG (pf_intern_term ist gl ty) in
-      E_As_X_In_T (combineCG e ty (mkCCast (loc_ofCG t)) mkRCast, x, t)
+      let ty = mkG (pf_intern_term gl ty) (ist_of ty) in
+      E_As_X_In_T (combineCG e ty (mkCCast ?loc:(loc_ofCG t)) mkRCast, x, t)
   | red -> red in
   pp(lazy(str"typed as: " ++ pr_pattern_w_ids red));
-  let mkXLetIn loc x (a,(g,c)) = match c with
-  | Some b -> a,(g,Some (mkCLetIn loc x (mkCHole loc) b))
-  | None -> a,(GLetIn (loc,x,(GHole (loc, BinderType x, IntroAnonymous, None)), g), None) in
+  let mkXLetIn ?loc x (a,(g,c),ist) = match c with
+  | Some b -> a,(g,Some (mkCLetIn ?loc x (mkCHole ~loc) b)), ist
+  | None -> a,(DAst.make ?loc @@ GLetIn (x, DAst.make ?loc @@ GHole (BinderType x, IntroAnonymous, None), None, g), None), ist 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
+  | T t -> let sigma, t = interp_term gl t in sigma, T t
+  | In_T t -> let sigma, t = interp_term gl t in sigma, In_T t
   | X_In_T (x, rp) | In_X_In_T (x, rp) ->
     let mk x p = match red with X_In_T _ -> X_In_T(x,p) | _ -> In_X_In_T(x,p) in
-    let rp = mkXLetIn dummy_loc (Name x) rp in
-    let sigma, rp = interp_term ist gl rp in
+    let rp = mkXLetIn (Name x) rp in
+    let sigma, rp = interp_term gl rp in
     let _, h, _, rp = destLetIn rp in
     let sigma = cleanup_XinE h x rp sigma in
-    let rp = subst1 h (Evarutil.nf_evar sigma rp) in
+    let rp = subst1 h (nf_evar sigma rp) in
     sigma, mk h rp
   | E_In_X_In_T(e, x, rp) | E_As_X_In_T (e, x, rp) ->
     let mk e x p =
       match red with E_In_X_In_T _ ->E_In_X_In_T(e,x,p)|_->E_As_X_In_T(e,x,p) in
-    let rp = mkXLetIn dummy_loc (Name x) rp in
-    let sigma, rp = interp_term ist gl rp in
+    let rp = mkXLetIn (Name x) rp in
+    let sigma, rp = interp_term gl rp in
     let _, h, _, rp = destLetIn rp in
     let sigma = cleanup_XinE h x rp sigma in
-    let rp = subst1 h (Evarutil.nf_evar sigma rp) in
-    let sigma, e = interp_term ist (re_sig (sig_it gl) sigma) e in
+    let rp = subst1 h (nf_evar sigma rp) in
+    let sigma, e = interp_term (re_sig (sig_it gl) sigma) e in
     sigma, mk e h rp
 ;;
-let interp_cpattern ist gl red redty = interp_pattern ist gl (T red) redty;;
-let interp_rpattern ~wit_ssrpatternarg ist gl red = interp_pattern ~wit_ssrpatternarg ist gl red None;;
+let interp_cpattern gl red redty = interp_pattern gl (T red) redty;;
+let interp_rpattern ~wit_ssrpatternarg gl red = interp_pattern ~wit_ssrpatternarg 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 *)
@@ -1226,11 +1254,11 @@ let noindex = Some(false,[])
 
 (* calls do_subst on every sub-term identified by (pattern,occ) *)
 let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
-  let fs sigma x = Reductionops.nf_evar sigma x in
+  let fs sigma x = nf_evar sigma x in
   let pop_evar sigma e p =
     let { Evd.evar_body = e_body } as e_def = Evd.find sigma e in
     let e_body = match e_body with Evar_defined c -> c
-    | _ -> errorstrm (str "Matching the pattern " ++ pr_constr p ++
+    | _ -> 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
@@ -1238,21 +1266,21 @@ 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, UState.empty
   | Some (sigma, (T rp | In_T rp)) -> 
     let rp = fs sigma rp in
     let ise = create_evar_defs sigma in
     let occ = match pattern with Some (_, T _) -> occ | _ -> noindex in
     let rp = mk_upat_for env0 sigma0 (ise, rp) all_ok in
     let find_T, end_T = mk_tpattern_matcher ?raise_NoMatch sigma0 occ rp in
-    let concl = find_T env0 concl0 1 do_subst in
-    let _ = end_T () in
-    concl
+    let concl = find_T env0 concl0 1 ~k:do_subst in
+    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
@@ -1262,13 +1290,13 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
     (* we start from sigma, so hole is considered a rigid head *)
     let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
     let find_X, end_X = mk_tpattern_matcher ?raise_NoMatch sigma occ holep in
-    let concl = find_T env0 concl0 1 (fun env c _ h ->
-      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
+    let concl = find_T env0 concl0 1 ~k:(fun env c _ h ->
+      let p_sigma = unify_HO env (create_evar_defs sigma) (EConstr.of_constr c) (EConstr.of_constr p) in
       let sigma, e_body = pop_evar p_sigma ex p in
       fs p_sigma (find_X env (fs sigma p) h 
-        (fun env _ -> do_subst env e_body))) in
-    let _ = end_X () in let _ = end_T () in 
-    concl
+        ~k:(fun env _ -> do_subst env e_body))) in
+    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
@@ -1278,42 +1306,43 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
     let find_X, end_X = mk_tpattern_matcher sigma noindex holep in
     let re = mk_upat_for env0 sigma0 (sigma, e) all_ok in
     let find_E, end_E = mk_tpattern_matcher ?raise_NoMatch sigma0 occ re in
-    let concl = find_T env0 concl0 1 (fun env c _ h ->
-      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
+    let concl = find_T env0 concl0 1 ~k:(fun env c _ h ->
+      let p_sigma = unify_HO env (create_evar_defs sigma) (EConstr.of_constr c) (EConstr.of_constr p) in
       let sigma, e_body = pop_evar p_sigma ex p in
-      fs p_sigma (find_X env (fs sigma p) h (fun env c _ h ->
-        find_E env e_body h do_subst))) in
-    let _ = end_E () in let _ = end_X () in let _ = end_T () in
-    concl
+      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 _,_,(_,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
     let rp = 
-      let e_sigma = unify_HO env0 sigma hole e in
+      let e_sigma = unify_HO env0 sigma (EConstr.of_constr hole) (EConstr.of_constr e) in
       e_sigma, fs e_sigma p in
     let rp = mk_upat_for ~hack:true env0 sigma0 rp all_ok in
     let find_TE, end_TE = mk_tpattern_matcher sigma0 noindex rp in
     let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
     let find_X, end_X = mk_tpattern_matcher sigma occ holep in
-    let concl = find_TE env0 concl0 1 (fun env c _ h ->
-      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
+    let concl = find_TE env0 concl0 1 ~k:(fun env c _ h ->
+      let p_sigma = unify_HO env (create_evar_defs sigma) (EConstr.of_constr c) (EConstr.of_constr p) in
       let sigma, e_body = pop_evar p_sigma ex p in
-      fs p_sigma (find_X env (fs sigma p) h (fun env c _ h ->
-        let e_sigma = unify_HO env sigma e_body e in
+      fs p_sigma (find_X env (fs sigma p) h ~k:(fun env c _ h ->
+        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) =
   let e = match p with
-  | In_T _ | In_X_In_T _ -> CErrors.anomaly (str"pattern without redex")
+  | In_T _ | In_X_In_T _ -> CErrors.anomaly (str"pattern without redex.")
   | T e | X_In_T (e, _) | E_As_X_In_T (e, _, _) | E_In_X_In_T (e, _, _) -> e in
   let sigma =
     if not resolve_typeclasses then sigma
     else Typeclasses.resolve_typeclasses ~fail:false env sigma in
-  Reductionops.nf_evar sigma e, Evd.evar_universe_context sigma
+  nf_evar sigma e, Evd.evar_universe_context sigma
 
 let fill_occ_pattern ?raise_NoMatch env sigma cl pat occ h =
   let do_make_rel, occ =
@@ -1321,12 +1350,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 *)
@@ -1334,19 +1365,25 @@ 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
  let ise = create_evar_defs sigma in
- let ise, u = mk_tpattern env sigma0 (ise,t) ok L2R p in
+ let ise, u = mk_tpattern env sigma0 (ise,EConstr.Unsafe.to_constr t) ok L2R p in
  let find_U, end_U =
    mk_tpattern_matcher ~raise_NoMatch:true sigma0 occ (ise,[u]) in
- let concl = find_U env concl h (fun _ _ _ -> mkRel) in
+ let concl = find_U env concl h ~k:(fun _ _ _ -> mkRel) in
  let rdx, _, (sigma, uc, p) = end_U () in
- sigma, uc, p, concl, rdx
+ sigma, uc, EConstr.of_constr p, EConstr.of_constr concl, EConstr.of_constr rdx
 
 let fill_occ_term env cl occ sigma0 (sigma, t) =
   try
     let sigma',uc,t',cl,_= pf_fill_occ env cl occ sigma0 t (sigma, t) all_ok 1 in
-    if sigma' != sigma0 then CErrors.error "matching impacts evars"
+    if sigma' != sigma0 then CErrors.user_err Pp.(str "matching impacts evars")
     else cl, (Evd.merge_universe_context sigma' uc, t')
   with NoMatch -> try
     let sigma', uc, t' =
@@ -1354,7 +1391,7 @@ let fill_occ_term env cl occ sigma0 (sigma, t) =
     if sigma' != sigma0 then raise NoMatch
     else cl, (Evd.merge_universe_context sigma' uc, t')
   with _ ->
-    errorstrm (str "partial term " ++ pr_constr_pat t
+    errorstrm (str "partial term " ++ pr_constr_pat (EConstr.Unsafe.to_constr t)
             ++ str " does not match any subterm of the goal")
 
 let pf_fill_occ_term gl occ t =
@@ -1362,25 +1399,20 @@ 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 = ' ', (GRef (dummy_loc, VarRef  id, None), None)
+let cpattern_of_id id =
+  ' ', (DAst.make @@ GRef (VarRef  id, None), None), Some Geninterp.({ lfun = Id.Map.empty; extra = Tacinterp.TacStore.empty })
 
-let is_wildcard = function
-  | _,(_,Some (CHole _)|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" *)
-let pr_ssrpatternarg _ _ _ (_,cpat) = pr_rpattern cpat
-let pr_ssrpatternarg_glob _ _ _ cpat = pr_rpattern cpat
-let interp_ssrpatternarg ist gl p = project gl, (ist, p)
 
-ARGUMENT EXTEND ssrpatternarg
-  PRINTED BY pr_ssrpatternarg
-  INTERPRETED BY interp_ssrpatternarg
-  GLOBALIZED BY glob_rpattern
-  RAW_PRINTED BY pr_ssrpatternarg_glob
-  GLOB_PRINTED BY pr_ssrpatternarg_glob
+ARGUMENT EXTEND ssrpatternarg TYPED AS rpattern PRINTED BY pr_rpattern
 | [ rpattern(pat) ] -> [ pat ]
 END
+
+let pr_rpattern = pr_pattern
   
 let pf_merge_uc uc gl =
   re_sig (sig_it gl) (Evd.merge_universe_context (project gl) uc)
@@ -1388,16 +1420,19 @@ let pf_merge_uc uc gl =
 let pf_unsafe_merge_uc uc gl =
   re_sig (sig_it gl) (Evd.set_universe_context (project gl) uc)
 
-let interp_rpattern ist gl red = interp_rpattern ~wit_ssrpatternarg ist gl red
+let interp_rpattern = interp_rpattern ~wit_ssrpatternarg
 
-let ssrpatterntac _ist (arg_ist,arg) gl =
-  let pat = interp_rpattern arg_ist gl arg in
+let ssrpatterntac _ist arg gl =
+  let pat = interp_rpattern gl arg in
   let sigma0 = project gl in
   let concl0 = pf_concl gl in
+  let concl0 = EConstr.Unsafe.to_constr concl0 in
   let (t, uc), concl_x =
     fill_occ_pattern (Global.env()) sigma0 concl0 pat noindex 1 in
+  let t = EConstr.of_constr t in
+  let concl_x = EConstr.of_constr concl_x in
   let gl, tty = pf_type_of gl t in
-  let concl = mkLetIn (Name (id_of_string "selected"), t, tty, concl_x) in
+  let concl = EConstr.mkLetIn (Name (Id.of_string "selected"), t, tty, concl_x) in
   Proofview.V82.of_tactic (convert_concl concl DEFAULTcast) gl
 
 (* Register "ssrpattern" tactic *)
@@ -1410,23 +1445,25 @@ let () =
   let name = { mltac_plugin = "ssrmatching_plugin"; mltac_tactic = "ssrpattern"; } in
   let () = Tacenv.register_ml_tactic name [|mltac|] in
   let tac =
-    TacFun ([Some (Id.of_string "pattern")],
-      TacML (Loc.ghost, { mltac_name = name; mltac_index = 0 }, [])) in
+    TacFun ([Name (Id.of_string "pattern")],
+      TacML (Loc.tag ({ mltac_name = name; mltac_index = 0 }, []))) in
   let obj () =
     Tacenv.register_ltac true false (Id.of_string "ssrpattern") tac in
   Mltop.declare_cache_obj obj "ssrmatching_plugin"
 
-let ssrinstancesof ist arg gl =
+let ssrinstancesof 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 sigma0, cpat = interp_cpattern ist gl arg None in
+  let concl = EConstr.Unsafe.to_constr concl in
+  let sigma0, cpat = interp_cpattern gl arg None in
   let pat = match cpat with T x -> x | _ -> errorstrm (str"Not supported") in
   let etpat, tpat = mk_tpattern env sigma (sigma0,pat) (ok pat) L2R pat in
   let find, conclude =
     mk_tpattern_matcher ~all_instances:true ~raise_NoMatch:true
       sigma None (etpat,[tpat]) in
-  let print env p c _ = ppnl (hov 1 (str"instance:" ++ spc() ++ pr_constr p ++ spc() ++ str "matches:" ++ spc() ++ pr_constr c)); c in
+  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
@@ -1435,13 +1472,13 @@ let ssrinstancesof ist arg gl =
   with NoMatch -> ppnl (str"END INSTANCES"); tclIDTAC gl
 
 TACTIC EXTEND ssrinstoftpat
-| [ "ssrinstancesoftpat" cpattern(arg) ] -> [ Proofview.V82.tactic (ssrinstancesof ist arg) ]
+| [ "ssrinstancesoftpat" cpattern(arg) ] -> [ Proofview.V82.tactic (ssrinstancesof arg) ]
 END
 
 (* We wipe out all the keywords generated by the grammar rules we defined. *)
 (* The user is supposed to Require Import ssreflect or Require ssreflect   *)
 (* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
 (* consequence the extended ssreflect grammar.                             *)
-let () = CLexer.unfreeze frozen_lexer ;;
+let () = CLexer.set_keyword_state frozen_lexer ;;
 
 (* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli
deleted file mode 100644
index 288a04e6..00000000
--- a/plugins/ssrmatching/ssrmatching.mli
+++ /dev/null
@@ -1,241 +0,0 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
-(* Distributed under the terms of CeCILL-B.                                  *)
-
-open Genarg
-open Tacexpr
-open Environ
-open Tacmach
-open Evd
-open Proof_type
-open Term
-
-(** ******** Small Scale Reflection pattern matching facilities ************* *)
-
-(** Pattern parsing *)
-
-(** The type of context patterns, the patterns of the [set] tactic and 
-    [:] tactical. These are patterns that identify a precise subterm. *)
-type cpattern
-val pr_cpattern : cpattern -> Pp.std_ppcmds
-
-(** CS cpattern: (f _), (X in t), (t in X in t), (t as X in t) *)
-val cpattern         : cpattern Pcoq.Gram.entry
-val wit_cpattern     : cpattern uniform_genarg_type
-
-(** OS cpattern: f _, (X in t), (t in X in t), (t as X in t) *)
-val lcpattern         : cpattern Pcoq.Gram.entry
-val wit_lcpattern     : cpattern uniform_genarg_type
-
-(** The type of rewrite patterns, the patterns of the [rewrite] tactic.
-    These patterns also include patterns that identify all the subterms
-    of a context (i.e. "in" prefix) *)
-type rpattern
-val pr_rpattern : rpattern -> Pp.std_ppcmds
-
-(** OS rpattern: f _, in t, X in t, in X in t, t in X in t, t as X in t *)
-val rpattern         : rpattern Pcoq.Gram.entry
-val wit_rpattern     : rpattern uniform_genarg_type
-
-(** Pattern interpretation and matching *)
-
-exception NoMatch
-exception NoProgress
-
-(** AST for [rpattern] (and consequently [cpattern]) *)
-type ('ident, 'term) ssrpattern =
-  | T of 'term
-  | In_T of 'term
-  | X_In_T of 'ident * 'term
-  | In_X_In_T of 'ident * 'term
-  | E_In_X_In_T of 'term * 'ident * 'term
-  | E_As_X_In_T of 'term * 'ident * 'term
-
-type pattern = evar_map * (constr, constr) ssrpattern
-val pp_pattern : pattern -> Pp.std_ppcmds
-
-(** Extracts the redex and applies to it the substitution part of the pattern.
-  @raise Anomaly if called on [In_T] or [In_X_In_T] *)
-val redex_of_pattern :
-  ?resolve_typeclasses:bool -> env -> pattern ->
-     constr Evd.in_evar_universe_context
-
-(** [interp_rpattern ise gl rpat] "internalizes" and "interprets" [rpat]
-    in the current [Ltac] interpretation signature [ise] and tactic input [gl]*)
-val interp_rpattern :
-  Tacinterp.interp_sign -> goal sigma ->
-  rpattern ->
-    pattern
-
-(** [interp_cpattern ise gl cpat ty] "internalizes" and "interprets" [cpat]
-    in the current [Ltac] interpretation signature [ise] and tactic input [gl].
-    [ty] is an optional type for the redex of [cpat] *)
-val interp_cpattern :
-  Tacinterp.interp_sign -> goal sigma ->
-  cpattern -> glob_constr_and_expr option ->
-    pattern
-
-(** The set of occurrences to be matched. The boolean is set to true
- *  to signal the complement of this set (i.e. {-1 3}) *)
-type occ = (bool * int list) option
-
-(** [subst e p t i]. [i] is the number of binders
-    traversed so far, [p] the term from the pattern, [t] the matched one *)
-type subst = env -> constr -> constr -> int -> constr
-
-(** [eval_pattern b env sigma t pat occ subst] maps [t] calling [subst] on every
-    [occ] occurrence of [pat]. The [int] argument is the number of 
-    binders traversed. If [pat] is [None] then then subst is called on [t].
-    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
-    (an extension of) [sigma]. 
-  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false])
-  @return [t] where all [occ] occurrences of [pat] have been mapped using
-    [subst] *)
-val eval_pattern :
-  ?raise_NoMatch:bool ->
-  env -> evar_map -> constr ->
-  pattern option -> occ -> subst ->
-    constr
-
-(** [fill_occ_pattern b env sigma t pat occ h] is a simplified version of 
-    [eval_pattern]. 
-    It replaces all [occ] occurrences of [pat] in [t] with Rel [h]. 
-    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
-    (an extension of) [sigma]. 
-  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false]) 
-  @return the instance of the redex of [pat] that was matched and [t]
-    transformed as described above. *)
-val fill_occ_pattern :
-  ?raise_NoMatch:bool ->
-  env -> evar_map -> constr ->
-  pattern -> occ -> int ->
-    constr Evd.in_evar_universe_context * constr
-
-(** *************************** Low level APIs ****************************** *)
-
-(* The primitive matching facility. It matches of a term with holes, like 
-   the T pattern above, and calls a continuation on its occurrences. *)
-
-type ssrdir = L2R | R2L
-val pr_dir_side : ssrdir -> Pp.std_ppcmds
-
-(** a pattern for a term with wildcards *)
-type tpattern
-
-(** [mk_tpattern env sigma0 sigma_p ok p_origin dir t] compiles a term [t] 
-    living in [env] [sigma] (an extension of [sigma0]) intro a [tpattern].
-    The [tpattern] can hold a (proof) term [p] and a diction [dir]. The [ok]
-    callback is used to filter occurrences.
-  @return the compiled [tpattern] and its [evar_map]
-  @raise UserEerror is the pattern is a wildcard *)
-val mk_tpattern :
-  ?p_origin:ssrdir * constr ->
-  env -> evar_map ->
-  evar_map * constr ->
-  (constr -> evar_map -> bool) ->
-  ssrdir -> constr ->
-    evar_map * tpattern
-
-(** [findP env t i k] is a stateful function that finds the next occurrence 
-    of a tpattern and calls the callback [k] to map the subterm matched. 
-    The [int] argument passed to [k] is the number of binders traversed so far 
-    plus the initial value [i]. 
-  @return [t] where the subterms identified by the selected occurrences of 
-    the patter have been mapped using [k]
-  @raise NoMatch if the raise_NoMatch flag given to [mk_tpattern_matcher] is
-    [true] and if the pattern did not match 
-  @raise UserEerror if the raise_NoMatch flag given to [mk_tpattern_matcher] is
-    [false] and if the pattern did not match *)
-type find_P =
-  env -> constr -> int -> k:subst -> constr
-
-(** [conclude ()] asserts that all mentioned ocurrences have been visited.
-  @return the instance of the pattern, the evarmap after the pattern
-    instantiation, the proof term and the ssrdit stored in the tpattern
-  @raise UserEerror if too many occurrences were specified *)
-type conclude =
-  unit -> constr * ssrdir * (evar_map * Evd.evar_universe_context * constr)
-
-(** [mk_tpattern_matcher b o sigma0 occ sigma_tplist] creates a pair 
-    a function [find_P] and [conclude] with the behaviour explained above.
-    The flag [b] (default [false]) changes the error reporting behaviour
-    of [find_P] if none of the [tpattern] matches. The argument [o] can
-    be passed to tune the [UserError] eventually raised (useful if the 
-    pattern is coming from the LHS/RHS of an equation) *)
-val mk_tpattern_matcher :
-  ?all_instances:bool ->
-  ?raise_NoMatch:bool ->
-  ?upats_origin:ssrdir * constr ->
-  evar_map -> occ -> evar_map * tpattern list ->
-    find_P * conclude
-
-(** Example of [mk_tpattern_matcher] to implement 
-    [rewrite \{occ\}\[in t\]rules].
-    It first matches "in t" (called [pat]), then in all matched subterms 
-    it matches the LHS of the rules using [find_R].
-    [concl0] is the initial goal, [concl] will be the goal where some terms
-    are replaced by a De Bruijn index. The [rw_progress] extra check
-    selects only occurrences that are not rewritten to themselves (e.g.
-    an occurrence "x + x" rewritten with the commutativity law of addition 
-    is skipped) {[
-  let find_R, conclude = match pat with
-  | Some (_, In_T _) ->
-      let aux (sigma, pats) (d, r, lhs, rhs) =
-        let sigma, pat = 
-          mk_tpattern env0 sigma0 (sigma, r) (rw_progress rhs) d lhs in
-        sigma, pats @ [pat] in
-      let rpats = List.fold_left aux (r_sigma, []) rules in
-      let find_R, end_R = mk_tpattern_matcher sigma0 occ rpats in
-      find_R ~k:(fun _ _ h -> mkRel h), 
-      fun cl -> let rdx, d, r = end_R () in (d,r),rdx
-  | _ -> ... in
-  let concl = eval_pattern env0 sigma0 concl0 pat occ find_R in
-  let (d, r), rdx = conclude concl in ]} *)
-
-(* convenience shortcut: [pf_fill_occ_term gl occ (sigma,t)] returns
- * the conclusion of [gl] where [occ] occurrences of [t] have been replaced
- * by [Rel 1] and the instance of [t] *)
-val pf_fill_occ_term : goal sigma -> occ -> evar_map * constr -> constr * constr
-
-(* It may be handy to inject a simple term into the first form of cpattern *)
-val cpattern_of_term : char * glob_constr_and_expr -> cpattern
-
-(** Helpers to make stateful closures. Example: a [find_P] function may be 
-    called many times, but the pattern instantiation phase is performed only the
-    first time. The corresponding [conclude] has to return the instantiated
-    pattern redex. Since it is up to [find_P] to raise [NoMatch] if the pattern
-    has no instance, [conclude] considers it an anomaly if the pattern did
-    not match *)
-
-(** [do_once r f] calls [f] and updates the ref only once *)
-val do_once : 'a option ref -> (unit -> 'a) -> unit
-(** [assert_done r] return the content of r. @raise Anomaly is r is [None] *)
-val assert_done : 'a option ref -> 'a
-
-(** Very low level APIs.
-    these are calls to evarconv's [the_conv_x] followed by
-    [solve_unif_constraints_with_heuristics] and [resolve_typeclasses].
-    In case of failure they raise [NoMatch] *)
-
-val unify_HO : env -> evar_map -> constr -> constr -> evar_map
-val pf_unify_HO : goal sigma -> constr -> constr -> goal sigma
-
-(** Some more low level functions needed to implement the full SSR language
-    on top of the former APIs *)
-val tag_of_cpattern : cpattern -> char
-val loc_of_cpattern : cpattern -> Loc.t
-val id_of_pattern : pattern -> Names.variable option
-val is_wildcard : cpattern -> bool
-val cpattern_of_id : Names.variable -> cpattern
-val cpattern_of_id : Names.variable -> cpattern
-val pr_constr_pat : constr -> Pp.std_ppcmds
-val pf_merge_uc : Evd.evar_universe_context -> goal Evd.sigma -> goal Evd.sigma
-val pf_unsafe_merge_uc : Evd.evar_universe_context -> goal Evd.sigma -> goal Evd.sigma
-
-(* One can also "Set SsrMatchingDebug" from a .v *)
-val debug : bool -> unit
-
-(* One should delimit a snippet with "Set SsrMatchingProfiling" and
- * "Unset SsrMatchingProfiling" to get timings *)
-val profile : bool -> unit
-
-(* eof *)
diff --git a/plugins/ssrmatching/ssrmatching.v b/plugins/ssrmatching/ssrmatching.v
deleted file mode 100644
index 829ee05e..00000000
--- a/plugins/ssrmatching/ssrmatching.v
+++ /dev/null
@@ -1,26 +0,0 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
-(* Distributed under the terms of CeCILL-B.                                  *)
-Declare ML Module "ssrmatching_plugin".
-
-Module SsrMatchingSyntax.
-
-(* Reserve the notation for rewrite patterns so that the user is not allowed  *)
-(* to declare it at a different level.                                        *)
-Reserved Notation "( a 'in' b )"        (at level 0).
-Reserved Notation "( a 'as' b )"        (at level 0).
-Reserved Notation "( a 'in' b 'in' c )" (at level 0).
-Reserved Notation "( a 'as' b 'in' c )" (at level 0).
-
-(* Notation to define shortcuts for the "X in t" part of a pattern.           *)
-Notation "( X 'in' t )" := (_ : fun X => t) : ssrpatternscope.
-Delimit Scope ssrpatternscope with pattern.
-
-(* Some shortcuts for recurrent "X in t" parts.                               *)
-Notation RHS := (X in _ = X)%pattern.
-Notation LHS := (X in X = _)%pattern.
-
-End SsrMatchingSyntax.
-
-Export SsrMatchingSyntax.
-
-Tactic Notation "ssrpattern" ssrpatternarg(p) := ssrpattern p .
diff --git a/plugins/ssrmatching/vo.itarget b/plugins/ssrmatching/vo.itarget
deleted file mode 100644
index b0eb3883..00000000
--- a/plugins/ssrmatching/vo.itarget
+++ /dev/null
@@ -1 +0,0 @@
-ssrmatching.vo
diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml
index e18d19ce..acb297dd 100644
--- a/plugins/syntax/ascii_syntax.ml
+++ b/plugins/syntax/ascii_syntax.ml
@@ -1,10 +1,13 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
 
 (* Poor's man DECLARE PLUGIN *)
 let __coq_plugin_name = "ascii_syntax_plugin"
@@ -24,6 +27,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"
@@ -37,34 +44,34 @@ let glob_Ascii = lazy (make_reference "Ascii")
 
 open Lazy
 
-let interp_ascii dloc p =
+let interp_ascii ?loc p =
   let rec aux n p =
      if Int.equal n 0 then [] else
      let mp = p mod 2 in
-     GRef (dloc,(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
-  GApp (dloc,GRef(dloc,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 dloc s =
+let interp_ascii_string ?loc s =
   let p =
     if Int.equal (String.length s) 1 then int_of_char s.[0]
     else
       if Int.equal (String.length s) 3 && is_digit s.[0] && is_digit s.[1] && is_digit s.[2]
       then int_of_string s
       else
-	user_err_loc (dloc,"interp_ascii_string",
-	  str "Expects a single character or a three-digits ascii code.") in
-  interp_ascii dloc p
+	user_err ?loc ~hdr:"interp_ascii_string"
+	 (str "Expects a single character or a three-digits ascii code.") in
+  interp_ascii ?loc p
 
 let uninterp_ascii r =
   let rec uninterp_bool_list n = function
     | [] when Int.equal n 0 -> 0
-    | GRef (_,k,_)::l when Globnames.eq_gr k glob_true  -> 1+2*(uninterp_bool_list (n-1)  l)
-    | 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
-    | GApp (_,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
@@ -74,10 +81,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
-    ([GRef (Loc.ghost,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
new file mode 100644
index 00000000..5529ea70
--- /dev/null
+++ b/plugins/syntax/int31_syntax.ml
@@ -0,0 +1,105 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+
+(* Poor's man DECLARE PLUGIN *)
+let __coq_plugin_name = "int31_syntax_plugin"
+let () = Mltop.add_known_module __coq_plugin_name
+
+(* digit-based syntax for int31 *)
+
+open Bigint
+open Names
+open Globnames
+open Glob_term
+
+(*** Constants for locating int31 constructors ***)
+
+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 =
+  let mp = ModPath.MPdot (ModPath.MPfile (make_dir dir), Label.make modname)
+  in make_mind mp id
+
+
+(* int31 stuff *)
+let int31_module = ["Coq"; "Numbers"; "Cyclic"; "Int31"; "Int31"]
+let int31_path = make_path int31_module "int31"
+let int31_id = make_mind_mpfile int31_module
+let int31_scope = "int31_scope"
+
+let int31_construct = ConstructRef ((int31_id "int31",0),1)
+
+let int31_0 = ConstructRef ((int31_id "digits",0),1)
+let int31_1 = ConstructRef ((int31_id "digits",0),2)
+
+(*** Definition of the Non_closed exception, used in the pretty printing ***)
+exception Non_closed
+
+(*** Parsing for int31 in digital notation ***)
+
+(* 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 = 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
+      []
+    else
+      let (q,r) = div2_with_rest n in
+	(if r then ref_1 else ref_0)::(args (counter-1) q)
+  in
+  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.")
+
+let interp_int31 ?loc n =
+  if is_pos_or_zero n then
+    int31_of_pos_bigint ?loc n
+  else
+    error_negative ?loc
+
+(* Pretty prints an int31 *)
+
+let bigint_of_int31 =
+  let rec args_parsing args cur =
+    match args with
+      | [] -> 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
+  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 (AnyGlobConstr i) =
+  try
+    Some (bigint_of_int31 i)
+  with Non_closed ->
+    None
+
+(* Actually declares the interpreter for int31 *)
+let _ = Notation.declare_numeral_interpreter int31_scope
+  (int31_path, int31_module)
+  interp_int31
+  ([DAst.make (GRef (int31_construct, None))],
+   uninterp_int31,
+   true)
diff --git a/plugins/syntax/int31_syntax_plugin.mlpack b/plugins/syntax/int31_syntax_plugin.mlpack
new file mode 100644
index 00000000..54a5bc0c
--- /dev/null
+++ b/plugins/syntax/int31_syntax_plugin.mlpack
@@ -0,0 +1 @@
+Int31_syntax
diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml
index a9eb126b..ad8b54d4 100644
--- a/plugins/syntax/nat_syntax.ml
+++ b/plugins/syntax/nat_syntax.ml
@@ -1,11 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+
 (* Poor's man DECLARE PLUGIN *)
 let __coq_plugin_name = "nat_syntax_plugin"
 let () = Mltop.add_known_module __coq_plugin_name
@@ -33,34 +36,39 @@ let warn_large_nat =
                  strbrk "may vary from 5000 to 70000 depending on your system " ++
                  strbrk "limits and on the command executed).")
 
-let nat_of_int dloc n =
+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 = GRef (dloc, glob_O, None) in
-      let ref_S = GRef (dloc, 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 (GApp (dloc,ref_S, [acc])) (sub_1 n)
+	  mk_nat (DAst.make ?loc @@ GApp (ref_S, [acc])) (sub_1 n)
 	else
 	  acc
       in
       mk_nat ref_O n
     end
   else
-      user_err_loc (dloc, "nat_of_int",
-        str "Cannot interpret a negative number as a number of type nat")
+      user_err ?loc ~hdr:"nat_of_int"
+       (str "Cannot interpret a negative number as a number of type nat")
 
 (************************************************************************)
 (* Printing via scopes *)
 
 exception Non_closed_number
 
-let rec int_of_nat = function
-  | GApp (_,GRef (_,s,_),[a]) when Globnames.eq_gr s glob_S -> add_1 (int_of_nat a)
-  | GRef (_,z,_) when Globnames.eq_gr z glob_O -> zero
+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
@@ -73,4 +81,4 @@ let _ =
   Notation.declare_numeral_interpreter "nat_scope"
     (nat_path,datatypes_module_name)
     nat_of_int
-    ([GRef (Loc.ghost,glob_S,None); GRef (Loc.ghost,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/numbers_syntax.ml b/plugins/syntax/numbers_syntax.ml
deleted file mode 100644
index f65f9b79..00000000
--- a/plugins/syntax/numbers_syntax.ml
+++ /dev/null
@@ -1,311 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* Poor's man DECLARE PLUGIN *)
-let __coq_plugin_name = "numbers_syntax_plugin"
-let () = Mltop.add_known_module __coq_plugin_name
-
-(* digit-based syntax for int31, bigN bigZ and bigQ *)
-
-open Bigint
-open Names
-open Globnames
-open Glob_term
-
-(*** Constants for locating int31 / bigN / bigZ / bigQ constructors ***)
-
-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 make_mind mp id = Names.MutInd.make2 mp (Label.make id)
-let make_mind_mpfile dir id = make_mind (MPfile (make_dir dir)) id
-let make_mind_mpdot dir modname id =
-  let mp = MPdot (MPfile (make_dir dir), Label.make modname)
-  in make_mind mp id
-
-
-(* int31 stuff *)
-let int31_module = ["Coq"; "Numbers"; "Cyclic"; "Int31"; "Int31"]
-let int31_path = make_path int31_module "int31"
-let int31_id = make_mind_mpfile int31_module
-let int31_scope = "int31_scope"
-
-let int31_construct = ConstructRef ((int31_id "int31",0),1)
-
-let int31_0 = ConstructRef ((int31_id "digits",0),1)
-let int31_1 = ConstructRef ((int31_id "digits",0),2)
-
-
-(* bigN stuff*)
-let zn2z_module = ["Coq"; "Numbers"; "Cyclic"; "DoubleCyclic"; "DoubleType"]
-let zn2z_path = make_path zn2z_module "zn2z"
-let zn2z_id = make_mind_mpfile zn2z_module
-
-let zn2z_W0 = ConstructRef ((zn2z_id "zn2z",0),1)
-let zn2z_WW = ConstructRef ((zn2z_id "zn2z",0),2)
-
-let bigN_module = ["Coq"; "Numbers"; "Natural"; "BigN"; "BigN" ]
-let bigN_path = make_path (bigN_module@["BigN"]) "t"
-let bigN_t = make_mind_mpdot bigN_module "BigN" "t'"
-let bigN_scope = "bigN_scope"
-
-(* number of inlined level of bigN (actually the level 0 to n_inlined-1 are inlined) *)
-let n_inlined = 7
-
-let bigN_constructor i =
-  ConstructRef ((bigN_t,0),(min i n_inlined)+1)
-
-(*bigZ stuff*)
-let bigZ_module = ["Coq"; "Numbers"; "Integer"; "BigZ"; "BigZ" ]
-let bigZ_path = make_path (bigZ_module@["BigZ"]) "t"
-let bigZ_t = make_mind_mpdot bigZ_module "BigZ" "t_"
-let bigZ_scope = "bigZ_scope"
-
-let bigZ_pos = ConstructRef ((bigZ_t,0),1)
-let bigZ_neg = ConstructRef ((bigZ_t,0),2)
-
-
-(*bigQ stuff*)
-let bigQ_module = ["Coq"; "Numbers"; "Rational"; "BigQ"; "BigQ"]
-let bigQ_path = make_path (bigQ_module@["BigQ"]) "t"
-let bigQ_t = make_mind_mpdot bigQ_module "BigQ" "t_"
-let bigQ_scope = "bigQ_scope"
-
-let bigQ_z =  ConstructRef ((bigQ_t,0),1)
-
-
-(*** Definition of the Non_closed exception, used in the pretty printing ***)
-exception Non_closed
-
-(*** Parsing for int31 in digital notation ***)
-
-(* parses a *non-negative* integer (from bigint.ml) into an int31
-   wraps modulo 2^31 *)
-let int31_of_pos_bigint dloc n =
-  let ref_construct = GRef (dloc, int31_construct, None) in
-  let ref_0 = GRef (dloc, int31_0, None) in
-  let ref_1 = GRef (dloc, int31_1, None) in
-  let rec args counter n =
-    if counter <= 0 then
-      []
-    else
-      let (q,r) = div2_with_rest n in
-	(if r then ref_1 else ref_0)::(args (counter-1) q)
-  in
-  GApp (dloc, ref_construct, List.rev (args 31 n))
-
-let error_negative dloc =
-  CErrors.user_err_loc (dloc, "interp_int31", Pp.str "int31 are only non-negative numbers.")
-
-let interp_int31 dloc n =
-  if is_pos_or_zero n then
-    int31_of_pos_bigint dloc n
-  else
-    error_negative dloc
-
-(* Pretty prints an int31 *)
-
-let bigint_of_int31 =
-  let rec args_parsing args cur =
-    match args with
-      | [] -> cur
-      | (GRef (_,b,_))::l when eq_gr b int31_0 -> args_parsing l (mult_2 cur)
-      | (GRef (_,b,_))::l when eq_gr b int31_1 -> args_parsing l (add_1 (mult_2 cur))
-      | _ -> raise Non_closed
-  in
-  function
-  | GApp (_, GRef (_, c, _), args) when eq_gr c int31_construct -> args_parsing args zero
-  | _ -> raise Non_closed
-
-let uninterp_int31 i =
-  try
-    Some (bigint_of_int31 i)
-  with Non_closed ->
-    None
-
-(* Actually declares the interpreter for int31 *)
-let _ = Notation.declare_numeral_interpreter int31_scope
-  (int31_path, int31_module)
-  interp_int31
-  ([GRef (Loc.ghost, int31_construct, None)],
-   uninterp_int31,
-   true)
-
-
-(*** Parsing for bigN in digital notation ***)
-(* the base for bigN (in Coq) that is 2^31 in our case *)
-let base = pow two 31
-
-(* base of the bigN of height N : (2^31)^(2^n) *)
-let rank n =
-  let rec rk n pow2 =
-    if n <= 0 then pow2
-    else rk (n-1) (mult pow2 pow2)
-  in rk n base
-
-(* splits a number bi at height n, that is the rest needs 2^n int31 to be stored
-   it is expected to be used only when the quotient would also need 2^n int31 to be
-   stored *)
-let split_at n bi =
-  euclid bi (rank (n-1))
-
-(* search the height of the Coq bigint needed to represent the integer bi *)
-let height bi =
-  let rec hght n pow2 =
-    if less_than bi pow2 then n
-    else hght (n+1) (mult pow2 pow2)
-  in hght 0 base
-
-(* n must be a non-negative integer (from bigint.ml) *)
-let word_of_pos_bigint dloc hght n =
-  let ref_W0 = GRef (dloc, zn2z_W0, None) in
-  let ref_WW = GRef (dloc, zn2z_WW, None) in
-  let rec decomp hgt n =
-    if hgt <= 0 then
-      int31_of_pos_bigint dloc n
-    else if equal n zero then
-      GApp (dloc, ref_W0, [GHole (dloc, Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None)])
-    else
-      let (h,l) = split_at hgt n in
-      GApp (dloc, ref_WW, [GHole (dloc, Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None);
-			   decomp (hgt-1) h;
-			   decomp (hgt-1) l])
-  in
-  decomp hght n
-
-let bigN_of_pos_bigint dloc n =
-  let h = height n in
-  let ref_constructor = GRef (dloc, bigN_constructor h, None) in
-  let word = word_of_pos_bigint dloc h n in
-  let args =
-    if h < n_inlined then [word]
-    else [Nat_syntax_plugin.Nat_syntax.nat_of_int dloc (of_int (h-n_inlined));word]
-  in
-  GApp (dloc, ref_constructor, args)
-
-let bigN_error_negative dloc =
-  CErrors.user_err_loc (dloc, "interp_bigN", Pp.str "bigN are only non-negative numbers.")
-
-let interp_bigN dloc n =
-  if is_pos_or_zero n then
-    bigN_of_pos_bigint dloc n
-  else
-    bigN_error_negative dloc
-
-
-(* Pretty prints a bigN *)
-
-let bigint_of_word =
-  let rec get_height rc =
-    match rc with
-    | GApp (_,GRef(_,c,_), [_;lft;rght]) when eq_gr c zn2z_WW ->
-      1+max (get_height lft) (get_height rght)
-    | _ -> 0
-  in
-  let rec transform hght rc =
-    match rc with
-    | GApp (_,GRef(_,c,_),_) when eq_gr c zn2z_W0-> zero
-    | GApp (_,GRef(_,c,_), [_;lft;rght]) when eq_gr c zn2z_WW->
-      let new_hght = hght-1 in
-      add (mult (rank new_hght)
-             (transform new_hght lft))
-	(transform new_hght rght)
-    | _ -> bigint_of_int31 rc
-  in
-  fun rc ->
-    let hght = get_height rc in
-    transform hght rc
-
-let bigint_of_bigN rc =
-  match rc with
-  | GApp (_,_,[one_arg]) -> bigint_of_word one_arg
-  | GApp (_,_,[_;second_arg]) -> bigint_of_word second_arg
-  | _ -> raise Non_closed
-
-let uninterp_bigN rc =
-  try
-    Some (bigint_of_bigN rc)
-  with Non_closed ->
-    None
-
-
-(* declare the list of constructors of bigN used in the declaration of the
-   numeral interpreter *)
-
-let bigN_list_of_constructors =
-  let rec build i =
-    if i < n_inlined+1 then
-      GRef (Loc.ghost, bigN_constructor i,None)::(build (i+1))
-    else
-      []
-  in
-  build 0
-
-(* Actually declares the interpreter for bigN *)
-let _ = Notation.declare_numeral_interpreter bigN_scope
-  (bigN_path, bigN_module)
-  interp_bigN
-  (bigN_list_of_constructors,
-   uninterp_bigN,
-   true)
-
-
-(*** Parsing for bigZ in digital notation ***)
-let interp_bigZ dloc n =
-  let ref_pos = GRef (dloc, bigZ_pos, None) in
-  let ref_neg = GRef (dloc, bigZ_neg, None) in
-  if is_pos_or_zero n then
-    GApp (dloc, ref_pos, [bigN_of_pos_bigint dloc n])
-  else
-    GApp (dloc, ref_neg, [bigN_of_pos_bigint dloc (neg n)])
-
-(* pretty printing functions for bigZ *)
-let bigint_of_bigZ = function
-  | GApp (_, GRef(_,c,_), [one_arg]) when eq_gr c bigZ_pos -> bigint_of_bigN one_arg
-  | GApp (_, GRef(_,c,_), [one_arg]) when eq_gr c bigZ_neg ->
-      let opp_val = bigint_of_bigN one_arg in
-      if equal opp_val zero then
-	raise Non_closed
-      else
-	neg opp_val
-  | _ -> raise Non_closed
-
-
-let uninterp_bigZ rc =
-  try
-    Some (bigint_of_bigZ rc)
-  with Non_closed ->
-    None
-
-(* Actually declares the interpreter for bigZ *)
-let _ = Notation.declare_numeral_interpreter bigZ_scope
-  (bigZ_path, bigZ_module)
-  interp_bigZ
-  ([GRef (Loc.ghost, bigZ_pos, None);
-    GRef (Loc.ghost, bigZ_neg, None)],
-   uninterp_bigZ,
-   true)
-
-(*** Parsing for bigQ in digital notation ***)
-let interp_bigQ dloc n =
-  let ref_z = GRef (dloc, bigQ_z, None) in
-  GApp (dloc, ref_z, [interp_bigZ dloc n])
-
-let uninterp_bigQ rc =
-  try match rc with
-    | GApp (_, GRef(_,c,_), [one_arg]) when eq_gr c bigQ_z ->
-	Some (bigint_of_bigZ one_arg)
-    | _ -> None (* we don't pretty-print yet fractions *)
-  with Non_closed -> None
-
-(* Actually declares the interpreter for bigQ *)
-let _ = Notation.declare_numeral_interpreter bigQ_scope
-  (bigQ_path, bigQ_module)
-  interp_bigQ
-  ([GRef (Loc.ghost, bigQ_z, None)], uninterp_bigQ,
-   true)
diff --git a/plugins/syntax/numbers_syntax_plugin.mlpack b/plugins/syntax/numbers_syntax_plugin.mlpack
deleted file mode 100644
index e48c00a0..00000000
--- a/plugins/syntax/numbers_syntax_plugin.mlpack
+++ /dev/null
@@ -1 +0,0 @@
-Numbers_syntax
diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml
index 3ae2d45f..372e8ff3 100644
--- a/plugins/syntax/r_syntax.ml
+++ b/plugins/syntax/r_syntax.ml
@@ -1,14 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Names
 open Globnames
+open Glob_term
+open Bigint
 
 (* Poor's man DECLARE PLUGIN *)
 let __coq_plugin_name = "r_syntax_plugin"
@@ -17,108 +21,119 @@ let () = Mltop.add_known_module __coq_plugin_name
 exception Non_closed_number
 
 (**********************************************************************)
-(* Parsing R via scopes                                               *)
+(* Parsing positive via scopes                                        *)
 (**********************************************************************)
 
-open Glob_term
-open Bigint
+let binnums = ["Coq";"Numbers";"BinNums"]
 
 let make_dir l = DirPath.make (List.rev_map Id.of_string l)
-let rdefinitions = make_dir ["Coq";"Reals";"Rdefinitions"]
-let make_path dir id = Libnames.make_path 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 positive_path = make_path binnums "positive"
+
+(* TODO: temporary hack *)
+let make_kn dir id = Globnames.encode_mind dir id
+
+let positive_kn = make_kn (make_dir binnums) (Id.of_string "positive")
+let glob_positive = IndRef (positive_kn,0)
+let path_of_xI = ((positive_kn,0),1)
+let path_of_xO = ((positive_kn,0),2)
+let path_of_xH = ((positive_kn,0),3)
+let glob_xI = ConstructRef path_of_xI
+let glob_xO = ConstructRef path_of_xO
+let glob_xH = ConstructRef path_of_xH
+
+let pos_of_bignat ?loc x =
+  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) -> 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
+
+(**********************************************************************)
+(* Printing positive via scopes                                       *)
+(**********************************************************************)
+
+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
+
+(**********************************************************************)
+(* Parsing Z via scopes                                               *)
+(**********************************************************************)
+
+let z_path = make_path binnums "Z"
+let z_kn = make_kn (make_dir binnums) (Id.of_string "Z")
+let glob_z = IndRef (z_kn,0)
+let path_of_ZERO = ((z_kn,0),1)
+let path_of_POS = ((z_kn,0),2)
+let path_of_NEG = ((z_kn,0),3)
+let glob_ZERO = ConstructRef path_of_ZERO
+let glob_POS = ConstructRef path_of_POS
+let glob_NEG = ConstructRef path_of_NEG
+
+let z_of_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
+    DAst.make @@ GApp(DAst.make @@ GRef (sgn,None), [pos_of_bignat ?loc n])
+  else
+    DAst.make @@ GRef (glob_ZERO, None)
+
+(**********************************************************************)
+(* Printing Z via scopes                                              *)
+(**********************************************************************)
+
+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
 
+(**********************************************************************)
+(* Parsing R via scopes                                               *)
+(**********************************************************************)
+
+let rdefinitions = ["Coq";"Reals";"Rdefinitions"]
 let r_path = make_path rdefinitions "R"
 
 (* TODO: temporary hack *)
 let make_path dir id = Globnames.encode_con dir (Id.of_string id)
 
-let r_kn = make_path rdefinitions "R"
-let glob_R = ConstRef r_kn
-let glob_R1 = ConstRef (make_path rdefinitions "R1")
-let glob_R0 = ConstRef (make_path rdefinitions "R0")
-let glob_Ropp = ConstRef (make_path rdefinitions "Ropp")
-let glob_Rplus = ConstRef (make_path rdefinitions "Rplus")
-let glob_Rmult = ConstRef (make_path rdefinitions "Rmult")
-
-let two = mult_2 one
-let three = add_1 two
-let four = mult_2 two
-
-(* Unary representation of strictly positive numbers *)
-let rec small_r dloc n =
-  if equal one n then GRef (dloc, glob_R1, None)
-  else GApp(dloc,GRef (dloc,glob_Rplus, None),
-            [GRef (dloc, glob_R1, None);small_r dloc (sub_1 n)])
-
-let r_of_posint dloc n =
-  let r1 = GRef (dloc, glob_R1, None) in
-  let r2 = small_r dloc two in
-  let rec r_of_pos n =
-    if less_than n four then small_r dloc n
-    else
-      let (q,r) = div2_with_rest n in
-      let b = GApp(dloc,GRef(dloc,glob_Rmult,None),[r2;r_of_pos q]) in
-      if r then GApp(dloc,GRef(dloc,glob_Rplus,None),[r1;b]) else b in
-  if not (Bigint.equal n zero) then r_of_pos n else GRef(dloc,glob_R0,None)
-
-let r_of_int dloc z =
-  if is_strictly_neg z then
-    GApp (dloc, GRef(dloc,glob_Ropp,None), [r_of_posint dloc (neg z)])
-  else
-    r_of_posint dloc z
+let glob_IZR = ConstRef (make_path (make_dir rdefinitions) "IZR")
+
+let r_of_int ?loc z =
+  DAst.make @@ GApp (DAst.make @@ GRef(glob_IZR,None), [z_of_int ?loc z])
 
 (**********************************************************************)
 (* Printing R via scopes                                              *)
 (**********************************************************************)
 
-let bignat_of_r =
-(* for numbers > 1 *)
-let rec bignat_of_pos = function
-  (* 1+1 *)
-  | GApp (_,GRef (_,p,_), [GRef (_,o1,_); GRef (_,o2,_)])
-      when Globnames.eq_gr p glob_Rplus && Globnames.eq_gr o1 glob_R1 && Globnames.eq_gr o2 glob_R1 -> two
-  (* 1+(1+1) *)
-  | GApp (_,GRef (_,p1,_), [GRef (_,o1,_);
-      GApp(_,GRef (_,p2,_),[GRef(_,o2,_);GRef(_,o3,_)])])
-      when Globnames.eq_gr p1 glob_Rplus && Globnames.eq_gr p2 glob_Rplus &&
-           Globnames.eq_gr o1 glob_R1 && Globnames.eq_gr o2 glob_R1 && Globnames.eq_gr o3 glob_R1 -> three
-  (* (1+1)*b *)
-  | GApp (_,GRef (_,p,_), [a; b]) when Globnames.eq_gr p glob_Rmult ->
-      if not (Bigint.equal (bignat_of_pos a) two) then raise Non_closed_number;
-      mult_2 (bignat_of_pos b)
-  (* 1+(1+1)*b *)
-  | GApp (_,GRef (_,p1,_), [GRef (_,o,_); GApp (_,GRef (_,p2,_),[a;b])])
-      when Globnames.eq_gr p1 glob_Rplus && Globnames.eq_gr p2 glob_Rmult && Globnames.eq_gr o glob_R1  ->
-      if not (Bigint.equal (bignat_of_pos a) two) then raise Non_closed_number;
-        add_1 (mult_2 (bignat_of_pos b))
+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
-in
-let bignat_of_r = function
-  | GRef (_,a,_) when Globnames.eq_gr a glob_R0 -> zero
-  | GRef (_,a,_) when Globnames.eq_gr a glob_R1 -> one
-  | r -> bignat_of_pos r
-in
-bignat_of_r
-
-let bigint_of_r = function
-  | GApp (_,GRef (_,o,_), [a]) when Globnames.eq_gr o glob_Ropp ->
-      let n = bignat_of_r a in
-      if Bigint.equal n zero then raise Non_closed_number;
-      neg n
-  | a -> bignat_of_r a
-
-let uninterp_r p =
+
+let uninterp_r (AnyGlobConstr p) =
   try
     Some (bigint_of_r p)
   with Non_closed_number ->
     None
 
-let mkGRef gr = GRef (Loc.ghost,gr,None)
-
 let _ = Notation.declare_numeral_interpreter "R_scope"
   (r_path,["Coq";"Reals";"Rdefinitions"])
   r_of_int
-  (List.map mkGRef 
-    [glob_Ropp;glob_R0;glob_Rplus;glob_Rmult;glob_R1],
+  ([DAst.make @@ GRef (glob_IZR, None)],
     uninterp_r,
     false)
diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml
index de0fa77e..2421cc12 100644
--- a/plugins/syntax/string_syntax.ml
+++ b/plugins/syntax/string_syntax.ml
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 open Globnames
 open Ascii_syntax_plugin.Ascii_syntax
@@ -31,25 +33,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 dloc s =
+let interp_string ?loc s =
   let le = String.length s in
   let rec aux n =
-     if n = le then GRef (dloc, force glob_EmptyString, None) else
-     GApp (dloc,GRef (dloc, force glob_String, None),
-       [interp_ascii dloc (int_of_char s.[n]); aux (n+1)])
+     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
-    | GApp (_,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)
-    | 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 +67,6 @@ let _ =
   Notation.declare_string_interpreter "string_scope"
     (string_path,["Coq";"Strings";"String"])
     interp_string
-    ([GRef (Loc.ghost,static_glob_String,None);
-      GRef (Loc.ghost,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 60803a36..d5300e47 100644
--- a/plugins/syntax/z_syntax.ml
+++ b/plugins/syntax/z_syntax.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -44,37 +46,42 @@ let glob_xI = ConstructRef path_of_xI
 let glob_xO = ConstructRef path_of_xO
 let glob_xH = ConstructRef path_of_xH
 
-let pos_of_bignat dloc x =
-  let ref_xI = GRef (dloc, glob_xI, None) in
-  let ref_xH = GRef (dloc, glob_xH, None) in
-  let ref_xO = GRef (dloc, glob_xO, None) in
+let pos_of_bignat ?loc x = 
+  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) -> GApp (dloc, ref_xO,[pos_of q])
-      | (q,true) when not (Bigint.equal q zero) -> GApp (dloc,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
 
-let error_non_positive dloc =
-  user_err_loc (dloc, "interp_positive",
-    str "Only strictly positive numbers in type \"positive\".")
+let error_non_positive ?loc =
+  user_err ?loc ~hdr:"interp_positive"
+   (str "Only strictly positive numbers in type \"positive\".")
 
-let interp_positive dloc n =
-  if is_strictly_pos n then pos_of_bignat dloc n
-  else error_non_positive dloc
+let interp_positive ?loc n =
+  if is_strictly_pos n then pos_of_bignat ?loc n
+  else error_non_positive ?loc
 
 (**********************************************************************)
 (* Printing positive via scopes                                       *)
 (**********************************************************************)
 
-let rec bignat_of_pos = function
-  | GApp (_, GRef (_,b,_),[a]) when Globnames.eq_gr b glob_xO -> mult_2(bignat_of_pos a)
-  | GApp (_, GRef (_,b,_),[a]) when Globnames.eq_gr b glob_xI -> add_1(mult_2(bignat_of_pos a))
-  | GRef (_, a, _) when Globnames.eq_gr a glob_xH -> Bigint.one
+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 ->
@@ -87,9 +94,9 @@ let uninterp_positive p =
 let _ = Notation.declare_numeral_interpreter "positive_scope"
   (positive_path,binnums)
   interp_positive
-  ([GRef (Loc.ghost, glob_xI, None);
-    GRef (Loc.ghost, glob_xO, None);
-    GRef (Loc.ghost, glob_xH, None)],
+  ([DAst.make @@ GRef (glob_xI, None);
+    DAst.make @@ GRef (glob_xO, None);
+    DAst.make @@ GRef (glob_xH, None)],
    uninterp_positive,
    true)
 
@@ -106,29 +113,30 @@ let glob_Npos = ConstructRef path_of_Npos
 
 let n_path = make_path binnums "N"
 
-let n_of_binnat dloc pos_or_neg n =
+let n_of_binnat ?loc pos_or_neg n = DAst.make ?loc @@
   if not (Bigint.equal n zero) then
-    GApp(dloc, GRef (dloc,glob_Npos,None), [pos_of_bignat dloc n])
+    GApp(DAst.make @@ GRef (glob_Npos,None), [pos_of_bignat ?loc n])
   else
-    GRef (dloc, glob_N0, None)
+    GRef(glob_N0, None)
 
-let error_negative dloc =
-  user_err_loc (dloc, "interp_N", str "No negative numbers in type \"N\".")
+let error_negative ?loc =
+  user_err ?loc ~hdr:"interp_N" (str "No negative numbers in type \"N\".")
 
-let n_of_int dloc n =
-  if is_pos_or_zero n then n_of_binnat dloc true n
-  else error_negative dloc
+let n_of_int ?loc n =
+  if is_pos_or_zero n then n_of_binnat ?loc true n
+  else error_negative ?loc
 
 (**********************************************************************)
 (* Printing N via scopes                                              *)
 (**********************************************************************)
 
-let bignat_of_n = function
-  | GApp (_, GRef (_,b,_),[a]) when Globnames.eq_gr b glob_Npos -> bignat_of_pos a
-  | GRef (_, a,_) when Globnames.eq_gr a glob_N0 -> Bigint.zero
+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
 
@@ -138,8 +146,8 @@ let uninterp_n p =
 let _ = Notation.declare_numeral_interpreter "N_scope"
   (n_path,binnums)
   n_of_int
-  ([GRef (Loc.ghost, glob_N0, None);
-    GRef (Loc.ghost, glob_Npos, None)],
+  ([DAst.make @@ GRef (glob_N0, None);
+    DAst.make @@ GRef (glob_Npos, None)],
   uninterp_n,
   true)
 
@@ -157,25 +165,26 @@ let glob_ZERO = ConstructRef path_of_ZERO
 let glob_POS = ConstructRef path_of_POS
 let glob_NEG = ConstructRef path_of_NEG
 
-let z_of_int dloc n =
+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
-    GApp(dloc, GRef (dloc,sgn,None), [pos_of_bignat dloc n])
+    DAst.make ?loc @@ GApp(DAst.make ?loc @@ GRef(sgn,None), [pos_of_bignat ?loc n])
   else
-    GRef (dloc, glob_ZERO, None)
+    DAst.make ?loc @@ GRef(glob_ZERO, None)
 
 (**********************************************************************)
 (* Printing Z via scopes                                              *)
 (**********************************************************************)
 
-let bigint_of_z = function
-  | GApp (_, GRef (_,b,_),[a]) when Globnames.eq_gr b glob_POS -> bignat_of_pos a
-  | GApp (_, GRef (_,b,_),[a]) when Globnames.eq_gr b glob_NEG -> Bigint.neg (bignat_of_pos a)
-  | GRef (_, a, _) when Globnames.eq_gr a glob_ZERO -> Bigint.zero
+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
@@ -186,8 +195,8 @@ let uninterp_z p =
 let _ = Notation.declare_numeral_interpreter "Z_scope"
   (z_path,binnums)
   z_of_int
-  ([GRef (Loc.ghost, glob_ZERO, None);
-    GRef (Loc.ghost, glob_POS, None);
-    GRef (Loc.ghost, 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 e18aece0..84295959 100644
--- a/pretyping/arguments_renaming.ml
+++ b/pretyping/arguments_renaming.ml
@@ -1,18 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
 open Names
 open Globnames
 open Term
+open Constr
 open Environ
 open Util
 open Libobject
+
+module NamedDecl = Context.Named.Declaration
 (*i*)
 
 let name_table =
@@ -37,18 +42,12 @@ 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.UContext.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 (fun (id, _,_,_) -> Name id) vars in
+       let var_names = List.map (fst %> NamedDecl.get_id %> Name.mk_name) vars in
        let names' = var_names @ names in
        Some (ReqGlobal (c', names), (c', names'))
      with Not_found -> Some req)
@@ -101,7 +100,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 e123e778..65e3c3be 100644
--- a/pretyping/arguments_renaming.mli
+++ b/pretyping/arguments_renaming.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 6e4d7270..fe0f20f8 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -1,23 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+module CVars = Vars
+
 open Pp
 open CErrors
 open Util
 open Names
 open Nameops
-open Term
-open Vars
+open Constr
 open Termops
+open Environ
+open EConstr
+open Vars
 open Namegen
 open Declarations
 open Inductiveops
-open Environ
 open Reductionops
 open Type_errors
 open Glob_term
@@ -29,8 +34,11 @@ open Evardefine
 open Evarsolve
 open Evarconv
 open Evd
-open Sigma.Notations
 open Context.Rel.Declaration
+open Ltac_pretype
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 (* Pattern-matching errors *)
 
@@ -45,26 +53,26 @@ type pattern_matching_error =
 
 exception PatternMatchingError of env * evar_map * pattern_matching_error
 
-let raise_pattern_matching_error (loc,env,sigma,te) =
-  Loc.raise loc (PatternMatchingError(env,sigma,te))
+let raise_pattern_matching_error ?loc (env,sigma,te) =
+  Loc.raise ?loc (PatternMatchingError(env,sigma,te))
 
-let error_bad_pattern_loc loc env sigma cstr ind =
-  raise_pattern_matching_error
-    (loc, env, sigma, BadPattern (cstr,ind))
+let error_bad_pattern ?loc env sigma cstr ind =
+  raise_pattern_matching_error ?loc
+    (env, sigma, BadPattern (cstr,ind))
 
-let error_bad_constructor_loc loc env cstr ind =
-  raise_pattern_matching_error
-    (loc, env, Evd.empty, BadConstructor (cstr,ind))
+let error_bad_constructor ?loc env cstr ind =
+  raise_pattern_matching_error ?loc
+    (env, Evd.empty, BadConstructor (cstr,ind))
 
-let error_wrong_numarg_constructor_loc loc env c n =
-  raise_pattern_matching_error (loc, env, Evd.empty, WrongNumargConstructor(c,n))
+let error_wrong_numarg_constructor ?loc env c n =
+  raise_pattern_matching_error ?loc (env, Evd.empty, WrongNumargConstructor(c,n))
 
-let error_wrong_numarg_inductive_loc loc env c n =
-  raise_pattern_matching_error (loc, env, Evd.empty, WrongNumargInductive(c,n))
+let error_wrong_numarg_inductive ?loc env c n =
+  raise_pattern_matching_error ?loc (env, Evd.empty, WrongNumargInductive(c,n))
 
 let list_try_compile f l =
   let rec aux errors = function
-  | [] -> if errors = [] then anomaly (str "try_find_f") else iraise (List.last errors)
+  | [] -> if errors = [] then anomaly (str "try_find_f.") else iraise (List.last errors)
   | h::t ->
       try f h
       with UserError _ | TypeError _ | PretypeError _ | PatternMatchingError _ as e ->
@@ -89,33 +97,34 @@ let msg_may_need_inversion () =
 
 (* Utils *)
 let make_anonymous_patvars n =
-  List.make n (PatVar (Loc.ghost,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'] *)
 
 let relocate_rel n1 n2 k j = if Int.equal j (n1 + k) then n2+k else j
 
-let rec relocate_index n1 n2 k t = match kind_of_term t with
+let rec relocate_index sigma n1 n2 k t =
+  match EConstr.kind sigma t with
   | Rel j when Int.equal j (n1 + k) -> mkRel (n2+k)
   | Rel j when j < n1+k -> t
   | Rel j when j > n1+k -> t
-  | _ -> map_constr_with_binders succ (relocate_index n1 n2) k t
+  | _ -> EConstr.map_with_binders sigma succ (relocate_index sigma n1 n2) k t
 
 (**********************************************************************)
 (* Structures used in compiling pattern-matching *)
 
 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 =
     { patterns     : cases_pattern list;
       rhs          : 'a rhs;
       alias_stack  : Name.t list;
-      eqn_loc      : Loc.t;
+      eqn_loc      : Loc.t option;
       used         : bool ref }
 
 type 'a matrix = 'a equation list
@@ -135,7 +144,7 @@ type tomatch_status =
   | Pushed of (bool*((constr * tomatch_type) * int list * Name.t))
   | Alias of (bool*(Name.t * constr * (constr * types)))
   | NonDepAlias
-  | Abstract of int * Context.Rel.Declaration.t
+  | Abstract of int * rel_declaration
 
 type tomatch_stack = tomatch_status list
 
@@ -155,9 +164,9 @@ let feed_history arg = function
   | Continuation (n, l, h) when n>=1 ->
       Continuation (n-1, arg :: l, h)
   | Continuation (n, _, _) ->
-      anomaly (str "Bad number of expected remaining patterns: " ++ int n)
+      anomaly (str "Bad number of expected remaining patterns: " ++ int n ++ str ".")
   | Result _ ->
-      anomaly (Pp.str "Exhausted pattern history")
+      anomaly (Pp.str "Exhausted pattern history.")
 
 (* This is for non exhaustive error message *)
 
@@ -171,7 +180,7 @@ and build_glob_pattern args = function
   | Top -> args
   | MakeConstructor (pci, rh) ->
       glob_pattern_of_partial_history
-	[PatCstr (Loc.ghost, pci, args, Anonymous)] rh
+	[DAst.make @@ PatCstr (pci, args, Anonymous)] rh
 
 let complete_history = glob_pattern_of_partial_history []
 
@@ -181,12 +190,12 @@ let pop_history_pattern = function
   | Continuation (0, l, Top) ->
       Result (List.rev l)
   | Continuation (0, l, MakeConstructor (pci, rh)) ->
-      feed_history (PatCstr (Loc.ghost,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")
+      anomaly (Pp.str "Constructor not yet filled with its arguments.")
 
 let pop_history h =
-  feed_history (PatVar (Loc.ghost, Anonymous)) h
+  feed_history (DAst.make @@ PatVar Anonymous) h
 
 (* Builds a continuation expecting [n] arguments and building [ci] applied
    to this [n] arguments *)
@@ -239,12 +248,13 @@ let push_history_pattern n pci cont =
 
 type 'a pattern_matching_problem =
     { env       : env;
+      lvar      : Ltac_pretype.ltac_var_map;
       evdref    : evar_map ref;
       pred      : constr;
       tomatch   : tomatch_stack;
       history   : pattern_continuation;
       mat       : 'a matrix;
-      caseloc   : Loc.t;
+      caseloc   : Loc.t option;
       casestyle : case_style;
       typing_function: type_constraint -> env -> evar_map ref -> 'a option -> unsafe_judgment }
 
@@ -266,24 +276,29 @@ type 'a pattern_matching_problem =
 
 let rec find_row_ind = function
     [] -> None
-  | PatVar _ :: l -> find_row_ind l
-  | PatCstr(loc,c,_,_) :: _ -> 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
   let arsign = inductive_alldecls_env env indu in
-  let hole_source = match tmloc with
-    | Some loc -> fun i -> (loc, Evar_kinds.TomatchTypeParameter (ind,i))
-    | None -> fun _ -> (Loc.ghost, Evar_kinds.InternalHole) in
+  let indu = on_snd EInstance.make indu in
+  let hole_source i = match tmloc with
+    | Some loc -> Loc.tag ~loc @@ Evar_kinds.TomatchTypeParameter (ind,i)
+    | None     -> Loc.tag      @@ Evar_kinds.TomatchTypeParameter (ind,i) in
    let (_,evarl,_) =
     List.fold_right
       (fun decl (subst,evarl,n) ->
 	match decl with
         | LocalAssum (na,ty) ->
+            let ty = EConstr.of_constr ty in
 	    let ty' = substl subst ty in
 	    let e = e_new_evar env evdref ~src:(hole_source n) ty' in
 	    (e::subst,e::evarl,n+1)
 	| LocalDef (na,b,ty) ->
+            let b = EConstr.of_constr b in
 	    (substl subst b::subst,evarl,n+1))
       arsign ([],[],1) in
    applist (mkIndU indu,List.rev evarl)
@@ -307,9 +322,9 @@ let inh_coerce_to_ind evdref env loc ty tyi =
      un inductif cela doit être égal *)
   if not (e_cumul env evdref expected_typ ty) then evdref := sigma
 
-let binding_vars_of_inductive = function
+let binding_vars_of_inductive sigma = function
   | NotInd _ -> []
-  | IsInd (_,IndType(_,realargs),_) -> List.filter isRel realargs
+  | IsInd (_,IndType(_,realargs),_) -> List.filter (isRel sigma) realargs
 
 let extract_inductive_data env sigma decl =
   match decl with
@@ -317,7 +332,7 @@ let extract_inductive_data env sigma decl =
     let tmtyp =
       try try_find_ind env sigma t None
       with Not_found -> NotInd (None,t) in
-    let tmtypvars = binding_vars_of_inductive tmtyp in
+    let tmtypvars = binding_vars_of_inductive sigma tmtyp in
     (tmtyp,tmtypvars)
   | LocalDef (_,_,t) ->
     (NotInd (None, t), [])
@@ -332,35 +347,55 @@ let unify_tomatch_with_patterns evdref env loc typ pats realnames =
 
 let find_tomatch_tycon evdref env loc = function
   (* Try if some 'in I ...' is present and can be used as a constraint *)
-  | Some (_,ind,realnal) ->
+  | Some {CAst.v=(ind,realnal)} ->
       mk_tycon (inductive_template evdref env loc ind),Some (List.rev realnal)
   | None ->
       empty_tycon,None
 
-let coerce_row typing_fun evdref env pats (tomatch,(_,indopt)) =
-  let loc = Some (loc_of_glob_constr tomatch) in
+let make_return_predicate_ltac_lvar sigma na tm c lvar =
+  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
+       let ltac_idents = match kind sigma c with
+       | Var id' -> Id.Map.add id id' lvar.ltac_idents
+       | _ -> lvar.ltac_idents in
+       { lvar with ltac_genargs; ltac_idents }
+     else lvar
+  | _ -> lvar
+
+let ltac_interp_realnames lvar = function
+  | t, IsInd (ty,ind,realnal) -> t, IsInd (ty,ind,List.map (ltac_interp_name lvar) realnal)
+  | _ as x -> x
+
+let coerce_row typing_fun evdref env lvar pats (tomatch,(na,indopt)) =
+  let loc = loc_of_glob_constr tomatch in
   let tycon,realnames = find_tomatch_tycon evdref env loc indopt in
-  let j = typing_fun tycon env evdref tomatch in
-  let evd, j = Coercion.inh_coerce_to_base (loc_of_glob_constr tomatch) env !evdref j in
+  let j = typing_fun tycon env evdref !lvar tomatch in
+  let evd, j = Coercion.inh_coerce_to_base ?loc:(loc_of_glob_constr tomatch) env !evdref j in
   evdref := evd;
   let typ = nf_evar !evdref j.uj_type in
+  lvar := make_return_predicate_ltac_lvar !evdref na tomatch j.uj_val !lvar;
   let t =
     try try_find_ind env !evdref typ realnames
     with Not_found ->
       unify_tomatch_with_patterns evdref env loc typ pats realnames in
   (j.uj_val,t)
 
-let coerce_to_indtype typing_fun evdref env matx tomatchl =
+let coerce_to_indtype typing_fun evdref env lvar matx tomatchl =
   let pats = List.map (fun r ->  r.patterns) matx in
   let matx' = match matrix_transpose pats with
     | [] -> List.map (fun _ -> []) tomatchl (* no patterns at all *)
     | m -> m in
-  List.map2 (coerce_row typing_fun evdref env) matx' tomatchl
+  let lvar = ref lvar in
+  let tms = List.map2 (coerce_row typing_fun evdref env lvar) matx' tomatchl in
+  let tms = List.map (ltac_interp_realnames !lvar) tms in
+  !lvar,tms
 
 (************************************************************************)
 (* Utils *)
 
-let mkExistential env ?(src=(Loc.ghost,Evar_kinds.InternalHole)) evdref =
+let mkExistential env ?(src=(Loc.tag Evar_kinds.InternalHole)) evdref =
   let e, u = e_new_type_evar env evdref univ_flexible_alg ~src:src in e
 
 let evd_comb2 f evdref x y =
@@ -387,12 +422,12 @@ let adjust_tomatch_to_pattern pb ((current,typ),deps,dep) =
 	| Some (_,(ind,_)) ->
 	    let indt = inductive_template pb.evdref pb.env None ind in
 	    let current =
-	      if List.is_empty deps && isEvar typ then
+	      if List.is_empty deps && isEvar !(pb.evdref) typ then
 	      (* Don't insert coercions if dependent; only solve evars *)
 		let _ = e_cumul pb.env pb.evdref indt typ in
 		current
 	      else
-		(evd_comb2 (Coercion.inh_conv_coerce_to true Loc.ghost pb.env)
+		(evd_comb2 (Coercion.inh_conv_coerce_to true pb.env)
 		  pb.evdref (make_judge current typ) indt).uj_val in
 	    let sigma =  !(pb.evdref) in
 	    (current,try_find_ind pb.env sigma indt names))
@@ -406,7 +441,7 @@ let map_tomatch_type f = function
   | IsInd (t,ind,names) -> IsInd (f t,map_inductive_type f ind,names)
   | NotInd (c,t) -> NotInd (Option.map f c, f t)
 
-let liftn_tomatch_type n depth = map_tomatch_type (liftn n depth)
+let liftn_tomatch_type n depth = map_tomatch_type (Vars.liftn n depth)
 let lift_tomatch_type n = liftn_tomatch_type n 1
 
 (**********************************************************************)
@@ -415,11 +450,7 @@ let lift_tomatch_type n = liftn_tomatch_type n 1
 let current_pattern eqn =
   match eqn.patterns with
     | pat::_ -> pat
-    | [] -> anomaly (Pp.str "Empty list of patterns")
-
-let alias_of_pat = function
-  | PatVar (_,name) -> name
-  | PatCstr(_,_,_,name) -> name
+    | [] -> anomaly (Pp.str "Empty list of patterns.")
 
 let remove_current_pattern eqn =
   match eqn.patterns with
@@ -427,7 +458,7 @@ let remove_current_pattern eqn =
 	{ eqn with
 	    patterns = pats;
 	    alias_stack = alias_of_pat pat :: eqn.alias_stack }
-    | [] -> anomaly (Pp.str "Empty list of patterns")
+    | [] -> anomaly (Pp.str "Empty list of patterns.")
 
 let push_current_pattern (cur,ty) eqn =
   match eqn.patterns with
@@ -436,7 +467,7 @@ let push_current_pattern (cur,ty) eqn =
 	{ eqn with
             rhs = { eqn.rhs with rhs_env = rhs_env };
 	    patterns = pats }
-    | [] -> anomaly (Pp.str "Empty list of patterns")
+    | [] -> anomaly (Pp.str "Empty list of patterns.")
 
 (* spiwack: like [push_current_pattern] but does not introduce an
    alias in rhs_env. Aliasing binders are only useful for variables at
@@ -446,7 +477,7 @@ let push_noalias_current_pattern eqn =
   match eqn.patterns with
   | _::pats ->
       { eqn with patterns = pats }
-  | [] -> anomaly (Pp.str "push_noalias_current_pattern: Empty list of patterns")
+  | [] -> anomaly (Pp.str "push_noalias_current_pattern: Empty list of patterns.")
 
 
 
@@ -458,17 +489,18 @@ let prepend_pattern tms eqn = {eqn with patterns = tms@eqn.patterns }
 
 exception NotAdjustable
 
-let rec adjust_local_defs loc = function
+let rec adjust_local_defs ?loc = function
   | (pat :: pats, LocalAssum _ :: decls) ->
-      pat :: adjust_local_defs loc (pats,decls)
+      pat :: adjust_local_defs ?loc (pats,decls)
   | (pats, LocalDef _ :: decls) ->
-      PatVar (loc, 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
-  | PatVar _ as pat -> pat
-  | PatCstr (loc,((_,i) as cstr),args,alias) 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
@@ -478,35 +510,37 @@ let check_and_adjust_constructor env ind cstrs = function
 	if Int.equal (List.length args) nb_args_constr then pat
 	else
 	  try
-	    let args' = adjust_local_defs loc (args, List.rev ci.cs_args)
-	    in PatCstr (loc, cstr, args', alias)
+	    let args' = adjust_local_defs ?loc (args, List.rev ci.cs_args)
+	    in DAst.make ?loc @@ PatCstr (cstr, args', alias)
 	  with NotAdjustable ->
-	    error_wrong_numarg_constructor_loc loc env cstr nb_args_constr
+	    error_wrong_numarg_constructor ?loc env cstr nb_args_constr
       else
 	(* Try to insert a coercion *)
 	try
-	  Coercion.inh_pattern_coerce_to loc env pat ind' ind
+	  Coercion.inh_pattern_coerce_to ?loc env pat ind' ind
 	with Not_found ->
-	  error_bad_constructor_loc loc env cstr ind
+	  error_bad_constructor ?loc env cstr ind
 
 let check_all_variables env sigma typ mat =
   List.iter
-    (fun eqn -> match current_pattern eqn with
-       | PatVar (_,id) -> ()
-       | PatCstr (loc,cstr_sp,_,_) ->
-	   error_bad_pattern_loc loc env sigma cstr_sp typ)
+    (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
 
 let check_unused_pattern env eqn =
   if not !(eqn.used) then
-    raise_pattern_matching_error
-      (eqn.eqn_loc, env, Evd.empty, UnusedClause eqn.patterns)
+    raise_pattern_matching_error ?loc:eqn.eqn_loc (env, Evd.empty, UnusedClause eqn.patterns)
 
 let set_used_pattern eqn = eqn.used := true
 
 let extract_rhs pb =
   match pb.mat with
-    | [] -> errorlabstrm "build_leaf" (msg_may_need_inversion())
+    | [] -> user_err ~hdr:"build_leaf" (msg_may_need_inversion())
     | eqn::_ ->
 	set_used_pattern eqn;
         eqn.rhs
@@ -517,10 +551,10 @@ 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
-  | PatVar (_,name) -> Flags.is_program_mode () || occur_in_rhs name eqn.rhs
+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) =
@@ -533,19 +567,19 @@ let dependencies_in_pure_rhs nargs eqns =
   let deps_columns = matrix_transpose deps_rows in
   List.map (List.exists (fun x -> x)) deps_columns
 
-let dependent_decl a =
+let dependent_decl sigma a =
   function
-  | LocalAssum (na,t) -> dependent a t
-  | LocalDef (na,c,t) -> dependent a t || dependent a c
+  | LocalAssum (na,t) -> dependent sigma a t
+  | LocalDef (na,c,t) -> dependent sigma a t || dependent sigma a c
 
-let rec dep_in_tomatch n = function
-  | (Pushed _ | Alias _ | NonDepAlias) :: l -> dep_in_tomatch n l
-  | Abstract (_,d) :: l -> dependent_decl (mkRel n) d || dep_in_tomatch (n+1) l
+let rec dep_in_tomatch sigma n = function
+  | (Pushed _ | Alias _ | NonDepAlias) :: l -> dep_in_tomatch sigma n l
+  | Abstract (_,d) :: l -> dependent_decl sigma (mkRel n) d || dep_in_tomatch sigma (n+1) l
   | [] -> false
 
-let dependencies_in_rhs nargs current tms eqns =
-  match kind_of_term current with
-  | Rel n when dep_in_tomatch n tms -> List.make nargs true
+let dependencies_in_rhs sigma nargs current tms eqns =
+  match EConstr.kind sigma current with
+  | Rel n when dep_in_tomatch sigma n tms -> List.make nargs true
   | _ -> dependencies_in_pure_rhs nargs eqns
 
 (* Computing the matrix of dependencies *)
@@ -554,31 +588,30 @@ let dependencies_in_rhs nargs current tms eqns =
    declarations [d(i+1);...;dn] the term [tmi] is dependent in.
 
    [find_dependencies_signature (used1,...,usedn) ((tm1,d1),...,(tmn,dn))]
-   returns [(deps1,...,depsn)] where [depsi] is a subset of n,..,i+1
+   returns [(deps1,...,depsn)] where [depsi] is a subset of tm(i+1),..,tmn
    denoting in which of the d(i+1)...dn, the term tmi is dependent.
-   Dependencies are expressed by index, e.g. in dependency list
-   [n-2;1], [1] points to [dn] and [n-2] to [d3]
 *)
 
-let rec find_dependency_list tmblock = function
+let rec find_dependency_list sigma tmblock = function
   | [] -> []
-  | (used,tdeps,d)::rest ->
-      let deps = find_dependency_list tmblock rest in
-      if used && List.exists (fun x -> dependent_decl x d) tmblock
+  | (used,tdeps,tm,d)::rest ->
+      let deps = find_dependency_list sigma tmblock rest in
+      if used && List.exists (fun x -> dependent_decl sigma x d) tmblock
       then
-        List.add_set Int.equal
-          (List.length rest + 1) (List.union Int.equal deps tdeps)
+        match EConstr.kind sigma tm with
+        | Rel n -> List.add_set Int.equal n (List.union Int.equal deps tdeps)
+        | _ -> List.union Int.equal deps tdeps
       else deps
 
-let find_dependencies is_dep_or_cstr_in_rhs (tm,(_,tmtypleaves),d) nextlist =
-  let deps = find_dependency_list (tm::tmtypleaves) nextlist in
+let find_dependencies sigma is_dep_or_cstr_in_rhs (tm,(_,tmtypleaves),d) nextlist =
+  let deps = find_dependency_list sigma (tm::tmtypleaves) nextlist in
   if is_dep_or_cstr_in_rhs || not (List.is_empty deps)
-  then ((true ,deps,d)::nextlist)
-  else ((false,[]  ,d)::nextlist)
+  then ((true ,deps,tm,d)::nextlist)
+  else ((false,[]  ,tm,d)::nextlist)
 
-let find_dependencies_signature deps_in_rhs typs =
-  let l = List.fold_right2 find_dependencies deps_in_rhs typs [] in
-  List.map (fun (_,deps,_) -> deps) l
+let find_dependencies_signature sigma deps_in_rhs typs =
+  let l = List.fold_right2 (find_dependencies sigma) deps_in_rhs typs [] in
+  List.map (fun (_,deps,_,_) -> deps) l
 
 (* Assume we had terms t1..tq to match in a context xp:Tp,...,x1:T1 |-
    and xn:Tn has just been regeneralized into x:Tn so that the terms
@@ -591,31 +624,31 @@ let find_dependencies_signature deps_in_rhs typs =
    [relocate_index_tomatch 1 n tomatch] will go the way back.
  *)
 
-let relocate_index_tomatch n1 n2 =
+let relocate_index_tomatch sigma n1 n2 =
   let rec genrec depth = function
   | [] ->
       []
   | Pushed (b,((c,tm),l,na)) :: rest ->
-      let c = relocate_index n1 n2 depth c in
-      let tm = map_tomatch_type (relocate_index n1 n2 depth) tm in
+      let c = relocate_index sigma n1 n2 depth c in
+      let tm = map_tomatch_type (relocate_index sigma n1 n2 depth) tm in
       let l = List.map (relocate_rel n1 n2 depth) l in
       Pushed (b,((c,tm),l,na)) :: genrec depth rest
   | Alias (initial,(na,c,d)) :: rest ->
       (* [c] is out of relocation scope *)
-      Alias (initial,(na,c,map_pair (relocate_index n1 n2 depth) d)) :: genrec depth rest
+      Alias (initial,(na,c,map_pair (relocate_index sigma n1 n2 depth) d)) :: genrec depth rest
   | NonDepAlias :: rest ->
       NonDepAlias :: genrec depth rest
   | Abstract (i,d) :: rest ->
       let i = relocate_rel n1 n2 depth i in
-      Abstract (i, map_constr (relocate_index n1 n2 depth) d)
+      Abstract (i, RelDecl.map_constr (fun c -> relocate_index sigma n1 n2 depth c) d)
       :: genrec (depth+1) rest in
   genrec 0
 
 (* [replace_tomatch n c tomatch] replaces [Rel n] by [c] in [tomatch] *)
 
-let rec replace_term n c k t =
-  if isRel t && Int.equal (destRel t) (n + k) then lift k c
-  else map_constr_with_binders succ (replace_term n c) k t
+let rec replace_term sigma n c k t =
+  if isRel sigma t && Int.equal (destRel sigma t) (n + k) then Vars.lift k c
+  else EConstr.map_with_binders sigma succ (replace_term sigma n c) k t
 
 let length_of_tomatch_type_sign na t =
   let l = match na with
@@ -626,21 +659,21 @@ let length_of_tomatch_type_sign na t =
   | NotInd _ -> l
   | IsInd (_, _, names) -> List.length names + l
 
-let replace_tomatch n c =
+let replace_tomatch sigma n c =
   let rec replrec depth = function
   | [] -> []
   | Pushed (initial,((b,tm),l,na)) :: rest ->
-      let b = replace_term n c depth b in
-      let tm = map_tomatch_type (replace_term n c depth) tm in
-      List.iter (fun i -> if Int.equal i (n + depth) then anomaly (Pp.str "replace_tomatch")) l;
+      let b = replace_term sigma n c depth b in
+      let tm = map_tomatch_type (replace_term sigma n c depth) tm in
+      List.iter (fun i -> if Int.equal i (n + depth) then anomaly (Pp.str "replace_tomatch.")) l;
       Pushed (initial,((b,tm),l,na)) :: replrec depth rest
   | Alias (initial,(na,b,d)) :: rest ->
       (* [b] is out of replacement scope *)
-      Alias (initial,(na,b,map_pair (replace_term n c depth) d)) :: replrec depth rest
+      Alias (initial,(na,b,map_pair (replace_term sigma n c depth) d)) :: replrec depth rest
   | NonDepAlias  :: rest ->
       NonDepAlias :: replrec depth rest
   | Abstract (i,d) :: rest ->
-      Abstract (i, map_constr (replace_term n c depth) d)
+      Abstract (i, RelDecl.map_constr (fun t -> replace_term sigma n c depth t) d)
       :: replrec (depth+1) rest in
   replrec 0
 
@@ -665,7 +698,7 @@ let rec liftn_tomatch_stack n depth = function
       NonDepAlias :: liftn_tomatch_stack n depth rest
   | Abstract (i,d)::rest ->
       let i = if i<depth then i else i+n in
-      Abstract (i, map_constr (liftn n depth) d)
+      Abstract (i, RelDecl.map_constr (liftn n depth) d)
       ::(liftn_tomatch_stack n (depth+1) rest)
 
 let lift_tomatch_stack n = liftn_tomatch_stack n 1
@@ -700,7 +733,7 @@ let merge_name get_name obj = function
 
 let merge_names get_name = List.map2 (merge_name get_name)
 
-let get_names env sign eqns =
+let get_names env sigma sign eqns =
   let names1 = List.make (Context.Rel.length sign) Anonymous in
   (* If any, we prefer names used in pats, from top to bottom *)
   let names2,aliasname =
@@ -712,17 +745,17 @@ let get_names env 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 ->
 	 let na =
 	   merge_name
-	     (fun (LocalAssum (na,t) | LocalDef (na,_,t)) -> Name (next_name_away (named_hd env t na) avoid))
+	     (fun (LocalAssum (na,t) | LocalDef (na,_,t)) -> Name (next_name_away (named_hd env sigma t na) avoid))
 	     d na
 	 in
-         (na::l,(out_name na)::avoid))
+         (na::l,Id.Set.add (Name.get_id na) avoid))
       ([],allvars) (List.rev sign) names2 in
   names3,aliasname
 
@@ -733,7 +766,7 @@ let get_names env sign eqns =
 (* We now replace the names y1 .. yn y by the actual names       *)
 (* xi1 .. xin xi to be found in the i-th clause of the matrix    *)
 
-let recover_initial_subpattern_names = List.map2 set_name
+let recover_initial_subpattern_names = List.map2 RelDecl.set_name
 
 let recover_and_adjust_alias_names names sign =
   let rec aux = function
@@ -742,7 +775,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 ->
-      (PatVar (Loc.ghost,na), decl) :: aux (names,sign)
+      (DAst.make @@ PatVar na, decl) :: aux (names,sign)
   | _ -> assert false
   in
   List.split (aux (names,sign))
@@ -758,11 +791,11 @@ let push_rels_eqn_with_names sign eqn =
   push_rels_eqn sign eqn
 
 let push_generalized_decl_eqn env n decl eqn =
-  match get_name decl with
+  match RelDecl.get_name decl with
   | Anonymous ->
       push_rels_eqn [decl] eqn
   | Name _ ->
-      push_rels_eqn [set_name (get_name (Environ.lookup_rel n eqn.rhs.rhs_env)) decl] eqn
+      push_rels_eqn [RelDecl.set_name (RelDecl.get_name (Environ.lookup_rel n eqn.rhs.rhs_env)) decl] eqn
 
 let drop_alias_eqn eqn =
   { eqn with alias_stack = List.tl eqn.alias_stack }
@@ -770,7 +803,7 @@ let drop_alias_eqn eqn =
 let push_alias_eqn alias eqn =
   let aliasname = List.hd eqn.alias_stack in
   let eqn = drop_alias_eqn eqn in
-  let alias = set_name aliasname alias in
+  let alias = RelDecl.set_name aliasname alias in
   push_rels_eqn [alias] eqn
 
 (**********************************************************************)
@@ -830,13 +863,13 @@ let rec map_predicate f k ccl = function
   | Abstract _ :: rest ->
       map_predicate f (k+1) ccl rest
 
-let noccur_predicate_between n = map_predicate (noccur_between n)
+let noccur_predicate_between sigma n = map_predicate (noccur_between sigma n)
 
 let liftn_predicate n = map_predicate (liftn n)
 
 let lift_predicate n = liftn_predicate n 1
 
-let regeneralize_index_predicate n = map_predicate (relocate_index n 1) 0
+let regeneralize_index_predicate sigma n = map_predicate (relocate_index sigma n 1) 0
 
 let substnl_predicate sigma = map_predicate (substnl sigma)
 
@@ -847,7 +880,7 @@ let subst_predicate (subst,copt) ccl tms =
     | Some c -> c::subst in
   substnl_predicate sigma 0 ccl tms
 
-let specialize_predicate_var (cur,typ,dep) tms ccl =
+let specialize_predicate_var (cur,typ,dep) env tms ccl =
   let c = match dep with
   | Anonymous -> None
   | Name _ -> Some cur
@@ -855,7 +888,10 @@ let specialize_predicate_var (cur,typ,dep) tms ccl =
   let l =
     match typ with
     | IsInd (_, IndType (_, _), []) -> []
-    | IsInd (_, IndType (_, realargs), names) -> realargs
+    | IsInd (_, IndType (indf, realargs), names) ->
+       let arsign,_ = get_arity env indf in
+       let arsign = List.map EConstr.of_rel_decl arsign in
+       subst_of_rel_context_instance arsign realargs
     | NotInd _ -> [] in
   subst_predicate (l,c) ccl tms
 
@@ -868,13 +904,13 @@ let specialize_predicate_var (cur,typ,dep) tms ccl =
 (* We first need to lift t(x) s.t. it is typed in Gamma, X:=rargs, x'        *)
 (* then we have to replace x by x' in t(x) and y by y' in P                  *)
 (*****************************************************************************)
-let generalize_predicate (names,na) ny d tms ccl =
+let generalize_predicate sigma (names,na) ny d tms ccl =
   let () = match na with
-  | Anonymous -> anomaly (Pp.str "Undetected dependency")
+  | Anonymous -> anomaly (Pp.str "Undetected dependency.")
   | _ -> () in
   let p = List.length names + 1 in
   let ccl = lift_predicate 1 ccl tms in
-  regeneralize_index_predicate (ny+p+1) ccl tms
+  regeneralize_index_predicate sigma (ny+p+1) ccl tms
 
 (*****************************************************************************)
 (* We just matched over cur:ind(realargs) in the following matching problem  *)
@@ -916,16 +952,16 @@ let rec extract_predicate ccl = function
       ccl
 
 let abstract_predicate env sigma indf cur realargs (names,na) tms ccl =
-  let sign = make_arity_signature env true indf in
+  let sign = make_arity_signature env sigma true indf in
   (* n is the number of real args + 1 (+ possible let-ins in sign) *)
   let n = List.length sign in
   (* Before abstracting we generalize over cur and on those realargs *)
   (* that are rels, consistently with the specialization made in     *)
   (* build_branch                                                    *)
   let tms = List.fold_right2 (fun par arg tomatch ->
-    match kind_of_term par with
-    | Rel i -> relocate_index_tomatch (i+n) (destRel arg) tomatch
-    | _ -> tomatch) (realargs@[cur]) (Context.Rel.to_extended_list 0 sign)
+    match EConstr.kind sigma par with
+    | Rel i -> relocate_index_tomatch sigma (i+n) (destRel sigma arg) tomatch
+    | _ -> tomatch) (realargs@[cur]) (Context.Rel.to_extended_list EConstr.mkRel 0 sign)
        (lift_tomatch_stack n tms) in
   (* Pred is already dependent in the current term to match (if      *)
   (* (na<>Anonymous) and its realargs; we just need to adjust it to  *)
@@ -937,7 +973,7 @@ let abstract_predicate env sigma indf cur realargs (names,na) tms ccl =
   let pred = extract_predicate ccl tms in
   (* Build the predicate properly speaking *)
   let sign = List.map2 set_name (na::names) sign in
-  it_mkLambda_or_LetIn_name env pred sign
+  it_mkLambda_or_LetIn_name env sigma pred sign
 
 (* [expand_arg] is used by [specialize_predicate]
    if Yk denotes [Xk;xk] or [Xk],
@@ -949,34 +985,37 @@ let expand_arg tms (p,ccl) ((_,t),_,na) =
   let k = length_of_tomatch_type_sign na t in
   (p+k,liftn_predicate (k-1) (p+1) ccl tms)
 
-
 let use_unit_judge evd =
   let j, ctx = coq_unit_judge () in
   let evd' = Evd.merge_context_set Evd.univ_flexible_alg evd ctx in
     evd', j
 
 let add_assert_false_case pb tomatch =
-  let pats = List.map (fun _ -> PatVar (Loc.ghost,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 = Loc.ghost;
+      eqn_loc = None;
       used = ref false } ]
 
 let adjust_impossible_cases pb pred tomatch submat =
   match submat with
   | [] ->
-    begin match kind_of_term pred with
+    (** FIXME: This breaks if using evar-insensitive primitives. In particular,
+        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 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
-	  pb.evdref := Evd.define evk default.uj_type evd
+	  pb.evdref := Evd.define evk (EConstr.Unsafe.to_constr default.uj_type) evd
         end;
         add_assert_false_case pb tomatch
     | _ ->
@@ -1022,12 +1061,13 @@ let specialize_predicate newtomatchs (names,depna) arsign cs tms ccl =
   (* We prepare the substitution of X and x:I(X) *)
   let realargsi =
     if not (Int.equal nrealargs 0) then
-      subst_of_rel_context_instance arsign (Array.to_list cs.cs_concl_realargs)
+      CVars.subst_of_rel_context_instance arsign (Array.to_list cs.cs_concl_realargs)
     else
       [] in
+  let realargsi = List.map EConstr.of_constr realargsi in
   let copti = match depna with
   | Anonymous -> None
-  | Name _ -> Some (build_dependent_constructor cs)
+  | Name _ -> Some (EConstr.of_constr (build_dependent_constructor cs))
   in
   (* The substituends realargsi, copti are all defined in gamma, x1...xn *)
   (* We need _parallel_ bindings to get gamma, x1...xn |- PI tms. ccl'' *)
@@ -1063,69 +1103,69 @@ let adjust_predicate_from_tomatch tomatch (current,typ as ct) pb =
 (* Remove commutative cuts that turn out to be non-dependent after
    some evars have been instantiated *)
 
-let rec ungeneralize n ng body =
-  match kind_of_term body with
+let rec ungeneralize sigma n ng body =
+  match EConstr.kind sigma body with
   | Lambda (_,_,c) when Int.equal ng 0 ->
       subst1 (mkRel n) c
   | Lambda (na,t,c) ->
       (* We traverse an inner generalization *)
-      mkLambda (na,t,ungeneralize (n+1) (ng-1) c)
+      mkLambda (na,t,ungeneralize sigma (n+1) (ng-1) c)
   | LetIn (na,b,t,c) ->
       (* We traverse an alias *)
-      mkLetIn (na,b,t,ungeneralize (n+1) ng c)
+      mkLetIn (na,b,t,ungeneralize sigma (n+1) ng c)
   | Case (ci,p,c,brs) ->
       (* We traverse a split *)
       let p =
-        let sign,p = decompose_lam_assum p in
-        let sign2,p = decompose_prod_n_assum ng p in
-        let p = prod_applist p [mkRel (n+List.length sign+ng)] in
+        let sign,p = decompose_lam_assum sigma p in
+        let sign2,p = decompose_prod_n_assum sigma ng p in
+        let p = prod_applist sigma p [mkRel (n+List.length sign+ng)] in
         it_mkLambda_or_LetIn (it_mkProd_or_LetIn p sign2) sign in
       mkCase (ci,p,c,Array.map2 (fun q c ->
-        let sign,b = decompose_lam_n_decls q c in
-        it_mkLambda_or_LetIn (ungeneralize (n+q) ng b) sign)
+        let sign,b = decompose_lam_n_decls sigma q c in
+        it_mkLambda_or_LetIn (ungeneralize sigma (n+q) ng b) sign)
         ci.ci_cstr_ndecls brs)
   | App (f,args) ->
       (* We traverse an inner generalization *)
-      assert (isCase f);
-      mkApp (ungeneralize n (ng+Array.length args) f,args)
+      assert (isCase sigma f);
+      mkApp (ungeneralize sigma n (ng+Array.length args) f,args)
   | _ -> assert false
 
-let ungeneralize_branch n k (sign,body) cs =
-  (sign,ungeneralize (n+cs.cs_nargs) k body)
+let ungeneralize_branch sigma n k (sign,body) cs =
+  (sign,ungeneralize sigma (n+cs.cs_nargs) k body)
 
-let rec is_dependent_generalization ng body =
-  match kind_of_term body with
+let rec is_dependent_generalization sigma ng body =
+  match EConstr.kind sigma body with
   | Lambda (_,_,c) when Int.equal ng 0 ->
-      dependent (mkRel 1) c
+      not (noccurn sigma 1 c)
   | Lambda (na,t,c) ->
       (* We traverse an inner generalization *)
-      is_dependent_generalization (ng-1) c
+      is_dependent_generalization sigma (ng-1) c
   | LetIn (na,b,t,c) ->
       (* We traverse an alias *)
-      is_dependent_generalization ng c
+      is_dependent_generalization sigma ng c
   | Case (ci,p,c,brs) ->
       (* We traverse a split *)
       Array.exists2 (fun q c ->
-        let _,b = decompose_lam_n_decls q c in
-        is_dependent_generalization ng b)
+        let _,b = decompose_lam_n_decls sigma q c in
+        is_dependent_generalization sigma ng b)
         ci.ci_cstr_ndecls brs
   | App (g,args) ->
       (* We traverse an inner generalization *)
-      assert (isCase g);
-      is_dependent_generalization (ng+Array.length args) g
+      assert (isCase sigma g);
+      is_dependent_generalization sigma (ng+Array.length args) g
   | _ -> assert false
 
-let is_dependent_branch k (_,br) =
-  is_dependent_generalization k br
+let is_dependent_branch sigma k (_,br) =
+  is_dependent_generalization sigma k br
 
 let postprocess_dependencies evd tocheck brs tomatch pred deps cs =
   let rec aux k brs tomatch pred tocheck deps = match deps, tomatch with
   | [], _ -> brs,tomatch,pred,[]
   | n::deps, Abstract (i,d) :: tomatch ->
-      let d = map_constr (nf_evar evd) d in
+      let d = map_constr (fun c -> nf_evar evd c) d in
       let is_d = match d with LocalAssum _ -> false | LocalDef _ -> true in
-      if is_d || List.exists (fun c -> dependent_decl (lift k c) d) tocheck
-                 && Array.exists (is_dependent_branch k) brs then
+      if is_d || List.exists (fun c -> dependent_decl evd (lift k c) d) tocheck
+                 && Array.exists (is_dependent_branch evd k) brs then
         (* Dependency in the current term to match and its dependencies is real *)
         let brs,tomatch,pred,inst = aux (k+1) brs tomatch pred (mkRel n::tocheck) deps in
         let inst = match d with
@@ -1138,9 +1178,9 @@ let postprocess_dependencies evd tocheck brs tomatch pred deps cs =
         (* terms by its actual value in both the remaining terms to match and *)
         (* the bodies of the Case *)
         let pred = lift_predicate (-1) pred tomatch in
-        let tomatch = relocate_index_tomatch 1 (n+1) tomatch in
+        let tomatch = relocate_index_tomatch evd 1 (n+1) tomatch in
         let tomatch = lift_tomatch_stack (-1) tomatch in
-        let brs = Array.map2 (ungeneralize_branch n k) brs cs in
+        let brs = Array.map2 (ungeneralize_branch evd n k) brs cs in
         aux k brs tomatch pred tocheck deps
   | _ -> assert false
   in aux 0 brs tomatch pred tocheck deps
@@ -1148,9 +1188,9 @@ let postprocess_dependencies evd tocheck brs tomatch pred deps cs =
 (************************************************************************)
 (* Sorting equations by constructor *)
 
-let rec irrefutable env = function
-  | PatVar (_,name) -> true
-  | 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
@@ -1170,15 +1210,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
-	   | 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
-	   | PatCstr (loc,((_,i)),args,name) ->
+	   | PatCstr (((_,i)),args,name) ->
 	       (* This is a regular clause *)
 	       only_default := Some false;
 	       brs.(i-1) <- (args, name, rest) :: brs.(i-1)) mat () in
@@ -1192,17 +1232,17 @@ let rec generalize_problem names pb = function
   | [] -> pb, []
   | i::l ->
       let pb',deps = generalize_problem names pb l in
-      let d = map_constr (lift i) (Environ.lookup_rel i pb.env) in
+      let d = map_constr (lift i) (lookup_rel i pb.env) in
       begin match d with
       | LocalDef (Anonymous,_,_) -> pb', deps
       | _ ->
 	 (* for better rendering *)
-	let d = map_type (whd_betaiota !(pb.evdref)) d in
+	let d = RelDecl.map_type (fun c -> whd_betaiota !(pb.evdref) c) d in
         let tomatch = lift_tomatch_stack 1 pb'.tomatch in
-        let tomatch = relocate_index_tomatch (i+1) 1 tomatch in
+        let tomatch = relocate_index_tomatch !(pb.evdref) (i+1) 1 tomatch in
         { pb' with
             tomatch = Abstract (i,d) :: tomatch;
-            pred = generalize_predicate names i d pb'.tomatch pb'.pred  },
+            pred = generalize_predicate !(pb'.evdref) names i d pb'.tomatch pb'.pred  },
         i::deps
       end
 
@@ -1224,10 +1264,17 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   (* build the name x1..xn from the names present in the equations *)
   (* that had matched constructor C *)
   let cs_args = const_info.cs_args in
-  let names,aliasname = get_names pb.env cs_args eqns in
-  let typs = List.map2 set_name names cs_args
+  let cs_args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cs_args in
+  let names,aliasname = get_names pb.env !(pb.evdref) cs_args eqns in
+  let typs = List.map2 RelDecl.set_name names cs_args
   in
 
+  (* Beta-iota-normalize types to better compatibility of refine with 8.4 behavior *)
+  (* 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.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 *)
   (* a matching on "x1 .. xn eqn" *)
@@ -1247,35 +1294,35 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   (* We compute over which of x(i+1)..xn and x matching on xi will need a *)
   (* generalization *)
   let dep_sign =
-    find_dependencies_signature
-      (dependencies_in_rhs const_info.cs_nargs current pb.tomatch eqns)
+    find_dependencies_signature !(pb.evdref)
+      (dependencies_in_rhs !(pb.evdref) const_info.cs_nargs current pb.tomatch eqns)
       (List.rev typs') in
 
   (* The dependent term to subst in the types of the remaining UnPushed
      terms is relative to the current context enriched by topushs *)
-  let ci = build_dependent_constructor const_info in
+  let ci = EConstr.of_constr (build_dependent_constructor const_info) in
 
   (* Current context Gamma has the form Gamma1;cur:I(realargs);Gamma2 *)
   (* We go from Gamma |- PI tms. pred to                              *)
   (* Gamma;x1..xn;curalias:I(x1..xn) |- PI tms'. pred'                *)
   (* where, in tms and pred, those realargs that are vars are         *)
   (* replaced by the corresponding xi and cur replaced by curalias    *)
-  let cirealargs = Array.to_list const_info.cs_concl_realargs in
+  let cirealargs = Array.map_to_list EConstr.of_constr const_info.cs_concl_realargs in
 
   (* Do the specialization for terms to match *)
   let tomatch = List.fold_right2 (fun par arg tomatch ->
-    match kind_of_term par with
-    | Rel i -> replace_tomatch (i+const_info.cs_nargs) arg tomatch
+    match EConstr.kind !(pb.evdref) par with
+    | Rel i -> replace_tomatch !(pb.evdref) (i+const_info.cs_nargs) arg tomatch
     | _ -> tomatch) (current::realargs) (ci::cirealargs)
       (lift_tomatch_stack const_info.cs_nargs pb.tomatch) in
 
   let pred_is_not_dep =
-    noccur_predicate_between 1 (List.length realnames + 1) pb.pred tomatch in
+    noccur_predicate_between !(pb.evdref) 1 (List.length realnames + 1) pb.pred tomatch in
 
   let typs' =
     List.map2
       (fun (tm, (tmtyp,_), decl) deps ->
-        let na = get_name decl in
+        let na = RelDecl.get_name decl in
 	let na = match curname, na with
 	| Name _, Anonymous -> curname
 	| Name _, Name _ -> na
@@ -1296,10 +1343,10 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   | Name _ ->
       let cur_alias = lift const_info.cs_nargs current in
       let ind =
-        appvect (
-          applist (mkIndU (inductive_of_constructor (fst const_info.cs_cstr), snd const_info.cs_cstr),
-                   List.map (lift const_info.cs_nargs) const_info.cs_params),
-          const_info.cs_concl_realargs) in
+        mkApp (
+          applist (mkIndU (inductive_of_constructor (fst const_info.cs_cstr), EInstance.make (snd const_info.cs_cstr)),
+                   List.map (EConstr.of_constr %> lift const_info.cs_nargs) const_info.cs_params),
+          Array.map EConstr.of_constr const_info.cs_concl_realargs) in
       Alias (initial,(aliasname,cur_alias,(ci,ind))) in
 
   let tomatch = List.rev_append (alias :: currents) tomatch in
@@ -1307,8 +1354,7 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   let submat = adjust_impossible_cases pb pred tomatch submat in
   let () = match submat with
   | [] ->
-    raise_pattern_matching_error
-      (Loc.ghost, pb.env, Evd.empty, NonExhaustive (complete_history history))
+    raise_pattern_matching_error (pb.env, Evd.empty, NonExhaustive (complete_history history))
   | _ -> ()
   in
 
@@ -1366,23 +1412,24 @@ and match_current pb (initial,tomatch) =
 	  (* We compile branches *)
 	  let brvals = Array.map2 (compile_branch initial current realargs (names,dep) deps pb arsign) eqns cstrs in
 	  (* We build the (elementary) case analysis *)
-          let depstocheck = current::binding_vars_of_inductive typ in
+          let depstocheck = current::binding_vars_of_inductive !(pb.evdref) typ in
           let brvals,tomatch,pred,inst =
             postprocess_dependencies !(pb.evdref) depstocheck
               brvals pb.tomatch pb.pred deps cstrs in
           let brvals = Array.map (fun (sign,body) ->
+            let sign = List.map (map_name (ltac_interp_name pb.lvar)) sign in
             it_mkLambda_or_LetIn body sign) brvals in
 	  let (pred,typ) =
 	    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 indf ci pred current brvals
+	    make_case_or_project pb.env !(pb.evdref) indf ci pred current brvals
 	  in
 	  Typing.check_allowed_sort pb.env !(pb.evdref) mind current pred;
 	  { uj_val = applist (case, inst);
-	    uj_type = prod_applist typ inst }
+	    uj_type = prod_applist !(pb.evdref) typ inst }
 
 
 (* Building the sub-problem when all patterns are variables. Case
@@ -1390,7 +1437,7 @@ and match_current pb (initial,tomatch) =
 and shift_problem ((current,t),_,na) pb =
   let ty = type_of_tomatch t in
   let tomatch = lift_tomatch_stack 1 pb.tomatch in
-  let pred = specialize_predicate_var (current,t,na) pb.tomatch pb.pred in
+  let pred = specialize_predicate_var (current,t,na) pb.env pb.tomatch pb.pred in
   let pb =
     { pb with
        env = push_rel (LocalDef (na,current,ty)) pb.env;
@@ -1407,7 +1454,7 @@ and shift_problem ((current,t),_,na) pb =
    are already introduced in the context, we avoid creating aliases to
    themselves by treating this case specially. *)
 and pop_problem ((current,t),_,na) pb =
-  let pred = specialize_predicate_var (current,t,na) pb.tomatch pb.pred in
+  let pred = specialize_predicate_var (current,t,na) pb.env pb.tomatch pb.pred in
   let pb =
     { pb with
        pred = pred;
@@ -1450,8 +1497,9 @@ and compile_alias initial pb (na,orig,(expanded,expanded_typ)) rest =
          history = pop_history_pattern pb.history;
          mat = List.map (push_alias_eqn alias) pb.mat } in
     let j = compile pb in
+    let sigma = !(pb.evdref) in
     { uj_val =
-        if isRel c || isVar c || count_occurrences (mkRel 1) j.uj_val <= 1 then
+        if isRel sigma c || isVar sigma c || count_occurrences sigma (mkRel 1) j.uj_val <= 1 then
           subst1 c j.uj_val
         else
           mkLetIn (na,c,t,j.uj_val);
@@ -1476,10 +1524,10 @@ and compile_alias initial pb (na,orig,(expanded,expanded_typ)) rest =
      evaluation; the drawback is that it might duplicate the instances
      of the term to match when the corresponding variable is
      substituted by a non-evaluated expression *)
-  if not (Flags.is_program_mode ()) && (isRel orig || isVar orig) then
+  if not (Flags.is_program_mode ()) && (isRel sigma orig || isVar sigma orig) then
     (* Try to compile first using non expanded alias *)
     try
-      if initial then f orig (Retyping.get_type_of pb.env !(pb.evdref) orig)
+      if initial then f orig (Retyping.get_type_of pb.env sigma orig)
       else just_pop ()
     with e when precatchable_exception e ->
     (* Try then to compile using expanded alias *)
@@ -1515,15 +1563,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 {CAst.loc;v=(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 = [];
@@ -1560,7 +1608,7 @@ let matx_of_eqns env eqns =
    returning True never happens and any inhabited type can be put instead).
 *)
 
-let adjust_to_extended_env_and_remove_deps env extenv subst t =
+let adjust_to_extended_env_and_remove_deps env extenv sigma subst t =
   let n = Context.Rel.length (rel_context env) in
   let n' = Context.Rel.length (rel_context extenv) in
   (* We first remove the bindings that are dependently typed (they are
@@ -1578,11 +1626,11 @@ let adjust_to_extended_env_and_remove_deps env extenv subst t =
     let (p, _, _) = lookup_rel_id x (rel_context extenv) in
     let rec traverse_local_defs p =
       match lookup_rel p extenv with
-      | LocalDef (_,c,_) -> assert (isRel c); traverse_local_defs (p + destRel c)
+      | LocalDef (_,c,_) -> assert (isRel sigma c); traverse_local_defs (p + destRel sigma c)
       | LocalAssum _ -> p in
     let p = traverse_local_defs p in
     let u = lift (n' - n) u in
-    try Some (p, u, expand_vars_in_term extenv u)
+    try Some (p, u, expand_vars_in_term extenv sigma u)
       (* pedrot: does this really happen to raise [Failure _]? *)
     with Failure _ -> None in
   let subst0 = List.map_filter map subst in
@@ -1611,19 +1659,19 @@ let rec list_assoc_in_triple x = function
  * similarly for each ti.
 *)
 
-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 src = match kind_of_term t with
-    | Evar (evk,_) -> (loc,Evar_kinds.SubEvar evk)
-    | _ -> (loc,Evar_kinds.CasesType true) in
-  let subst0,t0 = adjust_to_extended_env_and_remove_deps env extenv subst t in
+let abstract_tycon ?loc env evdref subst tycon extenv t =
+  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
+  let subst0,t0 = adjust_to_extended_env_and_remove_deps env extenv !evdref subst t in
   (* We traverse the type T of the original problem Xi looking for subterms
      that match the non-constructor part of the constraints (this part
      is in subst); these subterms are the "good" subterms and we replace them
      by an evar that may depend (and only depend) on the corresponding
      convertible subterms of the substitution *)
   let rec aux (k,env,subst as x) t =
-    let t = whd_evar !evdref t in match kind_of_term t with
+    match EConstr.kind !evdref t with
     | Rel n when is_local_def (lookup_rel n env) -> t
     | Evar ev ->
         let ty = get_type_of env !evdref t in
@@ -1643,7 +1691,7 @@ let abstract_tycon loc env evdref subst tycon extenv t =
     let good = List.filter (fun (_,u,_) -> is_conv_leq env !evdref t u) subst in
     match good with
     | [] ->
-      map_constr_with_full_binders push_binder aux x t
+      map_constr_with_full_binders !evdref push_binder aux x t
     | (_, _, u) :: _ -> (* u is in extenv *)
       let vl = List.map pi1 good in
       let ty = 
@@ -1651,17 +1699,16 @@ let abstract_tycon loc env evdref subst tycon extenv t =
 	  Evarutil.evd_comb1 (refresh_universes (Some false) env) evdref ty
       in
       let ty = lift (-k) (aux x ty) in
-      let depvl = free_rels ty in
+      let depvl = free_rels !evdref ty in
       let inst =
 	List.map_i
 	  (fun i _ -> if Int.List.mem i vl then u else mkRel i) 1
 	  (rel_context extenv) in
       let rel_filter =
-	List.map (fun a -> not (isRel a) || dependent a u
-                           || Int.Set.mem (destRel a) depvl) inst in
+	List.map (fun a -> not (isRel !evdref a) || dependent !evdref a u
+                           || Int.Set.mem (destRel !evdref a) depvl) inst in
       let named_filter =
-        let open Context.Named.Declaration in
-	List.map (fun d -> dependent (mkVar (get_id d)) u)
+	List.map (fun d -> local_occur_var !evdref (NamedDecl.get_id d) u)
 	  (named_context extenv) in
       let filter = Filter.make (rel_filter @ named_filter) in
       let candidates = u :: List.map mkRel vl in
@@ -1670,7 +1717,7 @@ let abstract_tycon loc env evdref subst tycon extenv t =
   in
   aux (0,extenv,subst0) t0
 
-let build_tycon loc env tycon_env s subst tycon extenv evdref t =
+let build_tycon ?loc env tycon_env s subst tycon extenv evdref t =
   let t,tt = match t with
     | None ->
 	(* This is the situation we are building a return predicate and
@@ -1678,15 +1725,15 @@ let build_tycon loc env tycon_env s subst tycon extenv evdref t =
 	let n = Context.Rel.length (rel_context env) in
 	let n' = Context.Rel.length (rel_context tycon_env) in
 	let impossible_case_type, u =
-	  e_new_type_evar (reset_context env) evdref univ_flexible_alg ~src:(loc,Evar_kinds.ImpossibleCase) in
+	  e_new_type_evar (reset_context env) evdref univ_flexible_alg ~src:(Loc.tag ?loc Evar_kinds.ImpossibleCase) in
 	(lift (n'-n) impossible_case_type, mkSort u)
     | Some t ->
-        let t = abstract_tycon loc tycon_env evdref subst tycon extenv t in
+        let t = abstract_tycon ?loc tycon_env evdref subst tycon extenv t in
         let evd,tt = Typing.type_of extenv !evdref t in
         evdref := evd;
         (t,tt) in
   let b = e_cumul env evdref tt (mkSort s) (* side effect *) in
-  if not b then anomaly (Pp.str "Build_tycon: should be a type");
+  if not b then anomaly (Pp.str "Build_tycon: should be a type.");
   { uj_val = t; uj_type = tt }
 
 (* For a multiple pattern-matching problem Xi on t1..tn with return
@@ -1701,26 +1748,26 @@ 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 t Anonymous) avoid in
-    PatVar (Loc.ghost,Name id), ((id,t)::subst, id::avoid) in
+    let id = next_name_away (named_hd env sigma t Anonymous) 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 kind_of_term (whd_all env sigma t) with
-    | Construct (cstr,u) -> PatCstr (Loc.ghost,cstr,[],Anonymous), acc
-    | App (f,v) when isConstruct f ->
-	let cstr,u = destConstruct f in
+    match EConstr.kind sigma (whd_all env sigma t) with
+    | 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_map' reveal_pattern l acc in
-	PatCstr (Loc.ghost,cstr,l,Anonymous), acc
+	let l,acc = List.fold_right_map reveal_pattern l acc in
+	DAst.make (PatCstr (cstr,l,Anonymous)), acc
     | _ -> make_patvar t acc in
   let rec aux n env acc_sign tms acc =
     match tms with
     | [] -> [], acc_sign, acc
     | (t, IsInd (_,IndType(indf,realargs),_)) :: tms ->
-	let patl,acc = List.fold_map' reveal_pattern realargs acc in
+	let patl,acc = List.fold_right_map reveal_pattern realargs acc in
 	let pat,acc = make_patvar t acc in
 	let indf' = lift_inductive_family n indf in
-	let sign = make_arity_signature env true indf' in
+	let sign = make_arity_signature env sigma true indf' in
         let patl = pat :: List.rev patl in
 	let patl,sign = recover_and_adjust_alias_names patl sign in
 	let p = List.length patl in
@@ -1732,7 +1779,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;
@@ -1753,11 +1800,11 @@ let build_inversion_problem loc env sigma tms t =
     List.map (fun (c,d) -> (c,extract_inductive_data pb_env sigma d,d)) decls in
 
   let decls = List.rev decls in
-  let dep_sign = find_dependencies_signature (List.make n true) decls in
+  let dep_sign = find_dependencies_signature sigma (List.make n true) decls in
 
   let sub_tms =
     List.map2 (fun deps (tm, (tmtyp,_), decl) ->
-      let na = if List.is_empty deps then Anonymous else force_name (get_name decl) in
+      let na = if List.is_empty deps then Anonymous else force_name (RelDecl.get_name decl) in
       Pushed (true,((tm,tmtyp),deps,na)))
       dep_sign decls in
   let subst = List.map (fun (na,t) -> (na,lift n t)) subst in
@@ -1769,12 +1816,12 @@ let build_inversion_problem loc env sigma tms t =
   let main_eqn =
     { patterns = patl;
       alias_stack = [];
-      eqn_loc = Loc.ghost;
+      eqn_loc = None;
       used = ref false;
       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
@@ -1787,22 +1834,23 @@ let build_inversion_problem loc env sigma tms t =
       (* No need for a catch all clause *)
       []
     else
-      [ { patterns = List.map (fun _ -> PatVar (Loc.ghost,Anonymous)) patl;
+      [ { patterns = List.map (fun _ -> DAst.make @@ PatVar Anonymous) patl;
           alias_stack = [];
-          eqn_loc = Loc.ghost;
+          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
       return type of the original problem Xi *)
   let s' = Retyping.get_sort_of env sigma t in
-  let sigma, s = Evd.new_sort_variable univ_flexible_alg sigma in
+  let sigma, s = Evd.new_sort_variable univ_flexible sigma in
   let sigma = Evd.set_leq_sort env sigma s' s in
   let evdref = ref sigma in
   let pb =
     { env       = pb_env;
+      lvar      = empty_lvar;
       evdref    = evdref;
       pred      = (*ty *) mkSort s;
       tomatch   = sub_tms;
@@ -1810,7 +1858,7 @@ let build_inversion_problem loc env sigma tms t =
       mat       = main_eqn :: catch_all_eqn;
       caseloc   = loc;
       casestyle = RegularStyle;
-      typing_function = build_tycon loc env pb_env s subst} in
+      typing_function = build_tycon ?loc env pb_env s subst} in
   let pred = (compile pb).uj_val in
   (!evdref,pred)
 
@@ -1820,52 +1868,62 @@ let build_initial_predicate arsign pred =
   let rec buildrec n pred tmnames = function
     | [] -> List.rev tmnames,pred
     | (decl::realdecls)::lnames ->
-        let na = get_name decl in
+        let na = RelDecl.get_name decl in
         let n' = n + List.length realdecls in
         buildrec (n'+1) pred (force_name na::tmnames) lnames
     | _ -> assert false
   in buildrec 0 pred [] (List.rev arsign)
 
-let extract_arity_signature ?(dolift=true) env0 tomatchl tmsign =
+let extract_arity_signature ?(dolift=true) env0 lvar tomatchl tmsign =
   let lift = if dolift then lift else fun n t -> t in
   let get_one_sign n tm (na,t) =
     match tm with
       | NotInd (bo,typ) ->
 	  (match t with
-	    | None -> (match bo with
+	    | None -> let sign = match bo with
 		       | None -> [LocalAssum (na, lift n typ)]
-		       | Some b -> [LocalDef (na, lift n b, lift n typ)])
-	    | Some (loc,_,_) ->
- 	    user_err_loc (loc,"",
-	    str"Unexpected type annotation for a term of non inductive type."))
+		       | Some b -> [LocalDef (na, lift n b, lift n typ)] in sign,sign
+            | Some {CAst.loc} ->
+            user_err ?loc
+                (str"Unexpected type annotation for a term of non inductive type."))
       | IsInd (term,IndType(indf,realargs),_) ->
           let indf' = if dolift then lift_inductive_family n indf else indf in
 	  let ((ind,u),_) = dest_ind_family indf' in
 	  let nrealargs_ctxt = inductive_nrealdecls_env env0 ind in
 	  let arsign = fst (get_arity env0 indf') in
-	  let realnal =
+	  let arsign = List.map (fun d -> map_rel_decl EConstr.of_constr d) arsign in
+	  let realnal, realnal' =
 	    match t with
-	      | Some (loc,ind',realnal) ->
+              | Some {CAst.loc;v=(ind',realnal)} ->
 		  if not (eq_ind ind ind') then
-		    user_err_loc (loc,"",str "Wrong inductive type.");
+		    user_err ?loc  (str "Wrong inductive type.");
 		  if not (Int.equal nrealargs_ctxt (List.length realnal)) then
-		      anomaly (Pp.str "Ill-formed 'in' clause in cases");
-		  List.rev realnal
-	      | None -> List.make nrealargs_ctxt Anonymous in
-	  LocalAssum (na, build_dependent_inductive env0 indf')
-	  ::(List.map2 set_name realnal arsign) in
+		      anomaly (Pp.str "Ill-formed 'in' clause in cases.");
+		  let realnal = List.rev realnal in
+                  let realnal' = List.map (ltac_interp_name lvar) realnal in
+                  realnal,realnal'
+	      | None ->
+                  let realnal = List.make nrealargs_ctxt Anonymous in
+                  realnal, realnal in
+          let na' = ltac_interp_name lvar na in
+          let t = EConstr.of_constr (build_dependent_inductive env0 indf') in
+          (* Context with names for typing *)
+          let arsign1 = LocalAssum (na, t) :: List.map2 RelDecl.set_name realnal arsign in
+          (* Context with names for building the term *)
+          let arsign2 = LocalAssum (na', t) :: List.map2 RelDecl.set_name realnal' arsign in
+          arsign1,arsign2 in
   let rec buildrec n = function
     | [],[] -> []
     | (_,tm)::ltm, (_,x)::tmsign ->
 	let l = get_one_sign n tm x in
-	l :: buildrec (n + List.length l) (ltm,tmsign)
+	l :: buildrec (n + List.length (fst l)) (ltm,tmsign)
     | _ -> assert false
   in List.rev (buildrec 0 (tomatchl,tmsign))
 
-let inh_conv_coerce_to_tycon loc env evdref j tycon =
+let inh_conv_coerce_to_tycon ?loc env evdref j tycon =
   match tycon with
     | Some p ->
-	let (evd',j) = Coercion.inh_conv_coerce_to true loc env !evdref j p in
+	let (evd',j) = Coercion.inh_conv_coerce_to ?loc true env !evdref j p in
           evdref := evd';
           j
     | None -> j
@@ -1877,8 +1935,8 @@ let prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign c =
   let subst, len =
     List.fold_right2 (fun (tm, tmtype) sign (subst, len) ->
       let signlen = List.length sign in
-	match kind_of_term tm with
-	  | Rel n when dependent tm c
+	match EConstr.kind sigma tm with
+	  | Rel n when dependent sigma tm c
 		&& Int.equal signlen 1 (* The term to match is not of a dependent type itself *) ->
 	      ((n, len) :: subst, len - signlen)
 	  | Rel n when signlen > 1 (* The term is of a dependent type,
@@ -1889,21 +1947,21 @@ let prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign c =
 		    let subst, len =
 		      List.fold_left
 			(fun (subst, len) arg ->
-			  match kind_of_term arg with
-			  | Rel n when dependent arg c ->
+			  match EConstr.kind sigma arg with
+			  | Rel n when dependent sigma arg c ->
 			      ((n, len) :: subst, pred len)
 			  | _ -> (subst, pred len))
 			(subst, len) realargs
 		    in
 		    let subst =
-		      if dependent tm c && List.for_all isRel realargs
+		      if dependent sigma tm c && List.for_all (isRel sigma) realargs
 		      then (n, len) :: subst else subst
 		    in (subst, pred len))
 	  | _ -> (subst, len - signlen))
       (List.rev tomatchs) arsign ([], nar)
   in
   let rec predicate lift c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
       | Rel n when n > lift ->
 	  (try
 	      (* Make the predicate dependent on the matched variable *)
@@ -1913,7 +1971,7 @@ let prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign c =
 	      (* A variable that is not matched, lift over the arsign. *)
 	      mkRel (n + nar))
       | _ ->
-	  map_constr_with_binders succ predicate lift c
+	  EConstr.map_with_binders sigma succ predicate lift c
   in
   assert (len == 0);
   let p = predicate 0 c in
@@ -1933,7 +1991,22 @@ let prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign c =
  * tycon to make the predicate if it is not closed.
  *)
 
-let prepare_predicate loc typing_fun env sigma tomatchs arsign tycon pred =
+exception LocalOccur
+
+let noccur_with_meta sigma n m term =
+  let rec occur_rec n c = match EConstr.kind sigma c with
+    | Rel p -> if n<=p && p<n+m then raise LocalOccur
+    | App(f,cl) ->
+        (match EConstr.kind sigma f with
+           | Cast (c,_,_) when isMeta sigma c -> ()
+           | Meta _ -> ()
+           | _ -> EConstr.iter_with_binders sigma succ occur_rec n c)
+    | Evar (_, _) -> ()
+    | _ -> EConstr.iter_with_binders sigma succ occur_rec n c
+  in
+  try (occur_rec n term; true) with LocalOccur -> false
+
+let prepare_predicate ?loc typing_fun env sigma lvar tomatchs arsign tycon pred =
   let refresh_tycon sigma t =
     (** If we put the typing constraint in the term, it has to be
        refreshed to preserve the invariant that no algebraic universe
@@ -1941,16 +2014,17 @@ let prepare_predicate loc typing_fun env sigma tomatchs arsign tycon pred =
     refresh_universes ~status:Evd.univ_flexible ~onlyalg:true (Some true)
 		      env sigma t
   in
+  let typing_arsign,building_arsign = List.split arsign in
   let preds =
     match pred, tycon with
     (* No return clause *)
-    | None, Some t when not (noccur_with_meta 0 max_int t) ->
+    | None, Some t when not (noccur_with_meta sigma 0 max_int t) ->
 	(* If the tycon is not closed w.r.t real variables, we try *)
         (* two different strategies *)
        (* First strategy: we abstract the tycon wrt to the dependencies *)
          let sigma, t = refresh_tycon sigma t in
          let p1 =
-          prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign t in
+          prepare_predicate_from_arsign_tycon env sigma loc tomatchs typing_arsign t in
 	(* Second strategy: we build an "inversion" predicate *)
 	let sigma2,pred2 = build_inversion_problem loc env sigma tomatchs t in
 	(match p1 with
@@ -1962,31 +2036,29 @@ let prepare_predicate loc typing_fun env sigma tomatchs arsign tycon pred =
         let sigma,t = match tycon with
 	| Some t -> refresh_tycon sigma t
 	| None -> 
-          let sigma = Sigma.Unsafe.of_evar_map sigma in
-          let Sigma ((t, _), sigma, _) =
-	    new_type_evar env sigma univ_flexible_alg ~src:(loc, Evar_kinds.CasesType false) in
-          let sigma = Sigma.to_evar_map sigma in
+          let (sigma, (t, _)) =
+	    new_type_evar env sigma univ_flexible_alg ~src:(Loc.tag ?loc @@ Evar_kinds.CasesType false) in
 	    sigma, t
 	in
         (* First strategy: we build an "inversion" predicate *)
 	let sigma1,pred1 = build_inversion_problem loc env sigma tomatchs t in
 	(* Second strategy: we directly use the evar as a non dependent pred *)
-        let pred2 = lift (List.length (List.flatten arsign)) t in
+        let pred2 = lift (List.length (List.flatten typing_arsign)) t in
 	[sigma1, pred1; sigma, pred2]
     (* Some type annotation *)
     | Some rtntyp, _ ->
       (* We extract the signature of the arity *)
-      let envar = List.fold_right push_rel_context arsign env in
+      let envar = List.fold_right push_rel_context typing_arsign env in
       let sigma, newt = new_sort_variable univ_flexible_alg sigma in
       let evdref = ref sigma in
-      let predcclj = typing_fun (mk_tycon (mkSort newt)) envar evdref rtntyp in
+      let predcclj = typing_fun (mk_tycon (mkSort newt)) envar evdref lvar rtntyp in
       let sigma = !evdref in
-      let predccl = (j_nf_evar sigma predcclj).uj_val in
+      let predccl = nf_evar sigma predcclj.uj_val in
       [sigma, predccl]
   in
   List.map
     (fun (sigma,pred) ->
-      let (nal,pred) = build_initial_predicate arsign pred in
+      let (nal,pred) = build_initial_predicate building_arsign pred in
       sigma,nal,pred)
     preds
 
@@ -2011,7 +2083,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 =
@@ -2026,31 +2098,33 @@ let mk_JMeq evdref typ x typ' y =
 let mk_JMeq_refl evdref typ x = 
   papp evdref coq_JMeq_refl [| typ; x |]
 
-let hole =
-  GHole (Loc.ghost, Evar_kinds.QuestionMark (Evar_kinds.Define false),
+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 =
-    match pat with
-    | PatVar (l,name) ->
+    let loc = pat.CAst.loc in
+    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
-	  (PatVar (l, 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 (l,((_, i) as cstr),args,alias) ->
+    | PatCstr (((_, i) as cstr),args,alias) ->
 	let cind = inductive_of_constructor cstr in
 	let IndType (indf, _) = 
 	  try find_rectype env ( !evdref) (lift (-(List.length realargs)) ty)
-	  with Not_found -> error_case_not_inductive env 
+	  with Not_found -> error_case_not_inductive env !evdref
 	    {uj_val = ty; uj_type = Typing.unsafe_type_of env !evdref ty}
 	in
 	let (ind,u), params = dest_ind_family indf in
-	if not (eq_ind ind cind) then error_bad_constructor_loc l env cstr ind;
+	let params = List.map EConstr.of_constr params in
+	if not (eq_ind ind cind) then error_bad_constructor ?loc env cstr ind;
 	let cstrs = get_constructors env indf in
 	let ci = cstrs.(i-1) in
 	let nb_args_constr = ci.cs_nargs in
@@ -2058,7 +2132,7 @@ let constr_of_pat env evdref arsign pat avoid =
 	let patargs, args, sign, env, n, m, avoid =
 	  List.fold_right2
 	    (fun decl ua (patargs, args, sign, env, n, m, avoid)  ->
-               let t = get_type decl in
+               let t = EConstr.of_constr (RelDecl.get_type decl) in
 	       let pat', sign', arg', typ', argtypargs, n', avoid =
 		 let liftt = liftn (List.length sign) (succ (List.length args)) t in
 		   typ env (substl args liftt, []) ua avoid
@@ -2070,18 +2144,18 @@ let constr_of_pat env evdref arsign pat avoid =
 	in
 	let args = List.rev args in
 	let patargs = List.rev patargs in
-	let pat' = PatCstr (l, cstr, patargs, alias) in
-	let cstr = mkConstructU ci.cs_cstr in
-	let app = applistc cstr (List.map (lift (List.length sign)) params) in
-	let app = applistc app args 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
 	let apptype = Retyping.get_type_of env ( !evdref) app in
-	let IndType (indf, realargs) = find_rectype env ( !evdref) apptype in
+	let IndType (indf, realargs) = find_rectype env (!evdref) apptype in
 	  match alias with
 	      Anonymous ->
 		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
@@ -2092,58 +2166,61 @@ 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 *)
 		  pat', sign, lift i app, lift i apptype, realargs, n + i, avoid
   in
-  let pat', sign, patc, patty, args, z, avoid = typ env (get_type (List.hd arsign), List.tl arsign) pat avoid in
-    pat', (sign, patc, (get_type (List.hd arsign), args), pat'), avoid
+  let pat', sign, patc, patty, args, z, avoid = typ env (RelDecl.get_type (List.hd arsign), List.tl arsign) pat avoid in
+    pat', (sign, patc, (RelDecl.get_type (List.hd arsign), args), pat'), avoid
 
 
 (* shadows functional version *)
 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 t =
-match kind_of_term t with
+let is_topvar sigma t =
+match EConstr.kind sigma t with
 | Rel 0 -> true
 | _ -> false
 
-let rels_of_patsign =
+let rels_of_patsign sigma =
   List.map (fun decl ->
 	    match decl with
-	    | LocalDef (na,t',t) when is_topvar t' -> LocalAssum (na,t)
+	    | LocalDef (na,t',t) when is_topvar sigma t' -> LocalAssum (na,t)
 	    | _ -> decl)
 
-let vars_of_ctx ctx =
+let vars_of_ctx sigma ctx =
   let _, y =
     List.fold_right (fun decl (prev, vars) ->
       match decl with
-	| LocalDef (na,t',t) when is_topvar t' ->
+	| LocalDef (na,t',t) when is_topvar sigma t' ->
 	    prev,
-	    (GApp (Loc.ghost,
-		(GRef (Loc.ghost, delayed_force coq_eq_refl_ref, None)), 
-		   [hole; GVar (Loc.ghost, prev)])) :: vars
+	    (DAst.make @@ GApp (
+		(DAst.make @@ GRef (delayed_force coq_eq_refl_ref, None)), 
+		   [hole na; DAst.make @@ GVar prev])) :: vars
 	| _ ->
-	    match get_name decl with
+	    match RelDecl.get_name decl with
 		Anonymous -> invalid_arg "vars_of_ctx"
-	      | Name n -> n, GVar (Loc.ghost, n) :: vars)
+	      | 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 x, y with
+  match DAst.get x, DAst.get y with
     | PatVar _, _ -> true
     | _, PatVar _ -> true
-    | PatCstr (l, (_, i), args, alias), PatCstr (l', (_, i'), args', alias')  ->
+    | PatCstr ((_, i), args, alias), PatCstr ((_, i'), args', alias')  ->
 	if Int.equal i i' then List.for_all2 is_included args args'
 	else false
 
+let lift_rel_context n l =
+  map_rel_context_with_binders (liftn n) l
+
 (* liftsign is the current pattern's complete signature length. 
    Hence pats is already typed in its
    full signature. However prevpatterns are in the original one signature per pattern form.
@@ -2180,14 +2257,14 @@ let build_ineqs evdref prevpatterns pats liftsign =
 	   (Some ([], 0, 0, [])) eqnpats pats
 	 in match acc with
 	     None -> c
-	   | Some (sign, len, _, c') ->
-	       let conj = it_mkProd_or_LetIn (mk_coq_not (mk_coq_and c'))
-		 (lift_rel_context liftsign sign)
-	       in
-		 conj :: c)
+	    | Some (sign, len, _, c') ->
+               let sigma, conj = mk_coq_and !evdref c' in
+               let sigma, neg = mk_coq_not sigma conj in
+	       let conj = it_mkProd_or_LetIn neg (lift_rel_context liftsign sign) in
+               evdref := sigma; conj :: c)
       [] prevpatterns
   in match diffs with [] -> None
-    | _ -> Some (mk_coq_and diffs)
+    | _ -> Some (let sigma, conj = mk_coq_and !evdref diffs in evdref := sigma; conj)
 
 let constrs_of_pats typing_fun env evdref eqns tomatchs sign neqs arity =
   let i = ref 0 in
@@ -2199,7 +2276,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 =
@@ -2218,12 +2295,12 @@ let constrs_of_pats typing_fun env evdref eqns tomatchs sign neqs arity =
 	   (* lift to get outside of past patterns to get terms in the combined environment. *)
 	   (fun (pats, n) (sign, c, (s, args), p) ->
 	     let len = List.length sign in
-	       ((rels_of_patsign sign, lift n c,
+	       ((rels_of_patsign !evdref sign, lift n c,
 		 (s, List.map (lift n) args), p) :: pats, len + n))
 	   ([], 0) pats
 	 in
 	 let ineqs = build_ineqs evdref prevpatterns pats signlen in
-	 let rhs_rels' = rels_of_patsign rhs_rels in
+	 let rhs_rels' = rels_of_patsign !evdref rhs_rels in
 	 let _signenv = push_rel_context rhs_rels' env in
 	 let arity =
 	   let args, nargs =
@@ -2241,7 +2318,7 @@ let constrs_of_pats typing_fun env evdref eqns tomatchs sign neqs arity =
 	     | Some ineqs ->
 		 [LocalAssum (Anonymous, ineqs)], lift 1 arity
 	   in
-	   let eqs_rels, arity = decompose_prod_n_assum neqs arity in
+	   let eqs_rels, arity = decompose_prod_n_assum !evdref neqs arity in
 	     eqs_rels @ neqs_rels @ rhs_rels', arity
 	 in
 	 let rhs_env = push_rel_context rhs_rels' env in
@@ -2252,13 +2329,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 = GVar (Loc.ghost, branch_name) in
-	     match vars_of_ctx rhs_rels with
+	   let bref = DAst.make @@ GVar branch_name in
+	     match vars_of_ctx !evdref rhs_rels with
 		 [] -> bref
-	       | l -> GApp (Loc.ghost, bref, l)
+	       | l  -> DAst.make @@ GApp (bref, l)
 	 in
 	 let branch = match ineqs with
-	     Some _ -> GApp (Loc.ghost, branch, [ hole ])
+	     Some _ -> DAst.make @@ GApp (branch, [ hole Anonymous ])
 	   | None -> branch
 	 in
 	 incr i;
@@ -2287,27 +2364,27 @@ let lift_ctx n ctx =
   in ctx'
 
 (* Turn matched terms into variables. *)
-let abstract_tomatch env tomatchs tycon =
+let abstract_tomatch env sigma tomatchs tycon =
   let prev, ctx, names, tycon =
     List.fold_left
       (fun (prev, ctx, names, tycon) (c, t) ->
 	 let lenctx =  List.length ctx in
-	 match kind_of_term c with
+	 match EConstr.kind sigma c with
 	     Rel n -> (lift lenctx c, lift_tomatch_type lenctx t) :: prev, ctx, names, tycon
 	   | _ ->
 	       let tycon = Option.map
-		 (fun t -> subst_term (lift 1 c) (lift 1 t)) tycon in
+		 (fun t -> subst_term sigma (lift 1 c) (lift 1 t)) tycon in
 	       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 =
   let avoid = ref avoid in
   let arsign = List.rev arsign in
-  let allnames = List.rev_map (List.map get_name) arsign in
+  let allnames = List.rev_map (List.map RelDecl.get_name) arsign in
   let nar = List.fold_left (fun n names -> List.length names + n) 0 allnames in
   let eqs, neqs, refls, slift, arsign' =
     List.fold_left2
@@ -2324,14 +2401,14 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		as much as possible *)
 	     let argsign = List.tl arsign in (* arguments in inverse application order *)
 	     let app_decl = List.hd arsign in (* The matched argument *)
-	     let appn = get_name app_decl in
-	     let appt = get_type app_decl in
+	     let appn = RelDecl.get_name app_decl in
+	     let appt = RelDecl.get_type app_decl in
 	     let argsign = List.rev argsign in (* arguments in application order *)
 	     let env', nargeqs, argeqs, refl_args, slift, argsign' =
 	       List.fold_left2
 		 (fun (env, nargeqs, argeqs, refl_args, slift, argsign') arg decl ->
-		    let name = get_name decl in
-		    let t = get_type decl in
+		    let name = RelDecl.get_name decl in
+		    let t = RelDecl.get_type decl in
 		    let argt = Retyping.get_type_of env !evdref arg in
 		    let eq, refl_arg =
 		      if Reductionops.is_conv env !evdref argt t then
@@ -2348,8 +2425,8 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		    in
 		    let previd, id =
 		      let name =
-			match kind_of_term arg with
-			Rel n -> get_name (lookup_rel n env)
+			match EConstr.kind !evdref arg with
+			Rel n -> RelDecl.get_name (lookup_rel n env)
 			| _ -> name
 		      in
 			make_prime avoid name
@@ -2358,7 +2435,7 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		       (LocalAssum (Name (eq_id avoid previd), eq)) :: argeqs,
 		       refl_arg :: refl_args,
 		       pred slift,
-		       set_name (Name id) decl :: argsign'))
+		       RelDecl.set_name (Name id) decl :: argsign'))
 		 (env, neqs, [], [], slift, []) args argsign
 	     in
 	     let eq = mk_JMeq evdref
@@ -2373,13 +2450,13 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		succ nargeqs,
 		refl_eq :: refl_args,
 		pred slift,
-		((set_name (Name id) app_decl :: argsign') :: arsigns))
+		((RelDecl.set_name (Name id) app_decl :: argsign') :: arsigns))
 
 	 | _ -> (* Non dependent inductive or not inductive, just use a regular equality *)
 	     let decl = match arsign with [x] -> x | _ -> assert(false) in
-	     let name = get_name decl in
+	     let name = RelDecl.get_name decl in
 	     let previd, id = make_prime avoid name in
-	     let arsign' = set_name (Name id) decl in
+	     let arsign' = RelDecl.set_name (Name id) decl in
 	     let tomatch_ty = type_of_tomatch ty in
 	     let eq =
 	       mk_eq evdref (lift nar tomatch_ty)
@@ -2401,10 +2478,10 @@ let context_of_arsign l =
     l ([], 0)
   in x
 
-let compile_program_cases loc style (typing_function, evdref) tycon env
+let compile_program_cases ?loc style (typing_function, evdref) tycon env lvar
     (predopt, tomatchl, eqns) =
   let typing_fun tycon env = function
-    | Some t ->	typing_function tycon env evdref t
+    | Some t ->	typing_function tycon env evdref lvar t
     | None -> Evarutil.evd_comb0 use_unit_judge evdref in
 
   (* We build the matrix of patterns and right-hand side *)
@@ -2412,29 +2489,30 @@ let compile_program_cases loc style (typing_function, evdref) tycon env
 
   (* We build the vector of terms to match consistently with the *)
   (* constructors found in patterns *)
-  let tomatchs = coerce_to_indtype typing_function evdref env matx tomatchl in
+  let predlvar,tomatchs = coerce_to_indtype typing_function evdref env lvar matx tomatchl in
   let tycon = valcon_of_tycon tycon in
-  let tomatchs, tomatchs_lets, tycon' = abstract_tomatch env tomatchs tycon in
+  let tomatchs, tomatchs_lets, tycon' = abstract_tomatch env !evdref tomatchs tycon in
   let env = push_rel_context tomatchs_lets env in
   let len = List.length eqns in
   let sign, allnames, signlen, eqs, neqs, args =
     (* The arity signature *)
-    let arsign = extract_arity_signature ~dolift:false env tomatchs tomatchl in
+    let arsign = extract_arity_signature ~dolift:false env predlvar tomatchs tomatchl in
+    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
   let tycon, arity =
+    let nar = List.fold_left (fun n sign -> List.length sign + n) 0 sign in
     match tycon' with
-    | None -> let ev = mkExistential env evdref in ev, ev
+    | None -> let ev = mkExistential env evdref in ev, lift nar ev
     | Some t ->
 	let pred =
 	  match prepare_predicate_from_arsign_tycon env !evdref loc tomatchs sign t with
 	  | Some (evd, pred) -> evdref := evd; pred
 	  | None ->
-	     let nar = List.fold_left (fun n sign -> List.length sign + n) 0 sign in
 	       lift nar t
 	in Option.get tycon, pred
   in
@@ -2468,25 +2546,26 @@ let compile_program_cases loc style (typing_function, evdref) tycon env
     List.map (fun (c,d) -> (c,extract_inductive_data env !evdref d,d)) typs in
     
   let dep_sign =
-    find_dependencies_signature
+    find_dependencies_signature !evdref
       (List.make (List.length typs) true)
       typs in
     
   let typs' =
     List.map3
       (fun (tm,tmt) deps na ->
-         let deps = if not (isRel tm) then [] else deps in
+         let deps = if not (isRel !evdref tm) then [] else deps in
            ((tm,tmt),deps,na))
       tomatchs dep_sign nal in
     
   let initial_pushed = List.map (fun x -> Pushed (true,x)) typs' in
     
   let typing_function tycon env evdref = function
-    | Some t ->	typing_function tycon env evdref t
+    | Some t ->	typing_function tycon env evdref lvar t
     | None -> evd_comb0 use_unit_judge evdref in
 
   let pb =
     { env      = env;
+      lvar     = lvar;
       evdref   = evdref;
       pred     = pred;
       tomatch  = initial_pushed;
@@ -2499,19 +2578,19 @@ let compile_program_cases loc style (typing_function, evdref) tycon env
   let j = compile pb in
     (* We check for unused patterns *)
     List.iter (check_unused_pattern env) matx;
-    let body = it_mkLambda_or_LetIn (applistc j.uj_val args) lets in
+    let body = it_mkLambda_or_LetIn (applist (j.uj_val, args)) lets in
     let j =
       { uj_val = it_mkLambda_or_LetIn body tomatchs_lets;
-	uj_type = nf_evar !evdref tycon; }
+	uj_type = EConstr.of_constr (EConstr.to_constr !evdref tycon); }
     in j
 
 (**************************************************************************)
 (* Main entry of the matching compilation                                 *)
 
-let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, eqns) =
+let compile_cases ?loc style (typing_fun, evdref) tycon env lvar (predopt, tomatchl, eqns) =
   if predopt == None && Flags.is_program_mode () && Program.is_program_cases () then
-    compile_program_cases loc style (typing_fun, evdref)
-      tycon env (predopt, tomatchl, eqns)
+    compile_program_cases ?loc style (typing_fun, evdref)
+      tycon env lvar (predopt, tomatchl, eqns)
   else
 
   (* We build the matrix of patterns and right-hand side *)
@@ -2519,15 +2598,15 @@ let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, e
 
   (* We build the vector of terms to match consistently with the *)
   (* constructors found in patterns *)
-  let tomatchs = coerce_to_indtype typing_fun evdref env matx tomatchl in
+  let predlvar,tomatchs = coerce_to_indtype typing_fun evdref env lvar matx tomatchl in
 
 
 
   (* If an elimination predicate is provided, we check it is compatible
      with the type of arguments to match; if none is provided, we
      build alternative possible predicates *)
-  let arsign = extract_arity_signature env tomatchs tomatchl in
-  let preds = prepare_predicate loc typing_fun env !evdref tomatchs arsign tycon predopt in
+  let arsign = extract_arity_signature env predlvar tomatchs tomatchl in
+  let preds = prepare_predicate ?loc typing_fun env !evdref predlvar tomatchs arsign tycon predopt in
 
   let compile_for_one_predicate (sigma,nal,pred) =
     (* We push the initial terms to match and push their alias to rhs' envs *)
@@ -2543,14 +2622,14 @@ let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, e
       List.map (fun (c,d) -> (c,extract_inductive_data env sigma d,d)) typs in
 
     let dep_sign =
-      find_dependencies_signature
+      find_dependencies_signature !evdref
         (List.make (List.length typs) true)
         typs in
 
     let typs' =
       List.map3
         (fun (tm,tmt) deps na ->
-          let deps = if not (isRel tm) then [] else deps in
+          let deps = if not (isRel !evdref tm) then [] else deps in
           ((tm,tmt),deps,na))
         tomatchs dep_sign nal in
 
@@ -2558,13 +2637,14 @@ let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, e
 
     (* A typing function that provides with a canonical term for absurd cases*)
     let typing_fun tycon env evdref = function
-    | Some t ->	typing_fun tycon env evdref t
+    | Some t ->	typing_fun tycon env evdref lvar t
     | None -> evd_comb0 use_unit_judge evdref in
 
     let myevdref = ref sigma in
 
     let pb =
       { env       = env;
+        lvar      = lvar;
         evdref    = myevdref;
 	pred      = pred;
 	tomatch   = initial_pushed;
@@ -2577,7 +2657,7 @@ let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, e
     let j = compile pb in
 
     (* We coerce to the tycon (if an elim predicate was provided) *)
-    let j = inh_conv_coerce_to_tycon loc env myevdref j tycon in
+    let j = inh_conv_coerce_to_tycon ?loc env myevdref j tycon in
     evdref := !myevdref;
     j in
 
diff --git a/pretyping/cases.mli b/pretyping/cases.mli
index ee4148de..04a34646 100644
--- a/pretyping/cases.mli
+++ b/pretyping/cases.mli
@@ -1,18 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 } *)
 
@@ -28,43 +32,43 @@ type pattern_matching_error =
 
 exception PatternMatchingError of env * evar_map * pattern_matching_error
 
-val error_wrong_numarg_constructor_loc : Loc.t -> env -> constructor -> int -> 'a
+val error_wrong_numarg_constructor : ?loc:Loc.t -> env -> constructor -> int -> 'a
 
-val error_wrong_numarg_inductive_loc : Loc.t -> env -> inductive -> int -> 'a
+val error_wrong_numarg_inductive   : ?loc:Loc.t -> env -> inductive -> int -> 'a
 
 val irrefutable : env -> cases_pattern -> bool
 
 (** {6 Compilation primitive. } *)
 
 val compile_cases :
-  Loc.t -> case_style ->
-  (type_constraint -> env -> evar_map ref -> glob_constr -> unsafe_judgment) * evar_map ref ->
+  ?loc:Loc.t -> case_style ->
+  (type_constraint -> env -> evar_map ref -> ltac_var_map -> glob_constr -> unsafe_judgment) * evar_map ref ->
   type_constraint ->
-  env -> glob_constr option * tomatch_tuples * cases_clauses ->
+  env -> ltac_var_map -> glob_constr option * tomatch_tuples * cases_clauses ->
   unsafe_judgment
 
 val constr_of_pat : 
            Environ.env ->
            Evd.evar_map ref ->
-           Context.Rel.Declaration.t list ->
+           rel_context ->
            Glob_term.cases_pattern ->
-           Names.Id.t list ->
+           Names.Id.Set.t ->
            Glob_term.cases_pattern *
-           (Context.Rel.Declaration.t list * Term.constr *
-            (Term.types * Term.constr list) * Glob_term.cases_pattern) *
-           Names.Id.t list
+           (rel_context * constr *
+            (types * constr list) * Glob_term.cases_pattern) *
+           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 =
     { patterns     : cases_pattern list;
       rhs          : 'a rhs;
       alias_stack  : Name.t list;
-      eqn_loc      : Loc.t;
+      eqn_loc      : Loc.t option;
       used         : bool ref }
 
 type 'a matrix = 'a equation list
@@ -84,7 +88,7 @@ type tomatch_status =
   | Pushed of (bool*((constr * tomatch_type) * int list * Name.t))
   | Alias of (bool * (Name.t * constr * (constr * types)))
   | NonDepAlias
-  | Abstract of int * Context.Rel.Declaration.t
+  | Abstract of int * rel_declaration
 
 type tomatch_stack = tomatch_status list
 
@@ -100,25 +104,29 @@ and pattern_continuation =
 
 type 'a pattern_matching_problem =
     { env       : env;
+      lvar      : Ltac_pretype.ltac_var_map;
       evdref    : evar_map ref;
       pred      : constr;
       tomatch   : tomatch_stack;
       history   : pattern_continuation;
       mat       : 'a matrix;
-      caseloc   : Loc.t;
+      caseloc   : Loc.t option;
       casestyle : case_style;
       typing_function: type_constraint -> env -> evar_map ref -> 'a option -> unsafe_judgment }
 
 
-val compile : 'a pattern_matching_problem -> Environ.unsafe_judgment
+val compile : 'a pattern_matching_problem -> unsafe_judgment
 
-val prepare_predicate :            Loc.t ->
-           (Evarutil.type_constraint ->
-            Environ.env -> Evd.evar_map ref -> glob_constr -> Environ.unsafe_judgment) ->
+val prepare_predicate : ?loc:Loc.t ->
+           (type_constraint ->
+            Environ.env -> Evd.evar_map ref -> ltac_var_map -> glob_constr -> unsafe_judgment) ->
            Environ.env ->
            Evd.evar_map ->
-           (Term.types * tomatch_type) list ->
-           Context.Rel.t list ->
-           Constr.constr option ->
-           glob_constr option ->
-           (Evd.evar_map * Names.name list * Term.constr) list
+           Ltac_pretype.ltac_var_map ->
+           (types * tomatch_type) list ->
+           (rel_context * rel_context) list ->
+           constr option ->
+           glob_constr option -> (Evd.evar_map * Name.t list * constr) list
+
+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 84bf849e..cb0fc325 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open CClosure
 open Esubst
@@ -45,7 +47,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
@@ -69,7 +71,7 @@ and cbv_stack =
   | TOP
   | APP of cbv_value array * cbv_stack
   | CASE of constr * constr array * case_info * cbv_value subs * cbv_stack
-  | PROJ of projection * Declarations.projection_body * cbv_stack
+  | PROJ of Projection.t * Declarations.projection_body * cbv_stack
 
 (* les vars pourraient etre des constr,
    cela permet de retarder les lift: utile ?? *)
@@ -132,6 +134,7 @@ let mkSTACK = function
   | STACK(0,v0,stk0), stk -> STACK(0,v0,stack_concat stk0 stk)
   | v,stk -> STACK(0,v,stk)
 
+type cbv_infos = { tab : cbv_value infos_tab; infos : cbv_value infos; sigma : Evd.evar_map }
 
 (* Change: zeta reduction cannot be avoided in CBV *)
 
@@ -170,11 +173,68 @@ 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
 
+let debug_cbv = ref false
+let _ = Goptions.declare_bool_option {
+  Goptions.optdepr = false;
+  Goptions.optname = "cbv visited constants display";
+  Goptions.optkey = ["Debug";"Cbv"];
+  Goptions.optread = (fun () -> !debug_cbv);
+  Goptions.optwrite = (fun a -> debug_cbv:=a);
+}
+
+let pr_key = function
+  | ConstKey (sp,_) -> Names.Constant.print sp
+  | VarKey id -> Names.Id.print id
+  | RelKey n -> Pp.(str "REL_" ++ int n)
+
+let rec reify_stack t = function
+  | TOP -> t
+  | APP (args,st) ->
+      reify_stack (mkApp(t,Array.map reify_value args)) st
+  | CASE (ty,br,ci,env,st) ->
+      reify_stack
+        (mkCase (ci, ty, t,br))
+        st
+  | PROJ (p, pinfo, st) ->
+       reify_stack (mkProj (p, t)) st
+
+and reify_value = function (* reduction under binders *)
+  | VAL (n,t) -> lift n t
+  | STACK (0,v,stk) ->
+      reify_stack (reify_value v) stk
+  | STACK (n,v,stk) ->
+      lift n (reify_stack (reify_value v) stk)
+  | CBN(t,env) ->
+    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) ->
+    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) ->
+    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
  *
@@ -189,7 +249,7 @@ let cofixp_reducible flgs _ stk =
 
 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 *)
@@ -200,12 +260,12 @@ let rec norm_head info env t stack =
   
   | Proj (p, c) -> 
     let p' =
-      if red_set (info_flags info) (fCONST (Projection.constant p)) 
-      	&& red_set (info_flags info) fBETA 
+      if red_set (info_flags info.infos) (fCONST (Projection.constant p)) 
+      	&& red_set (info_flags info.infos) fBETA 
       then Projection.unfold p
       else p
     in 
-    let pinfo = Environ.lookup_projection p (info_env info) in
+    let pinfo = Environ.lookup_projection p (info_env info.infos) in
       norm_head info env c (PROJ (p', pinfo, stack))
 	
   (* constants, axioms
@@ -220,14 +280,16 @@ let rec norm_head info env t stack =
 
   | Var id -> norm_head_ref 0 info env stack (VarKey id)
 
-  | Const sp -> norm_head_ref 0 info env stack (ConstKey sp)
+  | Const sp ->
+      Reductionops.reduction_effect_hook (env_of_infos info.infos) info.sigma t (lazy (reify_stack t stack));
+      norm_head_ref 0 info env stack (ConstKey sp)
 
   | LetIn (_, b, _, c) ->
       (* zeta means letin are contracted; delta without zeta means we *)
       (* allow bindings but leave let's in place *)
-      if red_set (info_flags info) fZETA then
+      if red_set (info_flags info.infos) fZETA then
         (* New rule: for Cbv, Delta does not apply to locally bound variables
-           or red_set (info_flags info) fDELTA
+           or red_set (info_flags info.infos) fDELTA
          *)
 	let env' = subs_cons ([|cbv_stack_term info TOP env b|],env) in
         norm_head info env' c stack
@@ -235,13 +297,16 @@ let rec norm_head info env t stack =
 	(CBN(t,env), stack) (* Should we consider a commutative cut ? *)
 
   | Evar ev ->
-      (match evar_value info.i_cache ev with
+      (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)
@@ -252,11 +317,19 @@ let rec norm_head info env t stack =
   | Prod _ -> (CBN(t,env), stack)
 
 and norm_head_ref k info env stack normt =
-  if red_set_ref (info_flags info) normt then
-    match ref_value_cache info normt with
-      | Some body -> strip_appl (shift_value k body) stack
-      | None -> (VAL(0,make_constr_ref k normt),stack)
-  else (VAL(0,make_constr_ref k normt),stack)
+  if red_set_ref (info_flags info.infos) normt then
+    match ref_value_cache info.infos info.tab normt with
+      | Some body ->
+         if !debug_cbv then Feedback.msg_debug Pp.(str "Unfolding " ++ pr_key normt);
+         strip_appl (shift_value k body) stack
+      | None ->
+         if !debug_cbv then Feedback.msg_debug Pp.(str "Not unfolding " ++ pr_key normt);
+         (VAL(0,make_constr_ref k normt),stack)
+  else
+    begin
+      if !debug_cbv then Feedback.msg_debug Pp.(str "Not unfolding " ++ pr_key normt);
+      (VAL(0,make_constr_ref k normt),stack)
+    end
 
 (* cbv_stack_term performs weak reduction on constr t under the subs
  * env, with context stack, i.e. ([env]t stack).  First computes weak
@@ -270,7 +343,7 @@ and cbv_stack_term info stack env t =
 and cbv_stack_value info env = function
   (* a lambda meets an application -> BETA *)
   | (LAM (nlams,ctxt,b,env), APP (args, stk))
-      when red_set (info_flags info) fBETA ->
+      when red_set (info_flags info.infos) fBETA ->
     let nargs = Array.length args in
       if nargs == nlams then
           cbv_stack_term info stk (subs_cons(args,env)) b
@@ -284,31 +357,31 @@ and cbv_stack_value info env = function
 
     (* a Fix applied enough -> IOTA *)
     | (FIXP(fix,env,[||]), stk)
-        when fixp_reducible (info_flags info) fix stk ->
+        when fixp_reducible (info_flags info.infos) fix stk ->
         let (envf,redfix) = contract_fixp env fix in
         cbv_stack_term info stk envf redfix
 
     (* constructor guard satisfied or Cofix in a Case -> IOTA *)
     | (COFIXP(cofix,env,[||]), stk)
-        when cofixp_reducible (info_flags info) cofix stk->
+        when cofixp_reducible (info_flags info.infos) cofix stk->
         let (envf,redfix) = contract_cofixp env cofix in
         cbv_stack_term info stk envf redfix
 
     (* constructor in a Case -> IOTA *)
     | (CONSTR(((sp,n),u),[||]), APP(args,CASE(_,br,ci,env,stk)))
-            when red_set (info_flags info) fMATCH ->
+            when red_set (info_flags info.infos) fMATCH ->
 	let cargs =
           Array.sub args ci.ci_npar (Array.length args - ci.ci_npar) in
         cbv_stack_term info (stack_app cargs stk) env br.(n-1)
 
     (* constructor of arity 0 in a Case -> IOTA *)
     | (CONSTR(((_,n),u),[||]), CASE(_,br,_,env,stk))
-            when red_set (info_flags info) fMATCH ->
+            when red_set (info_flags info.infos) fMATCH ->
                     cbv_stack_term info stk env br.(n-1)
 
     (* constructor in a Projection -> IOTA *)
     | (CONSTR(((sp,n),u),[||]), APP(args,PROJ(p,pi,stk)))
-        when red_set (info_flags info) fMATCH && Projection.unfolded p ->
+        when red_set (info_flags info.infos) fMATCH && Projection.unfolded p ->
       let arg = args.(pi.Declarations.proj_npars + pi.Declarations.proj_arg) in
 	cbv_stack_value info env (strip_appl arg stk)
 
@@ -316,7 +389,7 @@ and cbv_stack_value info env = function
     | (FIXP(fix,env,[||]), APP(appl,TOP)) -> FIXP(fix,env,appl)
     | (COFIXP(cofix,env,[||]), APP(appl,TOP)) -> COFIXP(cofix,env,appl)
     | (CONSTR(c,[||]), APP(appl,TOP)) -> CONSTR(c,appl)
-      
+
     (* definitely a value *)
     | (head,stk) -> mkSTACK(head, stk)
 
@@ -350,12 +423,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,
@@ -376,14 +449,14 @@ and cbv_norm_value info = function (* reduction under binders *)
 
 (* with profiling *)
 let cbv_norm infos constr =
-  with_stats (lazy (cbv_norm_term infos (subs_id 0) constr))
-
-type cbv_infos = cbv_value infos
+  let constr = EConstr.Unsafe.to_constr constr in
+  EConstr.of_constr (with_stats (lazy (cbv_norm_term infos (subs_id 0) constr)))
 
 (* constant bodies are normalized at the first expansion *)
 let create_cbv_infos flgs env sigma =
-  create
-    (fun old_info c -> cbv_stack_term old_info TOP (subs_id 0) c)
+  let infos = create
+    (fun old_info tab c -> cbv_stack_term { tab; infos = old_info; sigma } TOP (subs_id 0) c)
     flgs
     env
-    (Reductionops.safe_evar_value sigma)
+    (Reductionops.safe_evar_value sigma) in
+  { tab = CClosure.create_tab (); infos; sigma }
diff --git a/pretyping/cbv.mli b/pretyping/cbv.mli
index 87a03abb..cdaa39c5 100644
--- a/pretyping/cbv.mli
+++ b/pretyping/cbv.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Environ
 open CClosure
 open Esubst
@@ -23,6 +25,9 @@ val cbv_norm         : cbv_infos -> constr -> constr
 
 (***********************************************************************
   i This is for cbv debug *)
+
+open Constr
+
 type cbv_value =
   | VAL of int * constr
   | STACK of int * cbv_value * cbv_stack
@@ -30,13 +35,13 @@ 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
   | APP of cbv_value array * cbv_stack
   | CASE of constr * constr array * case_info * cbv_value subs * cbv_stack
-  | PROJ of projection * Declarations.projection_body * cbv_stack
+  | PROJ of Projection.t * Declarations.projection_body * cbv_stack
 
 val shift_value : int -> cbv_value -> cbv_value
 
diff --git a/pretyping/classops.ml b/pretyping/classops.ml
index 4f265e76..a0804b72 100644
--- a/pretyping/classops.ml
+++ b/pretyping/classops.ml
@@ -1,23 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 Termops
 open Mod_subst
 
 (* usage qque peu general: utilise aussi dans record *)
@@ -29,9 +29,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
@@ -45,12 +45,13 @@ 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 }
 
 let coe_info_typ_equal c1 c2 =
+  let eq_constr c1 c2 = Termops.eq_constr Evd.empty (EConstr.of_constr c1) (EConstr.of_constr c2) in
   eq_constr c1.coe_value c2.coe_value &&
     eq_constr c1.coe_type c2.coe_type &&
     c1.coe_local == c2.coe_local &&
@@ -60,8 +61,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 *)
 
@@ -89,7 +90,7 @@ sig
     type t
     val compare : t -> t -> int
     val equal : t -> t -> bool
-    val print : t -> std_ppcmds
+    val print : t -> Pp.t
   end
   type 'a t
   val empty : 'a t
@@ -192,15 +193,16 @@ let coercion_exists coe = CoeTypMap.mem coe !coercion_tab
 (* find_class_type : evar_map -> constr -> cl_typ * universe_list * constr list *)
 
 let find_class_type sigma t =
+  let open EConstr in
   let t', args = Reductionops.whd_betaiotazeta_stack sigma t in
-  match kind_of_term t' with
-    | Var id -> CL_SECVAR id, Univ.Instance.empty, args
+  match EConstr.kind sigma t' with
+    | Var id -> CL_SECVAR id, EInstance.empty, args
     | Const (sp,u) -> CL_CONST sp, u, args
     | Proj (p, c) when not (Projection.unfolded p) ->
-      CL_PROJ (Projection.constant p), Univ.Instance.empty, c :: args
+      CL_PROJ (Projection.constant p), EInstance.empty, (c :: args)
     | Ind (ind_sp,u) -> CL_IND ind_sp, u, args
-    | Prod (_,_,_) -> CL_FUN, Univ.Instance.empty, []
-    | Sort _ -> CL_SORT, Univ.Instance.empty, []
+    | Prod (_,_,_) -> CL_FUN, EInstance.empty, []
+    | Sort _ -> CL_SORT, EInstance.empty, []
     |  _ -> raise Not_found
 
 
@@ -214,7 +216,7 @@ let subst_cl_typ subst ct = match ct with
   | CL_CONST c ->
       let c',t = subst_con_kn subst c in
 	if c' == c then ct else
-         pi1 (find_class_type Evd.empty t)
+         pi1 (find_class_type Evd.empty (EConstr.of_constr t))
   | CL_IND i ->
       let i' = subst_ind subst i in
 	if i' == i then ct else CL_IND i'
@@ -297,9 +299,9 @@ let lookup_path_to_sort_from env sigma s =
 
 let get_coercion_constructor env coe =
   let c, _ =
-    Reductionops.whd_all_stack env Evd.empty coe.coe_value
+    Reductionops.whd_all_stack env Evd.empty (EConstr.of_constr coe.coe_value)
   in
-  match kind_of_term c with
+  match EConstr.kind Evd.empty (** FIXME *) c with
   | Construct (cstr,u) ->
       (cstr, Inductiveops.constructor_nrealargs cstr -1)
   | _ ->
@@ -317,21 +319,21 @@ let coercion_value { coe_value = c; coe_type = t; coe_context = ctx;
   let subst, ctx = Universes.fresh_universe_context_set_instance ctx in
   let c' = Vars.subst_univs_level_constr subst c 
   and t' = Vars.subst_univs_level_constr subst t in
-    (make_judge c' t', b, b'), ctx
+    (make_judge (EConstr.of_constr c') (EConstr.of_constr t'), b, b'), 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 -> std_ppcmds)
+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 *)
@@ -344,8 +346,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
@@ -386,8 +388,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 && is_verbose () 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;
@@ -402,8 +404,8 @@ type coercion = {
 (* Computation of the class arity *)
 
 let reference_arity_length ref =
-  let t = Universes.unsafe_type_of_global ref in
-  List.length (fst (Reductionops.splay_arity (Global.env()) Evd.empty t))
+  let t, _ = Global.type_of_global_in_context (Global.env ()) ref in
+  List.length (fst (Reductionops.splay_arity (Global.env()) Evd.empty (EConstr.of_constr t))) (** FIXME *)
 
 let projection_arity_length p =
   let len = reference_arity_length (ConstRef p) in
@@ -427,20 +429,20 @@ let automatically_import_coercions = ref false
 open Goptions
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = true; (* remove in 8.8 *)
       optname  = "automatic import of coercions";
       optkey   = ["Automatic";"Coercions";"Import"];
       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 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;
       coe_type = typ;
@@ -450,19 +452,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 || Flags.version_less_or_equal Flags.V8_2
-  then
-    cache_coercion o
+  if !automatically_import_coercions then
+    cache_coercion (Global.env ()) Evd.empty o
 
 let open_coercion i o =
-  if Int.equal i 1 && not
-    (!automatically_import_coercions || Flags.version_less_or_equal Flags.V8_2)
-  then
-    cache_coercion o
+  if Int.equal i 1 && not !automatically_import_coercions then
+    cache_coercion (Global.env ()) Evd.empty o
 
 let subst_coercion (subst, c) =
   let coe = subst_coe_typ subst c.coercion_type in
@@ -501,7 +499,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 }
@@ -538,7 +538,7 @@ let inheritance_graph () =
 let coercion_of_reference r =
   let ref = Nametab.global r in
   if not (coercion_exists ref) then
-    errorlabstrm "try_add_coercion"
+    user_err ~hdr:"try_add_coercion"
       (Nametab.pr_global_env Id.Set.empty ref ++ str" is not a coercion.");
   ref
 
@@ -554,7 +554,6 @@ module CoercionPrinting =
     let member_message x b =
       str "Explicit printing of coercion " ++ printer x ++
       str (if b then " is set" else " is unset")
-    let synchronous = true
   end
 
 module PrintingCoercion  = Goptions.MakeRefTable(CoercionPrinting)
diff --git a/pretyping/classops.mli b/pretyping/classops.mli
index d509739c..f8600bbe 100644
--- a/pretyping/classops.mli
+++ b/pretyping/classops.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
-open Evd
 open Environ
+open EConstr
+open Evd
 open Mod_subst
 
 (** {6 This is the type of class kinds } *)
@@ -17,9 +19,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
@@ -59,7 +61,7 @@ val class_info_from_index : cl_index -> cl_typ * cl_info_typ
 
 (** [find_class_type env sigma c] returns the head reference of [c],
     its universe instance and its arguments *)
-val find_class_type : evar_map -> types -> cl_typ * Univ.universe_instance * constr list
+val find_class_type : evar_map -> types -> cl_typ * EInstance.t * constr list
 
 (** raises [Not_found] if not convertible to a class *)
 val class_of : env -> evar_map -> types -> types * cl_index
@@ -95,16 +97,15 @@ val lookup_pattern_path_between :
 
 (**/**)
 (* Crade *)
-open Pp
 val install_path_printer :
-  ((cl_index * cl_index) * inheritance_path -> std_ppcmds) -> unit
+  (env -> evar_map -> (cl_index * cl_index) * inheritance_path -> Pp.t) -> unit
 (**/**)
 
 (** {6 This is for printing purpose } *)
 val string_of_class : cl_typ -> string
-val pr_class : cl_typ -> std_ppcmds
-val pr_cl_index : cl_index -> std_ppcmds
-val get_coercion_value : coe_index -> constr
+val pr_class : cl_typ -> Pp.t
+val pr_cl_index : cl_index -> Pp.t
+val get_coercion_value : coe_index -> Constr.t
 val inheritance_graph : unit -> ((cl_index * cl_index) * inheritance_path) list
 val classes : unit -> cl_typ list
 val coercions : unit -> coe_index list
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml
index 913e80f3..04cb6a59 100644
--- a/pretyping/coercion.ml
+++ b/pretyping/coercion.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Hugo Herbelin for Coq V7 by isolating the coercion
@@ -18,10 +20,10 @@ open CErrors
 open Util
 open Names
 open Term
+open Environ
+open EConstr
 open Vars
 open Reductionops
-open Environ
-open Typeops
 open Pretype_errors
 open Classops
 open Evarutil
@@ -33,14 +35,13 @@ open Globnames
 let use_typeclasses_for_conversion = ref true
 
 let _ =
-  Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      optdepr  = false;
+  Goptions.(declare_bool_option
+    { optdepr  = false;
       optname  = "use typeclass resolution during conversion";
       optkey   = ["Typeclass"; "Resolution"; "For"; "Conversion"];
       optread  = (fun () -> !use_typeclasses_for_conversion);
       optwrite = (fun b -> use_typeclasses_for_conversion := b) }
-
+    )
 
 (* Typing operations dealing with coercions *)
 exception NoCoercion
@@ -52,7 +53,7 @@ let apply_coercion_args env evd check isproj argl funj =
   let rec apply_rec acc typ = function
     | [] ->
       if isproj then
-	let cst = fst (destConst (j_val funj)) in
+	let cst = fst (destConst !evdref (j_val funj)) in
 	let p = Projection.make cst false in
 	let pb = lookup_projection p env in
 	let args = List.skipn pb.Declarations.proj_npars argl in
@@ -63,35 +64,36 @@ let apply_coercion_args env evd check isproj argl funj =
 	{ uj_val = applist (j_val funj,argl);
 	  uj_type = typ }
     | h::restl -> (* On devrait pouvoir s'arranger pour qu'on n'ait pas a faire hnf_constr *)
-      match kind_of_term (whd_all env evd typ) with
+      match EConstr.kind !evdref (whd_all env !evdref typ) with
       | Prod (_,c1,c2) ->
-        if check && not (e_cumul env evdref (Retyping.get_type_of env evd h) c1) then
+        if check && not (e_cumul env evdref (Retyping.get_type_of env !evdref h) c1) then
 	  raise NoCoercion;
         apply_rec (h::acc) (subst1 h c2) restl
-      | _ -> anomaly (Pp.str "apply_coercion_args")
+      | _ -> anomaly (Pp.str "apply_coercion_args.")
   in
   let res = apply_rec [] funj.uj_type argl in
     !evdref, res
 
 (* appliquer le chemin de coercions de patterns p *)
-let apply_pattern_coercion loc pat p =
+let apply_pattern_coercion ?loc pat p =
   List.fold_left
     (fun pat (co,n) ->
-       let f i = if i<n then Glob_term.PatVar (loc, Anonymous) else pat in
-	 Glob_term.PatCstr (loc, co, List.init (n+1) f, Anonymous))
+       let f i =
+         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 *)
-let inh_pattern_coerce_to loc env pat ind1 ind2 =
+let inh_pattern_coerce_to ?loc env pat ind1 ind2 =
   let p = lookup_pattern_path_between env (ind1,ind2) in
-    apply_pattern_coercion loc pat p
+    apply_pattern_coercion ?loc pat p
 
 (* Program coercions *)
 
 open Program
 
-let make_existential loc ?(opaque = not (get_proofs_transparency ()))  env evdref c =
-  let src = (loc, Evar_kinds.QuestionMark (Evar_kinds.Define opaque)) in
+let make_existential ?loc ?(opaque = not (get_proofs_transparency ())) na env evdref c =
+  let src = Loc.tag ?loc (Evar_kinds.QuestionMark (Evar_kinds.Define opaque,na)) in
   Evarutil.e_new_evar env evdref ~src c
 
 let app_opt env evdref f t =
@@ -99,10 +101,10 @@ let app_opt env evdref f t =
 
 let pair_of_array a = (a.(0), a.(1))
 
-let disc_subset x =
-  match kind_of_term x with
+let disc_subset sigma x =
+  match EConstr.kind sigma x with
   | App (c, l) ->
-      (match kind_of_term c with
+      (match EConstr.kind sigma c with
        Ind (i,_) ->
 	 let len = Array.length l in
 	 let sigty = delayed_force sig_typ in
@@ -129,7 +131,7 @@ let lift_args n sign =
 let mu env evdref t =
   let rec aux v =
     let v' = hnf env !evdref v in
-      match disc_subset v' with
+      match disc_subset !evdref v' with
       | Some (u, p) ->
 	let f, ct = aux u in
 	let p = hnf_nodelta env !evdref p in
@@ -140,8 +142,8 @@ let mu env evdref t =
       | None -> (None, v)
   in aux t
 
-and coerce loc env evdref (x : Term.constr) (y : Term.constr)
-    : (Term.constr -> Term.constr) option
+and coerce ?loc env evdref (x : EConstr.constr) (y : EConstr.constr)
+    : (EConstr.constr -> EConstr.constr) option
     =
   let open Context.Rel.Declaration in
   let rec coerce_unify env x y =
@@ -150,12 +152,11 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 	evdref := the_conv_x_leq env x y !evdref;
 	None
       with UnableToUnify _ -> coerce' env x y
-  and coerce' env x y : (Term.constr -> Term.constr) option =
+  and coerce' env x y : (EConstr.constr -> EConstr.constr) option =
     let subco () = subset_coerce env evdref x y in
     let dest_prod c =
-      let open Context.Rel.Declaration in
-      match Reductionops.splay_prod_n env ( !evdref) 1 c with
-      | [LocalAssum (na,t) | LocalDef (na,_,t)], c -> (na,t), c
+      match Reductionops.splay_prod_n env (!evdref) 1 c with
+      | [LocalAssum (na,t) | LocalDef (na,_,t)], c -> (na, t), c
       | _ -> raise NoSubtacCoercion
     in
     let coerce_application typ typ' c c' l l' =
@@ -175,14 +176,14 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 		with UnableToUnify _ -> raise NoSubtacCoercion
 	      in
 		(* Disallow equalities on arities *)
-		if Reduction.is_arity env eqT then raise NoSubtacCoercion;
+		if Reductionops.is_arity env !evdref eqT then raise NoSubtacCoercion;
 		let restargs = lift_args 1
 		  (List.rev (Array.to_list (Array.sub l (succ i) (len - (succ i)))))
 		in
 		let args = List.rev (restargs @ mkRel 1 :: List.map (lift 1) tele) in
-		let pred = mkLambda (n, eqT, applistc (lift 1 c) args) in
+		let pred = mkLambda (n, eqT, applist (lift 1 c, args)) in
 		let eq = papp evdref coq_eq_ind [| eqT; hdx; hdy |] in
-		let evar = make_existential loc env evdref eq in
+		let evar = make_existential ?loc n env evdref eq in
 		let eq_app x = papp evdref coq_eq_rect
 		  [| eqT; hdx; pred; x; hdy; evar|] 
 		in
@@ -192,21 +193,21 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 	  let term = co x in
 	    Typing.e_solve_evars env evdref term)
       in
-	if isEvar c || isEvar c' || not (Program.is_program_generalized_coercion ()) then
+	if isEvar !evdref c || isEvar !evdref c' || not (Program.is_program_generalized_coercion ()) then
 	  (* Second-order unification needed. *)
 	  raise NoSubtacCoercion;
 	aux [] typ typ' 0 (fun x -> x)
     in
-      match (kind_of_term x, kind_of_term y) with
+      match (EConstr.kind !evdref x, EConstr.kind !evdref y) with
       | Sort s, Sort s' ->
-        (match s, s' with
+        (match ESorts.kind !evdref s, ESorts.kind !evdref s' with
 	| Prop x, Prop y when x == y -> None
 	| Prop _, Type _ -> None
 	| Type x, Type y when Univ.Universe.equal x y -> None (* false *)
 	| _ -> 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
@@ -225,7 +226,7 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 				  (mkApp (lift 1 f, [| coec1 |])))))
 
       | App (c, l), App (c', l') ->
-	  (match kind_of_term c, kind_of_term c' with
+	  (match EConstr.kind !evdref c, EConstr.kind !evdref c' with
 	   Ind (i, u), Ind (i', u') -> (* Inductive types *)
 	     let len = Array.length l in
 	     let sigT = delayed_force sigT_typ in
@@ -242,16 +243,15 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 		     in
 		     let c1 = coerce_unify env a a' in
 		     let remove_head a c =
-		       match kind_of_term c with
+		       match EConstr.kind !evdref c with
 		       | Lambda (n, t, t') -> c, t'
 		       | Evar (k, args) ->
 			   let (evs, t) = Evardefine.define_evar_as_lambda env !evdref (k,args) in
 			     evdref := evs;
-			     let (n, dom, rng) = destLambda t in
-			     let dom = whd_evar !evdref dom in
-			       if isEvar dom then
-				 let (domk, args) = destEvar dom in
-				   evdref := define domk a !evdref;
+			     let (n, dom, rng) = destLambda !evdref t in
+			       if isEvar !evdref dom then
+				 let (domk, args) = destEvar !evdref dom in
+				   evdref := define domk (EConstr.Unsafe.to_constr a) !evdref;
 			       else ();
 			       t, rng
 		       | _ -> raise NoSubtacCoercion
@@ -302,7 +302,7 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 			  coerce_application typ typ' c c' l l')
 		 else
 		   subco ()
-	   | x, y when Constr.equal c c' ->
+	   | x, y when EConstr.eq_constr !evdref c c' ->
 	       if Int.equal (Array.length l) (Array.length l') then
 		 let evm =  !evdref in
 		 let lam_type = Typing.unsafe_type_of env evm c in
@@ -313,20 +313,20 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
       | _, _ ->  subco ()
 
   and subset_coerce env evdref x y =
-    match disc_subset x with
+    match disc_subset !evdref x with
     Some (u, p) ->
       let c = coerce_unify env u y in
       let f x =
 	app_opt env evdref c (papp evdref sig_proj1 [| u; p; x |])
       in Some f
     | None ->
-	match disc_subset y with
+	match disc_subset !evdref y with
 	Some (u, p) ->
 	  let c = coerce_unify env x u in
 	    Some
 	      (fun x ->
 		 let cx = app_opt env evdref c x in
-		 let evar = make_existential loc env evdref (mkApp (p, [| cx |]))
+		 let evar = make_existential ?loc Anonymous env evdref (mkApp (p, [| cx |]))
 		 in
 		   (papp evdref sig_intro [| u; p; cx; evar |]))
 	| None ->
@@ -340,9 +340,9 @@ let app_coercion env evdref coercion v =
      let v' = Typing.e_solve_evars env evdref (f v) in
      whd_betaiota !evdref v'
 
-let coerce_itf loc env evd v t c1 =
+let coerce_itf ?loc env evd v t c1 =
   let evdref = ref evd in
-  let coercion = coerce loc env evdref t c1 in
+  let coercion = coerce ?loc env evdref t c1 in
   let t = Option.map (app_coercion env evdref coercion) v in
     !evdref, t
 
@@ -370,12 +370,12 @@ let apply_coercion env sigma p hj typ_cl =
       (hj,typ_cl,sigma) p
     in evd, j
   with NoCoercion as e -> raise e
-  | e when CErrors.noncritical e -> anomaly (Pp.str "apply_coercion")
+  | e when CErrors.noncritical e -> anomaly (Pp.str "apply_coercion.")
 
 (* Try to coerce to a funclass; raise NoCoercion if not possible *)
 let inh_app_fun_core env evd j =
   let t = whd_all env evd j.uj_type in
-    match kind_of_term t with
+    match EConstr.kind evd t with
     | Prod (_,_,_) -> (evd,j)
     | Evar ev ->
 	let (evd',t) = Evardefine.define_evar_as_product evd ev in
@@ -405,36 +405,41 @@ let inh_app_fun resolve_tc env evd j =
     try inh_app_fun_core env (saturate_evd env evd) j
     with NoCoercion -> (evd, j)
 
-let inh_tosort_force loc env evd j =
+let type_judgment env sigma j =
+  match EConstr.kind sigma (whd_all env sigma j.uj_type) with
+    | Sort s -> {utj_val = j.uj_val; utj_type = ESorts.kind sigma s }
+    | _ -> error_not_a_type env sigma j
+
+let inh_tosort_force ?loc env evd j =
   try
     let t,p = lookup_path_to_sort_from env evd j.uj_type in
     let evd,j1 = apply_coercion env evd p j t in
     let j2 = on_judgment_type (whd_evar evd) j1 in
-      (evd,type_judgment env j2)
+      (evd,type_judgment env evd j2)
   with Not_found | NoCoercion ->
-    error_not_a_type_loc loc env evd j
+    error_not_a_type ?loc env evd j
 
-let inh_coerce_to_sort loc env evd j =
+let inh_coerce_to_sort ?loc env evd j =
   let typ = whd_all env evd j.uj_type in
-    match kind_of_term typ with
-    | Sort s -> (evd,{ utj_val = j.uj_val; utj_type = s })
-    | Evar ev when not (is_defined evd (fst ev)) ->
+    match EConstr.kind evd typ with
+    | Sort s -> (evd,{ utj_val = j.uj_val; utj_type = ESorts.kind evd s })
+    | Evar ev ->
 	let (evd',s) = Evardefine.define_evar_as_sort env evd ev in
 	  (evd',{ utj_val = j.uj_val; utj_type = s })
     | _ ->
-	inh_tosort_force loc env evd j
+	inh_tosort_force ?loc env evd j
 
-let inh_coerce_to_base loc env evd j =
+let inh_coerce_to_base ?loc env evd j =
   if Flags.is_program_mode () then
     let evdref = ref evd in
     let ct, typ' = mu env evdref j.uj_type in
     let res =
-      { uj_val = app_coercion env evdref ct j.uj_val;
+      { uj_val = (app_coercion env evdref ct j.uj_val);
 	uj_type = typ' }
     in !evdref, res
   else (evd, j)
 
-let inh_coerce_to_prod loc env evd t =
+let inh_coerce_to_prod ?loc env evd t =
   if Flags.is_program_mode () then
     let evdref = ref evd in
     let _, typ' = mu env evdref t in
@@ -442,7 +447,7 @@ let inh_coerce_to_prod loc env evd t =
   else (evd, t)
 
 let inh_coerce_to_fail env evd rigidonly v t c1 =
-  if rigidonly && not (Heads.is_rigid env c1 && Heads.is_rigid env t)
+  if rigidonly && not (Heads.is_rigid env (EConstr.Unsafe.to_constr c1) && Heads.is_rigid env (EConstr.Unsafe.to_constr t))
   then
     raise NoCoercion
   else
@@ -461,71 +466,72 @@ let inh_coerce_to_fail env evd rigidonly v t c1 =
       try (the_conv_x_leq env t' c1 evd, v')
       with UnableToUnify _ -> raise NoCoercion
 
-let rec inh_conv_coerce_to_fail loc env evd rigidonly v t c1 =
+let rec inh_conv_coerce_to_fail ?loc env evd rigidonly v t c1 =
   try (the_conv_x_leq env t c1 evd, v)
   with UnableToUnify (best_failed_evd,e) ->
     try inh_coerce_to_fail env evd rigidonly v t c1
     with NoCoercion ->
       match
-      kind_of_term (whd_all env evd t),
-      kind_of_term (whd_all env evd c1)
+      EConstr.kind evd (whd_all env evd t),
+      EConstr.kind evd (whd_all env evd c1)
       with
       | Prod (name,t1,t2), Prod (_,u1,u2) ->
           (* Conversion did not work, we may succeed with a coercion. *)
           (* We eta-expand (hence possibly modifying the original term!) *)
 	  (* and look for a coercion c:u1->t1 s.t. fun x:u1 => v' (c x)) *)
 	  (* has type forall (x:u1), u2 (with v' recursively obtained) *)
-          (* Note: we retype the term because sort-polymorphism may have *)
-          (* weaken its type *)
+          (* Note: we retype the term because template polymorphism may have *)
+          (* weakened its type *)
 	  let name = match name with
 	    | Anonymous -> Name Namegen.default_dependent_ident
 	    | _ -> name in
 	  let open Context.Rel.Declaration in
 	  let env1 = push_rel (LocalAssum (name,u1)) env in
 	  let (evd', v1) =
-	    inh_conv_coerce_to_fail loc env1 evd rigidonly
+	    inh_conv_coerce_to_fail ?loc env1 evd rigidonly
               (Some (mkRel 1)) (lift 1 u1) (lift 1 t1) in
           let v1 = Option.get v1 in
-	  let v2 = Option.map (fun v -> beta_applist (lift 1 v,[v1])) v in
+	  let v2 = Option.map (fun v -> beta_applist evd' (lift 1 v,[v1])) v in
 	  let t2 = match v2 with
-	    | None -> subst_term v1 t2
+	    | None -> subst_term evd' v1 t2
 	    | Some v2 -> Retyping.get_type_of env1 evd' v2 in
-	  let (evd'',v2') = inh_conv_coerce_to_fail loc env1 evd' rigidonly v2 t2 u2 in
+	  let (evd'',v2') = inh_conv_coerce_to_fail ?loc env1 evd' rigidonly v2 t2 u2 in
 	    (evd'', Option.map (fun v2' -> mkLambda (name, u1, v2')) v2')
       | _ -> raise (NoCoercionNoUnifier (best_failed_evd,e))
 
 (* Look for cj' obtained from cj by inserting coercions, s.t. cj'.typ = t *)
-let inh_conv_coerce_to_gen resolve_tc rigidonly loc env evd cj t =
+let inh_conv_coerce_to_gen ?loc resolve_tc rigidonly env evd cj t =
   let (evd', val') =
     try
-      inh_conv_coerce_to_fail loc env evd rigidonly (Some cj.uj_val) cj.uj_type t
+      inh_conv_coerce_to_fail ?loc env evd rigidonly (Some cj.uj_val) cj.uj_type t
     with NoCoercionNoUnifier (best_failed_evd,e) ->
       try
 	if Flags.is_program_mode () then
-	  coerce_itf loc env evd (Some cj.uj_val) cj.uj_type t
+	  coerce_itf ?loc env evd (Some cj.uj_val) cj.uj_type t
 	else raise NoSubtacCoercion
       with
       | NoSubtacCoercion when not resolve_tc || not !use_typeclasses_for_conversion ->
-	  error_actual_type_loc loc env best_failed_evd cj t e
+	  error_actual_type ?loc env best_failed_evd cj t e
       | NoSubtacCoercion ->
 	let evd' = saturate_evd env evd in
       	  try
 	    if evd' == evd then 
-	      error_actual_type_loc loc env best_failed_evd cj t e
+	      error_actual_type ?loc env best_failed_evd cj t e
 	    else 
-      	      inh_conv_coerce_to_fail loc env evd' rigidonly (Some cj.uj_val) cj.uj_type t
+      	      inh_conv_coerce_to_fail ?loc env evd' rigidonly (Some cj.uj_val) cj.uj_type t
 	  with NoCoercionNoUnifier (_evd,_error) ->
-	    error_actual_type_loc loc env best_failed_evd cj t e
+	    error_actual_type ?loc env best_failed_evd cj t e
   in
   let val' = match val' with Some v -> v | None -> assert(false) in
     (evd',{ uj_val = val'; uj_type = t })
 
-let inh_conv_coerce_to resolve_tc = inh_conv_coerce_to_gen resolve_tc false
-let inh_conv_coerce_rigid_to resolve_tc = inh_conv_coerce_to_gen resolve_tc true
+let inh_conv_coerce_to ?loc resolve_tc = inh_conv_coerce_to_gen ?loc resolve_tc false
+
+let inh_conv_coerce_rigid_to ?loc resolve_tc = inh_conv_coerce_to_gen resolve_tc ?loc true
 
-let inh_conv_coerces_to loc env evd t t' =
+let inh_conv_coerces_to ?loc env evd t t' =
   try
-    fst (inh_conv_coerce_to_fail loc env evd true None t t')
+    fst (inh_conv_coerce_to_fail ?loc env evd true None t t')
   with NoCoercion ->
     evd (* Maybe not enough information to unify *)
       
diff --git a/pretyping/coercion.mli b/pretyping/coercion.mli
index 68f9a2e6..6cfd958b 100644
--- a/pretyping/coercion.mli
+++ b/pretyping/coercion.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Evd
 open Names
-open Term
 open Environ
+open EConstr
 open Glob_term
 
 (** {6 Coercions. } *)
@@ -25,17 +27,17 @@ val inh_app_fun : bool ->
 (** [inh_coerce_to_sort env isevars j] coerces [j] to a type; i.e. it
     inserts a coercion into [j], if needed, in such a way it gets as
     type a sort; it fails if no coercion is applicable *)
-val inh_coerce_to_sort : Loc.t ->
+val inh_coerce_to_sort : ?loc:Loc.t ->
   env -> evar_map -> unsafe_judgment -> evar_map * unsafe_type_judgment
 
 (** [inh_coerce_to_base env isevars j] coerces [j] to its base type; i.e. it
     inserts a coercion into [j], if needed, in such a way it gets as
     type its base type (the notion depends on the coercion system) *)
-val inh_coerce_to_base : Loc.t ->
+val inh_coerce_to_base : ?loc:Loc.t ->
   env -> evar_map -> unsafe_judgment -> evar_map * unsafe_judgment
 
 (** [inh_coerce_to_prod env isevars t] coerces [t] to a product type *)
-val inh_coerce_to_prod : Loc.t ->
+val inh_coerce_to_prod : ?loc:Loc.t ->
   env -> evar_map -> types -> evar_map * types
 
 (** [inh_conv_coerce_to resolve_tc Loc.t env isevars j t] coerces [j] to an 
@@ -43,20 +45,20 @@ val inh_coerce_to_prod : Loc.t ->
     a way [t] and [j.uj_type] are convertible; it fails if no coercion is
     applicable. resolve_tc=false disables resolving type classes (as the last
     resort before failing) *)
-val inh_conv_coerce_to : bool -> Loc.t ->
+val inh_conv_coerce_to : ?loc:Loc.t -> bool ->
   env -> evar_map -> unsafe_judgment -> types -> evar_map * unsafe_judgment
 
-val inh_conv_coerce_rigid_to : bool -> Loc.t ->
+val inh_conv_coerce_rigid_to : ?loc:Loc.t -> bool ->
   env -> evar_map -> unsafe_judgment -> types -> evar_map * unsafe_judgment
 
 (** [inh_conv_coerces_to loc env isevars t t'] checks if an object of type [t]
     is coercible to an object of type [t'] adding evar constraints if needed;
     it fails if no coercion exists *)
-val inh_conv_coerces_to : Loc.t ->
+val inh_conv_coerces_to : ?loc:Loc.t ->
   env -> evar_map -> types -> types -> evar_map
 
 (** [inh_pattern_coerce_to loc env isevars pat ind1 ind2] coerces the Cases
     pattern [pat] typed in [ind1] into a pattern typed in [ind2];
     raises [Not_found] if no coercion found *)
 val inh_pattern_coerce_to :
-  Loc.t -> env -> cases_pattern -> inductive -> inductive -> cases_pattern
+  ?loc:Loc.t -> env -> cases_pattern -> inductive -> inductive -> cases_pattern
diff --git a/pretyping/constr_matching.ml b/pretyping/constr_matching.ml
index 886a9826..0413c6b6 100644
--- a/pretyping/constr_matching.ml
+++ b/pretyping/constr_matching.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -12,15 +14,15 @@ open CErrors
 open Util
 open Names
 open Globnames
-open Nameops
 open Termops
-open Reductionops
 open Term
+open EConstr
 open Vars
 open Pattern
 open Patternops
 open Misctypes
 open Context.Rel.Declaration
+open Ltac_pretype
 (*i*)
 
 (* Given a term with second-order variables in it,
@@ -45,6 +47,7 @@ open Context.Rel.Declaration
 
  *)
 
+type binding_bound_vars = Id.Set.t
 type bound_ident_map = Id.t Id.Map.t
 
 exception PatternMatchingFailure
@@ -52,67 +55,109 @@ 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.")
 
 
-let constrain n (ids, m as x) (names, terms as subst) =
+let constrain sigma n (ids, m) ((names,seen as names_seen), terms as subst) =
+  let open EConstr in
   try
     let (ids', m') = Id.Map.find n terms in
-    if List.equal Id.equal ids ids' && eq_constr m m' then subst
+    if List.equal Id.equal ids ids' && eq_constr sigma m m' then subst
     else raise PatternMatchingFailure
   with Not_found ->
     let () = if Id.Map.mem n names then warn_meta_collision n in
-    (names, Id.Map.add n x terms)
+    (names_seen, Id.Map.add n (ids, m) terms)
 
-let add_binders na1 na2 binding_vars (names, terms as subst) =
+let add_binders na1 na2 binding_vars ((names,seen), terms as subst) =
   match na1, na2 with
   | Name id1, Name id2 when Id.Set.mem id1 binding_vars ->
     if Id.Map.mem id1 names then
       let () = Glob_ops.warn_variable_collision id1 in
-      (names, terms)
+      subst
     else
+      let id2 = Namegen.next_ident_away id2 seen in
       let names = Id.Map.add id1 id2 names in
+      let seen = Id.Set.add id2 seen in
       let () = if Id.Map.mem id1 terms then
         warn_meta_collision id1 in
-      (names, terms)
+      ((names,seen), terms)
   | _ -> subst
 
-let rec build_lambda vars ctx m = match vars with
+let rec build_lambda sigma vars ctx m = match vars with
 | [] ->
-  let len = List.length ctx in
-  lift (-1 * len) m
+  if Vars.closed0 sigma m then m else raise PatternMatchingFailure
 | n :: vars ->
   (* change [ x1 ... xn y z1 ... zm |- t ] into
      [ x1 ... xn z1 ... zm |- lam y. t ] *)
-  let len = List.length ctx in
-  let init i =
-    if i < pred n then mkRel (i + 2)
-    else if Int.equal i (pred n) then mkRel 1
-    else mkRel (i + 1)
-  in
-  let m = substl (List.init len init) m in
   let pre, suf = List.chop (pred n) ctx in
-  match suf with
+  let (na, t, suf) = match suf with
   | [] -> assert false
-  | (_, na, t) :: suf ->
-    let map i = if i > n then pred i else i in
-    let vars = List.map map vars in
-    (** Check that the abstraction is legal *)
-    let frels = free_rels t in
-    let brels = List.fold_right Int.Set.add vars Int.Set.empty in
-    let () = if not (Int.Set.subset frels brels) then raise PatternMatchingFailure in
-    (** Create the abstraction *)
-    let m = mkLambda (na, t, m) in
-    build_lambda vars (pre @ suf) m
+  | (_, id, t) :: suf ->
+     (Name id, t, suf)
+  in
+  (** Check that the abstraction is legal by generating a transitive closure of
+      its dependencies. *)
+  let is_nondep t clear = match clear with
+  | [] -> true
+  | _ ->
+    let rels = free_rels sigma t in
+    let check i b = b || not (Int.Set.mem i rels) in
+    List.for_all_i check 1 clear
+  in
+  let fold (_, _, t) clear = is_nondep t clear :: clear in
+  (** Produce a list of booleans: true iff we keep the hypothesis *)
+  let clear = List.fold_right fold pre [false] in
+  let clear = List.drop_last clear in
+  (** If the conclusion depends on a variable we cleared, failure *)
+  let () = if not (is_nondep m clear) then raise PatternMatchingFailure in
+  (** Create the abstracted term *)
+  let fold (k, accu) keep =
+    if keep then
+      let k = succ k in
+      (k, Some k :: accu)
+    else (k, None :: accu)
+  in
+  let keep, shift = List.fold_left fold (0, []) clear in
+  let shift = List.rev shift in
+  let map = function
+  | None -> mkProp (** dummy term *)
+  | Some i -> mkRel (i + 1)
+  in
+  (** [x1 ... xn y z1 ... zm] -> [x1 ... xn f(z1) ... f(zm) y] *)
+  let subst =
+    List.map map shift @
+    mkRel 1 ::
+    List.mapi (fun i _ -> mkRel (i + keep + 2)) suf
+  in
+  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
+    (na, id, substl subst c)
+  in
+  let pre = List.mapi map pre in
+  let pre = List.filter_with clear pre in
+  let m = substl subst m in
+  let map i =
+    if i > n then i - n + keep
+    else match List.nth shift (i - 1) with
+    | None ->
+      (** We cleared a variable that we wanted to abstract! *)
+      raise PatternMatchingFailure
+    | Some k -> k
+  in
+  let vars = List.map map vars in
+  (** Create the abstraction *)
+  let m = mkLambda (na, Vars.lift keep t, m) in
+  build_lambda sigma vars (pre @ suf) m
 
 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
@@ -122,69 +167,78 @@ let rec extract_bound_aux k accu frels ctx = match ctx with
 let extract_bound_vars frels ctx =
   extract_bound_aux 1 Id.Set.empty frels ctx
 
-let dummy_constr = mkProp
+let dummy_constr = EConstr.mkProp
 
 let make_renaming ids = function
-| (Name id, Name _, _) ->
+| (Name id, _, _) ->
   begin
-    try mkRel (List.index Id.equal id ids)
+    try EConstr.mkRel (List.index Id.equal id ids)
     with Not_found -> dummy_constr
   end
 | _ -> dummy_constr
 
-let merge_binding allow_bound_rels ctx n cT subst =
+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))
+
+let merge_binding sigma allow_bound_rels ctx n cT subst =
   let c = match ctx with
   | [] -> (* Optimization *)
     ([], cT)
   | _ ->
-    let frels = free_rels cT in
+    let frels = free_rels sigma cT in
     if allow_bound_rels then
       let vars = extract_bound_vars frels ctx in
       let ordered_vars = Id.Set.elements vars in
       let rename binding = make_renaming ordered_vars binding in
       let renaming = List.map rename ctx in
-      (ordered_vars, substl renaming cT)
+      (ordered_vars, Vars.substl renaming cT)
     else
       let depth = List.length ctx in
       let min_elt = try Int.Set.min_elt frels with Not_found -> succ depth in
       if depth < min_elt then
-        ([], lift (- depth) cT)
+        ([], Vars.lift (- depth) cT)
       else raise PatternMatchingFailure
   in
-  constrain n c subst
+  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, kind_of_term c with
-    | VarRef id, Var id' -> Names.id_eq id id'
-    | ConstRef c, Const (c',_) -> Names.eq_constant c c'
+    match ref, EConstr.kind sigma c with
+    | 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 c' c
-       else false)
+    | _, _ -> false
   in
   let rec sorec ctx env subst p t =
-    let cT = strip_outer_cast t in
-    match p,kind_of_term cT with
+    let cT = strip_outer_cast sigma t in
+    match p, EConstr.kind sigma cT with
       | PSoApp (n,args),m ->
         let fold (ans, seen) = function
         | PRel n ->
-          let () = if Int.Set.mem n seen then error "Non linear second-order pattern" in
+          let () = if Int.Set.mem n seen then user_err (str "Non linear second-order pattern") in
           (n :: ans, Int.Set.add n seen)
-        | _ -> error "Only bound indices allowed in second order pattern matching."
+        | _ -> user_err (str "Only bound indices allowed in second order pattern matching.")
         in
         let relargs, relset = List.fold_left fold ([], Int.Set.empty) args in
-        let frels = free_rels cT in
+        let frels = free_rels sigma cT in
         if Int.Set.subset frels relset then
-          constrain n ([], build_lambda relargs ctx cT) subst
+          constrain sigma n ([], build_lambda sigma relargs ctx cT) subst
         else
           raise PatternMatchingFailure
 
-      | PMeta (Some n), m -> merge_binding allow_bound_rels ctx n cT subst
+      | PMeta (Some n), m -> merge_binding sigma allow_bound_rels ctx n cT subst
 
       | PMeta None, m -> subst
 
@@ -196,18 +250,21 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
 
       | PRel n1, Rel n2 when Int.equal n1 n2 -> subst
 
-      | PSort GProp, Sort (Prop Null) -> subst
+      | PSort ps, Sort s ->
 
-      | PSort GSet, Sort (Prop Pos) -> subst
-
-      | PSort (GType _), Sort (Type _) -> subst
+        begin match ps, ESorts.kind sigma s with
+        | GProp, Prop Null -> subst
+        | GSet, Prop Pos -> subst
+        | GType _, Type _ -> subst
+        | _ -> raise PatternMatchingFailure
+        end
 
       | PApp (p, [||]), _ -> sorec ctx env subst p t
 
       | 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
@@ -215,10 +272,10 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
             let subst =
               match meta with
               | None -> subst
-              | Some n -> merge_binding allow_bound_rels ctx n c subst in
+              | Some n -> merge_binding sigma allow_bound_rels ctx n c subst in
             Array.fold_left2 (sorec ctx env) subst args1 args22
           else (* Might be a projection on the right *)
-	    match kind_of_term c2 with
+	    match EConstr.kind sigma c2 with
 	    | Proj (pr, c) when not (Projection.unfolded pr) ->
 	      (try let term = Retyping.expand_projection env sigma pr c (Array.to_list args2) in
 		     sorec ctx env subst p term
@@ -226,8 +283,8 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
 	    | _ -> raise PatternMatchingFailure)
 	   
       | PApp (c1,arg1), App (c2,arg2) ->
-	(match c1, kind_of_term c2 with
-	| PRef (ConstRef r), Proj (pr,c) when not (eq_constant r (Projection.constant pr))
+	(match c1, EConstr.kind sigma c2 with
+	| 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) ->
@@ -244,7 +301,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) ->
@@ -256,29 +313,33 @@ 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) (Environ.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) (Environ.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,d1), LetIn(na2,c2,t2,d2) ->
-	  sorec ((na1,na2,t2)::ctx) (Environ.push_rel (LocalDef (na2,c2,t2)) env)
+      | PLetIn (na1,c1,Some t1,d1), LetIn(na2,c2,t2,d2) ->
+	  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 (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'|]) ->
-	  let ctx_b2,b2 = decompose_lam_n_decls ci.ci_cstr_ndecls.(0) b2 in
-	  let ctx_b2',b2' = decompose_lam_n_decls ci.ci_cstr_ndecls.(1) b2' in
+	  let ctx_b2,b2 = decompose_lam_n_decls sigma ci.ci_cstr_ndecls.(0) b2 in
+	  let ctx_b2',b2' = decompose_lam_n_decls sigma ci.ci_cstr_ndecls.(1) b2' in
 	  let n = Context.Rel.length ctx_b2 in
           let n' = Context.Rel.length ctx_b2' in
-	  if noccur_between 1 n b2 && noccur_between 1 n' b2' then
-            let f l (LocalAssum (na,t) | LocalDef (na,_,t)) = (Anonymous,na,t)::l 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)) = 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
-	    sorec ctx_br' (Environ.push_rel_context ctx_b2' env)
-	      (sorec ctx_br (Environ.push_rel_context ctx_b2 env)
+	    sorec ctx_br' (push_rel_context ctx_b2' env)
+	      (sorec ctx_br (push_rel_context ctx_b2 env)
                  (sorec ctx env subst a1 a2) b1 b2) b1' b2'
           else
             raise PatternMatchingFailure
@@ -305,21 +366,27 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
 	  let chk_head = sorec ctx env (sorec ctx env subst a1 a2) p1 p2 in
 	  List.fold_left chk_branch chk_head br1
 
-      |	PFix c1, Fix _ when eq_constr (mkFix c1) cT -> subst
-      |	PCoFix c1, CoFix _ when eq_constr (mkCoFix c1) cT -> subst
-      | _ -> raise PatternMatchingFailure
+      |	PFix c1, Fix _ when eq_constr sigma (mkFix (to_fix c1)) cT -> subst
+      |	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
+      | (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
+  sorec [] env ((Id.Map.empty,Id.Set.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
-  (names, Id.Map.map snd subst)
+let matches_core_closed env sigma pat c =
+  let names, subst = matches_core env sigma false pat c in
+  (fst names, Id.Map.map snd subst)
 
-let extended_matches env sigma = matches_core env sigma false true true
+let extended_matches env sigma pat c =
+  let (names,_), subst = matches_core env sigma true pat c in
+  names, subst
 
 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)
 
@@ -332,8 +399,9 @@ let mkresult s c n = IStream.Cons ( { m_sub=s; m_ctx=c; } , (IStream.thunk n) )
 let isPMeta = function PMeta _ -> true | _ -> false
 
 let matches_head env sigma pat c =
+  let open EConstr in
   let head =
-    match pat, kind_of_term c with
+    match pat, EConstr.kind sigma c with
     | PApp (c1,arg1), App (c2,arg2) ->
         if isPMeta c1 then c else
         let n1 = Array.length arg1 in
@@ -343,10 +411,10 @@ 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
-    if closed && Id.Map.exists (fun _ c -> not (closed0 c)) (snd subst)
+    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)
   with PatternMatchingFailure -> (fun next -> next ())
@@ -354,10 +422,11 @@ 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 next () = match kind_of_term c with
+  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
       | [c1] -> mk_ctx (mkCast (c1, k, c2))
@@ -369,51 +438,29 @@ let sub_match ?(partial_app=false) ?(closed=true) env sigma pat c =
       | [c1; c2] -> mk_ctx (mkLambda (x, c1, c2))
       | _ -> assert false
       in
-      let env' = Environ.push_rel (LocalAssum (x,c1)) env in
+      let env' = EConstr.push_rel (LocalAssum (x,c1)) env in
       try_aux [(env, c1); (env', c2)] next_mk_ctx next
   | Prod (x,c1,c2) ->
       let next_mk_ctx = function
       | [c1; c2] -> mk_ctx (mkProd (x, c1, c2))
       | _ -> assert false
       in
-      let env' = Environ.push_rel (LocalAssum (x,c1)) env in
+      let env' = EConstr.push_rel (LocalAssum (x,c1)) env in
       try_aux [(env, c1); (env', c2)] next_mk_ctx next
   | LetIn (x,c1,t,c2) ->
       let next_mk_ctx = function
       | [c1; c2] -> mk_ctx (mkLetIn (x, c1, t, c2))
       | _ -> assert false
       in
-      let env' = Environ.push_rel (LocalDef (x,c1,t)) env in
+      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))
@@ -421,29 +468,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
@@ -464,13 +510,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
@@ -482,12 +522,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 8d8166f2..3c2c7391 100644
--- a/pretyping/constr_matching.mli
+++ b/pretyping/constr_matching.mli
@@ -1,17 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** 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
 
 (** [PatternMatchingFailure] is the exception raised when pattern
   matching fails *)
@@ -41,7 +47,7 @@ val matches_head : env -> Evd.evar_map -> constr_pattern -> constr -> patvar_map
    variables or metavariables have the same name, the metavariable,
    or else the rightmost bound variable, takes precedence *)
 val extended_matches :
-  env -> Evd.evar_map -> Tacexpr.binding_bound_vars * constr_pattern ->
+  env -> Evd.evar_map -> binding_bound_vars * constr_pattern ->
   constr -> bound_ident_map * extended_patvar_map
 
 (** [is_matching pat c] just tells if [c] matches against [pat] *)
@@ -51,38 +57,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 : constr }
-
-(** [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
+      m_ctx : EConstr.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 *) ->
-  Tacexpr.binding_bound_vars * constr_pattern -> constr ->
+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 85125a50..9ba5949a 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -1,19 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+module CVars = Vars
+
 open Pp
 open CErrors
 open Util
 open Names
 open Term
+open EConstr
 open Vars
 open Inductiveops
-open Environ
 open Glob_term
 open Glob_ops
 open Termops
@@ -25,8 +29,11 @@ open Mod_subst
 open Misctypes
 open Decl_kinds
 open Context.Named.Declaration
+open Ltac_pretype
 
-let dl = Loc.ghost
+type _ delay =
+| Now : 'a delay
+| Later : [ `thunk ] delay
 
 (** Should we keep details of universes during detyping ? *)
 let print_universes = Flags.univ_print
@@ -64,24 +71,24 @@ let has_two_constructors lc =
 
 let isomorphic_to_tuple lc = Int.equal (Array.length lc) 1
 
-let encode_bool r =
+let encode_bool ({CAst.loc} as r) =
   let (x,lc) = encode_inductive r in
   if not (has_two_constructors lc) then
-    user_err_loc (loc_of_reference r,"encode_if",
-      str "This type has not exactly two constructors.");
+    user_err ?loc ~hdr:"encode_if"
+      (str "This type has not exactly two constructors.");
   x
 
-let encode_tuple r =
+let encode_tuple ({CAst.loc} as r) =
   let (x,lc) = encode_inductive r in
   if not (isomorphic_to_tuple lc) then
-    user_err_loc (loc_of_reference r,"encode_tuple",
-      str "This type cannot be seen as a tuple type.");
+    user_err ?loc ~hdr:"encode_tuple"
+      (str "This type cannot be seen as a tuple type.");
   x
 
 module PrintingInductiveMake =
   functor (Test : sig
      val encode : reference -> inductive
-     val member_message : std_ppcmds -> bool -> std_ppcmds
+     val member_message : Pp.t -> bool -> Pp.t
      val field : string
      val title : string
   end) ->
@@ -133,8 +140,7 @@ let wildcard_value = ref true
 let force_wildcard () = !wildcard_value
 
 let _ = declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
+	  { optdepr  = false;
 	    optname  = "forced wildcard";
 	    optkey   = ["Printing";"Wildcard"];
 	    optread  = force_wildcard;
@@ -144,8 +150,7 @@ let synth_type_value = ref true
 let synthetize_type () = !synth_type_value
 
 let _ = declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
+	  { optdepr  = false;
 	    optname  = "pattern matching return type synthesizability";
 	    optkey   = ["Printing";"Synth"];
 	    optread  = synthetize_type;
@@ -155,30 +160,27 @@ let reverse_matching_value = ref true
 let reverse_matching () = !reverse_matching_value
 
 let _ = declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
+	  { optdepr  = false;
 	    optname  = "pattern-matching reversibility";
 	    optkey   = ["Printing";"Matching"];
 	    optread  = reverse_matching;
 	    optwrite = (:=) reverse_matching_value }
 
-let print_primproj_params_value = ref true
+let print_primproj_params_value = ref false
 let print_primproj_params () = !print_primproj_params_value
 
 let _ = declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
+	  { optdepr  = false;
 	    optname  = "printing of primitive projection parameters";
 	    optkey   = ["Printing";"Primitive";"Projection";"Parameters"];
 	    optread  = print_primproj_params;
 	    optwrite = (:=) print_primproj_params_value }
 
-let print_primproj_compatibility_value = ref true
+let print_primproj_compatibility_value = ref false
 let print_primproj_compatibility () = !print_primproj_compatibility_value
 
 let _ = declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
+	  { optdepr  = false;
 	    optname  = "backwards-compatible printing of primitive projections";
 	    optkey   = ["Printing";"Primitive";"Projection";"Compatibility"];
 	    optread  = print_primproj_compatibility;
@@ -188,7 +190,7 @@ let _ = declare_bool_option
 (* Auxiliary function for MutCase printing *)
 (* [computable] tries to tell if the predicate typing the result is inferable*)
 
-let computable p k =
+let computable sigma p k =
     (* We first remove as many lambda as the arity, then we look
        if it remains a lambda for a dependent elimination. This function
        works for normal eta-expanded term. For non eta-expanded or
@@ -205,29 +207,29 @@ let computable p k =
        sinon on perd la réciprocité de la synthèse (qui, lui,
        engendrera un prédicat non dépendant) *)
 
-  let sign,ccl = decompose_lam_assum p in
+  let sign,ccl = decompose_lam_assum sigma p in
   Int.equal (Context.Rel.length sign) (k + 1)
   &&
-  noccur_between 1 (k+1) ccl
+  noccur_between sigma 1 (k+1) ccl
 
-let lookup_name_as_displayed env t s =
-  let rec lookup avoid n c = match kind_of_term c with
+let lookup_name_as_displayed env sigma t s =
+  let rec lookup avoid n c = match EConstr.kind sigma c with
     | Prod (name,_,c') ->
-	(match compute_displayed_name_in RenamingForGoal avoid name c' with
+	(match compute_displayed_name_in sigma RenamingForGoal avoid name c' with
            | (Name id,avoid') -> if Id.equal id s then Some n else lookup avoid' (n+1) c'
 	   | (Anonymous,avoid') -> lookup avoid' (n+1) (pop c'))
     | LetIn (name,_,_,c') ->
-	(match compute_displayed_name_in RenamingForGoal avoid name c' with
+	(match compute_displayed_name_in sigma RenamingForGoal avoid name c' with
            | (Name id,avoid') -> if Id.equal id s then Some n else lookup avoid' (n+1) c'
 	   | (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 t n =
-  let rec lookup n d c = match kind_of_term c with
+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 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
@@ -237,7 +239,7 @@ let lookup_index_as_renamed env t n =
 		 else
 		   lookup (n-1) (d+1) c')
     | LetIn (name,_,_,c') ->
-	  (match compute_displayed_name_in 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
@@ -252,22 +254,109 @@ let lookup_index_as_renamed env 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
+  | ({CAst.loc; v=(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 {CAst.v=(_ids,patll,_rhs)} = List.length patll
+
+let is_default_candidate {CAst.v=(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 open CAst in
+  let rec aux found = function
+  | {loc;v=(ids,patl,rhs)}::rest ->
+     let patll,rest = join_eqns (ids,rhs) [patl] rest in
+     aux (CAst.make ?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
+  let open CAst 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 {loc=gloc;v=([],patl::_::_,rhs)}, (_::_ as eqns) ->
+      eqns@[CAst.make ?loc: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 {loc=gloc;v=([],patl::patl'::_,rhs)}, [] ->
+      [CAst.make ?loc:gloc ([],[patl;mk_anon patl'],rhs)]
+    | Some {v=((_::_,_,_ | _,([]|[_]),_))}, _ -> assert false
+    | None, eqns -> eqns
+  else
+    eqns
+
+(**********************************************************************)
 (* Fragile algorithm to reverse pattern-matching compilation          *)
 
-let update_name na ((_,(e,_)),c) =
+let update_name sigma na ((_,(e,_)),c) =
   match na with
-  | Name _ when force_wildcard () && noccurn (List.index Name.equal na e) c ->
+  | Name _ when force_wildcard () && noccurn sigma (List.index Name.equal na e) c ->
       Anonymous
   | _ ->
       na
 
-let rec decomp_branch tags nal b (avoid,env as e) c =
+let rec decomp_branch tags nal b (avoid,env as e) sigma c =
   let flag = if b then RenamingForGoal else RenamingForCasesPattern (fst env,c) in
   match tags with
   | [] -> (List.rev nal,(e,c))
   | b::tags ->
       let na,c,f,body,t =
-        match kind_of_term (strip_outer_cast c), b with
+        match EConstr.kind sigma (strip_outer_cast sigma c), b with
 	| Lambda (na,t,c),false -> na,c,compute_displayed_let_name_in,None,Some t
 	| LetIn (na,b,t,c),true ->
             na,c,compute_displayed_name_in,Some b,Some t
@@ -277,60 +366,60 @@ let rec decomp_branch tags nal b (avoid,env as e) c =
 	| _, true ->
 	  Anonymous,lift 1 c,compute_displayed_name_in,None,None
     in
-    let na',avoid' = f flag avoid na c in
+    let na',avoid' = f sigma flag avoid na c in
     decomp_branch tags (na'::nal) b
-      (avoid', add_name_opt na' body t env) c
+      (avoid', add_name_opt na' body t env) sigma c
 
-let rec build_tree na isgoal e ci cl =
-  let mkpat n rhs pl = PatCstr(dl,(ci.ci_ind,n+1),pl,update_name na rhs) in
+let rec build_tree na isgoal e sigma ci cl =
+  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 (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) = match nal with
-  | [] -> [[],rhs]
+and align_tree nal isgoal (e,c as rhs) sigma = match nal with
+  | [] -> [Id.Set.empty,[],rhs]
   | na::nal ->
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Case (ci,p,c,cl) when
-        eq_constr c (mkRel (List.index Name.equal na (fst (snd e))))
+        eq_constr sigma c (mkRel (List.index Name.equal na (fst (snd e))))
         && not (Int.equal (Array.length cl) 0)
 	&& (* don't contract if p dependent *)
-	computable p (List.length ci.ci_pp_info.ind_tags) (* FIXME: can do better *) ->
-	let clauses = build_tree na isgoal e ci cl in
+	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) ->
-	      let lines = align_tree nal isgoal rhs in
-	      List.map (fun (hd,rest) -> pat::hd,rest) lines)
+          (List.map (fun (ids,pat,rhs) ->
+	      let lines = align_tree nal isgoal rhs sigma in
+              List.map (fun (ids',hd,rest) -> Id.Set.fold Id.Set.add ids ids',pat::hd,rest) lines)
 	    clauses)
     | _ ->
-	let pat = PatVar(dl,update_name na rhs) in
-	let mat = align_tree nal isgoal rhs in
-	List.map (fun (hd,rest) -> pat::hd,rest) mat
+        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 (cdn,can,mkpat,b) =
-  let nal,rhs = decomp_branch cdn [] isgoal e b in
-  let mat = align_tree nal isgoal rhs in
-  List.map (fun (hd,rhs) -> (mkpat rhs hd,rhs)) mat
+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 (ids,hd,rhs) -> ids,mkpat rhs hd,rhs) mat
 
 (**********************************************************************)
 (* Transform internal representation of pattern-matching into list of *)
 (* clauses                                                            *)
 
-let is_nondep_branch c l =
+let is_nondep_branch sigma c l =
   try
     (* FIXME: do better using tags from l *)
-    let sign,ccl = decompose_lam_n_decls (List.length l) c in
-    noccur_between 1 (Context.Rel.length sign) ccl
+    let sign,ccl = decompose_lam_n_decls sigma (List.length l) c in
+    noccur_between sigma 1 (Context.Rel.length sign) ccl
   with e when CErrors.noncritical e -> (* Not eta-expanded or not reduced *)
     false
 
 let extract_nondep_branches test c b l =
   let rec strip l r =
-    match r,l with
-      | r, [] -> r
-      | GLambda (_,_,_,_,t), false::l -> strip l t
+    match DAst.get r, l with
+      | r', [] -> r
+      | GLambda (_,_,_,t), false::l -> strip l t
       | GLetIn (_,_,_,t), true::l -> strip l t
       (* FIXME: do we need adjustment? *)
       | _,_ -> assert false in
@@ -338,10 +427,10 @@ let extract_nondep_branches test c b l =
 
 let it_destRLambda_or_LetIn_names l c =
   let rec aux l nal c =
-    match c, 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
+      | GLambda (na,_,_,c), false::l -> aux l (na::nal) c
+      | GLetIn (na,_,_,c), true::l -> aux l (na::nal) c
       | _, true::l -> (* let-expansion *) aux l (Anonymous :: nal) c
       | _, false::l ->
           (* eta-expansion *)
@@ -352,11 +441,11 @@ let it_destRLambda_or_LetIn_names l c =
 	    x
 	  in
 	  let x = next (free_glob_vars c) in
-	  let a = GVar (dl,x) in
+	  let a = DAst.make @@ GVar x in
 	  aux l (Name x :: nal)
-            (match c with
-              | GApp (loc,p,l) -> GApp (loc,p,l@[a])
-              | _ -> (GApp (dl,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 =
@@ -368,17 +457,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 with
-              | GLambda (_,x,_,t,c) -> x, c
-	      | _ -> Anonymous, typ in
-	    let aliastyp =
-	      if List.for_all (Name.equal Anonymous) nl then None
-	      else Some (dl,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 (CAst.make (indsp,nl)) in
+      n, aliastyp, Some typ
   in
   let constructs = Array.init (Array.length bl) (fun i -> (indsp,i+1)) in
   let tag =
@@ -399,20 +486,24 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl =
   | LetStyle, None ->
       let bl' = Array.map detype bl in
       let (nal,d) = it_destRLambda_or_LetIn_names constagsl.(0) bl'.(0) in
-      GLetTuple (dl,nal,(alias,pred),tomatch,d)
+      GLetTuple (nal,(alias,pred),tomatch,d)
   | IfStyle, None ->
       let bl' = Array.map detype bl in
       let nondepbrs =
 	Array.map3 (extract_nondep_branches testdep) bl bl' constagsl in
       if Array.for_all ((!=) None) nondepbrs then
-	GIf (dl,tomatch,(alias,pred),
+	GIf (tomatch,(alias,pred),
              Option.get nondepbrs.(0),Option.get nondepbrs.(1))
       else
 	let eqnl = detype_eqns constructs constagsl bl in
-	GCases (dl,tag,pred,[tomatch,(alias,aliastyp)],eqnl)
+	GCases (tag,pred,[tomatch,(alias,aliastyp)],eqnl)
   | _ ->
       let eqnl = detype_eqns constructs constagsl bl in
-      GCases (dl,tag,pred,[tomatch,(alias,aliastyp)],eqnl)
+      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
@@ -420,7 +511,7 @@ let detype_sort sigma = function
   | Type u ->
     GType
       (if !print_universes
-       then [dl, Pp.string_of_ppcmds (Univ.Universe.pr_with (Evd.pr_evd_level sigma) u)]
+       then detype_universe sigma u
        else [])
 
 type binder_kind = BProd | BLambda | BLetIn
@@ -428,72 +519,85 @@ type binder_kind = BProd | BLambda | BLetIn
 (**********************************************************************)
 (* Main detyping function                                             *)
 
-let detype_anonymous = ref (fun loc n -> anomaly ~label:"detype" (Pp.str "index to an anonymous variable"))
+let detype_anonymous = ref (fun ?loc n -> anomaly ~label:"detype" (Pp.str "index to an anonymous variable."))
 let set_detype_anonymous f = detype_anonymous := f
 
 let detype_level sigma l =
-  GType (Some (dl, Pp.string_of_ppcmds (Evd.pr_evd_level sigma 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 =
-  match kind_of_term (collapse_appl t) with
+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 (dl, id)
-	 | Anonymous -> !detype_anonymous dl n
+	 | Name id   -> GVar id
+	 | Anonymous -> GVar (!detype_anonymous n)
        with Not_found ->
 	 let s = "_UNBOUND_REL_"^(string_of_int n)
-	 in GVar (dl, Id.of_string s))
+	 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 (dl, 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 (dl, VarRef id, None)
-	 with Not_found -> GVar (dl, id))
-    | Sort s -> GSort (dl,detype_sort sigma s)
+	(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
+        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(dl,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
+	GCast(d1,cast)
+    | 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' with
- 	| GApp (dl',f',args'') -> 
- 	  GApp (dl,f',args''@args')
- 	| _ -> GApp (dl,f',args')
+ 	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)
-    | Const (sp,u) -> GRef (dl, ConstRef sp, detype_instance sigma u)
+      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 = GHole(Loc.ghost,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None) in
+	let hole = DAst.make @@ GHole(Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None) in
 	let args = List.make pars hole in
- 	  GApp (dl, GRef (dl, ConstRef (Projection.constant p), None), 
-		(args @ [detype flags avoid env sigma c]))
+ 	  GApp (DAst.make @@ GRef (ConstRef (Projection.constant p), None),
+		(args @ [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 (dl, GRef (dl, 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 *)
@@ -504,16 +608,18 @@ let rec detype flags avoid env sigma t =
 	      let ty = Retyping.get_type_of (snd env) sigma c in
 	      let ((ind,u), args) = Inductiveops.find_mrectype (snd env) sigma ty in
 	      let body' = strip_lam_assum body in
-	      let body' = subst_instance_constr u body' in
+	      let u = EInstance.kind sigma u in
+	      let body' = CVars.subst_instance_constr u body' in
+	      let body' = EConstr.of_constr body' in
 		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'
+	  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
+              DAst.get (detype d flags avoid env sigma c)
 	    with Retyping.RetypeError _ -> noparams ()
 	  else noparams ()
 
@@ -523,133 +629,134 @@ let rec detype flags avoid env sigma t =
           | LocalDef _ -> true
           | LocalAssum (id,_) ->
 	     try let n = List.index Name.equal (Name id) (fst env) in
-	         isRelN n c
-	     with Not_found -> isVarId id c
+	         isRelN sigma n c
+	     with Not_found -> isVarId sigma id c
         in
       let id,l =
         try
           let id = match Evd.evar_ident evk sigma with
-          | None -> Evd.pr_evar_suggested_name evk sigma
+          | None -> Termops.pr_evar_suggested_name evk sigma
           | Some id -> id
           in
           let l = Evd.evar_instance_array bound_to_itself_or_letin (Evd.find sigma evk) cl in
-          let fvs,rels = List.fold_left (fun (fvs,rels) (_,c) -> match kind_of_term c with Rel n -> (fvs,Int.Set.add n rels) | Var id -> (Id.Set.add id fvs,rels) | _ -> (fvs,rels)) (Id.Set.empty,Int.Set.empty) l in
-          let l = Evd.evar_instance_array (fun d c -> not !print_evar_arguments && (bound_to_itself_or_letin d c && not (isRel c && Int.Set.mem (destRel c) rels || isVar c && (Id.Set.mem (destVar c) fvs)))) (Evd.find sigma evk) cl in
+          let fvs,rels = List.fold_left (fun (fvs,rels) (_,c) -> match EConstr.kind sigma c with Rel n -> (fvs,Int.Set.add n rels) | Var id -> (Id.Set.add id fvs,rels) | _ -> (fvs,rels)) (Id.Set.empty,Int.Set.empty) l in
+          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 (dl,id,
-               List.map (on_snd (detype flags avoid env sigma)) l)
+        GEvar (id,
+               List.map (on_snd (detype d flags avoid env sigma)) l)
     | Ind (ind_sp,u) ->
-	GRef (dl, IndRef ind_sp, detype_instance sigma u)
+	GRef (IndRef ind_sp, detype_instance sigma u)
     | Construct (cstr_sp,u) ->
-	GRef (dl, ConstructRef cstr_sp, detype_instance sigma u)
+	GRef (ConstructRef cstr_sp, detype_instance sigma u)
     | Case (ci,p,c,bl) ->
-	let comp = computable 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)
-	  is_nondep_branch avoid
+	let comp = computable sigma p (List.length (ci.ci_pp_info.ind_tags)) in
+	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(dl,GFix (Array.map (fun i -> Some i, GStructRec) (fst nvn), snd nvn),Array.of_list (List.rev lfi),
+  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(dl,GCoFix n,Array.of_list (List.rev lfi),
+  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 =
-  match kind_of_term c, kind_of_term t with
+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') ->
         let na = match (na,na') with
             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) ci bl in
-    List.map (fun (pat,((avoid,env),c)) -> (dl,[],[pat],detype flags avoid env sigma c))
+    let mat = build_tree Anonymous (snd flags) (avoid,env) sigma ci bl in
+    List.map (fun (ids,pat,((avoid,env),c)) ->
+        CAst.make (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 1 b then
-      PatVar (dl,Anonymous),avoid,(add_name Anonymous body ty env),ids
+    if force_wildcard () && noccurn sigma 1 b then
+      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 flag avoid x b in
-      PatVar (dl,na),avoid',(add_name na body ty env),add_vname ids na
+      let na,avoid' = compute_displayed_name_in sigma flag avoid x b in
+      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 kind_of_term b, l with
-      | _, [] ->
-        (dl, Id.Set.elements ids,
-         [PatCstr(dl, constr, List.rev patlist,Anonymous)],
-         detype flags avoid env sigma b)
+    match EConstr.kind sigma b, l with
+      | _, [] -> CAst.make @@
+        (Id.Set.elements ids,
+         [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
@@ -662,7 +769,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 = PatVar (dl,Anonymous) in
+	    let pat = DAst.make @@ PatVar Anonymous in
             buildrec ids (pat::patlist) avoid env l b
 
       | _, false::l ->
@@ -677,25 +784,24 @@ 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 flag avoid na c
-  | _ -> compute_displayed_name_in flag avoid na c in
-  let r =  detype flags avoid' (add_name na' body ty env) sigma c in
+  | BLetIn -> compute_displayed_let_name_in sigma flag avoid na c
+  | _ -> compute_displayed_name_in sigma flag avoid na c in
+  let r =  detype d flags avoid' (add_name na' body ty env) sigma c in
   match bk with
-  | BProd -> GProd (dl, na',Explicit,detype (lax,false) avoid env sigma ty, r)
-  | BLambda -> GLambda (dl, 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 c = if s != InProp then c else
-          GCast (dl, c, CastConv (detype (lax,false) avoid env sigma ty)) in
-      GLetIn (dl, na', c, r)
+      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 where = Option.map (fun c -> it_mkLambda_or_LetIn c sign) where in
+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
   | [] -> []
   | decl::rest ->
@@ -707,26 +813,30 @@ let detype_rel_context ?(lax=false) where avoid env sigma sign =
 	| None -> na,avoid
 	| Some c ->
 	    if is_local_def decl then
-	      compute_displayed_let_name_in
+	      compute_displayed_let_name_in sigma
                 (RenamingElsewhereFor (fst env,c)) avoid na c
 	    else
-	      compute_displayed_name_in
+	      compute_displayed_name_in sigma
                 (RenamingElsewhereFor (fst env,c)) avoid na c in
       let b = match decl with
 	      | 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
   let convert_id cl id =
     try Id.Map.find id cl.idents
     with Not_found -> id
@@ -735,11 +845,11 @@ 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 = function
-    | GVar (loc,id) ->
+  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
-          GVar(loc,Id.Map.find id cl.idents)
+          GVar(Id.Map.find id cl.idents)
         (* if [id] is bound to a typed term *)
         with Not_found -> try
           (* assumes [detype] does not raise [Not_found] exceptions *)
@@ -747,127 +857,131 @@ let detype_closed_glob ?lax isgoal avoid env sigma t =
           (* spiwack: I'm not sure it is the right thing to do,
              but I'm computing the detyping environment like
              [Printer.pr_constr_under_binders_env] does. *)
-          let assums = List.map (fun id -> (Name id,(* dummy *) mkProp)) b in
-          let env = Termops.push_rels_assum assums env in
-          detype ?lax isgoal avoid env sigma c
+          let assums = List.map (fun id -> LocalAssum (Name id,(* dummy *) mkProp)) b in
+          let env = push_rel_context assums env in
+          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
+          DAst.get (detype_closed_glob closure term)
         (* Otherwise [id] stands for itself *)
         with Not_found ->
-         GVar(loc,id)
+         GVar id
         end
-    | GLambda (loc,id,k,t,c) ->
+    | GLambda (id,k,t,c) ->
         let id = convert_name cl id in
-        GLambda(loc,id,k,detype_closed_glob cl t, detype_closed_glob cl c)
-    | GProd (loc,id,k,t,c) ->
+        GLambda(id,k,detype_closed_glob cl t, detype_closed_glob cl c)
+    | GProd (id,k,t,c) ->
         let id = convert_name cl id in
-        GProd(loc,id,k,detype_closed_glob cl t, detype_closed_glob cl c)
-    | GLetIn (loc,id,b,e) ->
+        GProd(id,k,detype_closed_glob cl t, detype_closed_glob cl c)
+    | GLetIn (id,b,t,e) ->
         let id = convert_name cl id in
-        GLetIn(loc,id,detype_closed_glob cl b, detype_closed_glob cl e)
-    | GLetTuple (loc,ids,(n,r),b,e) ->
+        GLetIn(id,detype_closed_glob cl b, Option.map (detype_closed_glob cl) t, detype_closed_glob cl e)
+    | GLetTuple (ids,(n,r),b,e) ->
         let ids = List.map (convert_name cl) ids in
         let n = convert_name cl n in
-        GLetTuple (loc,ids,(n,r),detype_closed_glob cl b, detype_closed_glob cl e)
-    | GCases (loc,sty,po,tml,eqns) ->
+        GLetTuple (ids,(n,r),detype_closed_glob cl b, detype_closed_glob cl e)
+    | GCases (sty,po,tml,eqns) ->
         let (tml,eqns) =
           Glob_ops.map_pattern_binders (fun na -> convert_name cl na) tml eqns
         in
         let (tml,eqns) =
           Glob_ops.map_pattern (fun c -> detype_closed_glob cl c) tml eqns
         in
-        GCases(loc,sty,po,tml,eqns)
+        GCases(sty,po,tml,eqns)
     | c ->
-        Glob_ops.map_glob_constr (detype_closed_glob cl) c
+        DAst.get (Glob_ops.map_glob_constr (detype_closed_glob cl) cg)
+    ) cg
   in
   detype_closed_glob t.closure t.term
 
 (**********************************************************************)
 (* Module substitution: relies on detyping                            *)
 
-let rec subst_cases_pattern subst pat =
-  match pat with
-  | PatVar _ -> pat
-  | PatCstr (loc,((kn,i),j),cpl,n) ->
+let 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
       and cpl' = List.smartmap (subst_cases_pattern subst) cpl in
 	if kn' == kn && cpl' == cpl then pat else
-	  PatCstr (loc,((kn',i),j),cpl',n)
+	  PatCstr (((kn',i),j),cpl',n)
+  )
 
 let (f_subst_genarg, subst_genarg_hook) = Hook.make ()
 
-let rec subst_glob_constr subst raw =
-  match raw with
-  | GRef (loc,ref,u) ->
+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 t
+         DAst.get (detype Now false Id.Set.empty (Global.env()) Evd.empty (EConstr.of_constr t))
 
-  | GVar _ -> raw
-  | GEvar _ -> raw
-  | GPatVar _ -> raw
+  | GSort _
+  | GVar _
+  | GEvar _
+  | GPatVar _ as raw -> raw
 
-  | GApp (loc,r,rl) ->
+  | GApp (r,rl) as raw ->
       let r' = subst_glob_constr subst r
       and rl' = List.smartmap (subst_glob_constr subst) rl in
 	if r' == r && rl' == rl then raw else
-	  GApp(loc,r',rl')
+	  GApp(r',rl')
 
-  | GLambda (loc,n,bk,r1,r2) ->
+  | GLambda (n,bk,r1,r2) as raw ->
       let r1' = subst_glob_constr subst r1 and r2' = subst_glob_constr subst r2 in
 	if r1' == r1 && r2' == r2 then raw else
-	  GLambda (loc,n,bk,r1',r2')
+	  GLambda (n,bk,r1',r2')
 
-  | GProd (loc,n,bk,r1,r2) ->
+  | GProd (n,bk,r1,r2) as raw ->
       let r1' = subst_glob_constr subst r1 and r2' = subst_glob_constr subst r2 in
 	if r1' == r1 && r2' == r2 then raw else
-	  GProd (loc,n,bk,r1',r2')
+	  GProd (n,bk,r1',r2')
 
-  | GLetIn (loc,n,r1,r2) ->
-      let r1' = subst_glob_constr subst r1 and r2' = subst_glob_constr subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  GLetIn (loc,n,r1',r2')
+  | GLetIn (n,r1,t,r2) as raw ->
+      let r1' = subst_glob_constr subst r1 in
+      let r2' = subst_glob_constr subst r2 in
+      let t' = Option.smartmap (subst_glob_constr subst) t in
+	if r1' == r1 && t == t' && r2' == r2 then raw else
+	  GLetIn (n,r1',t',r2')
 
-  | GCases (loc,sty,rtno,rl,branches) ->
+  | GCases (sty,rtno,rl,branches) as raw ->
+    let open CAst in
       let rtno' = Option.smartmap (subst_glob_constr subst) rtno
       and rl' = List.smartmap (fun (a,x as y) ->
         let a' = subst_glob_constr subst a in
         let (n,topt) = x in
         let topt' = Option.smartmap
-          (fun (loc,(sp,i),y as t) ->
+          (fun ({loc;v=((sp,i),y)} as t) ->
             let sp' = subst_mind subst sp in
-            if sp == sp' then t else (loc,(sp',i),y)) topt in
+            if sp == sp' then t else CAst.(make ?loc ((sp',i),y))) topt in
         if a == a' && topt == topt' then y else (a',(n,topt'))) rl
       and branches' = List.smartmap
-			(fun (loc,idl,cpl,r as branch) ->
+                        (fun ({loc;v=(idl,cpl,r)} as branch) ->
 			   let cpl' =
 			     List.smartmap (subst_cases_pattern subst) cpl
 			   and r' = subst_glob_constr subst r in
 			     if cpl' == cpl && r' == r then branch else
-			       (loc,idl,cpl',r'))
+                               CAst.(make ?loc (idl,cpl',r')))
 			branches
       in
 	if rtno' == rtno && rl' == rl && branches' == branches then raw else
-	  GCases (loc,sty,rtno',rl',branches')
+	  GCases (sty,rtno',rl',branches')
 
-  | GLetTuple (loc,nal,(na,po),b,c) ->
+  | GLetTuple (nal,(na,po),b,c) as raw ->
       let po' = Option.smartmap (subst_glob_constr subst) po
       and b' = subst_glob_constr subst b
       and c' = subst_glob_constr subst c in
 	if po' == po && b' == b && c' == c then raw else
-          GLetTuple (loc,nal,(na,po'),b',c')
+          GLetTuple (nal,(na,po'),b',c')
 
-  | GIf (loc,c,(na,po),b1,b2) ->
+  | GIf (c,(na,po),b1,b2) as raw ->
       let po' = Option.smartmap (subst_glob_constr subst) po
       and b1' = subst_glob_constr subst b1
       and b2' = subst_glob_constr subst b2
       and c' = subst_glob_constr subst c in
 	if c' == c && po' == po && b1' == b1 && b2' == b2 then raw else
-          GIf (loc,c',(na,po'),b1',b2')
+          GIf (c',(na,po'),b1',b2')
 
-  | GRec (loc,fix,ida,bl,ra1,ra2) ->
+  | GRec (fix,ida,bl,ra1,ra2) as raw ->
       let ra1' = Array.smartmap (subst_glob_constr subst) ra1
       and ra2' = Array.smartmap (subst_glob_constr subst) ra2 in
       let bl' = Array.smartmap
@@ -877,11 +991,9 @@ let rec subst_glob_constr subst raw =
           if ty'==ty && obd'==obd then dcl else (na,k,obd',ty')))
         bl in
 	if ra1' == ra1 && ra2' == ra2 && bl'==bl then raw else
-	  GRec (loc,fix,ida,bl',ra1',ra2')
-
-  | GSort _ -> raw
+	  GRec (fix,ida,bl',ra1',ra2')
 
-  | GHole (loc, knd, naming, solve) ->
+  | GHole (knd, naming, solve) as raw ->
     let nknd = match knd with
     | Evar_kinds.ImplicitArg (ref, i, b) ->
       let nref, _ = subst_global subst ref in
@@ -890,25 +1002,25 @@ let rec subst_glob_constr subst raw =
     in
     let nsolve = Option.smartmap (Hook.get f_subst_genarg subst) solve in
     if nsolve == solve && nknd == knd then raw
-    else GHole (loc, nknd, naming, nsolve)
+    else GHole (nknd, naming, nsolve)
 
-  | GCast (loc,r1,k) ->
+  | GCast (r1,k) as raw ->
       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 (loc,r1',k')
+      if r1' == r1 && k' == k then raw else GCast (r1',k')
+  )
 
 (* Utilities to transform kernel cases to simple pattern-matching problem *)
 
 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 = PatVar (Loc.ghost,na) in
-      let p = PatCstr (Loc.ghost,(ind,i+1),List.map mkPatVar nal,Anonymous) in
-      let map name = try Some (Nameops.out_name name) with Failure _ -> None in
-      let ids = List.map_filter map nal in
-      (Loc.ghost,ids,[p],c))
+      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
+      CAst.make @@ (ids,[p],c))
     brs
 
 let return_type_of_predicate ind nrealargs_tags pred =
   let nal,p = it_destRLambda_or_LetIn_names (nrealargs_tags@[false]) pred in
-  (List.hd nal, Some (Loc.ghost, ind, List.tl nal)), Some p
+  (List.hd nal, Some (CAst.make (ind, List.tl nal))), Some p
diff --git a/pretyping/detyping.mli b/pretyping/detyping.mli
index c51cb0f4..32b94e1b 100644
--- a/pretyping/detyping.mli
+++ b/pretyping/detyping.mli
@@ -1,19 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
 open Environ
+open EConstr
 open Glob_term
 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
@@ -21,39 +28,43 @@ 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 : ?lax:bool -> bool -> Id.t list -> env -> evar_map -> constr -> glob_constr
+val detype_names : bool -> Id.Set.t -> names_context -> env -> evar_map -> constr -> glob_constr
 
-val detype_case :
-  bool -> (constr -> glob_constr) ->
-  (constructor array -> bool list array -> constr array ->
-    (Loc.t * Id.t list * cases_pattern list * glob_constr) list) ->
-  (constr -> bool list -> bool) ->
-  Id.t list -> inductive * case_style * bool list array * bool list ->
-    constr option -> constr -> constr array -> 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 -> Context.Rel.t -> 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 -> constr -> Id.t -> int option
-val lookup_index_as_renamed : env -> constr -> int -> int option
+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 -> Id.t) -> unit
 
-val set_detype_anonymous : (Loc.t -> int -> glob_constr) -> unit
 val force_wildcard : unit -> bool
 val synthetize_type : unit -> bool
 
@@ -71,7 +82,7 @@ val subst_genarg_hook :
 module PrintingInductiveMake :
   functor (Test : sig
     val encode : Libnames.reference -> Names.inductive
-    val member_message : Pp.std_ppcmds -> bool -> Pp.std_ppcmds
+    val member_message : Pp.t -> bool -> Pp.t
     val field : string
     val title : string
   end) ->
@@ -80,9 +91,9 @@ module PrintingInductiveMake :
       val compare : t -> t -> int
       val encode : Libnames.reference -> Names.inductive
       val subst : substitution -> t -> t
-      val printer : t -> Pp.std_ppcmds
+      val printer : t -> Pp.t
       val key : Goptions.option_name
       val title : string
-      val member_message : t -> bool -> Pp.std_ppcmds
+      val member_message : t -> bool -> Pp.t
       val synchronous : bool
     end
diff --git a/pretyping/doc.tex b/pretyping/doc.tex
deleted file mode 100644
index d92a027e..00000000
--- a/pretyping/doc.tex
+++ /dev/null
@@ -1,14 +0,0 @@
-
-\newpage
-\section*{Pre-typing}
-
-\ocwsection \label{pretyping}
-
-\bigskip
-\begin{center}\epsfig{file=pretyping.dep.ps,width=\linewidth}\end{center}
-
-
-%%% Local Variables: 
-%%% mode: latex
-%%% TeX-master: t
-%%% End: 
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 9fd55a48..d37090a6 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -1,37 +1,41 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Names
-open Term
+open Constr
+open Termops
+open Environ
+open EConstr
 open Vars
 open CClosure
 open Reduction
 open Reductionops
-open Termops
-open Environ
 open Recordops
 open Evarutil
 open Evardefine
 open Evarsolve
-open Globnames
 open Evd
 open Pretype_errors
-open Sigma.Notations
-open Context.Rel.Declaration
+open Context.Named.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 type unify_fun = transparent_state ->
-  env -> evar_map -> conv_pb -> constr -> constr -> Evarsolve.unification_result
+  env -> evar_map -> conv_pb -> EConstr.constr -> EConstr.constr -> Evarsolve.unification_result
 
 let debug_unification = ref (false)
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optdepr = false;
   Goptions.optname =
     "Print states sent to Evarconv unification";
   Goptions.optkey = ["Debug";"Unification"];
@@ -39,6 +43,31 @@ let _ = Goptions.declare_bool_option {
   Goptions.optwrite = (fun a -> debug_unification:=a);
 }
 
+(*******************************************)
+(* Functions to deal with impossible cases *)
+(*******************************************)
+(* XXX: we would like to search for this with late binding
+   "data.id.type" etc... *)
+let impossible_default_case () =
+  let c, ctx = Universes.fresh_global_instance (Global.env()) (Globnames.ConstRef Coqlib.id) in
+  let (_, u) = Constr.destConst c in
+  Some (c, Constr.mkConstU (Coqlib.type_of_id, u), ctx)
+
+let coq_unit_judge =
+  let open Environ in
+  let make_judge c t = make_judge (EConstr.of_constr c) (EConstr.of_constr t) in
+  let na1 = Name (Id.of_string "A") in
+  let na2 = Name (Id.of_string "H") in
+  fun () ->
+    match impossible_default_case () with
+    | Some (id, type_of_id, ctx) ->
+      make_judge id type_of_id, ctx
+    | None ->
+      (* In case the constants id/ID are not defined *)
+      Environ.make_judge (mkLambda (na1,mkProp,mkLambda(na2,mkRel 1,mkRel 1)))
+        (mkProd (na1,mkProp,mkArrow (mkRel 1) (mkRel 2))), 
+      Univ.ContextSet.empty
+
 let unfold_projection env evd ts p c =
   let cst = Projection.constant p in
     if is_transparent_constant ts cst then
@@ -46,21 +75,20 @@ let unfold_projection env evd ts p c =
     else None
       
 let eval_flexible_term ts env evd c =
-  match kind_of_term c with
-  | Const (c,u as cu) ->
+  match EConstr.kind evd c with
+  | Const (c, u) ->
       if is_transparent_constant ts c
-      then constant_opt_value_in env cu
+      then Option.map EConstr.of_constr (constant_opt_value_in env (c, EInstance.kind evd u))
       else None
   | Rel n ->
       (try match lookup_rel n env with
-           | LocalAssum _ -> None
-           | LocalDef (_,v,_) -> Some (lift n v)
+           | RelDecl.LocalAssum _ -> None
+           | RelDecl.LocalDef (_,v,_) -> Some (lift n v)
        with Not_found -> None)
   | Var id ->
       (try
 	 if is_transparent_variable ts id then
-           let open Context.Named.Declaration in
-	   lookup_named id env |> get_value
+	   env |> lookup_named id |> NamedDecl.get_value
 	 else None
        with Not_found -> None)
   | LetIn (_,b,_,c) -> Some (subst1 b c)
@@ -72,11 +100,11 @@ let eval_flexible_term ts env evd c =
 
 type flex_kind_of_term =
   | Rigid
-  | MaybeFlexible of Constr.t (* reducible but not necessarily reduced *)
-  | Flexible of existential
+  | MaybeFlexible of EConstr.t (* reducible but not necessarily reduced *)
+  | Flexible of EConstr.existential
 
 let flex_kind_of_term ts env evd c sk =
-  match kind_of_term c with
+  match EConstr.kind evd c with
     | LetIn _ | Rel _ | Const _ | Var _ | Proj _ ->
       Option.cata (fun x -> MaybeFlexible x) Rigid (eval_flexible_term ts env evd c)
     | Lambda _ when not (Option.is_empty (Stack.decomp sk)) -> MaybeFlexible c
@@ -86,10 +114,13 @@ let flex_kind_of_term ts env evd c sk =
     | Fix _ -> Rigid (* happens when the fixpoint is partially applied *)
     | Cast _ | App _ | Case _ -> assert false
 
+let add_conv_pb (pb, env, x, y) sigma =
+  Evd.add_conv_pb (pb, env, EConstr.Unsafe.to_constr x, EConstr.Unsafe.to_constr y) sigma
+
 let apprec_nohdbeta ts env evd c =
   let (t,sk as appr) = Reductionops.whd_nored_state evd (c, []) in
   if Stack.not_purely_applicative sk
-  then Stack.zip (fst (whd_betaiota_deltazeta_for_iota_state
+  then Stack.zip evd (fst (whd_betaiota_deltazeta_for_iota_state
 		   ts env evd Cst_stack.empty appr))
   else c
 
@@ -99,7 +130,7 @@ let position_problem l2r = function
 
 let occur_rigidly (evk,_ as ev) evd t =
   let rec aux t =
-    match kind_of_term (whd_evar evd t) with
+    match EConstr.kind evd t with
     | App (f, c) -> if aux f then Array.exists aux c else false
     | Construct _ | Ind _ | Sort _ | Meta _ | Fix _ | CoFix _ -> true
     | Proj (p, c) -> not (aux c)
@@ -109,7 +140,7 @@ let occur_rigidly (evk,_ as ev) evd t =
     | Const _ -> false
     | Prod (_, b, t) -> ignore(aux b || aux t); true
     | Rel _ | Var _ -> false
-    | Case (_,_,c,_) -> if eq_constr (mkEvar ev) c then raise Occur else false
+    | Case (_,_,c,_) -> if eq_constr evd (mkEvar ev) c then raise Occur else false
   in try ignore(aux t); false with Occur -> true
 
 (* [check_conv_record env sigma (t1,stack1) (t2,stack2)] tries to decompose 
@@ -133,20 +164,28 @@ let occur_rigidly (evk,_ as ev) evd t =
    projection would have been reduced) *)
 
 let check_conv_record env sigma (t1,sk1) (t2,sk2) =
-  let (proji, u), arg = Universes.global_app_of_constr t1 in
+  let (proji, u), arg = Termops.global_app_of_constr sigma t1 in
   let canon_s,sk2_effective =
     try
-      match kind_of_term t2 with
+      match EConstr.kind sigma t2 with
 	Prod (_,a,b) -> (* assert (l2=[]); *)
-	  let _, a, b = destProd (Evarutil.nf_evar sigma t2) in
-      	  if dependent (mkRel 1) b then raise Not_found
-	  else lookup_canonical_conversion (proji, Prod_cs),
+	  let _, a, b = destProd sigma t2 in
+          if noccurn sigma 1 b then
+            lookup_canonical_conversion (proji, Prod_cs),
 	    (Stack.append_app [|a;pop b|] Stack.empty)
+          else raise Not_found
       | 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 = global_of_constr t2 in
+	let (c2, _) = Termops.global_of_constr sigma t2 in
 	  lookup_canonical_conversion (proji, Const_cs c2),sk2
     with Not_found ->
       let (c, cs) = lookup_canonical_conversion (proji,Default_cs) in 
@@ -154,12 +193,14 @@ let check_conv_record env sigma (t1,sk1) (t2,sk2) =
   in
   let t', { o_DEF = c; o_CTX = ctx; o_INJ=n; o_TABS = bs;
         o_TPARAMS = params; o_NPARAMS = nparams; o_TCOMPS = us } = canon_s in
+  let us = List.map EConstr.of_constr us in
+  let params = List.map EConstr.of_constr params in
   let params1, c1, extra_args1 =
     match arg with
     | Some c -> (* A primitive projection applied to c *)
       let ty = Retyping.get_type_of ~lax:true env sigma c in
       let (i,u), ind_args = 
-	try Inductiveops.find_mrectype env sigma ty 
+	try Inductiveops.find_mrectype env sigma ty
 	with _ -> raise Not_found
       in Stack.append_app_list ind_args Stack.empty, c, sk1
     | None ->
@@ -172,14 +213,19 @@ let check_conv_record env sigma (t1,sk1) (t2,sk2) =
       else match (Stack.strip_n_app (l_us-1) sk2_effective) with
       | None -> raise Not_found
       | Some (l',el,s') -> (l'@Stack.append_app [|el|] Stack.empty,s') in
-  let subst, ctx' = Universes.fresh_universe_context_set_instance ctx in
+  let u, ctx' = Universes.fresh_instance_from ctx None in
+  let subst = Univ.make_inverse_instance_subst u in
+  let c = EConstr.of_constr c in
   let c' = subst_univs_level_constr subst c in
+  let t' = EConstr.of_constr t' in
   let t' = subst_univs_level_constr subst t' in
-  let bs' = List.map (subst_univs_level_constr subst) bs in
-  let h, _ = decompose_app_vect 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,
-    (n,Stack.zip(t2,sk2))
+    (n, Stack.zip sigma (t2,sk2))
 
 (* Precondition: one of the terms of the pb is an uninstantiated evar,
  * possibly applied to arguments. *)
@@ -250,7 +296,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,
@@ -263,8 +309,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
@@ -294,11 +338,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
@@ -310,6 +352,14 @@ let exact_ise_stack2 env evd f sk1 sk2 =
     ise_stack2 evd (List.rev sk1) (List.rev sk2)
   else UnifFailure (evd, (* Dummy *) NotSameHead)
 
+(* Add equality constraints for covariant/invariant positions. For
+   irrelevant positions, unify universes when flexible. *)
+let compare_cumulative_instances evd variances u u' =
+  match Evarutil.compare_cumulative_instances CONV variances u u' evd with
+  | Inl evd ->
+    Success evd
+  | Inr p -> UnifFailure (evd, UnifUnivInconsistency p)
+
 let rec evar_conv_x ts env evd pbty term1 term2 =
   let term1 = whd_head_evar evd term1 in
   let term2 = whd_head_evar evd term2 in
@@ -321,7 +371,7 @@ let rec evar_conv_x ts env evd pbty term1 term2 =
       let e =
 	try
 	  let evd, b = infer_conv ~catch_incon:false ~pb:pbty ~ts:(fst ts)
-	    env evd term1 term2 
+	    env evd term1 term2
 	  in
 	    if b then Success evd
 	    else UnifFailure (evd, ConversionFailed (env,term1,term2))
@@ -335,7 +385,7 @@ let rec evar_conv_x ts env evd pbty term1 term2 =
   match ground_test with
     | Some result -> result
     | None ->
-	(* Until pattern-unification is used consistently, use nohdbeta to not
+      (* Until pattern-unification is used consistently, use nohdbeta to not
 	   destroy beta-redexes that can be used for 1st-order unification *)
         let term1 = apprec_nohdbeta (fst ts) env evd term1 in
         let term2 = apprec_nohdbeta (fst ts) env evd term2 in
@@ -344,16 +394,16 @@ let rec evar_conv_x ts env evd pbty term1 term2 =
             (whd_nored_state evd (term1,Stack.empty), Cst_stack.empty)
             (whd_nored_state evd (term2,Stack.empty), Cst_stack.empty)
 	in
-          begin match kind_of_term term1, kind_of_term term2 with
+          begin match EConstr.kind evd term1, EConstr.kind evd term2 with
           | Evar ev, _ when Evd.is_undefined evd (fst ev) ->
             (match solve_simple_eqn (evar_conv_x ts) env evd
-              (position_problem true pbty,ev,term2) with
+              (position_problem true pbty,ev, term2) with
 	      | UnifFailure (_,OccurCheck _) -> 
 		(* Eta-expansion might apply *) default ()
 	      | x -> x)
           | _, Evar ev when Evd.is_undefined evd (fst ev) ->
             (match solve_simple_eqn (evar_conv_x ts) env evd
-              (position_problem false pbty,ev,term1) with
+              (position_problem false pbty,ev, term1) with
 	      | UnifFailure (_, OccurCheck _) ->
 		(* Eta-expansion might apply *) default () 
 	      | x -> x)
@@ -369,8 +419,8 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     match is_unification_pattern_evar env evd ev lF tM with
       | None -> fallback ()
       | Some l1' -> (* Miller-Pfenning's patterns unification *)
-	let t2 = nf_evar evd tM in
-	let t2 = solve_pattern_eqn env l1' t2 in
+	let t2 = tM in
+	let t2 = solve_pattern_eqn env evd l1' t2 in
 	  solve_simple_eqn (evar_conv_x ts) env evd
 	    (position_problem on_left pbty,ev,t2) 
   in
@@ -379,34 +429,82 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     let not_only_app = Stack.not_purely_applicative skO in
     match switch (ise_stack2 not_only_app env evd (evar_conv_x ts)) skF skO with
       |Some (l,r), Success i' when on_left && (not_only_app || List.is_empty l) ->
-	switch (evar_conv_x ts env i' pbty) (Stack.zip(termF,l)) (Stack.zip(termO,r))
+	switch (evar_conv_x ts env i' pbty) (Stack.zip evd (termF,l)) (Stack.zip evd (termO,r))
       |Some (r,l), Success i' when not on_left && (not_only_app || List.is_empty l) ->
-	switch (evar_conv_x ts env i' pbty) (Stack.zip(termF,l)) (Stack.zip(termO,r))
+	switch (evar_conv_x ts env i' pbty) (Stack.zip evd (termF,l)) (Stack.zip evd (termO,r))
       |None, Success i' -> switch (evar_conv_x ts env i' pbty) termF termO
       |_, (UnifFailure _ as x) -> x
       |Some _, _ -> UnifFailure (evd,NotSameArgSize) in
   let eta env evd onleft sk term sk' term' =
     assert (match sk with [] -> true | _ -> false);
-    let (na,c1,c'1) = destLambda term in
+    let (na,c1,c'1) = destLambda evd term in
     let c = nf_evar evd c1 in
-    let env' = push_rel (LocalAssum (na,c)) env in
+    let env' = push_rel (RelDecl.LocalAssum (na,c)) env in
     let out1 = whd_betaiota_deltazeta_for_iota_state
       (fst ts) env' evd Cst_stack.empty (c'1, Stack.empty) in
     let out2 = whd_nored_state evd
-      (Stack.zip (term', sk' @ [Stack.Shift 1]), Stack.append_app [|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
   in
   let rigids env evd sk term sk' term' =
-    let b,univs = Universes.eq_constr_universes term term' in
-      if b then
-       ise_and evd [(fun i ->
-         let cstrs = Universes.to_constraints (Evd.universes i) univs in
-           try Success (Evd.add_constraints i cstrs)
-           with Univ.UniverseInconsistency p -> UnifFailure (i, UnifUnivInconsistency p));
-                  (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk sk')]
-      else UnifFailure (evd,NotSameHead)
+    let check_strict evd u u' =
+      let cstrs = Univ.enforce_eq_instances u u' Univ.Constraint.empty in
+      try Success (Evd.add_constraints evd cstrs)
+      with Univ.UniverseInconsistency p -> UnifFailure (evd, UnifUnivInconsistency p)
+    in
+    let compare_heads evd =
+      match EConstr.kind evd term, EConstr.kind evd term' with
+      | Const (c, u), Const (c', u') when Constant.equal c c' ->
+        let u = EInstance.kind evd u and u' = EInstance.kind evd u' in
+        check_strict evd u u'
+      | Const _, Const _ -> UnifFailure (evd, NotSameHead)
+      | Ind ((mi,i) as ind , u), Ind (ind', u') when Names.eq_ind ind ind' ->
+        if EInstance.is_empty u && EInstance.is_empty u' then Success evd
+        else
+          let u = EInstance.kind evd u and u' = EInstance.kind evd u' in
+          let mind = Environ.lookup_mind mi env in
+          let open Declarations in
+          begin match mind.mind_universes with
+            | Monomorphic_ind _ -> assert false
+            | Polymorphic_ind _ -> check_strict evd u u'
+            | Cumulative_ind cumi ->
+              let nparamsaplied = Stack.args_size sk in
+              let nparamsaplied' = Stack.args_size sk' in
+              let needed = Reduction.inductive_cumulativity_arguments (mind,i) in
+              if not (Int.equal nparamsaplied needed && Int.equal nparamsaplied' needed)
+              then check_strict evd u u'
+              else
+                compare_cumulative_instances evd (Univ.ACumulativityInfo.variance cumi) u u'
+          end
+      | Ind _, Ind _ -> UnifFailure (evd, NotSameHead)
+      | Construct (((mi,ind),ctor as cons), u), Construct (cons', u')
+        when Names.eq_constructor cons cons' ->
+        if EInstance.is_empty u && EInstance.is_empty u' then Success evd
+        else
+          let u = EInstance.kind evd u and u' = EInstance.kind evd u' in
+          let mind = Environ.lookup_mind mi env in
+          let open Declarations in
+          begin match mind.mind_universes with
+            | Monomorphic_ind _ -> assert false
+            | Polymorphic_ind _ -> check_strict evd u u'
+            | Cumulative_ind cumi ->
+              let nparamsaplied = Stack.args_size sk in
+              let nparamsaplied' = Stack.args_size sk' in
+              let needed = Reduction.constructor_cumulativity_arguments (mind,ind,ctor) in
+              if not (Int.equal nparamsaplied needed && Int.equal nparamsaplied' needed)
+              then check_strict evd u u'
+              else
+                Success (compare_constructor_instances evd u u')
+          end
+      | Construct _, Construct _ -> UnifFailure (evd, NotSameHead)
+      | _, _ -> anomaly (Pp.str "")
+    in
+    ise_and evd [(fun i ->
+                try compare_heads i
+                with Univ.UniverseInconsistency p -> UnifFailure (i, UnifUnivInconsistency p));
+                 (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk sk')]
   in
   let flex_maybeflex on_left ev ((termF,skF as apprF),cstsF) ((termM, skM as apprM),cstsM) vM =
     let switch f a b = if on_left then f a b else f b a in
@@ -415,10 +513,10 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
       match Stack.list_of_app_stack skF with
       | None -> quick_fail evd
       | Some lF -> 
-        let tM = Stack.zip apprM in
+        let tM = Stack.zip evd apprM in
 	  miller_pfenning on_left
 	    (fun () -> if not_only_app then (* Postpone the use of an heuristic *)
-	      switch (fun x y -> Success (add_conv_pb (pbty,env,x,y) i)) (Stack.zip apprF) tM
+	      switch (fun x y -> Success (add_conv_pb (pbty,env,x,y) i)) (Stack.zip evd apprF) tM
 	    else quick_fail i)
 	  ev lF tM i
     and consume (termF,skF as apprF) (termM,skM as apprM) i = 
@@ -432,7 +530,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     in    
     let default i = ise_try i [f1; consume apprF apprM; delta]
     in
-      match kind_of_term termM with
+      match EConstr.kind evd termM with
       | Proj (p, c) when not (Stack.is_empty skF) ->
 	(* Might be ?X args = p.c args', and we have to eta-expand the 
 	   primitive projection if |args| >= |args'|+1. *)
@@ -462,7 +560,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
   let flex_rigid on_left ev (termF, skF as apprF) (termR, skR as apprR) =
     let switch f a b = if on_left then f a b else f b a in
     let eta evd =
-      match kind_of_term termR with
+      match EConstr.kind evd termR with
       | Lambda _ when (* if ever problem is ill-typed: *) List.is_empty skR ->
          eta env evd false skR termR skF termF
       | Construct u -> eta_constructor ts env evd skR u skF termF
@@ -472,7 +570,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     | None ->
         ise_try evd [consume_stack on_left apprF apprR; eta]
     | Some lF ->
-        let tR = Stack.zip apprR in
+        let tR = Stack.zip evd apprR in
 	  miller_pfenning on_left
 	    (fun () ->
 	      ise_try evd 
@@ -480,12 +578,12 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 		 (fun i -> 
 		   if not (occur_rigidly ev i tR) then
                      let i,tF =
-                       if isRel tR || isVar tR then
+                       if isRel i tR || isVar i tR then
                          (* Optimization so as to generate candidates *)
                          let i,ev = evar_absorb_arguments env i ev lF in
                          i,mkEvar ev
                        else
-                         i,Stack.zip apprF in
+                         i,Stack.zip evd apprF in
 		     switch (fun x y -> Success (add_conv_pb (pbty,env,x,y) i))
 	               tF tR
 		   else
@@ -496,8 +594,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
   (* Evar must be undefined since we have flushed evars *)
   let () = if !debug_unification then
 	     let open Pp in
-	     Feedback.msg_notice (v 0 (pr_state appr1 ++ cut () ++ pr_state appr2 ++ cut ()) 
-		 ++ fnl ()) in
+	     Feedback.msg_notice (v 0 (pr_state appr1 ++ cut () ++ pr_state appr2 ++ cut ())) in
   match (flex_kind_of_term (fst ts) env evd term1 sk1, 
 	 flex_kind_of_term (fst ts) env evd term2 sk2) with
     | Flexible (sp1,al1 as ev1), Flexible (sp2,al2 as ev2) ->
@@ -509,9 +606,9 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
             (* We do have sk1[] = sk2[]: we now unify ?ev1 and ?ev2 *)
             (* Note that ?ev1 and ?ev2, may have been instantiated in the meantime *)
 	    let ev1' = whd_evar i' (mkEvar ev1) in
-	      if isEvar ev1' then
+	      if isEvar i' ev1' then
 		solve_simple_eqn (evar_conv_x ts) env i'
-		  (position_problem true pbty,destEvar ev1',term2)
+		  (position_problem true pbty,destEvar i' ev1', term2)
 	      else 
 		evar_eqappr_x ts env evd pbty 
 		  ((ev1', sk1), csts1) ((term2, sk2), csts2)
@@ -519,9 +616,9 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
             (* We have sk1'[] = sk2[] for some sk1' s.t. sk1[]=sk1'[r[]] *)
             (* we now unify r[?ev1] and ?ev2 *)
 	    let ev2' = whd_evar i' (mkEvar ev2) in
-	      if isEvar ev2' then
+	      if isEvar i' ev2' then
 		solve_simple_eqn (evar_conv_x ts) env i'
-		  (position_problem false pbty,destEvar ev2',Stack.zip(term1,r))
+		  (position_problem false pbty,destEvar i' ev2',Stack.zip evd (term1,r))
 	      else 
 		evar_eqappr_x ts env evd pbty 
 		  ((ev2', sk1), csts1) ((term2, sk2), csts2)
@@ -530,9 +627,9 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
             (* We have sk1[] = sk2'[] for some sk2' s.t. sk2[]=sk2'[r[]] *)
             (* we now unify ?ev1 and r[?ev2] *)
 	    let ev1' = whd_evar i' (mkEvar ev1) in
-	      if isEvar ev1' then
+	      if isEvar i' ev1' then
 		solve_simple_eqn (evar_conv_x ts) env i'
-	          (position_problem true pbty,destEvar ev1',Stack.zip(term2,r))
+	          (position_problem true pbty,destEvar i' ev1',Stack.zip evd (term2,r))
 	      else evar_eqappr_x ts env evd pbty 
 		((ev1', sk1), csts1) ((term2, sk2), csts2)
 	  | None, (UnifFailure _ as x) ->
@@ -585,7 +682,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
       flex_maybeflex false ev2 (appr2,csts2) (appr1,csts1) v1
 
     | MaybeFlexible v1, MaybeFlexible v2 -> begin
-        match kind_of_term term1, kind_of_term term2 with
+        match EConstr.kind evd term1, EConstr.kind evd term2 with
         | LetIn (na1,b1,t1,c'1), LetIn (na2,b2,t2,c'2) ->
         let f1 i = (* FO *)
           ise_and i
@@ -596,8 +693,8 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	     (fun i ->
 	       let b = nf_evar i b1 in
 	       let t = nf_evar i t1 in
-               let na = Nameops.name_max na1 na2 in
-	       evar_conv_x ts (push_rel (LocalDef (na,b,t)) env) i pbty c'1 c'2);
+               let na = Nameops.Name.pick na1 na2 in
+	       evar_conv_x ts (push_rel (RelDecl.LocalDef (na,b,t)) env) i pbty c'1 c'2);
 	     (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk1 sk2)]
 	and f2 i =
           let out1 = whd_betaiota_deltazeta_for_iota_state (fst ts) env i csts1 (v1,sk1)
@@ -620,9 +717,9 @@ 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 (Retyping.expand_projection env evd p c []))
+	    try Some (destApp evd (Retyping.expand_projection env evd p c []))
 	    with Retyping.RetypeError _ -> None
 	  in
 	    (match res with 
@@ -631,9 +728,9 @@ 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 (Retyping.expand_projection env evd p' c' []))
+	    try Some (destApp evd (Retyping.expand_projection env evd p' c' []))
 	    with Retyping.RetypeError _ -> None
 	  in 
 	    (match res with
@@ -648,14 +745,16 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	     allow this identification (first-order unification of universes). Otherwise
 	     fallback to unfolding.
 	  *)
-	  let b,univs = Universes.eq_constr_universes term1 term2 in
-	    if b then
+          let univs = EConstr.eq_constr_universes env evd term1 term2 in
+          match univs with
+          | Some univs ->
 	      ise_and i [(fun i -> 
 		try Success (Evd.add_universe_constraints i univs)
 		with UniversesDiffer -> UnifFailure (i,NotSameHead)
 		| Univ.UniverseInconsistency p -> UnifFailure (i, UnifUnivInconsistency p));
 			 (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk1 sk2)]
-	    else UnifFailure (i,NotSameHead)
+          | None ->
+            UnifFailure (i,NotSameHead)
 	and f2 i =
 	  (try 
 	     if not (snd ts) then raise Not_found
@@ -668,7 +767,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
              if the first argument is a beta-redex (expand a constant
              only if necessary) or the second argument is potentially
              usable as a canonical projection or canonical value *)
-          let rec is_unnamed (hd, args) = match kind_of_term hd with
+          let rec is_unnamed (hd, args) = match EConstr.kind i hd with
             | (Var _|Construct _|Ind _|Const _|Prod _|Sort _) ->
 	      Stack.not_purely_applicative args
             | (CoFix _|Meta _|Rel _)-> true
@@ -689,7 +788,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
           let rhs_is_already_stuck =
             rhs_is_already_stuck || rhs_is_stuck_and_unnamed () in
 
-	  if (isLambda term1 || rhs_is_already_stuck)
+	  if (EConstr.isLambda i term1 || rhs_is_already_stuck)
 	    && (not (Stack.not_purely_applicative sk1)) then
 	    evar_eqappr_x ~rhs_is_already_stuck ts env i pbty
 	      (whd_betaiota_deltazeta_for_iota_state
@@ -703,16 +802,16 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	ise_try evd [f1; f2; f3]
     end
 
-    | Rigid, Rigid when isLambda term1 && isLambda term2 ->
-        let (na1,c1,c'1) = destLambda term1 in
-        let (na2,c2,c'2) = destLambda term2 in
+    | Rigid, Rigid when EConstr.isLambda evd term1 && EConstr.isLambda evd term2 ->
+        let (na1,c1,c'1) = EConstr.destLambda evd term1 in
+        let (na2,c2,c'2) = EConstr.destLambda evd term2 in
         assert app_empty;
         ise_and evd
           [(fun i -> evar_conv_x ts env i CONV c1 c2);
            (fun i ->
 	     let c = nf_evar i c1 in
-             let na = Nameops.name_max na1 na2 in
-	     evar_conv_x ts (push_rel (LocalAssum (na,c)) env) i CONV c'1 c'2)]
+             let na = Nameops.Name.pick na1 na2 in
+	     evar_conv_x ts (push_rel (RelDecl.LocalAssum (na,c)) env) i CONV c'1 c'2)]
 
     | Flexible ev1, Rigid -> flex_rigid true ev1 appr1 appr2
     | Rigid, Flexible ev2 -> flex_rigid false ev2 appr2 appr1
@@ -745,17 +844,19 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	  ise_try evd [f3; f4]
 
     (* Eta-expansion *)
-    | Rigid, _ when isLambda term1 && (* if ever ill-typed: *) List.is_empty sk1 ->
+    | Rigid, _ when isLambda evd term1 && (* if ever ill-typed: *) List.is_empty sk1 ->
         eta env evd true sk1 term1 sk2 term2
 
-    | _, Rigid when isLambda term2 && (* if ever ill-typed: *) List.is_empty sk2 ->
+    | _, Rigid when isLambda evd term2 && (* if ever ill-typed: *) List.is_empty sk2 ->
         eta env evd false sk2 term2 sk1 term1
 
     | Rigid, Rigid -> begin
-        match kind_of_term term1, kind_of_term term2 with
+        match EConstr.kind evd term1, EConstr.kind evd term2 with
 
 	| Sort s1, Sort s2 when app_empty ->
 	    (try
+              let s1 = ESorts.kind evd s1 in
+              let s2 = ESorts.kind evd s2 in
 	       let evd' =
 		 if pbty == CONV
 		 then Evd.set_eq_sort env evd s1 s2
@@ -770,8 +871,8 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
               [(fun i -> evar_conv_x ts env i CONV c1 c2);
                (fun i ->
  	         let c = nf_evar i c1 in
-                 let na = Nameops.name_max n1 n2 in
-	         evar_conv_x ts (push_rel (LocalAssum (na,c)) env) i pbty c'1 c'2)]
+                 let na = Nameops.Name.pick n1 n2 in
+	         evar_conv_x ts (push_rel (RelDecl.LocalAssum (na,c)) env) i pbty c'1 c'2)]
 
 	| Rel x1, Rel x2 ->
 	    if Int.equal x1 x2 then
@@ -818,7 +919,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	  begin match ise_stack2 true env evd (evar_conv_x ts) sk1 sk2 with
 	  |_, (UnifFailure _ as x) -> x
 	  |None, Success i' -> evar_conv_x ts env i' CONV term1 term2
-	  |Some (sk1',sk2'), Success i' -> evar_conv_x ts env i' CONV (Stack.zip (term1,sk1')) (Stack.zip (term2,sk2'))
+	  |Some (sk1',sk2'), Success i' -> evar_conv_x ts env i' CONV (Stack.zip i' (term1,sk1')) (Stack.zip i' (term2,sk2'))
 	  end
 
 	| (Ind _ | Sort _ | Prod _ | CoFix _ | Fix _ | Rel _ | Var _ | Const _), _ ->
@@ -866,10 +967,8 @@ and conv_record trs env evd (ctx,(h,h2),c,bs,(params,params1),(us,us2),(sk1,sk2)
 	    let test i = evar_conv_x trs env i CUMUL ty (substl ks b) in
 	      (i,t2::ks, m-1, test)
 	  else
-	    let dloc = (Loc.ghost,Evar_kinds.InternalHole) in
-	    let i = Sigma.Unsafe.of_evar_map i in
-            let Sigma (ev, i', _) = Evarutil.new_evar env i ~src:dloc (substl ks b) in
-            let i' = Sigma.to_evar_map i' in
+	    let dloc = Loc.tag Evar_kinds.InternalHole in
+            let (i', ev) = Evarutil.new_evar env i ~src:dloc (substl ks b) in
 	    (i', ev :: ks, m - 1,test))
 	(evd,[],List.length bs,fun i -> Success i) bs
     in
@@ -887,19 +986,19 @@ and conv_record trs env evd (ctx,(h,h2),c,bs,(params,params1),(us,us2),(sk1,sk2)
        (fun i -> exact_ise_stack2 env i (evar_conv_x trs) sk1 sk2);
        test;
        (fun i -> evar_conv_x trs env i CONV h2
-	 (fst (decompose_app_vect (substl ks h))))]
+	 (fst (decompose_app_vect i (substl ks h))))]
   else UnifFailure(evd,(*dummy*)NotSameHead)
 
 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
 	   let l2' = 
-	     let term = Stack.zip (term2,sk2) in 
-	       List.map (fun p -> mkProj (Projection.make p false, term)) (Array.to_list projs)
+	     let term = Stack.zip evd (term2,sk2) in 
+	       List.map (fun p -> EConstr.mkProj (Projection.make p false, term)) (Array.to_list projs)
 	   in
 	     exact_ise_stack2 env evd (evar_conv_x (fst ts, false)) l1' 
 	       (Stack.append_app_list l2' Stack.empty)
@@ -914,8 +1013,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 ()
@@ -943,50 +1042,57 @@ let first_order_unification ts env evd (ev1,l1) (term2,l2) =
 let choose_less_dependent_instance evk evd term args =
   let evi = Evd.find_undefined evd evk in
   let subst = make_pure_subst evi args in
-  let subst' = List.filter (fun (id,c) -> Term.eq_constr c term) subst in
+  let subst' = List.filter (fun (id,c) -> EConstr.eq_constr evd c term) subst in
   match subst' with
   | [] -> None
-  | (id, _) :: _ -> Some (Evd.define evk (mkVar id) evd)
+  | (id, _) :: _ -> Some (Evd.define evk (Constr.mkVar id) evd)
 
-open Context.Named.Declaration
 let apply_on_subterm env evdref f c t =
   let rec applyrec (env,(k,c) as acc) t =
     (* By using eq_constr, we make an approximation, for instance, we *)
     (* could also be interested in finding a term u convertible to t *)
     (* such that c occurs in u *)
-    if e_eq_constr_univs evdref c t then f k
+    let eq_constr c1 c2 = match EConstr.eq_constr_universes env !evdref c1 c2 with
+    | None -> false
+    | Some cstr ->
+      try ignore (Evd.add_universe_constraints !evdref cstr); true
+      with UniversesDiffer -> false
+    in
+    if eq_constr c t then f k
     else
-      match kind_of_term t with
-      | Evar (evk,args) when Evd.is_undefined !evdref evk ->
+      match EConstr.kind !evdref t with
+      | Evar (evk,args) ->
           let ctx = evar_filtered_context (Evd.find_undefined !evdref evk) in
           let g decl a = if is_local_assum decl then applyrec acc a else a in
           mkEvar (evk, Array.of_list (List.map2 g ctx (Array.to_list args)))
       | _ ->
-        map_constr_with_binders_left_to_right
+        map_constr_with_binders_left_to_right !evdref
 	  (fun d (env,(k,c)) -> (push_rel d env, (k+1,lift 1 c)))
 	  applyrec acc t
   in
   applyrec (env,(0,c)) t
 
-let filter_possible_projections c ty ctxt args =
+let filter_possible_projections evd c ty ctxt args =
   (* Since args in the types will be replaced by holes, we count the
      fv of args to have a well-typed filter; don't know how necessary
-     it is however to have a well-typed filter here *)
-  let fv1 = free_rels (mkApp (c,args)) (* Hack: locally untyped *) in
-  let fv2 = collect_vars (mkApp (c,args)) in
+    it is however to have a well-typed filter here *)
+  let fv1 = free_rels evd (mkApp (c,args)) (* Hack: locally untyped *) in
+  let fv2 = collect_vars evd (mkApp (c,args)) in
   let len = Array.length args in
-  let tyvars = collect_vars ty in
+  let tyvars = collect_vars evd ty in
   List.map_i (fun i decl ->
     let () = assert (i < len) in
     let a = Array.unsafe_get args i in
-    (match decl with LocalAssum _ -> false | LocalDef (_,c,_) -> not (isRel c || isVar c)) ||
+    (match decl with
+     | NamedDecl.LocalAssum _ -> false
+     | NamedDecl.LocalDef (_,c,_) -> not (isRel evd (EConstr.of_constr c) || isVar evd (EConstr.of_constr c))) ||
     a == c ||
     (* Here we make an approximation, for instance, we could also be *)
     (* interested in finding a term u convertible to c such that a occurs *)
     (* in u *)
-    isRel a && Int.Set.mem (destRel a) fv1 ||
-    isVar a && Id.Set.mem (destVar a) fv2 ||
-    Id.Set.mem (get_id decl) tyvars)
+    isRel evd a && Int.Set.mem (destRel evd a) fv1 ||
+    isVar evd a && Id.Set.mem (destVar evd a) fv2 ||
+    Id.Set.mem (NamedDecl.get_id decl) tyvars)
     0 ctxt
 
 let solve_evars = ref (fun _ -> failwith "solve_evars not installed")
@@ -1017,39 +1123,39 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
   let env_evar = evar_filtered_env evi in
   let sign = named_context_val env_evar in
   let ctxt = evar_filtered_context evi in
-  let instance = List.map mkVar (List.map get_id ctxt) in
+  let instance = List.map mkVar (List.map NamedDecl.get_id ctxt) in
 
   let rec make_subst = function
-  | decl'::ctxt', c::l, occs::occsl when isVarId (get_id decl') c ->
+  | decl'::ctxt', c::l, occs::occsl when isVarId evd (NamedDecl.get_id decl') c ->
       begin match occs with
       | Some _ ->
-        error "Cannot force abstraction on identity instance."
+        user_err Pp.(str "Cannot force abstraction on identity instance.")
       | None ->
         make_subst (ctxt',l,occsl)
       end
   | decl'::ctxt', c::l, occs::occsl ->
-      let (id,_,t) = to_tuple decl' in
+      let id = NamedDecl.get_id decl' in
+      let t = EConstr.of_constr (NamedDecl.get_type decl') in
       let evs = ref [] in
       let ty = Retyping.get_type_of env_rhs evd c in
-      let filter' = filter_possible_projections c ty ctxt args in
+      let filter' = filter_possible_projections evd c ty ctxt args in
       (id,t,c,ty,evs,Filter.make filter',occs) :: make_subst (ctxt',l,occsl)
   | _, _, [] -> []
-  | _ -> anomaly (Pp.str "Signature or instance are shorter than the occurrences list") in
+  | _ -> anomaly (Pp.str "Signature or instance are shorter than the occurrences list.") in
 
   let rec set_holes evdref rhs = function
   | (id,_,c,cty,evsref,filter,occs)::subst ->
       let set_var k =
         match occs with
         | Some Locus.AllOccurrences -> mkVar id
-        | Some _ -> error "Selection of specific occurrences not supported"
+        | Some _ -> user_err Pp.(str "Selection of specific occurrences not supported")
         | None ->
         let evty = set_holes evdref cty subst in
         let instance = Filter.filter_list filter instance in
-        let evd = Sigma.Unsafe.of_evar_map !evdref in
-        let Sigma (ev, evd, _) = new_evar_instance sign evd evty ~filter instance in
-        let evd = Sigma.to_evar_map evd in
+        let evd = !evdref in
+        let (evd, ev) = new_evar_instance sign evd evty ~filter instance in
         evdref := evd;
-        evsref := (fst (destEvar ev),evty)::!evsref;
+        evsref := (fst (destEvar !evdref ev),evty)::!evsref;
         ev in
       set_holes evdref (apply_on_subterm env_rhs evdref set_var c rhs) subst
   | [] -> rhs in
@@ -1077,12 +1183,12 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
               (* We force abstraction over this unconstrained occurrence *)
               (* and we use typing to propagate this instantiation *)
               (* This is an arbitrary choice *)
-              let evd = Evd.define evk (mkVar id) evd in
+              let evd = Evd.define evk (Constr.mkVar id) evd in
               match evar_conv_x ts env_evar evd CUMUL idty evty with
-              | UnifFailure _ -> error "Cannot find an instance"
+              | UnifFailure _ -> user_err Pp.(str "Cannot find an instance")
               | Success evd ->
               match reconsider_unif_constraints (evar_conv_x ts) evd with
-              | UnifFailure _ -> error "Cannot find an instance"
+              | UnifFailure _ -> user_err Pp.(str "Cannot find an instance")
               | Success evd ->
               evd
             else
@@ -1095,15 +1201,18 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
       force_instantiation evd !evsref
   | [] ->
     let evd = 
-      try Evarsolve.check_evar_instance evd evk rhs 
+      try Evarsolve.check_evar_instance evd evk rhs
 	    (evar_conv_x full_transparent_state)
       with IllTypedInstance _ -> raise (TypingFailed evd)
     in
-      Evd.define evk rhs evd 
+      Evd.define evk (EConstr.Unsafe.to_constr rhs) evd 
   in
   abstract_free_holes evd subst, true
   with TypingFailed evd -> evd, false
 
+let to_pb (pb, env, t1, t2) =
+  (pb, env, EConstr.Unsafe.to_constr t1, EConstr.Unsafe.to_constr t2)
+
 let second_order_matching_with_args ts env evd pbty ev l t =
 (*
   let evd,ev = evar_absorb_arguments env evd ev l in
@@ -1113,18 +1222,22 @@ let second_order_matching_with_args ts env evd pbty ev l t =
   else UnifFailure (evd, ConversionFailed (env,mkApp(mkEvar ev,l),t))
   if b then Success evd else
  *)
-  let pb = (pbty,env,mkApp(mkEvar ev,l),t) in
+  let pb = to_pb (pbty,env,mkApp(mkEvar ev,l),t) in
   UnifFailure (evd, CannotSolveConstraint (pb,ProblemBeyondCapabilities))
 
 let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
   let t1 = apprec_nohdbeta ts env evd (whd_head_evar evd t1) in
   let t2 = apprec_nohdbeta ts env evd (whd_head_evar evd t2) in
-  let (term1,l1 as appr1) = try destApp t1 with DestKO -> (t1, [||]) in
-  let (term2,l2 as appr2) = try destApp t2 with DestKO -> (t2, [||]) in
+  let (term1,l1 as appr1) = try destApp evd t1 with DestKO -> (t1, [||]) in
+  let (term2,l2 as appr2) = try destApp evd t2 with DestKO -> (t2, [||]) in
+  let () = if !debug_unification then
+	     let open Pp in
+	     Feedback.msg_notice (v 0 (str "Heuristic:" ++ spc () ++ print_constr t1
+                                       ++ cut () ++ print_constr t2 ++ cut ())) in
   let app_empty = Array.is_empty l1 && Array.is_empty l2 in
-  match kind_of_term term1, kind_of_term term2 with
+  match EConstr.kind evd term1, EConstr.kind evd term2 with
   | Evar (evk1,args1), (Rel _|Var _) when app_empty
-      && List.for_all (fun a -> Term.eq_constr a term2 || isEvar a)
+      && List.for_all (fun a -> EConstr.eq_constr evd a term2 || isEvar evd a)
         (remove_instance_local_defs evd evk1 args1) ->
       (* The typical kind of constraint coming from pattern-matching return
          type inference *)
@@ -1132,9 +1245,9 @@ let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
       | Some evd -> Success evd
       | None ->
          let reason = ProblemBeyondCapabilities in
-         UnifFailure (evd, CannotSolveConstraint ((pbty,env,t1,t2),reason)))
+         UnifFailure (evd, CannotSolveConstraint (to_pb (pbty,env,t1,t2),reason)))
   | (Rel _|Var _), Evar (evk2,args2) when app_empty
-      && List.for_all (fun a -> Term.eq_constr a term1 || isEvar a)
+      && List.for_all (fun a -> EConstr.eq_constr evd a term1 || isEvar evd a)
         (remove_instance_local_defs evd evk2 args2) ->
       (* The typical kind of constraint coming from pattern-matching return
          type inference *)
@@ -1142,7 +1255,7 @@ let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
       | Some evd -> Success evd
       | None ->
          let reason = ProblemBeyondCapabilities in
-         UnifFailure (evd, CannotSolveConstraint ((pbty,env,t1,t2),reason)))
+         UnifFailure (evd, CannotSolveConstraint (to_pb (pbty,env,t1,t2),reason)))
   | Evar (evk1,args1), Evar (evk2,args2) when Evar.equal evk1 evk2 ->
       let f env evd pbty x y = is_fconv ~reds:ts pbty env evd x y in
       Success (solve_refl ~can_drop:true f env evd
@@ -1176,29 +1289,31 @@ let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
       evar_conv_x ts env evd pbty t1 t2
 
 let error_cannot_unify env evd pb ?reason t1 t2 =
-  Pretype_errors.error_cannot_unify_loc
-    (loc_of_conv_pb evd pb) env
+  Pretype_errors.error_cannot_unify
+    ?loc:(loc_of_conv_pb evd pb) env
     evd ?reason (t1, t2)
 
 let check_problems_are_solved env evd =
   match snd (extract_all_conv_pbs evd) with
-  | (pbty,env,t1,t2) as pb::_ -> error_cannot_unify env evd pb t1 t2
+  | (pbty,env,t1,t2) as pb::_ -> error_cannot_unify env evd pb (EConstr.of_constr t1) (EConstr.of_constr t2)
   | _ -> ()
 
+exception MaxUndefined of (Evar.t * evar_info * Constr.t list)
+
 let max_undefined_with_candidates evd =
-  (* If evar were ordered with highest index first, fold_undefined
-     would be going decreasingly and we could use fold_undefined to
-     find the undefined evar of maximum index (alternatively,
-     max_bindings from ocaml 3.12 could be used); instead we traverse
-     the whole map *)
-  let l = Evd.fold_undefined
-    (fun evk ev_info evars ->
-        match ev_info.evar_candidates with
-        | None -> evars
-        | Some l -> (evk,ev_info,l)::evars) evd [] in
-  match l with
-  | [] -> None
-  | a::l -> Some (List.last (a::l))
+  let fold evk evi () = match evi.evar_candidates with
+  | None -> ()
+  | Some l -> raise (MaxUndefined (evk, evi, l))
+  in
+  (** [fold_right] traverses the undefined map in decreasing order of indices.
+  The evar with candidates of maximum index is thus the first evar with
+  candidates found by a [fold_right] traversal. This has a significant impact on
+  performance. *)
+  try
+    let () = Evar.Map.fold_right fold (Evd.undefined_map evd) () in
+    None
+  with MaxUndefined ans ->
+    Some ans
 
 let rec solve_unconstrained_evars_with_candidates ts evd =
   (* max_undefined is supposed to return the most recent, hence
@@ -1207,11 +1322,11 @@ let rec solve_unconstrained_evars_with_candidates ts evd =
   | None -> evd
   | Some (evk,ev_info,l) ->
       let rec aux = function
-      | [] -> error "Unsolvable existential variables."
+      | [] -> user_err Pp.(str "Unsolvable existential variables.")
       | a::l ->
           try
             let conv_algo = evar_conv_x ts in
-            let evd = check_evar_instance evd evk a conv_algo in
+            let evd = check_evar_instance evd evk (EConstr.of_constr a) conv_algo in
             let evd = Evd.define evk a evd in
             match reconsider_unif_constraints conv_algo evd with
             | Success evd -> solve_unconstrained_evars_with_candidates ts evd
@@ -1229,11 +1344,11 @@ let solve_unconstrained_impossible_cases env evd =
     match ev_info.evar_source with
     | loc,Evar_kinds.ImpossibleCase ->
       let j, ctx = coq_unit_judge () in
-      let evd' = Evd.merge_context_set Evd.univ_flexible_alg ~loc evd' ctx in
+      let evd' = Evd.merge_context_set Evd.univ_flexible_alg ?loc evd' ctx in
       let ty = j_type j in
       let conv_algo = evar_conv_x full_transparent_state in
       let evd' = check_evar_instance evd' evk ty conv_algo in
-	Evd.define evk ty evd' 
+	Evd.define evk (EConstr.Unsafe.to_constr ty) evd' 
     | _ -> evd') evd evd
 
 let solve_unif_constraints_with_heuristics env
@@ -1242,6 +1357,8 @@ let solve_unif_constraints_with_heuristics env
   let rec aux evd pbs progress stuck =
     match pbs with
     | (pbty,env,t1,t2 as pb) :: pbs ->
+        let t1 = EConstr.of_constr t1 in
+        let t2 = EConstr.of_constr t2 in
         (match apply_conversion_problem_heuristic ts env evd pbty t1 t2 with
 	| Success evd' ->
 	    let (evd', rest) = extract_all_conv_pbs evd' in
@@ -1258,6 +1375,8 @@ let solve_unif_constraints_with_heuristics env
 	  match stuck with
 	  | [] -> (* We're finished *) evd
 	  | (pbty,env,t1,t2 as pb) :: _ ->
+            let t1 = EConstr.of_constr t1 in
+            let t2 = EConstr.of_constr t2 in
 	     (* There remains stuck problems *)
              error_cannot_unify env evd pb t1 t2
   in
diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli
index 2231e5bc..9270d6e3 100644
--- a/pretyping/evarconv.mli
+++ b/pretyping/evarconv.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Environ
 open Reductionops
 open Evd
@@ -36,7 +38,7 @@ val e_cumul : env -> ?ts:transparent_state -> evar_map ref -> constr -> constr -
 val solve_unif_constraints_with_heuristics : env -> ?ts:transparent_state -> evar_map -> evar_map
 
 val consider_remaining_unif_problems : env -> ?ts:transparent_state -> evar_map -> evar_map
-(** @deprecated Alias for [solve_unif_constraints_with_heuristics] *)
+[@@ocaml.deprecated "Alias for [solve_unif_constraints_with_heuristics]"]
 
 (** Check all pending unification problems are solved and raise an
     error otherwise *)
@@ -46,18 +48,18 @@ val check_problems_are_solved : env -> evar_map -> unit
 (** Check if a canonical structure is applicable *)
 
 val check_conv_record : env -> evar_map -> 
-  constr * types Stack.t -> constr * types Stack.t ->
-  Univ.universe_context_set * (constr * constr) 
+  state -> state ->
+  Univ.ContextSet.t * (constr * constr) 
   * constr * constr list * (constr Stack.t * constr Stack.t) *
-    (constr Stack.t * types Stack.t) *
-    (constr Stack.t * types Stack.t) * constr *
+    (constr Stack.t * constr Stack.t) *
+    (constr Stack.t * constr Stack.t) * constr *
     (int option * constr)
 
 (** Try to solve problems of the form ?x[args] = c by second-order
     matching, using typing to select occurrences *)
 
 val second_order_matching : transparent_state -> env -> evar_map ->
-  existential -> occurrences option list -> constr -> evar_map * bool
+  EConstr.existential -> occurrences option list -> constr -> evar_map * bool
 
 (** Declare function to enforce evars resolution by using typing constraints *)
 
@@ -80,3 +82,5 @@ val evar_eqappr_x : ?rhs_is_already_stuck:bool -> transparent_state * bool ->
       Evarsolve.unification_result
 (**/**)
 
+(** {6 Functions to deal with impossible cases } *)
+val coq_unit_judge : unit -> EConstr.unsafe_judgment Univ.in_universe_context_set
diff --git a/pretyping/evardefine.ml b/pretyping/evardefine.ml
index f9ab75ce..03f40ad9 100644
--- a/pretyping/evardefine.ml
+++ b/pretyping/evardefine.ml
@@ -1,47 +1,45 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+open Sorts
 open Util
 open Pp
 open Names
-open Term
-open Vars
+open Constr
 open Termops
+open EConstr
+open Vars
 open Namegen
-open Environ
 open Evd
 open Evarutil
 open Pretype_errors
-open Sigma.Notations
 
-let new_evar_unsafe env evd ?src ?filter ?candidates ?store ?naming ?principal typ =
-  let evd = Sigma.Unsafe.of_evar_map evd in
-  let Sigma (evk, evd, _) = new_evar env evd ?src ?filter ?candidates ?store ?naming ?principal typ in
-  (Sigma.to_evar_map evd, evk)
+module RelDecl = Context.Rel.Declaration
 
 let env_nf_evar sigma env =
-  let open Context.Rel.Declaration in
+  let nf_evar c = nf_evar sigma c in
   process_rel_context
-    (fun d e -> push_rel (map_constr (nf_evar sigma) d) e) env
+    (fun d e -> push_rel (RelDecl.map_constr nf_evar d) e) env
 
 let env_nf_betaiotaevar sigma env =
-  let open Context.Rel.Declaration in
   process_rel_context
-    (fun d e ->
-      push_rel (map_constr (Reductionops.nf_betaiota sigma) d) e) env
+    (fun d env ->
+      push_rel (RelDecl.map_constr (fun c -> Reductionops.nf_betaiota env sigma c) d) env) env
 
 (****************************************)
 (* Operations on value/type constraints *)
 (****************************************)
 
-type type_constraint = types option
+type type_constraint = EConstr.types option
 
-type val_constraint = constr option
+type val_constraint = EConstr.constr option
 
 (* Old comment...
  * Basically, we have the following kind of constraints (in increasing
@@ -77,34 +75,30 @@ 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 concl = Reductionops.whd_all evenv evd evi.evar_concl in
-  let s = destSort concl 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) =
-    let evd = Sigma.Unsafe.of_evar_map evd in
-    let Sigma (e, evd1, _) = new_type_evar evenv evd univ_flexible_alg ~filter:(evar_filter evi) in
-    (Sigma.to_evar_map evd1, e)
+    new_type_evar evenv evd univ_flexible_alg ~filter:(evar_filter evi)
   in
   let evd2,rng =
     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 s then
+      if Sorts.is_prop (ESorts.kind evd1 s) then
        (* Impredicative product, conclusion must fall in [Prop]. *)
-        new_evar_unsafe newenv evd1 concl ~src ~filter
+        new_evar newenv evd1 concl ~src ~filter
       else
 	let status = univ_flexible_alg in
 	let evd3, (rng, srng) =
-          let evd1 = Sigma.Unsafe.of_evar_map evd1 in
-          let Sigma (e, evd3, _) = new_type_evar newenv evd1 status ~src ~filter in
-          (Sigma.to_evar_map evd3, e)
+          new_type_evar newenv evd1 status ~src ~filter
         in
 	let prods = Univ.sup (univ_of_sort u1) (univ_of_sort srng) in
-	let evd3 = Evd.set_leq_sort evenv evd3 (Type prods) s in
+	let evd3 = Evd.set_leq_sort evenv evd3 (Type prods) (ESorts.kind evd1 s) in
 	  evd3, rng
   in
   let prod = mkProd (Name id, dom, subst_var id rng) in
-  let evd3 = Evd.define evk prod evd2 in
+  let evd3 = Evd.define evk (EConstr.Unsafe.to_constr prod) evd2 in
     evd3,prod
 
 (* Refine an applied evar to a product and returns its instantiation *)
@@ -112,11 +106,11 @@ let define_pure_evar_as_product evd evk =
 let define_evar_as_product evd (evk,args) =
   let evd,prod = define_pure_evar_as_product evd evk in
   (* Quick way to compute the instantiation of evk with args *)
-  let na,dom,rng = destProd prod in
-  let evdom = mkEvar (fst (destEvar dom), args) in
+  let na,dom,rng = destProd evd prod in
+  let evdom = mkEvar (fst (destEvar evd dom), args) in
   let evrngargs = Array.cons (mkRel 1) (Array.map (lift 1) args) in
-  let evrng =  mkEvar (fst (destEvar rng), evrngargs) in
-  evd,mkProd (na, evdom, evrng)
+  let evrng =  mkEvar (fst (destEvar evd rng), evrngargs) in
+  evd, mkProd (na, evdom, evrng)
 
 (* Refine an evar with an abstraction
 
@@ -131,36 +125,36 @@ let define_pure_evar_as_lambda env evd evk =
   let open Context.Named.Declaration in
   let evi = Evd.find_undefined evd evk in
   let evenv = evar_env evi in
-  let typ = Reductionops.whd_all evenv evd (evar_concl evi) in
-  let evd1,(na,dom,rng) = match kind_of_term typ with
+  let typ = Reductionops.whd_all evenv evd (EConstr.of_constr (evar_concl evi)) in
+  let evd1,(na,dom,rng) = match EConstr.kind evd typ with
   | Prod (na,dom,rng) -> (evd,(na,dom,rng))
-  | Evar ev' -> let evd,typ = define_evar_as_product evd ev' in evd,destProd typ
-  | _ -> error_not_product_loc Loc.ghost env evd typ in
-  let avoid = ids_of_named_context (evar_context evi) in
+  | 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 = 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
   let filter = Filter.extend 1 (evar_filter evi) in
   let src = evar_source evk evd1 in
-  let evd2,body = new_evar_unsafe newenv evd1 ~src (subst1 (mkVar id) rng) ~filter in
+  let evd2,body = new_evar newenv evd1 ~src (subst1 (mkVar id) rng) ~filter in
   let lam = mkLambda (Name id, dom, subst_var id body) in
-  Evd.define evk lam evd2, lam
+  Evd.define evk (EConstr.Unsafe.to_constr lam) evd2, lam
 
 let define_evar_as_lambda env evd (evk,args) =
   let evd,lam = define_pure_evar_as_lambda env evd evk in
   (* Quick way to compute the instantiation of evk with args *)
-  let na,dom,body = destLambda lam in
+  let na,dom,body = destLambda evd lam in
   let evbodyargs = Array.cons (mkRel 1) (Array.map (lift 1) args) in
-  let evbody = mkEvar (fst (destEvar body), evbodyargs) in
-  evd,mkLambda (na, dom, evbody)
+  let evbody = mkEvar (fst (destEvar evd body), evbodyargs) in
+  evd, mkLambda (na, dom, evbody)
 
 let rec evar_absorb_arguments env evd (evk,args as ev) = function
   | [] -> evd,ev
   | a::l ->
       (* TODO: optimize and avoid introducing intermediate evars *)
       let evd,lam = define_pure_evar_as_lambda env evd evk in
-      let _,_,body = destLambda lam in
-      let evk = fst (destEvar body) in
+      let _,_,body = destLambda evd lam in
+      let evk = fst (destEvar evd body) in
       evar_absorb_arguments env evd (evk, Array.cons a args) l
 
 (* Refining an evar to a sort *)
@@ -169,29 +163,29 @@ let define_evar_as_sort env evd (ev,args) =
   let evd, u = new_univ_variable univ_rigid evd in
   let evi = Evd.find_undefined evd ev in 
   let s = Type u in
-  let concl = Reductionops.whd_all (evar_env evi) evd evi.evar_concl in
-  let sort = destSort concl in
-  let evd' = Evd.define ev (mkSort s) evd in
-  Evd.set_leq_sort env evd' (Type (Univ.super u)) sort, s
+  let concl = Reductionops.whd_all (evar_env evi) evd (EConstr.of_constr evi.evar_concl) in
+  let sort = destSort evd concl in
+  let evd' = Evd.define ev (Constr.mkSort s) evd in
+  Evd.set_leq_sort env evd' (Type (Univ.super u)) (ESorts.kind evd' sort), s
 
 (* Propagation of constraints through application and abstraction:
    Given a type constraint on a functional term, returns the type
    constraint on its domain and codomain. If the input constraint is
    an evar instantiate it with the product of 2 new evars. *)
 
-let split_tycon loc env evd tycon =
+let split_tycon ?loc env evd tycon =
   let rec real_split evd c =
     let t = Reductionops.whd_all env evd c in
-      match kind_of_term t with
+      match EConstr.kind evd t with
 	| Prod (na,dom,rng) -> evd, (na, dom, rng)
 	| Evar ev (* ev is undefined because of whd_all *) ->
 	    let (evd',prod) = define_evar_as_product evd ev in
-	    let (_,dom,rng) = destProd prod in
+	    let (_,dom,rng) = destProd evd prod in
 	      evd',(Anonymous, dom, rng)
-	| App (c,args) when isEvar c ->
-	    let (evd',lam) = define_evar_as_lambda env evd (destEvar c) in
+	| App (c,args) when isEvar evd c ->
+	    let (evd',lam) = define_evar_as_lambda env evd (destEvar evd c) in
 	    real_split evd' (mkApp (lam,args))
-	| _ -> error_not_product_loc loc env evd c
+	| _ -> error_not_product ?loc env evd c
   in
     match tycon with
       | None -> evd,(Anonymous,None,None)
@@ -202,6 +196,6 @@ let split_tycon loc env evd tycon =
 let valcon_of_tycon x = x
 let lift_tycon n = Option.map (lift n)
 
-let pr_tycon env = function
+let pr_tycon env sigma = function
     None -> str "None"
-  | Some t -> Termops.print_constr_env env t
+  | Some t -> Termops.print_constr_env env sigma t
diff --git a/pretyping/evardefine.mli b/pretyping/evardefine.mli
index 07b0e69d..cd23f9c6 100644
--- a/pretyping/evardefine.mli
+++ b/pretyping/evardefine.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Evd
 open Environ
 
@@ -30,7 +32,7 @@ val evar_absorb_arguments : env -> evar_map -> existential -> constr list ->
   evar_map * existential
 
 val split_tycon :
-  Loc.t -> env ->  evar_map -> type_constraint ->
+  ?loc:Loc.t -> env ->  evar_map -> type_constraint ->
     evar_map * (Name.t * type_constraint * type_constraint)
 
 val valcon_of_tycon : type_constraint -> val_constraint
@@ -38,9 +40,9 @@ 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:} *)
 
-val pr_tycon : env -> type_constraint -> Pp.std_ppcmds
+val pr_tycon : env -> evar_map -> type_constraint -> Pp.t
 
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index 4fd03084..d0721439 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -1,45 +1,42 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+open Sorts
 open Util
 open CErrors
 open Names
-open Term
-open Vars
+open Constr
 open Environ
 open Termops
 open Evd
+open EConstr
+open Vars
 open Namegen
 open Retyping
 open Reductionops
 open Evarutil
 open Pretype_errors
-open Sigma.Notations
 
 let normalize_evar evd ev =
-  match kind_of_term (whd_evar evd (mkEvar ev)) with
+  match EConstr.kind evd (mkEvar ev) with
   | Evar (evk,args) -> (evk,args)
   | _ -> assert false
 
-let get_polymorphic_positions f = 
+let get_polymorphic_positions sigma f =
   let open Declarations in
-  match kind_of_term f with
+  match EConstr.kind sigma f with
   | Ind (ind, u) | Construct ((ind, _), u) -> 
     let mib,oib = Global.lookup_inductive ind in
       (match oib.mind_arity with
       | RegularArity _ -> assert false
       | TemplateArity templ -> templ.template_param_levels)
-  | Const (cst, u) ->
-    let cb = Global.lookup_constant cst in
-      (match cb.const_type with
-      | RegularArity _ -> assert false
-      | TemplateArity (_, templ) -> 
-        templ.template_param_levels)
   | _ -> assert false
 
 let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false)
@@ -48,6 +45,7 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false)
   let modified = ref false in
   (* direction: true for fresh universes lower than the existing ones *)
   let refresh_sort status ~direction s =
+    let s = ESorts.kind !evdref s in
     let s' = evd_comb0 (new_sort_variable status) evdref in
     let evd = 
       if direction then set_leq_sort env !evdref s' s
@@ -56,8 +54,10 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false)
     modified := true; evdref := evd; mkSort s'
   in
   let rec refresh ~onlyalg status ~direction t =
-    match kind_of_term t with
-    | Sort (Type u as s) ->
+    match EConstr.kind !evdref t with
+    | Sort s ->
+      begin match ESorts.kind !evdref s with
+      | Type u ->
        (match Univ.universe_level u with
 	| None -> refresh_sort status ~direction s
 	| Some l ->
@@ -67,31 +67,33 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false)
 	       else t
 	    | UnivFlexible alg ->
 	       if onlyalg && alg then
-	         (evdref := Evd.make_flexible_variable !evdref false l; t)
+	         (evdref := Evd.make_flexible_variable !evdref ~algebraic:false l; t)
 	       else t))
-    | Sort (Prop Pos as s) when refreshset && not direction ->
+      | Prop Pos when refreshset && not direction ->
        (* Cannot make a universe "lower" than "Set",
           only refreshing when we want higher universes. *)
        refresh_sort status ~direction s
+      | _ -> t
+      end
     | Prod (na,u,v) -> 
       mkProd (na, u, refresh ~onlyalg status ~direction v)
     | _ -> t
   (** Refresh the types of evars under template polymorphic references *)
   and refresh_term_evars onevars top t =
-    match kind_of_term (whd_evar !evdref t) with
-    | App (f, args) when is_template_polymorphic env f ->
-      let pos = get_polymorphic_positions f in
+    match EConstr.kind !evdref t with
+    | App (f, args) when is_template_polymorphic env !evdref f ->
+      let pos = get_polymorphic_positions !evdref f in
 	refresh_polymorphic_positions args pos
-    | App (f, args) when top && isEvar f -> 
+    | App (f, args) when top && isEvar !evdref f -> 
       refresh_term_evars true false f; 
       Array.iter (refresh_term_evars onevars false) args
     | Evar (ev, a) when onevars ->
       let evi = Evd.find !evdref ev in
-      let ty' = refresh ~onlyalg univ_flexible ~direction:true evi.evar_concl in
+      let ty' = refresh ~onlyalg univ_flexible ~direction:true (EConstr.of_constr evi.evar_concl) in
 	if !modified then 
-	  evdref := Evd.add !evdref ev {evi with evar_concl = ty'}
+	  evdref := Evd.add !evdref ev {evi with evar_concl = EConstr.Unsafe.to_constr ty'}
 	else ()
-    | _ -> Constr.iter (refresh_term_evars onevars false) t
+    | _ -> EConstr.iter !evdref (refresh_term_evars onevars false) t
   and refresh_polymorphic_positions args pos =
     let rec aux i = function
       | Some l :: ls -> 
@@ -106,7 +108,7 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false)
     in aux 0 pos
   in
   let t' = 
-    if isArity t then
+    if isArity !evdref t then
       match pbty with
       | None ->
 	 (* No cumulativity needed, but we still need to refresh the algebraics *)
@@ -135,6 +137,8 @@ let test_success conv_algo env evd c c' rhs =
   is_success (conv_algo env evd c c' rhs)
 
 let add_conv_oriented_pb ?(tail=true) (pbty,env,t1,t2) evd =
+  let t1 = EConstr.Unsafe.to_constr t1 in
+  let t2 = EConstr.Unsafe.to_constr t2 in
   match pbty with
   | Some true -> add_conv_pb ~tail (Reduction.CUMUL,env,t1,t2) evd
   | Some false -> add_conv_pb ~tail (Reduction.CUMUL,env,t2,t1) evd
@@ -142,18 +146,18 @@ let add_conv_oriented_pb ?(tail=true) (pbty,env,t1,t2) evd =
 
 (* We retype applications to ensure the universe constraints are collected *)
 
-exception IllTypedInstance of env * types * types
+exception IllTypedInstance of env * EConstr.types * EConstr.types
 
 let recheck_applications conv_algo env evdref t =
   let rec aux env t =
-    match kind_of_term t with
+    match EConstr.kind !evdref t with
     | App (f, args) ->
        let () = aux env f in
        let fty = Retyping.get_type_of env !evdref f in
        let argsty = Array.map (fun x -> aux env x; Retyping.get_type_of env !evdref x) args in
        let rec aux i ty =
 	 if i < Array.length argsty then
-	 match kind_of_term (whd_all env !evdref ty) with
+	 match EConstr.kind !evdref (whd_all env !evdref ty) with
 	 | Prod (na, dom, codom) ->
 	    (match conv_algo env !evdref Reduction.CUMUL argsty.(i) dom with
 	     | Success evd -> evdref := evd;
@@ -164,7 +168,7 @@ let recheck_applications conv_algo env evdref t =
        else ()
      in aux 0 fty
     | _ ->
-       iter_constr_with_full_binders (fun d env -> push_rel d env) aux env t
+       iter_with_full_binders !evdref (fun d env -> push_rel d env) aux env t
   in aux env t
 
 	  
@@ -177,7 +181,7 @@ type 'a update =
 | NoUpdate
 
 open Context.Named.Declaration
-let inst_of_vars sign = Array.map_of_list (mkVar % get_id) sign
+let inst_of_vars sign = Array.map_of_list (get_id %> mkVar) sign
 
 let restrict_evar_key evd evk filter candidates =
   match filter, candidates with
@@ -193,11 +197,9 @@ let restrict_evar_key evd evk filter candidates =
       | None -> evar_filter evi
       | Some filter -> filter in
       let candidates = match candidates with
-      | NoUpdate -> evi.evar_candidates
+      | NoUpdate -> Option.map (fun l -> List.map EConstr.of_constr l) evi.evar_candidates
       | UpdateWith c -> Some c in
-      let sigma = Sigma.Unsafe.of_evar_map evd in
-      let Sigma (evk, sigma, _) = restrict_evar sigma evk filter candidates in
-      (Sigma.to_evar_map sigma, evk)
+      restrict_evar evd evk filter candidates
     end
 
 (* Restrict an applied evar and returns its restriction in the same context *)
@@ -226,25 +228,22 @@ open Context.Rel.Declaration
 let noccur_evar env evd evk c =
   let cache = ref Int.Set.empty (* cache for let-ins *) in
   let rec occur_rec check_types (k, env as acc) c =
-  match kind_of_term c with
+  match EConstr.kind evd c with
   | Evar (evk',args' as ev') ->
-      (match safe_evar_value evd ev' with
-       | Some c -> occur_rec check_types acc c
-       | None ->
-           if Evar.equal evk evk' then raise Occur
-           else (if check_types then
-                   occur_rec false acc (existential_type evd ev');
-                 Array.iter (occur_rec check_types acc) args'))
+    if Evar.equal evk evk' then raise Occur
+    else (if check_types then
+            occur_rec false acc (existential_type evd ev');
+          Array.iter (occur_rec check_types acc) args')
   | Rel i when i > k ->
      if not (Int.Set.mem (i-k) !cache) then
        let decl = Environ.lookup_rel i env in
        if check_types then
-         (cache := Int.Set.add (i-k) !cache; occur_rec false acc (lift i (get_type decl)));
+         (cache := Int.Set.add (i-k) !cache; occur_rec false acc (lift i (EConstr.of_constr (get_type decl))));
        (match decl with
         | LocalAssum _ -> ()
-        | LocalDef (_,b,_) -> cache := Int.Set.add (i-k) !cache; occur_rec false acc (lift i b))
+        | LocalDef (_,b,_) -> cache := Int.Set.add (i-k) !cache; occur_rec false acc (lift i (EConstr.of_constr b)))
   | Proj (p,c) -> occur_rec true acc c
-  | _ -> iter_constr_with_full_binders (fun rd (k,env) -> (succ k, push_rel rd env))
+  | _ -> iter_with_full_binders evd (fun rd (k,env) -> (succ k, push_rel rd env))
     (occur_rec check_types) acc c
   in
   try occur_rec false (0,env) c; true with Occur -> false
@@ -253,158 +252,209 @@ let noccur_evar env evd evk c =
 (* Managing chains of local definitons *)
 (***************************************)
 
+type alias =
+| RelAlias of int
+| VarAlias of Id.t
+
+let of_alias = function
+| RelAlias n -> mkRel n
+| VarAlias id -> mkVar id
+
+let to_alias sigma c = match EConstr.kind sigma c with
+| Rel n -> Some (RelAlias n)
+| Var id -> Some (VarAlias id)
+| _ -> None
+
+let is_alias sigma c alias = match EConstr.kind sigma c, alias with
+| Var id, VarAlias id' -> Id.equal id id'
+| Rel n, RelAlias n' -> Int.equal n n'
+| _ -> false
+
+let eq_alias a b = match a, b with
+| RelAlias n, RelAlias m -> Int.equal m n
+| VarAlias id1, VarAlias id2 -> Id.equal id1 id2
+| _ -> false
+
+type aliasing = EConstr.t option * alias list
+
+let empty_aliasing = None, []
+let make_aliasing c = Some c, []
+let push_alias (alias, l) a = (alias, a :: l)
+let lift_aliasing n (alias, l) =
+  let map a = match a with
+  | VarAlias _ -> a
+  | RelAlias m -> RelAlias (m + n)
+  in
+  (Option.map (fun c -> lift n c) alias, List.map map l)
+
+type aliases = {
+  rel_aliases : aliasing Int.Map.t;
+  var_aliases : aliasing Id.Map.t;
+  (** Only contains [VarAlias] *)
+}
+
 (* Expand rels and vars that are bound to other rels or vars so that
    dependencies in variables are canonically associated to the most ancient
    variable in its family of aliased variables *)
 
-let compute_var_aliases sign =
+let compute_var_aliases sign sigma =
   let open Context.Named.Declaration in
   List.fold_right (fun decl aliases ->
     let id = get_id decl in
     match decl with
     | LocalDef (_,t,_) ->
-        (match kind_of_term t with
+        (match EConstr.kind sigma t with
         | Var id' ->
             let aliases_of_id =
-              try Id.Map.find id' aliases with Not_found -> [] in
-            Id.Map.add id (aliases_of_id@[t]) aliases
+              try Id.Map.find id' aliases with Not_found -> empty_aliasing in
+            Id.Map.add id (push_alias aliases_of_id (VarAlias id')) aliases
         | _ ->
-            Id.Map.add id [t] aliases)
+            Id.Map.add id (make_aliasing t) aliases)
     | LocalAssum _ -> aliases)
     sign Id.Map.empty
 
-let compute_rel_aliases var_aliases rels =
+let compute_rel_aliases var_aliases rels sigma =
   snd (List.fold_right
 	 (fun decl (n,aliases) ->
 	  (n-1,
 	   match decl with
 	   | LocalDef (_,t,u) ->
-	      (match kind_of_term t with
+	      (match EConstr.kind sigma t with
 	       | Var id' ->
 		  let aliases_of_n =
-		    try Id.Map.find id' var_aliases with Not_found -> [] in
-		  Int.Map.add n (aliases_of_n@[t]) aliases
+		    try Id.Map.find id' var_aliases with Not_found -> empty_aliasing in
+		  Int.Map.add n (push_alias aliases_of_n (VarAlias id')) aliases
 	       | Rel p ->
 		  let aliases_of_n =
-		    try Int.Map.find (p+n) aliases with Not_found -> [] in
-		  Int.Map.add n (aliases_of_n@[mkRel (p+n)]) aliases
+		    try Int.Map.find (p+n) aliases with Not_found -> empty_aliasing in
+		  Int.Map.add n (push_alias aliases_of_n (RelAlias (p+n))) aliases
 	       | _ ->
-		  Int.Map.add n [lift n (mkCast(t,DEFAULTcast,u))] aliases)
+		  Int.Map.add n (make_aliasing (lift n (mkCast(t,DEFAULTcast,u)))) aliases)
 	   | LocalAssum _ -> aliases)
 	 )
 	 rels
 	 (List.length rels,Int.Map.empty))
 
-let make_alias_map env =
+let make_alias_map env sigma =
   (* We compute the chain of aliases for each var and rel *)
-  let var_aliases = compute_var_aliases (named_context env) in
-  let rel_aliases = compute_rel_aliases var_aliases (rel_context env) in
-  (var_aliases,rel_aliases)
+  let var_aliases = compute_var_aliases (named_context env) sigma in
+  let rel_aliases = compute_rel_aliases var_aliases (rel_context env) sigma in
+  { var_aliases; rel_aliases }
 
-let lift_aliases n (var_aliases,rel_aliases as aliases) =
+let lift_aliases n aliases =
   if Int.equal n 0 then aliases else
-  (var_aliases,
-   Int.Map.fold (fun p l -> Int.Map.add (p+n) (List.map (lift n) l))
-     rel_aliases Int.Map.empty)
-
-let get_alias_chain_of aliases x = match kind_of_term x with
-  | Rel n -> (try Int.Map.find n (snd aliases) with Not_found -> [])
-  | Var id -> (try Id.Map.find id (fst aliases) with Not_found -> [])
-  | _ -> []
-
-let normalize_alias_opt aliases x =
-  match get_alias_chain_of aliases x with
-  | []  -> None
-  | a::_ when isRel a || isVar a -> Some a
-  | [_] -> None
-  | _::a::_ -> Some a
-
-let normalize_alias aliases x =
-  match normalize_alias_opt aliases x with
+  let rel_aliases =
+   Int.Map.fold (fun p l -> Int.Map.add (p+n) (lift_aliasing n l))
+     aliases.rel_aliases Int.Map.empty
+  in
+  { aliases with rel_aliases }
+
+let get_alias_chain_of sigma aliases x = match x with
+  | RelAlias n -> (try Int.Map.find n aliases.rel_aliases with Not_found -> empty_aliasing)
+  | VarAlias id -> (try Id.Map.find id aliases.var_aliases with Not_found -> empty_aliasing)
+
+let normalize_alias_opt_alias sigma aliases x =
+  match get_alias_chain_of sigma aliases x with
+  | _, []  -> None
+  | _, a :: _ -> Some a
+
+let normalize_alias_opt sigma aliases x = match to_alias sigma x with
+| None -> None
+| Some a -> normalize_alias_opt_alias sigma aliases a
+
+let normalize_alias sigma aliases x =
+  match normalize_alias_opt_alias sigma aliases x with
   | Some a -> a
   | None -> x
 
-let normalize_alias_var var_aliases id =
-  destVar (normalize_alias (var_aliases,Int.Map.empty) (mkVar id))
+let normalize_alias_var sigma var_aliases id =
+  let aliases = { var_aliases; rel_aliases = Int.Map.empty } in
+  match normalize_alias sigma aliases (VarAlias id) with
+  | VarAlias id -> id
+  | RelAlias _ -> assert false (** var only aliases to variables *)
 
-let extend_alias decl (var_aliases,rel_aliases) =
+let extend_alias sigma decl { var_aliases; rel_aliases } =
   let rel_aliases =
-    Int.Map.fold (fun n l -> Int.Map.add (n+1) (List.map (lift 1) l))
+    Int.Map.fold (fun n l -> Int.Map.add (n+1) (lift_aliasing 1 l))
       rel_aliases Int.Map.empty in
   let rel_aliases =
     match decl with
     | LocalDef(_,t,_) ->
-        (match kind_of_term t with
+        (match EConstr.kind sigma t with
         | Var id' ->
             let aliases_of_binder =
-              try Id.Map.find id' var_aliases with Not_found -> [] in
-            Int.Map.add 1 (aliases_of_binder@[t]) rel_aliases
+              try Id.Map.find id' var_aliases with Not_found -> empty_aliasing in
+            Int.Map.add 1 (push_alias aliases_of_binder (VarAlias id')) rel_aliases
         | Rel p ->
             let aliases_of_binder =
-              try Int.Map.find (p+1) rel_aliases with Not_found -> [] in
-            Int.Map.add 1 (aliases_of_binder@[mkRel (p+1)]) rel_aliases
+              try Int.Map.find (p+1) rel_aliases with Not_found -> empty_aliasing in
+            Int.Map.add 1 (push_alias aliases_of_binder (RelAlias (p+1))) rel_aliases
         | _ ->
-            Int.Map.add 1 [lift 1 t] rel_aliases)
+            Int.Map.add 1 (make_aliasing (lift 1 t)) rel_aliases)
     | LocalAssum _ -> rel_aliases in
-  (var_aliases, rel_aliases)
-
-let expand_alias_once aliases x =
-  match get_alias_chain_of aliases x with
-  | []  -> None
-  | l -> Some (List.last l)
-
-let expansions_of_var aliases x =
-  match get_alias_chain_of aliases x with
-  | [] -> [x]
-  | a::_ as l when isRel a || isVar a -> x :: List.rev l
-  | _::l -> x :: List.rev l
-
-let expansion_of_var aliases x =
-  match get_alias_chain_of aliases x with
-  | [] -> x
-  | a::_ -> a
-
-let rec expand_vars_in_term_using aliases t = match kind_of_term t with
-  | Rel _ | Var _ ->
-      normalize_alias aliases t
+  { var_aliases; rel_aliases }
+
+let expand_alias_once sigma aliases x =
+  match get_alias_chain_of sigma aliases x with
+  | None, []  -> None
+  | Some a, [] -> Some a
+  | _, l -> Some (of_alias (List.last l))
+
+let expansions_of_var sigma aliases x =
+  let (_, l) = get_alias_chain_of sigma aliases x in
+  x :: List.rev l
+
+let expansion_of_var sigma aliases x =
+  match get_alias_chain_of sigma aliases x with
+  | None, [] -> (false, of_alias x)
+  | Some a, _ -> (true, a)
+  | None, a :: _ -> (true, of_alias a)
+
+let rec expand_vars_in_term_using sigma aliases t = match EConstr.kind sigma t with
+  | Rel n -> of_alias (normalize_alias sigma aliases (RelAlias n))
+  | Var id -> of_alias (normalize_alias sigma aliases (VarAlias id))
   | _ ->
-      map_constr_with_full_binders
-        extend_alias expand_vars_in_term_using aliases t
+    let self aliases c = expand_vars_in_term_using sigma aliases c in
+    map_constr_with_full_binders sigma (extend_alias sigma) self aliases t
 
-let expand_vars_in_term env = expand_vars_in_term_using (make_alias_map env)
+let expand_vars_in_term env sigma = expand_vars_in_term_using sigma (make_alias_map env sigma)
 
-let free_vars_and_rels_up_alias_expansion aliases c =
+let free_vars_and_rels_up_alias_expansion sigma aliases c =
   let acc1 = ref Int.Set.empty and acc2 = ref Id.Set.empty in
   let acc3 = ref Int.Set.empty and acc4 = ref Id.Set.empty in
   let cache_rel = ref Int.Set.empty and cache_var = ref Id.Set.empty in
   let is_in_cache depth = function
-    | Rel n -> Int.Set.mem (n-depth) !cache_rel
-    | Var s -> Id.Set.mem s !cache_var
-    | _ -> false in
+    | RelAlias n -> Int.Set.mem (n-depth) !cache_rel
+    | VarAlias s -> Id.Set.mem s !cache_var
+  in
   let put_in_cache depth = function
-    | Rel n -> cache_rel := Int.Set.add (n-depth) !cache_rel
-    | Var s -> cache_var := Id.Set.add s !cache_var
-    | _ -> () in
+    | RelAlias n -> cache_rel := Int.Set.add (n-depth) !cache_rel
+    | VarAlias s -> cache_var := Id.Set.add s !cache_var
+  in
   let rec frec (aliases,depth) c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Rel _ | Var _ as ck ->
+      let ck = match ck with
+      | Rel n -> RelAlias n
+      | Var id -> VarAlias id
+      | _ -> assert false
+      in
       if is_in_cache depth ck then () else begin
       put_in_cache depth ck;
-      let c' = expansion_of_var aliases c in
-      (if c != c' then (* expansion, hence a let-in *)
-        match kind_of_term c with
-        | Var id -> acc4 := Id.Set.add id !acc4
-        | Rel n -> if n >= depth+1 then acc3 := Int.Set.add (n-depth) !acc3
-        | _ -> ());
-      match kind_of_term c' with
+      let expanded, c' = expansion_of_var sigma aliases ck in
+      (if expanded then (* expansion, hence a let-in *)
+        match ck with
+        | VarAlias id -> acc4 := Id.Set.add id !acc4
+        | RelAlias n -> if n >= depth+1 then acc3 := Int.Set.add (n-depth) !acc3);
+      match EConstr.kind sigma c' with
         | Var id -> acc2 := Id.Set.add id !acc2
         | Rel n -> if n >= depth+1 then acc1 := Int.Set.add (n-depth) !acc1
         | _ -> frec (aliases,depth) c end
     | Const _ | Ind _ | Construct _ ->
-        acc2 := Id.Set.union (vars_of_global (Global.env()) c) !acc2
+        acc2 := Id.Set.union (vars_of_global (Global.env()) (EConstr.to_constr sigma c)) !acc2
     | _ ->
-        iter_constr_with_full_binders
-          (fun d (aliases,depth) -> (extend_alias d aliases,depth+1))
+        iter_with_full_binders sigma
+          (fun d (aliases,depth) -> (extend_alias sigma d aliases,depth+1))
           frec (aliases,depth) c
   in
   frec (aliases,0) c;
@@ -414,42 +464,35 @@ let free_vars_and_rels_up_alias_expansion aliases c =
 (* Managing pattern-unification *)
 (********************************)
 
-let rec expand_and_check_vars aliases = function
-  | [] -> []
-  | a::l when isRel a || isVar a ->
-      let a = expansion_of_var aliases a in
-      if isRel a || isVar a then a :: expand_and_check_vars aliases l
-      else raise Exit
-  | _ ->
-      raise Exit
-
-module Constrhash = Hashtbl.Make
-  (struct type t = constr
-          let equal = Term.eq_constr
-          let hash = hash_constr
-   end)
-
-let constr_list_distinct l =
-  let visited = Constrhash.create 23 in
-  let rec loop = function
-    | h::t ->
-        if Constrhash.mem visited h then false
-        else (Constrhash.add visited h h; loop t)
-    | [] -> true
-  in loop l
-
-let get_actual_deps aliases l t =
-  if occur_meta_or_existential t then
+let expand_and_check_vars sigma aliases l =
+  let map a = match get_alias_chain_of sigma aliases a with
+  | None, [] -> Some a
+  | None, a :: _ -> Some a
+  | Some _, _ -> None
+  in
+  Option.List.map map l
+
+let alias_distinct l =
+  let rec check (rels, vars) = function
+  | [] -> true
+  | RelAlias n :: l ->
+    not (Int.Set.mem n rels) && check (Int.Set.add n rels, vars) l
+  | VarAlias id :: l ->
+    not (Id.Set.mem id vars) && check (rels, Id.Set.add id vars) l
+  in
+  check (Int.Set.empty, Id.Set.empty) l
+
+let get_actual_deps evd aliases l t =
+  if occur_meta_or_existential evd t then
     (* Probably no restrictions on allowed vars in presence of evars *)
     l
   else
     (* Probably strong restrictions coming from t being evar-closed *)
-    let (fv_rels,fv_ids,_,_) = free_vars_and_rels_up_alias_expansion aliases t in
-    List.filter (fun c ->
-      match kind_of_term c with
-      | Var id -> Id.Set.mem id fv_ids
-      | Rel n -> Int.Set.mem n fv_rels
-      | _ -> assert false) l
+    let (fv_rels,fv_ids,_,_) = free_vars_and_rels_up_alias_expansion evd aliases t in
+    List.filter (function
+      | VarAlias id -> Id.Set.mem id fv_ids
+      | RelAlias n -> Int.Set.mem n fv_rels
+    ) l
 
 open Context.Named.Declaration
 let remove_instance_local_defs evd evk args =
@@ -468,35 +511,42 @@ let remove_instance_local_defs evd evk args =
 
 (* Check if an applied evar "?X[args] l" is a Miller's pattern *)
 
-let find_unification_pattern_args env l t =
-  if List.for_all (fun x -> isRel x || isVar x) l (* common failure case *) then
-    let aliases = make_alias_map env in
-    match (try Some (expand_and_check_vars aliases l) with Exit -> None) with
-    | Some l as x when constr_list_distinct (get_actual_deps aliases l t) -> x
-    | _ -> None
-  else
-    None
+let find_unification_pattern_args env evd l t =
+  let aliases = make_alias_map env evd in
+  match expand_and_check_vars evd aliases l with
+  | Some l as x when alias_distinct (get_actual_deps evd aliases l t) -> x
+  | _ -> None
 
-let is_unification_pattern_meta env nb m l t =
+let is_unification_pattern_meta env evd nb m l t =
   (* Variables from context and rels > nb are implicitly all there *)
   (* so we need to be a rel <= nb *)
-  if List.for_all (fun x -> isRel x && destRel x <= nb) l then
-    match find_unification_pattern_args env l t with
-    | Some _ as x when not (dependent (mkMeta m) t) -> x
+  let map a = match EConstr.kind evd a with
+  | Rel n -> if n <= nb then Some (RelAlias n) else None
+  | _ -> None
+  in
+  match Option.List.map map l with
+  | Some l ->
+    begin match find_unification_pattern_args env evd l t with
+    | Some _ as x when not (dependent evd (mkMeta m) t) -> x
     | _ -> None
-  else
+    end
+  | None ->
     None
 
 let is_unification_pattern_evar env evd (evk,args) l t =
-  if List.for_all (fun x -> isRel x || isVar x) l 
-    && noccur_evar env evd evk t
-  then
+  match Option.List.map (fun c -> to_alias evd c) l with
+  | Some l when noccur_evar env evd evk t ->
     let args = remove_instance_local_defs evd evk args in
+    let args = Option.List.map (fun c -> to_alias evd c) args in
+    begin match args with
+    | None -> None
+    | Some args ->
     let n = List.length args in
-      match find_unification_pattern_args env (args @ l) t with
+      match find_unification_pattern_args env evd (args @ l) t with
       | Some l -> Some (List.skipn n l)
       | _ -> None
-  else None
+    end
+  | _ -> None
 
 let is_unification_pattern_pure_evar env evd (evk,args) t =
   let is_ev = is_unification_pattern_evar env evd (evk,args) [] t in
@@ -505,8 +555,8 @@ let is_unification_pattern_pure_evar env evd (evk,args) t =
   | Some _ -> true
 
 let is_unification_pattern (env,nb) evd f l t =
-  match kind_of_term f with
-  | Meta m -> is_unification_pattern_meta env nb m l t
+  match EConstr.kind evd f with
+  | Meta m -> is_unification_pattern_meta env evd nb m l t
   | Evar ev -> is_unification_pattern_evar env evd ev l t
   | _ -> None
 
@@ -517,18 +567,18 @@ let is_unification_pattern (env,nb) evd f l t =
    *implicitly* depend on Vars but lambda abstraction will not reflect this
    dependency: ?X x = ?1 (?1 is a meta) will return \_.?1 while it should
    return \y. ?1{x\y} (non constant function if ?1 depends on x) (BB) *)
-let solve_pattern_eqn env l c =
+let solve_pattern_eqn env sigma l c =
   let c' = List.fold_right (fun a c ->
-    let c' = subst_term (lift 1 a) (lift 1 c) in
-    match kind_of_term a with
+    let c' = subst_term sigma (lift 1 (of_alias a)) (lift 1 c) in
+    match a with
       (* Rem: if [a] links to a let-in, do as if it were an assumption *)
-      | Rel n ->
+      | RelAlias n ->
           let open Context.Rel.Declaration in
           let d = map_constr (lift n) (lookup_rel n env) in
           mkLambda_or_LetIn d c'
-      | Var id ->
+      | VarAlias id ->
           let d = lookup_named id env in mkNamedLambda_or_LetIn d c'
-      | _ -> assert false)
+    )
     l c in
   (* Warning: we may miss some opportunity to eta-reduce more since c'
      is not in normal form *)
@@ -550,36 +600,35 @@ let solve_pattern_eqn env l c =
 
 let make_projectable_subst aliases sigma evi args =
   let sign = evar_filtered_context evi in
-  let evar_aliases = compute_var_aliases sign in
+  let sign = List.map (fun d -> map_named_decl EConstr.of_constr d) sign in
+  let evar_aliases = compute_var_aliases sign sigma in
   let (_,full_subst,cstr_subst) =
     List.fold_right
       (fun decl (args,all,cstrs) ->
         match decl,args with
         | LocalAssum (id,c), a::rest ->
-            let a = whd_evar sigma a in
             let cstrs =
-              let a',args = decompose_app_vect a in
-              match kind_of_term a' with
+              let a',args = decompose_app_vect sigma a in
+              match EConstr.kind sigma a' with
               | Construct cstr ->
                   let l = try Constrmap.find (fst cstr) cstrs with Not_found -> [] in
                   Constrmap.add (fst cstr) ((args,id)::l) cstrs
               | _ -> cstrs in
-            (rest,Id.Map.add id [a,normalize_alias_opt aliases a,id] all,cstrs)
+            (rest,Id.Map.add id [a,normalize_alias_opt sigma aliases a,id] all,cstrs)
         | LocalDef (id,c,_), a::rest ->
-            let a = whd_evar sigma a in
-            (match kind_of_term c with
+            (match EConstr.kind sigma c with
             | Var id' ->
-                let idc = normalize_alias_var evar_aliases id' in
+                let idc = normalize_alias_var sigma evar_aliases id' in
                 let sub = try Id.Map.find idc all with Not_found -> [] in
-                if List.exists (fun (c,_,_) -> Term.eq_constr a c) sub then
+                if List.exists (fun (c,_,_) -> EConstr.eq_constr sigma a c) sub then
                   (rest,all,cstrs)
                 else
                   (rest,
-                   Id.Map.add idc ((a,normalize_alias_opt aliases a,id)::sub) all,
+                   Id.Map.add idc ((a,normalize_alias_opt sigma aliases a,id)::sub) all,
                    cstrs)
             | _ ->
-                (rest,Id.Map.add id [a,normalize_alias_opt aliases a,id] all,cstrs))
-        | _ -> anomaly (Pp.str "Instance does not match its signature"))
+                (rest,Id.Map.add id [a,normalize_alias_opt sigma aliases a,id] all,cstrs))
+        | _ -> anomaly (Pp.str "Instance does not match its signature."))
       sign (Array.rev_to_list args,Id.Map.empty,Constrmap.empty) in
   (full_subst,cstr_subst)
 
@@ -594,14 +643,13 @@ let make_projectable_subst aliases sigma evi args =
  *)
 
 let define_evar_from_virtual_equation define_fun env evd src t_in_env ty_t_in_sign sign filter inst_in_env =
-  let evd = Sigma.Unsafe.of_evar_map evd in
-  let Sigma (evar_in_env, evd, _) = new_evar_instance sign evd ty_t_in_sign ~filter ~src inst_in_env in
-  let evd = Sigma.to_evar_map evd in
+  let (evd, evar_in_env) = new_evar_instance sign evd ty_t_in_sign ~filter ~src inst_in_env in
   let t_in_env = whd_evar evd t_in_env in
-  let evd = define_fun env evd None (destEvar evar_in_env) t_in_env in
+  let (evk, _) = destEvar evd evar_in_env in
+  let evd = define_fun env evd None (destEvar evd evar_in_env) t_in_env in
   let ctxt = named_context_of_val sign in
   let inst_in_sign = inst_of_vars (Filter.filter_list filter ctxt) in
-  let evar_in_sign = mkEvar (fst (destEvar evar_in_env), inst_in_sign) in
+  let evar_in_sign = mkEvar (evk, inst_in_sign) in
   (evd,whd_evar evd evar_in_sign)
 
 (* We have x1..xq |- ?e1 : Ï„ and had to solve something like
@@ -627,13 +675,14 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
   if Evd.is_defined evd evk1 then
       (* Some circularity somewhere (see e.g. #3209) *)
       raise MorePreciseOccurCheckNeeeded;
-  let (evk1,args1) = destEvar (whd_evar evd (mkEvar (evk1,args1))) in
+  let (evk1,args1) = destEvar evd (mkEvar (evk1,args1)) in
   let evi1 = Evd.find_undefined evd evk1 in
   let env1,rel_sign = env_rel_context_chop k env in
   let sign1 = evar_hyps evi1 in
   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,_) =
@@ -646,18 +695,18 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
 	 ~status:univ_flexible (Some false) env evd (mkSort s) in
         define_evar_from_virtual_equation define_fun env evd src t_in_env
           ty_t_in_sign sign filter inst_in_env in
-      let evd,b_in_sign = match d with
-      | LocalAssum _ -> evd,None
+      let evd,d' = match d with
+      | LocalAssum _ -> evd, Context.Named.Declaration.LocalAssum (id,t_in_sign)
       | LocalDef (_,b,_) ->
           let evd,b = define_evar_from_virtual_equation define_fun env evd src b
             t_in_sign sign filter inst_in_env in
-          evd,Some b in
-      (push_named_context_val (Context.Named.Declaration.of_tuple (id,b_in_sign,t_in_sign)) sign, Filter.extend 1 filter,
+          evd, Context.Named.Declaration.LocalDef (id,b,t_in_sign) in
+      (push_named_context_val d' sign, Filter.extend 1 filter,
        (mkRel 1)::(List.map (lift 1) inst_in_env),
        (mkRel 1)::(List.map (lift 1) inst_in_sign),
-       push_rel d env,evd,id::avoid))
+       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
@@ -665,11 +714,9 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
      ~status:univ_flexible (Some false) env evd (mkSort s) in
     define_evar_from_virtual_equation define_fun env evd src ty_in_env
       ty_t_in_sign sign2 filter2 inst2_in_env in
-  let evd = Sigma.Unsafe.of_evar_map evd in
-  let Sigma (ev2_in_sign, evd, _) =
+  let (evd, ev2_in_sign) =
     new_evar_instance sign2 evd ev2ty_in_sign ~filter:filter2 ~src inst2_in_sign in
-  let evd = Sigma.to_evar_map evd in
-  let ev2_in_env = (fst (destEvar ev2_in_sign), Array.of_list inst2_in_env) in
+  let ev2_in_env = (fst (destEvar evd ev2_in_sign), Array.of_list inst2_in_env) in
   (evd, ev2_in_sign, ev2_in_env)
 
 let restrict_upon_filter evd evk p args =
@@ -690,7 +737,7 @@ let find_projectable_constructor env evd cstr k args cstr_subst =
       List.filter (fun (args',id) ->
         (* is_conv is maybe too strong (and source of useless computation) *)
         (* (at least expansion of aliases is needed) *)
-        Array.for_all2 (is_conv env evd) args args') l in
+        Array.for_all2 (fun c1 c2 -> is_conv env evd c1 c2) args args') l in
     List.map snd l
   with Not_found ->
     []
@@ -729,7 +776,7 @@ let find_projectable_constructor env evd cstr k args cstr_subst =
 
 type evar_projection =
 | ProjectVar
-| ProjectEvar of existential * evar_info * Id.t * evar_projection
+| ProjectEvar of EConstr.existential * evar_info * Id.t * evar_projection
 
 exception NotUnique
 exception NotUniqueInType of (Id.t * evar_projection) list
@@ -737,19 +784,18 @@ exception NotUniqueInType of (Id.t * evar_projection) list
 let rec assoc_up_to_alias sigma aliases y yc = function
   | [] -> raise Not_found
   | (c,cc,id)::l ->
-      let c' = whd_evar sigma c in
-      if Term.eq_constr y c' then id
+      if is_alias sigma c y then id
       else
         match l with
         | _ :: _ -> assoc_up_to_alias sigma aliases y yc l
         | [] ->
           (* Last chance, we reason up to alias conversion *)
-          match (if c == c' then cc else normalize_alias_opt aliases c') with
-          | Some cc when Term.eq_constr yc cc -> id
-          | _ -> if Term.eq_constr yc c then id else raise Not_found
+          match (normalize_alias_opt sigma aliases c) with
+          | Some cc when eq_alias yc cc -> id
+          | _ -> if is_alias sigma c yc then id else raise Not_found
 
 let rec find_projectable_vars with_evars aliases sigma y subst =
-  let yc = normalize_alias aliases y in
+  let yc = normalize_alias sigma aliases y in
   let is_projectable idc idcl subst' =
     (* First test if some [id] aliased to [idc] is bound to [y] in [subst] *)
     try
@@ -759,12 +805,12 @@ let rec find_projectable_vars with_evars aliases sigma y subst =
     (* Then test if [idc] is (indirectly) bound in [subst] to some evar *)
     (* projectable on [y] *)
       if with_evars then
-        let f (c,_,id) = isEvar c && is_undefined sigma (fst (destEvar c)) in
+        let f (c,_,id) = isEvar sigma c in
         let idcl' = List.filter f idcl in
         match idcl' with
         | [c,_,id] ->
           begin
-            let (evk,argsv as t) = destEvar c in
+            let (evk,argsv as t) = destEvar sigma c in
             let evi = Evd.find sigma evk in
             let subst,_ = make_projectable_subst aliases sigma evi argsv in
             let l = find_projectable_vars with_evars aliases sigma y subst in
@@ -773,7 +819,7 @@ let rec find_projectable_vars with_evars aliases sigma y subst =
             | _ -> subst'
           end
         | [] -> subst'
-        | _ -> anomaly (Pp.str "More than one non var in aliases class of evar instance")
+        | _ -> anomaly (Pp.str "More than one non var in aliases class of evar instance.")
       else
         subst' in
   Id.Map.fold is_projectable subst []
@@ -799,6 +845,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
@@ -812,19 +877,18 @@ let rec find_solution_type evarenv = function
 let rec do_projection_effects define_fun env ty evd = function
   | ProjectVar -> evd
   | ProjectEvar ((evk,argsv),evi,id,p) ->
-      let evd = Evd.define evk (mkVar id) evd in
+      let evd = Evd.define evk (Constr.mkVar id) evd in
       (* TODO: simplify constraints involving evk *)
       let evd = do_projection_effects define_fun env ty evd p in
       let ty = whd_all env evd (Lazy.force ty) in
-      if not (isSort ty) then
+      if not (isSort evd ty) then
         (* Don't try to instantiate if a sort because if evar_concl is an
            evar it may commit to a univ level which is not the right
            one (however, regarding coercions, because t is obtained by
            unif, we know that no coercion can be inserted) *)
         let subst = make_pure_subst evi argsv in
-        let ty' = replace_vars subst evi.evar_concl in
-        let ty' = whd_evar evd ty' in
-        if isEvar ty' then define_fun env evd (Some false) (destEvar ty') ty else evd
+        let ty' = replace_vars subst (EConstr.of_constr evi.evar_concl) in
+        if isEvar evd ty' then define_fun env evd (Some false) (destEvar evd ty') ty else evd
       else
         evd
 
@@ -850,7 +914,7 @@ let rec do_projection_effects define_fun env ty evd = function
 
 type projectibility_kind =
   | NoUniqueProjection
-  | UniqueProjection of constr * evar_projection list
+  | UniqueProjection of EConstr.constr * evar_projection list
 
 type projectibility_status =
   | CannotInvert
@@ -859,17 +923,16 @@ type projectibility_status =
 let invert_arg_from_subst evd aliases k0 subst_in_env_extended_with_k_binders c_in_env_extended_with_k_binders =
   let effects = ref [] in
   let rec aux k t =
-    let t = whd_evar evd t in
-    match kind_of_term t with
-    | Rel i when i>k0+k -> aux' k (mkRel (i-k))
-    | Var id -> aux' k t
-    | _ -> map_constr_with_binders succ aux k t
+    match EConstr.kind evd t with
+    | Rel i when i>k0+k -> aux' k (RelAlias (i-k))
+    | Var id -> aux' k (VarAlias id)
+    | _ -> map_with_binders evd succ aux k t
   and aux' k t =
     try project_with_effects aliases evd effects t subst_in_env_extended_with_k_binders
     with Not_found ->
-      match expand_alias_once aliases t with
+      match expand_alias_once evd aliases t with
       | None -> raise Not_found
-      | Some c -> aux k c in
+      | Some c -> aux k (lift k c) in
   try
     let c = aux 0 c_in_env_extended_with_k_binders in
     Invertible (UniqueProjection (c,!effects))
@@ -931,23 +994,23 @@ let invert_invertible_arg fullenv evd aliases k (evk,argsv) args' =
 let set_of_evctx l =
   List.fold_left (fun s decl -> Id.Set.add (get_id decl) s) Id.Set.empty l
 
-let filter_effective_candidates evi filter candidates =
+let filter_effective_candidates evd evi filter candidates =
   match filter with
   | None -> candidates
   | Some filter ->
       let ids = set_of_evctx (Filter.filter_list filter (evar_context evi)) in
-      List.filter (fun a -> Id.Set.subset (collect_vars a) ids) candidates
+      List.filter (fun a -> Id.Set.subset (collect_vars evd a) ids) candidates
 
 let filter_candidates evd evk filter candidates_update =
   let evi = Evd.find_undefined evd evk in
   let candidates = match candidates_update with
-  | NoUpdate -> evi.evar_candidates
+  | NoUpdate -> Option.map (fun l -> List.map EConstr.of_constr l) evi.evar_candidates
   | UpdateWith c -> Some c
   in
   match candidates with
   | None -> NoUpdate
   | Some l ->
-      let l' = filter_effective_candidates evi filter l in
+      let l' = filter_effective_candidates evd evi filter l in
       if List.length l = List.length l' && candidates_update = NoUpdate then
         NoUpdate
       else
@@ -960,13 +1023,14 @@ let closure_of_filter evd evk = function
   | None -> None
   | Some filter ->
   let evi = Evd.find_undefined evd evk in
-  let vars = collect_vars (Evarutil.nf_evar evd (evar_concl evi)) in
-  let test b decl = b || Idset.mem (get_id decl) vars ||
+  let vars = collect_vars evd (EConstr.of_constr (evar_concl evi)) in
+  let test b decl = b || Id.Set.mem (get_id decl) vars ||
                     match decl with
                     | LocalAssum _ ->
                        false
                     | LocalDef (_,c,_) ->
-                       not (isRel c || isVar c)
+                      let c = EConstr.of_constr c in
+                       not (isRel evd c || isVar evd c)
   in
   let newfilter = Filter.map_along test filter (evar_context evi) in
   (* Now ensure that restriction is at least what is was originally *)
@@ -989,17 +1053,17 @@ let restrict_hyps evd evk filter candidates =
     let typablefilter = closure_of_filter evd evk (Some filter) in
     (typablefilter,candidates)
 
-exception EvarSolvedWhileRestricting of evar_map * constr
+exception EvarSolvedWhileRestricting of evar_map * EConstr.constr
 
 let do_restrict_hyps evd (evk,args as ev) filter candidates =
   let filter,candidates = match filter with
   | None -> None,candidates
   | Some filter -> restrict_hyps evd evk filter candidates in
   match candidates,filter with
-  | UpdateWith [], _ -> error "Not solvable."
+  | UpdateWith [], _ -> user_err Pp.(str "Not solvable.")
   | UpdateWith [nc],_ ->
-      let evd = Evd.define evk nc evd in
-      raise (EvarSolvedWhileRestricting (evd,whd_evar evd (mkEvar ev)))
+      let evd = Evd.define evk (EConstr.Unsafe.to_constr nc) evd in
+      raise (EvarSolvedWhileRestricting (evd,mkEvar ev))
   | NoUpdate, None -> evd,ev
   | _ -> restrict_applied_evar evd ev filter candidates
 
@@ -1007,7 +1071,7 @@ let do_restrict_hyps evd (evk,args as ev) filter candidates =
 (* ?e is assumed to have no candidates *)
 
 let postpone_non_unique_projection env evd pbty (evk,argsv as ev) sols rhs =
-  let rhs = expand_vars_in_term env rhs in
+  let rhs = expand_vars_in_term env evd rhs in
   let filter =
     restrict_upon_filter evd evk
       (* Keep only variables that occur in rhs *)
@@ -1017,8 +1081,8 @@ let postpone_non_unique_projection env evd pbty (evk,argsv as ev) sols rhs =
       (* that says that the body is hidden. Note that expand_vars_in_term *)
       (* expands only rels and vars aliases, not rels or vars bound to an *)
       (* arbitrary complex term *)
-      (fun a -> not (isRel a || isVar a)
-                || dependent a rhs || List.exists (fun (id,_) -> isVarId id a) sols)
+      (fun a -> not (isRel evd a || isVar evd a)
+                || dependent evd a rhs || List.exists (fun (id,_) -> isVarId evd id a) sols)
       argsv in
   let filter = closure_of_filter evd evk filter in
   let candidates = extract_candidates sols in
@@ -1049,6 +1113,9 @@ let postpone_non_unique_projection env evd pbty (evk,argsv as ev) sols rhs =
  * Note: argument f is the function used to instantiate evars.
  *)
 
+let instantiate_evar_array evi c args =
+  EConstr.of_constr (instantiate_evar_array evi (EConstr.Unsafe.to_constr c) (Array.map EConstr.Unsafe.to_constr args))
+
 let filter_compatible_candidates conv_algo env evd evi args rhs c =
   let c' = instantiate_evar_array evi c args in
   match conv_algo env evd Reduction.CONV rhs c' with
@@ -1068,7 +1135,9 @@ let restrict_candidates conv_algo env evd filter1 (evk1,argsv1) (evk2,argsv2) =
   | _, None -> filter_candidates evd evk1 filter1 NoUpdate
   | None, Some _ -> raise DoesNotPreserveCandidateRestriction
   | Some l1, Some l2 ->
-      let l1 = filter_effective_candidates evi1 filter1 l1 in
+      let l1 = List.map EConstr.of_constr l1 in
+      let l2 = List.map EConstr.of_constr l2 in
+      let l1 = filter_effective_candidates evd evi1 filter1 l1 in
       let l1' = List.filter (fun c1 ->
         let c1' = instantiate_evar_array evi1 c1 argsv1 in
         let filter c2 =
@@ -1082,7 +1151,7 @@ let restrict_candidates conv_algo env evd filter1 (evk1,argsv1) (evk2,argsv2) =
       if Int.equal (List.length l1) (List.length l1') then NoUpdate
       else UpdateWith l1'
 
-exception CannotProject of evar_map * existential
+exception CannotProject of evar_map * EConstr.existential
 
 (* Assume that FV(?n[x1:=t1..xn:=tn]) belongs to some set U.
    Can ?n be instantiated by a term u depending essentially on xi such that the
@@ -1099,10 +1168,8 @@ exception CannotProject of evar_map * existential
 *)
 
 let rec is_constrainable_in top evd k (ev,(fv_rels,fv_ids) as g) t =
-  let f,args2 = decompose_app_vect t in
-  let f,args1 = decompose_app_vect (whd_evar evd f) in
-  let args = Array.append args1 args2 in
-  match kind_of_term f with
+  let f,args = decompose_app_vect evd t in
+  match EConstr.kind evd f with
   | Construct ((ind,_),u) ->
     let n = Inductiveops.inductive_nparams ind in
     if n > Array.length args then true (* We don't try to be more clever *)
@@ -1118,30 +1185,32 @@ let rec is_constrainable_in top evd k (ev,(fv_rels,fv_ids) as g) t =
   | _ -> (* We don't try to be more clever *) true
 
 let has_constrainable_free_vars env evd aliases force k ev (fv_rels,fv_ids,let_rels,let_ids) t =
-  let t' = expansion_of_var aliases t in
-  if t' != t then
+  match to_alias evd t with
+  | Some t ->
+    let expanded, t' = expansion_of_var evd aliases t in
+    if expanded then
     (* t is a local definition, we keep it only if appears in the list *)
     (* of let-in variables effectively occurring on the right-hand side, *)
     (* which is the only reason to keep it when inverting arguments *)
-    match kind_of_term t with
-    | Var id -> Id.Set.mem id let_ids
-    | Rel n -> Int.Set.mem n let_rels
-    | _ -> assert false
-  else
+      match t with
+      | VarAlias id -> Id.Set.mem id let_ids
+      | RelAlias n -> Int.Set.mem n let_rels
+    else begin match t with
+    | VarAlias id -> Id.Set.mem id fv_ids
+    | RelAlias n -> n <= k || Int.Set.mem n fv_rels
+    end
+  | None ->
     (* t is an instance for a proper variable; we filter it along *)
     (* the free variables allowed to occur *)
-    match kind_of_term t with
-    | Var id -> Id.Set.mem id fv_ids
-    | Rel n -> n <= k || Int.Set.mem n fv_rels
-    | _ -> (not force || noccur_evar env evd ev t) && is_constrainable_in true evd k (ev,(fv_rels,fv_ids)) t
+    (not force || noccur_evar env evd ev t) && is_constrainable_in true evd k (ev,(fv_rels,fv_ids)) t
 
-exception EvarSolvedOnTheFly of evar_map * constr
+exception EvarSolvedOnTheFly of evar_map * EConstr.constr
 
 (* Try to project evk1[argsv1] on evk2[argsv2], if [ev1] is a pattern on
    the common domain of definition *)
 let project_evar_on_evar force g env evd aliases k2 pbty (evk1,argsv1 as ev1) (evk2,argsv2 as ev2) =
   (* Apply filtering on ev1 so that fvs(ev1) are in fvs(ev2). *)
-  let fvs2 = free_vars_and_rels_up_alias_expansion aliases (mkEvar ev2) in
+  let fvs2 = free_vars_and_rels_up_alias_expansion evd aliases (mkEvar ev2) in
   let filter1 = restrict_upon_filter evd evk1
     (has_constrainable_free_vars env evd aliases force k2 evk2 fvs2)
     argsv1 in
@@ -1171,11 +1240,11 @@ let check_evar_instance evd evk1 body conv_algo =
   (* This happens in practice, cf MathClasses build failure on 2013-3-15 *)
   let ty =
     try Retyping.get_type_of ~lax:true evenv evd body
-    with Retyping.RetypeError _ -> error "Ill-typed evar instance"
+    with Retyping.RetypeError _ -> user_err Pp.(str "Ill-typed evar instance")
   in
-  match conv_algo evenv evd Reduction.CUMUL ty evi.evar_concl with
+  match conv_algo evenv evd Reduction.CUMUL ty (EConstr.of_constr evi.evar_concl) with
   | Success evd -> evd
-  | UnifFailure _ -> raise (IllTypedInstance (evenv,ty,evi.evar_concl))
+  | UnifFailure _ -> raise (IllTypedInstance (evenv,ty,EConstr.of_constr evi.evar_concl))
 
 let update_evar_source ev1 ev2 evd =
   let loc, evs2 = evar_source ev2 evd in
@@ -1188,8 +1257,8 @@ let update_evar_source ev1 ev2 evd =
 let solve_evar_evar_l2r force f g env evd aliases pbty ev1 (evk2,_ as ev2) =
   try
     let evd,body = project_evar_on_evar force g env evd aliases 0 pbty ev1 ev2 in
-    let evd' = Evd.define evk2 body evd in
-    let evd' = update_evar_source (fst (destEvar body)) evk2 evd' in
+    let evd' = Evd.define evk2 (EConstr.Unsafe.to_constr body) evd in
+    let evd' = update_evar_source (fst (destEvar evd body)) evk2 evd' in
       check_evar_instance evd' evk2 body g
   with EvarSolvedOnTheFly (evd,c) ->
     f env evd pbty ev2 c
@@ -1206,7 +1275,7 @@ let preferred_orientation evd evk1 evk2 =
   | _ -> true
 
 let solve_evar_evar_aux force f g env evd pbty (evk1,args1 as ev1) (evk2,args2 as ev2) =
-  let aliases = make_alias_map env in
+  let aliases = make_alias_map env evd in
   if preferred_orientation evd evk1 evk2 then
     try solve_evar_evar_l2r force f g env evd aliases (opp_problem pbty) ev2 ev1
     with CannotProject (evd,ev2) ->
@@ -1223,15 +1292,18 @@ let solve_evar_evar_aux force f g env evd pbty (evk1,args1 as ev1) (evk2,args2 a
 let solve_evar_evar ?(force=false) f g env evd pbty (evk1,args1 as ev1) (evk2,args2 as ev2) =
   let pbty = if force then None else pbty in
   let evi = Evd.find evd evk1 in
+  let downcast evk t evd = downcast evk (EConstr.Unsafe.to_constr t) evd in
   let evd =
     try 
       (* ?X : Π Δ. Type i = ?Y : Π Δ'. Type j.
 	 The body of ?X and ?Y just has to be of type Π Δ. Type k for some k <= i, j. *)
       let evienv = Evd.evar_env evi in
       let ctx1, i = Reduction.dest_arity evienv evi.evar_concl in
+      let ctx1 = List.map (fun c -> map_rel_decl EConstr.of_constr c) ctx1 in
       let evi2 = Evd.find evd evk2 in
       let evi2env = Evd.evar_env evi2 in
       let ctx2, j = Reduction.dest_arity evi2env evi2.evar_concl in
+      let ctx2 = List.map (fun c -> map_rel_decl EConstr.of_constr c) ctx2 in
       let ui, uj = univ_of_sort i, univ_of_sort j in
 	if i == j || Evd.check_eq evd ui uj
 	then (* Shortcut, i = j *) 
@@ -1253,10 +1325,10 @@ let solve_evar_evar ?(force=false) f g env evd pbty (evk1,args1 as ev1) (evk2,ar
   solve_evar_evar_aux force f g env evd pbty ev1 ev2
 
 type conv_fun =
-  env ->  evar_map -> conv_pb -> constr -> constr -> unification_result
+  env ->  evar_map -> conv_pb -> EConstr.constr -> EConstr.constr -> unification_result
 
 type conv_fun_bool =
-  env ->  evar_map -> conv_pb -> constr -> constr -> bool
+  env ->  evar_map -> conv_pb -> EConstr.constr -> EConstr.constr -> bool
 
 (* Solve pbs ?e[t1..tn] = ?e[u1..un] which arise often in fixpoint
  * definitions. We try to unify the ti with the ui pairwise. The pairs
@@ -1265,7 +1337,13 @@ type conv_fun_bool =
 
 let solve_refl ?(can_drop=false) conv_algo env evd pbty evk argsv1 argsv2 =
   let evdref = ref evd in
-  if Array.equal (e_eq_constr_univs evdref) argsv1 argsv2 then !evdref else
+  let eq_constr c1 c2 = match EConstr.eq_constr_universes env !evdref c1 c2 with
+  | None -> false
+  | Some cstr ->
+    try ignore (Evd.add_universe_constraints !evdref cstr); true
+    with UniversesDiffer -> false
+  in
+  if Array.equal eq_constr argsv1 argsv2 then !evdref else
   (* Filter and restrict if needed *)
   let args = Array.map2 (fun a1 a2 -> (a1, a2)) argsv1 argsv2 in
   let untypedfilter =
@@ -1297,14 +1375,14 @@ let solve_candidates conv_algo env evd (evk,argsv) rhs =
   | Some l ->
       let l' =
         List.map_filter
-          (filter_compatible_candidates conv_algo env evd evi argsv rhs) l in
+          (fun c -> filter_compatible_candidates conv_algo env evd evi argsv rhs (EConstr.of_constr c)) l in
       match l' with
       | [] -> raise IncompatibleCandidates
       | [c,evd] ->
           (* solve_candidates might have been called recursively in the mean *)
           (* time and the evar been solved by the filtering process *)
          if Evd.is_undefined evd evk then
-	   let evd' = Evd.define evk c evd in
+	   let evd' = Evd.define evk (EConstr.Unsafe.to_constr c) evd in
 	     check_evar_instance evd' evk c conv_algo
 	 else evd
       | l when List.length l < List.length l' ->
@@ -1313,8 +1391,10 @@ let solve_candidates conv_algo env evd (evk,argsv) rhs =
       | l -> evd
 
 let occur_evar_upto_types sigma n c =
+  let c = EConstr.Unsafe.to_constr c in
   let seen = ref Evar.Set.empty in
-  let rec occur_rec c = match kind_of_term c with
+  (** FIXME: Is that supposed to be evar-insensitive? *)
+  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
@@ -1322,7 +1402,7 @@ let occur_evar_upto_types sigma n c =
        else (
          seen := Evar.Set.add sp !seen;
 	 Option.iter occur_rec (existential_opt_value sigma e);
-	 occur_rec (existential_type sigma e))
+	 occur_rec (Evd.existential_type sigma e))
     | _ -> Constr.iter occur_rec c
   in
   try occur_rec c; false with Occur -> true
@@ -1350,14 +1430,14 @@ let occur_evar_upto_types sigma n c =
  *                Σ; Γ, y1..yk |- φ(u1..un) = c /\ x1..xn |- φ(x1..xn)
  *)
 
-exception NotInvertibleUsingOurAlgorithm of constr
+exception NotInvertibleUsingOurAlgorithm of EConstr.constr
 exception NotEnoughInformationToProgress of (Id.t * evar_projection) list
-exception NotEnoughInformationEvarEvar of constr
-exception OccurCheckIn of evar_map * constr
+exception NotEnoughInformationEvarEvar of EConstr.constr
+exception OccurCheckIn of evar_map * EConstr.constr
 exception MetaOccurInBodyInternal
 
 let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
-  let aliases = make_alias_map env in
+  let aliases = make_alias_map env evd in
   let evdref = ref evd in
   let progress = ref false in
   let evi = Evd.find evd evk in
@@ -1371,15 +1451,19 @@ 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 t) 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
       evdref := evd;
       c
     with
-      | Not_found -> raise (NotInvertibleUsingOurAlgorithm t)
+      | Not_found -> raise (NotInvertibleUsingOurAlgorithm (of_alias t))
       | NotUniqueInType sols ->
           if not !progress then
             raise (NotEnoughInformationToProgress sols);
@@ -1389,15 +1473,15 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
           let ty' = instantiate_evar_array evi ty argsv in
           let (evd,evar,(evk',argsv' as ev')) =
             materialize_evar (evar_define conv_algo ~choose) env !evdref 0 ev ty' in
-          let ts = expansions_of_var aliases t in
-          let test c = isEvar c || List.mem_f Constr.equal c ts in
+          let ts = expansions_of_var evd aliases t in
+          let test c = isEvar evd c || List.exists (is_alias evd c) ts in
           let filter = restrict_upon_filter evd evk test argsv' in
           let filter = closure_of_filter evd evk' filter in
           let candidates = extract_candidates sols in
           let evd = match candidates with
           | NoUpdate ->
             let evd, ev'' = restrict_applied_evar evd ev' filter NoUpdate in
-            Evd.add_conv_pb (Reduction.CONV,env,mkEvar ev'',t) evd
+            add_conv_oriented_pb ~tail:false (None,env,mkEvar ev'',of_alias t) evd
           | UpdateWith _ ->
             restrict_evar evd evk' filter candidates
           in
@@ -1405,21 +1489,20 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
           evar in
 
   let rec imitate (env',k as envk) t =
-    let t = whd_evar !evdref t in
-    match kind_of_term t with
+    match EConstr.kind !evdref t with
     | Rel i when i>k ->
         let open Context.Rel.Declaration in
         (match Environ.lookup_rel (i-k) env' with
-        | LocalAssum _ -> project_variable (mkRel (i-k))
+        | LocalAssum _ -> project_variable (RelAlias (i-k))
         | LocalDef (_,b,_) ->
-          try project_variable (mkRel (i-k))
-          with NotInvertibleUsingOurAlgorithm _ -> imitate envk (lift i b))
+          try project_variable (RelAlias (i-k))
+          with NotInvertibleUsingOurAlgorithm _ -> imitate envk (lift i (EConstr.of_constr b)))
     | Var id ->
         (match Environ.lookup_named id env' with
-        | LocalAssum _ -> project_variable t
+        | LocalAssum _ -> project_variable (VarAlias id)
         | LocalDef (_,b,_) ->
-          try project_variable t
-          with NotInvertibleUsingOurAlgorithm _ -> imitate envk b)
+          try project_variable (VarAlias id)
+          with NotInvertibleUsingOurAlgorithm _ -> imitate envk (EConstr.of_constr b))
     | LetIn (na,b,u,c) ->
         imitate envk (subst1 b c)
     | Evar (evk',args' as ev') ->
@@ -1446,7 +1529,7 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
              (* Try to project (a restriction of) the left evar ... *)
             try
               let evd,body = project_evar_on_evar false conv_algo env' evd aliases 0 None ev'' ev' in
-              let evd = Evd.define evk' body evd in
+              let evd = Evd.define evk' (EConstr.Unsafe.to_constr body) evd in
 		check_evar_instance evd evk' body conv_algo
             with
             | EvarSolvedOnTheFly _ -> assert false (* ev has no candidates *)
@@ -1458,9 +1541,9 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
     | _ ->
         progress := true;
         match
-          let c,args = decompose_app_vect t in
-          match kind_of_term c with
-          | Construct (cstr,u) when noccur_between 1 k t ->
+          let c,args = decompose_app_vect !evdref t in
+          match EConstr.kind !evdref c with
+          | Construct (cstr,u) when noccur_between !evdref 1 k t ->
             (* This is common case when inferring the return clause of match *)
             (* (currently rudimentary: we do not treat the case of multiple *)
             (*  possible inversions; we do not treat overlap with a possible *)
@@ -1475,7 +1558,7 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
             let candidates =
               try
                 let t =
-                  map_constr_with_full_binders (fun d (env,k) -> push_rel d env, k+1)
+                  map_constr_with_full_binders !evdref (fun d (env,k) -> push_rel d env, k+1)
                     imitate envk t in
                 t::l
               with e when CErrors.noncritical e -> l in
@@ -1488,28 +1571,28 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
               evar'')
         | None ->
            (* Evar/Rigid problem (or assimilated if not normal): we "imitate" *)
-	   map_constr_with_full_binders (fun d (env,k) -> push_rel d env, k+1)
+          map_constr_with_full_binders !evdref (fun d (env,k) -> push_rel d env, k+1)
 					imitate envk t
   in
   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;
-        isVarId id c && is_id_subst ctxt' s'
+        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 rhs &&
-      Idset.subset (collect_vars rhs) !names 
+      closed0 evd rhs &&
+      Id.Set.subset (collect_vars evd rhs) !names 
   in
   let body =
-    if fast rhs then nf_evar evd rhs
+    if fast rhs then EConstr.of_constr (EConstr.to_constr evd rhs) (** FIXME? *)
     else
       let t' = imitate (env,0) rhs in
 	if !progress then
@@ -1525,7 +1608,7 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
  *)
 
 and evar_define conv_algo ?(choose=false) env evd pbty (evk,argsv as ev) rhs =
-  match kind_of_term rhs with
+  match EConstr.kind evd rhs with
   | Evar (evk2,argsv2 as ev2) ->
       if Evar.equal evk evk2 then
         solve_refl ~can_drop:choose
@@ -1538,7 +1621,7 @@ and evar_define conv_algo ?(choose=false) env evd pbty (evk,argsv as ev) rhs =
   with NoCandidates ->
   try
     let (evd',body) = invert_definition conv_algo choose env evd pbty ev rhs in
-    if occur_meta body then raise MetaOccurInBodyInternal;
+    if occur_meta evd' body then raise MetaOccurInBodyInternal;
     (* invert_definition may have instantiate some evars of rhs with evk *)
     (* so we recheck acyclicity *)
     if occur_evar_upto_types evd' evk body then raise (OccurCheckIn (evd',body));
@@ -1561,7 +1644,7 @@ and evar_define conv_algo ?(choose=false) env evd pbty (evk,argsv as ev) rhs =
            print_constr body);
         raise e in*)
     let evd' = check_evar_instance evd' evk body conv_algo in
-    Evd.define evk body evd'
+    Evd.define evk (EConstr.Unsafe.to_constr body) evd'
   with
     | NotEnoughInformationToProgress sols ->
         postpone_non_unique_projection env evd pbty ev sols rhs
@@ -1574,7 +1657,7 @@ and evar_define conv_algo ?(choose=false) env evd pbty (evk,argsv as ev) rhs =
     | OccurCheckIn (evd,rhs) ->
         (* last chance: rhs actually reduces to ev *)
         let c = whd_all env evd rhs in
-        match kind_of_term c with
+        match EConstr.kind evd c with
         | Evar (evk',argsv2) when Evar.equal evk evk' ->
 	    solve_refl (fun env sigma pb c c' -> is_fconv pb env sigma c c')
               env evd pbty evk argsv argsv2
@@ -1607,17 +1690,19 @@ and evar_define conv_algo ?(choose=false) env evd pbty (evk,argsv as ev) rhs =
  * ass.
  *)
 
-let status_changed lev (pbty,_,t1,t2) =
-  (try Evar.Set.mem (head_evar t1) lev with NoHeadEvar -> false) ||
-  (try Evar.Set.mem (head_evar t2) lev with NoHeadEvar -> false)
+let status_changed evd lev (pbty,_,t1,t2) =
+  let t1 = EConstr.of_constr t1 in
+  let t2 = EConstr.of_constr t2 in
+  (try Evar.Set.mem (head_evar evd t1) lev with NoHeadEvar -> false) ||
+  (try Evar.Set.mem (head_evar evd t2) lev with NoHeadEvar -> false)
 
 let reconsider_unif_constraints conv_algo evd =
-  let (evd,pbs) = extract_changed_conv_pbs evd status_changed in
+  let (evd,pbs) = extract_changed_conv_pbs evd (status_changed evd) in
   List.fold_left
     (fun p (pbty,env,t1,t2 as x) ->
        match p with
        | Success evd ->
-           (match conv_algo env evd pbty t1 t2 with
+           (match conv_algo env evd pbty (EConstr.of_constr t1) (EConstr.of_constr t2) with
            | Success _ as x -> x
            | UnifFailure (i,e) -> UnifFailure (i,CannotSolveConstraint (x,e)))
        | UnifFailure _ as x -> x)
diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli
index b6bdc078..3f05c58c 100644
--- a/pretyping/evarsolve.mli
+++ b/pretyping/evarsolve.mli
@@ -1,15 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open Evd
 open Environ
 
+type alias
+
+val of_alias : alias -> EConstr.t
+
 type unification_result =
   | Success of evar_map
   | UnifFailure of evar_map * Pretype_errors.unification_error
@@ -18,7 +24,7 @@ val is_success : unification_result -> bool
 
 (** Replace the vars and rels that are aliases to other vars and rels by 
    their representative that is most ancient in the context *)
-val expand_vars_in_term : env -> constr -> constr
+val expand_vars_in_term : env -> evar_map -> constr -> constr
 
 (** [evar_define choose env ev c] try to instantiate [ev] with [c] (typed in [env]),
    possibly solving related unification problems, possibly leaving open
@@ -44,7 +50,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) ->
@@ -57,15 +63,15 @@ val solve_simple_eqn : conv_fun -> ?choose:bool -> env ->  evar_map ->
 val reconsider_unif_constraints : conv_fun -> evar_map -> unification_result
 
 val reconsider_conv_pbs : conv_fun -> evar_map -> unification_result
-(** @deprecated Alias for [reconsider_unif_constraints] *)
+[@@ocaml.deprecated "Alias for [reconsider_unif_constraints]"]
 
 val is_unification_pattern_evar : env -> evar_map -> existential -> constr list ->
-  constr -> constr list option
+  constr -> alias list option
 
 val is_unification_pattern : env * int -> evar_map -> constr -> constr list ->
-  constr -> constr list option
+  constr -> alias list option
 
-val solve_pattern_eqn : env -> constr list -> constr -> constr
+val solve_pattern_eqn : env -> evar_map -> alias list -> constr -> constr
 
 val noccur_evar : env -> evar_map -> Evar.t -> constr -> bool
 
@@ -73,10 +79,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 -> constr array -> constr 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 4caa1e99..b1608703 100644
--- a/pretyping/find_subterm.ml
+++ b/pretyping/find_subterm.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,11 +13,12 @@ open Util
 open CErrors
 open Names
 open Locus
-open Term
-open Nameops
+open EConstr
 open Termops
 open Pretype_errors
 
+module NamedDecl = Context.Named.Declaration
+
 (** Processing occurrences *)
 
 type occurrence_error =
@@ -28,14 +31,14 @@ 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
   | IncorrectInValueOccurrence id -> explain_incorrect_in_value_occurrence id
 
 let error_occurrences_error e =
-  errorlabstrm "" (explain_occurrence_error e)
+  user_err  (explain_occurrence_error e)
 
 let error_invalid_occurrence occ =
   error_occurrences_error (InvalidOccurrence occ)
@@ -61,7 +64,10 @@ let proceed_with_occurrences f occs x =
 
 let map_named_declaration_with_hyploc f hyploc acc decl =
   let open Context.Named.Declaration in
-  let f = f (Some (get_id decl, hyploc)) in
+  let f acc typ =
+    let acc, typ = f (Some (NamedDecl.get_id decl, hyploc)) acc typ in
+    acc, typ
+  in
   match decl,hyploc with
   | LocalAssum (id,_), InHypValueOnly ->
       error_occurrences_error (IncorrectInValueOccurrence id)
@@ -80,10 +86,10 @@ let map_named_declaration_with_hyploc f hyploc acc decl =
 
 exception SubtermUnificationError of subterm_unification_error
 
-exception NotUnifiable of (constr * constr * unification_error) option
+exception NotUnifiable of (EConstr.t * EConstr.t * unification_error) option
 
 type 'a testing_function = {
-  match_fun : 'a -> constr -> 'a;
+  match_fun : 'a -> EConstr.constr -> 'a;
   merge_fun : 'a -> 'a -> 'a;
   mutable testing_state : 'a;
   mutable last_found : position_reporting option
@@ -94,7 +100,7 @@ type 'a testing_function = {
    (b,l), b=true means no occurrence except the ones in l and b=false,
    means all occurrences except the ones in l *)
 
-let replace_term_occ_gen_modulo occs like_first test bywhat cl occ t =
+let replace_term_occ_gen_modulo sigma occs like_first test bywhat cl occ t =
   let (nowhere_except_in,locs) = Locusops.convert_occs occs in
   let maxocc = List.fold_right max locs 0 in
   let pos = ref occ in
@@ -128,23 +134,23 @@ let replace_term_occ_gen_modulo occs like_first test bywhat cl occ t =
     with NotUnifiable _ ->
       subst_below k t
   and subst_below k t =
-    map_constr_with_binders_left_to_right (fun d k -> k+1) substrec k t
+    map_constr_with_binders_left_to_right sigma (fun d k -> k+1) substrec k t
   in
   let t' = substrec 0 t in
   (!pos, t')
 
-let replace_term_occ_modulo occs test bywhat t =
+let replace_term_occ_modulo evd occs test bywhat t =
   let occs',like_first =
     match occs with AtOccs occs -> occs,false | LikeFirst -> AllOccurrences,true in
   proceed_with_occurrences
-    (replace_term_occ_gen_modulo occs' like_first test bywhat None) occs' t
+    (replace_term_occ_gen_modulo evd occs' like_first test bywhat None) occs' t
 
-let replace_term_occ_decl_modulo occs test bywhat d =
+let replace_term_occ_decl_modulo evd occs test bywhat d =
   let (plocs,hyploc),like_first =
     match occs with AtOccs occs -> occs,false | LikeFirst -> (AllOccurrences,InHyp),true in
   proceed_with_occurrences
     (map_named_declaration_with_hyploc
-       (replace_term_occ_gen_modulo plocs like_first test bywhat)
+       (replace_term_occ_gen_modulo evd plocs like_first test bywhat)
        hyploc)
     plocs d
 
@@ -152,11 +158,12 @@ let replace_term_occ_decl_modulo occs test bywhat d =
 
 let make_eq_univs_test env evd c =
   { match_fun = (fun evd c' ->
-    let b, cst = Universes.eq_constr_universes_proj env c c' in
-      if b then
+    match EConstr.eq_constr_universes_proj env evd c c' with
+    | None -> raise (NotUnifiable None)
+    | Some cst ->
 	try Evd.add_universe_constraints evd cst
 	with Evd.UniversesDiffer -> raise (NotUnifiable None)
-      else raise (NotUnifiable None));
+    );
   merge_fun = (fun evd _ -> evd);
   testing_state = evd;
   last_found = None
@@ -165,7 +172,7 @@ let make_eq_univs_test env evd c =
 let subst_closed_term_occ env evd occs c t =
   let test = make_eq_univs_test env evd c in
   let bywhat () = mkRel 1 in
-  let t' = replace_term_occ_modulo occs test bywhat t in
+  let t' = replace_term_occ_modulo evd occs test bywhat t in
     t', test.testing_state
 
 let subst_closed_term_occ_decl env evd occs c d =
@@ -175,6 +182,6 @@ let subst_closed_term_occ_decl env evd occs c d =
   let bywhat () = mkRel 1 in
   proceed_with_occurrences
     (map_named_declaration_with_hyploc
-       (fun _ -> replace_term_occ_gen_modulo plocs like_first test bywhat None)
+       (fun _ -> replace_term_occ_gen_modulo evd plocs like_first test bywhat None)
        hyploc) plocs d,
   test.testing_state
diff --git a/pretyping/find_subterm.mli b/pretyping/find_subterm.mli
index c741ab04..9ba63b4f 100644
--- a/pretyping/find_subterm.mli
+++ b/pretyping/find_subterm.mli
@@ -1,16 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Locus
-open Term
 open Evd
 open Pretype_errors
 open Environ
+open EConstr
 
 (** Finding subterms, possibly up to some unification function,
     possibly at some given occurrences *)
@@ -41,15 +43,16 @@ val make_eq_univs_test : env -> evar_map -> constr -> evar_map testing_function
     matching subterms at the indicated occurrences [occl] with [mk
     ()]; it turns a NotUnifiable exception raised by the testing
     function into a SubtermUnificationError. *)
-val replace_term_occ_modulo : occurrences or_like_first ->
+val replace_term_occ_modulo : evar_map -> occurrences or_like_first ->
   'a testing_function -> (unit -> constr) -> constr -> constr
 
 (** [replace_term_occ_decl_modulo] is similar to
     [replace_term_occ_modulo] but for a named_declaration. *)
 val replace_term_occ_decl_modulo :
+  evar_map ->
   (occurrences * hyp_location_flag) or_like_first ->
   'a testing_function -> (unit -> constr) ->
-  Context.Named.Declaration.t -> Context.Named.Declaration.t
+  named_declaration -> named_declaration
 
 (** [subst_closed_term_occ occl c d] replaces occurrences of
     closed [c] at positions [occl] by [Rel 1] in [d] (see also Note OCC),
@@ -61,7 +64,7 @@ val subst_closed_term_occ : env -> evar_map -> occurrences or_like_first ->
     closed [c] at positions [occl] by [Rel 1] in [decl]. *)
 val subst_closed_term_occ_decl : env -> evar_map ->
   (occurrences * hyp_location_flag) or_like_first ->
-  constr -> Context.Named.Declaration.t -> Context.Named.Declaration.t * evar_map
+  constr -> named_declaration -> named_declaration * evar_map
 
 (** Miscellaneous *)
 val error_invalid_occurrence : int list -> 'a
diff --git a/engine/geninterp.ml b/pretyping/geninterp.ml
index cfca95d3..1f8b9263 100644
--- a/engine/geninterp.ml
+++ b/pretyping/geninterp.ml
@@ -1,19 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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
@@ -32,7 +34,7 @@ struct
   let repr = ValT.repr
   let create = ValT.create
 
-  let pr : type a. a typ -> Pp.std_ppcmds = fun t -> Pp.str (repr t)
+  let pr : type a. a typ -> Pp.t = fun t -> Pp.str (repr t)
 
   let typ_list = ValT.create "list"
   let typ_opt = ValT.create "option"
@@ -47,6 +49,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 b70671a2..fa522e9c 100644
--- a/engine/geninterp.mli
+++ b/pretyping/geninterp.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Interpretation functions for generic arguments and interpreted Ltac
@@ -30,7 +32,7 @@ sig
 
   val eq : 'a typ -> 'b typ -> ('a, 'b) CSig.eq option
   val repr : 'a typ -> string
-  val pr : 'a typ -> Pp.std_ppcmds
+  val pr : 'a typ -> Pp.t
 
   val typ_list : t list typ
   val typ_opt : t option typ
@@ -39,6 +41,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 51660818..eda45f3d 100644
--- a/pretyping/glob_ops.ml
+++ b/pretyping/glob_ops.ml
@@ -1,33 +1,46 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
+open CAst
 open Names
 open Nameops
 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 = function
-    PatVar(loc,_) -> loc
-  | PatCstr(loc,_,_,_) -> loc
+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)
+    | (tm,(na,Some {v=(_,nal)})) -> na::nal) tml)
 
-let mkGApp loc p t =
-  match p with
-  | GApp (loc,f,l) -> GApp (loc,f,l@[t])
-  | _ -> GApp (loc,p,[t])
+let mkGApp ?loc p t = DAst.make ?loc @@
+  match DAst.get p with
+  | GApp (f,l) -> GApp (f,l@[t])
+  | _          -> GApp (p,[t])
 
 let map_glob_decl_left_to_right f (na,k,obd,ty) =
   let comp1 = Option.map f obd in
@@ -35,367 +48,280 @@ let map_glob_decl_left_to_right f (na,k,obd,ty) =
   (na,k,comp1,comp2)
 
 let binding_kind_eq bk1 bk2 = match bk1, bk2 with
-| Decl_kinds.Explicit, Decl_kinds.Explicit -> true
-| Decl_kinds.Implicit, Decl_kinds.Implicit -> true
-| _ -> false
+  | Decl_kinds.Explicit, Decl_kinds.Explicit -> true
+  | Decl_kinds.Implicit, Decl_kinds.Implicit -> true
+  | (Decl_kinds.Explicit | Decl_kinds.Implicit), _ -> false
 
 let case_style_eq s1 s2 = match s1, s2 with
-| LetStyle, LetStyle -> true
-| IfStyle, IfStyle -> true
-| LetPatternStyle, LetPatternStyle -> true
-| MatchStyle, MatchStyle -> true
-| RegularStyle, RegularStyle -> true
-| _ -> false
-
-let rec cases_pattern_eq p1 p2 = match p1, p2 with
-| PatVar (_, na1), PatVar (_, na2) -> Name.equal na1 na2
-| PatCstr (_, c1, pl1, na1), PatCstr (_, c2, pl2, na2) ->
-  eq_constructor c1 c2 && List.equal cases_pattern_eq pl1 pl2 &&
-  Name.equal na1 na2
-| _ -> false
+  | LetStyle, LetStyle -> true
+  | IfStyle, IfStyle -> true
+  | LetPatternStyle, LetPatternStyle -> true
+  | MatchStyle, MatchStyle -> true
+  | RegularStyle, RegularStyle -> true
+  | (LetStyle | IfStyle | LetPatternStyle | MatchStyle | RegularStyle), _ -> 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
+  | (PatVar _ | PatCstr _), _ -> false
 
 let cast_type_eq eq t1 t2 = match t1, t2 with
-| CastConv t1, CastConv t2 -> eq t1 t2
-| CastVM t1, CastVM t2 -> eq t1 t2
-| CastCoerce, CastCoerce -> true
-| CastNative t1, CastNative t2 -> eq t1 t2
-| _ -> false
-
-let rec glob_constr_eq c1 c2 = match c1, c2 with
-| GRef (_, gr1, _), GRef (_, gr2, _) -> eq_gr gr1 gr2
-| GVar (_, id1), GVar (_, id2) -> Id.equal id1 id2
-| GEvar (_, id1, arg1), GEvar (_, id2, arg2) ->
-  Id.equal id1 id2 &&
-  List.equal instance_eq arg1 arg2
-| GPatVar (_, (b1, pat1)), GPatVar (_, (b2, pat2)) ->
-  (b1 : bool) == b2 && Id.equal pat1 pat2
-| GApp (_, f1, arg1), GApp (_, f2, arg2) ->
-  glob_constr_eq f1 f2 && List.equal glob_constr_eq arg1 arg2
-| GLambda (_, na1, bk1, t1, c1), GLambda (_, na2, bk2, t2, c2) ->
-  Name.equal na1 na2 && binding_kind_eq bk1 bk2 &&
-  glob_constr_eq t1 t2 && glob_constr_eq c1 c2
-| GProd (_, na1, bk1, t1, c1), GProd (_, na2, bk2, t2, c2) ->
-  Name.equal na1 na2 && binding_kind_eq bk1 bk2 &&
-  glob_constr_eq t1 t2 && glob_constr_eq c1 c2
-| GLetIn (_, na1, t1, c1), GLetIn (_, na2, t2, c2) ->
-  Name.equal na1 na2 && glob_constr_eq t1 t2 && glob_constr_eq c1 c2
-| GCases (_, st1, c1, tp1, cl1), GCases (_, st2, c2, tp2, cl2) ->
-  case_style_eq st1 st2 && Option.equal glob_constr_eq c1 c2 &&
-  List.equal tomatch_tuple_eq tp1 tp2 &&
-  List.equal cases_clause_eq cl1 cl2
-| GLetTuple (_, na1, (n1, p1), c1, t1), GLetTuple (_, na2, (n2, p2), c2, t2) ->
-  List.equal Name.equal na1 na2 && Name.equal n1 n2 &&
-  Option.equal glob_constr_eq p1 p2 && glob_constr_eq c1 c2 &&
-  glob_constr_eq t1 t2
-| GIf (_, m1, (pat1, p1), c1, t1), GIf (_, m2, (pat2, p2), c2, t2) ->
-  glob_constr_eq m1 m2 && Name.equal pat1 pat2 &&
-  Option.equal glob_constr_eq p1 p2 && glob_constr_eq c1 c2 &&
-  glob_constr_eq t1 t2
-| GRec (_, kn1, id1, decl1, c1, t1), GRec (_, kn2, id2, decl2, c2, t2) ->
-  fix_kind_eq kn1 kn2 && Array.equal Id.equal id1 id2 &&
-  Array.equal (fun l1 l2 -> List.equal glob_decl_eq l1 l2) decl1 decl2 &&
-  Array.equal glob_constr_eq c1 c2 &&
-  Array.equal glob_constr_eq t1 t2
-| GSort (_, s1), GSort (_, s2) -> Miscops.glob_sort_eq s1 s2
-| GHole (_, kn1, nam1, gn1), GHole (_, kn2, nam2, gn2) ->
-  Option.equal (==) gn1 gn2 (** Only thing sensible *) &&
-  Miscops.intro_pattern_naming_eq nam1 nam2
-| GCast (_, c1, t1), GCast (_, c2, t2) ->
-  glob_constr_eq c1 c2 && cast_type_eq glob_constr_eq t1 t2
-| _ -> false
-
-and tomatch_tuple_eq (c1, p1) (c2, p2) =
-  let eqp (_, i1, na1) (_, i2, na2) =
+  | CastConv t1, CastConv t2 -> eq t1 t2
+  | CastVM t1, CastVM t2 -> eq t1 t2
+  | CastCoerce, CastCoerce -> true
+  | CastNative t1, CastNative t2 -> eq t1 t2
+  | (CastConv _ | CastVM _ | CastCoerce | CastNative _), _ -> false
+
+let matching_var_kind_eq k1 k2 = match k1, k2 with
+| FirstOrderPatVar ido1, FirstOrderPatVar ido2 -> Id.equal ido1 ido2
+| SecondOrderPatVar id1, SecondOrderPatVar id2 -> Id.equal id1 id2
+| (FirstOrderPatVar _ | SecondOrderPatVar _), _ -> false
+
+let tomatch_tuple_eq f (c1, p1) (c2, p2) =
+  let eqp {CAst.v=(i1, na1)} {CAst.v=(i2, na2)} =
     eq_ind i1 i2 && List.equal Name.equal na1 na2
   in
   let eq_pred (n1, o1) (n2, o2) = Name.equal n1 n2 && Option.equal eqp o1 o2 in
-  glob_constr_eq c1 c2 && eq_pred p1 p2
+  f c1 c2 && eq_pred p1 p2
 
-and cases_clause_eq (_, id1, p1, c1) (_, id2, p2, c2) =
-  List.equal Id.equal id1 id2 && List.equal cases_pattern_eq p1 p2 &&
-  glob_constr_eq c1 c2
+and cases_clause_eq f {CAst.v=(id1, p1, c1)} {CAst.v=(id2, p2, c2)} =
+  List.equal Id.equal id1 id2 && List.equal cases_pattern_eq p1 p2 && f c1 c2
 
-and glob_decl_eq (na1, bk1, c1, t1) (na2, bk2, c2, t2) =
+let glob_decl_eq f (na1, bk1, c1, t1) (na2, bk2, c2, t2) =
   Name.equal na1 na2 && binding_kind_eq bk1 bk2 &&
-  Option.equal glob_constr_eq c1 c2 &&
-  glob_constr_eq t1 t2
-
-and fix_kind_eq k1 k2 = match k1, k2 with
-| GFix (a1, i1), GFix (a2, i2) ->
-  let eq (i1, o1) (i2, o2) =
-    Option.equal Int.equal i1 i2 && fix_recursion_order_eq o1 o2
-  in
-  Int.equal i1 i2 && Array.equal eq a1 a1
-| GCoFix i1, GCoFix i2 -> Int.equal i1 i2
-| _ -> false
-
-and fix_recursion_order_eq o1 o2 = match o1, o2 with
-| GStructRec, GStructRec -> true
-| GWfRec c1, GWfRec c2 -> glob_constr_eq c1 c2
-| GMeasureRec (c1, o1), GMeasureRec (c2, o2) ->
-  glob_constr_eq c1 c2 && Option.equal glob_constr_eq o1 o2
-| _ -> false
-
-and instance_eq (x1,c1) (x2,c2) =
-  Id.equal x1 x2 && glob_constr_eq c1 c2
-
-let map_glob_constr_left_to_right f = function
-  | GApp (loc,g,args) ->
+  Option.equal f c1 c2 && f t1 t2
+
+let fix_recursion_order_eq f o1 o2 = match o1, o2 with
+  | GStructRec, GStructRec -> true
+  | GWfRec c1, GWfRec c2 -> f c1 c2
+  | GMeasureRec (c1, o1), GMeasureRec (c2, o2) ->
+    f c1 c2 && Option.equal f o1 o2
+  | (GStructRec | GWfRec _ | GMeasureRec _), _ -> false
+
+let fix_kind_eq f k1 k2 = match k1, k2 with
+  | GFix (a1, i1), GFix (a2, i2) ->
+    let eq (i1, o1) (i2, o2) =
+      Option.equal Int.equal i1 i2 && fix_recursion_order_eq f o1 o2
+    in
+    Int.equal i1 i2 && Array.equal eq a1 a1
+  | GCoFix i1, GCoFix i2 -> Int.equal i1 i2
+  | (GFix _ | GCoFix _), _ -> false
+
+let instance_eq f (x1,c1) (x2,c2) =
+  Id.equal x1 x2 && f c1 c2
+
+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) ->
+    Id.equal id1 id2 && List.equal (instance_eq f) arg1 arg2
+  | GPatVar k1, GPatVar k2 -> matching_var_kind_eq k1 k2
+  | GApp (f1, arg1), GApp (f2, arg2) ->
+    f f1 f2 && List.equal f arg1 arg2
+  | GLambda (na1, bk1, t1, c1), GLambda (na2, bk2, t2, c2) ->
+    Name.equal na1 na2 && binding_kind_eq bk1 bk2 && f t1 t2 && f c1 c2
+  | GProd (na1, bk1, t1, c1), GProd (na2, bk2, t2, c2) ->
+    Name.equal na1 na2 && binding_kind_eq bk1 bk2 && f t1 t2 && f c1 c2
+  | GLetIn (na1, b1, t1, c1), GLetIn (na2, b2, t2, c2) ->
+    Name.equal na1 na2 && f b1 b2 && Option.equal f t1 t2 && f c1 c2
+  | GCases (st1, c1, tp1, cl1), GCases (st2, c2, tp2, cl2) ->
+    case_style_eq st1 st2 && Option.equal f c1 c2 &&
+    List.equal (tomatch_tuple_eq f) tp1 tp2 &&
+    List.equal (cases_clause_eq f) cl1 cl2
+  | GLetTuple (na1, (n1, p1), c1, t1), GLetTuple (na2, (n2, p2), c2, t2) ->
+    List.equal Name.equal na1 na2 && Name.equal n1 n2 &&
+    Option.equal f p1 p2 && f c1 c2 && f t1 t2
+  | GIf (m1, (pat1, p1), c1, t1), GIf (m2, (pat2, p2), c2, t2) ->
+    f m1 m2 && Name.equal pat1 pat2 &&
+    Option.equal f p1 p2 && f c1 c2 && f t1 t2
+  | GRec (kn1, id1, decl1, c1, t1), GRec (kn2, id2, decl2, c2, t2) ->
+    fix_kind_eq f kn1 kn2 && Array.equal Id.equal id1 id2 &&
+    Array.equal (fun l1 l2 -> List.equal (glob_decl_eq f) l1 l2) decl1 decl2 &&
+    Array.equal f c1 c2 && Array.equal f t1 t2
+  | GSort s1, GSort s2 -> Miscops.glob_sort_eq s1 s2
+  | GHole (kn1, nam1, gn1), GHole (kn2, nam2, gn2) ->
+    Option.equal (==) gn1 gn2 (** Only thing sensible *) &&
+    Miscops.intro_pattern_naming_eq nam1 nam2
+  | GCast (c1, t1), GCast (c2, t2) ->
+    f c1 c2 && cast_type_eq f t1 t2
+  | (GRef _ | GVar _ | GEvar _ | GPatVar _ | GApp _ | GLambda _ | GProd _ | GLetIn _ |
+     GCases _ | GLetTuple _ | GIf _ | GRec _ | GSort _ | GHole _ | GCast _), _ -> false
+
+let rec glob_constr_eq c = mk_glob_constr_eq glob_constr_eq c
+
+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
-      GApp (loc,comp1,comp2)
-  | GLambda (loc,na,bk,ty,c) ->
+      GApp (comp1,comp2)
+  | GLambda (na,bk,ty,c) ->
       let comp1 = f ty in
       let comp2 = f c in
-      GLambda (loc,na,bk,comp1,comp2)
-  | GProd (loc,na,bk,ty,c) ->
+      GLambda (na,bk,comp1,comp2)
+  | GProd (na,bk,ty,c) ->
       let comp1 = f ty in
       let comp2 = f c in
-      GProd (loc,na,bk,comp1,comp2)
-  | GLetIn (loc,na,b,c) ->
+      GProd (na,bk,comp1,comp2)
+  | GLetIn (na,b,t,c) ->
       let comp1 = f b in
+      let compt = Option.map f t in
       let comp2 = f c in
-      GLetIn (loc,na,comp1,comp2)
-  | GCases (loc,sty,rtntypopt,tml,pl) ->
+      GLetIn (na,comp1,compt,comp2)
+  | GCases (sty,rtntypopt,tml,pl) ->
       let comp1 = Option.map f rtntypopt in
       let comp2 = Util.List.map_left (fun (tm,x) -> (f tm,x)) tml in
-      let comp3 = Util.List.map_left (fun (loc,idl,p,c) -> (loc,idl,p,f c)) pl in
-      GCases (loc,sty,comp1,comp2,comp3)
-  | GLetTuple (loc,nal,(na,po),b,c) ->
+      let comp3 = Util.List.map_left (CAst.map (fun (idl,p,c) -> (idl,p,f c))) pl in
+      GCases (sty,comp1,comp2,comp3)
+  | GLetTuple (nal,(na,po),b,c) ->
       let comp1 = Option.map f po in
       let comp2 = f b in
       let comp3 = f c in
-      GLetTuple (loc,nal,(na,comp1),comp2,comp3)
-  | GIf (loc,c,(na,po),b1,b2) ->
+      GLetTuple (nal,(na,comp1),comp2,comp3)
+  | GIf (c,(na,po),b1,b2) ->
       let comp1 = Option.map f po in
       let comp2 = f b1 in
       let comp3 = f b2 in
-      GIf (loc,f c,(na,comp1),comp2,comp3)
-  | GRec (loc,fk,idl,bl,tyl,bv) ->
+      GIf (f c,(na,comp1),comp2,comp3)
+  | GRec (fk,idl,bl,tyl,bv) ->
       let comp1 = Array.map (Util.List.map_left (map_glob_decl_left_to_right f)) bl in
       let comp2 = Array.map f tyl in
       let comp3 = Array.map f bv in
-      GRec (loc,fk,idl,comp1,comp2,comp3)
-  | GCast (loc,c,k) ->
+      GRec (fk,idl,comp1,comp2,comp3)
+  | GCast (c,k) ->
       let comp1 = f c in
       let comp2 = Miscops.map_cast_type f k in
-      GCast (loc,comp1,comp2)
+      GCast (comp1,comp2)
   | (GVar _ | GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) as x -> x
+  )
 
 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 = 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) | GLetIn (_,_,b,c) ->
+  | GApp (c,args) -> List.fold_left f (f acc c) args
+  | GLambda (_,_,b,c) | GProd (_,_,b,c) ->
     f (f acc b) c
-  | GCases (_,_,rtntypopt,tml,pl) ->
-    let fold_pattern acc (_,idl,p,c) = f acc c in
+  | GLetIn (_,b,t,c) ->
+    f (Option.fold_left f (f acc b) t) c
+  | GCases (_,rtntypopt,tml,pl) ->
+    let fold_pattern acc {CAst.v=(idl,p,c)} = f acc c in
     List.fold_left fold_pattern
       (List.fold_left f (Option.fold_left f acc rtntypopt) (List.map fst tml))
       pl
-  | GLetTuple (_,_,rtntyp,b,c) ->
+  | GLetTuple (_,rtntyp,b,c) ->
     f (f (fold_return_type f acc rtntyp) b) c
-  | GIf (_,c,rtntyp,b1,b2) ->
+  | GIf (c,rtntyp,b1,b2) ->
     f (f (f (fold_return_type f acc rtntyp) c) b1) b2
-  | GRec (_,_,_,bl,tyl,bv) ->
+  | GRec (_,_,bl,tyl,bv) ->
     let acc = Array.fold_left
       (List.fold_left (fun acc (na,k,bbd,bty) ->
 	f (Option.fold_left f acc bbd) bty)) acc bl in
     Array.fold_left f (Array.fold_left f acc tyl) bv
-  | GCast (_,c,k) ->
+  | GCast (c,k) ->
     let acc = match k with
       | CastConv t | CastVM t | CastNative t -> f acc t | CastCoerce -> acc in
     f acc c
   | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> acc
+  )
 
-let iter_glob_constr f = fold_glob_constr (fun () -> f) ()
+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 same_id na id = match na with
-| Anonymous -> false
-| Name id' -> Id.equal id id'
+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) ->
+    f (Name.fold_right g na v) (f v acc b) c
+  | GLetIn (na,b,t,c) ->
+    f (Name.fold_right g na v) (Option.fold_left (f v) (f v acc b) t) c
+  | GCases (_,rtntypopt,tml,pl) ->
+    let fold_pattern acc {v=(idl,p,c)} = f (List.fold_right g idl v) acc c in
+    let fold_tomatch (v',acc) (tm,(na,onal)) =
+      ((if rtntypopt = None then v' else
+       Option.fold_left (fun v'' {v=(_,nal)} -> List.fold_right (Name.fold_right g) nal v'')
+                        (Name.fold_right g na v') onal),
+       f v acc tm) in
+    let (v',acc) = List.fold_left fold_tomatch (v,acc) tml in
+    let acc = Option.fold_left (f v') acc rtntypopt in
+    List.fold_left fold_pattern acc pl
+  | GLetTuple (nal,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) ->
+    let v' = Array.fold_right g idl v in
+    let f' i acc fid =
+      let v,acc =
+	List.fold_left
+	  (fun (v,acc) (na,k,bbd,bty) ->
+            (Name.fold_right g na v, f v (Option.fold_left (f v) acc bbd) bty))
+          (v,acc)
+          bll.(i) in
+      f v' (f v acc tyl.(i)) (bv.(i)) in
+    Array.fold_left_i f' acc idl
+  | GCast (c,k) ->
+    let acc = match k with
+      | CastConv t | CastVM t | CastNative t -> f v acc t | CastCoerce -> acc in
+    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 rec occur = function
-    | GVar (loc,id') -> Id.equal id id'
-    | GApp (loc,f,args) -> (occur f) || (List.exists occur args)
-    | GLambda (loc,na,bk,ty,c) ->
-      (occur ty) || (not (same_id na id) && (occur c))
-    | GProd (loc,na,bk,ty,c) ->
-      (occur ty) || (not (same_id na id) && (occur c))
-    | GLetIn (loc,na,b,c) ->
-      (occur b) || (not (same_id na id) && (occur c))
-    | GCases (loc,sty,rtntypopt,tml,pl) ->
-	(occur_option rtntypopt)
-        || (List.exists (fun (tm,_) -> occur tm) tml)
-	|| (List.exists occur_pattern pl)
-    | GLetTuple (loc,nal,rtntyp,b,c) ->
-	occur_return_type rtntyp id
-        || (occur b) || (not (List.mem_f Name.equal (Name id) nal) && (occur c))
-    | GIf (loc,c,rtntyp,b1,b2) ->
-	occur_return_type rtntyp id || (occur c) || (occur b1) || (occur b2)
-    | GRec (loc,fk,idl,bl,tyl,bv) ->
-        not (Array.for_all4 (fun fid bl ty bd ->
-          let rec occur_fix = function
-              [] -> not (occur ty) && (Id.equal fid id || not(occur bd))
-            | (na,k,bbd,bty)::bl ->
-                not (occur bty) &&
-                (match bbd with
-                    Some bd -> not (occur bd)
-                  | _ -> true) &&
-                (match na with Name id' -> Id.equal id id' | _ -> not (occur_fix bl)) in
-          occur_fix bl)
-          idl bl tyl bv)
-    | GCast (loc,c,k) -> (occur c) || (match k with CastConv t
-      | CastVM t | CastNative t -> occur t | CastCoerce -> false)
-    | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> false
-
-  and occur_pattern (loc,idl,p,c) = not (Id.List.mem id idl) && (occur c)
-
-  and occur_option = function None -> false | Some p -> occur p
-
-  and occur_return_type (na,tyopt) id = not (same_id na id) && occur_option tyopt
-
-  in occur
-
-
-let add_name_to_ids set na =
-  match na with
-    | Anonymous -> set
-    | Name id -> Id.Set.add id set
+  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
+       let f barred acc c = acc || not barred && occur false acc c in
+       fold_glob_constr_with_binders g f barred acc c in
+  occur false false
 
 let free_glob_vars =
-  let rec vars bounded vs = function
-    | GVar (loc,id') -> if Id.Set.mem id' bounded then vs else Id.Set.add id' vs
-    | GApp (loc,f,args) -> List.fold_left (vars bounded) vs (f::args)
-    | GLambda (loc,na,_,ty,c) | GProd (loc,na,_,ty,c) | GLetIn (loc,na,ty,c) ->
-	let vs' = vars bounded vs ty in
-	let bounded' = add_name_to_ids bounded na in
-       vars bounded' vs' c
-    | GCases (loc,sty,rtntypopt,tml,pl) ->
-	let vs1 = vars_option bounded vs rtntypopt in
-	let vs2 = List.fold_left (fun vs (tm,_) -> vars bounded vs tm) vs1 tml in
-	List.fold_left (vars_pattern bounded) vs2 pl
-    | GLetTuple (loc,nal,rtntyp,b,c) ->
-	let vs1 = vars_return_type bounded vs rtntyp in
-	let vs2 = vars bounded vs1 b in
-	let bounded' = List.fold_left add_name_to_ids bounded nal in
-	vars bounded' vs2 c
-    | GIf (loc,c,rtntyp,b1,b2) ->
-	let vs1 = vars_return_type bounded vs rtntyp in
-	let vs2 = vars bounded vs1 c in
-	let vs3 = vars bounded vs2 b1 in
-	vars bounded vs3 b2
-    | GRec (loc,fk,idl,bl,tyl,bv) ->
-	let bounded' = Array.fold_right Id.Set.add idl bounded in
-	let vars_fix i vs fid =
-	  let vs1,bounded1 =
-	    List.fold_left
-	      (fun (vs,bounded) (na,k,bbd,bty) ->
-		 let vs' = vars_option bounded vs bbd in
-		 let vs'' = vars bounded vs' bty in
-		 let bounded' = add_name_to_ids bounded na in
-		 (vs'',bounded')
-	      )
-	      (vs,bounded')
-	      bl.(i)
-	  in
-	  let vs2 = vars bounded1 vs1 tyl.(i) in
-	  vars bounded1 vs2 bv.(i)
-	in
-	Array.fold_left_i vars_fix vs idl
-    | GCast (loc,c,k) -> let v = vars bounded vs c in
-	(match k with CastConv t | CastVM t | CastNative t -> vars bounded v t | _ -> v)
-    | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> vs
-
-  and vars_pattern bounded vs (loc,idl,p,c) =
-    let bounded' = List.fold_right Id.Set.add idl bounded  in
-    vars bounded' vs c
-
-  and vars_option bounded vs = function None -> vs | Some p -> vars bounded vs p
-
-  and vars_return_type bounded vs (na,tyopt) =
-    let bounded' = add_name_to_ids bounded na in
-    vars_option bounded' vs tyopt
-  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
-    | 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;
   Id.Set.add id set
 
 let bound_glob_vars =
-  let rec vars bound = function
-    | GLambda (_,na,_,_,_) | GProd (_,na,_,_,_) | GLetIn (_,na,_,_) as c ->
-        let bound = name_fold add_and_check_ident na bound in
-        fold_glob_constr vars bound c
-    | GCases (loc,sty,rtntypopt,tml,pl) ->
-	let bound = vars_option bound rtntypopt in
-	let bound =
-          List.fold_left (fun bound (tm,_) -> vars bound tm) bound tml in
-	List.fold_left vars_pattern bound pl
-    | GLetTuple (loc,nal,rtntyp,b,c) ->
-	let bound = vars_return_type bound rtntyp in
-	let bound = vars bound b in
-	let bound = List.fold_right (name_fold add_and_check_ident) nal bound in
-	vars bound c
-    | GIf (loc,c,rtntyp,b1,b2) ->
-	let bound = vars_return_type bound rtntyp in
-	let bound = vars bound c in
-	let bound = vars bound b1 in
-	vars bound b2
-    | GRec (loc,fk,idl,bl,tyl,bv) ->
-	let bound = Array.fold_right Id.Set.add idl bound in
-	let vars_fix i bound fid =
-	  let bound =
-	    List.fold_left
-	      (fun bound (na,k,bbd,bty) ->
-		 let bound = vars_option bound bbd in
-		 let bound = vars bound bty in
-		 name_fold add_and_check_ident na bound
-	      )
-	      bound
-	      bl.(i)
-	  in
-	  let bound = vars bound tyl.(i) in
-	  vars bound bv.(i)
-	in
-	Array.fold_left_i vars_fix bound idl
-    | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _ | GVar _) -> bound
-    | GApp _ | GCast _ as c -> fold_glob_constr vars bound c
-
-  and vars_pattern bound (loc,idl,p,c) =
-    let bound = List.fold_right add_and_check_ident idl bound in
-    vars bound c
-
-  and vars_option bound = function None -> bound | Some p -> vars bound p
-
-  and vars_return_type bound (na,tyopt) =
-    let bound = name_fold add_and_check_ident na bound in
-    vars_option bound tyopt
+  let rec vars bound =
+    fold_glob_constr_with_binders
+      (fun id () -> bound := add_and_check_ident id !bound)
+      (fun () () -> vars bound)
+      () ()
   in
   fun rt ->
-    vars Id.Set.empty rt
+    let bound = ref Id.Set.empty in
+    vars bound rt;
+    !bound
 
 (** Mapping of names in binders *)
 
@@ -405,37 +331,38 @@ let bound_glob_vars =
    probably be no significant penalty in doing reallocation as
    pattern-matching expressions are usually rather small. *)
 
-let map_inpattern_binders f ((loc,id,nal) as x) =
+let map_inpattern_binders f ({loc;v=(id,nal)} as x) =
   let r = CList.smartmap f nal in
   if r == nal then x
-  else loc,id,r
+  else CAst.make ?loc (id,r)
 
 let map_tomatch_binders f ((c,(na,inp)) as x) : tomatch_tuple =
   let r = Option.smartmap (fun p -> map_inpattern_binders f p) inp in
   if r == inp then x
   else c,(f na, r)
 
-let rec map_case_pattern_binders f = function
-  | PatVar (loc,na) as x ->
+let rec map_case_pattern_binders f = DAst.map (function
+  | PatVar na as x ->
       let r = f na in
       if r == na then x
-      else PatVar (loc,r)
-  | PatCstr (loc,c,ps,na) as x ->
+      else PatVar r
+  | PatCstr (c,ps,na) as x ->
       let rna = f na in
       let rps =
         CList.smartmap (fun p -> map_case_pattern_binders f p) ps
       in
       if rna == na && rps == ps then x
-      else PatCstr(loc,c,rps,rna)
+      else PatCstr(c,rps,rna)
+  )
 
-let map_cases_branch_binders f ((loc,il,cll,rhs) as x) : cases_clause =
+let map_cases_branch_binders f ({CAst.loc;v=(il,cll,rhs)} as x) : cases_clause =
   (* spiwack: not sure if I must do something with the list of idents.
      It is intended to be a superset of the free variable of the
      right-hand side, if I understand correctly. But I'm not sure when
      or how they are used. *)
   let r = List.smartmap (fun cl -> map_case_pattern_binders f cl) cll in
   if r == cll then x
-  else loc,il,r,rhs
+  else CAst.make ?loc (il,r,rhs)
 
 let map_pattern_binders f tomatch branches =
   CList.smartmap (fun tm -> map_tomatch_binders f tm) tomatch,
@@ -445,41 +372,28 @@ let map_pattern_binders f tomatch branches =
 
 let map_tomatch f (c,pp) : tomatch_tuple = f c , pp
 
-let map_cases_branch f (loc,il,cll,rhs) : cases_clause =
-  loc , il , cll , f rhs
+let map_cases_branch f =
+  CAst.map (fun (il,cll,rhs) -> (il , cll , f rhs))
 
 let map_pattern f tomatch branches =
   List.map (fun tm -> map_tomatch f tm) tomatch,
   List.map (fun br -> map_cases_branch f br) branches
 
-let loc_of_glob_constr = function
-  | GRef (loc,_,_) -> loc
-  | GVar (loc,_) -> loc
-  | GEvar (loc,_,_) -> loc
-  | GPatVar (loc,_) -> loc
-  | GApp (loc,_,_) -> loc
-  | GLambda (loc,_,_,_,_) -> loc
-  | GProd (loc,_,_,_,_) -> loc
-  | GLetIn (loc,_,_,_) -> loc
-  | GCases (loc,_,_,_,_) -> loc
-  | GLetTuple (loc,_,_,_,_) -> loc
-  | GIf (loc,_,_,_,_) -> loc
-  | GRec (loc,_,_,_,_,_) -> loc
-  | GSort (loc,_) -> loc
-  | GHole (loc,_,_,_) -> loc
-  | GCast (loc,_,_) -> loc
+let loc_of_glob_constr c = c.CAst.loc
 
 (**********************************************************************)
 (* Alpha-renaming                                                     *)
 
+exception UnsoundRenaming
+
 let collide_id l id = List.exists (fun (id',id'') -> Id.equal id id' || Id.equal id id'') l
-let test_id l id = if collide_id l id then raise Not_found
-let test_na l na = name_iter (test_id l) na
+let test_id l id = if collide_id l id then raise UnsoundRenaming
+let test_na l na = Name.iter (test_id l) na
 
 let update_subst na l =
   let in_range id l = List.exists (fun (_,id') -> Id.equal id id') l in
-  let l' = name_fold Id.List.remove_assoc na l in
-  name_fold
+  let l' = Name.fold_right Id.List.remove_assoc na l in
+  Name.fold_right
     (fun id _ ->
      if in_range id l' then
        let id' = Namegen.next_ident_away_from id (fun id' -> in_range id' l') in
@@ -487,8 +401,6 @@ let update_subst na l =
      else na,l)
     na (na,l)
 
-exception UnsoundRenaming
-
 let rename_var l id =
   try
     let id' = Id.List.assoc id l in
@@ -499,77 +411,160 @@ 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 = function
-  | GVar (loc,id) as r ->
+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 (loc,id')
-  | GRef (_,VarRef id,_) as r ->
+      if id == id' then r else GVar id'
+  | GRef (VarRef id,_) as r ->
       if List.exists (fun (_,id') -> Id.equal id id') l then raise UnsoundRenaming
       else r
-  | GProd (loc,na,bk,t,c) ->
+  | GProd (na,bk,t,c) ->
       let na',l' = update_subst na l in
-      GProd (loc,na,bk,rename_glob_vars l t,rename_glob_vars l' c)
-  | GLambda (loc,na,bk,t,c) ->
+      GProd (na,bk,rename_glob_vars l t,rename_glob_vars l' c)
+  | GLambda (na,bk,t,c) ->
       let na',l' = update_subst na l in
-      GLambda (loc,na',bk,rename_glob_vars l t,rename_glob_vars l' c)
-  | GLetIn (loc,na,b,c) ->
+      GLambda (na',bk,rename_glob_vars l t,rename_glob_vars l' c)
+  | GLetIn (na,b,t,c) ->
       let na',l' = update_subst na l in
-      GLetIn (loc,na',rename_glob_vars l b,rename_glob_vars l' c)
+      GLetIn (na',rename_glob_vars l b,Option.map (rename_glob_vars l) t,rename_glob_vars l' c)
   (* Lazy strategy: we fail if a collision with renaming occurs, rather than renaming further *)
-  | GCases (loc,ci,po,tomatchl,cls) ->
+  | GCases (ci,po,tomatchl,cls) ->
       let test_pred_pat (na,ino) =
-        test_na l na; Option.iter (fun (_,_,nal) -> List.iter (test_na l) nal) ino in
+        test_na l na; Option.iter (fun {v=(_,nal)} -> List.iter (test_na l) nal) ino in
       let test_clause idl = List.iter (test_id l) idl in
       let po = Option.map (rename_glob_vars l) po in
       let tomatchl = Util.List.map_left (fun (tm,x) -> test_pred_pat x; (rename_glob_vars l tm,x)) tomatchl in
-      let cls = Util.List.map_left (fun (loc,idl,p,c) -> test_clause idl; (loc,idl,p,rename_glob_vars l c)) cls in
-      GCases (loc,ci,po,tomatchl,cls)
-  | GLetTuple (loc,nal,(na,po),c,b) ->
+      let cls = Util.List.map_left (CAst.map (fun (idl,p,c) -> test_clause idl; (idl,p,rename_glob_vars l c))) cls in
+      GCases (ci,po,tomatchl,cls)
+  | GLetTuple (nal,(na,po),c,b) ->
      List.iter (test_na l) (na::nal);
-     GLetTuple (loc,nal,(na,Option.map (rename_glob_vars l) po),
+     GLetTuple (nal,(na,Option.map (rename_glob_vars l) po),
                 rename_glob_vars l c,rename_glob_vars l b)
-  | GIf (loc,c,(na,po),b1,b2) ->
+  | GIf (c,(na,po),b1,b2) ->
      test_na l na;
-     GIf (loc,rename_glob_vars l c,(na,Option.map (rename_glob_vars l) po),
+     GIf (rename_glob_vars l c,(na,Option.map (rename_glob_vars l) po),
           rename_glob_vars l b1,rename_glob_vars l b2)
-  | GRec (loc,k,idl,decls,bs,ts) ->
+  | GRec (k,idl,decls,bs,ts) ->
      Array.iter (test_id l) idl;
-     GRec (loc,k,idl,
+     GRec (k,idl,
            Array.map (List.map (fun (na,k,bbd,bty) ->
              test_na l na; (na,k,Option.map (rename_glob_vars l) bbd,rename_glob_vars l bty))) decls,
            Array.map (rename_glob_vars l) bs,
            Array.map (rename_glob_vars l) ts)
-  | r -> map_glob_constr (rename_glob_vars l) r
+  | _ -> 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 = function
-  | GVar (loc,id) ->
+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 _ ->
       (* Unable to manage the presence of both an alias and a variable *)
       raise Not_found
-    | Anonymous -> PatVar (loc,Name id)
+    | Anonymous -> PatVar (Name id)
+    end
+  | GHole (_,_,_) -> PatVar na
+  | GRef (ConstructRef cstr,_) -> PatCstr (cstr,[],na)
+  | 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
-  | GHole (loc,_,_,_) -> PatVar (loc,na)
-  | GRef (loc,ConstructRef cstr,_) ->
-      PatCstr (loc,cstr,[],na)
-  | GApp (loc,GRef (_,ConstructRef cstr,_),l) ->
-      PatCstr (loc,cstr,List.map (cases_pattern_of_glob_constr Anonymous) l,na)
+  | 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
+  )
+
+open Declarations
+open Term
+open Context
+
+(* Keep only patterns which are not bound to a local definitions *)
+let drop_local_defs typi args =
+    let (decls,_) = decompose_prod_assum typi in
+    let rec aux decls args =
+      match decls, args with
+      | [], [] -> []
+      | Rel.Declaration.LocalDef _ :: decls, pat :: args ->
+         begin
+           match DAst.get pat with
+           | PatVar Anonymous -> aux decls args
+           | _ -> raise Not_found (* The pattern is used, one cannot drop it *)
+         end
+      | Rel.Declaration.LocalAssum _ :: decls, a :: args -> a :: aux decls args
+      | _ -> assert false in
+    aux (List.rev decls) args
+
+let add_patterns_for_params_remove_local_defs (ind,j) l =
+  let (mib,mip) = Global.lookup_inductive ind in
+  let nparams = mib.Declarations.mind_nparams in
+  let l =
+    if mip.mind_consnrealdecls.(j-1) = mip.mind_consnrealargs.(j-1) then
+      (* Optimisation *) l
+    else
+      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 (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 = function
-  | PatCstr (loc,cstr,[],Anonymous) ->
-      GRef (loc,ConstructRef cstr,None)
-  | PatCstr (loc,cstr,l,Anonymous) ->
-      let ref = GRef (loc,ConstructRef cstr,None) in
-      GApp (loc,ref, List.map glob_constr_of_closed_cases_pattern_aux l)
+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
+      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
-  | PatCstr (loc,cstr,l,na) ->
-      na,glob_constr_of_closed_cases_pattern_aux (PatCstr (loc,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 *)
+
+open Pp
+open CErrors
+
+let ltac_interp_name { ltac_idents ; ltac_genargs } = function
+  | Anonymous -> Anonymous
+  | Name id as n ->
+      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()++ Id.print id ++
+                           spc()++str"is not bound to an identifier."++spc()++
+                           str"It cannot be used in a binder.")
+        else n
+
+let empty_lvar : ltac_var_map = {
+  ltac_constrs = Id.Map.empty;
+  ltac_uconstrs = Id.Map.empty;
+  ltac_idents = Id.Map.empty;
+  ltac_genargs = Id.Map.empty;
+}
diff --git a/pretyping/glob_ops.mli b/pretyping/glob_ops.mli
index 55e6b653..124440f5 100644
--- a/pretyping/glob_ops.mli
+++ b/pretyping/glob_ops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -11,21 +13,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
+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.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
@@ -36,13 +42,18 @@ val map_glob_constr_left_to_right :
 
 val warn_variable_collision : ?loc:Loc.t -> Id.t -> unit
 
+val mk_glob_constr_eq : (glob_constr -> glob_constr -> bool) ->
+  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
-val loc_of_glob_constr : glob_constr -> Loc.t
-val glob_visible_short_qualid : glob_constr -> Id.t list
+(* Obsolete *)
+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
@@ -52,14 +63,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
@@ -73,6 +84,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
+
+(** 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 -> 'a cases_pattern_g list -> 'a cases_pattern_g list
 
-val glob_constr_of_closed_cases_pattern : cases_pattern -> Name.t * glob_constr
+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 39aeb41f..3143f8a5 100644
--- a/pretyping/indrec.ml
+++ b/pretyping/indrec.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File initially created by Christine Paulin, 1996 *)
@@ -18,6 +20,7 @@ open Libnames
 open Globnames
 open Nameops
 open Term
+open Constr
 open Vars
 open Namegen
 open Declarations
@@ -27,19 +30,30 @@ open Inductiveops
 open Environ
 open Reductionops
 open Nametab
-open Sigma.Notations
 open Context.Rel.Declaration
 
 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
 
 exception RecursionSchemeError of recursion_scheme_error
 
+let named_hd env t na = named_hd env Evd.empty (EConstr.of_constr t) na
+let name_assumption env = function
+| LocalAssum (na,t) -> LocalAssum (named_hd env t na, t)
+| LocalDef (na,c,t) -> LocalDef (named_hd env c na, c, t)
+
+let mkLambda_or_LetIn_name env d b = mkLambda_or_LetIn (name_assumption env d) b
+let mkProd_or_LetIn_name env d b = mkProd_or_LetIn (name_assumption env d) b
+let mkLambda_name env (n,a,b) = mkLambda_or_LetIn_name env (LocalAssum (n,a)) b
+let mkProd_name env (n,a,b) = mkProd_or_LetIn_name env (LocalAssum (n,a)) b
+let it_mkProd_or_LetIn_name env b l = List.fold_left (fun c d -> mkProd_or_LetIn_name env d c) b l
+let it_mkLambda_or_LetIn_name env b l = List.fold_left (fun c d -> mkLambda_or_LetIn_name env d c) b l
+
 let make_prod_dep dep env = if dep then mkProd_name env else mkProd
 let mkLambda_string s t c = mkLambda (Name (Id.of_string s), t, c)
 
@@ -55,7 +69,7 @@ let is_private mib =
 
 let check_privacy_block mib =
   if is_private mib then
-    errorlabstrm ""(str"case analysis on a private inductive type")
+    user_err (str"case analysis on a private inductive type")
       
 (**********************************************************************)
 (* Building case analysis schemes *)
@@ -63,7 +77,7 @@ let check_privacy_block mib =
 
 let mis_make_case_com dep env sigma (ind, u as pind) (mib,mip as specif) kind =
   let lnamespar = Vars.subst_instance_context u mib.mind_params_ctxt in
-  let indf = make_ind_family(pind, Context.Rel.to_extended_list 0 lnamespar) in
+  let indf = make_ind_family(pind, Context.Rel.to_extended_list mkRel 0 lnamespar) in
   let constrs = get_constructors env indf in
   let projs = get_projections env indf in
 
@@ -93,8 +107,8 @@ let mis_make_case_com dep env sigma (ind, u as pind) (mib,mip as specif) kind =
       let pbody =
         appvect
           (mkRel (ndepar + nbprod),
-           if dep then Context.Rel.to_extended_vect 0 deparsign
-           else Context.Rel.to_extended_vect 1 arsign) in
+           if dep then Context.Rel.to_extended_vect mkRel 0 deparsign
+           else Context.Rel.to_extended_vect mkRel 1 arsign) in
       let p =
 	it_mkLambda_or_LetIn_name env'
 	  ((if dep then mkLambda_name env' else mkLambda)
@@ -118,18 +132,19 @@ let mis_make_case_com dep env sigma (ind, u as pind) (mib,mip as specif) kind =
 	it_mkLambda_or_LetIn_name env' obj deparsign
     else
       let cs = lift_constructor (k+1) constrs.(k) in
-      let t = build_branch_type env dep (mkRel (k+1)) cs in
+      let t = build_branch_type env sigma dep (mkRel (k+1)) cs in
       mkLambda_string "f" t
 	(add_branch (push_rel (LocalAssum (Anonymous, t)) env) (k+1))
   in
-  let Sigma (s, sigma, p) = Sigma.fresh_sort_in_family ~rigid:Evd.univ_flexible_alg env sigma kind in
-  let typP = make_arity env' dep indf s in
+  let (sigma, s) = Evd.fresh_sort_in_family ~rigid:Evd.univ_flexible_alg env sigma kind in
+  let typP = make_arity env' sigma dep indf s in
+  let typP = EConstr.Unsafe.to_constr typP in
   let c = 
     it_mkLambda_or_LetIn_name env
     (mkLambda_string "P" typP
      (add_branch (push_rel (LocalAssum (Anonymous,typP)) env') 0)) lnamespar
   in
-  Sigma (c, sigma, p)
+  (sigma, c)
 
 (* check if the type depends recursively on one of the inductive scheme *)
 
@@ -153,8 +168,10 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
   let nparams = List.length vargs in
   let process_pos env depK pk =
     let rec prec env i sign p =
-      let p',largs = whd_allnolet_stack env sigma p in
-      match kind_of_term p' with
+      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 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)
@@ -166,18 +183,19 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
 	    let base = applist (lift i pk,realargs) in
             if depK then
 	      Reduction.beta_appvect
-                base [|applist (mkRel (i+1), Context.Rel.to_extended_list 0 sign)|]
+                base [|applist (mkRel (i+1), Context.Rel.to_extended_list mkRel 0 sign)|]
             else
 	      base
       	| _ ->
-	   let t' = whd_all env sigma p in
-	   if Term.eq_constr p' t' then assert false
+	   let t' = whd_all env sigma (EConstr.of_constr p) in
+	   let t' = EConstr.Unsafe.to_constr t' in
+	   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
@@ -229,8 +247,10 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
 let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
   let process_pos env fk  =
     let rec prec env i hyps p =
-      let p',largs = whd_allnolet_stack env sigma p in
-      match kind_of_term p' with
+      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 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)
@@ -239,11 +259,12 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
 	    mkLetIn (n,b,t,prec (push_rel d env) (i+1) (d::hyps) c)
      	| Ind _ ->
             let realargs = List.skipn nparrec largs
-            and arg = appvect (mkRel (i+1), Context.Rel.to_extended_vect 0 hyps) in
+            and arg = appvect (mkRel (i+1), Context.Rel.to_extended_vect mkRel 0 hyps) in
             applist(lift i fk,realargs@[arg])
      	| _ ->
-	   let t' = whd_all env sigma p in
-	     if Term.eq_constr t' p' then assert false
+	   let t' = whd_all env sigma (EConstr.of_constr p) in
+	   let t' = EConstr.Unsafe.to_constr t' in
+	     if Constr.equal t' p' then assert false
 	     else prec env i hyps t'
     in
     prec env 0 []
@@ -261,7 +282,7 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
            | None ->
 	       mkLambda_name env
 		 (n,t,process_constr (push_rel d env) (i+1)
-		    (whd_beta Evd.empty (applist (lift 1 f, [(mkRel 1)])))
+		    (EConstr.Unsafe.to_constr (whd_beta Evd.empty (EConstr.of_constr (applist (lift 1 f, [(mkRel 1)])))))
 		    (cprest,rest))
            | Some(_,f_0) ->
 	       let nF = lift (i+1+decF) f_0 in
@@ -269,7 +290,7 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
 	       let arg = process_pos env' nF (lift 1 t) in
                mkLambda_name env
 		 (n,t,process_constr env' (i+1)
-		    (whd_beta Evd.empty (applist (lift 1 f, [(mkRel 1); arg])))
+		    (EConstr.Unsafe.to_constr (whd_beta Evd.empty (EConstr.of_constr (applist (lift 1 f, [(mkRel 1); arg])))))
 		    (cprest,rest)))
     | (LocalDef (n,c,t) as d)::cprest, rest ->
 	mkLetIn
@@ -277,13 +298,13 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
 	   process_constr (push_rel d env) (i+1) (lift 1 f)
 	     (cprest,rest))
     | [],[] -> f
-    | _,[] | [],_ -> anomaly (Pp.str "process_constr")
+    | _,[] | [],_ -> anomaly (Pp.str "process_constr.")
 
   in
   process_constr env 0 f (List.rev cstr.cs_args, recargs)
 
 (* Main function *)
-let mis_make_indrec env sigma listdepkind mib u =
+let mis_make_indrec env sigma ?(force_mutual=false) listdepkind mib u =
   let nparams = mib.mind_nparams in
   let nparrec = mib.mind_nparams_rec in
   let evdref = ref sigma in
@@ -317,7 +338,7 @@ let mis_make_indrec env sigma listdepkind mib u =
 
             (* arity in the context of the fixpoint, i.e.
                P1..P_nrec f1..f_nbconstruct *)
-	    let args = Context.Rel.to_extended_list (nrec+nbconstruct) lnamesparrec in
+	    let args = Context.Rel.to_extended_list mkRel (nrec+nbconstruct) lnamesparrec in
 	    let indf = make_ind_family((indi,u),args) in
 
 	    let arsign,_ = get_arity env indf in
@@ -331,15 +352,15 @@ let mis_make_indrec env sigma listdepkind mib u =
 
             (* constructors in context of the Cases expr, i.e.
                P1..P_nrec f1..f_nbconstruct F_1..F_nrec a_1..a_nar x:I *)
-	    let args' = Context.Rel.to_extended_list (dect+nrec) lnamesparrec in
-	    let args'' = Context.Rel.to_extended_list ndepar lnonparrec in
+	    let args' = Context.Rel.to_extended_list mkRel (dect+nrec) lnamesparrec in
+	    let args'' = Context.Rel.to_extended_list mkRel ndepar lnonparrec in
             let indf' = make_ind_family((indi,u),args'@args'') in
 
 	    let branches =
 	      let constrs = get_constructors env indf' in
 	      let fi = Termops.rel_vect (dect-i-nctyi) nctyi in
 	      let vecfi = Array.map
-		(fun f -> appvect (f, Context.Rel.to_extended_vect ndepar lnonparrec))
+		(fun f -> appvect (f, Context.Rel.to_extended_vect mkRel ndepar lnonparrec))
 		fi
 	      in
 		Array.map3
@@ -360,9 +381,9 @@ let mis_make_indrec env sigma listdepkind mib u =
 	    let deparsign' = LocalAssum (Anonymous,depind')::arsign' in
 
 	    let pargs =
-	      let nrpar = Context.Rel.to_extended_list (2*ndepar) lnonparrec
-	      and nrar = if dep then Context.Rel.to_extended_list 0 deparsign'
-		else Context.Rel.to_extended_list 1 arsign'
+	      let nrpar = Context.Rel.to_extended_list mkRel (2*ndepar) lnonparrec
+	      and nrar = if dep then Context.Rel.to_extended_list mkRel 0 deparsign'
+		else Context.Rel.to_extended_list mkRel 1 arsign'
 	      in nrpar@nrar
 
 	    in
@@ -378,9 +399,10 @@ let mis_make_indrec env sigma listdepkind mib u =
 		  arsign'
 	      in
 	      let obj =
-		Inductiveops.make_case_or_project env indf ci pred
-						  (mkRel 1) branches
+		Inductiveops.make_case_or_project env !evdref indf ci (EConstr.of_constr pred)
+						  (EConstr.mkRel 1) (Array.map EConstr.of_constr branches)
 	      in
+	      let obj = EConstr.to_constr !evdref obj in
 		it_mkLambda_or_LetIn_name env obj
 		  (Termops.lift_rel_context nrec deparsign)
 	    in
@@ -389,8 +411,8 @@ let mis_make_indrec env sigma listdepkind mib u =
 
 	    let typtyi =
 	      let concl =
-		let pargs = if dep then Context.Rel.to_extended_vect 0 deparsign
-		  else Context.Rel.to_extended_vect 1 arsign
+		let pargs = if dep then Context.Rel.to_extended_vect mkRel 0 deparsign
+		  else Context.Rel.to_extended_vect mkRel 1 arsign
 		in appvect (mkRel (nbconstruct+ndepar+nonrecpar+j),pargs)
 	      in it_mkProd_or_LetIn_name env
 		concl
@@ -417,7 +439,7 @@ let mis_make_indrec env sigma listdepkind mib u =
 	    else
 	      let recarg = (dest_subterms recargsvec.(tyi)).(j) in
 	      let recarg = recargpar@recarg in
-	      let vargs = Context.Rel.to_extended_list (nrec+i+j) lnamesparrec in
+	      let vargs = Context.Rel.to_extended_list mkRel (nrec+i+j) lnamesparrec in
 	      let cs = get_constructor ((indi,u),mibi,mipi,vargs) (j+1) in
 	      let p_0 =
 		type_rec_branch
@@ -431,12 +453,13 @@ let mis_make_indrec env sigma listdepkind mib u =
     in
     let rec put_arity env i = function
       | ((indi,u),_,_,dep,kinds)::rest ->
-	  let indf = make_ind_family ((indi,u), Context.Rel.to_extended_list i lnamesparrec) in
+	  let indf = make_ind_family ((indi,u), Context.Rel.to_extended_list mkRel i lnamesparrec) in
 	  let s = 
 	    Evarutil.evd_comb1 (Evd.fresh_sort_in_family ~rigid:Evd.univ_flexible_alg env) 
 	      evdref kinds 
 	  in
-	  let typP = make_arity env dep indf s in
+	  let typP = make_arity env !evdref dep indf s in
+	  let typP = EConstr.Unsafe.to_constr typP in
 	    mkLambda_string "P" typP
 	      (put_arity (push_rel (LocalAssum (Anonymous,typP)) env) (i+1) rest)
       | [] ->
@@ -446,7 +469,7 @@ let mis_make_indrec env sigma listdepkind mib u =
     (* Body on make_one_rec *)
     let ((indi,u),mibi,mipi,dep,kind) = List.nth listdepkind p in
 
-      if (mis_is_recursive_subset
+      if force_mutual || (mis_is_recursive_subset
 	(List.map (fun ((indi,u),_,_,_,_) -> snd indi) listdepkind)
 	mipi.mind_recargs)
       then
@@ -454,10 +477,9 @@ let mis_make_indrec env sigma listdepkind mib u =
 	  it_mkLambda_or_LetIn_name env (put_arity env' 0 listdepkind)
 	    lnamesparrec
       else
-        let sigma = Sigma.Unsafe.of_evar_map !evdref in
-        let Sigma (c, sigma, _) = mis_make_case_com dep env sigma (indi,u) (mibi,mipi) kind in
-        let evd' = Sigma.to_evar_map sigma in
-	  evdref := evd'; c
+        let evd = !evdref in
+        let (evd, c) = mis_make_case_com dep env evd (indi,u) (mibi,mipi) kind in
+	  evdref := evd; c
   in
     (* Body of mis_make_indrec *)
     !evdref, List.init nrec make_one_rec
@@ -486,7 +508,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')
@@ -500,7 +522,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
@@ -512,7 +534,7 @@ let weaken_sort_scheme env evd set sort npars term ty =
 	    mkProd (n, t, c'), mkLambda (n, t, term')
       | LetIn (n,b,t,c) -> let c',term' = drec np c in
            mkLetIn (n,b,t,c'), mkLetIn (n,b,t,term')
-      | _ -> anomaly ~label:"weaken_sort_scheme" (Pp.str "wrong elimination type")
+      | _ -> anomaly ~label:"weaken_sort_scheme" (Pp.str "wrong elimination type.")
   in
   let ty, term = drec npars ty in
     !evdref, ty, term
@@ -536,7 +558,7 @@ let check_arities env listdepkind =
 	    [] listdepkind
   in true
 
-let build_mutual_induction_scheme env sigma = function
+let build_mutual_induction_scheme env sigma ?(force_mutual=false) = function
   | ((mind,u),dep,s)::lrecspec ->
       let (mib,mip) = lookup_mind_specif env mind in
       if dep && not (Inductiveops.has_dependent_elim mib) then
@@ -547,7 +569,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
@@ -555,8 +577,8 @@ let build_mutual_induction_scheme env sigma = function
 	   lrecspec)
       in
       let _ = check_arities env listdepkind in
-      mis_make_indrec env sigma listdepkind mib u
-  | _ -> anomaly (Pp.str "build_induction_scheme expects a non empty list of inductive types")
+      mis_make_indrec env sigma ~force_mutual listdepkind mib u
+  | _ -> anomaly (Pp.str "build_induction_scheme expects a non empty list of inductive types.")
 
 let build_induction_scheme env sigma pind dep kind =
   let (mib,mip) = lookup_mind_specif env (fst pind) in
@@ -586,7 +608,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 ->
@@ -594,9 +616,9 @@ let lookup_eliminator ind_sp s =
   (* using short name (e.g. for "eq_rec") *)
   try Nametab.locate (qualid_of_ident id)
   with Not_found ->
-    errorlabstrm "default_elim"
+    user_err ~hdr:"default_elim"
       (strbrk "Cannot find the elimination combinator " ++
-       pr_id id ++ strbrk ", the elimination of the inductive definition " ++
+       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 192b64a5..7a68443b 100644
--- a/pretyping/indrec.mli
+++ b/pretyping/indrec.mli
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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
 
@@ -26,26 +28,27 @@ type dep_flag = bool
 
 (** Build a case analysis elimination scheme in some sort family *)
 
-val build_case_analysis_scheme : env -> 'r Sigma.t -> pinductive ->
-      dep_flag -> sorts_family -> (constr, 'r) Sigma.sigma
+val build_case_analysis_scheme : env -> Evd.evar_map -> pinductive ->
+      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 -> 'r Sigma.t -> pinductive ->
-      sorts_family -> (constr, 'r) Sigma.sigma
+val build_case_analysis_scheme_default : env -> evar_map -> pinductive ->
+      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 -> ?force_mutual:bool ->
+  (pinductive * dep_flag * Sorts.family) list -> evar_map * constr list
 
 (** Scheme combinators *)
 
@@ -54,13 +57,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 214e19fe..97aa82e4 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -11,6 +13,7 @@ open Util
 open Names
 open Univ
 open Term
+open Constr
 open Vars
 open Termops
 open Declarations
@@ -24,14 +27,14 @@ open Context.Rel.Declaration
 
 let type_of_inductive env (ind,u) =
  let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
- Typeops.check_hyps_inclusion env (mkInd ind) mib.mind_hyps;
+ Typeops.check_hyps_inclusion env mkInd ind mib.mind_hyps;
  Inductive.type_of_inductive env (specif,u)
 
 (* Return type as quoted by the user *)
 let type_of_constructor env (cstr,u) =
  let (mib,_ as specif) =
    Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
- Typeops.check_hyps_inclusion env (mkConstruct cstr) mib.mind_hyps;
+ Typeops.check_hyps_inclusion env mkConstruct cstr mib.mind_hyps;
  Inductive.type_of_constructor (cstr,u) specif
 
 (* Return constructor types in user form *)
@@ -58,21 +61,24 @@ let lift_inductive_family n = liftn_inductive_family n 1
 let substnl_ind_family l n = map_ind_family (substnl l n)
 
 
-type inductive_type = IndType of inductive_family * constr list
+type inductive_type = IndType of inductive_family * EConstr.constr list
 
 let make_ind_type (indf, realargs) = IndType (indf,realargs)
 let dest_ind_type (IndType (indf,realargs)) = (indf,realargs)
 
 let map_inductive_type f (IndType (indf, realargs)) =
-  IndType (map_ind_family f indf, List.map f realargs)
+  let f' c = EConstr.Unsafe.to_constr (f (EConstr.of_constr c)) in
+  IndType (map_ind_family f' indf, List.map f realargs)
 
-let liftn_inductive_type n d = map_inductive_type (liftn n d)
+let liftn_inductive_type n d = map_inductive_type (EConstr.Vars.liftn n d)
 let lift_inductive_type n = liftn_inductive_type n 1
 
-let substnl_ind_type l n = map_inductive_type (substnl l n)
+let substnl_ind_type l n = map_inductive_type (EConstr.Vars.substnl l n)
 
 let mkAppliedInd (IndType ((ind,params), realargs)) =
-  applist (mkIndU ind,params@realargs)
+  let open EConstr in
+  let ind = on_snd EInstance.make ind in
+  applist (mkIndU ind, (List.map EConstr.of_constr params)@realargs)
 
 (* Does not consider imbricated or mutually recursive types *)
 let mis_is_recursive_subset listind rarg =
@@ -80,7 +86,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)
@@ -94,7 +100,7 @@ let mis_nf_constructor_type ((ind,u),mib,mip) j =
   and ntypes = mib.mind_ntypes
   and nconstr = Array.length mip.mind_consnames in
   let make_Ik k = mkIndU (((fst ind),ntypes-k-1),u) in
-  if j > nconstr then error "Not enough constructors in the type.";
+  if j > nconstr then user_err Pp.(str "Not enough constructors in the type.");
     substl (List.init ntypes make_Ik) (subst_instance_constr u specif.(j-1))
 
 (* Number of constructors *)
@@ -271,7 +277,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 *)
@@ -343,34 +349,35 @@ let get_projections env (ind,params) =
     | Some (Some (id, projs, pbs)) -> Some projs
     | _ -> None
 
-let make_case_or_project env indf ci pred c branches =
+let make_case_or_project env sigma indf ci pred c branches =
+  let open EConstr in
   let projs = get_projections env indf in
   match projs with
   | None -> (mkCase (ci, pred, c, branches))
   | Some ps ->
      assert(Array.length branches == 1);
      let () =
-       let _, _, t = destLambda pred in
+       let _, _, t = destLambda sigma pred in
        let (ind, _), _ = dest_ind_family indf in
        let mib, _ = Inductive.lookup_mind_specif env ind in
-       if (* dependent *) not (noccurn 1 t) &&
+       if (* dependent *) not (Vars.noccurn sigma 1 t) &&
           not (has_dependent_elim mib) then
-       errorlabstrm "make_case_or_project"
-		    Pp.(str"Dependent case analysis not allowed" ++
-		     str" on inductive type " ++ Names.MutInd.print (fst ind))
+       user_err ~hdr:"make_case_or_project"
+                    Pp.(str"Dependent case analysis not allowed" ++
+                     str" on inductive type " ++ Names.MutInd.print (fst ind))
      in
      let branch = branches.(0) in
-     let ctx, br = decompose_lam_n_assum (Array.length ps) branch in
+     let 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, substl subst b :: subst))
-	 ctx (0, [])
-     in substl subst br
+          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 *)
 
@@ -393,8 +400,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
@@ -408,51 +415,55 @@ let build_dependent_constructor cs =
   applist
     (mkConstructU cs.cs_cstr,
      (List.map (lift cs.cs_nargs) cs.cs_params)
-      @(Context.Rel.to_extended_list 0 cs.cs_args))
+      @(Context.Rel.to_extended_list mkRel 0 cs.cs_args))
 
 let build_dependent_inductive env ((ind, params) as indf) =
   let arsign,_ = get_arity env indf in
   let nrealargs = List.length arsign in
   applist
     (mkIndU ind,
-     (List.map (lift nrealargs) params)@(Context.Rel.to_extended_list 0 arsign))
+     (List.map (lift nrealargs) params)@(Context.Rel.to_extended_list mkRel 0 arsign))
 
 (* builds the arity of an elimination predicate in sort [s] *)
 
-let make_arity_signature env dep indf =
+let make_arity_signature env sigma dep indf =
   let (arsign,_) = get_arity env indf in
+  let arsign = List.map (fun d -> Termops.map_rel_decl EConstr.of_constr d) arsign in
   if dep then
     (* We need names everywhere *)
-    Namegen.name_context env
-      ((LocalAssum (Anonymous,build_dependent_inductive env indf))::arsign)
+    Namegen.name_context env sigma
+      ((LocalAssum (Anonymous,EConstr.of_constr (build_dependent_inductive env indf)))::arsign)
       (* Costly: would be better to name once for all at definition time *)
   else
     (* No need to enforce names *)
     arsign
 
-let make_arity env dep indf s = mkArity (make_arity_signature env dep indf, s)
+let make_arity env sigma dep indf s =
+  let open EConstr in
+  it_mkProd_or_LetIn (mkSort s) (make_arity_signature env sigma dep indf)
 
 (* [p] is the predicate and [cs] a constructor summary *)
-let build_branch_type env dep p cs =
+let build_branch_type env sigma dep p cs =
   let base = appvect (lift cs.cs_nargs p, cs.cs_concl_realargs) in
   if dep then
-    Namegen.it_mkProd_or_LetIn_name env
-      (applist (base,[build_dependent_constructor cs]))
-      cs.cs_args
+    EConstr.Unsafe.to_constr (Namegen.it_mkProd_or_LetIn_name env sigma
+      (EConstr.of_constr (applist (base,[build_dependent_constructor cs])))
+      (List.map (fun d -> Termops.map_rel_decl EConstr.of_constr d) cs.cs_args))
   else
-    it_mkProd_or_LetIn base cs.cs_args
+    Term.it_mkProd_or_LetIn base cs.cs_args
 
 (**************************************************)
 
-let extract_mrectype t =
-  let (t, l) = decompose_app t in
-  match kind_of_term t with
+let extract_mrectype sigma t =
+  let open EConstr in
+  let (t, l) = decompose_app sigma t in
+  match EConstr.kind sigma t with
     | Ind ind -> (ind, l)
     | _ -> raise Not_found
 
 let find_mrectype_vect env sigma c =
-  let (t, l) = decompose_appvect (whd_all env sigma c) in
-  match kind_of_term t with
+  let (t, l) = Termops.decompose_app_vect sigma (whd_all env sigma c) in
+  match EConstr.kind sigma t with
     | Ind ind -> (ind, l)
     | _ -> raise Not_found
 
@@ -460,28 +471,35 @@ let find_mrectype env sigma c =
   let (ind, v) = find_mrectype_vect env sigma c in (ind, Array.to_list v)
 
 let find_rectype env sigma c =
-  let (t, l) = decompose_app (whd_all env sigma c) in
-  match kind_of_term t with
-    | Ind (ind,u as indu) ->
+  let open EConstr in
+  let (t, l) = decompose_app sigma (whd_all env sigma c) in
+  match EConstr.kind sigma t with
+    | Ind (ind,u) ->
         let (mib,mip) = Inductive.lookup_mind_specif env ind in
         if mib.mind_nparams > List.length l then raise Not_found;
+        let l = List.map EConstr.Unsafe.to_constr l in
         let (par,rargs) = List.chop mib.mind_nparams l in
-        IndType((indu, par),rargs)
+        let indu = (ind, EInstance.kind sigma u) in
+        IndType((indu, par),List.map EConstr.of_constr rargs)
     | _ -> raise Not_found
 
 let find_inductive env sigma c =
-  let (t, l) = decompose_app (whd_all env sigma c) in
-  match kind_of_term t with
+  let open EConstr in
+  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
 
 let find_coinductive env sigma c =
-  let (t, l) = decompose_app (whd_all env sigma c) in
-  match kind_of_term t with
+  let open EConstr in
+  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
 
@@ -490,32 +508,32 @@ let find_coinductive env sigma c =
 (* find appropriate names for pattern variables. Useful in the Case
    and Inversion (case_then_using et case_nodep_then_using) tactics. *)
 
-let is_predicate_explicitly_dep env pred arsign =
+let is_predicate_explicitly_dep env sigma pred arsign =
   let rec srec env pval arsign =
-    let pv' = whd_all env Evd.empty pval in
-    match kind_of_term pv', arsign with
+    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).
-
-          From Coq > 8.2, using or not the the effective dependency of
+          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 effective dependency of
           the predicate is parametrable! *)
 
           begin match na with
@@ -523,19 +541,20 @@ let is_predicate_explicitly_dep env pred arsign =
           | Name _ -> true
           end
 
-      | _ -> anomaly (Pp.str "Non eta-expanded dep-expanded \"match\" predicate")
+      | _ -> anomaly (Pp.str "Non eta-expanded dep-expanded \"match\" predicate.")
   in
-  srec env pred arsign
+  srec env (EConstr.of_constr pred) arsign
 
-let is_elim_predicate_explicitly_dependent env pred indf =
+let is_elim_predicate_explicitly_dependent env sigma pred indf =
   let arsign,_ = get_arity env indf in
-  is_predicate_explicitly_dep env pred arsign
+  is_predicate_explicitly_dep env sigma pred arsign
 
-let set_names env n brty =
-  let (ctxt,cl) = decompose_prod_n_assum n brty in
-  Namegen.it_mkProd_or_LetIn_name env cl ctxt
+let set_names env sigma n brty =
+  let open EConstr in
+  let (ctxt,cl) = decompose_prod_n_assum sigma n brty in
+  EConstr.Unsafe.to_constr (Namegen.it_mkProd_or_LetIn_name env sigma cl ctxt)
 
-let set_pattern_names env ind brv =
+let set_pattern_names env sigma ind brv =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
   let arities =
     Array.map
@@ -543,10 +562,11 @@ let set_pattern_names env ind brv =
         Context.Rel.length ((prod_assum c)) -
         mib.mind_nparams)
       mip.mind_nf_lc in
-  Array.map2 (set_names env) arities brv
+  Array.map2 (set_names env sigma) arities brv
 
-let type_case_branches_with_names env indspec p c =
+let type_case_branches_with_names env sigma indspec p c =
   let (ind,args) = indspec in
+  let args = List.map EConstr.Unsafe.to_constr args in
   let (mib,mip as specif) = Inductive.lookup_mind_specif env (fst ind) in
   let nparams = mib.mind_nparams in
   let (params,realargs) = List.chop nparams args in
@@ -554,8 +574,8 @@ let type_case_branches_with_names env indspec p c =
   (* Build case type *)
   let conclty = lambda_appvect_assum (mip.mind_nrealdecls+1) p (Array.of_list (realargs@[c])) in
   (* Adjust names *)
-  if is_elim_predicate_explicitly_dependent env p (ind,params) then
-    (set_pattern_names env (fst ind) lbrty, conclty)
+  if is_elim_predicate_explicitly_dependent env sigma p (ind,params) then
+    (set_pattern_names env sigma (fst ind) (Array.map EConstr.of_constr lbrty), conclty)
   else (lbrty, conclty)
 
 (* Type of Case predicates *)
@@ -563,7 +583,7 @@ let arity_of_case_predicate env (ind,params) dep k =
   let arsign,_ = get_arity env (ind,params) in
   let mind = build_dependent_inductive env (ind,params) in
   let concl = if dep then mkArrow mind (mkSort k) else mkSort k in
-  it_mkProd_or_LetIn concl arsign
+  Term.it_mkProd_or_LetIn concl arsign
 
 (***********************************************)
 (* Inferring the sort of parameters of a polymorphic inductive type
@@ -582,15 +602,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 *)
@@ -598,24 +618,26 @@ let rec instantiate_universes env evdref scl is = function
 
 let type_of_inductive_knowing_conclusion env sigma ((mib,mip),u) conclty =
   match mip.mind_arity with
-  | RegularArity s -> sigma, subst_instance_constr u s.mind_user_arity
+  | RegularArity s -> sigma, EConstr.of_constr (subst_instance_constr u s.mind_user_arity)
   | TemplateArity ar ->
-    let _,scl = Reduction.dest_arity env conclty in
+    let _,scl = splay_arity env sigma conclty in
+    let scl = EConstr.ESorts.kind sigma scl in
     let ctx = List.rev mip.mind_arity_ctxt in
     let evdref = ref sigma in
     let ctx =
       instantiate_universes
         env evdref scl ar.template_level (ctx,ar.template_param_levels) in
-      !evdref, mkArity (List.rev ctx,scl)
+      !evdref, EConstr.of_constr (mkArity (List.rev ctx,scl))
 
 let type_of_projection_knowing_arg env sigma p c ty =
+  let c = EConstr.Unsafe.to_constr c in
   let IndType(pars,realargs) =
     try find_rectype env sigma ty
     with Not_found ->
       raise (Invalid_argument "type_of_projection_knowing_arg_type: not an inductive type")
   in
   let (_,u), pars = dest_ind_family pars in
-  substl (c :: List.rev pars) (Typeops.type_of_projection env (p,u))
+  substl (c :: List.rev pars) (Typeops.type_of_projection_constant env (p,u))
 
 (***********************************************)
 (* Guard condition *)
@@ -623,8 +645,9 @@ let type_of_projection_knowing_arg env sigma p c ty =
 (* A function which checks that a term well typed verifies both
    syntactic conditions *)
 
-let control_only_guard env c =
-  let check_fix_cofix e c = match kind_of_term c with
+let control_only_guard env sigma c =
+  let check_fix_cofix e c =
+    match kind (EConstr.to_constr sigma c) with
     | CoFix (_,(_,_,_) as cofix) ->
       Inductive.check_cofix e cofix
     | Fix (_,(_,_,_) as fix) ->
@@ -633,6 +656,6 @@ let control_only_guard env c =
   in
   let rec iter env c =
     check_fix_cofix env c;
-    iter_constr_with_full_binders push_rel iter env c
+    iter_constr_with_full_binders sigma EConstr.push_rel iter env c
   in
   iter env c
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index 7bd61659..b0d714b0 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Declarations
 open Environ
 open Evd
@@ -28,8 +30,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
@@ -37,15 +39,15 @@ val substnl_ind_family :
   constr list -> int -> inductive_family -> inductive_family
 
 (** An inductive type with its parameters and real arguments *)
-type inductive_type = IndType of inductive_family * constr list
-val make_ind_type : inductive_family * constr list -> inductive_type
-val dest_ind_type : inductive_type -> inductive_family * constr list
-val map_inductive_type : (constr -> constr) -> inductive_type -> inductive_type
+type inductive_type = IndType of inductive_family * EConstr.constr list
+val make_ind_type : inductive_family * EConstr.constr list -> inductive_type
+val dest_ind_type : inductive_type -> inductive_family * EConstr.constr list
+val map_inductive_type : (EConstr.constr -> EConstr.constr) -> inductive_type -> inductive_type
 val liftn_inductive_type : int -> int -> inductive_type -> inductive_type
 val lift_inductive_type  : int -> inductive_type -> inductive_type
-val substnl_ind_type : constr list -> int -> inductive_type -> inductive_type
+val substnl_ind_type : EConstr.constr list -> int -> inductive_type -> inductive_type
 
-val mkAppliedInd : inductive_type -> constr
+val mkAppliedInd : inductive_type -> EConstr.constr
 val mis_is_recursive_subset : int list -> wf_paths -> bool
 val mis_is_recursive :
   inductive * mutual_inductive_body * one_inductive_body -> bool
@@ -120,17 +122,17 @@ 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. *)
 val has_dependent_elim : mutual_inductive_body -> bool
 
 (** Primitive projections *)
-val projection_nparams : projection -> int
-val projection_nparams_env : env -> projection -> int
+val projection_nparams : Projection.t -> int
+val projection_nparams_env : env -> Projection.t -> int
 val type_of_projection_knowing_arg : env -> evar_map -> Projection.t ->
-				     constr -> types -> types
+				     EConstr.t -> EConstr.types -> types
 
 
 (** Extract information from an inductive family *)
@@ -147,35 +149,35 @@ 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 -> bool -> inductive_family -> Context.Rel.t
-val make_arity : env -> bool -> inductive_family -> sorts -> types
-val build_branch_type : env -> bool -> constr -> constructor_summary -> types
+val make_arity_signature : env -> evar_map -> bool -> inductive_family -> EConstr.rel_context
+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 *)
-val extract_mrectype : constr -> pinductive * constr list
-val find_mrectype    : env -> evar_map -> types -> pinductive * constr list
-val find_mrectype_vect : env -> evar_map -> types -> pinductive * constr array
-val find_rectype     : env -> evar_map -> types -> inductive_type
-val find_inductive   : env -> evar_map -> types -> pinductive * constr list
-val find_coinductive : env -> evar_map -> types -> pinductive * constr list
+val extract_mrectype : evar_map -> EConstr.t -> (inductive * EConstr.EInstance.t) * EConstr.constr list
+val find_mrectype    : env -> evar_map -> EConstr.types -> (inductive * EConstr.EInstance.t) * EConstr.constr list
+val find_mrectype_vect : env -> evar_map -> EConstr.types -> (inductive * EConstr.EInstance.t) * EConstr.constr array
+val find_rectype     : env -> evar_map -> EConstr.types -> inductive_type
+val find_inductive   : env -> evar_map -> EConstr.types -> (inductive * EConstr.EInstance.t) * constr list
+val find_coinductive : env -> evar_map -> EConstr.types -> (inductive * EConstr.EInstance.t) * constr list
 
 (********************)
 
 (** 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 -> pinductive * constr list -> constr -> constr -> types array * types
+  env -> evar_map -> pinductive * EConstr.constr list -> constr -> constr -> types array * types
 
 (** Annotation for cases *)
 val make_case_info : env -> inductive -> case_style -> case_info
@@ -185,8 +187,8 @@ val make_case_info : env -> inductive -> case_style -> case_info
     Fail with an error if the elimination is dependent while the
     inductive type does not allow dependent elimination. *)
 val make_case_or_project :
-  env -> inductive_family -> case_info ->
-  (* pred *) constr -> (* term *) constr -> (* branches *) constr array -> constr
+  env -> evar_map -> inductive_family -> case_info ->
+  (* pred *) EConstr.constr -> (* term *) EConstr.constr -> (* branches *) EConstr.constr array -> EConstr.constr
 
 (*i Compatibility
 val make_default_case_info : env -> case_style -> inductive -> case_info
@@ -195,7 +197,7 @@ i*)
 (********************)
 
 val type_of_inductive_knowing_conclusion :
-  env -> evar_map -> Inductive.mind_specif puniverses -> types -> evar_map * types
+  env -> evar_map -> Inductive.mind_specif Univ.puniverses -> EConstr.types -> evar_map * EConstr.types
 
 (********************)
-val control_only_guard : env -> types -> unit
+val control_only_guard : env -> Evd.evar_map -> EConstr.types -> unit
diff --git a/pretyping/inferCumulativity.ml b/pretyping/inferCumulativity.ml
new file mode 100644
index 00000000..be79b8b0
--- /dev/null
+++ b/pretyping/inferCumulativity.ml
@@ -0,0 +1,212 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 whd_stack (infos, tab) hd stk = CClosure.whd_stack infos tab hd stk
+
+let rec infer_fterm cv_pb infos variances hd stk =
+  Control.check_for_interrupt ();
+  let hd,stk = whd_stack infos hd stk in
+  let open CClosure 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 _ -> infer_stack infos variances stk
+  | 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 (fst 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 (fst 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, create_tab ()) 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 00000000..a0c8d339
--- /dev/null
+++ b/pretyping/inferCumulativity.mli
@@ -0,0 +1,12 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+val infer_inductive : Environ.env -> Entries.mutual_inductive_entry ->
+  Entries.mutual_inductive_entry
diff --git a/pretyping/locusops.ml b/pretyping/locusops.ml
index e4fbf8d5..1664e68f 100644
--- a/pretyping/locusops.ml
+++ b/pretyping/locusops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Locus
@@ -50,9 +52,9 @@ let is_nowhere = function
 
 let simple_clause_of enum_hyps cl =
   let error_occurrences () =
-    CErrors.error "This tactic does not support occurrences selection" in
+    CErrors.user_err Pp.(str "This tactic does not support occurrences selection") in
   let error_body_selection () =
-    CErrors.error "This tactic does not support body selection" in
+    CErrors.user_err Pp.(str "This tactic does not support body selection") in
   let hyps =
     match cl.onhyps with
     | None ->
@@ -84,7 +86,7 @@ let concrete_clause_of enum_hyps cl =
 (** Miscellaneous functions *)
 
 let out_arg = function
-  | Misctypes.ArgVar _ -> CErrors.anomaly (Pp.str "Unevaluated or_var variable")
+  | Misctypes.ArgVar _ -> CErrors.anomaly (Pp.str "Unevaluated or_var variable.")
   | Misctypes.ArgArg x -> x
 
 let occurrences_of_hyp id cls =
diff --git a/pretyping/locusops.mli b/pretyping/locusops.mli
index c7661239..a07c018c 100644
--- a/pretyping/locusops.mli
+++ b/pretyping/locusops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
diff --git a/pretyping/ltac_pretype.ml b/pretyping/ltac_pretype.ml
new file mode 100644
index 00000000..be8579c2
--- /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 142e430f..0f0af540 100644
--- a/pretyping/miscops.ml
+++ b/pretyping/miscops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -30,7 +32,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 -> CString.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
@@ -58,3 +61,16 @@ let map_red_expr_gen f g h = function
   | CbvNative occs_o -> CbvNative (Option.map (map_occs (map_union g h)) occs_o)
   | Cbn flags -> Cbn (map_flags g flags)
   | ExtraRedExpr _ | Red _ | Hnf as x -> x
+
+(** Mapping bindings *)
+
+let map_explicit_bindings f l =
+  let map = CAst.map (fun (hyp, x) -> (hyp, f x)) in
+  List.map map l
+
+let map_bindings f = function
+| ImplicitBindings l -> ImplicitBindings (List.map f l)
+| ExplicitBindings expl -> ExplicitBindings (map_explicit_bindings f expl)
+| NoBindings -> NoBindings
+
+let map_with_bindings f (x, bl) = (f x, map_bindings f bl)
diff --git a/pretyping/miscops.mli b/pretyping/miscops.mli
index 337473a6..abe817fe 100644
--- a/pretyping/miscops.mli
+++ b/pretyping/miscops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Misctypes
@@ -27,3 +29,8 @@ val intro_pattern_naming_eq :
 
 val map_red_expr_gen : ('a -> 'd) -> ('b -> 'e) -> ('c -> 'f) ->
   ('a,'b,'c) red_expr_gen -> ('d,'e,'f) red_expr_gen
+
+(** Mapping bindings *)
+
+val map_bindings : ('a -> 'b) -> 'a bindings -> 'b bindings
+val map_with_bindings : ('a -> 'b) -> 'a with_bindings -> 'b with_bindings
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index 0dd64697..1ed4d21b 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -1,17 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
-open Pp
 open CErrors
 open Term
+open Constr
 open Vars
 open Environ
 open Reduction
-open Univ
 open Declarations
 open Names
 open Inductive
@@ -20,10 +21,65 @@ open Nativecode
 open Nativevalues
 open Context.Rel.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (** This module implements normalization by evaluation to OCaml code *)
 
 exception Find_at of int
 
+(* profiling *)
+
+let profiling_enabled = ref false
+    
+(* for supported platforms, filename for profiler results *)
+
+let profile_filename = ref "native_compute_profile.data"
+
+let profiler_platform () =
+  match [@warning "-8"] Sys.os_type with
+  | "Unix" ->
+     let in_ch = Unix.open_process_in "uname" in
+     let uname = input_line in_ch in
+     let _ = close_in in_ch in
+     Format.sprintf "Unix (%s)" uname
+  | "Win32" -> "Windows (Win32)"
+  | "Cygwin" -> "Windows (Cygwin)"
+
+let get_profile_filename () = !profile_filename
+
+let set_profile_filename fn =
+  profile_filename := fn
+
+(* find unused profile filename *)
+let get_available_profile_filename () =
+  let profile_filename = get_profile_filename () in
+  let dir = Filename.dirname profile_filename in 
+  let base = Filename.basename profile_filename in 
+  (* starting with OCaml 4.04, could use Filename.remove_extension and Filename.extension, which
+     gets rid of need for exception-handling here
+  *)
+  let (name,ext) =
+    try
+      let nm = Filename.chop_extension base in
+      let nm_len = String.length nm in
+      let ex = String.sub base nm_len (String.length base - nm_len) in
+      (nm,ex)
+    with Invalid_argument _ -> (base,"")
+  in
+  try 
+    (* unlikely race: fn deleted, another process uses fn *)
+    Filename.temp_file ~temp_dir:dir (name ^ "_") ext
+  with Sys_error s ->
+    let msg = "When trying to find native_compute profile output file: " ^ s in
+    let _ = Feedback.msg_info (Pp.str msg) in
+    assert false
+
+let get_profiling_enabled () =
+  !profiling_enabled
+    
+let set_profiling_enabled b =
+  profiling_enabled := b
+    
 let invert_tag cst tag reloc_tbl =
   try
     for j = 0 to Array.length reloc_tbl - 1 do
@@ -37,7 +93,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 =
@@ -47,7 +103,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
 
@@ -80,7 +136,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
@@ -90,13 +146,15 @@ let construct_of_constr_const env tag typ =
 
 let construct_of_constr_block = construct_of_constr false
 
-let build_branches_type env (mind,_ as _ind) mib mip u params dep p =
+let build_branches_type env sigma (mind,_ as _ind) mib mip u params dep p =
   let rtbl = mip.mind_reloc_tbl in
   (* [build_one_branch i cty] construit le type de la ieme branche (commence
      a 0) et les lambda correspondant aux realargs *)
   let build_one_branch i cty =
     let typi = type_constructor mind mib u cty params in
-    let decl,indapp = Reductionops.splay_prod env Evd.empty typi in
+    let decl,indapp = Reductionops.splay_prod env sigma (EConstr.of_constr typi) in
+    let decl = List.map (on_snd EConstr.Unsafe.to_constr) decl in
+    let indapp = EConstr.Unsafe.to_constr indapp in
     let decl_with_letin,_ = decompose_prod_assum typi in
     let ind,cargs = find_rectype_a env indapp in
     let nparams = Array.length params in
@@ -120,44 +178,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 =
-  lookup_rel n env |> 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 lookup_named id env |> 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 = 
@@ -170,9 +190,9 @@ let branch_of_switch lvl ans bs =
     bs ci in
   Array.init (Array.length tbl) branch
 
-let rec nf_val env v typ =
+let rec nf_val env sigma v typ =
   match kind_of_value v with
-  | Vaccu accu -> nf_accu env accu
+  | Vaccu accu -> nf_accu env sigma accu
   | Vfun f -> 
       let lvl = nb_rel env in
       let name,dom,codom = 
@@ -182,44 +202,44 @@ let rec nf_val env v typ =
             (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
       in
       let env = push_rel (LocalAssum (name,dom)) env in
-      let body = nf_val env (f (mk_rel_accu lvl)) codom in
+      let body = nf_val env sigma (f (mk_rel_accu lvl)) codom in
       mkLambda(name,dom,body)
   | Vconst n -> construct_of_constr_const env n typ
   | Vblock b ->
       let capp,ctyp = construct_of_constr_block env (block_tag b) typ in
-      let args = nf_bargs env b ctyp in
+      let args = nf_bargs env sigma b ctyp in
       mkApp(capp,args)
 
-and nf_type env v =
+and nf_type env sigma v =
   match kind_of_value v with
-  | Vaccu accu -> nf_accu env accu
+  | Vaccu accu -> nf_accu env sigma accu
   | _ -> assert false
 
-and nf_type_sort env v =
+and nf_type_sort env sigma v =
   match kind_of_value v with
   | Vaccu accu -> 
-      let t,s = nf_accu_type env accu in
+      let t,s = nf_accu_type env sigma accu in
       let s = try destSort s with DestKO -> assert false in
       t, s
   | _ -> assert false
 
-and nf_accu env accu =
+and nf_accu env sigma accu =
   let atom = atom_of_accu accu in
-  if Int.equal (accu_nargs accu) 0 then nf_atom env atom
+  if Int.equal (accu_nargs accu) 0 then nf_atom env sigma atom
   else
-    let a,typ = nf_atom_type env atom in
-    let _, args = nf_args env accu typ in
+    let a,typ = nf_atom_type env sigma atom in
+    let _, args = nf_args env sigma (args_of_accu accu) typ in
     mkApp(a,Array.of_list args)
 
-and nf_accu_type env accu =
+and nf_accu_type env sigma accu =
   let atom = atom_of_accu accu in
-  if Int.equal (accu_nargs accu) 0 then nf_atom_type env atom
+  if Int.equal (accu_nargs accu) 0 then nf_atom_type env sigma atom
   else
-    let a,typ = nf_atom_type env atom in
-    let t, args = nf_args env accu typ in
+    let a,typ = nf_atom_type env sigma atom 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 accu t =
+and nf_args env sigma args t =
   let aux arg (t,l) = 
     let _,dom,codom =
       try decompose_prod env t with
@@ -227,13 +247,13 @@ and nf_args env accu t =
 	CErrors.anomaly
 	  (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
     in
-    let c = nf_val env arg dom in
+    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 b t =
+and nf_bargs env sigma b t =
   let t = ref t in
   let len = block_size b in
   Array.init len
@@ -244,10 +264,10 @@ and nf_bargs env b t =
 	  CErrors.anomaly
 	    (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
       in
-      let c = nf_val env (block_field b i) dom in
+      let c = nf_val env sigma (block_field b i) dom in
       t := subst1 c codom; c)
 
-and nf_atom env atom =
+and nf_atom env sigma atom =
   match atom with
   | Arel i -> mkRel (nb_rel env - i)
   | Aconstant cst -> mkConstU cst
@@ -255,33 +275,32 @@ and nf_atom env atom =
   | Asort s -> mkSort s
   | Avar id -> mkVar id
   | Aprod(n,dom,codom) ->
-      let dom = nf_type env dom in
+      let dom = nf_type env sigma dom in
       let vn = mk_rel_accu (nb_rel env) in
       let env = push_rel (LocalAssum (n,dom)) env in
-      let codom = nf_type env (codom vn) in
+      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 c in
+      let c = nf_accu env sigma c in
 	mkProj(Projection.make p true,c)
-  | _ -> fst (nf_atom_type env atom)
+  | _ -> fst (nf_atom_type env sigma atom)
 
-and nf_atom_type env atom =
+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 accu in
+      let a,ta = nf_accu_type env sigma accu in
       let ((mind,_),u as ind),allargs = find_rectype_a env ta in
       let (mib,mip) = Inductive.lookup_mind_specif env (fst ind) in
       let nparams = mib.mind_nparams in
@@ -290,14 +309,14 @@ and nf_atom_type env atom =
 	hnf_prod_applist env 
 	  (Inductiveops.type_of_inductive env ind) (Array.to_list params) in
       let pT = whd_all env pT in
-      let dep, p = nf_predicate env ind mip params p pT in
+      let dep, p = nf_predicate env sigma ind mip params p pT in
       (* Calcul du type des branches *)
-      let btypes = build_branches_type env (fst ind) mib mip u params dep p in
+      let btypes = build_branches_type env sigma (fst ind) mib mip u params dep p in
       (* calcul des branches *)
       let bsw = branch_of_switch (nb_rel env) ans bs in
       let mkbranch i v =
        let decl,decl_with_letin,codom = btypes.(i) in
-       let b = nf_val (Termops.push_rels_assum decl env) v codom in
+       let b = nf_val (Termops.push_rels_assum decl env) sigma v codom in
         Termops.it_mkLambda_or_LetIn_from_no_LetIn b decl_with_letin
       in 
       let branchs = Array.mapi mkbranch bsw in
@@ -305,8 +324,8 @@ and nf_atom_type env atom =
       let ci = ans.asw_ci in
       mkCase(ci, p, a, branchs), tcase 
   | Afix(tt,ft,rp,s) ->
-      let tt = Array.map (fun t -> nf_type env t) tt in
-      let name = Array.map (fun _ -> (Name (id_of_string "Ffix"))) tt in
+      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 lvl = nb_rel env in
       let nbfix = Array.length ft in
       let fargs = mk_rels_accu lvl (Array.length ft) in
@@ -314,38 +333,37 @@ and nf_atom_type env atom =
       let env = push_rec_types (name,tt,[||]) env in
       (* We lift here because the types of arguments (in tt) will be evaluated
          in an environment where the fixpoints have been pushed *)
-      let norm_body i v = nf_val env (napply v fargs) (lift nbfix tt.(i)) in
+      let norm_body i v = nf_val env sigma (napply v fargs) (lift nbfix tt.(i)) in
       let ft = Array.mapi norm_body ft in
       mkFix((rp,s),(name,tt,ft)), tt.(s)
   | Acofix(tt,ft,s,_) | Acofixe(tt,ft,s,_) ->
-      let tt = Array.map (nf_type env) tt in
-      let name = Array.map (fun _ -> (Name (id_of_string "Fcofix"))) tt in
+      let tt = Array.map (nf_type env sigma) 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
-      let ft = Array.mapi (fun i v -> nf_val env (napply v fargs) tt.(i)) ft in
+      let ft = Array.mapi (fun i v -> nf_val env sigma (napply v fargs) tt.(i)) ft in
       mkCoFix(s,(name,tt,ft)), tt.(s)
   | Aprod(n,dom,codom) ->
-      let dom,s1 = nf_type_sort env dom in
+      let dom,s1 = nf_type_sort env sigma dom in
       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 (codom vn) in
-      mkProd(n,dom,codom), mkSort (sort_of_product env s1 s2)
-  | Aevar(ev,ty) ->
-     let ty = nf_type env ty in
-     mkEvar ev, ty
+      let codom,s2 = nf_type_sort env sigma (codom vn) in
+      mkProd(n,dom,codom), Typeops.type_of_product env n s1 s2
+  | Aevar(evk, _, args) ->
+    nf_evar env sigma evk args
   | Ameta(mv,ty) ->
-     let ty = nf_type env ty in
+     let ty = nf_type env sigma ty in
      mkMeta mv, ty
   | Aproj(p,c) ->
-      let c,tc = nf_accu_type env c in
+      let c,tc = nf_accu_type env sigma c in
       let cj = make_judge c tc in
       let uj = Typeops.judge_of_projection env (Projection.make p true) cj in
       uj.uj_val, uj.uj_type
 
 
-and  nf_predicate env ind mip params v pT =
-  match kind_of_value v, kind_of_term pT with
+and  nf_predicate env sigma ind mip params v pT =
+  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
@@ -356,51 +374,124 @@ and  nf_predicate env ind mip params v pT =
 	    (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
       in
       let dep,body = 
-	nf_predicate (push_rel (LocalAssum (name,dom)) env) ind mip params vb codom in
+	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 = 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
       let dom = mkApp(mkIndU ind,Array.append params rargs) in
-      let body = nf_type (push_rel (LocalAssum (name,dom)) env) vb in
+      let body = nf_type (push_rel (LocalAssum (name,dom)) env) sigma vb in
       true, mkLambda(name,dom,body)
-  | _, _ -> false, nf_type env v
+  | _, _ -> false, nf_type env sigma v
+
+and nf_evar env sigma evk 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
+  let ty = Evd.evar_concl evi in
+  if List.is_empty hyps then begin
+    assert (Int.equal (Array.length args) 0);
+    mkEvar (evk, [||]), ty
+  end
+  else
+    (** Let-bound arguments are present in the evar arguments but not in the
+        type, so we turn the let into a product. *)
+    let drop_body = function
+    | NamedDecl.LocalAssum _ as d -> d
+    | NamedDecl.LocalDef (na, _, t) -> NamedDecl.LocalAssum (na, t)
+    in
+    let hyps = List.map drop_body hyps in
+    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
+    (** nf_args takes arguments in the reverse order but produces them in the
+        correct one, so we have to reverse them again for the evar node *)
+    mkEvar (evk, Array.rev_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;
     Nativelambda.evars_metas = Evd.meta_type sigma }
 
-let native_norm env sigma c ty =  
-  if Coq_config.no_native_compiler then
-    error "Native_compute reduction has been disabled at configure time."
+(* fork perf process, return profiler's process id *)
+let start_profiler_linux profile_fn =
+  let coq_pid = Unix.getpid () in (* pass pid of running coqtop *)
+  (* we don't want to see perf's console output *)
+  let dev_null = Unix.descr_of_out_channel (open_out_bin "/dev/null") in
+  let _ = Feedback.msg_info (Pp.str ("Profiling to file " ^ profile_fn)) in
+  let perf = "perf" in
+  let profiler_pid = 
+    Unix.create_process
+      perf
+      [|perf; "record"; "-g"; "-o"; profile_fn; "-p"; string_of_int coq_pid |]
+      Unix.stdin dev_null dev_null
+  in
+  (* doesn't seem to be a way to test whether process creation succeeded *)
+  if !Flags.debug then 
+    Feedback.msg_debug (Pp.str (Format.sprintf "Native compute profiler started, pid = %d, output to: %s" profiler_pid profile_fn));
+  Some profiler_pid
+
+(* kill profiler via SIGINT *)
+let stop_profiler_linux m_pid = 
+  match m_pid with 
+  | Some pid -> (
+    let _ = if !Flags.debug then Feedback.msg_debug (Pp.str "Stopping native code profiler") in
+    try 
+      Unix.kill pid Sys.sigint;
+      let _ = Unix.waitpid [] pid in ()
+    with Unix.Unix_error (Unix.ESRCH,"kill","") ->
+      Feedback.msg_info (Pp.str "Could not stop native code profiler, no such process")
+  )
+  | None -> ()
+
+let start_profiler () =
+  let profile_fn = get_available_profile_filename () in
+  match profiler_platform () with
+    "Unix (Linux)" -> start_profiler_linux profile_fn
+  | _ ->
+     let _ = Feedback.msg_info
+       (Pp.str (Format.sprintf "Native_compute profiling not supported on the platform: %s"
+		  (profiler_platform ()))) in
+     None
+
+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 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
-  let sigma = evars_of_evar_map sigma in
   (*
   Format.eprintf "Numbers of free variables (named): %i\n" (List.length vl1);
   Format.eprintf "Numbers of free variables (rel): %i\n" (List.length vl2);
   *)
   let ml_filename, prefix = Nativelib.get_ml_filename () in
-  let code, upd = mk_norm_code penv sigma prefix c in
-  match Nativelib.compile ml_filename code with
+  let code, upd = mk_norm_code penv (evars_of_evar_map sigma) prefix c in
+  let profile = get_profiling_enabled () in
+  match Nativelib.compile ml_filename code ~profile:profile with
     | true, fn ->
         if !Flags.debug then Feedback.msg_debug (Pp.str "Running norm ...");
+	let profiler_pid = if profile then start_profiler () else None in
         let t0 = Sys.time () in
         Nativelib.call_linker ~fatal:true prefix fn (Some upd);
         let t1 = Sys.time () in
+	if profile then stop_profiler profiler_pid;
         let time_info = Format.sprintf "Evaluation done in %.5f@." (t1 -. t0) in
         if !Flags.debug then Feedback.msg_debug (Pp.str time_info);
-        let res = nf_val env !Nativelib.rt1 ty in
+        let res = nf_val env sigma !Nativelib.rt1 ty in
         let t2 = Sys.time () in
         let time_info = Format.sprintf "Reification done in %.5f@." (t2 -. t1) in
         if !Flags.debug then Feedback.msg_debug (Pp.str time_info);
-        res
-    | _ -> anomaly (Pp.str "Compilation failure") 
+        EConstr.of_constr res
+    | _ -> anomaly (Pp.str "Compilation failure.") 
 
 let native_conv_generic pb sigma t =
   Nativeconv.native_conv_gen pb (evars_of_evar_map sigma) t
diff --git a/pretyping/nativenorm.mli b/pretyping/nativenorm.mli
index 0b1ce8e5..67b7a2a4 100644
--- a/pretyping/nativenorm.mli
+++ b/pretyping/nativenorm.mli
@@ -1,16 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
-open Term
+
+open EConstr
 open Environ
 open Evd
 
 (** This module implements normalization by evaluation to OCaml code *)
 
+val get_profile_filename : unit -> string
+val set_profile_filename : string -> unit
+
+val get_profiling_enabled : unit -> bool
+val set_profiling_enabled : bool -> unit
+
+
 val native_norm : env -> evar_map -> constr -> types -> constr
 
 (** Conversion with inference of universe constraints *)
diff --git a/pretyping/patternops.ml b/pretyping/patternops.ml
index fe73b610..c9925087 100644
--- a/pretyping/patternops.ml
+++ b/pretyping/patternops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -12,15 +14,14 @@ open Names
 open Globnames
 open Nameops
 open Term
+open Constr
 open Vars
 open Glob_term
-open Glob_ops
 open Pp
 open Mod_subst
 open Misctypes
 open Decl_kinds
 open Pattern
-open Evd
 open Environ
 
 let case_info_pattern_eq i1 i2 =
@@ -44,8 +45,9 @@ let rec constr_pattern_eq p1 p2 = match p1, p2 with
   Name.equal v1 v2 && constr_pattern_eq t1 t2 && constr_pattern_eq b1 b2
 | PProd (v1, t1, b1), PProd (v2, t2, b2) ->
   Name.equal v1 v2 && constr_pattern_eq t1 t2 && constr_pattern_eq b1 b2
-| PLetIn (v1, t1, b1), PLetIn (v2, t2, b2) ->
-  Name.equal v1 v2 && constr_pattern_eq t1 t2 && constr_pattern_eq b1 b2
+| PLetIn (v1, b1, t1, c1), PLetIn (v2, b2, t2, c2) ->
+  Name.equal v1 v2 && constr_pattern_eq b1 b2 &&
+  Option.equal constr_pattern_eq t1 t2 && constr_pattern_eq c1 c2
 | PSort s1, PSort s2 -> Miscops.glob_sort_eq s1 s2
 | PMeta m1, PMeta m2 -> Option.equal Id.equal m1 m2
 | PIf (t1, l1, r1), PIf (t2, l2, r2) ->
@@ -59,7 +61,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) =
@@ -76,8 +82,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) ->
@@ -85,7 +91,8 @@ let rec occur_meta_pattern = function
   | PProj (_,arg) -> occur_meta_pattern arg
   | PLambda (na,t,c)  -> (occur_meta_pattern t) || (occur_meta_pattern c)
   | PProd (na,t,c)  -> (occur_meta_pattern t) || (occur_meta_pattern c)
-  | PLetIn (na,t,c)  -> (occur_meta_pattern t) || (occur_meta_pattern c)
+  | PLetIn (na,b,t,c)  ->
+     Option.fold_left (fun b t -> b || occur_meta_pattern t) (occur_meta_pattern b) t || (occur_meta_pattern c)
   | PIf (c,c1,c2)  ->
       (occur_meta_pattern c) ||
       (occur_meta_pattern c1) || (occur_meta_pattern c2)
@@ -96,12 +103,37 @@ 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 =
   match t with
     | PProd (_,_,b)  -> head_pattern_bound b
-    | PLetIn (_,_,b) -> head_pattern_bound b
+    | PLetIn (_,_,_,b) -> head_pattern_bound b
     | PApp (c,args)  -> head_pattern_bound c
     | PIf (c,_,_)  -> head_pattern_bound c
     | PCase (_,p,c,br) -> head_pattern_bound c
@@ -112,19 +144,19 @@ let rec head_pattern_bound t =
 	-> raise BoundPattern
     (* Perhaps they were arguments, but we don't beta-reduce *)
     | PLambda _ -> raise BoundPattern
-    | PCoFix _ -> anomaly ~label:"head_pattern_bound" (Pp.str "not a type")
+    | PCoFix _ -> anomaly ~label:"head_pattern_bound" (Pp.str "not a type.")
 
-let head_of_constr_reference c = match kind_of_term c with
+let head_of_constr_reference sigma c = match EConstr.kind sigma c with
   | Const (sp,_) -> ConstRef sp
   | Construct (sp,_) -> ConstructRef sp
   | Ind (sp,_) -> IndRef sp
   | Var id -> VarRef id
-  | _ -> anomaly (Pp.str "Not a rigid reference")
+  | _ -> anomaly (Pp.str "Not a rigid reference.")
 
 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
@@ -132,7 +164,7 @@ let pattern_of_constr env sigma t =
     | Sort (Prop Pos) -> PSort GSet
     | Sort (Type _) -> PSort (GType [])
     | Cast (c,_,_)      -> pattern_of_constr env c
-    | LetIn (na,c,t,b) -> PLetIn (na,pattern_of_constr env c,
+    | LetIn (na,c,t,b) -> PLetIn (na,pattern_of_constr env c,Some (pattern_of_constr env t),
 				  pattern_of_constr (push_rel (LocalDef (na,c,t)) env) b)
     | Prod (na,c,b)   -> PProd (na,pattern_of_constr env c,
 				pattern_of_constr (push_rel (LocalAssum (na, c)) env) b)
@@ -140,31 +172,31 @@ 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 (true,id) -> Some id
+              Evar_kinds.MatchingVar (Evar_kinds.SecondOrderPatVar id) -> Some id
             | _ -> None)
           | _ -> None
          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) -> 
-      pattern_of_constr env (Retyping.expand_projection env sigma p c [])
+      pattern_of_constr env (EConstr.Unsafe.to_constr (Retyping.expand_projection env sigma p (EConstr.of_constr c) []))
     | Evar (evk,ctxt as ev) ->
       (match snd (Evd.evar_source evk sigma) with
-      | Evar_kinds.MatchingVar (b,id) ->
-	let ty = Evarutil.nf_evar sigma (existential_type sigma ev) in
-	let () = ignore (pattern_of_constr env ty) in
-        assert (not b); PMeta (Some id)
-      | Evar_kinds.GoalEvar -> 
-	PEvar (evk,Array.map (pattern_of_constr env) ctxt)
+      | Evar_kinds.MatchingVar (Evar_kinds.FirstOrderPatVar id) ->
+        PMeta (Some id)
+      | Evar_kinds.GoalEvar | Evar_kinds.VarInstance _ ->
+        (* These are the two evar kinds used for existing goals *)
+        (* see Proofview.mark_in_evm *)
+         if Evd.is_defined sigma evk then pattern_of_constr env (Evd.existential_value sigma ev)
+         else PEvar (evk,Array.map (pattern_of_constr env) ctxt)
+      | Evar_kinds.MatchingVar (Evar_kinds.SecondOrderPatVar ido) -> assert false
       | _ -> 
-	let ty = Evarutil.nf_evar sigma (existential_type sigma ev) in
-	let () = ignore (pattern_of_constr env ty) in
 	 PMeta None)
     | Case (ci,p,a,br) ->
         let cip =
@@ -189,7 +221,7 @@ let map_pattern_with_binders g f l = function
   | PSoApp (n,pl) -> PSoApp (n, List.map (f l) pl)
   | PLambda (n,a,b) -> PLambda (n,f l a,f (g n l) b)
   | PProd (n,a,b) -> PProd (n,f l a,f (g n l) b)
-  | PLetIn (n,a,b) -> PLetIn (n,f l a,f (g n l) b)
+  | PLetIn (n,a,t,b) -> PLetIn (n,f l a,Option.map (f l) t,f (g n l) b)
   | PIf (c,b1,b2) -> PIf (f l c,f l b1,f l b2)
   | PCase (ci,po,p,pl) ->
     PCase (ci,f l po,f l p, List.map (fun (i,n,c) -> (i,n,f l c)) pl)
@@ -204,11 +236,13 @@ let error_instantiate_pattern id l =
   | [_] -> "is" 
   | _ -> "are"
   in
-  errorlabstrm "" (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 =
+  let open EConstr in
+  let open Vars in
   let rec aux vars = function
   | PVar id as x ->
       (try
@@ -220,14 +254,16 @@ let instantiate_pattern env sigma lvar c =
               ctx
           in
 	  let c = substl inst c in
-	  pattern_of_constr env sigma c
+	  (** FIXME: Stupid workaround to pattern_of_constr being evar sensitive *)
+	  let c = Evarutil.nf_evar sigma c in
+	  pattern_of_constr env sigma (EConstr.Unsafe.to_constr c)
 	with Not_found (* List.index failed *) ->
 	  let vars =
 	    List.map_filter (function Name id -> Some id | _ -> None) vars in
 	  error_instantiate_pattern id (List.subtract Id.equal ctx vars)
        with Not_found (* Map.find failed *) ->
 	 x)
-  | (PFix _ | PCoFix _) -> error ("Non instantiable pattern.")
+  | (PFix _ | PCoFix _) -> user_err Pp.(str "Non instantiable pattern.")
   | c ->
       map_pattern_with_binders (fun id vars -> id::vars) aux vars c in
   aux [] c
@@ -274,11 +310,12 @@ let rec subst_pattern subst pat =
       let c2' = subst_pattern subst c2 in
 	if c1' == c1 && c2' == c2 then pat else
 	  PProd (name,c1',c2')
-  | PLetIn (name,c1,c2) ->
+  | PLetIn (name,c1,t,c2) ->
       let c1' = subst_pattern subst c1 in
+      let t' = Option.smartmap (subst_pattern subst) t in
       let c2' = subst_pattern subst c2 in
-	if c1' == c1 && c2' == c2 then pat else
-	  PLetIn (name,c1',c2')
+	if c1' == c1 && t' == t && c2' == c2 then pat else
+	  PLetIn (name,c1',t',c2')
   | PSort _
   | PMeta _ -> pat
   | PIf (c,c1,c2) ->
@@ -315,52 +352,56 @@ let rec subst_pattern subst pat =
 let mkPLambda na b = PLambda(na,PMeta None,b)
 let rev_it_mkPLambda = List.fold_right mkPLambda
 
-let err loc pp = user_err_loc (loc,"pattern_of_glob_constr", pp)
+let err ?loc pp = user_err ?loc ~hdr:"pattern_of_glob_constr" pp
 
 let warn_cast_in_pattern =
   CWarnings.create ~name:"cast-in-pattern" ~category:"automation"
     (fun () -> Pp.strbrk "Casts are ignored in patterns")
 
-let rec pat_of_raw metas vars = function
-  | GVar (_,id) ->
+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)
-  | GPatVar (_,(false,n)) ->
+  | GPatVar (Evar_kinds.FirstOrderPatVar n) ->
       metas := n::!metas; PMeta (Some n)
-  | GRef (_,gr,_) ->
+  | GRef (gr,_) ->
       PRef (canonical_gr gr)
   (* Hack to avoid rewriting a complete interpretation of patterns *)
-  | GApp (_, GPatVar (_,(true,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))
-  | GLambda (_,na,bk,c1,c2) ->
-      name_iter (fun n -> metas := n::!metas) na;
+    end
+  | GLambda (na,bk,c1,c2) ->
+      Name.iter (fun n -> metas := n::!metas) na;
       PLambda (na, pat_of_raw metas vars c1,
 	       pat_of_raw metas (na::vars) c2)
-  | GProd (_,na,bk,c1,c2) ->
-      name_iter (fun n -> metas := n::!metas) na;
+  | GProd (na,bk,c1,c2) ->
+      Name.iter (fun n -> metas := n::!metas) na;
       PProd (na, pat_of_raw metas vars c1,
 	       pat_of_raw metas (na::vars) c2)
-  | GLetIn (_,na,c1,c2) ->
-      name_iter (fun n -> metas := n::!metas) na;
+  | GLetIn (na,c1,t,c2) ->
+      Name.iter (fun n -> metas := n::!metas) na;
       PLetIn (na, pat_of_raw metas vars c1,
+               Option.map (pat_of_raw metas vars) t,
 	       pat_of_raw metas (na::vars) c2)
-  | GSort (_,s) ->
+  | GSort s ->
       PSort s
   | GHole _ ->
       PMeta None
-  | GCast (_,c,_) ->
+  | GCast (c,_) ->
       warn_cast_in_pattern ();
       pat_of_raw metas vars c
-  | GIf (_,c,(_,None),b1,b2) ->
+  | GIf (c,(_,None),b1,b2) ->
       PIf (pat_of_raw metas vars c,
            pat_of_raw metas vars b1,pat_of_raw metas vars b2)
-  | GLetTuple (loc,nal,(_,None),b,c) ->
-      let mkGLambda c na =
-	GLambda (loc,na,Explicit,GHole (loc,Evar_kinds.InternalHole, IntroAnonymous, None),c) in
-      let c = List.fold_left mkGLambda c nal in
+  | GLetTuple (nal,(_,None),b,c) ->
+      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;
 	  cip_ind = None;
@@ -370,24 +411,31 @@ let rec pat_of_raw metas vars = function
       let tags = List.map (fun _ -> false) nal (* Approximation which can be without let-ins... *) in
       PCase (cip, PMeta None, pat_of_raw metas vars b,
              [0,tags,pat_of_raw metas vars c])
-  | GCases (loc,sty,p,[c,(na,indnames)],brs) ->
+  | 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
-	| (_,_,[PatCstr(_,(ind,_),_,_)],_)::_ -> Some ind
+        | {CAst.v=(_,[p],_)}::_ -> get_ind p
 	| _ -> None
       in
       let ind_tags,ind = match indnames with
-	| Some (_,ind,nal) -> Some (List.length nal), Some ind
+        | Some {CAst.v=(ind,nal)} -> Some (List.length nal), Some ind
 	| None -> None, get_ind brs
       in
       let ext,brs = pats_of_glob_branches loc metas vars ind brs
       in
       let pred = match p,indnames with
-	| Some p, Some (_,_,nal) ->
+        | Some p, Some {CAst.v=(_,nal)} ->
           let nvars = na :: List.rev nal @ vars in
           rev_it_mkPLambda nal (mkPLambda na (pat_of_raw metas nvars p))
-        | (None | Some (GHole _)), _ -> PMeta None
+        | None, _ -> PMeta None
 	| Some p, None ->
-            user_err_loc (loc,"",strbrk "Clause \"in\" expected in patterns over \"match\" expressions with an explicit \"return\" clause.")
+          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 =
 	{ cip_style = sty;
@@ -400,32 +448,41 @@ let rec pat_of_raw metas vars = function
 	 one non-trivial branch. These facts are used in [Constrextern]. *)
       PCase (info, pred, pat_of_raw metas vars c, brs)
 
-  | r -> err (loc_of_glob_constr r) (Pp.str "Non supported pattern.")
+  | 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
-    | PatVar(_,na) -> na
-    | PatCstr(loc,_,_,_) -> err loc (Pp.str "Non supported pattern.")
+  let get_arg p = match DAst.get p with
+    | PatVar na ->
+      Name.iter (fun n -> metas := n::!metas) na;
+      na
+    | PatCstr(_,_,_) -> err ?loc:p.CAst.loc (Pp.str "Non supported pattern.")
   in
   let rec get_pat indexes = function
     | [] -> false, []
-    | [(_,_,[PatVar(_,Anonymous)],GHole _)] -> true, [] (* ends with _ => _ *)
-    | (_,_,[PatCstr(_,(indsp,j),lv,_)],br) :: brs ->
-      let () = match ind with
-      | Some sp when eq_ind sp indsp -> ()
+    | {CAst.loc=loc';v=(_,[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)
-    | (loc,_,_,_) :: _ -> err loc (Pp.str "Non supported pattern.")
+        err ?loc:loc' (Pp.str "Non supported pattern.")
+      end
+    | {CAst.loc;v=(_,_,_)} :: _ -> 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 1f63565d..9f087857 100644
--- a/pretyping/patternops.mli
+++ b/pretyping/patternops.mli
@@ -1,17 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open Globnames
 open Glob_term
 open Mod_subst
 open Misctypes
 open Pattern
+open Ltac_pretype
 
 (** {5 Functions on patterns} *)
 
@@ -21,6 +24,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
@@ -32,13 +37,13 @@ val head_pattern_bound : constr_pattern -> global_reference
 (** [head_of_constr_reference c] assumes [r] denotes a reference and
    returns its label; raises an anomaly otherwise *)
 
-val head_of_constr_reference : Term.constr -> global_reference
+val head_of_constr_reference : Evd.evar_map -> constr -> global_reference
 
 (** [pattern_of_constr c] translates a term [c] with metavariables into
    a pattern; currently, no destructor (Cases, Fix, Cofix) and no
    existential variable are allowed in [c] *)
 
-val pattern_of_constr : Environ.env -> Evd.evar_map -> constr -> constr_pattern
+val pattern_of_constr : Environ.env -> Evd.evar_map -> Constr.constr -> constr_pattern
 
 (** [pattern_of_glob_constr l c] translates a term [c] with metavariables into
    a pattern; variables bound in [l] are replaced by the pattern to which they
diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml
index 00b6100c..278a4761 100644
--- a/pretyping/pretype_errors.ml
+++ b/pretyping/pretype_errors.ml
@@ -1,26 +1,27 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Util
 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
@@ -31,14 +32,16 @@ type position_reporting = (position * int) * constr
 
 type subterm_unification_error = bool * position_reporting * position_reporting * (constr * constr * unification_error) option
 
+type type_error = (constr, types) ptype_error
+
 type pretype_error =
   (* Old Case *)
   | CantFindCaseType of constr
   (* 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
@@ -55,7 +58,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
 
@@ -64,43 +67,54 @@ let precatchable_exception = function
   | Nametab.GlobalizationError _ -> true
   | _ -> false
 
-let raise_pretype_error (loc,env,sigma,te) =
-  Loc.raise loc (PretypeError(env,sigma,te))
+let raise_pretype_error ?loc (env,sigma,te) =
+  Loc.raise ?loc (PretypeError(env,sigma,te))
 
-let raise_located_type_error (loc,env,sigma,te) =
-  Loc.raise loc (PretypeError(env,sigma,TypingError te))
+let raise_type_error ?loc (env,sigma,te) =
+  Loc.raise ?loc (PretypeError(env,sigma,TypingError te))
 
+let error_actual_type ?loc env sigma {uj_val=c;uj_type=actty} expty reason =
+  let j = {uj_val=c;uj_type=actty} in
+  raise_pretype_error ?loc
+    (env, sigma, ActualTypeNotCoercible (j, expty, reason))
 
-let error_actual_type_loc loc env sigma {uj_val=c;uj_type=actty} expty reason =
+let error_actual_type_core ?loc env sigma {uj_val=c;uj_type=actty} expty =
   let j = {uj_val=c;uj_type=actty} in
-  raise_pretype_error
-    (loc, env, sigma, ActualTypeNotCoercible (j, expty, reason))
+  raise_type_error ?loc
+    (env, sigma, ActualType (j, expty))
+
+let error_cant_apply_not_functional ?loc env sigma rator randl =
+  raise_type_error ?loc
+    (env, sigma, CantApplyNonFunctional (rator, randl))
 
-let error_cant_apply_not_functional_loc loc env sigma rator randl =
-  raise_located_type_error
-    (loc, env, sigma, CantApplyNonFunctional (rator, Array.of_list randl))
+let error_cant_apply_bad_type ?loc env sigma (n,c,t) rator randl =
+  raise_type_error ?loc
+    (env, sigma,
+       CantApplyBadType ((n,c,t), rator, randl))
 
-let error_cant_apply_bad_type_loc loc env sigma (n,c,t) rator randl =
-  raise_located_type_error
-    (loc, env, sigma,
-       CantApplyBadType ((n,c,t), rator, Array.of_list randl))
+let error_ill_formed_branch ?loc env sigma c i actty expty =
+  raise_type_error
+    ?loc (env, sigma, IllFormedBranch (c, i, actty, expty))
 
-let error_ill_formed_branch_loc loc env sigma c i actty expty =
-  raise_located_type_error
-    (loc, env, sigma, IllFormedBranch (c, i, actty, expty))
+let error_number_branches ?loc env sigma cj expn =
+  raise_type_error ?loc (env, sigma, NumberBranches (cj, expn))
 
-let error_number_branches_loc loc env sigma cj expn =
-  raise_located_type_error (loc, env, sigma, NumberBranches (cj, expn))
+let error_case_not_inductive ?loc env sigma cj =
+  raise_type_error ?loc (env, sigma, CaseNotInductive cj)
 
-let error_case_not_inductive_loc loc env sigma cj =
-  raise_located_type_error (loc, env, sigma, CaseNotInductive cj)
+let error_ill_typed_rec_body ?loc env sigma i na jl tys =
+  raise_type_error ?loc
+    (env, sigma, IllTypedRecBody (i, na, jl, tys))
 
-let error_ill_typed_rec_body_loc loc env sigma i na jl tys =
-  raise_located_type_error
-    (loc, env, sigma, IllTypedRecBody (i, na, jl, tys))
+let error_elim_arity ?loc env sigma pi s c j a =
+  raise_type_error ?loc
+    (env, sigma, ElimArity (pi, s, c, j, a))
 
-let error_not_a_type_loc loc env sigma j =
-  raise_located_type_error (loc, env, sigma, NotAType j)
+let error_not_a_type ?loc env sigma j =
+  raise_type_error ?loc (env, sigma, NotAType j)
+
+let error_assumption ?loc env sigma j =
+  raise_type_error ?loc (env, sigma, BadAssumption j)
 
 (*s Implicit arguments synthesis errors. It is hard to find
     a precise location. *)
@@ -108,15 +122,12 @@ let error_not_a_type_loc loc env sigma j =
 let error_occur_check env sigma ev c =
   raise (PretypeError (env, sigma, UnifOccurCheck (ev,c)))
 
-let error_unsolvable_implicit loc env sigma evk explain =
-  Loc.raise loc
+let error_unsolvable_implicit ?loc env sigma evk explain =
+  Loc.raise ?loc
     (PretypeError (env, sigma, UnsolvableImplicit (evk, explain)))
 
-let error_cannot_unify_loc loc env sigma ?reason (m,n) =
-  Loc.raise loc (PretypeError (env, sigma,CannotUnify (m,n,reason)))
-
-let error_cannot_unify env sigma ?reason (m,n) =
-  raise (PretypeError (env, sigma,CannotUnify (m,n,reason)))
+let error_cannot_unify ?loc env sigma ?reason (m,n) =
+  Loc.raise ?loc (PretypeError (env, sigma,CannotUnify (m,n,reason)))
 
 let error_cannot_unify_local env sigma (m,n,sn) =
   raise (PretypeError (env, sigma,CannotUnifyLocal (m,n,sn)))
@@ -140,21 +151,21 @@ let error_non_linear_unification env sigma hdmeta t =
 
 (*s Ml Case errors *)
 
-let error_cant_find_case_type_loc loc env sigma expr =
-  raise_pretype_error (loc, env, sigma, CantFindCaseType expr)
+let error_cant_find_case_type ?loc env sigma expr =
+  raise_pretype_error ?loc (env, sigma, CantFindCaseType expr)
 
 (*s Pretyping errors *)
 
-let error_unexpected_type_loc loc env sigma actty expty =
-  raise_pretype_error (loc, env, sigma, UnexpectedType (actty, expty))
+let error_unexpected_type ?loc env sigma actty expty =
+  raise_pretype_error ?loc (env, sigma, UnexpectedType (actty, expty))
 
-let error_not_product_loc loc env sigma c =
-  raise_pretype_error (loc, env, sigma, NotProduct c)
+let error_not_product ?loc env sigma c =
+  raise_pretype_error ?loc (env, sigma, NotProduct c)
 
 (*s Error in conversion from AST to glob_constr *)
 
-let error_var_not_found_loc loc s =
-  raise_pretype_error (loc, empty_env, Evd.empty, VarNotFound s)
+let error_var_not_found ?loc s =
+  raise_pretype_error ?loc (empty_env, Evd.empty, VarNotFound s)
 
 (*s Typeclass errors *)
 
@@ -166,7 +177,7 @@ let unsatisfiable_constraints env evd ev comp =
   | Some ev ->
     let loc, kind = Evd.evar_source ev evd in
     let err = UnsatisfiableConstraints (Some (ev, kind), comp) in
-    Loc.raise loc (PretypeError (env,evd,err))
+    Loc.raise ?loc (PretypeError (env,evd,err))
 
 let unsatisfiable_exception exn =
   match exn with
diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli
index 880f48e5..6f14d025 100644
--- a/pretyping/pretype_errors.mli
+++ b/pretyping/pretype_errors.mli
@@ -1,27 +1,30 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
+open EConstr
 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
@@ -32,14 +35,16 @@ type position_reporting = (position * int) * constr
 
 type subterm_unification_error = bool * position_reporting * position_reporting * (constr * constr * unification_error) option
 
+type type_error = (constr, types) ptype_error
+
 type pretype_error =
   (** Old Case *)
   | CantFindCaseType of constr
   (** 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
@@ -56,7 +61,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
@@ -64,52 +69,60 @@ exception PretypeError of env * Evd.evar_map * pretype_error
 val precatchable_exception : exn -> bool
 
 (** Raising errors *)
-val error_actual_type_loc :
-  Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> constr ->
+val error_actual_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> constr ->
       unification_error -> 'b
 
-val error_cant_apply_not_functional_loc :
-  Loc.t -> env -> Evd.evar_map ->
-      unsafe_judgment -> unsafe_judgment list -> 'b
+val error_actual_type_core :
+  ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> constr -> 'b
+
+val error_cant_apply_not_functional :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
+      unsafe_judgment -> unsafe_judgment array -> 'b
 
-val error_cant_apply_bad_type_loc :
-  Loc.t -> env -> Evd.evar_map -> int * constr * constr ->
-      unsafe_judgment -> unsafe_judgment list -> 'b
+val error_cant_apply_bad_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> int * constr * constr ->
+      unsafe_judgment -> unsafe_judgment array -> 'b
 
-val error_case_not_inductive_loc :
-  Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
+val error_case_not_inductive :
+  ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
 
-val error_ill_formed_branch_loc :
-  Loc.t -> env -> Evd.evar_map ->
+val error_ill_formed_branch :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
       constr -> pconstructor -> constr -> constr -> 'b
 
-val error_number_branches_loc :
-  Loc.t -> env -> Evd.evar_map ->
+val error_number_branches :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
       unsafe_judgment -> int -> 'b
 
-val error_ill_typed_rec_body_loc :
-  Loc.t -> env -> Evd.evar_map ->
+val error_ill_typed_rec_body :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
       int -> Name.t array -> unsafe_judgment array -> types array -> 'b
 
-val error_not_a_type_loc :
-  Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
+val error_elim_arity :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
+      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
+
+val error_assumption :
+  ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
 
 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.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 ->
+val error_cannot_unify : ?loc:Loc.t -> env -> Evd.evar_map ->
   ?reason:unification_error -> constr * constr -> 'b
 
-val error_cannot_unify : env -> Evd.evar_map -> ?reason:unification_error ->
-  constr * constr -> 'b
-
 val error_cannot_unify_local : env -> Evd.evar_map -> constr * constr * constr -> 'b
 
 val error_cannot_find_well_typed_abstraction : env -> Evd.evar_map ->
@@ -126,24 +139,24 @@ val error_non_linear_unification : env -> Evd.evar_map ->
 
 (** {6 Ml Case errors } *)
 
-val error_cant_find_case_type_loc :
-  Loc.t -> env -> Evd.evar_map -> constr -> 'b
+val error_cant_find_case_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> constr -> 'b
 
 (** {6 Pretyping errors } *)
 
-val error_unexpected_type_loc :
-  Loc.t -> env -> Evd.evar_map -> constr -> constr -> 'b
+val error_unexpected_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> constr -> constr -> 'b
 
-val error_not_product_loc :
-  Loc.t -> env -> Evd.evar_map -> constr -> 'b
+val error_not_product :
+  ?loc:Loc.t -> env -> Evd.evar_map -> constr -> 'b
 
 (** {6 Error in conversion from AST to glob_constr } *)
 
-val error_var_not_found_loc : Loc.t -> Id.t -> 'b
+val error_var_not_found : ?loc:Loc.t -> Id.t -> 'b
 
 (** {6 Typeclass errors } *)
 
-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 4b6d10c6..c7db802f 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file contains the syntax-directed part of the type inference
@@ -27,12 +29,13 @@ open Util
 open Names
 open Evd
 open Term
-open Vars
 open Termops
-open Reductionops
 open Environ
+open EConstr
+open Vars
+open Reductionops
 open Type_errors
-open Typeops
+open Typing
 open Globnames
 open Nameops
 open Evarutil
@@ -41,25 +44,12 @@ open Pretype_errors
 open Glob_term
 open Glob_ops
 open Evarconv
-open Pattern
 open Misctypes
-open Sigma.Notations
-open Context.Named.Declaration
+open Ltac_pretype
+
+module NamedDecl = Context.Named.Declaration
 
 type typing_constraint = OfType of types | IsType | WithoutTypeConstraint
-type var_map = constr_under_binders Id.Map.t
-type uconstr_var_map = Glob_term.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_uconstrs : uconstr_var_map;
-  ltac_idents: Id.t Id.Map.t;
-  ltac_genargs : unbound_ltac_var_map;
-}
-type glob_constr_ltac_closure = ltac_var_map * glob_constr
-type pure_open_constr = evar_map * constr
-type 'a delayed_open =
-  { delayed : 'r. Environ.env -> 'r Sigma.t -> ('a, 'r) Sigma.sigma }
 
 (************************************************************************)
 (* This concerns Cases *)
@@ -77,47 +67,46 @@ type t = {
   (** Delay the computation of the evar extended environment *)
 }
 
-let get_extra env =
+let get_extra env sigma =
   let open Context.Named.Declaration in
   let ids = List.map get_id (named_context env) in
   let avoid = List.fold_right Id.Set.add ids Id.Set.empty in
-  Context.Rel.fold_outside push_rel_decl_to_named_context
-    (Environ.rel_context env) ~init:(empty_csubst, [], avoid, named_context env)
+  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)
 
-let make_env env = { env = env; extra = lazy (get_extra env) }
+let make_env env sigma = { env = env; extra = lazy (get_extra env sigma) }
 let rel_context env = rel_context env.env
 
-let push_rel d env = {
+let push_rel sigma d env = {
   env = push_rel d env.env;
-  extra = lazy (push_rel_decl_to_named_context d (Lazy.force env.extra));
+  extra = lazy (push_rel_decl_to_named_context sigma d (Lazy.force env.extra));
 }
 
-let pop_rel_context n env = make_env (pop_rel_context n env.env)
+let pop_rel_context n env sigma = make_env (pop_rel_context n env.env) sigma
 
-let push_rel_context ctx env = {
+let push_rel_context sigma ctx env = {
   env = push_rel_context ctx env.env;
-  extra = lazy (List.fold_right push_rel_decl_to_named_context ctx (Lazy.force env.extra));
+  extra = lazy (List.fold_right (fun d acc -> push_rel_decl_to_named_context sigma d acc) ctx (Lazy.force env.extra));
 }
 
 let lookup_named id env = lookup_named id env.env
 
 let e_new_evar env evdref ?src ?naming typ =
-  let subst2 subst vsubst c = csubst_subst subst (replace_vars vsubst c) in
   let open Context.Named.Declaration in
-  let inst_vars = List.map (fun d -> mkVar (get_id d)) (named_context env.env) 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 = Sigma.Unsafe.of_evar_map !evdref in
-  let Sigma (e, sigma, _) = new_evar_instance sign sigma typ' ?src ?naming instance in
-  evdref := Sigma.to_evar_map sigma;
+  let sigma = !evdref in
+  let (sigma, e) = new_evar_instance sign sigma typ' ?src ?naming instance in
+  evdref := sigma;
   e
 
-let push_rec_types (lna,typarray,_) env =
+let push_rec_types sigma (lna,typarray,_) env =
   let ctxt = Array.map2_i (fun i na t -> Context.Rel.Declaration.LocalAssum (na, lift i t)) lna typarray in
-  Array.fold_left (fun e assum -> push_rel assum e) env ctxt
+  Array.fold_left (fun e assum -> push_rel sigma assum e) env ctxt
 
 end
 
@@ -127,7 +116,11 @@ open ExtraEnv
 
 exception Found of int array
 
-let search_guard loc env possible_indexes fixdefs =
+let nf_fix sigma (nas, cs, ts) =
+  let inj c = EConstr.to_constr sigma c in
+  (nas, Array.map inj cs, Array.map inj ts)
+
+let search_guard ?loc env possible_indexes fixdefs =
   (* Standard situation with only one possibility for each fix. *)
   (* We treat it separately in order to get proper error msg. *)
   let is_singleton = function [_] -> true | _ -> false in
@@ -137,7 +130,7 @@ let search_guard loc env possible_indexes fixdefs =
     (try check_fix env fix
      with reraise ->
        let (e, info) = CErrors.push reraise in
-       let info = Loc.add_loc info loc in
+       let info = Option.cata (fun loc -> Loc.add_loc info loc) info loc in
        iraise (e, info));
     indexes
   else
@@ -160,7 +153,7 @@ let search_guard loc env possible_indexes fixdefs =
 	    with TypeError _ -> ())
 	 (List.combinations possible_indexes);
        let errmsg = "Cannot guess decreasing argument of fix." in
-	 user_err_loc (loc,"search_guard", Pp.str errmsg)
+	 user_err ?loc ~hdr:"search_guard" (Pp.str errmsg)
      with Found indexes -> indexes)
 
 (* To force universe name declaration before use *)
@@ -170,8 +163,7 @@ let is_strict_universe_declarations () = !strict_universe_declarations
 
 let _ =
   Goptions.(declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
+	  { optdepr  = false;
 	    optname  = "strict universe declaration";
 	    optkey   = ["Strict";"Universe";"Declaration"];
 	    optread  = is_strict_universe_declarations;
@@ -179,67 +171,86 @@ let _ =
 
 let _ =
   Goptions.(declare_bool_option
-	  { optsync  = true;
-            optdepr  = false;
+	  { optdepr  = false;
 	    optname  = "minimization to Set";
 	    optkey   = ["Universe";"Minimization";"ToSet"];
 	    optread  = Universes.is_set_minimization;
 	    optwrite = (:=) Universes.set_minimization })
-						  
+
 (** Miscellaneous interpretation functions *)
-let interp_universe_level_name evd (loc,s) =
-  let names, _ = Universes.global_universe_names () in
-    if CString.string_contains s "." then
-      match List.rev (CString.split '.' s) with
-      | [] -> anomaly (str"Invalid universe name " ++ str s)
-      | 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 (loc, "interp_universe_level_name",
-			     Pp.(str "Undeclared universe: " ++ str s))
+
+let interp_known_universe_level evd r =
+  let qid = Libnames.qualid_of_reference r in
+  try
+    match r.CAst.v with
+    | Libnames.Ident id -> Evd.universe_of_name evd id
+    | Libnames.Qualid _ -> raise Not_found
+  with Not_found ->
+    let univ, k = Nametab.locate_universe qid.CAst.v 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 *)
+    | {CAst.loc; v=Libnames.Qualid 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
+    | {CAst.loc; v=Libnames.Ident 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 -> 
-      let evd', l = interp_universe_level_name 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_universe_level loc evd = function
-  | None -> new_univ_level_variable ~loc univ_rigid evd
-  | Some (loc,s) -> interp_universe_level_name evd (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;
@@ -257,16 +268,36 @@ type inference_flags = {
    [sigma'] into those already in [sigma] or deriving from an evar in
    [sigma] by restriction, and the evars properly created in [sigma'] *)
 
+type frozen =
+| FrozenId of evar_info Evar.Map.t
+  (** No pending evars. We do not put a set here not to reallocate like crazy,
+      but the actual data of the map is not used, only keys matter. All
+      functions operating on this type must have the same behaviour on
+      [FrozenId map] and [FrozenProgress (Evar.Map.domain map, Evar.Set.empty)] *)
+| FrozenProgress of (Evar.Set.t * Evar.Set.t) Lazy.t
+  (** Proper partition of the evar map as described above. *)
+
 let frozen_and_pending_holes (sigma, sigma') =
-  let add_derivative_of evk evi acc =
-    match advance sigma' evk with None -> acc | Some evk' -> Evar.Set.add evk' acc in
-  let frozen = Evd.fold_undefined add_derivative_of sigma Evar.Set.empty in
-  let fold evk _ accu = if not (Evar.Set.mem evk frozen) then Evar.Set.add evk accu else accu in
-  let pending = Evd.fold_undefined fold sigma' Evar.Set.empty in
-  (frozen,pending)
+  let undefined0 = Evd.undefined_map sigma in
+  (** Fast path when the undefined evars where not modified *)
+  if undefined0 == Evd.undefined_map sigma' then
+    FrozenId undefined0
+  else
+    let data = lazy begin
+    let add_derivative_of evk evi acc =
+      match advance sigma' evk with None -> acc | Some evk' -> Evar.Set.add evk' acc in
+    let frozen = Evar.Map.fold add_derivative_of undefined0 Evar.Set.empty in
+    let fold evk _ accu = if not (Evar.Set.mem evk frozen) then Evar.Set.add evk accu else accu in
+    let pending = Evd.fold_undefined fold sigma' Evar.Set.empty in
+    (frozen, pending)
+    end in
+    FrozenProgress data
 
 let apply_typeclasses env evdref frozen fail_evar =
-  let filter_frozen evk = Evar.Set.mem evk frozen in
+  let filter_frozen = match frozen with
+  | FrozenId map -> fun evk -> Evar.Map.mem evk map
+  | FrozenProgress (lazy (frozen, _)) -> fun evk -> Evar.Set.mem evk frozen
+  in
   evdref := Typeclasses.resolve_typeclasses
      ~filter:(if Flags.is_program_mode () 
 	      then (fun evk evi -> Typeclasses.no_goals_or_obligations evk evi && not (filter_frozen evk))
@@ -276,13 +307,15 @@ let apply_typeclasses env evdref frozen fail_evar =
     evdref := Typeclasses.resolve_typeclasses
       ~filter:(fun evk evi -> Typeclasses.all_evars evk evi && not (filter_frozen evk)) ~split:true ~fail:false env !evdref
 
-let apply_inference_hook hook evdref pending =
+let apply_inference_hook hook evdref frozen = match frozen with
+| FrozenId _ -> ()
+| FrozenProgress (lazy (_, pending)) ->
   evdref := Evar.Set.fold (fun evk sigma ->
     if Evd.is_undefined sigma evk (* in particular not defined by side-effect *)
     then
       try
         let sigma, c = hook sigma evk in
-        Evd.define evk c sigma
+        Evd.define evk (EConstr.Unsafe.to_constr c) sigma
       with Exit ->
         sigma
     else
@@ -299,7 +332,9 @@ let check_typeclasses_instances_are_solved env current_sigma frozen =
   (* Naive way, call resolution again with failure flag *)
   apply_typeclasses env (ref current_sigma) frozen true
 
-let check_extra_evars_are_solved env current_sigma pending =
+let check_extra_evars_are_solved env current_sigma frozen = match frozen with
+| FrozenId _ -> ()
+| FrozenProgress (lazy (_, pending)) ->
   Evar.Set.iter
     (fun evk ->
       if not (Evd.is_defined current_sigma evk) then
@@ -307,67 +342,76 @@ let check_extra_evars_are_solved env current_sigma pending =
 	match k with
 	| Evar_kinds.ImplicitArg (gr, (i, id), false) -> ()
 	| _ ->
-	    error_unsolvable_implicit loc env current_sigma evk None) pending
+	    error_unsolvable_implicit ?loc env current_sigma evk None) pending
 
 (* [check_evars] fails if some unresolved evar remains *)
 
 let check_evars env initial_sigma sigma c =
   let rec proc_rec c =
-    match kind_of_term c with
-    | Evar (evk,_ as ev) ->
-        (match existential_opt_value sigma ev with
-        | Some c -> proc_rec c
-        | None ->
-	  if not (Evd.mem initial_sigma evk) then
-            let (loc,k) = evar_source evk sigma in
-	      match k with
-	      | Evar_kinds.ImplicitArg (gr, (i, id), false) -> ()
-	      | _ -> Pretype_errors.error_unsolvable_implicit loc env sigma evk None)
-      | _ -> Constr.iter proc_rec c
+    match EConstr.kind sigma c with
+    | Evar (evk, _) ->
+      if not (Evd.mem initial_sigma evk) then
+        let (loc,k) = evar_source evk sigma in
+        begin match k with
+          | Evar_kinds.ImplicitArg (gr, (i, id), false) -> ()
+          | _ -> Pretype_errors.error_unsolvable_implicit ?loc env sigma evk None
+        end
+    | _ -> EConstr.iter sigma proc_rec c
   in proc_rec c
 
-let check_evars_are_solved env current_sigma frozen pending =
+let check_evars_are_solved env current_sigma frozen =
   check_typeclasses_instances_are_solved env current_sigma frozen;
   check_problems_are_solved env current_sigma;
-  check_extra_evars_are_solved env current_sigma pending
+  check_extra_evars_are_solved env current_sigma frozen
 
 (* Try typeclasses, hooks, unification heuristics ... *)
 
-let solve_remaining_evars flags env current_sigma pending =
-  let frozen,pending = frozen_and_pending_holes pending in
+let solve_remaining_evars flags env current_sigma init_sigma =
+  let frozen = frozen_and_pending_holes (init_sigma, current_sigma) in
   let evdref = ref current_sigma in
   if flags.use_typeclasses then apply_typeclasses env evdref frozen false;
   if Option.has_some flags.use_hook then
-    apply_inference_hook (Option.get flags.use_hook env) evdref pending;
+    apply_inference_hook (Option.get flags.use_hook env) evdref frozen;
   if flags.solve_unification_constraints then apply_heuristics env evdref false;
-  if flags.fail_evar then check_evars_are_solved env !evdref frozen pending;
+  if flags.fail_evar then check_evars_are_solved env !evdref frozen;
   !evdref
 
-let check_evars_are_solved env current_sigma pending =
-  let frozen,pending = frozen_and_pending_holes pending in
-  check_evars_are_solved env current_sigma frozen pending
+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 sigma = solve_remaining_evars flags env sigma (initial_sigma, sigma) in
+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
-
-(* Allow references to syntactically nonexistent variables (i.e., if applied on an inductive) *)
-let allow_anonymous_refs = ref false
+  sigma,c,cty
+
+let adjust_evar_source evdref na c =
+  match na, kind !evdref c with
+  | Name id, Evar (evk,args) ->
+     let evi = Evd.find !evdref evk in
+     begin match evi.evar_source with
+     | loc, Evar_kinds.QuestionMark (b,Anonymous) ->
+        let src = (loc,Evar_kinds.QuestionMark (b,na)) in
+        let (evd, evk') = restrict_evar !evdref evk (evar_filter evi) ~src None in
+        evdref := evd;
+        mkEvar (evk',args)
+     | _ -> c
+     end
+  | _, _ -> c
 
 (* coerce to tycon if any *)
-let inh_conv_coerce_to_tycon resolve_tc loc env evdref j = function
+let inh_conv_coerce_to_tycon ?loc resolve_tc env evdref j = function
   | None -> j
   | Some t ->
-      evd_comb2 (Coercion.inh_conv_coerce_to resolve_tc loc env.ExtraEnv.env) evdref j t
+      evd_comb2 (Coercion.inh_conv_coerce_to ?loc resolve_tc env.ExtraEnv.env) evdref j t
 
 let check_instance loc subst = function
   | [] -> ()
   | (id,_) :: _ ->
       if List.mem_assoc id subst then
-        user_err_loc (loc,"",pr_id id ++ str "appears more than once.")
+        user_err ?loc  (Id.print id ++ str "appears more than once.")
       else
-        user_err_loc (loc,"",str "No such variable in the signature of the existential variable: " ++ pr_id id ++ str ".")
+        user_err ?loc  (str "No such variable in the signature of the existential variable: " ++ Id.print id ++ str ".")
 
 (* used to enforce a name in Lambda when the type constraints itself
    is named, hence possibly dependent *)
@@ -376,18 +420,7 @@ let orelse_name name name' = match name with
   | Anonymous -> name'
   | _ -> name
 
-let ltac_interp_name { ltac_idents ; ltac_genargs } = function
-  | Anonymous -> Anonymous
-  | Name id as n ->
-      try Name (Id.Map.find id ltac_idents)
-      with Not_found ->
-        if Id.Map.mem id ltac_genargs then
-          errorlabstrm "" (str"Ltac variable"++spc()++ pr_id id ++
-                           spc()++str"is not bound to an identifier."++spc()++
-                           str"It cannot be used in a binder.")
-        else n
-
-let ltac_interp_name_env k0 lvar env =
+let ltac_interp_name_env k0 lvar env sigma =
   (* envhd is the initial part of the env when pretype was called first *)
   (* (in practice is is probably 0, but we have to grant the
      specification of pretype which accepts to start with a non empty
@@ -398,20 +431,20 @@ let ltac_interp_name_env k0 lvar env =
   let open Context.Rel.Declaration in
   let ctxt' = List.smartmap (map_name (ltac_interp_name lvar)) ctxt in
   if List.equal (fun d1 d2 -> Name.equal (get_name d1) (get_name d2)) ctxt ctxt' then env
-  else push_rel_context ctxt' (pop_rel_context n env)
+  else push_rel_context sigma ctxt' (pop_rel_context n env sigma)
 
 let invert_ltac_bound_name lvar env id0 id =
   let id' = Id.Map.find id lvar.ltac_idents in
   try mkRel (pi1 (lookup_rel_id id' (rel_context env)))
   with Not_found ->
-    errorlabstrm "" (str "Ltac variable " ++ pr_id id0 ++
-		       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 =
   try Retyping.get_type_of ~lax:true env.ExtraEnv.env sigma c
   with Retyping.RetypeError _ ->
-    errorlabstrm ""
+    user_err 
       (str "Cannot reinterpret " ++ quote (print_constr c) ++
        str " in the current environment.")
 
@@ -422,7 +455,7 @@ let pretype_id pretype k0 loc env evdref lvar id =
     let (n,_,typ) = lookup_rel_id id (rel_context env) in
       { uj_val  = mkRel n; uj_type = lift n typ }
   with Not_found ->
-    let env = ltac_interp_name_env k0 lvar env in
+    let env = ltac_interp_name_env k0 lvar env !evdref in
     (* Check if [id] is an ltac variable *)
     try
       let (ids,c) = Id.Map.find id lvar.ltac_constrs in
@@ -447,136 +480,154 @@ let pretype_id pretype k0 loc env evdref lvar id =
 	(* and build a nice error message *)
       if Id.Map.mem id lvar.ltac_genargs then begin
         let Geninterp.Val.Dyn (typ, _) = Id.Map.find id lvar.ltac_genargs in
-	user_err_loc (loc,"",
-          str "Variable " ++ pr_id id ++ str " should be bound to a term but is \
+	user_err ?loc 
+         (str "Variable " ++ 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 *)
       try
-	  { uj_val  = mkVar id; uj_type = (get_type (lookup_named id env)) }
+	  { uj_val  = mkVar id; uj_type = NamedDecl.get_type (lookup_named id env) }
       with Not_found ->
 	  (* [id] not found, standard error message *)
-	  error_var_not_found_loc loc id
-
-let evar_kind_of_term sigma c =
-  kind_of_term (whd_evar sigma c)
+	  error_var_not_found ?loc id
 
 (*************************************************************************)
 (* Main pretyping function                                               *)
 
-let interp_universe_level_name loc evd l =
-  match l with
+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
-  | GType s -> interp_universe_level loc evd s
+  | GType s -> interp_level_info ?loc evd s
+
+let interp_instance ?loc evd ~len l =
+  if len != List.length l then
+    user_err ?loc ~hdr:"pretype"
+      (str "Universe instance should have length " ++ int len)
+  else
+    let evd, l' =
+      List.fold_left
+        (fun (evd, univs) l ->
+	  let evd, l = interp_glob_level ?loc evd l in
+	  (evd, l :: univs)) (evd, [])
+        l
+    in
+    if List.exists (fun l -> Univ.Level.is_prop l) l' then
+      user_err ?loc ~hdr:"pretype"
+	(str "Universe instances cannot contain Prop, polymorphic" ++
+	   str " universe instances must be greater or equal to Set.");
+    evd, Some (Univ.Instance.of_array (Array.of_list (List.rev l')))
 
-let pretype_global loc rigid env evd gr us = 
+let pretype_global ?loc rigid env evd gr us = 
   let evd, instance = 
     match us with
     | None -> evd, None
     | Some l -> 
-       let _, ctx = Universes.unsafe_constr_of_global gr in
-       let arr = Univ.Instance.to_array (Univ.UContext.instance ctx) in
-       let len = Array.length arr in
-       if len != List.length l then
-	 user_err_loc (loc, "pretype", 
-		       str "Universe instance should have length " ++ int len)
-       else
-	 let evd, l' = List.fold_left (fun (evd, univs) l -> 
-	    let evd, l = interp_universe_level_name loc evd l in
-	      (evd, l :: univs)) (evd, []) l
-	 in
-	 if List.exists (fun l -> Univ.Level.is_prop l) l' then
-	   user_err_loc (loc, "pretype",
-		 str "Universe instances cannot contain Prop, polymorphic" ++
-		   str " universe instances must be greater or equal to Set.");
-	 evd, Some (Univ.Instance.of_array (Array.of_list (List.rev l')))
+       let _, ctx = Global.constr_of_global_in_context env.ExtraEnv.env gr in
+       let len = Univ.AUContext.size ctx in
+       interp_instance ?loc evd ~len l
   in
-    Evd.fresh_global ~loc ~rigid ?names:instance env.ExtraEnv.env evd gr
+  let (sigma, c) = Evd.fresh_global ?loc ~rigid ?names:instance env.ExtraEnv.env evd gr in
+  (sigma, EConstr.of_constr c)
 
-let pretype_ref loc evdref env ref us =
+let pretype_ref ?loc evdref env ref us =
   match ref with
   | VarRef id ->
       (* Section variable *)
-      (try make_judge (mkVar id) (get_type (lookup_named id env))
+      (try make_judge (mkVar id) (NamedDecl.get_type (lookup_named id env))
        with Not_found ->
          (* This may happen if env is a goal env and section variables have
             been cleared - section variables should be different from goal
             variables *)
-         Pretype_errors.error_var_not_found_loc loc id)
+         Pretype_errors.error_var_not_found ?loc id)
   | ref ->
-    let evd, c = pretype_global loc univ_flexible env !evdref ref us in
+    let evd, c = pretype_global ?loc univ_flexible env !evdref ref us in
     let () = evdref := evd in
-    let ty = Typing.unsafe_type_of env.ExtraEnv.env evd c in
+    let ty = unsafe_type_of env.ExtraEnv.env evd c in
       make_judge c ty
 
-let judge_of_Type loc evd s =
-  let evd, s = interp_universe ~loc evd s in
+let judge_of_Type ?loc evd s =
+  let evd, s = interp_universe ?loc evd s in
   let judge = 
     { uj_val = mkSort (Type s); uj_type = mkSort (Type (Univ.super s)) }
   in
     evd, judge
 
-let pretype_sort loc evdref = function
+let pretype_sort ?loc evdref = function
   | GProp -> judge_of_prop
   | GSet -> judge_of_set
-  | GType s -> evd_comb1 (judge_of_Type loc) evdref s
+  | GType s -> evd_comb1 (judge_of_Type ?loc) evdref s
 
 let new_type_evar env evdref loc =
-  let sigma = Sigma.Unsafe.of_evar_map !evdref in
-  let Sigma ((e, _), sigma, _) =
+  let sigma = !evdref in
+  let (sigma, (e, _)) =
     Evarutil.new_type_evar env.ExtraEnv.env sigma
       univ_flexible_alg ~src:(loc,Evar_kinds.InternalHole)
   in
-  evdref := Sigma.to_evar_map sigma;
+  evdref := sigma;
   e
 
-let (f_genarg_interp, genarg_interp_hook) = Hook.make ()
+module ConstrInterpObj =
+struct
+  type ('r, 'g, 't) obj =
+    unbound_ltac_var_map -> env -> evar_map -> types -> 'g -> constr * evar_map
+  let name = "constr_interp"
+  let default _ = None
+end
+
+module ConstrInterp = Genarg.Register(ConstrInterpObj)
+
+let register_constr_interp0 = ConstrInterp.register0
 
 (* [pretype tycon env evdref lvar lmeta cstr] attempts to type [cstr] *)
 (* in environment [env], with existential variables [evdref] and *)
 (* the type constraint tycon *)
 
 let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdref (lvar : ltac_var_map) t =
-  let inh_conv_coerce_to_tycon = inh_conv_coerce_to_tycon resolve_tc in
+  let inh_conv_coerce_to_tycon ?loc = inh_conv_coerce_to_tycon ?loc resolve_tc in
   let pretype_type = pretype_type k0 resolve_tc in
   let pretype = pretype k0 resolve_tc in
   let open Context.Rel.Declaration in
-  match t with
-  | GRef (loc,ref,u) ->
-      inh_conv_coerce_to_tycon loc env evdref
-	(pretype_ref loc evdref env ref u)
+  let loc = t.CAst.loc in
+  match DAst.get t with
+  | GRef (ref,u) ->
+      inh_conv_coerce_to_tycon ?loc env evdref
+	(pretype_ref ?loc evdref env ref u)
 	tycon
 
-  | GVar (loc, id) ->
-    inh_conv_coerce_to_tycon loc env evdref
+  | GVar id ->
+    inh_conv_coerce_to_tycon ?loc env evdref
       (pretype_id (fun e r l t -> pretype tycon e r l t) k0 loc env evdref lvar id)
       tycon
 
-  | GEvar (loc, id, inst) ->
+  | GEvar (id, inst) ->
       (* Ne faudrait-il pas s'assurer que hyps est bien un
 	 sous-contexte du contexte courant, et qu'il n'y a pas de Rel "caché" *)
       let evk =
         try Evd.evar_key id !evdref
         with Not_found ->
-          user_err_loc (loc,"",str "Unknown existential variable.") in
+          user_err ?loc  (str "Unknown existential variable.") in
       let hyps = evar_filtered_context (Evd.find !evdref evk) in
       let args = pretype_instance k0 resolve_tc env evdref lvar loc hyps evk inst in
       let c = mkEvar (evk, args) in
       let j = (Retyping.get_judgment_of env.ExtraEnv.env !evdref c) in
-	inh_conv_coerce_to_tycon loc env evdref j tycon
+	inh_conv_coerce_to_tycon ?loc env evdref j tycon
 
-  | GPatVar (loc,(someta,n)) ->
-    let env = ltac_interp_name_env k0 lvar env in
+  | GPatVar kind ->
+    let env = ltac_interp_name_env k0 lvar env !evdref in
     let ty =
       match tycon with
       | Some ty -> ty
       | None -> new_type_evar env evdref loc in
-    let k = Evar_kinds.MatchingVar (someta,n) in
+    let k = Evar_kinds.MatchingVar kind in
       { uj_val = e_new_evar env evdref ~src:(loc,k) ty; uj_type = ty }
 
-  | GHole (loc, k, naming, None) ->
-      let env = ltac_interp_name_env k0 lvar env in
+  | GHole (k, naming, None) ->
+      let env = ltac_interp_name_env k0 lvar env !evdref in
       let ty =
         match tycon with
         | Some ty -> ty
@@ -584,37 +635,40 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
           new_type_evar env evdref loc in
         { uj_val = e_new_evar env evdref ~src:(loc,k) ~naming ty; uj_type = ty }
 
-  | GHole (loc, k, _naming, Some arg) ->
-      let env = ltac_interp_name_env k0 lvar env in
+  | GHole (k, _naming, Some arg) ->
+      let env = ltac_interp_name_env k0 lvar env !evdref in
       let ty =
         match tycon with
         | Some ty -> ty
         | None ->
           new_type_evar env evdref loc in
+      let open Genarg in
       let ist = lvar.ltac_genargs in
-      let (c, sigma) = Hook.get f_genarg_interp ty env.ExtraEnv.env !evdref ist arg in
+      let GenArg (Glbwit tag, arg) = arg in
+      let interp = ConstrInterp.obj tag in
+      let (c, sigma) = interp ist env.ExtraEnv.env !evdref ty arg in
       let () = evdref := sigma in
       { uj_val = c; uj_type = ty }
 
-  | GRec (loc,fixkind,names,bl,lar,vdef) ->
+  | GRec (fixkind,names,bl,lar,vdef) ->
     let rec type_bl env ctxt = function
     [] -> ctxt
       | (na,bk,None,ty)::bl ->
         let ty' = pretype_type empty_valcon env evdref lvar ty in
 	let dcl = LocalAssum (na, ty'.utj_val) in
         let dcl' = LocalAssum (ltac_interp_name lvar na,ty'.utj_val) in
-	  type_bl (push_rel dcl env) (Context.Rel.add dcl' ctxt) bl
+	  type_bl (push_rel !evdref dcl env) (Context.Rel.add dcl' ctxt) bl
       | (na,bk,Some bd,ty)::bl ->
         let ty' = pretype_type empty_valcon env evdref lvar ty in
         let bd' = pretype (mk_tycon ty'.utj_val) env evdref lvar bd in
         let dcl = LocalDef (na, bd'.uj_val, ty'.utj_val) in
         let dcl' = LocalDef (ltac_interp_name lvar na, bd'.uj_val, ty'.utj_val) in
-	  type_bl (push_rel dcl env) (Context.Rel.add dcl' ctxt) bl in
+	  type_bl (push_rel !evdref dcl env) (Context.Rel.add dcl' ctxt) bl in
     let ctxtv = Array.map (type_bl env Context.Rel.empty) bl in
     let larj =
       Array.map2
         (fun e ar ->
-          pretype_type empty_valcon (push_rel_context e env) evdref lvar ar)
+          pretype_type empty_valcon (push_rel_context !evdref e env) evdref lvar ar)
         ctxtv lar in
     let lara = Array.map (fun a -> a.utj_val) larj in
     let ftys = Array.map2 (fun e a -> it_mkProd_or_LetIn a e) ctxtv lara in
@@ -630,23 +684,24 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
       | None -> true
     in
       (* Note: bodies are not used by push_rec_types, so [||] is safe *)
-    let newenv = push_rec_types (names,ftys,[||]) env in
+    let newenv = push_rec_types !evdref (names,ftys,[||]) env in
     let vdefj =
       Array.map2_i
 	(fun i ctxt def ->
              (* we lift nbfix times the type in tycon, because of
 	      * the nbfix variables pushed to newenv *)
           let (ctxt,ty) =
-	    decompose_prod_n_assum (Context.Rel.length ctxt)
+	    decompose_prod_n_assum !evdref (Context.Rel.length ctxt)
               (lift nbfix ftys.(i)) in
-          let nenv = push_rel_context ctxt newenv in
+          let nenv = push_rel_context !evdref ctxt newenv in
           let j = pretype (mk_tycon ty) nenv evdref lvar def in
 	    { uj_val = it_mkLambda_or_LetIn j.uj_val ctxt;
 	      uj_type = it_mkProd_or_LetIn j.uj_type ctxt })
         ctxtv vdef in
-      Typing.check_type_fixpoint loc env.ExtraEnv.env evdref names ftys vdefj;
-      let ftys = Array.map (nf_evar !evdref) ftys in
-      let fdefs = Array.map (fun x -> nf_evar !evdref (j_val x)) vdefj in
+      Typing.check_type_fixpoint ?loc env.ExtraEnv.env evdref names ftys vdefj;
+      let nf c = nf_evar !evdref c in
+      let ftys = Array.map nf ftys in (** FIXME *)
+      let fdefs = Array.map (fun x -> nf (j_val x)) vdefj in
       let fixj = match fixkind with
 	| GFix (vn,i) ->
 	      (* First, let's find the guard indexes. *)
@@ -665,25 +720,26 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	  let fixdecls = (names,ftys,fdefs) in
           let indexes =
             search_guard
-              loc env.ExtraEnv.env possible_indexes fixdecls
+              ?loc env.ExtraEnv.env possible_indexes (nf_fix !evdref fixdecls)
           in
 	    make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i)
 	| GCoFix i ->
-	  let cofix = (i,(names,ftys,fdefs)) in
-            (try check_cofix env.ExtraEnv.env cofix
+          let fixdecls = (names,ftys,fdefs) in
+	  let cofix = (i, fixdecls) in
+            (try check_cofix env.ExtraEnv.env (i, nf_fix !evdref fixdecls)
              with reraise ->
                let (e, info) = CErrors.push reraise in
-               let info = Loc.add_loc info loc in
+               let info = Option.cata (Loc.add_loc info) info loc in
                iraise (e, info));
 	    make_judge (mkCoFix cofix) ftys.(i)
       in
-	inh_conv_coerce_to_tycon loc env evdref fixj tycon
+	inh_conv_coerce_to_tycon ?loc env evdref fixj tycon
 
-  | GSort (loc,s) ->
-    let j = pretype_sort loc evdref s in
-      inh_conv_coerce_to_tycon loc env evdref j tycon
+  | GSort s ->
+    let j = pretype_sort ?loc evdref s in
+      inh_conv_coerce_to_tycon ?loc env evdref j tycon
 
-  | GApp (loc,f,args) ->
+  | GApp (f,args) ->
     let fj = pretype empty_tycon env evdref lvar f in
     let floc = loc_of_glob_constr f in
     let length = List.length args in
@@ -691,24 +747,24 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	(* Bidirectional typechecking hint: 
 	   parameters of a constructor are completely determined
 	   by a typing constraint *)
-      if Flags.is_program_mode () && length > 0 && isConstruct fj.uj_val then
+      if Flags.is_program_mode () && length > 0 && isConstruct !evdref fj.uj_val then
 	match tycon with
 	| None -> []
 	| Some ty ->
-	  let ((ind, i), u) = destConstruct fj.uj_val in
+	  let ((ind, i), u) = destConstruct !evdref fj.uj_val in
 	  let npars = inductive_nparams ind in
 	    if Int.equal npars 0 then []
 	    else
 	      try
 	  	let IndType (indf, args) = find_rectype env.ExtraEnv.env !evdref ty in
 	  	let ((ind',u'),pars) = dest_ind_family indf in
-	  	  if eq_ind ind ind' then pars
+	  	  if eq_ind ind ind' then List.map EConstr.of_constr pars
 	  	  else (* Let the usual code throw an error *) []
 	      with Not_found -> []
       else []
     in
     let app_f = 
-      match kind_of_term fj.uj_val with
+      match EConstr.kind !evdref fj.uj_val with
       | Const (p, u) when Environ.is_projection p env.ExtraEnv.env ->
 	let p = Projection.make p false in
 	let pb = Environ.lookup_projection p env.ExtraEnv.env in
@@ -724,7 +780,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	let argloc = loc_of_glob_constr c in
 	let resj = evd_comb1 (Coercion.inh_app_fun resolve_tc env.ExtraEnv.env) evdref resj in
         let resty = whd_all env.ExtraEnv.env !evdref resj.uj_type in
-      	  match kind_of_term resty with
+      	  match EConstr.kind !evdref resty with
 	  | Prod (na,c1,c2) ->
 	    let tycon = Some c1 in
 	    let hj = pretype tycon env evdref lvar c in
@@ -736,57 +792,56 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 		  args, nf_evar !evdref (j_val hj)
 		else [], j_val hj
 	    in
+            let ujval = adjust_evar_source evdref na ujval in
 	    let value, typ = app_f n (j_val resj) ujval, subst1 ujval c2 in
 	    let j = { uj_val = value; uj_type = typ } in
 	      apply_rec env (n+1) j candargs rest
 		
 	  | _ ->
 	    let hj = pretype empty_tycon env evdref lvar c in
-	      error_cant_apply_not_functional_loc
-		(Loc.merge floc argloc) env.ExtraEnv.env !evdref
-	      	resj [hj]
+	      error_cant_apply_not_functional
+                ?loc:(Loc.merge_opt floc argloc) env.ExtraEnv.env !evdref
+                resj [|hj|]
     in
     let resj = apply_rec env 1 fj candargs args in
     let resj =
-      match evar_kind_of_term !evdref resj.uj_val with
+      match EConstr.kind !evdref resj.uj_val with
       | App (f,args) ->
-        let f = whd_evar !evdref f in
-          if is_template_polymorphic env.ExtraEnv.env f then
+          if is_template_polymorphic env.ExtraEnv.env !evdref f then
 	    (* Special case for inductive type applications that must be 
 	       refreshed right away. *)
-	    let sigma = !evdref in
-	    let c = mkApp (f,Array.map (whd_evar sigma) args) in
+	    let c = mkApp (f, args) in
 	    let c = evd_comb1 (Evarsolve.refresh_universes (Some true) env.ExtraEnv.env) evdref c in
 	    let t = Retyping.get_type_of env.ExtraEnv.env !evdref c in
 	      make_judge c (* use this for keeping evars: resj.uj_val *) t
 	  else resj
       | _ -> resj 
     in
-      inh_conv_coerce_to_tycon loc env evdref resj tycon
+      inh_conv_coerce_to_tycon ?loc env evdref resj tycon
 
-  | GLambda(loc,name,bk,c1,c2)      ->
+  | GLambda(name,bk,c1,c2)      ->
     let tycon' = evd_comb1
       (fun evd tycon ->
 	match tycon with
 	| None -> evd, tycon
 	| Some ty ->
-	  let evd, ty' = Coercion.inh_coerce_to_prod loc env.ExtraEnv.env evd ty in
+	  let evd, ty' = Coercion.inh_coerce_to_prod ?loc env.ExtraEnv.env evd ty in
 	    evd, Some ty')
       evdref tycon
     in
-    let (name',dom,rng) = evd_comb1 (split_tycon loc env.ExtraEnv.env) evdref tycon' in
+    let (name',dom,rng) = evd_comb1 (split_tycon ?loc env.ExtraEnv.env) evdref tycon' in
     let dom_valcon = valcon_of_tycon dom in
     let j = pretype_type dom_valcon env evdref lvar c1 in
     (* The name specified by ltac is used also to create bindings. So
        the substitution must also be applied on variables before they are
        looked up in the rel context. *)
     let var = LocalAssum (name, j.utj_val) in
-    let j' = pretype rng (push_rel var env) evdref lvar c2 in
+    let j' = pretype rng (push_rel !evdref var env) evdref lvar c2 in
     let name = ltac_interp_name lvar name in
     let resj = judge_of_abstraction env.ExtraEnv.env (orelse_name name name') j j' in
-      inh_conv_coerce_to_tycon loc env evdref resj tycon
+      inh_conv_coerce_to_tycon ?loc env evdref resj tycon
 
-  | GProd(loc,name,bk,c1,c2)        ->
+  | GProd(name,bk,c1,c2)        ->
     let j = pretype_type empty_valcon env evdref lvar c1 in
     (* The name specified by ltac is used also to create bindings. So
        the substitution must also be applied on variables before they are
@@ -797,7 +852,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
           { j with utj_val = lift 1 j.utj_val }
       | Name _ ->
         let var = LocalAssum (name, j.utj_val) in
-        let env' = push_rel var env in
+        let env' = push_rel !evdref var env in
           pretype_type empty_valcon env' evdref lvar c2
     in
     let name = ltac_interp_name lvar name in
@@ -806,18 +861,18 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
         judge_of_product env.ExtraEnv.env name j j'
       with TypeError _ as e ->
         let (e, info) = CErrors.push e in
-        let info = Loc.add_loc info loc in
+        let info = Option.cata (Loc.add_loc info) info loc in
         iraise (e, info) in
-      inh_conv_coerce_to_tycon loc env evdref resj tycon
+      inh_conv_coerce_to_tycon ?loc env evdref resj tycon
 
-  | GLetIn(loc,name,c1,c2)      ->
-    let j =
-      match c1 with
-      | GCast (loc, c, CastConv t) ->
-	let tj = pretype_type empty_valcon env evdref lvar t in
-	  pretype (mk_tycon tj.utj_val) env evdref lvar c
-      | _ -> pretype empty_tycon env evdref lvar c1
-    in
+  | GLetIn(name,c1,t,c2)      ->
+    let tycon1 =
+      match t with
+      | Some t ->
+	 mk_tycon (pretype_type empty_valcon env evdref lvar t).utj_val
+      | None ->
+         empty_tycon in
+    let j = pretype tycon1 env evdref lvar c1 in
     let t = evd_comb1 (Evarsolve.refresh_universes
       ~onlyalg:true ~status:Evd.univ_flexible (Some false) env.ExtraEnv.env)
       evdref j.uj_type in
@@ -826,28 +881,29 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
        looked up in the rel context. *)
     let var = LocalDef (name, j.uj_val, t) in
     let tycon = lift_tycon 1 tycon in
-    let j' = pretype tycon (push_rel var env) evdref lvar c2 in
+    let j' = pretype tycon (push_rel !evdref var env) evdref lvar c2 in
     let name = ltac_interp_name lvar name in
       { uj_val = mkLetIn (name, j.uj_val, t, j'.uj_val) ;
 	uj_type = subst1 j.uj_val j'.uj_type }
 
-  | GLetTuple (loc,nal,(na,po),c,d) ->
+  | GLetTuple (nal,(na,po),c,d) ->
     let cj = pretype empty_tycon env evdref lvar c in
     let (IndType (indf,realargs)) =
       try find_rectype env.ExtraEnv.env !evdref cj.uj_type
       with Not_found ->
 	let cloc = loc_of_glob_constr c in
-	  error_case_not_inductive_loc cloc env.ExtraEnv.env !evdref cj
+	  error_case_not_inductive ?loc:cloc env.ExtraEnv.env !evdref cj
     in
     let cstrs = get_constructors env.ExtraEnv.env indf in
     if not (Int.equal (Array.length cstrs) 1) then
-      user_err_loc (loc,"",str "Destructing let is only for inductive types" ++
+      user_err ?loc  (str "Destructing let is only for inductive types" ++
 	str " with one constructor.");
     let cs = cstrs.(0) in
     if not (Int.equal (List.length nal) cs.cs_nargs) then
-      user_err_loc (loc,"", str "Destructing let on this type expects " ++ 
+      user_err ?loc:loc (str "Destructing let on this type expects " ++ 
 	int cs.cs_nargs ++ str " variables.");
     let fsign, record = 
+      let set_name na d = set_name na (map_rel_decl EConstr.of_constr d) in
       match get_projections env.ExtraEnv.env indf with
       | None ->
 	 List.map2 set_name (List.rev nal) cs.cs_args, false
@@ -855,6 +911,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	let rec aux n k names l =
 	  match names, l with
 	  | na :: names, (LocalAssum (_,t) :: l) ->
+            let t = EConstr.of_constr t in
 	    let proj = Projection.make ps.(cs.cs_nargs - k) true in
 	    LocalDef (na, lift (cs.cs_nargs - n) (mkProj (proj, cj.uj_val)), t)
 	    :: aux (n+1) (k + 1) names l
@@ -863,6 +920,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
+                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
@@ -873,26 +933,29 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	  mkCase (ci, p, cj.uj_val,[|f|]) 
       else it_mkLambda_or_LetIn f fsign
     in
-    let env_f = push_rel_context fsign env in
+    let env_f = push_rel_context !evdref fsign env in
       (* Make dependencies from arity signature impossible *)
     let arsgn =
       let arsgn,_ = get_arity env.ExtraEnv.env indf in
-	if not !allow_anonymous_refs then
-	  List.map (set_name Anonymous) arsgn
-	else arsgn
+      List.map (set_name Anonymous) arsgn
     in
-      let psign = LocalAssum (na, build_dependent_inductive env.ExtraEnv.env indf) :: arsgn in
+      let indt = build_dependent_inductive env.ExtraEnv.env indf in
+      let psign = LocalAssum (na, indt) :: arsgn in (* For locating names in [po] *)
+      let predlvar = Cases.make_return_predicate_ltac_lvar !evdref na c cj.uj_val lvar in
+      let psign' = LocalAssum (ltac_interp_name predlvar na, indt) :: arsgn in
+      let psign' = List.map (fun d -> map_rel_decl EConstr.of_constr d) psign' in
+      let psign' = Namegen.name_context env.ExtraEnv.env !evdref psign' in (* For naming abstractions in [po] *)
+      let psign = List.map (fun d -> map_rel_decl EConstr.of_constr d) psign in
       let nar = List.length arsgn in
 	  (match po with
 	  | Some p ->
-	    let env_p = push_rel_context psign env in
-	    let pj = pretype_type empty_valcon env_p evdref lvar p in
+	    let env_p = push_rel_context !evdref psign env in
+	    let pj = pretype_type empty_valcon env_p evdref predlvar p in
 	    let ccl = nf_evar !evdref pj.utj_val in
-	    let psign = make_arity_signature env.ExtraEnv.env true indf in (* with names *)
-	    let p = it_mkLambda_or_LetIn ccl psign in
+	    let p = it_mkLambda_or_LetIn ccl psign' in
 	    let inst =
-	      (Array.to_list cs.cs_concl_realargs)
-	      @[build_dependent_constructor cs] in
+	      (Array.map_to_list EConstr.of_constr cs.cs_concl_realargs)
+	      @[EConstr.of_constr (build_dependent_constructor cs)] in
 	    let lp = lift cs.cs_nargs p in
 	    let fty = hnf_lam_applist env.ExtraEnv.env !evdref lp inst in
 	    let fj = pretype (mk_tycon fty) env_f evdref lvar d in
@@ -901,80 +964,84 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 		Typing.check_allowed_sort env.ExtraEnv.env !evdref ind cj.uj_val p;
 		obj ind p cj.uj_val fj.uj_val
 	    in
-	      { uj_val = v; uj_type = substl (realargs@[cj.uj_val]) ccl }
+	      { uj_val = v; uj_type = (substl (realargs@[cj.uj_val]) ccl) }
 
 	  | None ->
 	    let tycon = lift_tycon cs.cs_nargs tycon in
-	    let fj = pretype tycon env_f evdref lvar d in
+	    let fj = pretype tycon env_f evdref predlvar d in
 	    let ccl = nf_evar !evdref fj.uj_type in
 	    let ccl =
-	      if noccur_between 1 cs.cs_nargs ccl then
+	      if noccur_between !evdref 1 cs.cs_nargs ccl then
 		lift (- cs.cs_nargs) ccl
 	      else
-		error_cant_find_case_type_loc loc env.ExtraEnv.env !evdref
+		error_cant_find_case_type ?loc env.ExtraEnv.env !evdref
 		  cj.uj_val in
 		 (* let ccl = refresh_universes ccl in *)
-	    let p = it_mkLambda_or_LetIn (lift (nar+1) ccl) psign in
+	    let p = it_mkLambda_or_LetIn (lift (nar+1) ccl) psign' in
 	    let v =
 	      let ind,_ = dest_ind_family indf in
 		Typing.check_allowed_sort env.ExtraEnv.env !evdref ind cj.uj_val p;
 		obj ind p cj.uj_val fj.uj_val
 	    in { uj_val = v; uj_type = ccl })
 
-  | GIf (loc,c,(na,po),b1,b2) ->
+  | GIf (c,(na,po),b1,b2) ->
     let cj = pretype empty_tycon env evdref lvar c in
     let (IndType (indf,realargs)) =
       try find_rectype env.ExtraEnv.env !evdref cj.uj_type
       with Not_found ->
 	let cloc = loc_of_glob_constr c in
-	  error_case_not_inductive_loc cloc env.ExtraEnv.env !evdref cj in
+	  error_case_not_inductive ?loc:cloc env.ExtraEnv.env !evdref cj in
     let cstrs = get_constructors env.ExtraEnv.env indf in
       if not (Int.equal (Array.length cstrs) 2) then
-        user_err_loc (loc,"",
-		      str "If is only for inductive types with two constructors.");
+        user_err ?loc 
+		      (str "If is only for inductive types with two constructors.");
 
       let arsgn =
 	let arsgn,_ = get_arity env.ExtraEnv.env indf in
-	  if not !allow_anonymous_refs then
-	      (* Make dependencies from arity signature impossible *)
-	    List.map (set_name Anonymous) arsgn
-	  else arsgn
+        (* Make dependencies from arity signature impossible *)
+        List.map (set_name Anonymous) arsgn
       in
       let nar = List.length arsgn in
-      let psign = LocalAssum (na, build_dependent_inductive env.ExtraEnv.env indf) :: arsgn in
+      let indt = build_dependent_inductive env.ExtraEnv.env indf in
+      let psign = LocalAssum (na, indt) :: arsgn in (* For locating names in [po] *)
+      let predlvar = Cases.make_return_predicate_ltac_lvar !evdref na c cj.uj_val lvar in
+      let psign' = LocalAssum (ltac_interp_name predlvar na, indt) :: arsgn in
+      let psign' = List.map (fun d -> map_rel_decl EConstr.of_constr d) psign' in
+      let psign' = Namegen.name_context env.ExtraEnv.env !evdref psign' in (* For naming abstractions in [po] *)
+      let psign = List.map (fun d -> map_rel_decl EConstr.of_constr d) psign in
       let pred,p = match po with
 	| Some p ->
-	  let env_p = push_rel_context psign env in
-	  let pj = pretype_type empty_valcon env_p evdref lvar p in
+	  let env_p = push_rel_context !evdref psign env in
+	  let pj = pretype_type empty_valcon env_p evdref predlvar p in
 	  let ccl = nf_evar !evdref pj.utj_val in
-	  let pred = it_mkLambda_or_LetIn ccl psign in
-	  let typ = lift (- nar) (beta_applist (pred,[cj.uj_val])) in
+	  let pred = it_mkLambda_or_LetIn ccl psign' in
+	  let typ = lift (- nar) (beta_applist !evdref (pred,[cj.uj_val])) in
 	    pred, typ
 	| None ->
 	  let p = match tycon with
 	    | Some ty -> ty
 	    | None ->
-              let env = ltac_interp_name_env k0 lvar env in
+              let env = ltac_interp_name_env k0 lvar env !evdref in
               new_type_evar env evdref loc
 	  in
-	    it_mkLambda_or_LetIn (lift (nar+1) p) psign, p in
+	    it_mkLambda_or_LetIn (lift (nar+1) p) psign', p in
       let pred = nf_evar !evdref pred in
       let p = nf_evar !evdref p in
       let f cs b =
 	let n = Context.Rel.length cs.cs_args in
 	let pi = lift n pred in (* liftn n 2 pred ? *)
-	let pi = beta_applist (pi, [build_dependent_constructor cs]) in
+	let 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
+          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 =
-	  if not !allow_anonymous_refs then
-	    List.map (set_name Anonymous) cs.cs_args
-	  else
-	    List.map (map_name (function Name _ as n -> n
-				       | Anonymous -> Name Namegen.default_non_dependent_ident))
-		     cs.cs_args
-	in
-	let env_c = push_rel_context csgn env in
+          List.map (set_name Anonymous) cs_args
+        in
+	let env_c = push_rel_context !evdref csgn env in
 	let bj = pretype (mk_tycon pi) env_c evdref lvar b in
-	  it_mkLambda_or_LetIn bj.uj_val cs.cs_args in
+	  it_mkLambda_or_LetIn bj.uj_val cs_args in
       let b1 = f cstrs.(0) b1 in
       let b2 = f cstrs.(1) b2 in
       let v =
@@ -985,19 +1052,19 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	  mkCase (ci, pred, cj.uj_val, [|b1;b2|])
       in
       let cj = { uj_val = v; uj_type = p } in
-      inh_conv_coerce_to_tycon loc env evdref cj tycon
+      inh_conv_coerce_to_tycon ?loc env evdref cj tycon
 
-  | GCases (loc,sty,po,tml,eqns) ->
-    Cases.compile_cases loc sty
-      ((fun vtyc env evdref -> pretype vtyc (make_env env) evdref lvar),evdref)
-      tycon env.ExtraEnv.env (* loc *) (po,tml,eqns)
+  | GCases (sty,po,tml,eqns) ->
+    Cases.compile_cases ?loc sty
+      ((fun vtyc env evdref -> pretype vtyc (make_env env !evdref) evdref),evdref)
+      tycon env.ExtraEnv.env (* loc *) lvar (po,tml,eqns)
 
-  | GCast (loc,c,k) ->
+  | GCast (c,k) ->
     let cj =
       match k with
       | CastCoerce ->
 	let cj = pretype empty_tycon env evdref lvar c in
-	  evd_comb1 (Coercion.inh_coerce_to_base loc env.ExtraEnv.env) evdref cj
+	  evd_comb1 (Coercion.inh_coerce_to_base ?loc env.ExtraEnv.env) evdref cj
       | CastConv t | CastVM t | CastNative t ->
 	let k = (match k with CastVM _ -> VMcast | CastNative _ -> NATIVEcast | _ -> DEFAULTcast) in
 	let tj = pretype_type empty_valcon env evdref lvar t in
@@ -1009,13 +1076,13 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	  | VMcast ->
  	    let cj = pretype empty_tycon env evdref lvar c in
 	    let cty = nf_evar !evdref cj.uj_type and tval = nf_evar !evdref tval in
-	      if not (occur_existential cty || occur_existential tval) then
+	      if not (occur_existential !evdref cty || occur_existential !evdref tval) then
 		let (evd,b) = Reductionops.vm_infer_conv env.ExtraEnv.env !evdref cty tval in
 		if b then (evdref := evd; cj, tval)
 		else
-		  error_actual_type_loc loc env.ExtraEnv.env !evdref cj tval 
+		  error_actual_type ?loc env.ExtraEnv.env !evdref cj tval 
                       (ConversionFailed (env.ExtraEnv.env,cty,tval))
-	      else user_err_loc (loc,"",str "Cannot check cast with vm: " ++
+	      else user_err ?loc  (str "Cannot check cast with vm: " ++
 		str "unresolved arguments remain.")
 	  | NATIVEcast ->
  	    let cj = pretype empty_tycon env evdref lvar c in
@@ -1024,7 +1091,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	      let (evd,b) = Nativenorm.native_infer_conv env.ExtraEnv.env !evdref cty tval in
 	      if b then (evdref := evd; cj, tval)
 	      else
-                error_actual_type_loc loc env.ExtraEnv.env !evdref cj tval 
+                error_actual_type ?loc env.ExtraEnv.env !evdref cj tval
                   (ConversionFailed (env.ExtraEnv.env,cty,tval))
             end
 	  | _ -> 
@@ -1032,12 +1099,12 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	in
 	let v = mkCast (cj.uj_val, k, tval) in
 	  { uj_val = v; uj_type = tval }
-    in inh_conv_coerce_to_tycon loc env evdref cj tycon
+    in inh_conv_coerce_to_tycon ?loc env evdref cj tycon
 
 and pretype_instance k0 resolve_tc env evdref lvar loc hyps evk update =
   let f decl (subst,update) =
-    let id = get_id decl in
-    let t = replace_vars subst (get_type decl) in
+    let id = NamedDecl.get_id decl in
+    let t = replace_vars subst (EConstr.of_constr (NamedDecl.get_type decl)) in
     let c, update =
       try
         let c = List.assoc id update in
@@ -1046,66 +1113,75 @@ and pretype_instance k0 resolve_tc env evdref lvar loc hyps evk update =
       with Not_found ->
       try
         let (n,_,t') = lookup_rel_id id (rel_context env) in
-        if is_conv env.ExtraEnv.env !evdref t t' then mkRel n, update else raise Not_found
+        if is_conv env.ExtraEnv.env !evdref t (lift n t') then mkRel n, update else raise Not_found
       with Not_found ->
       try
-        let t' = lookup_named id env |> get_type in
+        let t' = env |> lookup_named id |> NamedDecl.get_type in
         if is_conv env.ExtraEnv.env !evdref t t' then mkVar id, update else raise Not_found
       with Not_found ->
-        user_err_loc (loc,"",str "Cannot interpret " ++
+        user_err ?loc  (str "Cannot interpret " ++
           pr_existential_key !evdref evk ++
-          str " in current context: no binding for " ++ pr_id id ++ str ".") in
+          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
-  | GHole (loc, knd, naming, None) ->
+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 =
 	     let sigma =  !evdref in
 	     let t = Retyping.get_type_of env.ExtraEnv.env sigma v in
-	       match kind_of_term (whd_all env.ExtraEnv.env sigma t) with
-               | Sort s -> s
-               | Evar ev when is_Type (existential_type sigma ev) ->
+	       match EConstr.kind sigma (whd_all env.ExtraEnv.env sigma t) with
+               | Sort s -> ESorts.kind sigma s
+               | 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")
+               | _ -> anomaly (Pp.str "Found a type constraint which is not a type.")
            in
-	     { utj_val = v;
-	       utj_type = s }
+           (* Correction of bug #5315 : we need to define an evar for *all* holes *)
+           let evkt = e_new_evar env evdref ~src:(loc, knd) ~naming (mkSort s) in
+           let ev,_ = destEvar !evdref evkt in
+           evdref := Evd.define ev (to_constr !evdref v) !evdref;
+           (* End of correction of bug #5315 *)
+           { utj_val = v;
+	     utj_type = s }
        | None ->
-           let env = ltac_interp_name_env k0 lvar env in
+           let env = ltac_interp_name_env k0 lvar env !evdref in
 	   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
+      let tj = evd_comb1 (Coercion.inh_coerce_to_sort ?loc env.ExtraEnv.env) evdref j in
 	match valcon with
 	| None -> tj
 	| Some v ->
 	    if e_cumul env.ExtraEnv.env evdref v tj.utj_val then tj
 	    else
-	      error_unexpected_type_loc
-                (loc_of_glob_constr c) env.ExtraEnv.env !evdref tj.utj_val v
+	      error_unexpected_type
+                ?loc:(loc_of_glob_constr c) env.ExtraEnv.env !evdref tj.utj_val v
 
 let ise_pretype_gen flags env sigma lvar kind c =
-  let env = make_env env in
+  let 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;
@@ -1124,40 +1200,9 @@ let no_classes_no_fail_inference_flags = {
 let all_and_fail_flags = default_inference_flags true
 let all_no_fail_flags = default_inference_flags false
 
-let empty_lvar : ltac_var_map = {
-  ltac_constrs = Id.Map.empty;
-  ltac_uconstrs = Id.Map.empty;
-  ltac_idents = Id.Map.empty;
-  ltac_genargs = Id.Map.empty;
-}
-
-let on_judgment f j =
-  let c = mkCast(j.uj_val,DEFAULTcast, j.uj_type) in
-  let (c,_,t) = destCast (f c) in
-  {uj_val = c; uj_type = t}
-
-let understand_judgment env sigma c =
-  let env = make_env env in
-  let evdref = ref sigma in
-  let k0 = Context.Rel.length (rel_context env) in
-  let j = pretype k0 true empty_tycon env evdref empty_lvar c in
-  let j = on_judgment (fun c ->
-    let evd, c = process_inference_flags all_and_fail_flags env.ExtraEnv.env sigma (!evdref,c) in 
-      evdref := evd; c) j
-  in j, Evd.evar_universe_context !evdref
-
-let understand_judgment_tcc env evdref c =
-  let env = make_env env in
-  let k0 = Context.Rel.length (rel_context env) in
-  let j = pretype k0 true empty_tycon env evdref empty_lvar c in
-  on_judgment (fun c ->
-    let (evd,c) = process_inference_flags all_no_fail_flags env.ExtraEnv.env Evd.empty (!evdref,c) in
-    evdref := evd; c) j
-
 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, f = Evarutil.nf_evars_and_universes evd in
-    f c, Evd.evar_universe_context evd
+  let evd, c, _ = ise_pretype_gen flags env sigma lvar kind c in
+  c, Evd.evar_universe_context evd
 
 (** Entry points of the high-level type synthesis algorithm *)
 
@@ -1167,42 +1212,19 @@ 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 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_evars ?(flags=all_no_fail_flags) env evdref ?(expected_type=WithoutTypeConstraint) c =
-  let sigma, c = ise_pretype_gen flags env !evdref empty_lvar expected_type c in
-  evdref := sigma;
-  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 =
-  ise_pretype_gen flags env sigma lvar kind c
-
-let constr_flags = {
-  use_typeclasses = true;
-  solve_unification_constraints = true;
-  use_hook = None;
-  fail_evar = true;
-  expand_evars = true }
-
-(* Fully evaluate an untyped constr *)
-let type_uconstr ?(flags = constr_flags)
-  ?(expected_type = WithoutTypeConstraint) ist c =
-  { delayed = begin fun env sigma ->
-  let { closure; term } = c in
-  let vars = {
-    ltac_constrs = closure.typed;
-    ltac_uconstrs = closure.untyped;
-    ltac_idents = closure.idents;
-    ltac_genargs = Id.Map.empty;
-  } in
-  let sigma = Sigma.to_evar_map sigma in
-  let (sigma, c) = understand_ltac flags env sigma vars expected_type term in
-  Sigma.Unsafe.of_pair (c, sigma)
-  end }
+  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 =
-  pretype k0 resolve_tc typcon (make_env env) evdref lvar t
+  pretype k0 resolve_tc typcon (make_env env !evdref) evdref lvar t
 
 let pretype_type k0 resolve_tc valcon env evdref lvar t =
-  pretype_type k0 resolve_tc valcon (make_env env) evdref lvar t
+  pretype_type k0 resolve_tc valcon (make_env env !evdref) evdref lvar t
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 0f3f7c3c..415c4e17 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file implements type inference. It maps [glob_constr]
@@ -12,42 +14,24 @@
    into elementary ones, insertion of coercions and resolution of
    implicit arguments. *)
 
-open Names
-open Term
 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 *)
 
 val search_guard :
-  Loc.t -> env -> int list list -> rec_declaration -> int array
+  ?loc:Loc.t -> env -> int list list -> Constr.rec_declaration -> int array
 
 type typing_constraint = OfType of types | IsType | WithoutTypeConstraint
 
-type var_map = Pattern.constr_under_binders Id.Map.t
-type uconstr_var_map = Glob_term.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 *)
-}
-
-val empty_lvar : ltac_var_map
-
-type glob_constr_ltac_closure = ltac_var_map * glob_constr
-type pure_open_constr = evar_map * constr
-
-type inference_hook = env -> evar_map -> evar -> evar_map * constr
+type inference_hook = env -> evar_map -> Evar.t -> evar_map * constr
 
 type inference_flags = {
   use_typeclasses : bool;
@@ -57,9 +41,6 @@ type inference_flags = {
   expand_evars : bool
 }
 
-type 'a delayed_open =
-  { delayed : 'r. Environ.env -> 'r Sigma.t -> ('a, 'r) Sigma.sigma }
-
 val default_inference_flags : bool -> inference_flags
 
 val no_classes_no_fail_inference_flags : inference_flags
@@ -68,9 +49,6 @@ val all_no_fail_flags : inference_flags
 
 val all_and_fail_flags : inference_flags
 
-(** Allow references to syntactically nonexistent variables (i.e., if applied on an inductive) *)
-val allow_anonymous_refs : bool ref
-  
 (** Generic calls to the interpreter from glob_constr to open_constr;
     by default, inference_flags tell to use type classes and
     heuristics (but no external tactic solver hooks), as well as to
@@ -79,10 +57,12 @@ val allow_anonymous_refs : bool ref
     evar_map is modified explicitly or by side-effect. *)
 
 val understand_tcc : ?flags:inference_flags -> env -> evar_map ->
-  ?expected_type:typing_constraint -> glob_constr -> open_constr
+  ?expected_type:typing_constraint -> glob_constr -> evar_map * constr
 
-val understand_tcc_evars : ?flags:inference_flags -> env -> evar_map ref ->
-  ?expected_type:typing_constraint -> glob_constr -> 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 *)
 
@@ -98,7 +78,7 @@ val understand_tcc_evars : ?flags:inference_flags -> env -> evar_map ref ->
 
 val understand_ltac : inference_flags ->
   env -> evar_map -> ltac_var_map ->
-  typing_constraint -> glob_constr -> pure_open_constr
+  typing_constraint -> glob_constr -> evar_map * EConstr.t
 
 (** Standard call to get a constr from a glob_constr, resolving
     implicit arguments and coercions, and compiling pattern-matching;
@@ -106,24 +86,9 @@ val understand_ltac : inference_flags ->
     heuristics (but no external tactic solver hook), as well as to
     ensure that conversion problems are all solved and that no
     unresolved evar remains, expanding evars. *)
-
 val understand : ?flags:inference_flags -> ?expected_type:typing_constraint ->
   env -> evar_map -> glob_constr -> constr Evd.in_evar_universe_context
 
-(** Idem but returns the judgment of the understood term *)
-
-val understand_judgment : env -> evar_map -> 
-  glob_constr -> unsafe_judgment Evd.in_evar_universe_context
-
-(** Idem but do not fail on unresolved evars (type cl*)
-val understand_judgment_tcc : env -> evar_map ref ->
-  glob_constr -> unsafe_judgment
-
-val type_uconstr :
-  ?flags:inference_flags ->
-  ?expected_type:typing_constraint ->
-  Geninterp.interp_sign -> Glob_term.closed_glob_constr -> constr delayed_open
-
 (** Trying to solve remaining evars and remaining conversion problems
     possibly using type classes, heuristics, external tactic solver
     hook depending on given flags. *)
@@ -132,13 +97,13 @@ val type_uconstr :
    [pending], however, it can contain more evars than the pending ones. *)
 
 val solve_remaining_evars : inference_flags ->
-  env -> (* initial map *) evar_map -> (* map to solve *) pending -> evar_map
+  env -> (* current map *) evar_map -> (* initial map *) evar_map -> evar_map
 
 (** Checking evars and pending conversion problems are all solved,
     reporting an appropriate error message *)
 
 val check_evars_are_solved :
-  env -> (* current map: *) evar_map -> (* map to check: *) pending -> unit
+  env -> (* current map: *) evar_map -> (* initial map: *) evar_map -> unit
 
 (** [check_evars env initial_sigma extended_sigma c] fails if some
    new unresolved evar remains in [c] *)
@@ -156,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 genarg_interp_hook :
-  (types -> env -> evar_map -> unbound_ltac_var_map ->
-    Genarg.glob_generic_argument -> constr * evar_map) Hook.t
+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 c8b3307d..ae4ad0be 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/program.ml b/pretyping/program.ml
index 62aedcfb..52d940d8 100644
--- a/pretyping/program.ml
+++ b/pretyping/program.ml
@@ -1,34 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open CErrors
 open Util
-open Names
-open Term
 
-let make_dir l = DirPath.make (List.rev_map Id.of_string l)
-
-let find_reference locstr dir s =
-  let dp = make_dir dir in
-  let sp = Libnames.make_path dp (Id.of_string s) in
-  try Nametab.global_of_path sp
-  with Not_found ->
-    user_err_loc (Loc.ghost, "", str "Library " ++ Libnames.pr_dirpath dp ++
-      str " has to be required first.")
-
-let coq_reference locstr dir s = find_reference locstr ("Coq"::dir) s
-let coq_constant locstr dir s = Universes.constr_of_global (coq_reference locstr dir s)
-
-let init_constant dir s () = coq_constant "Program" dir s
-let init_reference dir s () = coq_reference "Program" dir s
+let init_reference dir s () = Coqlib.coq_reference  "Program" dir s
 
 let papp evdref r args = 
+  let open EConstr in
   let gr = delayed_force r in
     mkApp (Evarutil.e_new_global evdref gr, args)
 
@@ -54,20 +40,22 @@ let coq_eq_rect = init_reference ["Init"; "Logic"] "eq_rect"
 let coq_JMeq_ind = init_reference ["Logic";"JMeq"] "JMeq"
 let coq_JMeq_refl = init_reference ["Logic";"JMeq"] "JMeq_refl"
 
-let coq_not = init_constant ["Init";"Logic"] "not"
-let coq_and = init_constant ["Init";"Logic"] "and"
+let coq_not = init_reference ["Init";"Logic"] "not"
+let coq_and = init_reference ["Init";"Logic"] "and"
 
-let mk_coq_not x = mkApp (delayed_force coq_not, [| x |])
+let mk_coq_not sigma x =
+  let sigma, notc = Evarutil.new_global sigma (coq_not ()) in
+  sigma, EConstr.mkApp (notc, [| x |])
 
 let unsafe_fold_right f = function
     hd :: tl -> List.fold_right f tl hd
   | [] -> invalid_arg "unsafe_fold_right"
 
-let mk_coq_and l =
-  let and_typ = delayed_force coq_and in
-    unsafe_fold_right
+let mk_coq_and sigma l =
+  let sigma, and_typ = Evarutil.new_global sigma (coq_and ()) in
+  sigma, unsafe_fold_right
       (fun c conj ->
-	 mkApp (and_typ, [| c ; conj |]))
+	 EConstr.mkApp (and_typ, [| c ; conj |]))
       l
 
 (* true = transparent by default, false = opaque if possible *)
@@ -85,8 +73,7 @@ open Goptions
 
 let _ =
   declare_bool_option
-  { optsync  = true;
-    optdepr  = false;
+  { optdepr  = false;
     optname  = "preferred transparency of Program obligations";
     optkey   = ["Transparent";"Obligations"];
     optread  = get_proofs_transparency;
@@ -94,8 +81,7 @@ let _ =
 
 let _ =
   declare_bool_option
-  { optsync  = true;
-    optdepr  = false;
+  { optdepr  = false;
     optname  = "program cases";
     optkey   = ["Program";"Cases"];
     optread  = (fun () -> !program_cases);
@@ -103,8 +89,7 @@ let _ =
 
 let _ =
   declare_bool_option
-  { optsync  = true;
-    optdepr  = false;
+  { optdepr  = false;
     optname  = "program generalized coercion";
     optkey   = ["Program";"Generalized";"Coercion"];
     optread  = (fun () -> !program_generalized_coercion);
diff --git a/pretyping/program.mli b/pretyping/program.mli
index 023ff8ca..df0848ba 100644
--- a/pretyping/program.mli
+++ b/pretyping/program.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open Globnames
 
 (** A bunch of Coq constants used by Progam *)
@@ -32,8 +34,8 @@ val coq_eq_rect : unit -> global_reference
 val coq_JMeq_ind : unit -> global_reference
 val coq_JMeq_refl : unit -> global_reference
 
-val mk_coq_and : constr list -> constr
-val mk_coq_not : constr -> constr
+val mk_coq_and : Evd.evar_map -> constr list -> Evd.evar_map * constr
+val mk_coq_not : Evd.evar_map -> constr -> Evd.evar_map * constr
 
 (** Polymorphic application of delayed references *)
 val papp : Evd.evar_map ref -> (unit -> global_reference) -> constr array -> constr
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml
index 284af0cb..d070edea 100644
--- a/pretyping/recordops.ml
+++ b/pretyping/recordops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Amokrane Saïbi, Dec 1998 *)
@@ -19,7 +21,7 @@ open Pp
 open Names
 open Globnames
 open Nametab
-open Term
+open Constr
 open Libobject
 open Mod_subst
 open Reductionops
@@ -37,7 +39,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 +50,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
@@ -134,7 +136,7 @@ let find_projection = function
 
 type obj_typ = {
   o_DEF : constr;
-  o_CTX : Univ.ContextSet.t;
+  o_CTX : Univ.AUContext.t;
   o_INJ : int option;      (* position of trivial argument if any *)
   o_TABS : constr list;    (* ordered *)
   o_TPARAMS : constr list; (* ordered *)
@@ -144,7 +146,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,16 +173,20 @@ 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
           with e when CErrors.noncritical e -> raise Not_found
 	end
     | Rel n -> Default_cs, Some n, []
-    | Prod (_,a,b) when not (Termops.dependent (mkRel 1) b) -> Prod_cs, None, [a; Termops.pop b]
-    | Sort s -> Sort_cs (family_of_sort s), None, []
+    | Prod (_,a,b) when Vars.noccurn 1 b -> Prod_cs, None, [a; Vars.lift (-1) b]
+    | 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, []
@@ -189,27 +195,33 @@ let cs_pattern_of_constr t =
 
 let warn_projection_no_head_constant =
   CWarnings.create ~name:"projection-no-head-constant" ~category:"typechecker"
-         (fun (t,con_pp,proji_sp_pp) ->
+         (fun (sign,env,t,con,proji_sp) ->
+          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
+          let term_pp = Termops.print_constr_env env Evd.empty (EConstr.of_constr t) in
           strbrk "Projection value has no head constant: "
-          ++ Termops.print_constr t ++ strbrk " in canonical instance "  
+          ++ term_pp ++ strbrk " in canonical instance "
           ++ con_pp ++ str " of " ++ proji_sp_pp ++ strbrk ", ignoring it.")
 
 (* Intended to always succeed *)
 let compute_canonical_projections warn (con,ind) =
   let env = Global.env () in
-  let ctx = Univ.instantiate_univ_context (Environ.constant_context env con) in
-  let u = Univ.UContext.instance ctx in
+  let ctx = Environ.constant_context env con in
+  let u = Univ.make_abstract_instance ctx in
   let v = (mkConstU (con,u)) in
-  let ctx = Univ.ContextSet.of_context ctx in
   let c = Environ.constant_value_in env (con,u) in
-  let lt,t = Reductionops.splay_lam env Evd.empty c in
-  let lt = List.rev_map snd lt 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 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 *)
@@ -217,12 +229,10 @@ 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 ->
-                     let con_pp = Nametab.pr_global_env Id.Set.empty (ConstRef con)
-                      and proji_sp_pp = Nametab.pr_global_env Id.Set.empty (ConstRef proji_sp) in
-                     if warn then warn_projection_no_head_constant (t,con_pp,proji_sp_pp);
+                   if warn then warn_projection_no_head_constant (sign,env,t,con,proji_sp);
                    l
 	       end
 	   | _ -> l)
@@ -255,8 +265,8 @@ let add_canonical_structure warn o =
       in match ocs with
         | None -> object_table := Refmap.add proj ((pat,s)::l) !object_table;
         | Some (c, cs) ->
-              let old_can_s = (Termops.print_constr cs.o_DEF)
-              and new_can_s = (Termops.print_constr s.o_DEF) in
+              let old_can_s = (Termops.print_constr (EConstr.of_constr cs.o_DEF))
+              and new_can_s = (Termops.print_constr (EConstr.of_constr s.o_DEF)) in
               let prj = (Nametab.pr_global_env Id.Set.empty proj)
               and hd_val = (pr_cs_pattern cs_pat) in
               if warn then warn_redundant_canonical_projection (hd_val,prj,new_can_s,old_can_s))
@@ -278,7 +288,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;
@@ -290,29 +300,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 =
-  errorlabstrm "object_declare"
-    (Nameops.pr_id (basename_of_global ref) ++ str" is not a structure object.")
+let error_not_structure ref description =
+  user_err ~hdr:"object_declare"
+    (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 ctx = Environ.constant_context env sp in
-  let u = Univ.UContext.instance ctx 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
-  let body = snd (splay_lam (Global.env()) Evd.empty vc) in
-  let f,args = match kind_of_term body with
+    | 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 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 =
@@ -321,15 +342,26 @@ 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 = global_of_constr 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 hd = match kind_of_term arg with App (hd, _) -> hd | _ -> arg in
-      not (isConstruct hd)
+      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
   with Not_found -> false
diff --git a/pretyping/recordops.mli b/pretyping/recordops.mli
index a6a90c75..1f7b23c0 100644
--- a/pretyping/recordops.mli
+++ b/pretyping/recordops.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Globnames
 
 (** Operations concerning records and canonical structures *)
@@ -20,10 +22,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 +37,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,12 +54,12 @@ 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 = {
   o_DEF : constr;
-  o_CTX : Univ.ContextSet.t;
+  o_CTX : Univ.AUContext.t;
   o_INJ : int option;      (** position of trivial argument *)
   o_TABS : constr list;    (** ordered *)
   o_TPARAMS : constr list; (** ordered *)
@@ -65,13 +67,13 @@ 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.std_ppcmds
+val pr_cs_pattern : cs_pattern -> Pp.t
 
 val lookup_canonical_conversion : (global_reference * cs_pattern) -> constr * obj_typ
 val declare_canonical_structure : global_reference -> unit
 val is_open_canonical_projection :
-  Environ.env -> Evd.evar_map -> (constr * constr Reductionops.Stack.t) -> bool
+  Environ.env -> Evd.evar_map -> Reductionops.state -> bool
 val canonical_projections : unit ->
   ((global_reference * cs_pattern) * obj_typ) list
diff --git a/pretyping/redops.ml b/pretyping/redops.ml
index 7d65925e..90c3bdfa 100644
--- a/pretyping/redops.ml
+++ b/pretyping/redops.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Genredexpr
@@ -20,13 +22,13 @@ let make_red_flag l =
     | FZeta :: lf -> add_flag { red with rZeta = true } lf
     | FConst l :: lf ->
 	if red.rDelta then
-	  CErrors.error
-	    "Cannot set both constants to unfold and constants not to unfold";
+	  CErrors.user_err Pp.(str
+	    "Cannot set both constants to unfold and constants not to unfold");
         add_flag { red with rConst = union_consts red.rConst l } lf
     | FDeltaBut l :: lf ->
 	if red.rConst <> [] && not red.rDelta then
-	  CErrors.error
-	    "Cannot set both constants to unfold and constants not to unfold";
+	  CErrors.user_err Pp.(str
+	    "Cannot set both constants to unfold and constants not to unfold");
         add_flag
           { red with rConst = union_consts red.rConst l; rDelta = true }
           lf
diff --git a/pretyping/redops.mli b/pretyping/redops.mli
index f6d4d808..285931ec 100644
--- a/pretyping/redops.mli
+++ b/pretyping/redops.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Genredexpr
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 297f0a1a..360c6e86 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -1,20 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Names
-open Term
-open Vars
+open Constr
 open Termops
 open Univ
 open Evd
 open Environ
+open EConstr
+open Vars
 open Context.Rel.Declaration
 
 exception Elimconst
@@ -26,18 +29,63 @@ exception Elimconst
     their parameters in its stack.
 *)
 
-let refolding_in_reduction = ref false
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optdepr = false;
   Goptions.optname =
-    "Perform refolding of fixpoints/constants like cbn during reductions";
-  Goptions.optkey = ["Refolding";"Reduction"];
-  Goptions.optread = (fun () -> !refolding_in_reduction);
-  Goptions.optwrite = (fun a -> refolding_in_reduction:=a);
+    "Generate weak constraints between Irrelevant universes";
+  Goptions.optkey = ["Cumulativity";"Weak";"Constraints"];
+  Goptions.optread = (fun () -> not !UState.drop_weak_constraints);
+  Goptions.optwrite = (fun a -> UState.drop_weak_constraints:=not a);
 }
 
-let get_refolding_in_reduction () = !refolding_in_reduction
-let set_refolding_in_reduction = (:=) refolding_in_reduction
+
+(** Support for reduction effects *)
+
+open Mod_subst
+open Libobject
+
+type effect_name = string
+
+(** create a persistent set to store effect functions *)
+module ConstrMap = Map.Make (Constr)
+
+(* Table bindings a constant to an effect *)
+let constant_effect_table = Summary.ref ~name:"reduction-side-effect" ConstrMap.empty
+
+(* Table bindings function key to effective functions *)
+let effect_table = Summary.ref ~name:"reduction-function-effect" String.Map.empty
+
+(** a test to know whether a constant is actually the effect function *)
+let reduction_effect_hook env sigma termkey c =
+  try
+    let funkey = ConstrMap.find termkey !constant_effect_table in
+    let effect = String.Map.find funkey !effect_table in
+    effect env sigma (Lazy.force c)
+  with Not_found -> ()
+
+let cache_reduction_effect (_,(termkey,funkey)) =
+  constant_effect_table := ConstrMap.add termkey funkey !constant_effect_table
+
+let subst_reduction_effect (subst,(termkey,funkey)) =
+  (subst_mps subst termkey,funkey)
+
+let inReductionEffect : Constr.constr * string -> obj =
+  declare_object {(default_object "REDUCTION-EFFECT") with
+    cache_function = cache_reduction_effect;
+    open_function = (fun i o -> if Int.equal i 1 then cache_reduction_effect o);
+    subst_function = subst_reduction_effect;
+    classify_function = (fun o -> Substitute o) }
+
+let declare_reduction_effect funkey f =
+  if String.Map.mem funkey !effect_table then
+    CErrors.anomaly Pp.(str "Cannot redeclare effect function " ++ qstring funkey ++ str ".");
+  effect_table := String.Map.add funkey f !effect_table
+
+(** A function to set the value of the print function *)
+let set_reduction_effect x funkey =
+  let termkey = Universes.constr_of_global x in
+  Lib.add_anonymous_leaf (inReductionEffect (termkey,funkey))
+
 
 (** Machinery to custom the behavior of the reduction *)
 module ReductionBehaviour = struct
@@ -72,10 +120,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
@@ -156,6 +204,7 @@ end
 
 (** Machinery about stack of unfolded constants *)
 module Cst_stack = struct
+  open EConstr
 (** constant * params * args
 
 - constant applied to params = term in head applied to args
@@ -191,24 +240,24 @@ module Cst_stack = struct
     | (cst,params,[])::_ -> Some(cst,params)
     | _ -> None
 
-  let reference t = match best_cst t with
-    | Some (c, _) when Term.isConst c -> Some (fst (Term.destConst c))
+  let reference sigma t = match best_cst t with
+    | Some (c, _) when isConst sigma c -> Some (fst (destConst sigma c))
     | _ -> None
 
   (** [best_replace d cst_l c] makes the best replacement for [d]
       by [cst_l] in [c] *)
-  let best_replace d cst_l c =
+  let best_replace sigma d cst_l c =
     let reconstruct_head = List.fold_left
       (fun t (i,args) -> mkApp (t,Array.sub args i (Array.length args - i))) in
     List.fold_right
-      (fun (cst,params,args) t -> Termops.replace_term
+      (fun (cst,params,args) t -> Termops.replace_term sigma
 	(reconstruct_head d args)
 	(applist (cst, List.rev params))
 	t) cst_l c
 
   let pr l =
     let open Pp in
-    let p_c = Termops.print_constr in
+    let p_c c = Termops.print_constr c in
     prlist_with_sep pr_semicolon
       (fun (c,params,args) ->
 	hov 1 (str"(" ++ p_c c ++ str ")" ++ spc () ++ pr_sequence p_c params ++ spc () ++ str "(args:" ++
@@ -220,34 +269,36 @@ end
 (** The type of (machine) stacks (= lambda-bar-calculus' contexts) *)
 module Stack :
 sig
+  open EConstr
   type 'a app_node
-  val pr_app_node : ('a -> Pp.std_ppcmds) -> 'a app_node -> Pp.std_ppcmds
+  val pr_app_node : ('a -> Pp.t) -> 'a app_node -> Pp.t
 
   type cst_member =
     | Cst_const of pconstant
-    | Cst_proj of projection
+    | Cst_proj of Projection.t
 
   type 'a member =
   | App of 'a app_node
   | Case of case_info * 'a * 'a array * Cst_stack.t
-  | Proj of int * int * projection * Cst_stack.t
-  | Fix of fixpoint * 'a t * Cst_stack.t
+  | Proj of int * int * Projection.t * 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
-  val pr : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds
+
+  exception IncompatibleFold2
+
+  val pr : ('a -> Pp.t) -> 'a t -> Pp.t
   val empty : 'a t
   val is_empty : 'a t -> bool
   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) -> (fixpoint * int -> fixpoint * 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 : (constr -> constr) -> constr t -> constr t
+  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
@@ -258,10 +309,11 @@ sig
   val args_size : 'a t -> int
   val tail : int -> 'a t -> 'a t
   val nth : 'a t -> int -> 'a
-  val best_state : constr * constr t -> Cst_stack.t -> constr * constr t
-  val zip : ?refold:bool -> constr * constr t -> constr
+  val best_state : evar_map -> constr * constr t -> Cst_stack.t -> constr * constr t
+  val zip : ?refold:bool -> evar_map -> constr * constr t -> constr
 end =
 struct
+  open EConstr
   type 'a app_node = int * 'a array * int
   (* first releavnt position, arguments, last relevant position *)
 
@@ -280,16 +332,14 @@ struct
 
   type cst_member =
     | Cst_const of pconstant
-    | Cst_proj of projection
+    | Cst_proj of Projection.t
 
   type 'a member =
   | App of 'a app_node
-  | Case of Term.case_info * 'a * 'a array * Cst_stack.t
-  | Proj of int * int * projection * Cst_stack.t
-  | Fix of fixpoint * 'a t * Cst_stack.t
+  | Case of case_info * 'a * 'a array * Cst_stack.t
+  | Proj of int * int * Projection.t * 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 =
@@ -303,17 +353,15 @@ 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 Termops.print_constr f
+       str "ZFix(" ++ Termops.pr_fix pr_c f
        ++ pr_comma () ++ pr pr_c args ++ str ")"
     | Cst (mem,curr,remains,params,cst_l) ->
       str "ZCst(" ++ pr_cst_member pr_c mem ++ pr_comma () ++ int curr
       ++ 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
@@ -348,54 +396,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) ->
@@ -409,41 +445,31 @@ struct
       | (_,_) -> false in
     compare_rec 0 stk1 stk2
 
+  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 (Invalid_argument "Reductionops.Stack.fold2")
-    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)
@@ -460,18 +486,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
@@ -496,14 +519,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 =
@@ -512,20 +533,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
@@ -533,11 +552,11 @@ struct
     | None -> raise Not_found
 
   (** This function breaks the abstraction of Cst_stack ! *)
-  let best_state (_,sk as s) l =
+  let best_state sigma (_,sk as s) l =
     let rec aux sk def = function
       |(cst, params, []) -> (cst, append_app_list (List.rev params) sk)
       |(cst, params, (i,t)::q) -> match decomp sk with
-	| Some (el,sk') when Constr.equal el t.(i) ->
+	| Some (el,sk') when EConstr.eq_constr sigma el t.(i) ->
 	  if i = pred (Array.length t)
 	  then aux sk' def (cst, params, q)
 	  else aux sk' def (cst, params, (succ i,t)::q)
@@ -546,59 +565,62 @@ struct
 
   let constr_of_cst_member f sk =
     match f with
-    | Cst_const (c, u) -> mkConstU (c,u), sk
+    | Cst_const (c, u) -> mkConstU (c, EInstance.make u), sk
     | Cst_proj p -> 
       match decomp sk with
       | Some (hd, sk) -> mkProj (p, hd), sk
       | None -> assert false
 
-  let rec zip ?(refold=false) = function
+  let zip ?(refold=false) sigma s =
+  let rec zip = function
     | f, [] -> f
     | f, (App (i,a,j) :: s) ->
        let a' = if Int.equal i 0 && Int.equal j (Array.length a - 1)
 		then a
 		else Array.sub a i (j - i + 1) in
-       zip ~refold (mkApp (f, a'), s)
+       zip (mkApp (f, a'), s)
     | f, (Case (ci,rt,br,cst_l)::s) when refold ->
-      zip ~refold (best_state (mkCase (ci,rt,f,br), s) cst_l)
-    | f, (Case (ci,rt,br,_)::s) -> zip ~refold (mkCase (ci,rt,f,br), s)
+      zip (best_state sigma (mkCase (ci,rt,f,br), s) cst_l)
+    | f, (Case (ci,rt,br,_)::s) -> zip (mkCase (ci,rt,f,br), s)
     | f, (Fix (fix,st,cst_l)::s) when refold ->
-      zip ~refold (best_state (mkFix fix, st @ (append_app [|f|] s)) cst_l)
-  | f, (Fix (fix,st,_)::s) -> zip ~refold
+      zip (best_state sigma (mkFix fix, st @ (append_app [|f|] s)) cst_l)
+  | f, (Fix (fix,st,_)::s) -> zip
     (mkFix fix, st @ (append_app [|f|] s))
   | f, (Cst (cst,_,_,params,cst_l)::s) when refold ->
-    zip ~refold (best_state (constr_of_cst_member cst (params @ (append_app [|f|] s))) cst_l)
+    zip (best_state sigma (constr_of_cst_member cst (params @ (append_app [|f|] s))) cst_l)
   | f, (Cst (cst,_,_,params,_)::s) ->
-    zip ~refold (constr_of_cst_member cst (params @ (append_app [|f|] s)))
-  | f, (Shift n::s) -> zip ~refold (lift n f, s)
+    zip (constr_of_cst_member cst (params @ (append_app [|f|] s)))
   | f, (Proj (n,m,p,cst_l)::s) when refold ->
-    zip ~refold (best_state (mkProj (p,f),s) cst_l)
-  | f, (Proj (n,m,p,_)::s) -> zip ~refold (mkProj (p,f),s)
-  | _, (Update _::_) -> assert false
+    zip (best_state sigma (mkProj (p,f),s) cst_l)
+  | f, (Proj (n,m,p,_)::s) -> zip (mkProj (p,f),s)
+  in
+  zip s
+
 end
 
 (** The type of (machine) states (= lambda-bar-calculus' cuts) *)
 type state = constr * constr Stack.t
 
-type  contextual_reduction_function = env ->  evar_map -> constr -> constr
-type  reduction_function =  contextual_reduction_function
+type contextual_reduction_function = env -> evar_map -> constr -> constr
+type reduction_function = contextual_reduction_function
 type local_reduction_function = evar_map -> constr -> constr
-type e_reduction_function = { e_redfun : 'r. env -> 'r Sigma.t -> constr -> (constr, 'r) Sigma.sigma }
+type e_reduction_function = env -> evar_map -> constr -> evar_map * constr
 
-type  contextual_stack_reduction_function =
-    env ->  evar_map -> constr -> constr * constr list
-type  stack_reduction_function =  contextual_stack_reduction_function
+type contextual_stack_reduction_function =
+    env -> evar_map -> constr -> constr * constr list
+type stack_reduction_function = contextual_stack_reduction_function
 type local_stack_reduction_function =
     evar_map -> constr -> constr * constr list
 
-type  contextual_state_reduction_function =
-    env ->  evar_map -> state -> state
-type  state_reduction_function =  contextual_state_reduction_function
+type contextual_state_reduction_function =
+    env -> evar_map -> state -> state
+type state_reduction_function = contextual_state_reduction_function
 type local_state_reduction_function = evar_map -> state -> state
 
 let pr_state (tm,sk) =
   let open Pp in
-  h 0 (Termops.print_constr tm ++ str "|" ++ cut () ++ Stack.pr Termops.print_constr sk)
+  let pr c = Termops.print_constr c in
+  h 0 (pr tm ++ str "|" ++ cut () ++ Stack.pr pr sk)
 
 (*************************************)
 (*** Reduction Functions Operators ***)
@@ -612,16 +634,16 @@ let safe_meta_value sigma ev =
 
 let strong whdfun env sigma t =
   let rec strongrec env t =
-    map_constr_with_full_binders push_rel strongrec env (whdfun env sigma t) in
+    map_constr_with_full_binders sigma push_rel strongrec env (whdfun env sigma t) in
   strongrec env t
 
 let local_strong whdfun sigma =
-  let rec strongrec t = Constr.map strongrec (whdfun sigma t) in
+  let rec strongrec t = EConstr.map sigma strongrec (whdfun sigma t) in
   strongrec
 
 let rec strong_prodspine redfun sigma c =
   let x = redfun sigma c in
-  match kind_of_term x with
+  match EConstr.kind sigma x with
     | Prod (na,a,b) -> mkProd (na,a,strong_prodspine redfun sigma b)
     | _ -> x
 
@@ -633,20 +655,25 @@ let eta = CClosure.RedFlags.mkflags [CClosure.RedFlags.fETA]
 
 (* Beta Reduction tools *)
 
-let apply_subst recfun env refold cst_l t stack =
+let apply_subst recfun env sigma refold cst_l t stack =
   let rec aux env cst_l t stack =
-    match (Stack.decomp stack,kind_of_term t) with
+    match (Stack.decomp stack, EConstr.kind sigma t) with
     | Some (h,stacktl), Lambda (_,_,c) ->
        let cst_l' = if refold then Cst_stack.add_param h cst_l else cst_l in
        aux (h::env) cst_l' c stacktl
-    | _ -> recfun cst_l (substl env t, stack)
+    | _ -> recfun sigma cst_l (substl env t, stack)
   in aux env cst_l t stack
 
-let stacklam recfun env t stack =
-  apply_subst (fun _ -> recfun) env false Cst_stack.empty t stack
+let stacklam recfun env sigma t stack =
+  apply_subst (fun _ _ s -> recfun s) env sigma false Cst_stack.empty t stack
+
+let beta_app sigma (c,l) =
+  let zip s = Stack.zip sigma s in
+  stacklam zip [] sigma c (Stack.append_app l Stack.empty)
 
-let beta_applist (c,l) =
-  stacklam Stack.zip [] c (Stack.append_app_list l Stack.empty)
+let beta_applist sigma (c,l) =
+  let zip s = Stack.zip sigma s in
+  stacklam zip [] sigma c (Stack.append_app_list l Stack.empty)
 
 (* Iota reduction tools *)
 
@@ -657,7 +684,7 @@ type 'a miota_args = {
   mcargs  : 'a list;    (* the constructor's arguments *)
   mlf     : 'a array }  (* the branch code vector *)
 
-let reducible_mind_case c = match kind_of_term c with
+let reducible_mind_case sigma c = match EConstr.kind sigma c with
   | Construct _ | CoFix _ -> true
   | _  -> false
 
@@ -671,27 +698,38 @@ let reducible_mind_case c = match kind_of_term c with
     f x := t. End M. Definition f := u. and say goodbye to any hope
     of refolding M.f this way ...
 *)
-let magicaly_constant_of_fixbody env reference bd = function
+let magicaly_constant_of_fixbody env sigma reference bd = function
   | Name.Anonymous -> bd
   | Name.Name id ->
+    let open Universes in
     try
       let (cst_mod,cst_sect,_) = Constant.repr3 reference in
       let cst = Constant.make3 cst_mod cst_sect (Label.of_id id) in
-      let (cst, u), ctx = Universes.fresh_constant_instance env cst in
+      let (cst, u), ctx = fresh_constant_instance env cst in
       match constant_opt_value_in env (cst,u) with
       | None -> bd
       | Some t ->
-        let b, csts = Universes.eq_constr_universes t bd in
-    	let subst = Universes.Constraints.fold (fun (l,d,r) acc ->
-    	  Univ.LMap.add (Option.get (Universe.level l)) (Option.get (Universe.level r)) acc)
-    	  csts Univ.LMap.empty
-    	in
-    	let inst = Instance.subst_fn (fun u -> Univ.LMap.find u subst) u in
-          if b then mkConstU (cst,inst) else bd
+        let csts = EConstr.eq_constr_universes env sigma (EConstr.of_constr t) bd in
+        begin match csts with
+        | Some csts ->
+          let subst = Constraints.fold (fun cst acc ->
+              let l, r = match cst with
+                | ULub (u, v) | UWeak (u, v) -> u, v
+                | UEq (u, v) | ULe (u, v) ->
+                  let get u = Option.get (Universe.level u) in
+                  get u, get v
+              in
+            Univ.LMap.add l r acc)
+            csts Univ.LMap.empty
+          in
+          let inst = Instance.subst_fn (fun u -> Univ.LMap.find u subst) u in
+          mkConstU (cst, EInstance.make inst)
+        | None -> bd
+        end
     with
     | Not_found -> bd
 
-let contract_cofix ?env ?reference (bodynum,(names,types,bodies as typedbodies)) =
+let contract_cofix ?env sigma ?reference (bodynum,(names,types,bodies as typedbodies)) =
   let nbodies = Array.length bodies in
   let make_Fi j =
     let ind = nbodies-j-1 in
@@ -703,37 +741,37 @@ let contract_cofix ?env ?reference (bodynum,(names,types,bodies as typedbodies))
       | Some e ->
         match reference with
         | None -> bd
-        | Some r -> magicaly_constant_of_fixbody e r bd names.(ind) in
+        | Some r -> magicaly_constant_of_fixbody e sigma r bd names.(ind) in
   let closure = List.init nbodies make_Fi in
   substl closure bodies.(bodynum)
 
 (** Similar to the "fix" case below *)
-let reduce_and_refold_cofix recfun env refold cst_l cofix sk =
+let reduce_and_refold_cofix recfun env sigma refold cst_l cofix sk =
   let raw_answer =
     let env = if refold then Some env else None in
-    contract_cofix ?env ?reference:(Cst_stack.reference cst_l) cofix in
+    contract_cofix ?env sigma ?reference:(Cst_stack.reference sigma cst_l) cofix in
   apply_subst
-    (fun x (t,sk') ->
+    (fun sigma x (t,sk') ->
       let t' =
-        if refold then Cst_stack.best_replace (mkCoFix cofix) cst_l t else t in
+        if refold then Cst_stack.best_replace sigma (mkCoFix cofix) cst_l t else t in
       recfun x (t',sk'))
-    [] refold Cst_stack.empty raw_answer sk
+    [] sigma refold Cst_stack.empty raw_answer sk
 
-let reduce_mind_case mia =
-  match kind_of_term mia.mconstr with
+let reduce_mind_case sigma mia =
+  match EConstr.kind sigma mia.mconstr with
     | Construct ((ind_sp,i),u) ->
 (*	let ncargs = (fst mia.mci).(i-1) in*)
 	let real_cargs = List.skipn mia.mci.ci_npar mia.mcargs in
         applist (mia.mlf.(i-1),real_cargs)
     | CoFix cofix ->
-	let cofix_def = contract_cofix cofix in
+	let cofix_def = contract_cofix sigma cofix in
 	mkCase (mia.mci, mia.mP, applist(cofix_def,mia.mcargs), mia.mlf)
     | _ -> assert false
 
 (* contracts fix==FIX[nl;i](A1...Ak;[F1...Fk]{B1....Bk}) to produce
    Bi[Fj --> FIX[nl;j](A1...Ak;[F1...Fk]{B1...Bk})] *)
 
-let contract_fix ?env ?reference ((recindices,bodynum),(names,types,bodies as typedbodies)) =
+let contract_fix ?env sigma ?reference ((recindices,bodynum),(names,types,bodies as typedbodies)) =
     let nbodies = Array.length recindices in
     let make_Fi j =
       let ind = nbodies-j-1 in
@@ -745,7 +783,7 @@ let contract_fix ?env ?reference ((recindices,bodynum),(names,types,bodies as ty
 	| Some e ->
           match reference with
           | None -> bd
-          | Some r -> magicaly_constant_of_fixbody e r bd names.(ind) in
+          | Some r -> magicaly_constant_of_fixbody e sigma r bd names.(ind) in
     let closure = List.init nbodies make_Fi in
     substl closure bodies.(bodynum)
 
@@ -753,18 +791,18 @@ let contract_fix ?env ?reference ((recindices,bodynum),(names,types,bodies as ty
     replace the fixpoint by the best constant from [cst_l]
     Other rels are directly substituted by constants "magically found from the
     context" in contract_fix *)
-let reduce_and_refold_fix recfun env refold cst_l fix sk =
+let reduce_and_refold_fix recfun env sigma refold cst_l fix sk =
   let raw_answer =
-    let env = if refold then None else Some env in
-    contract_fix ?env ?reference:(Cst_stack.reference cst_l) fix in
+    let env = if refold then Some env else None in
+    contract_fix ?env sigma ?reference:(Cst_stack.reference sigma cst_l) fix in
   apply_subst
-    (fun x (t,sk') ->
+    (fun sigma x (t,sk') ->
       let t' =
         if refold then
-          Cst_stack.best_replace (mkFix fix) cst_l t
+          Cst_stack.best_replace sigma (mkFix fix) cst_l t
         else t
       in recfun x (t',sk'))
-    [] refold Cst_stack.empty raw_answer sk
+    [] sigma refold Cst_stack.empty raw_answer sk
 
 let fix_recarg ((recindices,bodynum),_) stack =
   assert (0 <= bodynum && bodynum < Array.length recindices);
@@ -789,7 +827,7 @@ let fix_recarg ((recindices,bodynum),_) stack =
 
 let debug_RAKAM = ref (false)
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optdepr = false;
   Goptions.optname =
     "Print states of the Reductionops abstract machine";
   Goptions.optkey = ["Debug";"RAKAM"];
@@ -797,30 +835,30 @@ let _ = Goptions.declare_bool_option {
   Goptions.optwrite = (fun a -> debug_RAKAM:=a);
 }
 
-let equal_stacks (x, l) (y, l') =
-  let f_equal (x,lft1) (y,lft2) = Constr.equal (Vars.lift lft1 x) (Vars.lift lft2 y) in
-  let eq_fix (a,b) (c,d) = f_equal (Constr.mkFix a, b) (Constr.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 equal_stacks sigma (x, l) (y, l') =
+  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
-  let rec whrec cst_l (x, stack as s) =
+  let rec whrec cst_l (x, stack) =
     let () = if !debug_RAKAM then
 	let open Pp in
+	let pr c = Termops.print_constr c in
 	Feedback.msg_notice
-             (h 0 (str "<<" ++ Termops.print_constr x ++
+             (h 0 (str "<<" ++ pr x ++
 		   str "|" ++ cut () ++ Cst_stack.pr cst_l ++
-		   str "|" ++ cut () ++ Stack.pr Termops.print_constr stack ++
+		   str "|" ++ cut () ++ Stack.pr pr stack ++
 		   str ">>"))
     in
+    let c0 = EConstr.kind sigma x in
     let fold () =
       let () = if !debug_RAKAM then
 	  let open Pp in Feedback.msg_notice (str "<><><><><>") in
-      (s,cst_l)
+      ((EConstr.of_kind c0, stack),cst_l)
     in
-    match kind_of_term x with
+    match c0 with
     | Rel n when CClosure.RedFlags.red_set flags CClosure.RedFlags.fDELTA ->
       (match lookup_rel n env with
       | LocalDef (_,body,_) -> whrec Cst_stack.empty (lift n body, stack)
@@ -830,18 +868,20 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
       | LocalDef (_,body,_) ->
 	whrec (if refold then Cst_stack.add_cst (mkVar id) cst_l else cst_l) (body, stack)
       | _ -> fold ())
-    | Evar ev ->
-      (match safe_evar_value sigma ev with
-      | Some body -> whrec cst_l (body, stack)
-      | None -> fold ())
+    | Evar ev -> fold ()
     | Meta ev ->
       (match safe_meta_value sigma ev with
-      | Some body -> whrec cst_l (body, stack)
+      | Some body -> whrec cst_l (EConstr.of_constr body, stack)
       | None -> fold ())
-    | Const (c,u as const) when CClosure.RedFlags.red_set flags (CClosure.RedFlags.fCONST c) ->
-       (match constant_opt_value_in env const with
+    | Const (c,u as const) ->
+      reduction_effect_hook env sigma (EConstr.to_constr sigma x)
+         (lazy (EConstr.to_constr sigma (Stack.zip sigma (x,stack))));
+      if CClosure.RedFlags.red_set flags (CClosure.RedFlags.fCONST c) then
+       let u' = EInstance.kind sigma u in
+       (match constant_opt_value_in env (c, u') with
 	| None -> fold ()
 	| Some body ->
+          let body = EConstr.of_constr body in
 	   if not tactic_mode
 	   then whrec (if refold then Cst_stack.add_cst (mkConstU const) cst_l else cst_l)
 		      (body, stack)
@@ -858,12 +898,12 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
 		    let (tm',sk'),cst_l' =
 		      whrec (Cst_stack.add_cst (mkConstU const) cst_l) (body, app_sk)
 		    in
-		    let rec is_case x = match kind_of_term x with
+		    let rec is_case x = match EConstr.kind sigma x with
 		      | Lambda (_,_, x) | LetIn (_,_,_, x) | Cast (x, _,_) -> is_case x
 		      | App (hd, _) -> is_case hd
 		      | Case _ -> true
 		      | _ -> false in
-		    if equal_stacks (x, app_sk) (tm', sk')
+		    if equal_stacks sigma (x, app_sk) (tm', sk')
 		       || Stack.will_expose_iota sk'
 		       || is_case tm'
 		      then fold ()
@@ -877,8 +917,8 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
 		    | None -> fold ()
 		    | Some (bef,arg,s') ->
 		      whrec Cst_stack.empty 
-			(arg,Stack.Cst(Stack.Cst_const const,curr,remains,bef,cst_l)::s')
-       )
+			(arg,Stack.Cst(Stack.Cst_const (fst const, u'),curr,remains,bef,cst_l)::s')
+       ) else fold ()
     | Proj (p, c) when CClosure.RedFlags.red_projection flags p ->
       (let pb = lookup_projection p env in
        let kn = Projection.constant p in
@@ -891,7 +931,7 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
 	 | None ->
 	   let stack' = (c, Stack.Proj (npars, arg, p, cst_l) :: stack) in
 	   let stack'', csts = whrec Cst_stack.empty stack' in
-	     if equal_stacks stack' stack'' then fold ()
+	     if equal_stacks sigma stack' stack'' then fold ()
 	     else stack'', csts
 	 | Some (recargs, nargs, flags) ->
 	   if (List.mem `ReductionNeverUnfold flags
@@ -921,7 +961,7 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
 				      Stack.append_app [|c|] bef,cst_l)::s'))
 
     | LetIn (_,b,_,c) when CClosure.RedFlags.red_set flags CClosure.RedFlags.fZETA ->
-      apply_subst whrec [b] refold cst_l c stack
+      apply_subst (fun _ -> whrec) [b] sigma refold cst_l c stack
     | Cast (c,_,_) -> whrec cst_l (c, stack)
     | App (f,cl)  ->
       whrec
@@ -930,20 +970,20 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
     | Lambda (na,t,c) ->
       (match Stack.decomp stack with
       | Some _ when CClosure.RedFlags.red_set flags CClosure.RedFlags.fBETA ->
-	apply_subst whrec [] refold cst_l x stack
+	apply_subst (fun _ -> whrec) [] sigma refold cst_l x stack
       | None when CClosure.RedFlags.red_set flags CClosure.RedFlags.fETA ->
-	let env' = push_rel (LocalAssum (na,t)) env in
+	let env' = push_rel (LocalAssum (na, t)) env in
 	let whrec' = whd_state_gen ~refold ~tactic_mode flags env' sigma in
-        (match kind_of_term (Stack.zip ~refold (fst (whrec' (c, Stack.empty)))) with
+        (match EConstr.kind sigma (Stack.zip ~refold sigma (fst (whrec' (c, Stack.empty)))) with
         | App (f,cl) ->
 	  let napp = Array.length cl in
 	  if napp > 0 then
 	    let (x', l'),_ = whrec' (Array.last cl, Stack.empty) in
-            match kind_of_term x', l' with
+            match EConstr.kind sigma x', l' with
             | Rel 1, [] ->
 	      let lc = Array.sub cl 0 (napp-1) in
-	      let u = if Int.equal napp 1 then f else appvect (f,lc) in
-	      if noccurn 1 u then (pop u,Stack.empty),Cst_stack.empty else fold ()
+	      let u = if Int.equal napp 1 then f else mkApp (f,lc) in
+	      if noccurn sigma 1 u then (pop u,Stack.empty),Cst_stack.empty else fold ()
             | _ -> fold ()
 	  else fold ()
 	| _ -> fold ())
@@ -968,11 +1008,11 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
 	|args, (Stack.Proj (n,m,p,_)::s') when use_match ->
 	  whrec Cst_stack.empty (Stack.nth args (n+m), s')
 	|args, (Stack.Fix (f,s',cst_l)::s'') when use_fix ->
-	  let x' = Stack.zip(x,args) in
+	  let x' = Stack.zip sigma (x, args) in
 	  let out_sk = s' @ (Stack.append_app [|x'|] s'') in
-	  reduce_and_refold_fix whrec env refold cst_l f out_sk
+	  reduce_and_refold_fix whrec env sigma refold cst_l f out_sk
 	|args, (Stack.Cst (const,curr,remains,s',cst_l) :: s'') ->
-	  let x' = Stack.zip(x,args) in
+	  let x' = Stack.zip sigma (x, args) in
 	  begin match remains with
 	  | [] -> 
 	    (match const with
@@ -980,6 +1020,8 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
 	      (match constant_opt_value_in env const with
 	      | None -> fold ()
 	      | Some body ->
+                let const = (fst const, EInstance.make (snd const)) in
+                let body = EConstr.of_constr body in
 		whrec (if refold then Cst_stack.add_cst (mkConstU const) cst_l else cst_l)
 		  (body, s' @ (Stack.append_app [|x'|] s'')))
 	    | Stack.Cst_proj p ->
@@ -998,7 +1040,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 ()
 
@@ -1006,40 +1048,42 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
       if CClosure.RedFlags.red_set flags CClosure.RedFlags.fCOFIX then
 	match Stack.strip_app stack with
 	|args, ((Stack.Case _ |Stack.Proj _)::s') ->
-	  reduce_and_refold_cofix whrec env refold cst_l cofix stack
+	  reduce_and_refold_cofix whrec env sigma refold cst_l cofix stack
 	|_ -> fold ()
       else fold ()
 
-    | Rel _ | Var _ | Const _ | LetIn _ | Proj _ -> fold ()
+    | Rel _ | Var _ | LetIn _ | Proj _ -> fold ()
     | Sort _ | Ind _ | Prod _ -> fold ()
   in
   fun xs ->
   let (s,cst_l as res) = whrec (Option.default Cst_stack.empty csts) xs in
-  if tactic_mode then (Stack.best_state s cst_l,Cst_stack.empty) else res
+  if tactic_mode then (Stack.best_state sigma s cst_l,Cst_stack.empty) else res
 
 (** reduction machine without global env and refold machinery *)
 let local_whd_state_gen flags sigma =
-  let rec whrec (x, stack as s) =
-    match kind_of_term x with
+  let rec whrec (x, stack) =
+    let c0 = EConstr.kind sigma x in
+    let s = (EConstr.of_kind c0, stack) in
+    match c0 with
     | LetIn (_,b,_,c) when CClosure.RedFlags.red_set flags CClosure.RedFlags.fZETA ->
-      stacklam whrec [b] c stack
+      stacklam whrec [b] sigma c stack
     | Cast (c,_,_) -> whrec (c, stack)
     | App (f,cl)  -> whrec (f, Stack.append_app cl stack)
     | Lambda (_,_,c) ->
       (match Stack.decomp stack with
       | Some (a,m) when CClosure.RedFlags.red_set flags CClosure.RedFlags.fBETA ->
-	stacklam whrec [a] c m
+	stacklam whrec [a] sigma c m
       | None when CClosure.RedFlags.red_set flags CClosure.RedFlags.fETA ->
-        (match kind_of_term (Stack.zip (whrec (c, Stack.empty))) with
+        (match EConstr.kind sigma (Stack.zip sigma (whrec (c, Stack.empty))) with
         | App (f,cl) ->
 	  let napp = Array.length cl in
 	  if napp > 0 then
 	    let x', l' = whrec (Array.last cl, Stack.empty) in
-            match kind_of_term x', l' with
+            match EConstr.kind sigma x', l' with
             | Rel 1, [] ->
 	      let lc = Array.sub cl 0 (napp-1) in
-	      let u = if Int.equal napp 1 then f else appvect (f,lc) in
-	      if noccurn 1 u then (pop u,Stack.empty) else s
+	      let u = if Int.equal napp 1 then f else mkApp (f,lc) in
+	      if noccurn sigma 1 u then (pop u,Stack.empty) else s
             | _ -> s
 	  else s
 	| _ -> s)
@@ -1059,14 +1103,10 @@ let local_whd_state_gen flags sigma =
       |None -> s
       |Some (bef,arg,s') -> whrec (arg, Stack.Fix(f,bef,Cst_stack.empty)::s'))
 
-    | Evar ev ->
-      (match safe_evar_value sigma ev with
-        Some c -> whrec (c,stack)
-      | None -> s)
-
+    | Evar ev -> s
     | Meta ev ->
       (match safe_meta_value sigma ev with
-        Some c -> whrec (c,stack)
+        Some c -> whrec (EConstr.of_constr c,stack)
       | None -> s)
 
     | Construct ((ind,c),u) ->
@@ -1079,9 +1119,9 @@ let local_whd_state_gen flags sigma =
 	|args, (Stack.Proj (n,m,p,_) :: s') when use_match ->
 	  whrec (Stack.nth args (n+m), s')
 	|args, (Stack.Fix (f,s',cst)::s'') when use_fix ->
-	  let x' = Stack.zip(x,args) in
-	  whrec (contract_fix f, s' @ (Stack.append_app [|x'|] s''))
-	|_, (Stack.App _|Stack.Update _|Stack.Shift _|Stack.Cst _)::_ -> assert false
+	  let x' = Stack.zip sigma (x,args) in
+	  whrec (contract_fix sigma f, s' @ (Stack.append_app [|x'|] s''))
+        |_, (Stack.App _|Stack.Cst _)::_ -> assert false
 	|_, _ -> s
       else s
 
@@ -1089,32 +1129,35 @@ let local_whd_state_gen flags sigma =
       if CClosure.RedFlags.red_set flags CClosure.RedFlags.fCOFIX then
 	match Stack.strip_app stack with
 	|args, ((Stack.Case _ | Stack.Proj _)::s') ->
-	  whrec (contract_cofix cofix, stack)
+	  whrec (contract_cofix sigma cofix, stack)
 	|_ -> s
       else s
 
-    | x -> s
+    | Rel _ | Var _ | Sort _ | Prod _ | LetIn _ | Const _  | Ind _ | Proj _ -> s
+
   in
   whrec
 
 let raw_whd_state_gen flags env =
-  let f sigma s = fst (whd_state_gen (get_refolding_in_reduction ()) false flags env sigma s) in
+  let f sigma s = fst (whd_state_gen ~refold:false
+                         ~tactic_mode:false
+                         flags env sigma s) in
   f
 
 let stack_red_of_state_red f =
-  let f sigma x = decompose_app (Stack.zip (f sigma (x, Stack.empty))) in
+  let f sigma x = EConstr.decompose_app sigma (Stack.zip sigma (f sigma (x, Stack.empty))) in
   f
 
 (* Drops the Cst_stack *)
 let iterate_whd_gen refold flags env sigma s =
   let rec aux t =
-  let (hd,sk),_ = whd_state_gen refold false flags env sigma (t,Stack.empty) in
+  let (hd,sk),_ = whd_state_gen ~refold ~tactic_mode:false flags env sigma (t,Stack.empty) in
   let whd_sk = Stack.map aux sk in
-  Stack.zip ~refold (hd,whd_sk)
+  Stack.zip sigma ~refold (hd,whd_sk)
   in aux s
 
 let red_of_state_red f sigma x =
-  Stack.zip (f sigma (x,Stack.empty))
+  Stack.zip sigma (f sigma (x,Stack.empty))
 
 (* 0. No Reduction Functions *)
 
@@ -1169,7 +1212,7 @@ let whd_allnolet env =
 
 (* 4. Ad-hoc eta reduction, does not subsitute evars *)
 
-let shrink_eta c = Stack.zip (local_whd_state_gen eta Evd.empty (c,Stack.empty))
+let shrink_eta c = Stack.zip Evd.empty (local_whd_state_gen eta Evd.empty (c,Stack.empty))
 
 (* 5. Zeta Reduction Functions *)
 
@@ -1191,14 +1234,24 @@ let nf_evar = Evarutil.nf_evar
 let clos_norm_flags flgs env sigma t =
   try
     let evars ev = safe_evar_value sigma ev in
-    CClosure.norm_val
+    EConstr.of_constr (CClosure.norm_val
+      (CClosure.create_clos_infos ~evars flgs env)
+      (CClosure.create_tab ())
+      (CClosure.inject (EConstr.Unsafe.to_constr t)))
+  with e when is_anomaly e -> user_err Pp.(str "Tried to normalize ill-typed term")
+
+let clos_whd_flags flgs env sigma t =
+  try
+    let evars ev = safe_evar_value sigma ev in
+    EConstr.of_constr (CClosure.whd_val
       (CClosure.create_clos_infos ~evars flgs env)
-      (CClosure.inject t)
-  with e when is_anomaly e -> error "Tried to normalize ill-typed term"
+      (CClosure.create_tab ())
+      (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
 
@@ -1207,11 +1260,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 =
@@ -1221,7 +1274,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
 
@@ -1229,11 +1282,21 @@ let pb_equal = function
   | Reduction.CUMUL -> Reduction.CONV
   | Reduction.CONV -> Reduction.CONV
 
-let report_anomaly _ =
-  let e = UserError ("", Pp.str "Conversion test raised an anomaly") in
+let report_anomaly e =
+  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
 
+let f_conv ?l2r ?reds env ?evars x y =
+  let inj = EConstr.Unsafe.to_constr in
+  Reduction.conv ?l2r ?reds env ?evars (inj x) (inj y)
+
+let f_conv_leq ?l2r ?reds env ?evars x y =
+  let inj = EConstr.Unsafe.to_constr in
+  Reduction.conv_leq ?l2r ?reds env ?evars (inj x) (inj y)
+
 let test_trans_conversion (f: constr Reduction.extended_conversion_function) reds env sigma x y =
   try
     let evars ev = safe_evar_value sigma ev in
@@ -1242,16 +1305,16 @@ let test_trans_conversion (f: constr Reduction.extended_conversion_function) red
   with Reduction.NotConvertible -> false
     | e when is_anomaly e -> report_anomaly e
 
-let is_conv ?(reds=full_transparent_state) env sigma = test_trans_conversion Reduction.conv reds env sigma
-let is_conv_leq ?(reds=full_transparent_state) env sigma = test_trans_conversion Reduction.conv_leq reds env sigma
+let is_conv ?(reds=full_transparent_state) env sigma = test_trans_conversion f_conv reds env sigma
+let is_conv_leq ?(reds=full_transparent_state) env sigma = test_trans_conversion f_conv_leq reds env sigma
 let is_fconv ?(reds=full_transparent_state) = function
   | Reduction.CONV -> is_conv ~reds
   | Reduction.CUMUL -> is_conv_leq ~reds
 
 let check_conv ?(pb=Reduction.CUMUL) ?(ts=full_transparent_state) env sigma x y = 
   let f = match pb with
-    | Reduction.CONV -> Reduction.conv
-    | Reduction.CUMUL -> Reduction.conv_leq
+    | Reduction.CONV -> f_conv
+    | Reduction.CUMUL -> f_conv_leq
   in
     try f ~reds:ts env ~evars:(safe_evar_value sigma, Evd.universes sigma) x y; true
     with Reduction.NotConvertible -> false
@@ -1269,23 +1332,34 @@ let sigma_compare_instances ~flex i0 i1 sigma =
      | Univ.UniverseInconsistency _ ->
 	raise Reduction.NotConvertible
 
+let sigma_check_inductive_instances cv_pb variance u1 u2 sigma =
+  match Evarutil.compare_cumulative_instances cv_pb variance u1 u2 sigma with
+  | Inl sigma -> sigma
+  | Inr _ ->
+    raise Reduction.NotConvertible
+
 let sigma_univ_state = 
-  { Reduction.compare = sigma_compare_sorts;
-    Reduction.compare_instances = sigma_compare_instances }
+  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 *)
   try
-    let fold cstr sigma =
-      try Some (Evd.add_universe_constraints sigma cstr)
-      with Univ.UniverseInconsistency _ | Evd.UniversesDiffer -> None
-    in
     let b, sigma = 
       let ans =
 	if pb == Reduction.CUMUL then 
-	  Universes.leq_constr_univs_infer (Evd.universes sigma) fold x y sigma
+          EConstr.leq_constr_universes env sigma x y
 	else
-	  Universes.eq_constr_univs_infer (Evd.universes sigma) fold x y sigma
+          EConstr.eq_constr_universes env sigma x y
+      in
+      let ans = match ans with
+      | None -> None
+      | Some cstr ->
+        try Some (Evd.add_universe_constraints sigma cstr)
+        with Univ.UniverseInconsistency _ | Evd.UniversesDiffer -> None
       in
       match ans with
       | None -> false, sigma
@@ -1293,6 +1367,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
@@ -1315,37 +1391,37 @@ let vm_infer_conv ?(pb=Reduction.CUMUL) env t1 t2 =
 (*             Special-Purpose Reduction                            *)
 (********************************************************************)
 
-let whd_meta sigma c = match kind_of_term c with
-  | Meta p -> (try meta_value sigma p with Not_found -> c)
+let whd_meta sigma c = match EConstr.kind sigma c with
+  | Meta p -> (try EConstr.of_constr (meta_value sigma p) with Not_found -> c)
   | _ -> c
 
 let default_plain_instance_ident = Id.of_string "H"
 
 (* Try to replace all metas. Does not replace metas in the metas' values
  * Differs from (strong whd_meta). *)
-let plain_instance s c =
-  let rec irec n u = match kind_of_term u with
+let plain_instance sigma s c =
+  let rec irec n u = match EConstr.kind sigma u with
     | Meta p -> (try lift n (Metamap.find p s) with Not_found -> u)
-    | App (f,l) when isCast f ->
-        let (f,_,t) = destCast f in
+    | App (f,l) when isCast sigma f ->
+        let (f,_,t) = destCast sigma f in
         let l' = CArray.Fun1.smartmap irec n l in
-        (match kind_of_term f with
+        (match EConstr.kind sigma f with
         | Meta p ->
 	    (* Don't flatten application nodes: this is used to extract a
                proof-term from a proof-tree and we want to keep the structure
                of the proof-tree *)
 	    (try let g = Metamap.find p s in
-	    match kind_of_term g with
+	    match EConstr.kind sigma g with
             | App _ ->
                 let l' = CArray.Fun1.smartmap lift 1 l' in
                 mkLetIn (Name default_plain_instance_ident,g,t,mkApp(mkRel 1, l'))
             | _ -> mkApp (g,l')
 	    with Not_found -> mkApp (f,l'))
         | _ -> mkApp (irec n f,l'))
-    | Cast (m,_,_) when isMeta m ->
-	(try lift n (Metamap.find (destMeta m) s) with Not_found -> u)
+    | Cast (m,_,_) when isMeta sigma m ->
+	(try lift n (Metamap.find (destMeta sigma m) s) with Not_found -> u)
     | _ ->
-	map_constr_with_binders succ irec n u
+	map_with_binders sigma succ irec n u
   in
   if Metamap.is_empty s then c
   else irec 0 c
@@ -1386,7 +1462,7 @@ let plain_instance s c =
 
 let instance sigma s c =
   (* if s = [] then c else *)
-  local_strong whd_betaiota sigma (plain_instance s c)
+  local_strong whd_betaiota sigma (plain_instance sigma s c)
 
 (* pseudo-reduction rule:
  * [hnf_prod_app env s (Prod(_,B)) N --> B[N]
@@ -1395,34 +1471,33 @@ let instance sigma s c =
  * error message. *)
 
 let hnf_prod_app env sigma t n =
-  match kind_of_term (whd_all env sigma t) with
+  match EConstr.kind sigma (whd_all env sigma t) with
     | Prod (_,_,b) -> subst1 n b
-    | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product")
+    | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product.")
 
 let hnf_prod_appvect env sigma t nl =
-  Array.fold_left (hnf_prod_app env sigma) t nl
+  Array.fold_left (fun acc t -> hnf_prod_app env sigma acc t) t nl
 
 let hnf_prod_applist env sigma t nl =
-  List.fold_left (hnf_prod_app env sigma) t nl
+  List.fold_left (fun acc t -> hnf_prod_app env sigma acc t) t nl
 
 let hnf_lam_app env sigma t n =
-  match kind_of_term (whd_all env sigma t) with
+  match EConstr.kind sigma (whd_all env sigma t) with
     | Lambda (_,_,b) -> subst1 n b
-    | _ -> anomaly ~label:"hnf_lam_app" (Pp.str "Need an abstraction")
+    | _ -> anomaly ~label:"hnf_lam_app" (Pp.str "Need an abstraction.")
 
 let hnf_lam_appvect env sigma t nl =
-  Array.fold_left (hnf_lam_app env sigma) t nl
+  Array.fold_left (fun acc t -> hnf_lam_app env sigma acc t) t nl
 
 let hnf_lam_applist env sigma t nl =
-  List.fold_left (hnf_lam_app env sigma) t nl
+  List.fold_left (fun acc t -> hnf_lam_app env sigma acc t) t nl
 
 let splay_prod env sigma =
   let rec decrec env m c =
     let t = whd_all env sigma c in
-    match kind_of_term t with
+    match EConstr.kind sigma t with
       | Prod (n,a,c0) ->
-	  decrec (push_rel (LocalAssum (n,a)) env)
-	    ((n,a)::m) c0
+         decrec (push_rel (LocalAssum (n,a)) env) ((n,a)::m) c0
       | _ -> m,t
   in
   decrec env []
@@ -1430,10 +1505,9 @@ let splay_prod env sigma =
 let splay_lam env sigma =
   let rec decrec env m c =
     let t = whd_all env sigma c in
-    match kind_of_term t with
+    match EConstr.kind sigma t with
       | Lambda (n,a,c0) ->
-	  decrec (push_rel (LocalAssum (n,a)) env)
-	    ((n,a)::m) c0
+         decrec (push_rel (LocalAssum (n,a)) env) ((n,a)::m) c0
       | _ -> m,t
   in
   decrec env []
@@ -1441,7 +1515,7 @@ let splay_lam env sigma =
 let splay_prod_assum env sigma =
   let rec prodec_rec env l c =
     let t = whd_allnolet env sigma c in
-    match kind_of_term t with
+    match EConstr.kind sigma t with
     | Prod (x,t,c)  ->
 	prodec_rec (push_rel (LocalAssum (x,t)) env)
 	  (Context.Rel.add (LocalAssum (x,t)) l) c
@@ -1451,14 +1525,14 @@ let splay_prod_assum env sigma =
     | Cast (c,_,_)    -> prodec_rec env l c
     | _               -> 
       let t' = whd_all env sigma t in
-	if Term.eq_constr t t' then l,t
+	if EConstr.eq_constr sigma t t' then l,t
 	else prodec_rec env l t'
   in
   prodec_rec env Context.Rel.empty
 
 let splay_arity env sigma c =
   let l, c = splay_prod env sigma c in
-  match kind_of_term c with
+  match EConstr.kind sigma c with
     | Sort s -> l,s
     | _ -> invalid_arg "splay_arity"
 
@@ -1466,7 +1540,7 @@ let sort_of_arity env sigma c = snd (splay_arity env sigma c)
 
 let splay_prod_n env sigma n =
   let rec decrec env m ln c = if Int.equal m 0 then (ln,c) else
-    match kind_of_term (whd_all env sigma c) with
+    match EConstr.kind sigma (whd_all env sigma c) with
       | Prod (n,a,c0) ->
 	  decrec (push_rel (LocalAssum (n,a)) env)
 	    (m-1) (Context.Rel.add (LocalAssum (n,a)) ln) c0
@@ -1476,7 +1550,7 @@ let splay_prod_n env sigma n =
 
 let splay_lam_n env sigma n =
   let rec decrec env m ln c = if Int.equal m 0 then (ln,c) else
-    match kind_of_term (whd_all env sigma c) with
+    match EConstr.kind sigma (whd_all env sigma c) with
       | Lambda (n,a,c0) ->
 	  decrec (push_rel (LocalAssum (n,a)) env)
 	    (m-1) (Context.Rel.add (LocalAssum (n,a)) ln) c0
@@ -1485,7 +1559,7 @@ let splay_lam_n env sigma n =
   decrec env n Context.Rel.empty
 
 let is_sort env sigma t =
-  match kind_of_term (whd_all env sigma t) with
+  match EConstr.kind sigma (whd_all env sigma t) with
   | Sort s -> true
   | _ -> false
 
@@ -1493,7 +1567,7 @@ let is_sort env sigma t =
    of case/fix (heuristic used by evar_conv) *)
 
 let whd_betaiota_deltazeta_for_iota_state ts env sigma csts s =
-  let refold = get_refolding_in_reduction () in
+  let refold = false in
   let tactic_mode = false in
   let rec whrec csts s =
     let (t, stack as s),csts' = whd_state_gen ~csts ~refold ~tactic_mode CClosure.betaiota env sigma s in
@@ -1501,24 +1575,24 @@ let whd_betaiota_deltazeta_for_iota_state ts env sigma csts s =
       |args, (Stack.Case _ :: _ as stack') ->
 	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' ~refold ~tactic_mode
 	  (CClosure.RedFlags.red_add_transparent CClosure.all ts) env sigma (t,args) in
-	if reducible_mind_case t_o then whrec csts_o (t_o, stack_o@stack') else s,csts'
+	if reducible_mind_case sigma t_o then whrec csts_o (t_o, stack_o@stack') else s,csts'
       |args, (Stack.Fix _ :: _ as stack') ->
 	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' ~refold ~tactic_mode
 	  (CClosure.RedFlags.red_add_transparent CClosure.all ts) env sigma (t,args) in
-	if isConstruct t_o then whrec csts_o (t_o, stack_o@stack') else s,csts'
+	if isConstruct sigma t_o then whrec csts_o (t_o, stack_o@stack') else s,csts'
       |args, (Stack.Proj (n,m,p,_) :: stack'') ->
 	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' ~refold ~tactic_mode
 	  (CClosure.RedFlags.red_add_transparent CClosure.all ts) env sigma (t,args) in
-	if isConstruct t_o then
+	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 =
   let rec decrec env c =
     let t = whd_all env sigma c in
-    match kind_of_term t with
+    match EConstr.kind sigma t with
       | Prod (x,t,c0) -> decrec (push_rel (LocalAssum (x,t)) env) c0
       | Lambda (x,t,c0) -> decrec (push_rel (LocalAssum (x,t)) env) c0
       | t -> t
@@ -1538,7 +1612,7 @@ let meta_value evd mv =
     match meta_opt_fvalue evd mv with
     | Some (b,_) ->
       let metas = Metamap.bind valrec b.freemetas in
-      instance evd metas b.rebus
+      instance evd metas (EConstr.of_constr b.rebus)
     | None -> mkMeta mv
   in
   valrec mv
@@ -1550,7 +1624,10 @@ let meta_instance sigma b =
     let c_sigma = Metamap.bind (fun mv -> meta_value sigma mv) fm in
     instance sigma c_sigma b.rebus
 
-let nf_meta sigma c = meta_instance sigma (mk_freelisted c)
+let nf_meta sigma c =
+  let c = EConstr.Unsafe.to_constr c in
+  let cl = mk_freelisted c in
+  meta_instance sigma { cl with rebus = EConstr.of_constr cl.rebus }
 
 (* Instantiate metas that create beta/iota redexes *)
 
@@ -1564,78 +1641,80 @@ let meta_reducible_instance evd b =
   in
   let metas = Metaset.fold fold fm Metamap.empty in
   let rec irec u =
-    let u = whd_betaiota Evd.empty u in
-    match kind_of_term u with
-    | Case (ci,p,c,bl) when isMeta (strip_outer_cast c) ->
-	let m = destMeta (strip_outer_cast c) in
+    let u = whd_betaiota Evd.empty u (** FIXME *) in
+    match EConstr.kind evd u with
+    | Case (ci,p,c,bl) when EConstr.isMeta evd (strip_outer_cast evd c) ->
+	let m = destMeta evd (strip_outer_cast evd c) in
 	(match
 	  try
 	    let g, s = Metamap.find m metas in
+	    let g = EConstr.of_constr g in
             let is_coerce = match s with CoerceToType -> true | _ -> false in
-	    if isConstruct g || not is_coerce then Some g else None
+	    if isConstruct evd g || not is_coerce then Some g else None
 	  with Not_found -> None
 	  with
 	    | Some g -> irec (mkCase (ci,p,g,bl))
 	    | None -> mkCase (ci,irec p,c,Array.map irec bl))
-    | App (f,l) when isMeta (strip_outer_cast f) ->
-	let m = destMeta (strip_outer_cast f) in
+    | App (f,l) when EConstr.isMeta evd (strip_outer_cast evd f) ->
+	let m = destMeta evd (strip_outer_cast evd f) in
 	(match
 	  try
 	    let g, s = Metamap.find m metas in
+	    let g = EConstr.of_constr g in
             let is_coerce = match s with CoerceToType -> true | _ -> false in
-	    if isLambda g || not is_coerce then Some g else None
+	    if isLambda evd g || not is_coerce then Some g else None
 	  with Not_found -> None
 	 with
 	   | Some g -> irec (mkApp (g,l))
 	   | None -> mkApp (f,Array.map irec l))
     | Meta m ->
 	(try let g, s = Metamap.find m metas in
+          let g = EConstr.of_constr g in
           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 c || isCast c && isMeta (pi1 (destCast c)) ->
-	let m = try destMeta c with _ -> destMeta (pi1 (destCast 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
+            let g = EConstr.of_constr g in
             let is_coerce = match s with CoerceToType -> true | _ -> false in
-	    if isConstruct g || not is_coerce then Some g else None
+	    if isConstruct evd g || not is_coerce then Some g else None
 	  with Not_found -> None
 	  with
 	    | Some g -> irec (mkProj (p,g))
 	    | None -> mkProj (p,c))
-    | _ -> Constr.map irec u
+    | _ -> EConstr.map evd irec u
   in
   if Metaset.is_empty fm then (* nf_betaiota? *) b.rebus
   else irec b.rebus
 
 
-let head_unfold_under_prod ts env _ c =
-  let unfold (cst,u as cstu) =
+let head_unfold_under_prod ts env sigma c =
+  let unfold (cst,u) =
+    let cstu = (cst, EInstance.kind sigma u) in
     if Cpred.mem cst (snd ts) then
       match constant_opt_value_in env cstu with
-	| Some c -> c
-	| None -> mkConstU cstu
-    else mkConstU cstu in
+	| Some c -> EConstr.of_constr c
+	| None -> mkConstU (cst, u)
+    else mkConstU (cst, u) in
   let rec aux c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
       | Prod (n,t,c) -> mkProd (n,aux t, aux c)
       | _ ->
-	  let (h,l) = decompose_app c in
-	  match kind_of_term h with
-	    | Const cst -> beta_applist (unfold cst,l)
+	  let (h,l) = decompose_app_vect sigma c in
+	  match EConstr.kind sigma h with
+	    | Const cst -> beta_app sigma (unfold cst, l)
 	    | _ -> c in
   aux c
 
 let betazetaevar_applist sigma n c l =
   let rec stacklam n env t stack =
     if Int.equal n 0 then applist (substl env t, stack) else
-    match kind_of_term t, stack with
+    match EConstr.kind sigma t, stack with
     | Lambda(_,_,c), arg::stacktl -> stacklam (n-1) (arg::env) c stacktl
     | LetIn(_,b,_,c), _ -> stacklam (n-1) (substl env b::env) c stack
-    | Evar ev, _ ->
-      (match safe_evar_value sigma ev with
-      | Some body -> stacklam n env body stack
-      | None -> applist (substl env t, stack))
-    | _ -> anomaly (Pp.str "Not enough lambda/let's") in
+    | Evar _, _ -> applist (substl env t, stack)
+    | _ -> anomaly (Pp.str "Not enough lambda/let's.") in
   stacklam n [] c l
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 4cd7a2a8..b8ac085a 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -1,13 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
+open EConstr
 open Univ
 open Evd
 open Environ
@@ -25,13 +28,24 @@ module ReductionBehaviour : sig
     bool -> Globnames.global_reference -> (int list * int * flag list) -> unit
   val get :
     Globnames.global_reference -> (int list * int * flag list) option
-  val print : Globnames.global_reference -> Pp.std_ppcmds
+  val print : Globnames.global_reference -> Pp.t
 end
 
-(** Option telling if reduction should use the refolding machinery of cbn
-   (off by default) *)
-val get_refolding_in_reduction : unit -> bool
-val set_refolding_in_reduction : bool -> unit
+(** {6 Support for reduction effects } *)
+
+type effect_name = string
+
+(* [declare_reduction_effect name f] declares [f] under key [name];
+   [name] must be a unique in "world". *)
+val declare_reduction_effect : effect_name ->
+  (Environ.env -> Evd.evar_map -> Constr.constr -> unit) -> unit
+
+(* [set_reduction_effect cst name] declares effect [name] to be called when [cst] is found *)
+val set_reduction_effect : Globnames.global_reference -> effect_name -> unit
+
+(* [effect_hook env sigma key term] apply effect associated to [key] on [term] *)
+val reduction_effect_hook : Environ.env -> Evd.evar_map -> Constr.constr ->
+  Constr.constr Lazy.t -> unit
 
 (** {6 Machinery about a stack of unfolded constant }
 
@@ -44,33 +58,30 @@ module Cst_stack : sig
   val add_args : constr array -> t -> t
   val add_cst : constr -> t -> t
   val best_cst : t -> (constr * constr list) option
-  val best_replace : constr -> t -> constr -> constr
-  val reference : t -> Constant.t option
-  val pr : t -> Pp.std_ppcmds
+  val best_replace : Evd.evar_map -> constr -> t -> constr -> constr
+  val reference : Evd.evar_map -> t -> Constant.t option
+  val pr : t -> Pp.t
 end
 
-
 module Stack : sig
   type 'a app_node
 
-  val pr_app_node : ('a -> Pp.std_ppcmds) -> 'a app_node -> Pp.std_ppcmds
+  val pr_app_node : ('a -> Pp.t) -> 'a app_node -> Pp.t
 
   type cst_member =
     | Cst_const of pconstant
-    | Cst_proj of projection
+    | Cst_proj of Projection.t
 
   type 'a member =
   | App of 'a app_node
   | Case of case_info * 'a * 'a array * Cst_stack.t
-  | Proj of int * int * projection * Cst_stack.t
-  | Fix of fixpoint * 'a t * Cst_stack.t
+  | Proj of int * int * Projection.t * Cst_stack.t
+  | 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.std_ppcmds) -> 'a t -> Pp.std_ppcmds
+  val pr : ('a -> Pp.t) -> 'a t -> Pp.t
 
   val empty : 'a t
   val is_empty : 'a t -> bool
@@ -80,15 +91,18 @@ module Stack : sig
   val decomp_node_last : 'a app_node -> 'a t -> ('a * 'a t)
 
   val compare_shape : 'a t -> 'a t -> bool
+
+  exception IncompatibleFold2
   (** [fold2 f x sk1 sk2] folds [f] on any pair of term in [(sk1,sk2)].
-      @return the result and the lifts to apply on the terms *)
-  val fold2 : ('a -> Term.constr -> Term.constr -> 'a) -> 'a ->
-    Term.constr t -> Term.constr t -> 'a * int * int
-  val map : (Term.constr -> Term.constr) -> Term.constr t -> Term.constr t
+      @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
+  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
@@ -101,8 +115,8 @@ module Stack : sig
   val tail : int -> 'a t -> 'a t
   val nth : 'a t -> int -> 'a
 
-  val best_state : constr * constr t -> Cst_stack.t -> constr * constr t
-  val zip : ?refold:bool -> constr * constr t -> constr
+  val best_state : evar_map -> constr * constr t -> Cst_stack.t -> constr * constr t
+  val zip : ?refold:bool -> evar_map -> constr * constr t -> constr
 end
 
 (************************************************************************)
@@ -113,7 +127,7 @@ type contextual_reduction_function = env -> evar_map -> constr -> constr
 type reduction_function = contextual_reduction_function
 type local_reduction_function = evar_map -> constr -> constr
 
-type e_reduction_function = { e_redfun : 'r. env -> 'r Sigma.t -> constr -> (constr, 'r) Sigma.sigma }
+type e_reduction_function = env -> evar_map -> constr -> evar_map * constr
 
 type contextual_stack_reduction_function =
     env -> evar_map -> constr -> constr * constr list
@@ -126,7 +140,7 @@ type contextual_state_reduction_function =
 type state_reduction_function = contextual_state_reduction_function
 type local_state_reduction_function = evar_map -> state -> state
 
-val pr_state : state -> Pp.std_ppcmds
+val pr_state : state -> Pp.t
 
 (** {6 Reduction Function Operators } *)
 
@@ -137,22 +151,23 @@ val strong_prodspine : local_reduction_function -> local_reduction_function
 val stack_reduction_of_reduction :
   'a reduction_function -> 'a state_reduction_function
 i*)
-val stacklam : (state -> 'a) -> constr list -> constr -> constr Stack.t -> 'a
+val stacklam : (state -> 'a) -> constr list -> evar_map -> constr -> constr Stack.t -> 'a
 
 val whd_state_gen : ?csts:Cst_stack.t -> refold:bool -> tactic_mode:bool ->
   CClosure.RedFlags.reds -> Environ.env -> Evd.evar_map -> state -> state * Cst_stack.t
 
 val iterate_whd_gen : bool -> CClosure.RedFlags.reds ->
-  Environ.env -> Evd.evar_map -> Term.constr -> Term.constr
+  Environ.env -> Evd.evar_map -> constr -> constr
 
 (** {6 Generic Optimized Reduction Function using Closures } *)
 
 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
 
@@ -200,9 +215,9 @@ val shrink_eta : constr -> constr
 
 (** Various reduction functions *)
 
-val safe_evar_value : evar_map -> existential -> constr option
+val safe_evar_value : evar_map -> Constr.existential -> Constr.constr option
 
-val beta_applist : constr * constr list -> constr
+val beta_applist : evar_map -> constr * constr list -> constr
 
 val hnf_prod_app     : env ->  evar_map -> constr -> constr -> constr
 val hnf_prod_appvect : env ->  evar_map -> constr -> constr array -> constr
@@ -213,12 +228,12 @@ val hnf_lam_applist  : env ->  evar_map -> constr -> constr list -> constr
 
 val splay_prod : env ->  evar_map -> constr -> (Name.t * constr) list * constr
 val splay_lam : env ->  evar_map -> constr -> (Name.t * constr) list * constr
-val splay_arity : env ->  evar_map -> constr -> (Name.t * constr) list * sorts
-val sort_of_arity : env -> evar_map -> constr -> sorts
-val splay_prod_n : env ->  evar_map -> int -> constr -> Context.Rel.t * constr
-val splay_lam_n : env ->  evar_map -> int -> constr -> Context.Rel.t * constr
+val splay_arity : env ->  evar_map -> constr -> (Name.t * constr) list * ESorts.t
+val sort_of_arity : env -> evar_map -> constr -> ESorts.t
+val splay_prod_n : env ->  evar_map -> int -> constr -> rel_context * constr
+val splay_lam_n : env ->  evar_map -> int -> constr -> rel_context * constr
 val splay_prod_assum :
-  env ->  evar_map -> constr -> Context.Rel.t * constr
+  env ->  evar_map -> constr -> rel_context * constr
 
 type 'a miota_args = {
   mP      : constr;     (** the result type *)
@@ -227,22 +242,22 @@ type 'a miota_args = {
   mcargs  : 'a list;    (** the constructor's arguments *)
   mlf     : 'a array }  (** the branch code vector *)
 
-val reducible_mind_case : constr -> bool
-val reduce_mind_case : constr miota_args -> constr
+val reducible_mind_case : evar_map -> constr -> bool
+val reduce_mind_case : evar_map -> constr miota_args -> constr
 
-val find_conclusion : env -> evar_map -> constr -> (constr,constr) kind_of_term
+val find_conclusion : env -> evar_map -> constr -> (constr, constr, ESorts.t, EInstance.t) kind_of_term
 val is_arity : env ->  evar_map -> constr -> bool
 val is_sort : env -> evar_map -> types -> bool
 
-val contract_fix : ?env:Environ.env -> ?reference:Constant.t -> fixpoint -> constr
-val fix_recarg : fixpoint -> constr Stack.t -> (int * constr) option
+val contract_fix : ?env:Environ.env -> evar_map -> ?reference:Constant.t -> fixpoint -> constr
+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
@@ -258,7 +273,7 @@ val check_conv : ?pb:conv_pb -> ?ts:transparent_state -> env ->  evar_map -> con
 
 (** [infer_conv] Adds necessary universe constraints to the evar map.
     pb defaults to CUMUL and ts to a full transparent state.
-    @raises UniverseInconsistency iff catch_incon is set to false, 
+    @raise UniverseInconsistency iff catch_incon is set to false,
     otherwise returns false in that case.
  *)
 val infer_conv : ?catch_incon:bool -> ?pb:conv_pb -> ?ts:transparent_state -> 
@@ -274,14 +289,14 @@ val vm_infer_conv : ?pb:conv_pb -> env -> evar_map -> constr -> constr ->
 (** [infer_conv_gen] behaves like [infer_conv] but is parametrized by a
 conversion function. Used to pretype vm and native casts. *)
 val infer_conv_gen : (conv_pb -> l2r:bool -> evar_map -> transparent_state ->
-    (constr, evar_map) Reduction.generic_conversion_function) ->
+    (Constr.constr, evar_map) Reduction.generic_conversion_function) ->
   ?catch_incon:bool -> ?pb:conv_pb -> ?ts:transparent_state -> env ->
   evar_map -> constr -> constr -> evar_map * bool
 
 (** {6 Special-Purpose Reduction Functions } *)
 
-val whd_meta : evar_map -> constr -> constr
-val plain_instance : constr Metamap.t -> constr -> constr
+val whd_meta : local_reduction_function
+val plain_instance : evar_map -> constr Metamap.t -> constr -> constr
 val instance : evar_map -> constr Metamap.t -> constr -> constr
 val head_unfold_under_prod : transparent_state -> reduction_function
 val betazetaevar_applist : evar_map -> int -> constr -> constr list -> constr
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 98b36fb9..3582b644 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -1,25 +1,32 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Term
-open Vars
+open Constr
 open Inductive
 open Inductiveops
 open Names
 open Reductionops
 open Environ
 open Termops
+open EConstr
+open Vars
 open Arguments_renaming
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 type retype_error =
   | NotASort
   | NotAnArity
@@ -44,14 +51,14 @@ let retype_error re = raise (RetypeError re)
 
 let anomaly_on_error f x =
  try f x
- with RetypeError e -> anomaly ~label:"retyping" (print_retype_error e)
+ with RetypeError e -> anomaly ~label:"retyping" (print_retype_error e ++ str ".")
 
 let get_type_from_constraints env sigma t =
-  if isEvar (fst (decompose_app t)) then
+  if isEvar sigma (fst (decompose_app_vect sigma t)) then
     match
       List.map_filter (fun (pbty,env,t1,t2) ->
-        if is_fconv Reduction.CONV env sigma t t1 then Some t2
-        else if is_fconv Reduction.CONV env sigma t t2 then Some t1
+        if is_fconv Reduction.CONV env sigma t (EConstr.of_constr t1) then Some t2
+        else if is_fconv Reduction.CONV env sigma t (EConstr.of_constr t2) then Some t1
         else None)
         (snd (Evd.extract_all_conv_pbs sigma))
     with
@@ -62,7 +69,7 @@ let get_type_from_constraints env sigma t =
 let rec subst_type env sigma typ = function
   | [] -> typ
   | h::rest ->
-      match kind_of_term (whd_all env sigma typ) with
+      match EConstr.kind sigma (whd_all env sigma typ) with
         | Prod (na,c1,c2) -> subst_type env sigma (subst1 h c2) rest
         | _ -> retype_error NonFunctionalConstruction
 
@@ -71,49 +78,50 @@ let rec subst_type env sigma typ = function
 
 let sort_of_atomic_type env sigma ft args =
   let rec concl_of_arity env n ar args =
-    match kind_of_term (whd_all env sigma ar), args with
+    match EConstr.kind sigma (whd_all env sigma ar), args with
     | Prod (na, t, b), h::l -> concl_of_arity (push_rel (LocalDef (na, lift n h, t)) env) (n + 1) b l
-    | Sort s, [] -> s
+    | Sort s, [] -> ESorts.kind sigma s
     | _ -> retype_error NotASort
   in concl_of_arity env 0 ft (Array.to_list args)
 
 let type_of_var env id =
-  let open Context.Named.Declaration in
-  try get_type (lookup_named id env)
+  try NamedDecl.get_type (lookup_named id env)
   with Not_found -> retype_error (BadVariable id)
 
 let decomp_sort env sigma t =
-  match kind_of_term (whd_all env sigma t) with
-  | Sort s -> s
+  match EConstr.kind sigma (whd_all env sigma t) with
+  | Sort s -> ESorts.kind sigma s
   | _ -> retype_error NotASort
 
+let destSort sigma s = ESorts.kind sigma (destSort sigma s)
+
 let retype ?(polyprop=true) sigma =
   let rec type_of env cstr =
-    match kind_of_term cstr with
+    match EConstr.kind sigma cstr with
     | Meta n ->
-      (try strip_outer_cast (Evd.meta_ftype sigma n).Evd.rebus
+      (try strip_outer_cast sigma (EConstr.of_constr (Evd.meta_ftype sigma n).Evd.rebus)
        with Not_found -> retype_error (BadMeta n))
     | Rel n ->
-	let ty = get_type (lookup_rel n env) in
+	let ty = RelDecl.get_type (lookup_rel n env) in
         lift n ty
     | Var id -> type_of_var env id
-    | Const cst -> rename_type_of_constant env cst
-    | Evar ev -> Evd.existential_type sigma ev
-    | Ind ind -> rename_type_of_inductive env ind
-    | Construct cstr -> rename_type_of_constructor env cstr
+    | Const (cst, u) -> EConstr.of_constr (rename_type_of_constant env (cst, EInstance.kind sigma u))
+    | Evar ev -> existential_type sigma ev
+    | Ind (ind, u) -> EConstr.of_constr (rename_type_of_inductive env (ind, EInstance.kind sigma u))
+    | Construct (cstr, u) -> EConstr.of_constr (rename_type_of_constructor env (cstr, EInstance.kind sigma u))
     | Case (_,p,c,lf) ->
         let Inductiveops.IndType(indf,realargs) =
           let t = type_of env c in
           try Inductiveops.find_rectype env sigma t
           with Not_found ->
           try
-            let t = get_type_from_constraints env sigma t in
+            let t = EConstr.of_constr (get_type_from_constraints env sigma t) in
             Inductiveops.find_rectype env sigma t
           with Not_found -> retype_error BadRecursiveType
         in
         let n = inductive_nrealdecls_env env (fst (fst (dest_ind_family indf))) in
         let t = betazetaevar_applist sigma n p realargs in
-        (match kind_of_term (whd_all env sigma (type_of env t)) with
+        (match EConstr.kind sigma (whd_all env sigma (type_of env t)) with
           | Prod _ -> whd_beta sigma (applist (t, [c]))
           | _ -> t)
     | Lambda (name,c1,c2) ->
@@ -122,25 +130,28 @@ let retype ?(polyprop=true) sigma =
          subst1 b (type_of (push_rel (LocalDef (name,b,c1)) env) c2)
     | Fix ((_,i),(_,tys,_)) -> tys.(i)
     | CoFix (i,(_,tys,_)) -> tys.(i)
-    | App(f,args) when is_template_polymorphic env f ->
+    | App(f,args) when is_template_polymorphic env sigma f ->
 	let t = type_of_global_reference_knowing_parameters env f args in
-        strip_outer_cast (subst_type env sigma t (Array.to_list args))
+        strip_outer_cast sigma (subst_type env sigma t (Array.to_list args))
     | App(f,args) ->
-        strip_outer_cast
+        strip_outer_cast sigma
           (subst_type env sigma (type_of env f) (Array.to_list args))
     | Proj (p,c) ->
        let ty = type_of env c in
-       (try
+       EConstr.of_constr (try
 	   Inductiveops.type_of_projection_knowing_arg env sigma p c ty
 	 with Invalid_argument _ -> retype_error BadRecursiveType)
     | Cast (c,_, t) -> t
     | Sort _ | Prod _ -> mkSort (sort_of env cstr)
 
   and sort_of env t =
-    match kind_of_term t with
-    | Cast (c,_, s) when isSort s -> destSort s
-    | Sort (Prop c) -> type1_sort
-    | Sort (Type u) -> Type (Univ.super u)
+    match EConstr.kind sigma t with
+    | Cast (c,_, s) when isSort sigma s -> destSort sigma s
+    | Sort s ->
+      begin match ESorts.kind sigma s with
+      | Prop _ -> Sorts.type1
+      | Type u -> Type (Univ.super u)
+      end
     | Prod (name,t,c2) ->
         (match (sort_of env t, sort_of (push_rel (LocalAssum (name,t)) env) c2) with
 	  | _, (Prop Null as s) -> s
@@ -150,69 +161,67 @@ let retype ?(polyprop=true) sigma =
 	  | Prop Pos, (Type u2) -> Type (Univ.sup Univ.type0_univ u2)
 	  | Prop Null, (Type _ as s) -> s
 	  | Type u1, Type u2 -> Type (Univ.sup u1 u2))
-    | App(f,args) when is_template_polymorphic env f ->
+    | App(f,args) when is_template_polymorphic env sigma f ->
       let t = type_of_global_reference_knowing_parameters env f args in
         sort_of_atomic_type env sigma t args
     | App(f,args) -> sort_of_atomic_type env sigma (type_of env f) args
     | Lambda _ | Fix _ | Construct _ -> retype_error NotAType
     | _ -> decomp_sort env sigma (type_of env t)
 
-  and sort_family_of env t =
-    match kind_of_term t with
-    | Cast (c,_, s) when isSort s -> family_of_sort (destSort s)
-    | Sort (Prop c) -> InType
-    | Sort (Type u) -> InType
+  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
+    match EConstr.kind sigma c with
+    | Ind (ind, u) ->
+      let u = EInstance.kind sigma u in
+      let mip = lookup_mind_specif env ind in
+	EConstr.of_constr (try Inductive.type_of_inductive_knowing_parameters
+	       ~polyprop env (mip, u) argtyps
+	 with Reduction.NotArity -> retype_error NotAnArity)
+    | Construct (cstr, u) ->
+      let u = EInstance.kind sigma u in
+      EConstr.of_constr (type_of_constructor env (cstr, u))
+    | _ -> assert false
+
+  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 f ->
+    | 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
-        family_of_sort (sort_of_atomic_type env sigma t args)
+        Sorts.family (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)
+	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
     | _ -> 
-      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 (nf_evar sigma (type_of env c))) args in
-    match kind_of_term c with
-    | Ind ind ->
-      let mip = lookup_mind_specif env (fst ind) in
-	(try Inductive.type_of_inductive_knowing_parameters
-	       ~polyprop env (mip,snd ind) argtyps
-	 with Reduction.NotArity -> retype_error NotAnArity)
-    | Const cst ->
-	(try Typeops.type_of_constant_knowing_parameters_in env cst argtyps
-	 with Reduction.NotArity -> retype_error NotAnArity)
-    | Var id -> type_of_var env id
-    | Construct cstr -> type_of_constructor env cstr
-    | _ -> assert false
-
-  in type_of, sort_of, sort_family_of,
-     type_of_global_reference_knowing_parameters
+      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 =
-  let conclty = nf_evar sigma conclty in
-  match kind_of_term c with
+  match EConstr.kind sigma c with
     | Ind (ind,u) ->
         let spec = Inductive.lookup_mind_specif env ind in
-          type_of_inductive_knowing_conclusion env sigma (spec,u) conclty
-    | Const cst ->
-        let t = constant_type_in env cst in
-        (* TODO *)
-          sigma, Typeops.type_of_constant_type_knowing_parameters env t [||]
+          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
+          sigma, EConstr.of_constr t
     | Var id -> sigma, type_of_var env id
-    | Construct cstr -> sigma, type_of_constructor env cstr
+    | Construct (cstr, u) -> sigma, EConstr.of_constr (type_of_constructor env (cstr, EInstance.kind sigma u))
     | _ -> assert false
 
 (* Profiling *)
@@ -220,14 +229,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 *)
@@ -239,7 +248,7 @@ let sorts_of_context env evc ctxt =
   | [] -> env,[]
   | d :: ctxt ->
       let env,sorts = aux ctxt in
-      let s = get_sort_of env evc (get_type d) in
+      let s = get_sort_of env evc (RelDecl.get_type d) in
       (push_rel d env,s::sorts) in
   snd (aux ctxt)
 
diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli
index 8ca40f82..2aff0c77 100644
--- a/pretyping/retyping.mli
+++ b/pretyping/retyping.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
 open Evd
 open Environ
+open EConstr
 
 (** This family of functions assumes its constr argument is known to be
    well-typable. It does not type-check, just recompute the type
@@ -29,10 +31,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
@@ -43,8 +48,8 @@ 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 -> Context.Rel.t -> 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
+val expand_projection : env -> evar_map -> Names.Projection.t -> constr -> constr list -> constr
 
-val print_retype_error : retype_error -> Pp.std_ppcmds
+val print_retype_error : retype_error -> Pp.t
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 820a81b5..518d2f60 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,24 +13,27 @@ open CErrors
 open Util
 open Names
 open Term
-open Vars
 open Libnames
 open Globnames
 open Termops
+open Environ
+open EConstr
+open Vars
 open Find_subterm
 open Namegen
-open Environ
 open CClosure
 open Reductionops
 open Cbv
 open Patternops
 open Locus
-open Sigma.Notations
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 (* Errors *)
 
 type reduction_tactic_error =
-    InvalidAbstraction of env * Evd.evar_map * constr * (env * Type_errors.type_error)
+    InvalidAbstraction of env * Evd.evar_map * EConstr.constr * (env * Type_errors.type_error)
 
 exception ReductionTacticError of reduction_tactic_error
 
@@ -38,7 +43,7 @@ exception Elimconst
 exception Redelimination
 
 let error_not_evaluable r =
-  errorlabstrm "error_not_evaluable"
+  user_err ~hdr:"error_not_evaluable"
     (str "Cannot coerce" ++ spc () ++ Nametab.pr_global_env Id.Set.empty r ++
      spc () ++ str "to an evaluable reference.")
 
@@ -54,13 +59,11 @@ let is_evaluable env = function
   | EvalVarRef id -> is_evaluable_var env id
 
 let value_of_evaluable_ref env evref u =
-  let open Context.Named.Declaration in
   match evref with
   | EvalConstRef con -> 
-    (try constant_value_in env (con,u)
-    with NotEvaluableConst IsProj -> 
-      raise (Invalid_argument "value_of_evaluable_ref"))
-  | EvalVarRef id -> lookup_named id env |> get_value |> Option.get
+    let u = Unsafe.to_instance u in
+    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
   | ConstRef cst when is_evaluable_const env cst -> EvalConstRef cst
@@ -72,17 +75,17 @@ 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 existential
+  | EvalEvar of EConstr.existential
 
-let evaluable_reference_eq r1 r2 = match r1, r2 with
-| EvalConst c1, EvalConst c2 -> eq_constant c1 c2
+let evaluable_reference_eq sigma r1 r2 = match r1, r2 with
+| 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) ->
-  Evar.equal e1 e2 && Array.equal eq_constr ctx1 ctx2
+  Evar.equal e1 e2 && Array.equal (EConstr.eq_constr sigma) ctx1 ctx2
 | _ -> false
 
 let mkEvalRef ref u =
@@ -90,45 +93,49 @@ let mkEvalRef ref u =
   | EvalConst cst -> mkConstU (cst,u)
   | EvalVar id -> mkVar id
   | EvalRel n -> mkRel n
-  | EvalEvar ev -> mkEvar ev
+  | EvalEvar ev -> EConstr.mkEvar ev
 
-let isEvalRef env c = match kind_of_term c with
+let isEvalRef env sigma c = match EConstr.kind sigma c with
   | Const (sp,_) -> is_evaluable env (EvalConstRef sp)
   | Var id -> is_evaluable env (EvalVarRef id)
   | Rel _ | Evar _ -> true
   | _ -> false
 
-let destEvalRefU c = match kind_of_term c with
+let destEvalRefU sigma c = match EConstr.kind sigma c with
   | Const (cst,u) ->  EvalConst cst, u
-  | Var id  -> (EvalVar id, Univ.Instance.empty)
-  | Rel n -> (EvalRel n, Univ.Instance.empty)
-  | Evar ev -> (EvalEvar ev, Univ.Instance.empty)
-  | _ -> anomaly (Pp.str "Not an unfoldable reference")
+  | Var id  -> (EvalVar id, EInstance.empty)
+  | Rel n -> (EvalRel n, EInstance.empty)
+  | Evar ev -> (EvalEvar ev, EInstance.empty)
+  | _ -> anomaly (Pp.str "Not an unfoldable reference.")
 
 let unsafe_reference_opt_value env sigma eval =
   match eval with
   | EvalConst cst ->
     (match (lookup_constant cst env).Declarations.const_body with 
-    | Declarations.Def c -> Some (Mod_subst.force_constr c)
+    | Declarations.Def c -> Some (EConstr.of_constr (Mod_subst.force_constr c))
     | _ -> None)
   | EvalVar id ->
-      let open Context.Named.Declaration in
-      lookup_named id env |> get_value
+      env |> lookup_named id |> NamedDecl.get_value
   | EvalRel n ->
-      let open Context.Rel.Declaration in
-      lookup_rel n env |> map_value (lift n) |> get_value
-  | EvalEvar ev -> Evd.existential_opt_value sigma ev
+      env |> lookup_rel n |> RelDecl.get_value |> Option.map (lift n)
+  | EvalEvar ev ->
+    match EConstr.kind sigma (mkEvar ev) with
+    | Evar _ -> None
+    | c -> Some (EConstr.of_kind c)
 
 let reference_opt_value env sigma eval u = 
   match eval with
-  | EvalConst cst -> constant_opt_value_in env (cst,u)
+  | EvalConst cst ->
+    let u = EInstance.kind sigma u in
+    Option.map EConstr.of_constr (constant_opt_value_in env (cst,u))
   | EvalVar id ->
-      let open Context.Named.Declaration in
-      lookup_named id env |> get_value
+      env |> lookup_named id |> NamedDecl.get_value
   | EvalRel n ->
-      let open Context.Rel.Declaration in
-      lookup_rel n env |> map_value (lift n) |> get_value
-  | EvalEvar ev -> Evd.existential_opt_value sigma ev
+      env |> lookup_rel n |> RelDecl.get_value |> Option.map (lift n)
+  | EvalEvar ev ->
+    match EConstr.kind sigma (mkEvar ev) with
+    | Evar _ -> None
+    | c -> Some (EConstr.of_kind c)
 
 exception NotEvaluable
 let reference_value env sigma c u =
@@ -179,18 +186,18 @@ let eval_table = Summary.ref (Cmap.empty : frozen) ~name:"evaluation"
    the xp..x1.
 *)
 
-let check_fix_reversibility labs args ((lv,i),(_,tys,bds)) =
+let check_fix_reversibility sigma labs args ((lv,i),(_,tys,bds)) =
   let n = List.length labs in
   let nargs = List.length args in
   if nargs > n then raise Elimconst;
   let nbfix = Array.length bds in
   let li =
     List.map
-      (function d -> match kind_of_term d with
+      (function d -> match EConstr.kind sigma d with
          | Rel k ->
              if
-	       Array.for_all (noccurn k) tys
-	       && Array.for_all (noccurn (k+nbfix)) bds
+	       Array.for_all (Vars.noccurn sigma k) tys
+	       && Array.for_all (Vars.noccurn sigma (k+nbfix)) bds
 	       && k <= n
 	     then
 	       (k, List.nth labs (k-1))
@@ -204,7 +211,7 @@ let check_fix_reversibility labs args ((lv,i),(_,tys,bds)) =
     raise Elimconst;
   List.iteri (fun i t_i ->
     if not (Int.List.mem_assoc (i+1) li) then
-      let fvs = List.map ((+) (i+1)) (Int.Set.elements (free_rels t_i)) in
+      let fvs = List.map ((+) (i+1)) (Int.Set.elements (free_rels sigma t_i)) in
       match List.intersect Int.equal fvs reversible_rels with
       | [] -> ()
       | _ -> raise Elimconst)
@@ -233,17 +240,18 @@ 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 ->
 	      try match unsafe_reference_opt_value env sigma ref with
 		| None -> None
 		| Some c ->
-		    let labs',ccl = decompose_lam c in
+		    let labs',ccl = decompose_lam sigma c in
 		    let _, l' = whd_betalet_stack sigma ccl in
 		    let labs' = List.map snd labs' in
 		    (** ppedrot: there used to be generic equality on terms here *)
+                    let eq_constr c1 c2 = EConstr.eq_constr sigma c1 c2 in
 		    if List.equal eq_constr labs' labs &&
                        List.equal eq_constr l l' then Some (minfxargs,ref)
                     else None
@@ -258,16 +266,16 @@ let invert_name labs l na0 env sigma ref = function
 let compute_consteval_direct env sigma ref =
   let rec srec env n labs onlyproj c =
     let c',l = whd_betadeltazeta_stack env sigma c in
-    match kind_of_term c' with
+    match EConstr.kind sigma c' with
       | Lambda (id,t,g) when List.is_empty l && not onlyproj ->
           let open Context.Rel.Declaration in
 	  srec (push_rel (LocalAssum (id,t)) env) (n+1) (t::labs) onlyproj g
       | Fix fix when not onlyproj ->
-	  (try check_fix_reversibility labs l fix
+	  (try check_fix_reversibility sigma labs l fix
 	  with Elimconst -> NotAnElimination)
-      | Case (_,_,d,_) when isRel d && not onlyproj -> EliminationCases n
+      | Case (_,_,d,_) when isRel sigma d && not onlyproj -> EliminationCases n
       | Case (_,_,d,_) -> srec env n labs true d
-      | Proj (p, d) when isRel d -> EliminationProj n
+      | Proj (p, d) when isRel sigma d -> EliminationProj n
       | _ -> NotAnElimination
   in
   match unsafe_reference_opt_value env sigma ref with
@@ -278,7 +286,7 @@ let compute_consteval_mutual_fix env sigma ref =
   let rec srec env minarg labs ref c =
     let c',l = whd_betalet_stack sigma c in
     let nargs = List.length l in
-    match kind_of_term c' with
+    match EConstr.kind sigma c' with
       | Lambda (na,t,g) when List.is_empty l ->
           let open Context.Rel.Declaration in
 	  srec (push_rel (LocalAssum (na,t)) env) (minarg+1) (t::labs) ref g
@@ -294,11 +302,11 @@ let compute_consteval_mutual_fix env sigma ref =
 		 let new_minarg = max (minarg'+minarg-nargs) minarg' in
 		 EliminationMutualFix (new_minarg,ref,(refs,infos))
 	     | _ -> assert false)
-      | _ when isEvalRef env c' ->
+      | _ when isEvalRef env sigma c' ->
 	  (* Forget all \'s and args and do as if we had started with c' *)
-	  let ref,_ = destEvalRefU c' in
+	  let ref,_ = destEvalRefU sigma c' in
 	  (match unsafe_reference_opt_value env sigma ref with
-	    | None -> anomaly (Pp.str "Should have been trapped by compute_direct")
+	    | None -> anomaly (Pp.str "Should have been trapped by compute_direct.")
 	    | Some c -> srec env (minarg-nargs) [] ref c)
       | _ -> (* Should not occur *) NotAnElimination
   in
@@ -355,17 +363,17 @@ let make_elim_fun (names,(nbfix,lv,n)) u largs =
       (* k from the comment is q+1 *)
       try mkRel (p+1-(List.index Int.equal (n-q) lyi))
       with Not_found -> aq)
-      0 (List.map (lift p) lu)
+      0 (List.map (Vars.lift p) lu)
   in
   fun i ->
     match names.(i) with
       | None -> None
       | Some (minargs,ref) ->
-          let body = applistc (mkEvalRef ref u) la in
+          let body = applist (mkEvalRef ref u, la) in
           let g =
             List.fold_left_i (fun q (* j = n+1-q *) c (ij,tij) ->
-              let subst = List.map (lift (-q)) (List.firstn (n-ij) la) in
-              let tij' = substl (List.rev subst) tij in
+              let subst = List.map (Vars.lift (-q)) (List.firstn (n-ij) la) in
+              let tij' = Vars.substl (List.rev subst) tij in
 	      mkLambda (x,tij',c)) 1 body (List.rev lv)
           in Some (minargs,g)
 
@@ -385,21 +393,20 @@ let substl_with_function subst sigma constr =
   let evd = ref sigma in
   let minargs = ref Evar.Map.empty in
   let v = Array.of_list subst in
-  let rec subst_total k c = match kind_of_term c with
+  let rec subst_total k c = match EConstr.kind sigma c with
   | Rel i when k < i ->
     if i <= k + Array.length v then
       match v.(i-k-1) with
       | (fx, Some (min, ref)) ->
-        let sigma = Sigma.Unsafe.of_evar_map !evd in
-        let Sigma (evk, sigma, _) = Evarutil.new_pure_evar venv sigma dummy in
-        let sigma = Sigma.to_evar_map sigma in
+        let sigma = !evd in
+        let (sigma, evk) = Evarutil.new_pure_evar venv sigma dummy in
         evd := sigma;
         minargs := Evar.Map.add evk min !minargs;
-        lift k (mkEvar (evk, [|fx;ref|]))
-      | (fx, None) -> lift k fx
+        Vars.lift k (mkEvar (evk, [|fx;ref|]))
+      | (fx, None) -> Vars.lift k fx
     else mkRel (i - Array.length v)
   | _ ->
-    map_constr_with_binders succ subst_total k c in
+    map_with_binders sigma succ subst_total k c in
   let c = subst_total 0 constr in
   (c, !evd, !minargs)
 
@@ -409,28 +416,28 @@ exception Partial
    reduction is solved by the expanded fix term. *)
 let solve_arity_problem env sigma fxminargs c =
   let evm = ref sigma in
-  let set_fix i = evm := Evd.define i (mkVar vfx) !evm in
+  let set_fix i = evm := Evd.define i (Constr.mkVar vfx) !evm in
   let rec check strict c =
     let c' = whd_betaiotazeta sigma c in
-    let (h,rcargs) = decompose_app c' in
-    match kind_of_term h with
+    let (h,rcargs) = decompose_app_vect sigma c' in
+    match EConstr.kind sigma h with
         Evar(i,_) when Evar.Map.mem i fxminargs && not (Evd.is_defined !evm i) ->
           let minargs = Evar.Map.find i fxminargs in
-          if List.length rcargs < minargs then
+          if Array.length rcargs < minargs then
             if strict then set_fix i
             else raise Partial;
-          List.iter (check strict) rcargs
-      | (Var _|Const _) when isEvalRef env h ->
-          (let ev, u = destEvalRefU h in
+          Array.iter (check strict) rcargs
+      | (Var _|Const _) when isEvalRef env sigma h ->
+          (let ev, u = destEvalRefU sigma h in
 	     match reference_opt_value env sigma ev u with
              | Some h' ->
                 let bak = !evm in
-                (try List.iter (check false) rcargs
+                (try Array.iter (check false) rcargs
                 with Partial ->
                   evm := bak;
-                  check strict (applist(h',rcargs)))
-            | None -> List.iter (check strict) rcargs)
-      | _ -> iter_constr (check strict) c' in
+                  check strict (mkApp(h',rcargs)))
+            | None -> Array.iter (check strict) rcargs)
+      | _ -> EConstr.iter sigma (check strict) c' in
   check true c;
   !evm
 
@@ -441,16 +448,18 @@ let substl_checking_arity env subst sigma c =
   let sigma' = solve_arity_problem env sigma minargs body in
   (* we propagate the constraints: solved problems are substituted;
      the other ones are replaced by the function symbol *)
-  let rec nf_fix c =
-    match kind_of_term c with
-        Evar(i,[|fx;f|] as ev) when Evar.Map.mem i minargs ->
-          (match Evd.existential_opt_value sigma' ev with
-              Some c' -> c'
-            | None -> f)
-      | _ -> map_constr nf_fix c in
+  let rec nf_fix c = match EConstr.kind sigma c with
+  | Evar (i,[|fx;f|]) when Evar.Map.mem i minargs ->
+    (** FIXME: find a less hackish way of doing this *)
+    begin match EConstr.kind sigma' c with
+    | Evar _ -> f
+    | c -> EConstr.of_kind c
+    end
+  | _ -> EConstr.map sigma nf_fix c
+  in
   nf_fix body
 
-type fix_reduction_result = NotReducible | Reduced of (constr*constr list)
+type fix_reduction_result = NotReducible | Reduced of (constr * constr list)
 
 let reduce_fix whdfun sigma fix stack =
   match fix_recarg fix (Stack.append_app_list stack Stack.empty) with
@@ -458,8 +467,8 @@ let reduce_fix whdfun sigma fix stack =
     | Some (recargnum,recarg) ->
         let (recarg'hd,_ as recarg') = whdfun sigma recarg in
         let stack' = List.assign stack recargnum (applist recarg') in
-	(match kind_of_term recarg'hd with
-           | Construct _ -> Reduced (contract_fix fix, stack')
+	(match EConstr.kind sigma recarg'hd with
+           | Construct _ -> Reduced (contract_fix sigma fix, stack')
 	   | _ -> NotReducible)
 
 let contract_fix_use_function env sigma f
@@ -467,20 +476,20 @@ 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
     | None -> NotReducible
     | Some (recargnum,recarg) ->
         let (recarg'hd,_ as recarg') =
-	  if isRel recarg then
+	  if EConstr.isRel sigma recarg then
 	    (* The recarg cannot be a local def, no worry about the right env *)
 	    (recarg, [])
 	  else
 	    whfun recarg in
         let stack' = List.assign stack recargnum (applist recarg') in
-	(match kind_of_term recarg'hd with
+	(match EConstr.kind sigma recarg'hd with
            | Construct _ ->
 	       Reduced (contract_fix_use_function env sigma f fix,stack')
 	   | _ -> NotReducible)
@@ -491,16 +500,16 @@ 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 kind_of_term mia.mconstr with
+  match EConstr.kind sigma mia.mconstr with
     | Construct ((ind_sp,i),u) ->
 	let real_cargs = List.skipn mia.mci.ci_npar mia.mcargs in
 	applist (mia.mlf.(i-1), real_cargs)
     | CoFix (bodynum,(names,_,_) as cofix) ->
 	let build_cofix_name =
-	  if isConst func then
+	  if isConst sigma func then
             let minargs = List.length mia.mcargs in
 	    fun i ->
 	      if Int.equal i bodynum then Some (minargs,func)
@@ -511,13 +520,13 @@ let reduce_mind_case_use_function func env sigma mia =
 		       mutual inductive, try to reuse the global name if
 		       the block was indeed initially built as a global
 		       definition *)
-		    let kn = map_puniverses (fun x -> con_with_label x (Label.of_id id))
-		      (destConst func)
-		    in
-		    try match constant_opt_value_in env kn with
+                    let (kn, u) = destConst sigma func 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
                           (* TODO: check kn is correct *)
-		      | Some _ -> Some (minargs,mkConstU kn)
+		      | Some _ -> Some (minargs,mkConstU (kn, u))
 		    with Not_found -> None
 	  else
 	    fun _ -> None in
@@ -527,45 +536,56 @@ let reduce_mind_case_use_function func env sigma mia =
     | _ -> assert false
 
 
-let match_eval_ref env constr = 
-  match kind_of_term constr with
-  | Const (sp, u) when is_evaluable env (EvalConstRef sp) ->
-      Some (EvalConst sp, u)
-  | Var id when is_evaluable env (EvalVarRef id) -> Some (EvalVar id, Univ.Instance.empty)
-  | Rel i -> Some (EvalRel i, Univ.Instance.empty)
-  | Evar ev -> Some (EvalEvar ev, Univ.Instance.empty)
+let match_eval_ref env sigma constr stack =
+  match EConstr.kind sigma constr with
+  | Const (sp, u) ->
+     reduction_effect_hook env sigma (EConstr.to_constr sigma constr)
+        (lazy (EConstr.to_constr sigma (applist (constr,stack))));
+     if is_evaluable env (EvalConstRef sp) then Some (EvalConst sp, u) else None
+  | Var id when is_evaluable env (EvalVarRef id) -> Some (EvalVar id, EInstance.empty)
+  | Rel i -> Some (EvalRel i, EInstance.empty)
+  | Evar ev -> Some (EvalEvar ev, EInstance.empty)
   | _ -> None
 
-let match_eval_ref_value env sigma constr = 
-  match kind_of_term constr with
-  | Const (sp, u) when is_evaluable env (EvalConstRef sp) ->
-    Some (constant_value_in env (sp, u))
+let match_eval_ref_value env sigma constr stack =
+  match EConstr.kind sigma constr with
+  | Const (sp, u) ->
+     reduction_effect_hook env sigma (EConstr.to_constr sigma constr)
+        (lazy (EConstr.to_constr sigma (applist (constr,stack))));
+    if is_evaluable env (EvalConstRef sp) then
+      let u = EInstance.kind sigma u in
+      Some (EConstr.of_constr (constant_value_in env (sp, u)))
+    else
+      None
+  | Proj (p, c) when not (Projection.unfolded p) ->
+     reduction_effect_hook env sigma (EConstr.to_constr sigma constr)
+        (lazy (EConstr.to_constr sigma (applist (constr,stack))));
+     if is_evaluable env (EvalConstRef (Projection.constant p)) then
+       Some (mkProj (Projection.unfold p, c))
+     else None
   | Var id when is_evaluable env (EvalVarRef id) -> 
-     let open Context.Named.Declaration in
-     lookup_named id env |> get_value
+     env |> lookup_named id |> NamedDecl.get_value
   | Rel n ->
-     let open Context.Rel.Declaration in
-     lookup_rel n env |> map_value (lift n) |> get_value
-  | Evar ev -> Evd.existential_opt_value sigma ev
+     env |> lookup_rel n |> RelDecl.get_value |> Option.map (lift n)
   | _ -> None
 
 let special_red_case env sigma whfun (ci, p, c, lf) =
   let rec redrec s =
     let (constr, cargs) = whfun s in
-    match match_eval_ref env constr with
+    match match_eval_ref env sigma constr cargs with
     | Some (ref, u) ->
       (match reference_opt_value env sigma ref u with
       | None -> raise Redelimination
       | Some gvalue ->
-        if reducible_mind_case gvalue then
+        if reducible_mind_case sigma gvalue then
 	  reduce_mind_case_use_function constr env sigma
 	  {mP=p; mconstr=gvalue; mcargs=cargs;
            mci=ci; mlf=lf}
 	else
 	  redrec (applist(gvalue, cargs)))
     | None ->
-      if reducible_mind_case constr then
-        reduce_mind_case
+      if reducible_mind_case sigma constr then
+        reduce_mind_case sigma
 	  {mP=p; mconstr=constr; mcargs=cargs;
 	  mci=ci; mlf=lf}
       else
@@ -578,7 +598,7 @@ let recargs = function
   | EvalConst c -> ReductionBehaviour.get (ConstRef c)
 
 let reduce_projection env sigma pb (recarg'hd,stack') stack =
-  (match kind_of_term recarg'hd with
+  (match EConstr.kind sigma recarg'hd with
   | Construct _ -> 
     let proj_narg = 
       pb.Declarations.proj_npars + pb.Declarations.proj_arg
@@ -587,11 +607,11 @@ let reduce_projection env sigma pb (recarg'hd,stack') stack =
 
 let reduce_proj env sigma whfun whfun' c =
   let rec redrec s =
-    match kind_of_term s with
+    match EConstr.kind sigma s with
     | Proj (proj, c) -> 
       let c' = try redrec c with Redelimination -> c in
       let constr, cargs = whfun c' in
-	(match kind_of_term constr with
+	(match EConstr.kind sigma constr with
 	| Construct _ -> 
 	  let proj_narg = 
 	    let pb = lookup_projection proj env in
@@ -608,7 +628,7 @@ let reduce_proj env sigma whfun whfun' c =
 
 let whd_nothing_for_iota env sigma s =
   let rec whrec (x, stack as s) =
-    match kind_of_term x with
+    match EConstr.kind sigma x with
       | Rel n ->
           let open Context.Rel.Declaration in
 	  (match lookup_rel n env with
@@ -619,27 +639,26 @@ let whd_nothing_for_iota env sigma s =
 	  (match lookup_named id env with
 	     | LocalDef (_,body,_) -> whrec (body, stack)
 	     | _ -> s)
-      | Evar ev ->
-	(try whrec (Evd.existential_value sigma ev, stack)
-	with Evd.NotInstantiatedEvar | Not_found -> s)
+      | Evar ev -> s
       | Meta ev ->
-	(try whrec (Evd.meta_value sigma ev, stack)
+	(try whrec (EConstr.of_constr (Evd.meta_value sigma ev), stack)
 	with Not_found -> s)
-      | Const const when is_transparent_constant full_transparent_state (fst const) ->
-	  (match constant_opt_value_in env const with
-	     | Some  body -> whrec (body, stack)
+      | Const (const, u) when is_transparent_constant full_transparent_state const ->
+          let u = EInstance.kind sigma u in
+	  (match constant_opt_value_in env (const, u) with
+	     | Some  body -> whrec (EConstr.of_constr body, stack)
 	     | None -> s)
-      | LetIn (_,b,_,c) -> stacklam whrec [b] c stack
+      | LetIn (_,b,_,c) -> stacklam whrec [b] sigma c stack
       | Cast (c,_,_) -> whrec (c, stack)
       | App (f,cl)  -> whrec (f, Stack.append_app cl stack)
       | Lambda (na,t,c) ->
           (match Stack.decomp stack with
-             | Some (a,m) -> stacklam whrec [a] c m
+             | Some (a,m) -> stacklam whrec [a] sigma c m
 	     | _ -> s)
 
       | x -> s
   in
-  decompose_app (Stack.zip (whrec (s,Stack.empty)))
+  EConstr.decompose_app sigma (Stack.zip sigma (whrec (s,Stack.empty)))
 
 (* [red_elim_const] contracts iota/fix/cofix redexes hidden behind
    constants by keeping the name of the constants in the recursive calls;
@@ -664,7 +683,7 @@ let rec red_elim_const env sigma ref u largs =
 	let c = reference_value env sigma ref u in
 	let c', lrest = whd_nothing_for_iota env sigma (applist(c,largs)) in
 	let whfun = whd_simpl_stack env sigma in
-        (special_red_case env sigma whfun (destCase c'), lrest), nocase
+        (special_red_case env sigma whfun (EConstr.destCase sigma c'), lrest), nocase
     | EliminationProj n when nargs >= n ->
 	let c = reference_value env sigma ref u in
 	let c', lrest = whd_nothing_for_iota env sigma (applist(c,largs)) in
@@ -676,24 +695,24 @@ let rec red_elim_const env sigma ref u largs =
 	let d, lrest = whd_nothing_for_iota env sigma (applist(c,largs)) in
 	let f = make_elim_fun ([|Some (minfxargs,ref)|],infos) u largs in
 	let whfun = whd_construct_stack env sigma in
-	(match reduce_fix_use_function env sigma f whfun (destFix d) lrest with
+	(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
-	  if evaluable_reference_eq ref refgoal then
+	  if evaluable_reference_eq sigma ref refgoal then
 	    (c,args)
 	  else
 	    let c', lrest = whd_betalet_stack sigma (applist(c,args)) in
-	    descend (destEvalRefU c') lrest in
+	    descend (destEvalRefU sigma c') lrest in
 	let (_, midargs as s) = descend (ref,u) largs in
 	let d, lrest = whd_nothing_for_iota env sigma (applist s) in
 	let f = make_elim_fun refinfos u midargs in
 	let whfun = whd_construct_stack env sigma in
-	(match reduce_fix_use_function env sigma f whfun (destFix d) lrest with
+	(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
@@ -709,7 +728,7 @@ and reduce_params env sigma stack l =
       else
 	let arg = List.nth stack i in
 	let rarg = whd_construct_stack env sigma arg in
-	  match kind_of_term (fst rarg) with
+	  match EConstr.kind sigma (fst rarg) with
 	  | Construct _ -> List.assign stack i (applist rarg)
 	  | _ -> raise Redelimination)
       stack l
@@ -720,13 +739,15 @@ and reduce_params env sigma stack l =
 
 and whd_simpl_stack env sigma =
   let rec redrec s =
-    let (x, stack as s') = decompose_app s in
-    match kind_of_term x with
+    let (x, stack) = decompose_app_vect sigma s in
+    let stack = Array.to_list stack in
+    let s' = (x, stack) in
+    match EConstr.kind sigma x with
       | Lambda (na,t,c) ->
           (match stack with
              | [] -> s'
-             | a :: rest -> redrec (beta_applist (x,stack)))
-      | LetIn (n,b,t,c) -> redrec (applist (substl [b] c, stack))
+             | a :: rest -> redrec (beta_applist sigma (x, stack)))
+      | LetIn (n,b,t,c) -> redrec (applist (Vars.substl [b] c, stack))
       | App (f,cl) -> redrec (applist(f, (Array.to_list cl)@stack))
       | Cast (c,_,_) -> redrec (applist(c, stack))
       | Case (ci,p,c,lf) ->
@@ -766,12 +787,12 @@ and whd_simpl_stack env sigma =
 	 with Redelimination -> s')
 	  
       | _ -> 
-        match match_eval_ref env x with
+        match match_eval_ref env sigma x stack with
 	| Some (ref, u) ->
           (try
 	     let sapp, nocase = red_elim_const env sigma ref u stack in
              let hd, _ as s'' = redrec (applist(sapp)) in
-             let rec is_case x = match kind_of_term x with
+             let rec is_case x = match EConstr.kind sigma x with
                | Lambda (_,_, x) | LetIn (_,_,_, x) | Cast (x, _,_) -> is_case x
                | App (hd, _) -> is_case hd
                | Case _ -> true
@@ -787,8 +808,8 @@ and whd_simpl_stack env sigma =
 
 and whd_construct_stack env sigma s =
   let (constr, cargs as s') = whd_simpl_stack env sigma s in
-  if reducible_mind_case constr then s'
-  else match match_eval_ref env constr with
+  if reducible_mind_case sigma constr then s'
+  else match match_eval_ref env sigma constr cargs with
   | Some (ref, u) ->
     (match reference_opt_value env sigma ref u with
     | None -> raise Redelimination
@@ -804,12 +825,12 @@ and whd_construct_stack env sigma s =
 *)
 
 let try_red_product env sigma c =
-  let simpfun = clos_norm_flags betaiotazeta env sigma in
+  let simpfun c = clos_norm_flags betaiotazeta env sigma c in
   let rec redrec env x =
     let x = whd_betaiota sigma x in
-    match kind_of_term x with
+    match EConstr.kind sigma x with
       | App (f,l) ->
-          (match kind_of_term f with
+          (match EConstr.kind sigma f with
              | Fix fix ->
                  let stack = Stack.append_app l Stack.empty in
                  (match fix_recarg fix stack with
@@ -817,17 +838,17 @@ let try_red_product env sigma c =
                     | Some (recargnum,recarg) ->
                         let recarg' = redrec env recarg in
                         let stack' = Stack.assign stack recargnum recarg' in
-                        simpfun (Stack.zip (f,stack')))
-             | _ -> simpfun (appvect (redrec env f, l)))
+                        simpfun (Stack.zip sigma (f,stack')))
+             | _ -> simpfun (mkApp (redrec env f, l)))
       | Cast (c,_,_) -> redrec env c
       | Prod (x,a,b) ->
           let open Context.Rel.Declaration in
-	  mkProd (x, a, redrec (push_rel (LocalAssum (x,a)) env) b)
-      | LetIn (x,a,b,t) -> redrec env (subst1 a t)
+	  mkProd (x, a, redrec (push_rel (LocalAssum (x, a)) env) b)
+      | LetIn (x,a,b,t) -> redrec env (Vars.subst1 a t)
       | Case (ci,p,d,lf) -> simpfun (mkCase (ci,p,redrec env d,lf))
       | Proj (p, c) -> 
 	let c' = 
-	  match kind_of_term c with
+	  match EConstr.kind sigma c with
 	  | Construct _ -> c
 	  | _ -> redrec env c
 	in
@@ -836,7 +857,7 @@ let try_red_product env sigma c =
 	  | Reduced s -> simpfun (applist s)
 	  | NotReducible -> raise Redelimination)
       | _ -> 
-        (match match_eval_ref env x with
+        (match match_eval_ref env sigma x [] with
         | Some (ref, u) ->
           (* TO DO: re-fold fixpoints after expansion *)
           (* to get true one-step reductions *)
@@ -848,7 +869,7 @@ let try_red_product env sigma c =
 
 let red_product env sigma c =
   try try_red_product env sigma c
-  with Redelimination -> error "No head constant to reduce."
+  with Redelimination -> user_err (str "No head constant to reduce.")
 
 (*
 (* This old version of hnf uses betadeltaiota instead of itself (resp
@@ -906,8 +927,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
@@ -917,13 +938,13 @@ let whd_simpl_stack =
 let whd_simpl_orelse_delta_but_fix env sigma c =
   let rec redrec s =
     let (constr, stack as s') = whd_simpl_stack env sigma s in
-    match match_eval_ref_value env sigma constr with
+    match match_eval_ref_value env sigma constr stack with
     | Some c ->
-      (match kind_of_term (strip_lam c) with
+      (match EConstr.kind sigma (snd (decompose_lam sigma c)) with
       | CoFix _ | Fix _ -> s'
       | Proj (p,t) when
-	  (match kind_of_term constr with
-	  | Const (c', _) -> eq_constant (Projection.constant p) c'
+	  (match EConstr.kind sigma constr with
+	  | 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
@@ -948,9 +969,9 @@ let simpl env sigma c = strong whd_simpl env sigma c
 (* Reduction at specific subterms *)
 
 let matches_head env sigma c t =
-  match kind_of_term t with
+  match EConstr.kind sigma t with
     | App (f,_) -> Constr_matching.matches env sigma c f
-    | Proj (p, _) -> Constr_matching.matches env sigma c (mkConst (Projection.constant p))
+    | Proj (p, _) -> Constr_matching.matches env sigma c (mkConstU (Projection.constant p, EInstance.empty))
     | _ -> raise Constr_matching.PatternMatchingFailure
 
 (** FIXME: Specific function to handle projections: it ignores what happens on the
@@ -958,26 +979,25 @@ let matches_head env sigma c t =
     of the projection and its eta expanded form.
 *)
 let change_map_constr_with_binders_left_to_right g f (env, l as acc) sigma c = 
-  match kind_of_term c with
+  match EConstr.kind sigma c with
   | Proj (p, r) -> (* Treat specially for partial applications *)
     let t = Retyping.expand_projection env sigma p r [] in
-    let hdf, al = destApp t in
+    let hdf, al = destApp sigma t in
     let a = al.(Array.length al - 1) in
     let app = (mkApp (hdf, Array.sub al 0 (Array.length al - 1))) in
     let app' = f acc app in
     let a' = f acc a in
-      (match kind_of_term app' with
+      (match EConstr.kind sigma app' with
       | App (hdf', al') when hdf' == hdf ->
         (* Still the same projection, we ignore the change in parameters *)
 	mkProj (p, a')
       | _ -> mkApp (app', [| a' |]))
-  | _ -> map_constr_with_binders_left_to_right g f acc c
+  | _ -> map_constr_with_binders_left_to_right sigma g f acc c
 
-let e_contextually byhead (occs,c) f = { e_redfun = begin fun env sigma t ->
+let e_contextually byhead (occs,c) f = begin fun env sigma t ->
   let (nowhere_except_in,locs) = Locusops.convert_occs occs in
   let maxocc = List.fold_right max locs 0 in
   let pos = ref 1 in
-  let sigma = Sigma.to_evar_map sigma in
   (** FIXME: we do suspicious things with this evarmap *)
   let evd = ref sigma in
   let rec traverse nested (env,c as envc) t =
@@ -993,12 +1013,12 @@ let e_contextually byhead (occs,c) f = { e_redfun = begin fun env sigma t ->
       incr pos;
       if ok then begin
         if Option.has_some nested then
-          errorlabstrm "" (str "The subterm at occurrence " ++ int (Option.get nested) ++ str " overlaps with the subterm at occurrence " ++ int (!pos-1) ++ str ".");
+          user_err  (str "The subterm at occurrence " ++ int (Option.get nested) ++ str " overlaps with the subterm at occurrence " ++ int (!pos-1) ++ str ".");
         (* Skip inner occurrences for stable counting of occurrences *)
         if locs != [] then
           ignore (traverse_below (Some (!pos-1)) envc t);
-	let Sigma (t, evm, _) = (f subst).e_redfun env (Sigma.Unsafe.of_evar_map !evd) t in
-	(evd := Sigma.to_evar_map evm; t)
+	let (evm, t) = (f subst) env !evd t in
+	(evd := evm; t)
       end
       else
 	traverse_below nested envc t
@@ -1007,7 +1027,7 @@ let e_contextually byhead (occs,c) f = { e_redfun = begin fun env sigma t ->
   and traverse_below nested envc t =
     (* when byhead, find other occurrences without matching again partial
        application with same head *)
-    match kind_of_term t with
+    match EConstr.kind !evd t with
     | App (f,l) when byhead -> mkApp (f, Array.map_left (traverse nested envc) l)
     | Proj (p,c) when byhead -> mkProj (p,traverse nested envc c)
     | _ ->
@@ -1017,24 +1037,21 @@ let e_contextually byhead (occs,c) f = { e_redfun = begin fun env sigma t ->
   in
   let t' = traverse None (env,c) t in
   if List.exists (fun o -> o >= !pos) locs then error_invalid_occurrence locs;
-  Sigma.Unsafe.of_pair (t', !evd)
-  end }
+  (!evd, t')
+  end
 
 let contextually byhead occs f env sigma t =
-  let f' subst = { e_redfun = begin fun env sigma t ->
-    Sigma.here (f subst env (Sigma.to_evar_map sigma) t) sigma
-  end } in
-  let Sigma (c, _, _) = (e_contextually byhead occs f').e_redfun env (Sigma.Unsafe.of_evar_map sigma) t in
-  c
+  let f' subst env sigma t = sigma, f subst env sigma t in
+  snd (e_contextually byhead occs f' env sigma t)
 
 (* linear bindings (following pretty-printer) of the value of name in c.
  * n is the number of the next occurrence of name.
  * ol is the occurrence list to find. *)
 
 let match_constr_evaluable_ref sigma c evref = 
-  match kind_of_term 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 Univ.Instance.empty
+  match EConstr.kind sigma c, evref with
+  | 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 =
@@ -1053,7 +1070,7 @@ let substlin env sigma evalref n (nowhere_except_in,locs) c =
 	  incr pos;
 	  if ok then value u else c
       | None -> 
-        map_constr_with_binders_left_to_right
+        map_constr_with_binders_left_to_right sigma
 	  (fun _ () -> ())
           substrec () c
   in
@@ -1066,11 +1083,11 @@ let string_of_evaluable_ref env = function
       string_of_qualid
         (Nametab.shortest_qualid_of_global (vars_of_env env) (ConstRef kn))
 
-let unfold env sigma name =
+let unfold env sigma name c =
   if is_evaluable env name then
-    clos_norm_flags (unfold_red name) env sigma
+    clos_norm_flags (unfold_red name) env sigma c
   else
-    error (string_of_evaluable_ref env name^" is opaque.")
+    user_err Pp.(str (string_of_evaluable_ref env name^" is opaque."))
 
 (* [unfoldoccs : (readable_constraints -> (int list * full_path) -> constr -> constr)]
  * Unfolds the constant name in a term c following a list of occurrences occl.
@@ -1080,13 +1097,13 @@ let unfoldoccs env sigma (occs,name) c =
   let unfo nowhere_except_in locs =
     let (nbocc,uc) = substlin env sigma name 1 (nowhere_except_in,locs) c in
     if Int.equal nbocc 1 then
-      error ((string_of_evaluable_ref env name)^" does not occur.");
+      user_err Pp.(str ((string_of_evaluable_ref env name)^" does not occur."));
     let rest = List.filter (fun o -> o >= nbocc) locs in
     let () = match rest with
     | [] -> ()
     | _ -> error_invalid_occurrence rest
     in
-    nf_betaiotazeta sigma uc
+    nf_betaiotazeta env sigma uc
   in
   match occs with
     | NoOccurrences -> c
@@ -1102,21 +1119,21 @@ let unfoldn loccname env sigma c =
 let fold_one_com com env sigma c =
   let rcom =
     try red_product env sigma com
-    with Redelimination -> error "Not reducible." in
+    with Redelimination -> user_err Pp.(str "Not reducible.") in
   (* Reason first on the beta-iota-zeta normal form of the constant as
      unfold produces it, so that the "unfold f; fold f" configuration works
      to refold fix expressions *)
-  let a = subst_term (clos_norm_flags unfold_side_red env sigma rcom) c in
-  if not (eq_constr a c) then
-    subst1 com a
+  let a = subst_term sigma (clos_norm_flags unfold_side_red env sigma rcom) c in
+  if not (EConstr.eq_constr sigma a c) then
+    Vars.subst1 com a
   else
     (* Then reason on the non beta-iota-zeta form for compatibility -
        even if it is probably a useless configuration *)
-    let a = subst_term rcom c in
-    subst1 com a
+    let a = subst_term sigma rcom c in
+    Vars.subst1 com a
 
 let fold_commands cl env sigma c =
-  List.fold_right (fun com -> fold_one_com com env sigma) (List.rev cl) c
+  List.fold_right (fun com c -> fold_one_com com env sigma c) (List.rev cl) c
 
 
 (* call by value reduction functions *)
@@ -1134,38 +1151,37 @@ let compute = cbv_betadeltaiota
 (* gives [na:ta]c' such that c converts to ([na:ta]c' a), abstracting only
  * the specified occurrences. *)
 
-let abstract_scheme env (locc,a) (c, sigma) =
+let abstract_scheme env sigma (locc,a) (c, sigma) =
   let ta = Retyping.get_type_of env sigma a in
-  let na = named_hd env ta Anonymous in
-  if occur_meta ta then error "Cannot find a type for the generalisation.";
-  if occur_meta a then
+  let na = named_hd env sigma ta Anonymous in
+  if occur_meta sigma ta then user_err Pp.(str "Cannot find a type for the generalisation.");
+  if occur_meta sigma a then
     mkLambda (na,ta,c), sigma
   else
     let c', sigma' = subst_closed_term_occ env sigma (AtOccs locc) a c in
       mkLambda (na,ta,c'), sigma'
 
-let pattern_occs loccs_trm = { e_redfun = begin fun env sigma c ->
-  let sigma = Sigma.to_evar_map sigma in
-  let abstr_trm, sigma = List.fold_right (abstract_scheme env) loccs_trm (c,sigma) in
+let pattern_occs loccs_trm = begin fun env sigma c ->
+  let abstr_trm, sigma = List.fold_right (abstract_scheme env sigma) loccs_trm (c,sigma) in
   try
     let _ = Typing.unsafe_type_of env sigma abstr_trm in
-    Sigma.Unsafe.of_pair (applist(abstr_trm, List.map snd loccs_trm), sigma)
+    (sigma, applist(abstr_trm, List.map snd loccs_trm))
   with Type_errors.TypeError (env',t) ->
     raise (ReductionTacticError (InvalidAbstraction (env,sigma,abstr_trm,(env',t))))
-  end }
+  end
 
 (* Used in several tactics. *)
 
 let check_privacy env ind =
   let spec = Inductive.lookup_mind_specif env (fst ind) in
   if Inductive.is_private spec then
-    errorlabstrm "" (str "case analysis on a private type.")
+    user_err  (str "case analysis on a private type.")
   else ind
 
 let check_not_primitive_record env ind =
   let spec = Inductive.lookup_mind_specif env (fst ind) in
     if Inductive.is_primitive_record spec then
-      errorlabstrm "" (str "case analysis on a primitive record type: " ++
+      user_err  (str "case analysis on a primitive record type: " ++
 		       str "use projections or let instead.")
     else ind
 
@@ -1175,30 +1191,30 @@ let check_not_primitive_record env ind =
 let reduce_to_ind_gen allow_product env sigma t =
   let rec elimrec env t l =
     let t = hnf_constr env sigma t in
-    match kind_of_term (fst (decompose_app t)) with
+    match EConstr.kind sigma (fst (decompose_app_vect sigma t)) with
       | Ind ind-> (check_privacy env ind, it_mkProd_or_LetIn t l)
       | Prod (n,ty,t') ->
 	  let open Context.Rel.Declaration in
 	  if allow_product then
 	    elimrec (push_rel (LocalAssum (n,ty)) env) t' ((LocalAssum (n,ty))::l)
 	  else
-	    errorlabstrm "" (str"Not an inductive definition.")
+	    user_err  (str"Not an inductive definition.")
       | _ ->
 	  (* Last chance: we allow to bypass the Opaque flag (as it
 	     was partially the case between V5.10 and V8.1 *)
 	  let t' = whd_all env sigma t in
-	  match kind_of_term (fst (decompose_app t')) with
+	  match EConstr.kind sigma (fst (decompose_app_vect sigma t')) with
 	    | Ind ind-> (check_privacy env ind, it_mkProd_or_LetIn t' l)
-	    | _ -> errorlabstrm "" (str"Not an inductive product.")
+	    | _ -> user_err  (str"Not an inductive product.")
   in
   elimrec env t []
 
-let reduce_to_quantified_ind x = reduce_to_ind_gen true x
-let reduce_to_atomic_ind x = reduce_to_ind_gen false x
+let reduce_to_quantified_ind env sigma c = reduce_to_ind_gen true env sigma c
+let reduce_to_atomic_ind env sigma c = reduce_to_ind_gen false env sigma c
 
 let find_hnf_rectype env sigma t =
   let ind,t = reduce_to_atomic_ind env sigma t in
-  ind, snd (decompose_app t)
+  ind, snd (decompose_app sigma t)
 
 (* Reduce the weak-head redex [beta,iota/fix/cofix[all],cast,zeta,simpl/delta]
    or raise [NotStepReducible] if not a weak-head redex *)
@@ -1207,13 +1223,13 @@ exception NotStepReducible
 
 let one_step_reduce env sigma c =
   let rec redrec (x, stack) =
-    match kind_of_term x with
+    match EConstr.kind sigma x with
       | Lambda (n,t,c)  ->
           (match stack with
              | []        -> raise NotStepReducible
-             | a :: rest -> (subst1 a c, rest))
+             | a :: rest -> (Vars.subst1 a c, rest))
       | App (f,cl) -> redrec (f, (Array.to_list cl)@stack)
-      | LetIn (_,f,_,cl) -> (subst1 f cl,stack)
+      | LetIn (_,f,_,cl) -> (Vars.subst1 f cl,stack)
       | Cast (c,_,_) -> redrec (c,stack)
       | Case (ci,p,c,lf) ->
           (try
@@ -1225,8 +1241,8 @@ let one_step_reduce env sigma c =
              | Reduced s' -> s'
 	     | NotReducible -> raise NotStepReducible
            with Redelimination -> raise NotStepReducible)
-      | _ when isEvalRef env x ->
-	  let ref,u = destEvalRefU x in
+      | _ when isEvalRef env sigma x ->
+	  let ref,u = destEvalRefU sigma x in
           (try
              fst (red_elim_const env sigma ref u stack)
            with Redelimination ->
@@ -1239,7 +1255,7 @@ let one_step_reduce env sigma c =
   applist (redrec (c,[]))
 
 let error_cannot_recognize ref =
-  errorlabstrm ""
+  user_err 
     (str "Cannot recognize a statement based on " ++
      Nametab.pr_global_env Id.Set.empty ref ++ str".")
 
@@ -1253,8 +1269,8 @@ let reduce_to_ref_gen allow_product env sigma ref t =
   else
   (* lazily reduces to match the head of [t] with the expected [ref] *)
   let rec elimrec env t l =
-    let c, _ = decompose_appvect (Reductionops.whd_nored sigma t) in
-    match kind_of_term c with
+    let c, _ = decompose_app_vect sigma t in
+    match EConstr.kind sigma c with
       | Prod (n,ty,t') ->
           if allow_product then
 	    let open Context.Rel.Declaration in
@@ -1263,12 +1279,12 @@ let reduce_to_ref_gen allow_product env sigma ref t =
             error_cannot_recognize ref
       | _ ->
 	  try
-	    if eq_gr (global_of_constr c) ref
+	    if eq_gr (fst (global_of_constr sigma c)) ref
 	    then it_mkProd_or_LetIn t l
 	    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 f8dfe1ad..aa7604f5 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -1,20 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
 open Environ
 open Evd
+open EConstr
 open Reductionops
 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)
@@ -75,12 +78,12 @@ val cbv_norm_flags : CClosure.RedFlags.reds ->  reduction_function
 (** [reduce_to_atomic_ind env sigma t] puts [t] in the form [t'=(I args)]
    with [I] an inductive definition;
    returns [I] and [t'] or fails with a user error *)
-val reduce_to_atomic_ind : env ->  evar_map -> types -> pinductive * types
+val reduce_to_atomic_ind : env ->  evar_map -> types -> (inductive * EInstance.t) * types
 
 (** [reduce_to_quantified_ind env sigma t] puts [t] in the form
    [t'=(x1:A1)..(xn:An)(I args)] with [I] an inductive definition;
    returns [I] and [t'] or fails with a user error *)
-val reduce_to_quantified_ind : env ->  evar_map -> types -> pinductive * types
+val reduce_to_quantified_ind : env ->  evar_map -> types -> (inductive * EInstance.t) * types
 
 (** [reduce_to_quantified_ref env sigma ref t] try to put [t] in the form
    [t'=(x1:A1)..(xn:An)(ref args)] and fails with user error if not possible *)
@@ -91,7 +94,7 @@ val reduce_to_atomic_ref :
   env ->  evar_map -> global_reference -> types -> types
 
 val find_hnf_rectype : 
-  env ->  evar_map -> types -> pinductive * constr list
+  env ->  evar_map -> types -> (inductive * EInstance.t) * constr list
 
 val contextually : bool -> occurrences * constr_pattern ->
   (patvar_map -> reduction_function) -> reduction_function
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml
index b8da6b68..08051fd3 100644
--- a/pretyping/typeclasses.ml
+++ b/pretyping/typeclasses.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
@@ -11,12 +13,16 @@ open Names
 open Globnames
 open Decl_kinds
 open Term
+open Constr
 open Vars
 open Evd
 open Util
 open Typeclasses_errors
 open Libobject
 open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 (*i*)
 
 let typeclasses_unique_solutions = ref false
@@ -27,8 +33,7 @@ open Goptions
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "check that typeclasses proof search returns unique solutions";
       optkey   = ["Typeclasses";"Unique";"Solutions"];
       optread  = get_typeclasses_unique_solutions;
@@ -55,18 +60,21 @@ type direction = Forward | Backward
 
 (* This module defines type-classes *)
 type typeclass = {
+  (* Universe quantification *)
+  cl_univs : Univ.AUContext.t;
+
   (* The class implementation *)
   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;
 
@@ -79,9 +87,8 @@ type instance = {
   is_class: global_reference;
   is_info: Vernacexpr.hint_info_expr;
   (* Sections where the instance should be redeclared,
-     -1 for discard, 0 for none. *)
-  is_global: int;
-  is_poly: bool;
+     None for discard, Some 0 for none. *)
+  is_global: int option;
   is_impl: global_reference;
 }
 
@@ -91,15 +98,16 @@ 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 Lib.sections_depth ()
-    else -1
+    if glob then Some (Lib.sections_depth ())
+    else None
   in
+  if match global with Some n -> n>0 && isVarRef impl | _ -> false then
+    CErrors.user_err (Pp.str "Cannot set Global an instance referring to a section variable.");
     { is_class = cl.cl_impl;
       is_info = info ;
       is_global = global ;
-      is_poly = poly;
       is_impl = impl }
 
 (*
@@ -109,64 +117,48 @@ let new_instance cl info glob poly impl =
 let classes : typeclasses ref = Summary.ref Refmap.empty ~name:"classes"
 let instances : instances ref = Summary.ref Refmap.empty ~name:"instances"
 
-open Declarations
-
-let typeclass_univ_instance (cl,u') =
-  let subst = 
-    let u = 
-      match cl.cl_impl with
-      | ConstRef c -> 
-        let cb = Global.lookup_constant c in
-	  if cb.const_polymorphic then Univ.UContext.instance cb.const_universes
-	  else Univ.Instance.empty
-      | IndRef c ->
-         let mib,oib = Global.lookup_inductive c in
-	  if mib.mind_polymorphic then Univ.UContext.instance mib.mind_universes
-	  else Univ.Instance.empty
-      | _ -> Univ.Instance.empty
-    in Array.fold_left2 (fun subst u u' -> Univ.LMap.add u u' subst) 
-      Univ.LMap.empty (Univ.Instance.to_array u) (Univ.Instance.to_array u')
-  in
-  let subst_ctx = Context.Rel.map (subst_univs_level_constr subst) in
-    { cl with cl_context = fst cl.cl_context, subst_ctx (snd cl.cl_context);
-      cl_props = subst_ctx cl.cl_props}, u'
+let typeclass_univ_instance (cl, u) =
+  assert (Univ.AUContext.size cl.cl_univs == Univ.Instance.length u);
+  let subst_ctx c = Context.Rel.map (subst_instance_constr u) c in
+    { cl with cl_context = on_snd subst_ctx cl.cl_context;
+      cl_props = subst_ctx cl.cl_props}
 
 let class_info c =
   try Refmap.find c !classes
-  with Not_found -> not_a_class (Global.env()) (printable_constr_of_global c)
+  with Not_found -> not_a_class (Global.env()) (EConstr.of_constr (printable_constr_of_global c))
 
-let global_class_of_constr env c =
-  try let gr, u = Universes.global_of_constr c in
+let global_class_of_constr env sigma c =
+  try let gr, u = Termops.global_of_constr sigma c in
 	class_info gr, u
   with Not_found -> not_a_class env c
 
-let dest_class_app env c =
-  let cl, args = decompose_app c in
-    global_class_of_constr env cl, args
+let dest_class_app env sigma c =
+  let cl, args = EConstr.decompose_app sigma c in
+    global_class_of_constr env sigma cl, (List.map EConstr.Unsafe.to_constr args)
 
-let dest_class_arity env c =
-  let rels, c = decompose_prod_assum c in
-    rels, dest_class_app env c
+let dest_class_arity env sigma c =
+  let open EConstr in
+  let rels, c = decompose_prod_assum sigma c in
+    rels, dest_class_app env sigma c
 
-let class_of_constr c =
-  try Some (dest_class_arity (Global.env ()) c)
+let class_of_constr sigma c =
+  try Some (dest_class_arity (Global.env ()) sigma c)
   with e when CErrors.noncritical e -> None
 
-let is_class_constr c = 
-  try let gr, u = Universes.global_of_constr c in
+let is_class_constr sigma c = 
+  try let gr, u = Termops.global_of_constr sigma c in
 	Refmap.mem gr !classes
   with Not_found -> false
 
 let rec is_class_type evd c =
-  let c, args = decompose_app c in
-    match kind_of_term c with
+  let c, _ = Termops.decompose_app_vect evd c in
+    match EConstr.kind evd c with
     | Prod (_, _, t) -> is_class_type evd t
-    | Evar (e, _) when Evd.is_defined evd e ->
-      is_class_type evd (Evarutil.whd_head_evar evd c)
-    | _ -> is_class_constr c
+    | Cast (t, _, _) -> is_class_type evd t
+    | _ -> is_class_constr evd c
       
 let is_class_evar evd evi =
-  is_class_type evd evi.Evd.evar_concl
+  is_class_type evd (EConstr.of_constr evi.Evd.evar_concl)
 
 (*
  * classes persistent object
@@ -181,13 +173,14 @@ let subst_class (subst,cl) =
   let do_subst_con c = Mod_subst.subst_constant subst c
   and do_subst c = Mod_subst.subst_mps subst c
   and do_subst_gr gr = fst (subst_global subst gr) in
-  let do_subst_ctx = List.smartmap (map_constr do_subst) in
+  let do_subst_ctx = List.smartmap (RelDecl.map_constr do_subst) in
   let do_subst_context (grs,ctx) =
-    List.smartmap (Option.smartmap (fun (gr,b) -> do_subst_gr gr, b)) grs,
+    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
-  { cl_impl = do_subst_gr cl.cl_impl;
+  { cl_univs = cl.cl_univs;
+    cl_impl = do_subst_gr cl.cl_impl;
     cl_context = do_subst_context cl.cl_context;
     cl_props = do_subst_ctx cl.cl_props;
     cl_projs = do_subst_projs cl.cl_projs;
@@ -197,22 +190,18 @@ let subst_class (subst,cl) =
 let discharge_class (_,cl) =
   let repl = Lib.replacement_context () in
   let rel_of_variable_context ctx = List.fold_right
-    ( fun (n,_,b,t) (ctx', subst) ->
-        let decl = match b with
-                   | None -> LocalAssum (Name n, substn_vars 1 subst t)
-		   | Some b -> LocalDef (Name n, substn_vars 1 subst b, substn_vars 1 subst t)
-	in
-	(decl :: ctx', n :: subst)
+    ( fun (decl,_) (ctx', subst) ->
+        let decl' = decl |> NamedDecl.map_constr (substn_vars 1 subst) |> NamedDecl.to_rel_decl in
+	(decl' :: ctx', NamedDecl.get_id decl :: subst)
     ) ctx ([], []) in
-  let discharge_rel_context subst n rel =
+  let discharge_rel_context (subst, usubst) n rel =
     let rel = Context.Rel.map (Cooking.expmod_constr repl) rel in
-    let ctx, _ =
-      List.fold_right
-	(fun decl (ctx, k) ->
-	   map_constr (substn_vars k subst) decl :: ctx, succ k
-	)
-	rel ([], n)
-    in ctx
+    let fold decl (ctx, k) =
+      let map c = subst_univs_level_constr usubst (substn_vars k subst c) in
+      RelDecl.map_constr map decl :: ctx, succ k
+    in
+    let ctx, _ = List.fold_right fold rel ([], n) in
+    ctx
   in
   let abs_context cl =
     match cl.cl_impl with
@@ -222,22 +211,25 @@ let discharge_class (_,cl) =
   let discharge_context ctx' subst (grs, ctx) =
     let grs' =
       let newgrs = List.map (fun decl ->
-			     match decl |> get_type |> class_of_constr with
+			     match decl |> RelDecl.get_type |> 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, usubst, uctx = 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 context = discharge_context ctx subst cl.cl_context in
-    let props = discharge_rel_context subst (succ (List.length (fst cl.cl_context))) cl.cl_props 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
+    let props = discharge_rel_context (subst, usubst) (succ (List.length (fst cl.cl_context))) cl.cl_props in
     let discharge_proj (x, y, z) = x, y, Option.smartmap Lib.discharge_con z in
-      { cl_impl = cl_impl';
+      { cl_univs = cl_univs';
+        cl_impl = cl_impl';
 	cl_context = context;
 	cl_props = props;
 	cl_projs = List.smartmap discharge_proj cl.cl_projs;
@@ -284,15 +276,18 @@ let build_subclasses ~check env sigma glob { hint_priority = pri } =
         Nameops.add_suffix _id ("_subinstance_" ^ string_of_int !i))
   in
   let ty, ctx = Global.type_of_global_in_context env glob in
-  let sigma = Evd.merge_context_set Evd.univ_rigid sigma (Univ.ContextSet.of_context ctx) in
+  let inst, ctx = Universes.fresh_instance_from ctx None in
+  let ty = Vars.subst_instance_constr inst ty in
+  let ty = EConstr.of_constr ty in
+  let sigma = Evd.merge_context_set Evd.univ_rigid sigma ctx in
   let rec aux pri c ty path =
-    let ty = Evarutil.nf_evar sigma ty in
-      match class_of_constr ty with
+      match class_of_constr sigma ty with
       | None -> []
       | Some (rels, ((tc,u), args)) ->
 	let instapp = 
-	  Reductionops.whd_beta sigma (appvectc c (Context.Rel.to_extended_vect 0 rels))
+	  Reductionops.whd_beta sigma (EConstr.of_constr (appvectc c (Context.Rel.to_extended_vect mkRel 0 rels)))
 	in
+	let instapp = EConstr.Unsafe.to_constr instapp in
 	let projargs = Array.of_list (args @ [instapp]) in
 	let projs = List.map_filter 
 	  (fun (n, b, proj) ->
@@ -301,8 +296,10 @@ let build_subclasses ~check env sigma glob { hint_priority = pri } =
 	   | Some (Backward, _) -> None
 	   | Some (Forward, info) ->
 	     let proj = Option.get proj in
+	     let rels = List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) rels in
+	     let u = EConstr.EInstance.kind sigma u in
 	     let body = it_mkLambda_or_LetIn (mkApp (mkConstU (proj,u), projargs)) rels in
-	       if check && check_instance env sigma body then None
+	       if check && check_instance env sigma (EConstr.of_constr body) then None
 	       else 
 		 let newpri =
 		   match pri, info.hint_priority with
@@ -314,12 +311,12 @@ let build_subclasses ~check env sigma glob { hint_priority = pri } =
 	in
 	let declare_proj hints (cref, info, body) =
 	  let path' = cref :: path in
-	  let ty = Retyping.get_type_of env sigma body in
+	  let ty = Retyping.get_type_of env sigma (EConstr.of_constr body) in
 	  let rest = aux pri body ty path' in
 	    hints @ (path', info, body) :: rest
 	in List.fold_left declare_proj [] projs 
   in
-  let term = Universes.constr_of_global_univ (glob,Univ.UContext.instance ctx) in
+  let term = Universes.constr_of_global_univ (glob, inst) in
     (*FIXME subclasses should now get substituted for each particular instance of
       the polymorphic superclass *)
     aux pri term ty [glob]
@@ -357,22 +354,34 @@ let subst_instance (subst, (action, inst)) = action,
       is_impl = fst (subst_global subst inst.is_impl) }
 
 let discharge_instance (_, (action, inst)) =
-  if inst.is_global <= 0 then None
-  else Some (action,
+  match inst.is_global with
+  | None -> None
+  | Some n ->
+    assert (not (isVarRef inst.is_impl));
+    Some (action,
     { inst with 
-      is_global = pred inst.is_global;
+      is_global = Some (pred n);
       is_class = Lib.discharge_global inst.is_class;
       is_impl = Lib.discharge_global inst.is_impl })
     
 
-let is_local i = Int.equal i.is_global (-1)
+let is_local i = (i.is_global == None)
+
+let is_local_for_hint i =
+  match i.is_global with
+  | None -> true  (* i.e. either no Global keyword not in section, or in section *)
+  | Some n -> n <> 0 (* i.e. in a section, declare the hint as local
+     since discharge is managed by rebuild_instance which calls again
+     add_instance_hint; don't ask hints to take discharge into account
+     itself *)
 
 let add_instance check inst =
   let poly = Global.is_polymorphic inst.is_impl in
-  add_instance_hint (IsGlobal inst.is_impl) [inst.is_impl] (is_local inst) 
+  let local = is_local_for_hint inst in
+  add_instance_hint (IsGlobal inst.is_impl) [inst.is_impl] local
     inst.is_info poly;
   List.iter (fun (path, pri, c) -> add_instance_hint (IsConstr c) path
-    (is_local inst) pri poly)
+    local pri poly)
     (build_subclasses ~check:(check && not (isVarRef inst.is_impl))
        (Global.env ()) (Evd.from_env (Global.env ())) inst.is_impl inst.is_info)
 
@@ -407,11 +416,12 @@ let remove_instance i =
   remove_instance_hint i.is_impl
 
 let declare_instance info local glob =
-  let ty = Global.type_of_global_unsafe glob in
+  let ty, _ = Global.type_of_global_in_context (Global.env ()) glob in
   let info = Option.default {hint_priority = None; hint_pattern = None} info in
-    match class_of_constr ty with
+    match class_of_constr Evd.empty (EConstr.of_constr ty) with
     | Some (rels, ((tc,_), args) as _cl) ->
-      add_instance (new_instance tc info (not local) (Flags.use_polymorphic_flag ()) glob)
+      assert (not (isVarRef glob) || local);
+      add_instance (new_instance tc info (not local) glob)
     | None -> ()
 
 let add_class cl =
@@ -420,7 +430,7 @@ let add_class cl =
 	     match inst with
 	     | Some (Backward, info) ->
 	       (match body with
-	       | None -> CErrors.error "Non-definable projection can not be declared as a subinstance"
+	       | None -> CErrors.user_err Pp.(str "Non-definable projection can not be declared as a subinstance")
 	       | Some b -> declare_instance (Some info) false (ConstRef b))
 	     | _ -> ())
   cl.cl_projs
@@ -433,19 +443,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 []
@@ -512,7 +523,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
@@ -543,8 +554,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 620bc367..b80c2871 100644
--- a/pretyping/typeclasses.mli
+++ b/pretyping/typeclasses.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
 open Globnames
-open Term
+open Constr
 open Evd
 open Environ
 
@@ -16,14 +18,17 @@ type direction = Forward | Backward
 
 (** This module defines type-classes *)
 type typeclass = {
+  (** The toplevel universe quantification in which the typeclass lives. In
+      particular, [cl_props] and [cl_context] are quantified over it. *)
+  cl_univs : Univ.AUContext.t;
+
   (** The class implementation: a record parameterized by the context with defs in it or a definition if
      the class is a singleton. This acts as the class' global identifier. *)
   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;
@@ -32,7 +37,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; 
@@ -50,7 +55,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
@@ -61,13 +66,13 @@ val class_info : global_reference -> typeclass (** raises a UserError if not a c
 (** These raise a UserError if not a class.
     Caution: the typeclass structures is not instantiated w.r.t. the universe instance.
     This is done separately by typeclass_univ_instance. *)
-val dest_class_app : env -> constr -> typeclass puniverses * constr list
+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 puniverses
+val typeclass_univ_instance : typeclass Univ.puniverses -> typeclass
 
 (** Just return None if not a class *)
-val class_of_constr : constr -> (Context.Rel.t * (typeclass puniverses * constr list)) option
+val class_of_constr : evar_map -> EConstr.constr -> (EConstr.rel_context * ((typeclass * EConstr.EInstance.t) * constr list)) option
   
 val instance_impl : instance -> global_reference
 
@@ -79,18 +84,23 @@ 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
 val no_goals_or_obligations : evar_filter
 
 (** Resolvability.
-    Only undefined evars can be marked or checked for resolvability. *)
+    Only undefined evars can be marked or checked for resolvability.
+    They represent type-class search roots.
+
+    A resolvable evar is an evar the type-class engine may try to solve
+    An unresolvable evar is an evar the type-class engine will NOT try to solve
+*)
 
 val set_resolvable : Evd.Store.t -> bool -> Evd.Store.t
 val is_resolvable : evar_info -> bool
@@ -99,11 +109,11 @@ val mark_unresolvables : ?filter:evar_filter -> evar_map -> evar_map
 val mark_resolvables   : ?filter:evar_filter -> evar_map -> evar_map
 val mark_resolvable : evar_info -> evar_info
 val is_class_evar : evar_map -> evar_info -> bool
-val is_class_type : evar_map -> types -> bool
+val is_class_type : evar_map -> EConstr.types -> bool
 
 val resolve_typeclasses : ?fast_path:bool -> ?filter:evar_filter -> ?unique:bool ->
   ?split:bool -> ?fail:bool -> env -> evar_map -> evar_map
-val resolve_one_typeclass : ?unique:bool -> env -> evar_map -> types -> open_constr
+val resolve_one_typeclass : ?unique:bool -> env -> evar_map -> EConstr.types -> evar_map * EConstr.constr
 
 val set_typeclass_transparency_hook : (evaluable_global_reference -> bool (*local?*) -> bool -> unit) Hook.t
 val set_typeclass_transparency : evaluable_global_reference -> bool -> bool -> unit
@@ -120,7 +130,7 @@ val add_instance_hint : global_reference_or_constr -> global_reference list ->
 val remove_instance_hint : global_reference -> unit
 
 val solve_all_instances_hook : (env -> evar_map -> evar_filter -> bool -> bool -> bool -> evar_map) Hook.t
-val solve_one_instance_hook : (env -> evar_map -> types -> bool -> open_constr) Hook.t
+val solve_one_instance_hook : (env -> evar_map -> EConstr.types -> bool -> evar_map * EConstr.constr) Hook.t
 
 val declare_instance : Vernacexpr.hint_info_expr option -> bool -> global_reference -> unit
 
diff --git a/pretyping/typeclasses_errors.ml b/pretyping/typeclasses_errors.ml
index b1dfb19a..e10c81c2 100644
--- a/pretyping/typeclasses_errors.ml
+++ b/pretyping/typeclasses_errors.ml
@@ -1,14 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
-open Names
-open Term
+open EConstr
 open Environ
 open Constrexpr
 open Globnames
@@ -18,7 +19,7 @@ type contexts = Parameters | Properties
 
 type typeclass_error =
     | NotAClass of constr
-    | UnboundMethod of global_reference * Id.t Loc.located (* Class name, method *)
+    | UnboundMethod of global_reference * Misctypes.lident (* Class name, method *)
     | MismatchedContextInstance of contexts * constr_expr list * Context.Rel.t (* found, expected *)
 
 exception TypeClassError of env * typeclass_error
diff --git a/pretyping/typeclasses_errors.mli b/pretyping/typeclasses_errors.mli
index ee76f638..d9829565 100644
--- a/pretyping/typeclasses_errors.mli
+++ b/pretyping/typeclasses_errors.mli
@@ -1,14 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Loc
-open Names
-open Term
+open EConstr
 open Environ
 open Constrexpr
 open Globnames
@@ -17,14 +17,14 @@ type contexts = Parameters | Properties
 
 type typeclass_error =
   | NotAClass of constr
-  | UnboundMethod of global_reference * Id.t located (** Class name, method *)
+  | UnboundMethod of global_reference * Misctypes.lident (** Class name, method *)
   | MismatchedContextInstance of contexts * constr_expr list * Context.Rel.t (** found, expected *)
 
 exception TypeClassError of env * typeclass_error
 
 val not_a_class : env -> constr -> 'a
 
-val unbound_method : env -> global_reference -> Id.t located -> 'a
+val unbound_method : env -> global_reference -> Misctypes.lident -> 'a
 
 val mismatched_ctx_inst : env -> contexts -> constr_expr list -> Context.Rel.t -> 'a
 
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 9e9997f7..4c834f2f 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -1,52 +1,81 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+module CVars = Vars
+
 open Pp
 open CErrors
 open Util
 open Term
-open Vars
 open Environ
+open EConstr
+open Vars
 open Reductionops
-open Type_errors
 open Inductive
 open Inductiveops
 open Typeops
 open Arguments_renaming
+open Pretype_errors
 open Context.Rel.Declaration
 
 let meta_type evd mv =
   let ty =
     try Evd.meta_ftype evd mv
-    with Not_found -> anomaly (str "unknown meta ?" ++ str (Nameops.string_of_meta mv)) in
+    with Not_found -> anomaly (str "unknown meta ?" ++ str (Nameops.string_of_meta mv) ++ str ".") in
+  let ty = Evd.map_fl EConstr.of_constr ty in
   meta_instance evd ty
 
-let constant_type_knowing_parameters env cst jl =
-  let paramstyp = Array.map (fun j -> lazy j.uj_type) jl in
-  type_of_constant_knowing_parameters_in env cst paramstyp
-
-let inductive_type_knowing_parameters env (ind,u) jl =
+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 j.uj_type) jl in
+  let paramstyp = Array.map (fun j -> lazy (EConstr.to_constr sigma j.uj_type)) jl in
   Inductive.type_of_inductive_knowing_parameters env (mspec,u) paramstyp
 
 let e_type_judgment env evdref j =
-  match kind_of_term (whd_all env !evdref j.uj_type) with
-    | Sort s -> {utj_val = j.uj_val; utj_type = s }
+  match EConstr.kind !evdref (whd_all env !evdref j.uj_type) with
+    | Sort s -> {utj_val = j.uj_val; utj_type = ESorts.kind !evdref s }
     | Evar ev ->
         let (evd,s) = Evardefine.define_evar_as_sort env !evdref ev in
         evdref := evd; { utj_val = j.uj_val; utj_type = s }
-    | _ -> error_not_type env j
+    | _ -> error_not_a_type env !evdref j
 
 let e_assumption_of_judgment env evdref j =
   try (e_type_judgment env evdref j).utj_val
-  with TypeError _ ->
-    error_assumption env 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 ->
+       let (c1,c2) =
+         match EConstr.kind !evdref (whd_all env !evdref typ) with
+         | Prod (_,c1,c2) -> (c1,c2)
+         | Evar ev ->
+             let (evd',t) = Evardefine.define_evar_as_product !evdref ev in
+             evdref := evd';
+             let (_,c1,c2) = destProd evd' t in
+             (c1,c2)
+         | _ ->
+             error_cant_apply_not_functional env !evdref funj argjv
+       in
+       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
+  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
@@ -54,28 +83,30 @@ let e_judge_of_apply env evdref funj argjv =
       { uj_val  = mkApp (j_val funj, Array.map j_val argjv);
         uj_type = typ }
   | hj::restjl ->
-      match kind_of_term (whd_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 (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 t in
-	  apply_rec (n+1) (subst1 hj.uj_val c2) restjl
-      | _ ->
-	  error_cant_apply_not_functional env funj argjv
+       let (c1,c2) =
+         match EConstr.kind !evdref (whd_all env !evdref typ) with
+         | Prod (_,c1,c2) -> (c1,c2)
+         | Evar ev ->
+             let (evd',t) = Evardefine.define_evar_as_product !evdref ev in
+             evdref := evd';
+             let (_,c1,c2) = destProd evd' t in
+             (c1,c2)
+         | _ ->
+            error_cant_apply_not_functional env !evdref funj argjv
+       in
+       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
   in
   apply_rec 1 funj.uj_type (Array.to_list argjv)
 
 let e_check_branch_types env evdref (ind,u) cj (lfj,explft) =
   if not (Int.equal (Array.length lfj) (Array.length explft)) then
-    error_number_branches env cj (Array.length explft);
+    error_number_branches env !evdref cj (Array.length explft);
   for i = 0 to Array.length explft - 1 do
     if not (Evarconv.e_cumul env evdref lfj.(i).uj_type explft.(i)) then
-      error_ill_formed_branch env cj.uj_val ((ind,i+1),u) lfj.(i).uj_type explft.(i)
+      error_ill_formed_branch env !evdref cj.uj_val ((ind,i+1),u) lfj.(i).uj_type explft.(i)
   done
 
 let max_sort l =
@@ -83,21 +114,22 @@ let max_sort l =
   if Sorts.List.mem InSet l then InSet else InProp
 
 let e_is_correct_arity env evdref c pj ind specif params =
-  let arsign = make_arity_signature env true (make_ind_family (ind,params)) in
+  let arsign = make_arity_signature env !evdref true (make_ind_family (ind,params)) in
   let allowed_sorts = elim_sorts specif in
-  let error () = error_elim_arity env ind allowed_sorts c pj None in
+  let error () = Pretype_errors.error_elim_arity env !evdref ind allowed_sorts c pj None in
   let rec srec env pt ar =
     let pt' = whd_all env !evdref pt in
-    match kind_of_term pt', ar with
+    match EConstr.kind !evdref pt', ar with
     | Prod (na1,a1,t), (LocalAssum (_,a1'))::ar' ->
         if not (Evarconv.e_cumul env evdref a1 a1') then error ();
         srec (push_rel (LocalAssum (na1,a1)) env) t ar'
     | Sort s, [] ->
+        let s = ESorts.kind !evdref s in
         if not (Sorts.List.mem (Sorts.family s) allowed_sorts)
         then error ()
     | Evar (ev,_), [] ->
         let evd, s = Evd.fresh_sort_in_family env !evdref (max_sort allowed_sorts) in
-        evdref := Evd.define ev (mkSort s) evd
+        evdref := Evd.define ev (Constr.mkSort s) evd
     | _, (LocalDef _ as d)::ar' ->
         srec (push_rel d env) (lift 1 pt') ar'
     | _ ->
@@ -105,52 +137,66 @@ let e_is_correct_arity env evdref c pj ind specif params =
   in
   srec env pj.uj_type (List.rev arsign)
 
+let lambda_applist_assum sigma 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 match EConstr.kind sigma 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 lambda/let's.") in
+  app n [] c l
+
 let e_type_case_branches env evdref (ind,largs) pj c =
   let specif = lookup_mind_specif env (fst ind) in
   let nparams = inductive_params specif in
   let (params,realargs) = List.chop nparams largs in
   let p = pj.uj_val in
+  let params = List.map EConstr.Unsafe.to_constr params in
   let () = e_is_correct_arity env evdref c pj ind specif params in
-  let lc = build_branches_type ind specif params p in
+  let lc = build_branches_type ind specif params (EConstr.to_constr !evdref p) in
+  let lc = Array.map EConstr.of_constr lc in
   let n = (snd specif).Declarations.mind_nrealdecls in
-  let ty = whd_betaiota !evdref (lambda_applist_assum (n+1) p (realargs@[c])) in
+  let ty = whd_betaiota !evdref (lambda_applist_assum !evdref (n+1) p (realargs@[c])) in
   (lc, ty)
 
 let e_judge_of_case env evdref ci pj cj lfj =
-  let indspec =
+  let ((ind, u), spec) =
     try find_mrectype env !evdref cj.uj_type
-    with Not_found -> error_case_not_inductive env cj in
+    with Not_found -> error_case_not_inductive env !evdref cj in
+  let indspec = ((ind, EInstance.kind !evdref u), spec) in
   let _ = check_case_info env (fst indspec) ci in
   let (bty,rslty) = e_type_case_branches env evdref indspec pj cj.uj_val in
   e_check_branch_types env evdref (fst indspec) cj (lfj,bty);
   { uj_val  = mkCase (ci, pj.uj_val, cj.uj_val, Array.map j_val lfj);
     uj_type = rslty }
 
-let check_type_fixpoint loc env evdref lna lar vdefj =
+let check_type_fixpoint ?loc env evdref lna lar vdefj =
   let lt = Array.length vdefj in
     if Int.equal (Array.length lar) lt then
       for i = 0 to lt-1 do
         if not (Evarconv.e_cumul env evdref (vdefj.(i)).uj_type
 		  (lift lt lar.(i))) then
-          Pretype_errors.error_ill_typed_rec_body_loc loc env !evdref
+          error_ill_typed_rec_body ?loc env !evdref
             i lna vdefj lar
       done
 
 (* FIXME: might depend on the level of actual parameters!*)
 let check_allowed_sort env sigma ind c p =
   let pj = Retyping.get_judgment_of env sigma p in
-  let ksort = family_of_sort (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
     let s = inductive_sort_family (snd specif) in
-    error_elim_arity env ind sorts c pj
-      (Some(ksort,s,error_elim_explain ksort s))
+    error_elim_arity env sigma ind sorts c pj
+      (Some(ksort,s,Type_errors.error_elim_explain ksort s))
 
 let e_judge_of_cast env evdref cj k tj =
   let expected_type = tj.utj_val in
   if not (Evarconv.e_cumul env evdref cj.uj_type expected_type) then
-    error_actual_type env cj expected_type;
+    error_actual_type_core env !evdref cj expected_type;
   { uj_val = mkCast (cj.uj_val, k, expected_type);
     uj_type = expected_type }
 
@@ -159,19 +205,78 @@ let enrich_env env evdref =
   let penv' = Pre_env.({ penv with env_stratification =
     { penv.env_stratification with env_universes = Evd.universes !evdref } }) in
   Environ.env_of_pre_env penv'
-			  
+
+let check_fix env sigma pfix =
+  let inj c = EConstr.to_constr sigma c in
+  let (idx, (ids, cs, ts)) = pfix in
+  check_fix env (idx, (ids, Array.map inj cs, Array.map inj ts))
+
+let check_cofix env sigma pcofix =
+  let inj c = EConstr.to_constr sigma c in
+  let (idx, (ids, cs, ts)) = pcofix in
+  check_cofix env (idx, (ids, Array.map inj cs, Array.map inj ts))
+
 (* The typing machine with universes and existential variables. *)
 
+let judge_of_prop =
+  { uj_val = EConstr.mkProp;
+    uj_type = EConstr.mkSort Sorts.type1 }
+
+let judge_of_set =
+  { uj_val = EConstr.mkSet;
+    uj_type = EConstr.mkSort Sorts.type1 }
+
+let judge_of_prop_contents = function
+  | Null -> judge_of_prop
+  | Pos -> judge_of_set
+
+let judge_of_type u =
+  let uu = Univ.Universe.super u in
+    { uj_val = EConstr.mkType u;
+      uj_type = EConstr.mkType uu }
+
+let judge_of_relative env v =
+  Termops.on_judgment EConstr.of_constr (judge_of_relative env v)
+
+let judge_of_variable env id =
+  Termops.on_judgment EConstr.of_constr (judge_of_variable env id)
+
+let judge_of_projection env sigma p cj =
+  let pb = lookup_projection p env in
+  let (ind,u), args =
+    try find_mrectype env sigma cj.uj_type
+    with Not_found -> error_case_not_inductive env sigma cj
+  in
+  let u = EInstance.kind sigma u in
+    let ty = EConstr.of_constr (CVars.subst_instance_constr u pb.Declarations.proj_type) in
+    let ty = substl (cj.uj_val :: List.rev args) ty in
+      {uj_val = EConstr.mkProj (p,cj.uj_val);
+       uj_type = ty}
+
+let judge_of_abstraction env name var j =
+  { uj_val = mkLambda (name, var.utj_val, j.uj_val);
+    uj_type = mkProd (name, var.utj_val, j.uj_type) }
+
+let judge_of_product env name t1 t2 =
+  let s = sort_of_product env t1.utj_type t2.utj_type in
+  { uj_val = mkProd (name, t1.utj_val, t2.utj_val);
+    uj_type = mkSort s }
+
+let judge_of_letin env name defj typj j =
+  { uj_val = mkLetIn (name, defj.uj_val, typj.utj_val, j.uj_val) ;
+    uj_type = subst1 defj.uj_val j.uj_type }
+
 (* cstr must be in n.f. w.r.t. evars and execute returns a judgement
    where both the term and type are in n.f. *)
 let rec execute env evdref cstr =
-  match kind_of_term cstr with
+  let cstr = whd_evar !evdref cstr in
+  match EConstr.kind !evdref cstr with
     | Meta n ->
         { uj_val = cstr; uj_type = meta_type !evdref n }
 
     | Evar ev ->
-	let ty = Evd.existential_type !evdref ev in
-	let jty = execute env evdref (whd_evar !evdref ty) in
+	let ty = EConstr.existential_type !evdref ev in
+	let jty = execute env evdref ty in
 	let jty = e_assumption_of_judgment env evdref jty in
 	{ uj_val = cstr; uj_type = jty }
 
@@ -181,14 +286,17 @@ let rec execute env evdref cstr =
     | Var id ->
         judge_of_variable env id
 
-    | Const c ->
-        make_judge cstr (rename_type_of_constant env c)
+    | Const (c, u) ->
+        let u = EInstance.kind !evdref u in
+        make_judge cstr (EConstr.of_constr (rename_type_of_constant env (c, u)))
 
-    | Ind ind ->
-	make_judge cstr (rename_type_of_inductive env ind)
+    | Ind (ind, u) ->
+        let u = EInstance.kind !evdref u in
+	make_judge cstr (EConstr.of_constr (rename_type_of_inductive env (ind, u)))
 
-    | Construct cstruct ->
-	make_judge cstr (rename_type_of_constructor env cstruct)
+    | Construct (cstruct, u) ->
+        let u = EInstance.kind !evdref u in
+	make_judge cstr (EConstr.of_constr (rename_type_of_constructor env (cstruct, u)))
 
     | Case (ci,p,c,lf) ->
         let cj = execute env evdref c in
@@ -199,43 +307,37 @@ let rec execute env evdref cstr =
     | Fix ((vn,i as vni),recdef) ->
         let (_,tys,_ as recdef') = execute_recdef env evdref recdef in
 	let fix = (vni,recdef') in
-        check_fix env fix;
+        check_fix env !evdref fix;
 	make_judge (mkFix fix) tys.(i)
 
     | CoFix (i,recdef) ->
         let (_,tys,_ as recdef') = execute_recdef env evdref recdef in
         let cofix = (i,recdef') in
-        check_cofix env cofix;
+        check_cofix env !evdref cofix;
 	make_judge (mkCoFix cofix) tys.(i)
 
-    | Sort (Prop c) ->
-	judge_of_prop_contents c
-
-    | Sort (Type u) ->
+    | Sort s ->
+      begin match ESorts.kind !evdref s with
+      | Prop c ->
+        judge_of_prop_contents c
+      | Type u ->
         judge_of_type u
+      end
 
     | Proj (p, c) -> 
         let cj = execute env evdref c in
-	  judge_of_projection env p (Evarutil.j_nf_evar !evdref cj)
+	  judge_of_projection env !evdref p cj
 
     | App (f,args) ->
         let jl = execute_array env evdref args in
-	let j =
-	  match kind_of_term f with
-	    | Ind ind when Environ.template_polymorphic_pind ind env ->
-		(* Sort-polymorphism of inductive types *)
-		make_judge f
-		  (inductive_type_knowing_parameters env ind
-		    (Evarutil.jv_nf_evar !evdref jl))
-	    | Const cst when Environ.template_polymorphic_pconstant cst env ->
-		(* Sort-polymorphism of inductive types *)
-		make_judge f
-		  (constant_type_knowing_parameters env cst
-		    (Evarutil.jv_nf_evar !evdref jl))
-	    | _ ->
-		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
@@ -273,7 +375,7 @@ and execute_recdef env evdref (names,lar,vdef) =
   let env1 = push_rec_types (names,lara,vdef) env in
   let vdefj = execute_array env1 evdref vdef in
   let vdefv = Array.map j_val vdefj in
-  let _ = check_type_fixpoint Loc.ghost env1 evdref names lara vdefj in
+  let _ = check_type_fixpoint env1 evdref names lara vdefj in
   (names,lara,vdefv)
 
 and execute_array env evdref = Array.map (execute env evdref)
@@ -282,7 +384,7 @@ let e_check env evdref c t =
   let env = enrich_env env evdref in
   let j = execute env evdref c in
   if not (Evarconv.e_cumul env evdref j.uj_type t) then
-    error_actual_type env j (nf_evar !evdref t)
+    error_actual_type_core env !evdref j t
 
 (* Type of a constr *)
 
@@ -327,4 +429,4 @@ let e_solve_evars env evdref c =
   (* side-effect on evdref *)
   nf_evar !evdref c
 
-let _ = Evarconv.set_solve_evars e_solve_evars
+let _ = Evarconv.set_solve_evars (fun env evdref c -> e_solve_evars env evdref c)
diff --git a/pretyping/typing.mli b/pretyping/typing.mli
index 04e5e40b..0ff724a1 100644
--- a/pretyping/typing.mli
+++ b/pretyping/typing.mli
@@ -1,13 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Names
+open Constr
 open Environ
+open EConstr
 open Evd
 
 (** This module provides the typing machine with existential variables
@@ -24,7 +28,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
@@ -42,5 +46,12 @@ val check_allowed_sort : env -> evar_map -> pinductive -> constr -> constr ->
 
 (** Raise an error message if bodies have types not unifiable with the
     expected ones *)
-val check_type_fixpoint : Loc.t -> env -> evar_map ref ->
+val check_type_fixpoint : ?loc:Loc.t -> env -> evar_map ref ->
   Names.Name.t array -> types array -> unsafe_judgment array -> unit
+
+val judge_of_prop : unsafe_judgment
+val judge_of_set : unsafe_judgment
+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
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 25931869..6f594186 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -1,20 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Pp
 open Util
 open Names
-open Term
-open Vars
+open Constr
 open Termops
-open Namegen
 open Environ
+open EConstr
+open Vars
+open Namegen
 open Evd
 open Reduction
 open Reductionops
@@ -28,12 +31,20 @@ open Recordops
 open Locus
 open Locusops
 open Find_subterm
-open Sigma.Notations
-open Context.Named.Declaration
+
+type metabinding = (metavariable * EConstr.constr * (instance_constraint * instance_typing_status))
+
+type subst0 =
+  (evar_map *
+    metabinding list *
+      (Environ.env * EConstr.existential * EConstr.t) list)
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let keyed_unification = ref (false)
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optdepr = false;
   Goptions.optname = "Unification is keyed";
   Goptions.optkey = ["Keyed";"Unification"];
   Goptions.optread = (fun () -> !keyed_unification);
@@ -44,7 +55,7 @@ let is_keyed_unification () = !keyed_unification
 
 let debug_unification = ref (false)
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optdepr = false;
   Goptions.optname =
     "Print states sent to tactic unification";
   Goptions.optkey = ["Debug";"Tactic";"Unification"];
@@ -52,8 +63,23 @@ let _ = Goptions.declare_bool_option {
   Goptions.optwrite = (fun a -> debug_unification:=a);
 }
 
+(** Making this unification algorithm correct w.r.t. the evar-map abstraction
+    breaks too much stuff. So we redefine incorrect functions here. *)
+
+let unsafe_occur_meta_or_existential c =
+  let c = EConstr.Unsafe.to_constr c in
+  let rec occrec c = match Constr.kind c with
+    | Evar _ -> raise Occur
+    | Meta _ -> raise Occur
+    | _ -> Constr.iter occrec c
+  in try occrec c; false with Occur -> true
+
+
 let occur_meta_or_undefined_evar evd c =
-  let rec occrec c = match kind_of_term c with
+  (** 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 Constr.kind c with
     | Meta _ -> raise Occur
     | Evar (ev,args) ->
         (match evar_body (Evd.find evd ev) with
@@ -66,27 +92,29 @@ let occur_meta_or_undefined_evar evd c =
 let occur_meta_evd sigma mv c =
   let rec occrec c =
     (* Note: evars are not instantiated by terms with metas *)
-    let c = whd_evar sigma (whd_meta sigma c) in
-    match kind_of_term c with
+    let c = whd_meta sigma c in
+    match EConstr.kind sigma c with
     | Meta mv' when Int.equal mv mv' -> raise Occur
-    | _ -> Constr.iter occrec c
+    | _ -> EConstr.iter sigma occrec c
   in try occrec c; false with Occur -> true
 
 (* if lname_typ is [xn,An;..;x1,A1] and l is a list of terms,
    gives [x1:A1]..[xn:An]c' such that c converts to ([x1:A1]..[xn:An]c' l) *)
 
 let abstract_scheme env evd c l lname_typ =
+  let mkLambda_name env (n,a,b) =
+    mkLambda (named_hd env evd a n, a, b)
+  in
   List.fold_left2
     (fun (t,evd) (locc,a) decl ->
-       let open Context.Rel.Declaration in
-       let na = get_name decl in
-       let ta = get_type decl in
-       let na = match kind_of_term a with Var id -> Name id | _ -> na in
+       let na = RelDecl.get_name decl in
+       let ta = RelDecl.get_type decl in
+       let na = match EConstr.kind evd a with Var id -> Name id | _ -> na in
 (* [occur_meta ta] test removed for support of eelim/ecase but consequences
    are unclear...
        if occur_meta ta then error "cannot find a type for the generalisation"
        else *) 
-       if occur_meta a then mkLambda_name env (na,ta,t), evd
+       if occur_meta evd a then mkLambda_name env (na,ta,t), evd
        else
 	 let t', evd' = Find_subterm.subst_closed_term_occ env evd locc a t in
 	   mkLambda_name env (na,ta,t'), evd')
@@ -106,6 +134,9 @@ let abstract_list_all env evd typ c l =
     | UserError _ ->
         error_cannot_find_well_typed_abstraction env evd p l None
     | Type_errors.TypeError (env',x) ->
+        (** FIXME: plug back the typing information *)
+        error_cannot_find_well_typed_abstraction env evd p l None
+    | Pretype_errors.PretypeError (env',evd,TypingError x) ->
         error_cannot_find_well_typed_abstraction env evd p l (Some (env',x)) in
   evd,(p,typp)
 
@@ -113,20 +144,18 @@ let set_occurrences_of_last_arg args =
   Some AllOccurrences :: List.tl (Array.map_to_list (fun _ -> None) args)
 
 let abstract_list_all_with_dependencies env evd typ c l =
-  let evd = Sigma.Unsafe.of_evar_map evd in
-  let Sigma (ev, evd, _) = new_evar env evd typ in
-  let evd = Sigma.to_evar_map evd in
-  let evd,ev' = evar_absorb_arguments env evd (destEvar ev) l in
+  let (evd, ev) = new_evar env evd typ in
+  let evd,ev' = evar_absorb_arguments env evd (destEvar evd ev) l in
   let n = List.length l in
   let argoccs = set_occurrences_of_last_arg (Array.sub (snd ev') 0 n) in
   let evd,b =
     Evarconv.second_order_matching empty_transparent_state
       env evd ev' argoccs c in
   if b then
-    let p = nf_evar evd (existential_value evd (destEvar ev)) in
+    let p = nf_evar evd ev in
       evd, p
   else error_cannot_find_well_typed_abstraction env evd 
-    (nf_evar evd c) l None
+    c l None
 
 (**)
 
@@ -146,50 +175,57 @@ let extract_instance_status = function
   | CUMUL -> add_type_status (IsSubType, IsSuperType)
   | CONV -> add_type_status (Conv, Conv)
 
-let rec subst_meta_instances bl c =
-  match kind_of_term c with
+let rec subst_meta_instances sigma bl c =
+  match EConstr.kind sigma c with
     | Meta i ->
       let select (j,_,_) = Int.equal i j in
       (try pi2 (List.find select bl) with Not_found -> c)
-    | _ -> Constr.map (subst_meta_instances bl) c
+    | _ -> EConstr.map sigma (subst_meta_instances sigma bl) c
 
 (** [env] should be the context in which the metas live *)
 
 let pose_all_metas_as_evars env evd t =
   let evdref = ref evd in
-  let rec aux t = match kind_of_term t with
+  let rec aux t = match EConstr.kind !evdref t with
   | Meta mv ->
       (match Evd.meta_opt_fvalue !evdref mv with
-       | Some ({rebus=c},_) -> c
+       | Some ({rebus=c},_) -> EConstr.of_constr c
        | None ->
         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
+          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 (ev,(Conv,TypeNotProcessed)) !evdref;
+        evdref := meta_assign mv (EConstr.Unsafe.to_constr ev,(Conv,TypeNotProcessed)) !evdref;
         ev)
   | _ ->
-      Constr.map aux t in
+      EConstr.map !evdref aux t in
   let c = aux t in
   (* side-effect *)
   (!evdref, c)
 
-let solve_pattern_eqn_array (env,nb) f l c (sigma,metasubst,evarsubst) =
-  match kind_of_term f with
+let solve_pattern_eqn_array (env,nb) f l c (sigma,metasubst,evarsubst : subst0) =
+  match EConstr.kind sigma f with
     | Meta k ->
 	(* We enforce that the Meta does not depend on the [nb]
 	   extra assumptions added by unification to the context *)
         let env' = pop_rel_context nb env in
 	let sigma,c = pose_all_metas_as_evars env' sigma c in
-	let c = solve_pattern_eqn env l c in
+	let c = solve_pattern_eqn env sigma l c in
 	let pb = (Conv,TypeNotProcessed) in
-	  if noccur_between 1 nb c then
+	  if noccur_between sigma 1 nb c then
             sigma,(k,lift (-nb) c,pb)::metasubst,evarsubst
-	  else error_cannot_unify_local env sigma (applist (f, l),c,c)
+	  else
+            let l = List.map of_alias l in
+            error_cannot_unify_local env sigma (applist (f, l),c,c)
     | Evar ev ->
         let env' = pop_rel_context nb env in
 	let sigma,c = pose_all_metas_as_evars env' sigma c in
-	sigma,metasubst,(env,ev,solve_pattern_eqn env l c)::evarsubst
+	sigma,metasubst,(env,ev,solve_pattern_eqn env sigma l c)::evarsubst
     | _ -> assert false
 
 let push d (env,n) = (push_rel_assum d env,n+1)
@@ -214,33 +250,6 @@ let unify_r2l x = x
 let sort_eqns = unify_r2l
 *)
 
-let global_pattern_unification_flag = ref true
-
-(* Compatibility option introduced and activated in Coq 8.3 whose
-   syntax is now deprecated. *)
-
-open Goptions
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
-      optname  = "pattern-unification for existential variables in tactics";
-      optkey   = ["Tactic";"Evars";"Pattern";"Unification"];
-      optread  = (fun () -> !global_pattern_unification_flag);
-      optwrite = (:=) global_pattern_unification_flag }
-
-(* Compatibility option superseding the previous one, introduced and
-   activated in Coq 8.4 *)
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "pattern-unification for existential variables in tactics";
-      optkey   = ["Tactic";"Pattern";"Unification"];
-      optread  = (fun () -> !global_pattern_unification_flag);
-      optwrite = (:=) global_pattern_unification_flag }
-
 type core_unify_flags = {
   modulo_conv_on_closed_terms : Names.transparent_state option;
     (* What this flag controls was activated with all constants transparent, *)
@@ -264,12 +273,10 @@ type core_unify_flags = {
 
   use_pattern_unification : bool;
     (* This solves pattern "?n x1 ... xn = t" when the xi are distinct rels *)
-    (* This says if pattern unification is tried; can be overwritten with *)
-    (* option "Set Tactic Pattern Unification" *)
+    (* This says if pattern unification is tried *)
 
   use_meta_bound_pattern_unification : bool;
-    (* This is implied by use_pattern_unification (though deactivated *)
-    (* by unsetting Tactic Pattern Unification); has no particular *)
+    (* This is implied by use_pattern_unification; has no particular *)
     (* reasons to be set differently than use_pattern_unification *)
     (* except for compatibility of "auto". *)
     (* This was on for all tactics, including auto, since Sep 2006 for 8.1 *)
@@ -450,18 +457,16 @@ let set_flags_for_type flags = { flags with
 }
 
 let use_evars_pattern_unification flags =
-  !global_pattern_unification_flag && flags.use_pattern_unification
-  && Flags.version_strictly_greater Flags.V8_2
+  flags.use_pattern_unification
 
-let use_metas_pattern_unification flags nb l =
-  !global_pattern_unification_flag && flags.use_pattern_unification
-  || (Flags.version_less_or_equal Flags.V8_3 || 
-      flags.use_meta_bound_pattern_unification) &&
-     Array.for_all (fun c -> isRel c && destRel c <= nb) l
+let use_metas_pattern_unification sigma flags nb l =
+  flags.use_pattern_unification
+  || flags.use_meta_bound_pattern_unification &&
+     Array.for_all (fun c -> isRel sigma c && destRel sigma c <= nb) l
 
 type key = 
   | IsKey of CClosure.table_key
-  | IsProj of projection * constr
+  | IsProj of Projection.t * EConstr.constr
 
 let expand_table_key env = function
   | ConstKey cst -> constant_opt_value_in env cst
@@ -477,13 +482,17 @@ let unfold_projection env p stk =
   | None -> assert false)
 
 let expand_key ts env sigma = function
-  | Some (IsKey k) -> expand_table_key env k
+  | Some (IsKey k) -> Option.map EConstr.of_constr (expand_table_key env k)
   | Some (IsProj (p, c)) -> 
-    let red = Stack.zip (fst (whd_betaiota_deltazeta_for_iota_state ts env sigma
+    let red = Stack.zip sigma (fst (whd_betaiota_deltazeta_for_iota_state ts env sigma
                                Cst_stack.empty (c, unfold_projection env p [])))
-    in if Term.eq_constr (mkProj (p, c)) red then None else Some red
+    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;
@@ -494,12 +503,13 @@ type unirec_flags = {
 let subterm_restriction opt flags =
   not opt.at_top && flags.restrict_conv_on_strict_subterms
 
-let key_of env b flags f =
+let key_of env sigma b flags f =
   if subterm_restriction b flags then None else
-  match kind_of_term f with
+  match EConstr.kind sigma f with
   | Const (cst, u) when is_transparent env (ConstKey cst) &&
       (Cpred.mem cst (snd flags.modulo_delta)
        || Environ.is_projection cst env) ->
+      let u = EInstance.kind sigma u in
       Some (IsKey (ConstKey (cst, u)))
   | Var id when is_transparent env (VarKey id) && 
       Id.Pred.mem id (fst flags.modulo_delta) ->
@@ -532,74 +542,85 @@ 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)
 		  (Environ.oracle env) false (translate_key k1) (translate_key k2))
 
-let is_rigid_head flags t =
-  match kind_of_term t with
+let is_rigid_head sigma flags t =
+  match EConstr.kind sigma t with
   | Const (cst,u) -> not (Cpred.mem cst (snd flags.modulo_delta))
   | Ind (i,u) -> true
   | Construct _ -> true
   | Fix _ | CoFix _ -> true
-  | _ -> false
-
-let force_eqs c = 
-  Universes.Constraints.fold
-    (fun ((l,d,r) as c) acc -> 
-      let c' = if d == Universes.ULub then (l,Universes.UEq,r) else c in
-	Universes.Constraints.add c' acc) 
-    c Universes.Constraints.empty
-
-let constr_cmp pb sigma flags t u =
-  let b, cstrs = 
-    if pb == Reduction.CONV then Universes.eq_constr_universes t u
-    else Universes.leq_constr_universes t u
+  | Rel _ | Var _ | Meta _ | Evar _ | Sort _ | Cast (_, _, _) | Prod (_, _, _)
+    | Lambda (_, _, _) | LetIn (_, _, _, _) | App (_, _) | Case (_, _, _, _)
+    | Proj (_, _) -> false (* Why aren't Prod, Sort rigid heads ? *)
+
+let force_eqs c =
+  let open Universes in
+  Constraints.fold
+    (fun c acc ->
+       let c' = match c with
+         (* Should we be forcing weak constraints? *)
+         | ULub (l, r) | UWeak (l, r) -> UEq (Univ.Universe.make l,Univ.Universe.make r)
+         | ULe _ | UEq _ -> c
+       in
+        Constraints.add c' acc)
+    c Constraints.empty
+
+let constr_cmp pb env sigma flags t u =
+  let cstrs =
+    if pb == Reduction.CONV then EConstr.eq_constr_universes env sigma t u
+    else EConstr.leq_constr_universes env sigma t u
   in 
-    if b then 
-      try Evd.add_universe_constraints sigma cstrs, b
+  match cstrs with
+  | Some cstrs ->
+      begin try Evd.add_universe_constraints sigma cstrs, true
       with Univ.UniverseInconsistency _ -> sigma, false
       | Evd.UniversesDiffer -> 
-	if is_rigid_head flags t then 
-	  try Evd.add_universe_constraints sigma (force_eqs cstrs), b
+	if is_rigid_head sigma flags t then 
+          try Evd.add_universe_constraints sigma (force_eqs cstrs), true
 	  with Univ.UniverseInconsistency _ -> sigma, false
 	else sigma, false
-    else sigma, b
+      end
+  | None ->
+    sigma, false
     
 let do_reduce ts (env, nb) sigma c =
-  Stack.zip (fst (whd_betaiota_deltazeta_for_iota_state
+  Stack.zip sigma (fst (whd_betaiota_deltazeta_for_iota_state
 		  ts env sigma Cst_stack.empty (c, Stack.empty)))
 
-let use_full_betaiota flags =
-  flags.modulo_betaiota && Flags.version_strictly_greater Flags.V8_3
-
-let isAllowedEvar flags c = match kind_of_term c with
+let isAllowedEvar sigma flags c = match EConstr.kind sigma c with
   | Evar (evk,_) -> not (Evar.Set.mem evk flags.frozen_evars)
   | _ -> false
 
 
-let subst_defined_metas_evars (bl,el) c =
-  let rec substrec c = match kind_of_term c with
+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 Constr.kind c with
     | Meta i ->
       let select (j,_,_) = Int.equal i j in
-      substrec (pi2 (List.find select bl))
+      substrec (EConstr.Unsafe.to_constr (pi2 (List.find select bl)))
     | Evar (evk,args) ->
-      let select (_,(evk',args'),_) = Evar.equal evk evk' && Array.equal Constr.equal args args' in
-      (try substrec (pi3 (List.find select el))
+      let eq c1 c2 = Constr.equal c1 (EConstr.Unsafe.to_constr c2) in
+      let select (_,(evk',args'),_) = Evar.equal evk evk' && Array.for_all2 eq args args' in
+      (try substrec (EConstr.Unsafe.to_constr (pi3 (List.find select el)))
        with Not_found -> Constr.map substrec c)
     | _ -> Constr.map substrec c
-  in try Some (substrec c) with Not_found -> None
+  in try Some (EConstr.of_constr (substrec c)) with Not_found -> None
 
-let check_compatibility env pbty flags (sigma,metasubst,evarsubst) tyM tyN =
-  match subst_defined_metas_evars (metasubst,[]) tyM with
+let check_compatibility env pbty flags (sigma,metasubst,evarsubst : subst0) tyM tyN =
+  match subst_defined_metas_evars sigma (metasubst,[]) tyM with
   | None -> sigma
   | Some m ->
-  match subst_defined_metas_evars (metasubst,[]) tyN with
+  match subst_defined_metas_evars sigma (metasubst,[]) tyN with
   | None -> sigma
   | Some n ->
     if is_ground_term sigma m && is_ground_term sigma n then
@@ -609,9 +630,9 @@ let check_compatibility env pbty flags (sigma,metasubst,evarsubst) tyM tyN =
     else sigma
 
 
-let rec is_neutral env ts t =
-  let (f, l) = decompose_appvect t in
-    match kind_of_term f with
+let rec is_neutral env sigma ts t =
+  let (f, l) = decompose_app_vect sigma t in
+    match EConstr.kind sigma f with
     | Const (c, u) ->
       not (Environ.evaluable_constant c env) ||
       not (is_transparent env (ConstKey c)) ||
@@ -622,24 +643,27 @@ let rec is_neutral env ts t =
       not (Id.Pred.mem id (fst ts))
     | Rel n -> true
     | Evar _ | Meta _ -> true
-    | Case (_, p, c, cl) -> is_neutral env ts c
-    | Proj (p, c) -> is_neutral env ts c
-    | _ -> false
-
-let is_eta_constructor_app env ts f l1 term =
-  match kind_of_term f with
+    | Case (_, p, c, cl) -> is_neutral env sigma ts c
+    | Proj (p, c) -> is_neutral env sigma ts c
+    | 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 ts term
+	is_neutral env sigma ts term
       | _ -> false)
   | _ -> false
 
-let eta_constructor_app env f l1 term =
-  match kind_of_term f with
+let eta_constructor_app env sigma f l1 term =
+  match EConstr.kind sigma f with
   | Construct (((_, i as ind), j), u) ->
     let mib = lookup_mind (fst ind) env in
       (match mib.Declarations.mind_record with
@@ -652,15 +676,15 @@ let eta_constructor_app env f l1 term =
       | _ -> assert false)
   | _ -> assert false
 
-let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flags m n =
-  let rec unirec_rec (curenv,nb as curenvnb) pb opt ((sigma,metasubst,evarsubst) as substn) curm curn =
+let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top env cv_pb flags m n =
+  let rec unirec_rec (curenv,nb as curenvnb) pb opt ((sigma,metasubst,evarsubst) as substn : subst0) curm curn =
     let cM = Evarutil.whd_head_evar sigma curm
     and cN = Evarutil.whd_head_evar sigma curn in
     let () = 
       if !debug_unification then
-	Feedback.msg_debug (Termops.print_constr_env curenv cM ++ str" ~= " ++ Termops.print_constr_env curenv cN)
+	Feedback.msg_debug (print_constr_env curenv sigma cM ++ str" ~= " ++ print_constr_env curenv sigma cN)
     in 
-      match (kind_of_term cM,kind_of_term cN) with
+      match (EConstr.kind sigma cM, EConstr.kind sigma cN) with
 	| Meta k1, Meta k2 ->
             if Int.equal k1 k2 then substn else
 	    let stM,stN = extract_instance_status pb in
@@ -675,7 +699,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	    if k2 < k1 then sigma,(k1,cN,stN)::metasubst,evarsubst
 	    else sigma,(k2,cM,stM)::metasubst,evarsubst
 	| Meta k, _
-            when not (dependent cM cN) (* helps early trying alternatives *) ->
+            when not (dependent sigma cM cN) (* helps early trying alternatives *) ->
             let sigma = 
 	      if opt.with_types && flags.check_applied_meta_types then
 		(try
@@ -689,13 +713,13 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	    (* Here we check that [cN] does not contain any local variables *)
 	    if Int.equal nb 0 then
               sigma,(k,cN,snd (extract_instance_status pb))::metasubst,evarsubst
-            else if noccur_between 1 nb cN then
+            else if noccur_between sigma 1 nb cN then
               (sigma,
 	      (k,lift (-nb) cN,snd (extract_instance_status pb))::metasubst,
               evarsubst)
 	    else error_cannot_unify_local curenv sigma (m,n,cN)
 	| _, Meta k
-            when not (dependent cN cM) (* helps early trying alternatives *) ->
+            when not (dependent sigma cN cM) (* helps early trying alternatives *) ->
           let sigma = 
 	    if opt.with_types && flags.check_applied_meta_types then
               (try
@@ -709,7 +733,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	    (* Here we check that [cM] does not contain any local variables *)
 	    if Int.equal nb 0 then
               (sigma,(k,cM,fst (extract_instance_status pb))::metasubst,evarsubst)
-	    else if noccur_between 1 nb cM
+	    else if noccur_between sigma 1 nb cM
 	    then
               (sigma,(k,lift (-nb) cM,fst (extract_instance_status pb))::metasubst,
               evarsubst)
@@ -717,27 +741,29 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	| Evar (evk,_ as ev), Evar (evk',_)
             when not (Evar.Set.mem evk flags.frozen_evars)
               && Evar.equal evk evk' ->
-            let sigma',b = constr_cmp cv_pb sigma flags cM cN in
+            let sigma',b = constr_cmp cv_pb env sigma flags cM cN in
             if b then
 	      sigma',metasubst,evarsubst
             else
 	      sigma,metasubst,((curenv,ev,cN)::evarsubst)
 	| Evar (evk,_ as ev), _
             when not (Evar.Set.mem evk flags.frozen_evars) 
-	      && not (occur_evar evk cN) ->
-	    let cmvars = free_rels cM and cnvars = free_rels cN in
+	      && not (occur_evar sigma evk cN) ->
+	    let cmvars = free_rels sigma cM and cnvars = free_rels sigma cN in
 	      if Int.Set.subset cnvars cmvars then
 		sigma,metasubst,((curenv,ev,cN)::evarsubst)
 	      else error_cannot_unify_local curenv sigma (m,n,cN)
 	| _, Evar (evk,_ as ev)
             when not (Evar.Set.mem evk flags.frozen_evars)
-	      && not (occur_evar evk cM) ->
-	    let cmvars = free_rels cM and cnvars = free_rels cN in
+	      && not (occur_evar sigma evk cM) ->
+	    let cmvars = free_rels sigma cM and cnvars = free_rels sigma cN in
 	      if Int.Set.subset cmvars cnvars then
 		sigma,metasubst,((curenv,ev,cM)::evarsubst)
 	      else error_cannot_unify_local curenv sigma (m,n,cN)
 	| Sort s1, Sort s2 ->
 	    (try 
+              let s1 = ESorts.kind sigma s1 in
+              let s2 = ESorts.kind sigma s2 in
 	       let sigma' = 
 		 if pb == CUMUL
 		 then Evd.set_leq_sort curenv sigma s1 s2 
@@ -756,7 +782,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	| _, 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
@@ -775,30 +801,30 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	| App (f1, l1), _ when flags.modulo_eta && 
 	    (* This ensures cN is an evar, meta or irreducible constant/variable
 	       and not a constructor. *)
-	    is_eta_constructor_app curenv flags.modulo_delta f1 l1 cN ->
+	    is_eta_constructor_app curenv sigma flags.modulo_delta f1 l1 cN ->
 	  (try 
-	     let l1', l2' = eta_constructor_app curenv f1 l1 cN in
+	     let l1', l2' = eta_constructor_app curenv sigma f1 l1 cN in
 	     let opt' = {opt with at_top = true; with_cs = false} in
 	       Array.fold_left2 (unirec_rec curenvnb CONV opt') substn l1' l2'
 	   with ex when precatchable_exception ex ->
-	     match kind_of_term cN with
+	     match EConstr.kind sigma cN with
 	     | App(f2,l2) when
-		 (isMeta f2 && use_metas_pattern_unification flags nb l2
-		  || use_evars_pattern_unification flags && isAllowedEvar flags f2) ->
+		 (isMeta sigma f2 && use_metas_pattern_unification sigma flags nb l2
+		  || use_evars_pattern_unification flags && isAllowedEvar sigma flags f2) ->
 	       unify_app_pattern false curenvnb pb opt substn cM f1 l1 cN f2 l2
 	     | _ -> raise ex)
 
 	| _, App (f2, l2) when flags.modulo_eta && 
-	    is_eta_constructor_app curenv flags.modulo_delta f2 l2 cM ->
+	    is_eta_constructor_app curenv sigma flags.modulo_delta f2 l2 cM ->
 	  (try 
-	     let l2', l1' = eta_constructor_app curenv f2 l2 cM in
+	     let l2', l1' = eta_constructor_app curenv sigma f2 l2 cM in
 	     let opt' = {opt with at_top = true; with_cs = false} in
 	       Array.fold_left2 (unirec_rec curenvnb CONV opt') substn l1' l2'
 	   with ex when precatchable_exception ex ->
-	     match kind_of_term cM with
+	     match EConstr.kind sigma cM with
 	     | App(f1,l1) when 
-		 (isMeta f1 && use_metas_pattern_unification flags nb l1
-		  || use_evars_pattern_unification flags && isAllowedEvar flags f1) ->
+		 (isMeta sigma f1 && use_metas_pattern_unification sigma flags nb l1
+		  || use_evars_pattern_unification flags && isAllowedEvar sigma flags f1) ->
 	       unify_app_pattern true curenvnb pb opt substn cM f1 l1 cN f2 l2
 	     | _ -> raise ex)
 
@@ -813,13 +839,13 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	       reduce curenvnb pb opt substn cM cN)
 
 	| App (f1,l1), _ when 
-	    (isMeta f1 && use_metas_pattern_unification flags nb l1
-            || use_evars_pattern_unification flags && isAllowedEvar flags f1) ->
+	    (isMeta sigma f1 && use_metas_pattern_unification sigma flags nb l1
+            || use_evars_pattern_unification flags && isAllowedEvar sigma flags f1) ->
 	  unify_app_pattern true curenvnb pb opt substn cM f1 l1 cN cN [||]
 
 	| _, App (f2,l2) when
-	    (isMeta f2 && use_metas_pattern_unification flags nb l2
-            || use_evars_pattern_unification flags && isAllowedEvar flags f2) ->
+	    (isMeta sigma f2 && use_metas_pattern_unification sigma flags nb l2
+            || use_evars_pattern_unification flags && isAllowedEvar sigma flags f2) ->
 	  unify_app_pattern false curenvnb pb opt substn cM cM [||] cN f2 l2
 
 	| App (f1,l1), App (f2,l2) ->
@@ -834,11 +860,11 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	| _ ->
           unify_not_same_head curenvnb pb opt substn cM cN
 
-  and unify_app_pattern dir curenvnb pb opt substn cM f1 l1 cN f2 l2 =
+  and unify_app_pattern dir curenvnb pb opt (sigma, _, _ as substn) cM f1 l1 cN f2 l2 =
     let f, l, t = if dir then f1, l1, cN else f2, l2, cM in
       match is_unification_pattern curenvnb sigma f (Array.to_list l) t with
       | None ->
-	(match kind_of_term t with
+	(match EConstr.kind sigma t with
 	| App (f',l') -> 
 	  if dir then unify_app curenvnb pb opt substn cM f1 l1 t f' l'
 	  else unify_app curenvnb pb opt substn t f' l' cN f2 l2
@@ -847,19 +873,19 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
       | Some l ->
 	solve_pattern_eqn_array curenvnb f l t substn
 
-  and unify_app (curenv, nb as curenvnb) pb opt (sigma, metas, evars as substn) cM f1 l1 cN f2 l2 =
+  and unify_app (curenv, nb as curenvnb) pb opt (sigma, metas, evars as substn : subst0) cM f1 l1 cN f2 l2 =
     try
       let needs_expansion p c' = 
-	match kind_of_term c' with
+	match EConstr.kind sigma c' with
 	| Meta _ -> true
 	| Evar _ -> true
 	| Const (c, u) -> Constant.equal c (Projection.constant p)
 	| _ -> false
       in
       let expand_proj c c' l = 
-      	match kind_of_term c with
+      	match EConstr.kind sigma c with
       	| Proj (p, t) when not (Projection.unfolded p) && needs_expansion p c' ->
-      	  (try destApp (Retyping.expand_projection curenv sigma p t (Array.to_list l))
+      	  (try destApp sigma (Retyping.expand_projection curenv sigma p t (Array.to_list l))
       	   with RetypeError _ -> (** Unification can be called on ill-typed terms, due
       				     to FO and eta in particular, fail gracefully in that case *)
       	     (c, l))
@@ -894,33 +920,33 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	    ty1 ty2
       with RetypeError _ -> substn
 
-  and unify_not_same_head curenvnb pb opt (sigma, metas, evars as substn) cM cN =
+  and unify_not_same_head curenvnb pb opt (sigma, metas, evars as substn : subst0) cM cN =
     try canonical_projections curenvnb pb opt cM cN substn
     with ex when precatchable_exception ex ->
-    let sigma', b = constr_cmp cv_pb sigma flags cM cN in
+    let sigma', b = constr_cmp cv_pb env sigma flags cM cN in
       if b then (sigma', metas, evars)
       else
 	try reduce curenvnb pb opt substn cM cN
 	with ex when precatchable_exception ex ->
 	let (f1,l1) =
-	  match kind_of_term cM with App (f,l) -> (f,l) | _ -> (cM,[||]) in
+	  match EConstr.kind sigma cM with App (f,l) -> (f,l) | _ -> (cM,[||]) in
 	let (f2,l2) =
-	  match kind_of_term cN with App (f,l) -> (f,l) | _ -> (cN,[||]) in
+	  match EConstr.kind sigma cN with App (f,l) -> (f,l) | _ -> (cN,[||]) in
 	  expand curenvnb pb opt substn cM f1 l1 cN f2 l2
 
   and reduce curenvnb pb opt (sigma, metas, evars as substn) cM cN =
-    if use_full_betaiota flags && not (subterm_restriction opt flags) then
+    if flags.modulo_betaiota && not (subterm_restriction opt flags) then
       let cM' = do_reduce flags.modulo_delta curenvnb sigma cM in
-	if not (Term.eq_constr cM cM') then
+	if not (EConstr.eq_constr sigma cM cM') then
 	  unirec_rec curenvnb pb opt substn cM' cN
 	else
 	  let cN' = do_reduce flags.modulo_delta curenvnb sigma cN in
-	    if not (Term.eq_constr cN cN') then
+	    if not (EConstr.eq_constr sigma cN cN') then
 	      unirec_rec curenvnb pb opt substn cM cN'
 	    else error_cannot_unify (fst curenvnb) sigma (cM,cN)
     else error_cannot_unify (fst curenvnb) sigma (cM,cN)
 	    
-  and expand (curenv,_ as curenvnb) pb opt (sigma,metasubst,evarsubst as substn) cM f1 l1 cN f2 l2 =
+  and expand (curenv,_ as curenvnb) pb opt (sigma,metasubst,evarsubst as substn : subst0) cM f1 l1 cN f2 l2 =
     let res =
       (* Try full conversion on meta-free terms. *)
       (* Back to 1995 (later on called trivial_unify in 2002), the
@@ -939,10 +965,10 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
       | None -> None
       | Some convflags ->
       let subst = ((if flags.use_metas_eagerly_in_conv_on_closed_terms then metasubst else ms), (if flags.use_evars_eagerly_in_conv_on_closed_terms then evarsubst else es)) in
-      match subst_defined_metas_evars subst cM with
+      match subst_defined_metas_evars sigma subst cM with
       | None -> (* some undefined Metas in cM *) None
       | Some m1 ->
-      match subst_defined_metas_evars subst cN with
+      match subst_defined_metas_evars sigma subst cN with
       | None -> (* some undefined Metas in cN *) None
       | Some n1 ->
          (* No subterm restriction there, too much incompatibilities *)
@@ -966,7 +992,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
       match res with
       | Some substn -> substn
       | None ->
-      let cf1 = key_of curenv opt flags f1 and cf2 = key_of curenv opt flags f2 in
+      let cf1 = key_of curenv sigma opt flags f1 and cf2 = key_of curenv sigma opt flags f2 in
 	match oracle_order curenv cf1 cf2 with
 	| None -> error_cannot_unify curenv sigma (cM,cN)
 	| Some true ->
@@ -996,7 +1022,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 
   and canonical_projections (curenv, _ as curenvnb) pb opt cM cN (sigma,_,_ as substn) =
     let f1 () =
-      if isApp 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
@@ -1012,7 +1038,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 	error_cannot_unify (fst curenvnb) sigma (cM,cN)
       else
 	try f1 () with e when precatchable_exception e ->
-	  if isApp 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
@@ -1034,23 +1060,23 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
                 (evd,t2::ks, m-1)
             else
               let mv = new_meta () in
-	      let evd' = meta_declare mv (substl ks b) evd in
+	      let evd' = meta_declare mv (EConstr.Unsafe.to_constr (substl ks b)) evd in
 	      (evd', mkMeta mv :: ks, m - 1))
 	  (sigma,[],List.length bs) bs
       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 (unirec_rec curenvnb pb opt') 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
-      with Invalid_argument "Reductionops.Stack.fold2" ->
+      with Reductionops.Stack.IncompatibleFold2 ->
 	error_cannot_unify (fst curenvnb) sigma (cM,cN)
     else error_cannot_unify (fst curenvnb) sigma (cM,cN)
   in
@@ -1066,7 +1092,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
     else 
       let sigma, b = match flags.modulo_conv_on_closed_terms with
 	| Some convflags -> infer_conv ~pb:cv_pb ~ts:convflags env sigma m n
-	| _ -> constr_cmp cv_pb sigma flags m n in
+        | _ -> constr_cmp cv_pb env sigma flags m n in
 	if b then Some sigma
 	else if (match flags.modulo_conv_on_closed_terms, flags.modulo_delta with
         | Some (cv_id, cv_k), (dl_id, dl_k) ->
@@ -1093,7 +1119,7 @@ let right = false
 
 let rec unify_with_eta keptside flags env sigma c1 c2 =
 (* Question: try whd_all on ci if not two lambdas? *)
-  match kind_of_term c1, kind_of_term c2 with
+  match EConstr.kind sigma c1, EConstr.kind sigma c2 with
   | (Lambda (na,t1,c1'), Lambda (_,t2,c2')) ->
     let env' = push_rel_assum (na,t1) env in
     let sigma,metas,evars = unify_0 env sigma CONV flags t1 t2 in
@@ -1196,22 +1222,22 @@ let merge_instances env sigma flags st1 st2 c1 c2 =
  * close it off.  But this might not always work,
  * since other metavars might also need to be resolved. *)
 
-let applyHead env (type r) (evd : r Sigma.t) n c =
-  let rec apprec : type s. _ -> _ -> _ -> (r, s) Sigma.le -> s Sigma.t -> (constr, r) Sigma.sigma =
-    fun n c cty p evd ->
+let applyHead env evd n c  =
+  let rec apprec n c cty evd =
     if Int.equal n 0 then
-      Sigma (c, evd, p)
+      (evd, c)
     else
-      match kind_of_term (whd_all env (Sigma.to_evar_map evd) cty) with
+      match EConstr.kind evd (whd_all env evd cty) with
       | Prod (_,c1,c2) ->
-        let Sigma (evar, evd', q) = Evarutil.new_evar env evd ~src:(Loc.ghost,Evar_kinds.GoalEvar) c1 in
-	  apprec (n-1) (mkApp(c,[|evar|])) (subst1 evar c2) (p +> q) evd'
-      | _ -> error "Apply_Head_Then"
+        let (evd',evar) =
+      Evarutil.new_evar env evd ~src:(Loc.tag Evar_kinds.GoalEvar) c1 in
+      apprec (n-1) (mkApp(c,[|evar|])) (subst1 evar c2) evd'
+      | _ -> user_err Pp.(str "Apply_Head_Then")
   in
-    apprec n c (Typing.unsafe_type_of env (Sigma.to_evar_map evd) c) Sigma.refl evd
+    apprec n c (Typing.unsafe_type_of env evd c) evd
 
-let is_mimick_head ts f =
-  match kind_of_term f with
+let is_mimick_head sigma ts f =
+  match EConstr.kind sigma f with
   | Const (c,u) -> not (CClosure.is_transparent_constant ts c)
   | Var id -> not (CClosure.is_transparent_variable ts id)
   | (Rel _|Construct _|Ind _) -> true
@@ -1219,9 +1245,9 @@ let is_mimick_head ts f =
 
 let try_to_coerce env evd c cty tycon =
   let j = make_judge c cty in
-  let (evd',j') = inh_conv_coerce_rigid_to true Loc.ghost env evd j tycon in
+  let (evd',j') = inh_conv_coerce_rigid_to true env evd j tycon in
   let evd' = Evarconv.solve_unif_constraints_with_heuristics env evd' in
-  let evd' = Evd.map_metas_fvalue (nf_evar evd') evd' in
+  let evd' = Evd.map_metas_fvalue (fun c -> EConstr.Unsafe.to_constr (nf_evar evd' (EConstr.of_constr c))) evd' in
     (evd',j'.uj_val)
 
 let w_coerce_to_type env evd c cty mvty =
@@ -1242,7 +1268,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 =
@@ -1269,36 +1295,31 @@ let solve_simple_evar_eqn ts env evd ev rhs =
   match solve_simple_eqn (Evarconv.evar_conv_x ts) env evd (None,ev,rhs) with
   | UnifFailure (evd,reason) ->
       error_cannot_unify env evd ~reason (mkEvar ev,rhs);
-  | Success evd ->
-     if Flags.version_less_or_equal Flags.V8_5 then
-       (* We used to force solving unrelated problems at arbitrary times *)
-       Evarconv.solve_unif_constraints_with_heuristics env evd
-     else (* solve_simple_eqn calls reconsider_unif_constraints itself *)
-       evd
+  | Success evd -> evd
 
 (* [w_merge env sigma b metas evars] merges common instances in metas
    or in evars, possibly generating new unification problems; if [b]
    is true, unification of types of metas is required *)
 
-let w_merge env with_types flags (evd,metas,evars) =
+let w_merge env with_types flags (evd,metas,evars : subst0) =
   let rec w_merge_rec evd metas evars eqns =
 
     (* Process evars *)
     match evars with
     | (curenv,(evk,_ as ev),rhs)::evars' ->
 	if Evd.is_defined evd evk then
-	  let v = Evd.existential_value evd ev in
+	  let v = mkEvar ev in
 	  let (evd,metas',evars'') =
 	    unify_0 curenv evd CONV flags rhs v in
 	  w_merge_rec evd (metas'@metas) (evars''@evars') eqns
     	else begin
 	  (* This can make rhs' ill-typed if metas are *)
-          let rhs' = subst_meta_instances metas rhs in
-          match kind_of_term rhs with
-	  | App (f,cl) when occur_meta rhs' ->
-	      if occur_evar evk rhs' then
+          let rhs' = subst_meta_instances evd metas rhs in
+          match EConstr.kind evd rhs with
+	  | App (f,cl) when occur_meta evd rhs' ->
+	      if occur_evar evd evk rhs' then
                 error_occur_check curenv evd evk rhs';
-	      if is_mimick_head flags.modulo_delta f then
+	      if is_mimick_head evd flags.modulo_delta f then
 		let evd' =
 		  mimick_undefined_evar evd flags f (Array.length cl) evk in
 		  w_merge_rec evd' metas evars eqns
@@ -1338,20 +1359,20 @@ let w_merge env with_types flags (evd,metas,evars) =
 	  if meta_defined evd mv then
 	    let {rebus=c'},(status',_) = meta_fvalue evd mv in
             let (take_left,st,(evd,metas',evars')) =
-	      merge_instances env evd flags status' status c' c
+	      merge_instances env evd flags status' status (EConstr.of_constr c') c
 	    in
 	    let evd' =
               if take_left then evd
-              else meta_reassign mv (c,(st,TypeProcessed)) evd
+              else meta_reassign mv (EConstr.Unsafe.to_constr c,(st,TypeProcessed)) evd
 	    in
               w_merge_rec evd' (metas'@metas@metas'') (evars'@evars'') eqns
     	  else
             let evd' =
               if occur_meta_evd evd mv c then
-                if isMetaOf mv (whd_all env evd c) then evd
+                if isMetaOf evd mv (whd_all env evd c) then evd
                 else error_cannot_unify env evd (mkMeta mv,c)
               else
-	        meta_assign mv (c,(status,TypeProcessed)) evd in
+	        meta_assign mv (EConstr.Unsafe.to_constr c,(status,TypeProcessed)) evd in
 	    w_merge_rec evd' (metas''@metas) evars'' eqns
     | [] ->
 	(* Process type eqns *)
@@ -1371,23 +1392,21 @@ let w_merge env with_types flags (evd,metas,evars) =
 	      
   and mimick_undefined_evar evd flags hdc nargs sp =
     let ev = Evd.find_undefined evd sp in
-    let sp_env = Global.env_of_context ev.evar_hyps in
-    let evd = Sigma.Unsafe.of_evar_map evd in
-    let Sigma (c, evd', _) = applyHead sp_env evd nargs hdc in
-    let evd' = Sigma.to_evar_map evd' in
+    let sp_env = Global.env_of_context (evar_filtered_hyps ev) in
+    let (evd', c) = applyHead sp_env evd nargs hdc in
     let (evd'',mc,ec) =
       unify_0 sp_env evd' CUMUL flags
-        (get_type_of sp_env evd' c) ev.evar_concl in
+        (get_type_of sp_env evd' c) (EConstr.of_constr ev.evar_concl) in
     let evd''' = w_merge_rec evd'' mc ec [] in
     if evd' == evd'''
-    then Evd.define sp c evd'''
-    else Evd.define sp (Evarutil.nf_evar evd''' c) evd''' in
+    then Evd.define sp (EConstr.Unsafe.to_constr c) evd'''
+    else Evd.define sp (EConstr.Unsafe.to_constr (Evarutil.nf_evar evd''' c)) evd''' in
 
   let check_types evd = 
     let metas = Evd.meta_list evd in
     let eqns = List.fold_left (fun acc (mv, b) ->
       match b with
-      | Clval (n, (t, (c, TypeNotProcessed)), v) -> (mv, c, t.rebus) :: acc
+      | Clval (n, (t, (c, TypeNotProcessed)), v) -> (mv, c, EConstr.of_constr t.rebus) :: acc
       | _ -> acc) [] metas
     in w_merge_rec evd [] [] eqns
   in
@@ -1398,6 +1417,11 @@ let w_merge env with_types flags (evd,metas,evars) =
   in
   if with_types then check_types res else res
 
+let retract_coercible_metas evd =
+  let (metas, evd) = retract_coercible_metas evd in
+  let map (mv, c, st) = (mv, EConstr.of_constr c, st) in
+  (List.map map metas, evd)
+
 let w_unify_meta_types env ?(flags=default_unify_flags ()) evd =
   let metas,evd = retract_coercible_metas evd in
   w_merge env true flags.merge_unify_flags (evd,metas,[])
@@ -1415,13 +1439,17 @@ let w_unify_meta_types env ?(flags=default_unify_flags ()) evd =
 let head_app sigma m =
   fst (whd_nored_state sigma (m, Stack.empty))
 
+let isEvar_or_Meta sigma c = match EConstr.kind sigma c with
+| Evar _ | Meta _ -> true
+| _ -> false
+
 let check_types env flags (sigma,_,_ as subst) m n =
-  if isEvar_or_Meta (head_app sigma m) then
+  if isEvar_or_Meta sigma (head_app sigma m) then
     unify_0_with_initial_metas subst true env CUMUL
       flags
       (get_type_of env sigma n)
       (get_type_of env sigma m)
-  else if isEvar_or_Meta (head_app sigma n) then
+  else if isEvar_or_Meta sigma (head_app sigma n) then
     unify_0_with_initial_metas subst true env CUMUL
       flags
       (get_type_of env sigma m)
@@ -1463,7 +1491,7 @@ let w_typed_unify_array env evd flags f1 l1 f2 l2 =
 let iter_fail f a =
   let n = Array.length a in
   let rec ffail i =
-    if Int.equal i n then error "iter_fail"
+    if Int.equal i n then user_err Pp.(str "iter_fail")
     else
       try f a.(i)
       with ex when precatchable_exception ex -> ffail (i+1)
@@ -1472,22 +1500,18 @@ let iter_fail f a =
 (* make_abstraction: a variant of w_unify_to_subterm which works on
    contexts, with evars, and possibly with occurrences *)
 
-let indirectly_dependent c d decls =
-  not (isVar c) &&
+let indirectly_dependent sigma c d decls =
+  not (isVar sigma c) &&
     (* This test is not needed if the original term is a variable, but
        it is needed otherwise, as e.g. when abstracting over "2" in
        "forall H:0=2, H=H:>(0=1+1) -> 0=2." where there is now obvious
        way to see that the second hypothesis depends indirectly over 2 *)
-    List.exists (fun d' -> dependent_in_decl (mkVar (get_id d')) d) decls
-
-let indirect_dependency d decls =
-  decls  |>  List.filter (fun d' -> dependent_in_decl (mkVar (get_id d')) d)  |>  List.hd  |>  get_id
+    List.exists (fun d' -> dependent_in_decl sigma (EConstr.mkVar (NamedDecl.get_id d')) d) decls
 
 let finish_evar_resolution ?(flags=Pretyping.all_and_fail_flags) env current_sigma (pending,c) =
-  let current_sigma = Sigma.to_evar_map current_sigma in
   let sigma = Pretyping.solve_remaining_evars flags env current_sigma pending in
   let sigma, subst = nf_univ_variables sigma in
-  Sigma.Unsafe.of_pair (subst_univs_constr subst (nf_evar sigma c), sigma)
+  (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 {
@@ -1516,7 +1540,7 @@ let default_matching_merge_flags sigma =
     use_pattern_unification = true;
 }
 
-let default_matching_flags (sigma,_) =
+let default_matching_flags sigma =
   let flags = default_matching_core_flags sigma in {
   core_unify_flags = flags;
   merge_unify_flags = default_matching_merge_flags sigma;
@@ -1539,17 +1563,17 @@ let make_pattern_test from_prefix_of_ind is_correct_type env sigma (pending,c) =
         modulo_conv_on_closed_terms = Some Names.full_transparent_state;
         restrict_conv_on_strict_subterms = true } }
     else default_matching_flags pending in
-  let n = List.length (snd (decompose_app c)) in
+  let n = Array.length (snd (decompose_app_vect sigma c)) in
   let matching_fun _ t =
     try
       let t',l2 =
         if from_prefix_of_ind then
           (* We check for fully applied subterms of the form "u u1 .. un" *)
           (* of inductive type knowing only a prefix "u u1 .. ui" *)
-          let t,l = decompose_app t in
+          let t,l = decompose_app sigma t in
           let l1,l2 =
             try List.chop n l with Failure _ -> raise (NotUnifiable None) in
-          if not (List.for_all closed0 l2) then raise (NotUnifiable None)
+          if not (List.for_all (fun c -> Vars.closed0 sigma c) l2) then raise (NotUnifiable None)
           else
             applist (t,l1), l2
         else t, [] in
@@ -1575,9 +1599,9 @@ let make_pattern_test from_prefix_of_ind is_correct_type env sigma (pending,c) =
   (fun test -> match test.testing_state with
   | None -> None
   | Some (sigma,_,l) ->
-     let c = applist (nf_evar sigma (local_strong whd_meta sigma c),l) in
+     let c = applist (nf_evar sigma (local_strong whd_meta sigma c), l) in
      let univs, subst = nf_univ_variables sigma in
-     Some (sigma,subst_univs_constr subst 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 =
@@ -1588,27 +1612,28 @@ let make_eq_test env evd c =
 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()) t name in
-    let ids = ids_of_named_context (named_context env) in
+    let x = id_of_name_using_hdchar (Global.env()) sigma t name 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
-      errorlabstrm "Unification.make_abstraction_core"
-        (str "The variable " ++ Nameops.pr_id x ++ str " is already declared.")
+      user_err ~hdr:"Unification.make_abstraction_core"
+        (str "The variable " ++ Id.print x ++ str " is already declared.")
     else
       x
   in
   let likefirst = clause_with_generic_occurrences occs in
-  let mkvarid () = mkVar id in
+  let mkvarid () = EConstr.mkVar id in
   let compute_dependency _ d (sign,depdecls) =
-    let hyp = get_id d in
+    let d = map_named_decl EConstr.of_constr d in
+    let hyp = NamedDecl.get_id d in
     match occurrences_of_hyp hyp occs with
     | NoOccurrences, InHyp ->
         (push_named_context_val d sign,depdecls)
     | AllOccurrences, InHyp as occ ->
         let occ = if likefirst then LikeFirst else AtOccs occ in
-        let newdecl = replace_term_occ_decl_modulo occ test mkvarid d in
-        if Context.Named.Declaration.equal d newdecl
-           && not (indirectly_dependent c d depdecls)
+        let newdecl = replace_term_occ_decl_modulo sigma occ test mkvarid d in
+        if Context.Named.Declaration.equal (EConstr.eq_constr sigma) d newdecl
+           && not (indirectly_dependent sigma c d depdecls)
         then
           if check_occs && not (in_every_hyp occs)
           then raise (PretypeError (env,sigma,NoOccurrenceFound (c,Some hyp)))
@@ -1617,7 +1642,7 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
           (push_named_context_val newdecl sign, newdecl :: depdecls)
     | occ ->
         (* There are specific occurrences, hence not like first *)
-        let newdecl = replace_term_occ_decl_modulo (AtOccs occ) test mkvarid d in
+        let newdecl = replace_term_occ_decl_modulo sigma (AtOccs occ) test mkvarid d in
         (push_named_context_val newdecl sign, newdecl :: depdecls) in
   try
     let sign,depdecls =
@@ -1627,13 +1652,13 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
       | NoOccurrences -> concl
       | occ ->
           let occ = if likefirst then LikeFirst else AtOccs occ in
-          replace_term_occ_modulo occ test mkvarid concl
+          replace_term_occ_modulo sigma occ test mkvarid concl
     in
     let lastlhyp =
-      if List.is_empty depdecls then None else Some (get_id (List.last depdecls)) in
+      if List.is_empty depdecls then None else Some (NamedDecl.get_id (List.last depdecls)) in
     let res = match out test with
     | None -> None
-    | Some (sigma, c) -> Some (Sigma.Unsafe.of_pair (c, sigma))
+    | Some (sigma, c) -> Some (sigma,c)
     in
     (id,sign,depdecls,lastlhyp,ccl,res)
   with
@@ -1654,16 +1679,15 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
 type prefix_of_inductive_support_flag = bool
 
 type abstraction_request =
-| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Name.t * pending_constr * clause * bool
+| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Name.t * (evar_map * constr) * clause * bool
 | AbstractExact of Name.t * constr * types option * clause * bool
 
 type 'r abstraction_result =
   Names.Id.t * named_context_val *
-    Context.Named.Declaration.t list * Names.Id.t option *
-    types * (constr, 'r) Sigma.sigma option
+    named_declaration list * Names.Id.t option *
+    types * (evar_map * constr) option
 
 let make_abstraction env evd ccl abs =
-  let evd = Sigma.to_evar_map evd in
   match abs with
   | AbstractPattern (from_prefix,check,name,c,occs,check_occs) ->
       make_abstraction_core name
@@ -1681,7 +1705,7 @@ let keyed_unify env evd kop =
     | None -> fun _ -> true
     | Some kop ->
       fun cl ->
-	let kc = Keys.constr_key cl in
+	let kc = Keys.constr_key (fun c -> EConstr.kind evd c) cl in
 	  match kc with
 	  | None -> false
 	  | Some kc -> Keys.equiv_keys kop kc
@@ -1691,22 +1715,22 @@ let keyed_unify env evd kop =
    Fails if no match is found *)
 let w_unify_to_subterm env evd ?(flags=default_unify_flags ()) (op,cl) =
   let bestexn = ref None in
-  let kop = Keys.constr_key op in
+  let kop = Keys.constr_key (fun c -> EConstr.kind evd c) op in
   let rec matchrec cl =
-    let cl = strip_outer_cast cl in
+    let cl = strip_outer_cast evd cl in
     (try
-       if closed0 cl && not (isEvar cl) && keyed_unify env evd kop cl then
+       if closed0 evd cl && not (isEvar evd cl) && keyed_unify env evd kop cl then
        (try
          if !keyed_unification then
-           let f1, l1 = decompose_app_vect op in
-	   let f2, l2 = decompose_app_vect cl in
+           let f1, l1 = decompose_app_vect evd op in
+	   let f2, l2 = decompose_app_vect evd cl in
 	   w_typed_unify_array env evd flags f1 l1 f2 l2,cl
 	 else w_typed_unify env evd CONV flags op cl,cl
        with ex when Pretype_errors.unsatisfiable_exception ex ->
-	    bestexn := Some ex; error "Unsat")
-       else error "Bound 1"
+	    bestexn := Some ex; user_err Pp.(str "Unsat"))
+       else user_err Pp.(str "Bound 1")
      with ex when precatchable_exception ex ->
-       (match kind_of_term cl with
+       (match EConstr.kind evd cl with
 	  | App (f,args) ->
 	      let n = Array.length args in
 	      assert (n>0);
@@ -1753,7 +1777,9 @@ let w_unify_to_subterm env evd ?(flags=default_unify_flags ()) (op,cl) =
 	       with ex when precatchable_exception ex ->
 		 matchrec c)
 
-          | _ -> error "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 ->
@@ -1767,9 +1793,9 @@ let w_unify_to_subterm env evd ?(flags=default_unify_flags ()) (op,cl) =
 let w_unify_to_subterm_all env evd ?(flags=default_unify_flags ()) (op,cl) =
   let return a b =
     let (evd,c as a) = a () in
-      if List.exists (fun (evd',c') -> Term.eq_constr c c') b then b else a :: b
+      if List.exists (fun (evd',c') -> EConstr.eq_constr evd' c c') b then b else a :: b
   in
-  let fail str _ = error str in
+  let fail str _ = user_err (Pp.str str) in
   let bind f g a =
     let a1 = try f a
              with ex
@@ -1786,12 +1812,12 @@ let w_unify_to_subterm_all env evd ?(flags=default_unify_flags ()) (op,cl) =
     in ffail 0
   in
   let rec matchrec cl =
-    let cl = strip_outer_cast cl in
+    let cl = strip_outer_cast evd cl in
       (bind
-	  (if closed0 cl
+	  (if closed0 evd cl
 	  then return (fun () -> w_typed_unify env evd CONV flags op cl,cl)
             else fail "Bound 1")
-          (match kind_of_term cl with
+          (match EConstr.kind evd cl with
 	    | App (f,args) ->
 		let n = Array.length args in
 		assert (n>0);
@@ -1819,7 +1845,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
@@ -1831,13 +1861,13 @@ let w_unify_to_subterm_list env evd flags hdmeta oplist t =
   List.fold_right
     (fun op (evd,l) ->
       let op = whd_meta evd op in
-      if isMeta op then
+      if isMeta evd op then
 	if flags.allow_K_in_toplevel_higher_order_unification then (evd,op::l)
-	else error_abstraction_over_meta env evd hdmeta (destMeta op)
+	else error_abstraction_over_meta env evd hdmeta (destMeta evd op)
       else
         let allow_K = flags.allow_K_in_toplevel_higher_order_unification in
         let flags =
-          if occur_meta_or_existential op || !keyed_unification then
+          if unsafe_occur_meta_or_existential op || !keyed_unification then
 	    (* This is up to delta for subterms w/o metas ... *)
             flags
           else
@@ -1846,7 +1876,7 @@ let w_unify_to_subterm_list env evd flags hdmeta oplist t =
                unify pre-existing non frozen evars of the goal or of the
                pattern *)
           set_no_delta_flags flags in
-	let t' = (strip_outer_cast op,t) in
+	let t' = (strip_outer_cast evd op,t) in
         let (evd',cl) =
           try
   	    if is_keyed_unification () then
@@ -1862,11 +1892,11 @@ let w_unify_to_subterm_list env evd flags hdmeta oplist t =
                 (* w_unify_to_subterm does not go through evars, so
                    the next step, which was already in <= 8.4, is
                    needed at least for compatibility of rewrite *)
-                dependent op t -> (evd,op)
+                dependent evd op t -> (evd,op)
         in
 	  if not allow_K &&
             (* ensure we found a different instance *)
-	    List.exists (fun op -> Term.eq_constr op cl) l
+	    List.exists (fun op -> EConstr.eq_constr evd' op cl) l
 	  then error_non_linear_unification env evd hdmeta cl
 	  else (evd',cl::l))
     oplist
@@ -1898,14 +1928,14 @@ let secondOrderAbstractionAlgo dep =
 let w_unify2 env evd flags dep cv_pb ty1 ty2 =
   let c1, oplist1 = whd_nored_stack evd ty1 in
   let c2, oplist2 = whd_nored_stack evd ty2 in
-  match kind_of_term c1, kind_of_term c2 with
+  match EConstr.kind evd c1, EConstr.kind evd c2 with
     | Meta p1, _ ->
         (* Find the predicate *)
-        secondOrderAbstractionAlgo dep env evd flags ty2 (p1,oplist1)
+        secondOrderAbstractionAlgo dep env evd flags ty2 (p1, oplist1)
     | _, Meta p2 ->
         (* Find the predicate *)
         secondOrderAbstractionAlgo dep env evd flags ty1 (p2, oplist2)
-    | _ -> error "w_unify2"
+    | _ -> user_err Pp.(str "w_unify2")
 
 (* The unique unification algorithm works like this: If the pattern is
    flexible, and the goal has a lambda-abstraction at the head, then
@@ -1928,11 +1958,11 @@ let w_unify2 env evd flags dep cv_pb ty1 ty2 =
    convertible and first-order otherwise. But if failed if e.g. the type of
    Meta(1) had meta-variables in it. *)
 let w_unify env evd cv_pb ?(flags=default_unify_flags ()) ty1 ty2 =
-  let hd1,l1 = decompose_appvect (whd_nored evd ty1) in
-  let hd2,l2 = decompose_appvect (whd_nored evd ty2) in
+  let hd1,l1 = decompose_app_vect evd (whd_nored evd ty1) in
+  let hd2,l2 = decompose_app_vect evd (whd_nored evd ty2) in
   let is_empty1 = Array.is_empty l1 in
   let is_empty2 = Array.is_empty l2 in
-    match kind_of_term hd1, not is_empty1, kind_of_term hd2, not is_empty2 with
+    match EConstr.kind evd hd1, not is_empty1, EConstr.kind evd hd2, not is_empty2 with
       (* Pattern case *)
       | (Meta _, true, Lambda _, _ | Lambda _, _, Meta _, true)
 	  when Int.equal (Array.length l1) (Array.length l2) ->
@@ -1969,8 +1999,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 0ad882a9..16ce5c93 100644
--- a/pretyping/unification.mli
+++ b/pretyping/unification.mli
@@ -1,12 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Constr
+open EConstr
 open Environ
 open Evd
 
@@ -44,7 +47,7 @@ val elim_no_delta_flags : unit -> unify_flags
 
 val is_keyed_unification : unit -> bool
 
-(** The "unique" unification fonction *)
+(** The "unique" unification function *)
 val w_unify :
   env -> evar_map -> conv_pb -> ?flags:unify_flags -> constr -> constr -> evar_map
 
@@ -71,18 +74,18 @@ exception PatternNotFound
 type prefix_of_inductive_support_flag = bool
 
 type abstraction_request =
-| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Names.Name.t * pending_constr * Locus.clause * bool
+| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Names.Name.t * (evar_map * constr) * Locus.clause * bool
 | AbstractExact of Names.Name.t * constr * types option * Locus.clause * bool
 
 val finish_evar_resolution : ?flags:Pretyping.inference_flags ->
-  env -> 'r Sigma.t -> pending_constr -> (constr, 'r) Sigma.sigma
+  env -> evar_map -> (evar_map * constr) -> evar_map * constr
 
 type 'r abstraction_result =
   Names.Id.t * named_context_val *
-    Context.Named.Declaration.t list * Names.Id.t option *
-    types * (constr, 'r) Sigma.sigma option
+    named_declaration list * Names.Id.t option *
+    types * (evar_map * constr) option
 
-val make_abstraction : env -> 'r Sigma.t -> constr ->
+val make_abstraction : env -> evar_map -> constr ->
   abstraction_request -> 'r abstraction_result
 
 val pose_all_metas_as_evars : env -> evar_map -> constr -> evar_map * constr
@@ -97,28 +100,29 @@ val abstract_list_all :
 
 (* For tracing *)
 
-val w_merge : env -> bool -> core_unify_flags -> evar_map *
-  (metavariable * constr * (instance_constraint * instance_typing_status)) list *
-  (env * types pexistential * types) list -> evar_map
+type metabinding = (metavariable * constr * (instance_constraint * instance_typing_status))
+
+type subst0 =
+  (evar_map *
+    metabinding list *
+      (Environ.env * existential * t) list)
+
+val w_merge : env -> bool -> core_unify_flags -> subst0 -> evar_map
 
 val unify_0 :            Environ.env ->
            Evd.evar_map ->
            Evd.conv_pb ->
            core_unify_flags ->
-           Term.types ->
-           Term.types ->
-           Evd.evar_map * Evd.metabinding list *
-           (Environ.env * Term.types Term.pexistential * Term.constr) list
+           types ->
+           types ->
+           subst0
 
 val unify_0_with_initial_metas : 
-           Evd.evar_map * Evd.metabinding list *
-           (Environ.env * Term.types Term.pexistential * Term.constr) list ->
+           subst0 ->
            bool ->
            Environ.env ->
            Evd.conv_pb ->
            core_unify_flags ->
-           Term.types ->
-           Term.types ->
-           Evd.evar_map * Evd.metabinding list *
-           (Environ.env * Term.types Term.pexistential * Term.constr) list
-
+           types ->
+           types ->
+           subst0
diff --git a/pretyping/univdecls.ml b/pretyping/univdecls.ml
new file mode 100644
index 00000000..8864be57
--- /dev/null
+++ b/pretyping/univdecls.ml
@@ -0,0 +1,52 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 (UState.make_with_initial_binders (Environ.universes env) 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 00000000..305d045b
--- /dev/null
+++ b/pretyping/univdecls.mli
@@ -0,0 +1,21 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** 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 -> Constrexpr.universe_decl_expr ->
+                       Evd.evar_map * universe_decl
+
+val interp_univ_decl_opt : Environ.env -> Constrexpr.universe_decl_expr option ->
+                       Evd.evar_map * universe_decl
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index e281f22d..c53305e2 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -1,22 +1,29 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 (*******************************************)
 (* Calcul de la forme normal d'un terme    *)
 (*******************************************)
@@ -48,7 +55,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
 
@@ -96,13 +103,15 @@ let construct_of_constr_block = construct_of_constr false
 let type_of_ind env (ind, u) =
   type_of_inductive env (Inductive.lookup_mind_specif env ind, u)
 
-let build_branches_type env (mind,_ as _ind) mib mip u params dep p =
+let build_branches_type env sigma (mind,_ as _ind) mib mip u params dep p =
   let rtbl = mip.mind_reloc_tbl in
   (* [build_one_branch i cty] construit le type de la ieme branche (commence
      a 0) et les lambda correspondant aux realargs *)
   let build_one_branch i cty =
     let typi = type_constructor mind mib u cty params in
-    let decl,indapp = Reductionops.splay_prod env Evd.empty typi in
+    let decl,indapp = Reductionops.splay_prod env sigma (EConstr.of_constr typi) in
+    let decl = List.map (on_snd EConstr.Unsafe.to_constr) decl in
+    let indapp = EConstr.Unsafe.to_constr indapp in
     let decl_with_letin,_ = decompose_prod_assum typi in
     let ((ind,u),cargs) = find_rectype_a env indapp in
     let nparams = Array.length params in
@@ -128,28 +137,27 @@ let build_case_type dep p realargs c =
 
 (* La fonction de normalisation *)
 
-let rec nf_val env v t = nf_whd env (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 v =  nf_val env v crazy_type
+and nf_vtype env sigma v =  nf_val env sigma v crazy_type
 
-and nf_whd env whd typ =
+and nf_whd env sigma whd typ =
   match whd with
-  | Vsort s -> mkSort s
   | Vprod p ->
-      let dom = nf_vtype env (dom p) in
+      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 codom = nf_vtype (push_rel (LocalAssum (name,dom)) env) vc  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 f typ
-  | Vfix(f,None) -> nf_fix env f
-  | Vfix(f,Some vargs) -> fst (nf_fix_app env f vargs)
-  | Vcofix(cf,_,None) -> nf_cofix env cf
+  | Vfun f -> nf_fun env sigma f typ
+  | Vfix(f,None) -> nf_fix env sigma f
+  | Vfix(f,Some vargs) -> fst (nf_fix_app env sigma f vargs)
+  | Vcofix(cf,_,None) -> nf_cofix env sigma cf
   | Vcofix(cf,_,Some vargs) ->
-      let cfd = nf_cofix env cf in
+      let cfd = nf_cofix env sigma cf in
       let i,(_,ta,_) = destCoFix cfd in
       let t = ta.(i) in
-      let _, args = nf_args env vargs t in
+      let _, args = nf_args env sigma vargs t in
       mkApp(cfd,args)
   | Vconstr_const n ->
     construct_of_constr_const env n typ
@@ -162,149 +170,176 @@ and nf_whd env whd typ =
 	  | _ -> assert false
         else (tag, 0) in
       let capp,ctyp = construct_of_constr_block env tag typ in
-      let args = nf_bargs env b ofs ctyp in
+      let args = nf_bargs env sigma b ofs ctyp in
       mkApp(capp,args)
   | Vatom_stk(Aid idkey, stk) ->
-      constr_type_of_idkey env idkey stk
+      constr_type_of_idkey env sigma idkey stk
   | Vatom_stk(Aind ((mi,i) as ind), stk) ->
      let mib = Environ.lookup_mind mi env in
      let nb_univs =
-       if mib.mind_polymorphic then Univ.UContext.size mib.mind_universes
-       else 0
+       Univ.AUContext.size (Declareops.inductive_polymorphic_context mib)
      in
      let mk u =
        let pind = (ind, u) in (mkIndU pind, type_of_ind env pind)
      in
-     nf_univ_args ~nb_univs mk env stk
-  | Vatom_stk(Atype u, stk) -> assert false
+     nf_univ_args ~nb_univs mk env sigma stk
+  | Vatom_stk(Asort s, stk) ->
+    assert (List.is_empty stk); mkSort s
   | Vuniv_level lvl ->
     assert false
 
-and nf_univ_args ~nb_univs mk env stk =
+and nf_univ_args ~nb_univs mk env sigma stk =
   let u =
     if Int.equal nb_univs 0 then Univ.Instance.empty
     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
   in
   let (t,ty) = mk u in
-  nf_stk ~from:nb_univs env t ty stk
-
-and constr_type_of_idkey env (idkey : Vars.id_key) stk =
+  nf_stk ~from:nb_univs env sigma t ty stk
+
+and nf_evar env sigma evk stk =
+  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
+  let concl = Evd.evar_concl evi in
+  if List.is_empty hyps then
+    nf_stk env sigma (mkEvar (evk, [||])) concl stk
+  else match stk with
+  | Zapp args :: stk ->
+    (** We assume that there is no consecutive Zapp nodes in a VM stack. Is that
+        really an invariant? *)
+    (** Let-bound arguments are present in the evar arguments but not in the
+        type, so we turn the let into a product. *)
+    let drop_body = function
+    | NamedDecl.LocalAssum _ as d -> d
+    | NamedDecl.LocalDef (na, _, t) -> NamedDecl.LocalAssum (na, t)
+    in
+    let hyps = List.map drop_body hyps in
+    let fold accu d = Term.mkNamedProd_or_LetIn d accu in
+    let t = List.fold_left fold concl hyps in
+    let t, args = nf_args env sigma args t in
+    let inst, args = Array.chop (List.length hyps) args in
+    let c = mkApp (mkEvar (evk, inst), args) in
+    nf_stk env sigma c t stk
+  | _ ->
+    CErrors.anomaly (Pp.str "Argument size mismatch when decompiling an evar")
+
+and constr_type_of_idkey env sigma (idkey : Vmvalues.id_key) stk =
   match idkey with
   | ConstKey cst ->
      let cbody = Environ.lookup_constant cst env in
      let nb_univs =
-       if cbody.const_polymorphic then Univ.UContext.size cbody.const_universes
-       else 0
+       Univ.AUContext.size (Declareops.constant_polymorphic_context cbody)
      in
      let mk u =
        let pcst = (cst, u) in (mkConstU pcst, Typeops.type_of_constant_in env pcst)
      in
-     nf_univ_args ~nb_univs mk env stk
+     nf_univ_args ~nb_univs mk env sigma stk
    | VarKey id ->
-      let open Context.Named.Declaration in
-      let ty = get_type (lookup_named id env) in
-      nf_stk env (mkVar id) ty stk
+      let ty = NamedDecl.get_type (lookup_named id env) in
+      nf_stk env sigma (mkVar id) ty stk
   | RelKey i ->
       let n = (nb_rel env - i) in
-      let ty = get_type (lookup_rel n env) in
-      nf_stk env (mkRel n) (lift n ty) stk
+      let ty = RelDecl.get_type (lookup_rel n env) in
+      nf_stk env sigma (mkRel n) (lift n ty) stk
+  | EvarKey evk ->
+      nf_evar env sigma evk stk
 
-and nf_stk ?from:(from=0) env c t stk  =
+and nf_stk ?from:(from=0) env sigma c t stk  =
   match stk with
   | [] -> c
   | Zapp vargs :: stk ->
       if nargs vargs >= from then
-	let t, args = nf_args ~from:from env vargs t in
-	nf_stk env (mkApp(c,args)) t stk
+	let t, args = nf_args ~from:from env sigma vargs t in
+	nf_stk env sigma (mkApp(c,args)) t stk
       else
 	let rest = from - nargs vargs in
-	nf_stk ~from:rest env c t stk
+	nf_stk ~from:rest env sigma c t stk
   | Zfix (f,vargs) :: stk ->
       assert (from = 0) ;
-      let fa, typ = nf_fix_app env f vargs in
+      let fa, typ = nf_fix_app env sigma f vargs in
       let _,_,codom = decompose_prod env typ in
-      nf_stk env (mkApp(fa,[|c|])) (subst1 c codom) stk
+      nf_stk env sigma (mkApp(fa,[|c|])) (subst1 c codom) stk
   | Zswitch sw :: stk ->
       assert (from = 0) ;
       let ((mind,_ as ind), u), allargs = find_rectype_a env t in
       let (mib,mip) = Inductive.lookup_mind_specif env ind in
       let nparams = mib.mind_nparams in
       let params,realargs = Util.Array.chop nparams allargs in
+      let 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 (ind,u) mip params (type_of_switch sw) pT in
+      let dep, p = nf_predicate env sigma (ind,u) mip params (type_of_switch sw) pT in
       (* Calcul du type des branches *)
-      let btypes = build_branches_type env ind mib mip u params dep p in
+      let btypes = build_branches_type env sigma ind mib mip u params dep p in
       (* calcul des branches *)
       let bsw = branch_of_switch (nb_rel env) sw in
       let mkbranch i (n,v) =
 	let decl,decl_with_letin,codom = btypes.(i) in
-	let b = nf_val (Termops.push_rels_assum decl env) v codom in
+	let b = nf_val (Termops.push_rels_assum decl env) sigma v codom in
         Termops.it_mkLambda_or_LetIn_from_no_LetIn b decl_with_letin
       in
       let branchs = Array.mapi mkbranch bsw in
       let tcase = build_case_type dep p realargs c in
-      let ci = case_info sw in
-      nf_stk env (mkCase(ci, p, c, branchs)) tcase stk
+      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) ;
      let p' = Projection.make p true in
-     let ty = Inductiveops.type_of_projection_knowing_arg env Evd.empty p' c t in
-     nf_stk env (mkProj(p',c)) ty stk
+     let ty = Inductiveops.type_of_projection_knowing_arg env sigma p' (EConstr.of_constr c) (EConstr.of_constr t) in
+     nf_stk env sigma (mkProj(p',c)) ty stk
 
-and nf_predicate env ind mip params v pT =
-  match whd_val v, kind_of_term pT with
+and nf_predicate env sigma ind mip params v pT =
+  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) ind mip params vb codom in
+	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
       let params = if Int.equal n 0 then params else Array.map (lift n) params in
       let dom = mkApp(mkIndU ind,Array.append params rargs) in
-      let body = nf_vtype (push_rel (LocalAssum (name,dom)) env) vb in
+      let body = nf_vtype (push_rel (LocalAssum (name,dom)) env) sigma vb in
       true, mkLambda(name,dom,body)
-  | _, _ -> false, nf_val env v crazy_type
+  | _, _ -> false, nf_val env sigma v crazy_type
 
-and nf_args env vargs ?from:(f=0) t =
+and nf_args env sigma vargs ?from:(f=0) t =
   let t = ref t in
   let len = nargs vargs - f in
   let args =
     Array.init len
       (fun i ->
 	let _,dom,codom = decompose_prod env !t in
-	let c = nf_val env (arg vargs (f+i)) dom in
+	let c = nf_val env sigma (arg vargs (f+i)) dom in
 	t := subst1 c codom; c) in
   !t,args
 
-and nf_bargs env b ofs t =
+and nf_bargs env sigma b ofs t =
   let t = ref t in
   let len = bsize b - ofs in
   let args =
     Array.init len
       (fun i ->
 	let _,dom,codom = decompose_prod env !t in
-	let c = nf_val env (bfield b (i+ofs)) dom in
+	let c = nf_val env sigma (bfield b (i+ofs)) dom in
 	t := subst1 c codom; c) in
   args
 
-and nf_fun env f typ =
+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 ->
@@ -312,49 +347,54 @@ and nf_fun env f typ =
       CErrors.anomaly
         (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
   in
-  let body = nf_val (push_rel (LocalAssum (name,dom)) env) vb codom in
+  let body = nf_val (push_rel (LocalAssum (name,dom)) env) sigma vb codom in
   mkLambda(name,dom,body)
 
-and nf_fix env f =
+and nf_fix env sigma f =
   let init = current_fix f in
   let rec_args = rec_args f in
   let k = nb_rel env in
   let vb, vt = reduce_fix k f in
   let ndef = Array.length vt in
-  let ft = Array.map (fun v -> nf_val env v crazy_type) vt in
+  let ft = Array.map (fun v -> nf_val env sigma v crazy_type) vt in
   let name = Array.init ndef (fun _ -> (Name (Id.of_string "Ffix"))) in
   (* Third argument of the tuple is ignored by push_rec_types *)
   let env = push_rec_types (name,ft,ft) env in
   (* We lift here because the types of arguments (in tt) will be evaluated
      in an environment where the fixpoints have been pushed *)
-  let norm_vb v t = nf_fun env v (lift ndef t) in
+  let norm_vb v t = nf_fun env sigma v (lift ndef t) in
   let fb = Util.Array.map2 norm_vb vb ft in
   mkFix ((rec_args,init),(name,ft,fb))
 
-and nf_fix_app env f vargs =
-  let fd = nf_fix env f in
+and nf_fix_app env sigma f vargs =
+  let fd = nf_fix env sigma f in
   let (_,i),(_,ta,_) = destFix fd in
   let t = ta.(i) in
-  let t, args = nf_args env vargs t in
+  let t, args = nf_args env sigma vargs t in
   mkApp(fd,args),t
 
-and nf_cofix env cf =
+and nf_cofix env sigma cf =
   let init = current_cofix cf in
   let k = nb_rel env in
   let vb,vt = reduce_cofix k cf in
   let ndef = Array.length vt in
-  let cft = Array.map (fun v -> nf_val env v crazy_type) vt in
+  let cft = Array.map (fun v -> nf_val env sigma v crazy_type) vt in
   let name = Array.init ndef (fun _ -> (Name (Id.of_string "Fcofix"))) in
   let env = push_rec_types (name,cft,cft) env in
-  let cfb = Util.Array.map2 (fun v t -> nf_val env v t) vb cft in
+  let cfb = Util.Array.map2 (fun v t -> nf_val env sigma v t) vb cft in
   mkCoFix (init,(name,cft,cfb))
 
-let cbv_vm env c t  =
+let cbv_vm env sigma c t  =
+  if Termops.occur_meta sigma c then
+    CErrors.user_err Pp.(str "vm_compute does not support metas.");
+  (** This evar-normalizes terms beforehand *)
+  let c = EConstr.to_constr sigma c in
+  let t = EConstr.to_constr sigma t in
   let v = Vconv.val_of_constr env c in
-  nf_val env v t
+  EConstr.of_constr (nf_val env sigma v t)
 
 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/pretyping/vnorm.mli b/pretyping/vnorm.mli
index 58f5b14e..3e0eabb0 100644
--- a/pretyping/vnorm.mli
+++ b/pretyping/vnorm.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open Environ
 
 (** {6 Reduction functions } *)
-val cbv_vm : env -> constr -> types -> constr
+val cbv_vm : env -> Evd.evar_map -> constr -> types -> constr
diff --git a/printing/genprint.ml b/printing/genprint.ml
index 0ec35e07..1bb7838a 100644
--- a/printing/genprint.ml
+++ b/printing/genprint.ml
@@ -1,31 +1,128 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open Genarg
+open Geninterp
 
-type ('raw, 'glb, 'top) printer = {
-  raw : 'raw -> std_ppcmds;
-  glb : 'glb -> std_ppcmds;
-  top : 'top -> std_ppcmds;
+(* 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_result;
+  glb : 'glb -> printer_result;
+  top : 'top -> top_printer_result;
 }
 
 module PrintObj =
 struct
-  type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) printer
+  type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) genprinter
   let name = "printer"
   let default wit = match wit with
   | ExtraArg tag ->
     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
@@ -35,6 +132,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 6e6626f2..fd5dd725 100644
--- a/printing/genprint.mli
+++ b/printing/genprint.mli
@@ -1,28 +1,54 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Entry point for generic printers *)
 
-open Pp
 open Genarg
 
-val raw_print : ('raw, 'glb, 'top) genarg_type -> 'raw -> std_ppcmds
+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
+
+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 -> std_ppcmds
+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 -> std_ppcmds
+val top_print : ('raw, 'glb, 'top) genarg_type -> 'top top_printer
 (** Printer for top level generic arguments. *)
 
-val generic_raw_print : rlevel generic_argument -> std_ppcmds
-val generic_glb_print : glevel generic_argument -> std_ppcmds
-val generic_top_print : tlevel generic_argument -> std_ppcmds
-
 val register_print0 : ('raw, 'glb, 'top) genarg_type ->
-  ('raw -> std_ppcmds) -> ('glb -> std_ppcmds) -> ('top -> std_ppcmds) -> unit
+  '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 top_printer
+val generic_val_print : Geninterp.Val.t top_printer
diff --git a/printing/miscprint.ml b/printing/miscprint.ml
deleted file mode 100644
index 7b2c5695..00000000
--- a/printing/miscprint.ml
+++ /dev/null
@@ -1,49 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Misctypes
-open Pp
-
-(** Printing of [intro_pattern] *)
-
-let rec pr_intro_pattern prc (_,pat) = match pat with
-  | IntroForthcoming true -> str "*"
-  | IntroForthcoming false -> str "**"
-  | IntroNaming p -> pr_intro_pattern_naming p
-  | 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
-  | IntroAnonymous -> str "?"
-
-and pr_intro_pattern_action prc = function
-  | IntroWildcard -> str "_"
-  | IntroOrAndPattern pll -> pr_or_and_intro_pattern prc pll
-  | IntroInjection pl ->
-      str "[=" ++ hv 0 (prlist_with_sep spc (pr_intro_pattern prc) pl) ++
-      str "]"
-  | IntroApplyOn (c,pat) -> pr_intro_pattern prc pat ++ str "%" ++ prc c
-  | IntroRewrite true -> str "->"
-  | IntroRewrite false -> str "<-"
-
-and pr_or_and_intro_pattern prc = function
-  | IntroAndPattern pl ->
-      str "(" ++ hv 0 (prlist_with_sep pr_comma (pr_intro_pattern prc) pl) ++ str ")"
-  | IntroOrPattern pll ->
-      str "[" ++
-      hv 0 (prlist_with_sep pr_bar (prlist_with_sep spc (pr_intro_pattern prc)) pll)
-      ++ str "]"
-
-(** Printing of [move_location] *)
-
-let pr_move_location pr_id = function
-  | MoveAfter id -> brk(1,1) ++ str "after " ++ pr_id id
-  | MoveBefore id -> brk(1,1) ++ str "before " ++ pr_id id
-  | MoveFirst -> str " at top"
-  | MoveLast -> str " at bottom"
diff --git a/printing/miscprint.mli b/printing/miscprint.mli
deleted file mode 100644
index fe8c779f..00000000
--- a/printing/miscprint.mli
+++ /dev/null
@@ -1,24 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Misctypes
-
-(** Printing of [intro_pattern] *)
-
-val pr_intro_pattern :
-  ('a -> Pp.std_ppcmds) -> 'a intro_pattern_expr Loc.located -> Pp.std_ppcmds
-
-val pr_or_and_intro_pattern :
-  ('a -> Pp.std_ppcmds) -> 'a or_and_intro_pattern_expr -> Pp.std_ppcmds
-
-val pr_intro_pattern_naming : intro_pattern_naming_expr -> Pp.std_ppcmds
-
-(** Printing of [move_location] *)
-
-val pr_move_location :
-  ('a -> Pp.std_ppcmds) -> 'a move_location -> Pp.std_ppcmds
diff --git a/printing/ppannotation.ml b/printing/ppannotation.ml
deleted file mode 100644
index 511f9356..00000000
--- a/printing/ppannotation.ml
+++ /dev/null
@@ -1,39 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Ppextend
-open Constrexpr
-open Vernacexpr
-open Tacexpr
-
-type t =
-  | AKeyword
-  | AUnparsing            of unparsing
-  | AConstrExpr           of constr_expr
-  | AVernac               of vernac_expr
-  | AGlobTacticExpr       of glob_tactic_expr
-  | AGlobAtomicTacticExpr of glob_atomic_tactic_expr
-  | ARawTacticExpr        of raw_tactic_expr
-  | ARawAtomicTacticExpr  of raw_atomic_tactic_expr
-  | AAtomicTacticExpr     of atomic_tactic_expr
-
-let tag_of_annotation = function
-  | AKeyword                -> "keyword"
-  | AUnparsing _            -> "unparsing"
-  | AConstrExpr _           -> "constr_expr"
-  | AVernac _               -> "vernac_expr"
-  | AGlobTacticExpr _       -> "glob_tactic_expr"
-  | AGlobAtomicTacticExpr _ -> "glob_atomic_tactic_expr"
-  | ARawTacticExpr _        -> "raw_tactic_expr"
-  | ARawAtomicTacticExpr _  -> "raw_atomic_tactic_expr"
-  | AAtomicTacticExpr _     -> "atomic_tactic_expr"
-
-let attributes_of_annotation a =
-  []
-
-let tag = Pp.Tag.create "ppannotation"
diff --git a/printing/ppannotation.mli b/printing/ppannotation.mli
deleted file mode 100644
index a0fef1a7..00000000
--- a/printing/ppannotation.mli
+++ /dev/null
@@ -1,32 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** This module defines the annotations that are attached to
-    semi-structured pretty-printing of Coq syntactic objects. *)
-
-open Ppextend
-open Constrexpr
-open Vernacexpr
-open Tacexpr
-
-type t =
-  | AKeyword
-  | AUnparsing            of unparsing
-  | AConstrExpr           of constr_expr
-  | AVernac               of vernac_expr
-  | AGlobTacticExpr       of glob_tactic_expr
-  | AGlobAtomicTacticExpr of glob_atomic_tactic_expr
-  | ARawTacticExpr        of raw_tactic_expr
-  | ARawAtomicTacticExpr  of raw_atomic_tactic_expr
-  | AAtomicTacticExpr     of atomic_tactic_expr
-
-val tag_of_annotation : t -> string
-
-val attributes_of_annotation : t -> (string * string) list
-
-val tag : t Pp.Tag.key
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index aa94fb7b..4c5d955c 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -1,38 +1,55 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
 open CErrors
 open Util
 open Pp
+open CAst
 open Names
 open Nameops
 open Libnames
 open Pputils
 open Ppextend
+open Notation_term
 open Constrexpr
 open Constrexpr_ops
 open Decl_kinds
 open Misctypes
 (*i*)
 
-module Make (Taggers : sig
-  val tag_keyword     : std_ppcmds -> std_ppcmds
-  val tag_evar     : std_ppcmds -> std_ppcmds
-  val tag_type     : std_ppcmds -> std_ppcmds
-  val tag_path     : std_ppcmds -> std_ppcmds
-  val tag_ref     : std_ppcmds -> std_ppcmds
-  val tag_var     : std_ppcmds -> std_ppcmds
-  val tag_constr_expr : constr_expr -> std_ppcmds -> std_ppcmds
-  val tag_unparsing   : unparsing -> std_ppcmds -> std_ppcmds
-end) = struct
+module Tag =
+struct
+  let keyword   = "constr.keyword"
+  let evar      = "constr.evar"
+  let univ      = "constr.type"
+  let notation  = "constr.notation"
+  let variable  = "constr.variable"
+  let reference = "constr.reference"
+  let path      = "constr.path"
+
+end
+
+let do_not_tag _ x = x
+let tag t s = Pp.tag t s
+let tag_keyword     = tag Tag.keyword
+let tag_evar        = tag Tag.evar
+let tag_type        = tag Tag.univ
+let tag_unparsing   = function
+| UnpTerminal s -> tag Tag.notation
+| _ -> do_not_tag ()
+let tag_constr_expr = do_not_tag
+let tag_path = tag Tag.path
+let tag_ref = tag Tag.reference
+let tag_var = tag Tag.variable
 
-  open Taggers
 
   let keyword s = tag_keyword (str s)
   let sep_v = fun _ -> str"," ++ spc()
@@ -67,13 +84,13 @@ end) = struct
         | Any -> true
 
   let prec_of_prim_token = function
-    | Numeral p -> if Bigint.is_pos_or_zero p then lposint else lnegint
+    | Numeral (_,b) -> if b then lposint else lnegint
     | String _ -> latom
 
   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:
@@ -88,6 +105,11 @@ end) = struct
         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
@@ -103,7 +125,7 @@ end) = struct
         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 ->
@@ -113,9 +135,9 @@ end) = struct
     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)
@@ -129,17 +151,22 @@ end) = struct
     str "`" ++ str hd ++ c ++ str tl
 
   let pr_com_at n =
-    if !Flags.beautify && not (Int.equal n 0) then comment (CLexer.extract_comments n)
+    if !Flags.beautify && not (Int.equal n 0) then comment (Pputils.extract_comments n)
     else mt()
 
-  let pr_with_comments loc pp = pr_located (fun x -> x) (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 (constr_loc c) (sep() ++ f c)
+  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] -> str x
-      | l -> str"max(" ++ prlist_with_sep (fun () -> str",") (fun x -> str (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 "}"
 
@@ -152,22 +179,23 @@ end) = struct
   let pr_glob_level = function
     | GProp -> tag_type (str "Prop")
     | GSet -> tag_type (str "Set")
-    | GType None -> tag_type (str "Type")
-    | GType (Some (_, u)) -> tag_type (str u)
+    | 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
 
@@ -178,15 +206,16 @@ end) = struct
       tag_type (str "Set")
     | GType u ->
       (match u with
-        | Some (_,u) -> str 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
 
-  let pr_reference = function
-  | Qualid (_, qid) -> pr_qualid qid
-  | Ident (_, id) -> tag_var (pr_id id)
+  let pr_reference = CAst.with_val (function
+  | Qualid qid -> pr_qualid qid
+  | Ident id -> tag_var (pr_id id))
 
   let pr_cref ref us =
     pr_reference ref ++ pr_universe_instance us
@@ -194,36 +223,31 @@ end) = struct
   let pr_expl_args pr (a,expl) =
     match expl with
       | None -> pr (lapp,L) a
-      | Some (_,ExplByPos (n,_id)) ->
-        anomaly (Pp.str "Explicitation by position not implemented")
-      | Some (_,ExplByName id) ->
+      | Some {v=ExplByPos (n,_id)} ->
+        anomaly (Pp.str "Explicitation by position not implemented.")
+      | Some {v=ExplByName id} ->
         str "(" ++ pr_id id ++ str ":=" ++ pr ltop a ++ str ")"
 
-  let pr_opt_type pr = function
-    | CHole (_,_,Misctypes.IntroAnonymous,_) -> mt ()
-    | t -> cut () ++ str ":" ++ pr t
-
   let pr_opt_type_spc pr = function
-    | CHole (_,_,Misctypes.IntroAnonymous,_) -> mt ()
+    | { CAst.v = CHole (_,Misctypes.IntroAnonymous,_) } -> mt ()
     | t ->  str " :" ++ pr_sep_com (fun()->brk(1,2)) (pr ltop) t
 
-  let pr_lident (loc,id) =
-    if not (Loc.is_ghost loc) then
-      let (b,_) = Loc.unloc loc in
-      pr_located pr_id (Loc.make_loc (b,b + String.length (Id.to_string id)), id)
-    else
-      pr_id 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 (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 pr_name 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 -> str (Bigint.to_string n)
+    | Numeral (n,s) -> str (if s then n else "-"^n)
     | String s -> qs s
 
   let pr_evar pr id l =
@@ -240,73 +264,74 @@ end) = struct
   let lpatrec = 0
 
   let rec pr_patt sep inh p =
-    let (strm,prec) = match p with
-      | CPatRecord (_, l) ->
+    let (strm,prec) = match CAst.(p.v) with
+      | CPatRecord l ->
         let pp (c, p) =
           pr_reference c ++ spc() ++ str ":=" ++ pr_patt spc (lpatrec, Any) p
         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, []) ->
+      | CPatCstr (c, None, []) ->
         pr_reference c, latom
 
-      | CPatCstr (_, c, None, args) ->
+      | CPatCstr (c, None, args) ->
         pr_reference c ++ prlist (pr_patt spc (lapp,L)) args, lapp
 
-      | CPatCstr (_, c, Some args, []) ->
+      | CPatCstr (c, Some args, []) ->
         str "@" ++ pr_reference c ++ prlist (pr_patt spc (lapp,L)) args, lapp
 
-      | CPatCstr (_, c, Some expl_args, extra_args) ->
+      | CPatCstr (c, Some expl_args, extra_args) ->
         surround (str "@" ++ pr_reference c ++ prlist (pr_patt spc (lapp,L)) expl_args)
         ++ prlist (pr_patt spc (lapp,L)) extra_args, lapp
 
-      | CPatAtom (_, None) ->
+      | CPatAtom (None) ->
         str "_", latom
 
-      | CPatAtom (_,Some r) ->
+      | CPatAtom (Some r) ->
         pr_reference r, latom
 
-      | CPatOr (_,pl) ->
-        hov 0 (prlist_with_sep pr_bar (pr_patt spc (lpator,L)) pl), lpator
+      | CPatOr pl ->
+        hov 0 (prlist_with_sep pr_spcbar (pr_patt mt (lpator,L)) pl), lpator
 
-      | CPatNotation (_,"( _ )",([p],[]),[]) ->
+      | 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
+      | CPatNotation (s,(l,ll),args) ->
+        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
 
-      | CPatPrim (_,p) ->
+      | CPatPrim p ->
         pr_prim_token p, latom
 
-      | CPatDelimiters (_,k,p) ->
+      | CPatDelimiters (k,p) ->
         pr_delimiters k (pr_patt mt lsimplepatt p), 1
       | CPatCast _ ->
         assert false
     in
-    let loc = cases_pattern_expr_loc p in
-    pr_with_comments loc
+    let loc = p.CAst.loc in
+    pr_with_comments ?loc
       (sep() ++ if prec_less prec inh then strm else surround strm)
 
   let pr_patt = pr_patt mt
 
-  let pr_eqn pr (loc,pl,rhs) =
-    let pl = List.map snd pl in
+  let pr_eqn pr {loc;v=(pl,rhs)} =
     spc() ++ hov 4
-      (pr_with_comments loc
+      (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 = function
-  LocalRawDef((loc,_),_) -> fst (Loc.unloc loc)
-    | LocalRawAssum((loc,_)::_,_,_) -> fst (Loc.unloc loc)
-    | LocalPattern(loc,_,_) -> fst (Loc.unloc loc)
+  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
     | _ -> assert false
 
   let begin_of_binders = function
@@ -328,18 +353,18 @@ end) = struct
       | 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
       | Default b ->
         match t with
-          | CHole (_,_,Misctypes.IntroAnonymous,_) ->
+          | { CAst.v = CHole (_,Misctypes.IntroAnonymous,_) } ->
             let s = prlist_with_sep spc pr_lname nal in
             hov 1 (surround_implicit b s)
           | _ ->
@@ -347,15 +372,13 @@ end) = struct
             hov 1 (if many then surround_impl b s else surround_implicit b s)
 
   let pr_binder_among_many pr_c = function
-    | LocalRawAssum (nal,k,t) ->
+    | CLocalAssum (nal,k,t) ->
       pr_binder true pr_c (nal,k,t)
-    | LocalRawDef (na,c) ->
-      let c,topt = match c with
-        | CCast(_,c, (CastConv t|CastVM t|CastNative t)) -> c, t
-        | _ -> c, CHole (Loc.ghost, None, Misctypes.IntroAnonymous, None) in
-      surround (pr_lname na ++ pr_opt_type pr_c topt ++
-                  str":=" ++ cut() ++ pr_c c)
-    | LocalPattern (loc,p,tyo) ->
+    | CLocalDef (na,c,topt) ->
+      surround (pr_lname na ++
+                pr_opt_no_spc (fun t -> str " :" ++ ws 1 ++ pr_c t) topt ++
+                str" :=" ++ spc() ++ pr_c c)
+    | CLocalPattern {CAst.loc; v = p,tyo} ->
       let p = pr_patt lsimplepatt p in
       match tyo with
         | None ->
@@ -369,80 +392,20 @@ end) = struct
   let pr_delimited_binders kw sep pr_c bl =
     let n = begin_of_binders bl in
     match bl with
-      | [LocalRawAssum (nal,k,t)] ->
+      | [CLocalAssum (nal,k,t)] ->
         kw n ++ pr_binder false pr_c (nal,k,t)
-      | (LocalRawAssum _ | LocalPattern _) :: _ 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 = function
-  (*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_prod_binders c in
-      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
-    | CProdN (loc,[],c) ->
-      extract_prod_binders c
-    | CProdN (loc,[[_,Name id],bk,t],
-              CCases (_,LetPatternStyle,None, [CRef (Ident (_,id'),None),None,None],[(_,[_,[p]],b)]))
-         when Id.equal id id' && not (Id.Set.mem id (Topconstr.free_vars_of_constr_expr b)) ->
-      let bl,c = extract_prod_binders b in
-      LocalPattern (loc,p,None) :: bl, c
-    | CProdN (loc,(nal,bk,t)::bl,c) ->
-      let bl,c = extract_prod_binders (CProdN(loc,bl,c)) in
-      LocalRawAssum (nal,bk,t) :: bl, c
-    | c -> [], c
-
-  let rec extract_lam_binders = function
-  (*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_lam_binders c in
-      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
-    | CLambdaN (loc,[],c) ->
-      extract_lam_binders c
-    | CLambdaN (loc,[[_,Name id],bk,t],
-                CCases (_,LetPatternStyle,None, [CRef (Ident (_,id'),None),None,None],[(_,[_,[p]],b)]))
-         when Id.equal id id' && not (Id.Set.mem id (Topconstr.free_vars_of_constr_expr b)) ->
-      let bl,c = extract_lam_binders b in
-      LocalPattern (loc,p,None) :: bl, c
-    | CLambdaN (loc,(nal,bk,t)::bl,c) ->
-      let bl,c = extract_lam_binders (CLambdaN(loc,bl,c)) in
-      LocalRawAssum (nal,bk,t) :: bl, c
-    | c -> [], c
-
-  let split_lambda = function
-    | CLambdaN (loc,[[na],bk,t],c) -> (na,t,c)
-    | CLambdaN (loc,([na],bk,t)::bl,c) -> (na,t,CLambdaN(loc,bl,c))
-    | CLambdaN (loc,(na::nal,bk,t)::bl,c) -> (na,t,CLambdaN(loc,(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' = function
-    | CProdN (loc,[[na],bk,t],c) -> rename na na' t c
-    | CProdN (loc,([na],bk,t)::bl,c) -> rename na na' t (CProdN(loc,bl,c))
-    | CProdN (loc,(na::nal,bk,t)::bl,c) ->
-      rename na na' t (CProdN(loc,(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
-      (LocalRawAssum ([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
-    pr_id id ++ str" " ++
+    pr_id id ++ (if bl = [] then mt () else str" ") ++
       hov 0 (pr_undelimited_binders spc (pr ltop) bl ++ annot) ++
       pr_opt_type_spc pr t ++ str " :=" ++
       pr_sep_com (fun () -> brk(1,2)) (pr_body ltop) c
@@ -450,13 +413,13 @@ end) = struct
   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
-              | LocalRawAssum (nal,_,_) -> nal
-              | LocalRawDef (_,_) -> []
-              | LocalPattern _ -> assert false
+              | CLocalAssum (nal,_,_) -> nal
+              | CLocalDef (_,_,_) -> []
+              | CLocalPattern _ -> assert false
             in let ids = List.flatten (List.map names_of_binder bl) in
                if List.length ids > 1 then
                  spc() ++ str "{" ++ keyword "struct" ++ spc () ++ pr_id id ++ str"}"
@@ -467,15 +430,15 @@ end) = struct
             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
-    | [] -> anomaly (Pp.str "(co)fixpoint with no definition")
+    | [] -> anomaly (Pp.str "(co)fixpoint with no definition.")
     | [d1] -> pr_decl false d1
     | dl ->
       prlist_with_sep (fun () -> fnl() ++ keyword "with" ++ spc ())
@@ -495,13 +458,13 @@ end) = struct
 
   let pr_case_type pr po =
     match po with
-      | None | Some (CHole (_,_,Misctypes.IntroAnonymous,_)) -> mt()
+      | None | Some { CAst.v = CHole (_,Misctypes.IntroAnonymous,_) } -> mt()
       | Some p ->
         spc() ++ hov 2 (keyword "return" ++ pr_sep_com spc (pr lsimpleconstr) p)
 
   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
@@ -532,33 +495,32 @@ end) = struct
   let pr_fun_sep = spc () ++ str "=>"
 
   let pr_dangling_with_for sep pr inherited a =
-    match a with
-      | (CFix (_,_,[_])|CCoFix(_,_,[_])) ->
+    match a.v with
+      | (CFix (_,[_])|CCoFix(_,[_])) ->
         pr sep (latom,E) a
       | _ ->
         pr sep inherited a
 
   let pr pr sep inherited a =
     let return (cmds, prec) = (tag_constr_expr a cmds, prec) in
-    let (strm, prec) = match a with
+    let (strm, prec) = match CAst.(a.v) with
       | CRef (r, us) ->
         return (pr_cref r us, latom)
-      | CFix (_,id,fix) ->
+      | CFix (id,fix) ->
         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) ->
+      | 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
@@ -566,8 +528,7 @@ end) = struct
               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
@@ -575,7 +536,8 @@ end) = struct
               pr_fun_sep ++ pr spc ltop a),
           llambda
         )
-      | CLetIn (_,(_,Name x),(CFix(_,(_,x'),[_])|CCoFix(_,(_,x'),[_]) as fx), 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 (
@@ -585,16 +547,17 @@ end) = struct
               pr spc ltop b),
           lletin
         )
-      | CLetIn (_,x,a,b) ->
+      | CLetIn (x,a,t,b) ->
         return (
           hv 0 (
-            hov 2 (keyword "let" ++ spc () ++ pr_lname x ++ str " :="
-                   ++ pr spc ltop a ++ spc ()
+            hov 2 (keyword "let" ++ spc () ++ pr_lname x
+                   ++ pr_opt_no_spc (fun t -> str " :" ++ ws 1 ++ pr mt ltop t) t
+                   ++ str " :=" ++ pr spc ltop a ++ spc ()
                    ++ keyword "in") ++
               pr spc ltop b),
           lletin
         )
-      | CAppExpl (_,(Some i,f,us),l) ->
+      | CAppExpl ((Some i,f,us),l) ->
         let l1,l2 = List.chop i l in
         let c,l1 = List.sep_last l1 in
         let p = pr_proj (pr mt) pr_appexpl c (f,us) l1 in
@@ -602,16 +565,16 @@ end) = struct
           return (p ++ prlist (pr spc (lapp,L)) l2, lapp)
         else
           return (p, lproj)
-      | CAppExpl (_,(None,Ident (_,var),us),[t])
-      | CApp (_,(_,CRef(Ident(_,var),us)),[t,None])
+      | CAppExpl ((None,{v=Ident var},us),[t])
+      | CApp ((_, {v = CRef({v=Ident var},us)}),[t,None])
           when Id.equal var Notation_ops.ldots_var ->
         return (
           hov 0 (str ".." ++ pr spc (latom,E) t ++ spc () ++ str ".."),
           larg
         )
-      | CAppExpl (_,(None,f,us),l) ->
+      | CAppExpl ((None,f,us),l) ->
         return (pr_appexpl (pr mt) (f,us) l, lapp)
-      | CApp (_,(Some i,f),l) ->
+      | CApp ((Some i,f),l) ->
         let l1,l2 = List.chop i l in
         let c,l1 = List.sep_last l1 in
         assert (Option.is_empty (snd c));
@@ -623,14 +586,14 @@ end) = struct
           )
         else
           return (p, lproj)
-      | CApp (_,(None,a),l) ->
+      | CApp ((None,a),l) ->
         return (pr_app (pr mt) a l, lapp)
-      | CRecord (_,l) ->
+      | CRecord l ->
         return (
           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"'" ++
@@ -641,7 +604,7 @@ end) = struct
                        spc () ++ keyword "in" ++ pr spc ltop b)),
           lletpattern
         )
-      | CCases(_,_,rtntypopt,c,eqns) ->
+      | CCases(_,rtntypopt,c,eqns) ->
         return (
           v 0
             (hv 0 (keyword "match" ++ brk (1,2) ++
@@ -654,7 +617,7 @@ end) = struct
              ++ keyword "end"),
           latom
         )
-      | CLetTuple (_,nal,(na,po),c,b) ->
+      | CLetTuple (nal,(na,po),c,b) ->
         return (
           hv 0 (
             hov 2 (keyword "let" ++ spc () ++
@@ -667,7 +630,7 @@ end) = struct
               pr spc ltop b),
           lletin
         )
-      | CIf (_,c,(na,po),b1,b2) ->
+      | CIf (c,(na,po),b1,b2) ->
       (* On force les parenthèses autour d'un "if" sous-terme (même si le
          parsing est lui plus tolérant) *)
         return (
@@ -681,19 +644,19 @@ end) = struct
         lif
         )
 
-      | CHole (_,_,Misctypes.IntroIdentifier id,_) ->
+      | CHole (_,Misctypes.IntroIdentifier id,_) ->
         return (str "?[" ++ pr_id id ++ str "]", latom)
-      | CHole (_,_,Misctypes.IntroFresh id,_) ->
+      | CHole (_,Misctypes.IntroFresh id,_) ->
         return (str "?[?" ++ pr_id id ++ str "]", latom)
-      | CHole (_,_,_,_) ->
+      | CHole (_,_,_) ->
         return (str "_", latom)
-      | CEvar (_,n,l) ->
+      | CEvar (n,l) ->
         return (pr_evar (pr mt) n l, latom)
-      | CPatVar (_,p) ->
-        return (str "?" ++ pr_patvar p, latom)
-      | CSort (_,s) ->
+      | CPatVar p ->
+        return (str "@?" ++ pr_patvar p, latom)
+      | CSort s ->
         return (pr_glob_sort s, latom)
-      | CCast (_,a,b) ->
+      | CCast (a,b) ->
         return (
           hv 0 (pr mt (lcast,L) a ++ spc () ++
                   match b with
@@ -703,56 +666,65 @@ end) = struct
                     | 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
-      | CGeneralization (_,bk,ak,c) ->
+      | CNotation (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) ->
+      | CPrim p ->
         return (pr_prim_token p, prec_of_prim_token p)
-      | CDelimiters (_,sc,a) ->
+      | CDelimiters (sc,a) ->
         return (pr_delimiters sc (pr mt (ldelim,E) a), ldelim)
     in
     let loc = constr_loc a in
-    pr_with_comments loc
+    pr_with_comments ?loc
       (sep() ++ if prec_less prec inherited then strm else surround strm)
 
   type term_pr = {
-    pr_constr_expr   : constr_expr -> std_ppcmds;
-    pr_lconstr_expr  : constr_expr -> std_ppcmds;
-    pr_constr_pattern_expr  : constr_pattern_expr -> std_ppcmds;
-    pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds
+    pr_constr_expr   : constr_expr -> Pp.t;
+    pr_lconstr_expr  : constr_expr -> Pp.t;
+    pr_constr_pattern_expr  : constr_pattern_expr -> Pp.t;
+    pr_lconstr_pattern_expr : constr_pattern_expr -> Pp.t
   }
 
-  type precedence =  Ppextend.precedence * Ppextend.parenRelation
   let modular_constr_pr = pr
   let rec fix rf x = rf (fix rf) x
   let pr = fix modular_constr_pr mt
 
-  let transf env c =
+  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 sigma c =
     if !Flags.beautify_file then
-      let r = Constrintern.for_grammar (Constrintern.intern_constr env) c in
+      let r = Constrintern.for_grammar (Constrintern.intern_constr env sigma) 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 =
+    let env = Global.env () in
+    let sigma = Evd.from_env env in
+    pr prec (transf env sigma c)
 
-  let pr_simpleconstr = function
-    | 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
@@ -762,88 +734,5 @@ end) = struct
 
   let pr_record_body = pr_record_body_gen pr
 
-  let pr_binders = pr_undelimited_binders spc (pr ltop)
-
-end
-
-module Tag =
-struct
-  let keyword =
-    let style = Terminal.make ~bold:true () in
-    Ppstyle.make ~style ["constr"; "keyword"]
-
-  let evar =
-    let style = Terminal.make ~fg_color:`LIGHT_BLUE () in
-    Ppstyle.make ~style ["constr"; "evar"]
-
-  let univ =
-    let style = Terminal.make ~bold:true ~fg_color:`YELLOW () in
-    Ppstyle.make ~style ["constr"; "type"]
-
-  let notation =
-    let style = Terminal.make ~fg_color:`WHITE () in
-    Ppstyle.make ~style ["constr"; "notation"]
-
-  let variable =
-    Ppstyle.make ["constr"; "variable"]
-
-  let reference =
-    let style = Terminal.make ~fg_color:`LIGHT_GREEN () in
-    Ppstyle.make ~style ["constr"; "reference"]
-
-  let path =
-    let style = Terminal.make ~fg_color:`LIGHT_MAGENTA () in
-    Ppstyle.make ~style ["constr"; "path"]
-
-end
-
-let do_not_tag _ x = x
-
-let split_token tag s =
-  let len = String.length s in
-  let rec parse_string off i =
-    if Int.equal i len then
-      if Int.equal off i then mt () else tag (str (String.sub s off (i - off)))
-    else if s.[i] == ' ' then
-      if Int.equal off i then parse_space 1 (succ i)
-      else tag (str (String.sub s off (i - off))) ++ parse_space 1 (succ i)
-    else parse_string off (succ i)
-  and parse_space spc i =
-    if Int.equal i len then str (String.make spc ' ')
-    else if s.[i] == ' ' then parse_space (succ spc) (succ i)
-    else str (String.make spc ' ') ++ parse_string i (succ i)
-  in
-  parse_string 0 0
-
-(** Instantiating Make with tagging functions that only add style
-    information. *)
-include Make (struct
-    let tag t s = Pp.tag (Pp.Tag.inj t Ppstyle.tag) s
-    let tag_keyword     = tag Tag.keyword
-    let tag_evar        = tag Tag.evar
-    let tag_type        = tag Tag.univ
-    let tag_unparsing   = function
-    | UnpTerminal s -> fun _ -> split_token (fun pp -> tag Tag.notation pp) s
-    | _ -> do_not_tag ()
-    let tag_constr_expr = do_not_tag
-    let tag_path = tag Tag.path
-    let tag_ref = tag Tag.reference
-    let tag_var = tag Tag.variable
-end)
-
-module Richpp = struct
-
-  include Make (struct
-    open Ppannotation
-    let tag_keyword       = Pp.tag (Pp.Tag.inj AKeyword tag)
-    let tag_type          = Pp.tag (Pp.Tag.inj AKeyword tag)
-    let tag_evar          = do_not_tag ()
-    let tag_unparsing unp = Pp.tag (Pp.Tag.inj (AUnparsing unp) tag)
-    let tag_constr_expr e = Pp.tag (Pp.Tag.inj (AConstrExpr e) tag)
-    let tag_path = do_not_tag ()
-    let tag_ref = do_not_tag ()
-    let tag_var = do_not_tag ()
-  end)
-
-end
+  let pr_binders = pr_undelimited_binders spc (pr_expr ltop)
 
diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli
index 0241633c..1f1308b0 100644
--- a/printing/ppconstr.mli
+++ b/printing/ppconstr.mli
@@ -1,21 +1,89 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module implements pretty-printers for constr_expr syntactic
     objects and their subcomponents. *)
 
-(** The default pretty-printers produce {!Pp.std_ppcmds} that are
-    interpreted as raw strings. *)
-include Ppconstrsig.Pp
+(** The default pretty-printers produce pretty-printing commands ({!Pp.t}). *)
+open Libnames
+open Constrexpr
+open Names
+open Misctypes
+open Notation_term
 
-(** The rich pretty-printers produce {!Pp.std_ppcmds} that are
-    interpreted as annotated strings. The annotations can be
-    retrieved using {!RichPp.rich_pp}. Their definitions are
-    located in {!Ppannotation.t}. *)
+val prec_less : precedence -> tolerability -> bool
 
-module Richpp : Ppconstrsig.Pp
+val pr_tight_coma : unit -> Pp.t
+
+val pr_or_var : ('a -> Pp.t) -> 'a or_var -> 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
+val pr_sep_com :
+  (unit -> Pp.t) ->
+  (constr_expr -> Pp.t) ->
+  constr_expr -> Pp.t
+
+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
+
+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 ->
+  lident option * recursion_order_expr ->
+  Pp.t
+
+val pr_record_body : (reference * constr_expr) list -> Pp.t
+val pr_binders : local_binder_expr list -> Pp.t
+val pr_constr_pattern_expr : constr_pattern_expr -> Pp.t
+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;
+  pr_lconstr_expr  : constr_expr -> Pp.t;
+  pr_constr_pattern_expr  : constr_pattern_expr -> Pp.t;
+  pr_lconstr_pattern_expr : constr_pattern_expr -> Pp.t
+}
+
+val set_term_pr : term_pr -> unit
+val default_term_pr : term_pr
+
+(* The modular constr printer.
+  [modular_constr_pr pr s p t] prints the head of the term [t] and calls
+  [pr] on its subterms.
+  [s] is typically {!Pp.mt} and [p] is [lsimpleconstr] for "constr" printers
+  and [ltop] for "lconstr" printers (spiwack: we might need more
+  specification here).
+  We can make a new modular constr printer by overriding certain branches,
+  for instance if we want to build a printer which prints "Prop" as "Omega"
+  instead we can proceed as follows:
+  let my_modular_constr_pr pr s p = function
+  | CSort (_,GProp Null) -> str "Omega"
+  | t -> modular_constr_pr pr s p t
+  Which has the same type. We can turn a modular printer into a printer by
+  taking its fixpoint. *)
+
+val lsimpleconstr : tolerability
+val ltop : tolerability
+val modular_constr_pr :
+  ((unit->Pp.t) -> tolerability -> constr_expr -> Pp.t) ->
+  (unit->Pp.t) -> tolerability -> constr_expr -> Pp.t
diff --git a/printing/ppconstrsig.mli b/printing/ppconstrsig.mli
deleted file mode 100644
index 3de0d805..00000000
--- a/printing/ppconstrsig.mli
+++ /dev/null
@@ -1,95 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Loc
-open Pp
-open Libnames
-open Constrexpr
-open Names
-open Misctypes
-
-module type Pp = sig
-
-  val extract_lam_binders :
-    constr_expr -> local_binder list * constr_expr
-  val extract_prod_binders :
-    constr_expr -> local_binder list * constr_expr
-  val split_fix :
-    int -> constr_expr -> constr_expr ->
-    local_binder list *  constr_expr * constr_expr
-
-  val prec_less : int -> int * Ppextend.parenRelation -> bool
-
-  val pr_tight_coma : unit -> std_ppcmds
-
-  val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
-
-  val pr_lident : Id.t located -> std_ppcmds
-  val pr_lname : Name.t located -> std_ppcmds
-
-  val pr_with_comments : Loc.t -> std_ppcmds -> std_ppcmds
-  val pr_com_at : int -> std_ppcmds
-  val pr_sep_com :
-    (unit -> std_ppcmds) ->
-    (constr_expr -> std_ppcmds) ->
-    constr_expr -> std_ppcmds
-
-  val pr_id : Id.t -> std_ppcmds
-  val pr_name : Name.t -> std_ppcmds
-  val pr_qualid : qualid -> std_ppcmds
-  val pr_patvar : patvar -> std_ppcmds
-
-  val pr_glob_level : glob_level -> std_ppcmds
-  val pr_glob_sort : glob_sort -> std_ppcmds
-  val pr_guard_annot : (constr_expr -> std_ppcmds) ->
-    local_binder list ->
-    ('a * Names.Id.t) option * recursion_order_expr ->
-    std_ppcmds
-
-  val pr_record_body : (reference * constr_expr) list -> std_ppcmds
-  val pr_binders : local_binder list -> std_ppcmds
-  val pr_constr_pattern_expr : constr_pattern_expr -> std_ppcmds
-  val pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds
-  val pr_constr_expr : constr_expr -> std_ppcmds
-  val pr_lconstr_expr : constr_expr -> std_ppcmds
-  val pr_cases_pattern_expr : cases_pattern_expr -> std_ppcmds
-
-  type term_pr = {
-    pr_constr_expr   : constr_expr -> std_ppcmds;
-    pr_lconstr_expr  : constr_expr -> std_ppcmds;
-    pr_constr_pattern_expr  : constr_pattern_expr -> std_ppcmds;
-    pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds
-  }
-
-  val set_term_pr : term_pr -> unit
-  val default_term_pr : term_pr
-
-(** The modular constr printer.
-    [modular_constr_pr pr s p t] prints the head of the term [t] and calls
-    [pr] on its subterms.
-    [s] is typically {!Pp.mt} and [p] is [lsimpleconstr] for "constr" printers
-    and [ltop] for "lconstr" printers (spiwack: we might need more
-    specification here).
-    We can make a new modular constr printer by overriding certain branches,
-    for instance if we want to build a printer which prints "Prop" as "Omega"
-    instead we can proceed as follows:
-    let my_modular_constr_pr pr s p = function
-    | CSort (_,GProp Null) -> str "Omega"
-    | t -> modular_constr_pr pr s p t
-    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 modular_constr_pr :
-    ((unit->std_ppcmds) -> precedence -> constr_expr -> std_ppcmds) ->
-    (unit->std_ppcmds) -> precedence  -> constr_expr -> std_ppcmds
-
-end
-
diff --git a/printing/pptactic.mli b/printing/pptactic.mli
deleted file mode 100644
index 86e3ea54..00000000
--- a/printing/pptactic.mli
+++ /dev/null
@@ -1,67 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** This module implements pretty-printers for tactic_expr syntactic
-    objects and their subcomponents. *)
-
-open Pp
-open Genarg
-open Geninterp
-open Names
-open Constrexpr
-open Tacexpr
-open Ppextend
-
-type 'a grammar_tactic_prod_item_expr =
-| TacTerm of string
-| TacNonTerm of Loc.t * 'a * Names.Id.t
-
-type 'a raw_extra_genarg_printer =
-    (constr_expr -> std_ppcmds) ->
-    (constr_expr -> std_ppcmds) ->
-    (tolerability -> raw_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-type 'a glob_extra_genarg_printer =
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (glob_constr_and_expr -> std_ppcmds) ->
-    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-type 'a extra_genarg_printer =
-    (Term.constr -> std_ppcmds) ->
-    (Term.constr -> std_ppcmds) ->
-    (tolerability -> Val.t -> std_ppcmds) ->
-    'a -> std_ppcmds
-
-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
-
-type grammar_terminals = Genarg.ArgT.any Extend.user_symbol grammar_tactic_prod_item_expr list
-
-type pp_tactic = {
-  pptac_level : int;
-  pptac_prods : grammar_terminals;
-}
-
-val declare_notation_tactic_pprule : KerName.t -> pp_tactic -> unit
-
-(** The default pretty-printers produce {!Pp.std_ppcmds} that are
-    interpreted as raw strings. *)
-include Pptacticsig.Pp
-
-(** The rich pretty-printers produce {!Pp.std_ppcmds} that are
-    interpreted as annotated strings. The annotations can be
-    retrieved using {!RichPp.rich_pp}. Their definitions are
-    located in {!Ppannotation.t}. *)
-module Richpp : Pptacticsig.Pp
-
-val ltop : tolerability
diff --git a/printing/pptacticsig.mli b/printing/pptacticsig.mli
deleted file mode 100644
index 665e055f..00000000
--- a/printing/pptacticsig.mli
+++ /dev/null
@@ -1,83 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Genarg
-open Geninterp
-open Tacexpr
-open Ppextend
-open Environ
-open Misctypes
-
-module type Pp = sig
-
-  val pr_with_occurrences :
-    ('a -> std_ppcmds) -> 'a Locus.with_occurrences -> std_ppcmds
-  val pr_red_expr :
-    ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) * ('c -> std_ppcmds) ->
-    ('a,'b,'c) Genredexpr.red_expr_gen -> std_ppcmds
-  val pr_may_eval :
-    ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) ->
-    ('c -> std_ppcmds) -> ('a,'b,'c) Genredexpr.may_eval -> std_ppcmds
-
-  val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
-  val pr_and_short_name : ('a -> std_ppcmds) -> 'a and_short_name -> std_ppcmds
-  val pr_or_by_notation : ('a -> std_ppcmds) -> 'a or_by_notation -> std_ppcmds
-
-  val pr_in_clause :
-    ('a -> Pp.std_ppcmds) -> 'a Locus.clause_expr -> Pp.std_ppcmds
-
-  val pr_clauses :  bool option ->
-    ('a -> Pp.std_ppcmds) -> 'a Locus.clause_expr -> Pp.std_ppcmds
-
-  val pr_raw_generic : env -> rlevel generic_argument -> std_ppcmds
-
-  val pr_glb_generic : env -> glevel generic_argument -> std_ppcmds
-
-  val pr_raw_extend: env -> int ->
-    ml_tactic_entry -> raw_tactic_arg list -> std_ppcmds
-
-  val pr_glob_extend: env -> int ->
-    ml_tactic_entry -> glob_tactic_arg list -> std_ppcmds
-
-  val pr_extend :
-    (Val.t -> std_ppcmds) -> int -> ml_tactic_entry -> Val.t list -> std_ppcmds
-
-  val pr_alias_key : Names.KerName.t -> std_ppcmds
-
-  val pr_alias : (Val.t -> std_ppcmds) ->
-    int -> Names.KerName.t -> Val.t list -> std_ppcmds
-
-  val pr_alias_key : Names.KerName.t -> std_ppcmds
-
-  val pr_ltac_constant : Nametab.ltac_constant -> std_ppcmds
-
-  val pr_raw_tactic : raw_tactic_expr -> std_ppcmds
-
-  val pr_raw_tactic_level : tolerability -> raw_tactic_expr -> std_ppcmds
-
-  val pr_glob_tactic : env -> glob_tactic_expr -> std_ppcmds
-
-  val pr_atomic_tactic : env -> atomic_tactic_expr -> std_ppcmds
-
-  val pr_hintbases : string list option -> std_ppcmds
-
-  val pr_auto_using : ('constr -> std_ppcmds) -> 'constr list -> std_ppcmds
-
-  val pr_bindings :
-    ('constr -> std_ppcmds) ->
-    ('constr -> std_ppcmds) -> 'constr bindings -> std_ppcmds
-
-  val pr_match_pattern : ('a -> std_ppcmds) -> 'a match_pattern -> std_ppcmds
-
-  val pr_match_rule : bool -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) ->
-    ('b, 'a) match_rule -> std_ppcmds
-
-  val pr_value : tolerability -> Val.t -> std_ppcmds
-
-end
diff --git a/printing/pputils.ml b/printing/pputils.ml
index 50ce56fb..c14aa318 100644
--- a/printing/pputils.ml
+++ b/printing/pputils.ml
@@ -1,19 +1,177 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+open Util
 open Pp
+open Genarg
+open Misctypes
+open Locus
+open Genredexpr
+
+let beautify_comments = ref []
+
+let rec split_comments comacc acc pos = function
+  | [] -> beautify_comments := List.rev acc; comacc
+  | ((b,e),c as com)::coms ->
+      (* Take all comments that terminates before pos, or begin exactly
+         at pos (used to print comments attached after an expression) *)
+      if e<=pos || pos=b then split_comments (c::comacc) acc pos coms
+      else split_comments comacc (com::acc) pos coms
+
+let extract_comments pos = split_comments [] [] pos !beautify_comments
 
 let pr_located pr (loc, x) =
-  if !Flags.beautify && loc <> Loc.ghost then
+  match loc with
+  | Some loc when !Flags.beautify ->
     let (b, e) = Loc.unloc loc in
     (* Side-effect: order matters *)
-    let before = Pp.comment (CLexer.extract_comments b) in
+    let before = Pp.comment (extract_comments b) in
     let x = pr x in
-    let after = Pp.comment (CLexer.extract_comments e) in
+    let after = Pp.comment (extract_comments e) in
     before ++ x ++ after
-  else pr x
+  | _ -> 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 {CAst.v=s} -> Names.Id.print s
+
+let pr_with_occurrences pr keyword (occs,c) =
+  match occs with
+    | AllOccurrences ->
+      pr c
+    | NoOccurrences ->
+      failwith "pr_with_occurrences: no occurrences"
+    | OnlyOccurrences nl ->
+      hov 1 (pr c ++ spc () ++ keyword "at" ++ spc () ++
+                hov 0 (prlist_with_sep spc (pr_or_var int) nl))
+    | AllOccurrencesBut nl ->
+      hov 1 (pr c ++ spc () ++ keyword "at" ++ str" - " ++
+                hov 0 (prlist_with_sep spc (pr_or_var int) nl))
+
+exception ComplexRedFlag
+
+let pr_short_red_flag pr r =
+  if not r.rBeta ||  not r.rMatch || not r.rFix || not r.rCofix || not r.rZeta then
+    raise ComplexRedFlag
+  else if List.is_empty r.rConst then
+    if r.rDelta then mt () else raise ComplexRedFlag
+  else (if r.rDelta then str "-" else mt ()) ++
+          hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]")
+
+let pr_red_flag pr r =
+  try pr_short_red_flag pr r
+  with complexRedFlags ->
+    (if r.rBeta then pr_arg str "beta" else mt ()) ++
+      (if r.rMatch && r.rFix && r.rCofix then pr_arg str "iota" else
+          (if r.rMatch then pr_arg str "match" else mt ()) ++
+          (if r.rFix then pr_arg str "fix" else mt ()) ++
+          (if r.rCofix then pr_arg str "cofix" else mt ())) ++
+      (if r.rZeta then pr_arg str "zeta" else mt ()) ++
+      (if List.is_empty r.rConst then
+          if r.rDelta then pr_arg str "delta"
+          else mt ()
+        else
+          pr_arg str "delta " ++ (if r.rDelta then str "-" else mt ()) ++
+            hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]"))
+
+let pr_union pr1 pr2 = function
+  | Inl a -> pr1 a
+  | Inr b -> pr2 b
+
+let pr_red_expr (pr_constr,pr_lconstr,pr_ref,pr_pattern) keyword = function
+  | Red false -> keyword "red"
+  | Hnf -> keyword "hnf"
+  | Simpl (f,o) -> keyword "simpl" ++ (pr_short_red_flag pr_ref f)
+                    ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern) keyword) o
+  | Cbv f ->
+    if f.rBeta && f.rMatch && f.rFix && f.rCofix &&
+          f.rZeta && f.rDelta && List.is_empty f.rConst then
+      keyword "compute"
+    else
+      hov 1 (keyword "cbv" ++ pr_red_flag pr_ref f)
+  | Lazy f ->
+    hov 1 (keyword "lazy" ++ pr_red_flag pr_ref f)
+  | Cbn f ->
+    hov 1 (keyword "cbn" ++ pr_red_flag pr_ref f)
+  | Unfold l ->
+    hov 1 (keyword "unfold" ++ spc() ++
+              prlist_with_sep pr_comma (pr_with_occurrences pr_ref keyword) l)
+  | Fold l -> hov 1 (keyword "fold" ++ prlist (pr_arg pr_constr) l)
+  | Pattern l ->
+    hov 1 (keyword "pattern" ++
+              pr_arg (prlist_with_sep pr_comma (pr_with_occurrences pr_constr keyword)) l)
+
+  | Red true ->
+    CErrors.user_err Pp.(str "Shouldn't be accessible from user.")
+  | ExtraRedExpr s ->
+    str s
+  | CbvVm o ->
+    keyword "vm_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern) keyword) o
+  | CbvNative o ->
+    keyword "native_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern) keyword) o
+
+let pr_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
+  | {CAst.loc; v=AN v} -> f v
+  | {CAst.loc; v=ByNotation (s,sc)} -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
+
+let hov_if_not_empty n p = if Pp.ismt p then p else hov n p
+
+let rec pr_raw_generic env (GenArg (Rawwit wit, x)) =
+  match wit with
+    | ListArg wit ->
+      let map x = pr_raw_generic env (in_gen (rawwit wit) x) in
+      let ans = pr_sequence map x in
+      hov_if_not_empty 0 ans
+    | OptArg wit ->
+      let ans = match x with
+        | None -> mt ()
+        | Some x -> pr_raw_generic env (in_gen (rawwit wit) x)
+      in
+      hov_if_not_empty 0 ans
+    | PairArg (wit1, wit2) ->
+      let p, q = x in
+      let p = in_gen (rawwit wit1) p in
+      let q = in_gen (rawwit wit2) q in
+      hov_if_not_empty 0 (pr_sequence (pr_raw_generic env) [p; q])
+    | ExtraArg s ->
+       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)) =
+  match wit with
+    | ListArg wit ->
+      let map x = pr_glb_generic env (in_gen (glbwit wit) x) in
+      let ans = pr_sequence map x in
+      hov_if_not_empty 0 ans
+    | OptArg wit ->
+      let ans = match x with
+        | None -> mt ()
+        | Some x -> pr_glb_generic env (in_gen (glbwit wit) x)
+      in
+      hov_if_not_empty 0 ans
+    | PairArg (wit1, wit2) ->
+      let p, q = x in
+      let p = in_gen (glbwit wit1) p in
+      let q = in_gen (glbwit wit2) q in
+      let ans = pr_sequence (pr_glb_generic env) [p; q] in
+      hov_if_not_empty 0 ans
+    | ExtraArg s ->
+       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 a0f2c772..6039168f 100644
--- a/printing/pputils.mli
+++ b/printing/pputils.mli
@@ -1,13 +1,47 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
+open Genarg
+open Misctypes
+open Locus
+open Genredexpr
 
-val pr_located : ('a -> std_ppcmds) -> 'a Loc.located -> std_ppcmds
+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
+val pr_or_by_notation : ('a -> Pp.t) -> 'a or_by_notation -> Pp.t
+val pr_with_occurrences :
+  ('a -> Pp.t) -> (string -> Pp.t) -> 'a with_occurrences -> Pp.t
+
+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
+
+val pr_raw_generic : Environ.env -> rlevel generic_argument -> Pp.t
+val pr_glb_generic : Environ.env -> glevel generic_argument -> Pp.t
+
+(* The comments interface is imperative due to the printer not
+   threading it, this could be solved using a better data
+   structure. *)
+val beautify_comments : ((int * int) * string) list ref
+val extract_comments : int -> string list
diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml
index 5d6d36d5..5c5b7206 100644
--- a/printing/ppvernac.ml
+++ b/printing/ppvernac.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,6 +13,8 @@ open Names
 
 open CErrors
 open Util
+open CAst
+
 open Extend
 open Vernacexpr
 open Pputils
@@ -19,18 +23,11 @@ open Constrexpr
 open Constrexpr_ops
 open Decl_kinds
 
-module Make
-  (Ppconstr : Ppconstrsig.Pp)
-  (Pptactic : Pptacticsig.Pp)
-  (Taggers  : sig
-    val tag_keyword : std_ppcmds -> std_ppcmds
-    val tag_vernac  : vernac_expr -> std_ppcmds -> std_ppcmds
-  end)
-= struct
-
-  open Taggers
   open Ppconstr
-  open Pptactic
+
+  let do_not_tag _ x = x
+  let tag_keyword = do_not_tag ()
+  let tag_vernac  = do_not_tag
 
   let keyword s = tag_keyword (str s)
 
@@ -38,36 +35,50 @@ module Make
   let pr_lconstr = pr_lconstr_expr
   let pr_spc_lconstr = pr_sep_com spc pr_lconstr_expr
 
-  let pr_lident (loc,id) =
-    if Loc.is_ghost loc then
-      let (b,_) = Loc.unloc loc in
-      pr_located pr_id (Loc.make_loc (b,b + String.length(Id.to_string id)),id)
-    else
-      pr_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)
 
   let pr_fqid fqid = str (string_of_fqid fqid)
 
-  let pr_lfqid (loc,fqid) =
-    if Loc.is_ghost loc then
-      let (b,_) = Loc.unloc loc in
-      pr_located pr_fqid (Loc.make_loc (b,b + String.length(string_of_fqid fqid)),fqid)
-    else
-      pr_fqid fqid
+  let pr_lfqid {CAst.loc;v=fqid} =
+    match loc with
+    | None     -> pr_fqid fqid
+    | 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 pr_name lna
+  let pr_lname_decl (n, u) =
+    pr_lname n ++ pr_universe_decl u
 
-  let pr_smart_global = pr_or_by_notation pr_reference
+  let pr_smart_global = Pputils.pr_or_by_notation pr_reference
 
   let pr_ltac_ref = Libnames.pr_reference
 
@@ -77,25 +88,44 @@ module Make
 
   let sep_end = function
     | VernacBullet _
-    | VernacSubproof None
+    | VernacSubproof _
     | VernacEndSubproof -> str""
     | _ -> str"."
 
-  let pr_gen t = pr_raw_generic (Global.env ()) t
+  let pr_gen t = Pputils.pr_raw_generic (Global.env ()) t
 
   let sep = fun _ -> spc()
   let sep_v2 = fun _ -> str"," ++ spc()
 
-  let pr_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
@@ -114,7 +144,7 @@ module Make
         | SearchString (s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
 
   let pr_search a gopt b pr_p =
-    pr_opt (fun g -> int g ++ str ":"++ spc()) gopt
+    pr_opt (fun g -> Proof_bullet.pr_goal_selector g ++ str ":"++ spc()) gopt
     ++
       match a with
       | SearchHead c -> keyword "SearchHead" ++ spc() ++ pr_p c ++ pr_in_out_modules b
@@ -127,7 +157,7 @@ module Make
 
   let pr_explanation (e,b,f) =
     let a = match e with
-      | ExplByPos (n,_) -> anomaly (Pp.str "No more supported")
+      | ExplByPos (n,_) -> anomaly (Pp.str "No more supported.")
       | ExplByName id -> pr_id id in
     let a = if f then str"!" ++ a else a in
     if b then str "[" ++ a ++ str "]" else a
@@ -198,31 +228,31 @@ module Make
         | HintsExtern (n,c,tac) ->
           let pat = match c with None -> mt () | Some pat -> pr_pat pat in
           keyword "Extern" ++ spc() ++ int n ++ spc() ++ pat ++ str" =>" ++
-            spc() ++ pr_raw_tactic tac
+            spc() ++ Pputils.pr_raw_generic (Global.env ()) tac
     in
     hov 2 (keyword "Hint "++ pph ++ opth)
 
   let pr_with_declaration pr_c = function
-    | CWith_Definition (id,c) ->
+    | CWith_Definition (id,udecl,c) ->
       let p = pr_c c in
-      keyword "Definition" ++ spc() ++ pr_lfqid id ++ str" := " ++ p
+      keyword "Definition" ++ spc() ++ pr_lfqid id ++ pr_universe_decl udecl ++ str" := " ++ p
     | CWith_Module (id,qid) ->
       keyword "Module" ++ spc() ++ pr_lfqid id ++ str" := " ++
-        pr_located pr_qualid qid
+        pr_ast pr_qualid qid
 
   let rec pr_module_ast leading_space pr_c = function
-    | CMident qid ->
+    | { loc ; v = CMident qid } ->
       if leading_space then
-        spc () ++ pr_located pr_qualid qid
+        spc () ++ pr_located pr_qualid (loc, qid)
       else
-        pr_located pr_qualid qid
-    | CMwith (_,mty,decl) ->
+        pr_located pr_qualid (loc,qid)
+    | { v = CMwith (mty,decl) } ->
       let m = pr_module_ast leading_space pr_c mty in
       let p = pr_with_declaration pr_c decl in
       m ++ spc() ++ keyword "with" ++ spc() ++ p
-    | CMapply (_,me1,(CMident _ as me2)) ->
+    | { v = CMapply (me1, ( { v = CMident _ } as me2 ) ) } ->
       pr_module_ast leading_space pr_c me1 ++ spc() ++ pr_module_ast false pr_c me2
-    | CMapply (_,me1,me2) ->
+    | { v = CMapply (me1,me2) } ->
       pr_module_ast leading_space pr_c me1 ++ spc() ++
         hov 1 (str"(" ++ pr_module_ast false pr_c me2 ++ str")")
 
@@ -261,10 +291,10 @@ module Make
     prlist_strict (pr_module_vardecls pr_c) l
 
   let pr_type_option pr_c = function
-    | CHole (loc, 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
@@ -284,7 +314,7 @@ module Make
         ) ++
           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()
@@ -292,7 +322,7 @@ module Make
         ) ++
           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()
@@ -303,31 +333,26 @@ module Make
 
   let begin_of_inductive = function
     | [] -> 0
-    | (_,((loc,_),_))::_ -> fst (Loc.unloc 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) ->
-        anomaly (Pp.str "Don't know how to beautify a local conjecture")
+      | (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)) =
     hov 2 (prlist_with_sep sep pr_lident xl ++ spc() ++
@@ -358,54 +383,41 @@ module Make
   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,guard)) =
-    assert (not (Option.is_empty idpl));
-    let id, pl = Option.get idpl in
+  let pr_statement head (idpl,(bl,c)) =
     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()) ++
-         pr_opt (pr_guard_annot pr_lconstr_expr bl) guard ++
          str":" ++ pr_spc_lconstr c)
 
-  let pr_priority = function
-    | None -> mt ()
-    | Some i -> spc () ++ str "|" ++ spc () ++ int i
-
 (**************************************)
 (* Pretty printer for vernac commands *)
 (**************************************)
@@ -448,7 +460,7 @@ module Make
     | 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 ->
@@ -489,8 +501,8 @@ module Make
         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 ->
@@ -503,9 +515,9 @@ module Make
       keyword "Print Scope" ++ spc() ++ str s
     | PrintVisibility s ->
       keyword "Print Visibility" ++ pr_opt str s
-    | PrintAbout (qid,gopt) ->
-       pr_opt (fun g -> int g ++ str ":"++ spc()) gopt
-       ++ keyword "About" ++ spc()  ++ pr_smart_global qid
+    | PrintAbout (qid,l,gopt) ->
+       pr_opt (fun g -> Proof_bullet.pr_goal_selector g ++ str ":"++ spc()) gopt
+       ++ 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
@@ -519,40 +531,50 @@ module Make
       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 return = Taggers.tag_vernac v in
+  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 PrintDag ->
-        return (keyword "Stm PrintDag")
-      | VernacStm Finish ->
-        return (keyword "Stm Finish")
-      | VernacStm Wait ->
-        return (keyword "Stm Wait")
-      | VernacStm (Observe id) ->
-        return (keyword "Stm Observe " ++ str(Stateid.to_string id))
-      | VernacStm (Command v) ->
-        return (keyword "Stm Command " ++ pr_vernac_body v)
-      | VernacStm (PGLast v) ->
-        return (keyword "Stm PGLast " ++ pr_vernac_body v)
+      | VernacLoad (f,s) ->
+        return (
+          keyword "Load"
+          ++ if f then
+              (spc() ++ keyword "Verbose" ++ spc())
+            else
+              spc() ++ qs s
+        )
 
       (* Proof management *)
       | VernacAbortAll ->
@@ -563,8 +585,6 @@ module Make
         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 ->
@@ -582,20 +602,16 @@ module Make
           | 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
-          | ShowGoalImplicitly n -> keyword "Show Implicit Arguments" ++ pr_opt int n
           | ShowProof -> keyword "Show Proof"
-          | ShowNode -> keyword "Show Node"
           | ShowScript -> keyword "Show Script"
           | ShowExistentials -> keyword "Show Existentials"
           | ShowUniverses -> keyword "Show Universes"
-          | ShowTree -> keyword "Show Tree"
           | ShowProofNames -> keyword "Show Conjectures"
           | ShowIntros b -> keyword "Show " ++ (if b then keyword "Intros" else keyword "Intro")
           | ShowMatch id -> keyword "Show Match " ++ pr_reference id
-          | ShowThesis -> keyword "Show Thesis"
         in
         return (pr_showable s)
       | VernacCheckGuard ->
@@ -619,28 +635,8 @@ module Make
       | VernacRestoreState s ->
         return  (keyword "Restore State" ++ spc() ++ qs s)
 
-    (* Control *)
-      | VernacLoad (f,s) ->
-        return (
-          keyword "Load"
-          ++ if f then
-              (spc() ++ keyword "Verbose" ++ spc())
-            else
-              spc() ++ qs s
-        )
-      | VernacTime (_,v) ->
-        return (keyword "Time" ++ spc() ++ pr_vernac_body v)
-      | VernacRedirect (s, (_,v)) ->
-        return (keyword "Redirect" ++ spc() ++ qs s ++ spc() ++ pr_vernac_body v)
-      | VernacTimeout(n,v) ->
-        return (keyword "Timeout " ++ int n ++ spc() ++ pr_vernac_body v)
-      | VernacFail v ->
-        return (keyword "Fail" ++ spc() ++ pr_vernac_body v)
-      | VernacError _ ->
-        return (keyword "No-parsing-rule for VernacError")
-
     (* Syntax *)
-      | VernacOpenCloseScope (_,(opening,sc)) ->
+      | VernacOpenCloseScope (opening,sc) ->
         return (
           keyword (if opening then "Open " else "Close ") ++
             keyword "Scope" ++ spc() ++ str sc
@@ -669,7 +665,7 @@ module Make
           ++ 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) ++
@@ -678,7 +674,7 @@ module Make
                      | 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 ++
@@ -686,9 +682,9 @@ module Make
                      | 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) ->
@@ -697,16 +693,18 @@ module Make
         )
 
       (* 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()
           | Some r ->
             keyword "Eval" ++ spc() ++
-              pr_red_expr (pr_constr, pr_lconstr, pr_smart_global, pr_constr) r ++
+              pr_red_expr (pr_constr, pr_lconstr, pr_smart_global, pr_constr) keyword r ++
               keyword " in" ++ spc()
         in
         let pr_def_body = function
@@ -717,18 +715,19 @@ module Make
             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))
         )
 
-      | VernacStartTheoremProof (ki,l,_) ->
+      | VernacStartTheoremProof (ki,l) ->
         return (
           hov 1 (pr_statement (pr_thm_token ki) (List.hd l) ++
                    prlist (pr_statement (spc () ++ keyword "with")) (List.tl l))
@@ -741,25 +740,20 @@ module Make
         match o with
           | None -> (match opac with
               | Transparent -> keyword "Defined"
-              | Opaque None -> keyword "Qed"
-              | Opaque (Some l) ->
-                  keyword "Qed" ++ spc() ++ str"export" ++
-                    prlist_with_sep (fun () -> str", ") pr_lident l)
-          | Some (id,th) -> (match th with
-              | None -> (if opac <> Transparent then keyword "Save" else keyword "Defined") ++ spc() ++ pr_lident id
-              | Some tok -> keyword "Save" ++ spc() ++ pr_thm_token tok ++ spc() ++ pr_lident id)
+              | 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 (p,f,l) ->
+      | VernacInductive (cum, p,f,l) ->
         let pr_constructor (coe,(id,c)) =
           hov 2 (pr_lident id ++ str" " ++
                    (if coe then str":>" else str":") ++
@@ -775,10 +769,10 @@ module Make
           | 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 ++
@@ -786,20 +780,29 @@ module Make
         in
         let key =
           let (_,_,_,k,_),_ = List.hd l in
-          match k with Record -> "Record" | Structure -> "Structure"
-            | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive"
-            | Class _ -> "Class" | Variant -> "Variant"
+          let kind =
+            match k with Record -> "Record" | Structure -> "Structure"
+                       | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive"
+                       | Class _ -> "Class" | Variant -> "Variant"
+          in
+          if p then
+            let cm =
+              match cum with
+              | GlobalCumulativity | LocalCumulativity -> "Cumulative"
+              | GlobalNonCumulativity | LocalNonCumulativity -> "NonCumulative"
+            in
+            cm ^ " " ^ kind
+          else kind
         in
         return (
           hov 1 (pr_oneind key (List.hd l)) ++
-            (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
+          (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
         )
 
       | VernacFixpoint (local, recs) ->
         let local = match local with
-          | Some Discharge -> "Let "
-          | Some Local -> "Local "
-          | None | Some Global -> ""
+          | DoDischarge -> "Let "
+          | NoDischarge -> ""
         in
         return (
           hov 0 (str local ++ keyword "Fixpoint" ++ spc () ++
@@ -809,12 +812,11 @@ module Make
 
       | 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
@@ -840,10 +842,6 @@ module Make
                    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)
@@ -876,14 +874,14 @@ module Make
         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 ++
@@ -895,16 +893,16 @@ module Make
         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,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()))
@@ -977,7 +975,7 @@ module Make
                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)
@@ -1007,9 +1005,9 @@ module Make
                    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 () ++
@@ -1037,7 +1035,7 @@ module Make
           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 "]"
@@ -1050,13 +1048,13 @@ module Make
                   | n, { name = id; recarg_like = k;
                          notation_scope = s;
                          implicit_status = imp } :: tl ->
-                    spc() ++ pr_br imp (pr_if k (str"!") ++ pr_name id ++ pr_s s) ++
+                    spc() ++ pr_br imp (pr_if k (str"!") ++ Name.print id ++ pr_s s) ++
                       print_arguments (Option.map pred n) tl
               in
               let rec print_implicits = function
                 | [] -> mt ()
                 | (name, impl) :: rest ->
-                   spc() ++ pr_br impl (pr_name name) ++ print_implicits rest
+                   spc() ++ pr_br impl (Name.print name) ++ print_implicits rest
               in
               print_arguments nargs args ++
                 if not (List.is_empty more_implicits) then
@@ -1103,7 +1101,7 @@ module Make
         )
       | VernacSetOpacity _ ->
         return (
-          CErrors.anomaly (keyword "VernacSetOpacity used to set something else")
+          CErrors.anomaly (keyword "VernacSetOpacity used to set something else.")
         )
       | VernacSetStrategy l ->
         let pr_lev = function
@@ -1120,18 +1118,15 @@ module Make
           hov 1 (keyword "Strategy" ++ spc() ++
                    hv 0 (prlist_with_sep sep pr_line l))
         )
-      | VernacUnsetOption (na) ->
+      | VernacUnsetOption (export, na) ->
+        let export = if export then keyword "Export" ++ spc () else mt () in
         return (
-          hov 1 (keyword "Unset" ++ spc() ++ pr_printoption na None)
+          hov 1 (export ++ keyword "Unset" ++ spc() ++ pr_printoption na None)
         )
-      | VernacSetOption (na,v) ->
+      | VernacSetOption (export, na,v) ->
+        let export = if export then keyword "Export" ++ spc () else mt () in
         return (
-          hov 2 (keyword "Set" ++ spc() ++ pr_set_option na v)
-        )
-      | VernacSetAppendOption (na,v) ->
-        return (
-          hov 2 (keyword "Set" ++ spc() ++ pr_printoption na None ++
-                   spc() ++ keyword "Append" ++ spc() ++ qs v)
+          hov 2 (export ++ keyword "Set" ++ spc() ++ pr_set_option na v)
         )
       | VernacAddOption (na,l) ->
         return (
@@ -1153,18 +1148,19 @@ module Make
         let pr_mayeval r c = match r with
           | Some r0 ->
             hov 2 (keyword "Eval" ++ spc() ++
-                     pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) r0 ++
+                     pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) keyword r0 ++
                      spc() ++ keyword "in" ++ spc () ++ pr_lconstr c)
           | None -> hov 2 (keyword "Check" ++ spc() ++ pr_lconstr c)
         in
-        let pr_i = match io with None -> mt () | Some i -> int i ++ str ": " in
+        let pr_i = match io with None -> mt ()
+                               | Some i -> Proof_bullet.pr_goal_selector i ++ str ": " in
         return (pr_i ++ pr_mayeval r c)
       | VernacGlobalCheck c ->
         return (hov 2 (keyword "Type" ++ pr_constrarg c))
       | VernacDeclareReduction (s,r) ->
         return (
           keyword "Declare Reduction" ++ spc () ++ str s ++ str " := " ++
-            pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) r
+            pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) keyword r
         )
       | VernacPrint p ->
         return (pr_printable p)
@@ -1177,7 +1173,7 @@ module Make
           | 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) ->
@@ -1205,12 +1201,12 @@ module Make
         return (keyword "Proof " ++ spc () ++
             keyword "using" ++ spc() ++ pr_using e)
       | VernacProof (Some te, None) ->
-        return (keyword "Proof with" ++ spc() ++ pr_raw_tactic te)
+        return (keyword "Proof with" ++ spc() ++ Pputils.pr_raw_generic (Global.env ()) te)
       | VernacProof (Some te, Some e) ->
         return (
           keyword "Proof" ++ spc () ++
             keyword "using" ++ spc() ++ pr_using e ++ spc() ++
-            keyword "with" ++ spc() ++pr_raw_tactic te
+            keyword "with" ++ spc() ++ Pputils.pr_raw_generic (Global.env ()) te
         )
       | VernacProofMode s ->
         return (keyword "Proof Mode" ++ str s)
@@ -1223,47 +1219,34 @@ module Make
       | 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 (fun x -> x) (aux rl cl))
-    with Not_found ->
-      hov 1 (str "TODO(" ++ str (fst s) ++ spc () ++ prlist_with_sep sep pr_arg cl ++ str ")")
-
-  let pr_vernac v =
-    try pr_vernac_body v ++ sep_end v
-    with e -> CErrors.print e
-
-end
-
-include Make (Ppconstr) (Pptactic) (struct
-  let do_not_tag _ x = x
-  let tag_keyword = do_not_tag ()
-  let tag_vernac  = do_not_tag
-end)
-
-module Richpp = struct
+let pr_vernac_flag =
+  function
+  | VernacPolymorphic true -> keyword "Polymorphic"
+  | VernacPolymorphic false -> keyword "Monomorphic"
+  | VernacProgram -> keyword "Program"
+  | VernacLocal local -> pr_locality local
 
-  include Make
-    (Ppconstr.Richpp)
-    (Pptactic.Richpp)
-    (struct
-      open Ppannotation
-      let tag_keyword s = Pp.tag (Pp.Tag.inj AKeyword tag) s
-      let tag_vernac v s = Pp.tag (Pp.Tag.inj (AVernac v) tag) s
-     end)
-
-end
+  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 d3d4a5ce..4aa24bf5 100644
--- a/printing/ppvernac.mli
+++ b/printing/ppvernac.mli
@@ -1,20 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module implements pretty-printers for vernac_expr syntactic
     objects and their subcomponents. *)
 
-(** The default pretty-printers produce {!Pp.std_ppcmds} that are
-    interpreted as raw strings. *)
-include Ppvernacsig.Pp
+val pr_set_entry_type : ('a -> Pp.t) -> 'a Extend.constr_entry_key_gen -> Pp.t
 
-(** The rich pretty-printers produce {!Pp.std_ppcmds} that are
-    interpreted as annotated strings. The annotations can be
-    retrieved using {!RichPp.rich_pp}. Their definitions are
-    located in {!Ppannotation.t}. *)
-module Richpp : Ppvernacsig.Pp
+(** Prints a fixpoint body *)
+val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> 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_control -> Pp.t
diff --git a/printing/ppvernacsig.mli b/printing/ppvernacsig.mli
deleted file mode 100644
index 5e5e4bcf..00000000
--- a/printing/ppvernacsig.mli
+++ /dev/null
@@ -1,20 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-module type Pp = sig
-
-  (** Prints a fixpoint body *)
-  val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.std_ppcmds
-
-  (** Prints a vernac expression *)
-  val pr_vernac_body : Vernacexpr.vernac_expr -> Pp.std_ppcmds
-
-  (** Prints a vernac expression and closes it with a dot. *)
-  val pr_vernac : Vernacexpr.vernac_expr -> Pp.std_ppcmds
-
-end
diff --git a/printing/prettyp.ml b/printing/prettyp.ml
index e117f1dc..1f17d844 100644
--- a/printing/prettyp.ml
+++ b/printing/prettyp.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Changed by (and thus parts copyright ©) by Lionel Elie Mamane <lionel@mamane.lu>
@@ -13,9 +15,9 @@
 open Pp
 open CErrors
 open Util
+open CAst
 open Names
 open Nameops
-open Term
 open Termops
 open Declarations
 open Environ
@@ -27,19 +29,23 @@ open Recordops
 open Misctypes
 open Printer
 open Printmod
+open Context.Rel.Declaration
+
+(* module RelDecl = Context.Rel.Declaration *)
+module NamedDecl = Context.Named.Declaration
 
 type object_pr = {
-  print_inductive           : mutual_inductive -> std_ppcmds;
-  print_constant_with_infos : constant -> std_ppcmds;
-  print_section_variable    : variable -> std_ppcmds;
-  print_syntactic_def       : kernel_name -> std_ppcmds;
-  print_module              : bool -> Names.module_path -> std_ppcmds;
-  print_modtype             : module_path -> std_ppcmds;
-  print_named_decl          : Context.Named.Declaration.t -> std_ppcmds;
-  print_library_entry       : bool -> (object_name * Lib.node) -> std_ppcmds option;
-  print_context             : bool -> int option -> Lib.library_segment -> std_ppcmds;
-  print_typed_value_in_env  : Environ.env -> Evd.evar_map -> Term.constr * Term.types -> Pp.std_ppcmds;
-  print_eval                : Reductionops.reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> unsafe_judgment -> std_ppcmds;
+  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;
 }
 
 let gallina_print_module  = print_module
@@ -65,28 +71,42 @@ 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 typ = Global.type_of_global_unsafe ref in
+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
   let typ =
     if reduce then
       let ctx,ccl = Reductionops.splay_prod_assum (Global.env()) Evd.empty typ
-      in it_mkProd_or_LetIn ccl ctx
+      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 sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) 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 (UState.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_ltype_env env sigma typ ++ 
-  	   Printer.pr_universe_ctx sigma univs)
+  hov 0 (pr_global ref ++ inst ++ str " :" ++ spc () ++ pr_letype_env env sigma typ ++ 
+           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
   | []  -> []
@@ -127,12 +147,11 @@ let print_impargs_list prefix l =
 let print_renames_list prefix l =
   if List.is_empty l then [] else
   [add_colon prefix ++ str "Arguments are renamed to " ++
-    hv 2 (prlist_with_sep pr_comma (fun x -> x) (List.map pr_name l))]
+    hv 2 (prlist_with_sep pr_comma (fun x -> x) (List.map Name.print l))]
 
 let need_expansion impl ref =
-  let typ = Global.type_of_global_unsafe ref in
-  let ctx = prod_assum typ in
-  let open Context.Rel.Declaration in
+  let typ, _ = Global.type_of_global_in_context (Global.env ()) ref 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
@@ -144,7 +163,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"]))
@@ -170,9 +189,8 @@ type opacity =
   | TransparentMaybeOpacified of Conv_oracle.level
 
 let opacity env =
-  let open Context.Named.Declaration in
   function
-  | VarRef v when is_local_def (Environ.lookup_named v env) ->
+  | VarRef v when NamedDecl.is_local_def (Environ.lookup_named v env) ->
       Some(TransparentMaybeOpacified
         (Conv_oracle.get_strategy (Environ.oracle env) (VarKey v)))
   | ConstRef cst ->
@@ -202,6 +220,11 @@ let print_opacity ref =
               str "transparent (with minimal expansion weight)"]
 
 (*******************)
+
+let print_if_is_coercion ref =
+  if Classops.coercion_exists ref then [pr_global ref ++ str " is a coercion"] else []
+
+(*******************)
 (* *)
 
 let print_polymorphism ref =
@@ -224,10 +247,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 =
@@ -246,7 +269,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 @
@@ -255,11 +278,12 @@ let print_name_infos ref =
   type_info_for_implicit @
   print_renames_list (mt()) renames @
   print_impargs_list (mt()) impls @
-  print_argument_scopes (mt()) scopes
+  print_argument_scopes (mt()) scopes @
+  print_if_is_coercion 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
     []
 
@@ -292,16 +316,35 @@ 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
+  let {v=qid} = qualid_of_reference ref in
   try Term (Nametab.locate qid)
   with Not_found ->
   try Syntactic (Nametab.locate_syndef qid)
@@ -309,7 +352,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 ->
@@ -323,17 +372,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."
 
@@ -371,14 +419,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
@@ -396,18 +440,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 {v=qid} = qualid_of_reference ref 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 ->
@@ -420,43 +481,43 @@ 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 *)
 (****  Gallina layer                  *****)
 
 let gallina_print_typed_value_in_env env sigma (trm,typ) =
-  (pr_lconstr_env env sigma trm ++ fnl () ++
-     str "     : " ++ pr_ltype_env env sigma typ)
+  (pr_leconstr_env env sigma trm ++ fnl () ++
+     str "     : " ++ pr_letype_env env sigma typ)
 
 (* To be improved; the type should be used to provide the types in the
    abstractions. This should be done recursively inside pr_lconstr, so that
    the pretty-print of a proposition (P:(nat->nat)->Prop)(P [u]u)
    synthesizes the type nat of the abstraction on u *)
 
-let print_named_def name body typ =
-  let pbody = 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
@@ -464,22 +525,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
@@ -489,102 +550,128 @@ let print_body env evd = function
 let print_typed_body env evd (val_0,typ) =
   (print_body env evd val_0 ++ fnl () ++ str "     : " ++ pr_ltype_env env evd typ)
 
-let ungeneralized_type_of_constant_type t = 
-  Typeops.type_of_constant_type (Global.env ()) t
-
 let print_instance sigma cb =
-  if cb.const_polymorphic then
-    pr_universe_instance sigma cb.const_universes
+  if Declareops.constant_is_polymorphic cb then
+    let univs = Declareops.constant_polymorphic_context cb in
+    let inst = Univ.AUContext.instance univs in
+    let univs = Univ.UContext.make (inst, Univ.AUContext.instantiate inst univs) in
+    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 = Declareops.type_of_constant cb in
-  let typ = ungeneralized_type_of_constant_type typ in
-  let univs = Univ.instantiate_univ_context 
-    (Global.universes_of_constant_body cb)
+  let typ =
+    match cb.const_universes with
+    | Monomorphic_const _ -> cb.const_type
+    | Polymorphic_const univs ->
+      let inst = Univ.AUContext.instance univs in
+      Vars.subst_instance_constr inst cb.const_type
+  in
+  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 -> Monomorphic_const_entry ctx, []
+        | Polymorphic_const 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 ->
+        Monomorphic_const_entry (ContextSet.union body_uctxs ctx), []
+      | Polymorphic_const 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))
+    UState.of_binders
+      (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
-  hov 0 (pr_polymorphic cb.const_polymorphic ++
+  hov 0 (pr_polymorphic (Declareops.constant_is_polymorphic cb) ++
     match val_0 with
     | None ->
 	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 (val_0,typ) else pr_ltype typ)++
-        Printer.pr_universe_ctx sigma univs)
+	(if with_values then print_typed_body env sigma (Some c,typ) else pr_ltype typ)++
+        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 Loc.ghost a 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)
-    | (_,Lib.FrozenState _) ->
-	None
 
-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 ()
@@ -639,49 +726,51 @@ let print_judgment env sigma {uj_val=trm;uj_type=typ} =
 let print_safe_judgment env sigma j =
   let trm = Safe_typing.j_val j in
   let typ = Safe_typing.j_type j in
+  let trm = EConstr.of_constr trm in
+  let typ = EConstr.of_constr typ in
   print_typed_value_in_env env sigma (trm, typ)
 
 (*********************)
 (* *)
 
-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
       | "CONSTANT" ->
 	  let con = Global.constant_of_delta_kn kn in
 	  let cb = Global.lookup_constant con in
-	  let typ = ungeneralized_type_of_constant_type cb.const_type in
+	  let typ = cb.const_type in
 	  hov 0 (
 	    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
@@ -696,16 +785,16 @@ let print_full_pure_context () =
 
 (* This is designed to print the contents of an opened section *)
 let read_sec_context r =
-  let loc,qid = qualid_of_reference r in
+  let qid = qualid_of_reference r in
   let dir =
-    try Nametab.locate_section qid
+    try Nametab.locate_section qid.v
     with Not_found ->
-      user_err_loc (loc,"read_sec_context", str "Unknown section.") in
+      user_err ?loc:qid.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 ->
-        error "Cannot print the contents of a closed section."
+        user_err Pp.(str "Cannot print the contents of a closed section.")
 	(* LEM: Actually, we could if we wanted to. *)
     | [] -> []
     | hd::rest -> get_cxt (hd::in_cxt) rest
@@ -713,90 +802,106 @@ 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;
-    let open Context.Named.Declaration in
-    str |> Global.lookup_named |> set_id str |> print_named_decl
-  with Not_found ->
-    errorlabstrm
-      "print_name" (pr_qualid qid ++ spc () ++ str "not a defined object.")
+    str |> Global.lookup_named |> print_named_decl env sigma
 
-let print_name = function
-  | ByNotation (loc,ntn,sc) ->
-      print_any_name
-        (Term (Notation.interp_notation_as_global_reference loc (fun _ -> true)
+  with Not_found ->
+    user_err
+      ~hdr:"print_name" (pr_qualid qid ++ spc () ++ str "not a defined object.")
+
+let print_name env sigma na udecl =
+  match na with
+  | {loc; v=ByNotation (ntn,sc)} ->
+      print_any_name env sigma
+        (Term (Notation.interp_notation_as_global_reference ?loc (fun _ -> true)
                ntn sc))
-  | AN ref ->
-      print_any_name (locate_any_name ref)
+        udecl
+  | {loc; v=AN 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
-	  error "Not a defined constant."
+	  user_err Pp.(str "Not a defined constant.")
     | IndRef (sp,_) ->
-        print_inductive sp
+        print_inductive sp None
     | ConstructRef cstr as gr ->
-	let ty = Universes.unsafe_type_of_global gr in
+	let ty, ctx = Global.type_of_global_in_context env gr in
+	let inst = Univ.AUContext.instance ctx in
+	let ty = Vars.subst_instance_constr inst ty in
+	let ty = EConstr.of_constr ty in
+        let open EConstr in
 	print_typed_value (mkConstruct cstr, ty)
     | VarRef id ->
-        let open Context.Named.Declaration in
-        lookup_named id env |> set_id id |> print_named_decl
+        env |> lookup_named id |> 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;
+    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 @
 	[hov 0 (str "Expands to: " ++ pr_located_qualid k)])
   | Syntactic kn ->
     let () = match Syntax_def.search_syntactic_definition kn with
-    | [],Notation_term.NRef ref -> Dumpglob.add_glob loc ref
+    | [],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
-  | ByNotation (loc,ntn,sc) ->
-      print_about_any loc
-        (Term (Notation.interp_notation_as_global_reference loc (fun _ -> true)
-               ntn sc))
-  | AN ref ->
-      print_about_any (loc_of_reference ref) (locate_any_name ref)
+let print_about env sigma na udecl =
+  match na with
+  | {loc;v=ByNotation (ntn,sc)} ->
+      print_about_any ?loc env sigma
+        (Term (Notation.interp_notation_as_global_reference ?loc (fun _ -> true)
+               ntn sc)) udecl
+  | {loc;v=AN ref} ->
+      print_about_any ?loc 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 ())
 
 
 (*************************************************************************)
@@ -804,54 +909,54 @@ 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
     fst (class_info cl)
   with Not_found ->
-    errorlabstrm "index_of_class"
+    user_err ~hdr:"index_of_class"
       (pr_class cl ++ spc() ++ str "not a defined class.")
 
-let print_path_between cls clt =
+let print_path_between env sigma cls clt =
   let i = index_of_class cls in
   let j = index_of_class clt in
   let p =
     try
       lookup_path_between_class (i,j)
     with Not_found ->
-      errorlabstrm "index_cl_of_id"
+      user_err ~hdr:"index_cl_of_id"
         (str"No path between " ++ pr_class cls ++ str" and " ++ pr_class clt
 	 ++ str ".")
   in
-  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 ())
 
 (*************************************************************************)
@@ -862,7 +967,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
@@ -871,7 +976,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 0eab1557..213f0aee 100644
--- a/printing/prettyp.mli
+++ b/printing/prettyp.mli
@@ -1,76 +1,101 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open Names
-open Term
 open Environ
 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 -> std_ppcmds
-val print_library_entry : bool -> (object_name * Lib.node) -> std_ppcmds option
-val print_full_context : unit -> std_ppcmds
-val print_full_context_typ : unit -> std_ppcmds
-val print_full_pure_context : unit -> std_ppcmds
-val print_sec_context : reference -> std_ppcmds
-val print_sec_context_typ : reference -> std_ppcmds
-val print_judgment : env -> Evd.evar_map -> unsafe_judgment -> std_ppcmds
-val print_safe_judgment : env -> Evd.evar_map -> Safe_typing.judgment -> std_ppcmds
+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 -> unsafe_judgment -> std_ppcmds
+    Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t
 
-val print_name : reference or_by_notation -> std_ppcmds
-val print_opaque_name : reference -> std_ppcmds
-val print_about : reference or_by_notation -> std_ppcmds
-val print_impargs : reference or_by_notation -> std_ppcmds
+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 -> std_ppcmds
-val print_classes : unit -> std_ppcmds
-val print_coercions : unit -> std_ppcmds
-val print_path_between : Classops.cl_typ -> Classops.cl_typ -> std_ppcmds
-val print_canonical_projections : unit -> std_ppcmds
+val print_graph : env -> evar_map -> Pp.t
+val print_classes : 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 -> std_ppcmds
-val print_instances : global_reference -> std_ppcmds
-val print_all_instances : unit -> std_ppcmds
+val print_typeclasses : unit -> Pp.t
+val print_instances : global_reference -> Pp.t
+val print_all_instances : unit -> Pp.t
 
-val inspect : int -> std_ppcmds
+val inspect : env -> Evd.evar_map -> int -> Pp.t
 
-(** Locate *)
+(** {5 Locate} *)
 
-val print_located_qualid : reference -> std_ppcmds
-val print_located_term : reference -> std_ppcmds
-val print_located_tactic : reference -> std_ppcmds
-val print_located_module : reference -> std_ppcmds
+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_module : reference -> Pp.t
+val print_located_other : string -> reference -> Pp.t
 
 type object_pr = {
-  print_inductive           : mutual_inductive -> std_ppcmds;
-  print_constant_with_infos : constant -> std_ppcmds;
-  print_section_variable    : variable -> std_ppcmds;
-  print_syntactic_def       : kernel_name -> std_ppcmds;
-  print_module              : bool -> Names.module_path -> std_ppcmds;
-  print_modtype             : module_path -> std_ppcmds;
-  print_named_decl          : Context.Named.Declaration.t -> std_ppcmds;
-  print_library_entry       : bool -> (object_name * Lib.node) -> std_ppcmds option;
-  print_context             : bool -> int option -> Lib.library_segment -> std_ppcmds;
-  print_typed_value_in_env  : Environ.env -> Evd.evar_map -> Term.constr * Term.types -> Pp.std_ppcmds;
-  print_eval                : reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> unsafe_judgment -> std_ppcmds
+  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;
 }
 
 val set_object_pr : object_pr -> unit
diff --git a/printing/printer.ml b/printing/printer.ml
index 04337f6b..199aa79c 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -1,34 +1,71 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Environ
 open Globnames
 open Nametab
 open Evd
 open Proof_type
 open Refiner
-open Pfedit
 open Constrextern
 open Ppconstr
 open Declarations
 
-let emacs_str s =
-  if !Flags.print_emacs then s else ""
-let delayed_emacs_cmd s =
-  if !Flags.print_emacs then s () else str ""
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+module CompactedDecl = Context.Compacted.Declaration
+
+let enable_unfocused_goal_printing = ref false
+let enable_goal_tags_printing = ref false
+let enable_goal_names_printing = ref false
+
+let should_tag() = !enable_goal_tags_printing
+let should_unfoc() = !enable_unfocused_goal_printing
+let should_gname() = !enable_goal_names_printing
+
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "printing of unfocused goal";
+      optkey   = ["Printing";"Unfocused"];
+      optread  = (fun () -> !enable_unfocused_goal_printing);
+      optwrite = (fun b -> enable_unfocused_goal_printing:=b) }
+
+(* This is set on by proofgeneral proof-tree mode. But may be used for
+   other purposes *)
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "printing of goal tags";
+      optkey   = ["Printing";"Goal";"Tags"];
+      optread  = (fun () -> !enable_goal_tags_printing);
+      optwrite = (fun b -> enable_goal_tags_printing:=b) }
+
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "printing of goal names";
+      optkey   = ["Printing";"Goal";"Names"];
+      optread  = (fun () -> !enable_goal_names_printing);
+      optwrite = (fun b -> enable_goal_names_printing:=b) }
 
-let get_current_context () =
-  Pfedit.get_current_context ()
 
 (**********************************************************************)
 (** Terms                                                             *)
@@ -41,32 +78,42 @@ let get_current_context () =
    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_constr_core goal_concl_style env sigma t =
+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_lconstr_core 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_lconstr_env env = pr_lconstr_core false env
-let pr_constr_env env = pr_constr_core false env
+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
 
-let pr_lconstr_goal_style_env env = pr_lconstr_core true env
-let pr_constr_goal_style_env env = pr_constr_core true env
+let pr_lconstr_goal_style_env env sigma c = pr_leconstr_core true env sigma (EConstr.of_constr c)
+let pr_constr_goal_style_env env sigma c = pr_econstr_core true env sigma (EConstr.of_constr c)
 
 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
 
-  (* NB do not remove the eta-redexes! Global.env() has side-effects... *)
+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
 let pr_open_constr (_,c) = pr_constr c
 
+let pr_leconstr c = pr_lconstr (EConstr.Unsafe.to_constr c)
+let pr_econstr c = pr_constr (EConstr.Unsafe.to_constr c)
+
 let pr_constr_under_binders_env_gen pr env sigma (ids,c) =
   (* Warning: clashes can occur with variables of same name in env but *)
   (* we also need to preserve the actual names of the patterns *)
@@ -74,37 +121,40 @@ let pr_constr_under_binders_env_gen pr env sigma (ids,c) =
   let assums = List.map (fun id -> (Name id,(* dummy *) mkProp)) ids in
   pr (Termops.push_rels_assum assums env) sigma c
 
-let pr_constr_under_binders_env = pr_constr_under_binders_env_gen pr_constr_env
-let pr_lconstr_under_binders_env = pr_constr_under_binders_env_gen pr_lconstr_env
+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_type_core goal_concl_style env sigma t =
+let pr_etype_core goal_concl_style env sigma t =
   pr_constr_expr (extern_type goal_concl_style env sigma t)
-let pr_ltype_core goal_concl_style env sigma t =
+let pr_letype_core goal_concl_style env sigma t =
   pr_lconstr_expr (extern_type goal_concl_style env sigma t)
 
-let pr_goal_concl_style_env env = pr_ltype_core true env
-let pr_ltype_env env = pr_ltype_core false env
-let pr_type_env env = pr_type_core false env
+let pr_ltype_env env sigma c = pr_letype_core false env sigma (EConstr.of_constr c)
+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
+let pr_letype_env env sigma c = pr_letype_core false env sigma c
+let pr_goal_concl_style_env env sigma c = pr_letype_core true env sigma c
+
 let pr_ljudge_env env sigma j =
-  (pr_lconstr_env env sigma j.uj_val, pr_lconstr_env env sigma j.uj_type)
+  (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 =
@@ -113,16 +163,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 =
@@ -134,16 +186,16 @@ 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)
 
 let _ = Termops.set_print_constr 
-  (fun env t -> pr_lconstr_expr (extern_constr ~lax:true false env Evd.empty t))
+  (fun env sigma t -> pr_lconstr_expr (extern_constr ~lax:true false env sigma t))
 
 let pr_in_comment pr x = str "(* " ++ pr x ++ str " *)"
 
@@ -182,10 +234,10 @@ let qualid_of_global env r =
 
 let safe_gen f env sigma c =
   let orig_extern_ref = Constrextern.get_extern_reference () in
-  let extern_ref loc vars r =
-    try orig_extern_ref loc vars r
+  let extern_ref ?loc vars r =
+    try orig_extern_ref vars r
     with e when CErrors.noncritical e ->
-      Libnames.Qualid (loc, qualid_of_global env r)
+      CAst.make ?loc @@ Libnames.Qualid (qualid_of_global env r)
   in
   Constrextern.set_extern_reference extern_ref;
   try
@@ -199,17 +251,36 @@ 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 (Evd.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
+    fnl()++pr_in_comment (fun uii -> v 0 
+      (Univ.pr_cumulativity_info (Termops.pr_evd_level sigma) uii)) cumi
   else
     mt()
 
@@ -226,7 +297,7 @@ let pr_puniverses f env (c,u) =
    else mt ())
 
 let pr_constant env cst = pr_global_env (Termops.vars_of_env env) (ConstRef cst)
-let pr_existential_key = Evd.pr_existential_key
+let pr_existential_key = Termops.pr_existential_key
 let pr_existential env sigma ev = pr_lconstr_env env sigma (mkEvar ev)
 let pr_inductive env ind = pr_lconstr_env env Evd.empty (mkInd ind)
 let pr_constructor env cstr = pr_lconstr_env env Evd.empty (mkConstruct cstr)
@@ -248,31 +319,37 @@ let pr_pattern t = pr_pattern_env (Global.env()) empty_names_context t*)
 (**********************************************************************)
 (* Contexts and declarations                                          *)
 
-let pr_var_decl_skel pr_id env sigma (id,c,typ) =
-  let pbody = match c with
-    | None ->  (mt ())
-    | Some c ->
-	(* Force evaluation *)
-	let pb = pr_lconstr_env env sigma c in
-	let pb = if isCast c then surround pb else pb in
-	(str" := " ++ pb ++ cut () ) in
+
+(* Flag for compact display of goals *)
+
+let get_compact_context,set_compact_context =
+  let compact_context = ref false in
+  (fun () -> !compact_context),(fun b  -> compact_context := b)
+
+let pr_compacted_decl env sigma decl =
+  let ids, pbody, typ = match decl with
+    | CompactedDecl.LocalAssum (ids, typ) ->
+       ids, mt (), typ
+    | CompactedDecl.LocalDef (ids,c,typ) ->
+       (* Force evaluation *)
+       let pb = pr_lconstr_env env sigma c in
+       let pb = if isCast c then surround pb else pb in
+       ids, (str" := " ++ pb ++ cut ()), typ
+  in
+  let pids = prlist_with_sep pr_comma pr_id ids in
   let pt = pr_ltype_env env sigma typ in
   let ptyp = (str" : " ++ pt) in
-  (pr_id id ++ hov 0 (pbody ++ ptyp))
+  hov 0 (pids ++ pbody ++ ptyp)
 
-let pr_var_decl env sigma d =
-  pr_var_decl_skel pr_id env sigma (Context.Named.Declaration.to_tuple d)
-
-let pr_var_list_decl env sigma (l,c,typ) =
-  hov 0 (pr_var_decl_skel (fun ids -> prlist_with_sep pr_comma pr_id ids) env sigma (l,c,typ))
+let pr_named_decl env sigma decl =
+  decl |> CompactedDecl.of_named_decl |> pr_compacted_decl env sigma
 
 let pr_rel_decl env sigma decl =
-  let open Context.Rel.Declaration in
-  let na = get_name decl in
-  let typ = get_type decl in
+  let na = RelDecl.get_name decl in
+  let typ = RelDecl.get_type decl in
   let pbody = match decl with
-    | LocalAssum _ -> mt ()
-    | LocalDef (_,c,_) ->
+    | RelDecl.LocalAssum _ -> mt ()
+    | RelDecl.LocalDef (_,c,_) ->
 	(* Force evaluation *)
 	let pb = pr_lconstr_env env sigma c in
 	let pb = if isCast c then surround pb else pb in
@@ -289,16 +366,20 @@ let pr_rel_decl env sigma decl =
 
 (* Prints a signature, all declarations on the same line if possible *)
 let pr_named_context_of env sigma =
-  let make_decl_list env d pps = pr_var_decl env sigma d :: pps in
+  let make_decl_list env d pps = pr_named_decl env sigma d :: pps in
   let psl = List.rev (fold_named_context make_decl_list env ~init:[]) in
   hv 0 (prlist_with_sep (fun _ -> ws 2) (fun x -> x) psl)
 
+let pr_var_list_decl env sigma decl =
+  hov 0 (pr_compacted_decl env sigma decl)
+
 let pr_named_context env sigma ne_context =
   hv 0 (Context.Named.fold_outside
-	  (fun d pps -> pps ++ ws 2 ++ pr_var_decl env sigma d)
+	  (fun d pps -> pps ++ ws 2 ++ pr_named_decl env sigma d)
           ne_context ~init:(mt ()))
 
 let pr_rel_context env sigma rel_context =
+  let rel_context = List.map (fun d -> Termops.map_rel_decl EConstr.of_constr d) rel_context in
   pr_binders (extern_rel_context None env sigma rel_context)
 
 let pr_rel_context_of env sigma =
@@ -307,9 +388,9 @@ let pr_rel_context_of env sigma =
 (* Prints an env (variables and de Bruijn). Separator: newline *)
 let pr_context_unlimited env sigma =
   let sign_env =
-    Context.NamedList.fold
+    Context.Compacted.fold
       (fun d pps ->
-         let pidt =  pr_var_list_decl env sigma d in
+         let pidt =  pr_compacted_decl env sigma d in
          (pps ++ fnl () ++ pidt))
       (Termops.compact_named_context (named_context env)) ~init:(mt ())
   in
@@ -326,39 +407,74 @@ let pr_ne_context_of header env sigma =
     List.is_empty (Environ.named_context env)  then (mt ())
   else let penv = pr_context_unlimited env sigma in (header ++ penv ++ fnl ())
 
-let pr_context_limit n env sigma =
-  let named_context = Environ.named_context env in
-  let lgsign = List.length named_context in
-  if n >= lgsign then
-    pr_context_unlimited env sigma
-  else
-    let k = lgsign-n in
-    let _,sign_env =
-      Context.NamedList.fold
-        (fun d (i,pps) ->
-           if i < k then
-	     (i+1, (pps ++str "."))
-	   else
-             let pidt = pr_var_list_decl env sigma d in
-	     (i+1, (pps ++ fnl () ++
-		      str (emacs_str "") ++
-		      pidt)))
-        (Termops.compact_named_context (Environ.named_context env)) ~init:(0,(mt ()))
-    in
-    let db_env =
-      fold_rel_context
-        (fun env d pps ->
-           let pnat = pr_rel_decl env sigma d in
-	   (pps ++ fnl () ++
-	      str (emacs_str "") ++
-	      pnat))
-        env ~init:(mt ())
-    in
-    (sign_env ++ db_env)
+(* Heuristic for horizontalizing hypothesis that the user probably
+   considers as "variables": An hypothesis H:T where T:S and S<>Prop. *)
+let should_compact env sigma typ =
+  get_compact_context() &&
+    let type_of_typ = Retyping.get_type_of env sigma (EConstr.of_constr typ) in
+    not (is_Prop (EConstr.to_constr sigma type_of_typ))
+
+
+(* If option Compact Contexts is set, we pack "simple" hypothesis in a
+   hov box (with three sapaces as a separator), the global box being a
+   v box *)
+let rec bld_sign_env env sigma ctxt pps =
+  match ctxt with
+  | [] -> pps
+  | CompactedDecl.LocalAssum (ids,typ)::ctxt' when should_compact env sigma typ ->
+    let pps',ctxt' = bld_sign_env_id env sigma ctxt (mt ()) true in
+    (* putting simple hyps in a more horizontal flavor *)
+    bld_sign_env env sigma ctxt' (pps ++ brk (0,0) ++ hov 0 pps')
+  | d:: ctxt' ->
+    let pidt = pr_var_list_decl env sigma d in
+    let pps' = pps ++ brk (0,0) ++ pidt in
+    bld_sign_env env sigma ctxt' pps'
+and bld_sign_env_id env sigma ctxt pps is_start =
+  match ctxt with
+  | [] -> pps,ctxt
+ | CompactedDecl.LocalAssum(ids,typ) as d :: ctxt' when should_compact env sigma typ ->
+    let pidt = pr_var_list_decl env sigma d in
+    let pps' = pps ++ (if not is_start then brk (3,0) else (mt ())) ++ pidt in
+    bld_sign_env_id env sigma ctxt' pps' false
+  | _ -> pps,ctxt
+
+
+(* compact printing an env (variables and de Bruijn). Separator: three
+   spaces between simple hyps, and newline otherwise *)
+let pr_context_limit_compact ?n env sigma =
+  let ctxt = Termops.compact_named_context (named_context env) in
+  let lgth = List.length ctxt in
+  let n_capped =
+    match n with
+    | None -> lgth
+    | Some n when n > lgth -> lgth
+    | Some n -> n in
+  let ctxt_chopped,ctxt_hidden = Util.List.chop n_capped ctxt in
+  (* a dot line hinting the number of hidden hyps. *)
+  let hidden_dots = String.make (List.length ctxt_hidden) '.' in
+  let sign_env = v 0 (str hidden_dots ++ (mt ())
+                 ++ bld_sign_env env sigma (List.rev ctxt_chopped) (mt ())) in
+  let db_env =
+    fold_rel_context (fun env d pps -> pps ++ fnl () ++ pr_rel_decl env sigma d)
+      env ~init:(mt ()) in
+  sign_env ++ db_env
+
+(* The number of printed hypothesis in a goal *)
+(* If [None], no limit *)
+let print_hyps_limit = ref (None : int option)
+
+let _ =
+  let open Goptions in
+  declare_int_option
+    { optdepr  = false;
+      optname  = "the hypotheses limit";
+      optkey   = ["Hyps";"Limit"];
+      optread  = (fun () -> !print_hyps_limit);
+      optwrite = (fun x -> print_hyps_limit := x) }
 
-let pr_context_of env sigma = match Flags.print_hyps_limit () with
-  | None -> hv 0 (pr_context_unlimited env sigma)
-  | Some n -> hv 0 (pr_context_limit n env sigma)
+let pr_context_of env sigma = match !print_hyps_limit with
+  | None -> hv 0 (pr_context_limit_compact env sigma)
+  | Some n -> hv 0 (pr_context_limit_compact ~n env sigma)
 
 (* display goal parts (Proof mode) *)
 
@@ -371,7 +487,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 () ++
@@ -379,7 +495,8 @@ let pr_transparent_state (ids, csts) =
 
 (* display complete goal *)
 let default_pr_goal gs =
-  let (g,sigma) = Goal.V82.nf_evar (project gs) (sig_it gs) in
+  let g = sig_it gs in
+  let sigma = project gs in
   let env = Goal.V82.env sigma g in
   let concl = Goal.V82.concl sigma g in
   let goal =
@@ -391,23 +508,25 @@ let default_pr_goal gs =
 (* display a goal tag *)
 let pr_goal_tag g =
   let s = " (ID " ^ Goal.uid g ^ ")" in
-  str (emacs_str s)
-
-let display_name = false
+  str s
 
 (* display a goal name *)
 let pr_goal_name sigma g =
-  if display_name then str " " ++ Pp.surround (pr_existential_key sigma g)
+  if should_gname() then str " " ++ Pp.surround (pr_existential_key sigma g)
   else mt ()
 
+let pr_goal_header nme sigma g =
+  let (g,sigma) = Goal.V82.nf_evar sigma g in
+  str "subgoal " ++ nme ++ (if should_tag() then pr_goal_tag g else str"")
+  ++ (if should_gname() then str " " ++ Pp.surround (pr_existential_key sigma g) else mt ())  
+
 (* display the conclusion of a goal *)
 let pr_concl n sigma g =
   let (g,sigma) = Goal.V82.nf_evar sigma g in
   let env = Goal.V82.env sigma g in
   let pc = pr_goal_concl_style_env env sigma (Goal.V82.concl sigma g) in
-    str (emacs_str "")  ++
-      str "subgoal " ++ int n ++ pr_goal_tag g ++ pr_goal_name sigma g ++
-      str " is:" ++ cut () ++ str" "  ++ pc
+  let header = pr_goal_header (int n) sigma g in
+  header ++ str " is:" ++ cut () ++ str" "  ++ pc
 
 (* display evar type: a context and a type *)
 let pr_evgl_sign sigma evi =
@@ -417,11 +536,10 @@ let pr_evgl_sign sigma evi =
   | None -> [], []
   | Some f -> List.filter2 (fun b c -> not b) f (evar_context evi)
   in
-  let open Context.Named.Declaration in
-  let ids = List.rev_map get_id l in
+  let ids = List.rev_map NamedDecl.get_id l in
   let warn =
     if List.is_empty ids then mt () else
-      (str "(" ++ prlist_with_sep pr_comma pr_id ids ++ str " cannot be used)")
+      (str " (" ++ prlist_with_sep pr_comma pr_id ids ++ str " cannot be used)")
   in
   let pc = pr_lconstr_env env sigma evi.evar_concl in
   let candidates =
@@ -433,7 +551,7 @@ let pr_evgl_sign sigma evi =
        mt ()
   in
   hov 0 (str"[" ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]" ++
-           candidates ++ spc () ++ warn)
+           candidates ++ warn)
 
 (* Print an existential variable *)
 
@@ -442,15 +560,25 @@ let pr_evar sigma (evk, evi) =
   hov 0 (pr_existential_key sigma evk ++ str " : " ++ pegl)
 
 (* Print an enumerated list of existential variables *)
-let rec pr_evars_int_hd head sigma i = function
+let rec pr_evars_int_hd pr sigma i = function
   | [] -> mt ()
   | (evk,evi)::rest ->
-      (hov 0 (head i ++ pr_evar sigma (evk,evi))) ++
-      (match rest with [] -> mt () | _ -> fnl () ++ pr_evars_int_hd head sigma (i+1) rest)
-
-let pr_evars_int sigma i evs = pr_evars_int_hd (fun i -> str "Existential " ++ int i ++ str " =" ++ spc ()) sigma i (Evar.Map.bindings evs)
-
-let pr_evars sigma evs = pr_evars_int_hd (fun i -> mt ()) sigma 1 (Evar.Map.bindings evs)
+      (hov 0 (pr i evk evi)) ++
+      (match rest with [] -> mt () | _ -> fnl () ++ pr_evars_int_hd pr sigma (i+1) rest)
+
+let pr_evars_int sigma ~shelf ~givenup i evs =
+  let pr_status i =
+    if List.mem i shelf then str " (shelved)"
+    else if List.mem i givenup then str " (given up)"
+    else mt () in
+  pr_evars_int_hd
+    (fun i evk evi ->
+      str "Existential " ++ int i ++ str " =" ++
+      spc () ++ pr_evar sigma (evk,evi) ++ pr_status evk)
+    sigma i (Evar.Map.bindings evs)
+
+let pr_evars sigma evs =
+  pr_evars_int_hd (fun i evk evi -> pr_evar sigma (evk,evi)) sigma 1 (Evar.Map.bindings evs)
 
 (* Display a list of evars given by their name, with a prefix *)
 let pr_ne_evar_set hd tl sigma l =
@@ -464,12 +592,12 @@ let pr_ne_evar_set hd tl sigma l =
 
 let pr_selected_subgoal name sigma g =
   let pg = default_pr_goal { sigma=sigma ; it=g; } in
-  v 0 (str "subgoal " ++ name ++ pr_goal_tag g ++ pr_goal_name sigma g
-       ++ str " is:" ++ cut () ++ pg)
+  let header = pr_goal_header name sigma g in
+  v 0 (header ++ str " is:" ++ cut () ++ pg)
 
 let default_pr_subgoal n sigma =
   let rec prrec p = function
-    | [] -> error "No such goal."
+    | [] -> user_err Pp.(str "No such goal.")
     | g::rest ->
 	if Int.equal p 1 then
           pr_selected_subgoal (int n) sigma g
@@ -478,7 +606,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 =
@@ -487,15 +615,15 @@ let print_evar_constraints gl sigma =
     | Some g ->
        let env = Goal.V82.env sigma g in fun e' ->
        begin
-         if Context.Named.equal (named_context env) (named_context e') then
-           if Context.Rel.equal (rel_context env) (rel_context e') then mt ()
+         if Context.Named.equal Constr.equal (named_context env) (named_context e') then
+           if Context.Rel.equal Constr.equal (rel_context env) (rel_context e') then mt ()
            else pr_rel_context_of e' sigma ++ str " |-" ++ spc ()
          else pr_context_of e' sigma ++ str " |-" ++ spc ()
        end
   in
   let pr_evconstr (pbty,env,t1,t2) =
-    let t1 = Evarutil.nf_evar sigma t1
-    and t2 = Evarutil.nf_evar sigma t2 in
+    let t1 = Evarutil.nf_evar sigma (EConstr.of_constr t1)
+    and t2 = Evarutil.nf_evar sigma (EConstr.of_constr t2) in
     let env =
       (** We currently allow evar instances to refer to anonymous de Bruijn
           indices, so we protect the error printing code in this case by giving
@@ -503,13 +631,13 @@ let print_evar_constraints gl sigma =
           problem. MS: we should rather stop depending on anonymous variables, they
           can be used to indicate independency. Also, this depends on a strategy for 
           naming/renaming *)
-      Namegen.make_all_name_different env in
+      Namegen.make_all_name_different env sigma in
     str" " ++
-      hov 2 (pr_env env ++ pr_lconstr_env env sigma t1 ++ spc () ++
+      hov 2 (pr_env env ++ pr_leconstr_env env sigma t1 ++ spc () ++
              str (match pbty with
                   | Reduction.CONV -> "=="
                   | Reduction.CUMUL -> "<=") ++
-             spc () ++ pr_lconstr_env env sigma t2)
+             spc () ++ pr_leconstr_env env sigma t2)
   in
   let pr_candidate ev evi (candidates,acc) =
     if Option.has_some evi.evar_candidates then
@@ -534,8 +662,7 @@ let should_print_dependent_evars = ref false
 let _ =
   let open Goptions in
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Printing Dependent Evars Line";
       optkey   = ["Printing";"Dependent";"Evars";"Line"];
       optread  = (fun () -> !should_print_dependent_evars);
@@ -558,27 +685,24 @@ let print_dependent_evars gl sigma seeds =
 	      end i (str ",")
 	end evars (str "")
     in
-    fnl () ++
-    str "(dependent evars:" ++ evars ++ str ")" ++ fnl ()
-    else
-      fnl () ++
-	str "(dependent evars: (printing disabled) )" ++ fnl ()
+    cut () ++ cut () ++
+    str "(dependent evars:" ++ evars ++ str ")"
+    else mt ()
   in
-  constraints ++ delayed_emacs_cmd evars
+  constraints ++ evars ()
 
 (* Print open subgoals. Checks for uninstantiated existential variables *)
 (* spiwack: [seeds] is for printing dependent evars in emacs mode. *)
 (* spiwack: [pr_first] is true when the first goal must be singled out
    and printed in its entirety. *)
-(* courtieu: in emacs mode, even less cases where the first goal is printed
-   in its entirety *)
-let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals =
+let default_pr_subgoals ?(pr_first=true)
+                        close_cmd sigma ~seeds ~shelf ~stack ~unfocused ~goals =
   (** Printing functions for the extra informations. *)
   let rec print_stack a = function
     | [] -> Pp.int a
     | b::l -> Pp.int a ++ str"-" ++ print_stack b l
   in
-  let print_unfocused l =
+  let print_unfocused_nums l =
     match l with
     | [] -> None
     | a::l -> Some (str"unfocused: " ++ print_stack a l)
@@ -598,7 +722,7 @@ let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals
     | [] -> Pp.mt ()
     | a::l -> Pp.spc () ++ str"(" ++ print_comma_separated_list a l ++ str")"
   in
-  let extra = Option.List.flatten [ print_unfocused stack ; print_shelf shelf ] in
+  let extra = Option.List.flatten [ print_unfocused_nums stack ; print_shelf shelf ] in
   let print_extra = print_extra_list extra in
   let focused_if_needed =
     let needed = not (CList.is_empty extra) && pr_first in
@@ -615,8 +739,9 @@ let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals
   in
   let print_multiple_goals g l =
     if pr_first then
-      default_pr_goal { it = g ; sigma = sigma; } ++ fnl () ++
-      pr_rec 2 l
+      default_pr_goal { it = g ; sigma = sigma; }
+      ++ (if l=[] then mt () else cut ())
+      ++ pr_rec 2 l
     else 
       pr_rec 1 (g::l)
   in
@@ -629,34 +754,29 @@ let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals
   match goals with
   | [] ->
       begin
-	let exl = Evarutil.non_instantiated sigma in
+	let exl = Evd.undefined_map sigma in
 	if Evar.Map.is_empty exl then
-	  (str"No more subgoals."
-	   ++ print_dependent_evars None sigma seeds)
+	  (str"No more subgoals." ++ print_dependent_evars None sigma seeds)
 	else
-	  let pei = pr_evars_int sigma 1 exl in
-	  (str "No more subgoals, but there are non-instantiated existential variables:"
-	   ++ fnl () ++ (hov 0 pei)
-	   ++ print_dependent_evars None sigma seeds ++ fnl () ++
-           str "You can use Grab Existential Variables.")
+          let pei = pr_evars_int sigma ~shelf ~givenup:[] 1 exl in
+	  v 0 ((str "No more subgoals,"
+                ++ str " but there are non-instantiated existential variables:"
+	        ++ cut () ++ (hov 0 pei)
+                ++ print_dependent_evars None sigma seeds
+                ++ cut () ++ str "You can use Grab Existential Variables."))
       end
-  | [g] when not !Flags.print_emacs && pr_first ->
-      let pg = default_pr_goal { it = g ; sigma = sigma; } in
-      v 0 (
-	str "1" ++ focused_if_needed ++ str"subgoal" ++ print_extra
-        ++ pr_goal_tag g ++ pr_goal_name sigma g ++ cut () ++ pg
-	++ print_dependent_evars (Some g) sigma seeds
-      )
   | g1::rest ->
       let goals = print_multiple_goals g1 rest in
       let ngoals = List.length rest+1 in
       v 0 (
-	int ngoals ++ focused_if_needed ++ str(String.plural ngoals "subgoal") ++
-          print_extra ++
-          str ((if display_name then (fun x -> x) else emacs_str) ", subgoal 1")
-        ++ pr_goal_tag g1
-        ++ pr_goal_name sigma g1 ++ cut ()
-	++ goals
+	int ngoals ++ focused_if_needed ++ str(String.plural ngoals "subgoal")
+        ++ print_extra
+        ++ str (if (should_gname()) then ", subgoal 1" else "")
+        ++ (if should_tag() then pr_goal_tag g1 else str"")
+        ++ pr_goal_name sigma g1 ++ cut () ++ goals
+        ++ (if unfocused=[] then str ""
+           else (cut() ++ cut() ++ str "*** Unfocused goals:" ++ cut()
+                 ++ pr_rec (List.length rest + 2) unfocused))
 	++ print_dependent_evars (Some g1) sigma seeds
       )
 
@@ -665,9 +785,9 @@ let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals
 
 
 type printer_pr = {
- pr_subgoals            : ?pr_first:bool -> std_ppcmds option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> std_ppcmds;
- pr_subgoal             : int -> evar_map -> goal list -> std_ppcmds;
- pr_goal                : goal sigma -> std_ppcmds;
+ pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> seeds:goal list -> shelf:goal list -> stack:int list -> unfocused:goal list -> goals:goal list -> Pp.t;
+ pr_subgoal             : int -> evar_map -> goal list -> Pp.t;
+ pr_goal                : goal sigma -> Pp.t;
 }
 
 let default_printer_pr = {
@@ -687,7 +807,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
@@ -699,66 +819,49 @@ let pr_open_subgoals ?(proof=Proof_global.give_me_the_proof ()) () =
   begin match goals with
   | [] -> let { Evd.it = bgoals ; sigma = bsigma } = Proof.V82.background_subgoals p in
           begin match bgoals,shelf,given_up with
-	  | [] , [] , [] -> pr_subgoals None sigma seeds shelf stack goals
+          | [] , [] , [] -> pr_subgoals None sigma ~seeds ~shelf ~stack ~unfocused:[] ~goals
           | [] , [] , _ ->
 	     Feedback.msg_info (str "No more subgoals, but there are some goals you gave up:");
 	     fnl ()
-            ++ pr_subgoals ~pr_first:false None bsigma seeds [] [] given_up
+            ++ pr_subgoals ~pr_first:false None bsigma ~seeds ~shelf:[] ~stack:[] ~unfocused:[] ~goals:given_up
             ++ fnl () ++ str "You need to go back and solve them."
           | [] , _ , _ ->
 	    Feedback.msg_info (str "All the remaining goals are on the shelf.");
 	    fnl ()
-            ++ pr_subgoals ~pr_first:false None bsigma seeds [] [] shelf
+            ++ pr_subgoals ~pr_first:false None bsigma ~seeds ~shelf:[] ~stack:[] ~unfocused:[] ~goals:shelf
 	  | _ , _, _ ->
             let end_cmd =
               str "This subproof is complete, but there are some unfocused goals." ++
-              (let s = Proof_global.Bullet.suggest p in
-               if Pp.is_empty s then s else fnl () ++ s) ++
+              (let s = Proof_bullet.suggest p in
+               if Pp.ismt s then s else fnl () ++ s) ++
               fnl ()
             in
-	    pr_subgoals ~pr_first:false (Some end_cmd) bsigma seeds shelf [] bgoals
+            pr_subgoals ~pr_first:false (Some end_cmd) bsigma ~seeds ~shelf ~stack:[] ~unfocused:[] ~goals:bgoals
 	  end
-  | _ -> pr_subgoals None sigma seeds shelf stack goals
+  | _ -> 
+     let { Evd.it = bgoals ; sigma = bsigma } = Proof.V82.background_subgoals p in
+     let bgoals_focused, bgoals_unfocused = List.partition (fun x -> List.mem x goals) bgoals in
+     let unfocused_if_needed = if should_unfoc() then bgoals_unfocused else [] in
+     pr_subgoals ~pr_first:true None bsigma ~seeds ~shelf ~stack:[] ~unfocused:unfocused_if_needed ~goals:bgoals_focused
   end
 
-let pr_nth_open_subgoal n =
-  let pf = get_pftreestate () 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 -> error "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 -> error "Invalid goal identifier."
+  with Not_found -> user_err Pp.(str "No such goal.")
 
 (* Elementary tactics *)
 
 let pr_prim_rule = function
-  | Cut (b,replace,id,t) ->
-     if b then
-       (* TODO: express "replace" *)
-       (str"assert " ++ str"(" ++ pr_id id ++ str":" ++ pr_lconstr t ++ str")")
-     else
-       let cl = if replace then str"clear " ++ pr_id id ++ str"; " else mt() in
-       (str"cut " ++ pr_constr t ++
-        str ";[" ++ cl ++ str"intro " ++ pr_id id ++ str"|idtac]")
-
   | Refine c ->
-      str(if Termops.occur_meta c then "refine " else "exact ") ++
+      (** FIXME *)
+      str(if Termops.occur_meta Evd.empty (EConstr.of_constr c) then "refine " else "exact ") ++
       Constrextern.with_meta_as_hole pr_constr c
 
 (* Backwards compatibility *)
@@ -770,15 +873,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 =
@@ -788,11 +891,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
@@ -805,16 +908,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"
@@ -822,15 +925,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 ()
@@ -857,7 +959,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)
@@ -901,6 +1003,11 @@ let pr_assumptionset env s =
 let xor a b = 
   (a && not b) || (not a && b)
 
+let pr_cumulative poly cum =
+  if poly then
+    if cum then str "Cumulative " else str "NonCumulative "
+  else mt ()
+
 let pr_polymorphic b = 
   let print = xor (Flags.is_universe_polymorphism ()) b in
   if print then
@@ -909,4 +1016,4 @@ let pr_polymorphic b =
 
 let pr_universe_instance evd ctx =
   let inst = Univ.UContext.instance ctx in
-    str"@{" ++ Univ.Instance.pr (Evd.pr_evd_level evd) inst ++ str"}"
+    str"@{" ++ Univ.Instance.pr (Termops.pr_evd_level evd) inst ++ str"}"
diff --git a/printing/printer.mli b/printing/printer.mli
index 695ab33b..41843680 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -1,192 +1,234 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 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, ... *)
 
+
+val enable_unfocused_goal_printing: bool ref
+val enable_goal_tags_printing      : bool ref
+val enable_goal_names_printing     : bool ref
+
 (** Terms *)
 
-val pr_lconstr_env         : env -> evar_map -> constr -> std_ppcmds
-val pr_lconstr             : constr -> std_ppcmds
-val pr_lconstr_goal_style_env : env -> evar_map -> constr -> std_ppcmds
+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_env          : env -> evar_map -> constr -> std_ppcmds
-val pr_constr              : constr -> std_ppcmds
-val pr_constr_goal_style_env : env -> evar_map -> constr -> std_ppcmds
+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 -> std_ppcmds
-val safe_pr_lconstr             : constr -> std_ppcmds
+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 -> std_ppcmds
-val safe_pr_constr              : constr -> std_ppcmds
+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_open_constr_env     : env -> evar_map -> open_constr -> std_ppcmds
-val pr_open_constr         : open_constr -> std_ppcmds
+val pr_econstr_n_env    : env -> evar_map -> Notation_term.tolerability -> EConstr.t -> Pp.t
 
-val pr_open_lconstr_env    : env -> evar_map -> open_constr -> std_ppcmds
-val pr_open_lconstr        : open_constr -> std_ppcmds
+val pr_etype_env           : env -> evar_map -> EConstr.types -> Pp.t
+val pr_letype_env           : env -> evar_map -> EConstr.types -> Pp.t
 
-val pr_constr_under_binders_env  : env -> evar_map -> constr_under_binders -> std_ppcmds
-val pr_constr_under_binders      : constr_under_binders -> std_ppcmds
+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_lconstr_under_binders_env : env -> evar_map -> constr_under_binders -> std_ppcmds
-val pr_lconstr_under_binders     : constr_under_binders -> std_ppcmds
+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_goal_concl_style_env : env -> evar_map -> types -> std_ppcmds
-val pr_ltype_env           : env -> evar_map -> types -> std_ppcmds
-val pr_ltype               : types -> std_ppcmds
+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_type_env            : env -> evar_map -> types -> std_ppcmds
-val pr_type                : types -> std_ppcmds
+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_closed_glob_env     : env -> evar_map -> closed_glob_constr -> std_ppcmds
-val pr_closed_glob         : closed_glob_constr -> std_ppcmds
+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_ljudge_env          : env -> evar_map -> unsafe_judgment -> std_ppcmds * std_ppcmds
-val pr_ljudge              : unsafe_judgment -> std_ppcmds * std_ppcmds
+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_lglob_constr_env      : env -> glob_constr -> std_ppcmds
-val pr_lglob_constr          : glob_constr -> std_ppcmds
+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_glob_constr_env       : env -> glob_constr -> std_ppcmds
-val pr_glob_constr           : glob_constr -> std_ppcmds
+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_lconstr_pattern_env : env -> evar_map -> constr_pattern -> std_ppcmds
-val pr_lconstr_pattern     : constr_pattern -> std_ppcmds
+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_constr_pattern_env  : env -> evar_map -> constr_pattern -> std_ppcmds
-val pr_constr_pattern      : constr_pattern -> std_ppcmds
+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_cases_pattern       : cases_pattern -> std_ppcmds
+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_sort                : evar_map -> sorts -> std_ppcmds
+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.t -> Pp.t
 
 (** Universe constraints *)
 
-val pr_polymorphic         : bool -> std_ppcmds
-val pr_universe_instance   : evar_map -> Univ.universe_context -> std_ppcmds
-val pr_universe_ctx        : evar_map -> Univ.universe_context -> std_ppcmds
+val pr_polymorphic         : bool -> Pp.t
+val pr_cumulative          : bool -> bool -> 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 -> std_ppcmds
-val pr_global              : global_reference -> std_ppcmds
+val pr_global_env          : Id.Set.t -> global_reference -> Pp.t
+val pr_global              : global_reference -> Pp.t
 
-val pr_constant            : env -> constant -> std_ppcmds
-val pr_existential_key     : evar_map -> existential_key -> std_ppcmds
-val pr_existential         : env -> evar_map -> existential -> std_ppcmds
-val pr_constructor         : env -> constructor -> std_ppcmds
-val pr_inductive           : env -> inductive -> std_ppcmds
-val pr_evaluable_reference : evaluable_global_reference -> std_ppcmds
+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
+val pr_evaluable_reference : evaluable_global_reference -> Pp.t
 
-val pr_pconstant           : env -> pconstant -> std_ppcmds
-val pr_pinductive          : env -> pinductive -> std_ppcmds
-val pr_pconstructor        : env -> pconstructor -> std_ppcmds
+val pr_pconstant           : env -> pconstant -> Pp.t
+val pr_pinductive          : env -> pinductive -> Pp.t
+val pr_pconstructor        : env -> pconstructor -> Pp.t
 
 
 (** Contexts *)
+(** Display compact contexts of goals (simple hyps on the same line) *)
+val set_compact_context : bool -> unit
+val get_compact_context : unit -> bool
 
-val pr_context_unlimited   : env -> evar_map -> std_ppcmds
-val pr_ne_context_of       : std_ppcmds -> env -> evar_map -> std_ppcmds
+val pr_context_unlimited   : env -> evar_map -> Pp.t
+val pr_ne_context_of       : Pp.t -> env -> evar_map -> Pp.t
 
-val pr_var_decl            : env -> evar_map -> Context.Named.Declaration.t -> std_ppcmds
-val pr_var_list_decl       : env -> evar_map -> Context.NamedList.Declaration.t -> std_ppcmds
-val pr_rel_decl            : env -> evar_map -> Context.Rel.Declaration.t -> std_ppcmds
+val pr_named_decl          : env -> evar_map -> Context.Named.Declaration.t -> Pp.t
+val pr_compacted_decl      : env -> evar_map -> Context.Compacted.Declaration.t -> Pp.t
+val pr_rel_decl            : env -> evar_map -> Context.Rel.Declaration.t -> Pp.t
 
-val pr_named_context       : env -> evar_map -> Context.Named.t -> std_ppcmds
-val pr_named_context_of    : env -> evar_map -> std_ppcmds
-val pr_rel_context         : env -> evar_map -> Context.Rel.t -> std_ppcmds
-val pr_rel_context_of      : env -> evar_map -> std_ppcmds
-val pr_context_of          : env -> evar_map -> std_ppcmds
+val pr_named_context       : env -> evar_map -> Context.Named.t -> Pp.t
+val pr_named_context_of    : env -> evar_map -> Pp.t
+val pr_rel_context         : env -> evar_map -> Context.Rel.t -> Pp.t
+val pr_rel_context_of      : env -> evar_map -> Pp.t
+val pr_context_of          : env -> evar_map -> Pp.t
 
 (** Predicates *)
 
-val pr_predicate           : ('a -> std_ppcmds) -> (bool * 'a list) -> std_ppcmds
-val pr_cpred               : Cpred.t -> std_ppcmds
-val pr_idpred              : Id.Pred.t -> std_ppcmds
-val pr_transparent_state   : transparent_state -> std_ppcmds
-
-(** Proofs *)
-
-val pr_goal                : goal sigma -> std_ppcmds
-val pr_subgoals            : ?pr_first:bool -> std_ppcmds option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> std_ppcmds
-val pr_subgoal             : int -> evar_map -> goal list -> std_ppcmds
-val pr_concl               : int -> evar_map -> goal -> std_ppcmds
-
-val pr_open_subgoals       : ?proof:Proof.proof -> unit -> std_ppcmds
-val pr_nth_open_subgoal    : int -> std_ppcmds
-val pr_evar                : evar_map -> (evar * evar_info) -> std_ppcmds
-val pr_evars_int           : evar_map -> int -> evar_info Evar.Map.t -> std_ppcmds
-val pr_evars               : evar_map -> evar_info Evar.Map.t -> std_ppcmds
-val pr_ne_evar_set         : std_ppcmds -> std_ppcmds -> evar_map ->
-  Evar.Set.t -> std_ppcmds
-
-val pr_prim_rule           : prim_rule -> std_ppcmds
-
-(** Emacs/proof general support
-   (emacs_str s) outputs
-    - s if emacs mode,
-    - nothing otherwise.
-    This function was previously used to insert special chars like
-    [(String.make 1 (Char.chr 253))] to parenthesize sub-parts of the
-    proof context for proof by pointing. This part of the code is
-    removed for now because it interacted badly with utf8. We may put
-    it back some day using some xml-like tags instead of special
-    chars. See for example the <prompt> tag in the prompt when in
-    emacs mode. *)
-val emacs_str              : string -> string
+val pr_predicate           : ('a -> Pp.t) -> (bool * 'a list) -> Pp.t
+val pr_cpred               : Cpred.t -> Pp.t
+val pr_idpred              : Id.Pred.t -> Pp.t
+val pr_transparent_state   : transparent_state -> Pp.t
+
+(** Proofs, these functions obey [Hyps Limit] and [Compact contexts]. *)
+
+val pr_goal                : goal sigma -> Pp.t
+
+(** [pr_subgoals ~pr_first pp sigma seeds shelf focus_stack unfocused goals]
+   prints the goals of the list [goals] followed by the goals in
+   [unfocused], in a short way (typically only the conclusion) except
+   for the first goal if [pr_first] is true. This function can be
+   replaced by another one by calling [set_printer_pr] (see below),
+   typically by plugin writers. The default printer prints only the
+   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 -> seeds:goal list -> shelf:goal list -> stack:int list -> unfocused:goal list -> goals: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.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 -> shelf:goal list -> givenup:goal list -> 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 ->
+  Evar.Set.t -> Pp.t
+
+val pr_prim_rule           : prim_rule -> Pp.t
 
 (** Backwards compatibility *)
 
-val prterm                 : constr -> std_ppcmds (** = pr_lconstr *)
+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 -> std_ppcmds
+val pr_assumptionset : env -> evar_map -> types ContextObjectMap.t -> Pp.t
 
-val pr_goal_by_id : Id.t -> std_ppcmds
-val pr_goal_by_uid : string -> std_ppcmds
+val pr_goal_by_id : proof:Proof.t -> Id.t -> Pp.t
 
 type printer_pr = {
- pr_subgoals            : ?pr_first:bool -> std_ppcmds option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> std_ppcmds;
- pr_subgoal             : int -> evar_map -> goal list -> std_ppcmds;
- pr_goal                : goal sigma -> std_ppcmds;
-};;
+ pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> seeds:goal list -> shelf:goal list -> stack:int list -> unfocused:goal list -> goals: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/printing.mllib b/printing/printing.mllib
index bc8f0750..86b68d8f 100644
--- a/printing/printing.mllib
+++ b/printing/printing.mllib
@@ -1,9 +1,7 @@
 Genprint
 Pputils
-Ppannotation
 Ppconstr
 Printer
-Pptactic
 Printmod
 Prettyp
 Ppvernac
diff --git a/printing/printmod.ml b/printing/printmod.ml
index dfa66d43..e076c10f 100644
--- a/printing/printmod.ml
+++ b/printing/printmod.ml
@@ -1,18 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
-open Term
+open Constr
 open Pp
 open Names
 open Environ
 open Declarations
-open Nameops
 open Globnames
 open Libnames
 open Goptions
@@ -26,12 +27,23 @@ open Goptions
     the "short" mode or (Some env) in the "rich" one.
 *)
 
+module Tag =
+struct
+
+  let definition = "module.definition"
+  let keyword    = "module.keyword"
+
+end
+
+let tag t s = Pp.tag t s
+let tag_definition s = tag Tag.definition s
+let tag_keyword s = tag Tag.keyword s
+
 let short = ref false
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "short module printing";
       optkey   = ["Short";"Module";"Printing"];
       optread  = (fun () -> !short) ;
@@ -44,14 +56,8 @@ let mk_fake_top =
   let r = ref 0 in
   fun () -> incr r; Id.of_string ("FAKETOP"^(string_of_int !r))
 
-module Make (Taggers : sig
-  val tag_definition : std_ppcmds -> std_ppcmds
-  val tag_keyword : std_ppcmds -> std_ppcmds
-end) =
-struct
-
-let def s = Taggers.tag_definition (str s)
-let keyword s = Taggers.tag_keyword (str s)
+let def s = tag_definition (str s)
+let keyword s = tag_keyword (str s)
 
 let get_new_id locals id =
   let rec get_id l id =
@@ -59,9 +65,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 *)
 
@@ -74,7 +81,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)
@@ -83,47 +90,74 @@ let build_ind_type env mip =
   Inductive.type_of_inductive env mip
 
 let print_one_inductive env sigma mib ((_,i) as ind) =
-  let u = if mib.mind_polymorphic then 
-      Univ.UContext.instance mib.mind_universes 
+  let u = if Declareops.inductive_is_polymorphic mib then 
+      Univ.AUContext.instance (Declareops.inductive_polymorphic_context mib)
     else Univ.Instance.empty in
   let mip = mib.mind_packets.(i) in
   let params = Inductive.inductive_paramdecls (mib,u) in
-  let args = Context.Rel.to_extended_list 0 params in
-  let arity = hnf_prod_applist env (build_ind_type env ((mib,mip),u)) args in
+  let nparamdecls = Context.Rel.length params in
+  let args = Context.Rel.to_extended_list mkRel 0 params 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 mib.mind_polymorphic then
-      Printer.pr_universe_instance sigma mib.mind_universes
+    if Declareops.inductive_is_polymorphic mib then
+      let ctx = Declareops.inductive_polymorphic_context mib in
+      let ctx = Univ.UContext.make (u, Univ.AUContext.instantiate u ctx) in
+      Printer.pr_universe_instance sigma ctx
     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 print_mutual_inductive env mind mib =
+let instantiate_cumulativity_info cumi =
+  let open Univ in
+  let univs = ACumulativityInfo.univ_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, ACumulativityInfo.variance cumi)
+
+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 sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) in
-  hov 0 (Printer.pr_polymorphic mib.mind_polymorphic ++
-    def keyword ++ spc () ++
-    prlist_with_sep (fun () -> fnl () ++ str"  with ")
-      (print_one_inductive env sigma mib) inds ++
-      Printer.pr_universe_ctx sigma (Univ.instantiate_univ_context mib.mind_universes))
+  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 (UState.of_binders bl) in
+  hov 0 (Printer.pr_polymorphic (Declareops.inductive_is_polymorphic mib) ++
+         Printer.pr_cumulative
+           (Declareops.inductive_is_polymorphic mib) 
+           (Declareops.inductive_is_cumulative mib) ++
+         def keyword ++ spc () ++
+         prlist_with_sep (fun () -> fnl () ++ str"  with ")
+           (print_one_inductive env sigma mib) inds ++
+         match mib.mind_universes with
+         | Monomorphic_ind _ | Polymorphic_ind _ -> str ""
+         | Cumulative_ind cumi ->
+           Printer.pr_cumulativity_info
+             sigma (instantiate_cumulativity_info cumi))
 
 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
@@ -134,24 +168,26 @@ let get_fields =
   in
   prodec_rec [] []
 
-let print_record env mind mib =
+let print_record env mind mib udecl =
   let u = 
-    if mib.mind_polymorphic then 
-      Univ.UContext.instance mib.mind_universes 
+    if Declareops.inductive_is_polymorphic mib then 
+      Univ.AUContext.instance (Declareops.inductive_polymorphic_context mib)
     else Univ.Instance.empty 
   in
   let mip = mib.mind_packets.(0) in
   let params = Inductive.inductive_paramdecls (mib,u) in
-  let args = Context.Rel.to_extended_list 0 params in
-  let arity = hnf_prod_applist env (build_ind_type env ((mib,mip),u)) args in
+  let nparamdecls = Context.Rel.length params in
+  let args = Context.Rel.to_extended_list mkRel 0 params 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 sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) 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 (UState.of_binders bl) in
   let keyword =
-    let open Decl_kinds in
+    let open Declarations in
     match mib.mind_finite with
     | BiFinite -> "Record"
     | Finite -> "Inductive"
@@ -159,31 +195,39 @@ let print_record env mind mib =
   in
   hov 0 (
     hov 0 (
-      Printer.pr_polymorphic mib.mind_polymorphic ++
-      def keyword ++ spc () ++ pr_id mip.mind_typename ++ brk(1,4) ++
+      Printer.pr_polymorphic (Declareops.inductive_is_polymorphic mib) ++
+      Printer.pr_cumulative
+        (Declareops.inductive_is_polymorphic mib)
+        (Declareops.inductive_is_cumulative mib) ++
+      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" }" ++
-      Printer.pr_universe_ctx sigma (Univ.instantiate_univ_context mib.mind_universes))
-
-let pr_mutual_inductive_body env mind mib =
+    match mib.mind_universes with
+    | Monomorphic_ind _ | Polymorphic_ind _ -> str ""
+    | Cumulative_ind cumi ->
+      Printer.pr_cumulativity_info
+        sigma (instantiate_cumulativity_info cumi)
+  )
+
+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 =
@@ -204,10 +248,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
@@ -267,15 +311,18 @@ 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
     | SFBconst cb ->
+       let ctx = Declareops.constant_polymorphic_context cb in
        let u =
-	 if cb.const_polymorphic then Univ.UContext.instance cb.const_universes
+	 if Declareops.constant_is_polymorphic cb then
+            Univ.AUContext.instance ctx
 	 else Univ.Instance.empty
        in
+       let ctx = Univ.UContext.make (u, Univ.AUContext.instantiate u ctx) in
        let sigma = Evd.empty in
       (match cb.const_body with
 	| Def _ -> def "Definition" ++ spc ()
@@ -287,7 +334,7 @@ let print_body is_impl env mp (l,body) =
 	    str " :" ++ spc () ++
 	    hov 0 (Printer.pr_ltype_env env sigma
 		(Vars.subst_instance_constr u
-   		  (Typeops.type_of_constant_type env cb.const_type))) ++
+   		  cb.const_type)) ++
 	    (match cb.const_body with
 	      | Def l when is_impl ->
 		spc () ++
@@ -295,14 +342,14 @@ let print_body is_impl env mp (l,body) =
 		       Printer.pr_lconstr_env env sigma
 			  (Vars.subst_instance_constr u (Mod_subst.force_constr l)))
 	      | _ -> mt ()) ++ str "." ++
-	    Printer.pr_universe_ctx sigma (Univ.instantiate_univ_context cb.const_universes))
+	    Printer.pr_universe_ctx sigma ctx)
     | 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"
@@ -338,9 +385,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() ++
@@ -366,7 +416,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 =
@@ -397,11 +447,11 @@ let rec printable_body dir =
 
 let print_expression' is_type env mp me =
   States.with_state_protection
-    (fun e -> eval_ppcmds (print_expression is_type env mp [] e)) me
+    (fun e -> print_expression is_type env mp [] e) me
 
 let print_signature' is_type env mp me =
   States.with_state_protection
-    (fun e -> eval_ppcmds (print_signature is_type env mp [] e)) me
+    (fun e -> print_signature is_type env mp [] e) me
 
 let unsafe_print_module env mp with_body mb =
   let name = print_modpath [] mp in
@@ -441,20 +491,4 @@ let print_modtype kn =
       with e when CErrors.noncritical e ->
 	print_signature' true None kn mtb.mod_type))
 
-end
-
-module Tag =
-struct
-  let definition =
-    let style = Terminal.make ~bold:true ~fg_color:`LIGHT_RED () in
-    Ppstyle.make ~style ["module"; "definition"]
-  let keyword =
-    let style = Terminal.make ~bold:true () in
-    Ppstyle.make ~style ["module"; "keyword"]
-end
 
-include Make(struct
-  let tag t s = Pp.tag (Pp.Tag.inj t Ppstyle.tag) s
-  let tag_definition s = tag Tag.definition s
-  let tag_keyword s = tag Tag.keyword s
-end)
diff --git a/printing/printmod.mli b/printing/printmod.mli
index 7f7d3439..b0b0b0a3 100644
--- a/printing/printmod.mli
+++ b/printing/printmod.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -11,4 +13,8 @@ open Names
 (** false iff the module is an element of an open module type *)
 val printable_body : DirPath.t -> bool
 
-include Printmodsig.Pp
+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/printing/printmodsig.mli b/printing/printmodsig.mli
deleted file mode 100644
index f71fffdc..00000000
--- a/printing/printmodsig.mli
+++ /dev/null
@@ -1,17 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Names
-
-module type Pp =
-sig
-  val pr_mutual_inductive_body : Environ.env -> mutual_inductive -> Declarations.mutual_inductive_body -> std_ppcmds
-  val print_module : bool -> module_path -> std_ppcmds
-  val print_modtype : module_path -> std_ppcmds
-end
diff --git a/proofs/clenv.ml b/proofs/clenv.ml
index 0a90e0db..03ff580a 100644
--- a/proofs/clenv.ml
+++ b/proofs/clenv.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -12,11 +14,12 @@ open Util
 open Names
 open Nameops
 open Term
-open Vars
 open Termops
 open Namegen
 open Environ
 open Evd
+open EConstr
+open Vars
 open Reduction
 open Reductionops
 open Tacred
@@ -24,12 +27,6 @@ open Pretype_errors
 open Evarutil
 open Unification
 open Misctypes
-open Sigma.Notations
-
-(* Abbreviations *)
-
-let pf_env = Refiner.pf_env
-let pf_type_of gls c  = Typing.unsafe_type_of (pf_env gls) gls.sigma c
 
 (******************************************************************)
 (* Clausal environments *)
@@ -43,12 +40,6 @@ type clausenv = {
 let cl_env ce = ce.env
 let cl_sigma ce =  ce.evd
 
-let map_clenv sub clenv =
-  { templval = map_fl sub clenv.templval;
-    templtyp = map_fl sub clenv.templtyp;
-    evd = cmap sub clenv.evd;
-    env = clenv.env }
-
 let clenv_nf_meta clenv c = nf_meta clenv.evd c
 let clenv_term clenv c = meta_instance clenv.evd c
 let clenv_meta_type clenv mv = Typing.meta_type clenv.evd mv
@@ -56,9 +47,9 @@ let clenv_value clenv = meta_instance clenv.evd clenv.templval
 let clenv_type clenv = meta_instance clenv.evd clenv.templtyp
 
 let refresh_undefined_univs clenv =
-  match kind_of_term clenv.templval.rebus with
+  match EConstr.kind clenv.evd clenv.templval.rebus with
   | Var _ -> clenv, Univ.empty_level_subst
-  | App (f, args) when isVar f -> clenv, Univ.empty_level_subst
+  | App (f, args) when isVar clenv.evd f -> clenv, Univ.empty_level_subst
   | _ ->  
     let evd', subst = Evd.refresh_undefined_universes clenv.evd in
     let map_freelisted f = { f with rebus = subst_univs_level_constr subst f.rebus } in
@@ -71,15 +62,18 @@ let clenv_get_type_of ce c = Retyping.get_type_of (cl_env ce) (cl_sigma ce) c
 
 exception NotExtensibleClause
 
+let mk_freelisted c =
+  map_fl EConstr.of_constr (mk_freelisted (EConstr.Unsafe.to_constr c))
+
 let clenv_push_prod cl =
   let typ = whd_all (cl_env cl) (cl_sigma cl) (clenv_type cl) in
-  let rec clrec typ = match kind_of_term typ with
+  let rec clrec typ = match EConstr.kind cl.evd typ with
     | Cast (t,_,_) -> clrec t
     | Prod (na,t,u) ->
 	let mv = new_meta () in
-	let dep = dependent (mkRel 1) u in
+	let dep = not (noccurn (cl_sigma cl) 1 u) in
 	let na' = if dep then na else Anonymous in
-	let e' = meta_declare mv t ~name:na' cl.evd in
+	let e' = meta_declare mv (EConstr.Unsafe.to_constr t) ~name:na' cl.evd in
 	let concl = if dep then subst1 (mkMeta mv) u else u in
 	let def = applist (cl.templval.rebus,[mkMeta mv]) in
 	{ templval = mk_freelisted def;
@@ -103,14 +97,17 @@ let clenv_push_prod cl =
    and [ccl] is [forall y, Meta n1=y -> y=Meta n1] *)
 
 let clenv_environments evd bound t =
+  let open EConstr in
+  let open Vars in
   let rec clrec (e,metas) n t =
-    match n, kind_of_term t with
+    match n, EConstr.kind evd t with
       | (Some 0, _) -> (e, List.rev metas, t)
       | (n, Cast (t,_,_)) -> clrec (e,metas) n t
       | (n, Prod (na,t1,t2)) ->
 	  let mv = new_meta () in
-	  let dep = not (noccurn 1 t2) in
+	  let dep = not (noccurn evd 1 t2) in
 	  let na' = if dep then na else Anonymous in
+	  let t1 = EConstr.Unsafe.to_constr t1 in
 	  let e' = meta_declare mv t1 ~name:na' e in
 	  clrec (e', (mkMeta mv)::metas) (Option.map ((+) (-1)) n)
 	    (if dep then (subst1 (mkMeta mv) t2) else t2)
@@ -128,11 +125,13 @@ let mk_clenv_from_env env sigma n (c,cty) =
     env = env }
 
 let mk_clenv_from_n gls n (c,cty) =
-  mk_clenv_from_env (pf_env gls) gls.sigma n (c, cty)
+  let env = Proofview.Goal.env gls in
+  let sigma = Tacmach.New.project gls in
+  mk_clenv_from_env env sigma n (c, cty)
 
 let mk_clenv_from gls = mk_clenv_from_n gls None
 
-let mk_clenv_type_of gls t = mk_clenv_from gls (t,pf_type_of gls t)
+let mk_clenv_type_of gls t = mk_clenv_from gls (t,Tacmach.New.pf_unsafe_type_of gls t)
 
 (******************************************************************)
 
@@ -155,28 +154,28 @@ let error_incompatible_inst clenv mv  =
   let na = meta_name clenv.evd mv in
   match na with
       Name id ->
-        errorlabstrm "clenv_assign"
+        user_err ~hdr:"clenv_assign"
           (str "An incompatible instantiation has already been found for " ++
-           pr_id id)
+           Id.print id)
     | _ ->
-        anomaly ~label:"clenv_assign" (Pp.str "non dependent metavar already assigned")
+        anomaly ~label:"clenv_assign" (Pp.str "non dependent metavar already assigned.")
 
 (* TODO: replace by clenv_unify (mkMeta mv) rhs ? *)
 let clenv_assign mv rhs clenv =
   let rhs_fls = mk_freelisted rhs in
   if Metaset.exists (mentions clenv mv) rhs_fls.freemetas then
-    error "clenv_assign: circularity in unification";
+    user_err Pp.(str "clenv_assign: circularity in unification");
   try
     if meta_defined clenv.evd mv then
-      if not (Term.eq_constr (fst (meta_fvalue clenv.evd mv)).rebus rhs) then
+      if not (EConstr.eq_constr clenv.evd (EConstr.of_constr (fst (meta_fvalue clenv.evd mv)).rebus) rhs) then
         error_incompatible_inst clenv mv
       else
 	clenv
     else
       let st = (Conv,TypeNotProcessed) in
-      {clenv with evd = meta_assign mv (rhs_fls.rebus,st) clenv.evd}
+      {clenv with evd = meta_assign mv (EConstr.Unsafe.to_constr rhs_fls.rebus,st) clenv.evd}
   with Not_found ->
-    error "clenv_assign: undefined meta"
+    user_err Pp.(str "clenv_assign: undefined meta")
 
 
 
@@ -219,7 +218,7 @@ let clenv_assign mv rhs clenv =
 *)
 
 let clenv_metas_in_type_of_meta evd mv =
-  (mk_freelisted (meta_instance evd (meta_ftype evd mv))).freemetas
+  (mk_freelisted (meta_instance evd (map_fl EConstr.of_constr (meta_ftype evd mv)))).freemetas
 
 let dependent_in_type_of_metas clenv mvs =
   List.fold_right
@@ -262,35 +261,38 @@ let clenv_unify ?(flags=default_unify_flags ()) cv_pb t1 t2 clenv =
 let clenv_unify_meta_types ?(flags=default_unify_flags ()) clenv =
   { clenv with evd = w_unify_meta_types ~flags:flags clenv.env clenv.evd }
 
-let clenv_unique_resolver ?(flags=default_unify_flags ()) clenv gl =
-  let concl = Goal.V82.concl clenv.evd (sig_it gl) in
-  if isMeta (fst (decompose_appvect (whd_nored clenv.evd clenv.templtyp.rebus))) then
+let clenv_unique_resolver_gen ?(flags=default_unify_flags ()) clenv concl =
+  if isMeta clenv.evd (fst (decompose_app_vect clenv.evd (whd_nored clenv.evd clenv.templtyp.rebus))) then
     clenv_unify CUMUL ~flags (clenv_type clenv) concl
       (clenv_unify_meta_types ~flags clenv)
   else
     clenv_unify CUMUL ~flags
       (meta_reducible_instance clenv.evd clenv.templtyp) concl clenv
 
+let old_clenv_unique_resolver ?flags clenv gl =
+  let concl = Goal.V82.concl clenv.evd (sig_it gl) in
+  clenv_unique_resolver_gen ?flags clenv concl
+
+let clenv_unique_resolver ?flags clenv gl =
+  let concl = Proofview.Goal.concl gl in
+  clenv_unique_resolver_gen ?flags clenv concl
+
 let adjust_meta_source evd mv = function
   | loc,Evar_kinds.VarInstance id ->
     let rec match_name c l =
-      match kind_of_term c, l with
-      | Lambda (Name id,_,c), a::l when Constr.equal a (mkMeta mv) -> Some id
+      match EConstr.kind evd c, l with
+      | Lambda (Name id,_,c), a::l when EConstr.eq_constr evd a (mkMeta mv) -> Some id
       | Lambda (_,_,c), a::l -> match_name c l
       | _ -> None in
     (* This is very ad hoc code so that an evar inherits the name of the binder
        in situations like "ex_intro (fun x => P) ?ev p" *)
     let f = function (mv',(Cltyp (_,t) | Clval (_,_,t))) ->
       if Metaset.mem mv t.freemetas then
-        let f,l = decompose_app t.rebus in
-        match kind_of_term f with
+        let f,l = decompose_app evd (EConstr.of_constr t.rebus) in
+        match EConstr.kind evd f with
         | Meta mv'' ->
           (match meta_opt_fvalue evd mv'' with
-          | Some (c,_) -> match_name c.rebus l
-          | None -> None)
-        | Evar ev ->
-          (match existential_opt_value evd ev with
-          | Some c -> match_name c l
+          | Some (c,_) -> match_name (EConstr.of_constr c.rebus) l
           | None -> None)
         | _ -> None
       else None in
@@ -332,13 +334,12 @@ let clenv_pose_metas_as_evars clenv dep_mvs =
       let ty = clenv_meta_type clenv mv in
       (* Postpone the evar-ization if dependent on another meta *)
       (* This assumes no cycle in the dependencies - is it correct ? *)
-      if occur_meta ty then fold clenv (mvs@[mv])
+      if occur_meta clenv.evd ty then fold clenv (mvs@[mv])
       else
         let src = evar_source_of_meta mv clenv.evd in
         let src = adjust_meta_source clenv.evd mv src in
-        let evd = Sigma.Unsafe.of_evar_map clenv.evd in
-	let Sigma (evar, evd, _) = new_evar (cl_env clenv) evd ~src ty in
-	let evd = Sigma.to_evar_map evd in
+        let evd = clenv.evd in
+	let (evd, evar) = new_evar (cl_env clenv) evd ~src ty in
 	let clenv = clenv_assign mv evar {clenv with evd=evd} in
 	fold clenv mvs in
   fold clenv dep_mvs
@@ -404,7 +405,7 @@ type arg_bindings = constr explicit_bindings
  * of cval, ctyp. *)
 
 let clenv_independent clenv =
-  let mvs = collect_metas (clenv_value clenv) in
+  let mvs = collect_metas clenv.evd (clenv_value clenv) in
   let ctyp_mvs = (mk_freelisted (clenv_type clenv)).freemetas in
   let deps = Metaset.union (dependent_in_type_of_metas clenv mvs) ctyp_mvs in
   List.filter (fun mv -> not (Metaset.mem mv deps)) mvs
@@ -415,13 +416,13 @@ let qhyp_eq h1 h2 = match h1, h2 with
 | _ -> false
 
 let check_bindings bl =
-  match List.duplicates qhyp_eq (List.map pi2 bl) with
+  match List.duplicates qhyp_eq (List.map (fun {CAst.v=x} -> fst x) bl) with
     | NamedHyp s :: _ ->
-	errorlabstrm ""
-	  (str "The variable " ++ pr_id s ++
+	user_err 
+	  (str "The variable " ++ Id.print s ++
 	   str " occurs more than once in binding list.");
     | AnonHyp n :: _ ->
-	errorlabstrm ""
+	user_err 
 	  (str "The position " ++ int n ++
 	   str " occurs more than once in binding list.")
     | [] -> ()
@@ -432,16 +433,16 @@ let explain_no_such_bound_variable evd id =
     | Cltyp (na, _) -> na
     | Clval (na, _, _) -> na
     in
-    if na != Anonymous then out_name na :: l else l
+    if na != Anonymous then Name.get_id na :: l else l
   in
   let mvl = List.fold_left fold [] (Evd.meta_list evd) in
-  errorlabstrm "Evd.meta_with_name"
-    (str"No such bound variable " ++ pr_id id ++
+  user_err ~hdr:"Evd.meta_with_name"
+    (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,8 +461,8 @@ let meta_with_name evd id =
     | ([n],_|_,[n]) ->
         n
     | _  ->
-        errorlabstrm "Evd.meta_with_name"
-          (str "Binder name \"" ++ pr_id id ++
+        user_err ~hdr:"Evd.meta_with_name"
+          (str "Binder name \"" ++ Id.print id ++
            strbrk "\" occurs more than once in clause.")
 
 let meta_of_binder clause loc mvs = function
@@ -469,20 +470,20 @@ let meta_of_binder clause loc mvs = function
   | AnonHyp n ->
       try List.nth mvs (n-1)
       with (Failure _|Invalid_argument _) ->
-        errorlabstrm "" (str "No such binder.")
+        user_err  (str "No such binder.")
 
 let error_already_defined b =
   match b with
     | NamedHyp id ->
-        errorlabstrm ""
-          (str "Binder name \"" ++ pr_id id ++
+        user_err 
+          (str "Binder name \"" ++ Id.print id ++
            str"\" already defined with incompatible value.")
     | AnonHyp n ->
         anomaly
           (str "Position " ++ int n ++ str" already defined.")
 
 let clenv_unify_binding_type clenv c t u =
-  if isMeta (fst (decompose_appvect (whd_nored clenv.evd u))) then
+  if isMeta clenv.evd (fst (decompose_app_vect clenv.evd (whd_nored clenv.evd u))) then
     (* Not enough information to know if some subtyping is needed *)
     CoerceToType, clenv, c
   else
@@ -499,8 +500,9 @@ 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 }
 
 let clenv_match_args bl clenv =
@@ -510,10 +512,10 @@ let clenv_match_args bl clenv =
     let mvs = clenv_independent clenv in
     check_bindings bl;
     List.fold_left
-      (fun clenv (loc,b,c) ->
+      (fun clenv {CAst.loc;v=(b,c)} ->
 	let k = meta_of_binder clenv loc mvs b in
         if meta_defined clenv.evd k then
-          if Term.eq_constr (fst (meta_fvalue clenv.evd k)).rebus c then clenv
+          if EConstr.eq_constr clenv.evd (EConstr.of_constr (fst (meta_fvalue clenv.evd k)).rebus) c then clenv
           else error_already_defined b
         else
 	  clenv_assign_binding clenv k c)
@@ -522,12 +524,12 @@ let clenv_match_args bl clenv =
 exception NoSuchBinding
 
 let clenv_constrain_last_binding c clenv =
-  let all_mvs = collect_metas clenv.templval.rebus in
+  let all_mvs = collect_metas clenv.evd clenv.templval.rebus in
   let k = try List.last all_mvs with Failure _ -> raise NoSuchBinding in
   clenv_assign_binding clenv k c
 
 let error_not_right_number_missing_arguments n =
-  errorlabstrm ""
+  user_err 
     (strbrk "Not the right number of missing arguments (expected " ++
       int n ++ str ").")
 
@@ -557,8 +559,9 @@ 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 Id.Set.empty [] t in
       let clause = mk_clenv_from_env env sigma n
-	(c,rename_bound_vars_as_displayed [] [] t)
+	(c, t)
       in clenv_match_args lbind clause
   | NoBindings ->
       mk_clenv_from_env env sigma n (c,t)
@@ -585,34 +588,34 @@ let pr_clenv clenv =
 (** Evar version of mk_clenv *)
 
 type hole = {
-  hole_evar : constr;
-  hole_type : types;
+  hole_evar : EConstr.constr;
+  hole_type : EConstr.types;
   hole_deps  : bool;
   hole_name : Name.t;
 }
 
 type clause = {
   cl_holes : hole list;
-  cl_concl : types;
+  cl_concl : EConstr.types;
 }
 
 let make_evar_clause env sigma ?len t =
+  let open EConstr in
+  let open Vars in
   let bound = match len with
   | None -> -1
   | Some n -> assert (0 <= n); n
   in
   (** FIXME: do the renaming online *)
-  let t = rename_bound_vars_as_displayed [] [] 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 kind_of_term t with
+    else match EConstr.kind sigma t with
     | Cast (t, _, _) -> clrec (sigma, holes) n t
     | Prod (na, t1, t2) ->
       let store = Typeclasses.set_resolvable Evd.Store.empty false in
-      let sigma = Sigma.Unsafe.of_evar_map sigma in
-      let Sigma (ev, sigma, _) = new_evar ~store env sigma t1 in
-      let sigma = Sigma.to_evar_map sigma in
-      let dep = dependent (mkRel 1) t2 in
+      let (sigma, ev) = new_evar ~store env sigma t1 in
+      let dep = not (noccurn sigma 1 t2) in
       let hole = {
         hole_evar = ev;
         hole_type = t1;
@@ -638,10 +641,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
-  errorlabstrm "" (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
@@ -653,38 +656,41 @@ let evar_with_name holes id =
   | [] -> explain_no_such_bound_variable holes id
   | [h] -> h.hole_evar
   | _ ->
-    errorlabstrm ""
-      (str "Binder name \"" ++ pr_id id ++
+    user_err 
+      (str "Binder name \"" ++ Id.print id ++
         str "\" occurs more than once in clause.")
 
 let evar_of_binder holes = function
 | NamedHyp s -> evar_with_name holes s
 | AnonHyp n ->
   try
-    let h = List.nth holes (pred n) in
+    let nondeps = List.filter (fun hole -> not hole.hole_deps) holes in
+    let h = List.nth nondeps (pred n) in
     h.hole_evar
   with e when CErrors.noncritical e ->
-    errorlabstrm "" (str "No such binder.")
+    user_err  (str "No such binder.")
 
 let define_with_type sigma env ev c =
+  let open EConstr in
   let t = Retyping.get_type_of env sigma ev in
   let ty = Retyping.get_type_of env sigma c in
   let j = Environ.make_judge c ty in
-  let (sigma, j) = Coercion.inh_conv_coerce_to true (Loc.ghost) env sigma j t in
-  let (ev, _) = destEvar ev in
-  let sigma = Evd.define ev j.Environ.uj_val sigma in
+  let (sigma, j) = Coercion.inh_conv_coerce_to true env sigma j t in
+  let (ev, _) = destEvar sigma ev in
+  let sigma = Evd.define ev (EConstr.Unsafe.to_constr j.Environ.uj_val) sigma in
   sigma
 
 let solve_evar_clause env sigma hyp_only clause = function
 | NoBindings -> sigma
 | ImplicitBindings largs ->
+  let open EConstr in
   let fold holes h =
     if h.hole_deps then
       (** Some subsequent term uses the hole *)
-      let (ev, _) = destEvar h.hole_evar in
-      let is_dep hole = occur_evar ev hole.hole_type in
+      let (ev, _) = destEvar sigma h.hole_evar in
+      let is_dep hole = occur_evar sigma ev hole.hole_type in
       let in_hyp = List.exists is_dep holes in
-      let in_ccl = occur_evar ev clause.cl_concl in
+      let in_ccl = occur_evar sigma ev clause.cl_concl in
       let dep = if hyp_only then in_hyp && not in_ccl else in_hyp || in_ccl in
       let h = { h with hole_deps = dep } in
       h :: holes
@@ -704,7 +710,7 @@ let solve_evar_clause env sigma hyp_only clause = function
     error_not_right_number_missing_arguments len
 | ExplicitBindings lbind ->
   let () = check_bindings lbind in
-  let fold sigma (_, binder, c) =
+  let fold sigma {CAst.v=(binder, c)} =
     let ev = evar_of_binder clause.cl_holes binder in
     define_with_type sigma env ev c
   in
diff --git a/proofs/clenv.mli b/proofs/clenv.mli
index e9236b1d..b85c4fc5 100644
--- a/proofs/clenv.mli
+++ b/proofs/clenv.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file defines clausenv, which is a deprecated way to handle open terms
@@ -11,9 +13,10 @@
     evar-based clauses. *)
 
 open Names
-open Term
+open Constr
 open Environ
 open Evd
+open EConstr
 open Unification
 open Misctypes
 
@@ -28,8 +31,6 @@ type clausenv = {
   templtyp : constr freelisted (** its type *)}
 
 
-val map_clenv : (constr -> constr) -> clausenv -> clausenv
-
 (** subject of clenv (instantiated) *)
 val clenv_value     : clausenv -> constr
 
@@ -37,16 +38,16 @@ val clenv_value     : clausenv -> constr
 val clenv_type      : clausenv -> types
 
 (** substitute resolved metas *)
-val clenv_nf_meta   : clausenv -> constr -> constr
+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 : Goal.goal sigma -> constr * types -> clausenv
+val mk_clenv_from : Proofview.Goal.t -> EConstr.constr * EConstr.types -> clausenv
 val mk_clenv_from_n :
-  Goal.goal sigma -> int option -> constr * types -> clausenv
-val mk_clenv_type_of : Goal.goal sigma -> constr -> clausenv
-val mk_clenv_from_env : env -> evar_map -> int option -> constr * types -> 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 *)
 val refresh_undefined_univs : clausenv -> clausenv * Univ.universe_level_subst
@@ -63,9 +64,12 @@ val clenv_unify :
   ?flags:unify_flags -> conv_pb -> constr -> constr -> clausenv -> clausenv
 
 (** unifies the concl of the goal with the type of the clenv *)
-val clenv_unique_resolver :
+val old_clenv_unique_resolver :
   ?flags:unify_flags -> clausenv -> Goal.goal sigma -> clausenv
 
+val clenv_unique_resolver :
+  ?flags:unify_flags -> clausenv -> Proofview.Goal.t -> clausenv
+
 val clenv_dependent : clausenv -> metavariable list
 
 val clenv_pose_metas_as_evars : clausenv -> metavariable list -> clausenv
@@ -92,25 +96,25 @@ val clenv_unify_meta_types : ?flags:unify_flags -> clausenv -> clausenv
    the optional int tells how many prods of the lemma have to be used 
    use all of them if None *)
 val make_clenv_binding_env_apply :
-  env -> evar_map -> int option -> constr * constr -> constr bindings ->
+  env -> evar_map -> int option -> EConstr.constr * EConstr.constr -> constr bindings ->
    clausenv
 
 val make_clenv_binding_apply :
-  env -> evar_map -> int option -> constr * constr -> constr bindings ->
+  env -> evar_map -> int option -> EConstr.constr * EConstr.constr -> constr bindings ->
    clausenv
 
 val make_clenv_binding_env :
-  env -> evar_map -> constr * constr -> constr bindings -> clausenv
+  env -> evar_map -> EConstr.constr * EConstr.constr -> constr bindings -> clausenv
 
 val make_clenv_binding :
-  env -> evar_map -> constr * constr -> constr bindings -> clausenv
+  env -> evar_map -> EConstr.constr * EConstr.constr -> constr bindings -> clausenv
 
 (** if the clause is a product, add an extra meta for this product *)
 exception NotExtensibleClause
 val clenv_push_prod : clausenv -> clausenv
 
 (** {6 Pretty-print (debug only) } *)
-val pr_clenv : clausenv -> Pp.std_ppcmds
+val pr_clenv : clausenv -> Pp.t
 
 (** {6 Evar-based clauses} *)
 
@@ -134,9 +138,9 @@ val pr_clenv : clausenv -> Pp.std_ppcmds
 *)
 
 type hole = {
-  hole_evar : constr;
+  hole_evar : EConstr.constr;
   (** The hole itself. Guaranteed to be an evar. *)
-  hole_type : types;
+  hole_type : EConstr.types;
   (** Type of the hole in the current environment. *)
   hole_deps  : bool;
   (** Whether the remainder of the clause was dependent in the hole. Note that
@@ -148,10 +152,10 @@ type hole = {
 
 type clause = {
   cl_holes : hole list;
-  cl_concl : types;
+  cl_concl : EConstr.types;
 }
 
-val make_evar_clause : env -> evar_map -> ?len:int -> types ->
+val make_evar_clause : env -> evar_map -> ?len:int -> EConstr.types ->
   (evar_map * clause)
 (** An evar version of {!make_clenv_binding}. Given a type [t],
     [evar_environments env sigma ~len t bl] tries to eliminate at most [len]
@@ -159,7 +163,7 @@ val make_evar_clause : env -> evar_map -> ?len:int -> types ->
     type together with the list of holes generated. Assumes that [t] is
     well-typed in the environment. *)
 
-val solve_evar_clause : env -> evar_map -> bool -> clause -> constr bindings ->
+val solve_evar_clause : env -> evar_map -> bool -> clause -> EConstr.constr bindings ->
   evar_map
 (** [solve_evar_clause env sigma hyps cl bl] tries to solve the holes contained
     in [cl] according to the [bl] argument. Assumes that [bl] are well-typed in
diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml
index 98b5bc8b..209104ac 100644
--- a/proofs/clenvtac.ml
+++ b/proofs/clenvtac.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -11,12 +13,12 @@ open Names
 open Term
 open Termops
 open Evd
+open EConstr
 open Refiner
 open Logic
 open Reduction
 open Tacmach
 open Clenv
-open Proofview.Notations
 
 (* This function put casts around metavariables whose type could not be
  * infered by the refiner, that is head of applications, predicates and
@@ -26,19 +28,19 @@ open Proofview.Notations
 
 let clenv_cast_meta clenv =
   let rec crec u =
-    match kind_of_term u with
+    match EConstr.kind clenv.evd u with
       | App _ | Case _ -> crec_hd u
-      | Cast (c,_,_) when isMeta c -> u
+      | Cast (c,_,_) when isMeta clenv.evd c -> u
       | Proj (p, c) -> mkProj (p, crec_hd c)
-      | _  -> map_constr crec u
+      | _  -> EConstr.map clenv.evd crec u
 
   and crec_hd u =
-    match kind_of_term (strip_outer_cast u) with
+    match EConstr.kind clenv.evd (strip_outer_cast clenv.evd u) with
       | Meta mv ->
 	  (try
             let b = Typing.meta_type clenv.evd mv in
-	    assert (not (occur_meta b));
-	    if occur_meta b then u
+	    assert (not (occur_meta clenv.evd b));
+	    if occur_meta clenv.evd b then u
             else mkCast (mkMeta mv, DEFAULTcast, b)
 	  with Not_found -> u)
       | App(f,args) -> mkApp (crec_hd f, Array.map crec args)
@@ -54,9 +56,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 *)
@@ -103,10 +106,10 @@ open Unification
 let dft = default_unify_flags
 
 let res_pf ?(with_evars=false) ?(with_classes=true) ?(flags=dft ()) clenv =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let clenv gl = clenv_unique_resolver ~flags clenv gl in
-    clenv_refine with_evars ~with_classes (Tacmach.New.of_old clenv (Proofview.Goal.assume gl))
-  end }
+  Proofview.Goal.enter begin fun gl ->
+    let clenv = clenv_unique_resolver ~flags clenv gl in
+    clenv_refine with_evars ~with_classes clenv
+  end
 
 (* [unifyTerms] et [unify] ne semble pas gérer les Meta, en
    particulier ne semblent pas vérifier que des instances différentes
@@ -138,12 +141,12 @@ let fail_quick_unif_flags = {
 
 (* let unifyTerms m n = walking (fun wc -> fst (w_Unify CONV m n [] wc)) *)
 let unify ?(flags=fail_quick_unif_flags) m =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  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
 	Proofview.Unsafe.tclEVARSADVANCE evd'
     with e when CErrors.noncritical e -> Proofview.tclZERO e
-  end }
+  end
diff --git a/proofs/clenvtac.mli b/proofs/clenvtac.mli
index aa091aec..7c1e300b 100644
--- a/proofs/clenvtac.mli
+++ b/proofs/clenvtac.mli
@@ -1,17 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Legacy components of the previous proof engine. *)
 
-open Term
 open Clenv
-open Tacexpr
+open EConstr
 open Unification
+open Misctypes
 
 (** Tactics *)
 val unify : ?flags:unify_flags -> constr -> unit Proofview.tactic
diff --git a/proofs/doc.tex b/proofs/doc.tex
deleted file mode 100644
index 431027ef..00000000
--- a/proofs/doc.tex
+++ /dev/null
@@ -1,14 +0,0 @@
-
-\newpage
-\section*{The Proof Engine}
-
-\ocwsection \label{proofs}
-This chapter describes the \Coq\ proof engine, which is also called
-the ``refiner'', since it provides a way to build terms by successive
-refining steps. Those steps are either primitive rules or higher-level
-tactics.
-The modules of the proof engine are organized as follows.
-
-\bigskip
-\begin{center}\epsfig{file=proofs.dep.ps,width=\linewidth}\end{center}
-
diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml
index 29cad063..0d197c92 100644
--- a/proofs/evar_refiner.ml
+++ b/proofs/evar_refiner.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -13,35 +15,41 @@ open Evd
 open Evarutil
 open Evarsolve
 open Pp
+open Glob_term
+open Ltac_pretype
 
 (******************************************)
 (* Instantiation of existential variables *)
 (******************************************)
 
-let depends_on_evar evk _ (pbty,_,t1,t2) =
-  try Evar.equal (head_evar t1) evk
+type glob_constr_ltac_closure = ltac_var_map * glob_constr
+
+let depends_on_evar sigma evk _ (pbty,_,t1,t2) =
+  let t1 = EConstr.of_constr t1 in
+  let t2 = EConstr.of_constr t2 in
+  try Evar.equal (head_evar sigma t1) evk
   with NoHeadEvar ->
-  try Evar.equal (head_evar t2) evk
+  try Evar.equal (head_evar sigma t2) evk
   with NoHeadEvar -> false
 
 let define_and_solve_constraints evk c env evd =
-  if Termops.occur_evar evk c then
+  if Termops.occur_evar evd evk c then
     Pretype_errors.error_occur_check env evd evk c;
-  let evd = define evk c evd in
-  let (evd,pbs) = extract_changed_conv_pbs evd (depends_on_evar evk) in
+  let evd = define evk (EConstr.Unsafe.to_constr c) evd in
+  let (evd,pbs) = extract_changed_conv_pbs evd (depends_on_evar evd evk) in
   match
     List.fold_left
       (fun p (pbty,env,t1,t2) -> match p with
-	| Success evd -> Evarconv.evar_conv_x full_transparent_state env evd pbty t1 t2
+	| Success evd -> Evarconv.evar_conv_x full_transparent_state env evd pbty (EConstr.of_constr t1) (EConstr.of_constr t2)
 	| UnifFailure _ as x -> x) (Success evd)
       pbs
   with
     | Success evd -> evd
-    | UnifFailure _ -> error "Instance does not satisfy the constraints."
+    | UnifFailure _ -> user_err Pp.(str "Instance does not satisfy the constraints.")
 
 let w_refine (evk,evi) (ltac_var,rawc) sigma =
   if Evd.is_defined sigma evk then
-    error "Instantiate called on already-defined evar";
+    user_err Pp.(str "Instantiate called on already-defined evar");
   let env = Evd.evar_filtered_env evi in
   let sigma',typed_c =
     let flags = {
@@ -51,11 +59,11 @@ let w_refine (evk,evi) (ltac_var,rawc) sigma =
       Pretyping.fail_evar = false;
       Pretyping.expand_evars = true } in
     try Pretyping.understand_ltac flags
-      env sigma ltac_var (Pretyping.OfType evi.evar_concl) rawc
+      env sigma ltac_var (Pretyping.OfType (EConstr.of_constr evi.evar_concl)) rawc
     with e when CErrors.noncritical e ->
       let loc = Glob_ops.loc_of_glob_constr rawc in
-      user_err_loc
-        (loc,"", str "Instance is not well-typed in the environment of " ++
-                 pr_existential_key sigma evk ++ str ".")
+      user_err ?loc 
+                (str "Instance is not well-typed in the environment of " ++
+                 Termops.pr_existential_key sigma evk ++ str ".")
   in
   define_and_solve_constraints evk typed_c env (evars_reset_evd sigma' sigma)
diff --git a/proofs/evar_refiner.mli b/proofs/evar_refiner.mli
index e3778e94..e8f3c4d1 100644
--- a/proofs/evar_refiner.mli
+++ b/proofs/evar_refiner.mli
@@ -1,15 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Evd
-open Pretyping
+open Glob_term
+open Ltac_pretype
 
 (** Refinement of existential variables. *)
 
-val w_refine : evar * evar_info ->
+type glob_constr_ltac_closure = ltac_var_map * glob_constr
+
+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 111a947a..ba7e458f 100644
--- a/proofs/goal.ml
+++ b/proofs/goal.ml
@@ -1,28 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Pp
-open Term
-open Sigma.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* This module implements the abstract interface to goals *)
 (* A general invariant of the module, is that a goal whose associated
    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
@@ -48,7 +48,7 @@ module V82 = struct
   (* Access to ".evar_concl" *)
   let concl evars gl =
     let evi = Evd.find evars gl in
-    evi.Evd.evar_concl
+    EConstr.of_constr evi.Evd.evar_concl
 
   (* Access to ".evar_extra" *)
   let extra evars gl =
@@ -61,24 +61,22 @@ module V82 = struct
        be shelved. It must not appear as a future_goal, so the future
        goals are restored to their initial value after the evar is
        created. *)
-    let prev_future_goals = Evd.future_goals evars in
-    let prev_principal_goal = Evd.principal_future_goal evars in
+    let concl = EConstr.Unsafe.to_constr concl in
+    let prev_future_goals = Evd.save_future_goals evars in
     let evi = { Evd.evar_hyps = hyps;
 		Evd.evar_concl = concl;
 		Evd.evar_filter = Evd.Filter.identity;
 		Evd.evar_body = Evd.Evar_empty;
-		Evd.evar_source = (Loc.ghost,Evar_kinds.GoalEvar);
+		Evd.evar_source = (Loc.tag Evar_kinds.GoalEvar);
 		Evd.evar_candidates = None;
 		Evd.evar_extra = extra }
     in
     let evi = Typeclasses.mark_unresolvable evi in
-    let evars = Sigma.Unsafe.of_evar_map evars in
-    let Sigma (evk, evars, _) = Evarutil.new_pure_evar_full evars evi in
-    let evars = Sigma.to_evar_map evars in
-    let evars = Evd.restore_future_goals evars prev_future_goals prev_principal_goal in
+    let (evars, evk) = Evarutil.new_pure_evar_full evars evi in
+    let evars = Evd.restore_future_goals evars prev_future_goals in
     let ctxt = Environ.named_context_of_val hyps in
-    let inst = Array.map_of_list (mkVar % get_id) ctxt in
-    let ev = Term.mkEvar (evk,inst) in
+    let inst = Array.map_of_list (NamedDecl.get_id %> EConstr.mkVar) ctxt in
+    let ev = EConstr.mkEvar (evk,inst) in
     (evk, ev, evars)
 
   (* Instantiates a goal with an open term *)
@@ -88,7 +86,7 @@ module V82 = struct
       if not (Evarutil.occur_evar_upto sigma evk c) then ()
       else Pretype_errors.error_occur_check Environ.empty_env sigma evk c
     in
-    Evd.define evk c sigma
+    Evd.define evk (EConstr.Unsafe.to_constr c) sigma
 
   (* Instantiates a goal with an open term, using name of goal for evk' *)
   let partial_solution_to sigma evk evk' c =
@@ -102,7 +100,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 =
@@ -130,9 +128,7 @@ module V82 = struct
     let new_evi =
       { evi with Evd.evar_hyps = new_hyps; Evd.evar_filter = new_filter } in
     let new_evi = Typeclasses.mark_unresolvable new_evi in
-    let sigma = Sigma.Unsafe.of_evar_map Evd.empty in
-    let Sigma (evk, sigma, _) = Evarutil.new_pure_evar_full sigma new_evi in
-    let sigma = Sigma.to_evar_map sigma in
+    let (sigma, evk) = Evarutil.new_pure_evar_full Evd.empty new_evi in
     { Evd.it = evk ; sigma = sigma; }
 
   (* Used by the compatibility layer and typeclasses *)
@@ -144,14 +140,16 @@ module V82 = struct
 
   (* Goal represented as a type, doesn't take into account section variables *)
   let abstract_type sigma gl =
+    let open EConstr in
     let (gl,sigma) = nf_evar sigma gl in
     let env = env sigma gl in
     let genv = Global.env () in
     let is_proof_var decl =
-      try ignore (Environ.lookup_named (get_id decl) genv); false
+      try ignore (Environ.lookup_named (NamedDecl.get_id decl) genv); false
       with Not_found -> true in
     Environ.fold_named_context_reverse (fun t decl ->
 					  if is_proof_var decl then
+                                            let decl = Termops.map_named_decl EConstr.of_constr decl in
 					    mkNamedProd_or_LetIn decl t
 					  else
 					    t
diff --git a/proofs/goal.mli b/proofs/goal.mli
index 6a79c1f4..dc986315 100644
--- a/proofs/goal.mli
+++ b/proofs/goal.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module implements the abstract interface to goals. Most of the code
@@ -15,12 +17,9 @@ 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.std_ppcmds
+val pr_goal : goal -> Pp.t
 
 (* 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
@@ -38,7 +37,7 @@ module V82 : sig
   val nf_hyps : Evd.evar_map -> goal -> Environ.named_context_val
 
   (* Access to ".evar_concl" *)
-  val concl : Evd.evar_map -> goal -> Term.constr
+  val concl : Evd.evar_map -> goal -> EConstr.constr
 
   (* Access to ".evar_extra" *)
   val extra : Evd.evar_map -> goal -> Evd.Store.t
@@ -48,23 +47,20 @@ module V82 : sig
        the evar corresponding to the goal, and an updated evar_map. *)
   val mk_goal : Evd.evar_map -> 
                          Environ.named_context_val ->
-                         Term.constr ->
+                         EConstr.constr ->
                          Evd.Store.t ->
-                         goal * Term.constr * Evd.evar_map
+                         goal * EConstr.constr * Evd.evar_map
 
   (* Instantiates a goal with an open term *)
-  val partial_solution : Evd.evar_map -> goal -> Term.constr -> Evd.evar_map
+  val partial_solution : Evd.evar_map -> goal -> EConstr.constr -> Evd.evar_map
 
   (* Instantiates a goal with an open term, reusing name of goal for
      second goal *)
-  val partial_solution_to : Evd.evar_map -> goal -> goal -> Term.constr -> Evd.evar_map
+  val partial_solution_to : Evd.evar_map -> goal -> goal -> EConstr.constr -> Evd.evar_map
 
-  (* Principal part of the weak-progress tactical *)
-  val weak_progress : goal list Evd.sigma -> goal Evd.sigma -> bool
-   
   (* 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
 
@@ -75,6 +71,6 @@ module V82 : sig
   val nf_evar : Evd.evar_map -> goal -> goal * Evd.evar_map
 
   (* Goal represented as a type, doesn't take into account section variables *)
-  val abstract_type : Evd.evar_map -> goal -> Term.types 
+  val abstract_type : Evd.evar_map -> goal -> EConstr.types 
 
 end
diff --git a/proofs/logic.ml b/proofs/logic.ml
index 65497c80..e5294715 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,7 +13,7 @@ open CErrors
 open Util
 open Names
 open Nameops
-open Term
+open Constr
 open Vars
 open Termops
 open Environ
@@ -22,7 +24,8 @@ open Proof_type
 open Type_errors
 open Retyping
 open Misctypes
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 type refiner_error =
 
@@ -32,14 +35,14 @@ type refiner_error =
   | CannotApply of constr * constr
   | NotWellTyped of constr
   | NonLinearProof of constr
-  | MetaInType of constr
+  | MetaInType of EConstr.constr
 
   (* Errors raised by the tactics *)
   | IntroNeedsProduct
   | 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
 
@@ -68,7 +71,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 *)
@@ -77,34 +80,20 @@ 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 =
-  if !check then let _ = unsafe_type_of env sigma c in ()
+  if !check then let _ = unsafe_type_of env sigma (EConstr.of_constr c) in ()
 
 (************************************************************************)
 (************************************************************************)
 (* Implementation of the structural rules (moving and deleting
    hypotheses around) *)
 
-(* The Clear tactic: it scans the context for hypotheses to be removed
-   (instead of iterating on the list of identifier to be removed, which
-   forces the user to give them in order). *)
-
-let clear_hyps env sigma ids sign cl =
-  let evdref = ref (Evd.clear_metas sigma) in
-  let (hyps,cl) = Evarutil.clear_hyps_in_evi env evdref sign cl ids in
-  (hyps, cl, !evdref)
-
-let clear_hyps2 env sigma ids sign t cl =
-  let evdref = ref (Evd.clear_metas sigma) in
-  let (hyps,t,cl) = Evarutil.clear_hyps2_in_evi env evdref sign t cl ids in
-  (hyps, t, cl, !evdref)
-
 (* The ClearBody tactic *)
 
 (* Reordering of the context *)
@@ -136,33 +125,33 @@ let find_q x (m,q) =
         else find (Id.Set.union l accs) (i::acc) itl in
   find Id.Set.empty [] q
 
-let occur_vars_in_decl env hyps d =
+let occur_vars_in_decl env sigma hyps d =
   if Id.Set.is_empty hyps then false else
-    let ohyps = global_vars_set_of_decl env d in
+    let ohyps = global_vars_set_of_decl env sigma d in
     Id.Set.exists (fun h -> Id.Set.mem h ohyps) hyps
 
-let reorder_context env sign ord =
+let reorder_context env sigma sign ord =
   let ords = List.fold_right Id.Set.add ord Id.Set.empty in
   if not (Int.equal (List.length ord) (Id.Set.cardinal ords)) then
-    error "Order list has duplicates";
+    user_err Pp.(str "Order list has duplicates");
   let rec step ord expected ctxt_head moved_hyps ctxt_tail =
     match ord with
       | [] -> List.rev ctxt_tail @ ctxt_head
       | top::ord' when mem_q top moved_hyps ->
           let ((d,h),mh) = find_q top moved_hyps in
-          if occur_vars_in_decl env h d then
-            errorlabstrm "reorder_context"
-              (str "Cannot move declaration " ++ pr_id top ++ spc() ++
+          if occur_vars_in_decl env sigma h d then
+            user_err ~hdr:"reorder_context"
+              (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 d))));
+                  (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 = get_id d in
+                let x = NamedDecl.get_id d in
                 if Id.Set.mem x expected then
                   step ord (Id.Set.remove x expected)
                     ctxt (push_item x d moved_hyps) ctxt_tail
@@ -171,19 +160,21 @@ let reorder_context env sign ord =
                     ctxt (push_val x moved_hyps) (d::ctxt_tail)) in
   step ord ords sign mt_q []
 
-let reorder_val_context env sign ord =
-  val_of_named_context (reorder_context env (named_context_of_val sign) ord)
+let reorder_val_context env sigma sign ord =
+  let open EConstr in
+  val_of_named_context (reorder_context env sigma (named_context_of_val sign) ord)
 
 
 
 
-let check_decl_position env sign d =
-  let x = get_id d in
-  let needed = global_vars_set_of_decl env d in
-  let deps = dependency_closure env (named_context_of_val sign) needed in
+let check_decl_position env sigma sign d =
+  let open EConstr in
+  let x = NamedDecl.get_id d in
+  let needed = global_vars_set_of_decl env sigma d in
+  let deps = dependency_closure env sigma (named_context_of_val sign) needed in
   if Id.List.mem x deps then
-    errorlabstrm "Logic.check_decl_position"
-      (str "Cannot create self-referring hypothesis " ++ pr_id x);
+    user_err ~hdr:"Logic.check_decl_position"
+      (str "Cannot create self-referring hypothesis " ++ Id.print x);
   x::deps
 
 (* Auxiliary functions for primitive MOVE tactic
@@ -201,19 +192,11 @@ let move_location_eq m1 m2 = match m1, m2 with
 | MoveFirst, MoveFirst -> true
 | _ -> false
 
-let rec get_hyp_after h = function
-  | [] -> error_no_such_hypothesis h
-  | d :: right ->
-      if Id.equal (get_id d) h then
-	match right with d' ::_ -> MoveBefore (get_id d') | [] -> MoveFirst
-      else
-       get_hyp_after h right
-
-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,_,typ = to_tuple d in
+        let hyp = NamedDecl.get_id d in
       	if Id.equal hyp hfrom then
 	  (left,right,d, toleft || move_location_eq hto MoveLast)
       	else
@@ -231,31 +214,31 @@ let hyp_of_move_location = function
   | MoveBefore id -> id
   | _ -> assert false
 
-let move_hyp toleft (left,declfrom,right) hto =
+let move_hyp sigma toleft (left,declfrom,right) hto =
   let env = Global.env() in
   let test_dep d d2 =
     if toleft
-    then occur_var_in_decl env (get_id d2) d
-    else occur_var_in_decl env (get_id d) d2
+    then occur_var_in_decl env sigma (NamedDecl.get_id d2) d
+    else occur_var_in_decl env sigma (NamedDecl.get_id d) d2
   in
   let rec moverec first middle = function
     | [] ->
 	if match hto with MoveFirst | MoveLast -> false | _ -> true then
-	  error_no_such_hypothesis (hyp_of_move_location hto);
+          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 (get_id d)) ->
+    | d :: _ as right when move_location_eq hto (MoveBefore (NamedDecl.get_id d)) ->
 	List.rev first @ List.rev middle @ right
     | d :: right ->
-        let hyp = get_id d in
+        let hyp = NamedDecl.get_id d in
 	let (first',middle') =
       	  if List.exists (test_dep d) middle then
 	    if not (move_location_eq hto (MoveAfter hyp)) then
 	      (first, d::middle)
             else
-	      errorlabstrm "move_hyp" (str "Cannot move " ++ pr_id (get_id declfrom) ++
-	        Miscprint.pr_move_location pr_id hto ++
-	        str (if toleft then ": it occurs in " else ": it depends on ")
-	        ++ pr_id hyp ++ str ".")
+	      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 ")
+	        ++ Id.print hyp ++ str ".")
           else
 	    (d::first, middle)
 	in
@@ -264,6 +247,7 @@ let move_hyp toleft (left,declfrom,right) hto =
       	else
 	  moverec first' middle' right
   in
+  let open EConstr in
   if toleft then
     let right =
       List.fold_right push_named_context_val right empty_named_context_val in
@@ -276,10 +260,15 @@ let move_hyp toleft (left,declfrom,right) hto =
     List.fold_left (fun sign d -> push_named_context_val d sign)
       right left
 
-let move_hyp_in_named_context hfrom hto sign =
+let 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
-  move_hyp toleft (left,declfrom,right) hto
+    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 =
+  let open EConstr in
+  move_hyp sigma false ([],decl,named_context_of_val sign) hto
 
 (**********************************************************************)
 
@@ -292,43 +281,46 @@ let move_hyp_in_named_context hfrom hto sign =
 variables only in Application and Case *)
 
 let error_unsupported_deep_meta c =
-  errorlabstrm "" (strbrk "Application of lemmas whose beta-iota normal " ++
+  user_err  (strbrk "Application of lemmas whose beta-iota normal " ++
     strbrk "form contains metavariables deep inside the term is not " ++
     strbrk "supported; try \"refine\" instead.")
 
 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 _) -> fold_constr (collrec deep) acc c
+    | (App _| Case _) -> Constr.fold (collrec deep) acc c
     | Proj (_, c) -> collrec deep acc c
-    | _ -> 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 ty conclty in
+    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 constr list
-let meta_free_prefix a =
+exception Stop of EConstr.t list
+let meta_free_prefix sigma a =
   try
+    let a = Array.map EConstr.of_constr a in
     let _ = Array.fold_left (fun acc a -> 
-      if occur_meta a then raise (Stop acc)
+      if occur_meta sigma a then raise (Stop acc)
       else a :: acc) [] a
     in a
   with Stop acc -> Array.rev_of_list acc
 
 let goal_type_of env sigma c =
-  if !check then unsafe_type_of env sigma c
-  else Retyping.get_type_of env sigma c
+  if !check then
+    let (sigma,t) = type_of env sigma (EConstr.of_constr c) in
+    (sigma, EConstr.Unsafe.to_constr t)
+  else (sigma, EConstr.Unsafe.to_constr (Retyping.get_type_of env sigma (EConstr.of_constr c)))
 
 let rec mk_refgoals sigma goal goalacc conclty trm =
   let env = Goal.V82.env sigma goal in
@@ -336,17 +328,20 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
   let mk_goal hyps concl =
     Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal)
   in
-    if (not !check) && not (occur_meta trm) then
-      let t'ty = Retyping.get_type_of env sigma trm in
+    if (not !check) && not (occur_meta sigma (EConstr.of_constr trm)) then
+      let t'ty = Retyping.get_type_of env sigma (EConstr.of_constr trm) in
+      let t'ty = EConstr.Unsafe.to_constr t'ty in
       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 conclty in
-	  if !check && occur_meta conclty then
-	    raise (RefinerError (MetaInType conclty));
+        let conclty = nf_betaiota env sigma (EConstr.of_constr conclty) in
+	  if !check && occur_meta sigma conclty then
+            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
 	  gl::goalacc, conclty, sigma, ev
 
       | Cast (t,k, ty) ->
@@ -365,26 +360,28 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
 
       | App (f,l) ->
 	let (acc',hdty,sigma,applicand) =
-	  if is_template_polymorphic env f then
+	  if is_template_polymorphic env sigma (EConstr.of_constr f) then
 	    let ty = 
-	      (* Template sort-polymorphism of definition and inductive types *)
-	      let firstmeta = Array.findi (fun i x -> occur_meta x) l in
+	      (* Template polymorphism of definitions and inductive types *)
+	      let firstmeta = Array.findi (fun i x -> occur_meta sigma (EConstr.of_constr x)) l in
 	      let args, _ = Option.cata (fun i -> CArray.chop i l) (l, [||]) firstmeta in
-	        type_of_global_reference_knowing_parameters env sigma f args
+	        type_of_global_reference_knowing_parameters env sigma (EConstr.of_constr f) (Array.map EConstr.of_constr args)
 	    in
+	    let ty = EConstr.Unsafe.to_constr ty in
 	      goalacc, ty, sigma, f
 	  else
 	    mk_hdgoals sigma goal goalacc f
 	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) ->
 	let (acc',cty,sigma,c') = mk_hdgoals sigma goal goalacc c in
 	let c = mkProj (p, c') in
-	let ty = get_type_of env sigma c in
+	let ty = get_type_of env sigma (EConstr.of_constr c) in
+	let ty = EConstr.Unsafe.to_constr ty in
 	  (acc',ty,sigma,c)
 
       | Case (ci,p,c,lf) ->
@@ -399,14 +396,14 @@ 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)
 
       | _ ->
-	if occur_meta trm then
-	  anomaly (Pp.str "refiner called with a meta in non app/case subterm");
-	let t'ty = goal_type_of env sigma trm in
+	if occur_meta sigma (EConstr.of_constr trm) then
+	  anomaly (Pp.str "refiner called with a meta in non app/case subterm.");
+	let (sigma, t'ty) = goal_type_of env sigma trm in
 	let sigma = check_conv_leq_goal env sigma trm t'ty conclty in
           (goalacc,t'ty,sigma, trm)
 
@@ -418,10 +415,11 @@ 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 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
 
     | Cast (t,_, ty) ->
@@ -430,14 +428,14 @@ and mk_hdgoals sigma goal goalacc trm =
 
     | App (f,l) ->
 	let (acc',hdty,sigma,applicand) =
-	  if is_template_polymorphic env f
+	  if is_template_polymorphic env sigma (EConstr.of_constr f)
 	  then
-	    let l' = meta_free_prefix l in	      
-	   (goalacc,type_of_global_reference_knowing_parameters env sigma f l',sigma,f)
+	    let l' = meta_free_prefix sigma l in
+	   (goalacc,EConstr.Unsafe.to_constr (type_of_global_reference_knowing_parameters env sigma (EConstr.of_constr f) l'),sigma,f)
 	  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) ->
@@ -451,68 +449,74 @@ 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)
 
     | Proj (p,c) ->
          let (acc',cty,sigma,c') = mk_hdgoals sigma goal goalacc c in
 	 let c = mkProj (p, c') in
-         let ty = get_type_of env sigma c in
+         let ty = get_type_of env sigma (EConstr.of_constr c) in
+         let ty = EConstr.Unsafe.to_constr ty in
 	   (acc',ty,sigma,c)
 
     | _ ->
-	if !check && occur_meta trm then
-	  anomaly (Pp.str "refine called with a dependent meta");
-	goalacc, goal_type_of env sigma trm, sigma, trm
+	if !check && occur_meta sigma (EConstr.of_constr trm) then
+	  anomaly (Pp.str "refine called with a dependent meta.");
+        let (sigma, ty) = goal_type_of env sigma trm in
+	goalacc, ty, sigma, trm
 
 and mk_arggoals sigma goal goalacc funty allargs =
   let foldmap (goalacc, funty, sigma) harg =
-    let t = whd_all (Goal.V82.env sigma goal) sigma funty in
-    let rec collapse t = match kind_of_term t with
+    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 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
 
 and mk_casegoals sigma goal goalacc p c =
   let env = Goal.V82.env sigma goal in
   let (acc',ct,sigma,c') = mk_hdgoals sigma goal goalacc c in
+  let ct = EConstr.of_constr ct in
   let (acc'',pt,sigma,p') = mk_hdgoals sigma goal acc' p in
-  let indspec =
+  let ((ind, u), spec) =
     try Tacred.find_hnf_rectype env sigma ct
-    with Not_found -> anomaly (Pp.str "mk_casegoals") in
-  let (lbrty,conclty) = type_case_branches_with_names env indspec p c in
+    with Not_found -> anomaly (Pp.str "mk_casegoals.") in
+  let indspec = ((ind, EConstr.EInstance.kind sigma u), spec) in
+  let (lbrty,conclty) = type_case_branches_with_names env sigma indspec p c in
   (acc'',lbrty,conclty,sigma,p',c')
 
 
 let convert_hyp check sign sigma d =
-  let id,b,bt = to_tuple d in
-  let env = Global.env() in
+  let id = NamedDecl.get_id d in
+  let b = NamedDecl.get_value d in
+  let env = Global.env () in
   let reorder = ref [] in
   let sign' =
-    apply_to_hyp check sign id
+    apply_to_hyp env sigma check sign id
       (fun _ d' _ ->
-        let _,c,ct = to_tuple d' in
+        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 bt ct) then
-	  errorlabstrm "Logic.convert_hyp"
-            (str "Incorrect change of the type of " ++ pr_id id ++ str ".");
+        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 " ++ Id.print id ++ str ".");
         if check && not (Option.equal (is_conv env sigma) b c) then
-	  errorlabstrm "Logic.convert_hyp"
-            (str "Incorrect change of the body of "++ pr_id id ++ str ".");
-       if check then reorder := check_decl_position env sign d;
-       d) in
-  reorder_val_context env sign' !reorder
-
-
+	  user_err ~hdr:"Logic.convert_hyp"
+            (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
 
 (************************************************************************)
 (************************************************************************)
@@ -520,37 +524,13 @@ let convert_hyp check sign sigma d =
 
 let prim_refiner r sigma goal =
   let env = Goal.V82.env sigma goal in
-  let sign = Goal.V82.hyps sigma goal in
   let cl = Goal.V82.concl sigma goal in
-  let mk_goal hyps concl = 
-    Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) 
-  in
   match r with
     (* Logical rules *)
-    | Cut (b,replace,id,t) ->
-(*        if !check && not (Retyping.get_sort_of env sigma t) then*)
-        let (sg1,ev1,sigma) = mk_goal sign (nf_betaiota sigma t) in
-	let sign,t,cl,sigma =
-	  if replace then
-	    let nexthyp = get_hyp_after id (named_context_of_val sign) in
-	    let sign,t,cl,sigma = clear_hyps2 env sigma (Id.Set.singleton id) sign t cl in
-	    move_hyp false ([], LocalAssum (id,t),named_context_of_val sign)
-	      nexthyp,
-	      t,cl,sigma
-	  else
-            (if !check && mem_named_context_val id sign then
-	      errorlabstrm "Logic.prim_refiner"
-                (str "Variable " ++ pr_id id ++ str " is already declared.");
-	     push_named_context_val (LocalAssum (id,t)) sign,t,cl,sigma) in
-        let (sg2,ev2,sigma) = 
-	  Goal.V82.mk_goal sigma sign cl (Goal.V82.extra sigma goal) in
-	let oterm = Term.mkNamedLetIn id ev1 t ev2 in
-	let sigma = Goal.V82.partial_solution_to sigma goal sg2 oterm in
-        if b then ([sg1;sg2],sigma) else ([sg2;sg1],sigma)
-
     | Refine c ->
-	check_meta_variables c;
+        let cl = EConstr.Unsafe.to_constr cl in
+        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 oterm in
+	let sigma = Goal.V82.partial_solution sigma goal (EConstr.of_constr oterm) in
 	  (sgl, sigma)
diff --git a/proofs/logic.mli b/proofs/logic.mli
index 0dba9ef1..dc471bb5 100644
--- a/proofs/logic.mli
+++ b/proofs/logic.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Legacy proof engine. Do not use in newly written code. *)
 
 open Names
-open Term
+open Constr
 open Evd
 open Proof_type
 
@@ -43,19 +45,25 @@ type refiner_error =
   | CannotApply of constr * constr
   | NotWellTyped of constr
   | NonLinearProof of constr
-  | MetaInType of constr
+  | MetaInType of EConstr.constr
 
   (*i Errors raised by the tactics i*)
   | IntroNeedsProduct
   | 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 : Environ.env -> evar_map -> Id.t -> 'a
 
 val catchable_exception : exn -> bool
 
 val convert_hyp : bool -> Environ.named_context_val -> evar_map ->
-  Context.Named.Declaration.t -> Environ.named_context_val
+  EConstr.named_declaration -> Environ.named_context_val
+
+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 move_hyp_in_named_context : Id.t -> Id.t Misctypes.move_location ->
+val insert_decl_in_named_context : Evd.evar_map ->
+  EConstr.named_declaration -> Id.t Misctypes.move_location ->
   Environ.named_context_val -> Environ.named_context_val
diff --git a/proofs/miscprint.ml b/proofs/miscprint.ml
new file mode 100644
index 00000000..1a63ff67
--- /dev/null
+++ b/proofs/miscprint.ml
@@ -0,0 +1,77 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pp
+open Names
+open Misctypes
+
+(** Printing of [intro_pattern] *)
+
+let rec pr_intro_pattern prc {CAst.v=pat} = match pat with
+  | IntroForthcoming true -> str "*"
+  | IntroForthcoming false -> str "**"
+  | IntroNaming p -> pr_intro_pattern_naming p
+  | IntroAction p -> pr_intro_pattern_action prc p
+
+and pr_intro_pattern_naming = function
+  | IntroIdentifier id -> Id.print id
+  | IntroFresh id -> str "?" ++ Id.print id
+  | IntroAnonymous -> str "?"
+
+and pr_intro_pattern_action prc = function
+  | IntroWildcard -> str "_"
+  | IntroOrAndPattern pll -> pr_or_and_intro_pattern prc pll
+  | IntroInjection pl ->
+      str "[=" ++ hv 0 (prlist_with_sep spc (pr_intro_pattern prc) pl) ++
+      str "]"
+  | IntroApplyOn ({CAst.v=c},pat) -> pr_intro_pattern prc pat ++ str "%" ++ prc c
+  | IntroRewrite true -> str "->"
+  | IntroRewrite false -> str "<-"
+
+and pr_or_and_intro_pattern prc = function
+  | IntroAndPattern pl ->
+      str "(" ++ hv 0 (prlist_with_sep pr_comma (pr_intro_pattern prc) pl) ++ str ")"
+  | IntroOrPattern pll ->
+      str "[" ++
+      hv 0 (prlist_with_sep pr_bar (prlist_with_sep spc (pr_intro_pattern prc)) pll)
+      ++ str "]"
+
+(** Printing of [move_location] *)
+
+let pr_move_location pr_id = function
+  | MoveAfter id -> brk(1,1) ++ str "after " ++ pr_id id
+  | MoveBefore id -> brk(1,1) ++ str "before " ++ pr_id id
+  | MoveFirst -> str " at top"
+  | MoveLast -> str " at bottom"
+
+(** Printing of bindings *)
+let pr_binding prc = let open CAst in function
+  | {loc;v=(NamedHyp id, c)} -> hov 1 (Names.Id.print id ++ str " := " ++ cut () ++ prc c)
+  | {loc;v=(AnonHyp n, c)} -> hov 1 (int n ++ str " := " ++ cut () ++ prc c)
+
+let pr_bindings prc prlc = function
+  | ImplicitBindings l ->
+    brk (1,1) ++ str "with" ++ brk (1,1) ++
+    pr_sequence prc l
+  | ExplicitBindings l ->
+    brk (1,1) ++ str "with" ++ brk (1,1) ++
+    pr_sequence (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
+  | NoBindings -> mt ()
+
+let pr_bindings_no_with prc prlc = function
+  | ImplicitBindings l ->
+    brk (0,1) ++ prlist_with_sep spc prc l
+  | ExplicitBindings l ->
+    brk (0,1) ++ prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
+  | NoBindings -> mt ()
+
+let pr_with_bindings prc prlc (c,bl) =
+  hov 1 (prc c ++ pr_bindings prc prlc bl)
+
diff --git a/proofs/miscprint.mli b/proofs/miscprint.mli
new file mode 100644
index 00000000..79790a27
--- /dev/null
+++ b/proofs/miscprint.mli
@@ -0,0 +1,39 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Misctypes
+
+(** Printing of [intro_pattern] *)
+
+val pr_intro_pattern :
+  ('a -> Pp.t) -> 'a intro_pattern_expr CAst.t -> Pp.t
+
+val pr_or_and_intro_pattern :
+  ('a -> Pp.t) -> 'a or_and_intro_pattern_expr -> Pp.t
+
+val pr_intro_pattern_naming : intro_pattern_naming_expr -> Pp.t
+
+(** Printing of [move_location] *)
+
+val pr_move_location :
+  ('a -> Pp.t) -> 'a move_location -> Pp.t
+
+val pr_bindings :
+  ('a -> Pp.t) ->
+  ('a -> Pp.t) -> 'a bindings -> Pp.t
+
+val pr_bindings_no_with :
+  ('a -> Pp.t) ->
+  ('a -> Pp.t) -> 'a bindings -> Pp.t
+
+val pr_with_bindings :
+  ('a -> Pp.t) ->
+  ('a -> Pp.t) -> 'a * 'a bindings -> Pp.t
+
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml
index eddbf72a..5d137988 100644
--- a/proofs/pfedit.ml
+++ b/proofs/pfedit.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -15,7 +17,7 @@ open Evd
 
 let use_unification_heuristics_ref = ref true
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optdepr = false;
   Goptions.optname = "Solve unification constraints at every \".\"";
   Goptions.optkey = ["Solve";"Unification";"Constraints"];
   Goptions.optread = (fun () -> !use_unification_heuristics_ref);
@@ -24,19 +26,6 @@ let _ = Goptions.declare_bool_option {
 
 let use_unification_heuristics () = !use_unification_heuristics_ref
 
-let refining = Proof_global.there_are_pending_proofs
-let check_no_pending_proofs = Proof_global.check_no_pending_proof
-
-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 start_proof (id : Id.t) ?pl str sigma hyps c ?init_tac terminator =
   let goals = [ (Global.env_of_context hyps , c) ] in
   Proof_global.start_proof sigma id ?pl str goals terminator;
@@ -55,44 +44,31 @@ let cook_this_proof p =
 let cook_proof () =
   cook_this_proof (fst
     (Proof_global.close_proof ~keep_body_ucst_separate:false (fun x -> x)))
-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 ()
 
 exception NoSuchGoal
 let _ = CErrors.register_handler begin function
-  | NoSuchGoal -> CErrors.error "No such goal."
+  | NoSuchGoal -> CErrors.user_err Pp.(str "No such goal.")
   | _ -> raise CErrors.Unhandled
 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 =
   let { it=goal ; sigma=sigma; } =  get_nth_V82_goal i in
   (sigma, Refiner.pf_env { it=goal ; sigma=sigma; })
 
 let get_goal_context i =
   try get_goal_context_gen i
-  with Proof_global.NoCurrentProof -> CErrors.error "No focused proof."
-     | NoSuchGoal -> CErrors.error "No such goal."
+  with Proof_global.NoCurrentProof -> CErrors.user_err Pp.(str "No focused proof.")
+     | NoSuchGoal -> CErrors.user_err Pp.(str "No such goal.")
 
 let get_current_goal_context () =
   try get_goal_context_gen 1
-  with Proof_global.NoCurrentProof -> CErrors.error "No focused proof."
+  with Proof_global.NoCurrentProof -> CErrors.user_err Pp.(str "No focused proof.")
      | NoSuchGoal -> 
     (* spiwack: returning empty evar_map, since if there is no goal, under focus,
         there is no accessible evar either *)
@@ -106,14 +82,14 @@ let get_current_context () =
     (Evd.from_env env, env)
      | NoSuchGoal ->
         (* No more focused goals ? *)
-        let p = get_pftreestate () in
+        let p = Proof_global.give_me_the_proof () in
         let evd = Proof.in_proof p (fun x -> x) in
         (evd, Global.env ())
 
 let current_proof_statement () =
   match Proof_global.V82.get_current_initial_conclusions () with
     | (id,([concl],strength)) -> id,strength,concl
-    | _ -> CErrors.anomaly ~label:"Pfedit.current_proof_statement" (Pp.str "more than one statement")
+    | _ -> CErrors.anomaly ~label:"Pfedit.current_proof_statement" (Pp.str "more than one statement.")
 
 let solve ?with_end_tac gi info_lvl tac pr =
   try 
@@ -143,12 +119,7 @@ let solve ?with_end_tac gi info_lvl tac pr =
     in
     (p,status)
   with
-    | Proof_global.NoCurrentProof  -> CErrors.error "No focused proof"
-    | CList.IndexOutOfRange ->
-        match gi with
-	| Vernacexpr.SelectNth i -> let msg = str "No such goal: " ++ int i ++ str "." in
-	                            CErrors.errorlabstrm "" msg
-        | _ -> assert false
+    Proof_global.NoCurrentProof -> CErrors.user_err Pp.(str "No focused proof")
 
 let by tac = Proof_global.with_current_proof (fun _ -> solve (Vernacexpr.SelectNth 1) None tac)
 
@@ -170,11 +141,12 @@ let build_constant_by_tactic id ctx sign ?(goal_kind = Global, false, Proof Theo
   try
     let status = by tac in
     let _,(const,univs,_) = cook_proof () in
-    delete_current_proof ();
-    const, status, fst univs
+    Proof_global.discard_current ();
+    let univs = UState.demote_seff_univs const univs in
+    const, status, univs
   with reraise ->
     let reraise = CErrors.push reraise in
-    delete_current_proof ();
+    Proof_global.discard_current ();
     iraise reraise
 
 let build_by_tactic ?(side_eff=true) env sigma ?(poly=false) typ tac =
@@ -186,12 +158,11 @@ 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
-        (fun (pt, _) -> pt, Safe_typing.empty_private_constants) } in
-  let (cb, ctx), se = Future.force ce.const_entry_body in
-  let univs' = Evd.merge_context_set Evd.univ_rigid (Evd.from_ctx univs) ctx in
-  assert(Safe_typing.empty_private_constants = se);
-  cb, status, Evd.evar_universe_context univs'
+      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 = UState.merge side_eff Evd.univ_rigid univs ctx in
+  cb, status, univs
 
 let refine_by_tactic env sigma ty tac =
   (** Save the initial side-effects to restore them afterwards. We set the
@@ -199,6 +170,8 @@ let refine_by_tactic env sigma ty tac =
       ones created during the tactic invocation easily. *)
   let eff = Evd.eval_side_effects sigma in
   let sigma = Evd.drop_side_effects sigma in
+  (** Save the existing goals *)
+  let prev_future_goals = save_future_goals sigma in
   (** Start a proof *)
   let prf = Proof.start sigma [env, ty] in
   let (prf, _) =
@@ -209,17 +182,30 @@ let refine_by_tactic env sigma ty tac =
       iraise (e, info)
   in
   (** Plug back the retrieved sigma *)
-  let sigma = Proof.in_proof prf (fun sigma -> sigma) in
+  let (goals,stack,shelf,given_up,sigma) = Proof.proof prf in
+  assert (stack = []);
   let ans = match Proof.initial_goals prf with
   | [c, _] -> c
   | _ -> assert false
   in
   let ans = Reductionops.nf_evar sigma ans in
+  let ans = EConstr.Unsafe.to_constr ans in
   (** [neff] contains the freshly generated side-effects *)
   let neff = Evd.eval_side_effects sigma in
   (** Reset the old side-effects *)
   let sigma = Evd.drop_side_effects sigma in
   let sigma = Evd.emit_side_effects eff sigma in
+  (** Restore former goals *)
+  let sigma = restore_future_goals sigma prev_future_goals in
+  (** Push remaining goals as future_goals which is the only way we
+      have to inform the caller that there are goals to collect while
+      not being encapsulated in the monad *)
+  (** Goals produced by tactic "shelve" *)
+  let sigma = List.fold_right (Evd.declare_future_goal ~tag:Evd.ToShelve) shelf sigma in
+  (** Goals produced by tactic "give_up" *)
+  let sigma = List.fold_right (Evd.declare_future_goal ~tag:Evd.ToGiveUp) given_up sigma in
+  (** Other goals *)
+  let sigma = List.fold_right Evd.declare_future_goal goals sigma in
   (** Get rid of the fresh side-effects by internalizing them in the term
       itself. Note that this is unsound, because the tactic may have solved
       other goals that were already present during its invocation, so that
@@ -238,20 +224,25 @@ let declare_implicit_tactic tac = implicit_tactic := Some tac
 
 let clear_implicit_tactic () = implicit_tactic := None
 
-let solve_by_implicit_tactic env sigma evk =
+let apply_implicit_tactic tac = (); fun env sigma evk ->
   let evi = Evd.find_undefined sigma evk in
-  match (!implicit_tactic, snd (evar_source evk sigma)) with
-  | Some tac, (Evar_kinds.ImplicitArg _ | Evar_kinds.QuestionMark _)
+  match snd (evar_source evk sigma) with
+  | (Evar_kinds.ImplicitArg _ | Evar_kinds.QuestionMark _)
       when
-	Context.Named.equal (Environ.named_context_of_val evi.evar_hyps)
+	Context.Named.equal Constr.equal (Environ.named_context_of_val evi.evar_hyps)
 	(Environ.named_context env) ->
-      let tac = Proofview.tclTHEN tac (Proofview.tclEXTEND [] (Proofview.tclZERO (CErrors.UserError ("",Pp.str"Proof is not complete."))) []) in
+      let tac = Proofview.tclTHEN tac (Proofview.tclEXTEND [] (Proofview.tclZERO (CErrors.UserError (None,Pp.str"Proof is not complete."))) []) in
       (try
         let c = Evarutil.nf_evars_universes sigma evi.evar_concl in
+        let c = EConstr.of_constr c in
         if Evarutil.has_undefined_evars sigma c then raise Exit;
         let (ans, _, ctx) =
 	  build_by_tactic env (Evd.evar_universe_context sigma) c tac in
         let sigma = Evd.set_universe_context sigma ctx in
-        sigma, ans
+        sigma, EConstr.of_constr ans
        with e when Logic.catchable_exception e -> raise Exit)
   | _ -> raise Exit
+
+let solve_by_implicit_tactic () = match !implicit_tactic with
+| None -> None
+| Some tac -> Some (apply_implicit_tactic tac)
diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli
index ea604e08..65cde3a3 100644
--- a/proofs/pfedit.mli
+++ b/proofs/pfedit.mli
@@ -1,52 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Global proof state. A quite redundant wrapper on {!Proof_global}. *)
 
-open Loc
 open Names
-open Term
+open Constr
 open Environ
 open Decl_kinds
 
-(** 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 *)
-
-(** {6 ... } *)
-(** [refining ()] tells if there is some proof in progress, even if a not
-   focused one *)
-
-val refining : unit -> bool
-
-(** [check_no_pending_proofs ()] fails if there is still some proof in
-   progress *)
-
-val check_no_pending_proofs : unit -> unit
-
-(** {6 ... } *)
-(** [delete_proof name] deletes proof of name [name] or fails if no proof
-    has this name *)
-
-val delete_proof : Id.t located -> unit
-
-(** [delete_current_proof ()] deletes current focused proof or fails if
-    no proof is focused *)
-
-val delete_current_proof : unit -> unit
-
-(** [delete_all_proofs ()] deletes all open proofs if any *)
-
-val delete_all_proofs : unit -> unit
-
 (** {6 ... } *)
 (** [start_proof s str env t hook tac] starts a proof of name [s] and
     conclusion [t]; [hook] is optionally a function to be applied at
@@ -55,12 +23,8 @@ val delete_all_proofs : unit -> unit
     systematically apply at initialization time (e.g. to start the
     proof of mutually dependent theorems) *)
 
-type lemma_possible_guards = Proof_global.lemma_possible_guards
-
-type universe_binders = Id.t Loc.located list
-
 val start_proof :
-  Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_map -> named_context_val -> 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
 
@@ -73,18 +37,13 @@ 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_pftreestate ()] returns the current focused pending proof.
-   @raise NoCurrentProof if there is no pending proof. *)
-
-val get_pftreestate : unit -> Proof.proof
-
 (** [get_goal_context n] returns the context of the [n]th subgoal of
    the current focused proof or raises a [UserError] if there is no
    focused proof or if there is no more subgoals *)
@@ -106,37 +65,10 @@ val get_current_context : unit -> Evd.evar_map * env
 (** [current_proof_statement] *)
 
 val current_proof_statement :
-  unit -> Id.t * goal_kind * types
+  unit -> Id.t * goal_kind * EConstr.types
 
 (** {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
 
-(** [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
-
-(** {6 ... } *)
-(** [set_end_tac tac] applies tactic [tac] to all subgoal generate
-    by [solve] *)
-
-val set_end_tac : Tacexpr.raw_tactic_expr -> unit
-
-(** {6 ... } *)
-(** [set_used_variables l] declares that section variables [l] will be
-    used in the proof *)
-val set_used_variables :
-  Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
-val get_used_variables : unit -> Context.section_context option
-
-(** {6 Universe binders } *)
-val get_universe_binders : unit -> universe_binders option
-
-(** {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
@@ -144,7 +76,7 @@ val get_universe_binders : unit -> universe_binders option
 
 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
@@ -165,16 +97,16 @@ 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 ->
-  types -> unit Proofview.tactic -> 
+  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 ->
-  types -> unit Proofview.tactic -> 
-  constr * bool * Evd.evar_universe_context
+val build_by_tactic : ?side_eff:bool -> env -> UState.t -> ?poly:polymorphic ->
+  EConstr.types -> unit Proofview.tactic -> 
+  constr * bool * UState.t
 
-val refine_by_tactic : env -> Evd.evar_map -> types -> unit Proofview.tactic ->
+val refine_by_tactic : env -> Evd.evar_map -> EConstr.types -> unit Proofview.tactic ->
   constr * Evd.evar_map
 (** A variant of the above function that handles open terms as well.
     Caveat: all effects are purged in the returned term at the end, but other
@@ -190,4 +122,4 @@ val declare_implicit_tactic : unit Proofview.tactic -> unit
 val clear_implicit_tactic : unit -> unit
 
 (* Raise Exit if cannot solve *)
-val solve_by_implicit_tactic : env -> Evd.evar_map -> Evd.evar -> Evd.evar_map * constr
+val solve_by_implicit_tactic : unit -> Pretyping.inference_hook option
diff --git a/proofs/proof.ml b/proofs/proof.ml
index 5c963d53..51e0a1d6 100644
--- a/proofs/proof.ml
+++ b/proofs/proof.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Module defining the last essential tiles of interactive proofs.
@@ -66,14 +68,14 @@ exception FullyUnfocused
 
 let _ = CErrors.register_handler begin function
   | CannotUnfocusThisWay ->
-    CErrors.error "This proof is focused, but cannot be unfocused this way"
+    CErrors.user_err Pp.(str "This proof is focused, but cannot be unfocused this way")
   | NoSuchGoals (i,j) when Int.equal i j ->
-      CErrors.errorlabstrm "Focus" Pp.(str"No such goal (" ++ int i ++ str").")
+      CErrors.user_err ~hdr:"Focus" Pp.(str"No such goal (" ++ int i ++ str").")
   | NoSuchGoals (i,j) ->
-      CErrors.errorlabstrm "Focus" Pp.(
+      CErrors.user_err ~hdr:"Focus" Pp.(
         str"Not every goal in range ["++ int i ++ str","++int j++str"] exist."
       )
-  | FullyUnfocused -> CErrors.error "The proof is not focused"
+  | FullyUnfocused -> CErrors.user_err Pp.(str "The proof is not focused")
   | _ -> raise CErrors.Unhandled
 end
 
@@ -98,7 +100,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 +114,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 +167,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}. *)
@@ -301,10 +306,10 @@ exception HasShelvedGoals
 exception HasGivenUpGoals
 exception HasUnresolvedEvar
 let _ = CErrors.register_handler begin function
-  | UnfinishedProof -> CErrors.error "Some goals have not been solved."
-  | HasShelvedGoals -> CErrors.error "Some goals have been left on the shelf."
-  | HasGivenUpGoals -> CErrors.error "Some goals have been given up."
-  | HasUnresolvedEvar -> CErrors.error "Some existential variables are uninstantiated."
+  | UnfinishedProof -> CErrors.user_err Pp.(str "Some goals have not been solved.")
+  | HasShelvedGoals -> CErrors.user_err Pp.(str "Some goals have been left on the shelf.")
+  | HasGivenUpGoals -> CErrors.user_err Pp.(str "Some goals have been given up.")
+  | HasUnresolvedEvar -> CErrors.user_err Pp.(str "Some existential variables are uninstantiated.")
   | _ -> raise CErrors.Unhandled
 end
 
@@ -342,7 +347,11 @@ let run_tactic env tac pr =
     Proofview.tclEVARMAP >>= fun sigma ->
     (* Already solved goals are not to be counted as shelved. Nor are
       they to be marked as unresolvable. *)
-    let retrieved = undef sigma (List.rev (Evd.future_goals sigma)) in
+    let retrieved = Evd.filter_future_goals (Evd.is_undefined sigma) (Evd.save_future_goals sigma) in
+    let retrieved,retrieved_given_up = Evd.extract_given_up_future_goals retrieved in
+    (* Check that retrieved given up is empty *)
+    if not (List.is_empty retrieved_given_up) then
+      CErrors.anomaly Pp.(str "Evars generated outside of proof engine (e.g. V82, clear, ...) are not supposed to be explicitly given up.");
     let sigma = List.fold_left Proofview.Unsafe.mark_as_goal sigma retrieved in
     Proofview.Unsafe.tclEVARS sigma >>= fun () ->
     Proofview.tclUNIT retrieved
@@ -372,13 +381,31 @@ let in_proof p k = k (Proofview.return p.proofview)
 let unshelve p =
   { p with proofview = Proofview.unshelve (p.shelf) (p.proofview) ; shelf = [] }
 
+let pr_proof p =
+  let p = map_structured_proof p (fun _sigma g -> g) in
+  Pp.(
+    let pr_goal_list = prlist_with_sep spc Goal.pr_goal in
+    let rec aux acc = function
+      | [] -> acc
+      | (before,after)::stack ->
+         aux (pr_goal_list before ++ spc () ++ str "{" ++ acc ++ str "}" ++ spc () ++
+              pr_goal_list after) stack in
+    str "[" ++ str "focus structure: " ++
+               aux (pr_goal_list p.fg_goals) p.bg_goals ++ str ";" ++ spc () ++
+    str "shelved: " ++ pr_goal_list p.shelved_goals ++ str ";" ++ spc () ++
+    str "given up: " ++ pr_goal_list p.given_up_goals ++
+    str "]"
+  )
+
 (*** Compatibility layer with <=v8.2 ***)
 module V82 = struct
   let subgoals p =
-    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; } =
@@ -404,15 +431,15 @@ module V82 = struct
         let evl = Evarutil.non_instantiated sigma in
         let evl = Evar.Map.bindings evl in
         if (n <= 0) then
-          CErrors.error "incorrect existential variable index"
+          CErrors.user_err Pp.(str "incorrect existential variable index")
         else if CList.length evl < n then
-          CErrors.error "not so many uninstantiated existential variables"
+          CErrors.user_err Pp.(str "not so many uninstantiated existential variables")
         else
           CList.nth evl (n-1)
       in
       let env = Evd.evar_filtered_env evi in
-      let rawc = Constrintern.intern_constr env com in
-      let ltac_vars = Pretyping.empty_lvar in
+      let rawc = Constrintern.intern_constr env sigma com in
+      let ltac_vars = Glob_ops.empty_lvar in
       let sigma = Evar_refiner.w_refine (evk, evi) (ltac_vars, rawc) sigma in
       Proofview.Unsafe.tclEVARS sigma
     end in
diff --git a/proofs/proof.mli b/proofs/proof.mli
index 5053fc7f..c0e832fb 100644
--- a/proofs/proof.mli
+++ b/proofs/proof.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Module defining the last essential tiles of interactive proofs.
@@ -30,7 +32,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 +46,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 +65,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 * Term.types) list -> proof
-val dependent_start : Proofview.telescope -> proof
-val initial_goals : proof -> (Term.constr * Term.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 -> Term.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 +95,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 +135,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,56 +151,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 : 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
new file mode 100644
index 00000000..e22d382f
--- /dev/null
+++ b/proofs/proof_bullet.ml
@@ -0,0 +1,246 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Proof
+
+type t = Vernacexpr.bullet
+
+let bullet_eq b1 b2 = match b1, b2 with
+| Vernacexpr.Dash n1, Vernacexpr.Dash n2 -> n1 = n2
+| Vernacexpr.Star n1, Vernacexpr.Star n2 -> n1 = n2
+| Vernacexpr.Plus n1, Vernacexpr.Plus n2 -> n1 = n2
+| _ -> false
+
+let pr_bullet b =
+  match b with
+  | Vernacexpr.Dash n -> Pp.(str (String.make n '-'))
+  | Vernacexpr.Star n -> Pp.(str (String.make n '*'))
+  | Vernacexpr.Plus n -> Pp.(str (String.make n '+'))
+
+
+type behavior = {
+  name : string;
+  put : Proof.t -> t -> Proof.t;
+  suggest: Proof.t -> Pp.t
+}
+
+let behaviors = Hashtbl.create 4
+let register_behavior b = Hashtbl.add behaviors b.name b
+
+(*** initial modes ***)
+let none = {
+  name = "None";
+  put = (fun x _ -> x);
+  suggest = (fun _ -> Pp.mt ())
+}
+let _ = register_behavior none
+
+module Strict = struct
+  type suggestion =
+  | Suggest of t (* this bullet is mandatory here *)
+  | Unfinished of t (* no mandatory bullet here, but this bullet is unfinished *)
+  | NoBulletInUse (* No mandatory bullet (or brace) here, no bullet pending,
+      	       some focused goals exists. *)
+  | NeedClosingBrace (* Some unfocussed goal exists "{" needed to focus them *)
+  | ProofFinished (* No more goal anywhere *)
+
+  (* give a message only if more informative than the standard coq message *)
+  let suggest_on_solved_goal sugg =
+    match sugg with
+    | NeedClosingBrace -> Pp.(str"Try unfocusing with \"}\".")
+    | NoBulletInUse -> Pp.mt ()
+    | ProofFinished -> Pp.mt ()
+    | Suggest b -> Pp.(str"Focus next goal with bullet " ++ pr_bullet b ++ str".")
+    | Unfinished b -> Pp.(str"The current bullet " ++ pr_bullet b ++ str" is unfinished.")
+
+  (* give always a message. *)
+  let suggest_on_error sugg =
+    match sugg with
+    | NeedClosingBrace -> Pp.(str"Try unfocusing with \"}\".")
+    | NoBulletInUse -> assert false (* This should never raise an error. *)
+    | ProofFinished -> Pp.(str"No more subgoals.")
+    | Suggest b -> Pp.(str"Expecting " ++ pr_bullet b ++ str".")
+    | Unfinished b -> Pp.(str"Current bullet " ++ pr_bullet b ++ str" is not finished.")
+
+  exception FailedBullet of t * suggestion
+
+  let _ =
+    CErrors.register_handler
+      (function
+      | FailedBullet (b,sugg) ->
+        let prefix = Pp.(str"Wrong bullet " ++ pr_bullet b ++ str": ") in
+        CErrors.user_err ~hdr:"Focus" Pp.(prefix ++ suggest_on_error sugg)
+      | _ -> raise CErrors.Unhandled)
+
+
+  (* spiwack: we need only one focus kind as we keep a stack of (distinct!) bullets *)
+  let bullet_kind = (new_focus_kind () : t list focus_kind)
+  let bullet_cond = done_cond ~loose_end:true bullet_kind
+
+  (* spiwack: as it is bullets are reset (locally) by *any* non-bullet focusing command
+     experience will tell if this is the right discipline of if we want to be finer and
+     reset them only for a choice of bullets. *)
+  let get_bullets pr =
+    if is_last_focus bullet_kind pr then
+      get_at_focus bullet_kind pr
+    else
+      []
+
+  let has_bullet bul pr =
+    let rec has_bullet = function
+      | b'::_ when bullet_eq bul b' -> true
+      | _::l -> has_bullet l
+      | [] -> false
+    in
+    has_bullet (get_bullets pr)
+
+  (* pop a bullet from proof [pr]. There should be at least one
+     bullet in use. If pop impossible (pending proofs on this level
+     of bullet or higher) then raise [Proof.CannotUnfocusThisWay]. *)
+  let pop pr =
+    match get_bullets pr with
+    | b::_ -> unfocus bullet_kind pr () , b
+    | _ -> assert false
+
+  let push (b:t) pr =
+    focus bullet_cond (b::get_bullets pr) 1 pr
+
+  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 *)
+      match get_bullets prf with
+      | b::_ -> Unfinished b
+      | _ -> NoBulletInUse
+    else (* There is no goal under focus but some are unfocussed,
+            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
+
+  let put p bul =
+    try
+      if not (has_bullet bul p) then
+        (* bullet is not in use, so pushing it is always ok unless
+           no goal under focus. *)
+        push bul p
+      else
+        match suggest_bullet p with
+        | Suggest suggested_bullet when bullet_eq bul suggested_bullet
+            -> (* suggested_bullet is mandatory and you gave the right one *)
+          let p' = pop_until p bul in
+          push bul p'
+      (* the bullet you gave is in use but not the right one *)
+        | sugg -> raise (FailedBullet (bul,sugg))
+    with NoSuchGoals _ -> (* push went bad *)
+      raise (FailedBullet (bul,suggest_bullet p))
+
+  let strict = {
+    name = "Strict Subproofs";
+    put = put;
+    suggest = (fun prf -> suggest_on_solved_goal (suggest_bullet prf))
+
+  }
+  let _ = register_behavior strict
+end
+
+(* Current bullet behavior, controlled by the option *)
+let current_behavior = ref Strict.strict
+
+let _ =
+  Goptions.(declare_string_option {
+    optdepr = false;
+    optname = "bullet behavior";
+    optkey = ["Bullet";"Behavior"];
+    optread = begin fun () ->
+      (!current_behavior).name
+    end;
+    optwrite = begin fun n ->
+      current_behavior :=
+        try Hashtbl.find behaviors n
+        with Not_found ->
+          CErrors.user_err Pp.(str ("Unknown bullet behavior: \"" ^ n ^ "\"."))
+    end
+  })
+
+let put p b =
+  (!current_behavior).put p b
+
+let suggest p =
+  (!current_behavior).suggest p
+
+(**********************************************************)
+(*                                                        *)
+(*                     Default goal selector              *)
+(*                                                        *)
+(**********************************************************)
+
+
+(* Default goal selector: selector chosen when a tactic is applied
+   without an explicit selector. *)
+let default_goal_selector = ref (Vernacexpr.SelectNth 1)
+let get_default_goal_selector () = !default_goal_selector
+
+let pr_range_selector (i, j) =
+  if i = j then Pp.int i
+  else Pp.(int i ++ str "-" ++ int j)
+
+let pr_goal_selector = function
+  | Vernacexpr.SelectAll -> Pp.str "all"
+  | Vernacexpr.SelectNth i -> Pp.int i
+  | Vernacexpr.SelectList l ->
+    Pp.(str "["
+     ++ prlist_with_sep pr_comma pr_range_selector l
+     ++ str "]")
+  | Vernacexpr.SelectId id -> Names.Id.print id
+
+let parse_goal_selector = function
+  | "all" -> Vernacexpr.SelectAll
+  | i ->
+      let err_msg = "The default selector must be \"all\" or a natural number." in
+      begin try
+              let i = int_of_string i in
+              if i < 0 then CErrors.user_err Pp.(str err_msg);
+              Vernacexpr.SelectNth i
+        with Failure _ -> CErrors.user_err Pp.(str err_msg)
+      end
+
+let _ =
+  Goptions.(declare_string_option{optdepr = false;
+                                  optname = "default goal selector" ;
+                                  optkey = ["Default";"Goal";"Selector"] ;
+                                  optread = begin fun () ->
+                                            Pp.string_of_ppcmds
+                                              (pr_goal_selector !default_goal_selector)
+                                            end;
+                                  optwrite = begin fun n ->
+                                    default_goal_selector := parse_goal_selector n
+                                  end
+                                 })
+
diff --git a/proofs/proof_bullet.mli b/proofs/proof_bullet.mli
new file mode 100644
index 00000000..ffbaa0fa
--- /dev/null
+++ b/proofs/proof_bullet.mli
@@ -0,0 +1,53 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(**********************************************************)
+(*                                                        *)
+(*                                 Bullets                *)
+(*                                                        *)
+(**********************************************************)
+
+type t = Vernacexpr.bullet
+
+(** A [behavior] is the data of a put function which
+    is called when a bullet prefixes a tactic, a suggest function
+    suggesting the right bullet to use on a given proof, together
+    with a name to identify the behavior. *)
+type behavior = {
+  name : string;
+  put : Proof.t -> t -> Proof.t;
+  suggest: Proof.t -> Pp.t
+}
+
+(** A registered behavior can then be accessed in Coq
+    through the command [Set Bullet Behavior "name"].
+
+    Two modes are registered originally:
+    * "Strict Subproofs":
+      - If this bullet follows another one of its kind, defocuses then focuses
+        (which fails if the focused subproof is not complete).
+      - If it is the first bullet of its kind, then focuses a new subproof.
+    * "None": bullets don't do anything *)
+val register_behavior : behavior -> unit
+
+(** Handles focusing/defocusing with bullets:
+     *)
+val put : Proof.t -> t -> Proof.t
+val suggest : Proof.t -> Pp.t
+
+(**********************************************************)
+(*                                                        *)
+(*                     Default goal selector              *)
+(*                                                        *)
+(**********************************************************)
+
+val pr_goal_selector : Vernacexpr.goal_selector -> Pp.t
+val get_default_goal_selector : unit -> Vernacexpr.goal_selector
+
diff --git a/proofs/proof_global.ml b/proofs/proof_global.ml
index e753e972..d6c0e334 100644
--- a/proofs/proof_global.ml
+++ b/proofs/proof_global.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (***********************************************************************)
@@ -18,6 +20,8 @@ open Util
 open Pp
 open Names
 
+module NamedDecl = Context.Named.Declaration
+
 (*** Proof Modes ***)
 
 (* Type of proof modes :
@@ -34,7 +38,7 @@ let proof_modes = Hashtbl.create 6
 let find_proof_mode n =
   try Hashtbl.find proof_modes n
   with Not_found ->
-    CErrors.error (Format.sprintf "No proof mode named \"%s\"." n)
+    CErrors.user_err Pp.(str (Format.sprintf "No proof mode named \"%s\"." n))
 
 let register_proof_mode ({name = n} as m) =
   Hashtbl.add proof_modes n (CEphemeron.create m)
@@ -50,8 +54,7 @@ let get_default_proof_mode_name () =
   (CEphemeron.default !default_proof_mode standard).name
 
 let _ =
-  Goptions.declare_string_option {Goptions.
-    optsync = true ;
+  Goptions.(declare_string_option {
     optdepr = false;
     optname = "default proof mode" ;
     optkey = ["Default";"Proof";"Mode"] ;
@@ -61,41 +64,42 @@ let _ =
     optwrite = begin fun n ->
       default_proof_mode := find_proof_mode n
     end
-  }
+  })
 
 (*** Proof Global Environment ***)
 
 (* 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 * Decl_kinds.theorem_kind option) option *
+              Misctypes.lident option *
               proof_object
 type proof_terminator = proof_ending -> unit
 type closed_proof = proof_object * proof_terminator
 
 type pstate = {
-  pid : Id.t;
+  pid : Id.t;  (* the name of the theorem whose proof is being constructed *)
   terminator : proof_terminator CEphemeron.key;
-  endline_tactic : Tacexpr.raw_tactic_expr option;
-  section_vars : Context.section_context option;
-  proof : Proof.proof;
+  endline_tactic : Genarg.glob_generic_argument option;
+  section_vars : Context.Named.t option;
+  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
 
@@ -123,13 +127,13 @@ let push a l = l := a::!l;
 
 exception NoSuchProof
 let _ = CErrors.register_handler begin function
-  | NoSuchProof -> CErrors.error "No such proof."
+  | NoSuchProof -> CErrors.user_err Pp.(str "No such proof.")
   | _ -> raise CErrors.Unhandled
 end
 
 exception NoCurrentProof
 let _ = CErrors.register_handler begin function
-  | NoCurrentProof -> CErrors.error "No focused proof (No proof-editing in progress)."
+  | NoCurrentProof -> CErrors.user_err Pp.(str "No focused proof (No proof-editing in progress).")
   | _ -> raise CErrors.Unhandled
 end
 
@@ -144,11 +148,9 @@ 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 interp_tac = ref (fun _ -> assert false)
-let set_interp_tac f = interp_tac := f
-
 let with_current_proof f =
   match !pstates with
   | [] -> raise NoCurrentProof
@@ -156,11 +158,18 @@ let with_current_proof f =
       let et =
         match p.endline_tactic with
         | None -> Proofview.tclUNIT ()
-        | Some tac -> !interp_tac tac in
+        | Some tac ->
+          let open Geninterp in
+          let ist = { lfun = Id.Map.empty; extra = TacStore.empty } in
+          let Genarg.GenArg (Genarg.Glbwit tag, tac) = tac in
+          let tac = Geninterp.interp tag ist tac in
+          Ftactic.run tac (fun _ -> Proofview.tclUNIT ())
+      in
       let (newpr,ret) = f et p.proof in
       let p = { p with proof = newpr } in
       pstates := p :: rest;
       ret
+
 let simple_with_current_proof f = with_current_proof (fun t p -> f t p , ())
 
 let compact_the_proof () = simple_with_current_proof (fun _ -> Proof.compact)
@@ -182,7 +191,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 ()
@@ -190,20 +199,20 @@ let check_no_pending_proof () =
   if not (there_are_pending_proofs ()) then
     ()
   else begin
-    CErrors.error (Pp.string_of_ppcmds
+    CErrors.user_err
       (str"Proof editing in progress" ++ msg_proofs () ++ fnl() ++
-       str"Use \"Abort All\" first or complete proof(s)."))
+       str"Use \"Abort All\" first or complete proof(s).")
   end
 
 let discard_gen id =
   pstates := List.filter (fun { pid = id' } -> not (Id.equal id id')) !pstates
 
-let discard (loc,id) =
+let discard {CAst.loc;v=id} =
   let n = List.length !pstates in
   discard_gen id;
   if Int.equal (List.length !pstates) n then
-    CErrors.user_err_loc
-      (loc,"Pfedit.delete_proof",str"No such proof" ++ msg_proofs ())
+    CErrors.user_err ?loc
+      ~hdr:"Pfedit.delete_proof" (str"No such proof" ++ msg_proofs ())
 
 let discard_current () =
   if List.is_empty !pstates then raise NoCurrentProof else pstates := List.tl !pstates
@@ -226,15 +235,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;
@@ -243,10 +259,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;
@@ -255,16 +271,15 @@ 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
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "Proof using Clear Unused";
       Goptions.optkey   = ["Proof";"Using";"Clear";"Unused"];
       Goptions.optread  = (fun () -> !proof_using_auto_clear);
@@ -276,19 +291,19 @@ let set_used_variables l =
   let ids = List.fold_right Id.Set.add l Id.Set.empty in
   let ctx = Environ.keep_hyps env ids in
   let ctx_set =
-    List.fold_right Id.Set.add (List.map get_id ctx) Id.Set.empty in
+    List.fold_right Id.Set.add (List.map NamedDecl.get_id ctx) Id.Set.empty in
   let vars_of = Environ.global_vars_set in
   let aux env entry (ctx, all_safe, to_clear as orig) =
     match entry with
     | LocalAssum (x,_) ->
        if Id.Set.mem x all_safe then orig
-       else (ctx, all_safe, (Loc.ghost,x)::to_clear) 
+       else (ctx, all_safe, (CAst.make x)::to_clear)
     | LocalDef (x,bo, ty) as decl ->
        if Id.Set.mem x all_safe then orig else
        let vars = Id.Set.union (vars_of env bo) (vars_of env ty) in
        if Id.Set.subset vars all_safe
        then (decl :: ctx, Id.Set.add x all_safe, to_clear)
-       else (ctx, all_safe, (Loc.ghost,x) :: to_clear) in
+       else (ctx, all_safe, (CAst.make x) :: to_clear) in
   let ctx, _, to_clear =
     Environ.fold_named_context aux env ~init:(ctx,ctx_set,[]) in
   let to_clear = if !proof_using_auto_clear then to_clear else [] in
@@ -296,7 +311,7 @@ let set_used_variables l =
   | [] -> raise NoCurrentProof
   | p :: rest ->
       if not (Option.is_empty p.section_vars) then
-        CErrors.error "Used section variables can be declared only once";
+        CErrors.user_err Pp.(str "Used section variables can be declared only once");
       pstates := { p with section_vars = Some ctx} :: rest;
       ctx, to_clear
 
@@ -307,17 +322,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 = (Constr.t * Safe_typing.private_constants) list * UState.t
 
-let close_proof ~keep_body_ucst_separate ?feedback_id ~now fpl =
-  let { pid; section_vars; strength; proof; terminator; universe_binders } =
+let close_proof ~keep_body_ucst_separate ?feedback_id ~now
+                (fpl : closed_proof_output Future.computation) =
+  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
@@ -326,72 +342,73 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now fpl =
   let subst_evar k =
     Proof.in_proof proof (fun m -> Evd.existential_opt_value m k) in
   let nf = Universes.nf_evars_and_universes_opt_subst subst_evar
-    (Evd.evar_universe_context_subst universes) in
+    (UState.subst universes) in
   let make_body =
     if poly || now then
       let make_body t (c, eff) =
-        let open Universes in
         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 = Universes.universes_of_constr body in
-        let used_univs_typ = Universes.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 = 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 = 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 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;
-	  const_entry_polymorphic = poly})
-		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
 
-type closed_proof_output = (Term.constr * Safe_typing.private_constants) list * Evd.evar_universe_context
-
 let return_proof ?(allow_partial=false) () =
  let { pid; proof; strength = (_,poly,_) } = cur_pstate () in
  if allow_partial then begin
@@ -401,14 +418,14 @@ let return_proof ?(allow_partial=false) () =
   (** ppedrot: FIXME, this is surely wrong. There is no reason to duplicate
       side-effects... This may explain why one need to uniquize side-effects
       thereafter... *)
-  let proofs = List.map (fun c -> c, eff) proofs in
+  let proofs = List.map (fun c -> EConstr.Unsafe.to_constr c, eff) proofs in
     proofs, Evd.evar_universe_context evd
  end else
   let initial_goals = Proof.initial_goals proof in
   let evd =
     let error s =
       let prf = str " (in proof " ++ Id.print pid ++ str ")" in
-      raise (CErrors.UserError("last tactic before Qed",s ++ prf))
+      raise (CErrors.UserError(Some "last tactic before Qed",s ++ prf))
     in
     try Proof.return proof with
     | Proof.UnfinishedProof ->
@@ -420,12 +437,12 @@ let return_proof ?(allow_partial=false) () =
     | Proof.HasUnresolvedEvar->
         error(strbrk"Attempt to save a proof with existential variables still non-instantiated") in
   let eff = Evd.eval_side_effects evd in
-  let evd = Evd.nf_constraints evd in
+  let evd = Evd.minimize_universes evd in
   (** ppedrot: FIXME, this is surely wrong. There is no reason to duplicate
       side-effects... This may explain why one need to uniquize side-effects
       thereafter... *)
   let proofs = 
-    List.map (fun (c, _) -> (Evarutil.nf_evars_universes evd c, eff)) initial_goals in
+    List.map (fun (c, _) -> (Evarutil.nf_evars_universes evd (EConstr.Unsafe.to_constr c), eff)) initial_goals in
     proofs, Evd.evar_universe_context evd
 
 let close_future_proof ~feedback_id proof =
@@ -442,263 +459,6 @@ let set_terminator hook =
   | [] -> raise NoCurrentProof
   | p :: ps -> pstates := { p with terminator = CEphemeron.create hook } :: ps
 
-
-
-
-(**********************************************************)
-(*                                                        *)
-(*                                 Bullets                *)
-(*                                                        *)
-(**********************************************************)
-
-module Bullet = struct
-
-  type t = Vernacexpr.bullet
-
-  let bullet_eq b1 b2 = match b1, b2 with
-  | Vernacexpr.Dash n1, Vernacexpr.Dash n2 -> n1 = n2
-  | Vernacexpr.Star n1, Vernacexpr.Star n2 -> n1 = n2
-  | Vernacexpr.Plus n1, Vernacexpr.Plus n2 -> n1 = n2
-  | _ -> false
-
-  let pr_bullet b =
-    match b with
-    | Vernacexpr.Dash n -> str (String.make n '-')
-    | Vernacexpr.Star n -> str (String.make n '*')
-    | Vernacexpr.Plus n -> str (String.make n '+')
-
-
-  type behavior = {
-    name : string;
-    put : Proof.proof -> t -> Proof.proof;
-    suggest: Proof.proof -> std_ppcmds
-  }
-
-  let behaviors = Hashtbl.create 4
-  let register_behavior b = Hashtbl.add behaviors b.name b
-
-  (*** initial modes ***)
-  let none = {
-    name = "None";
-    put = (fun x _ -> x);
-    suggest = (fun _ -> mt ())
-  }
-  let _ = register_behavior none
-
-  module Strict = struct
-    type suggestion =
-    | Suggest of t (* this bullet is mandatory here *)
-    | Unfinished of t (* no mandatory bullet here, but this bullet is unfinished *)
-    | NoBulletInUse (* No mandatory bullet (or brace) here, no bullet pending,
-		       some focused goals exists. *)
-    | NeedClosingBrace (* Some unfocussed goal exists "{" needed to focus them *)
-    | ProofFinished (* No more goal anywhere *)
-
-    (* give a message only if more informative than the standard coq message *)
-    let suggest_on_solved_goal sugg =
-      match sugg with
-      | NeedClosingBrace -> str"Try unfocusing with \"}\"."
-      | NoBulletInUse -> mt ()
-      | ProofFinished -> mt ()
-      | Suggest b -> str"Focus next goal with bullet " ++ pr_bullet b ++ str"."
-      | Unfinished b -> str"The current bullet " ++ pr_bullet b ++ str" is unfinished."
-
-    (* give always a message. *)
-    let suggest_on_error sugg =
-      match sugg with
-      | NeedClosingBrace -> str"Try unfocusing with \"}\"."
-      | NoBulletInUse -> assert false (* This should never raise an error. *)
-      | ProofFinished -> str"No more subgoals."
-      | Suggest b -> str"Bullet " ++ pr_bullet b ++ str" is mandatory here."
-      | Unfinished b -> str"Current bullet " ++ pr_bullet b ++ str" is not finished."
-
-    exception FailedBullet of t * suggestion
-
-    let _ =
-      CErrors.register_handler
-	(function
-	| FailedBullet (b,sugg) ->
-	  let prefix = str"Wrong bullet " ++ pr_bullet b ++ str" : " in
-	  CErrors.errorlabstrm "Focus" (prefix ++ suggest_on_error sugg)
-	| _ -> raise CErrors.Unhandled)
-
-
-    (* spiwack: we need only one focus kind as we keep a stack of (distinct!) bullets *)
-    let bullet_kind = (Proof.new_focus_kind () : t list Proof.focus_kind)
-    let bullet_cond = Proof.done_cond ~loose_end:true bullet_kind
-
-    (* spiwack: as it is bullets are reset (locally) by *any* non-bullet focusing command
-       experience will tell if this is the right discipline of if we want to be finer and
-       reset them only for a choice of bullets. *)
-    let get_bullets pr =
-      if Proof.is_last_focus bullet_kind pr then
-	Proof.get_at_focus bullet_kind pr
-      else
-	[]
-
-    let has_bullet bul pr =
-      let rec has_bullet = function
-	| b'::_ when bullet_eq bul b' -> true
-	| _::l -> has_bullet l
-	| [] -> false
-      in
-      has_bullet (get_bullets pr)
-
-    (* pop a bullet from proof [pr]. There should be at least one
-       bullet in use. If pop impossible (pending proofs on this level
-       of bullet or higher) then raise [Proof.CannotUnfocusThisWay]. *)
-    let pop pr =
-      match get_bullets pr with
-      | b::_ -> Proof.unfocus bullet_kind pr () , b
-      | _ -> assert false
-
-    let push (b:t) pr =
-      Proof.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.proof): suggestion =
-      if Proof.is_done prf then ProofFinished
-      else if not (Proof.no_focused_goal prf)
-      then (* No suggestion if a bullet is not mandatory, look for an unfinished bullet *)
-	match get_bullets prf with
-	| 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.proof) bul: Proof.proof =
-      let prf', b = pop prf in
-      if bullet_eq bul b then prf'
-      else pop_until prf' bul
-
-    let put p bul =
-      try
-	if not (has_bullet bul p) then
-	  (* bullet is not in use, so pushing it is always ok unless
-	     no goal under focus. *)
-	  push bul p
-	else
-	  match suggest_bullet p with
-	  | Suggest suggested_bullet when bullet_eq bul suggested_bullet
-	      -> (* suggested_bullet is mandatory and you gave the right one *)
-	    let p' = pop_until p bul in
-	    push bul p'
-	(* the bullet you gave is in use but not the right one *)
-	  | sugg -> raise (FailedBullet (bul,sugg))
-      with Proof.NoSuchGoals _ -> (* push went bad *)
-	raise (FailedBullet (bul,suggest_bullet p))
-
-    let strict = {
-      name = "Strict Subproofs";
-      put = put;
-      suggest = (fun prf -> suggest_on_solved_goal (suggest_bullet prf))
-
-    }
-    let _ = register_behavior strict
-  end
-
-  (* Current bullet behavior, controlled by the option *)
-  let current_behavior = ref Strict.strict
-
-  let _ =
-    Goptions.declare_string_option {Goptions.
-      optsync = true;
-      optdepr = false;
-      optname = "bullet behavior";
-      optkey = ["Bullet";"Behavior"];
-      optread = begin fun () ->
-	(!current_behavior).name
-      end;
-      optwrite = begin fun n ->
-	current_behavior :=
-          try Hashtbl.find behaviors n
-          with Not_found ->
-            CErrors.error ("Unknown bullet behavior: \"" ^ n ^ "\".")
-      end
-    }
-
-  let put p b =
-    (!current_behavior).put p b
-
-  let suggest p =
-    (!current_behavior).suggest p
-end
-
-
-let _ =
-  let hook n =
-    let prf = give_me_the_proof () in
-    (Bullet.suggest prf) in
-  Proofview.set_nosuchgoals_hook hook
-
-
-(**********************************************************)
-(*                                                        *)
-(*                     Default goal selector              *)
-(*                                                        *)
-(**********************************************************)
-
-
-(* Default goal selector: selector chosen when a tactic is applied
-   without an explicit selector. *)
-let default_goal_selector = ref (Vernacexpr.SelectNth 1)
-let get_default_goal_selector () = !default_goal_selector
-
-let print_range_selector (i, j) =
-  if i = j then string_of_int i
-  else string_of_int i ^ "-" ^ string_of_int j
-
-let print_goal_selector = function
-  | Vernacexpr.SelectAll -> "all"
-  | Vernacexpr.SelectNth i -> string_of_int i
-  | Vernacexpr.SelectList l -> "[" ^
-      String.concat ", " (List.map print_range_selector l) ^ "]"
-  | Vernacexpr.SelectId id -> Id.to_string id
-
-let parse_goal_selector = function
-  | "all" -> Vernacexpr.SelectAll
-  | i ->
-      let err_msg = "The default selector must be \"all\" or a natural number." in
-      begin try
-              let i = int_of_string i in
-              if i < 0 then CErrors.error err_msg;
-              Vernacexpr.SelectNth i
-        with Failure _ -> CErrors.error err_msg
-      end
-
-let _ =
-  Goptions.declare_string_option {Goptions.
-                                  optsync = true ;
-                                  optdepr = false;
-                                  optname = "default goal selector" ;
-                                  optkey = ["Default";"Goal";"Selector"] ;
-                                  optread = begin fun () -> print_goal_selector !default_goal_selector end;
-                                  optwrite = begin fun n ->
-                                    default_goal_selector := parse_goal_selector n
-                                  end
-                                 }
-
-
 module V82 = struct
   let get_current_initial_conclusions () =
   let { pid; strength; proof } = cur_pstate () in
@@ -707,12 +467,10 @@ module V82 = struct
     pid, (goals, strength)
 end
 
-type state = pstate list
-        
 let freeze ~marshallable =
   match marshallable with
   | `Yes ->
-      CErrors.anomaly (Pp.str"full marshalling of proof state not supported")
+      CErrors.anomaly (Pp.str"full marshalling of proof state not supported.")
   | `Shallow -> !pstates
   | `No -> !pstates
 let unfreeze s = pstates := s; update_proof_mode ()
@@ -727,3 +485,14 @@ let update_global_env () =
        let tac = Proofview.Unsafe.tclEVARS (Evd.update_sigma_env sigma (Global.env ())) in
        let (p,(status,info)) = Proof.run_tactic (Global.env ()) tac p in
          (p, ())))
+
+(* XXX: Bullet hook, should be really moved elsewhere *)
+let _ =
+  let hook n =
+    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 59daa296..bf35fd65 100644
--- a/proofs/proof_global.mli
+++ b/proofs/proof_global.mli
@@ -1,34 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module defines proof facilities relevant to the
      toplevel. In particular it defines the global proof
      environment. *)
 
-(** Type of proof modes :
-    - A name
-    - A function [set] to set it *from standard mode*
-    - A function [reset] to reset the *standard mode* from it 
-
-*)
-type proof_mode_name = string
-type proof_mode = {
-  name : proof_mode_name ;
-  set : unit -> unit ;
-  reset : unit -> unit
-}
-
-(** Registers a new proof mode which can then be adressed by name
-    in [set_default_proof_mode].
-    One mode is already registered - the standard mode - named "No",
-    It corresponds to Coq default setting are they are set when coqtop starts. *)
-val register_proof_mode : proof_mode -> unit
-val get_default_proof_mode_name : unit -> proof_mode_name
+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
@@ -36,16 +22,13 @@ val check_no_pending_proof : unit -> unit
 val get_current_proof_name : unit -> Names.Id.t
 val get_all_proof_names : unit -> Names.Id.t list
 
-val discard : Names.Id.t Loc.located -> unit
+val discard : Misctypes.lident -> unit
 val discard_current : unit -> unit
 val discard_all : unit -> unit
 
-(** [set_proof_mode] sets the proof mode to be used after it's called. It is
-    typically called by the Proof Mode command. *)
-val set_proof_mode : proof_mode_name -> 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
@@ -57,20 +40,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 * Decl_kinds.theorem_kind option) option *
+              Misctypes.lident option *
               proof_object
 type proof_terminator
 type closed_proof = proof_object * proof_terminator
@@ -78,21 +60,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 ->
-  Decl_kinds.goal_kind -> (Environ.env * Term.types) list  ->
+  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
@@ -108,7 +92,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. *)
@@ -129,87 +113,72 @@ 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 : Tacexpr.raw_tactic_expr -> unit
-val set_interp_tac :
-  (Tacexpr.raw_tactic_expr -> unit Proofview.tactic)
-    -> unit
+val set_endline_tactic : Genarg.glob_generic_argument -> unit
 
 (** Sets the section variables assumed by the proof, returns its closure
  * (w.r.t. type dependencies and let-ins covered by it) + a list of
  * ids to be cleared *)
 val set_used_variables :
-  Names.Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
-val get_used_variables : unit -> Context.section_context option
+  Names.Id.t list -> Context.Named.t * Misctypes.lident 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
 
-(**********************************************************)
-(*                                                        *)
-(*                            Proof modes                 *)
-(*                                                        *)
-(**********************************************************)
+module V82 : sig
+  val get_current_initial_conclusions : unit -> Names.Id.t *(EConstr.types list *
+  Decl_kinds.goal_kind)
+end
 
+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
 
-val activate_proof_mode : proof_mode_name -> unit
-val disactivate_current_proof_mode : unit -> unit
 
 (**********************************************************)
-(*                                                        *)
-(*                                 Bullets                *)
-(*                                                        *)
+(* Proof Mode API                                         *)
+(* The current Proof Mode API is deprecated and a new one *)
+(* will be (hopefully) defined in 8.8                     *)
 (**********************************************************)
 
-module Bullet : sig
-  type t = Vernacexpr.bullet
-
-  (** A [behavior] is the data of a put function which
-      is called when a bullet prefixes a tactic, a suggest function
-      suggesting the right bullet to use on a given proof, together
-      with a name to identify the behavior. *)
-  type behavior = {
-    name : string;
-    put : Proof.proof -> t -> Proof.proof;
-    suggest: Proof.proof -> Pp.std_ppcmds
-  }
-
-  (** A registered behavior can then be accessed in Coq
-      through the command [Set Bullet Behavior "name"].
-
-      Two modes are registered originally:
-      * "Strict Subproofs":
-        - If this bullet follows another one of its kind, defocuses then focuses
-          (which fails if the focused subproof is not complete).
-        - If it is the first bullet of its kind, then focuses a new subproof.
-      * "None": bullets don't do anything *)
-  val register_behavior : behavior -> unit
-
-  (** Handles focusing/defocusing with bullets:
-       *)
-  val put : Proof.proof -> t -> Proof.proof
-  val suggest : Proof.proof -> Pp.std_ppcmds
-end
+(** Type of proof modes :
+    - A name
+    - A function [set] to set it *from standard mode*
+    - A function [reset] to reset the *standard mode* from it 
 
+*)
+type proof_mode_name = string
+type proof_mode = {
+  name : proof_mode_name ;
+  set : unit -> unit ;
+  reset : unit -> unit
+}
 
-(**********************************************************)
-(*                                                        *)
-(*                     Default goal selector              *)
-(*                                                        *)
-(**********************************************************)
+(** Registers a new proof mode which can then be adressed by name
+    in [set_default_proof_mode].
+    One mode is already registered - the standard mode - named "No",
+    It corresponds to Coq default setting are they are set when coqtop starts. *)
+val register_proof_mode : proof_mode -> unit
+(* Can't make this deprecated due to limitations of camlp5 *)
+(* [@@ocaml.deprecated "the current proof mode API is deprecated, use with care, see PR #459 and #566 "] *)
 
-val get_default_goal_selector : unit -> Vernacexpr.goal_selector
+val get_default_proof_mode_name : unit -> proof_mode_name
+[@@ocaml.deprecated "the current proof mode API is deprecated, use with care, see PR #459 and #566 "]
 
-module V82 : sig
-  val get_current_initial_conclusions : unit -> Names.Id.t *(Term.types list *
-  Decl_kinds.goal_kind)
-end
+(** [set_proof_mode] sets the proof mode to be used after it's called. It is
+    typically called by the Proof Mode command. *)
+val set_proof_mode : proof_mode_name -> unit
+[@@ocaml.deprecated "the current proof mode API is deprecated, use with care, see PR #459 and #566 "]
+
+val activate_proof_mode : proof_mode_name -> unit
+[@@ocaml.deprecated "the current proof mode API is deprecated, use with care, see PR #459 and #566 "]
+
+val disactivate_current_proof_mode : unit -> unit
+[@@ocaml.deprecated "the current proof mode API is deprecated, use with care, see PR #459 and #566 "]
 
-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
diff --git a/proofs/proof_type.mli b/proofs/proof_type.ml
index c1207962..149f30c6 100644
--- a/proofs/proof_type.mli
+++ b/proofs/proof_type.ml
@@ -1,26 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Legacy proof engine. Do not use in newly written code. *)
 
 open Evd
-open Names
-open Term
-open Tacexpr
-open Glob_term
-open Nametab
-open Misctypes
+open Constr
 
 (** This module defines the structure of proof tree and the tactic type. So, it
    is used by [Proof_tree] and [Refiner] *)
 
 type prim_rule =
-  | Cut of bool * bool * Id.t * types
   | Refine of constr
 
 (** Nowadays, the only rules we'll consider are the primitive rules *)
diff --git a/proofs/proof_using.mli b/proofs/proof_using.mli
deleted file mode 100644
index b2c65412..00000000
--- a/proofs/proof_using.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Utility code for section variables handling in Proof using... *)
-
-val process_expr :
-  Environ.env -> Vernacexpr.section_subset_expr -> Constr.types list ->
-    Names.Id.t list
-
-val name_set : Names.Id.t -> Vernacexpr.section_subset_expr -> unit
-
-val to_string : Vernacexpr.section_subset_expr -> string
-
-val get_default_proof_using : unit -> string option
diff --git a/proofs/proofs.mllib b/proofs/proofs.mllib
index 804a5436..058e839b 100644
--- a/proofs/proofs.mllib
+++ b/proofs/proofs.mllib
@@ -1,10 +1,11 @@
 Miscprint
 Goal
 Evar_refiner
-Proof_using
+Proof_type
 Logic
 Refine
 Proof
+Proof_bullet
 Proof_global
 Redexpr
 Refiner
diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml
index 72cb05f1..6fb41193 100644
--- a/proofs/redexpr.ml
+++ b/proofs/redexpr.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,6 +13,7 @@ open CErrors
 open Util
 open Names
 open Term
+open EConstr
 open Declarations
 open Globnames
 open Genredexpr
@@ -24,10 +27,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
-  if Termops.occur_meta_or_existential c then
-    error "vm_compute does not support existential variables.";
-  Vnorm.cbv_vm env 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"
@@ -35,24 +39,25 @@ 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,_) =
-    (whd_state_gen true true flags env sigma (t,Reductionops.Stack.empty))
-  in Reductionops.Stack.zip ~refold:true state
+    (whd_state_gen ~refold:true ~tactic_mode:true flags env sigma (t,Reductionops.Stack.empty))
+  in
+  Reductionops.Stack.zip ~refold:true sigma state
 
 let strong_cbn flags =
   strong (whd_cbn flags)
 
 let simplIsCbn = ref (false)
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optdepr = false;
   Goptions.optname =
     "Plug the simpl tactic to the new cbn mechanism";
   Goptions.optkey = ["SimplIsCbn"];
@@ -73,7 +78,7 @@ let set_strategy_one ref l  =
         let cb = Global.lookup_constant sp in
 	(match cb.const_body with
 	  | OpaqueDef _ ->
-            errorlabstrm "set_transparent_const"
+            user_err ~hdr:"set_transparent_const"
               (str "Cannot make" ++ spc () ++
 		 Nametab.pr_global_env Id.Set.empty (ConstRef sp) ++
 		 spc () ++ str "transparent because it was declared opaque.");
@@ -175,19 +180,19 @@ let red_expr_tab = Summary.ref String.Map.empty ~name:"Declare Reduction"
 
 let declare_reduction s f =
   if String.Map.mem s !reduction_tab || String.Map.mem s !red_expr_tab
-  then errorlabstrm "Redexpr.declare_reduction"
+  then user_err ~hdr:"Redexpr.declare_reduction"
     (str "There is already a reduction expression of name " ++ str s)
   else reduction_tab := String.Map.add s f !reduction_tab
 
 let check_custom = function
   | ExtraRedExpr s ->
       if not (String.Map.mem s !reduction_tab || String.Map.mem s !red_expr_tab)
-      then errorlabstrm "Redexpr.check_custom" (str "Reference to undefined reduction expression " ++ str s)
+      then user_err ~hdr:"Redexpr.check_custom" (str "Reference to undefined reduction expression " ++ str s)
   |_ -> ()
 
 let decl_red_expr s e =
   if String.Map.mem s !reduction_tab || String.Map.mem s !red_expr_tab
-  then errorlabstrm "Redexpr.decl_red_expr"
+  then user_err ~hdr:"Redexpr.decl_red_expr"
     (str "There is already a reduction expression of name " ++ str s)
   else begin
     check_custom e;
@@ -195,13 +200,13 @@ let decl_red_expr s e =
   end
 
 let out_arg = function
-  | ArgVar _ -> anomaly (Pp.str "Unevaluated or_var variable")
+  | ArgVar _ -> anomaly (Pp.str "Unevaluated or_var variable.")
   | ArgArg x -> x
 
 let out_with_occurrences (occs,c) =
   (Locusops.occurrences_map (List.map out_arg) occs, c)
 
-let e_red f = { e_redfun = fun env evm c -> Sigma.here (f env (Sigma.to_evar_map evm) c) evm }
+let e_red f env evm c = evm, f env evm c
 
 let head_style = false (* Turn to true to have a semantics where simpl
    only reduce at the head when an evaluable reference is given, e.g.
@@ -247,16 +252,19 @@ let reduction_of_red_expr env =
       with Not_found ->
 	(try reduction_of_red_expr (String.Map.find s !red_expr_tab)
 	 with Not_found ->
-	   errorlabstrm "Redexpr.reduction_of_red_expr"
+	   user_err ~hdr:"Redexpr.reduction_of_red_expr"
              (str "unknown user-defined reduction \"" ++ str s ++ str "\"")))
   | CbvVm o -> (contextualize cbv_vm cbv_vm o, VMcast)
   | CbvNative o -> (contextualize cbv_native cbv_native o, NATIVEcast)
   in
     reduction_of_red_expr
 
+let subst_mps subst c =
+  EConstr.of_constr (Mod_subst.subst_mps subst (EConstr.Unsafe.to_constr c))
+
 let subst_red_expr subs =
   Miscops.map_red_expr_gen
-    (Mod_subst.subst_mps subs)
+    (subst_mps subs)
     (Mod_subst.subst_evaluable_reference subs)
     (Patternops.subst_pattern subs)
 
diff --git a/proofs/redexpr.mli b/proofs/redexpr.mli
index d4c2c4a6..1e59f436 100644
--- a/proofs/redexpr.mli
+++ b/proofs/redexpr.mli
@@ -1,15 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Interpretation layer of redexprs such as hnf, cbv, etc. *)
 
 open Names
-open Term
+open Constr
+open EConstr
 open Pattern
 open Genredexpr
 open Reductionops
diff --git a/proofs/refine.ml b/proofs/refine.ml
index 3f552706..909556b1 100644
--- a/proofs/refine.ml
+++ b/proofs/refine.ml
@@ -1,16 +1,19 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
-open Sigma.Notations
 open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let extract_prefix env info =
   let ctx1 = List.rev (Environ.named_context env) in
   let ctx2 = List.rev (Evd.evar_context info) in
@@ -26,12 +29,12 @@ let typecheck_evar ev env sigma =
   let info = Evd.find sigma ev in
   (** Typecheck the hypotheses. *)
   let type_hyp (sigma, env) decl =
-    let t = get_type decl in
+    let t = EConstr.of_constr (NamedDecl.get_type decl) in
     let evdref = ref sigma in
     let _ = Typing.e_sort_of env evdref t in
     let () = match decl with
     | LocalAssum _ -> ()
-    | LocalDef (_,body,_) -> Typing.e_check env evdref body t
+    | LocalDef (_,body,_) -> Typing.e_check env evdref (EConstr.of_constr body) t
     in
     (!evdref, Environ.push_named decl env)
   in
@@ -40,7 +43,7 @@ let typecheck_evar ev env sigma =
   let (sigma, env) = List.fold_left type_hyp (sigma, env) changed in
   (** Typecheck the conclusion *)
   let evdref = ref sigma in
-  let _ = Typing.e_sort_of env evdref (Evd.evar_concl info) in
+  let _ = Typing.e_sort_of env evdref (EConstr.of_constr (Evd.evar_concl info)) in
   !evdref
 
 let typecheck_proof c concl env sigma =
@@ -68,38 +71,48 @@ let add_side_effect env = function
 let add_side_effects env effects =
   List.fold_left (fun env eff -> add_side_effect env eff) env effects
 
-let make_refine_enter ?(unsafe = true) f =
-  { enter = fun gl ->
-  let gl = Proofview.Goal.assume gl in
+let generic_refine ~typecheck f gl =
   let sigma = Proofview.Goal.sigma gl in
-  let sigma = Sigma.to_evar_map sigma in
   let env = Proofview.Goal.env gl in
   let concl = Proofview.Goal.concl gl in
+  let state = Proofview.Goal.state gl in
   (** Save the [future_goals] state to restore them after the
       refinement. *)
-  let prev_future_goals = Evd.future_goals sigma in
-  let prev_principal_goal = Evd.principal_future_goal sigma in
+  let prev_future_goals = Evd.save_future_goals sigma in
   (** Create the refinement term *)
-  let ((v,c), sigma) = Sigma.run (Evd.reset_future_goals sigma) f in
-  let evs = Evd.future_goals sigma in
-  let evkmain = Evd.principal_future_goal sigma in
+  Proofview.Unsafe.tclEVARS (Evd.reset_future_goals sigma) >>= fun () ->
+  f >>= fun (v, c) ->
+  Proofview.tclEVARMAP >>= fun sigma ->
+  Proofview.V82.wrap_exceptions begin fun () ->
+  let evs = Evd.save_future_goals sigma in
   (** Redo the effects in sigma in the monad's env *)
   let privates_csts = Evd.eval_side_effects sigma in
   let sideff = Safe_typing.side_effects_of_private_constants privates_csts in
   let env = add_side_effects env sideff in
   (** Check that the introduced evars are well-typed *)
   let fold accu ev = typecheck_evar ev env accu in
-  let sigma = if unsafe then sigma else CList.fold_left fold sigma evs in
+  let sigma = if typecheck then Evd.fold_future_goals fold sigma evs else sigma in
   (** Check that the refined term is typesafe *)
-  let sigma = if unsafe then sigma else typecheck_proof c concl env sigma in
+  let sigma = if typecheck then typecheck_proof c concl env sigma else sigma in
   (** Check that the goal itself does not appear in the refined term *)
   let self = Proofview.Goal.goal gl in
   let _ =
     if not (Evarutil.occur_evar_upto sigma self c) then ()
     else Pretype_errors.error_occur_check env sigma self c
   in
+  (** Restore the [future goals] state. *)
+  let sigma = Evd.restore_future_goals sigma prev_future_goals in
+  (** Select the goals *)
+  let evs = Evd.map_filter_future_goals (Proofview.Unsafe.advance sigma) evs in
+  let comb,shelf,given_up,evkmain = Evd.dispatch_future_goals evs in
   (** Proceed to the refinement *)
-  let sigma = match evkmain with
+  let c = EConstr.Unsafe.to_constr c in
+  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
@@ -108,25 +121,37 @@ let make_refine_enter ?(unsafe = true) f =
         | None -> sigma
         | Some id -> Evd.rename evk id sigma
   in
-  (** Restore the [future goals] state. *)
-  let sigma = Evd.restore_future_goals sigma prev_future_goals prev_principal_goal in
-  (** Select the goals *)
-  let comb = CList.map_filter (Proofview.Unsafe.advance sigma) (CList.rev evs) in
+  (** Mark goals *)
   let sigma = CList.fold_left Proofview.Unsafe.mark_as_goal sigma comb in
+  let comb = CList.map (fun x -> Proofview.goal_with_state x state) comb in
   let trace () = Pp.(hov 2 (str"simple refine"++spc()++ Hook.get pr_constrv env sigma c)) in
   Proofview.Trace.name_tactic trace (Proofview.tclUNIT v) >>= fun v ->
   Proofview.Unsafe.tclSETENV (Environ.reset_context env) <*>
   Proofview.Unsafe.tclEVARS sigma <*>
   Proofview.Unsafe.tclSETGOALS comb <*>
+  Proofview.Unsafe.tclPUTSHELF shelf <*>
+  Proofview.Unsafe.tclPUTGIVENUP given_up <*>
   Proofview.tclUNIT v
-  }
+  end
 
-let refine_one ?(unsafe = true) f =
-  Proofview.Goal.enter_one (make_refine_enter ~unsafe f)
+let lift c =
+  Proofview.tclEVARMAP >>= fun sigma ->
+  Proofview.V82.wrap_exceptions begin fun () ->
+  let (sigma, c) = c sigma in
+  Proofview.Unsafe.tclEVARS sigma >>= fun () ->
+  Proofview.tclUNIT c
+  end
 
-let refine ?(unsafe = true) f =
-  let f = { run = fun sigma -> let Sigma (c,sigma,p) = f.run sigma in Sigma (((),c),sigma,p) } in
-  Proofview.Goal.enter (make_refine_enter ~unsafe f)
+let make_refine_enter ~typecheck f gl = generic_refine ~typecheck (lift f) gl
+
+let refine_one ~typecheck f =
+  Proofview.Goal.enter_one (make_refine_enter ~typecheck f)
+
+let refine ~typecheck f =
+  let f evd =
+    let (evd,c) = f evd in (evd,((), c))
+  in
+  Proofview.Goal.enter (make_refine_enter ~typecheck f)
 
 (** Useful definitions *)
 
@@ -134,21 +159,19 @@ let with_type env evd c t =
   let my_type = Retyping.get_type_of env evd c in
   let j = Environ.make_judge c my_type in
   let (evd,j') =
-    Coercion.inh_conv_coerce_to true (Loc.ghost) env evd j t
+    Coercion.inh_conv_coerce_to true env evd j t
   in
   evd , j'.Environ.uj_val
 
-let refine_casted ?unsafe f = Proofview.Goal.enter { enter = begin fun gl ->
-  let gl = Proofview.Goal.assume gl in
+let refine_casted ~typecheck f = Proofview.Goal.enter begin fun gl ->
   let concl = Proofview.Goal.concl gl in
   let env = Proofview.Goal.env gl in
-  let f = { run = fun h ->
-    let Sigma (c, h, p) = f.run h in
-    let sigma, c = with_type env (Sigma.to_evar_map h) c concl in
-    Sigma (c, Sigma.Unsafe.of_evar_map sigma, p)
-  } in
-  refine ?unsafe f
-end }
+  let f h =
+    let (h, c) = f h in
+    with_type env h c concl
+  in
+  refine ~typecheck f
+end
 
 (** {7 solve_constraints}
 
diff --git a/proofs/refine.mli b/proofs/refine.mli
index a44632ef..70a23a9f 100644
--- a/proofs/refine.mli
+++ b/proofs/refine.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The primitive refine tactic used to fill the holes in partial proofs. This
@@ -17,30 +19,33 @@ open Proofview
 
 (** Printer used to print the constr which refine refines. *)
 val pr_constr :
-  (Environ.env -> Evd.evar_map -> Term.constr -> Pp.std_ppcmds) Hook.t
+  (Environ.env -> Evd.evar_map -> Constr.constr -> Pp.t) Hook.t
 
 (** {7 Refinement primitives} *)
 
-val refine : ?unsafe:bool -> Constr.t Sigma.run -> unit tactic
-(** In [refine ?unsafe t], [t] is a term with holes under some
+val refine : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * EConstr.t) -> unit tactic
+(** In [refine ~typecheck t], [t] is a term with holes under some
     [evar_map] context. The term [t] is used as a partial solution
     for the current goal (refine is a goal-dependent tactic), the
     new holes created by [t] become the new subgoals. Exceptions
     raised during the interpretation of [t] are caught and result in
-    tactic failures. If [unsafe] is [false] (default is [true]) [t] is
-    type-checked beforehand. *)
+    tactic failures. If [typecheck] is [true] [t] is type-checked beforehand. *)
 
-val refine_one : ?unsafe:bool -> ('a * Constr.t) Sigma.run -> 'a tactic
-(** A generalization of [refine] which assumes exactly one goal under focus *)
+val refine_one : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * ('a * EConstr.t)) -> 'a tactic
+(** A variant of [refine] which assumes exactly one goal under focus *)
+
+val generic_refine : typecheck:bool -> ('a * EConstr.t) tactic ->
+  Proofview.Goal.t -> 'a tactic
+(** The general version of refine. *)
 
 (** {7 Helper functions} *)
 
 val with_type : Environ.env -> Evd.evar_map ->
-  Term.constr -> Term.types -> Evd.evar_map * Term.constr
+  EConstr.constr -> EConstr.types -> Evd.evar_map * EConstr.constr
 (** [with_type env sigma c t] ensures that [c] is of type [t]
     inserting a coercion if needed. *)
 
-val refine_casted : ?unsafe:bool -> Constr.t Sigma.run -> unit tactic
+val refine_casted : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * EConstr.t) -> unit tactic
 (** Like {!refine} except the refined term is coerced to the conclusion of the
     current goal. *)
 
diff --git a/proofs/refiner.ml b/proofs/refiner.ml
index ea8543b0..be32aadd 100644
--- a/proofs/refiner.ml
+++ b/proofs/refiner.ml
@@ -1,19 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Evd
-open Environ
 open Proof_type
 open Logic
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 let sig_it x = x.it
 let project x = x.sigma
@@ -21,7 +23,7 @@ let project x = x.sigma
 (* Getting env *)
 
 let pf_env gls = Global.env_of_context (Goal.V82.hyps (project gls) (sig_it gls))
-let pf_hyps gls = named_context_of_val (Goal.V82.hyps (project gls) (sig_it gls))
+let pf_hyps gls = EConstr.named_context_of_val (Goal.V82.hyps (project gls) (sig_it gls))
 
 let refiner pr goal_sigma =
   let (sgl,sigma') = prim_refiner pr goal_sigma.sigma goal_sigma.it in
@@ -30,8 +32,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
 
 (*********************)
@@ -60,10 +62,10 @@ let tclIDTAC_MESSAGE s gls =
   Feedback.msg_info (hov 0 s); tclIDTAC gls
 
 (* General failure tactic *)
-let tclFAIL_s s gls = errorlabstrm "Refiner.tclFAIL_s" (str s)
+let tclFAIL_s s gls = user_err ~hdr:"Refiner.tclFAIL_s" (str s)
 
 (* A special exception for levels for the Fail tactic *)
-exception FailError of int * std_ppcmds Lazy.t
+exception FailError of int * Pp.t Lazy.t
 
 (* The Fail tactic *)
 let tclFAIL lvl s g = raise (FailError (lvl,lazy s))
@@ -82,7 +84,7 @@ let thens3parts_tac tacfi tac tacli (sigr,gs) =
   let nf = Array.length tacfi in
   let nl = Array.length tacli in
   let ng = List.length gs in
-  if ng<nf+nl then errorlabstrm "Refiner.thensn_tac" (str "Not enough subgoals.");
+  if ng<nf+nl then user_err ~hdr:"Refiner.thensn_tac" (str "Not enough subgoals.");
   let gll =
       (List.map_i (fun i ->
         apply_sig_tac sigr (if i<nf then tacfi.(i) else if i>=ng-nl then tacli.(nl-ng+i) else tac))
@@ -161,30 +163,10 @@ let tclMAP tacfun l =
 
 (* PROGRESS tac ptree applies tac to the goal ptree and fails if tac leaves
 the goal unchanged *)
-let tclWEAK_PROGRESS tac ptree =
-  let rslt = tac ptree in
-  if Goal.V82.weak_progress rslt ptree then rslt
-  else errorlabstrm "Refiner.WEAK_PROGRESS" (str"Failed to progress.")
-
-(* PROGRESS tac ptree applies tac to the goal ptree and fails if tac leaves
-the goal unchanged *)
 let tclPROGRESS tac ptree =
   let rslt = tac ptree in
   if Goal.V82.progress rslt ptree then rslt
-  else errorlabstrm "Refiner.PROGRESS" (str"Failed to progress.")
-
-(* Same as tclWEAK_PROGRESS but fails also if tactics generates several goals,
-   one of them being identical to the original goal *)
-let tclNOTSAMEGOAL (tac : tactic) goal =
-  let same_goal gls1 evd2 gl2 =
-    Goal.V82.same_goal gls1.sigma gls1.it evd2 gl2
-  in
-  let rslt = tac goal in
-  let {it=gls;sigma=sigma} = rslt in
-  if List.exists (same_goal goal sigma) gls
-  then errorlabstrm "Refiner.tclNOTSAMEGOAL"
-      (str"Tactic generated a subgoal identical to the original goal.")
-  else rslt
+  else user_err ~hdr:"Refiner.PROGRESS" (str"Failed to progress.")
 
 (* Execute tac, show the names of new hypothesis names created by tac
    in the "as" format and then forget everything. From the logical
@@ -197,31 +179,29 @@ let tclNOTSAMEGOAL (tac : tactic) goal =
    destruct), this is not detected by this tactical. *)
 let tclSHOWHYPS (tac : tactic) (goal: Goal.goal Evd.sigma)
     :Proof_type.goal list Evd.sigma =
-  let oldhyps:Context.Named.t = pf_hyps goal in
+  let oldhyps = pf_hyps goal in
   let rslt:Proof_type.goal list Evd.sigma = tac goal in
   let { it = gls; sigma = sigma; } = rslt in
-  let hyps:Context.Named.t list =
+  let hyps =
     List.map (fun gl -> pf_hyps { it = gl; sigma=sigma; }) gls in
-  let cmp d1 d2 = Names.Id.equal (get_id d1) (get_id d2) in
+  let cmp d1 d2 = Names.Id.equal (NamedDecl.get_id d1) (NamedDecl.get_id d2) in
   let newhyps =
     List.map
       (fun hypl -> List.subtract cmp hypl oldhyps)
       hyps
   in
-  let emacs_str s =
-    if !Flags.print_emacs then s else "" in
   let s = 
     let frst = ref true in
     List.fold_left
     (fun acc lh -> acc ^ (if !frst then (frst:=false;"") else " | ")
       ^ (List.fold_left
-	   (fun acc d -> (Names.Id.to_string (get_id d)) ^ " " ^ acc)
+	   (fun acc d -> (Names.Id.to_string (NamedDecl.get_id d)) ^ " " ^ acc)
 	   "" lh))
     "" newhyps in
   Feedback.msg_notice
-    (str (emacs_str "<infoH>")
+    (str "<infoH>"
       ++  (hov 0 (str s))
-      ++  (str (emacs_str "</infoH>")));
+      ++  (str "</infoH>"));
   tclIDTAC goal;;
 
 
@@ -316,7 +296,7 @@ let tclSOLVE tacl = tclFIRST (List.map tclCOMPLETE tacl)
 
 let tclDO n t =
   let rec dorec k =
-    if k < 0 then errorlabstrm "Refiner.tclDO"
+    if k < 0 then user_err ~hdr:"Refiner.tclDO"
       (str"Wrong argument : Do needs a positive integer.");
     if Int.equal k 0 then tclIDTAC
     else if Int.equal k 1 then t else (tclTHEN t (dorec (k-1)))
diff --git a/proofs/refiner.mli b/proofs/refiner.mli
index 6dcafb77..5cd703a2 100644
--- a/proofs/refiner.mli
+++ b/proofs/refiner.mli
@@ -1,15 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Legacy proof engine. Do not use in newly written code. *)
 
 open Evd
 open Proof_type
+open EConstr
 
 (** The refiner (handles primitive rules and high-level tactics). *)
 
@@ -17,7 +20,7 @@ val sig_it  : 'a sigma -> 'a
 val project : 'a sigma -> evar_map
 
 val pf_env  : goal sigma -> Environ.env
-val pf_hyps : goal sigma -> Context.Named.t
+val pf_hyps : goal sigma -> named_context
 
 val unpackage : 'a sigma -> evar_map ref * 'a
 val repackage : evar_map ref -> 'a -> 'a sigma
@@ -30,16 +33,16 @@ val refiner : rule -> tactic
 
 (** [tclIDTAC] is the identity tactic without message printing*)
 val tclIDTAC          : tactic
-val tclIDTAC_MESSAGE  : Pp.std_ppcmds -> tactic
+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 *)
@@ -99,7 +102,7 @@ val tclTHENLASTn    : tactic -> tactic array -> tactic
 val tclTHENFIRSTn   : tactic -> tactic array -> tactic
 
 (** A special exception for levels for the Fail tactic *)
-exception FailError of int * Pp.std_ppcmds Lazy.t
+exception FailError of int * Pp.t Lazy.t
 
 (** Takes an exception and either raise it at the next
    level or do nothing. *)
@@ -115,13 +118,11 @@ val tclTRY           : tactic -> tactic
 val tclTHENTRY       : tactic -> tactic -> tactic
 val tclCOMPLETE      : tactic -> tactic
 val tclAT_LEAST_ONCE : tactic -> tactic
-val tclFAIL          : int -> Pp.std_ppcmds -> tactic
-val tclFAIL_lazy     : int -> Pp.std_ppcmds Lazy.t -> tactic
+val tclFAIL          : int -> Pp.t -> tactic
+val tclFAIL_lazy     : int -> Pp.t Lazy.t -> tactic
 val tclDO            : int -> tactic -> tactic
-val tclWEAK_PROGRESS : tactic -> tactic
 val tclPROGRESS      : tactic -> tactic
 val tclSHOWHYPS      : tactic -> tactic
-val tclNOTSAMEGOAL   : tactic -> tactic
 
 (** [tclIFTHENELSE tac1 tac2 tac3 gls] first applies [tac1] to [gls] then,
    if it succeeds, applies [tac2] to the resulting subgoals,
diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml
index 330594af..1889054f 100644
--- a/proofs/tacmach.ml
+++ b/proofs/tacmach.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -18,9 +20,10 @@ open Tacred
 open Proof_type
 open Logic
 open Refiner
-open Sigma.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let re_sig it  gc = { it = it; sigma = gc; }
 
 (**************************************************************)
@@ -39,44 +42,43 @@ let project  = Refiner.project
 let pf_env   = Refiner.pf_env
 let pf_hyps  = Refiner.pf_hyps
 
+let test_conversion env sigma pb c1 c2 =
+  Reductionops.check_conv ~pb env sigma c1 c2
+
 let pf_concl gls = Goal.V82.concl (project gls) (sig_it gls)
 let pf_hyps_types gls  =
   let sign = Environ.named_context (pf_env gls) in
   List.map (function LocalAssum (id,x)
-                   | LocalDef (id,_,x) -> id, x)
+                   | LocalDef (id,_,x) -> id, EConstr.of_constr x)
            sign
 
-let pf_nth_hyp_id gls n = List.nth (pf_hyps gls) (n-1) |> get_id
+let pf_nth_hyp_id gls n = List.nth (pf_hyps gls) (n-1) |> NamedDecl.get_id
 
 let pf_last_hyp gl = List.hd (pf_hyps gl)
 
 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 =
-  pf_get_hyp gls id |> get_type
+  id |> pf_get_hyp gls |> NamedDecl.get_type
 
 let pf_ids_of_hyps gls = ids_of_named_context (pf_hyps gls)
+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 = Constrintern.construct_reference (pf_hyps gls) id
+let pf_global gls id = EConstr.of_constr (Universes.constr_of_global (Constrintern.construct_reference (pf_hyps gls) id))
 
 let pf_reduction_of_red_expr gls re c =
   let (redfun, _) = reduction_of_red_expr (pf_env gls) re in
-  let sigma = Sigma.Unsafe.of_evar_map (project gls) in
-  let Sigma (c, sigma, _) = redfun.e_redfun (pf_env gls) sigma c in
-  (Sigma.to_evar_map sigma, c)
+  let sigma = project gls in
+  redfun (pf_env gls) sigma c
 
 let pf_apply f gls = f (pf_env gls) (project gls)
 let pf_eapply f gls x = 
@@ -87,7 +89,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
@@ -96,15 +98,12 @@ let pf_get_type_of               = pf_reduce Retyping.get_type_of
 
 let pf_conv_x gl                = pf_reduce test_conversion gl Reduction.CONV
 let pf_conv_x_leq gl            = pf_reduce test_conversion gl Reduction.CUMUL
-let pf_const_value              = pf_reduce (fun env _ -> constant_value_in env)
+let pf_const_value              = pf_reduce (fun env _ c -> EConstr.of_constr (constant_value_in env c))
 
 let pf_reduce_to_quantified_ind = pf_reduce reduce_to_quantified_ind
 let pf_reduce_to_atomic_ind     = pf_reduce reduce_to_atomic_ind
 
-let pf_hnf_type_of gls          = pf_whd_all gls % pf_get_type_of gls
-
-let pf_is_matching              = pf_apply Constr_matching.is_matching_conv
-let pf_matches                  = pf_apply Constr_matching.matches_conv
+let pf_hnf_type_of gls          = pf_get_type_of gls %> pf_whd_all gls
 
 (********************************************)
 (* Definition of the most primitive tactics *)
@@ -112,19 +111,12 @@ let pf_matches                  = pf_apply Constr_matching.matches_conv
 
 let refiner = refiner
 
-let internal_cut_no_check replace id t gl =
-  refiner (Cut (true,replace,id,t)) gl
-
-let internal_cut_rev_no_check replace id t gl =
-  refiner (Cut (false,replace,id,t)) gl
-
 let refine_no_check c gl =
+  let c = EConstr.Unsafe.to_constr c in
   refiner (Refine c) gl
 
 (* Versions with consistency checks *)
 
-let internal_cut b d t = with_check (internal_cut_no_check b d t)
-let internal_cut_rev b d t = with_check (internal_cut_rev_no_check b d t)
 let refine c           = with_check (refine_no_check c)
 
 (* Pretty-printers *)
@@ -134,7 +126,7 @@ open Pp
 let db_pr_goal sigma g =
   let env = Goal.V82.env sigma g in
   let penv = print_named_context env in
-  let pc = print_constr_env env (Goal.V82.concl sigma g) in
+  let pc = print_constr_env env sigma (Goal.V82.concl sigma g) in
   str"  " ++ hv 0 (penv ++ fnl () ++
                    str "============================" ++ fnl ()  ++
                    str" "  ++ pc) ++ fnl ()
@@ -150,8 +142,7 @@ let pr_glls glls =
 module New = struct
 
   let project gl =
-    let sigma = Proofview.Goal.sigma gl in
-    Sigma.to_evar_map sigma
+    Proofview.Goal.sigma gl
 
   let pf_apply f gl =
     f (Proofview.Goal.env gl) (project gl)
@@ -161,7 +152,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
 
@@ -171,9 +161,6 @@ module New = struct
   let pf_unsafe_type_of gl t =
     pf_apply unsafe_type_of gl t
 
-  let pf_get_type_of gl t =
-    pf_apply (Retyping.get_type_of ~lax:true) gl t
-
   let pf_type_of gl t =
     pf_apply type_of gl t
 
@@ -181,39 +168,43 @@ 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 Environ.lookup_named id hyps
-      with Not_found -> raise (RefinerError (NoSuchHyp id))
+      try EConstr.lookup_named id hyps
+      with Not_found -> raise (RefinerError (hyps, sigma, NoSuchHyp id))
     in
     sign
 
   let pf_get_hyp_typ id gl =
-    pf_get_hyp id gl |> get_type
+    pf_get_hyp id gl |> NamedDecl.get_type
 
   let pf_hyps_types gl =
     let env = Proofview.Goal.env gl in
     let sign = Environ.named_context env in
     List.map (function LocalAssum (id,x)
-                     | LocalDef (id,_,x) -> id, x)
+                     | LocalDef (id,_,x) -> id, EConstr.of_constr x)
              sign
 
   let pf_last_hyp gl =
     let hyps = Proofview.Goal.hyps gl in
     List.hd hyps
 
-  let pf_nf_concl (gl : ([ `LZ ], 'r) 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
@@ -229,8 +220,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 59f296f6..770d0940 100644
--- a/proofs/tacmach.mli
+++ b/proofs/tacmach.mli
@@ -1,24 +1,27 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
-open Evd
+open EConstr
 open Proof_type
 open Redexpr
-open Pattern
 open Locus
-open Misctypes
 
 (** 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
@@ -33,22 +36,21 @@ val apply_sig_tac :
 
 val pf_concl              : goal sigma -> types
 val pf_env                : goal sigma -> env
-val pf_hyps               : goal sigma -> Context.Named.t
+val pf_hyps               : goal sigma -> named_context
 (*i val pf_untyped_hyps       : goal sigma -> (Id.t * constr) list i*)
 val pf_hyps_types         : goal sigma -> (Id.t * types) list
 val pf_nth_hyp_id         : goal sigma -> int -> Id.t
-val pf_last_hyp           : goal sigma -> Context.Named.Declaration.t
+val pf_last_hyp           : goal sigma -> named_declaration
 val pf_ids_of_hyps        : goal sigma -> Id.t list
 val pf_global             : goal sigma -> Id.t -> constr
 val pf_unsafe_type_of            : goal sigma -> constr -> types
 val pf_type_of            : goal sigma -> constr -> evar_map * types
 val pf_hnf_type_of        : goal sigma -> constr -> types
 
-val pf_get_hyp            : goal sigma -> Id.t -> Context.Named.Declaration.t
+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
 
@@ -67,8 +69,8 @@ val pf_whd_all       : goal sigma -> constr -> constr
 val pf_hnf_constr              : goal sigma -> constr -> constr
 val pf_nf                      : goal sigma -> constr -> constr
 val pf_nf_betaiota             : goal sigma -> constr -> constr
-val pf_reduce_to_quantified_ind : goal sigma -> types -> pinductive * types
-val pf_reduce_to_atomic_ind     : goal sigma -> types -> pinductive * types
+val pf_reduce_to_quantified_ind : goal sigma -> types -> (inductive * EInstance.t) * types
+val pf_reduce_to_atomic_ind     : goal sigma -> types -> (inductive * EInstance.t) * types
 val pf_compute                 : goal sigma -> constr -> constr
 val pf_unfoldn    : (occurrences * evaluable_global_reference) list
   -> goal sigma -> constr -> constr
@@ -77,69 +79,61 @@ 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
-val internal_cut_no_check     : bool -> Id.t -> types -> tactic
 val refine_no_check           : constr -> tactic
 
 (** {6 The most primitive tactics with consistency and type checking } *)
 
-val internal_cut     : bool -> Id.t -> types -> tactic
-val internal_cut_rev : bool -> Id.t -> types -> tactic
 val refine           : constr -> tactic
 
 (** {6 Pretty-printing functions (debug only). } *)
-val pr_gls    : goal sigma -> Pp.std_ppcmds
-val pr_glls   : goal list sigma -> Pp.std_ppcmds
+val pr_gls    : goal sigma -> Pp.t
+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, 'r) Proofview.Goal.t -> 'a
-  val pf_global : identifier -> ('a, 'r) Proofview.Goal.t -> constr
+  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 ], 'r) Proofview.Goal.t -> 'a
+  val of_old : (Proof_type.goal Evd.sigma -> 'a) -> Proofview.Goal.t -> 'a
 
-  val project : ('a, 'r) Proofview.Goal.t -> Evd.evar_map
-  val pf_env : ('a, 'r) Proofview.Goal.t -> Environ.env
-  val pf_concl : ([ `NF ], 'r) 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, 'r) Proofview.Goal.t -> Term.constr -> Term.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, 'r) Proofview.Goal.t -> Term.constr -> Term.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, 'r) Proofview.Goal.t -> Term.constr -> evar_map * Term.types
-  val pf_conv_x : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.constr -> bool
-
-  val pf_get_new_id  : identifier -> ([ `NF ], 'r) Proofview.Goal.t -> identifier
-  val pf_ids_of_hyps : ('a, 'r) Proofview.Goal.t -> identifier list
-  val pf_hyps_types : ('a, 'r) 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 -> ([ `NF ], 'r) Proofview.Goal.t -> Context.Named.Declaration.t
-  val pf_get_hyp_typ        : identifier -> ([ `NF ], 'r) Proofview.Goal.t -> types
-  val pf_last_hyp           : ([ `NF ], 'r) Proofview.Goal.t -> Context.Named.Declaration.t
+  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 ], 'r) Proofview.Goal.t -> types
-  val pf_reduce_to_quantified_ind : ('a, 'r) Proofview.Goal.t -> types -> pinductive * 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, 'r) Proofview.Goal.t -> constr -> types
-  val pf_hnf_type_of : ('a, 'r) 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, 'r) Proofview.Goal.t -> constr -> constr
-  val pf_compute : ('a, 'r) 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, 'r) 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, 'r) Proofview.Goal.t -> constr -> constr
+  val pf_nf_evar : Proofview.Goal.t -> constr -> constr
 
 end
diff --git a/shell.nix b/shell.nix
new file mode 100644
index 00000000..3201c505
--- /dev/null
+++ b/shell.nix
@@ -0,0 +1,4 @@
+# Some developers don't want a pinned nix-shell by default.
+# If you want to use the pin nix-shell or a more sophisticated set of arguments:
+# $ nix-shell default.nix --arg shell true
+import ./default.nix { pkgs = import <nixpkgs> {}; shell = true; }
diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml
index fa6422cd..b3e1500a 100644
--- a/stm/asyncTaskQueue.ml
+++ b/stm/asyncTaskQueue.ml
@@ -1,26 +1,30 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Pp
 open Util
 
-let pr_err s = Printf.eprintf "%s] %s\n" (System.process_id ()) s; flush stderr
+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 ()
 
-let prerr_endline s = if !Flags.debug then begin pr_err 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 +33,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 +50,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 +60,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 ->
@@ -105,24 +106,24 @@ module Make(T : Task) = struct
 
   let report_status ?(id = !Flags.async_proofs_worker_id) s =
     let open Feedback in
-    feedback ~id:(State Stateid.initial) (WorkerStatus(id, s))
+    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]
+                   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"
@@ -140,38 +141,37 @@ 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
     let stop_waiting = ref false in
     let expiration_date = ref (ref false) in
     let pick_task () =
-      prerr_endline "waiting for a task";
+      stm_prerr_endline "waiting for a task";
       let pick age (t, c) = not !c && T.task_match age t in
       let task, task_expiration =
         TQueue.pop ~picky:(pick !worker_age) ~destroy:stop_waiting queue in
       expiration_date := task_expiration;
       last_task := Some task;
-      prerr_endline ("got task: "^T.name_of_task task);
+      stm_prerr_endline ("got task: " ^ T.name_of_task task);
       task in
     let add_tasks l =
       List.iter (fun t -> TQueue.push queue (t,!expiration_date)) l in
     let get_exec_token () =
       ignore(CoqworkmgrApi.get 1);
       got_token := true;
-      prerr_endline ("got execution token") in
+      stm_prerr_endline ("got execution token") in
     let kill proc =
       Worker.kill proc;
-      prerr_endline ("Worker exited: " ^
+      stm_prerr_endline ("Worker exited: " ^
         match Worker.wait proc with
         | Unix.WEXITED 0x400 -> "exit code unavailable"
         | Unix.WEXITED i -> Printf.sprintf "exit(%d)" i
         | Unix.WSIGNALED sno -> Printf.sprintf "signalled(%d)" sno
         | Unix.WSTOPPED sno -> Printf.sprintf "stopped(%d)" sno) in
     let more_univs n =
-      CList.init 10 (fun _ ->
-        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 ()
@@ -196,7 +196,7 @@ module Make(T : Task) = struct
       report_status ~id "Idle";
       let task = pick_task () in
       match T.request_of_task !worker_age task with
-      | None -> prerr_endline ("Task expired: " ^ T.name_of_task task)
+      | None -> stm_prerr_endline ("Task expired: " ^ T.name_of_task task)
       | Some req ->
       try
         get_exec_token ();
@@ -213,7 +213,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 ()
@@ -222,8 +222,7 @@ module Make(T : Task) = struct
           raise e (* we pass the exception to the external handler *)
       | MarshalError s -> T.on_marshal_error s task; raise Die
       | e ->
-          pr_err ("Uncaught exception in worker manager: "^
-            string_of_ppcmds (print e));
+          stm_pr_err Pp.(seq [str "Uncaught exception in worker manager: "; print e]);
           flush_all (); raise Die
     done with
     | (Die | TQueue.BeingDestroyed) ->
@@ -237,8 +236,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 =
@@ -251,18 +250,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) =
-    prerr_endline ("Enqueue task "^T.name_of_task t);
-    TQueue.push queue item
+  let enqueue_task { queue; active } t ~cancel_switch =
+    stm_prerr_endline ("Enqueue task "^T.name_of_task t);
+    TQueue.push queue (t, cancel_switch)
 
   let cancel_worker { active } n = Pool.cancel n active
 
@@ -298,28 +297,20 @@ module Make(T : Task) = struct
   let slave_handshake () =
     Pool.worker_handshake (Option.get !slave_ic) (Option.get !slave_oc)
 
-  let pp_pid pp = 
-    (* Breaking all abstraction barriers... very nice *)
-    let get_xml pp = match Richpp.repr pp with
-      | Xml_datatype.Element("_", [], xml) -> xml
-      | _ -> assert false in
-    Richpp.richpp_of_xml (Xml_datatype.Element("_", [],
-      get_xml (Richpp.richpp_of_pp Pp.(str (System.process_id ()^ " "))) @
-      get_xml pp))
+  let pp_pid pp = Pp.(str (Spawned.process_id () ^ " ") ++ pp)
 
   let debug_with_pid = Feedback.(function
     | { contents = Message(Debug, loc, pp) } as fb ->
-       { fb with contents = Message(Debug,loc,pp_pid pp) }
+       { fb with contents = Message(Debug,loc, pp_pid pp) }
     | x -> x)
 
   let main_loop () =
     (* We pass feedback to master *)
     let slave_feeder oc fb =
       Marshal.to_channel oc (RespFeedback (debug_with_pid fb)) []; flush oc in
-    Feedback.add_feeder (fun x -> slave_feeder (Option.get !slave_oc) x);
-    Feedback.set_logger Feedback.feedback_logger;
+    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));
@@ -337,25 +328,25 @@ module Make(T : Task) = struct
         CEphemeron.clear ()
       with
       | MarshalError s ->
-        pr_err ("Fatal marshal error: " ^ s); flush_all (); exit 2
+        stm_pr_err Pp.(prlist str ["Fatal marshal error: "; s]); flush_all (); exit 2
       | End_of_file ->
-        prerr_endline "connection lost"; flush_all (); exit 2
+        stm_prerr_endline "connection lost"; flush_all (); exit 2
       | e ->
-        pr_err ("Slave: critical exception: " ^ Pp.string_of_ppcmds (print e));
+        stm_pr_err Pp.(seq [str "Slave: critical exception: "; print e]);
         flush_all (); exit 1
     done
 
   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
 
@@ -363,5 +354,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 f140f8ed..6e6827c7 100644
--- a/stm/asyncTaskQueue.mli
+++ b/stm/asyncTaskQueue.mli
@@ -1,84 +1,221 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-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 20d5152a..36b5d18a 100644
--- a/stm/coqworkmgrApi.ml
+++ b/stm/coqworkmgrApi.ml
@@ -1,15 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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 +45,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 +66,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 +115,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 +126,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 54895814..2983b619 100644
--- a/stm/coqworkmgrApi.mli
+++ b/stm/coqworkmgrApi.mli
@@ -1,16 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* 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 +27,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/dag.ml b/stm/dag.ml
index 99e7c926..eb5063bf 100644
--- a/stm/dag.ml
+++ b/stm/dag.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type S = sig
diff --git a/stm/dag.mli b/stm/dag.mli
index e783cd8e..cae4fccc 100644
--- a/stm/dag.mli
+++ b/stm/dag.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module type S = sig
diff --git a/stm/lemmas.mli b/stm/lemmas.mli
deleted file mode 100644
index 39c089be..00000000
--- a/stm/lemmas.mli
+++ /dev/null
@@ -1,69 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Term
-open Decl_kinds
-open Pfedit
-
-type 'a declaration_hook
-val mk_hook :
-  (Decl_kinds.locality -> Globnames.global_reference -> 'a) -> 'a declaration_hook
-
-val call_hook :
-  Future.fix_exn -> 'a declaration_hook -> Decl_kinds.locality -> Globnames.global_reference -> 'a
-
-(** A hook start_proof calls on the type of the definition being started *)
-val set_start_hook : (types -> unit) -> unit
-
-val start_proof : Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_map ->
-  ?terminator:(lemma_possible_guards -> unit declaration_hook -> Proof_global.proof_terminator) ->
-  ?sign:Environ.named_context_val -> types ->
-  ?init_tac:unit Proofview.tactic -> ?compute_guard:lemma_possible_guards -> 
-   unit declaration_hook -> unit
-
-val start_proof_univs : Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_map ->
-  ?terminator:(lemma_possible_guards -> (Evd.evar_universe_context option -> unit declaration_hook) -> Proof_global.proof_terminator) ->
-  ?sign:Environ.named_context_val -> types ->
-  ?init_tac:unit Proofview.tactic -> ?compute_guard:lemma_possible_guards -> 
-  (Evd.evar_universe_context 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 ->
-  (bool * lemma_possible_guards * unit Proofview.tactic list option) option ->
-  ((Id.t * universe_binders option) *
-     (types * (Name.t list * 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) ->
-    Proof_global.proof_terminator
-
-val standard_proof_terminator :
-  Proof_global.lemma_possible_guards -> unit declaration_hook ->
-    Proof_global.proof_terminator
-
-(** {6 ... } *)
-
-(** A hook the next three functions pass to cook_proof *)
-val set_save_hook : (Proof.proof -> unit) -> unit
-
-val save_proof : ?proof:Proof_global.closed_proof -> Vernacexpr.proof_end -> unit
-
-
-(** [get_current_context ()] returns the evar context and env of the
-   current open proof if any, otherwise returns the empty evar context
-   and the current global env *)
-
-val get_current_context : unit -> Evd.evar_map * Environ.env
diff --git a/stm/proofBlockDelimiter.ml b/stm/proofBlockDelimiter.ml
index 8162fc3b..23f97612 100644
--- a/stm/proofBlockDelimiter.ml
+++ b/stm/proofBlockDelimiter.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Stm
@@ -11,7 +13,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 +25,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 +34,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 +45,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 +76,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 +108,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 +121,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 +143,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 +169,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 a55032a4..9784de11 100644
--- a/stm/proofBlockDelimiter.mli
+++ b/stm/proofBlockDelimiter.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file implements proof block detection for:
@@ -21,7 +23,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 23538a46..4b85a05a 100644
--- a/stm/proofworkertop.ml
+++ b/stm/proofworkertop.ml
@@ -1,18 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-module W = AsyncTaskQueue.MakeWorker(Stm.ProofTask)
+module W = AsyncTaskQueue.MakeWorker(Stm.ProofTask) ()
 
-let () = Coqtop.toploop_init := (fun args ->
-        Flags.make_silent true;
-        W.init_stdout ();
-        CoqworkmgrApi.init !Flags.async_proofs_worker_priority;
-        args)
+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 fff6d554..aa00102a 100644
--- a/stm/queryworkertop.ml
+++ b/stm/queryworkertop.ml
@@ -1,18 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-module W = AsyncTaskQueue.MakeWorker(Stm.QueryTask)
+module W = AsyncTaskQueue.MakeWorker(Stm.QueryTask) ()
 
-let () = Coqtop.toploop_init := (fun args ->
-        Flags.make_silent true;
-        W.init_stdout ();
-        CoqworkmgrApi.init !Flags.async_proofs_worker_priority;
-        args)
+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 c5bd5f6f..3833c802 100644
--- a/stm/spawned.ml
+++ b/stm/spawned.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Spawn
@@ -46,7 +48,7 @@ let control_channel = ref None
 let channels = ref None
 
 let init_channels () =
-  if !channels <> None then CErrors.anomaly(Pp.str "init_channels called twice");
+  if !channels <> None then CErrors.anomaly(Pp.str "init_channels called twice.");
   let () = match !main_channel with
   | None -> ()
   | Some (Socket(mh,mpr,mpw)) ->
@@ -65,7 +67,7 @@ let init_channels () =
   | Some (Socket (ch, cpr, cpw)) ->
     controller ch cpr cpw
   | Some AnonPipe ->
-    CErrors.anomaly (Pp.str "control channel cannot be a pipe")
+    CErrors.anomaly (Pp.str "control channel cannot be a pipe.")
 
 let get_channels () =
   match !channels with
@@ -73,3 +75,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 acad49f3..df4e7259 100644
--- a/stm/spawned.mli
+++ b/stm/spawned.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* To link this file, threads are needed *)
@@ -20,3 +22,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 b4331dc4..e1b90bd2 100644
--- a/stm/stm.ml
+++ b/stm/stm.ml
@@ -1,63 +1,113 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-let pr_err s = Printf.eprintf "%s] %s\n" (System.process_id ()) s; flush stderr
+(* enable in case of stm problems  *)
+(* let stm_debug () = !Flags.debug *)
+let stm_debug = ref false
 
-let prerr_endline s = if false then begin pr_err (s ()) end else ()
-let prerr_debug s = if !Flags.debug then begin pr_err (s ()) end else ()
+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
 
-(* Opening ppvernac below aliases Richpp, see PR#185 *)
-let pp_to_richpp  = Richpp.richpp_of_pp
-let str_to_richpp = Richpp.richpp_of_string
+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 Vernacexpr
-open CErrors
 open Pp
+open CErrors
 open Names
-open Util
-open Ppvernac
-open Vernac_classifier
 open Feedback
+open Vernacexpr
 
-module Hooks = struct
+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 process_error, process_error_hook = Hook.make ()
-let interp, interp_hook = Hook.make ()
-let with_fail, with_fail_hook = Hook.make ()
+  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))
+
+module Hooks = struct
 
 let state_computed, state_computed_hook = Hook.make
  ~default:(fun state_id ~in_cache ->
-    feedback ~id:(State state_id) Processed) ()
+    feedback ~id:state_id Processed) ()
 
 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 parse_error, parse_error_hook = Hook.make
- ~default:(fun id loc msg ->
-        feedback ~id (Message(Error, Some loc, pp_to_richpp msg))) ()
-
-let execution_error, execution_error_hook = Hook.make
- ~default:(fun state_id loc msg ->
-    feedback ~id:(State state_id) (Message(Error, Some loc, pp_to_richpp msg))) ()
-
 let unreachable_state, unreachable_state_hook = Hook.make
  ~default:(fun _ _ -> ()) ()
 
-let tactic_being_run, tactic_being_run_hook = Hook.make
- ~default:(fun _ -> ()) ()
-
 include Hook
 
 (* enables:  Hooks.(call foo args) *)
@@ -69,99 +119,37 @@ let call_process_error_once =
     match Exninfo.get info processed with
     | Some _ -> ei
     | None ->
-        let e, info = call process_error ei in
+        let e, info = ExplainErr.process_vernac_interp_error ei in
         let info = Exninfo.add info processed () in
         e, info
 
 end
 
-(* During interactive use we cache more states so that Undoing is fast *)
-let interactive () =
-  if !Flags.ide_slave || !Flags.print_emacs || not !Flags.batch_mode then `Yes
-  else `No
-
 let async_proofs_workers_extra_env = ref [||]
 
 type aast = {
   verbose : bool;
-  loc : Loc.t;
+  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 } = int indentation ++ str " " ++ pr_vernac expr
+let pr_ast { expr; indentation } = Pp.(int indentation ++ str " " ++ Ppvernac.pr_vernac expr)
 
-let default_proof_mode () = Proof_global.get_default_proof_mode_name ()
+let default_proof_mode () = Proof_global.get_default_proof_mode_name () [@ocaml.warning "-3"]
 
 (* 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
 
-(* Wrapper for Vernacentries.interp to set the feedback id *)
-let vernac_interp ?proof id ?route { verbose; loc; expr } =
-  let rec internal_command = function
-    | VernacResetName _ | VernacResetInitial | VernacBack _
-    | VernacBackTo _ | VernacRestart | VernacUndo _ | VernacUndoTo _
-    | VernacBacktrack _ | VernacAbortAll | VernacAbort _ -> true
-    | VernacTime (_,e) | VernacTimeout (_,e) | VernacRedirect (_,(_,e)) -> internal_command e
-    | _ -> false in
-  if internal_command expr then begin
-    prerr_endline (fun () -> "ignoring " ^ Pp.string_of_ppcmds(pr_vernac expr))
-  end else begin
-    set_id_for_feedback ?route (State id);
-    Aux_file.record_in_aux_set_at loc;
-    prerr_endline (fun () -> "interpreting " ^ Pp.string_of_ppcmds(pr_vernac expr));
-    try Hooks.(call interp ?verbosely:(Some verbose) ?proof (loc, expr))
-    with e ->
-      let e = CErrors.push e in
-      iraise Hooks.(call_process_error_once e)
-  end
-
-(* Wrapper for Vernac.parse_sentence to set the feedback id *)
-let indentation_of_string s =
-  let len = String.length s in
-  let rec aux n i precise =
-    if i >= len then 0, precise, len
-    else
-      match s.[i] with
-      | ' ' | '\t' -> aux (succ n) (succ i) precise
-      | '\n' | '\r' -> aux 0 (succ i) true
-      | _ -> n, precise, len in
-  aux 0 0 false
-
-let vernac_parse ?(indlen_prev=fun() -> 0) ?newtip ?route eid s =
-  let feedback_id = 
-    if Option.is_empty newtip then Edit eid
-    else State (Option.get newtip) in
-  let indentation, precise, strlen = indentation_of_string s in
-  let indentation =
-    if precise then indentation else indlen_prev () + indentation in
-  set_id_for_feedback ?route feedback_id;
-  let pa = Pcoq.Gram.parsable (Stream.of_string s) in
-  Flags.with_option Flags.we_are_parsing (fun () ->
-    try
-      match Pcoq.Gram.entry_parse Pcoq.main_entry pa with
-      | None -> raise (Invalid_argument "vernac_parse")
-      | Some (loc, ast) -> indentation, strlen, loc, ast
-    with e when CErrors.noncritical e ->
-      let (e, info) = CErrors.push e in
-      let loc = Option.default Loc.ghost (Loc.get_loc info) in
-      Hooks.(call parse_error feedback_id loc (iprint (e, info)));
-      iraise (e, info))
-  ()
-
-let pr_open_cur_subgoals () =
-  try Printer.pr_open_subgoals ()
-  with Proof_global.NoCurrentProof -> Pp.str ""
-
 let update_global_env () =
   if Proof_global.there_are_pending_proofs () then
     Proof_global.update_global_env ()
@@ -170,7 +158,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
@@ -181,22 +168,23 @@ type cmd_t = {
   ctac : bool; (* is a tactic *)
   ceff : bool; (* is a side-effecting command in the middle of a proof *)
   cast : aast;
-  cids : Id.t list;
+  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 * Id.t list
+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
 }
-type seff_t = aast option
+type seff_t = ReplayCommand of aast | CherryPickEnv
 type alias_t = Stateid.t * aast
+
 type transaction =
   | Cmd    of cmd_t
   | Fork   of fork_t
@@ -208,30 +196,30 @@ type step =
   [ `Cmd    of cmd_t
   | `Fork   of fork_t * Stateid.t option
   | `Qed    of qed_t * Stateid.t
-  | `Sideff of [ `Ast of aast * Stateid.t | `Id of 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 *)
@@ -241,7 +229,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.
@@ -276,7 +264,7 @@ end = struct (* {{{ *)
 
   let proof_nesting vcs =
     List.fold_left max 0
-      (List.map_filter
+      (CList.map_filter
         (function
          | { Vcs_.kind = `Proof (_,n) } -> Some n
          | { Vcs_.kind = `Edit _ } -> Some 1
@@ -286,7 +274,7 @@ end = struct (* {{{ *)
   let find_proof_at_depth vcs pl =
     try List.find (function
           | _, { Vcs_.kind = `Proof(m, n) } -> Int.equal n pl
-          | _, { Vcs_.kind = `Edit _ } -> anomaly(Pp.str "find_proof_at_depth")
+          | _, { Vcs_.kind = `Edit _ } -> anomaly(Pp.str "find_proof_at_depth.")
           | _ -> false)
         (List.map (fun h -> h, Vcs_.get_branch vcs h) (Vcs_.branches vcs))
     with Not_found -> failwith "find_proof_at_depth"
@@ -294,9 +282,9 @@ end = struct (* {{{ *)
   exception Expired
   let visit vcs id =
     if Stateid.equal id Stateid.initial then
-      anomaly(Pp.str "Visiting the initial state id")
+      anomaly(Pp.str "Visiting the initial state id.")
     else if Stateid.equal id Stateid.dummy then
-      anomaly(Pp.str "Visiting the dummy state id")
+      anomaly(Pp.str "Visiting the dummy state id.")
     else
     try
       match Vcs_.Dag.from_node (Vcs_.dag vcs) id with
@@ -307,12 +295,12 @@ end = struct (* {{{ *)
       | [p, Noop; n, Fork x] -> { step = `Fork (x,Some p); next = n }
       | [n, Qed x; p, Noop]
       | [p, Noop; n, Qed x] -> { step = `Qed (x,p); next = n }
-      | [n, Sideff None; p, Noop]
-      | [p, Noop; n, Sideff None]-> { step = `Sideff (`Id p); next = n }
-      | [n, Sideff (Some x); p, Noop]
-      | [p, Noop; n, Sideff (Some x)]-> { step = `Sideff(`Ast (x,p)); next = n }
-      | [n, Sideff (Some x)]-> {step = `Sideff(`Ast (x,Stateid.dummy)); next=n}
-      | _ -> anomaly (Pp.str ("Malformed VCS at node "^Stateid.to_string id))
+      | [n, Sideff CherryPickEnv; p, Noop]
+      | [p, Noop; n, Sideff CherryPickEnv]-> { step = `Sideff (CherryPickEnv, p); next = n }
+      | [n, Sideff (ReplayCommand x); p, Noop]
+      | [p, Noop; n, Sideff (ReplayCommand x)]-> { step = `Sideff(ReplayCommand x,p); next = n }
+      | [n, Sideff (ReplayCommand x)]-> {step = `Sideff(ReplayCommand x, Stateid.dummy); next=n}
+      | _ -> anomaly (Pp.str ("Malformed VCS at node "^Stateid.to_string id^"."))
     with Not_found -> raise Expired
 
 end (* }}} *)
@@ -320,6 +308,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
@@ -336,7 +334,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
@@ -364,7 +368,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
@@ -373,7 +377,7 @@ module VCS : sig
 
   val proof_nesting : unit -> int
   val checkout_shallowest_proof_branch : unit -> unit
-  val propagate_sideff : replay:aast option -> unit
+  val propagate_sideff : action:seff_t -> unit
 
   val gc : unit -> unit
 
@@ -392,19 +396,28 @@ end = struct (* {{{ *)
   open Printf
 
   let print_dag vcs () =
+
+    (* Due to threading, be wary that this will be called from the
+       toplevel with we_are_parsing set to true, as indeed, the
+       toplevel is waiting for input . What a race! XD
+
+       In case you are hitting the race enable stm_debug.
+    *)
+    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")
-      | Sideff (Some t) ->
+      | Sideff (ReplayCommand t) ->
           sprintf "Sideff(%s)"
             (try Pp.string_of_ppcmds (pr_ast t) with _ -> "ERR")
-      | Sideff None -> "EnvChange"
+      | Sideff CherryPickEnv -> "EnvChange"
       | Noop -> " "
       | Alias (id,_) -> sprintf "Alias(%s)" (Stateid.to_string id)
-      | Qed { qast } -> string_of_ppcmds (pr_ast qast) in
-    let is_green id = 
+      | Qed { qast } -> Pp.string_of_ppcmds (pr_ast qast) in
+    let is_green id =
       match get_info vcs id with
       | Some { state = Valid _ } -> true
       | _ -> false in
@@ -472,7 +485,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;
@@ -509,9 +522,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
 
@@ -532,9 +566,9 @@ 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
-    (match x with
-    | VernacDefinition (_,((_,i),_),_) -> string_of_id i
-    | VernacStartTheoremProof (_,[Some ((_,i),_),_],_) -> string_of_id i
+    (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
@@ -544,7 +578,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
@@ -558,7 +592,7 @@ end = struct (* {{{ *)
     if List.mem edit_branch (Vcs_.branches !vcs) then begin
       checkout edit_branch;
       match get_branch edit_branch with
-      | { kind = `Edit (mode, _,_,_,_) } -> Proof_global.activate_proof_mode mode
+      | { kind = `Edit (mode, _,_,_,_) } -> Proof_global.activate_proof_mode mode [@ocaml.warning "-3"]
       | _ -> assert false
     end else
       let pl = proof_nesting () in
@@ -566,20 +600,20 @@ end = struct (* {{{ *)
         let branch, mode = match Vcs_aux.find_proof_at_depth !vcs pl with
           | h, { Vcs_.kind = `Proof (m, _) } -> h, m | _ -> assert false in
         checkout branch;
-        prerr_endline (fun () -> "mode:" ^ mode);
-        Proof_global.activate_proof_mode mode
+        stm_prerr_endline (fun () -> "mode:" ^ mode);
+        Proof_global.activate_proof_mode mode [@ocaml.warning "-3"]
       with Failure _ ->
         checkout Branch.master;
-        Proof_global.disactivate_current_proof_mode ()
+        Proof_global.disactivate_current_proof_mode () [@ocaml.warning "-3"]
 
   (* copies the transaction on every open branch *)
-  let propagate_sideff ~replay:t =
+  let propagate_sideff ~action =
     List.iter (fun b ->
       checkout b;
       let id = new_node () in
-      merge id ~ours:(Sideff t) ~into:b Branch.master)
+      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 =
@@ -588,10 +622,10 @@ end = struct (* {{{ *)
       match visit id with
       | { next = n; step = `Cmd x } -> (id,Cmd x) :: aux n
       | { next = n; step = `Alias x } -> (id,Alias x) :: aux n
-      | { next = n; step = `Sideff (`Ast (x,_)) } ->
-           (id,Sideff (Some x)) :: aux n
-      | _ -> anomaly(str("Cannot slice from "^ Stateid.to_string block_start ^
-                         " to "^Stateid.to_string block_stop))
+      | { next = n; step = `Sideff (ReplayCommand x,_) } ->
+           (id,Sideff (ReplayCommand x)) :: aux n
+      | _ -> anomaly Pp.(str("Cannot slice from "^ Stateid.to_string block_start ^
+                         " to "^Stateid.to_string block_stop^"."))
     in aux block_stop
 
   let slice ~block_start ~block_stop =
@@ -643,11 +677,11 @@ end = struct (* {{{ *)
       l
 
   let create_proof_task_box l ~qed ~block_start:lemma =
-    if not (topo_invariant l) then anomaly (str "overlapping boxes");
+    if not (topo_invariant l) then anomaly Pp.(str "overlapping boxes.");
     vcs := create_property !vcs l (ProofTask { qed; lemma })
   let create_proof_block ({ block_start; block_stop} as decl) name =
     let l = nodes_in_slice ~block_start ~block_stop in
-    if not (topo_invariant l) then anomaly (str "overlapping boxes");
+    if not (topo_invariant l) then anomaly Pp.(str "overlapping boxes.");
     vcs := create_property !vcs l (ProofBlock (decl, name))
   let box_of id = List.map Dag.Property.data (property_of !vcs id)
   let delete_boxes_of id =
@@ -658,7 +692,7 @@ end = struct (* {{{ *)
     with
     | [] -> None
     | [x] -> Some x
-    | _ -> anomaly (str "node with more than 1 proof task box")
+    | _ -> anomaly Pp.(str "node with more than 1 proof task box.")
 
   let gc () =
     let old_vcs = !vcs in
@@ -678,7 +712,7 @@ end = struct (* {{{ *)
     val command : now:bool -> (unit -> unit) -> unit
 
   end = struct
-    
+
     let m = Mutex.create ()
     let c = Condition.create ()
     let job = ref None
@@ -719,7 +753,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
@@ -729,7 +763,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.
@@ -739,26 +773,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 : (iexn -> iexn) ref
+
+  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
 
-  val exn_on : Stateid.t -> valid:Stateid.t -> iexn -> iexn
   (* to send states across worker/master *)
-  type frozen_state
-  val get_cached : Stateid.t -> frozen_state
-  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
@@ -766,31 +810,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 =
@@ -813,21 +852,26 @@ 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 ()
-        else anomaly (str "installing a non cached state")
+        if VCS.is_interactive () = `No && Stateid.equal id !cur_id then ()
+        else anomaly Pp.(str "installing a non cached state.")
 
   let get_cached id =
     try match VCS.get_info id with
     | { state = Valid s } -> s
-    | _ -> anomaly (str "not a cached state")
-    with VCS.Expired -> anomaly (str "not a cached state (expired)")
+    | _ -> anomaly Pp.(str "not a cached state.")
+    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 ->
@@ -835,22 +879,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 -> ()
 
@@ -858,27 +907,27 @@ end = struct (* {{{ *)
     match Stateid.get info with
     | Some _ -> (e, info)
     | None ->
-        let loc = Option.default Loc.ghost (Loc.get_loc info) in
+        let loc = Loc.get_loc info in
         let (e, info) = Hooks.(call_process_error_once (e, info)) in
-        Hooks.(call execution_error id loc (iprint (e, info)));
+        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
   =
-    feedback ~id:(State id) (ProcessingIn !Flags.async_proofs_worker_id);
+    feedback ~id:id (ProcessingIn !Flags.async_proofs_worker_id);
     let str_id = Stateid.to_string id in
     if is_cached id && not redefine then
-      anomaly (str"defining state "++str str_id++str" twice");
+      anomaly Pp.(str"defining state "++str str_id++str" twice.");
     try
-      prerr_endline (fun () -> "defining "^str_id^" (cache="^
+      stm_prerr_endline (fun () -> "defining "^str_id^" (cache="^
         if cache = `Yes then "Y)" else if cache = `Shallow then "S)" else "N)");
       let good_id = match safe_id with None -> !cur_id | Some id -> id in
       fix_exn_ref := exn_on id ~valid:good_id;
@@ -886,7 +935,7 @@ end = struct (* {{{ *)
       fix_exn_ref := (fun x -> x);
       if cache = `Yes then freeze `No id
       else if cache = `Shallow then freeze `Shallow id;
-      prerr_endline (fun () -> "setting cur id to "^str_id);
+      stm_prerr_endline (fun () -> "setting cur id to "^str_id);
       cur_id := id;
       if feedback_processed then
         Hooks.(call state_computed id ~in_cache:false);
@@ -908,8 +957,138 @@ 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
+ * by D. de Rauglaudre. Should be moved away.
+ *)
+
+module ShowScript = struct
+
+let indent_script_item ((ng1,ngl1),nl,beginend,ppl) (cmd,ng) =
+  (* ng1 : number of goals remaining at the current level (before cmd)
+     ngl1 : stack of previous levels with their remaining goals
+     ng : number of goals after the execution of cmd
+     beginend : special indentation stack for { } *)
+  let ngprev = List.fold_left (+) ng1 ngl1 in
+  let new_ngl =
+    if ng > ngprev then
+      (* We've branched *)
+      (ng - ngprev + 1, ng1 - 1 :: ngl1)
+    else if ng < ngprev then
+      (* A subgoal have been solved. Let's compute the new current level
+	 by discarding all levels with 0 remaining goals. *)
+      let rec loop = function
+	| (0, ng2::ngl2) -> loop (ng2,ngl2)
+	| p -> p
+      in loop (ng1-1, ngl1)
+    else
+      (* Standard case, same goal number as before *)
+      (ng1, ngl1)
+  in
+  (* When a subgoal have been solved, separate this block by an empty line *)
+  let new_nl = (ng < ngprev)
+  in
+  (* Indentation depth *)
+  let ind = List.length ngl1
+  in
+  (* Some special handling of bullets and { }, to get a nicer display *)
+  let pred n = max 0 (n-1) in
+  let ind, nl, new_beginend = match 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
+    | _ -> ind, nl, beginend
+  in
+  let pp = Pp.(
+    (if nl then fnl () else mt ()) ++
+    (hov (ind+1) (str (String.make ind ' ') ++ Ppvernac.pr_vernac cmd)))
+  in
+  (new_ngl, new_nl, new_beginend, pp :: ppl)
+
+let get_script prf =
+  let branch, test =
+    match prf with
+    | None -> VCS.Branch.master, fun _ -> true
+    | Some name -> VCS.current_branch (),fun nl -> nl=[] || List.mem name nl in
+  let rec find acc id =
+    if Stateid.equal id Stateid.initial ||
+       Stateid.equal id Stateid.dummy then acc else
+    let view = VCS.visit id in
+    match view.step with
+    | `Fork((_,_,_,ns), _) when test ns -> acc
+    | `Qed (qed, proof) -> find [qed.qast.expr, (VCS.get_info id).n_goals] proof
+    | `Sideff (ReplayCommand x,_) ->
+         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
+    | `Cmd _ -> find acc view.next
+    | `Alias (id,_) -> find acc id
+    | `Fork _ -> find acc view.next
+    in
+  find [] (VCS.get_branch_pos branch)
+
+let show_script ?proof () =
+  try
+    let prf =
+      try match proof with
+      | None -> Some (Proof_global.get_current_proof_name ())
+      | Some (p,_) -> Some (p.Proof_global.id)
+      with Proof_global.NoCurrentProof -> None
+    in
+    let cmds = get_script prf in
+    let _,_,_,indented_cmds =
+      List.fold_left indent_script_item ((1,[]),false,[],[]) cmds
+    in
+    let indented_cmds = List.rev (indented_cmds) in
+    msg_notice Pp.(v 0 (prlist_with_sep fnl (fun x -> x) indented_cmds))
+  with Vcs_aux.Expired -> ()
+
+end
+
+(* Wrapper for Vernacentries.interp to set the feedback id *)
+(* It is currently called 19 times, this number should be certainly
+   reduced... *)
+let stm_vernac_interp ?proof ?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 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 is_filtered_command = function
+    | VernacResetName _ | VernacResetInitial | VernacBack _
+    | VernacBackTo _ | VernacRestart | VernacUndo _ | VernacUndoTo _
+    | VernacBacktrack _ | VernacAbortAll | VernacAbort _ -> true
+    | _ -> false
+  in
+  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 (CAst.make ?loc expr)
+        with e ->
+          let e = CErrors.push e in
+          Exninfo.iraise Hooks.(call_process_error_once e)
+  in aux_interp st expr
 
 (****************************** CRUFT *****************************************)
 (******************************************************************************)
@@ -919,13 +1098,12 @@ module Backtrack : sig
 
   val record : unit -> unit
   val backto : Stateid.t -> unit
-  val back_safe : unit -> unit
 
   (* 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 (* {{{ *)
 
@@ -948,16 +1126,16 @@ end = struct (* {{{ *)
     let info = VCS.get_info oid in
     match info.vcs_backup with
     | None, _ ->
-       anomaly(str"Backtrack.backto "++str(Stateid.to_string oid)++
-               str": a state with no vcs_backup")
+       anomaly Pp.(str"Backtrack.backto "++str(Stateid.to_string oid)++
+               str": a state with no vcs_backup.")
     | Some vcs, _ -> VCS.restore vcs
 
   let branches_of id =
     let info = VCS.get_info id in
     match info.vcs_backup with
     | _, None ->
-       anomaly(str"Backtrack.branches_of "++str(Stateid.to_string id)++
-               str": a state with no vcs_backup")
+       anomaly Pp.(str"Backtrack.branches_of "++str(Stateid.to_string id)++
+                   str": a state with no vcs_backup.")
     | _, Some x -> x
 
   let rec fold_until f acc id =
@@ -973,52 +1151,59 @@ 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 back_safe () =
-    let id =
-      fold_until (fun n (id,_,_,_,_) ->
-        if n >= 0 && State.is_cached_and_valid id then `Stop id else `Cont (succ n))
-        0 (VCS.get_branch_pos (VCS.current_branch ())) in
-    backto id
+
+  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 
-            | None, _ -> anomaly(str"Backtrack: tip with no vcs_backup")
+            match (VCS.get_info id).vcs_backup with
+            | None, _ -> anomaly Pp.(str"Backtrack: tip with no vcs_backup.")
             | Some vcs, _ -> vcs in
           let cb, _ =
             try Vcs_aux.find_proof_at_depth vcs (Vcs_aux.proof_nesting vcs)
@@ -1028,53 +1213,50 @@ 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.print_emacs), VtNow
-      | _ -> VtUnknown, VtNow
+          Stateid.of_int id, VtNow
+      | _ -> anomaly Pp.(str "incorrect VtMeta classification")
     with
     | Not_found ->
-       CErrors.errorlabstrm "undo_vernac_classifier"
-        (str "Cannot undo")
+       CErrors.user_err ~hdr:"undo_vernac_classifier"
+        Pp.(str "Cannot undo")
 
 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 !hints loc "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.ghost, 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 s = Aux_file.get ?loc !hints "context_used" in
+  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 Loc.ghost proof_name)
+  try float_of_string (Aux_file.get !hints proof_name)
   with Not_found -> 1.0
 
-let record_pb_time proof_name loc time =
+let record_pb_time ?loc proof_name time =
   let proof_build_time = Printf.sprintf "%.3f" time in
-  Aux_file.record_in_aux_at loc "proof_build_time" proof_build_time;
+  Aux_file.record_in_aux_at ?loc "proof_build_time" proof_build_time;
   if proof_name <> "" then begin
-    Aux_file.record_in_aux_at Loc.ghost proof_name proof_build_time;
-    hints := Aux_file.set !hints Loc.ghost proof_name proof_build_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 std_ppcmds
+
+exception RemoteException of Pp.t
 let _ = CErrors.register_handler (function
   | RemoteException ppcmd -> ppcmd
   | _ -> raise Unhandled)
@@ -1084,7 +1266,7 @@ let _ = CErrors.register_handler (function
 
 type document_node = {
   indentation : int;
-  ast : Vernacexpr.vernac_expr;
+  ast : Vernacexpr.vernac_control;
   id : Stateid.t;
 }
 
@@ -1099,23 +1281,23 @@ 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 []
 
 let register_proof_block_delimiter name static dynamic =
   if List.mem_assoc name !proof_block_delimiters then
-    CErrors.errorlabstrm "STM" (str "Duplicate block delimiter " ++ str name);
+    CErrors.user_err ~hdr:"STM" Pp.(str "Duplicate block delimiter " ++ str name);
   proof_block_delimiters := (name, (static,dynamic)) :: !proof_block_delimiters
 
 let mk_doc_node id = function
   | { step = `Cmd { ctac; cast = { indentation; expr }}; next } when ctac ->
        Some { indentation; ast = expr; id }
-  | { step = `Sideff (`Ast ({ indentation; expr }, _)); next } ->
+  | { step = `Sideff (ReplayCommand { indentation; expr }, _); next } ->
        Some { indentation; ast = expr; id }
   | _ -> None
 let prev_node { id } =
@@ -1124,15 +1306,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 -> ()
@@ -1144,14 +1326,16 @@ let detect_proof_block id name =
           VCS.create_proof_block decl name
       end
     with Not_found ->
-      CErrors.errorlabstrm "STM"
-        (str "Unknown proof block delimiter " ++ str name)
+      CErrors.user_err ~hdr:"STM"
+        Pp.(str "Unknown proof block delimiter " ++ str name)
   )
 (****************************** THE SCHEDULER *********************************)
 (******************************************************************************)
 
+(* 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;
@@ -1160,7 +1344,7 @@ module rec ProofTask : sig
     t_drop     : bool;
     t_states   : competence;
     t_assign   : Proof_global.closed_proof_output Future.assignement -> unit;
-    t_loc      : Loc.t;
+    t_loc      : Loc.t option;
     t_uuid     : Future.UUID.t;
     t_name     : string }
 
@@ -1174,16 +1358,17 @@ 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 ->
     drop_pt:bool ->
-    Stateid.t * Stateid.t -> Loc.t -> Stateid.t ->
+    Stateid.t * Stateid.t -> Stateid.t ->
       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 (* {{{ *)
 
@@ -1197,7 +1382,7 @@ end = struct (* {{{ *)
     t_drop     : bool;
     t_states   : competence;
     t_assign   : Proof_global.closed_proof_output Future.assignement -> unit;
-    t_loc      : Loc.t;
+    t_loc      : Loc.t option;
     t_uuid     : Future.UUID.t;
     t_name     : string }
 
@@ -1205,21 +1390,22 @@ 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;
-    e_msg         : std_ppcmds;
+    e_msg         : Pp.t;
     e_safe_states : Stateid.t list }
 
   type response =
     | RespBuiltProof of Proof_global.closed_proof_output * float
     | RespError of error
     | RespStates of (Stateid.t * State.partial_state) list
-    | RespDone
 
   let name = ref "proofworker"
   let extra_env () = !async_proofs_workers_extra_env
@@ -1229,10 +1415,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
 
@@ -1248,7 +1434,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;
@@ -1258,19 +1444,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 t_name t_loc time;
-        if !Flags.async_proofs_full || t_drop
+        record_pb_time ?loc:t_loc t_name time;
+        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
@@ -1285,21 +1471,21 @@ end = struct (* {{{ *)
     | Some (BuildProof { t_start = start; t_assign }) ->
         let s = "Worker dies or task expired" in
         let info = Stateid.add ~valid:start Exninfo.null start in
-        let e = (RemoteException (strbrk s), info) in
+        let e = (RemoteException (Pp.strbrk s), info) in
         t_assign (`Exn e);
-        Hooks.(call execution_error start Loc.ghost (strbrk s));
+        execution_error start (Pp.strbrk s);
         feedback (InProgress ~-1)
 
-  let build_proof_here ~drop_pt (id,valid) loc eop =
+  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"
+      Aux_file.record_in_aux_at ?loc "proof_build_time"
         (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1));
       let p = Proof_global.return_proof ~allow_partial:drop_pt () in
-      if drop_pt then feedback ~id:(State id) Complete;
+      if drop_pt then feedback ~id Complete;
       p)
 
   let perform_buildp { Stateid.exn_info; stop; document; loc } drop my_states =
@@ -1308,25 +1494,35 @@ end = struct (* {{{ *)
       VCS.print ();
       let proof, future_proof, time =
         let wall_clock = Unix.gettimeofday () in
-        let fp = build_proof_here ~drop_pt:drop exn_info loc stop in
+        let fp = build_proof_here ?loc ~drop_pt:drop exn_info stop in
         let proof = Future.force fp in
         proof, fp, Unix.gettimeofday () -. wall_clock in
       (* We typecheck the proof with the kernel (in the worker) to spot
        * 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 stop (Future.from_val ~fix_exn p) in
+            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
-          vernac_interp stop
-            ~proof:(pobject, terminator)
+
+          let st = Vernacstate.freeze_interp_state `No in
+          stm_vernac_interp stop
+            ~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 ->
@@ -1337,18 +1533,17 @@ end = struct (* {{{ *)
           | Some (safe, err) -> err, safe
           | None -> Stateid.dummy, Stateid.dummy in
         let e_msg = iprint (e, info) in
-        prerr_endline (fun () -> "failed with the following exception:");
-        prerr_endline (fun () -> string_of_ppcmds e_msg);
+        stm_pperr_endline Pp.(fun () -> str "failed with the following exception: " ++ fnl () ++ e_msg);
         let e_safe_states = List.filter State.is_cached_and_valid my_states in
         RespError { e_error_at; e_safe_id; e_msg; e_safe_states }
-  
+
   let perform_states query =
     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
@@ -1361,15 +1556,15 @@ 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 (str "STM: sending back a fat state");
+          msg_debug (Pp.str "STM: sending back a fat state");
           Some (id, `Full s)
       | _, Some s -> Some (id, `Full s) in
     let rec aux seen = function
@@ -1385,13 +1580,14 @@ end = struct (* {{{ *)
     | ReqStates sl -> RespStates (perform_states sl)
 
   let on_marshal_error s = function
-    | States _ -> msg_error(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(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 ~drop_pt t_exn_info t_loc t_stop));
+      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)
 
 end (* }}} *)
@@ -1401,13 +1597,13 @@ and Slaves : sig
 
   (* (eventually) remote calls *)
   val build_proof :
-    loc:Loc.t -> drop_pt:bool ->
+    ?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
 
@@ -1428,20 +1624,19 @@ 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)
 
   let check_task_aux extra name l i =
     let { Stateid.stop; document; loc; name = r_name }, drop = List.nth l i in
     Flags.if_verbose msg_info
-      (str(Printf.sprintf "Checking task %d (%s%s) of %s" i r_name extra name));
+      Pp.(str(Printf.sprintf "Checking task %d (%s%s) of %s" i r_name extra name));
     VCS.restore document;
     let start =
       let rec aux cur =
@@ -1463,36 +1658,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;
-      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 (
+        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 = `Sideff (`Ast ( { loc }, _)) } ->
-              let start, stop = Loc.unloc loc in
-              msg_error (
+          | { step = `Fork (( { loc }, _, _, _), _) }
+          | { step = `Qed ( { qast = { loc } }, _) }
+          | { step = `Sideff (ReplayCommand { loc }, _) } ->
+              let start, stop = Option.cata Loc.unloc (0,0) loc in
+              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 (
+              msg_warning Pp.(
                 str"File " ++ str name ++ str ": proof of " ++ str r_name ++
                 spc () ++ iprint (e, info))
     with e ->
-      msg_error (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 =
@@ -1516,19 +1718,20 @@ end = struct (* {{{ *)
         let uc =
           Option.get
             (Opaqueproof.get_constraints (Global.opaque_tables ()) o) in
+        (** We only manipulate monomorphic terms here. *)
+        let map (c, ctx) = assert (Univ.AUContext.is_empty ctx); c in
         let pr =
-          Future.from_val (Option.get (Global.body_of_constant_body c)) in
+          Future.from_val (map (Option.get (Global.body_of_constant_body c))) in
         let uc =
-          Future.chain
-            ~greedy:true ~pure:true uc Univ.hcons_universe_context_set in
-        let pr = Future.chain ~greedy:true ~pure:true pr discharge in
-        let pr = Future.chain ~greedy:true ~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
@@ -1537,10 +1740,10 @@ end = struct (* {{{ *)
   let info_tasks l =
     CList.map_i (fun i ({ Stateid.loc; name }, _) ->
       let time1 =
-        try float_of_string (Aux_file.get !hints loc "proof_build_time")
+        try float_of_string (Aux_file.get ?loc !hints "proof_build_time")
         with Not_found -> 0.0 in
       let time2 =
-        try float_of_string (Aux_file.get !hints loc "proof_check_time")
+        try float_of_string (Aux_file.get ?loc !hints "proof_check_time")
         with Not_found -> 0.0 in
       name, max (time1 +. time2) 0.0001,i) 0 l
 
@@ -1561,11 +1764,11 @@ end = struct (* {{{ *)
        BuildProof { t_states = s2 } -> overlap_rel s1 s2
      | _ -> 0)
 
-  let build_proof ~loc ~drop_pt ~exn_info ~block_start ~block_stop ~name:pname =
+  let build_proof ?loc ~drop_pt ~exn_info ~block_start ~block_stop ~name:pname =
     let id, valid as t_exn_info = exn_info in
     let cancel_switch = ref false in
     if TaskQueue.n_workers (Option.get !queue) = 0 then
-      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
@@ -1573,11 +1776,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 ~drop_pt t_exn_info loc block_stop, cancel_switch
-    else 
+        ProofTask.build_proof_here ?loc ~drop_pt t_exn_info block_stop, cancel_switch
+    else
       let f, t_assign = Future.create_delegate ~name:pname (State.exn_on id ~valid) in
       let t_uuid = Future.uuid f in
       feedback (InProgress 1);
@@ -1585,7 +1788,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)
@@ -1599,11 +1802,11 @@ 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
-    prerr_endline (fun () -> Printf.sprintf "dumping %d tasks\n" (List.length reqs));
+    stm_prerr_endline (fun () -> Printf.sprintf "dumping %d tasks\n" (List.length reqs));
     reqs
 
   let reset_task_queue () = TaskQueue.clear (Option.get !queue)
@@ -1612,7 +1815,7 @@ end (* }}} *)
 
 and TacTask : sig
 
-  type output = Constr.constr * Evd.evar_universe_context
+  type output = (Constr.constr * UState.t) option
   type task = {
     t_state    : Stateid.t;
     t_state_fb : Stateid.t;
@@ -1620,15 +1823,14 @@ and TacTask : sig
     t_ast      : int * aast;
     t_goal     : Goal.goal;
     t_kill     : unit -> unit;
-    t_name     : string }  
-  exception NoProgress
+    t_name     : string }
 
   include AsyncTaskQueue.Task with type task := task
 
 end = struct (* {{{ *)
 
-  type output = Constr.constr * Evd.evar_universe_context
-  
+  type output = (Constr.constr * UState.t) option
+
   let forward_feedback msg = Hooks.(call forward_feedback msg)
 
   type task = {
@@ -1638,7 +1840,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;
@@ -1649,14 +1851,15 @@ end = struct (* {{{ *)
     r_name     : string }
 
   type response =
-    | RespBuiltSubProof of output
-    | RespError of std_ppcmds
+    | RespBuiltSubProof of (Constr.constr * UState.t)
+    | RespError of Pp.t
     | RespNoProgress
-  exception NoProgress
 
   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 *)
@@ -1665,19 +1868,18 @@ 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 o); `Stay ((),[])
+    | RespBuiltSubProof o -> t_assign (`Val (Some o)); `Stay ((),[])
     | RespNoProgress ->
-        let e = (NoProgress, Exninfo.null) in
-        t_assign (`Exn e);
+        t_assign (`Val None);
         t_kill ();
         `Stay ((),[])
     | RespError msg ->
@@ -1685,15 +1887,15 @@ end = struct (* {{{ *)
         t_assign (`Exn e);
         t_kill ();
         `Stay ((),[])
-                    
+
   let on_marshal_error err { t_name } =
-    pr_err ("Fatal marshal error: " ^ t_name );
+    stm_pr_err ("Fatal marshal error: " ^ t_name );
     flush_all (); exit 1
 
   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
 
@@ -1701,57 +1903,69 @@ 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
        if not (
-         Evarutil.is_ground_term sigma0 Evd.(evar_concl g) &&
-         List.for_all (Context.Named.Declaration.for_all (Evarutil.is_ground_term sigma0))
+         is_ground Evd.(evar_concl g) &&
+         List.for_all (Context.Named.Declaration.for_all is_ground)
                       Evd.(evar_context g))
        then
-         CErrors.errorlabstrm "STM" (strbrk("the par: goal selector supports ground "^
+         CErrors.user_err ~hdr:"STM" Pp.(strbrk("the par: goal selector supports ground "^
            "goals only"))
        else begin
         let (i, ast) = r_ast in
         Proof_global.simple_with_current_proof (fun _ p -> Proof.focus focus_cond () i p);
-        vernac_interp r_state_fb ast;
+        (* 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
         | Evd.Evar_defined t ->
+            let t = EConstr.of_constr t in
             let t = Evarutil.nf_evar sigma t in
             if Evarutil.is_ground_term sigma t then
+              let t = EConstr.Unsafe.to_constr t in
               RespBuiltSubProof (t, Evd.evar_universe_context sigma)
-            else CErrors.errorlabstrm "STM" (str"The solution is not ground")
+            else CErrors.user_err ~hdr:"STM" Pp.(str"The solution is not ground")
        end) ()
     with e when CErrors.noncritical e -> RespError (CErrors.print e)
 
   let name_of_task { t_name } = t_name
   let name_of_request { r_name } = r_name
-  
+
 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) | VernacRedirect (_,(_,e)) -> find true fail e
-        | VernacFail e -> find time true e
-        | _ -> e, time, fail in find false false e in
-    Hooks.call Hooks.with_fail fail (fun () ->
-    (if time then System.with_time false 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
@@ -1764,19 +1978,19 @@ 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;
       let assign_tac : unit Proofview.tactic =
-        Proofview.(Goal.nf_enter { Goal.enter = fun g ->
+        Proofview.(Goal.nf_enter begin fun g ->
         let gid = Goal.goal g in
         let f =
           try List.assoc gid res
-          with Not_found -> CErrors.anomaly(str"Partac: wrong focus") in
+          with Not_found -> CErrors.anomaly(str"Partac: wrong focus.") in
         if not (Future.is_over f) then
           (* One has failed and cancelled the others, but not this one *)
           if solve then Tacticals.New.tclZEROMSG
@@ -1784,21 +1998,22 @@ end = struct (* {{{ *)
           else tclUNIT ()
         else
           let open Notations in
-          try
-            let pt, uc = Future.join f in
-            prerr_endline (fun () -> string_of_ppcmds(hov 0 (
+          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"uc=" ++ Evd.pr_evar_universe_context uc)));
+              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) <*>
-              Tactics.exact_no_check pt)
-          with TacTask.NoProgress ->
+              Tactics.exact_no_check (EConstr.of_constr pt))
+          | None ->
             if solve then Tacticals.New.tclSOLVE [] else tclUNIT ()
-        })
+        end)
       in
       Proof.run_tactic (Global.env()) assign_tac p)))) ())
-  
+
 end (* }}} *)
 
 and QueryTask : sig
@@ -1807,10 +2022,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
@@ -1818,6 +2033,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 } =
@@ -1827,52 +2044,58 @@ 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 _ _ =
-    pr_err ("Fatal marshal error in query");
+    stm_pr_err ("Fatal marshal error in query");
     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
-      vernac_interp r_for { r_what with verbose = true };
-      feedback ~id:(State r_for) Processed
+      (* 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 = pp_to_richpp (iprint e) in
-      feedback ~id:(State r_for) (Message (Error, None, msg))
-    
+      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 (* }}} *)
 
@@ -1884,21 +2107,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 () ->
@@ -1906,89 +2126,113 @@ let warn_deprecated_nested_proofs =
                     "stop working in a future Coq version"))
 
 let collect_proof keep cur hd brkind id =
- prerr_endline (fun () -> "Collecting proof ending at "^Stateid.to_string id);
+ stm_prerr_endline (fun () -> "Collecting proof ending at "^Stateid.to_string id);
  let no_name = "" in
  let name = function
    | [] -> no_name
-   | id :: _ -> Id.to_string id in
+   | id :: _ -> Names.Id.to_string id in
  let loc = (snd cur).loc in
- let is_defined = function
-   | _, { expr = VernacEndProof (Proved ((Transparent|Opaque (Some _)),_)) } ->
-      true
+ let is_defined_expr = function
+   | VernacEndProof (Proved (Transparent,_)) -> true
    | _ -> false in
+ let is_defined = function
+   | _, { expr = e } -> is_defined_expr (Vernacprop.under_control e)
+                        && (not (Vernacprop.has_Fail e)) in
  let proof_using_ast = function
-   | Some (_, ({ expr = VernacProof(_,Some _) } as v)) -> Some v
+   | VernacProof(_,Some _) -> true
+   | _ -> false
+ in
+ let proof_using_ast = function
+   | 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 (`Ast(x,_)) | `Cmd { cast = x })
-      when too_complex_to_delegate x -> `Sync(no_name,None,`Print)
+    | (`Sideff (ReplayCommand x,_) | `Cmd { cast = x })
+      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 (`Ast(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 _, _ ->
-     `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
 
@@ -2006,7 +2250,7 @@ let string_of_reason = function
   | `NoPU_NoHint_NoES -> "no 'Proof using..', no .aux file, inside a section"
   | `Unknown -> "unsupported case"
 
-let log_string s = prerr_debug (fun () -> "STM: " ^ s)
+let log_string s = stm_prerr_debug (fun () -> "STM: " ^ s)
 let log_processing_async id name = log_string Printf.(sprintf
   "%s: proof %s: asynch" (Stateid.to_string id) name
 )
@@ -2018,7 +2262,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
@@ -2031,43 +2275,48 @@ let known_state ?(redefine_qed=false) ~cache id =
           Some (decl, name)
       | _ -> None) boxes in
     assert(List.length valid_boxes < 2);
-    if valid_boxes = [] then iraise exn
+    if valid_boxes = [] then Exninfo.iraise exn
     else
       let decl, name = List.hd valid_boxes in
       try
         let _, dynamic_check = List.assoc name !proof_block_delimiters in
-        match dynamic_check decl with
-        | `Leaks -> iraise exn
+        match dynamic_check dummy_doc decl with
+        | `Leaks -> Exninfo.iraise exn
         | `ValidBlock { base_state; goals_to_admit; recovery_command } -> begin
            let tac =
-             let open Proofview.Notations in
-             Proofview.Goal.nf_enter { enter = fun gl ->
+             Proofview.Goal.nf_enter begin fun gl ->
                if CList.mem_f Evar.equal
                  (Proofview.Goal.goal gl) goals_to_admit then
              Proofview.give_up else Proofview.tclUNIT ()
-               } in
+              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:(State id) Feedback.AddedAxiom;
+                 feedback ~id:id Feedback.AddedAxiom;
                  fst (Pfedit.solve Vernacexpr.SelectAll None tac p), ());
-               Option.iter (fun expr -> vernac_interp id {
-                  verbose = true; loc = Loc.ghost; expr; indentation = 0;
-                  strlen = 0 })
+               (* 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 } ))
                recovery_command
            | _ -> assert false
         end
       with Not_found ->
-          CErrors.errorlabstrm "STM"
+          CErrors.user_err ~hdr:"STM"
             (str "Unknown proof block delimiter " ++ str name)
   in
 
   (* Absorb tactic errors from f () *)
   let resilient_tactic id blockname f =
-    if !Flags.async_proofs_tac_error_resilience = `None ||
-       (Flags.async_proofs_is_master () &&
-        !Flags.async_proofs_mode = Flags.APoff)
+    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 ()
@@ -2076,9 +2325,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
@@ -2087,22 +2336,28 @@ 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 ->
-    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 =
-    prerr_endline (fun () -> "reaching: " ^ Stateid.to_string id);
+    stm_prerr_endline (fun () -> "reaching: " ^ Stateid.to_string id);
     if not redefine_qed && State.is_cached ~cache id then begin
       Hooks.(call state_computed id ~in_cache:true);
-      prerr_endline (fun () -> "reached (cache)");
+      stm_prerr_endline (fun () -> "reached (cache)");
       State.install_cached id
     end else
     let step, cache_step, feedback_processed =
@@ -2113,51 +2368,58 @@ 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;
-              Hooks.(call tactic_being_run true); 
-              Partac.vernac_interp ~solve ~abstract
-                cancel !Flags.async_proofs_n_tacworkers view.next id x;
-              Hooks.(call tactic_being_run false))
+              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;
-              Hooks.(call tactic_being_run true); 
-              vernac_interp id x;
-              Hooks.(call tactic_being_run false)); 
+              (* 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 () ->
-            resilient_command reach view.next;
-            vernac_interp id x;
-	    if eff then update_global_env ()
-          ), (if eff then `Yes else cache), true
+          (match !cur_opt.async_proofs_mode with
+           | APon | APonLazy ->
+             resilient_command reach view.next
+           | 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;
-            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 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
-              iraise (e, info));
+              Exninfo.iraise (e, info));
             wall_clock_last_fork := Unix.gettimeofday ()
           ), `Yes, true
       | `Qed ({ qast = x; keep; brinfo; brname } as qed, eop) ->
           let rec aux = function
-          | `ASync (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
@@ -2168,7 +2430,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")
@@ -2176,7 +2438,7 @@ let known_state ?(redefine_qed=false) ~cache id =
                         ^"the proof's statement to avoid that."));
                     let fp, cancel =
                       Slaves.build_proof
-                        ~loc ~drop_pt ~exn_info ~block_start ~block_stop ~name in
+                        ?loc ~drop_pt ~exn_info ~block_start ~block_stop ~name in
                     Future.replace ofp fp;
                     qed.fproof <- Some (fp, cancel);
                     (* We don't generate a new state, but we still need
@@ -2188,35 +2450,39 @@ let known_state ?(redefine_qed=false) ~cache id =
                     let fp, cancel =
                       if delegate then
                         Slaves.build_proof
-                          ~loc ~drop_pt ~exn_info ~block_start ~block_stop ~name
+                          ?loc ~drop_pt ~exn_info ~block_start ~block_stop ~name
                       else
-                        ProofTask.build_proof_here
-                          ~drop_pt exn_info loc block_stop, ref false
+                        ProofTask.build_proof_here ?loc
+                          ~drop_pt exn_info block_stop, ref false
                     in
                     qed.fproof <- Some (fp, cancel);
                     let proof =
                       Proof_global.close_future_proof ~feedback_id:id fp in
                     if not delegate then ignore(Future.compute fp);
                     reach view.next;
-                    vernac_interp id ~proof x;
-                    feedback ~id:(State id) Incomplete
+                    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; 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
-                record_pb_time name x.loc (wall_clock -. !wall_clock_last_fork);
+                record_pb_time name ?loc:x.loc (wall_clock -. !wall_clock_last_fork);
                 let proof =
                   match keep with
                   | VtDrop -> None
                   | VtKeepAsAxiom ->
-                      let ctx = Evd.empty_evar_universe_context in
+                      let ctx = UState.empty in
                       let fp = Future.from_val ([],ctx) in
                       qed.fproof <- Some (fp, ref false); None
                   | VtKeep ->
@@ -2226,52 +2492,132 @@ let known_state ?(redefine_qed=false) ~cache id =
                 if keep != VtKeepAsAxiom then
                   reach view.next;
                 let wall_clock2 = Unix.gettimeofday () in
-                vernac_interp id ?proof x;
+                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 x.loc "proof_check_time"
+                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 List.is_empty (Environ.named_context (Global.env ()))
-                then pi1 (aux (`ASync (start, pua, nodes, name, delegate))) ()
-                else pi1 (aux (`Sync (name, pua, `NoPU_NoHint_NoES))) ()
+                if CList.is_empty (Environ.named_context (Global.env ()))
+                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 (`Ast (x,_)) -> (fun () ->
-            reach view.next; vernac_interp id x; update_global_env ()
+      | `Sideff (ReplayCommand x,_) -> (fun () ->
+            reach view.next;
+            let st = Vernacstate.freeze_interp_state `No in
+            ignore(stm_vernac_interp id st x);
+            update_global_env ()
           ), cache, true
-      | `Sideff (`Id origin) -> (fun () ->
+      | `Sideff (CherryPickEnv, origin) -> (fun () ->
             reach view.next;
             inject_non_pstate (pure_cherry_pick_non_pstate view.next origin);
           ), cache, true
     in
     let cache_step =
-      if !Flags.async_proofs_cache = Some Flags.Force then `Yes
+      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;
-    prerr_endline (fun () -> "reached: "^ Stateid.to_string id) in
+    stm_prerr_endline (fun () -> "reached: "^ Stateid.to_string id) in
   reach ~redefine_qed id
 
 end (* }}} *)
+[@@@ocaml.warning "+60"]
 
 (********************************* 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 = CAst.make @@ Libnames.(Qualid (qualid_of_string dir)) in
+      let mfrom = Option.map (fun fr -> CAst.make @@ Libnames.(Qualid (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
-    prerr_endline (fun () -> "Initializing workers");
+  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
@@ -2280,34 +2626,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;
-    iraise e
+    Exninfo.iraise e
 
-let finish ?(print_goals=false) () =
+let finish ~doc =
   let head = VCS.current_branch () in
-  observe (VCS.get_branch_pos head);
-  if print_goals then msg_notice (pr_open_cur_subgoals ());
+  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
-  | { VCS.kind = `Edit (mode,_,_,_,_) } -> Proof_global.activate_proof_mode mode
-  | { VCS.kind = `Proof (mode, _) } -> Proof_global.activate_proof_mode mode
+  (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
@@ -2318,33 +2669,33 @@ let rec join_admitted_proofs id =
        join_admitted_proofs view.next
   | _ -> join_admitted_proofs view.next
 
-let join () =
-  finish ();
-  wait ();
-  prerr_endline (fun () -> "Joining the environment");
+let join ~doc =
+  let doc = wait ~doc in
+  stm_prerr_endline (fun () -> "Joining the environment");
   Global.join_safe_environment ();
-  prerr_endline (fun () -> "Joining Admitted proofs");
+  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
@@ -2352,7 +2703,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 =
@@ -2364,7 +2715,7 @@ let merge_proof_branch ~valid ?id qast keep brname =
       let id = VCS.new_node ?id () in
       VCS.merge id ~ours:(Qed (qed None)) brname;
       VCS.delete_branch brname;
-      VCS.propagate_sideff None;
+      VCS.propagate_sideff ~action:CherryPickEnv;
       `Ok
   | { VCS.kind = `Edit (mode, qed_id, master_id, _,_) } ->
       let ofp =
@@ -2374,130 +2725,113 @@ 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 } ->
-       iraise (State.exn_on ~valid Stateid.dummy (Proof_global.NoCurrentProof, Exninfo.null))
+       Exninfo.iraise (State.exn_on ~valid Stateid.dummy (Proof_global.NoCurrentProof, Exninfo.null))
 
 (* When tty is true, this code also does some of the job of the user interface:
    jump back to a state that is valid *)
-let handle_failure (e, info) vcs tty =
-  if e = CErrors.Drop then iraise (e, info) else
+let handle_failure (e, info) vcs =
+  if e = CErrors.Drop then Exninfo.iraise (e, info) else
   match Stateid.get info with
   | None ->
       VCS.restore vcs;
       VCS.print ();
-      if tty && interactive () = `Yes then begin
-        (* Hopefully the 1 to last state is valid *)
-        Backtrack.back_safe (); 
-        VCS.checkout_shallowest_proof_branch ();
-      end;
-      VCS.print ();
       anomaly(str"error with no safe_id attached:" ++ spc() ++
-        CErrors.iprint_no_report (e, info))
+        CErrors.iprint_no_report (e, info) ++ str".")
   | Some (safe_id, id) ->
-      prerr_endline (fun () -> "Failed at state " ^ Stateid.to_string id);
+      stm_prerr_endline (fun () -> "Failed at state " ^ Stateid.to_string id);
       VCS.restore vcs;
-      if tty && interactive () = `Yes then begin
-        (* We stay on a valid state *)
-        Backtrack.backto safe_id;
-        VCS.checkout_shallowest_proof_branch ();
-        Reach.known_state ~cache:(interactive ()) safe_id;
-      end;
       VCS.print ();
-      iraise (e, info)
+      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.errorlabstrm "stm" (str"Cannot dump a vio with open proofs");
+    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 ()) ~tty
+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 =
-  prerr_endline (fun () -> "{{{ processing: "^ string_of_ppcmds (pr_ast x));
+  stm_pperr_endline (fun () -> str "{{{ processing: " ++ pr_ast x);
   let vcs = VCS.backup () in
   try
     let head = VCS.current_branch () in
     VCS.checkout head;
     let rc = begin
-      prerr_endline (fun () ->
-        "  classified as: " ^ string_of_vernac_classification c);
+      stm_prerr_endline (fun () ->
+        "  classified as: " ^ Vernac_classifier.string_of_vernac_classification c);
       match c with
-      (* PG stuff *)    
-      | VtStm(VtPG,false), VtNow -> vernac_interp Stateid.dummy x; `Ok
-      | VtStm(VtPG,_), _ -> anomaly(str "PG command in script or VtLater")
-      (* Joining various parts of the document *)
-      | VtStm (VtJoinDocument, b), VtNow -> join (); `Ok
-      | VtStm (VtFinish, b),       VtNow -> finish (); `Ok
-      | VtStm (VtWait, b),     VtNow -> finish (); wait (); `Ok
-      | VtStm (VtPrintDag, b), VtNow ->
-          VCS.print ~now:true (); `Ok
-      | VtStm (VtObserve id, b),   VtNow -> observe id; `Ok
-      | VtStm ((VtObserve _ | VtFinish | VtJoinDocument
-                |VtPrintDag |VtWait),_), VtLater ->
-          anomaly(str"classifier: join actions cannot be classified as VtLater")
-      
-      (* 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 ->
-          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
+        (* Special case Backtrack, as it is never part of a script. See #6240 *)
+        let part_of_script = begin match Vernacprop.under_control expr with
+          | VernacBacktrack _ -> false
+          | _ -> part_of_script
+        end in
+        process_back_meta_command ~part_of_script ~newtip ~head id x w
       (* Query *)
-      | VtQuery (false,(report_id,route)), VtNow when tty = true ->
-          finish ();
-          (try Future.purify (vernac_interp report_id ~route)
-            {x with verbose = true }
-           with e when CErrors.noncritical e ->
-             let e = CErrors.push e in
-             iraise (State.exn_on ~valid:Stateid.dummy report_id e)); `Ok
-      | VtQuery (false,(report_id,route)), VtNow ->
-          (try vernac_interp report_id ~route x
-           with e ->
-             let e = CErrors.push e in
-             iraise (State.exn_on ~valid:Stateid.dummy report_id e)); `Ok
-      | VtQuery (true,(report_id,_)), w ->
-          assert(Stateid.equal report_id Stateid.dummy);
+      | 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
-                 then `SkipQueue 
+                    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")
+          anomaly(str"classifier: VtQuery + VtLater must imply part_of_script.")
 
       (* Proof *)
       | VtStartProof (mode, guarantee, names), w ->
@@ -2511,10 +2845,10 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty
             VCS.branch bname (`Proof (mode, VCS.proof_nesting () + 1));
             VCS.merge id ~ours:(Fork (x, bname, guarantee, names)) head
           end;
-          Proof_global.activate_proof_mode mode;
-          Backtrack.record (); if w == VtNow then finish (); `Ok
+          Proof_global.activate_proof_mode mode [@ocaml.warning "-3"];
+          Backtrack.record (); if w == VtNow then ignore(finish ~doc:dummy_doc); `Ok
       | VtProofMode _, VtLater ->
-          anomaly(str"VtProofMode must be executed VtNow")
+          anomaly(str"VtProofMode must be executed VtNow.")
       | VtProofMode mode, VtNow ->
           let id = VCS.new_node ~id:newtip () in
           VCS.commit id (mkTransCmd x [] false `MainQueue);
@@ -2530,7 +2864,7 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty
             (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
@@ -2543,121 +2877,192 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty
              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 ->
-          vernac_interp (VCS.get_branch_pos head) x; `Ok
+
+      (* Side effect in a (still open) proof is replayed on all branches *)
+      | 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
           let id = VCS.new_node ~id:newtip () in
-          VCS.checkout VCS.Branch.master;
-          VCS.commit id (mkTransCmd x l in_proof `MainQueue);
-          (* We can't replay a Definition since universes may be differently
-           * inferred.  This holds in Coq >= 8.5 *)
-	  let replay = match x.expr with
-	    | VernacDefinition(_, _, DefineBody _) -> None
-	    | _ -> Some x in
-	  VCS.propagate_sideff ~replay;
+          begin match (VCS.get_branch head).VCS.kind with
+          | `Edit _ -> VCS.commit id (mkTransCmd x l true `MainQueue);
+          | `Master -> VCS.commit id (mkTransCmd x l false `MainQueue);
+          | `Proof _ ->
+              VCS.checkout VCS.Branch.master;
+              VCS.commit id (mkTransCmd x l true `MainQueue);
+              (* We can't replay a Definition since universes may be differently
+               * inferred.  This holds in Coq >= 8.5 *)
+              let action = match Vernacprop.under_control x.expr with
+                | VernacDefinition(_, _, DefineBody _) -> CherryPickEnv
+                | _ -> ReplayCommand x in
+              VCS.propagate_sideff ~action;
+          end;
           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;
-            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 opacity_of_produced_term =
-                match x.expr with
+              let opacity_of_produced_term = function
                 (* This AST is ambiguous, hence we check it dynamically *)
                 | VernacInstance (false, _,_ , None, _) -> GuaranteesOpacity
                 | _ -> Doesn'tGuaranteeOpacity in
-              VCS.commit id (Fork (x,bname,opacity_of_produced_term,[]));
+              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;
+              Proof_global.activate_proof_mode proof_mode [@ocaml.warning "-3"];
             end else begin
-              VCS.commit id (mkTransCmd x [] in_proof `MainQueue);
-              (* We hope it can be replayed, but we can't really know *)
-              VCS.propagate_sideff ~replay:(Some x);
+              begin match (VCS.get_branch head).VCS.kind with
+              | `Edit _ -> VCS.commit id (mkTransCmd x [] in_proof `MainQueue);
+              | `Master -> VCS.commit id (mkTransCmd x [] in_proof `MainQueue);
+              | `Proof _ ->
+                  VCS.commit id (mkTransCmd x [] in_proof `MainQueue);
+                  (* We hope it can be replayed, but we can't really know *)
+                  VCS.propagate_sideff ~action:(ReplayCommand x);
+              end;
               VCS.checkout_shallowest_proof_branch ();
             end in
           State.define ~safe_id:head_id ~cache:`Yes step id;
           Backtrack.record (); `Ok
 
       | VtUnknown, VtLater ->
-          anomaly(str"classifier: VtUnknown must imply VtNow")
+          anomaly(str"classifier: VtUnknown must imply VtNow.")
     end in
-    (* Proof General *)
-    begin match expr with 
-      | VernacStm (PGLast _) ->
-        if not (VCS.Branch.equal head VCS.Branch.master) then
-          vernac_interp Stateid.dummy
-            { verbose = true; loc = Loc.ghost; indentation = 0; strlen = 0;
-              expr = VernacShow (ShowGoal OpenSubgoals) }
-      | _ -> ()
-    end;
-    prerr_endline (fun () -> "processed }}}");
+    let pr_rc rc = match rc with
+      | `Ok -> Pp.(seq [str "newtip ("; str (Stateid.to_string (VCS.cur_tip ())); str ")"])
+      | _   -> Pp.(str "unfocus")
+    in
+    stm_pperr_endline (fun () -> str "processed with " ++ pr_rc rc ++ str " }}}");
     VCS.print ();
     rc
   with e ->
     let e = CErrors.push e in
-    handle_failure e vcs tty
+    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 = `Sideff ((ReplayCommand {loc; expr}) , _) }
   | { step = `Qed ({ qast = { loc; expr } }, _) } ->
-         Some (expr, loc)
+         Some (Loc.tag ?loc expr)
   | _ -> None
 
 let stop_worker n = Slaves.cancel_worker n
 
+(* We must parse on top of a state id, it should be something like:
+
+   - get parsing information for that state.
+   - feed the parsable / parser with the right parsing information.
+   - call the parser
+
+   Now, the invariant in ensured by the callers, but this is a bit
+   problematic.
+*)
+exception End_of_input
+
+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 *)
+  (* Reach.known_state ~cache:`Yes sid; *)
+  let cur_tip = VCS.cur_tip () in
+  let real_tip = !State.cur_id in
+  if not (Stateid.equal sid cur_tip) then
+    user_err ~hdr:"Stm.parse_sentence"
+      (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
+    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) ++
+       str " but the real tip is: " ++ str (Stateid.to_string real_tip) ++ fnl () ++
+       str "This is usually due to use of Stm.observe to evaluate a state different than the tip. " ++
+       str "All is good if not parsing changes occur between the two states, however if they do, a problem might occur.");
+  Flags.with_option Flags.we_are_parsing (fun () ->
+      try
+        match Pcoq.Gram.entry_parse Pcoq.main_entry pa with
+        | None            -> raise End_of_input
+        | Some (loc, cmd) -> CAst.make ~loc cmd
+      with e when CErrors.noncritical e ->
+        let (e, info) = CErrors.push e in
+        Exninfo.iraise (e, info))
+    ()
+
 (* You may need to know the len + indentation of previous command to compute
  * the indentation of the current one.
  *  Eg.   foo. bar.
  * Here bar is indented of the indentation of foo + its strlen (4) *)
-let ind_len_of id =
-  if Stateid.equal id Stateid.initial then 0
-  else match (VCS.visit id).step with
-  | `Cmd { ctac = true; cast = { indentation; strlen } } ->
-       indentation + strlen
-  | _ -> 0
-
-let add ~ontop ?newtip ?(check=ignore) verb eid s =
+let ind_len_loc_of_id sid =
+  if Stateid.equal sid Stateid.initial then None
+  else match (VCS.visit sid).step with
+  | `Cmd { ctac = true; cast = { indentation; strlen; loc } } ->
+         Some (indentation, strlen, loc)
+  | _ -> None
+
+(* the indentation logic works like this: if the beginning of the
+   command is different than the start we are in a new line, thus
+   indentation follows from the starting position. Otherwise, we use
+   the previous one plus the offset.
+
+   Note, this could maybe improved by handling more cases in
+   compute_indentation. *)
+
+let compute_indentation ?loc sid = Option.cata (fun loc ->
+  let open Loc              in
+  (* The effective lenght is the lenght on the last line *)
+  let len = loc.ep - loc.bp in
+  let prev_indent = match ind_len_loc_of_id sid with
+    | None         -> 0
+    | Some (i,l,p) -> i + l
+  in
+  (* Now if the line has not changed, the need to add the previous indent *)
+  let eff_indent = loc.bp - loc.bol_pos in
+  if loc.bol_pos = 0 then
+    eff_indent + prev_indent, len
+  else
+    eff_indent, len
+  ) (0, 0) loc
+
+let add ~doc ~ontop ?newtip verb { CAst.loc; v=ast } =
   let cur_tip = VCS.cur_tip () in
   if not (Stateid.equal ontop cur_tip) then
-    (* For now, arbitrary edits should be announced with edit_at *)
-    anomaly(str"Not yet implemented, the GUI should not try this");
-  let indentation, strlen, loc, ast =
-    vernac_parse ~indlen_prev:(fun () -> ind_len_of ontop) ?newtip eid s in
-  CWarnings.set_current_loc loc;
-  check(loc,ast);
-  let clas = classify_vernac ast in
+    user_err ?loc ~hdr:"Stm.add"
+      (str "Stm.add called for a different state (" ++ str (Stateid.to_string ontop) ++
+       str ") than the tip: " ++ str (Stateid.to_string cur_tip) ++ str "." ++ fnl () ++
+       str "This is not supported yet, sorry.");
+  let indentation, strlen = compute_indentation ?loc ontop in
+  (* XXX: Classifiy vernac should be moved inside process transaction *)
+  let clas = Vernac_classifier.classify_vernac ast in
   let aast = { verbose = verb; indentation; strlen; loc; expr = ast } in
-  match process_transaction ?newtip ~tty:false aast clas with
-  | `Ok -> VCS.cur_tip (), `NewTip
-  | `Unfocus qed_id -> qed_id, `Unfocus (VCS.cur_tip ())
+  match process_transaction ?newtip aast clas with
+  | `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;
@@ -2665,25 +3070,32 @@ type focus = {
   tip : Stateid.t
 }
 
-let query ~at ?(report_with=(Stateid.dummy,default_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 newtip, route = report_with in
-    let indentation, strlen, loc, ast = vernac_parse ~newtip ~route 0 s in
-    CWarnings.set_current_loc loc;
-    let clas = classify_vernac ast in
-    let aast = { verbose = true; indentation; strlen; loc; expr = ast } in
-    match clas with
-    | VtStm (w,_), _ ->
-       ignore(process_transaction ~tty:false aast (VtStm (w,false), VtNow))
-    | _ ->
-       ignore(process_transaction
-         ~tty:false aast (VtQuery (false,report_with), VtNow)))
+    try
+      while true do
+        let { CAst.loc; v=ast } = parse_sentence ~doc at s in
+        let indentation, strlen = compute_indentation ?loc at in
+        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 =
-  if Stateid.equal id Stateid.dummy then anomaly(str"edit_at dummy") else
+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 =
     let rec aux cur =
@@ -2714,7 +3126,7 @@ let edit_at id =
       if Stateid.equal tip Stateid.initial then tip else
       match VCS.visit tip with
       | { step = (`Fork _ | `Qed _) } -> tip
-      | { step = `Sideff (`Ast(_,id)) } -> id
+      | { step = `Sideff (ReplayCommand _,id) } -> id
       | { step = `Sideff _ } -> tip
       | { next } -> master_for_br root next in
   let reopen_branch start at_id mode qed_id tip old_branch =
@@ -2722,12 +3134,12 @@ let edit_at id =
       (* Hum, this should be the real start_id in the cluster and not next *)
       match VCS.visit qed_id with
       | { step = `Qed ({ fproof = Some (_,cs); keep },_) } -> start, cs, keep
-      | _ -> anomaly (str "ProofTask not ending with Qed") in
+      | _ -> anomaly (str "ProofTask not ending with Qed.") in
     VCS.branch ~root:master_id ~pos:id
       VCS.edit_branch (`Edit (mode, qed_id, master_id, keep, old_branch));
     VCS.delete_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
@@ -2749,8 +3161,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
@@ -2765,7 +3177,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) ->
@@ -2774,67 +3186,46 @@ let edit_at id =
           end else if is_ancestor_of_cur_branch id then begin
             backto id (Some bn)
           end else begin
-            anomaly(str"Cannot leave an `Edit branch open")
+            anomaly(str"Cannot leave an `Edit branch open.")
           end
       | 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
             backto id None
           end else begin
-            anomaly(str"Cannot leave an `Edit branch open")
+            anomaly(str"Cannot leave an `Edit branch open.")
           end
       | false, None, Some(_,bn) -> backto id (Some bn)
       | 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
     | None ->
         VCS.print ();
         anomaly (str ("edit_at "^Stateid.to_string id^": ") ++
-          CErrors.print_no_report e)
+          CErrors.print_no_report e ++ str ".")
     | Some (_, id) ->
-        prerr_endline (fun () -> "Failed at state " ^ Stateid.to_string id);
+        stm_prerr_endline (fun () -> "Failed at state " ^ Stateid.to_string id);
         VCS.restore vcs;
         VCS.print ();
-        iraise (e, info)
+        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_doc did = dummy_doc
 
 (*********************** TTY API (PG, coqtop, coqc) ***************************)
 (******************************************************************************)
 
-let interp verb (loc,e) =
-  let clas = classify_vernac e in
-  let aast = { verbose = verb; indentation = 0; strlen = 0; loc; expr = e } in
-  let rc = process_transaction ~tty:true aast clas in
-  if rc <> `Ok then anomaly(str"tty loop can't be mixed with the STM protocol");
-  if interactive () = `Yes ||
-     (!Flags.async_proofs_mode = Flags.APoff &&
-      !Flags.compilation_mode = Flags.BuildVo) then
-    let vcs = VCS.backup () in
-    let print_goals =
-      verb && match clas with
-       | VtQuery _, _ -> false
-       | (VtProofStep _ | VtStm (VtBack _, _) | VtStartProof _), _ -> true
-       | _ -> not !Flags.coqtop_ui in
-    try finish ~print_goals ()
-    with e ->
-      let e = CErrors.push e in
-      handle_failure e vcs true
-
-let finish () = finish ()
-
-let get_current_state () = VCS.cur_tip ()
-
-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
@@ -2847,111 +3238,25 @@ 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 () =
-  List.map unmangle (List.map_filter proofname (VCS.branches ()))
-
-let get_current_proof_name () =
-  Option.map unmangle (proofname (VCS.current_branch ()))
-
-let get_script prf =
-  let branch, test =
-    match prf with
-    | None -> VCS.Branch.master, fun _ -> true
-    | Some name -> VCS.current_branch (),fun nl -> nl=[] || List.mem name nl in
-  let rec find acc id =
-    if Stateid.equal id Stateid.initial ||
-       Stateid.equal id Stateid.dummy then acc else
-    let view = VCS.visit id in
-    match view.step with
-    | `Fork((_,_,_,ns), _) when test ns -> acc
-    | `Qed (qed, proof) -> find [qed.qast.expr, (VCS.get_info id).n_goals] proof
-    | `Sideff (`Ast (x,_)) ->
-         find ((x.expr, (VCS.get_info id).n_goals)::acc) view.next
-    | `Sideff (`Id id)  -> find acc id
-    | `Cmd {cast = x; ctac} when ctac -> (* skip non-tactics *)
-         find ((x.expr, (VCS.get_info id).n_goals)::acc) view.next 
-    | `Cmd _ -> find acc view.next
-    | `Alias (id,_) -> find acc id
-    | `Fork _ -> find acc view.next
-    in
-  find [] (VCS.get_branch_pos branch)
-
-(* indentation code for Show Script, initially contributed
-   by D. de Rauglaudre *)
-
-let indent_script_item ((ng1,ngl1),nl,beginend,ppl) (cmd,ng) =
-  (* ng1 : number of goals remaining at the current level (before cmd)
-     ngl1 : stack of previous levels with their remaining goals
-     ng : number of goals after the execution of cmd
-     beginend : special indentation stack for { } *)
-  let ngprev = List.fold_left (+) ng1 ngl1 in
-  let new_ngl =
-    if ng > ngprev then
-      (* We've branched *)
-      (ng - ngprev + 1, ng1 - 1 :: ngl1)
-    else if ng < ngprev then
-      (* A subgoal have been solved. Let's compute the new current level
-	 by discarding all levels with 0 remaining goals. *)
-      let rec loop = function
-	| (0, ng2::ngl2) -> loop (ng2,ngl2)
-	| p -> p
-      in loop (ng1-1, ngl1)
-    else
-      (* Standard case, same goal number as before *)
-      (ng1, ngl1)
-  in
-  (* When a subgoal have been solved, separate this block by an empty line *)
-  let new_nl = (ng < ngprev)
-  in
-  (* Indentation depth *)
-  let ind = List.length ngl1
-  in
-  (* Some special handling of bullets and { }, to get a nicer display *)
-  let pred n = max 0 (n-1) in
-  let ind, nl, new_beginend = match cmd with
-    | VernacSubproof _ -> pred ind, nl, (pred ind)::beginend
-    | VernacEndSubproof -> List.hd beginend, false, List.tl beginend
-    | VernacBullet _ -> pred ind, nl, beginend
-    | _ -> ind, nl, beginend
-  in
-  let pp =
-    (if nl then fnl () else mt ()) ++
-    (hov (ind+1) (str (String.make ind ' ') ++ Ppvernac.pr_vernac cmd))
-  in
-  (new_ngl, new_nl, new_beginend, pp :: ppl)
-
-let show_script ?proof () =
-  try
-    let prf =
-      try match proof with
-      | None -> Some (Pfedit.get_current_proof_name ())
-      | Some (p,_) -> Some (p.Proof_global.id)
-      with Proof_global.NoCurrentProof -> None
-    in
-    let cmds = get_script prf in
-    let _,_,_,indented_cmds =
-      List.fold_left indent_script_item ((1,[]),false,[],[]) cmds
-    in
-    let indented_cmds = List.rev (indented_cmds) in
-    msg_notice (v 0 (prlist_with_sep fnl (fun x -> x) indented_cmds))
-  with Vcs_aux.Expired -> ()
+let get_all_proof_names ~doc =
+  List.map unmangle (CList.map_filter proofname (VCS.branches ()))
 
 (* Export hooks *)
 let state_computed_hook = Hooks.state_computed_hook
 let state_ready_hook = Hooks.state_ready_hook
-let parse_error_hook = Hooks.parse_error_hook
-let execution_error_hook = Hooks.execution_error_hook
 let forward_feedback_hook = Hooks.forward_feedback_hook
-let process_error_hook = Hooks.process_error_hook
-let interp_hook = Hooks.interp_hook
-let with_fail_hook = Hooks.with_fail_hook
 let unreachable_state_hook = Hooks.unreachable_state_hook
-let get_fix_exn () = !State.fix_exn_ref
-let tactic_being_run_hook = Hooks.tactic_being_run_hook
+let () = Hook.set Obligations.stm_get_fix_exn (fun () -> !State.fix_exn_ref)
+
+type document = VCS.vcs
+let backup () = VCS.backup ()
+let restore d = VCS.restore d
+
+
 (* vim:set foldmethod=marker: *)
diff --git a/stm/stm.mli b/stm/stm.mli
index b8a2a385..35ce77a3 100644
--- a/stm/stm.mli
+++ b/stm/stm.mli
@@ -1,36 +1,120 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Vernacexpr
 open Names
-open Feedback
-open Loc
 
 (** state-transaction-machine interface *)
 
-(* [add ontop check vebose eid s] adds a new command [s] on the state [ontop]
-   having edit id [eid].  [check] is called on the AST.
-   The [ontop] parameter is just for asserting the GUI is on sync, but
-   will eventually call edit_at on the fly if needed.
-   The sentence [s] is parsed in the state [ontop].
-   If [newtip] is provided, then the returned state id is guaranteed to be
-   [newtip] *)
-val add :
-  ontop:Stateid.t -> ?newtip:Stateid.t ->
-  ?check:(vernac_expr located -> unit) ->
-  bool -> edit_id -> string ->
-    Stateid.t * [ `NewTip | `Unfocus of Stateid.t ]
-
-(* parses and executes a command at a given state, throws away its side effects
-   but for the printings.  Feedback is sent with report_with (defaults to dummy
-   state id)  *)
-val query :
-  at:Stateid.t -> ?report_with:(Stateid.t * Feedback.route_id) -> string -> unit
+(* 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 document type [stm_doc_type] determines some properties
+   such as what uncompleted proofs are allowed and what gets recorded
+   to aux files. *)
+type stm_doc_type =
+  | VoDoc       of string       (* file path *)
+  | VioDoc      of string       (* file path *)
+  | Interactive of DirPath.t    (* module path *)
+
+(** Coq initalization options:
+
+ - [doc_type]: Type of document being created.
+
+ - [require_libs]: list of libraries/modules to be pre-loaded at
+   startup. A tuple [(modname,modfrom,import)] is equivalent to [From
+   modfrom Require modname]; [import] works similarly to
+   [Library.require_library_from_dirpath], [Some false] will import
+   the module, [Some true] will additionally export it.
+
+*)
+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
+
+(** [init_core] performs some low-level initalization; should go away
+   in future releases. *)
+val init_core : unit -> unit
+
+(** [new_doc opt] Creates a new document with options [opt] *)
+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 : doc:doc -> Stateid.t -> Pcoq.Gram.coq_parsable ->
+  Vernacexpr.vernac_control CAst.t
+
+(* Reminder: A parsable [pa] is constructed using
+   [Pcoq.Gram.coq_parsable stream], where [stream : char Stream.t]. *)
+
+exception End_of_input
+
+(* [add ~ontop ?newtip verbose cmd] adds a new command [cmd] ontop of
+   the state [ontop].
+   The [ontop] parameter just asserts that the GUI is on
+   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 : doc:doc -> ontop:Stateid.t -> ?newtip:Stateid.t ->
+  bool -> Vernacexpr.vernac_control CAst.t ->
+  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 : 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
    the requested id is the new document tip hence the document portion following
@@ -42,24 +126,28 @@ 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 ]
+
+(* [observe doc sid]] Check / execute span [sid] *)
+val observe : doc:doc -> Stateid.t -> doc
 
-(* Evaluates the tip of the current branch *)
-val finish : unit -> unit
+(* [finish doc] Fully checks a document up to the "current" tip. *)
+val finish : doc:doc -> doc
 
-val observe : Stateid.t -> unit
+(* Internal use (fake_ide) only, do not use *)
+val wait : doc:doc -> 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 *)
@@ -74,23 +162,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.t) 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 **************************************************************** **)
 
@@ -105,20 +187,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. } ..
@@ -126,7 +208,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
@@ -147,7 +229,7 @@ type static_block_declaration = {
 
 type document_node = {
   indentation : int;
-  ast : Vernacexpr.vernac_expr;
+  ast : Vernacexpr.vernac_control;
   id : Stateid.t;
 }
 
@@ -162,11 +244,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 ->
@@ -182,43 +264,26 @@ val register_proof_block_delimiter :
  * the name of the Task(s) above) *)
 
 val state_computed_hook : (Stateid.t -> in_cache:bool -> unit) Hook.t
-val parse_error_hook :
-  (Feedback.edit_or_state_id -> Loc.t -> Pp.std_ppcmds -> unit) Hook.t
-val execution_error_hook : (Stateid.t -> Loc.t -> Pp.std_ppcmds -> unit) Hook.t
 val unreachable_state_hook : (Stateid.t -> Exninfo.iexn -> unit) Hook.t
+
 (* ready means that master has it at hand *)
 val state_ready_hook : (Stateid.t -> unit) Hook.t
-(* called with true before and with false after a tactic explicitly
- * in the document is run *)
-val tactic_being_run_hook : (bool -> 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 ]
-
-(** read-eval-print loop compatible interface ****************************** **)
+val get_doc : Feedback.doc_id -> doc
 
-(* Adds a new line to the document.  It replaces the core of Vernac.interp.
-   [finish] is called as the last bit of this function if the system
-   is running interactively (-emacs or coqtop). *)
-val interp : bool -> vernac_expr located -> unit
+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 get_current_proof_name : unit -> Id.t option
-val show_script : ?proof:Proof_global.closed_proof -> unit -> unit
-
-(* Hooks to be set by other Coq components in order to break file cycles *)
-val process_error_hook : Future.fix_exn Hook.t
-val interp_hook : (?verbosely:bool -> ?proof:Proof_global.closed_proof ->
-  Loc.t * Vernacexpr.vernac_expr -> unit) Hook.t
-val with_fail_hook : (bool -> (unit -> unit) -> unit) Hook.t
-val get_fix_exn : unit -> (Exninfo.iexn -> Exninfo.iexn)
+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
+
+type document
+val backup : unit -> document
+val restore : document -> unit
diff --git a/stm/stm.mllib b/stm/stm.mllib
index 939ee187..72b53801 100644
--- a/stm/stm.mllib
+++ b/stm/stm.mllib
@@ -4,8 +4,8 @@ Vcs
 TQueue
 WorkerPool
 Vernac_classifier
-Lemmas
 CoqworkmgrApi
+WorkerLoop
 AsyncTaskQueue
 Stm
 ProofBlockDelimiter
diff --git a/stm/tQueue.ml b/stm/tQueue.ml
index a0b08778..33744e73 100644
--- a/stm/tQueue.ml
+++ b/stm/tQueue.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module PriorityQueue : sig
@@ -88,7 +90,7 @@ let broadcast { lock = m; cond = c } =
 
 let push { queue = q; lock = m; cond = c; release } x =
   if release then CErrors.anomaly(Pp.str
-    "TQueue.push while being destroyed! Only 1 producer/destroyer allowed");
+    "TQueue.push while being destroyed! Only 1 producer/destroyer allowed.");
   Mutex.lock m;
   PriorityQueue.push q x;
   Condition.broadcast c;
diff --git a/stm/tQueue.mli b/stm/tQueue.mli
index 27eca12a..e098c37f 100644
--- a/stm/tQueue.mli
+++ b/stm/tQueue.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Thread safe queue with some extras *)
diff --git a/stm/tacworkertop.ml b/stm/tacworkertop.ml
index d5333d10..3b91df86 100644
--- a/stm/tacworkertop.ml
+++ b/stm/tacworkertop.ml
@@ -1,18 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-module W = AsyncTaskQueue.MakeWorker(Stm.TacTask)
+module W = AsyncTaskQueue.MakeWorker(Stm.TacTask) ()
 
-let () = Coqtop.toploop_init := (fun args ->
-        Flags.make_silent true;
-        W.init_stdout ();
-        CoqworkmgrApi.init !Flags.async_proofs_worker_priority;
-        args)
+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/vcs.ml b/stm/vcs.ml
index d3886464..4bd46286 100644
--- a/stm/vcs.ml
+++ b/stm/vcs.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -74,8 +76,6 @@ module Dag = Dag.Make(OT)
 
 type id = OT.t
 
-module NodeSet = Dag.NodeSet
-
 module Branch =
 struct
   type t = string
@@ -115,7 +115,7 @@ let add_node vcs id edges =
 
 let get_branch vcs head =
   try BranchMap.find head vcs.heads
-  with Not_found -> anomaly (str"head " ++ str head ++ str" not found")
+  with Not_found -> anomaly (str"head " ++ str head ++ str" not found.")
 
 let reset_branch vcs head id =
   let map name h =
diff --git a/stm/vcs.mli b/stm/vcs.mli
index 46b40f8a..47622ef6 100644
--- a/stm/vcs.mli
+++ b/stm/vcs.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This module builds a VCS like interface on top of Dag, used to build
diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml
index dc5be08a..f68c8b32 100644
--- a/stm/vernac_classifier.ml
+++ b/stm/vernac_classifier.ml
@@ -1,16 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Vernacexpr
 open CErrors
+open Util
 open Pp
+open CAst
+open Vernacexpr
 
-let default_proof_mode () = Proof_global.get_default_proof_mode_name ()
+let default_proof_mode () = Proof_global.get_default_proof_mode_name () [@ocaml.warning "-3"]
 
 let string_of_in_script b = if b then " (inside script)" else ""
 
@@ -30,13 +34,8 @@ let string_of_vernac_type = function
       "ProofStep " ^ string_of_parallel parallel ^
         Option.default "" proof_block_detection
   | VtProofMode s -> "ProofMode " ^ s
-  | VtQuery (b,(id,route)) ->
-      "Query " ^ string_of_in_script b ^ " report " ^ Stateid.to_string id ^
-      " route " ^ string_of_int route
-  | VtStm ((VtFinish|VtJoinDocument|VtObserve _|VtPrintDag|VtWait), b) ->
-      "Stm " ^ string_of_in_script b
-  | VtStm (VtPG, b) -> "Stm PG " ^ string_of_in_script b
-  | VtStm (VtBack _, b) -> "Stm Back " ^ string_of_in_script b
+  | VtQuery (b, route) -> "Query " ^ string_of_in_script b ^ " route " ^ string_of_int route
+  | VtMeta -> "Meta "
 
 let string_of_vernac_when = function
   | VtLater -> "Later"
@@ -52,65 +51,26 @@ let declare_vernac_classifier
 =
   classifiers := !classifiers @ [s,f]
 
-let elide_part_of_script_and_now (a, _) =
-  match a with
-  | VtQuery (_,id) -> VtQuery (false,id), VtNow
-  | VtStm (x, _) -> VtStm (x, false), VtNow
-  | x -> x, VtNow
-
-let make_polymorphic (a, b as x) =
-  match a with
-  | VtStartProof (x, _, ids) ->
-      VtStartProof (x, Doesn'tGuaranteeOpacity, ids), b
-  | _ -> x
+let idents_of_name : Names.Name.t -> Names.Id.t list =
+  function
+  | Names.Anonymous -> []
+  | Names.Name n -> [n]
 
-let undo_classifier = ref (fun _ -> assert false)
-let set_undo_classifier f = undo_classifier := f
-
-let rec classify_vernac e =
-  let static_classifier e = match e with
-    (* PG compatibility *)
-    | VernacUnsetOption (["Silent"]|["Undo"]|["Printing";"Depth"])
-    | VernacSetOption   ((["Silent"]|["Undo"]|["Printing";"Depth"]),_)
-      when !Flags.print_emacs -> VtStm(VtPG,false), VtNow
+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 Finish -> VtStm (VtFinish, true), VtNow
-    | VernacStm Wait -> VtStm (VtWait, true), VtNow
-    | VernacStm JoinDocument -> VtStm (VtJoinDocument, true), VtNow
-    | VernacStm PrintDag -> VtStm (VtPrintDag, true), VtNow
-    | VernacStm (Observe id) -> VtStm (VtObserve id, true), VtNow
-    | VernacStm (Command x) -> elide_part_of_script_and_now (classify_vernac x)
-    | VernacStm (PGLast x) -> fst (classify_vernac x), 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
     | VernacEndProof _ | VernacExactProof _ -> VtQed VtKeep, VtLater
     (* Query *)
     | VernacShow _ | VernacPrint _ | VernacSearch _ | VernacLocate _
-    | VernacCheckMayEval _ ->
-        VtQuery (true,(Stateid.dummy,Feedback.default_route)), VtLater
+    | VernacCheckMayEval _ -> VtQuery (true,Feedback.default_route), VtLater
     (* ProofStep *)
     | VernacProof _ 
     | VernacFocus _ | VernacUnfocus
@@ -127,51 +87,59 @@ let rec classify_vernac e =
                       proof_block_detection = Some "curly" },
         VtLater
     (* Options changing parser *)
-    | VernacUnsetOption (["Default";"Proof";"Using"])
-    | VernacSetOption (["Default";"Proof";"Using"],_) -> VtSideff [], VtNow
+    | 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
-    | 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) ->
+    | 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 = 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
-    | 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.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 (((_,({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 _
@@ -181,7 +149,7 @@ let rec classify_vernac e =
     | VernacReserve _
     | VernacGeneralizable _
     | VernacSetOpacity _ | VernacSetStrategy _
-    | VernacUnsetOption _ | VernacSetOption _ | VernacSetAppendOption _
+    | VernacUnsetOption _ | VernacSetOption _
     | VernacAddOption _ | VernacRemoveOption _
     | VernacMemOption _ | VernacPrintOption _
     | VernacGlobalCheck _
@@ -195,43 +163,58 @@ 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
-    | VernacError _ -> assert false
+    | 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))
+        with Not_found -> anomaly(str"No classifier for"++spc()++str (fst s)++str".")
+  in
+  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
-  let res = static_classifier e in
-    if Flags.is_universe_polymorphism () then
-      make_polymorphic res
-    else res
+  static_control_classifier ~poly:(Flags.is_universe_polymorphism ()) e
 
-let classify_as_query =
-  VtQuery (true,(Stateid.dummy,Feedback.default_route)), VtLater
+let classify_as_query = VtQuery (true,Feedback.default_route), VtLater
 let classify_as_sideeff = VtSideff [], VtLater
 let classify_as_proofstep = VtProofStep { parallel = `No; proof_block_detection = None}, VtLater
diff --git a/stm/vernac_classifier.mli b/stm/vernac_classifier.mli
index 45ca5cf6..abbc04e8 100644
--- a/stm/vernac_classifier.mli
+++ b/stm/vernac_classifier.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Vernacexpr
@@ -12,15 +14,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 a6237daa..64f19e1f 100644
--- a/stm/vio_checking.ml
+++ b/stm/vio_checking.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -14,7 +16,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
@@ -24,7 +26,7 @@ end
 module Pool = Map.Make(IntOT)
 
 let schedule_vio_checking j fs =
-  if j < 1 then CErrors.error "The number of workers must be bigger than 0";
+  if j < 1 then CErrors.user_err Pp.(str "The number of workers must be bigger than 0");
   let jobs = ref [] in
   List.iter (fun f ->
     let f =
@@ -98,7 +100,7 @@ let schedule_vio_checking j fs =
   exit !rc
 
 let schedule_vio_compilation j fs =
-  if j < 1 then CErrors.error "The number of workers must be bigger than 0";
+  if j < 1 then CErrors.user_err Pp.(str "The number of workers must be bigger than 0");
   let jobs = ref [] in
   List.iter (fun f ->
     let f =
@@ -107,7 +109,7 @@ let schedule_vio_compilation j fs =
     let long_f_dot_v = Loadpath.locate_file (f^".v") in
     let aux = Aux_file.load_aux_file_for long_f_dot_v in
     let eta =
-      try float_of_string (Aux_file.get aux Loc.ghost "vo_compile_time")
+      try float_of_string (Aux_file.get aux "vo_compile_time")
       with Not_found -> 0.0 in
     jobs := (f, eta) :: !jobs)
   fs;
diff --git a/stm/vio_checking.mli b/stm/vio_checking.mli
index c0b6d9e6..177b3b2d 100644
--- a/stm/vio_checking.mli
+++ b/stm/vio_checking.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* [check_vio tasks file] checks the [tasks] stored in [file] *)
diff --git a/stm/workerLoop.ml b/stm/workerLoop.ml
new file mode 100644
index 00000000..5445925b
--- /dev/null
+++ b/stm/workerLoop.ml
@@ -0,0 +1,25 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* 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 _coq_args extra_args =
+  let args = parse extra_args in
+  Flags.quiet := true;
+  init ();
+  CoqworkmgrApi.init !async_proofs_worker_priority;
+  args
diff --git a/stm/workerLoop.mli b/stm/workerLoop.mli
new file mode 100644
index 00000000..f02edb9b
--- /dev/null
+++ b/stm/workerLoop.mli
@@ -0,0 +1,14 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* Default priority *)
+val async_proofs_worker_priority : CoqworkmgrApi.priority ref
+
+val loop : (unit -> unit) -> Coqargs.coq_cmdopts -> string list -> string list
diff --git a/stm/workerPool.ml b/stm/workerPool.ml
index 9623765d..0ff66686 100644
--- a/stm/workerPool.ml
+++ b/stm/workerPool.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type worker_id = string
diff --git a/stm/workerPool.mli b/stm/workerPool.mli
index 75c32536..0f1237b5 100644
--- a/stm/workerPool.mli
+++ b/stm/workerPool.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type worker_id = string
diff --git a/tactics/auto.ml b/tactics/auto.ml
index bc644857..0c0d9bcf 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -1,26 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(*
-*)
+module CVars = Vars
+
 open Pp
 open Util
-open CErrors
 open Names
-open Vars
 open Termops
+open EConstr
 open Environ
-open Tacmach
 open Genredexpr
 open Tactics
-open Tacticals
 open Clenv
-open Tacexpr
 open Locus
 open Proofview.Notations
 open Hints
@@ -36,7 +34,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
@@ -44,9 +42,9 @@ let compute_secvars gl =
 
 open Unification
 
-let auto_core_unif_flags_of st1 st2 useeager = {
+let auto_core_unif_flags_of st1 st2 = {
   modulo_conv_on_closed_terms = Some st1;
-  use_metas_eagerly_in_conv_on_closed_terms = useeager;
+  use_metas_eagerly_in_conv_on_closed_terms = false;
   use_evars_eagerly_in_conv_on_closed_terms = false;
   modulo_delta = st2;
   modulo_delta_types = full_transparent_state;
@@ -59,8 +57,8 @@ let auto_core_unif_flags_of st1 st2 useeager = {
   modulo_eta = true;
 }
 
-let auto_unif_flags_of st1 st2 useeager =
-  let flags = auto_core_unif_flags_of st1 st2 useeager in {
+let auto_unif_flags_of st1 st2 =
+  let flags = auto_core_unif_flags_of st1 st2 in {
   core_unify_flags = flags;
   merge_unify_flags = flags;
   subterm_unify_flags = { flags with modulo_delta = empty_transparent_state };
@@ -69,7 +67,7 @@ let auto_unif_flags_of st1 st2 useeager =
 }
 
 let auto_unif_flags =
-  auto_unif_flags_of full_transparent_state empty_transparent_state false
+  auto_unif_flags_of full_transparent_state empty_transparent_state
 
 (* Try unification with the precompiled clause, then use registered Apply *)
 
@@ -84,27 +82,28 @@ let connect_hint_clenv poly (c, _, ctx) clenv gl =
     if poly then
       (** Refresh the instance of the hint *)
       let (subst, ctx) = Universes.fresh_universe_context_set_instance ctx in
-      let map c = Vars.subst_univs_level_constr subst c in
+      let map c = CVars.subst_univs_level_constr subst c in
+      let emap c = Vars.subst_univs_level_constr subst c in
       let evd = Evd.merge_context_set Evd.univ_flexible evd ctx in
       (** Only metas are mentioning the old universes. *)
       let clenv = {
-        templval = Evd.map_fl map clenv.templval;
-        templtyp = Evd.map_fl map clenv.templtyp;
+        templval = Evd.map_fl emap clenv.templval;
+        templtyp = Evd.map_fl emap clenv.templtyp;
         evd = Evd.map_metas map evd;
         env = Proofview.Goal.env gl;
       } in
-      clenv, map c
+      clenv, emap c
     else
       let evd = Evd.merge_context_set Evd.univ_flexible evd ctx in
       { clenv with evd = evd ; env = Proofview.Goal.env gl }, c
   in clenv, c
 
 let unify_resolve poly flags ((c : raw_hint), clenv) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let clenv, c = connect_hint_clenv poly c clenv gl in
-  let clenv = Tacmach.New.of_old (fun gl -> clenv_unique_resolver ~flags clenv gl) gl in
+  let clenv = clenv_unique_resolver ~flags clenv gl in
   Clenvtac.clenv_refine false clenv
-  end }
+  end
 
 let unify_resolve_nodelta poly h = unify_resolve poly auto_unif_flags h
 
@@ -113,12 +112,12 @@ let unify_resolve_gen poly = function
   | Some flags -> unify_resolve poly flags
 
 let exact poly (c,clenv) =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let clenv', c = connect_hint_clenv poly c clenv gl in
     Tacticals.New.tclTHEN
     (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
     (exact_check c)
-  end }
+  end
 
 (* Util *)
 
@@ -142,15 +141,15 @@ let conclPattern concl pat tac =
 	try
 	  Proofview.tclUNIT (Constr_matching.matches env sigma pat concl)
 	with Constr_matching.PatternMatchingFailure ->
-          Tacticals.New.tclZEROMSG (str "conclPattern")
+          Tacticals.New.tclZEROMSG (str "pattern-matching failed")
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
      let env = Proofview.Goal.env gl in
      let sigma = Tacmach.New.project gl in
        constr_bindings env sigma >>= fun constr_bindings ->
      let open Genarg in
      let open Geninterp in
-     let inj c = match val_tag (topwit Constrarg.wit_constr) with
+     let inj c = match val_tag (topwit Stdarg.wit_constr) with
      | Val.Base tag -> Val.Dyn (tag, c)
      | _ -> assert false
      in
@@ -160,7 +159,7 @@ let conclPattern concl pat tac =
      match tac with
      | GenArg (Glbwit wit, tac) ->
       Ftactic.run (Geninterp.interp wit ist tac) (fun _ -> Proofview.tclUNIT ())
-  end }
+  end
 
 (***********************************************************)
 (** A debugging / verbosity framework for trivial and auto *)
@@ -177,8 +176,7 @@ let global_info_auto = ref false
 
 let add_option ls refe =
   let _ = Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = String.concat " " ls;
       Goptions.optkey   = ls;
       Goptions.optread  = (fun () -> !refe);
@@ -191,35 +189,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
@@ -263,20 +260,20 @@ let pr_info_atom (d,pp) =
   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
@@ -294,18 +291,18 @@ let tclTRY_dbg d tac =
   de Hint impérative a été remplacée par plusieurs bases fonctionnelles *)
 
 let flags_of_state st =
-  auto_unif_flags_of st st false
+  auto_unif_flags_of st st
 
 let auto_flags_of_state st =
-  auto_unif_flags_of full_transparent_state st false
+  auto_unif_flags_of full_transparent_state st
 
-let hintmap_of secvars hdc concl =
+let hintmap_of sigma secvars hdc concl =
   match hdc with
   | None -> Hint_db.map_none ~secvars
   | Some hdc ->
-     if occur_existential concl then
-       Hint_db.map_existential ~secvars hdc concl
-     else Hint_db.map_auto ~secvars hdc concl
+     if occur_existential sigma concl then
+       Hint_db.map_existential sigma ~secvars hdc concl
+     else Hint_db.map_auto sigma ~secvars hdc concl
 
 let exists_evaluable_reference env = function
   | EvalConstRef _ -> true
@@ -317,37 +314,38 @@ let dbg_assumption dbg = tclLOG dbg (fun () -> str "assumption") assumption
 let rec trivial_fail_db dbg mod_delta db_list local_db =
   let intro_tac =
     Tacticals.New.tclTHEN (dbg_intro dbg)
-      ( Proofview.Goal.enter { enter = begin fun gl ->
+      ( Proofview.Goal.enter begin fun gl ->
           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
 	       (Hint_db.add_list env sigma hintl local_db)
-      end })
+      end)
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let concl = Tacmach.New.pf_nf_concl gl in
+  Proofview.Goal.enter begin fun gl ->
+    let concl = Tacmach.New.pf_concl gl in
+    let sigma = Tacmach.New.project gl in
     let secvars = compute_secvars gl in
     Tacticals.New.tclFIRST
       ((dbg_assumption dbg)::intro_tac::
           (List.map Tacticals.New.tclCOMPLETE
-             (trivial_resolve dbg mod_delta db_list local_db secvars concl)))
-  end }
+             (trivial_resolve sigma dbg mod_delta db_list local_db secvars concl)))
+  end
 
-and my_find_search_nodelta db_list local_db secvars hdc concl =
+and my_find_search_nodelta sigma db_list local_db secvars hdc concl =
   List.map (fun hint -> (None,hint))
-    (List.map_append (hintmap_of secvars hdc concl) (local_db::db_list))
+    (List.map_append (hintmap_of sigma secvars hdc concl) (local_db::db_list))
 
 and my_find_search mod_delta =
   if mod_delta then my_find_search_delta
   else my_find_search_nodelta
 
-and my_find_search_delta db_list local_db secvars hdc concl =
-  let f = hintmap_of secvars hdc concl in
-    if occur_existential concl then
+and my_find_search_delta sigma db_list local_db secvars hdc concl =
+  let f = hintmap_of sigma secvars hdc concl in
+    if occur_existential sigma concl then
       List.map_append
 	(fun db ->
 	  if Hint_db.use_dn db then
@@ -369,8 +367,8 @@ and my_find_search_delta db_list local_db secvars hdc concl =
 	      match hdc with None -> Hint_db.map_none ~secvars db
 	      | Some hdc ->
 		  if (Id.Pred.is_empty ids && Cpred.is_empty csts)
-		  then Hint_db.map_auto ~secvars hdc concl db
-		  else Hint_db.map_existential ~secvars hdc concl db
+		  then Hint_db.map_auto sigma ~secvars hdc concl db
+		  else Hint_db.map_existential sigma ~secvars hdc concl db
 	    in auto_flags_of_state st, l
 	  in List.map (fun x -> (Some flags,x)) l)
       	(local_db::db_list)
@@ -378,20 +376,21 @@ and my_find_search_delta db_list local_db secvars hdc concl =
 and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=dbname})) =
   let tactic = function
     | Res_pf (c,cl) -> unify_resolve_gen poly flags (c,cl)
-    | ERes_pf _ -> Proofview.V82.tactic (fun gl -> error "eres_pf")
+    | ERes_pf _ -> Proofview.Goal.enter (fun gl -> Tacticals.New.tclZEROMSG (str "eres_pf"))
     | Give_exact (c, cl)  -> exact poly (c, cl)
     | Res_pf_THEN_trivial_fail (c,cl) ->
       Tacticals.New.tclTHEN
         (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.V82.tactic (fun gl ->
-       if exists_evaluable_reference (pf_env gl) c then
-	 tclPROGRESS (Proofview.V82.of_tactic (reduce (Unfold [AllOccurrences,c]) Locusops.onConcl)) gl
-       else tclFAIL 0 (str"Unbound reference") gl)
-    | Extern tacast -> 
+      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 ->
       conclPattern concl p tacast
   in
   let pr_hint () =
@@ -399,27 +398,28 @@ 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)
 
-and trivial_resolve dbg mod_delta db_list local_db secvars cl =
+and trivial_resolve sigma dbg mod_delta db_list local_db secvars cl =
   try
     let head =
-      try let hdconstr = decompose_app_bound cl in
+      try let hdconstr = decompose_app_bound sigma cl in
 	    Some hdconstr
       with Bound -> None
     in
       List.map (tac_of_hint dbg db_list local_db cl)
 	(priority
-	    (my_find_search mod_delta db_list local_db secvars head cl))
+	    (my_find_search mod_delta sigma db_list local_db secvars head cl))
   with Not_found -> []
 
 (** The use of the "core" database can be de-activated by passing
     "nocore" amongst the databases. *)
 
 let trivial ?(debug=Off) lems dbnames =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = make_db_list dbnames in
@@ -427,10 +427,10 @@ let trivial ?(debug=Off) lems dbnames =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (trivial_fail_db d false db_list hints)
-  end }
+  end
 
 let full_trivial ?(debug=Off) lems =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = current_pure_db () in
@@ -438,7 +438,7 @@ let full_trivial ?(debug=Off) lems =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (trivial_fail_db d false db_list hints)
-  end }
+  end
 
 let gen_trivial ?(debug=Off) lems = function
   | None -> full_trivial ~debug lems
@@ -450,15 +450,15 @@ let h_trivial ?(debug=Off) lems l = gen_trivial ~debug lems l
 (*                       The classical Auto tactic                        *)
 (**************************************************************************)
 
-let possible_resolve dbg mod_delta db_list local_db secvars cl =
+let possible_resolve sigma dbg mod_delta db_list local_db secvars cl =
   try
     let head =
-      try let hdconstr = decompose_app_bound cl in
+      try let hdconstr = decompose_app_bound sigma cl in
 	    Some hdconstr
       with Bound -> None
     in
       List.map (tac_of_hint dbg db_list local_db cl)
-	(my_find_search mod_delta db_list local_db secvars head cl)
+	(my_find_search mod_delta sigma db_list local_db secvars head cl)
   with Not_found -> []
 
 let extend_local_db decl db gl =
@@ -471,10 +471,10 @@ let extend_local_db decl db gl =
 
 let intro_register dbg kont db =
   Tacticals.New.tclTHEN (dbg_intro dbg)
-    (Proofview.Goal.enter { enter = begin fun gl ->
+    (Proofview.Goal.enter begin fun gl ->
       let extend_local_db decl db = extend_local_db decl db gl in
       Tacticals.New.onLastDecl (fun decl -> kont (extend_local_db decl db))
-    end })
+    end)
 
 (* n is the max depth of search *)
 (* local_db contains the local Hypotheses *)
@@ -487,15 +487,16 @@ let search d n mod_delta db_list local_db =
       if Int.equal n 0 then Tacticals.New.tclZEROMSG (str"BOUND 2") else
         Tacticals.New.tclORELSE0 (dbg_assumption d)
 	  (Tacticals.New.tclORELSE0 (intro_register d (search d n) local_db)
-	     ( Proofview.Goal.enter { enter = begin fun gl ->
-               let concl = Tacmach.New.pf_nf_concl gl in
+	     ( Proofview.Goal.enter begin fun gl ->
+               let concl = Tacmach.New.pf_concl gl in
+               let sigma = Tacmach.New.project gl in
                let secvars = compute_secvars gl in
 	       let d' = incr_dbg d in
 	       Tacticals.New.tclFIRST
 	         (List.map
 		    (fun ntac -> Tacticals.New.tclTHEN ntac (search d' (n-1) local_db))
-		    (possible_resolve d mod_delta db_list local_db secvars concl))
-             end }))
+		    (possible_resolve sigma d mod_delta db_list local_db secvars concl))
+             end))
     end []
   in
   search d n local_db
@@ -503,7 +504,7 @@ let search d n mod_delta db_list local_db =
 let default_search_depth = ref 5
 
 let delta_auto debug mod_delta n lems dbnames =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = make_db_list dbnames in
@@ -511,12 +512,12 @@ let delta_auto debug mod_delta n lems dbnames =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (search d n mod_delta db_list hints)
-  end }
+  end
 
 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
@@ -526,7 +527,7 @@ let new_auto ?(debug=Off) n = delta_auto debug true n
 let default_auto = auto !default_search_depth [] []
 
 let delta_full_auto ?(debug=Off) mod_delta n lems =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let db_list = current_pure_db () in
@@ -534,7 +535,7 @@ let delta_full_auto ?(debug=Off) mod_delta n lems =
   let hints = make_local_hint_db env sigma false lems in
   tclTRY_dbg d
     (search d n mod_delta db_list hints)
-  end }
+  end
 
 let full_auto ?(debug=Off) n = delta_full_auto ~debug false n
 let new_full_auto ?(debug=Off) n = delta_full_auto ~debug true n
diff --git a/tactics/auto.mli b/tactics/auto.mli
index 3befaaad..a835c1ed 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -1,28 +1,31 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This files implements auto and related automation tactics *)
 
 open Names
-open Term
+open EConstr
 open Clenv
 open Pattern
 open Decl_kinds
 open Hints
+open Tactypes
 
-val compute_secvars : ('a,'b) 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, 'r) 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
@@ -39,43 +42,43 @@ val conclPattern : constr -> constr_pattern option -> Genarg.glob_generic_argume
 (** The use of the "core" database can be de-activated by passing
     "nocore" amongst the databases. *)
 
-val auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val auto : ?debug:debug ->
+  int -> delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 
 (** Auto with more delta. *)
 
-val new_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val new_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 
 (** auto with default search depth and with the hint database "core" *)
 val default_auto : unit Proofview.tactic
 
 (** auto with all hint databases *)
-val full_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
+val full_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> unit Proofview.tactic
 
 (** auto with all hint databases and doing delta *)
-val new_full_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
+val new_full_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> unit Proofview.tactic
 
 (** auto with default search depth and with all hint databases *)
 val default_full_auto : unit Proofview.tactic
 
 (** The generic form of auto (second arg [None] means all bases) *)
-val gen_auto : ?debug:Tacexpr.debug ->
-  int option -> Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val gen_auto : ?debug:debug ->
+  int option -> delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 
 (** The hidden version of auto *)
-val h_auto   : ?debug:Tacexpr.debug ->
-  int option -> Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val h_auto   : ?debug:debug ->
+  int option -> delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 
 (** Trivial *)
 
-val trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
-val gen_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
-val full_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> unit Proofview.tactic
-val h_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val gen_trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val full_trivial : ?debug:debug ->
+  delayed_open_constr list -> unit Proofview.tactic
+val h_trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index 47500564..c3857e6b 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -1,29 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Equality
 open Names
 open Pp
-open Tacticals
-open Tactics
-open Term
+open Constr
 open Termops
 open CErrors
 open Util
 open Mod_subst
 open Locus
-open Proofview.Notations
 
 (* Rewriting rules *)
 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 }
 
@@ -65,7 +64,7 @@ let raw_find_base bas = String.Map.find bas !rewtab
 let find_base bas =
   try raw_find_base bas
   with Not_found ->
-    errorlabstrm "AutoRewrite"
+    user_err ~hdr:"AutoRewrite"
       (str "Rewriting base " ++ str bas ++ str " does not exist.")
 
 let find_rewrites bas =
@@ -76,31 +75,30 @@ 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 " ++
-	       Pptactic.pr_glb_generic (Global.env()) tac) (mt ()) h.rew_tac)
+	       Pputils.pr_glb_generic (Global.env()) tac) (mt ()) h.rew_tac)
 	   (find_rewrites bas))
 
-type raw_rew_rule = Loc.t * constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option
+type raw_rew_rule = (constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option) CAst.t
 
 (* Applies all the rules of one base *)
 let one_base general_rewrite_maybe_in tac_main bas =
   let lrul = find_rewrites bas in
   let try_rewrite dir ctx c tc =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let subst, ctx' = Universes.fresh_universe_context_set_instance ctx in
     let c' = Vars.subst_univs_level_constr subst c in
-    let sigma = Sigma.to_evar_map sigma in
     let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx' in
-    let tac = general_rewrite_maybe_in dir c' tc in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end } in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (general_rewrite_maybe_in dir c' tc)
+  end in
   let lrul = List.map (fun h -> 
   let tac = match h.rew_tac with
   | None -> Proofview.tclUNIT ()
@@ -122,56 +120,24 @@ let autorewrite ?(conds=Naive) tac_main lbas =
        Tacticals.New.tclTHEN tac
         (one_base (fun dir c tac ->
 	  let tac = (tac, conds) in
-	    general_rewrite dir AllOccurrences true false ~tac c)
+	    general_rewrite dir AllOccurrences true false ~tac (EConstr.of_constr c))
 	  tac_main bas))
       (Proofview.tclUNIT()) lbas))
 
 let autorewrite_multi_in ?(conds=Naive) idl tac_main lbas =
- Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
  (* let's check at once if id exists (to raise the appropriate error) *)
- let _ = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) idl in
- let general_rewrite_in id =
-  let id = ref id in
-  let to_be_cleared = ref false in
-   fun dir cstr tac gl ->
-    let last_hyp_id =
-     match Tacmach.pf_hyps gl with
-        d :: _ -> Context.Named.Declaration.get_id d
-      | _ -> (* even the hypothesis id is missing *)
-        raise (Logic.RefinerError (Logic.NoSuchHyp !id))
-    in
-    let gl' = Proofview.V82.of_tactic (general_rewrite_in dir AllOccurrences true ~tac:(tac, conds) false !id cstr false) gl in
-    let gls = gl'.Evd.it in
-    match gls with
-       g::_ ->
-        (match Environ.named_context_of_val (Goal.V82.hyps gl'.Evd.sigma g) with
-            d ::_ ->
-              let lastid = Context.Named.Declaration.get_id d in
-              if not (Id.equal last_hyp_id lastid) then
-               begin
-                let gl'' =
-                  if !to_be_cleared then
-                   tclTHEN (fun _ -> gl') (tclTRY (Proofview.V82.of_tactic (clear [!id]))) gl
-                  else gl' in
-                id := lastid ;
-                to_be_cleared := true ;
-                gl''
-               end
-              else
-               begin
-                to_be_cleared := false ;
-                gl'
-               end
-          | _ -> assert false) (* there must be at least an hypothesis *)
-     | _ -> assert false (* rewriting cannot complete a proof *)
- in
- let general_rewrite_in x y z w = Proofview.V82.tactic (general_rewrite_in x y z w) in
+  let _ = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) idl in
+  let general_rewrite_in id dir cstr tac =
+    let cstr = EConstr.of_constr cstr in
+    general_rewrite_in dir AllOccurrences true ~tac:(tac, conds) false id cstr false
+  in
  Tacticals.New.tclMAP (fun id ->
   Tacticals.New.tclREPEAT_MAIN (Proofview.tclPROGRESS
     (List.fold_left (fun tac bas ->
        Tacticals.New.tclTHEN tac (one_base (general_rewrite_in id) tac_main bas)) (Proofview.tclUNIT()) lbas)))
    idl
- end }
+ end
 
 let autorewrite_in ?(conds=Naive) id = autorewrite_multi_in ~conds [id]
 
@@ -196,10 +162,10 @@ let gen_auto_multi_rewrite conds tac_main lbas cl =
 	   | None ->
 		 (* try to rewrite in all hypothesis
 		    (except maybe the rewritten one) *)
-               Proofview.Goal.nf_enter { enter = begin fun gl ->
+               Proofview.Goal.nf_enter begin fun gl ->
                  let ids = Tacmach.New.pf_ids_of_hyps gl in
 		 try_do_hyps (fun id -> id)  ids
-               end })
+               end)
 
 let auto_multi_rewrite ?(conds=Naive) lems cl =
   Proofview.V82.wrap_exceptions (fun () -> gen_auto_multi_rewrite conds (Proofview.tclUNIT()) lems cl)
@@ -257,12 +223,12 @@ type hypinfo = {
 
 let decompose_applied_relation metas env sigma c ctype left2right =
   let find_rel ty =
-    let eqclause = Clenv.mk_clenv_from_env env sigma None (c,ty) in
+    let eqclause = Clenv.mk_clenv_from_env env sigma None (EConstr.of_constr c,ty) in
     let eqclause =
       if metas then eqclause
       else clenv_pose_metas_as_evars eqclause (Evd.undefined_metas eqclause.evd)
     in
-    let (equiv, args) = decompose_app (Clenv.clenv_type eqclause) in
+    let (equiv, args) = decompose_app (EConstr.Unsafe.to_constr (Clenv.clenv_type eqclause)) in
     let rec split_last_two = function
       | [c1;c2] -> [],(c1, c2)
       | x::y::z ->
@@ -272,11 +238,13 @@ let decompose_applied_relation metas env sigma c ctype left2right =
       try
 	let others,(c1,c2) = split_last_two args in
 	let ty1, ty2 =
-	  Typing.unsafe_type_of env eqclause.evd c1, Typing.unsafe_type_of env eqclause.evd c2
+	  Typing.unsafe_type_of env eqclause.evd (EConstr.of_constr c1), Typing.unsafe_type_of env eqclause.evd (EConstr.of_constr c2)
 	in
+	let ty = EConstr.Unsafe.to_constr ty in
+	let ty1 = EConstr.Unsafe.to_constr ty1 in
 (* 	  if not (evd_convertible env eqclause.evd ty1 ty2) then None *)
 (* 	  else *)
-	    Some { hyp_cl=eqclause; hyp_prf=(Clenv.clenv_value eqclause); hyp_ty = ty;
+	    Some { hyp_cl=eqclause; hyp_prf=EConstr.Unsafe.to_constr (Clenv.clenv_value eqclause); hyp_ty = ty;
 		   hyp_car=ty1; hyp_rel=mkApp (equiv, Array.of_list others);
 		   hyp_l2r=left2right; hyp_left=c1; hyp_right=c2; }
       with Not_found -> None
@@ -289,13 +257,13 @@ let decompose_applied_relation metas env sigma c ctype left2right =
 	| Some c -> Some c
 	| None -> None
 
-let find_applied_relation metas loc env sigma c left2right =
-  let ctype = Typing.unsafe_type_of env sigma c in
+let find_applied_relation ?loc metas env sigma c left2right =
+  let ctype = Typing.unsafe_type_of env sigma (EConstr.of_constr c) in
     match decompose_applied_relation metas env sigma c ctype left2right with
     | Some c -> c
     | None ->
-	user_err_loc (loc, "decompose_applied_relation",
-		     str"The type" ++ spc () ++ Printer.pr_constr_env env sigma ctype ++
+	user_err ?loc ~hdr:"decompose_applied_relation"
+		    (str"The type" ++ spc () ++ Printer.pr_econstr_env env sigma ctype ++
 		       spc () ++ str"of this term does not end with an applied relation.")
 
 (* To add rewriting rules to a base *)
@@ -303,13 +271,13 @@ let add_rew_rules base lrul =
   let counter = ref 0 in
   let env = Global.env () in
   let sigma = Evd.from_env env in
-  let ist = { Genintern.ltacvars = Id.Set.empty; genv = Global.env () } in
+  let ist = Genintern.empty_glob_sign (Global.env ()) in
   let intern tac = snd (Genintern.generic_intern ist tac) in
   let lrul =
     List.fold_left
-      (fun dn (loc,(c,ctx),b,t) ->
+      (fun dn {CAst.loc;v=((c,ctx),b,t)} ->
 	let sigma = Evd.merge_context_set Evd.univ_rigid sigma ctx in
-	let info = find_applied_relation false loc env sigma c b in
+	let info = find_applied_relation ?loc false env sigma c b in
 	let pat = if b then info.hyp_left else info.hyp_right in
 	let rul = { rew_lemma = c; rew_type = info.hyp_ty;
 		    rew_pat = pat; rew_ctx = ctx; rew_l2r = b;
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index 07065717..03e9414e 100644
--- a/tactics/autorewrite.mli
+++ b/tactics/autorewrite.mli
@@ -1,19 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This files implements the autorewrite tactic. *)
 
-open Term
-open Tacexpr
+open Constr
 open Equality
 
 (** Rewriting rules before tactic interpretation *)
-type raw_rew_rule = Loc.t * constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option
+type raw_rew_rule = (constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option) CAst.t
 
 (** To add rewriting rules to a base *)
 val add_rew_rules : string -> raw_rew_rule list -> unit
@@ -29,7 +30,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 }
 
@@ -41,7 +42,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.std_ppcmds
+val print_rewrite_hintdb : Environ.env -> Evd.evar_map -> string -> Pp.t
 
 open Clenv
 
@@ -57,7 +58,7 @@ type hypinfo = {
   hyp_right : constr;
 }
 
-val find_applied_relation : bool ->
-  Loc.t ->
-  Environ.env -> Evd.evar_map -> Term.constr -> bool -> hypinfo
+val find_applied_relation :
+  ?loc:Loc.t -> bool ->
+  Environ.env -> Evd.evar_map -> constr -> bool -> hypinfo
 
diff --git a/tactics/btermdn.ml b/tactics/btermdn.ml
index 491bc8b4..8e50c977 100644
--- a/tactics/btermdn.ml
+++ b/tactics/btermdn.ml
@@ -1,13 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Term
+open EConstr
 open Names
 open Pattern
 open Globnames
@@ -38,18 +41,18 @@ let decomp_pat =
   in
   decrec []
 
-let decomp =
-  let rec decrec acc c = match kind_of_term c with
+let decomp sigma t =
+  let rec decrec acc c = match EConstr.kind sigma c with
     | App (f,l) -> decrec (Array.fold_right (fun a l -> a::l) l acc) f
     | Proj (p, c) -> (mkConst (Projection.constant p), c :: acc)
     | Cast (c1,_,_) -> decrec acc c1
     | _ -> (c,acc)
   in
-    decrec []
+    decrec [] t
 
-let constr_val_discr t =
-  let c, l = decomp t in
-    match kind_of_term c with
+let constr_val_discr sigma t =
+  let c, l = decomp sigma t in
+    match EConstr.kind sigma c with
     | Ind (ind_sp,u) -> Label(GRLabel (IndRef ind_sp),l)
     | Construct (cstr_sp,u) -> Label(GRLabel (ConstructRef cstr_sp),l)
     | Var id -> Label(GRLabel (VarRef id),l)
@@ -66,9 +69,9 @@ let constr_pat_discr t =
     | PRef ((VarRef v) as ref), args -> Some(GRLabel ref,args)
     | _ -> None
 
-let constr_val_discr_st (idpred,cpred) t =
-  let c, l = decomp t in
-    match kind_of_term c with
+let constr_val_discr_st sigma (idpred,cpred) t =
+  let c, l = decomp sigma t in
+    match EConstr.kind sigma c with
     | Const (c,u) -> if Cpred.mem c cpred then Everything else Label(GRLabel (ConstRef c),l)
     | Ind (ind_sp,u) -> Label(GRLabel (IndRef ind_sp),l)
     | Construct (cstr_sp,u) -> Label(GRLabel (ConstructRef cstr_sp),l)
@@ -105,11 +108,11 @@ let bounded_constr_pat_discr_st st (t,depth) =
       | None -> None
       | Some (c,l) -> Some(c,List.map (fun c -> (c,depth-1)) l)
 
-let bounded_constr_val_discr_st st (t,depth) =
+let bounded_constr_val_discr_st sigma st (t,depth) =
   if Int.equal depth 0 then
     Nothing
   else
-    match constr_val_discr_st st t with
+    match constr_val_discr_st sigma st t with
       | Label (c,l) -> Label(c,List.map (fun c -> (c,depth-1)) l)
       | Nothing -> Nothing
       | Everything -> Everything
@@ -122,11 +125,11 @@ let bounded_constr_pat_discr (t,depth) =
       | None -> None
       | Some (c,l) -> Some(c,List.map (fun c -> (c,depth-1)) l)
 
-let bounded_constr_val_discr (t,depth) =
+let bounded_constr_val_discr sigma (t,depth) =
   if Int.equal depth 0 then
     Nothing
   else
-    match constr_val_discr t with
+    match constr_val_discr sigma t with
       | Label (c,l) -> Label(c,List.map (fun c -> (c,depth-1)) l)
       | Nothing -> Nothing
       | Everything -> Everything
@@ -162,13 +165,13 @@ struct
 	(fun dn (c,v) ->
 	 Dn.rmv dn (bounded_constr_pat_discr_st st) ((c,!dnet_depth),v))
 
-  let lookup = function
+  let lookup sigma = function
     | None ->
 	(fun dn t ->
-	     Dn.lookup dn bounded_constr_val_discr (t,!dnet_depth))
+	     Dn.lookup dn (bounded_constr_val_discr sigma) (t,!dnet_depth))
     | Some st ->
 	(fun dn t ->
-	     Dn.lookup dn (bounded_constr_val_discr_st st) (t,!dnet_depth))
+	     Dn.lookup dn (bounded_constr_val_discr_st sigma st) (t,!dnet_depth))
 
   let app f dn = Dn.app f dn
 
diff --git a/tactics/btermdn.mli b/tactics/btermdn.mli
index 8ca5549b..861c9b62 100644
--- a/tactics/btermdn.mli
+++ b/tactics/btermdn.mli
@@ -1,12 +1,13 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
 open Pattern
 open Names
 
@@ -33,7 +34,7 @@ sig
   val add : transparent_state option -> t -> (constr_pattern * Z.t) -> t
   val rmv : transparent_state option -> t -> (constr_pattern * Z.t) -> t
 
-  val lookup : transparent_state option -> t -> constr -> Z.t list
+  val lookup : Evd.evar_map -> transparent_state option -> t -> EConstr.constr -> Z.t list
   val app : (Z.t -> unit) -> t -> unit
 end
 
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index b416bc65..73b649e5 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* TODO:
@@ -17,9 +19,7 @@ open Util
 open Names
 open Term
 open Termops
-open Reduction
-open Proof_type
-open Tacticals
+open EConstr
 open Tacmach
 open Tactics
 open Clenv
@@ -27,10 +27,11 @@ open Typeclasses
 open Globnames
 open Evd
 open Locus
-open Misctypes
 open Proofview.Notations
 open Hints
 
+module NamedDecl = Context.Named.Declaration
+
 (** Hint database named "typeclass_instances", now created directly in Auto *)
 
 (** Options handling *)
@@ -38,10 +39,6 @@ open Hints
 let typeclasses_debug = ref 0
 let typeclasses_depth = ref None
 
-let typeclasses_modulo_eta = ref false
-let set_typeclasses_modulo_eta d = (:=) typeclasses_modulo_eta d
-let get_typeclasses_modulo_eta () = !typeclasses_modulo_eta
-
 (** When this flag is enabled, the resolution of type classes tries to avoid
     useless introductions. This is no longer useful since we have eta, but is
     here for compatibility purposes. Another compatibility issues is that the
@@ -68,13 +65,6 @@ let set_typeclasses_filtered_unification d =
 let get_typeclasses_filtered_unification () =
   !typeclasses_filtered_unification
 
-(** [typeclasses_legacy_resolution] falls back to the 8.5 resolution algorithm,
-    instead of the 8.6 one which uses the native backtracking facilities of the
-    proof engine. *)
-let typeclasses_legacy_resolution = ref false
-let set_typeclasses_legacy_resolution d = (:=) typeclasses_legacy_resolution d
-let get_typeclasses_legacy_resolution () = !typeclasses_legacy_resolution
-
 let set_typeclasses_debug d = (:=) typeclasses_debug (if d then 1 else 0)
 let get_typeclasses_debug () = if !typeclasses_debug > 0 then true else false
 
@@ -91,17 +81,7 @@ open Goptions
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
-      optname  = "do typeclass search modulo eta conversion";
-      optkey   = ["Typeclasses";"Modulo";"Eta"];
-      optread  = get_typeclasses_modulo_eta;
-      optwrite = set_typeclasses_modulo_eta; }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "do typeclass search avoiding eta-expansions " ^
                    " in proof terms (expensive)";
       optkey   = ["Typeclasses";"Limit";"Intros"];
@@ -110,8 +90,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "during typeclass resolution, solve instances according to their dependency order";
       optkey   = ["Typeclasses";"Dependency";"Order"];
       optread  = get_typeclasses_dependency_order;
@@ -119,8 +98,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "use iterative deepening strategy";
       optkey   = ["Typeclasses";"Iterative";"Deepening"];
       optread  = get_typeclasses_iterative_deepening;
@@ -128,17 +106,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "compat";
-      optkey   = ["Typeclasses";"Legacy";"Resolution"];
-      optread  = get_typeclasses_legacy_resolution;
-      optwrite = set_typeclasses_legacy_resolution; }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "compat";
       optkey   = ["Typeclasses";"Filtered";"Unification"];
       optread  = get_typeclasses_filtered_unification;
@@ -146,8 +114,7 @@ let _ =
 
 let set_typeclasses_debug =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "debug output for typeclasses proof search";
       optkey   = ["Typeclasses";"Debug"];
       optread  = get_typeclasses_debug;
@@ -155,8 +122,7 @@ let set_typeclasses_debug =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "debug output for typeclasses proof search";
       optkey   = ["Debug";"Typeclasses"];
       optread  = get_typeclasses_debug;
@@ -164,8 +130,7 @@ let _ =
 
 let _ =
   declare_int_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "verbosity of debug output for typeclasses proof search";
       optkey   = ["Typeclasses";"Debug";"Verbosity"];
       optread  = get_typeclasses_verbose;
@@ -173,8 +138,7 @@ let _ =
 
 let set_typeclasses_depth =
   declare_int_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "depth for typeclasses proof search";
       optkey   = ["Typeclasses";"Depth"];
       optread  = get_typeclasses_depth;
@@ -187,8 +151,7 @@ let set_typeclasses_strategy = function
   | Bfs -> set_typeclasses_iterative_deepening true
 
 let pr_ev evs ev =
-  Printer.pr_constr_env (Goal.V82.env evs ev) evs
-                        (Evarutil.nf_evar evs (Goal.V82.concl evs ev))
+  Printer.pr_econstr_env (Goal.V82.env evs ev) evs (Goal.V82.concl evs ev)
 
 (** Typeclasses instance search tactic / eauto *)
 
@@ -207,7 +170,7 @@ let auto_core_unif_flags st freeze = {
   frozen_evars = freeze;
   restrict_conv_on_strict_subterms = false; (* ? *)
   modulo_betaiota = true;
-  modulo_eta = !typeclasses_modulo_eta;
+  modulo_eta = false;
 }
 
 let auto_unif_flags freeze st =
@@ -219,38 +182,48 @@ let auto_unif_flags freeze st =
     resolve_evars = false
 }
 
-let e_give_exact flags poly (c,clenv) gl =
+let e_give_exact flags poly (c,clenv) =
+  let open Tacmach.New in
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
   let (c, _, _) = c in
-  let c, gl =
+  let c, sigma =
     if poly then
       let clenv', subst = Clenv.refresh_undefined_univs clenv in
-      let evd = evars_reset_evd ~with_conv_pbs:true gl.sigma clenv'.evd in
+      let evd = evars_reset_evd ~with_conv_pbs:true sigma clenv'.evd in
       let c = Vars.subst_univs_level_constr subst c in
-        c, {gl with sigma = evd}
-    else c, gl
+        c, evd
+    else c, sigma
   in
-  let t1 = pf_unsafe_type_of gl c in
-  Proofview.V82.of_tactic (Clenvtac.unify ~flags t1 <*> exact_no_check c) gl
-
-let unify_e_resolve poly flags = { enter = begin fun gls (c,_,clenv) ->
+  let (sigma, t1) = Typing.type_of (pf_env gl) sigma c in
+  Proofview.Unsafe.tclEVARS sigma <*>
+  Clenvtac.unify ~flags t1 <*> exact_no_check c
+  end
+
+let clenv_unique_resolver_tac with_evars ~flags clenv' =
+  Proofview.Goal.enter begin fun gls ->
+    let resolve =
+      try Proofview.tclUNIT (clenv_unique_resolver ~flags clenv' gls)
+      with e -> Proofview.tclZERO e
+    in resolve >>= fun clenv' ->
+       Clenvtac.clenv_refine with_evars ~with_classes:false clenv'
+  end
+
+let unify_e_resolve poly flags = begin fun gls (c,_,clenv) ->
   let clenv', c = connect_hint_clenv poly c clenv gls in
-  let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags clenv') gls in
-    Clenvtac.clenv_refine true ~with_classes:false clenv'
-  end }
+  clenv_unique_resolver_tac true ~flags clenv' end
 
-let unify_resolve poly flags = { enter = begin fun gls (c,_,clenv) ->
+let unify_resolve poly flags = begin fun gls (c,_,clenv) ->
   let clenv', _ = connect_hint_clenv poly c clenv gls in
-  let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags clenv') gls in
-    Clenvtac.clenv_refine false ~with_classes:false clenv'
-  end }
+  clenv_unique_resolver_tac false ~flags clenv'
+  end
 
 (** Application of a lemma using [refine] instead of the old [w_unify] *)
 let unify_resolve_refine poly flags gls ((c, t, ctx),n,clenv) =
   let open Clenv in
   let env = Proofview.Goal.env gls in
   let concl = Proofview.Goal.concl gls in
-  Refine.refine ~unsafe:true { Sigma.run = fun sigma ->
-      let sigma = Sigma.to_evar_map sigma in
+  Refine.refine ~typecheck:false begin fun sigma ->
       let sigma, term, ty =
         if poly then
           let (subst, ctx) = Universes.fresh_universe_context_set_instance ctx in
@@ -262,11 +235,11 @@ let unify_resolve_refine poly flags gls ((c, t, ctx),n,clenv) =
           sigma, c, t
       in
       let sigma', cl = Clenv.make_evar_clause env sigma ?len:n ty in
-      let term = applistc term (List.map (fun x -> x.hole_evar) cl.cl_holes) in
+      let term = applist (term, List.map (fun x -> x.hole_evar) cl.cl_holes) in
       let sigma' =
         Evarconv.the_conv_x_leq env ~ts:flags.core_unify_flags.modulo_delta
                                 cl.cl_concl concl sigma'
-      in Sigma.here term (Sigma.Unsafe.of_evar_map sigma') }
+      in (sigma', term) end
 
 let unify_resolve_refine poly flags gl clenv =
   Proofview.tclORELSE
@@ -286,43 +259,42 @@ let clenv_of_prods poly nprods (c, clenv) gl =
   let (c, _, _) = c in
   if poly || Int.equal nprods 0 then Some (None, clenv)
   else
-    let ty = Retyping.get_type_of (Proofview.Goal.env gl)
-                                  (Sigma.to_evar_map (Proofview.Goal.sigma gl)) c in
-    let diff = nb_prod ty - nprods in
+    let sigma = Tacmach.New.project gl in
+    let ty = Retyping.get_type_of (Proofview.Goal.env gl) sigma c in
+    let diff = nb_prod sigma ty - nprods in
     if Pervasives.(>=) diff 0 then
       (* Was Some clenv... *)
       Some (Some diff,
-            Tacmach.New.of_old (fun gls -> mk_clenv_from_n gls (Some diff) (c,ty)) gl)
+            mk_clenv_from_n gl (Some diff) (c,ty))
     else None
 
 let with_prods nprods poly (c, clenv) f =
   if get_typeclasses_limit_intros () then
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       try match clenv_of_prods poly nprods (c, clenv) gl with
           | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses")
-          | Some (diff, clenv') -> f.enter gl (c, diff, clenv')
+          | Some (diff, clenv') -> f gl (c, diff, clenv')
       with e when CErrors.noncritical e ->
-        Tacticals.New.tclZEROMSG (CErrors.print e) end }
-  else Proofview.Goal.nf_enter
-         { enter = begin fun gl ->
-                   if Int.equal nprods 0 then f.enter gl (c, None, clenv)
-                   else Tacticals.New.tclZEROMSG (str"Not enough premisses") end }
+        Tacticals.New.tclZEROMSG (CErrors.print e) end
+  else Proofview.Goal.enter
+         begin fun gl ->
+         if Int.equal nprods 0 then f gl (c, None, clenv)
+         else Tacticals.New.tclZEROMSG (str"Not enough premisses") end
 
 let matches_pattern concl pat =
   let matches env sigma =
     match pat with
     | None -> Proofview.tclUNIT ()
     | Some pat ->
-       let sigma = Sigma.to_evar_map sigma in
        if Constr_matching.is_matching env sigma pat concl then
          Proofview.tclUNIT ()
        else
          Tacticals.New.tclZEROMSG (str "pattern does not match")
   in
-   Proofview.Goal.enter { enter = fun gl ->
+   Proofview.Goal.enter begin fun gl ->
      let env = Proofview.Goal.env gl in
      let sigma = Proofview.Goal.sigma gl in
-       matches env sigma }
+       matches env sigma end
 
 (** Semantics of type class resolution lemma application:
 
@@ -349,21 +321,21 @@ let shelve_dependencies gls =
      Feedback.msg_debug (str" shelving dependent subgoals: " ++ pr_gls sigma gls);
    shelve_goals gls)
 
-let hintmap_of hdc secvars concl =
+let hintmap_of sigma hdc secvars concl =
   match hdc with
-  | None -> fun db -> Hint_db.map_none secvars db
+  | None -> fun db -> Hint_db.map_none ~secvars db
   | Some hdc ->
      fun db ->
      if Hint_db.use_dn db then (* Using dnet *)
-       Hint_db.map_eauto secvars hdc concl db
-     else Hint_db.map_existential secvars hdc concl db
+       Hint_db.map_eauto sigma ~secvars hdc concl db
+     else Hint_db.map_existential sigma ~secvars hdc concl db
 
 (** Hack to properly solve dependent evars that are typeclasses *)
 let rec e_trivial_fail_db only_classes db_list local_db secvars =
   let open Tacticals.New in
   let open Tacmach.New in
   let trivial_fail =
-    Proofview.Goal.nf_enter { enter =
+    Proofview.Goal.enter
     begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
@@ -371,15 +343,15 @@ let rec e_trivial_fail_db only_classes db_list local_db secvars =
     let hintl = make_resolve_hyp env sigma d in
     let hints = Hint_db.add_list env sigma hintl local_db in
       e_trivial_fail_db only_classes db_list hints secvars
-      end }
+      end
   in
   let trivial_resolve =
-    Proofview.Goal.nf_enter { enter =
+    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}
+    end
   in
   let tacl =
     Eauto.registered_e_assumption ::
@@ -387,9 +359,9 @@ 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 = decompose_prod_assum concl in
+  let prods, concl = EConstr.decompose_prod_assum sigma concl in
   let nprods = List.length prods in
   let freeze =
     try
@@ -397,12 +369,12 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
       | Some (hd,_) when only_classes ->
          let cl = Typeclasses.class_info hd in
          if cl.cl_strict then
-           Evd.evars_of_term concl
+           Evarutil.undefined_evars_of_term sigma concl
          else Evar.Set.empty
       | _ -> Evar.Set.empty
     with e when CErrors.noncritical e -> Evar.Set.empty
   in
-  let hint_of_db = hintmap_of hdc secvars concl in
+  let hint_of_db = hintmap_of sigma hdc secvars concl in
   let hintl =
     List.map_append
       (fun db ->
@@ -418,31 +390,25 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
            if get_typeclasses_filtered_unification () then
              let tac =
                with_prods nprods poly (term,cl)
-                          ({ enter = fun gl clenv ->
+                          (fun gl clenv ->
                              matches_pattern concl p <*>
-                               unify_resolve_refine poly flags gl clenv})
+                               unify_resolve_refine poly flags gl clenv)
              in Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
            else
              let tac =
                with_prods nprods poly (term,cl) (unify_resolve poly flags) in
-             if get_typeclasses_legacy_resolution () then
-               Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
-             else
                Proofview.tclBIND (Proofview.with_shelf tac)
                   (fun (gls, ()) -> shelve_dependencies gls)
         | ERes_pf (term,cl) ->
            if get_typeclasses_filtered_unification () then
              let tac = (with_prods nprods poly (term,cl)
-                  ({ enter = fun gl clenv ->
+                  (fun gl clenv ->
                              matches_pattern concl p <*>
-                             unify_resolve_refine poly flags gl clenv})) in
+                             unify_resolve_refine poly flags gl clenv)) in
              Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
            else
              let tac =
                with_prods nprods poly (term,cl) (unify_e_resolve poly flags) in
-             if get_typeclasses_legacy_resolution () then
-               Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
-             else
                Proofview.tclBIND (Proofview.with_shelf tac)
                   (fun (gls, ()) -> shelve_dependencies gls)
         | Give_exact (c,clenv) ->
@@ -450,18 +416,17 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
              let tac =
                matches_pattern concl p <*>
                  Proofview.Goal.nf_enter
-                   { enter = fun gl -> unify_resolve_refine poly flags gl (c,None,clenv) } in
+                   (fun gl -> unify_resolve_refine poly flags gl (c,None,clenv)) in
              Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
            else
-             Proofview.V82.tactic (e_give_exact flags poly (c,clenv))
+             e_give_exact flags poly (c,clenv)
       | Res_pf_THEN_trivial_fail (term,cl) ->
          let fst = with_prods nprods poly (term,cl) (unify_e_resolve poly flags) in
          let snd = if complete then Tacticals.New.tclIDTAC
                    else e_trivial_fail_db only_classes db_list local_db secvars in
          Tacticals.New.tclTHEN fst snd
       | Unfold_nth c ->
-         let tac = Proofview.V82.of_tactic (unfold_in_concl [AllOccurrences,c]) in
-         Proofview.V82.tactic (tclWEAK_PROGRESS tac)
+         Proofview.tclPROGRESS (unfold_in_concl [AllOccurrences,c])
       | Extern tacast -> conclPattern concl p tacast
       in
       let tac = run_hint t tac in
@@ -469,24 +434,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 =
-  let hd = try Some (decompose_app_bound concl) with Bound -> None in
+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 hd = try Some (decompose_app_bound concl) with Bound -> None in
+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 =
@@ -496,17 +461,29 @@ let catchable = function
   | Refiner.FailError _ -> true
   | e -> Logic.catchable_exception e
 
-let pr_depth l = prlist_with_sep (fun () -> str ".") int (List.rev l)
+let pr_depth l = 
+  let rec fmt elts =
+    match elts with
+    | [] -> []
+    | [n] -> [string_of_int n]
+    | n1::n2::rest ->
+       (string_of_int n1 ^ "." ^ string_of_int n2) :: fmt rest
+  in
+  prlist_with_sep (fun () -> str "-") str (fmt (List.rev l))
 
 let is_Prop env sigma concl =
   let ty = Retyping.get_type_of env sigma concl in
-  match kind_of_term ty with
-  | Sort (Prop Null) -> true
+  match EConstr.kind sigma ty with
+  | Sort s ->
+    begin match ESorts.kind sigma s with
+    | Prop Null -> true
+    | _ -> false
+    end
   | _ -> false
 
-let is_unique env concl =
+let is_unique env sigma concl =
   try
-    let (cl,u), args = dest_class_app env concl in
+    let (cl,u), args = dest_class_app env sigma concl in
     cl.cl_unique
   with e when CErrors.noncritical e -> false
 
@@ -516,10 +493,10 @@ let top_sort evm undefs =
   let tosee = ref undefs in
   let rec visit ev evi =
     let evs = Evarutil.undefined_evars_of_evar_info evm evi in
+      tosee := Evar.Map.remove ev !tosee;
       Evar.Set.iter (fun ev ->
         if Evar.Map.mem ev !tosee then
           visit ev (Evar.Map.find ev !tosee)) evs;
-      tosee := Evar.Map.remove ev !tosee;
       l' := ev :: !l';
   in
     while not (Evar.Map.is_empty !tosee) do
@@ -546,18 +523,17 @@ let evars_to_goals p evm =
 
 (** Making local hints  *)
 let make_resolve_hyp env sigma st flags only_classes pri decl =
-  let open Context.Named.Declaration in
-  let id = get_id decl in
-  let cty = Evarutil.nf_evar sigma (get_type decl) in
+  let id = NamedDecl.get_id decl in
+  let cty = Evarutil.nf_evar sigma (NamedDecl.get_type decl) in
   let rec iscl env ty =
-    let ctx, ar = decompose_prod_assum ty in
-      match kind_of_term (fst (decompose_app ar)) with
+    let ctx, ar = decompose_prod_assum sigma ty in
+      match EConstr.kind sigma (fst (decompose_app sigma ar)) with
       | Const (c,_) -> is_class (ConstRef c)
       | Ind (i,_) -> is_class (IndRef i)
       | _ ->
-          let env' = Environ.push_rel_context ctx env in
-          let ty' = whd_all env' ar in
-               if not (Term.eq_constr ty' ar) then iscl env' ty'
+          let env' = push_rel_context ctx env in
+          let ty' = Reductionops.whd_all env' sigma ar in
+               if not (EConstr.eq_constr sigma ty' ar) then iscl env' ty'
                else false
   in
   let is_class = iscl env cty in
@@ -572,12 +548,12 @@ let make_resolve_hyp env sigma st flags only_classes pri decl =
              (fun (path,info,c) ->
 	      let info =
 		{ info with Vernacexpr.hint_pattern =
-			    Option.map (Constrintern.intern_constr_pattern env)
+                            Option.map (Constrintern.intern_constr_pattern env sigma)
 				       info.Vernacexpr.hint_pattern }
 	      in
 	      make_resolves env sigma ~name:(PathHints path)
-                  (true,false,Flags.is_verbose()) info false
-                 (IsConstr (c,Univ.ContextSet.empty)))
+                  (true,false,not !Flags.quiet) info false
+                 (IsConstr (EConstr.of_constr c,Univ.ContextSet.empty)))
                hints)
         else []
       in
@@ -593,10 +569,10 @@ let make_hints g st only_classes sign =
     List.fold_left
       (fun hints hyp ->
         let consider =
-          let open Context.Named.Declaration in
-          try let t = Global.lookup_named (get_id hyp) |> get_type in
+          not only_classes ||
+          try let t = hyp |> NamedDecl.get_id |> Global.lookup_named |> NamedDecl.get_type in
               (* Section variable, reindex only if the type changed *)
-              not (Term.eq_constr t (get_type hyp))
+              not (EConstr.eq_constr (project g) (EConstr.of_constr t) (NamedDecl.get_type hyp))
           with Not_found -> true
         in
         if consider then
@@ -607,370 +583,19 @@ let make_hints g st only_classes sign =
       ([]) sign
   in Hint_db.add_list (pf_env g) (project g) hintlist (Hint_db.empty st true)
 
-(** <= 8.5 resolution *)
-module V85 = struct
-
-  type autoinfo = { hints : hint_db; is_evar: existential_key option;
-                    only_classes: bool; unique : bool;
-                    auto_depth: int list; auto_last_tac: std_ppcmds Lazy.t;
-                    auto_path : global_reference option list;
-                    auto_cut : hints_path }
-  type autogoal = goal * autoinfo
-  type failure = NotApplicable | ReachedLimit
-  type 'ans fk = failure -> 'ans
-  type ('a,'ans) sk = 'a -> 'ans fk -> 'ans
-  type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
-
-  type auto_result = autogoal list sigma
-
-  type atac = auto_result tac
-
-  (* Some utility types to avoid the need of -rectypes *)
-
-  type 'a optionk =
-    | Nonek
-    | Somek of 'a * 'a optionk fk
-
-  type ('a,'b) optionk2 =
-    | Nonek2 of failure
-    | Somek2 of 'a * 'b * ('a,'b) optionk2 fk
-
-  let pf_filtered_hyps gls =
-    Goal.V82.hyps gls.Evd.sigma (sig_it gls)
-
-  let make_autogoal_hints =
-    let cache = ref (true, Environ.empty_named_context_val,
-                     Hint_db.empty full_transparent_state true)
-    in
-    fun only_classes ?(st=full_transparent_state) g ->
-    let sign = pf_filtered_hyps g in
-    let (onlyc, sign', cached_hints) = !cache in
-    if onlyc == only_classes &&
-         (sign == sign' || Environ.eq_named_context_val sign sign')
-         && Hint_db.transparent_state cached_hints == st
-    then
-      cached_hints
-    else
-      let hints = make_hints g st only_classes (Environ.named_context_of_val sign)
-      in
-      cache := (only_classes, sign, hints); hints
-
-  let lift_tactic tac (f : goal list sigma -> autoinfo -> autogoal list sigma) : 'a tac =
-    { skft = fun sk fk {it = gl,hints; sigma=s;} ->
-             let res = try Some (tac {it=gl; sigma=s;})
-                       with e when catchable e -> None in
-             match res with
-             | Some gls -> sk (f gls hints) fk
-             | None -> fk NotApplicable }
-
-  let intro_tac : atac =
-    let tac {it = gls; sigma = s} info =
-      let gls' =
-        List.map (fun g' ->
-            let env = Goal.V82.env s g' in
-            let context = Environ.named_context_of_val (Goal.V82.hyps s g') in
-            let hint = make_resolve_hyp env s (Hint_db.transparent_state info.hints)
-              (true,false,false) info.only_classes empty_hint_info (List.hd context) in
-            let ldb = Hint_db.add_list env s hint info.hints in
-            (g', { info with is_evar = None; hints = ldb;
-                             auto_last_tac = lazy (str"intro") })) gls
-      in {it = gls'; sigma = s;}
-    in
-    lift_tactic (Proofview.V82.of_tactic Tactics.intro) tac
-
-  let normevars_tac : atac =
-    { skft = fun sk fk {it = (gl, info); sigma = s;} ->
-             let gl', sigma' = Goal.V82.nf_evar s gl in
-             let info' = { info with auto_last_tac = lazy (str"normevars") } in
-             sk {it = [gl', info']; sigma = sigma';} fk }
-
-  let merge_failures x y =
-    match x, y with
-    | _, ReachedLimit
-      | ReachedLimit, _ -> ReachedLimit
-    | NotApplicable, NotApplicable -> NotApplicable
-
-  let or_tac (x : 'a tac) (y : 'a tac) : 'a tac =
-    { skft = fun sk fk gls -> x.skft sk
-      (fun f -> y.skft sk (fun f' -> fk (merge_failures f f')) gls) gls }
-
-  let or_else_tac (x : 'a tac) (y : failure -> 'a tac) : 'a tac =
-    { skft = fun sk fk gls -> x.skft sk
-      (fun f -> (y f).skft sk fk gls) gls }
-
-  let needs_backtrack env evd oev concl =
-    if Option.is_empty oev || is_Prop env evd concl then
-      occur_existential concl
-    else true
-
-  let hints_tac hints sk fk {it = gl,info; sigma = s} =
-    let env = Goal.V82.env s gl in
-    let concl = Goal.V82.concl s gl in
-    let tacgl = {it = gl; sigma = s;} in
-    let secvars = secvars_of_hyps (Environ.named_context_of_val (Goal.V82.hyps s gl)) in
-    let poss = e_possible_resolve hints info.hints secvars info.only_classes s concl in
-    let unique = is_unique env concl in
-    let rec aux i foundone = function
-      | (tac, _, extern, name, pp) :: tl ->
-         let derivs = path_derivate info.auto_cut name in
-         let res =
-           try
-             if path_matches derivs [] then None
-             else Some (Proofview.V82.of_tactic tac tacgl)
-           with e when catchable e -> None
-         in
-         (match res with
-          | None -> aux i foundone tl
-          | Some {it = gls; sigma = s';} ->
-             if !typeclasses_debug > 0 then
-               Feedback.msg_debug
-                 (pr_depth (i :: info.auto_depth) ++ str": " ++ Lazy.force pp
-                  ++ str" on" ++ spc () ++ pr_ev s gl);
-             let sgls =
-               evars_to_goals
-                 (fun evm ev evi ->
-                   if Typeclasses.is_resolvable evi && not (Evd.is_undefined s ev) &&
-                        (not info.only_classes || Typeclasses.is_class_evar evm evi)
-                   then Typeclasses.mark_unresolvable evi, true
-                   else evi, false) s'
-             in
-             let newgls, s' =
-               let gls' = List.map (fun g -> (None, g)) gls in
-               match sgls with
-               | None -> gls', s'
-               | Some (evgls, s') ->
-                  if not !typeclasses_dependency_order then
-                    (gls' @ List.map (fun (ev,_) -> (Some ev, ev)) (Evar.Map.bindings evgls), s')
-                  else
-                    (* Reorder with dependent subgoals. *)
-                    let evm = List.fold_left
-                                (fun acc g -> Evar.Map.add g (Evd.find_undefined s' g) acc) evgls gls in
-                    let gls = top_sort s' evm in
-                    (List.map (fun ev -> Some ev, ev) gls, s')
-             in
-             let reindex g =
-               let open Goal.V82 in
-               extern && not (Environ.eq_named_context_val
-                             (hyps s' g) (hyps s' gl))
-             in
-             let gl' j (evar, g) =
-               let hints' =
-                 if reindex g then
-                   make_autogoal_hints
-                     info.only_classes
-                     ~st:(Hint_db.transparent_state info.hints)
-                     {it = g; sigma = s';}
-                 else info.hints
-               in
-               { info with
-                 auto_depth = j :: i :: info.auto_depth;
-                 auto_last_tac = pp;
-                 is_evar = evar;
-                 hints = hints';
-                 auto_cut = derivs }
-             in
-             let gls' = List.map_i (fun i g -> snd g, gl' i g) 1 newgls in
-             let glsv = {it = gls'; sigma = s';} in
-             let fk' =
-               (fun e ->
-                 let do_backtrack =
-                   if unique then occur_existential concl
-                   else if info.unique then true
-                   else if List.is_empty gls' then
-                     needs_backtrack env s' info.is_evar concl
-                   else true
-                 in
-                 let e' = match foundone with None -> e
-                                            | Some e' -> merge_failures e e' in
-                 if !typeclasses_debug > 0 then
-                   Feedback.msg_debug
-                     ((if do_backtrack then str"Backtracking after "
-                       else str "Not backtracking after ")
-                      ++ Lazy.force pp);
-                 if do_backtrack then aux (succ i) (Some e') tl
-                 else fk e')
-             in
-             sk glsv fk')
-      | [] ->
-         if foundone == None && !typeclasses_debug > 0 then
-           Feedback.msg_debug
-             (pr_depth info.auto_depth ++ str": no match for " ++
-                Printer.pr_constr_env (Goal.V82.env s gl) s concl ++
-                spc () ++ str ", " ++ int (List.length poss) ++
-                str" possibilities");
-         match foundone with
-         | Some e -> fk e
-         | None -> fk NotApplicable
-    in aux 1 None poss
-
-  let hints_tac hints =
-  { skft = fun sk fk gls -> hints_tac hints sk fk gls }
-
-  let then_list (second : atac) (sk : (auto_result, 'a) sk) : (auto_result, 'a) sk =
-    let rec aux s (acc : autogoal list list) fk = function
-      | (gl,info) :: gls ->
-         Control.check_for_interrupt ();
-         (match info.is_evar with
-          | Some ev when Evd.is_defined s ev -> aux s acc fk gls
-          | _ ->
-             second.skft
-               (fun {it=gls';sigma=s'} fk' ->
-                 let fk'' =
-                   if not info.unique && List.is_empty gls' &&
-                        not (needs_backtrack (Goal.V82.env s gl) s
-                                           info.is_evar (Goal.V82.concl s gl))
-                   then fk
-                   else fk'
-                 in
-                 aux s' (gls'::acc) fk'' gls)
-               fk {it = (gl,info); sigma = s; })
-      | [] -> Somek2 (List.rev acc, s, fk)
-    in fun {it = gls; sigma = s; } fk ->
-       let rec aux' = function
-         | Nonek2 e -> fk e
-         | Somek2 (res, s', fk') ->
-            let goals' = List.concat res in
-            sk {it = goals'; sigma = s'; } (fun e -> aux' (fk' e))
-       in aux' (aux s [] (fun e -> Nonek2 e) gls)
-
-  let then_tac (first : atac) (second : atac) : atac =
-    { skft = fun sk fk -> first.skft (then_list second sk) fk }
-
-  let run_tac (t : 'a tac) (gl : autogoal sigma) : auto_result option =
-    t.skft (fun x _ -> Some x) (fun _ -> None) gl
-
-  type run_list_res = auto_result optionk
-
-  let run_list_tac (t : 'a tac) p goals (gl : autogoal list sigma) : run_list_res =
-    (then_list t (fun x fk -> Somek (x, fk)))
-      gl
-      (fun _ -> Nonek)
-
-  let fail_tac reason : atac =
-    { skft = fun sk fk _ -> fk reason }
-
-  let rec fix (t : 'a tac) : 'a tac =
-    then_tac t { skft = fun sk fk -> (fix t).skft sk fk }
-
-  let rec fix_limit limit (t : 'a tac) : 'a tac =
-    if Int.equal limit 0 then fail_tac ReachedLimit
-    else then_tac t { skft = fun sk fk -> (fix_limit (pred limit) t).skft sk fk }
-
-  let fix_iterative t =
-    let rec aux depth =
-      or_else_tac (fix_limit depth t)
-                  (function
-                   | NotApplicable as e -> fail_tac e
-                   | ReachedLimit -> aux (succ depth))
-    in aux 1
-
-  let fix_iterative_limit limit (t : 'a tac) : 'a tac =
-    let rec aux depth =
-      if Int.equal limit depth then fail_tac ReachedLimit
-      else or_tac (fix_limit depth t)
-                  { skft = fun sk fk -> (aux (succ depth)).skft sk fk }
-    in aux 1
-
-  let make_autogoal ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state)
-                    cut ev g =
-    let hints = make_autogoal_hints only_classes ~st g in
-    (g.it, { hints = hints ; is_evar = ev; unique = unique;
-             only_classes = only_classes; auto_depth = [];
-             auto_last_tac = lazy (str"none");
-             auto_path = []; auto_cut = cut })
-
-
-  let make_autogoals ?(only_classes=true) ?(unique=false)
-                     ?(st=full_transparent_state) hints gs evm' =
-    let cut = cut_of_hints hints in
-    let gl i g =
-      let (gl, auto) = make_autogoal ~only_classes ~unique
-                                     ~st cut (Some g) {it = g; sigma = evm'; } in
-      (gl, { auto with auto_depth = [i]})
-    in { it = List.map_i gl 1 gs; sigma = evm' }
-
-  let get_result r =
-    match r with
-    | Nonek -> None
-    | Somek (gls, fk) -> Some (gls.sigma,fk)
-
-  let run_on_evars ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state)
-                   p evm hints tac =
-    match evars_to_goals p evm with
-    | None -> None (* This happens only because there's no evar having p *)
-    | Some (goals, evm') ->
-       let goals =
-         if !typeclasses_dependency_order then
-           top_sort evm' goals
-         else List.map (fun (ev, _) -> ev) (Evar.Map.bindings goals)
-       in
-       let res = run_list_tac tac p goals
-           (make_autogoals ~only_classes ~unique ~st hints goals evm') in
-       match get_result res with
-       | None -> raise Not_found
-       | Some (evm', fk) ->
-          Some (evars_reset_evd ~with_conv_pbs:true ~with_univs:false evm' evm, fk)
-
-  let eauto_tac hints =
-    then_tac normevars_tac (or_tac (hints_tac hints) intro_tac)
-
-  let eauto_tac strategy depth hints =
-    match strategy with
-    | Bfs -> 
-       begin match depth with
-       | None -> fix_iterative (eauto_tac hints)
-       | Some depth -> fix_iterative_limit depth (eauto_tac hints) end
-    | Dfs ->
-       match depth with
-       | None -> fix (eauto_tac hints)
-       | Some depth -> fix_limit depth (eauto_tac hints)
-                                
-  let real_eauto ?depth strategy unique st hints p evd =
-    let res =
-      run_on_evars ~st ~unique p evd hints (eauto_tac strategy depth hints)
-    in
-    match res with
-    | None -> evd
-    | Some (evd', fk) ->
-       if unique then
-         (match get_result (fk NotApplicable) with
-          | Some (evd'', fk') -> error "Typeclass resolution gives multiple solutions"
-          | None -> evd')
-       else evd'
-
-  let resolve_all_evars_once debug depth unique p evd =
-    let db = searchtable_map typeclasses_db in
-    let strategy = if get_typeclasses_iterative_deepening () then Bfs else Dfs in
-    real_eauto ?depth strategy unique (Hint_db.transparent_state db) [db] p evd
-
-  let eauto85 ?(only_classes=true) ?st ?strategy depth hints g =
-    let strategy =
-      match strategy with
-      | None -> if get_typeclasses_iterative_deepening () then Bfs else Dfs
-      | Some s -> s
-    in
-    let gl = { it = make_autogoal ~only_classes ?st
-                                  (cut_of_hints hints) None g; sigma = project g; } in
-    match run_tac (eauto_tac strategy depth hints) gl with
-    | None -> raise Not_found
-    | Some {it = goals; sigma = s; } ->
-       {it = List.map fst goals; sigma = s;}
-
-end
-
-(** 8.6 resolution *)
 module Search = struct
   type autoinfo =
     { search_depth : int list;
-      last_tac : Pp.std_ppcmds Lazy.t;
+      last_tac : Pp.t Lazy.t;
       search_dep : bool;
       search_only_classes : bool;
       search_cut : hints_path;
       search_hints : hint_db; }
 
   (** Local hints *)
-  let autogoal_cache = ref (DirPath.empty, true, Context.Named.empty,
-                            Hint_db.empty full_transparent_state true)
+  let autogoal_cache = Summary.ref ~name:"autogoal_cache"
+      (DirPath.empty, true, Context.Named.empty,
+       Hint_db.empty full_transparent_state true)
 
   let make_autogoal_hints only_classes ?(st=full_transparent_state) g =
     let open Proofview in
@@ -978,9 +603,10 @@ module Search = struct
     let sign = Goal.hyps g in
     let (dir, onlyc, sign', cached_hints) = !autogoal_cache in
     let cwd = Lib.cwd () in
+    let eq c1 c2 = EConstr.eq_constr (project g) c1 c2 in
     if DirPath.equal cwd dir &&
          (onlyc == only_classes) &&
-           Context.Named.equal sign sign' &&
+           Context.Named.equal eq sign sign' &&
              Hint_db.transparent_state cached_hints == st
     then cached_hints
     else
@@ -999,9 +625,9 @@ module Search = struct
 
   (** In the proof engine failures are represented as exceptions *)
   exception ReachedLimitEx
-  exception NotApplicableEx
+  exception NoApplicableEx
 
-  (** ReachedLimitEx has priority over NotApplicableEx to handle
+  (** ReachedLimitEx has priority over NoApplicableEx to handle
       iterative deepening: it should fail when no hints are applicable,
       but go to a deeper depth otherwise. *)
   let merge_exceptions e e' =
@@ -1016,7 +642,7 @@ module Search = struct
       NOT backtrack. *)
   let needs_backtrack env evd unique concl =
     if unique || is_Prop env evd concl then
-      occur_existential concl
+      occur_existential evd concl
     else true
 
   let mark_unresolvables sigma goals =
@@ -1028,16 +654,15 @@ module Search = struct
       sigma goals
 
   let fail_if_nonclass info =
-    Proofview.Goal.enter { enter = fun gl ->
-      let gl = Proofview.Goal.assume gl in
-      let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+    Proofview.Goal.enter begin fun gl ->
+      let sigma = Proofview.Goal.sigma gl in
       if is_class_type sigma (Proofview.Goal.concl gl) then
         Proofview.tclUNIT ()
       else (if !typeclasses_debug > 1 then
               Feedback.msg_debug (pr_depth info.search_depth ++
                                     str": failure due to non-class subgoal " ++
                                     pr_ev sigma (Proofview.Goal.goal gl));
-            Proofview.tclZERO NotApplicableEx) }
+            Proofview.tclZERO NoApplicableEx) end
 
   (** The general hint application tactic.
       tac1 + tac2 .... The choice of OR or ORELSE is determined
@@ -1049,18 +674,17 @@ module Search = struct
     let env = Goal.env gl in
     let concl = Goal.concl gl in
     let sigma = Goal.sigma gl in
-    let s = Sigma.to_evar_map sigma in
-    let unique = not info.search_dep || is_unique env concl in
-    let backtrack = needs_backtrack env s unique concl in
+    let unique = not info.search_dep || is_unique env sigma concl in
+    let backtrack = needs_backtrack env sigma unique concl in
     if !typeclasses_debug > 0 then
       Feedback.msg_debug
         (pr_depth info.search_depth ++ str": looking for " ++
-           Printer.pr_constr_env (Goal.env gl) s concl ++
+           Printer.pr_econstr_env (Goal.env gl) sigma concl ++
            (if backtrack then str" with backtracking"
             else str" without backtracking"));
     let secvars = compute_secvars gl in
     let poss =
-      e_possible_resolve hints info.search_hints secvars info.search_only_classes s concl in
+      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
@@ -1073,32 +697,42 @@ module Search = struct
       let derivs = path_derivate info.search_cut name in
       let pr_error ie =
         if !typeclasses_debug > 1 then
-          let msg =
-            pr_depth (!idx :: info.search_depth) ++ str": " ++
+          let idx = if fst ie == NoApplicableEx then pred !idx else !idx in
+          let header =
+            pr_depth (idx :: info.search_depth) ++ str": " ++
               Lazy.force pp ++
               (if !foundone != true then
-                 str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl)
+                 str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal gl)
                else mt ())
           in
-          Feedback.msg_debug (msg ++ str " failed with " ++ CErrors.iprint ie)
+          let msg =
+            match fst ie with
+            | Pretype_errors.PretypeError (env, evd, Pretype_errors.CannotUnify (x,y,_)) ->
+               str"Cannot unify " ++ print_constr_env env evd x ++ str" and " ++
+                                           print_constr_env env evd y
+            | ReachedLimitEx -> str "Proof-search reached its limit."
+            | NoApplicableEx -> str "Proof-search failed."
+            | e -> CErrors.iprint ie
+          in
+          Feedback.msg_debug (header ++ str " failed with: " ++ msg)
         else ()
       in
-      let tac_of gls i j = Goal.nf_enter { enter = fun gl' ->
+      let tac_of gls i j = Goal.enter begin fun gl' ->
         let sigma' = Goal.sigma gl' in
-        let s' = Sigma.to_evar_map sigma' in
         let _concl = Goal.concl gl' in
         if !typeclasses_debug > 0 then
           Feedback.msg_debug
             (pr_depth (succ j :: i :: info.search_depth) ++ str" : " ++
-               pr_ev s' (Proofview.Goal.goal gl'));
+               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 (Goal.hyps gl') (Goal.hyps gl))
+          if b && not (Context.Named.equal eq (Goal.hyps gl') (Goal.hyps gl))
           then
             let st = Hint_db.transparent_state info.search_hints in
             make_autogoal_hints info.search_only_classes ~st gl'
           else info.search_hints
         in
-        let dep' = info.search_dep || Proofview.unifiable s' (Goal.goal gl') gls in
+        let 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;
@@ -1106,30 +740,31 @@ module Search = struct
             search_only_classes = info.search_only_classes;
             search_hints = hints';
             search_cut = derivs }
-        in kont info' }
+        in kont info' end
       in
       let rec result (shelf, ()) i k =
         foundone := true;
         Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+        let gls = CList.map Proofview.drop_state gls in
         let j = List.length gls in
         (if !typeclasses_debug > 0 then
            Feedback.msg_debug
              (pr_depth (i :: info.search_depth) ++ str": " ++ Lazy.force pp
-              ++ str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl)
+              ++ str" 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)));
         let res =
           if j = 0 then tclUNIT ()
           else tclDISPATCH
-                 (List.init j (fun j' -> (tac_of gls i (Option.default 0 k + j))))
+                 (List.init j (fun j' -> (tac_of gls i (Option.default 0 k + j'))))
         in
         let finish nestedshelf sigma =
           let filter ev =
             try
               let evi = Evd.find_undefined sigma ev in
               if info.search_only_classes then
-                Some (ev, not (is_class_type sigma (Evd.evar_concl evi)))
+                Some (ev, not (is_class_evar sigma evi))
               else Some (ev, true)
             with Not_found -> None
           in
@@ -1159,7 +794,7 @@ module Search = struct
               (if List.is_empty goals then tclUNIT ()
                else
 	         let sigma' = mark_unresolvables sigma goals in
-	         with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS goals) >>=
+                 with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS (CList.map Proofview.with_empty_state goals)) >>=
                       fun s -> result s i (Some (Option.default 0 k + j)))
           end
         in with_shelf res >>= fun (sh, ()) ->
@@ -1185,31 +820,29 @@ module Search = struct
          if !foundone == false && !typeclasses_debug > 0 then
            Feedback.msg_debug
              (pr_depth info.search_depth ++ str": no match for " ++
-                Printer.pr_constr_env (Goal.env gl) s concl ++
-                spc () ++ str ", " ++ int (List.length poss) ++
+                Printer.pr_econstr_env (Goal.env gl) sigma concl ++
+                str ", " ++ int (List.length poss) ++
                 str" possibilities");
          match e with
          | (ReachedLimitEx,ie) -> Proofview.tclZERO ~info:ie ReachedLimitEx
-         | (_,ie) -> Proofview.tclZERO ~info:ie NotApplicableEx
+         | (_,ie) -> Proofview.tclZERO ~info:ie NoApplicableEx
     in
-    if backtrack then aux (NotApplicableEx,Exninfo.null) poss
-    else tclONCE (aux (NotApplicableEx,Exninfo.null) poss)
+    if backtrack then aux (NoApplicableEx,Exninfo.null) poss
+    else tclONCE (aux (NoApplicableEx,Exninfo.null) poss)
 
   let hints_tac hints info kont : unit Proofview.tactic =
-    Proofview.Goal.nf_enter
-      { enter = fun gl -> hints_tac_gl hints info kont gl }
+    Proofview.Goal.enter
+      (fun gl -> hints_tac_gl hints info kont gl)
 
   let intro_tac info kont gl =
     let open Proofview in
-    let open Proofview.Notations in
     let env = Goal.env gl in
     let sigma = Goal.sigma gl in
-    let s = Sigma.to_evar_map sigma in
     let decl = Tacmach.New.pf_last_hyp gl in
     let hint =
-      make_resolve_hyp env s (Hint_db.transparent_state info.search_hints)
+      make_resolve_hyp env sigma (Hint_db.transparent_state info.search_hints)
                        (true,false,false) info.search_only_classes empty_hint_info decl in
-    let ldb = Hint_db.add_list env s hint info.search_hints in
+    let ldb = Hint_db.add_list env sigma hint info.search_hints in
     let info' =
       { info with search_hints = ldb; last_tac = lazy (str"intro");
         search_depth = 1 :: 1 :: info.search_depth }
@@ -1217,7 +850,7 @@ module Search = struct
 
   let intro info kont =
     Proofview.tclBIND Tactics.intro
-     (fun _ -> Proofview.Goal.nf_enter { enter = fun gl -> intro_tac info kont gl })
+     (fun _ -> Proofview.Goal.enter (fun gl -> intro_tac info kont gl))
 
   let rec search_tac hints limit depth =
     let kont info =
@@ -1239,7 +872,6 @@ module Search = struct
   let search_tac_gl ?st only_classes dep hints depth i sigma gls gl :
         unit Proofview.tactic =
     let open Proofview in
-    let open Proofview.Notations in
     if false (* In 8.6, still allow non-class goals only_classes && not (is_class_type sigma (Goal.concl gl)) *) then
       Tacticals.New.tclZEROMSG (str"Not a subgoal for a class")
     else
@@ -1250,11 +882,12 @@ module Search = struct
   let search_tac ?(st=full_transparent_state) only_classes dep hints depth =
     let open Proofview in
     let tac sigma gls i =
-      Goal.nf_enter
-        { enter = fun gl ->
-          search_tac_gl ~st only_classes dep hints depth (succ i) sigma gls gl }
+      Goal.enter
+        begin fun gl ->
+          search_tac_gl ~st only_classes dep hints depth (succ i) sigma gls gl end
     in
       Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+      let gls = CList.map Proofview.drop_state gls in
       Proofview.tclEVARMAP >>= fun sigma ->
       let j = List.length gls in
       (tclDISPATCH (List.init j (fun i -> tac sigma gls i)))
@@ -1299,7 +932,7 @@ module Search = struct
       match e with
       | ReachedLimitEx ->
          Tacticals.New.tclFAIL 0 (str"Proof search reached its limit")
-      | NotApplicableEx ->
+      | NoApplicableEx ->
          Tacticals.New.tclFAIL 0 (str"Proof search failed" ++
                                     (if Option.is_empty depth then mt()
                                      else str" without reaching its limit"))
@@ -1324,7 +957,7 @@ module Search = struct
                                             | Some i -> str ", with depth limit " ++ int i));
     tac
 
-  let run_on_evars p evm tac =
+  let run_on_evars env evm p tac =
     match evars_to_goals p evm with
     | None -> None (* This happens only because there's no evar having p *)
     | Some (goals, evm') ->
@@ -1333,14 +966,15 @@ module Search = struct
            top_sort evm' goals
          else List.map (fun (ev, _) -> ev) (Evar.Map.bindings goals)
        in
-       let fgoals = Evd.future_goals evm in
-       let pgoal = Evd.principal_future_goal evm in
+       let fgoals = Evd.save_future_goals evm in
        let _, pv = Proofview.init evm' [] in
        let pv = Proofview.unshelve goals pv in
        try
          let (), pv', (unsafe, shelved, gaveup), _ =
-           Proofview.apply (Global.env ()) tac pv
+           Proofview.apply env tac pv
          in
+         if not (List.is_empty gaveup) then
+           CErrors.anomaly (Pp.str "run_on_evars not assumed to apply tactics generating given up goals.");
          if Proofview.finished pv' then
            let evm' = Proofview.return pv' in
            assert(Evd.fold_undefined (fun ev _ acc ->
@@ -1350,28 +984,29 @@ module Search = struct
                           (str "leaking evar " ++ int (Evar.repr ev) ++
                              spc () ++ pr_ev evm' ev);
                       acc && okev) evm' true);
-           let evm' = Evd.restore_future_goals evm' (shelved @ fgoals) pgoal in
+           let fgoals = Evd.shelve_on_future_goals shelved fgoals in
+           let evm' = Evd.restore_future_goals evm' fgoals in
            let evm' = evars_reset_evd ~with_conv_pbs:true ~with_univs:false evm' evm in
            Some evm'
          else raise Not_found
        with Logic_monad.TacticFailure _ -> raise Not_found
 
-  let evars_eauto depth only_classes unique dep st hints p evd =
+  let evars_eauto env evd depth only_classes unique dep st hints p =
     let eauto_tac = eauto_tac ~st ~unique ~only_classes ~depth ~dep:(unique || dep) hints in
-    let res = run_on_evars p evd eauto_tac in
+    let res = run_on_evars env evd p eauto_tac in
     match res with
     | None -> evd
     | Some evd' -> evd'
 
-  let typeclasses_eauto ?depth unique st hints p evd =
-    evars_eauto depth true unique false st hints p evd
+  let typeclasses_eauto env evd ?depth unique st hints p =
+    evars_eauto env evd depth true unique false st hints p
   (** Typeclasses eauto is an eauto which tries to resolve only
       goals of typeclass type, and assumes that the initially selected
       evars in evd are independent of the rest of the evars *)
 
-  let typeclasses_resolve debug depth unique p evd =
+  let typeclasses_resolve env evd debug depth unique p =
     let db = searchtable_map typeclasses_db in
-    typeclasses_eauto ?depth unique (Hint_db.transparent_state db) [db] p evd
+    typeclasses_eauto env evd ?depth unique (Hint_db.transparent_state db) [db] p
 end
 
 (** Binding to either V85 or Search implementations. *)
@@ -1385,13 +1020,7 @@ let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state)
   in
   let st = match dbs with x :: _ -> Hint_db.transparent_state x | _ -> st in
   let depth = match depth with None -> get_typeclasses_depth () | Some l -> Some l in
-  if get_typeclasses_legacy_resolution () then
-    Proofview.V82.tactic
-    (fun gl ->
-      try V85.eauto85 depth ~only_classes ~st ?strategy dbs gl
-      with Not_found ->
-	Refiner.tclFAIL 0 (str"Proof search failed") gl)
-  else Search.eauto_tac ~st ~only_classes ?strategy ~depth ~dep:true dbs
+  Search.eauto_tac ~st ~only_classes ?strategy ~depth ~dep:true dbs
 
 (** We compute dependencies via a union-find algorithm.
     Beware of the imperative effects on the partition structure,
@@ -1401,23 +1030,25 @@ module Intpart = Unionfind.Make(Evar.Set)(Evar.Map)
 
 let deps_of_constraints cstrs evm p =
   List.iter (fun (_, _, x, y) ->
-    let evx = Evarutil.undefined_evars_of_term evm x in
-    let evy = Evarutil.undefined_evars_of_term evm y in
+    let evx = Evarutil.undefined_evars_of_term evm (EConstr.of_constr x) in
+    let evy = Evarutil.undefined_evars_of_term evm (EConstr.of_constr y) in
     Intpart.union_set (Evar.Set.union evx evy) p)
     cstrs
 
-let evar_dependencies evm p =
+let evar_dependencies pred evm p =
   Evd.fold_undefined
     (fun ev evi _ ->
-      let evars = Evar.Set.add ev (Evarutil.undefined_evars_of_evar_info evm evi)
-      in Intpart.union_set evars p)
+      if Typeclasses.is_resolvable evi && pred evm ev evi then
+        let evars = Evar.Set.add ev (Evarutil.undefined_evars_of_evar_info evm evi)
+        in Intpart.union_set evars p
+      else ())
     evm ()
 
 (** [split_evars] returns groups of undefined evars according to dependencies *)
 
-let split_evars evm =
+let split_evars pred evm =
   let p = Intpart.create () in
-  evar_dependencies evm p;
+  evar_dependencies pred evm p;
   deps_of_constraints (snd (extract_all_conv_pbs evm)) evm p;
   Intpart.partition p
 
@@ -1440,13 +1071,12 @@ let is_mandatory p comp evd =
 (** In case of unsatisfiable constraints, build a nice error message *)
 
 let error_unresolvable env comp evd =
-  let evd = Evarutil.nf_evar_map_undefined evd in
   let is_part ev = match comp with
   | None -> true
   | Some s -> Evar.Set.mem ev s
   in
   let fold ev evi (found, accu) =
-    let ev_class = class_of_constr evi.evar_concl in
+    let ev_class = class_of_constr evd (EConstr.of_constr evi.evar_concl) in
     if not (Option.is_empty ev_class) && is_part ev then
       (* focus on one instance if only one was searched for *)
       if not found then (true, Some ev)
@@ -1454,8 +1084,7 @@ let error_unresolvable env comp evd =
     else (found, accu)
    in
   let (_, ev) = Evd.fold_undefined fold evd (true, None) in
-    Pretype_errors.unsatisfiable_constraints
-      (Evarutil.nf_env_evar evd env) evd ev comp
+  Pretype_errors.unsatisfiable_constraints env evd ev comp
 
 (** Check if an evar is concerned by the current resolution attempt,
     (and in particular is in the current component), and also update
@@ -1502,7 +1131,7 @@ exception Unresolved
 (** If [do_split] is [true], we try to separate the problem in
     several components and then solve them separately *)
 let resolve_all_evars debug depth unique env p oevd do_split fail =
-  let split = if do_split then split_evars oevd else [Evar.Set.empty] in
+  let split = if do_split then split_evars p oevd else [Evar.Set.empty] in
   let in_comp comp ev = if do_split then Evar.Set.mem ev comp else true
   in
   let rec docomp evd = function
@@ -1510,12 +1139,7 @@ let resolve_all_evars debug depth unique env p oevd do_split fail =
     | comp :: comps ->
       let p = select_and_update_evars p oevd (in_comp comp) in
       try
-        let evd' =
-          if get_typeclasses_legacy_resolution () then
-            V85.resolve_all_evars_once debug depth unique p evd
-          else
-            Search.typeclasses_resolve debug depth unique p evd
-        in
+        let evd' = Search.typeclasses_resolve env evd debug depth unique p in
          if has_undefined p oevd evd' then raise Unresolved;
          docomp evd' comps
       with Unresolved | Not_found ->
@@ -1551,26 +1175,22 @@ 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 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
   let gls = { it = gl ; sigma = sigma; } in
   let hints = searchtable_map typeclasses_db in
   let st = Hint_db.transparent_state hints in
   let depth = get_typeclasses_depth () in
   let gls' =
-    if get_typeclasses_legacy_resolution () then
-      V85.eauto85 depth ~st [hints] gls
-    else
       try
         Proofview.V82.of_tactic
         (Search.eauto_tac ~st ~only_classes:true ~depth [hints] ~dep:true) gls
       with Refiner.FailError _ -> raise Not_found
   in
   let evd = sig_sig gls' in
-  let t' = let (ev, inst) = destEvar t in
-    mkEvar (ev, Array.of_list subst)
-  in
+  let t' = mkEvar (ev, Array.of_list subst) in
   let term = Evarutil.nf_evar evd t' in
     evd, term
 
@@ -1581,33 +1201,43 @@ let _ =
 (** Take the head of the arity of a constr.
     Used in the partial application tactic. *)
 
-let rec head_of_constr t =
-  let t = strip_outer_cast(collapse_appl t) in
-    match kind_of_term t with
-    | Prod (_,_,c2)  -> head_of_constr c2
-    | LetIn (_,_,_,c2) -> head_of_constr c2
-    | App (f,args)  -> head_of_constr f
+let rec head_of_constr sigma t =
+  let t = strip_outer_cast sigma (collapse_appl sigma t) in
+    match EConstr.kind sigma t with
+    | Prod (_,_,c2)  -> head_of_constr sigma c2
+    | LetIn (_,_,_,c2) -> head_of_constr sigma c2
+    | App (f,args)  -> head_of_constr sigma f
     | _      -> t
 
 let head_of_constr h c =
-  let c = head_of_constr c in
+  Proofview.tclEVARMAP >>= fun sigma ->
+  let c = head_of_constr sigma c in
   letin_tac None (Name h) c None Locusops.allHyps
 
 let not_evar c =
   Proofview.tclEVARMAP >>= fun sigma ->
-  match Evarutil.kind_of_term_upto sigma c with
+  match EConstr.kind sigma c with
   | Evar _ -> Tacticals.New.tclFAIL 0 (str"Evar")
   | _ -> Proofview.tclUNIT ()
 
-let is_ground c gl =
-  if Evarutil.is_ground_term (project gl) c then tclIDTAC gl
-  else tclFAIL 0 (str"Not ground") gl
+let is_ground c =
+  let open Tacticals.New in
+  Proofview.tclEVARMAP >>= fun sigma ->
+  if Evarutil.is_ground_term sigma c then tclIDTAC
+  else tclFAIL 0 (str"Not ground")
 
-let autoapply c i gl =
+let autoapply c i =
+  let open Proofview.Notations in
+  Proofview.Goal.enter begin fun gl ->
+  let hintdb = try Hints.searchtable_map i with Not_found ->
+    CErrors.user_err (Pp.str ("Unknown hint database " ^ i ^ "."))
+  in
   let flags = auto_unif_flags Evar.Set.empty
-    (Hints.Hint_db.transparent_state (Hints.searchtable_map i)) in
-  let cty = pf_unsafe_type_of gl c in
+    (Hints.Hint_db.transparent_state hintdb) in
+  let cty = Tacmach.New.pf_unsafe_type_of gl c in
   let ce = mk_clenv_from gl (c,cty) in
-  let tac = { enter = fun gl -> (unify_e_resolve false flags).enter gl
-    ((c,cty,Univ.ContextSet.empty),0,ce) } in
-  Proofview.V82.of_tactic (Proofview.Goal.nf_enter tac) gl
+    unify_e_resolve false flags gl
+                                 ((c,cty,Univ.ContextSet.empty),0,ce) <*>
+      Proofview.tclEVARMAP >>= (fun sigma ->
+      let sigma = Typeclasses.mark_unresolvables ~filter:Typeclasses.all_goals sigma in
+      Proofview.Unsafe.tclEVARS sigma) end
diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli
index 76760db0..9ba69a05 100644
--- a/tactics/class_tactics.mli
+++ b/tactics/class_tactics.mli
@@ -1,16 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This files implements typeclasses eauto *)
 
 open Names
-open Constr
-open Tacmach
+open EConstr
 
 val catchable : exn -> bool
 
@@ -28,13 +29,13 @@ val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> ?strategy
                         depth:(Int.t option) ->
                         Hints.hint_db_name list -> unit Proofview.tactic
 
-val head_of_constr : Id.t -> Term.constr -> unit Proofview.tactic
+val head_of_constr : Id.t -> constr -> unit Proofview.tactic
 
 val not_evar : constr -> unit Proofview.tactic
 
-val is_ground : constr -> tactic
+val is_ground : constr -> unit Proofview.tactic
 
-val autoapply : constr -> Hints.hint_db_name -> tactic
+val autoapply : constr -> Hints.hint_db_name -> unit Proofview.tactic
 
 module Search : sig
   val eauto_tac :
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 445a104d..c285f21e 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -1,82 +1,82 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Term
+open EConstr
 open Hipattern
 open Tactics
 open Coqlib
 open Reductionops
 open Misctypes
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* Absurd *)
 
-let mk_absurd_proof t =
+let mk_absurd_proof coq_not t =
   let id = Namegen.default_dependent_ident in
-  mkLambda (Names.Name id,mkApp(build_coq_not (),[|t|]),
+  mkLambda (Names.Name id,mkApp(coq_not,[|t|]),
     mkLambda (Names.Name id,t,mkApp (mkRel 2,[|mkRel 1|])))
 
 let absurd c =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
-    let sigma = Sigma.to_evar_map sigma in
     let j = Retyping.get_judgment_of env sigma c in
-    let sigma, j = Coercion.inh_coerce_to_sort Loc.ghost env sigma j in
+    let sigma, j = Coercion.inh_coerce_to_sort env sigma j in
     let t = j.Environ.utj_val in
-    let tac =
+    Proofview.Unsafe.tclEVARS sigma <*>
+    Tacticals.New.pf_constr_of_global (build_coq_not ()) >>= fun coqnot ->
+    Tacticals.New.pf_constr_of_global (build_coq_False ()) >>= fun coqfalse ->
     Tacticals.New.tclTHENLIST [
-      elim_type (build_coq_False ());
-      Simple.apply (mk_absurd_proof t)
-    ] in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+      elim_type coqfalse;
+      Simple.apply (mk_absurd_proof coqnot t)
+    ]
+  end
 
 let absurd c = absurd c
 
 (* Contradiction *)
 
-let use_negated_unit_or_eq_type () = Flags.version_strictly_greater Flags.V8_5
-
 (** [f] does not assume its argument to be [nf_evar]-ed. *)
 let filter_hyp f tac =
   let rec seek = function
     | [] -> Proofview.tclZERO Not_found
-    | d::rest when f (get_type d) -> tac (get_id d)
+    | d::rest when f (NamedDecl.get_type d) -> tac (NamedDecl.get_id d)
     | _::rest -> seek rest in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+  Proofview.Goal.enter begin fun gl ->
+    let hyps = Proofview.Goal.hyps gl in
     seek hyps
-  end }
+  end
 
 let contradiction_context =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     let rec seek_neg l = match l with
       | [] ->  Tacticals.New.tclZEROMSG (Pp.str"No such contradiction")
       | d :: rest ->
-          let id = get_id d in
-          let typ = nf_evar sigma (get_type d) in
+          let id = NamedDecl.get_id d in
+          let typ = nf_evar sigma (NamedDecl.get_type d) in
 	  let typ = whd_all env sigma typ in
-	  if is_empty_type typ then
+	  if is_empty_type sigma typ then
 	    simplest_elim (mkVar id)
-	  else match kind_of_term typ with
-	  | Prod (na,t,u) when is_empty_type u ->
-             let is_unit_or_eq =
-               if use_negated_unit_or_eq_type () then match_with_unit_or_eq_type t
-               else None in
+	  else match EConstr.kind sigma typ with
+	  | Prod (na,t,u) when is_empty_type sigma u ->
+             let is_unit_or_eq = match_with_unit_or_eq_type sigma t in
 	     Tacticals.New.tclORELSE
                (match is_unit_or_eq with
                | Some _ ->
-                   let hd,args = decompose_app t in
-                   let (ind,_ as indu) = destInd hd in
+                   let hd,args = decompose_app sigma t in
+                   let (ind,_ as indu) = destInd sigma hd in
                    let nparams = Inductiveops.inductive_nparams_env env ind in
                    let params = Util.List.firstn nparams args in
                    let p = applist ((mkConstructUi (indu,1)), params) in
@@ -85,36 +85,35 @@ let contradiction_context =
                | None ->
                  Tacticals.New.tclZEROMSG (Pp.str"Not a negated unit type."))
 	      (Proofview.tclORELSE
-                 (Proofview.Goal.enter { enter = begin fun gl ->
+                 (Proofview.Goal.enter begin fun gl ->
                    let is_conv_leq = Tacmach.New.pf_apply is_conv_leq gl in
 	           filter_hyp (fun typ -> is_conv_leq typ t)
 		     (fun id' -> simplest_elim (mkApp (mkVar id,[|mkVar id'|])))
-                 end })
+                 end)
                  begin function (e, info) -> match e with
 	           | Not_found -> seek_neg rest
                    | e -> Proofview.tclZERO ~info e
                  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 }
+  end
 
 let is_negation_of env sigma typ t =
-  match kind_of_term (whd_all env sigma t) with
+  match EConstr.kind sigma (whd_all env sigma t) with
     | Prod (na,t,u) ->
-      let u = nf_evar sigma u in
-      is_empty_type u && is_conv_leq env sigma typ t
+      is_empty_type sigma u && is_conv_leq env sigma typ t
     | _ -> false
 
 let contradiction_term (c,lbind as cl) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     let type_of = Tacmach.New.pf_unsafe_type_of gl in
     let typ = type_of c in
     let _, ccl = splay_prod env sigma typ in
-    if is_empty_type ccl then
+    if is_empty_type sigma ccl then
       Tacticals.New.tclTHEN
         (elim false None cl None)
         (Tacticals.New.tclTRY assumption)
@@ -122,7 +121,7 @@ let contradiction_term (c,lbind as cl) =
       Proofview.tclORELSE
         begin
           if lbind = NoBindings then
-            filter_hyp (is_negation_of env sigma typ)
+            filter_hyp (fun c -> is_negation_of env sigma typ c)
               (fun id -> simplest_elim (mkApp (mkVar id,[|c|])))
           else
             Proofview.tclZERO Not_found
@@ -131,7 +130,7 @@ let contradiction_term (c,lbind as cl) =
           | Not_found -> Tacticals.New.tclZEROMSG (Pp.str"Not a contradiction.")
           | e -> Proofview.tclZERO ~info e
         end
-  end }
+  end
 
 let contradiction = function
   | None -> Tacticals.New.tclTHEN intros contradiction_context
diff --git a/tactics/contradiction.mli b/tactics/contradiction.mli
index b876aee9..2b3a9475 100644
--- a/tactics/contradiction.mli
+++ b/tactics/contradiction.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open EConstr
 open Misctypes
 
 val absurd                      : constr -> unit Proofview.tactic
diff --git a/tactics/dnet.ml b/tactics/dnet.ml
index c501e306..17ff94ec 100644
--- a/tactics/dnet.ml
+++ b/tactics/dnet.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Generic dnet implementation over non-recursive types *)
diff --git a/tactics/dnet.mli b/tactics/dnet.mli
index 9f29c60b..647bbd6b 100644
--- a/tactics/dnet.mli
+++ b/tactics/dnet.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Generic discrimination net implementation over recursive
@@ -26,7 +28,7 @@
    distincts, or you'll get unexpected behaviours.
 
    Warning 2: This structure is perfect, i.e. the set of candidates
-   returned is equal to the set of solutions. Beware of DeBruijn
+   returned is equal to the set of solutions. Beware of de Bruijn
    shifts and sorts subtyping though (which makes the comparison not
    symmetric, see term_dnet.ml).
 
diff --git a/tactics/doc.tex b/tactics/doc.tex
deleted file mode 100644
index d44cc14a..00000000
--- a/tactics/doc.tex
+++ /dev/null
@@ -1,11 +0,0 @@
-
-\newpage
-\section*{The Tactics}
-
-\ocwsection \label{tactics}
-This chapter describes the \Coq\ main tactics.
-The modules of that chapter are organized as follows.
-
-\bigskip
-\begin{center}\epsfig{file=tactics.dep.ps,width=\linewidth}\end{center}
-
diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index 23ff5822..dc310c54 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -1,26 +1,29 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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
 open Genredexpr
-open Tacexpr
+open Tactypes
 open Locus
 open Locusops
 open Hints
@@ -29,26 +32,27 @@ open Proofview.Notations
 let eauto_unif_flags = auto_flags_of_state full_transparent_state
 
 let e_give_exact ?(flags=eauto_unif_flags) c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  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
-  if occur_existential t1 || occur_existential t2 then
+  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)
   else exact_check c
-  end }
+  end
 
 let assumption id = e_give_exact (mkVar id)
 
 let e_assumption =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     Tacticals.New.tclFIRST (List.map assumption (Tacmach.New.pf_ids_of_hyps gl))
-  end }
+  end
 
 let registered_e_assumption =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   Tacticals.New.tclFIRST (List.map (fun id -> e_give_exact (mkVar id))
               (Tacmach.New.pf_ids_of_hyps gl))
-  end }
+  end
 
 (************************************************************************)
 (*   PROLOG tactic                                                      *)
@@ -60,7 +64,7 @@ let registered_e_assumption =
 
 let first_goal gls =
   let gl = gls.Evd.it and sig_0 = gls.Evd.sigma in
-  if List.is_empty gl then error "first_goal";
+  if List.is_empty gl then user_err Pp.(str "first_goal");
   { Evd.it = List.hd gl; Evd.sigma = sig_0; }
 
 (* tactic -> tactic_list : Apply a tactic to the first goal in the list *)
@@ -71,7 +75,7 @@ let apply_tac_list tac glls =
   | (g1::rest) ->
       let gl = apply_sig_tac sigr tac g1 in
       repackage sigr (gl@rest)
-  | _ -> error "apply_tac_list"
+  | _ -> user_err Pp.(str "apply_tac_list")
 
 let one_step l gl =
   [Proofview.V82.of_tactic Tactics.intro]
@@ -80,25 +84,25 @@ let one_step l gl =
   @ (List.map (fun c -> Proofview.V82.of_tactic (assumption c)) (pf_ids_of_hyps gl))
 
 let rec prolog l n gl =
-  if n <= 0 then error "prolog - failure";
+  if n <= 0 then user_err Pp.(str "prolog - failure");
   let prol = (prolog l (n-1)) in
   (tclFIRST (List.map (fun t -> (tclTHEN t prol)) (one_step l gl))) gl
 
-let out_term = function
+let out_term env = function
   | IsConstr (c, _) -> c
-  | IsGlobRef gr -> fst (Universes.fresh_global_instance (Global.env ()) gr)
+  | IsGlobRef gr -> EConstr.of_constr (fst (Universes.fresh_global_instance env gr))
 
 let prolog_tac l n =
   Proofview.V82.tactic begin fun gl ->
   let map c =
-    let (c, sigma) = Tactics.run_delayed (pf_env gl) (project gl) c in
+    let (sigma, c) = c (pf_env gl) (project gl) in
     let c = pf_apply (prepare_hint false (false,true)) gl (sigma, c) in
-    out_term c
+    out_term (pf_env gl) c
   in
   let l = List.map map l in
   try (prolog l n gl)
-  with UserError ("Refiner.tclFIRST",_) ->
-    errorlabstrm "Prolog.prolog" (str "Prolog failed.")
+  with UserError (Some "Refiner.tclFIRST",_) ->
+    user_err ~hdr:"Prolog.prolog" (str "Prolog failed.")
   end
 
 open Auto
@@ -110,50 +114,49 @@ open Auto
 let priority l = List.map snd (List.filter (fun (pr,_) -> Int.equal pr 0) l)
 
 let unify_e_resolve poly flags (c,clenv) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
       let clenv', c = connect_hint_clenv poly c clenv gl in
-      Proofview.V82.tactic
-	(fun gls ->
-	 let clenv' = clenv_unique_resolver ~flags clenv' gls in
-	 tclTHEN (Refiner.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
-		 (Proofview.V82.of_tactic (Tactics.Simple.eapply c)) gls)
-    end }
-
-let hintmap_of secvars hdc concl =
+      let clenv' = clenv_unique_resolver ~flags clenv' gl in
+      Proofview.tclTHEN
+        (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
+        (Tactics.Simple.eapply c)
+    end
+
+let hintmap_of sigma secvars hdc concl =
   match hdc with
   | None -> fun db -> Hint_db.map_none ~secvars db
   | Some hdc ->
-     if occur_existential concl then
-       (fun db -> Hint_db.map_existential ~secvars hdc concl db)
-     else (fun db -> Hint_db.map_auto ~secvars hdc concl db)
+     if occur_existential sigma concl then
+       (fun db -> Hint_db.map_existential sigma ~secvars hdc concl db)
+     else (fun db -> Hint_db.map_auto sigma ~secvars hdc concl db)
    (* FIXME: should be (Hint_db.map_eauto hdc concl db) *)
 
 let e_exact poly flags (c,clenv) =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let clenv', c = connect_hint_clenv poly c clenv gl in
     Tacticals.New.tclTHEN
     (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
     (e_give_exact c)
-  end }
+  end
 
 let rec e_trivial_fail_db db_list local_db =
-  let next = Proofview.Goal.nf_enter { enter = begin fun gl ->
+  let next = Proofview.Goal.enter begin fun gl ->
     let d = Tacmach.New.pf_last_hyp gl in
     let hintl = make_resolve_hyp (Tacmach.New.pf_env gl) (Tacmach.New.project gl) d in
     e_trivial_fail_db db_list (Hint_db.add_list (Tacmach.New.pf_env gl) (Tacmach.New.project gl) hintl local_db)
-  end } in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  end in
+  Proofview.Goal.enter begin fun gl ->
   let secvars = compute_secvars gl in
   let tacl =
     registered_e_assumption ::
     (Tacticals.New.tclTHEN Tactics.intro next) ::
-    (List.map fst (e_trivial_resolve db_list local_db secvars (Tacmach.New.pf_nf_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 }
+  end
 
-and e_my_find_search db_list local_db secvars hdc concl =
-  let hint_of_db = hintmap_of secvars hdc concl in
+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 ->
 	let flags = auto_flags_of_state (Hint_db.transparent_state db) in
@@ -177,19 +180,19 @@ and e_my_find_search 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 db_list local_db secvars gl =
-  let hd = try Some (decompose_app_bound gl) with Bound -> None in
-  try priority (e_my_find_search db_list local_db secvars hd 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 env sigma db_list local_db secvars hd gl)
   with Not_found -> []
 
-let e_possible_resolve db_list local_db secvars gl =
-  let hd = try Some (decompose_app_bound gl) with Bound -> None in
+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 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 =
@@ -202,11 +205,11 @@ type search_state = {
   priority : int;
   depth : int; (*r depth of search before failing *)
   tacres : goal list sigma;
-  last_tactic : std_ppcmds Lazy.t;
+  last_tactic : Pp.t Lazy.t;
   dblist : hint_db list;
   localdb :  hint_db list;
   prev : prev_search_state;
-  local_lemmas : Tacexpr.delayed_open_constr list;
+  local_lemmas : delayed_open_constr list;
 }
 
 and prev_search_state = (* for info eauto *)
@@ -260,7 +263,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
@@ -287,9 +290,9 @@ module SearchProblem = struct
       in
       let rec_tacs =
 	let l =
-          let concl = Reductionops.nf_evar (project g)(pf_concl g) in
+          let concl = Reductionops.nf_evar (project g) (pf_concl g) in
 	  filter_tactics s.tacres
-                         (e_possible_resolve s.dblist (List.hd s.localdb) secvars concl)
+                         (e_possible_resolve (pf_env g) (project g) s.dblist (List.hd s.localdb) secvars concl)
 	in
 	List.map
 	  (fun (lgls, cost, pp) ->
@@ -330,8 +333,7 @@ let global_info_eauto = ref false
 
 let _ =
   Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "Debug Eauto";
       Goptions.optkey   = ["Debug";"Eauto"];
       Goptions.optread  = (fun () -> !global_debug_eauto);
@@ -339,8 +341,7 @@ let _ =
 
 let _ =
   Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "Info Eauto";
       Goptions.optkey   = ["Info";"Eauto"];
       Goptions.optread  = (fun () -> !global_info_eauto);
@@ -403,10 +404,10 @@ let e_search_auto debug (in_depth,p) lems db_list gl =
     s.tacres
   with Not_found ->
     pr_info_nop d;
-    error "eauto: search failed"
+    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)
@@ -436,11 +437,11 @@ let cons a l = a :: l
 let autounfolds db occs cls gl =
   let unfolds = List.concat (List.map (fun dbname -> 
     let db = try searchtable_map dbname 
-      with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
+      with Not_found -> user_err ~hdr:"autounfold" (str "Unknown database " ++ str dbname)
     in
     let (ids, csts) = Hint_db.unfolds db in
     let hyps = pf_ids_of_hyps gl in
-    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
@@ -464,18 +465,19 @@ let autounfold_tac db cls =
   in
   autounfold dbs cls
 
-let unfold_head env (ids, csts) c = 
+let unfold_head env sigma (ids, csts) c =
   let rec aux c = 
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Var id when Id.Set.mem id ids ->
 	(match Environ.named_body id env with
-	| Some b -> true, b
+	| Some b -> true, EConstr.of_constr b
 	| None -> false, c)
-    | Const (cst,u as c) when Cset.mem cst csts ->
-	true, Environ.constant_value_in env c
+    | Const (cst, u) when Cset.mem cst csts ->
+        let u = EInstance.kind sigma u in
+	true, EConstr.of_constr (Environ.constant_value_in env (cst, u))
     | App (f, args) ->
 	(match aux f with
-	| true, f' -> true, Reductionops.whd_betaiota Evd.empty (mkApp (f', args))
+	| true, f' -> true, Reductionops.whd_betaiota sigma (mkApp (f', args))
 	| false, _ -> 
 	    let done_, args' = 
 	      Array.fold_left_i (fun i (done_, acc) arg -> 
@@ -489,7 +491,7 @@ let unfold_head env (ids, csts) c =
 	      else false, c)
     | _ -> 
 	let done_ = ref false in
-	let c' = map_constr (fun c -> 
+	let c' = EConstr.map sigma (fun c -> 
 	  if !done_ then c else 
 	    let x, c' = aux c in
 	      done_ := x; c') c
@@ -497,18 +499,19 @@ let unfold_head env (ids, csts) c =
   in aux c
 
 let autounfold_one db cl =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
+  let sigma = Tacmach.New.project gl in
   let concl = Proofview.Goal.concl gl in
   let st =
     List.fold_left (fun (i,c) dbname -> 
       let db = try searchtable_map dbname 
-	with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
+	with Not_found -> user_err ~hdr:"autounfold" (str "Unknown database " ++ str dbname)
       in
       let (ids, csts) = Hint_db.unfolds db in
 	(Id.Set.union ids i, Cset.union csts c)) (Id.Set.empty, Cset.empty) db
   in
-  let did, c' = unfold_head env st 
+  let did, c' = unfold_head env sigma st 
     (match cl with Some (id, _) -> Tacmach.New.pf_get_hyp_typ id gl | None -> concl) 
   in
     if did then
@@ -516,4 +519,4 @@ let autounfold_one db cl =
       | Some hyp -> change_in_hyp None (make_change_arg c') hyp
       | None -> convert_concl_no_check c' DEFAULTcast
     else Tacticals.New.tclFAIL 0 (str "Nothing to unfold")
-  end }
+  end
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
index 8812093d..e161d888 100644
--- a/tactics/eauto.mli
+++ b/tactics/eauto.mli
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
-open Proof_type
+open EConstr
 open Hints
+open Tactypes
 
 val e_assumption : unit Proofview.tactic
 
@@ -16,15 +18,15 @@ val registered_e_assumption : unit Proofview.tactic
 
 val e_give_exact : ?flags:Unification.unify_flags -> constr -> unit Proofview.tactic
 
-val prolog_tac : Tacexpr.delayed_open_constr list -> int -> unit Proofview.tactic
+val prolog_tac : delayed_open_constr list -> int -> unit Proofview.tactic
 
-val gen_eauto : ?debug:Tacexpr.debug -> bool * int -> Tacexpr.delayed_open_constr list ->
+val gen_eauto : ?debug:debug -> bool * int -> delayed_open_constr list ->
   hint_db_name list option -> unit Proofview.tactic
 
 val eauto_with_bases :
-  ?debug:Tacexpr.debug ->
+  ?debug:debug ->
   bool * int ->
-  Tacexpr.delayed_open_constr list -> hint_db list -> Proof_type.tactic
+  delayed_open_constr list -> hint_db list -> Proof_type.tactic
 
 val autounfold : hint_db_name list -> Locus.clause -> unit Proofview.tactic
 val autounfold_tac : hint_db_name list option -> Locus.clause -> unit Proofview.tactic
diff --git a/tactics/elim.ml b/tactics/elim.ml
index f2b9eec4..003b069b 100644
--- a/tactics/elim.ml
+++ b/tactics/elim.ml
@@ -1,22 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
 open Names
-open Term
 open Termops
+open EConstr
 open Inductiveops
 open Hipattern
 open Tacmach.New
 open Tacticals.New
 open Tactics
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* Supposed to be called without as clause *)
 let introElimAssumsThen tac ba =
@@ -76,16 +79,17 @@ let tmphyp_name = Id.of_string "_TmpHyp"
 let up_to_delta = ref false (* true *)
 
 let general_decompose recognizer c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let type_of = pf_unsafe_type_of gl in
+  let sigma = project gl in
   let typc = type_of c in
   tclTHENS (cut typc)
     [ tclTHEN (intro_using tmphyp_name)
          (onLastHypId
-	    (ifOnHyp recognizer (general_decompose_aux recognizer)
+	    (ifOnHyp (recognizer sigma) (general_decompose_aux (recognizer sigma))
 	      (fun id -> clear [id])));
        exact_no_check c ]
-  end }
+  end
 
 let head_in indl t gl =
   let env = Proofview.Goal.env gl in
@@ -94,24 +98,24 @@ let head_in indl t gl =
     let ity,_ =
       if !up_to_delta
       then find_mrectype env sigma t
-      else extract_mrectype t
+      else extract_mrectype sigma t
     in List.exists (fun i -> eq_ind (fst i) (fst ity)) indl
   with Not_found -> false
 
 let decompose_these c l =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let indl = List.map (fun x -> x, Univ.Instance.empty) l in
-  general_decompose (fun (_,t) -> head_in indl t gl) c
-  end }
+  general_decompose (fun sigma (_,t) -> head_in indl t gl) c
+  end
 
 let decompose_and c =
   general_decompose
-    (fun (_,t) -> is_record t)
+    (fun sigma (_,t) -> is_record sigma t)
     c
 
 let decompose_or c =
   general_decompose
-    (fun (_,t) -> is_disjunction t)
+    (fun sigma (_,t) -> is_disjunction sigma t)
     c
 
 let h_decompose l c = decompose_these c l
@@ -130,16 +134,16 @@ let induction_trailer abs_i abs_j bargs =
     (tclDO (abs_j - abs_i) intro)
     (onLastHypId
        (fun id ->
-          Proofview.Goal.nf_enter { enter = begin fun gl ->
+          Proofview.Goal.enter begin fun gl ->
 	  let idty = pf_unsafe_type_of gl (mkVar id) in
-	  let fvty = global_vars (pf_env gl) idty in
+	  let fvty = global_vars (pf_env gl) (project gl) idty in
 	  let possible_bring_hyps =
 	    (List.tl (nLastDecls gl (abs_j - abs_i))) @ bargs.Tacticals.assums
           in
 	  let (hyps,_) =
             List.fold_left
 	      (fun (bring_ids,leave_ids) d ->
-                 let cid = get_id d in
+                 let cid = NamedDecl.get_id d in
                  if not (List.mem cid leave_ids)
                  then (d::bring_ids,leave_ids)
                  else (bring_ids,cid::leave_ids))
@@ -148,11 +152,11 @@ let induction_trailer abs_i abs_j bargs =
           let ids = List.rev (ids_of_named_context hyps) in
 	  (tclTHENLIST
             [revert ids; simple_elimination (mkVar id)])
-          end }
+          end
           ))
 
 let double_ind h1 h2 =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let abs_i = depth_of_quantified_hypothesis true h1 gl in
   let abs_j = depth_of_quantified_hypothesis true h2 gl in
   let abs =
@@ -165,7 +169,7 @@ let double_ind h1 h2 =
        	(fun id ->
            elimination_then
              (introElimAssumsThen (induction_trailer abs_i abs_j)) (mkVar id))))
-  end }
+  end
 
 let h_double_induction = double_ind
 
diff --git a/tactics/elim.mli b/tactics/elim.mli
index ae9cf85f..d6b67e5b 100644
--- a/tactics/elim.mli
+++ b/tactics/elim.mli
@@ -1,20 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Tacticals
 open Misctypes
+open Tactypes
 
 (** Eliminations tactics. *)
 
-val introCaseAssumsThen : Tacexpr.evars_flag ->
-  (Tacexpr.intro_patterns -> branch_assumptions -> unit Proofview.tactic) ->
+val introCaseAssumsThen : evars_flag ->
+  (intro_patterns -> branch_assumptions -> unit Proofview.tactic) ->
     branch_args -> unit Proofview.tactic
 
 val h_decompose       : inductive list -> constr -> unit Proofview.tactic
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 93073fdc..6bd4866c 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Hugo Herbelin from contents related to inductive schemes
@@ -13,12 +15,12 @@
 
 (* This file builds schemes related to case analysis and recursion schemes *)
 
-open Term
+open Sorts
+open Constr
 open Indrec
 open Declarations
 open Typeops
 open Ind_tables
-open Sigma.Notations
 
 (* Induction/recursion schemes *)
 
@@ -47,26 +49,15 @@ let optimize_non_type_induction_scheme kind dep sort _ ind =
     let sigma, nf = Evarutil.nf_evars_and_universes sigma in
       (nf c', Evd.evar_universe_context sigma), eff
   else
-    let mib,mip = Inductive.lookup_mind_specif env ind in
-    let ctx = Declareops.inductive_context mib in
-    let u = Univ.UContext.instance ctx in
-    let ctxset = Univ.ContextSet.of_context ctx in
-    let ectx = Evd.evar_universe_context_of ctxset in
-    let sigma = Evd.merge_universe_context sigma ectx in
-    let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in
+    let sigma, pind = Evd.fresh_inductive_instance env sigma ind in
+    let sigma, c = build_induction_scheme env sigma pind dep sort in
       (c, Evd.evar_universe_context sigma), Safe_typing.empty_private_constants
 
 let build_induction_scheme_in_type dep sort ind =
   let env = Global.env () in
   let sigma = Evd.from_env env in
-  let ctx = 
-    let mib,mip = Inductive.lookup_mind_specif env ind in
-      Declareops.inductive_context mib
-  in
-  let u = Univ.UContext.instance ctx in
-  let ctxset = Univ.ContextSet.of_context ctx in
-  let sigma = Evd.merge_universe_context sigma (Evd.evar_universe_context_of ctxset) in
-  let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in
+  let sigma, pind = Evd.fresh_inductive_instance env sigma ind in
+  let sigma, c = build_induction_scheme env sigma pind dep sort in
     c, Evd.evar_universe_context sigma
  
 let rect_scheme_kind_from_type =
@@ -81,38 +72,38 @@ let rect_dep_scheme_kind_from_type =
   declare_individual_scheme_object "_rect" ~aux:"_rect_from_type"
     (fun _ x -> build_induction_scheme_in_type true InType x, Safe_typing.empty_private_constants)
 
-let ind_scheme_kind_from_type =
-  declare_individual_scheme_object "_ind_nodep"
-  (optimize_non_type_induction_scheme rect_scheme_kind_from_type false InProp)
-
-let ind_scheme_kind_from_prop =
-  declare_individual_scheme_object "_ind" ~aux:"_ind_from_prop"
-  (optimize_non_type_induction_scheme rect_scheme_kind_from_prop false InProp)
-
-let ind_dep_scheme_kind_from_type =
-  declare_individual_scheme_object "_ind" ~aux:"_ind_from_type"
-  (optimize_non_type_induction_scheme rect_dep_scheme_kind_from_type true InProp)
+let rec_scheme_kind_from_type =
+  declare_individual_scheme_object "_rec_nodep" ~aux:"_rec_nodep_from_type"
+  (optimize_non_type_induction_scheme rect_scheme_kind_from_type false InSet)
 
 let rec_scheme_kind_from_prop =
   declare_individual_scheme_object "_rec" ~aux:"_rec_from_prop"
   (optimize_non_type_induction_scheme rect_scheme_kind_from_prop false InSet)
 
-let rec_scheme_kind_from_type =
-  declare_individual_scheme_object "_rec_nodep" ~aux:"_rec_nodep_from_type"
-  (optimize_non_type_induction_scheme rect_scheme_kind_from_type false InSet)
-
 let rec_dep_scheme_kind_from_type =
   declare_individual_scheme_object "_rec" ~aux:"_rec_from_type"
   (optimize_non_type_induction_scheme rect_dep_scheme_kind_from_type true InSet)
 
+let ind_scheme_kind_from_type =
+  declare_individual_scheme_object "_ind_nodep"
+  (optimize_non_type_induction_scheme rec_scheme_kind_from_type false InProp)
+
+let ind_dep_scheme_kind_from_type =
+  declare_individual_scheme_object "_ind" ~aux:"_ind_from_type"
+  (optimize_non_type_induction_scheme rec_dep_scheme_kind_from_type true InProp)
+
+let ind_scheme_kind_from_prop =
+  declare_individual_scheme_object "_ind" ~aux:"_ind_from_prop"
+  (optimize_non_type_induction_scheme rec_scheme_kind_from_prop false InProp)
+
 (* Case analysis *)
 
 let build_case_analysis_scheme_in_type dep sort ind =
   let env = Global.env () in
-  let sigma = Sigma.Unsafe.of_evar_map (Evd.from_env env) in
-  let Sigma (indu, sigma, _) = Sigma.fresh_inductive_instance env sigma ind in
-  let Sigma (c, sigma, _) = build_case_analysis_scheme env sigma indu dep sort in
-    c, Evd.evar_universe_context (Sigma.to_evar_map sigma)
+  let sigma = Evd.from_env env in
+  let (sigma, indu) = Evd.fresh_inductive_instance env sigma ind in
+  let (sigma, c) = build_case_analysis_scheme env sigma indu dep sort in
+    c, Evd.evar_universe_context sigma
 
 let case_scheme_kind_from_type =
   declare_individual_scheme_object "_case_nodep"
diff --git a/tactics/elimschemes.mli b/tactics/elimschemes.mli
index 77f927f2..ece4124b 100644
--- a/tactics/elimschemes.mli
+++ b/tactics/elimschemes.mli
@@ -1,15 +1,25 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Ind_tables
 
 (** Induction/recursion schemes *)
 
+val optimize_non_type_induction_scheme : 
+  'a Ind_tables.scheme_kind ->
+  Indrec.dep_flag ->
+  Sorts.family ->
+  'b ->
+  Names.inductive ->
+  (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
 val rec_scheme_kind_from_prop : individual scheme_kind
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
index b1d3290a..b0deeed1 100644
--- a/tactics/eqdecide.ml
+++ b/tactics/eqdecide.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (************************************************************************)
@@ -16,6 +18,7 @@ open Util
 open Names
 open Namegen
 open Term
+open EConstr
 open Declarations
 open Tactics
 open Tacticals.New
@@ -23,7 +26,7 @@ open Auto
 open Constr_matching
 open Misctypes
 open Hipattern
-open Pretyping
+open Proofview.Notations
 open Tacmach.New
 open Coqlib
 
@@ -49,7 +52,9 @@ open Coqlib
    Eduardo Gimenez (30/3/98).
 *)
 
-let clear_last = (onLastHyp (fun c -> (clear [destVar c])))
+let clear_last =
+  Proofview.tclEVARMAP >>= fun sigma ->
+  (onLastHyp (fun c -> (clear [destVar sigma c])))
 
 let choose_eq eqonleft =
   if eqonleft then
@@ -62,18 +67,39 @@ let choose_noteq eqonleft =
   else
     left_with_bindings false Misctypes.NoBindings
 
-let mkBranches c1 c2 =
+(* A surgical generalize which selects the right occurrences by hand *)
+(* This prevents issues where c2 is also a subterm of c1 (see e.g. #5449) *)
+
+let generalize_right mk typ c1 c2 =
+  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 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|]))
+  end
+  end
+
+let mkBranches (eqonleft,mk,c1,c2,typ) =
   tclTHENLIST
-    [generalize [c2];
+    [generalize_right mk typ c1 c2;
      Simple.elim c1;
      intros;
      onLastHyp Simple.case;
      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 = { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma } in
-  let tac c = Equality.discr_tac false (Some (None, Tacexpr.ElimOnConstr c)) in
+  let c env sigma = (sigma, (mkVar id, NoBindings)) in
+  let tac c = Equality.discr_tac false (Some (None, ElimOnConstr c)) in
   Tacticals.New.tclDELAYEDWITHHOLES false c tac
 
 let solveNoteqBranch side =
@@ -83,12 +109,9 @@ let solveNoteqBranch side =
 
 (* Constructs the type {c1=c2}+{~c1=c2} *)
 
-let make_eq () =
-(*FIXME*) Universes.constr_of_global (Coqlib.build_coq_eq ())
-
-let mkDecideEqGoal eqonleft op rectype c1 c2 =
-  let equality    = mkApp(make_eq(), [|rectype; c1; c2|]) in
-  let disequality = mkApp(build_coq_not (), [|equality|]) in
+let mkDecideEqGoal eqonleft (op,eq,neg) rectype c1 c2 =
+  let equality    = mkApp(eq, [|rectype; c1; c2|]) in
+  let disequality = mkApp(neg, [|equality|]) in
   if eqonleft then mkApp(op, [|equality; disequality |])
   else mkApp(op, [|disequality; equality |])
 
@@ -98,13 +121,13 @@ let mkDecideEqGoal eqonleft op rectype c1 c2 =
 let idx = Id.of_string "x"
 let idy = Id.of_string "y"
 
-let mkGenDecideEqGoal rectype g =
-  let hypnames = pf_ids_of_hyps g in
+let mkGenDecideEqGoal rectype ops g =
+  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
      (mkNamedProd yname rectype
-        (mkDecideEqGoal true (build_coq_sumbool ())
+        (mkDecideEqGoal true ops
           rectype (mkVar xname) (mkVar yname))))
 
 let rec rewrite_and_clear hyps = match hyps with
@@ -120,8 +143,8 @@ let eqCase tac =
   tclTHEN intro (onLastHypId tac)
 
 let injHyp id =
-  let c = { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma } in
-  let tac c = Equality.injClause None false (Some (None, Tacexpr.ElimOnConstr c)) in
+  let c env sigma = (sigma, (mkVar id, NoBindings)) 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 =
@@ -138,15 +161,32 @@ let diseqCase hyps eqonleft =
 
 open Proofview.Notations
 
-(* spiwack: a small wrapper around [Hipattern]. *)
-
-let match_eqdec c =
-  try Proofview.tclUNIT (match_eqdec c)
+(* spiwack: a PatternMatchingFailure wrapper around [Hipattern]. *)
+
+let match_eqdec env sigma c =
+  try
+    let (eqonleft,_,c1,c2,ty) = match_eqdec env sigma c in
+    let (op,eq1,noteq,eq2) =
+      match EConstr.kind sigma c with
+      | App (op,[|ty1;ty2|]) ->
+         let ty1, ty2 = if eqonleft then ty1, ty2 else ty2, ty1 in
+         (match EConstr.kind sigma ty1, EConstr.kind sigma ty2 with
+         | App (eq1,_), App (noteq,[|neq|]) ->
+            (match EConstr.kind sigma neq with
+             | App (eq2,_) -> op,eq1,noteq,eq2
+             | _ -> assert false)
+         | _ -> assert false)
+      | _ -> assert false in
+    let mk t x y =
+      let eq = mkApp (eq1,[|t;x;y|]) in
+      let neq = mkApp (noteq,[|mkApp (eq2,[|t;x;y|])|]) in
+      if eqonleft then mkApp (op,[|eq;neq|]) else mkApp (op,[|neq;eq|]) in
+    Proofview.tclUNIT (eqonleft,mk,c1,c2,ty)
   with PatternMatchingFailure -> Proofview.tclZERO PatternMatchingFailure
 
 (* /spiwack *)
 
-let rec solveArg hyps eqonleft op largs rargs = match largs, rargs with
+let rec solveArg hyps eqonleft mk largs rargs = match largs, rargs with
 | [], [] ->
   tclTHENLIST [
     choose_eq eqonleft;
@@ -154,30 +194,33 @@ let rec solveArg hyps eqonleft op largs rargs = match largs, rargs with
     intros_reflexivity;
   ]
 | a1 :: largs, a2 :: rargs ->
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let rectype = pf_unsafe_type_of gl a1 in
-  let decide = mkDecideEqGoal eqonleft op rectype a1 a2 in
-  let tac hyp = solveArg (hyp :: hyps) eqonleft op largs rargs in
+  let decide = mk rectype a1 a2 in
+  let tac hyp = solveArg (hyp :: hyps) eqonleft mk largs rargs in
   let subtacs =
     if eqonleft then [eqCase tac;diseqCase hyps eqonleft;default_auto]
     else [diseqCase hyps eqonleft;eqCase tac;default_auto] in
   (tclTHENS (elim_type decide) subtacs)
-  end }
+  end
 | _ -> invalid_arg "List.fold_right2"
 
 let solveEqBranch rectype =
   Proofview.tclORELSE
     begin
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
-        match_eqdec concl >>= fun (eqonleft,op,lhs,rhs,_) ->
+      Proofview.Goal.enter begin fun gl ->
+        let concl = pf_concl gl in
+        let env = Proofview.Goal.env gl in
+        let sigma = project gl in
+        match_eqdec env sigma concl >>= fun (eqonleft,mk,lhs,rhs,_) ->
           let (mib,mip) = Global.lookup_inductive rectype in
           let nparams   = mib.mind_nparams in
-          let getargs l = List.skipn nparams (snd (decompose_app l)) in
+          let getargs l = List.skipn nparams (snd (decompose_app sigma l)) in
           let rargs   = getargs rhs
           and largs   = getargs lhs in
-          solveArg [] eqonleft op largs rargs
-      end }
+
+          solveArg [] eqonleft mk largs rargs
+      end
     end
     begin function (e, info) -> match e with
       | PatternMatchingFailure -> Tacticals.New.tclZEROMSG (Pp.str"Unexpected conclusion!")
@@ -186,25 +229,27 @@ let solveEqBranch rectype =
 
 (* The tactic Decide Equality *)
 
-let hd_app c = match kind_of_term c with
+let hd_app sigma c = match EConstr.kind sigma c with
   | App (h,_) -> h
   | _ -> c
 
 let decideGralEquality =
   Proofview.tclORELSE
     begin
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
-        match_eqdec concl >>= fun (eqonleft,_,c1,c2,typ) ->
-        let headtyp = hd_app (pf_compute gl typ) in
-        begin match kind_of_term headtyp with
+      Proofview.Goal.enter begin fun gl ->
+        let concl = pf_concl gl in
+        let env = Proofview.Goal.env gl in
+        let sigma = project gl in
+        match_eqdec env sigma concl >>= fun (eqonleft,mk,c1,c2,typ as data) ->
+        let headtyp = hd_app sigma (pf_compute gl typ) in
+        begin match EConstr.kind sigma headtyp with
         | Ind (mi,_) -> Proofview.tclUNIT mi
         | _ -> tclZEROMSG (Pp.str"This decision procedure only works for inductive objects.")
         end >>= fun rectype ->
           (tclTHEN
-             (mkBranches c1 c2)
+             (mkBranches data)
              (tclORELSE (solveNoteqBranch eqonleft) (solveEqBranch rectype)))
-      end }
+      end
     end
     begin function (e, info) -> match e with
       | PatternMatchingFailure ->
@@ -214,21 +259,25 @@ let decideGralEquality =
 
 let decideEqualityGoal = tclTHEN intros decideGralEquality
 
-let decideEquality rectype =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let decide = mkGenDecideEqGoal rectype gl in
+let decideEquality rectype ops =
+  Proofview.Goal.enter begin fun gl ->
+  let decide = mkGenDecideEqGoal rectype ops gl in
   (tclTHENS (cut decide) [default_auto;decideEqualityGoal])
-  end }
+  end
 
 
 (* The tactic Compare *)
 
 let compare c1 c2 =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  pf_constr_of_global (build_coq_sumbool ()) >>= fun opc ->
+  pf_constr_of_global (Coqlib.build_coq_eq ()) >>= fun eqc ->
+  pf_constr_of_global (build_coq_not ()) >>= fun notc ->
+  Proofview.Goal.enter begin fun gl ->
   let rectype = pf_unsafe_type_of gl c1 in
-  let decide = mkDecideEqGoal true (build_coq_sumbool ()) rectype c1 c2 in
+  let ops = (opc,eqc,notc) in
+  let decide = mkDecideEqGoal true ops rectype c1 c2 in
   (tclTHENS (cut decide)
             [(tclTHEN  intro
              (tclTHEN (onLastHyp simplest_case) clear_last));
-             decideEquality rectype])
-  end }
+             decideEquality rectype ops])
+  end
diff --git a/tactics/eqdecide.mli b/tactics/eqdecide.mli
index cb48a5bc..1e898d42 100644
--- a/tactics/eqdecide.mli
+++ b/tactics/eqdecide.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (************************************************************************)
@@ -14,4 +16,4 @@
 
 val decideEqualityGoal : unit Proofview.tactic
 
-val compare : Constr.t -> Constr.t -> unit Proofview.tactic
+val compare : EConstr.t -> EConstr.t -> unit Proofview.tactic
diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml
index 1a45217a..477de645 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File created by Hugo Herbelin, Nov 2009 *)
@@ -48,6 +50,7 @@ open CErrors
 open Util
 open Names
 open Term
+open Constr
 open Vars
 open Declarations
 open Environ
@@ -57,13 +60,14 @@ open Namegen
 open Inductiveops
 open Ind_tables
 open Indrec
-open Sigma.Notations
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 let hid = Id.of_string "H"
 let xid = Id.of_string "X"
 let default_id_of_sort = function InProp | InSet -> hid | InType -> xid
-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')
 
@@ -71,13 +75,27 @@ let build_dependent_inductive ind (mib,mip) =
   let realargs,_ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
   applist
     (mkIndU ind,
-       Context.Rel.to_extended_list mip.mind_nrealdecls mib.mind_params_ctxt
-       @ Context.Rel.to_extended_list 0 realargs)
+       Context.Rel.to_extended_list mkRel mip.mind_nrealdecls mib.mind_params_ctxt
+       @ Context.Rel.to_extended_list mkRel 0 realargs)
+
+let named_hd env t na = named_hd env Evd.empty (EConstr.of_constr t) na
+let name_assumption env = function
+| LocalAssum (na,t) -> LocalAssum (named_hd env t na, t)
+| LocalDef (na,c,t) -> LocalDef (named_hd env c na, c, t)
+
+let name_context env hyps =
+  snd
+    (List.fold_left
+       (fun (env,hyps) d ->
+	  let d' = name_assumption env d in (push_rel d' env, d' :: hyps))
+       (env,[]) (List.rev hyps))
 
 let my_it_mkLambda_or_LetIn s c = it_mkLambda_or_LetIn c s
-let my_it_mkProd_or_LetIn s c = it_mkProd_or_LetIn c s
+let my_it_mkProd_or_LetIn s c = Term.it_mkProd_or_LetIn c s
 let my_it_mkLambda_or_LetIn_name s c =
-  it_mkLambda_or_LetIn_name (Global.env()) c s
+  let env = Global.env () in
+  let mkLambda_or_LetIn_name d b = mkLambda_or_LetIn (name_assumption env d) b in
+  List.fold_left (fun c d -> mkLambda_or_LetIn_name d c) c s
 
 let get_coq_eq ctx =
   try
@@ -87,7 +105,13 @@ let get_coq_eq ctx =
       (Universes.fresh_inductive_instance (Global.env ()) eq) in
       mkIndU eq, mkConstructUi (eq,1), ctx
   with Not_found ->
-    error "eq not found."
+    user_err Pp.(str "eq not found.")
+
+let univ_of_eq env eq =
+  let eq = EConstr.of_constr eq in
+  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
 
 (**********************************************************************)
 (* Check if an inductive type [ind] has the form                      *)
@@ -98,6 +122,8 @@ let get_coq_eq ctx =
 (* in which case, a symmetry lemma is definable                       *)
 (**********************************************************************)
 
+let error msg = user_err Pp.(str msg)
+
 let get_sym_eq_data env (ind,u) =
   let (mib,mip as specif) = lookup_mind_specif env ind in
   if not (Int.equal (Array.length mib.mind_packets) 1) ||
@@ -118,7 +144,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 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)
@@ -170,7 +196,7 @@ let build_sym_scheme env ind =
   let (mib,mip as specif),nrealargs,realsign,paramsctxt,paramsctxt1 =
     get_sym_eq_data env indu in
   let cstr n =
-    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect n mib.mind_params_ctxt) in
+    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect mkRel n mib.mind_params_ctxt) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let applied_ind = build_dependent_inductive indu specif in
   let realsign_ind =
@@ -183,12 +209,12 @@ let build_sym_scheme env ind =
      my_it_mkLambda_or_LetIn_name
        (lift_rel_context (nrealargs+1) realsign_ind)
        (mkApp (mkIndU indu,Array.concat
-	  [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+	  [Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 	   rel_vect 1 nrealargs;
 	   rel_vect (2*nrealargs+2) nrealargs])),
      mkRel 1 (* varH *),
        [|cstr (nrealargs+1)|]))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 let sym_scheme_kind =
   declare_individual_scheme_object "_sym_internal"
@@ -224,13 +250,13 @@ let build_sym_involutive_scheme env ind =
     get_sym_eq_data env indu in
   let eq,eqrefl,ctx = get_coq_eq ctx in
   let sym, ctx, eff = const_of_scheme sym_scheme_kind env ind ctx in
-  let cstr n = mkApp (mkConstructUi (indu,1),Context.Rel.to_extended_vect n paramsctxt) in
+  let cstr n = mkApp (mkConstructUi (indu,1),Context.Rel.to_extended_vect mkRel n paramsctxt) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let applied_ind = build_dependent_inductive indu specif in
   let applied_ind_C =
     mkApp
       (mkIndU indu, Array.append
-         (Context.Rel.to_extended_vect (nrealargs+1) mib.mind_params_ctxt)
+         (Context.Rel.to_extended_vect mkRel (nrealargs+1) mib.mind_params_ctxt)
          (rel_vect (nrealargs+1) nrealargs)) in
   let realsign_ind =
     name_context env ((LocalAssum (Name varH,applied_ind))::realsign) in
@@ -244,22 +270,22 @@ let build_sym_involutive_scheme env ind =
 	       (mkApp (eq,[|
 	       mkApp
 	       (mkIndU indu, Array.concat
-	       [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+	       [Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 		rel_vect (2*nrealargs+2) nrealargs;
 		rel_vect 1 nrealargs]);
                mkApp (sym,Array.concat
-	       [Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+	       [Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 		rel_vect 1 nrealargs;
 		rel_vect (2*nrealargs+2) nrealargs;
 		[|mkApp (sym,Array.concat
-		[Context.Rel.to_extended_vect (3*nrealargs+2) paramsctxt1;
+		[Context.Rel.to_extended_vect mkRel (3*nrealargs+2) paramsctxt1;
 		 rel_vect (2*nrealargs+2) nrealargs;
 		 rel_vect 1 nrealargs;
 		 [|mkRel 1|]])|]]);
 	       mkRel 1|])),
 	       mkRel 1 (* varH *),
 	       [|mkApp(eqrefl,[|applied_ind_C;cstr (nrealargs+1)|])|]))))
-  in (c, Evd.evar_universe_context_of ctx), eff
+  in (c, UState.of_context_set ctx), eff
 
 let sym_involutive_scheme_kind =
   declare_individual_scheme_object "_sym_involutive"
@@ -335,7 +361,7 @@ let build_l2r_rew_scheme dep env ind kind =
   let eq,eqrefl,ctx = get_coq_eq ctx in
   let cstr n p =
     mkApp (mkConstructUi(indu,1),
-      Array.concat [Context.Rel.to_extended_vect n paramsctxt1;
+      Array.concat [Context.Rel.to_extended_vect mkRel n paramsctxt1;
                     rel_vect p nrealargs]) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let varHC = fresh env (Id.of_string "HC") in
@@ -343,12 +369,12 @@ let build_l2r_rew_scheme dep env ind kind =
   let applied_ind = build_dependent_inductive indu specif in
   let applied_ind_P =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (3*nrealargs) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (3*nrealargs) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect nrealargs nrealargs]) in
   let applied_ind_G =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (3*nrealargs+3) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (3*nrealargs+3) paramsctxt1;
         rel_vect (nrealargs+3) nrealargs;
         rel_vect 0 nrealargs]) in
   let realsign_P = lift_rel_context nrealargs realsign in
@@ -359,10 +385,10 @@ let build_l2r_rew_scheme dep env ind kind =
                       lift_rel_context (nrealargs+3) realsign) in
   let applied_sym_C n =
      mkApp(sym,
-       Array.append (Context.Rel.to_extended_vect n mip.mind_arity_ctxt) [|mkVar varH|]) in
+       Array.append (Context.Rel.to_extended_vect mkRel n mip.mind_arity_ctxt) [|mkVar varH|]) in
   let applied_sym_G =
      mkApp(sym,
-       Array.concat [Context.Rel.to_extended_vect (nrealargs*3+4) paramsctxt1;
+       Array.concat [Context.Rel.to_extended_vect mkRel (nrealargs*3+4) paramsctxt1;
                      rel_vect (nrealargs+4) nrealargs;
                      rel_vect 1 nrealargs;
 		     [|mkRel 1|]]) in
@@ -372,7 +398,7 @@ let build_l2r_rew_scheme dep env ind kind =
   let ci = make_case_info (Global.env()) ind RegularStyle in
   let cieq = make_case_info (Global.env()) (fst (destInd eq)) RegularStyle in
   let applied_PC =
-    mkApp (mkVar varP,Array.append (Context.Rel.to_extended_vect 1 realsign)
+    mkApp (mkVar varP,Array.append (Context.Rel.to_extended_vect mkRel 1 realsign)
            (if dep then [|cstr (2*nrealargs+1) 1|] else [||])) in
   let applied_PG =
     mkApp (mkVar varP,Array.append (rel_vect 1 nrealargs)
@@ -382,11 +408,11 @@ let build_l2r_rew_scheme dep env ind kind =
            (if dep then [|mkRel 2|] else [||])) in
   let applied_sym_sym =
          mkApp (sym,Array.concat
-	   [Context.Rel.to_extended_vect (2*nrealargs+4) paramsctxt1;
+	   [Context.Rel.to_extended_vect mkRel (2*nrealargs+4) paramsctxt1;
             rel_vect 4 nrealargs;
             rel_vect (nrealargs+4) nrealargs;
             [|mkApp (sym,Array.concat
-	      [Context.Rel.to_extended_vect (2*nrealargs+4) paramsctxt1;
+	      [Context.Rel.to_extended_vect mkRel (2*nrealargs+4) paramsctxt1;
 	       rel_vect (nrealargs+4) nrealargs;
 	       rel_vect 4 nrealargs;
 	       [|mkRel 2|]])|]]) in
@@ -409,11 +435,11 @@ let build_l2r_rew_scheme dep env ind kind =
                    mkApp (eq,[|lift 4 applied_ind;applied_sym_sym;mkRel 1|]),
                    applied_PR)),
        mkApp (sym_involutive,
-         Array.append (Context.Rel.to_extended_vect 3 mip.mind_arity_ctxt) [|mkVar varH|]),
+         Array.append (Context.Rel.to_extended_vect mkRel 3 mip.mind_arity_ctxt) [|mkVar varH|]),
        [|main_body|])
    else
      main_body))))))
-  in (c, Evd.evar_universe_context_of ctx),
+  in (c, UState.of_context_set ctx),
       Safe_typing.concat_private eff' eff
 
 (**********************************************************************)
@@ -448,7 +474,7 @@ let build_l2r_forward_rew_scheme dep env ind kind =
     get_sym_eq_data env indu in
   let cstr n p =
     mkApp (mkConstructUi(indu,1),
-      Array.concat [Context.Rel.to_extended_vect n paramsctxt1;
+      Array.concat [Context.Rel.to_extended_vect mkRel n paramsctxt1;
                     rel_vect p nrealargs]) in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let varHC = fresh env (Id.of_string "HC") in
@@ -456,12 +482,12 @@ let build_l2r_forward_rew_scheme dep env ind kind =
   let applied_ind = build_dependent_inductive indu specif in
   let applied_ind_P =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (4*nrealargs+2) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (4*nrealargs+2) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect (nrealargs+1) nrealargs]) in
   let applied_ind_P' =
     mkApp (mkIndU indu, Array.concat
-       [Context.Rel.to_extended_vect (3*nrealargs+1) paramsctxt1;
+       [Context.Rel.to_extended_vect mkRel (3*nrealargs+1) paramsctxt1;
         rel_vect 0 nrealargs;
         rel_vect (2*nrealargs+1) nrealargs]) in
   let realsign_P n = lift_rel_context (nrealargs*n+n) realsign in
@@ -502,7 +528,7 @@ let build_l2r_forward_rew_scheme dep env ind kind =
 	  (if dep then realsign_ind_P 1 applied_ind_P' else realsign_P 2) s)
       (mkNamedLambda varHC applied_PC'
 	(mkVar varHC))|])))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 (**********************************************************************)
 (* Build the right-to-left rewriting lemma for hypotheses associated  *)
@@ -539,7 +565,7 @@ let build_r2l_forward_rew_scheme dep env ind kind =
   let ((mib,mip as specif),constrargs,realsign,paramsctxt,nrealargs) =
     get_non_sym_eq_data env indu in
   let cstr n =
-    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect n mib.mind_params_ctxt) in
+    mkApp (mkConstructUi(indu,1),Context.Rel.to_extended_vect mkRel n mib.mind_params_ctxt) in
   let constrargs_cstr = constrargs@[cstr 0] in
   let varH = fresh env (default_id_of_sort (snd (mind_arity mip))) in
   let varHC = fresh env (Id.of_string "HC") in
@@ -555,8 +581,8 @@ let build_r2l_forward_rew_scheme dep env ind kind =
     applist (mkVar varP,if dep then constrargs_cstr else constrargs) in
   let applied_PG =
     mkApp (mkVar varP,
-           if dep then Context.Rel.to_extended_vect 0 realsign_ind
-	   else Context.Rel.to_extended_vect 1 realsign) in
+           if dep then Context.Rel.to_extended_vect mkRel 0 realsign_ind
+	   else Context.Rel.to_extended_vect mkRel 1 realsign) in
   let c = 
   (my_it_mkLambda_or_LetIn paramsctxt
   (my_it_mkLambda_or_LetIn_name realsign_ind
@@ -575,7 +601,7 @@ let build_r2l_forward_rew_scheme dep env ind kind =
 	   lift (nrealargs+3) applied_PC,
 	   mkRel 1)|]),
     [|mkVar varHC|]))))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 (**********************************************************************)
 (* This function "repairs" the non-dependent r2l forward rewriting    *)
@@ -594,20 +620,21 @@ let build_r2l_forward_rew_scheme dep env ind kind =
 (**********************************************************************)
 
 let fix_r2l_forward_rew_scheme (c, ctx') =
-  let t = Retyping.get_type_of (Global.env()) Evd.empty c in
+  let t = Retyping.get_type_of (Global.env()) Evd.empty (EConstr.of_constr c) in
+  let t = EConstr.Unsafe.to_constr t in
   let ctx,_ = decompose_prod_assum t in
   match ctx with
   | hp :: p :: ind :: indargs ->
      let c' = 
       my_it_mkLambda_or_LetIn indargs
-        (mkLambda_or_LetIn (map_constr (liftn (-1) 1) p)
-	  (mkLambda_or_LetIn (map_constr (liftn (-1) 2) hp)
-	    (mkLambda_or_LetIn (map_constr (lift 2) ind)
-	      (Reductionops.whd_beta Evd.empty
-		(applist (c,
-	          Context.Rel.to_extended_list 3 indargs @ [mkRel 1;mkRel 3;mkRel 2]))))))
+        (mkLambda_or_LetIn (RelDecl.map_constr (liftn (-1) 1) p)
+	  (mkLambda_or_LetIn (RelDecl.map_constr (liftn (-1) 2) hp)
+	    (mkLambda_or_LetIn (RelDecl.map_constr (lift 2) ind)
+	      (EConstr.Unsafe.to_constr (Reductionops.whd_beta Evd.empty
+		(EConstr.of_constr (applist (c,
+	          Context.Rel.to_extended_list mkRel 3 indargs @ [mkRel 1;mkRel 3;mkRel 2]))))))))
       in c', ctx'
-  | _ -> anomaly (Pp.str "Ill-formed non-dependent left-to-right rewriting scheme")
+  | _ -> anomaly (Pp.str "Ill-formed non-dependent left-to-right rewriting scheme.")
 
 (**********************************************************************)
 (* Build the right-to-left rewriting lemma for conclusion associated  *)
@@ -631,10 +658,10 @@ let fix_r2l_forward_rew_scheme (c, ctx') =
 (**********************************************************************)
  
 let build_r2l_rew_scheme dep env ind k =
-  let sigma = Sigma.Unsafe.of_evar_map (Evd.from_env env) in
-  let Sigma (indu, sigma, _) = Sigma.fresh_inductive_instance env sigma ind in
-  let Sigma (c, sigma, _) = build_case_analysis_scheme env sigma indu dep k in
-    c, Evd.evar_universe_context (Sigma.to_evar_map sigma)
+  let sigma = Evd.from_env env in
+  let (sigma, indu) = Evd.fresh_inductive_instance env sigma ind in
+  let (sigma, c) = build_case_analysis_scheme env sigma indu dep k in
+    c, Evd.evar_universe_context sigma
 
 let build_l2r_rew_scheme = build_l2r_rew_scheme
 let build_l2r_forward_rew_scheme = build_l2r_forward_rew_scheme
@@ -741,10 +768,10 @@ let build_congr env (eq,refl,ctx) ind =
   if List.exists is_local_def realsign then
     error "Inductive equalities with local definitions in arity not supported.";
   let env_with_arity = push_rel_context arityctxt env in
-  let ty = get_type (lookup_rel (mip.mind_nrealargs - i + 1) env_with_arity) in
+  let ty = RelDecl.get_type (lookup_rel (mip.mind_nrealargs - i + 1) env_with_arity) in
   let constrsign,ccl = decompose_prod_assum mip.mind_nf_lc.(0) in
   let _,constrargs = decompose_app ccl in
-  if Int.equal (Context.Rel.length constrsign) (Context.Rel.length mib.mind_params_ctxt) then
+  if not (Int.equal (Context.Rel.length constrsign) (Context.Rel.length mib.mind_params_ctxt)) then
     error "Constructor must have no arguments";
   let b = List.nth constrargs (i + mib.mind_nparams - 1) in
   let varB = fresh env (Id.of_string "B") in
@@ -752,6 +779,7 @@ let build_congr env (eq,refl,ctx) ind =
   let varf = fresh env (Id.of_string "f") in
   let ci = make_case_info (Global.env()) ind RegularStyle in
   let uni, ctx = Universes.extend_context (Universes.new_global_univ ()) ctx in
+  let ctx = (fst ctx, Univ.enforce_leq uni (univ_of_eq env eq) (snd ctx)) in
   let c = 
   my_it_mkLambda_or_LetIn paramsctxt
      (mkNamedLambda varB (mkSort (Type uni))
@@ -760,8 +788,8 @@ let build_congr env (eq,refl,ctx) ind =
      (mkNamedLambda varH
         (applist
            (mkIndU indu,
-	    Context.Rel.to_extended_list (mip.mind_nrealargs+2) paramsctxt @
-	    Context.Rel.to_extended_list 0 realsign))
+	    Context.Rel.to_extended_list mkRel (mip.mind_nrealargs+2) paramsctxt @
+	    Context.Rel.to_extended_list mkRel 0 realsign))
      (mkCase (ci,
        my_it_mkLambda_or_LetIn_name
 	 (lift_rel_context (mip.mind_nrealargs+3) realsign)
@@ -769,9 +797,9 @@ let build_congr env (eq,refl,ctx) ind =
            (Anonymous,
             applist
              (mkIndU indu,
-	        Context.Rel.to_extended_list (2*mip.mind_nrealdecls+3)
+	        Context.Rel.to_extended_list mkRel (2*mip.mind_nrealdecls+3)
 		  paramsctxt
-	        @ Context.Rel.to_extended_list 0 realsign),
+	        @ Context.Rel.to_extended_list mkRel 0 realsign),
             mkApp (eq,
 	      [|mkVar varB;
                 mkApp (mkVar varf, [|lift (2*mip.mind_nrealdecls+4) b|]);
@@ -780,7 +808,7 @@ let build_congr env (eq,refl,ctx) ind =
        [|mkApp (refl,
           [|mkVar varB;
 	    mkApp (mkVar varf, [|lift (mip.mind_nrealargs+3) b|])|])|]))))))
-  in c, Evd.evar_universe_context_of ctx
+  in c, UState.of_context_set ctx
 
 let congr_scheme_kind = declare_individual_scheme_object "_congr"
   (fun _ ind ->
diff --git a/tactics/eqschemes.mli b/tactics/eqschemes.mli
index aa8a6d4b..4749aebd 100644
--- a/tactics/eqschemes.mli
+++ b/tactics/eqschemes.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file builds schemes relative to equality inductive types *)
 
 open Names
-open Term
+open Constr
 open Environ
 open Ind_tables
 
@@ -22,14 +24,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 +45,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 bb3cbad9..5821717d 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -1,23 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+module CVars = Vars
 open Pp
 open CErrors
 open Util
 open Names
 open Nameops
 open Term
-open Vars
 open Termops
+open EConstr
+open Vars
 open Namegen
 open Inductive
 open Inductiveops
-open Environ
 open Libnames
 open Globnames
 open Reductionops
@@ -26,7 +29,6 @@ open Retyping
 open Tacmach.New
 open Logic
 open Hipattern
-open Tacexpr
 open Tacticals.New
 open Tactics
 open Tacred
@@ -40,53 +42,35 @@ open Eqschemes
 open Locus
 open Locusops
 open Misctypes
-open Sigma.Notations
 open Proofview.Notations
 open Unification
 open Context.Named.Declaration
 
-(* Options *)
+module NamedDecl = Context.Named.Declaration
 
-let discriminate_introduction = ref true
+(* Options *)
 
-let discr_do_intro () =
-  !discriminate_introduction && Flags.version_strictly_greater Flags.V8_2
+type inj_flags = {
+    keep_proof_equalities : bool;
+    injection_in_context : bool;
+    injection_pattern_l2r_order : bool;
+  }
 
 open Goptions
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "automatic introduction of hypotheses by discriminate";
-      optkey   = ["Discriminate";"Introduction"];
-      optread  = (fun () -> !discriminate_introduction);
-      optwrite = (:=) discriminate_introduction }
-
-let injection_pattern_l2r_order = ref true
 
-let use_injection_pattern_l2r_order () =
-  !injection_pattern_l2r_order
-  && Flags.version_strictly_greater Flags.V8_4
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "injection left-to-right pattern order and clear by default when with introduction pattern";
-      optkey   = ["Injection";"L2R";"Pattern";"Order"];
-      optread  = (fun () -> !injection_pattern_l2r_order) ;
-      optwrite = (fun b -> injection_pattern_l2r_order := b) }
+let use_injection_pattern_l2r_order = function
+  | None -> true
+  | Some flags -> flags.injection_pattern_l2r_order
 
 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
+  | Some flags -> flags.injection_in_context
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "injection in context";
       optkey   = ["Structural";"Injection"];
       optread  = (fun () -> !injection_in_context) ;
@@ -94,9 +78,6 @@ let _ =
 
 (* Rewriting tactics *)
 
-let tclNOTSAMEGOAL tac =
-  Proofview.V82.tactic (Tacticals.tclNOTSAMEGOAL (Proofview.V82.of_tactic tac))
-
 type dep_proof_flag = bool (* true = support rewriting dependent proofs *)
 type freeze_evars_flag = bool (* true = don't instantiate existing evars *)
 
@@ -143,7 +124,7 @@ let freeze_initial_evars sigma flags clause =
   (* We take evars of the type: this may include old evars! For excluding *)
   (* all old evars, including the ones occurring in the rewriting lemma, *)
   (* we would have to take the clenv_value *)
-  let newevars = Evd.evars_of_term (clenv_type clause) in
+  let newevars = Evarutil.undefined_evars_of_term sigma (clenv_type clause) in
   let evars =
     fold_undefined (fun evk _ evars ->
       if Evar.Set.mem evk newevars then evars
@@ -164,10 +145,11 @@ let side_tac tac sidetac =
 
 let instantiate_lemma_all frzevars gl c ty l l2r concl =
   let env = Proofview.Goal.env gl in
+  let sigma = project gl in
   let eqclause = pf_apply Clenv.make_clenv_binding gl (c,ty) l in
-  let (equiv, args) = decompose_appvect (Clenv.clenv_type eqclause) in
+  let (equiv, args) = decompose_app_vect sigma (Clenv.clenv_type eqclause) in
   let arglen = Array.length args in
-  let () = if arglen < 2 then error "The term provided is not an applied relation." in
+  let () = if arglen < 2 then user_err Pp.(str "The term provided is not an applied relation.") in
   let c1 = args.(arglen - 2) in
   let c2 = args.(arglen - 1) in
   let try_occ (evd', c') =
@@ -257,12 +239,31 @@ let rewrite_keyed_unif_flags = {
 }
 
 let rewrite_elim with_evars frzevars cls c e =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let flags = if Unification.is_keyed_unification ()
 	      then rewrite_keyed_unif_flags else rewrite_conv_closed_unif_flags in
   let flags = make_flags frzevars (Tacmach.New.project gl) flags c in
   general_elim_clause with_evars flags cls c e
-  end }
+  end
+
+let tclNOTSAMEGOAL tac =
+  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
+    tac >>= fun () ->
+    Proofview.Goal.goals >>= fun gls ->
+    let check accu gl' =
+      gl' >>= fun gl' ->
+      let accu = accu || Goal.V82.same_goal sigma ev (project gl') (goal gl') in
+      Proofview.tclUNIT accu
+    in
+    Proofview.Monad.List.fold_left check false gls >>= fun has_same ->
+    if has_same then
+      tclZEROMSG (str"Tactic generated a subgoal identical to the original goal.")
+    else
+      Proofview.tclUNIT ()
+  end
 
 (* Ad hoc asymmetric general_elim_clause *)
 let general_elim_clause with_evars frzevars cls rew elim =
@@ -297,19 +298,19 @@ let general_elim_clause with_evars frzevars tac cls c t l l2r elim =
          (general_elim_clause with_evars frzevars cls c elim))
       tac
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let instantiate_lemma concl =
       if not all then instantiate_lemma gl c t l l2r concl
       else instantiate_lemma_all frzevars gl c t l l2r concl
     in
     let typ = match cls with
-    | None -> pf_nf_concl gl
-    | Some id -> pf_get_hyp_typ id (Proofview.Goal.assume gl)
+    | None -> pf_concl 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)
     else tclMAP try_clause cs
-  end }
+  end
 
 (* The next function decides in particular whether to try a regular
   rewrite or a generalized rewrite.
@@ -322,27 +323,30 @@ let (forward_general_setoid_rewrite_clause, general_setoid_rewrite_clause) = Hoo
 
 (* Do we have a JMeq instance on twice the same domains ? *)
 
-let jmeq_same_dom gl = function
+let jmeq_same_dom env sigma = function
   | None -> true (* already checked in Hipattern.find_eq_data_decompose *)
   | Some t ->
-    let rels, t = decompose_prod_assum t in
-    let env = Environ.push_rel_context rels (Proofview.Goal.env gl) in
-    match decompose_app t with
-      | _, [dom1; _; dom2;_] -> is_conv env (Tacmach.New.project gl) dom1 dom2
+    let rels, t = decompose_prod_assum sigma t in
+    let env = push_rel_context rels env in
+    match decompose_app sigma t with
+      | _, [dom1; _; dom2;_] -> is_conv env sigma dom1 dom2
       | _ -> false
 
 (* find_elim determines which elimination principle is necessary to
    eliminate lbeq on sort_of_gl. *)
 
-let find_elim hdcncl lft2rgt dep cls ot gl =
+let find_elim hdcncl lft2rgt dep cls ot =
+  Proofview.Goal.enter_one begin fun gl ->
+  let sigma = project gl in
+  let is_global gr c = Termops.is_global sigma gr c in
   let inccl = Option.is_empty cls in
+  let env = Proofview.Goal.env gl in
   if (is_global Coqlib.glob_eq hdcncl ||
       (is_global Coqlib.glob_jmeq hdcncl &&
-	 jmeq_same_dom gl ot)) && not dep
-    || Flags.version_less_or_equal Flags.V8_2
+	 jmeq_same_dom env sigma ot)) && not dep
   then
     let c = 
-      match kind_of_term hdcncl with 
+      match EConstr.kind sigma hdcncl with 
       | Ind (ind_sp,u) -> 
 	let pr1 = 
 	  lookup_eliminator ind_sp (elimination_sort_of_clause cls gl) 
@@ -351,16 +355,16 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
         | 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 -> 
-	      errorlabstrm "Equality.find_elim"
-                (str "Cannot find rewrite principle " ++ pr_label l' ++ str ".")
+	      user_err ~hdr:"Equality.find_elim"
+                (str "Cannot find rewrite principle " ++ Label.print l' ++ str ".")
 	  end
 	| _ -> destConstRef pr1
         end
@@ -369,8 +373,7 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
 	     Logic.eq or Jmeq just before *)
 	assert false
     in
-      let Sigma (elim, sigma, p) = Sigma.fresh_global (Global.env ()) (Proofview.Goal.sigma gl) (ConstRef c) in
-      Sigma ((elim, Safe_typing.empty_private_constants), sigma, p)
+        pf_constr_of_global (ConstRef c) 
   else
   let scheme_name = match dep, lft2rgt, inccl with
     (* Non dependent case *)
@@ -384,36 +387,31 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
     | true, _, true -> rew_r2l_dep_scheme_kind
     | true, _, false -> rew_r2l_forward_dep_scheme_kind
   in
-  match kind_of_term hdcncl with
+  match EConstr.kind sigma hdcncl with
   | Ind (ind,u) -> 
+      
       let c, eff = find_scheme scheme_name ind in 
-      (* MS: cannot use pf_constr_of_global as the eliminator might be generated by side-effect *)
-      let Sigma (elim, sigma, p) =
-	Sigma.fresh_global (Global.env ()) (Proofview.Goal.sigma gl) (ConstRef c)
-      in
-      Sigma ((elim, eff), sigma, p)
+      Proofview.tclEFFECTS eff <*>
+        pf_constr_of_global (ConstRef c) 
   | _ -> assert false
+  end
 
 let type_of_clause cls gl = match cls with
   | None -> Proofview.Goal.concl gl
   | Some id -> pf_get_hyp_typ id gl
 
 let leibniz_rewrite_ebindings_clause cls lft2rgt tac c t l with_evars frzevars dep_proof_ok hdcncl =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-  let evd = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
-  let isatomic = isProd (whd_zeta evd hdcncl) in
+  Proofview.Goal.enter begin fun gl ->
+  let evd = Proofview.Goal.sigma gl in
+  let isatomic = isProd evd (whd_zeta evd hdcncl) in
   let dep_fun = if isatomic then dependent else dependent_no_evar in
   let type_of_cls = type_of_clause cls gl in
-  let dep = dep_proof_ok && dep_fun c type_of_cls in
-  let Sigma ((elim, effs), sigma, p) = find_elim hdcncl lft2rgt dep cls (Some t) gl in
-  let tac =
-      Proofview.tclEFFECTS effs <*>
+  let dep = dep_proof_ok && dep_fun evd c type_of_cls in
+  find_elim hdcncl lft2rgt dep cls (Some t) >>= fun elim ->
       general_elim_clause with_evars frzevars tac cls c t l
       (match lft2rgt with None -> false | Some b -> b)
       {elimindex = None; elimbody = (elim,NoBindings); elimrename = None}
-  in
-  Sigma (tac, sigma, p)
-  end }
+  end
 
 let adjust_rewriting_direction args lft2rgt =
   match args with
@@ -421,7 +419,7 @@ let adjust_rewriting_direction args lft2rgt =
     (* equality to a constant, like in eq_true *)
     (* more natural to see -> as the rewriting to the constant *)
     if not lft2rgt then
-      error "Rewriting non-symmetric equality not allowed from right-to-left.";
+      user_err Pp.(str "Rewriting non-symmetric equality not allowed from right-to-left.");
     None
   | _ ->
     (* other equality *)
@@ -436,12 +434,12 @@ let general_rewrite_ebindings_clause cls lft2rgt occs frzevars dep_proof_ok ?tac
   if occs != AllOccurrences then (
     rewrite_side_tac (Hook.get forward_general_setoid_rewrite_clause cls lft2rgt occs (c,l) ~new_goals:[]) tac)
   else
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
     let ctype = get_type_of env sigma c in
-    let rels, t = decompose_prod_assum (whd_betaiotazeta sigma ctype) in
-      match match_with_equality_type t with
+    let rels, t = decompose_prod_assum sigma (whd_betaiotazeta sigma ctype) in
+      match match_with_equality_type sigma t with
       | Some (hdcncl,args) -> (* Fast path: direct leibniz-like rewrite *)
 	  let lft2rgt = adjust_rewriting_direction args lft2rgt in
           leibniz_rewrite_ebindings_clause cls lft2rgt tac c (it_mkProd_or_LetIn t rels)
@@ -454,9 +452,10 @@ let general_rewrite_ebindings_clause cls lft2rgt occs frzevars dep_proof_ok ?tac
             end
             begin function
               | (e, info) ->
+                  Proofview.tclEVARMAP >>= fun sigma ->
 	          let env' = push_rel_context rels env in
 	          let rels',t' = splay_prod_assum env' sigma t in (* Search for underlying eq *)
-	          match match_with_equality_type t' with
+	          match match_with_equality_type sigma t' with
 	            | Some (hdcncl,args) ->
 		  let lft2rgt = adjust_rewriting_direction args lft2rgt in
 		  leibniz_rewrite_ebindings_clause cls lft2rgt tac c
@@ -464,7 +463,7 @@ let general_rewrite_ebindings_clause cls lft2rgt occs frzevars dep_proof_ok ?tac
 	            | None -> Proofview.tclZERO ~info e
             (* error "The provided term does not end with an equality or a declared rewrite relation." *)  
             end
-    end }
+    end
 
 let general_rewrite_ebindings =
   general_rewrite_ebindings_clause None
@@ -515,46 +514,46 @@ let general_rewrite_clause l2r with_evars ?tac c cl =
 	let rec do_hyps_atleastonce = function
 	  | [] -> tclZEROMSG (Pp.str"Nothing to rewrite.")
 	  | id :: l ->
-	    tclIFTHENTRYELSEMUST
+            tclIFTHENFIRSTTRYELSEMUST
 	     (general_rewrite_ebindings_in l2r AllOccurrences false true ?tac id c with_evars)
 	     (do_hyps_atleastonce l)
 	in
 	let do_hyps =
 	  (* If the term to rewrite uses an hypothesis H, don't rewrite in H *)
 	  let ids gl =
-	    let ids_in_c = Environ.global_vars_set (Global.env()) (fst c) in
+	    let ids_in_c = Termops.global_vars_set (Proofview.Goal.env gl) (project gl) (fst c) in
             let ids_of_hyps = pf_ids_of_hyps gl in
 	    Id.Set.fold (fun id l -> List.remove Id.equal id l) ids_in_c ids_of_hyps
 	  in
-          Proofview.Goal.enter { enter = begin fun gl ->
+          Proofview.Goal.enter begin fun gl ->
             do_hyps_atleastonce (ids gl)
-          end }
+          end
 	in
 	if cl.concl_occs == NoOccurrences then do_hyps else
-	  tclIFTHENTRYELSEMUST
+          tclIFTHENFIRSTTRYELSEMUST
 	   (general_rewrite_ebindings l2r (occs_of cl.concl_occs) false true ?tac c with_evars)
 	   do_hyps
 
 let apply_special_clear_request clear_flag f =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let env = Proofview.Goal.env gl in
     try
-      let ((c, bl), sigma) = run_delayed env sigma f in
+      let (sigma, (c, bl)) = f env sigma in
       apply_clear_request clear_flag (use_clear_hyp_by_default ()) c
     with
       e when catchable_exception e -> tclIDTAC
-  end }
+  end
 
 let general_multi_rewrite with_evars l cl tac =
   let do1 l2r f =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
-      let (c, sigma) = run_delayed env sigma f in
+      let (sigma, c) = f env sigma in
       tclWITHHOLES with_evars
         (general_rewrite_clause l2r with_evars ?tac c cl) sigma
-    end }
+    end
   in
   let rec doN l2r c = function
     | Precisely n when n <= 0 -> Proofview.tclUNIT ()
@@ -617,7 +616,7 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
       | None -> Proofview.tclUNIT ()
       | Some tac ->  tclCOMPLETE tac
   in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let get_type_of = pf_apply get_type_of gl in
   let t1 = get_type_of c1
   and t2 = get_type_of c2 in
@@ -633,8 +632,8 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
   | Some evd ->
     let e = build_coq_eq () in
     let sym = build_coq_eq_sym () in
-    Tacticals.New.pf_constr_of_global sym (fun sym ->
-    Tacticals.New.pf_constr_of_global e (fun e ->
+    Tacticals.New.pf_constr_of_global sym >>= fun sym ->
+    Tacticals.New.pf_constr_of_global e >>= fun e ->
     let eq = applist (e, [t1;c1;c2]) in
     tclTHENLAST
       (replace_core clause l2r eq)
@@ -642,8 +641,8 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
          [assumption;
           tclTHEN (apply sym) assumption;
           try_prove_eq
-         ])))
-  end }
+         ])
+  end
 
 let replace c1 c2 =
   replace_using_leibniz onConcl c2 c1 false false None
@@ -705,26 +704,31 @@ let keep_proof_equalities_for_injection = ref false
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "injection on prop arguments";
       optkey   = ["Keep";"Proof";"Equalities"];
       optread  = (fun () -> !keep_proof_equalities_for_injection) ;
       optwrite = (fun b -> keep_proof_equalities_for_injection := b) }
 
+let keep_proof_equalities = function
+  | None -> !keep_proof_equalities_for_injection
+  | Some flags -> flags.keep_proof_equalities
 
-let find_positions env sigma t1 t2 =
+(* [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
   let rec findrec sorts posn t1 t2 =
     let hd1,args1 = whd_all_stack env sigma t1 in
     let hd2,args2 = whd_all_stack env sigma t2 in
-    match (kind_of_term hd1, kind_of_term hd2) with
-      | Construct (sp1,_), Construct (sp2,_)
+    match (EConstr.kind sigma hd1, EConstr.kind sigma hd2) with
+      | Construct ((ind1,i1 as sp1),u1), Construct (sp2,_)
           when Int.equal (List.length args1) (constructor_nallargs_env env sp1)
             ->
 	  let sorts' =
@@ -733,13 +737,18 @@ let find_positions env sigma t1 t2 =
           (* both sides are fully applied constructors, so either we descend,
              or we can discriminate here. *)
 	  if eq_constructor sp1 sp2 then
-	    let nrealargs = constructor_nrealargs_env env sp1 in
-	    let rargs1 = List.lastn nrealargs args1 in
-	    let rargs2 = List.lastn nrealargs args2 in
+	    let nparams = inductive_nparams_env env ind1 in
+	    let params1,rargs1 = List.chop nparams args1 in
+	    let _,rargs2 = List.chop nparams args2 in
+            let (mib,mip) = lookup_mind_specif env ind1 in
+            let params1 = List.map EConstr.Unsafe.to_constr params1 in
+            let u1 = EInstance.kind sigma u1 in
+            let ctxt = (get_constructor ((ind1,u1),mib,mip,params1) i1).cs_args in
+            let adjust i = CVars.adjust_rel_to_rel_context ctxt (i+1) - 1 in
             List.flatten
-	      (List.map2_i (fun i -> findrec sorts' ((sp1,i)::posn))
+	      (List.map2_i (fun i -> findrec sorts' ((sp1,adjust i)::posn))
 		0 rargs1 rargs2)
-	  else if Sorts.List.mem InType sorts'
+	  else if Sorts.List.mem InType sorts' && not no_discr
           then (* see build_discriminator *)
 	    raise (DiscrFound (List.rev posn,sp1,sp2))
 	  else 
@@ -755,21 +764,24 @@ let find_positions env sigma 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 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 t1 t2 with
-    | Inl _ | Inr [] | Inr [([],_,_)] -> false
+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
 
 
@@ -840,27 +852,30 @@ let descend_then env sigma head dirn =
   let IndType (indf,_) =
     try find_rectype env sigma (get_type_of env sigma head)
     with Not_found ->
-      error "Cannot project on an inductive type derived from a dependency." in
+      user_err Pp.(str "Cannot project on an inductive type derived from a dependency.") 
+  in
   let indp,_ = (dest_ind_family indf) in
   let ind, _ = check_privacy env indp in
   let (mib,mip) = lookup_mind_specif env ind in
   let cstr = get_constructors env indf in
   let dirn_nlams = cstr.(dirn-1).cs_nargs in
-  let dirn_env = push_rel_context cstr.(dirn-1).cs_args env in
+  let dirn_env = Environ.push_rel_context cstr.(dirn-1).cs_args env in
   (dirn_nlams,
    dirn_env,
-   (fun dirnval (dfltval,resty) ->
-      let deparsign = make_arity_signature env true indf in
+   (fun sigma dirnval (dfltval,resty) ->
+      let deparsign = make_arity_signature env sigma true indf in
       let p =
 	it_mkLambda_or_LetIn (lift (mip.mind_nrealargs+1) resty) deparsign in
       let build_branch i =
 	let result = if Int.equal i dirn then dirnval else dfltval in
-	it_mkLambda_or_LetIn_name env result cstr.(i-1).cs_args in
+	let cs_args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cstr.(i-1).cs_args in
+	let args = name_context env sigma cs_args in
+	it_mkLambda_or_LetIn result args in
       let brl =
         List.map build_branch
           (List.interval 1 (Array.length mip.mind_consnames)) in
       let ci = make_case_info env ind RegularStyle in
-      Inductiveops.make_case_or_project env indf ci p head (Array.of_list brl)))
+      Inductiveops.make_case_or_project env sigma indf ci p head (Array.of_list brl)))
 
 (* Now we need to construct the discriminator, given a discriminable
    position.  This boils down to:
@@ -888,35 +903,39 @@ let build_selector env sigma dirn c ind special default =
           on (c bool true) = (c bool false)
           CP : changed assert false in a more informative error
        *)
-      errorlabstrm "Equality.construct_discriminator"
+      user_err ~hdr:"Equality.construct_discriminator"
 	(str "Cannot discriminate on inductive constructors with \
 		 dependent types.") in
   let (indp,_) = dest_ind_family indf in
   let ind, _ = check_privacy env indp in
   let typ = Retyping.get_type_of env sigma default in
   let (mib,mip) = lookup_mind_specif env ind in
-  let deparsign = make_arity_signature env true indf in
+  let deparsign = make_arity_signature env sigma true indf in
   let p = it_mkLambda_or_LetIn typ deparsign in
   let cstrs = get_constructors env indf in
   let build_branch i =
     let endpt = if Int.equal i dirn then special else default in
-    it_mkLambda_or_LetIn endpt cstrs.(i-1).cs_args in
+    let args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cstrs.(i-1).cs_args in
+    it_mkLambda_or_LetIn endpt args in
   let brl =
     List.map build_branch(List.interval 1 (Array.length mip.mind_consnames)) in
   let ci = make_case_info env ind RegularStyle in
-  mkCase (ci, p, c, Array.of_list brl)
+  let ans = Inductiveops.make_case_or_project env sigma indf ci p c (Array.of_list brl) in
+  ans
 
-let rec build_discriminator env sigma dirn c = function
+let build_coq_False () = pf_constr_of_global (build_coq_False ())
+let build_coq_True () = pf_constr_of_global (build_coq_True ())
+let build_coq_I () = pf_constr_of_global (build_coq_I ())
+
+let rec build_discriminator env sigma true_0 false_0 dirn c = function
   | [] ->
       let ind = get_type_of env sigma c in
-      let true_0,false_0 =
-        build_coq_True(),build_coq_False() in
       build_selector env sigma dirn c ind true_0 false_0
   | ((sp,cnum),argnum)::l ->
       let (cnum_nlams,cnum_env,kont) = descend_then env sigma c cnum in
       let newc = mkRel(cnum_nlams-argnum) in
-      let subval = build_discriminator cnum_env sigma dirn newc l in
-      kont subval (build_coq_False (),mkSort (Prop Null))
+      let subval = build_discriminator cnum_env sigma true_0 false_0 dirn newc l in
+      kont sigma subval (false_0,mkSort (Prop Null))
 
 (* Note: discrimination could be more clever: if some elimination is
    not allowed because of a large impredicative constructor in the
@@ -930,15 +949,15 @@ let rec build_discriminator env sigma dirn c = function
 *)
 
 let gen_absurdity id =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let hyp_typ = pf_get_hyp_typ id (Proofview.Goal.assume gl) in
-  let hyp_typ = pf_nf_evar gl hyp_typ in
-  if is_empty_type hyp_typ
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
+  let hyp_typ = pf_get_hyp_typ id gl in
+  if is_empty_type sigma hyp_typ
   then
     simplest_elim (mkVar id)
   else
     tclZEROMSG (str "Not the negation of an equality.")
-  end }
+  end
 
 (* Precondition: eq is leibniz equality
 
@@ -958,13 +977,15 @@ let ind_scheme_of_eq lbeq =
     ConstRef c, eff
 
 
-let discrimination_pf env sigma e (t,t1,t2) discriminator lbeq =
-  let i            = build_coq_I () in
-  let absurd_term  = build_coq_False () in
-  let eq_elim, eff = ind_scheme_of_eq lbeq in
-  let sigma, eq_elim = Evd.fresh_global (Global.env ()) sigma eq_elim in
-    sigma, (applist (eq_elim, [t;t1;mkNamedLambda e t discriminator;i;t2]), absurd_term),
-    eff
+let discrimination_pf e (t,t1,t2) discriminator lbeq =
+  build_coq_I () >>= fun i ->
+  build_coq_False () >>= fun absurd_term ->
+  let eq_elim, eff       = ind_scheme_of_eq lbeq in
+  Proofview.tclEFFECTS eff <*>
+    pf_constr_of_global eq_elim >>= fun eq_elim ->
+    Proofview.tclUNIT
+       (applist (eq_elim, [t;t1;mkNamedLambda e t discriminator;i;t2]), absurd_term)
+
 
 let eq_baseid = Id.of_string "e"
 
@@ -972,39 +993,44 @@ let apply_on_clause (f,t) clause =
   let sigma =  clause.evd in
   let f_clause = mk_clenv_from_env clause.env sigma None (f,t) in
   let argmv =
-    (match kind_of_term (last_arg f_clause.templval.Evd.rebus) with
+    (match EConstr.kind sigma (last_arg f_clause.evd f_clause.templval.Evd.rebus) with
      | Meta mv -> mv
-     | _  -> errorlabstrm "" (str "Ill-formed clause applicator.")) in
+     | _  -> user_err  (str "Ill-formed clause applicator.")) in
   clenv_fchain ~with_univs:false argmv f_clause clause
 
 let discr_positions env sigma (lbeq,eqn,(t,t1,t2)) eq_clause cpath dirn =
-  let e = next_ident_away eq_baseid (ids_of_context env) in
+  build_coq_True () >>= fun true_0 ->
+  build_coq_False () >>= fun false_0 ->
+  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 =
-    build_discriminator e_env sigma dirn (mkVar e) cpath in
-  let sigma,(pf, absurd_term), eff = 
-    discrimination_pf env sigma e (t,t1,t2) discriminator lbeq in
-  let pf_ty = mkArrow eqn absurd_term in
-  let absurd_clause = apply_on_clause (pf,pf_ty) eq_clause in
-  let pf = Clenvtac.clenv_value_cast_meta absurd_clause in
-  Proofview.Unsafe.tclEVARS sigma <*>
-  Proofview.tclEFFECTS eff <*>
-  tclTHENS (assert_after Anonymous absurd_term)
-    [onLastHypId gen_absurdity; (Proofview.V82.tactic (Tacmach.refine pf))]
+    try
+      Proofview.tclUNIT
+        (build_discriminator e_env sigma true_0 false_0 dirn (mkVar e) cpath)
+    with
+      UserError _ as ex -> Proofview.tclZERO ex
+  in
+    discriminator >>= fun discriminator ->
+    discrimination_pf e (t,t1,t2) discriminator lbeq >>= fun (pf, absurd_term) ->
+    let pf_ty = mkArrow eqn absurd_term in
+    let absurd_clause = apply_on_clause (pf,pf_ty) eq_clause in
+    let pf = Clenvtac.clenv_value_cast_meta absurd_clause in
+    tclTHENS (assert_after Anonymous absurd_term)
+      [onLastHypId gen_absurdity; (Proofview.V82.tactic (Tacmach.refine pf))]
 
 let discrEq (lbeq,_,(t,t1,t2) as u) eq_clause =
   let sigma = eq_clause.evd in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
-    match find_positions env sigma 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), _) ->
 	discr_positions env sigma u eq_clause cpath dirn
-  end }
+  end
 
 let onEquality with_evars tac (c,lbindc) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let type_of = pf_unsafe_type_of gl in
   let reduce_to_quantified_ind = pf_apply Tacred.reduce_to_quantified_ind gl in
   let t = type_of c in
@@ -1016,21 +1042,21 @@ let onEquality with_evars tac (c,lbindc) =
   tclTHEN
     (Proofview.Unsafe.tclEVARS eq_clause'.evd)
     (tac (eq,eqn,eq_args) eq_clause')
-  end }
+  end
 
 let onNegatedEquality with_evars tac =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
     let ccl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
-    match kind_of_term (hnf_constr env sigma ccl) with
-    | Prod (_,t,u) when is_empty_type u ->
+    match EConstr.kind sigma (hnf_constr env sigma ccl) with
+    | Prod (_,t,u) when is_empty_type sigma u ->
         tclTHEN introf
           (onLastHypId (fun id ->
             onEquality with_evars tac (mkVar id,NoBindings)))
     | _ ->
         tclZEROMSG (str "Not a negated primitive equality.")
-  end }
+  end
 
 let discrSimpleClause with_evars = function
   | None -> onNegatedEquality with_evars discrEq
@@ -1041,19 +1067,13 @@ let discr with_evars = onEquality with_evars discrEq
 let discrClause with_evars = onClause (discrSimpleClause with_evars)
 
 let discrEverywhere with_evars =
-(*
-  tclORELSE
-*)
-    (if discr_do_intro () then
-      (tclTHEN
-	(tclREPEAT introf)
-	(tryAllHyps
+  tclTHEN (Proofview.tclUNIT ())
+    (* Delay the interpretation of side-effect *)
+    (tclTHEN
+       (tclREPEAT introf)
+       (tryAllHyps
           (fun id -> tclCOMPLETE (discr with_evars (mkVar id,NoBindings)))))
-     else (* <= 8.2 compat *)
-       tryAllHypsAndConcl (discrSimpleClause with_evars))
-(*    (fun gls ->
-       errorlabstrm "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
@@ -1078,7 +1098,7 @@ let find_sigma_data env s = build_sigma_type ()
  *)
 
 let make_tuple env sigma (rterm,rty) lind =
-  assert (dependent (mkRel lind) rty);
+  assert (not (noccurn sigma lind rty));
   let sigdata = find_sigma_data env (get_sort_of env sigma rty) in
   let sigma, a = type_of ~refresh:true env sigma (mkRel lind) in
   let na = Context.Rel.Declaration.get_name (lookup_rel lind env) in
@@ -1088,6 +1108,8 @@ let make_tuple env sigma (rterm,rty) lind =
   let p = mkLambda (na, a, rty) in
   let sigma, exist_term = Evd.fresh_global env sigma sigdata.intro in
   let sigma, sig_term = Evd.fresh_global env sigma sigdata.typ in
+  let exist_term = EConstr.of_constr exist_term in
+  let sig_term = EConstr.of_constr sig_term in
     sigma,
     (applist(exist_term,[a;p;(mkRel lind);rterm]),
      applist(sig_term,[a;p]))
@@ -1100,9 +1122,9 @@ let make_tuple env sigma (rterm,rty) lind =
    normalization *)
 
 let minimal_free_rels env sigma (c,cty) =
-  let cty_rels = free_rels cty in
+  let cty_rels = free_rels sigma cty in
   let cty' = simpl env sigma cty in
-  let rels' = free_rels cty' in
+  let rels' = free_rels sigma cty' in
   if Int.Set.subset cty_rels rels' then
     (cty,cty_rels)
   else
@@ -1167,25 +1189,24 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
           evdref := Evarconv.solve_unif_constraints_with_heuristics env !evdref in
 	dflt
       with Evarconv.UnableToUnify _ ->
-	error "Cannot solve a unification problem."
+	user_err Pp.(str "Cannot solve a unification problem.")
     else
       let (a,p_i_minus_1) = match whd_beta_stack !evdref p_i with
-	| (_sigS,[a;p]) -> (a,p)
- 	| _ -> anomaly ~label:"sig_clausal_form" (Pp.str "should be a sigma type") in
+	| (_sigS,[a;p]) -> (a, p)
+ 	| _ -> anomaly ~label:"sig_clausal_form" (Pp.str "should be a sigma type.") in
       let ev = Evarutil.e_new_evar env evdref a in
-      let rty = beta_applist(p_i_minus_1,[ev]) in
+      let rty = beta_applist sigma (p_i_minus_1,[ev]) in
       let tuple_tail = sigrec_clausal_form (siglen-1) rty in
-      match
-        Evd.existential_opt_value !evdref
-          (destEvar ev)
-      with
+      let evopt = match EConstr.kind !evdref ev with Evar _ -> None | _ -> Some ev in
+      match evopt with
 	| Some w ->
-            let w_type = unsafe_type_of env sigma w in
+            let w_type = unsafe_type_of env !evdref w in
             if Evarconv.e_cumul env evdref w_type a then
 	      let exist_term = Evarutil.evd_comb1 (Evd.fresh_global env) evdref sigdata.intro in
+	      let exist_term = EConstr.of_constr exist_term in
               applist(exist_term,[a;p_i_minus_1;w;tuple_tail])
             else
-              error "Cannot solve a unification problem."
+              user_err Pp.(str "Cannot solve a unification problem.")
 	| None ->
             (* This at least happens if what has been detected as a
                dependency is not one; use an evasive error message;
@@ -1193,7 +1214,7 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
                tried in the first place in make_iterated_tuple instead
                of approximatively computing the free rels; then
                unsolved evars would mean not binding rel *)
-	    error "Cannot solve a unification problem."
+	    user_err Pp.(str "Cannot solve a unification problem.")
   in
   let scf = sigrec_clausal_form siglen ty in
     !evdref, Evarutil.nf_evar !evdref scf
@@ -1263,7 +1284,7 @@ let make_iterated_tuple env sigma dflt (z,zty) =
   let sigma, (tuple,tuplety) =
     List.fold_left (fun (sigma, t) -> make_tuple env sigma t) (sigma, (z,zty)) sorted_rels
   in
-  assert (closed0 tuplety);
+  assert (closed0 sigma tuplety);
   let n = List.length sorted_rels in
   let sigma, dfltval = sig_clausal_form env sigma sort_of_zty n tuplety dflt in
     sigma, (tuple,tuplety,dfltval)
@@ -1275,7 +1296,8 @@ let rec build_injrec env sigma dflt c = function
       let (cnum_nlams,cnum_env,kont) = descend_then env sigma c cnum in
       let newc = mkRel(cnum_nlams-argnum) in
       let sigma, (subval,tuplety,dfltval) = build_injrec cnum_env sigma dflt newc l in
-	sigma, (kont subval (dfltval,tuplety), tuplety,dfltval)
+      let res = kont sigma subval (dfltval,tuplety) in
+      sigma, (res, tuplety,dfltval)
     with
 	UserError _ -> failwith "caught"
 
@@ -1283,62 +1305,51 @@ let build_injector env sigma dflt c cpath =
   let sigma, (injcode,resty,_) = build_injrec env sigma dflt c cpath in
     sigma, (injcode,resty)
 
-(*
-let try_delta_expand env sigma t =
-  let whdt = whd_all env sigma t  in
-  let rec hd_rec c  =
-    match kind_of_term c with
-      | Construct _ -> whdt
-      | App (f,_)  -> hd_rec f
-      | Cast (c,_,_) -> hd_rec c
-      | _  -> t
-  in
-  hd_rec whdt
-*)
-
 let eq_dec_scheme_kind_name = ref (fun _ -> failwith "eq_dec_scheme undefined")
 let set_eq_dec_scheme_kind k = eq_dec_scheme_kind_name := (fun _ -> k)
 
 let inject_if_homogenous_dependent_pair ty =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   try
+    let sigma = Tacmach.New.project gl in
     let eq,u,(t,t1,t2) = find_this_eq_data_decompose gl ty in
     (* fetch the informations of the  pair *)
-    let ceq = Universes.constr_of_global Coqlib.glob_eq in
     let sigTconstr () = (Coqlib.build_sigma_type()).Coqlib.typ in
     let existTconstr () = (Coqlib.build_sigma_type()).Coqlib.intro in
     (* check whether the equality deals with dep pairs or not *)
-    let eqTypeDest = fst (decompose_app t) in
-    if not (Globnames.is_global (sigTconstr()) eqTypeDest) then raise Exit;
-    let hd1,ar1 = decompose_app_vect t1 and
-        hd2,ar2 = decompose_app_vect t2 in
-    if not (Globnames.is_global (existTconstr()) hd1) then raise Exit;
-    if not (Globnames.is_global (existTconstr()) hd2) then raise Exit;
-    let ind,_ = try pf_apply find_mrectype gl ar1.(0) with Not_found -> raise Exit in
+    let eqTypeDest = fst (decompose_app sigma t) in
+    if not (Termops.is_global sigma (sigTconstr()) eqTypeDest) then raise Exit;
+    let hd1,ar1 = decompose_app_vect sigma t1 and
+        hd2,ar2 = decompose_app_vect sigma t2 in
+    if not (Termops.is_global sigma (existTconstr()) hd1) then raise Exit;
+    if not (Termops.is_global sigma (existTconstr()) hd2) then raise Exit;
+    let (ind, _), _ = try pf_apply find_mrectype gl ar1.(0) with Not_found -> raise Exit in
     (* check if the user has declared the dec principle *)
     (* and compare the fst arguments of the dep pair *)
     (* Note: should work even if not an inductive type, but the table only *)
     (* knows inductive types *)
-    if not (Ind_tables.check_scheme (!eq_dec_scheme_kind_name()) (fst ind) &&
+    if not (Ind_tables.check_scheme (!eq_dec_scheme_kind_name()) ind &&
       pf_apply is_conv gl ar1.(2) ar2.(2)) then raise Exit;
     Coqlib.check_required_library ["Coq";"Logic";"Eqdep_dec"];
     let new_eq_args = [|pf_unsafe_type_of gl ar1.(3);ar1.(3);ar2.(3)|] in
-    let inj2 = Coqlib.coq_constant "inj_pair2_eq_dec is missing"
-      ["Logic";"Eqdep_dec"] "inj_pair2_eq_dec" in
-    let c, eff = find_scheme (!eq_dec_scheme_kind_name()) (Univ.out_punivs ind) in
+    let inj2 = Coqlib.coq_reference "inj_pair2_eq_dec is missing" ["Logic";"Eqdep_dec"]
+                                    "inj_pair2_eq_dec" in
+    let c, eff = find_scheme (!eq_dec_scheme_kind_name()) ind in
     (* cut with the good equality and prove the requested goal *)
     tclTHENLIST
       [Proofview.tclEFFECTS eff;
        intro;
        onLastHyp (fun hyp ->
+        Tacticals.New.pf_constr_of_global Coqlib.glob_eq >>= fun ceq ->
         tclTHENS (cut (mkApp (ceq,new_eq_args)))
-          [clear [destVar hyp];
+          [clear [destVar sigma hyp];
+           Tacticals.New.pf_constr_of_global inj2 >>= fun inj2 ->
            Proofview.V82.tactic (Tacmach.refine
              (mkApp(inj2,[|ar1.(0);mkConst c;ar1.(1);ar1.(2);ar1.(3);ar2.(3);hyp|])))
           ])]
   with Exit ->
     Proofview.tclUNIT ()
-  end }
+  end
 
 (* Given t1=t2 Inj calculates the whd normal forms of t1 and t2 and it
    expands then only when the whdnf has a constructor of an inductive type
@@ -1346,13 +1357,13 @@ let inject_if_homogenous_dependent_pair ty =
 
 let simplify_args env sigma t =
   (* Quick hack to reduce in arguments of eq only *)
-  match decompose_app t with
+  match decompose_app sigma t with
     | eq, [t;c1;c2] -> applist (eq,[t;simpl env sigma c1;simpl env sigma c2])
     | eq, [t1;c1;t2;c2] -> applist (eq,[t1;simpl env sigma c1;t2;simpl env sigma c2])
     | _ -> 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') =
@@ -1361,6 +1372,7 @@ let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac =
       let sigma, (injbody,resty) = build_injector e_env !evdref t1' (mkVar e) cpath in
       let injfun = mkNamedLambda e t injbody in
       let sigma,congr = Evd.fresh_global env sigma eq.congr in
+      let congr = EConstr.of_constr congr in
       let pf = applist(congr,[t;resty;injfun;t1;t2]) in
       let sigma, pf_typ = Typing.type_of env sigma pf in
       let inj_clause = apply_on_clause (pf,pf_typ) eq_clause in
@@ -1383,46 +1395,48 @@ 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 t1 t2 with
+  match find_positions env sigma ~keep_proofs ~no_discr:true t1 t2 with
   | Inl _ ->
-     tclZEROMSG (strbrk"This equality is discriminable. You should use the discriminate tactic to solve the goal.")
+     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))
-  | Inr [([],_,_)] when Flags.version_strictly_greater Flags.V8_3 ->
+  | Inr [([],_,_)] ->
      tclZEROMSG (str"Nothing to inject.")
   | Inr posns ->
       inject_at_positions env sigma l2r u eq_clause posns
 	(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
     | Some ipats ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let destopt = match kind_of_term c with
+      Proofview.Goal.enter begin fun gl ->
+        let sigma = project gl in
+        let destopt = match EConstr.kind sigma c with
         | Var id -> get_previous_hyp_position id gl
         | _ -> MoveLast in
         let clear_tac =
@@ -1433,28 +1447,28 @@ let injEq ?(old=false) with_evars clear_flag ipats =
           then intro_patterns_bound_to with_evars n destopt ipats
           else intro_patterns_to with_evars destopt ipats in
         tclTHEN clear_tac intro_tac
-      end }
+      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.ghost,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 =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+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 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 *)
@@ -1462,21 +1476,21 @@ let decompEqThen ntac (lbeq,_,(t,t1,t2) as u) clause =
     | Inr posns ->
 	inject_at_positions env sigma true u clause posns
           (ntac (clenv_value clause))
-  end }
+  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 cl =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let cl = pf_apply make_clenv_binding gl cl NoBindings in
-    decompEqThen (fun _ -> tac) data cl
-  end }
+let 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 !keep_proof_equalities_for_injection (fun _ -> tac) data cl
+  end
 
 let _ = declare_intro_decomp_eq intro_decomp_eq
 
@@ -1512,14 +1526,14 @@ let _ = declare_intro_decomp_eq intro_decomp_eq
 
  *)
 
-let decomp_tuple_term env c t =
+let decomp_tuple_term env sigma c t =
   let rec decomprec inner_code ex exty =
     let iterated_decomp =
     try
-      let ({proj1=p1; proj2=p2}),(i,a,p,car,cdr) = find_sigma_data_decompose ex in
+      let ({proj1=p1; proj2=p2}),(i,a,p,car,cdr) = find_sigma_data_decompose env sigma ex in
       let car_code = applist (mkConstU (destConstRef p1,i),[a;p;inner_code])
       and cdr_code = applist (mkConstU (destConstRef p2,i),[a;p;inner_code]) in
-      let cdrtyp = beta_applist (p,[car]) in
+      let cdrtyp = beta_applist sigma (p,[car]) in
       List.map (fun l -> ((car,a),car_code)::l) (decomprec cdr_code cdr cdrtyp)
     with Constr_matching.PatternMatchingFailure ->
       []
@@ -1527,11 +1541,10 @@ let decomp_tuple_term env c t =
   in decomprec (mkRel 1) c t
 
 let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
-  let sigma = Sigma.to_evar_map sigma in
   let typ = get_type_of env sigma dep_pair1 in
   (* We find all possible decompositions *)
-  let decomps1 = decomp_tuple_term env dep_pair1 typ in
-  let decomps2 = decomp_tuple_term env dep_pair2 typ in
+  let decomps1 = decomp_tuple_term env sigma dep_pair1 typ in
+  let decomps2 = decomp_tuple_term env sigma dep_pair2 typ in
   (* We adjust to the shortest decomposition *)
   let n = min (List.length decomps1) (List.length decomps2) in
   let decomp1 = List.nth decomps1 (n-1) in
@@ -1543,16 +1556,16 @@ let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
   (* We build the expected goal *)
   let abst_B =
     List.fold_right
-      (fun (e,t) body -> lambda_create env (t,subst_term e body)) e1_list b in
-  let pred_body = beta_applist(abst_B,proj_list) in
-  let body = mkApp (lambda_create env (typ,pred_body),[|dep_pair1|]) in
-  let expected_goal = beta_applist (abst_B,List.map fst e2_list) in
+      (fun (e,t) body -> lambda_create env sigma (t,subst_term sigma e body)) e1_list b in
+  let pred_body = beta_applist sigma (abst_B,proj_list) in
+  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
-  Sigma.Unsafe.of_pair ((body, expected_goal), sigma)
+  (sigma, (body, expected_goal))
 
 (* Like "replace" but decompose dependent equalities                      *)
 (* i.e. if equality is "exists t v = exists u w", and goal is "phi(t,u)", *)
@@ -1560,42 +1573,38 @@ let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
 (* on for further iterated sigma-tuples                                   *)
 
 let cutSubstInConcl l2r eqn =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let (lbeq,u,(t,e1,e2)) = find_eq_data_decompose gl eqn in
   let typ = pf_concl gl in
   let (e1,e2) = if l2r then (e1,e2) else (e2,e1) in
-  let Sigma ((typ, expected), sigma, p) = subst_tuple_term env sigma e1 e2 typ in
-  let tac =
-  tclTHENFIRST
+  let (sigma, (typ, expected)) = subst_tuple_term env sigma e1 e2 typ in
+  tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  (tclTHENFIRST
     (tclTHENLIST [
        (change_concl typ); (* Put in pattern form *)
        (replace_core onConcl l2r eqn)
     ])
-    (change_concl expected) (* Put in normalized form *)
-  in
-  Sigma (tac, sigma, p)
-  end }
+    (change_concl expected)) (* Put in normalized form *)
+  end
 
 let cutSubstInHyp l2r eqn id =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let (lbeq,u,(t,e1,e2)) = find_eq_data_decompose gl eqn in
   let typ = pf_get_hyp_typ id gl in
   let (e1,e2) = if l2r then (e1,e2) else (e2,e1) in
-  let Sigma ((typ, expected), sigma, p) = subst_tuple_term env sigma e1 e2 typ in
-  let tac =
-    tclTHENFIRST
+  let (sigma, (typ, expected)) = subst_tuple_term env sigma e1 e2 typ in
+  tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (tclTHENFIRST
     (tclTHENLIST [
        (change_in_hyp None (make_change_arg typ) (id,InHypTypeOnly));
        (replace_core (onHyp id) l2r eqn)
     ])
-    (change_in_hyp None (make_change_arg expected) (id,InHypTypeOnly))
-  in
-  Sigma (tac, sigma, p)
-  end }
+    (change_in_hyp None (make_change_arg expected) (id,InHypTypeOnly)))
+  end
 
 let try_rewrite tac =
   Proofview.tclORELSE tac begin function (e, info) -> match e with
@@ -1617,11 +1626,11 @@ let cutRewriteInHyp l2r eqn id = cutRewriteClause l2r eqn (Some id)
 let cutRewriteInConcl l2r eqn = cutRewriteClause l2r eqn None
 
 let substClause l2r c cls =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let eq = pf_apply get_type_of gl c in
   tclTHENS (cutSubstClause l2r eq cls)
     [Proofview.tclUNIT (); exact_no_check c]
-  end }
+  end
 
 let rewriteClause l2r c cls = try_rewrite (substClause l2r c cls)
 let rewriteInHyp l2r c id = rewriteClause l2r c (Some id)
@@ -1650,8 +1659,7 @@ let regular_subst_tactic = ref true
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "more regular behavior of tactic subst";
       optkey   = ["Regular";"Subst";"Tactic"];
       optread  = (fun () -> !regular_subst_tactic);
@@ -1666,16 +1674,16 @@ exception FoundHyp of (Id.t * constr * bool)
 
 (* tests whether hyp [c] is [x = t] or [t = x], [x] not occurring in [t] *)
 let is_eq_x gl x d =
-  let id = get_id d in
+  let id = NamedDecl.get_id d in
   try
-    let is_var id c = match kind_of_term c with
+    let is_var id c = match EConstr.kind (project gl) c with
     | Var id' -> Id.equal id id'
     | _ -> false
     in
-    let c = pf_nf_evar gl (get_type d) in
+    let c = pf_nf_evar gl (NamedDecl.get_type d) in
     let (_,lhs,rhs) = pi3 (find_eq_data_decompose gl c) in
-    if (is_var x lhs) && not (local_occur_var x rhs) then raise (FoundHyp (id,rhs,true));
-    if (is_var x rhs) && not (local_occur_var x lhs) then raise (FoundHyp (id,lhs,false))
+    if (is_var x lhs) && not (local_occur_var (project gl) x rhs) then raise (FoundHyp (id,rhs,true));
+    if (is_var x rhs) && not (local_occur_var (project gl) x lhs) then raise (FoundHyp (id,lhs,false))
   with Constr_matching.PatternMatchingFailure ->
     ()
 
@@ -1683,16 +1691,17 @@ let is_eq_x gl x d =
    erase hyp and x; proceed by generalizing all dep hyps *)
 
 let subst_one dep_proof_ok x (hyp,rhs,dir) =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-  let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+  let sigma = Tacmach.New.project 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) ->
-      let id = get_id dcl in
+      let id = NamedDecl.get_id dcl in
       if not (Id.equal id hyp)
-         && List.exists (fun y -> occur_var_in_decl env y dcl) deps
+         && List.exists (fun y -> occur_var_in_decl env sigma y dcl) deps
       then
         let id_dest = if !regular_subst_tactic then dest else MoveLast in
         (dest,id::deps,(id_dest,id)::allhyps)
@@ -1701,7 +1710,7 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
       hyps
       (MoveBefore x,[x],[]))) in (* In practice, no dep hyps before x, so MoveBefore x is good enough *)
   (* Decides if x appears in conclusion *)
-  let depconcl = occur_var env x concl in
+  let depconcl = occur_var env sigma x concl in
   let need_rewrite = not (List.is_empty dephyps) || depconcl in
   tclTHENLIST
     ((if need_rewrite then
@@ -1711,17 +1720,16 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
       else
        [Proofview.tclUNIT ()]) @
      [tclTRY (clear [x; hyp])])
-  end }
+  end
 
 (* Look for an hypothesis hyp of the form "x=rhs" or "rhs=x", rewrite
    it everywhere, and erase hyp and x; proceed by generalizing all dep hyps *)
 
 let subst_one_var dep_proof_ok x =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
-    let xval = pf_get_hyp x gl |> get_value in
+  Proofview.Goal.enter begin fun gl ->
+    let decl = pf_get_hyp x gl in
     (* If x has a body, simply replace x with body and clear x *)
-    if not (Option.is_empty xval) then tclTHEN (unfold_body x) (clear [x]) else
+    if is_local_def decl then tclTHEN (unfold_body x) (clear [x]) else
       (* Find a non-recursive definition for x *)
       let res =
         try
@@ -1729,12 +1737,12 @@ let subst_one_var dep_proof_ok x =
           let hyps = Proofview.Goal.hyps gl in
           let test hyp _ = is_eq_x gl x hyp in
           Context.Named.fold_outside test ~init:() hyps;
-          errorlabstrm "Subst"
-            (str "Cannot find any non-recursive equality over " ++ pr_id x ++
+          user_err ~hdr:"Subst"
+            (str "Cannot find any non-recursive equality over " ++ Id.print x ++
 	       str".")
         with FoundHyp res -> res in
       subst_one dep_proof_ok x res
-  end }
+  end
 
 let subst_gen dep_proof_ok ids =
   tclMAP (subst_one_var dep_proof_ok) ids
@@ -1750,31 +1758,38 @@ type subst_tactic_flags = {
   rewrite_dependent_proof : bool
 }
 
-let default_subst_tactic_flags () =
-  if Flags.version_strictly_greater Flags.V8_2 then
-    { only_leibniz = false; rewrite_dependent_proof = true }
-  else
-    { only_leibniz = true; rewrite_dependent_proof = false }
+let default_subst_tactic_flags =
+  { only_leibniz = false; rewrite_dependent_proof = true }
+
+let warn_deprecated_simple_subst =
+  CWarnings.create ~name:"deprecated-simple-subst" ~category:"deprecated"
+    (fun () -> strbrk"\"simple subst\" is deprecated")
 
-let subst_all ?(flags=default_subst_tactic_flags ()) () =
+let subst_all ?(flags=default_subst_tactic_flags) () =
+
+  let () =
+    if flags.only_leibniz || not flags.rewrite_dependent_proof then
+      warn_deprecated_simple_subst ()
+  in
 
   if !regular_subst_tactic then
 
   (* 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
     let select_equation_name decl =
       try
-        let lbeq,u,(_,x,y) = find_eq_data_decompose (get_type decl) in
+        let lbeq,u,(_,x,y) = find_eq_data_decompose (NamedDecl.get_type decl) in
+        let u = EInstance.kind sigma u in
         let eq = Universes.constr_of_global_univ (lbeq.eq,u) in
         if flags.only_leibniz then restrict_to_eq_and_identity eq;
-        match kind_of_term x, kind_of_term y with
+        match EConstr.kind sigma x, EConstr.kind sigma y with
         | Var z, _  when not (is_evaluable env (EvalVarRef z)) ->
-            Some (get_id decl)
+            Some (NamedDecl.get_id decl)
         | _, Var z when not (is_evaluable env (EvalVarRef z)) ->
-            Some (get_id decl)
+            Some (NamedDecl.get_id decl)
         | _ ->
             None
       with Constr_matching.PatternMatchingFailure -> None
@@ -1785,51 +1800,53 @@ let subst_all ?(flags=default_subst_tactic_flags ()) () =
 
   (* Second step: treat equations *)
   let process hyp =
-    Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
+    Proofview.Goal.enter begin fun gl ->
+    let sigma = project gl in
     let env = Proofview.Goal.env gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
-    let c = pf_get_hyp hyp gl |> get_type in
+    let c = pf_get_hyp hyp gl |> NamedDecl.get_type in
     let _,_,(_,x,y) = find_eq_data_decompose c in
     (* J.F.: added to prevent failure on goal containing x=x as an hyp *)
-    if Term.eq_constr x y then Proofview.tclUNIT () else
-      match kind_of_term x, kind_of_term y with
-      | Var x', _ when not (occur_term x y) && not (is_evaluable env (EvalVarRef x')) ->
+    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 (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 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 ()
-    end }
+    end
   in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let ids = find_equations gl in
     tclMAP process ids
-  end }
+  end
 
   else
 
 (* Old implementation, not able to manage configurations like a=b, a=t,
    or situations like "a = S b, b = S a", or also accidentally unfolding
    let-ins *)
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = project gl in
   let find_eq_data_decompose = find_eq_data_decompose gl in
   let test (_,c) =
     try
       let lbeq,u,(_,x,y) = find_eq_data_decompose c in
+      let u = EInstance.kind sigma u in
       let eq = Universes.constr_of_global_univ (lbeq.eq,u) in
       if flags.only_leibniz then restrict_to_eq_and_identity eq;
       (* J.F.: added to prevent failure on goal containing x=x as an hyp *)
-      if Term.eq_constr x y then failwith "caught";
-      match kind_of_term x with Var x -> x | _ ->
-      match kind_of_term y with Var y -> y | _ -> failwith "caught"
+      if EConstr.eq_constr sigma x y then failwith "caught";
+      match EConstr.kind sigma x with Var x -> x | _ ->
+      match EConstr.kind sigma y with Var y -> y | _ -> failwith "caught"
     with Constr_matching.PatternMatchingFailure -> failwith "caught" in
   let test p = try Some (test p) with Failure _ -> None in
   let hyps = pf_hyps_types gl in
   let ids = List.map_filter test hyps in
   let ids = List.uniquize ids in
   subst_gen flags.rewrite_dependent_proof ids
-  end }
+  end
 
 (* Rewrite the first assumption for which a condition holds
    and gives the direction of the rewrite *)
@@ -1856,21 +1873,20 @@ let cond_eq_term c t gl =
 
 let rewrite_assumption_cond cond_eq_term cl =
   let rec arec hyps gl = match hyps with
-    | [] -> error "No such assumption."
+    | [] -> user_err Pp.(str "No such assumption.")
     | hyp ::rest ->
-        let id = get_id hyp in
+        let id = NamedDecl.get_id hyp in
 	begin
 	  try
-            let dir = cond_eq_term (get_type hyp) gl in
+            let dir = cond_eq_term (NamedDecl.get_type hyp) gl in
 	    general_rewrite_clause dir false (mkVar id,NoBindings) cl
 	  with | Failure _ | UserError _ -> arec rest gl
 	end
   in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.lift gl Sigma.Unsafe.le in
+  Proofview.Goal.enter begin fun gl ->
     let hyps = Proofview.Goal.hyps gl in
     arec hyps gl
-  end }
+  end
 
 (* Generalize "subst x" to substitution of subterm appearing as an
    equation in the context, but not clearing the hypothesis *)
diff --git a/tactics/equality.mli b/tactics/equality.mli
index 47cb6b82..c0be917a 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
 open Names
-open Term
 open Evd
+open EConstr
 open Environ
-open Tacexpr
 open Ind_tables
 open Locus
 open Misctypes
+open Tactypes
 (*i*)
 
 type dep_proof_flag = bool (* true = support rewriting dependent proofs *)
@@ -67,23 +69,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)
@@ -96,8 +106,11 @@ val cutRewriteInConcl : bool -> constr -> unit Proofview.tactic
 val rewriteInHyp : bool -> constr -> Id.t -> unit Proofview.tactic
 val rewriteInConcl : bool -> constr -> unit Proofview.tactic
 
+(* Tells if tactic "discriminate" is applicable *)
 val discriminable : env -> evar_map -> constr -> constr -> bool
-val injectable : env -> evar_map -> constr -> constr -> bool
+
+(* Tells if tactic "injection" is applicable *)
+val injectable : env -> evar_map -> keep_proofs:(bool option) -> constr -> constr -> bool
 
 (* Subst *)
 
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 9a96b738..500abc5b 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -1,17 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open Util
 open CErrors
 open Names
-open Vars
 open Term
+open Evd
+open EConstr
+open Vars
 open Environ
 open Mod_subst
 open Globnames
@@ -20,45 +24,49 @@ open Namegen
 open Libnames
 open Smartlocate
 open Misctypes
-open Evd
 open Termops
 open Inductiveops
 open Typing
-open Tacexpr
 open Decl_kinds
 open Pattern
 open Patternops
 open Clenv
-open Pfedit
 open Tacred
 open Printer
 open Vernacexpr
-open Sigma.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (****************************************)
 (* General functions                    *)
 (****************************************)
 
-exception Bound
+type debug = Debug | Info | Off
 
-let head_constr_bound t =
-  let t = strip_outer_cast t in
-  let _,ccl = decompose_prod_assum t in
-  let hd,args = decompose_app ccl in
-  match kind_of_term hd with
-    | Const _ | Ind _ | Construct _ | Var _ -> hd
-    | Proj (p, _) -> mkConst (Projection.constant p)
-    | _ -> raise Bound
-
-let head_constr c =
-  try head_constr_bound c with Bound -> error "Bound head variable."
+exception Bound
 
-let decompose_app_bound t =
-  let t = strip_outer_cast t in
-  let _,ccl = decompose_prod_assum t in
-  let hd,args = decompose_app_vect ccl in
-  match kind_of_term hd with
+let head_constr_bound sigma t =
+  let t = strip_outer_cast sigma t in
+  let _,ccl = decompose_prod_assum sigma t in
+  let hd,args = decompose_app sigma ccl in
+  match EConstr.kind sigma hd with
+  | Const (c, _) -> ConstRef c
+  | Ind (i, _) -> IndRef i
+  | Construct (c, _) -> ConstructRef c
+  | Var id -> VarRef id
+  | Proj (p, _) -> ConstRef (Projection.constant p)
+  | _ -> raise Bound
+
+let head_constr sigma c =
+  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
+  let _,ccl = decompose_prod_assum sigma t in
+  let hd,args = decompose_app_vect sigma ccl in
+  match EConstr.kind sigma hd with
     | Const (c,u) -> ConstRef c, args
     | Ind (i,u) -> IndRef i, args
     | Construct (c,u) -> ConstructRef c, args
@@ -71,6 +79,7 @@ let decompose_app_bound t =
     different declaration between the named hyps and the section context. *)
 let secvars_of_hyps hyps =
   let secctx = Global.named_context () in
+  let open Context.Named.Declaration in
   let pred, all =
     List.fold_left (fun (pred,all) decl ->
         try let _ = Context.Named.lookup (get_id decl) hyps in
@@ -121,14 +130,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
 
@@ -159,12 +168,11 @@ let write_warn_hint = function
 | "Lax" -> warn_hint := `LAX
 | "Warn" -> warn_hint := `WARN
 | "Strict" -> warn_hint := `STRICT
-| _ -> error "Only the following flags are accepted: Lax, Warn, Strict."
+| _ -> user_err Pp.(str "Only the following flags are accepted: Lax, Warn, Strict.")
 
 let _ =
   Goptions.declare_string_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "behavior of non-imported hints";
       Goptions.optkey   = ["Loose"; "Hint"; "Behavior"];
       Goptions.optread  = read_warn_hint;
@@ -251,8 +259,8 @@ let rebuild_dn st se =
   in
   { se with sentry_bnet = dn' }
 
-let lookup_tacs concl st se =
-  let l'  = Bounded_net.lookup st se.sentry_bnet concl in
+let lookup_tacs sigma concl st se =
+  let l'  = Bounded_net.lookup sigma st se.sentry_bnet concl in
   let sl' = List.stable_sort pri_order_int l' in
   List.merge pri_order_int se.sentry_nopat sl'
 
@@ -263,10 +271,10 @@ let is_transparent_gr (ids, csts) = function
   | ConstRef cst -> Cpred.mem cst csts
   | IndRef _ | ConstructRef _ -> false
 
-let strip_params env c = 
-  match kind_of_term c with
+let strip_params env sigma c = 
+  match EConstr.kind sigma c with
   | App (f, args) -> 
-    (match kind_of_term f with
+    (match EConstr.kind sigma f with
     | Const (p,_) ->
       let cb = lookup_constant p env in
 	(match cb.Declarations.const_proj with
@@ -285,7 +293,7 @@ let instantiate_hint env sigma p =
     let sigma = Evd.merge_context_set univ_flexible sigma ctx in
     let cl = mk_clenv_from_env env sigma None (c,cty) in 
       {cl with templval = 
-	  { cl.templval with rebus = strip_params env cl.templval.rebus };
+	  { cl.templval with rebus = strip_params env sigma cl.templval.rebus };
 	env = empty_env}
   in
   let code = match p.code.obj with
@@ -469,11 +477,11 @@ val empty : ?name:hint_db_name -> transparent_state -> bool -> t
 val find : global_reference -> t -> search_entry
 val map_none : secvars:Id.Pred.t -> t -> full_hint list
 val map_all : secvars:Id.Pred.t -> global_reference -> t -> full_hint list
-val map_existential : secvars:Id.Pred.t ->
+val map_existential : evar_map -> secvars:Id.Pred.t ->
 		      (global_reference * constr array) -> constr -> t -> full_hint list
-val map_eauto : secvars:Id.Pred.t ->
+val map_eauto : evar_map -> secvars:Id.Pred.t ->
 		(global_reference * constr array) -> constr -> t -> full_hint list
-val map_auto : secvars:Id.Pred.t ->
+val map_auto : evar_map -> secvars:Id.Pred.t ->
 	       (global_reference * constr array) -> constr -> t -> full_hint list
 val add_one : env -> evar_map -> hint_entry -> t -> t
 val add_list : env -> evar_map -> hint_entry list -> t -> t
@@ -529,21 +537,32 @@ struct
       (** Warn about no longer typable hint? *)
       None
 
-  let match_mode m arg =
+  let head_evar sigma c =
+    let rec hrec c = match EConstr.kind sigma c with
+      | Evar (evk,_)   -> evk
+      | Case (_,_,c,_) -> hrec c
+      | App (c,_)      -> hrec c
+      | Cast (c,_,_)   -> hrec c
+      | Proj (p, c)    -> hrec c
+      | _              -> raise Evarutil.NoHeadEvar
+    in
+    hrec c
+
+  let match_mode sigma m arg =
     match m with
-    | ModeInput -> not (occur_existential arg)
+    | ModeInput -> not (occur_existential sigma arg)
     | ModeNoHeadEvar ->
-       Evarutil.(try ignore(head_evar arg); false
-                 with NoHeadEvar -> true)
+       (try ignore(head_evar sigma arg); false
+                 with Evarutil.NoHeadEvar -> true)
     | ModeOutput -> true
                                
-  let matches_mode args mode =
+  let matches_mode sigma args mode =
     Array.length mode == Array.length args &&
-      Array.for_all2 match_mode mode args
+      Array.for_all2 (match_mode sigma) mode args
       
-  let matches_modes args modes =
+  let matches_modes sigma args modes =
     if List.is_empty modes then true
-    else List.exists (matches_mode args) modes
+    else List.exists (matches_mode sigma args) modes
 
   let merge_entry secvars db nopat pat =
     let h = List.sort pri_order_int (List.map snd db.hintdb_nopat) in
@@ -559,24 +578,24 @@ struct
     merge_entry secvars db se.sentry_nopat se.sentry_pat
 	
   (** Precondition: concl has no existentials *)
-  let map_auto ~secvars (k,args) concl db =
+  let map_auto sigma ~secvars (k,args) concl db =
     let se = find k db in
     let st = if db.use_dn then  (Some db.hintdb_state) else None in
-    let pat = lookup_tacs concl st se in
+    let pat = lookup_tacs sigma concl st se in
     merge_entry secvars db [] pat
 
-  let map_existential ~secvars (k,args) concl db =
+  let map_existential sigma ~secvars (k,args) concl db =
     let se = find k db in
-      if matches_modes args se.sentry_mode then
+      if matches_modes sigma args se.sentry_mode then
         merge_entry secvars db se.sentry_nopat se.sentry_pat
       else merge_entry secvars db [] []
 
   (* [c] contains an existential *)
-  let map_eauto ~secvars (k,args) concl db =
+  let map_eauto sigma ~secvars (k,args) concl db =
     let se = find k db in
-      if matches_modes args se.sentry_mode then
+      if matches_modes sigma args se.sentry_mode then
         let st = if db.use_dn then Some db.hintdb_state else None in
-        let pat = lookup_tacs concl st se in
+        let pat = lookup_tacs sigma concl st se in
         merge_entry secvars db [] pat
       else merge_entry secvars db [] []
 
@@ -716,7 +735,7 @@ let current_db () = Hintdbmap.bindings !searchtable
 let current_pure_db () = List.map snd (current_db ())
 
 let error_no_such_hint_database x =
-  errorlabstrm "Hints" (str "No such Hint database: " ++ str x ++ str ".")
+  user_err ~hdr:"Hints" (str "No such Hint database: " ++ str x ++ str ".")
 
 (**************************************************************************)
 (*                       Definition of the summary                        *)
@@ -741,15 +760,17 @@ let _ = Summary.declare_summary "search"
 (*             Auxiliary functions to prepare AUTOHINT objects            *)
 (**************************************************************************)
 
-let rec nb_hyp c = match kind_of_term c with
-  | Prod(_,_,c2) -> if noccurn 1 c2 then 1+(nb_hyp c2) else nb_hyp c2
+let rec nb_hyp sigma c = match EConstr.kind sigma c with
+  | Prod(_,_,c2) -> if noccurn sigma 1 c2 then 1+(nb_hyp sigma c2) else nb_hyp sigma c2
   | _ -> 0
 
 (* adding and removing tactics in the search table *)
 
 let try_head_pattern c =
   try head_pattern_bound c
-  with BoundPattern -> error "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 () }
 
@@ -759,19 +780,19 @@ let secvars_of_idset s =
         Id.Pred.add id p
       else p) s Id.Pred.empty
 
-let secvars_of_constr env c =
-  secvars_of_idset (global_vars_set env c)
+let secvars_of_constr env sigma c =
+  secvars_of_idset (Termops.global_vars_set env sigma c)
 
 let secvars_of_global env gr =
   secvars_of_idset (vars_of_global_reference env gr)
 
 let make_exact_entry env sigma info poly ?(name=PathAny) (c, cty, ctx) =
-  let secvars = secvars_of_constr env c in
-  let cty = strip_outer_cast cty in
-    match kind_of_term cty with
+  let secvars = secvars_of_constr env sigma c in
+  let cty = strip_outer_cast sigma cty in
+    match EConstr.kind sigma cty with
     | Prod _ -> failwith "make_exact_entry"
     | _ ->
-	let pat = Patternops.pattern_of_constr env sigma cty in
+	let pat = Patternops.pattern_of_constr env sigma (EConstr.to_constr sigma cty) in
 	let hd =
 	  try head_pattern_bound pat
 	  with BoundPattern -> failwith "make_exact_entry"
@@ -788,38 +809,48 @@ let make_exact_entry env sigma info poly ?(name=PathAny) (c, cty, ctx) =
 
 let make_apply_entry env sigma (eapply,hnf,verbose) info poly ?(name=PathAny) (c, cty, ctx) =
   let cty = if hnf then hnf_constr env sigma cty else cty in
-    match kind_of_term cty with
-    | Prod _ ->
-        let sigma' = Evd.merge_context_set univ_flexible sigma ctx in
-        let ce = mk_clenv_from_env env sigma' None (c,cty) in
-	let c' = clenv_type (* ~reduce:false *) ce in
-	let pat = Patternops.pattern_of_constr env ce.evd c' in
-        let hd =
-	  try head_pattern_bound pat
-          with BoundPattern -> failwith "make_apply_entry" in
-        let nmiss = List.length (clenv_missing ce) in
-        let secvars = secvars_of_constr env c in
-	let pri = match info.hint_priority with None -> nb_hyp cty + nmiss | Some p -> p in
-	let pat = match info.hint_pattern with
-	| Some p -> snd p | None -> pat
-	in
-	if Int.equal nmiss 0 then
-	  (Some hd,
-          { pri; poly; pat = Some pat; name;
-            db = None;
-            secvars;
-            code = with_uid (Res_pf(c,cty,ctx)); })
-	else begin
-	  if not eapply then failwith "make_apply_entry";
-          if verbose then
-	    Feedback.msg_info (str "the hint: eapply " ++ pr_lconstr c ++
-	    str " will only be used by eauto");
-          (Some hd,
-           { pri; poly; pat = Some pat; name;
-	     db = None; secvars;
-             code = with_uid (ERes_pf(c,cty,ctx)); })
-        end
-    | _ -> failwith "make_apply_entry"
+  match EConstr.kind sigma cty with
+  | Prod _ ->
+    let sigma' = Evd.merge_context_set univ_flexible sigma ctx in
+    let ce = mk_clenv_from_env env sigma' None (c,cty) in
+    let c' = clenv_type (* ~reduce:false *) ce in
+    let pat = Patternops.pattern_of_constr env ce.evd (EConstr.to_constr sigma c') in
+    let hd =
+      try head_pattern_bound pat
+      with BoundPattern -> failwith "make_apply_entry" in
+    let miss = clenv_missing ce in
+    let nmiss = List.length (clenv_missing ce) in
+    let secvars = secvars_of_constr env sigma c in
+    let pri = match info.hint_priority with None -> nb_hyp sigma' cty + nmiss | Some p -> p in
+    let pat = match info.hint_pattern with
+      | Some p -> snd p | None -> pat
+    in
+    if Int.equal nmiss 0 then
+      (Some hd,
+       { pri; poly; pat = Some pat; name;
+         db = None;
+         secvars;
+         code = with_uid (Res_pf(c,cty,ctx)); })
+    else begin
+      if not eapply then failwith "make_apply_entry";
+      if verbose then begin
+        let variables = str (CString.plural nmiss "variable") in
+        Feedback.msg_info (
+          strbrk "The hint " ++
+          pr_leconstr_env env sigma' c ++
+          strbrk " will only be used by eauto, because applying " ++
+          pr_leconstr_env env sigma' c ++
+          strbrk " would leave " ++ variables ++ Pp.spc () ++
+          Pp.prlist_with_sep Pp.pr_comma Name.print (List.map (Evd.meta_name ce.evd) miss) ++
+          strbrk " as unresolved existential " ++ variables ++ str "."
+        )
+      end;
+      (Some hd,
+       { pri; poly; pat = Some pat; name;
+         db = None; secvars;
+         code = with_uid (ERes_pf(c,cty,ctx)); })
+    end
+  | _ -> failwith "make_apply_entry"
 
 (* flags is (e,h,v) with e=true if eapply and h=true if hnf and v=true if verbose
    c is a constr
@@ -829,7 +860,7 @@ let pr_hint_term env sigma ctx = function
   | IsGlobRef gr -> pr_global gr
   | IsConstr (c, ctx) ->
      let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in
-     pr_constr_env env sigma c
+     pr_econstr_env env sigma c
 
 (** We need an object to record the side-effect of registering
   global universes associated with a hint. *)
@@ -855,7 +886,8 @@ let fresh_global_or_constr env sigma poly cr =
   let isgr, (c, ctx) =
     match cr with
     | IsGlobRef gr ->
-       true, Universes.fresh_global_instance env gr
+      let (c, ctx) = Universes.fresh_global_instance env gr in
+       true, (EConstr.of_constr c, ctx)
     | IsConstr (c, ctx) -> false, (c, ctx)
   in
     if poly then (c, ctx)
@@ -877,23 +909,23 @@ let make_resolves env sigma flags info poly ?name cr =
 			      make_apply_entry env sigma flags info poly ?name]
   in
   if List.is_empty ents then
-    errorlabstrm "Hint"
-      (pr_lconstr c ++ spc() ++
+    user_err ~hdr:"Hint"
+      (pr_leconstr_env env sigma c ++ spc() ++
         (if pi1 flags then str"cannot be used as a hint."
 	else str "can be used as a hint only for eauto."));
   ents
 
 (* used to add an hypothesis to the local hint database *)
 let make_resolve_hyp env sigma decl =
-  let hname = get_id decl in
+  let hname = NamedDecl.get_id decl in
   let c = mkVar hname in
   try
     [make_apply_entry env sigma (true, true, false) empty_hint_info false
        ~name:(PathHints [VarRef hname])
-       (c, get_type decl, Univ.ContextSet.empty)]
+       (c, NamedDecl.get_type decl, Univ.ContextSet.empty)]
   with
     | Failure _ -> []
-    | e when Logic.catchable_exception e -> anomaly (Pp.str "make_resolve_hyp")
+    | e when Logic.catchable_exception e -> anomaly (Pp.str "make_resolve_hyp.")
 
 (* REM : in most cases hintname = id *)
 
@@ -909,7 +941,6 @@ let make_unfold eref =
      code = with_uid (Unfold_nth eref) })
 
 let make_extern pri pat tacast =
-  let tacast = Genarg.in_gen (Genarg.glbwit Constrarg.wit_ltac) tacast in
   let hdconstr = Option.map try_head_pattern pat in
   (hdconstr,
    { pri = pri;
@@ -921,12 +952,13 @@ let make_extern pri pat tacast =
      code = with_uid (Extern tacast) })  
 
 let make_mode ref m = 
-  let ty = Global.type_of_global_unsafe ref in
+  let open Term in
+  let ty, _ = Global.type_of_global_in_context (Global.env ()) ref in
   let ctx, t = decompose_prod ty in
   let n = List.length ctx in
   let m' = Array.of_list m in
     if not (n == Array.length m') then
-      errorlabstrm "Hint"
+      user_err ~hdr:"Hint"
 	(pr_global ref ++ str" has " ++ int n ++ 
 	   str" arguments while the mode declares " ++ int (Array.length m'))
     else m'
@@ -935,14 +967,14 @@ let make_trivial env sigma poly ?(name=PathAny) r =
   let c,ctx = fresh_global_or_constr env sigma poly r in
   let sigma = Evd.merge_context_set univ_flexible sigma ctx in
   let t = hnf_constr env sigma (unsafe_type_of env sigma c) in
-  let hd = head_of_constr_reference (head_constr t) in
+  let hd = head_constr sigma t in
   let ce = mk_clenv_from_env env sigma None (c,t) in
   (Some hd, { pri=1;
 	      poly = poly;
-              pat = Some (Patternops.pattern_of_constr env ce.evd (clenv_type ce));
+              pat = Some (Patternops.pattern_of_constr env ce.evd (EConstr.to_constr sigma (clenv_type ce)));
 	      name = name;
               db = None;
-              secvars = secvars_of_constr env c;
+              secvars = secvars_of_constr env sigma c;
               code= with_uid (Res_pf_THEN_trivial_fail(c,t,ctx)) })
 
 
@@ -961,8 +993,8 @@ let get_db dbname =
 let add_hint dbname hintlist =
   let check (_, h) =
     let () = if KNmap.mem h.code.uid !statustable then
-      error "Conflicting hint keys. This can happen when including \
-      twice the same module."
+      user_err Pp.(str "Conflicting hint keys. This can happen when including \
+      twice the same module.")
     in
     statustable := KNmap.add h.code.uid false !statustable
   in
@@ -1036,14 +1068,16 @@ let cache_autohint (kn, obj) =
 let subst_autohint (subst, obj) =
   let subst_key gr =
     let (lab'', elab') = subst_global subst gr in
+    let elab' = EConstr.of_constr elab' in
     let gr' =
-      (try head_of_constr_reference (head_constr_bound elab')
+      (try head_constr_bound Evd.empty elab'
        with Bound -> lab'')
     in if gr' == gr then gr else gr'
   in
   let subst_hint (k,data as hint) =
     let k' = Option.smartmap subst_key k in
     let pat' = Option.smartmap (subst_pattern subst) data.pat in
+    let subst_mps subst c = EConstr.of_constr (subst_mps subst (EConstr.Unsafe.to_constr c)) in
     let code' = match data.code.obj with
       | Res_pf (c,t,ctx) ->
           let c' = subst_mps subst c in
@@ -1136,7 +1170,7 @@ let add_resolves env sigma clist local dbnames =
     (fun dbname ->
       let r =
         List.flatten (List.map (fun (pri, poly, hnf, path, gr) ->
-          make_resolves env sigma (true,hnf,Flags.is_verbose()) 
+          make_resolves env sigma (true,hnf,not !Flags.quiet)
             pri poly ~name:path gr) clist)
       in
       let hint = make_hint ~local dbname (AddHints r) in
@@ -1192,8 +1226,6 @@ let add_trivials env sigma l local dbnames =
       Lib.add_anonymous_leaf (inAutoHint hint))
     dbnames
 
-let (forward_intern_tac, extern_intern_tac) = Hook.make ()
-
 type hnf = bool
 
 type hint_info = (patvar list * constr_pattern) hint_info_gen
@@ -1205,7 +1237,7 @@ type hints_entry =
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
   | HintsModeEntry of global_reference * hint_mode list
-  | HintsExternEntry of hint_info * glob_tactic_expr
+  | HintsExternEntry of hint_info * Genarg.glob_generic_argument
 
 let default_prepare_hint_ident = Id.of_string "H"
 
@@ -1216,30 +1248,30 @@ let prepare_hint check (poly,local) env init (sigma,c) =
   (* We re-abstract over uninstantiated evars and universes.
      It is actually a bit stupid to generalize over evars since the first
      thing make_resolves will do is to re-instantiate the products *)
-  let sigma, subst = Evd.nf_univ_variables sigma in
-  let c = Vars.subst_univs_constr subst (Evarutil.nf_evar sigma c) in
-  let c = drop_extra_implicit_args c in
-  let vars = ref (collect_vars c) in
+  let sigma, _ = Evd.nf_univ_variables sigma in
+  let c = Evarutil.nf_evar sigma c in
+  let c = drop_extra_implicit_args sigma c in
+  let vars = ref (collect_vars sigma c) in
   let subst = ref [] in
-  let rec find_next_evar c = match kind_of_term c with
+  let rec find_next_evar c = match EConstr.kind sigma c with
     | Evar (evk,args as ev) ->
       (* We skip the test whether args is the identity or not *)
       let t = Evarutil.nf_evar sigma (existential_type sigma ev) in
-      let t = List.fold_right (fun (e,id) c -> replace_term e id c) !subst t in
-      if not (closed0 c) then
-	error "Hints with holes dependent on a bound variable not supported.";
-      if occur_existential t then
+      let t = List.fold_right (fun (e,id) c -> replace_term sigma e id c) !subst t in
+      if not (closed0 sigma c) then
+	user_err Pp.(str "Hints with holes dependent on a bound variable not supported.");
+      if occur_existential sigma t then
 	(* Not clever enough to construct dependency graph of evars *)
-	error "Not clever enough to deal with evars dependent in other evars.";
+	user_err Pp.(str "Not clever enough to deal with evars dependent in other evars.");
       raise (Found (c,t))
-    | _ -> Constr.iter find_next_evar c in
+    | _ -> EConstr.iter sigma find_next_evar c in
   let rec iter c =
     try find_next_evar c; c
     with Found (evar,t) ->
       let id = next_ident_away_from default_prepare_hint_ident (fun id -> Id.Set.mem id !vars) in
       vars := Id.Set.add id !vars;
       subst := (evar,mkVar id)::!subst;
-      mkNamedLambda id t (iter (replace_term evar (mkVar id) c)) in
+      mkNamedLambda id t (iter (replace_term sigma evar (mkVar id) c)) in
   let c' = iter c in
     if check then Pretyping.check_evars (Global.env()) Evd.empty sigma c';
     let diff = Univ.ContextSet.diff (Evd.universe_context_set sigma) (Evd.universe_context_set init) in
@@ -1250,18 +1282,16 @@ let prepare_hint check (poly,local) env init (sigma,c) =
 
 let interp_hints poly =
   fun h ->
-  let env = (Global.env()) in
+  let env = Global.env () in
   let sigma = Evd.from_env env in
   let f poly c =
     let evd,c = Constrintern.interp_open_constr env sigma c in
       prepare_hint true (poly,false) (Global.env()) Evd.empty (evd,c) in
   let fref r =
     let gr = global_with_alias r in
-    Dumpglob.add_glob (loc_of_reference r) gr;
+    Dumpglob.add_glob ?loc:r.CAst.loc gr;
     gr in
-  let fr r = 
-    evaluable_of_global_reference (Global.env()) (fref r)
-  in
+  let fr r = evaluable_of_global_reference env (fref r) in
   let fi c =
     match c with
     | HintsReference c ->
@@ -1269,7 +1299,7 @@ let interp_hints poly =
 	(PathHints [gr], poly, IsGlobRef gr)
     | HintsConstr c -> (PathAny, poly, f poly c)
   in
-  let fp = Constrintern.intern_constr_pattern (Global.env()) in
+  let fp = Constrintern.intern_constr_pattern env sigma in
   let fres (info, b, r) =
     let path, poly, gr = fi r in
     let info = { info with hint_pattern = Option.map fp info.hint_pattern } in
@@ -1286,22 +1316,25 @@ let interp_hints poly =
       let constr_hints_of_ind qid =
         let ind = global_inductive_with_alias qid in
 	let mib,_ = Global.lookup_inductive ind in
-	Dumpglob.dump_reference (fst (qualid_of_reference qid)) "<>" (string_of_reference qid) "ind";
+        Dumpglob.dump_reference ?loc:qid.CAst.loc "<>" (string_of_reference qid) "ind";
           List.init (nconstructors ind) 
 	    (fun i -> let c = (ind,i+1) in
 		      let gr = ConstructRef c in
-			empty_hint_info, mib.Declarations.mind_polymorphic, true,
+			empty_hint_info, 
+                        (Declareops.inductive_is_polymorphic mib), true,
 			PathHints [gr], IsGlobRef gr)
       in HintsResolveEntry (List.flatten (List.map constr_hints_of_ind lqid))
   | HintsExtern (pri, patcom, tacexp) ->
       let pat =	Option.map fp patcom in
       let l = match pat with None -> [] | Some (l, _) -> l in
-      let tacexp = Hook.get forward_intern_tac l tacexp in
+      let ltacvars = List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l in
+      let env = Genintern.({ (empty_glob_sign env) with ltacvars }) in
+      let _, tacexp = Genintern.generic_intern env tacexp in
       HintsExternEntry ({ hint_priority = Some pri; hint_pattern = pat }, tacexp)
 
 let add_hints local dbnames0 h =
   if String.List.mem "nocore" dbnames0 then
-    error "The hint database \"nocore\" is meant to stay empty.";
+    user_err Pp.(str "The hint database \"nocore\" is meant to stay empty.");
   let dbnames = if List.is_empty dbnames0 then ["core"] else dbnames0 in
   let env = Global.env() in
   let sigma = Evd.from_env env in
@@ -1318,7 +1351,7 @@ let add_hints local dbnames0 h =
 
 let expand_constructor_hints env sigma lems =
   List.map_append (fun (evd,lem) ->
-    match kind_of_term lem with
+    match EConstr.kind sigma lem with
     | Ind (ind,u) ->
 	List.init (nconstructors ind) 
 		  (fun i ->
@@ -1342,13 +1375,9 @@ let add_hint_lemmas env sigma eapply lems hint_db =
   Hint_db.add_list env sigma hintlist' hint_db
 
 let make_local_hint_db env sigma ts eapply lems =
-  let map c =
-    let sigma = Sigma.Unsafe.of_evar_map sigma in
-    let Sigma (c, sigma, _) = c.delayed env sigma in
-    (Sigma.to_evar_map sigma, c)
-  in
+  let map c = c env sigma in
   let lems = List.map map lems in
-  let sign = Environ.named_context env in
+  let sign = EConstr.named_context env in
   let ts = match ts with
     | None -> Hint_db.transparent_state (searchtable_map "core") 
     | Some ts -> ts
@@ -1373,42 +1402,37 @@ let make_db_list dbnames =
 (*                    Functions for printing the hints                    *)
 (**************************************************************************)
 
-let pr_hint_elt (c, _, _) = pr_constr 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*) " ++ Pptactic.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 Id.Pred.full c db) in
+    let hints = List.map (fun v -> 0, v) (Hint_db.map_all ~secvars:Id.Pred.full c db) in
     (name, db, hints)
   in
   let valid_dbs = List.map validate dbs in
@@ -1417,21 +1441,21 @@ 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 cl =
+let pr_hint_term env sigma cl =
   try
     let dbs = current_db () in
     let valid_dbs =
       let fn = try
-	  let hdc = decompose_app_bound cl in
-	    if occur_existential cl then
-	      Hint_db.map_existential ~secvars:Id.Pred.full hdc cl
-	    else Hint_db.map_auto ~secvars:Id.Pred.full hdc cl
+	  let hdc = decompose_app_bound sigma cl in
+	    if occur_existential sigma cl then
+	      Hint_db.map_existential sigma ~secvars:Id.Pred.full hdc cl
+	    else Hint_db.map_auto sigma ~secvars:Id.Pred.full hdc cl
 	with Bound -> Hint_db.map_none ~secvars:Id.Pred.full
       in
       let fn db = List.map (fun x -> 0, x) (fn db) in
@@ -1441,18 +1465,19 @@ let pr_hint_term 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 pts = get_pftreestate () in
-  let glss = Proof.V82.subgoals pts in
-  match glss.Evd.it with
-  | [] -> CErrors.error "No focused goal."
+  let env = Global.env () in
+  let pts = Proof_global.give_me_the_proof () in
+  let glss,_,_,_,sigma = Proof.proof pts in
+  match glss with
+  | [] -> CErrors.user_err Pp.(str "No focused goal.")
   | g::_ ->
-    pr_hint_term (Goal.V82.concl glss.Evd.sigma g)
+    pr_hint_term env sigma (Goal.V82.concl sigma g)
 
 let pp_hint_mode = function
   | ModeInput -> str"+"
@@ -1460,9 +1485,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
@@ -1472,7 +1497,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
@@ -1487,17 +1512,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 ())
 
@@ -1515,10 +1545,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
@@ -1527,6 +1560,6 @@ let run_hint tac k = match !warn_hint with
   else Proofview.tclBIND (k tac.obj) (fun x -> warn tac x)
 | `STRICT ->
   if is_imported tac then k tac.obj
-  else Proofview.tclZERO (UserError ("", (str "Tactic failure.")))
+  else Proofview.tclZERO (UserError (None, (str "Tactic failure.")))
 
 let repr_hint h = h.obj
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 1be3e0c5..1811150c 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -1,20 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open Util
 open Names
-open Term
+open EConstr
 open Environ
 open Globnames
 open Decl_kinds
 open Evd
 open Misctypes
+open Tactypes
 open Clenv
 open Pattern
 open Vernacexpr
@@ -23,9 +25,11 @@ open Vernacexpr
 
 exception Bound
 
-val decompose_app_bound : constr -> global_reference * constr array
+val decompose_app_bound : evar_map -> constr -> global_reference * constr array
 
-val secvars_of_hyps : Context.Named.t -> Id.Pred.t
+type debug = Debug | Info | Off
+
+val secvars_of_hyps : ('c, 't) Context.Named.pt -> Id.Pred.t
 
 val empty_hint_info : 'a hint_info_gen
 
@@ -40,7 +44,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
@@ -82,10 +86,10 @@ type hints_path = global_reference hints_path_gen
 val normalize_path : hints_path -> hints_path
 val path_matches : hints_path -> hints_path_atom list -> bool
 val path_derivate : hints_path -> hints_path_atom -> hints_path
-val pp_hints_path_gen : ('a -> Pp.std_ppcmds) -> 'a hints_path_gen -> Pp.std_ppcmds
-val pp_hints_path_atom : ('a -> Pp.std_ppcmds) -> 'a hints_path_atom_gen -> Pp.std_ppcmds
-val pp_hints_path : hints_path -> Pp.std_ppcmds
-val pp_hint_mode : hint_mode -> Pp.std_ppcmds
+val pp_hints_path_gen : ('a -> Pp.t) -> 'a hints_path_gen -> Pp.t
+val pp_hints_path_atom : ('a -> Pp.t) -> 'a hints_path_atom_gen -> Pp.t
+val pp_hints_path : hints_path -> Pp.t
+val pp_hint_mode : hint_mode -> Pp.t
 val glob_hints_path_atom :
   Libnames.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen
 val glob_hints_path :
@@ -107,16 +111,16 @@ module Hint_db :
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments, _not_ using the discrimination net. *)
-    val map_existential : secvars:Id.Pred.t ->
+    val map_existential : evar_map -> secvars:Id.Pred.t ->
       (global_reference * constr array) -> constr -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments and using the discrimination net. *)
-    val map_eauto : secvars:Id.Pred.t -> (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_eauto : evar_map -> secvars:Id.Pred.t -> (global_reference * constr array) -> constr -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments. *)
-    val map_auto : secvars:Id.Pred.t ->
+    val map_auto : evar_map -> secvars:Id.Pred.t ->
        (global_reference * constr array) -> constr -> t -> full_hint list
 
     val add_one : env -> evar_map -> hint_entry -> t -> t
@@ -144,7 +148,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
@@ -154,7 +158,7 @@ type hints_entry =
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
   | HintsModeEntry of global_reference * hint_mode list
-  | HintsExternEntry of hint_info * Tacexpr.glob_tactic_expr
+  | HintsExternEntry of hint_info * Genarg.glob_generic_argument
 
 val searchtable_map : hint_db_name -> hint_db
 
@@ -179,7 +183,7 @@ val add_hints : locality_flag -> hint_db_name list -> hints_entry -> unit
 
 val prepare_hint : bool (* Check no remaining evars *) ->
   (bool * bool) (* polymorphic or monomorphic, local or global *) ->
-  env -> evar_map -> open_constr -> hint_term
+  env -> evar_map -> evar_map * constr -> hint_term
 
 (** [make_exact_entry info (c, ctyp, ctx)].
    [c] is the term given as an exact proof to solve the goal;
@@ -191,7 +195,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;
@@ -209,7 +213,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
@@ -228,12 +232,12 @@ val make_resolves :
    If the hyp cannot be used as a Hint, the empty list is returned. *)
 
 val make_resolve_hyp :
-  env -> evar_map -> Context.Named.Declaration.t -> hint_entry list
+  env -> evar_map -> named_declaration -> hint_entry list
 
 (** [make_extern pri pattern tactic_expr] *)
 
 val make_extern :
-  int -> constr_pattern option -> Tacexpr.glob_tactic_expr
+  int -> constr_pattern option -> Genarg.glob_generic_argument
       -> hint_entry
 
 val run_hint : hint ->
@@ -243,14 +247,11 @@ val run_hint : hint ->
     written code. *)
 val repr_hint : hint -> (raw_hint * clausenv) hint_ast
 
-val extern_intern_tac :
-  (patvar list -> Tacexpr.raw_tactic_expr -> Tacexpr.glob_tactic_expr) Hook.t
-
 (** Create a Hint database from the pairs (name, constr).
    Useful to take the current goal hypotheses as hints;
    Boolean tells if lemmas with evars are allowed *)
 
-val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> Tacexpr.delayed_open_constr list -> hint_db
+val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> delayed_open_constr list -> hint_db
 
 val make_db_list : hint_db_name list -> hint_db list
 
@@ -261,14 +262,15 @@ val rewrite_db : hint_db_name
 
 (** Printing  hints *)
 
-val pr_searchtable : unit -> std_ppcmds
-val pr_applicable_hint : unit -> std_ppcmds
-val pr_hint_ref : global_reference -> std_ppcmds
-val pr_hint_db_by_name : hint_db_name -> std_ppcmds
-val pr_hint_db : Hint_db.t -> std_ppcmds
-val pr_hint : hint -> Pp.std_ppcmds
+val pr_searchtable : env -> evar_map -> Pp.t
+val pr_applicable_hint : unit -> 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
+[@@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 7b52a9ce..b012a7ec 100644
--- a/tactics/hipattern.ml
+++ b/tactics/hipattern.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -12,6 +14,7 @@ open Util
 open Names
 open Term
 open Termops
+open EConstr
 open Inductiveops
 open Constr_matching
 open Coqlib
@@ -19,6 +22,8 @@ open Declarations
 open Tacmach.New
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* I implemented the following functions which test whether a term t
    is an inductive but non-recursive type, a general conjuction, a
    general disjunction, or a type with no constructors.
@@ -29,46 +34,44 @@ open Context.Rel.Declaration
 
   -- Eduardo (6/8/97). *)
 
-type 'a matching_function = constr -> 'a option
+type 'a matching_function = Evd.evar_map -> EConstr.constr -> 'a option
 
-type testing_function  = constr -> bool
+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 meta4 = mkmeta 4
 
 let op2bool = function Some _ -> true | None -> false
 
-let match_with_non_recursive_type t =
-  match kind_of_term t with
+let match_with_non_recursive_type sigma t =
+  match EConstr.kind sigma t with
     | App _ ->
-        let (hdapp,args) = decompose_app t in
-        (match kind_of_term hdapp with
+        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
            | _ -> None)
     | _ -> None
 
-let is_non_recursive_type t = op2bool (match_with_non_recursive_type t)
+let is_non_recursive_type sigma t = op2bool (match_with_non_recursive_type sigma t)
 
 (* Test dependencies *)
 
 (* NB: we consider also the let-in case in the following function,
    since they may appear in types of inductive constructors (see #2629) *)
 
-let rec has_nodep_prod_after n c =
-  match kind_of_term c with
+let rec has_nodep_prod_after n sigma c =
+  match EConstr.kind sigma c with
     | Prod (_,_,b) | LetIn (_,_,_,b) ->
-	( n>0 || not (dependent (mkRel 1) b))
-	&& (has_nodep_prod_after (n-1) b)
+	( n>0 || Vars.noccurn sigma 1 b)
+	&& (has_nodep_prod_after (n-1) sigma b)
     | _            -> true
 
-let has_nodep_prod = has_nodep_prod_after 0
+let has_nodep_prod sigma c = has_nodep_prod_after 0 sigma c
 
 (* A general conjunctive type is a non-recursive with-no-indices inductive
    type with only one constructor and no dependencies between argument;
@@ -85,9 +88,17 @@ let is_lax_conjunction = function
 | Some false -> true
 | _ -> false
 
-let match_with_one_constructor style onlybinary allow_rec t =
-  let (hdapp,args) = decompose_app t in
-  let res = match kind_of_term hdapp with
+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
   | Ind ind ->
       let (mib,mip) = Global.lookup_inductive (fst ind) in
       if Int.equal (Array.length mip.mind_consnames) 1
@@ -96,21 +107,23 @@ let match_with_one_constructor style onlybinary allow_rec t =
       then
 	if is_strict_conjunction style (* strict conjunction *) then
 	  let ctx =
-	    (prod_assum (snd
-	      (decompose_prod_n_assum mib.mind_nparams mip.mind_nf_lc.(0)))) in
+	    (prod_assum sigma (snd
+	      (decompose_prod_n_assum sigma mib.mind_nparams (EConstr.of_constr mip.mind_nf_lc.(0))))) in
 	  if
 	    List.for_all
-	      (fun decl -> let c = get_type decl in
+	      (fun decl -> let c = RelDecl.get_type decl in
 	                   is_local_assum decl &&
-			   isRel c &&
-                           Int.equal (destRel c) mib.mind_nparams) ctx
+			   isRel sigma c &&
+                           Int.equal (destRel sigma c) mib.mind_nparams) ctx
 	  then
 	    Some (hdapp,args)
 	  else None
 	else
-	  let ctyp = prod_applist mip.mind_nf_lc.(0) args in
-	  let cargs = List.map get_type (prod_assum ctyp) in
-	  if not (is_lax_conjunction style) || has_nodep_prod ctyp then
+          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 *)
 	    Some (hdapp,List.rev cargs)
 	  else
@@ -123,28 +136,29 @@ let match_with_one_constructor style onlybinary allow_rec t =
   | Some (hdapp, [_; _]) -> res
   | _ -> None
 
-let match_with_conjunction ?(strict=false) ?(onlybinary=false) t =
-  match_with_one_constructor (Some strict) onlybinary false t
+let match_with_conjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  match_with_one_constructor sigma (Some strict) onlybinary false t
 
-let match_with_record t =
-  match_with_one_constructor None false false t
+let match_with_record sigma t =
+  match_with_one_constructor sigma None false false t
 
-let is_conjunction ?(strict=false) ?(onlybinary=false) t =
-  op2bool (match_with_conjunction ~strict ~onlybinary t)
+let is_conjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  op2bool (match_with_conjunction sigma ~strict ~onlybinary t)
 
-let is_record t =
-  op2bool (match_with_record t)
+let is_record sigma t =
+  op2bool (match_with_record sigma t)
 
-let match_with_tuple t =
-  let t = match_with_one_constructor None false true t in
+let match_with_tuple sigma t =
+  let t = match_with_one_constructor sigma None false true t in
   Option.map (fun (hd,l) ->
-    let ind = destInd hd in
+    let ind = destInd sigma hd in
+    let ind = on_snd (fun u -> EInstance.kind sigma u) ind in
     let (mib,mip) = Global.lookup_pinductive ind in
     let isrec = mis_is_recursive (fst ind,mib,mip) in
     (hd,l,isrec)) t
 
-let is_tuple t =
-  op2bool (match_with_tuple t)
+let is_tuple sigma t =
+  op2bool (match_with_tuple sigma t)
 
 (* A general disjunction type is a non-recursive with-no-indices inductive
    type with of which all constructors have a single argument;
@@ -152,14 +166,15 @@ let is_tuple t =
    "Inductive I A1 ... An := C1 (_:A1) | ... | Cn : (_:An)" *)
 
 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) t =
-  let (hdapp,args) = decompose_app t in
-  let res = match kind_of_term hdapp with
+let match_with_disjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  let res = match EConstr.kind sigma hdapp with
   | Ind (ind,u)  ->
       let car = constructors_nrealargs ind in
       let (mib,mip) = Global.lookup_inductive ind in
@@ -174,7 +189,7 @@ let match_with_disjunction ?(strict=false) ?(onlybinary=false) t =
 	    None
 	else
 	  let cargs =
-	    Array.map (fun ar -> pi2 (destProd (prod_applist ar args)))
+	    Array.map (fun ar -> pi2 (destProd sigma (prod_applist sigma (EConstr.of_constr ar) args)))
 	      mip.mind_nf_lc in
 	  Some (hdapp,Array.to_list cargs)
       else
@@ -185,48 +200,48 @@ let match_with_disjunction ?(strict=false) ?(onlybinary=false) t =
   | Some (hdapp,[_; _]) -> res
   | _ -> None
 
-let is_disjunction ?(strict=false) ?(onlybinary=false) t =
-  op2bool (match_with_disjunction ~strict ~onlybinary t)
+let is_disjunction ?(strict=false) ?(onlybinary=false) sigma t =
+  op2bool (match_with_disjunction ~strict ~onlybinary sigma t)
 
 (* An empty type is an inductive type, possible with indices, that has no
    constructors *)
 
-let match_with_empty_type t =
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
-    | Ind ind ->
-        let (mib,mip) = Global.lookup_pinductive ind in
+let match_with_empty_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
         let nconstr = Array.length mip.mind_consnames in
 	if Int.equal nconstr 0 then Some hdapp else None
     | _ ->  None
 
-let is_empty_type t = op2bool (match_with_empty_type t)
+let is_empty_type sigma t = op2bool (match_with_empty_type sigma t)
 
 (* This filters inductive types with one constructor with no arguments;
    Parameters and indices are allowed *)
 
-let match_with_unit_or_eq_type t =
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
-    | Ind ind  ->
-        let (mib,mip) = Global.lookup_pinductive ind in
+let match_with_unit_or_eq_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
         let constr_types = mip.mind_nf_lc in
         let nconstr = Array.length mip.mind_consnames in
-        let zero_args c = Int.equal (nb_prod c) mib.mind_nparams in
+        let zero_args c = Int.equal (nb_prod sigma (EConstr.of_constr c)) mib.mind_nparams in
 	if Int.equal nconstr 1 && zero_args constr_types.(0) then
 	  Some hdapp
 	else
 	  None
     | _ -> None
 
-let is_unit_or_eq_type t = op2bool (match_with_unit_or_eq_type t)
+let is_unit_or_eq_type sigma t = op2bool (match_with_unit_or_eq_type sigma t)
 
 (* A unit type is an inductive type with no indices but possibly
    (useless) parameters, and that has no arguments in its unique
    constructor *)
 
-let is_unit_type t =
-  match match_with_conjunction t with
+let is_unit_type sigma t =
+  match match_with_conjunction sigma t with
   | Some (_,[]) -> true
   | _ -> false
 
@@ -246,16 +261,16 @@ open Decl_kinds
 open Evar_kinds
 
 let mkPattern c = snd (Patternops.pattern_of_glob_constr c)
-let mkGApp f args = GApp (Loc.ghost, f, args)
-let mkGHole =
-  GHole (Loc.ghost, QuestionMark (Define false), Misctypes.IntroAnonymous, None)
-let mkGProd id c1 c2 =
-  GProd (Loc.ghost, Name (Id.of_string id), Explicit, c1, c2)
-let mkGArrow c1 c2 =
-  GProd (Loc.ghost, Anonymous, Explicit, c1, c2)
-let mkGVar id = GVar (Loc.ghost, Id.of_string id)
-let mkGPatVar id = GPatVar(Loc.ghost, (false, Id.of_string id))
-let mkGRef r = GRef (Loc.ghost, Lazy.force r, None)
+let 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 = DAst.make @@
+  GProd (Name (Id.of_string id), Explicit, c1, c2)
+let mkGArrow c1 c2 = DAst.make @@
+  GProd (Anonymous, Explicit, c1, c2)
+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 *)
@@ -274,13 +289,10 @@ let coq_refl_jm_pattern       =
 
 open Globnames
 
-let is_matching x y = is_matching (Global.env ()) Evd.empty x y
-let matches x y = matches (Global.env ()) Evd.empty x y
-
-let match_with_equation t =
-  if not (isApp t) then raise NoEquationFound;
-  let (hdapp,args) = destApp t in
-  match kind_of_term hdapp with
+let match_with_equation env sigma t =
+  if not (isApp sigma t) then raise NoEquationFound;
+  let (hdapp,args) = destApp sigma t in
+  match EConstr.kind sigma hdapp with
   | Ind (ind,u) ->
       if eq_gr (IndRef ind) glob_eq then
 	Some (build_coq_eq_data()),hdapp,
@@ -296,11 +308,11 @@ let match_with_equation t =
         let constr_types = mip.mind_nf_lc in
         let nconstr = Array.length mip.mind_consnames in
 	if Int.equal nconstr 1 then
-          if is_matching coq_refl_leibniz1_pattern constr_types.(0) then
+          if is_matching env sigma coq_refl_leibniz1_pattern (EConstr.of_constr constr_types.(0)) then
 	    None, hdapp, MonomorphicLeibnizEq(args.(0),args.(1))
-	  else if is_matching coq_refl_leibniz2_pattern constr_types.(0) then
+	  else if is_matching env sigma coq_refl_leibniz2_pattern (EConstr.of_constr constr_types.(0)) then
 	    None, hdapp, PolymorphicLeibnizEq(args.(0),args.(1),args.(2))
-	  else if is_matching coq_refl_jm_pattern constr_types.(0) then
+	  else if is_matching env sigma coq_refl_jm_pattern (EConstr.of_constr constr_types.(0)) then
 	    None, hdapp, HeterogenousEq(args.(0),args.(1),args.(2),args.(3))
 	  else raise NoEquationFound
         else raise NoEquationFound
@@ -316,84 +328,87 @@ let is_inductive_equality ind =
   let nconstr = Array.length mip.mind_consnames in
   Int.equal nconstr 1 && Int.equal (constructor_nrealargs (ind,1)) 0
 
-let match_with_equality_type t =
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
+let match_with_equality_type sigma t =
+  let (hdapp,args) = decompose_app sigma t in
+  match EConstr.kind sigma hdapp with
   | Ind (ind,_) when is_inductive_equality ind -> Some (hdapp,args)
   | _ -> None
 
-let is_equality_type t = op2bool (match_with_equality_type t)
+let is_equality_type sigma t = op2bool (match_with_equality_type sigma t)
 
 (* Arrows/Implication/Negation *)
 
 (** X1 -> X2 **)
 let coq_arrow_pattern = mkPattern (mkGArrow (mkGPatVar "X1") (mkGPatVar "X2"))
 
-let match_arrow_pattern t =
-  let result = matches coq_arrow_pattern t in
+let match_arrow_pattern env sigma t =
+  let result = matches env sigma coq_arrow_pattern t in
   match Id.Map.bindings result with
     | [(m1,arg);(m2,mind)] ->
       assert (Id.equal m1 meta1 && Id.equal m2 meta2); (arg, mind)
-    | _ -> anomaly (Pp.str "Incorrect pattern matching")
+    | _ -> anomaly (Pp.str "Incorrect pattern matching.")
 
-let match_with_imp_term c=
-  match kind_of_term c with
-    | Prod (_,a,b) when not (dependent (mkRel 1) b) ->Some (a,b)
+let match_with_imp_term sigma c =
+  match EConstr.kind sigma c with
+    | Prod (_,a,b) when Vars.noccurn sigma 1 b -> Some (a,b)
     | _              -> None
 
-let is_imp_term c = op2bool (match_with_imp_term c)
+let is_imp_term sigma c = op2bool (match_with_imp_term sigma c)
 
-let match_with_nottype t =
+let match_with_nottype env sigma t =
   try
-    let (arg,mind) = match_arrow_pattern t in
-    if is_empty_type mind then Some (mind,arg) else None
+    let (arg,mind) = match_arrow_pattern env sigma t in
+    if is_empty_type sigma mind then Some (mind,arg) else None
   with PatternMatchingFailure -> None
 
-let is_nottype t = op2bool (match_with_nottype t)
+let is_nottype env sigma t = op2bool (match_with_nottype env sigma t)
 
 (* Forall *)
 
-let match_with_forall_term c=
-  match kind_of_term c with
+let match_with_forall_term sigma c=
+  match EConstr.kind sigma c with
     | Prod (nam,a,b) -> Some (nam,a,b)
     | _            -> None
 
-let is_forall_term c = op2bool (match_with_forall_term c)
-
-let match_with_nodep_ind t =
-  let (hdapp,args) = decompose_app t in
-    match (kind_of_term hdapp) with
-      | Ind ind  ->
-          let (mib,mip) = Global.lookup_pinductive ind in
-	    if Array.length (mib.mind_packets)>1 then None else
-	      let nodep_constr = has_nodep_prod_after mib.mind_nparams in
-		if Array.for_all nodep_constr mip.mind_nf_lc then
-		  let params=
-		    if 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 t=op2bool (match_with_nodep_ind t)
-
-let match_with_sigma_type t=
-  let (hdapp,args) = decompose_app t in
-  match (kind_of_term hdapp) with
-    | Ind ind  ->
-        let (mib,mip) = Global.lookup_pinductive 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) mip.mind_nf_lc.(0) then
-	      (*allowing only 1 existential*)
-	      Some (hdapp,args)
-	  else
-	    None
-    | _ -> None
+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 (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 (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 t=op2bool (match_with_sigma_type t)
+let is_sigma_type sigma t = op2bool (match_with_sigma_type sigma t)
 
 (***** Destructing patterns bound to some theory *)
 
@@ -406,17 +421,17 @@ let rec first_match matcher = function
 
 (*** Equality *)
 
-let match_eq eqn (ref, hetero) =
+let match_eq sigma eqn (ref, hetero) =
   let ref =
     try Lazy.force ref
     with e when CErrors.noncritical e -> raise PatternMatchingFailure
   in
-  match kind_of_term eqn with
+  match EConstr.kind sigma eqn with
   | App (c, [|t; x; y|]) ->
-    if not hetero && is_global ref c then PolymorphicLeibnizEq (t, x, y)
+    if not hetero && Termops.is_global sigma ref c then PolymorphicLeibnizEq (t, x, y)
     else raise PatternMatchingFailure
   | App (c, [|t; x; t'; x'|]) ->
-    if hetero && is_global ref c then HeterogenousEq (t, x, t', x')
+    if hetero && Termops.is_global sigma ref c then HeterogenousEq (t, x, t', x')
     else raise PatternMatchingFailure
   | _ -> raise PatternMatchingFailure
 
@@ -428,9 +443,9 @@ let equalities =
    (coq_jmeq_ref, true), check_jmeq_loaded, build_coq_jmeq_data;
    (coq_identity_ref, false), no_check, build_coq_identity_data]
 
-let find_eq_data eqn = (* fails with PatternMatchingFailure *)
-  let d,k = first_match (match_eq eqn) equalities in
-  let hd,u = destInd (fst (destApp eqn)) in
+let find_eq_data sigma eqn = (* fails with PatternMatchingFailure *)
+  let d,k = first_match (match_eq sigma eqn) equalities in
+  let hd,u = destInd sigma (fst (destApp sigma eqn)) in
     d,u,k
 
 let extract_eq_args gl = function
@@ -442,60 +457,44 @@ let extract_eq_args gl = function
       else raise PatternMatchingFailure
 
 let find_eq_data_decompose gl eqn =
-  let (lbeq,u,eq_args) = find_eq_data eqn in
+  let (lbeq,u,eq_args) = find_eq_data (project gl) eqn in
   (lbeq,u,extract_eq_args gl eq_args)
 
 let find_this_eq_data_decompose gl eqn =
   let (lbeq,u,eq_args) =
     try (*first_match (match_eq eqn) inversible_equalities*)
-      find_eq_data eqn
+      find_eq_data (project gl) eqn
     with PatternMatchingFailure ->
-      errorlabstrm "" (str "No primitive equality found.") in
+      user_err  (str "No primitive equality found.") in
   let eq_args =
     try extract_eq_args gl eq_args
     with PatternMatchingFailure ->
-      error "Don't know what to do with JMeq on arguments not of same type." in
+      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 ->
-    error "Not an equality."
-
 (*** Sigma-types *)
 
-let match_sigma ex =
-  match kind_of_term ex with
-  | App (f, [| a; p; car; cdr |]) when is_global (Lazy.force coq_exist_ref) f -> 
-      build_sigma (), (snd (destConstruct f), a, p, car, cdr)
-  | App (f, [| a; p; car; cdr |]) when is_global (Lazy.force coq_existT_ref) f -> 
-    build_sigma_type (), (snd (destConstruct f), a, p, car, cdr)
+let match_sigma env sigma ex =
+  match EConstr.kind sigma ex with
+  | App (f, [| a; p; car; cdr |]) when Termops.is_global sigma (Lazy.force coq_exist_ref) f -> 
+      build_sigma (), (snd (destConstruct sigma f), a, p, car, cdr)
+  | App (f, [| a; p; car; cdr |]) when Termops.is_global sigma (Lazy.force coq_existT_ref) f -> 
+    build_sigma_type (), (snd (destConstruct sigma f), a, p, car, cdr)
   | _ -> raise PatternMatchingFailure
     
-let find_sigma_data_decompose ex = (* fails with PatternMatchingFailure *)
-  match_sigma ex
+let find_sigma_data_decompose env ex = (* fails with PatternMatchingFailure *)
+  match_sigma env ex
 
 (* Pattern "(sig ?1 ?2)" *)
 let coq_sig_pattern =
   lazy (mkPattern (mkGAppRef coq_sig_ref [mkGPatVar "X1"; mkGPatVar "X2"]))
 
-let match_sigma t =
-  match Id.Map.bindings (matches (Lazy.force coq_sig_pattern) t) with
+let match_sigma env sigma t =
+  match Id.Map.bindings (matches env sigma (Lazy.force coq_sig_pattern) t) with
     | [(_,a); (_,p)] -> (a,p)
-    | _ -> anomaly (Pp.str "Unexpected pattern")
+    | _ -> anomaly (Pp.str "Unexpected pattern.")
 
-let is_matching_sigma t = is_matching (Lazy.force coq_sig_pattern) t
+let is_matching_sigma env sigma t = is_matching env sigma (Lazy.force coq_sig_pattern) t
 
 (*** Decidable equalities *)
 
@@ -512,10 +511,10 @@ let coq_eqdec ~sum ~rev =
     mkPattern (mkGAppRef sum args)
   )
 
-(** { ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 } *)
+(** [{ ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 }] *)
 let coq_eqdec_inf_pattern = coq_eqdec ~sum:coq_sumbool_ref ~rev:false
 
-(** { ~ ?X2 = ?X3 :> ?X1 } + { ?X2 = ?X3 :> ?X1 } *)
+(** [{ ~ ?X2 = ?X3 :> ?X1 } + { ?X2 = ?X3 :> ?X1 }] *)
 let coq_eqdec_inf_rev_pattern = coq_eqdec ~sum:coq_sumbool_ref ~rev:true
 
 (** %coq_or_ref (?X2 = ?X3 :> ?X1) (~ ?X2 = ?X3 :> ?X1) *)
@@ -527,26 +526,26 @@ let coq_eqdec_rev_pattern = coq_eqdec ~sum:coq_or_ref ~rev:true
 let op_or = coq_or_ref
 let op_sum = coq_sumbool_ref
 
-let match_eqdec t =
+let match_eqdec env sigma t =
   let eqonleft,op,subst =
-    try true,op_sum,matches (Lazy.force coq_eqdec_inf_pattern) t
+    try true,op_sum,matches env sigma (Lazy.force coq_eqdec_inf_pattern) t
     with PatternMatchingFailure ->
-    try false,op_sum,matches (Lazy.force coq_eqdec_inf_rev_pattern) t
+    try false,op_sum,matches env sigma (Lazy.force coq_eqdec_inf_rev_pattern) t
     with PatternMatchingFailure ->
-    try true,op_or,matches (Lazy.force coq_eqdec_pattern) t
+    try true,op_or,matches env sigma (Lazy.force coq_eqdec_pattern) t
     with PatternMatchingFailure ->
-        false,op_or,matches (Lazy.force coq_eqdec_rev_pattern) t in
+        false,op_or,matches env sigma (Lazy.force coq_eqdec_rev_pattern) t in
   match Id.Map.bindings subst with
   | [(_,typ);(_,c1);(_,c2)] ->
-      eqonleft, Universes.constr_of_global (Lazy.force op), c1, c2, typ
-  | _ -> anomaly (Pp.str "Unexpected pattern")
+      eqonleft, Lazy.force op, c1, c2, typ
+  | _ -> anomaly (Pp.str "Unexpected pattern.")
 
 (* Patterns "~ ?" and "? -> False" *)
 let coq_not_pattern = lazy (mkPattern (mkGAppRef coq_not_ref [mkGHole]))
 let coq_imp_False_pattern = lazy (mkPattern (mkGArrow mkGHole (mkGRef coq_False_ref)))
 
-let is_matching_not t = is_matching (Lazy.force coq_not_pattern) t
-let is_matching_imp_False t = is_matching (Lazy.force coq_imp_False_pattern) t
+let is_matching_not env sigma t = is_matching env sigma (Lazy.force coq_not_pattern) t
+let is_matching_imp_False env sigma t = is_matching env sigma (Lazy.force coq_imp_False_pattern) t
 
 (* Remark: patterns that have references to the standard library must
    be evaluated lazily (i.e. at the time they are used, not a the time
diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli
index 7cc41f1b..0697d0f1 100644
--- a/tactics/hipattern.mli
+++ b/tactics/hipattern.mli
@@ -1,13 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Evd
+open EConstr
 open Coqlib
 
 (** High-order patterns *)
@@ -40,8 +43,8 @@ open Coqlib
    also work on ad-hoc disjunctions introduced by the user.
    (Eduardo, 6/8/97). *)
 
-type 'a matching_function = constr -> 'a option
-type testing_function = constr -> bool
+type 'a matching_function = evar_map -> constr -> 'a option
+type testing_function = evar_map -> constr -> bool
 
 val match_with_non_recursive_type : (constr * constr list) matching_function
 val is_non_recursive_type         : testing_function
@@ -80,8 +83,8 @@ val is_inductive_equality  : inductive -> bool
 val match_with_equality_type : (constr * constr list) matching_function
 val is_equality_type       : testing_function
 
-val match_with_nottype     : (constr * constr) matching_function
-val is_nottype             : testing_function
+val match_with_nottype     : Environ.env -> (constr * constr) matching_function
+val is_nottype             : Environ.env -> testing_function
 
 val match_with_forall_term    : (Name.t * constr * constr) matching_function
 val is_forall_term            : testing_function
@@ -113,39 +116,36 @@ type equation_kind =
 exception NoEquationFound
 
 val match_with_equation:
-  constr -> coq_eq_data option * constr * equation_kind
+  Environ.env -> evar_map -> constr -> coq_eq_data option * constr * equation_kind
 
 (***** Destructing patterns bound to some theory *)
 
 (** 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 : ([ `NF ], 'r) Proofview.Goal.t -> constr ->
-      coq_eq_data * Univ.universe_instance * (types * constr * 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 : ([ `NF ], 'r) Proofview.Goal.t -> constr ->
-      coq_eq_data * Univ.universe_instance * (types * constr * 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 *)
-val find_eq_data : constr -> coq_eq_data * Univ.universe_instance * equation_kind
+val find_eq_data : evar_map -> constr -> coq_eq_data * EInstance.t * equation_kind
 
 (** Match a term of the form [(existT A P t p)] 
    Returns associated lemmas and [A,P,t,p] *)
-val find_sigma_data_decompose : constr ->
-  coq_sigma_data * (Univ.universe_instance * constr * constr * constr * constr)
+val find_sigma_data_decompose : Environ.env -> evar_map -> constr ->
+  coq_sigma_data * (EInstance.t * constr * constr * constr * constr)
 
 (** Match a term of the form [{x:A|P}], returns [A] and [P] *)
-val match_sigma : constr -> constr * constr
+val match_sigma : Environ.env -> evar_map -> constr -> constr * constr
 
-val is_matching_sigma : constr -> bool
+val is_matching_sigma : Environ.env -> evar_map -> constr -> bool
 
 (** Match a decidable equality judgement (e.g [{t=u:>T}+{~t=u}]), returns
    [t,u,T] and a boolean telling if equality is on the left side *)
-val match_eqdec : constr -> bool * constr * constr * constr * constr
-
-(** Match an equality up to conversion; returns [(eq,t1,t2)] in normal form *)
-val dest_nf_eq : ([ `NF ], 'r) Proofview.Goal.t -> constr -> (constr * constr * constr)
+val match_eqdec : Environ.env -> evar_map -> constr -> bool * Globnames.global_reference * constr * constr * constr
 
 (** Match a negation *)
-val is_matching_not : constr -> bool
-val is_matching_imp_False : constr -> bool
+val is_matching_not : Environ.env -> evar_map -> constr -> bool
+val is_matching_imp_False : Environ.env -> evar_map -> constr -> bool
diff --git a/toplevel/ind_tables.ml b/tactics/ind_tables.ml
index 6d57a21d..62ead57f 100644
--- a/toplevel/ind_tables.ml
+++ b/tactics/ind_tables.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File created by Vincent Siles, Oct 2007, extended into a generic
@@ -17,7 +19,7 @@ open Mod_subst
 open Libobject
 open Nameops
 open Declarations
-open Term
+open Constr
 open CErrors
 open Util
 open Declare
@@ -29,7 +31,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 +59,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);
@@ -81,13 +83,13 @@ let scheme_object_table =
 let declare_scheme_object s aux f =
   let () =
     if not (Id.is_valid ("ind" ^ s)) then
-      error ("Illegal induction scheme suffix: " ^ s)
+      user_err Pp.(str ("Illegal induction scheme suffix: " ^ s))
   in
   let key = if String.is_empty aux then s else aux in
   try
     let _ = Hashtbl.find scheme_object_table key in
 (*    let aux_msg = if aux="" then "" else " (with key "^aux^")" in*)
-    errorlabstrm "IndTables.declare_scheme_object"
+    user_err ~hdr:"IndTables.declare_scheme_object"
       (str "Scheme object " ++ str key ++ str " already declared.")
   with Not_found ->
     Hashtbl.add scheme_object_table key (s,f);
@@ -120,17 +122,19 @@ let compute_name internal id =
 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 ctx = UState.minimize univs in
+  let c = Universes.subst_opt_univs_constr (UState.subst ctx) c in
+  let univs =
+    if p then Polymorphic_const_entry (UState.context ctx)
+    else Monomorphic_const_entry (UState.context_set ctx)
+  in
   let entry = {
     const_entry_body =
       Future.from_val ((c,Univ.ContextSet.empty),
                        Safe_typing.empty_private_constants);
     const_entry_secctx = None;
     const_entry_type = None;
-    const_entry_polymorphic = p;
-    const_entry_universes = Evd.evar_context_universe_context ctx;
+    const_entry_universes = univs;
     const_entry_opaque = false;
     const_entry_inline_code = false;
     const_entry_feedback = None;
@@ -148,10 +152,10 @@ let define_individual_scheme_base kind suff f mode idopt (mind,i as ind) =
   let id = match idopt with
     | Some id -> id
     | None -> add_suffix mib.mind_packets.(i).mind_typename suff in
-  let const = define mode id c mib.mind_polymorphic ctx in
+  let const = define mode id c (Declareops.inductive_is_polymorphic mib) ctx in
   declare_scheme kind [|ind,const|];
   const, Safe_typing.add_private
-     (Safe_typing.private_con_of_scheme kind (Global.safe_env()) [ind,const]) eff
+     (Safe_typing.private_con_of_scheme ~kind (Global.safe_env()) [ind,const]) eff
 
 let define_individual_scheme kind mode names (mind,i as ind) =
   match Hashtbl.find scheme_object_table kind with
@@ -166,13 +170,13 @@ let define_mutual_scheme_base kind suff f mode names mind =
       try Int.List.assoc i names
       with Not_found -> add_suffix mib.mind_packets.(i).mind_typename suff) in
   let consts = Array.map2 (fun id cl -> 
-     define mode id cl mib.mind_polymorphic ctx) ids cl in
+     define mode id cl (Declareops.inductive_is_polymorphic mib) ctx) ids cl in
   let schemes = Array.mapi (fun i cst -> ((mind,i),cst)) consts in
   declare_scheme kind schemes;
   consts,
   Safe_typing.add_private 
     (Safe_typing.private_con_of_scheme
-      kind (Global.safe_env()) (Array.to_list schemes))
+      ~kind (Global.safe_env()) (Array.to_list schemes))
     eff 
 
 let define_mutual_scheme kind mode names mind =
@@ -185,7 +189,7 @@ let find_scheme_on_env_too kind ind =
   let s = String.Map.find kind (Indmap.find ind !scheme_map) in
   s, Safe_typing.add_private
       (Safe_typing.private_con_of_scheme
-            kind (Global.safe_env()) [ind, s])
+            ~kind (Global.safe_env()) [ind, s])
       Safe_typing.empty_private_constants
 
 let find_scheme ?(mode=InternalTacticRequest) kind (mind,i as ind) =
diff --git a/toplevel/ind_tables.mli b/tactics/ind_tables.mli
index 20f30d6d..0eb4e47a 100644
--- a/toplevel/ind_tables.mli
+++ b/tactics/ind_tables.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
 open Names
+open Constr
 open Declare
 
 (** This module provides support for registering inductive scheme builders,
@@ -20,7 +22,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,15 +39,15 @@ 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
 
 
-val pr_scheme_kind : 'a scheme_kind -> Pp.std_ppcmds
+val pr_scheme_kind : 'a scheme_kind -> Pp.t
diff --git a/tactics/inv.ml b/tactics/inv.ml
index bda16b01..067fc894 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -1,21 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Names
-open Nameops
 open Term
-open Vars
 open Termops
+open EConstr
+open Vars
 open Namegen
-open Environ
 open Inductiveops
 open Printer
 open Retyping
@@ -25,15 +26,15 @@ open Tactics
 open Elim
 open Equality
 open Misctypes
-open Tacexpr
-open Sigma.Notations
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 let var_occurs_in_pf gl id =
   let env = Proofview.Goal.env gl in
-  occur_var env id (Proofview.Goal.concl gl) ||
-  List.exists (occur_var_in_decl env id) (Proofview.Goal.hyps gl)
+  let sigma = project gl in
+  occur_var env sigma id (Proofview.Goal.concl gl) ||
+  List.exists (occur_var_in_decl env sigma id) (Proofview.Goal.hyps gl)
 
 (* [make_inv_predicate (ity,args) C]
 
@@ -73,11 +74,12 @@ let make_inv_predicate env evd indf realargs id status concl =
       | NoDep ->
 	  (* We push the arity and leave concl unchanged *)
 	  let hyps_arity,_ = get_arity env indf in
+	  let hyps_arity = List.map (fun d -> map_rel_decl EConstr.of_constr d) hyps_arity in
 	    (hyps_arity,concl)
       | Dep dflt_concl ->
-	  if not (occur_var env id concl) then
-	    errorlabstrm "make_inv_predicate"
-              (str "Current goal does not depend on " ++ pr_id id ++ str".");
+	  if not (occur_var env !evd id concl) then
+	    user_err ~hdr:"make_inv_predicate"
+              (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 *)
@@ -87,11 +89,11 @@ let make_inv_predicate env evd indf realargs id status concl =
               | None ->
 		let sort = get_sort_family_of env !evd concl in
 		let sort = Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd sort in
-		let p = make_arity env true indf sort in
+		let p = make_arity env !evd true indf sort in
 		let evd',(p,ptyp) = Unification.abstract_list_all env
                   !evd p concl (realargs@[mkVar id])
 		in evd := evd'; p in
-	  let hyps,bodypred = decompose_lam_n_assum (nrealargs+1) pred in
+	  let hyps,bodypred = decompose_lam_n_assum !evd (nrealargs+1) pred in
 	  (* We lift to make room for the equations *)
 	  (hyps,lift nrealargs bodypred)
   in
@@ -109,7 +111,7 @@ let make_inv_predicate env evd indf realargs id status concl =
         let ai = lift nhyps ai in
         let (xi, ti) = compute_eqn env' !evd nhyps n ai in
         let (lhs,eqnty,rhs) =
-          if closed0 ti then
+          if closed0 !evd ti then
 	    (xi,ti,ai)
           else
 	    let sigma, res = make_iterated_tuple env' !evd ai (xi,ti) in
@@ -117,17 +119,19 @@ let make_inv_predicate env evd indf realargs id status concl =
 	in
         let eq_term = eqdata.Coqlib.eq in
 	let eq = Evarutil.evd_comb1 (Evd.fresh_global env) evd eq_term in
+        let eq = EConstr.of_constr eq in
         let eqn = applist (eq,[eqnty;lhs;rhs]) in
         let eqns = (Anonymous, lift n eqn) :: eqns in
         let refl_term = eqdata.Coqlib.refl in
 	let refl_term = Evarutil.evd_comb1 (Evd.fresh_global env) evd refl_term in
+	let refl_term = EConstr.of_constr refl_term in
         let refl = mkApp (refl_term, [|eqnty; rhs|]) in
 	let _ = Evarutil.evd_comb1 (Typing.type_of env) evd refl in
         let args = refl :: args in
         build_concl eqns args (succ n) restlist
   in
   let (newconcl, args) = build_concl [] [] 0 realargs in
-  let predicate = it_mkLambda_or_LetIn_name env newconcl hyps in
+  let predicate = it_mkLambda_or_LetIn newconcl (name_context env !evd hyps) in
   let _ = Evarutil.evd_comb1 (Typing.type_of env) evd predicate in
   (* OK - this predicate should now be usable by res_elimination_then to
      do elimination on the conclusion. *)
@@ -182,8 +186,8 @@ let dependent_hyps env id idlist gl =
     | [] -> []
     | d::l ->
 	(* Update the type of id1: it may have been subject to rewriting *)
-	let d = pf_get_hyp (get_id d) gl in
-	if occur_var_in_decl env id d
+	let d = pf_get_hyp (NamedDecl.get_id d) gl in
+	if occur_var_in_decl env (project gl) id d
         then d :: dep_rec l
         else dep_rec l
   in
@@ -192,7 +196,7 @@ let dependent_hyps env id idlist gl =
 let split_dep_and_nodep hyps gl =
   List.fold_right
     (fun d (l1,l2) ->
-       if var_occurs_in_pf gl (get_id d) then (d::l1,l2) else (l1,d::l2))
+       if var_occurs_in_pf gl (NamedDecl.get_id d) then (d::l1,l2) else (l1,d::l2))
     hyps ([],[])
 
 (* Computation of dids is late; must have been done in rewrite_equations*)
@@ -268,47 +272,50 @@ Nota: with Inversion_clear, only four useless hypotheses
 
 let generalizeRewriteIntros as_mode tac depids id =
   Proofview.tclENV >>= fun env ->
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let dids = dependent_hyps env id depids gl in
   let reintros = if as_mode then intros_replacing else intros_possibly_replacing in
   (tclTHENLIST
     [bring_hyps dids; tac;
      (* may actually fail to replace if dependent in a previous eq *)
      reintros (ids_of_named_context dids)])
-  end }
+  end
 
 let error_too_many_names pats =
-  let loc = Loc.join_loc (fst (List.hd pats)) (fst (List.last pats)) in
+  let loc = Loc.merge_opt (List.hd pats).CAst.loc (List.last pats).CAst.loc in
   Proofview.tclENV >>= fun env ->
-  tclZEROMSG ~loc (
+  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 (fst (run_delayed env Evd.empty c)))) 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
+let get_names (allow_conj,issimple) ({CAst.loc;v=pat} as x) = match pat with
   | IntroNaming IntroAnonymous | IntroForthcoming _ ->
-      error "Anonymous pattern not allowed for inversion equations."
+      user_err Pp.(str "Anonymous pattern not allowed for inversion equations.")
   | IntroNaming (IntroFresh _) ->
-      error "Fresh pattern not allowed for inversion equations."
+      user_err Pp.(str "Fresh pattern not allowed for inversion equations.")
   | IntroAction IntroWildcard ->
-      error "Discarding pattern not allowed for inversion equations."
+      user_err Pp.(str "Discarding pattern not allowed for inversion equations.")
   | IntroAction (IntroRewrite _) ->
-      error "Rewriting pattern not allowed for inversion equations."
+      user_err Pp.(str "Rewriting pattern not allowed for inversion equations.")
   | IntroAction (IntroOrAndPattern (IntroAndPattern [])) when allow_conj -> (None, [])
-  | IntroAction (IntroOrAndPattern (IntroAndPattern ((_,IntroNaming (IntroIdentifier id)) :: _ as l) | IntroOrPattern [(_,IntroNaming (IntroIdentifier id)) :: _ as l ]))
+  | IntroAction (IntroOrAndPattern (IntroAndPattern ({CAst.v=IntroNaming (IntroIdentifier id)} :: _ as l)
+                                   | IntroOrPattern [{CAst.v=IntroNaming (IntroIdentifier id)} :: _ as l]))
       when allow_conj -> (Some id,l)
   | IntroAction (IntroOrAndPattern (IntroAndPattern _)) ->
       if issimple then
-        error"Conjunctive patterns not allowed for simple inversion equations."
+        user_err Pp.(str"Conjunctive patterns not allowed for simple inversion equations.")
       else
-        error"Nested conjunctive patterns not allowed for inversion equations."
+        user_err Pp.(str"Nested conjunctive patterns not allowed for inversion equations.")
   | IntroAction (IntroInjection l) ->
-      error "Injection patterns not allowed for inversion equations."
+      user_err Pp.(str "Injection patterns not allowed for inversion equations.")
   | IntroAction (IntroOrAndPattern (IntroOrPattern _)) ->
-      error "Disjunctive patterns not allowed for inversion equations."
+      user_err Pp.(str "Disjunctive patterns not allowed for inversion equations.")
   | IntroAction (IntroApplyOn (c,pat)) ->
-      error "Apply patterns not allowed for inversion equations."
+      user_err Pp.(str "Apply patterns not allowed for inversion equations.")
   | IntroNaming (IntroIdentifier id) ->
       (Some id,[x])
 
@@ -331,21 +338,32 @@ 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 (mkVar id)))
+    tclTHEN (tclTRY(rewriteInConcl l2r (EConstr.mkVar id)))
       (if thin then clear [id] else (remember_first_eq id eqname; tclIDTAC))
   in
   let substHypIfVariable tac id =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    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
-    match (kind_of_term t1, kind_of_term t2) with
+    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
     | _ -> tac id
-    end }
+    end
   in
   let deq_trailer id clear_flag _ neqns =
     assert (clear_flag == None);
@@ -367,12 +385,12 @@ 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)
-	(Some (None,ElimOnConstr (mkVar id,NoBindings))))
+      dEqThen ~keep_proofs:None false (deq_trailer id)
+	(Some (None,ElimOnConstr (EConstr.mkVar id,NoBindings))))
     id
 
 let nLastDecls i tac =
-  Proofview.Goal.nf_enter { enter = begin fun gl -> tac (nLastDecls gl i) end }
+  Proofview.Goal.enter begin fun gl -> tac (nLastDecls gl i) end
 
 (* Introduction of the equations on arguments
    othin: discriminates Simple Inversion, Inversion and Inversion_clear
@@ -380,10 +398,10 @@ let nLastDecls i tac =
      Some thin: the equations are rewritten, and cleared if thin is true *)
 
 let rewrite_equations as_mode othin neqns names ba =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  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 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
@@ -399,10 +417,10 @@ let rewrite_equations as_mode othin neqns names ba =
 		   tclTRY (projectAndApply as_mode thin avoid id first_eq names depids)))))
 	       names;
 	     tclMAP (fun d -> tclIDTAC >>= fun () -> (* delay for [first_eq]. *)
-               let idopt = if as_mode then Some (get_id d) else None in
+               let idopt = if as_mode then Some (NamedDecl.get_id d) else None in
 	       intro_move idopt (if thin then MoveLast else !first_eq))
 	       nodepids;
-	     (tclMAP (fun d -> tclTRY (clear [get_id d])) depids)]
+	     (tclMAP (fun d -> tclTRY (clear [NamedDecl.get_id d])) depids)]
     | None ->
         (* simple inversion *)
         if as_mode then
@@ -413,7 +431,7 @@ let rewrite_equations as_mode othin neqns names ba =
              [tclDO neqns intro;
               bring_hyps nodepids;
               clear (ids_of_named_context nodepids)])
-  end }
+  end
 
 let interp_inversion_kind = function
   | SimpleInversion -> None
@@ -430,17 +448,16 @@ let rewrite_equations_tac as_mode othin id neqns names ba =
     tac
 
 let raw_inversion inv_kind id status names =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let sigma = Sigma.to_evar_map sigma in
     let env = Proofview.Goal.env gl in
     let concl = Proofview.Goal.concl gl in
     let c = mkVar id in
     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
-        CErrors.errorlabstrm "" msg
+        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
     let evdref = ref sigma in
@@ -448,30 +465,28 @@ let raw_inversion inv_kind id status names =
       make_inv_predicate env evdref indf realargs id status concl in
     let sigma = !evdref in
     let (cut_concl,case_tac) =
-      if status != NoDep && (dependent c concl) then
-        Reduction.beta_appvect elim_predicate (Array.of_list (realargs@[c])),
+      if status != NoDep && (dependent sigma c concl) then
+        Reductionops.beta_applist sigma (elim_predicate, realargs@[c]),
         case_then_using
       else
-        Reduction.beta_appvect elim_predicate (Array.of_list realargs),
+        Reductionops.beta_applist sigma (elim_predicate, realargs),
         case_nodep_then_using
     in
     let refined id =
       let prf = mkApp (mkVar id, args) in
-      Refine.refine { run = fun h -> Sigma (prf, h, Sigma.refl) }
+      Refine.refine ~typecheck:false (fun h -> (h, prf))
     in
     let neqns = List.length realargs in
     let as_mode = names != None in
-    let tac =
+    tclTHEN (Proofview.Unsafe.tclEVARS sigma)
       (tclTHENS
         (assert_before Anonymous cut_concl)
         [case_tac names
             (introCaseAssumsThen false (* ApplyOn not supported by inversion *)
                (rewrite_equations_tac as_mode inv_kind id neqns))
-            (Some elim_predicate) ind (c, t);
+            (Some elim_predicate) ind (c,t);
         onLastHypId (fun id -> tclTHEN (refined id) reflexivity)])
-    in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+  end
 
 (* Error messages of the inversion tactics *)
 let wrap_inv_error id = function (e, info) -> match e with
@@ -496,8 +511,6 @@ let inversion inv_kind status names id =
 let inv_gen thin status names =
   try_intros_until (inversion thin status names)
 
-open Tacexpr
-
 let inv k = inv_gen k NoDep
 
 let inv_tac id       = inv FullInversion None (NamedHyp id)
@@ -513,21 +526,23 @@ let dinv_clear_tac id = dinv FullInversionClear None None (NamedHyp id)
  * back to their places in the hyp-list. *)
 
 let invIn k names ids id =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let hyps = List.map (fun id -> pf_get_hyp id gl) ids in
     let concl = Proofview.Goal.concl gl in
-    let nb_prod_init = nb_prod concl in
+    let sigma = project gl in
+    let nb_prod_init = nb_prod sigma concl in
     let intros_replace_ids =
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let concl = pf_nf_concl gl in
+      Proofview.Goal.enter begin fun gl ->
+        let concl = pf_concl gl in
+        let sigma = project gl in
         let nb_of_new_hyp =
-          nb_prod concl - (List.length hyps + nb_prod_init)
+          nb_prod sigma concl - (List.length hyps + nb_prod_init)
         in
         if nb_of_new_hyp < 1 then
           intros_replacing ids
         else
           tclTHEN (tclDO nb_of_new_hyp intro) (intros_replacing ids)
-      end }
+      end
     in
     Proofview.tclORELSE
       (tclTHENLIST
@@ -535,7 +550,7 @@ let invIn k names ids id =
           inversion k NoDep names id;
           intros_replace_ids])
       (wrap_inv_error id)
-  end }
+  end
 
 let invIn_gen k names idl = try_intros_until (invIn k names idl)
 
diff --git a/tactics/inv.mli b/tactics/inv.mli
index af1cb996..c63d57af 100644
--- a/tactics/inv.mli
+++ b/tactics/inv.mli
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Misctypes
-open Tacexpr
+open Tactypes
 
 type inversion_status = Dep of constr option | NoDep
 
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index 40b600c8..a4cdc159 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,27 +13,29 @@ open CErrors
 open Util
 open Names
 open Term
-open Vars
 open Termops
+open Environ
+open EConstr
+open Vars
 open Namegen
 open Evd
 open Printer
 open Reductionops
 open Entries
 open Inductiveops
-open Environ
 open Tacmach.New
 open Clenv
 open Declare
 open Tacticals.New
 open Tactics
 open Decl_kinds
-open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let no_inductive_inconstr env sigma constr =
   (str "Cannot recognize an inductive predicate in " ++
-     pr_lconstr_env env sigma constr ++
+     pr_leconstr_env env sigma constr ++
      str "." ++ spc () ++ str "If there is one, may be the structure of the arity" ++
      spc () ++ str "or of the type of constructors" ++ spc () ++
      str "is hidden by constant definitions.")
@@ -114,13 +118,13 @@ let max_prefix_sign lid sign =
     | id::l -> snd (max_rec (id, sign_prefix id sign) l)
 *)
 let rec add_prods_sign env sigma t =
-  match kind_of_term (whd_all env sigma t) with
+  match EConstr.kind sigma (whd_all env sigma t) with
     | Prod (na,c1,b) ->
-	let id = id_of_name_using_hdchar env t na in
+	let id = id_of_name_using_hdchar env sigma t na in
 	let b'= subst1 (mkVar id) b in
         add_prods_sign (push_named (LocalAssum (id,c1)) env) sigma b'
     | LetIn (na,c1,t1,b) ->
-	let id = id_of_name_using_hdchar env t na in
+	let id = id_of_name_using_hdchar env sigma t na in
 	let b'= subst1 (mkVar id) b in
         add_prods_sign (push_named (LocalDef (id,c1,t1)) env) sigma b'
     | _ -> (env,t)
@@ -140,11 +144,11 @@ 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
-      let pty = make_arity env true indf sort in
+      let pty = make_arity env sigma true indf sort in
       let goal =
 	mkProd
 	  (Anonymous, mkAppliedInd ind, applist(mkVar p,realargs@[mkRel 1]))
@@ -152,11 +156,12 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       pty,goal
     else
       let i = mkAppliedInd ind in
-      let ivars = global_vars env i in
+      let ivars = global_vars env sigma i in
       let revargs,ownsign =
 	fold_named_context
 	  (fun env d (revargs,hyps) ->
-             let id = get_id d in
+            let d = map_named_decl EConstr.of_constr d in
+             let id = NamedDecl.get_id d in
              if Id.List.mem id ivars then
 	       ((mkVar id)::revargs, Context.Named.add d hyps)
 	     else
@@ -183,17 +188,17 @@ let inversion_scheme env sigma t sort dep_option inv_op =
   let ind =
     try find_rectype env sigma i
     with Not_found ->
-      errorlabstrm "inversion_scheme" (no_inductive_inconstr env sigma i)
+      user_err ~hdr:"inversion_scheme" (no_inductive_inconstr env sigma i)
   in
   let (invEnv,invGoal) =
     compute_first_inversion_scheme env sigma ind sort dep_option
   in
   assert
     (List.subset
-       (global_vars env invGoal)
+       (global_vars env sigma invGoal)
        (ids_of_named_context (named_context invEnv)));
   (*
-    errorlabstrm "lemma_inversion"
+    user_err ~hdr:"lemma_inversion"
     (str"Computed inversion goal was not closed in initial signature.");
   *)
   let pf = Proof.start (Evd.from_ctx (evar_universe_context sigma)) [invEnv,invGoal] in
@@ -206,84 +211,91 @@ let inversion_scheme env sigma t sort dep_option inv_op =
   let ownSign = ref begin
     fold_named_context
       (fun env d sign ->
-         if mem_named_context_val (get_id d) global_named_context then sign
+        let d = map_named_decl EConstr.of_constr d in
+         if mem_named_context_val (NamedDecl.get_id d) global_named_context then sign
 	 else Context.Named.add d sign)
       invEnv ~init:Context.Named.empty
   end in
-  let avoid = ref [] in
-  let { sigma=sigma } = Proof.V82.subgoals pf in
-  let sigma = Evd.nf_constraints sigma in
+  let avoid = ref Id.Set.empty in
+  let _,_,_,_,sigma = Proof.proof pf in
+  let sigma = Evd.minimize_universes sigma in
   let rec fill_holes c =
-    match kind_of_term c with
+    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)
-    | _ -> Constr.map fill_holes c
+    | _ -> EConstr.map sigma fill_holes c
   in
   let c = fill_holes pfterm in
   (* warning: side-effect on ownSign *)
   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 ("Case analysis",s) -> (* Reference to Indrec *)
-	  errorlabstrm "Inv needs Nodep Prop Set" s
+    |   UserError (Some "Case analysis",s) -> (* Reference to Indrec *)
+	  user_err ~hdr:"Inv needs Nodep Prop Set" s
 
 (* ================================= *)
 (* Applying a given inversion lemma  *)
 (* ================================= *)
 
-let lemInv id c gls =
+let lemInv id c =
+  Proofview.Goal.enter begin fun gls ->
   try
-    let clause = mk_clenv_type_of gls c in
-    let clause = clenv_constrain_last_binding (mkVar id) clause in
-    Proofview.V82.of_tactic (Clenvtac.res_pf clause ~flags:(Unification.elim_flags ()) ~with_evars:false) gls
+    let clause = mk_clenv_from_env (pf_env gls) (project gls) None (c, pf_unsafe_type_of gls c) in
+    let clause = clenv_constrain_last_binding (EConstr.mkVar id) clause in
+    Clenvtac.res_pf clause ~flags:(Unification.elim_flags ()) ~with_evars:false
   with
     | NoSuchBinding ->
-	errorlabstrm ""
-	  (hov 0 (pr_constr c ++ spc () ++ str "does not refer to an inversion lemma."))
+	user_err 
+	  (hov 0 (pr_econstr_env (pf_env gls) (project gls) c ++ spc () ++ str "does not refer to an inversion lemma."))
     | UserError (a,b) ->
-	 errorlabstrm "LemInv"
+	 user_err ~hdr:"LemInv"
 	   (str "Cannot refine current goal with the lemma " ++
-	      pr_lconstr_env (Refiner.pf_env gls) (Refiner.project gls) c)
+	      pr_leconstr_env (pf_env gls) (project gls) c)
+  end
 
-let lemInv_gen id c = try_intros_until (fun id -> Proofview.V82.tactic (lemInv id c)) id
+let lemInv_gen id c = try_intros_until (fun id -> lemInv id c) id
 
 let lemInvIn id c ids =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let hyps = List.map (fun id -> pf_get_hyp id gl) ids in
     let intros_replace_ids =
       let concl = Proofview.Goal.concl gl in
-      let nb_of_new_hyp  = nb_prod concl - List.length ids in
+      let sigma = project gl in
+      let nb_of_new_hyp = nb_prod sigma concl - List.length ids in
       if nb_of_new_hyp < 1  then
         intros_replacing ids
       else
         (tclTHEN (tclDO nb_of_new_hyp intro) (intros_replacing ids))
     in
-    ((tclTHEN (tclTHEN (bring_hyps hyps) (Proofview.V82.tactic (lemInv id c)))
+    ((tclTHEN (tclTHEN (bring_hyps hyps) (lemInv id c))
         (intros_replace_ids)))
-  end }
+  end
 
 let lemInvIn_gen id c l = try_intros_until (fun id -> lemInvIn id c l) id
 
diff --git a/tactics/leminv.mli b/tactics/leminv.mli
index c6ed9606..2337a790 100644
--- a/tactics/leminv.mli
+++ b/tactics/leminv.mli
@@ -1,19 +1,21 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open EConstr
 open Constrexpr
 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 66da9ee1..958a205a 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -1,22 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open CErrors
 open Util
 open Names
-open Term
+open Constr
+open EConstr
 open Termops
 open Declarations
 open Tacmach
 open Clenv
-open Sigma.Notations
-open Context.Named.Declaration
+open Tactypes
+
+module NamedDecl = Context.Named.Declaration
 
 (************************************************************************)
 (* Tacticals re-exported from the Refiner module                        *)
@@ -48,10 +52,8 @@ let tclAT_LEAST_ONCE = Refiner.tclAT_LEAST_ONCE
 let tclFAIL          = Refiner.tclFAIL
 let tclFAIL_lazy     = Refiner.tclFAIL_lazy
 let tclDO            = Refiner.tclDO
-let tclWEAK_PROGRESS = Refiner.tclWEAK_PROGRESS
 let tclPROGRESS      = Refiner.tclPROGRESS
 let tclSHOWHYPS      = Refiner.tclSHOWHYPS
-let tclNOTSAMEGOAL   = Refiner.tclNOTSAMEGOAL
 let tclTHENTRY       = Refiner.tclTHENTRY
 let tclIFTHENELSE    = Refiner.tclIFTHENELSE
 let tclIFTHENSELSE   = Refiner.tclIFTHENSELSE
@@ -68,9 +70,9 @@ let tclTHENSEQ       = tclTHENLIST
 
 let nthDecl m gl =
   try List.nth (pf_hyps gl) (m-1)
-  with Failure _ -> error "No such assumption."
+  with Failure _ -> user_err Pp.(str "No such assumption.")
 
-let nthHypId m gl = nthDecl m gl |> get_id
+let nthHypId m gl = nthDecl m gl |> NamedDecl.get_id
 let nthHyp m gl   = mkVar (nthHypId m gl)
 
 let lastDecl gl   = nthDecl 1 gl
@@ -79,9 +81,9 @@ let lastHyp gl    = nthHyp 1 gl
 
 let nLastDecls n gl =
   try List.firstn n (pf_hyps gl)
-  with Failure _ -> error "Not enough hypotheses in the goal."
+  with Failure _ -> user_err Pp.(str "Not enough hypotheses in the goal.")
 
-let nLastHypsId n gl = List.map get_id (nLastDecls n gl)
+let nLastHypsId n gl = List.map (NamedDecl.get_id) (nLastDecls n gl)
 let nLastHyps n gl   = List.map mkVar (nLastHypsId n gl)
 
 let onNthDecl m tac gl  = tac (nthDecl m gl) gl
@@ -99,7 +101,7 @@ let onNLastHypsId n tac = onHyps (nLastHypsId n) tac
 let onNLastHyps n tac   = onHyps (nLastHyps n) tac
 
 let afterHyp id gl =
-  fst (List.split_when (Id.equal id % get_id) (pf_hyps gl))
+  fst (List.split_when (NamedDecl.get_id %> Id.equal id) (pf_hyps gl))
 
 (***************************************)
 (*           Clause Tacticals          *)
@@ -151,11 +153,11 @@ type branch_args = {
   nassums    : int;         (* number of assumptions/letin to be introduced *)
   branchsign : bool list;   (* the signature of the branch.
                                true=assumption, false=let-in *)
-  branchnames : Tacexpr.intro_patterns}
+  branchnames : intro_patterns}
 
 type branch_assumptions = {
   ba        : branch_args;       (* the branch args *)
-  assums    : Context.Named.t}   (* the list of assumptions introduced *)
+  assums    : named_context}   (* the list of assumptions introduced *)
 
 open Misctypes
 
@@ -168,23 +170,23 @@ let fix_empty_or_and_pattern nv l =
   | IntroOrPattern [[]] -> IntroOrPattern (List.make nv [])
   | _ -> l
 
-let check_or_and_pattern_size check_and loc names branchsigns =
+let check_or_and_pattern_size ?loc check_and names branchsigns =
   let n = Array.length branchsigns in
   let msg p1 p2 = strbrk "a conjunctive pattern made of " ++ int p1 ++ (if p1 == p2 then mt () else str " or " ++ int p2) ++ str " patterns" in
   let err1 p1 p2 =
-    user_err_loc (loc,"",str "Expects " ++ msg p1 p2 ++ str ".") in
+    user_err ?loc  (str "Expects " ++ msg p1 p2 ++ str ".") in
   let errn n =
-    user_err_loc (loc,"",str "Expects a disjunctive pattern with " ++ int n
+    user_err ?loc  (str "Expects a disjunctive pattern with " ++ int n
 	++ str " branches.") in
   let err1' p1 p2 =
-    user_err_loc (loc,"",strbrk "Expects a disjunctive pattern with 1 branch or " ++ msg p1 p2 ++ str ".") in
-  let errforthcoming loc =
-    user_err_loc (loc,"",strbrk "Unexpected non atomic pattern.") in
+    user_err ?loc  (strbrk "Expects a disjunctive pattern with 1 branch or " ++ msg p1 p2 ++ str ".") in
+  let errforthcoming ?loc =
+    user_err ?loc  (strbrk "Unexpected non atomic pattern.") in
   match names with
   | IntroAndPattern l ->
       if not (Int.equal n 1) then errn n;
-      let l' = List.filter (function _,IntroForthcoming _ -> true | _,IntroNaming _ | _,IntroAction _ -> false) l in
-      if l' != [] then errforthcoming (fst (List.hd l'));
+      let l' = List.filter CAst.(function {v=IntroForthcoming _} -> true | {v=IntroNaming _} | {v=IntroAction _} -> false) l in
+      if l' != [] then errforthcoming ?loc:(List.hd l').CAst.loc;
       if check_and then
         let p1 = List.count (fun x -> x) branchsigns.(0) in
         let p2 = List.length branchsigns.(0) in
@@ -192,7 +194,7 @@ let check_or_and_pattern_size check_and loc names branchsigns =
         if not (Int.equal p p1 || Int.equal p p2) then err1 p1 p2;
         if Int.equal p p1 then
           IntroAndPattern
-            (List.extend branchsigns.(0) (Loc.ghost,IntroNaming IntroAnonymous) l)
+            (List.extend branchsigns.(0) (CAst.make @@ IntroNaming IntroAnonymous) l)
         else
           names
       else
@@ -205,27 +207,27 @@ let check_or_and_pattern_size check_and loc names branchsigns =
           err1' p1 p2 else errn n;
       names
 
-let get_and_check_or_and_pattern_gen check_and loc names branchsigns =
-  let names = check_or_and_pattern_size check_and loc names branchsigns in
+let get_and_check_or_and_pattern_gen ?loc check_and names branchsigns =
+  let names = check_or_and_pattern_size ?loc check_and names branchsigns in
   match names with
   | IntroAndPattern l -> [|l|]
   | IntroOrPattern l -> Array.of_list l
 
-let get_and_check_or_and_pattern = get_and_check_or_and_pattern_gen true
+let get_and_check_or_and_pattern ?loc = get_and_check_or_and_pattern_gen ?loc true
 
 let compute_induction_names_gen check_and branchletsigns = function
   | None ->
       Array.make (Array.length branchletsigns) []
-  | Some (loc,names) ->
+  | Some {CAst.loc;v=names} ->
       let names = fix_empty_or_and_pattern (Array.length branchletsigns) names in
-      get_and_check_or_and_pattern_gen check_and loc names branchletsigns
+      get_and_check_or_and_pattern_gen check_and ?loc names branchletsigns
 
 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 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
@@ -236,12 +238,12 @@ let compute_constructor_signatures isrec ((_,k as ity),u) =
         end
     | LetIn (_,_,_,c), rest -> false :: analrec c rest
     | _, [] -> []
-    | _ -> anomaly (Pp.str "compute_constructor_signatures")
+    | _ -> anomaly (Pp.str "compute_constructor_signatures.")
   in
   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
 
@@ -261,40 +263,7 @@ let pf_with_evars glsev k gls =
     tclTHEN (Refiner.tclEVARS evd) (k a) gls
 
 let pf_constr_of_global gr k =
-  pf_with_evars (fun gls -> pf_apply Evd.fresh_global gls gr) k
-
-(* computing the case/elim combinators *)
-
-let gl_make_elim ind gl =
-  let gr = Indrec.lookup_eliminator (fst ind) (elimination_sort_of_goal gl) in
-    pf_apply Evd.fresh_global gl gr
-
-let gl_make_case_dep ind gl =
-  let sigma = Sigma.Unsafe.of_evar_map (Tacmach.project gl) in
-  let Sigma (r, sigma, _) = Indrec.build_case_analysis_scheme (pf_env gl) sigma ind true
-    (elimination_sort_of_goal gl)
-  in
-  (Sigma.to_evar_map sigma, r)
-
-let gl_make_case_nodep ind gl =
-  let sigma = Sigma.Unsafe.of_evar_map (Tacmach.project gl) in
-  let Sigma (r, sigma, _) = Indrec.build_case_analysis_scheme (pf_env gl) sigma ind false
-    (elimination_sort_of_goal gl)
-  in
-  (Sigma.to_evar_map sigma, r)
-
-let make_elim_branch_assumptions ba gl =
-  let assums =
-    try List.rev (List.firstn ba.nassums (pf_hyps gl))
-    with Failure _ -> anomaly (Pp.str "make_elim_branch_assumptions") in
-  { ba = ba; assums = assums }
-
-let elim_on_ba tac ba gl = tac (make_elim_branch_assumptions ba gl) gl
-
-let make_case_branch_assumptions = make_elim_branch_assumptions
-
-let case_on_ba tac ba gl = tac (make_case_branch_assumptions ba gl) gl
-
+  pf_with_evars (fun gls -> on_snd EConstr.of_constr (pf_apply Evd.fresh_global gls gr)) k
 
 (** Tacticals of Ltac defined directly in term of Proofview *)
 module New = struct
@@ -311,7 +280,7 @@ module New = struct
     tclZERO (Refiner.FailError (lvl,lazy msg))
 
   let tclZEROMSG ?loc msg =
-    let err = UserError ("", msg) in
+    let err = UserError (None, msg) in
     let info = match loc with
     | None -> Exninfo.null
     | Some loc -> Loc.add_loc Exninfo.null loc
@@ -366,6 +335,16 @@ module New = struct
           catch_failerror e <*> t2
         end
     end
+
+  let tclORELSE0L t1 t2 =
+    tclINDEPENDENTL begin
+      tclORELSE
+        t1
+        begin fun e ->
+          catch_failerror e <*> t2
+        end
+    end
+
   let tclORELSE t1 t2 =
     tclORELSE0 (tclPROGRESS t1) t2
 
@@ -417,6 +396,9 @@ module New = struct
 
   let tclTRY t =
     tclORELSE0 t (tclUNIT ())
+  
+  let tclTRYb t =
+    tclORELSE0L (t <*> tclUNIT true) (tclUNIT false)
 
   let tclIFTHENELSE t1 t2 t3 =
     tclINDEPENDENT begin
@@ -428,8 +410,14 @@ module New = struct
     Proofview.tclIFCATCH t1
       (fun () -> tclDISPATCH (Array.to_list a))
       (fun _ -> t3)
+  let tclIFTHENFIRSTELSE t1 t2 t3 =
+    Proofview.tclIFCATCH t1
+      (fun () -> tclEXTEND [t2] (tclUNIT ()) [])
+      (fun _ -> t3)
   let tclIFTHENTRYELSEMUST t1 t2 =
     tclIFTHENELSE t1 (tclTRY t2) t2
+  let tclIFTHENFIRSTTRYELSEMUST t1 t2 =
+    tclIFTHENFIRSTELSE t1 (tclTRY t2) t2
 
   (* Try the first tactic that does not fail in a list of tactics *)
   let rec tclFIRST = function
@@ -478,19 +466,20 @@ module New = struct
 
   (* Select a subset of the goals *)
   let tclSELECT = function
-    | Tacexpr.SelectNth i -> Proofview.tclFOCUS i i
-    | Tacexpr.SelectList l -> Proofview.tclFOCUSLIST l
-    | Tacexpr.SelectId id -> Proofview.tclFOCUSID id
-    | Tacexpr.SelectAll -> fun tac -> tac
+    | Vernacexpr.SelectNth i -> Proofview.tclFOCUS i i
+    | Vernacexpr.SelectList l -> Proofview.tclFOCUSLIST l
+    | Vernacexpr.SelectId id -> Proofview.tclFOCUSID id
+    | Vernacexpr.SelectAll -> fun tac -> tac
 
   (* Check that holes in arguments have been resolved *)
 
   let check_evars env sigma extsigma origsigma =
     let rec is_undefined_up_to_restriction sigma evk =
+      if Evd.mem origsigma evk then None else
       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
@@ -500,7 +489,7 @@ module New = struct
     let rest =
       Evd.fold_undefined (fun evk evi acc ->
         match is_undefined_up_to_restriction sigma evk with
-        | Some (evk',evi) when not (Evd.mem origsigma evk) -> (evk',evi)::acc
+        | Some (evk',evi) -> (evk',evi)::acc
         | _ -> acc)
         extsigma []
     in
@@ -508,7 +497,7 @@ module New = struct
     | [] -> ()
     | (evk,evi) :: _ ->
       let (loc,_) = evi.Evd.evar_source in
-      Pretype_errors.error_unsolvable_implicit loc env sigma evk None
+      Pretype_errors.error_unsolvable_implicit ?loc env sigma evk None
 
   let tclWITHHOLES accept_unresolved_holes tac sigma =
     tclEVARMAP >>= fun sigma_initial ->
@@ -529,12 +518,12 @@ module New = struct
         Proofview.Unsafe.tclEVARS sigma <*> tac >>= check_evars_if
 
   let tclDELAYEDWITHHOLES check x tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let env = Proofview.Goal.env gl in
       let sigma = Proofview.Goal.sigma gl in
-      let Sigma (x, sigma, _) = x.Tacexpr.delayed env sigma in
-      tclWITHHOLES check (tac x) (Sigma.to_evar_map sigma)
-    end }
+      let (sigma, x) = x env sigma in
+      tclWITHHOLES check (tac x) sigma
+    end
 
   let tclTIMEOUT n t =
     Proofview.tclOR
@@ -551,99 +540,99 @@ module New = struct
     let hyps = Proofview.Goal.hyps gl in
     try
       List.nth hyps (m-1)
-    with Failure _ -> CErrors.error "No such assumption."
+    with Failure _ -> CErrors.user_err Pp.(str "No such assumption.")
 
   let nLastDecls gl n =
     try List.firstn n (Proofview.Goal.hyps gl)
-    with Failure _ -> error "Not enough hypotheses in the goal."
+    with Failure _ -> CErrors.user_err Pp.(str "Not enough hypotheses in the goal.")
 
   let nthHypId m gl =
     (** We only use [id] *)
-    let gl = Proofview.Goal.assume gl in
-    nthDecl m gl |> get_id
+    nthDecl m gl |> NamedDecl.get_id
   let nthHyp m gl = 
     mkVar (nthHypId m gl)
 
   let onNthHypId m tac =
-    Proofview.Goal.enter { enter = begin fun gl -> tac (nthHypId m gl) end }
+    Proofview.Goal.enter begin fun gl -> tac (nthHypId m gl) end 
   let onNthHyp m tac =
-    Proofview.Goal.enter { enter = begin fun gl -> tac (nthHyp m gl) end }
+    Proofview.Goal.enter begin fun gl -> tac (nthHyp m gl) end
 
   let onLastHypId = onNthHypId 1
   let onLastHyp   = onNthHyp 1
 
   let onNthDecl m tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       Proofview.tclUNIT (nthDecl m gl) >>= tac
-    end }
+    end
   let onLastDecl  = onNthDecl 1
 
   let ifOnHyp pred tac1 tac2 id =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let typ = Tacmach.New.pf_get_hyp_typ id gl in
     if pred (id,typ) then
       tac1 id
     else
       tac2 id
-    end }
+    end
 
-  let onHyps find tac = Proofview.Goal.nf_enter { enter = begin fun gl -> tac (find.enter gl) end }
+  let onHyps find tac = Proofview.Goal.enter begin fun gl -> tac (find gl) end
 
   let afterHyp id tac =
-    Proofview.Goal.enter { enter = begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-    let rem, _ = List.split_when (Id.equal id % get_id) hyps in
+    Proofview.Goal.enter begin fun gl ->
+    let hyps = Proofview.Goal.hyps gl in
+    let rem, _ = List.split_when (NamedDecl.get_id %> Id.equal id) hyps in
     tac rem
-    end }
+    end
 
   let fullGoal gl =
     let hyps = Tacmach.New.pf_ids_of_hyps gl in
     None :: List.map Option.make hyps
 
   let tryAllHyps tac =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let hyps = Tacmach.New.pf_ids_of_hyps gl in
     tclFIRST_PROGRESS_ON tac hyps
-    end }
+    end
   let tryAllHypsAndConcl tac =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       tclFIRST_PROGRESS_ON tac (fullGoal gl)
-    end }
+    end
 
   let onClause tac cl =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let hyps = Tacmach.New.pf_ids_of_hyps gl in
     tclMAP tac (Locusops.simple_clause_of (fun () -> hyps) cl)
-    end }
+    end
 
   (* Find the right elimination suffix corresponding to the sort of the goal *)
   (* c should be of type A1->.. An->B with B an inductive definition *)
   let general_elim_then_using mk_elim
       isrec allnames tac predicate ind (c, t) =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let sigma, elim = Tacmach.New.of_old (mk_elim ind) gl in
+    Proofview.Goal.enter begin fun gl ->
+    let sigma, elim = mk_elim ind gl in
+    let ind = on_snd (fun u -> EInstance.kind sigma u) ind in
     Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
-    (Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let indclause = Tacmach.New.of_old (fun gl -> mk_clenv_from gl (c, t)) gl in
+    (Proofview.Goal.enter begin fun gl ->
+    let indclause = mk_clenv_from gl (c, t) in
     (* applying elimination_scheme just a little modified *)
-    let elimclause = Tacmach.New.of_old (fun gls -> mk_clenv_from gls (elim,Tacmach.New.pf_unsafe_type_of gl elim)) gl in
+    let elimclause = mk_clenv_from gl (elim,Tacmach.New.pf_unsafe_type_of gl elim)  in
     let indmv =
-      match kind_of_term (last_arg elimclause.templval.Evd.rebus) with
+      match EConstr.kind elimclause.evd (last_arg elimclause.evd elimclause.templval.Evd.rebus) with
       | Meta mv -> mv
-      | _         -> anomaly (str"elimination")
+      | _         -> anomaly (str"elimination.")
     in
     let pmv =
-      let p, _ = decompose_app elimclause.templtyp.Evd.rebus in
-      match kind_of_term p with
+      let p, _ = decompose_app elimclause.evd elimclause.templtyp.Evd.rebus in
+      match EConstr.kind elimclause.evd p with
       | Meta p -> p
       | _ ->
 	  let name_elim =
-	    match kind_of_term elim with
-	    | Const (kn, _) -> string_of_con kn
-	    | Var id -> string_of_id id
+	    match EConstr.kind sigma elim with
+	    | Const (kn, _) -> Constant.to_string kn
+	    | Var id -> Id.to_string id
 	    | _ -> "\b"
 	  in
-	  errorlabstrm "Tacticals.general_elim_then_using"
+	  user_err ~hdr:"Tacticals.general_elim_then_using"
             (str "The elimination combinator " ++ str name_elim ++ str " is unknown.")
     in
     let elimclause' = clenv_fchain ~with_univs:false indmv elimclause indclause in
@@ -655,9 +644,9 @@ module New = struct
       | None   -> elimclause'
       | Some p -> clenv_unify ~flags Reduction.CONV (mkMeta pmv) p elimclause'
     in
-    let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags elimclause') gl in
+    let clenv' = clenv_unique_resolver ~flags elimclause' gl in
     let after_tac i =
-      let (hd,largs) = decompose_app clenv'.templtyp.Evd.rebus in
+      let (hd,largs) = decompose_app clenv'.evd clenv'.templtyp.Evd.rebus in
       let ba = { branchsign = branchsigns.(i);
                  branchnames = brnames.(i);
                  nassums = List.length branchsigns.(i);
@@ -672,10 +661,68 @@ module New = struct
     Proofview.tclTHEN
       (Clenvtac.clenv_refine false clenv')
       (Proofview.tclEXTEND [] tclIDTAC branchtacs)
-    end }) end }
+    end) end
+
+  let elimination_sort_of_goal gl =
+    (** Retyping will expand evars anyway. *)
+    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 gl in
+    pf_apply Retyping.get_sort_family_of gl c
+
+  let elimination_sort_of_clause id gl = match id with
+  | None -> elimination_sort_of_goal gl
+  | Some id -> elimination_sort_of_hyp id gl
+
+  (* computing the case/elim combinators *)
+
+  let gl_make_elim ind = begin fun gl ->
+    let gr = Indrec.lookup_eliminator (fst ind) (elimination_sort_of_goal gl) in
+    let (sigma, c) = pf_apply Evd.fresh_global gl gr in
+    (sigma, EConstr.of_constr c)
+  end
+
+  let gl_make_case_dep (ind, u) = begin fun gl ->
+    let sigma = project gl in
+    let u = EInstance.kind (project gl) u in
+    let (sigma, r) = Indrec.build_case_analysis_scheme (pf_env gl) sigma (ind, u) true
+      (elimination_sort_of_goal gl)
+    in
+    (sigma, EConstr.of_constr r)
+  end
+
+  let gl_make_case_nodep (ind, u) = begin fun gl ->
+    let sigma = project gl in
+    let u = EInstance.kind sigma u in
+    let (sigma, r) = Indrec.build_case_analysis_scheme (pf_env gl) sigma (ind, u) false
+      (elimination_sort_of_goal gl)
+    in
+    (sigma, EConstr.of_constr r)
+  end
+
+  let make_elim_branch_assumptions ba hyps =
+    let assums =
+      try List.rev (List.firstn ba.nassums hyps)
+      with Failure _ -> anomaly (Pp.str "make_elim_branch_assumptions.") in
+    { ba = ba; assums = assums }
+
+  let elim_on_ba tac ba =
+    Proofview.Goal.enter begin fun gl ->
+    let branches = make_elim_branch_assumptions ba (Proofview.Goal.hyps gl) in
+    tac branches
+    end
+
+  let case_on_ba tac ba = 
+    Proofview.Goal.enter begin fun gl ->
+    let branches = make_elim_branch_assumptions ba (Proofview.Goal.hyps gl) in
+    tac branches
+    end
 
   let elimination_then tac c =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let (ind,t) = pf_reduce_to_quantified_ind gl (pf_unsafe_type_of gl c) in
     let isrec,mkelim =
       match (Global.lookup_mind (fst (fst ind))).mind_record with
@@ -683,7 +730,7 @@ module New = struct
       | Some _ -> false,gl_make_case_dep
     in
     general_elim_then_using mkelim isrec None tac None ind (c, t)
-    end }
+    end
 
   let case_then_using =
     general_elim_then_using gl_make_case_dep false
@@ -691,38 +738,11 @@ module New = struct
   let case_nodep_then_using =
     general_elim_then_using gl_make_case_nodep false
 
-  let elim_on_ba tac ba =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let branches = Tacmach.New.of_old (make_elim_branch_assumptions ba) gl in
-    tac branches
-    end }
-
-  let case_on_ba tac ba = 
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let branches = Tacmach.New.of_old (make_case_branch_assumptions ba) gl in
-    tac branches
-    end }
-
-  let elimination_sort_of_goal gl =
-    (** Retyping will expand evars anyway. *)
-    let c = Proofview.Goal.concl (Goal.assume 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
-    pf_apply Retyping.get_sort_family_of gl c
-
-  let elimination_sort_of_clause id gl = match id with
-  | None -> elimination_sort_of_goal gl
-  | Some id -> elimination_sort_of_hyp id gl
-
-  let pf_constr_of_global ref tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-      let env = Proofview.Goal.env gl in
-      let sigma = Tacmach.New.project gl in
-      let (sigma, c) = Evd.fresh_global env sigma ref in
-      Proofview.Unsafe.tclEVARS sigma <*> (tac c)
-    end }
+  let pf_constr_of_global ref =
+    Proofview.tclEVARMAP >>= fun sigma ->
+    Proofview.tclENV >>= fun env ->
+    let (sigma, c) = Evd.fresh_global env sigma ref in
+    let c = EConstr.of_constr c in
+    Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT c
 
 end
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index cfdc2cff..f0ebac78 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -1,28 +1,31 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open Names
-open Term
-open Tacmach
+open Constr
+open EConstr
+open Evd
 open Proof_type
-open Tacexpr
 open Locus
 open Misctypes
+open Tactypes
 
 (** Tacticals i.e. functions from tactics to tactics. *)
 
 val tclIDTAC         : tactic
-val tclIDTAC_MESSAGE : std_ppcmds -> tactic
+val tclIDTAC_MESSAGE : Pp.t -> tactic
 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
@@ -40,13 +43,11 @@ val tclSOLVE         : tactic list -> tactic
 val tclTRY           : tactic -> tactic
 val tclCOMPLETE      : tactic -> tactic
 val tclAT_LEAST_ONCE : tactic -> tactic
-val tclFAIL          : int -> std_ppcmds -> tactic
-val tclFAIL_lazy     : int -> std_ppcmds Lazy.t -> tactic
+val tclFAIL          : int -> Pp.t -> tactic
+val tclFAIL_lazy     : int -> Pp.t Lazy.t -> tactic
 val tclDO            : int -> tactic -> tactic
-val tclWEAK_PROGRESS : tactic -> tactic
 val tclPROGRESS      : tactic -> tactic
 val tclSHOWHYPS      : tactic -> tactic
-val tclNOTSAMEGOAL   : tactic -> tactic
 val tclTHENTRY       : tactic -> tactic -> tactic
 val tclMAP           : ('a -> tactic) -> 'a list -> tactic
 
@@ -59,29 +60,29 @@ val tclIFTHENTRYELSEMUST : tactic -> tactic -> tactic
 
 val onNthHypId       : int -> (Id.t -> tactic) -> tactic
 val onNthHyp         : int -> (constr -> tactic) -> tactic
-val onNthDecl        : int -> (Context.Named.Declaration.t -> tactic) -> tactic
+val onNthDecl        : int -> (named_declaration -> tactic) -> tactic
 val onLastHypId      : (Id.t -> tactic) -> tactic
 val onLastHyp        : (constr -> tactic) -> tactic
-val onLastDecl       : (Context.Named.Declaration.t -> tactic) -> tactic
+val onLastDecl       : (named_declaration -> tactic) -> tactic
 val onNLastHypsId    : int -> (Id.t list -> tactic) -> tactic
 val onNLastHyps      : int -> (constr list -> tactic) -> tactic
-val onNLastDecls     : int -> (Context.Named.t -> tactic) -> tactic
+val onNLastDecls     : int -> (named_context -> tactic) -> tactic
 
 val lastHypId   : goal sigma -> Id.t
 val lastHyp     : goal sigma -> constr
-val lastDecl    : goal sigma -> Context.Named.Declaration.t
+val lastDecl    : goal sigma -> named_declaration
 val nLastHypsId : int -> goal sigma -> Id.t list
 val nLastHyps   : int -> goal sigma -> constr list
-val nLastDecls  : int -> goal sigma -> Context.Named.t
+val nLastDecls  : int -> goal sigma -> named_context
 
-val afterHyp    : Id.t -> goal sigma -> Context.Named.t
+val afterHyp    : Id.t -> goal sigma -> named_context
 
 val ifOnHyp     : (Id.t * types -> bool) ->
                   (Id.t -> tactic) -> (Id.t -> tactic) ->
 		   Id.t -> tactic
 
-val onHyps      : (goal sigma -> Context.Named.t) ->
-                  (Context.Named.t -> tactic) -> tactic
+val onHyps      : (goal sigma -> named_context) ->
+                  (named_context -> tactic) -> tactic
 
 (** {6 Tacticals applying to goal components } *)
 
@@ -97,7 +98,7 @@ val onClauseLR : (Id.t option -> tactic) -> clause -> tactic
 
 (** {6 Elimination tacticals. } *)
 
-type branch_args = {
+type branch_args = private {
   ity        : pinductive;  (** the type we were eliminating on *)
   largs      : constr list; (** its arguments *)
   branchnum  : int;         (** the branch number *)
@@ -107,15 +108,15 @@ type branch_args = {
                                 true=assumption, false=let-in *)
   branchnames : intro_patterns}
 
-type branch_assumptions = {
+type branch_assumptions = private {
   ba        : branch_args;       (** the branch args *)
-  assums    : Context.Named.t}   (** the list of assumptions introduced *)
+  assums    : named_context}   (** the list of assumptions introduced *)
 
 (** [get_and_check_or_and_pattern loc pats branchsign] returns an appropriate
    error message if |pats| <> |branchsign|; extends them if no pattern is given
    for let-ins in the case of a conjunctive pattern *)
 val get_and_check_or_and_pattern :
-  Loc.t -> delayed_open_constr or_and_intro_pattern_expr ->
+  ?loc:Loc.t -> delayed_open_constr or_and_intro_pattern_expr ->
   bool list array -> intro_patterns array
 
 (** Tolerate "[]" to mean a disjunctive pattern of any length *)
@@ -123,22 +124,19 @@ val fix_empty_or_and_pattern : int ->
   delayed_open_constr or_and_intro_pattern_expr ->
   delayed_open_constr or_and_intro_pattern_expr
 
-val compute_constructor_signatures : rec_flag -> pinductive -> bool list array
+val compute_constructor_signatures : rec_flag -> inductive * 'a -> bool list array
 
 (** Useful for [as intro_pattern] modifier *)
 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
 
-val elim_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic
-val case_on_ba : (branch_assumptions -> tactic) -> branch_args  -> tactic
-
 (** Tacticals defined directly in term of Proofview *)
 
 (** The tacticals in the module [New] are the tactical of Ltac. Their
@@ -164,9 +162,9 @@ module New : sig
   (* [tclFAIL n msg] fails with [msg] as an error message at level [n]
      (meaning that it will jump over [n] error catching tacticals FROM
      THIS MODULE. *)
-  val tclFAIL : int -> Pp.std_ppcmds -> 'a tactic
+  val tclFAIL : int -> Pp.t -> 'a tactic
 
-  val tclZEROMSG : ?loc:Loc.t -> Pp.std_ppcmds -> 'a tactic
+  val tclZEROMSG : ?loc:Loc.t -> Pp.t -> 'a tactic
   (** Fail with a [User_Error] containing the given message. *)
 
   val tclOR : unit tactic -> unit tactic -> unit tactic
@@ -209,10 +207,12 @@ module New : sig
   val tclMAP : ('a -> unit tactic) -> 'a list -> unit tactic
 
   val tclTRY : unit tactic -> unit tactic
+  val tclTRYb : unit tactic -> bool list tactic
   val tclFIRST : unit tactic list -> unit tactic
   val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic
   val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic
   val tclIFTHENTRYELSEMUST : unit tactic -> unit tactic -> unit tactic
+  val tclIFTHENFIRSTTRYELSEMUST : unit tactic -> unit tactic -> unit tactic
 
   val tclDO : int -> unit tactic -> unit tactic
   val tclREPEAT : unit tactic -> unit tactic
@@ -221,35 +221,35 @@ module New : sig
   val tclCOMPLETE : 'a tactic -> 'a tactic
   val tclSOLVE : unit tactic list -> unit tactic
   val tclPROGRESS : unit tactic -> unit tactic
-  val tclSELECT : goal_selector -> '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 delayed_open -> ('a -> unit tactic) -> unit tactic
 
   val tclTIMEOUT : int -> unit tactic -> unit tactic
   val tclTIME : string option -> 'a tactic -> 'a tactic
 
-  val nLastDecls  : ([ `NF ], 'r) Proofview.Goal.t -> int -> Context.Named.t
+  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       : (Context.Named.Declaration.t -> unit tactic) -> unit tactic
+  val onLastDecl       : (named_declaration -> unit tactic) -> unit tactic
 
-  val onHyps      : ([ `NF ], Context.Named.t) Proofview.Goal.enter ->
-                    (Context.Named.t -> unit tactic) -> unit tactic
-  val afterHyp    : Id.t -> (Context.Named.t -> unit tactic) -> unit tactic
+  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, 'r) Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_hyp  : Id.t -> ('a, 'r) Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_clause : Id.t option -> ('a, 'r) 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) ->
@@ -257,14 +257,14 @@ module New : sig
 
   val case_then_using :
     or_and_intro_pattern option -> (branch_args -> unit Proofview.tactic) ->
-    constr option -> pinductive -> Term.constr * Term.types -> unit Proofview.tactic
+    constr option -> inductive * EInstance.t -> constr * types -> unit Proofview.tactic
 
   val case_nodep_then_using :
     or_and_intro_pattern option -> (branch_args -> unit Proofview.tactic) ->
-    constr option -> pinductive -> Term.constr * Term.types -> unit Proofview.tactic
+    constr option -> inductive * EInstance.t -> constr * types -> unit Proofview.tactic
 
   val elim_on_ba : (branch_assumptions -> unit Proofview.tactic) -> branch_args  -> unit Proofview.tactic
   val case_on_ba : (branch_assumptions -> unit Proofview.tactic) -> branch_args  -> unit Proofview.tactic
 
-  val pf_constr_of_global : Globnames.global_reference -> (constr -> unit Proofview.tactic) -> unit Proofview.tactic
+  val pf_constr_of_global : Globnames.global_reference -> constr Proofview.tactic
 end
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 9d64e7c5..dfdd3237 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1,28 +1,32 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+module CVars = Vars
+
 open Pp
 open CErrors
 open Util
 open Names
 open Nameops
-open Term
-open Vars
+open Constr
 open Termops
+open Environ
+open EConstr
+open Vars
 open Find_subterm
 open Namegen
 open Declarations
 open Inductiveops
 open Reductionops
-open Environ
 open Globnames
 open Evd
-open Pfedit
 open Tacred
 open Genredexpr
 open Tacmach.New
@@ -32,7 +36,6 @@ open Refiner
 open Tacticals
 open Hipattern
 open Coqlib
-open Tacexpr
 open Decl_kinds
 open Evarutil
 open Indrec
@@ -42,63 +45,28 @@ open Locus
 open Locusops
 open Misctypes
 open Proofview.Notations
-open Sigma.Notations
+open Context.Named.Declaration
 
-let inj_with_occurrences e = (AllOccurrences,e)
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
-let dloc = Loc.ghost
+let inj_with_occurrences e = (AllOccurrences,e)
 
 let typ_of env sigma c =
   let open Retyping in
-  try get_type_of ~lax:true env (Sigma.to_evar_map sigma) c
+  try get_type_of ~lax:true env sigma c
   with RetypeError e ->
-    user_err_loc (Loc.ghost, "", print_retype_error e)
+    user_err (print_retype_error e)
 
 open Goptions
 
-(* Option for 8.2 compatibility *)
-let dependent_propositions_elimination = ref true
-
-let use_dependent_propositions_elimination () =
-  !dependent_propositions_elimination
-  && Flags.version_strictly_greater Flags.V8_2
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      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
-    { optsync  = true;
-      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 _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = true;
-  Goptions.optname =
-    "Perform typeclass resolution on apply-generated subgoals.";
-  Goptions.optkey = ["Typeclass";"Resolution";"After";"Apply"];
-  Goptions.optread = (fun () -> !apply_solve_class_goals);
-  Goptions.optwrite = (fun a -> apply_solve_class_goals:=a);
-}
-
 let clear_hyp_by_default = ref false
 
 let use_clear_hyp_by_default () = !clear_hyp_by_default
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "default clearing of hypotheses after use";
       optkey   = ["Default";"Clearing";"Used";"Hypotheses"];
       optread  = (fun () -> !clear_hyp_by_default) ;
@@ -114,26 +82,12 @@ let accept_universal_lemma_under_conjunctions () =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "trivial unification in tactics applying under conjunctions";
       optkey   = ["Universal";"Lemma";"Under";"Conjunction"];
       optread  = (fun () -> !universal_lemma_under_conjunctions) ;
       optwrite = (fun b -> universal_lemma_under_conjunctions := b) }
 
-(* Shrinking of abstract proofs. *)
-
-let shrink_abstract = ref true
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
-      optname  = "shrinking of abstracted proofs";
-      optkey   = ["Shrink"; "Abstract"];
-      optread  = (fun () -> !shrink_abstract) ;
-      optwrite = (fun b -> shrink_abstract := b) }
-
 (* The following boolean governs what "intros []" do on examples such
    as "forall x:nat*nat, x=x"; if true, it behaves as "intros [? ?]";
    if false, it behaves as "intro H; case H; clear H" for fresh H.
@@ -144,12 +98,10 @@ let bracketing_last_or_and_intro_pattern = ref true
 
 let use_bracketing_last_or_and_intro_pattern () =
   !bracketing_last_or_and_intro_pattern
-  && Flags.version_strictly_greater Flags.V8_4
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "bracketing last or-and introduction pattern";
       optkey   = ["Bracketing";"Last";"Introduction";"Pattern"];
       optread  = (fun () -> !bracketing_last_or_and_intro_pattern);
@@ -166,76 +118,74 @@ let _ =
 (** This tactic creates a partial proof realizing the introduction rule, but
     does not check anything. *)
 let unsafe_intro env store decl b =
-  let open Context.Named.Declaration in
-  Refine.refine ~unsafe:true { run = begin fun sigma ->
+  Refine.refine ~typecheck:false begin fun sigma ->
     let ctx = named_context_val env in
     let nctx = push_named_context_val decl ctx in
-    let inst = List.map (mkVar % get_id) (named_context env) in
+    let inst = List.map (NamedDecl.get_id %> mkVar) (named_context env) in
     let ninst = mkRel 1 :: inst in
-    let nb = subst1 (mkVar (get_id decl)) b in
-    let Sigma (ev, sigma, p) = new_evar_instance nctx sigma nb ~principal:true ~store ninst in
-    Sigma (mkNamedLambda_or_LetIn decl ev, sigma, p)
-  end }
+    let nb = subst1 (mkVar (NamedDecl.get_id decl)) b in
+    let (sigma, ev) = new_evar_instance nctx sigma nb ~principal:true ~store ninst in
+    (sigma, mkNamedLambda_or_LetIn decl ev)
+  end
 
 let introduction ?(check=true) id =
-  let open Context.Named.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
+  Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
     let hyps = named_context_val (Proofview.Goal.env gl) in
     let store = Proofview.Goal.extra gl in
     let env = Proofview.Goal.env gl in
     let () = if check && mem_named_context_val id hyps then
-      errorlabstrm "Tactics.introduction"
-        (str "Variable " ++ pr_id id ++ str " is already declared.")
+      user_err ~hdr:"Tactics.introduction"
+        (str "Variable " ++ Id.print id ++ str " is already declared.")
     in
-    match kind_of_term (whd_evar sigma concl) with
+    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)
-  end }
+    | _ -> raise (RefinerError (env, sigma, IntroNeedsProduct))
+  end
 
 let refine          = Tacmach.refine
+let error msg = CErrors.user_err Pp.(str msg)
 
 let convert_concl ?(check=true) ty k =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let store = Proofview.Goal.extra gl in
-    let conclty = Proofview.Goal.raw_concl gl in
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
-      let Sigma ((), sigma, p) =
+    let conclty = Proofview.Goal.concl gl in
+    Refine.refine ~typecheck:false begin fun sigma ->
+      let sigma =
         if check then begin
-          let sigma = Sigma.to_evar_map sigma in
           ignore (Typing.unsafe_type_of env sigma ty);
           let sigma,b = Reductionops.infer_conv env sigma ty conclty in
           if not b then error "Not convertible.";
-          Sigma.Unsafe.of_pair ((), sigma)
-        end else Sigma.here () sigma in
-      let Sigma (x, sigma, q) = Evarutil.new_evar env sigma ~principal:true ~store ty in
+          sigma
+        end else sigma in
+      let (sigma, x) = Evarutil.new_evar env sigma ~principal:true ~store ty in
       let ans = if k == DEFAULTcast then x else mkCast(x,k,conclty) in
-      Sigma (ans, sigma, p +> q)
-    end }
-  end }
+      (sigma, ans)
+    end
+  end
 
 let convert_hyp ?(check=true) d =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
-    let ty = Proofview.Goal.raw_concl gl in
+    let ty = Proofview.Goal.concl gl in
     let store = Proofview.Goal.extra gl in
     let sign = convert_hyp check (named_context_val env) sigma d in
     let env = reset_with_named_context sign env in
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
+    Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true ~store ty
-    end }
-  end }
+    end
+  end
 
 let convert_concl_no_check = convert_concl ~check:false
 let convert_hyp_no_check = convert_hyp ~check:false
 
 let convert_gen pb x y =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     try
       let sigma, b = Tacmach.New.pf_apply (Reductionops.infer_conv ~pb) gl x y in
       if b then Proofview.Unsafe.tclEVARS sigma
@@ -243,37 +193,37 @@ let convert_gen pb x y =
     with (* Reduction.NotConvertible *) _ ->
       (** FIXME: Sometimes an anomaly is raised from conversion *)
       Tacticals.New.tclFAIL 0 (str "Not convertible")
-end }
+end
 
 let convert x y = convert_gen Reduction.CONV x y
 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"."
 
 let error_clear_dependency env sigma id err =
-  errorlabstrm "" (clear_dependency_msg env sigma id err)
+  user_err  (clear_dependency_msg env sigma id err)
 
 let replacing_dependency_msg env sigma id = function
   | Evarutil.OccurHypInSimpleClause None ->
-      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"."
 
 let error_replacing_dependency env sigma id err =
-  errorlabstrm "" (replacing_dependency_msg env sigma id err)
+  user_err  (replacing_dependency_msg env sigma id err)
 
 (* This tactic enables the user to remove hypotheses from the signature.
  * Some care is taken to prevent him from removing variables that are
@@ -283,10 +233,9 @@ let error_replacing_dependency env sigma id err =
 let clear_gen fail = function
 | [] -> Proofview.tclUNIT ()
 | ids ->
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  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
@@ -296,43 +245,44 @@ let clear_gen fail = function
       with Evarutil.ClearDependencyError (id,err) -> fail env sigma id err
     in
     let env = reset_with_named_context hyps env in
-    let tac = Refine.refine ~unsafe:true { run = fun sigma ->
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS !evdref)
+    (Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true concl
-    } in
-    Sigma.Unsafe.of_pair (tac, !evdref)
-  end }
+    end)
+  end
 
 let clear ids = clear_gen error_clear_dependency ids
 let clear_for_replacing ids = clear_gen error_replacing_dependency ids
 
 let apply_clear_request clear_flag dft c =
+  Proofview.tclEVARMAP >>= fun sigma ->
   let check_isvar c =
-    if not (isVar c) then
+    if not (isVar sigma c) then
       error "keep/clear modifiers apply only to hypothesis names." in
   let doclear = match clear_flag with
-    | None -> dft && isVar c
+    | None -> dft && isVar sigma c
     | Some true -> check_isvar c; true
     | Some false -> false in
-  if doclear then clear [destVar c]
+  if doclear then clear [destVar sigma c]
   else Tacticals.New.tclIDTAC
 
 (* Moving hypotheses *)
 let move_hyp id dest =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let ty = Proofview.Goal.raw_concl gl in
+    let sigma = Tacmach.New.project gl in
+    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 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 ~unsafe:true { run = begin fun sigma ->
+    Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true ~store ty
-    end }
-  end }
+    end
+  end
 
 (* Renaming hypotheses *)
 let rename_hyp repl =
-  let open Context.Named.Declaration in
   let fold accu (src, dst) = match accu with
   | None -> None
   | Some (srcs, dsts) ->
@@ -348,24 +298,25 @@ let rename_hyp repl =
   match dom with
   | None -> Tacticals.New.tclZEROMSG (str "Not a one-to-one name mapping")
   | Some (src, dst) ->
-    Proofview.Goal.enter { enter = begin fun gl ->
-      let gl = Proofview.Goal.assume gl in
+    Proofview.Goal.enter begin fun gl ->
       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 (get_id decl) accu in
+      let fold accu decl = Id.Set.add (NamedDecl.get_id decl) accu in
       let vars = List.fold_left fold Id.Set.empty hyps in
       let () =
         if not (Id.Set.subset src vars) then
           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.errorlabstrm "" (pr_id elt ++ str " is already used")
+          CErrors.user_err  (Id.print elt ++ str " is already used")
         with Not_found -> ()
       in
       (** All is well *)
@@ -373,24 +324,26 @@ let rename_hyp repl =
       let subst = List.map make_subst repl in
       let subst c = Vars.replace_vars subst c in
       let map decl =
-        decl |> map_id (fun id -> try List.assoc_f Id.equal id repl with Not_found -> id)
-             |> map_constr subst
+        decl |> NamedDecl.map_id (fun id -> try List.assoc_f Id.equal id repl with Not_found -> id)
+             |> NamedDecl.map_constr subst
       in
       let nhyps = List.map map hyps in
       let nconcl = subst concl in
-      let nctx = Environ.val_of_named_context nhyps in
-      let instance = List.map (mkVar % get_id) hyps in
-      Refine.refine ~unsafe:true { run = begin fun sigma ->
+      let nctx = val_of_named_context nhyps in
+      let instance = List.map (NamedDecl.get_id %> mkVar) hyps in
+      Refine.refine ~typecheck:false begin fun sigma ->
         Evarutil.new_evar_instance nctx sigma nconcl ~principal:true ~store instance
-      end }
-    end }
+      end
+    end
 
 (**************************************************************)
 (*          Fresh names                                       *)
 (**************************************************************)
 
 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)
@@ -411,20 +364,20 @@ let default_id env sigma decl =
   | LocalAssum (name,t) ->
       let dft = default_id_of_sort (Retyping.get_sort_of env sigma t) in
       id_of_name_with_default dft name
-  | LocalDef (name,b,_) -> id_of_name_using_hdchar env b name
+  | LocalDef (name,b,_) -> id_of_name_using_hdchar env sigma b name
 
 (* Non primitive introduction tactics are treated by intro_then_gen
    There is possibly renaming, with possibly names to avoid and
    possibly a move to do after the introduction *)
 
 type name_flag =
-  | NamingAvoid of Id.t list
-  | NamingBasedOn of Id.t * Id.t list
-  | NamingMustBe of Loc.t * Id.t
+  | NamingAvoid of Id.Set.t
+  | NamingBasedOn of Id.t * Id.Set.t
+  | NamingMustBe of lident
 
 let naming_of_name = function
-  | Anonymous -> NamingAvoid []
-  | Name id -> NamingMustBe (dloc,id)
+  | Anonymous -> NamingAvoid Id.Set.empty
+  | Name id -> NamingMustBe (CAst.make id)
 
 let find_name mayrepl decl naming gl = match naming with
   | NamingAvoid idl ->
@@ -433,69 +386,129 @@ let find_name mayrepl decl naming gl = match naming with
       let sigma = Tacmach.New.project gl in
       new_fresh_id idl (default_id env sigma decl) gl
   | 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 id' = next_ident_away id ids_of_hyps in
-      if not mayrepl && not (Id.equal id' id) then
-        user_err_loc (loc,"",pr_id id ++ str" is already used.");
-      id
+  | NamingMustBe {CAst.loc;v=id} ->
+     (* When name is given, we allow to hide a global name *)
+     let ids_of_hyps = Tacmach.New.pf_ids_set_of_hyps gl in
+     if not mayrepl && Id.Set.mem id ids_of_hyps then
+       user_err ?loc  (Id.print id ++ str" is already used.");
+     id
+
+(**************************************************************)
+(*   Computing position of hypotheses for replacing           *)
+(**************************************************************)
+
+let get_next_hyp_position env sigma id =
+  let rec aux = function
+  | [] -> 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
+    else
+      aux right
+  in
+  aux
+
+let get_previous_hyp_position env sigma id =
+  let rec aux dest = function
+  | [] -> 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
+  in
+  aux MoveLast
 
 (**************************************************************)
 (*            Cut rule                                        *)
 (**************************************************************)
 
+let clear_hyps2 env sigma ids sign t cl =
+  try
+    let evdref = ref (Evd.clear_metas sigma) in
+    let (hyps,t,cl) = Evarutil.clear_hyps2_in_evi env evdref sign t cl ids in
+    (hyps, t, cl, !evdref)
+  with Evarutil.ClearDependencyError (id,err) ->
+    error_replacing_dependency env sigma id err
+
+let internal_cut_gen ?(check=true) dir replace id t =
+  Proofview.Goal.enter begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let sigma = Tacmach.New.project gl in
+    let concl = Proofview.Goal.concl gl in
+    let store = Proofview.Goal.extra gl in
+    let sign = named_context_val env in
+    let sign',t,concl,sigma =
+      if replace then
+        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 " ++ Id.print id ++ str " is already declared.");
+         push_named_context_val (LocalAssum (id,t)) sign,t,concl,sigma) in
+    let nf_t = nf_betaiota env sigma t in
+    Proofview.tclTHEN
+      (Proofview.Unsafe.tclEVARS sigma)
+      (Refine.refine ~typecheck:false begin fun sigma ->
+        let (sigma,ev,ev') =
+          if dir then
+            let (sigma, ev) = Evarutil.new_evar_from_context sign sigma nf_t in
+            let (sigma, ev') = Evarutil.new_evar_from_context sign' sigma ~principal:true ~store concl in
+            (sigma,ev,ev')
+          else
+            let (sigma, ev') = Evarutil.new_evar_from_context sign' sigma ~principal:true ~store concl in
+            let (sigma, ev) = Evarutil.new_evar_from_context sign sigma nf_t in
+            (sigma,ev,ev') in
+        let term = mkLetIn (Name id, ev, t, EConstr.Vars.subst_var id ev') in
+        (sigma, term)
+      end)
+  end
+
+let internal_cut ?(check=true) = internal_cut_gen ~check true
+let internal_cut_rev ?(check=true) = internal_cut_gen ~check false
+
 let assert_before_then_gen b naming t tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let id = find_name b (LocalAssum (Anonymous,t)) naming gl in
     Tacticals.New.tclTHENLAST
-      (Proofview.V82.tactic
-         (fun gl ->
-           try Tacmach.internal_cut b id t gl
-           with Evarutil.ClearDependencyError (id,err) ->
-             error_replacing_dependency (pf_env gl) (project gl) id err))
+      (internal_cut b id t)
       (tac id)
-  end }
+  end
 
 let assert_before_gen b naming t =
   assert_before_then_gen b naming t (fun _ -> Proofview.tclUNIT ())
 
 let assert_before na = assert_before_gen false (naming_of_name na)
-let assert_before_replacing id = assert_before_gen true (NamingMustBe (dloc,id))
+let assert_before_replacing id = assert_before_gen true (NamingMustBe (CAst.make id))
 
 let assert_after_then_gen b naming t tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let id = find_name b (LocalAssum (Anonymous,t)) naming gl in
     Tacticals.New.tclTHENFIRST
-      (Proofview.V82.tactic
-         (fun gl ->
-           try Tacmach.internal_cut_rev b id t gl
-           with Evarutil.ClearDependencyError (id,err) ->
-             error_replacing_dependency (pf_env gl) (project gl) id err))
+      (internal_cut_rev b id t)
       (tac id)
-  end }
+  end
 
 let assert_after_gen b naming t =
   assert_after_then_gen b naming t (fun _ -> (Proofview.tclUNIT ()))
 
 let assert_after na = assert_after_gen false (naming_of_name na)
-let assert_after_replacing id = assert_after_gen true (NamingMustBe (dloc,id))
+let assert_after_replacing id = assert_after_gen true (NamingMustBe (CAst.make id))
 
 (**************************************************************)
 (*          Fixpoints and CoFixpoints                         *)
 (**************************************************************)
 
-let rec mk_holes : type r s. _ -> r Sigma.t -> (s, r) Sigma.le -> _ -> (_, s) Sigma.sigma =
-fun env sigma p -> function
-| [] -> Sigma ([], sigma, p)
+let rec mk_holes env sigma = function
+| [] -> (sigma, [])
 | arg :: rem ->
-  let Sigma (arg, sigma, q) = Evarutil.new_evar env sigma arg in
-  let Sigma (rem, sigma, r) = mk_holes env sigma (p +> q) rem in
-  Sigma (arg :: rem, sigma, r)
+  let (sigma, arg) = Evarutil.new_evar env sigma arg in
+  let (sigma, rem) = mk_holes env sigma rem in
+  (sigma, arg :: rem)
 
-let rec check_mutind env sigma k cl = match kind_of_term (strip_outer_cast cl) with
+let rec check_mutind env sigma k cl = match EConstr.kind sigma (strip_outer_cast sigma cl) with
 | Prod (na, c1, b) ->
   if Int.equal k 1 then
     try
@@ -505,10 +518,13 @@ let rec check_mutind env sigma k cl = match kind_of_term (strip_outer_cast cl) w
   else
     let open Context.Rel.Declaration in
     check_mutind (push_rel (LocalAssum (na, c1)) env) sigma (pred k) b
+| LetIn (na, c1, t, b) ->
+    let open Context.Rel.Declaration in
+    check_mutind (push_rel (LocalDef (na, c1, t)) env) sigma k b
 | _ -> error "Not enough products."
 
 (* Refine as a fixpoint *)
-let mutual_fix f n rest j = Proofview.Goal.nf_enter { enter = begin fun gl ->
+let mutual_fix f n rest j = Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let concl = Proofview.Goal.concl gl in
@@ -520,40 +536,45 @@ let mutual_fix f n rest j = Proofview.Goal.nf_enter { 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
-      errorlabstrm "Logic.prim_refiner"
-        (str "Name " ++ pr_id f ++ str " already used in the environment");
+      user_err ~hdr:"Logic.prim_refiner"
+        (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
-  Refine.refine { run = begin fun sigma ->
-    let Sigma (evs, sigma, p) = mk_holes nenv sigma Sigma.refl (List.map pi3 all) in
+  Refine.refine ~typecheck:false begin fun sigma ->
+    let (sigma, evs) = mk_holes nenv sigma (List.map pi3 all) in
     let ids = List.map pi1 all in
     let evs = List.map (Vars.subst_vars (List.rev ids)) evs in
     let indxs = Array.of_list (List.map (fun n -> n-1) (List.map pi2 all)) in
     let funnames = Array.of_list (List.map (fun i -> Name i) ids) in
     let typarray = Array.of_list (List.map pi3 all) in
     let bodies = Array.of_list evs in
-    let oterm = Term.mkFix ((indxs,0),(funnames,typarray,bodies)) in
-    Sigma (oterm, sigma, p)
-  end }
-end }
+    let oterm = mkFix ((indxs,0),(funnames,typarray,bodies)) in
+    (sigma, oterm)
+  end
+end
+
+let warning_nameless_fix =
+    CWarnings.create ~name:"nameless-fix" ~category:"deprecated" Pp.(fun () ->
+        str "fix/cofix without a name are deprecated, please use the named version.")
 
 let fix ido n = match ido with
   | None ->
-    Proofview.Goal.enter { enter = begin fun gl ->
-      let name = Pfedit.get_current_proof_name () in
-      let id = new_fresh_id [] name gl in
+    warning_nameless_fix ();
+    Proofview.Goal.enter begin fun gl ->
+      let name = Proof_global.get_current_proof_name () in
+      let id = new_fresh_id Id.Set.empty name gl in
       mutual_fix id n [] 0
-    end }
+    end
   | Some id ->
     mutual_fix id n [] 0
 
 let rec check_is_mutcoind env sigma cl =
   let b = whd_all env sigma cl in
-  match kind_of_term b with
+  match EConstr.kind sigma b with
   | Prod (na, c1, b) ->
     let open Context.Rel.Declaration in
     check_is_mutcoind (push_rel (LocalAssum (na,c1)) env) sigma b
@@ -564,7 +585,7 @@ let rec check_is_mutcoind env sigma cl =
       error "All methods must construct elements in coinductive types."
 
 (* Refine as a cofixpoint *)
-let mutual_cofix f others j = Proofview.Goal.nf_enter { enter = begin fun gl ->
+let mutual_cofix f others j = Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let concl = Proofview.Goal.concl gl in
@@ -580,25 +601,26 @@ let mutual_cofix f others j = Proofview.Goal.nf_enter { enter = begin fun gl ->
     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
-  Refine.refine { run = begin fun sigma ->
+  Refine.refine ~typecheck:false begin fun sigma ->
     let (ids, types) = List.split all in
-    let Sigma (evs, sigma, p) = mk_holes nenv sigma Sigma.refl types in
+    let (sigma, evs) = mk_holes nenv sigma types in
     let evs = List.map (Vars.subst_vars (List.rev ids)) evs in
     let funnames = Array.of_list (List.map (fun i -> Name i) ids) in
     let typarray = Array.of_list types in
     let bodies = Array.of_list evs in
-    let oterm = Term.mkCoFix (0, (funnames, typarray, bodies)) in
-    Sigma (oterm, sigma, p)
-  end }
-end }
+    let oterm = mkCoFix (0, (funnames, typarray, bodies)) in
+    (sigma, oterm)
+  end
+end
 
 let cofix ido = match ido with
   | None ->
-    Proofview.Goal.enter { enter = begin fun gl ->
-      let name = Pfedit.get_current_proof_name () in
-      let id = new_fresh_id [] name gl in
+    warning_nameless_fix ();
+    Proofview.Goal.enter begin fun gl ->
+      let name = Proof_global.get_current_proof_name () in
+      let id = new_fresh_id Id.Set.empty name gl in
       mutual_cofix id [] 0
-    end }
+    end
   | Some id ->
       mutual_cofix id [] 0
 
@@ -606,15 +628,16 @@ let cofix ido = match ido with
 (*          Reduction and conversion tactics                  *)
 (**************************************************************)
 
-type tactic_reduction = env -> evar_map -> constr -> constr
+type tactic_reduction = Reductionops.reduction_function
+type e_tactic_reduction = Reductionops.e_reduction_function
 
 let pf_reduce_decl redfun where decl gl =
   let open Context.Named.Declaration in
-  let redfun' = Tacmach.New.pf_apply redfun gl in
+  let redfun' c = Tacmach.New.pf_apply redfun gl c in
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (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
@@ -690,14 +713,14 @@ let bind_red_expr_occurrences occs nbcl redexp =
    certain hypothesis *)
 
 let reduct_in_concl (redfun,sty) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     convert_concl_no_check (Tacmach.New.pf_apply redfun gl (Tacmach.New.pf_concl gl)) sty
-  end }
+  end
 
 let reduct_in_hyp ?(check=false) redfun (id,where) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   convert_hyp ~check (pf_reduce_decl redfun where (Tacmach.New.pf_get_hyp id gl) gl)
-  end }
+  end
 
 let revert_cast (redfun,kind as r) =
   if kind == DEFAULTcast then (redfun,REVERTcast) else r
@@ -711,30 +734,32 @@ let reduct_option ?(check=false) redfun = function
 let pf_e_reduce_decl redfun where decl gl =
   let open Context.Named.Declaration in
   let sigma = Proofview.Goal.sigma gl in
-  let redfun sigma c = redfun.e_redfun (Tacmach.New.pf_env gl) sigma c in
+  let redfun sigma c = redfun (Tacmach.New.pf_env gl) sigma c in
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
-    let Sigma (ty', sigma, p) = redfun sigma ty in
-    Sigma (LocalAssum (id, ty'), sigma, p)
+	user_err  (Id.print id ++ str " has no value.");
+    let (sigma, ty') = redfun sigma ty in
+    (sigma, LocalAssum (id, ty'))
   | LocalDef (id,b,ty) ->
-      let Sigma (b', sigma, p) = if where != InHypTypeOnly then redfun sigma b else Sigma.here b sigma in
-      let Sigma (ty', sigma, q) = if where != InHypValueOnly then redfun sigma ty else Sigma.here ty sigma in
-      Sigma (LocalDef (id, b', ty'), sigma, p +> q)
+      let (sigma, b') = if where != InHypTypeOnly then redfun sigma b else (sigma, b) in
+      let (sigma, ty') = if where != InHypValueOnly then redfun sigma ty else (sigma, ty) in
+      (sigma, LocalDef (id, b', ty'))
 
 let e_reduct_in_concl ~check (redfun, sty) =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let Sigma (c', sigma, p) = redfun.e_redfun (Tacmach.New.pf_env gl) sigma (Tacmach.New.pf_concl gl) in
-    Sigma (convert_concl ~check c' sty, sigma, p)
-  end }
+    let (sigma, c') = redfun (Tacmach.New.pf_env gl) sigma (Tacmach.New.pf_concl gl) in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (convert_concl ~check c' sty)
+  end
 
 let e_reduct_in_hyp ?(check=false) redfun (id, where) =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-    let Sigma (decl', sigma, p) = pf_e_reduce_decl redfun where (Tacmach.New.pf_get_hyp id gl) gl in
-    Sigma (convert_hyp ~check decl', sigma, p)
-  end }
+  Proofview.Goal.enter begin fun gl ->
+    let (sigma, decl') = pf_e_reduce_decl redfun where (Tacmach.New.pf_get_hyp id gl) gl in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (convert_hyp ~check decl')
+  end
 
 let e_reduct_option ?(check=false) redfun = function
   | Some id -> e_reduct_in_hyp ~check (fst redfun) id
@@ -744,41 +769,42 @@ let e_reduct_option ?(check=false) redfun = function
     from conversions. *)
 
 let e_change_in_concl (redfun,sty) =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let Sigma (c, sigma, p) = redfun.e_redfun (Proofview.Goal.env gl) sigma (Proofview.Goal.raw_concl gl) in
-    Sigma (convert_concl_no_check c sty, sigma, p)
-  end }
+    let (sigma, c) = redfun (Proofview.Goal.env gl) sigma (Proofview.Goal.concl gl) in
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (convert_concl_no_check c sty)
+  end
 
 let e_pf_change_decl (redfun : bool -> e_reduction_function) where decl env sigma =
   let open Context.Named.Declaration in
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
-    let Sigma (ty', sigma, p) = (redfun false).e_redfun env sigma ty in
-    Sigma (LocalAssum (id, ty'), sigma, p)
+	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) ->
-      let Sigma (b', sigma, p) =
-	if where != InHypTypeOnly then (redfun true).e_redfun env sigma b else Sigma.here b sigma
+      let (sigma, b') =
+	if where != InHypTypeOnly then redfun true env sigma b else (sigma, b)
       in
-      let Sigma (ty', sigma, q) =
-	if where != InHypValueOnly then (redfun false).e_redfun env sigma ty else Sigma.here ty sigma
+      let (sigma, ty') =
+	if where != InHypValueOnly then redfun false env sigma ty else (sigma, ty)
       in
-      Sigma (LocalDef (id,b',ty'), sigma, p +> q)
+      (sigma, LocalDef (id,b',ty'))
 
 let e_change_in_hyp redfun (id,where) =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  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 Sigma (c, sigma, p) = e_pf_change_decl redfun where hyp (Proofview.Goal.env gl) sigma in
-    Sigma (convert_hyp c, sigma, p)
-  end }
+    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 -> constr Sigma.run
+type change_arg = Ltac_pretype.patvar_map -> evar_map -> evar_map * EConstr.constr
 
-let make_change_arg c pats =
-  { run = fun sigma -> Sigma.here (replace_vars (Id.Map.bindings pats) c) sigma }
+let make_change_arg c pats sigma = (sigma, replace_vars (Id.Map.bindings pats) c)
 
 let check_types env sigma mayneedglobalcheck deep newc origc =
   let t1 = Retyping.get_type_of env sigma newc in
@@ -789,46 +815,43 @@ let check_types env sigma mayneedglobalcheck deep newc origc =
     let sigma, b = infer_conv ~pb:Reduction.CUMUL env sigma t1 t2 in
     if not b then
       if
-        isSort (whd_all env sigma t1) &&
-        isSort (whd_all env sigma t2)
+        isSort sigma (whd_all env sigma t1) &&
+        isSort sigma (whd_all env sigma t2)
       then (mayneedglobalcheck := true; sigma)
       else
-        errorlabstrm "convert-check-hyp" (str "Types are incompatible.")
+        user_err ~hdr:"convert-check-hyp" (str "Types are incompatible.")
     else sigma
   end
   else
-    if not (isSort (whd_all env sigma t1)) then
-      errorlabstrm "convert-check-hyp" (str "Not a type.")
+    if not (isSort sigma (whd_all env sigma t1)) then
+      user_err ~hdr:"convert-check-hyp" (str "Not a type.")
     else sigma
 
 (* Now we introduce different instances of the previous tacticals *)
-let change_and_check cv_pb mayneedglobalcheck deep t = { e_redfun = begin fun env sigma c ->
-  let Sigma (t', sigma, p) = t.run sigma in
-  let sigma = Sigma.to_evar_map sigma in
+let change_and_check cv_pb mayneedglobalcheck deep t env sigma c =
+  let (sigma, t') = t sigma in
   let sigma = check_types env sigma mayneedglobalcheck deep t' c in
   let sigma, b = infer_conv ~pb:cv_pb env sigma t' c in
-  if not b then errorlabstrm "convert-check-hyp" (str "Not convertible.");
-  Sigma.Unsafe.of_pair (t', sigma)
-end }
+  if not b then user_err ~hdr:"convert-check-hyp" (str "Not convertible.");
+  (sigma, t')
 
 (* Use cumulativity only if changing the conclusion not a subterm *)
-let change_on_subterm cv_pb deep t where = { e_redfun = begin fun env sigma c ->
+let change_on_subterm cv_pb deep t where env sigma c =
   let mayneedglobalcheck = ref false in
-  let Sigma (c, sigma, p) = match where with
-  | None -> (change_and_check cv_pb mayneedglobalcheck deep (t Id.Map.empty)).e_redfun env sigma c
+  let (sigma, c) = match where with
+  | None -> change_and_check cv_pb mayneedglobalcheck deep (t Id.Map.empty) env sigma c
   | Some occl ->
-      (e_contextually false occl
+      e_contextually false occl
         (fun subst ->
-          change_and_check Reduction.CONV mayneedglobalcheck true (t subst))).e_redfun
+          change_and_check Reduction.CONV mayneedglobalcheck true (t subst))
         env sigma c in
   if !mayneedglobalcheck then
     begin
-      try ignore (Typing.unsafe_type_of env (Sigma.to_evar_map sigma) c)
+      try ignore (Typing.unsafe_type_of env sigma c)
       with e when catchable_exception e ->
         error "Replacement would lead to an ill-typed term."
     end;
-  Sigma (c, sigma, p)
-end }
+  (sigma, c)
 
 let change_in_concl occl t =
   e_change_in_concl ((change_on_subterm Reduction.CUMUL false t occl),DEFAULTcast)
@@ -841,7 +864,7 @@ let change_option occl t = function
   | None -> change_in_concl occl t
 
 let change chg c cls =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let cls = concrete_clause_of (fun () -> Tacmach.New.pf_ids_of_hyps gl) cls in
     Tacticals.New.tclMAP (function
     | OnHyp (id,occs,where) ->
@@ -849,7 +872,7 @@ let change chg c cls =
     | OnConcl occs ->
        change_option (bind_change_occurrences occs chg) c None)
     cls
-  end }
+  end
 
 let change_concl t = 
   change_in_concl None (make_change_arg t)
@@ -884,16 +907,24 @@ let reduction_clause redexp cl =
 	(None, bind_red_expr_occurrences occs nbcl redexp)) cl
 
 let reduce redexp cl =
-  let trace () = Pp.(hov 2 (Pptactic.pr_atomic_tactic (Global.env()) (TacReduce (redexp,cl)))) in
+  let trace env sigma =
+    let open Printer in
+    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 { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let cl' = concrete_clause_of (fun () -> Tacmach.New.pf_ids_of_hyps gl) cl in
   let redexps = reduction_clause redexp cl' in
   let check = match redexp with Fold _ | Pattern _ -> true | _ -> false in
   Tacticals.New.tclMAP (fun (where,redexp) ->
     e_reduct_option ~check
       (Redexpr.reduction_of_red_expr (Tacmach.New.pf_env gl) redexp) where) redexps
-  end }
+  end
   end
 
 (* Unfolding occurrences of a constant *)
@@ -901,7 +932,7 @@ let reduce redexp cl =
 let unfold_constr = function
   | ConstRef sp -> unfold_in_concl [AllOccurrences,EvalConstRef sp]
   | VarRef id -> unfold_in_concl [AllOccurrences,EvalVarRef id]
-  | _ -> errorlabstrm "unfold_constr" (str "Cannot unfold a non-constant.")
+  | _ -> user_err ~hdr:"unfold_constr" (str "Cannot unfold a non-constant.")
 
 (*******************************************)
 (*         Introduction tactics            *)
@@ -913,13 +944,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
@@ -929,18 +960,19 @@ let build_intro_tac id dest tac = match dest with
 
 let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
-    let concl = nf_evar (Tacmach.New.project gl) concl in
-    match kind_of_term concl with
-    | Prod (name,t,u) when not dep_flag || (dependent (mkRel 1) u) ->
+  Proofview.Goal.enter begin fun gl ->
+    let sigma = Tacmach.New.project 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
 	build_intro_tac name move_flag tac
-    | LetIn (name,b,t,u) when not dep_flag || (dependent (mkRel 1) u) ->
+    | LetIn (name,b,t,u) when not dep_flag || not (noccurn sigma 1 u) ->
         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 *)
@@ -951,26 +983,26 @@ 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
-  end }
+  end
 
 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 (dloc,id)) MoveLast true false
-let intro_using id = intro_gen (NamingBasedOn (id,[])) MoveLast false false
+let intro_mustbe_force id = intro_gen (NamingMustBe (CAst.make id)) MoveLast true 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 (dloc,id)) hto true false
+  | Some id -> intro_gen (NamingMustBe (CAst.make 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 ****)
 
@@ -990,7 +1022,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
@@ -999,37 +1031,17 @@ let intro_forthcoming_then_gen name_flag move_flag dep_flag n bound tac =
   in
   aux n []
 
-let get_next_hyp_position id gl =
-  let open Context.Named.Declaration in
-  let rec aux = function
-  | [] -> raise (RefinerError (NoSuchHyp id))
-  | decl :: right ->
-    if Id.equal (get_id decl) id then
-      match right with decl::_ -> MoveBefore (get_id decl) | [] -> MoveLast
-    else
-      aux right
-  in
-  aux (Proofview.Goal.hyps (Proofview.Goal.assume gl))
-
-let get_previous_hyp_position id gl =
-  let open Context.Named.Declaration in
-  let rec aux dest = function
-  | [] -> raise (RefinerError (NoSuchHyp id))
-  | decl :: right ->
-      let hyp = get_id decl in
-      if Id.equal hyp id then dest else aux (MoveAfter hyp) right
-  in
-  aux MoveLast (Proofview.Goal.hyps (Proofview.Goal.assume gl))
-
 let intro_replacing id =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let next_hyp = get_next_hyp_position id gl in
+  Proofview.Goal.enter begin fun gl ->
+  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;
     move_hyp id next_hyp;
   ]
-  end }
+  end
 
 (* We have e.g. [x, y, y', x', y'' |- forall y y' y'', G] and want to
    reintroduce y, y,' y''. Note that we have to clear y, y' and y''
@@ -1041,8 +1053,10 @@ let intro_replacing id =
 (* the behavior of inversion *)
 let intros_possibly_replacing ids =
   let suboptimal = true in
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let posl = List.map (fun id -> (id, get_next_hyp_position id gl)) ids in
+  Proofview.Goal.enter begin fun gl ->
+    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]))
@@ -1050,30 +1064,32 @@ let intros_possibly_replacing ids =
       (Tacticals.New.tclMAP (fun (id,pos) ->
         Tacticals.New.tclORELSE (intro_move (Some id) pos) (intro_using id))
          posl)
-  end }
+  end
 
 (* This version assumes that replacement is actually possible *)
 let intros_replacing ids =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let posl = List.map (fun id -> (id, get_next_hyp_position id gl)) ids in
+  Proofview.Goal.enter begin fun gl ->
+    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)
-  end }
+  end
 
 (* User-level introduction tactics *)
 
-let lookup_hypothesis_as_renamed env ccl = function
-  | AnonHyp n -> Detyping.lookup_index_as_renamed env ccl n
-  | NamedHyp id -> Detyping.lookup_name_as_displayed env ccl id
+let lookup_hypothesis_as_renamed env sigma ccl = function
+  | AnonHyp n -> Detyping.lookup_index_as_renamed env sigma ccl n
+  | NamedHyp id -> Detyping.lookup_name_as_displayed env sigma ccl id
 
 let lookup_hypothesis_as_renamed_gen red h gl =
   let env = Proofview.Goal.env gl in
   let rec aux ccl =
-    match lookup_hypothesis_as_renamed env ccl h with
+    match lookup_hypothesis_as_renamed env (Tacmach.New.project gl) ccl h with
       | None when red ->
         let (redfun, _) = Redexpr.reduction_of_red_expr env (Red true) in
-        let Sigma (c, _, _) = redfun.e_redfun env (Proofview.Goal.sigma gl) ccl in
+        let (_, c) = redfun env (Proofview.Goal.sigma gl) ccl in
         aux c
       | x -> x
   in
@@ -1087,7 +1103,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"
@@ -1096,17 +1112,17 @@ let depth_of_quantified_hypothesis red h gl =
   match lookup_hypothesis_as_renamed_gen red h gl with
     | Some depth -> depth
     | None ->
-        errorlabstrm "lookup_quantified_hypothesis"
+        user_err ~hdr:"lookup_quantified_hypothesis"
           (str "No " ++ msg_quantified_hypothesis h ++
 	  strbrk " in current goal" ++
 	  (if red then strbrk " even after head-reduction" else mt ()) ++
 	  str".")
 
 let intros_until_gen red h =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let n = depth_of_quantified_hypothesis red h gl in
   Tacticals.New.tclDO n (if red then introf else intro)
-  end }
+  end
 
 let intros_until_id id = intros_until_gen false (NamedHyp id)
 let intros_until_n_gen red n = intros_until_gen red (AnonHyp n)
@@ -1115,10 +1131,10 @@ let intros_until = intros_until_gen true
 let intros_until_n = intros_until_n_gen true
 
 let tclCHECKVAR id =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let _ = Tacmach.New.pf_get_hyp id (Proofview.Goal.assume gl) in
+  Proofview.Goal.enter begin fun gl ->
+    let _ = Tacmach.New.pf_get_hyp id gl in
     Proofview.tclUNIT ()
-  end }
+  end
 
 let try_intros_until_id_check id =
   Tacticals.New.tclORELSE (intros_until_id id) (tclCHECKVAR id)
@@ -1130,49 +1146,43 @@ let try_intros_until tac = function
 let rec intros_move = function
   | [] -> Proofview.tclUNIT ()
   | (hyp,destopt) :: rest ->
-      Tacticals.New.tclTHEN (intro_gen (NamingMustBe (dloc,hyp)) destopt false false)
+      Tacticals.New.tclTHEN (intro_gen (NamingMustBe (CAst.make hyp)) destopt false false)
 	(intros_move rest)
 
-let run_delayed env sigma c =
-  Sigma.run sigma { Sigma.run = fun sigma -> c.delayed env sigma }
-
 (* Apply a tactic on a quantified hypothesis, an hypothesis in context
    or a term with bindings *)
 
 let tactic_infer_flags with_evar = {
   Pretyping.use_typeclasses = true;
   Pretyping.solve_unification_constraints = true;
-  Pretyping.use_hook = Some solve_by_implicit_tactic;
+  Pretyping.use_hook = Pfedit.solve_by_implicit_tactic ();
   Pretyping.fail_evar = not with_evar;
   Pretyping.expand_evars = true }
 
 
 let onOpenInductionArg env sigma tac = function
   | clear_flag,ElimOnConstr f ->
-      let (cbl, sigma') = run_delayed env sigma f in
-      let pending = (sigma,sigma') in
+      let (sigma', cbl) = f env sigma in
       Tacticals.New.tclTHEN
         (Proofview.Unsafe.tclEVARS sigma')
-        (tac clear_flag (pending,cbl))
+        (tac clear_flag (sigma,cbl))
   | clear_flag,ElimOnAnonHyp n ->
       Tacticals.New.tclTHEN
         (intros_until_n n)
         (Tacticals.New.onLastHyp
            (fun c ->
-             Proofview.Goal.enter { enter = begin fun gl ->
+             Proofview.Goal.enter begin fun gl ->
              let sigma = Tacmach.New.project gl in
-             let pending = (sigma,sigma) in
-             tac clear_flag (pending,(c,NoBindings))
-             end }))
-  | clear_flag,ElimOnIdent (_,id) ->
+             tac clear_flag (sigma,(c,NoBindings))
+             end))
+  | clear_flag,ElimOnIdent {CAst.v=id} ->
       (* A quantified hypothesis *)
       Tacticals.New.tclTHEN
         (try_intros_until_id_check id)
-        (Proofview.Goal.enter { enter = begin fun gl ->
+        (Proofview.Goal.enter begin fun gl ->
          let sigma = Tacmach.New.project gl in
-         let pending = (sigma,sigma) in
-         tac clear_flag (pending,(mkVar id,NoBindings))
-        end })
+         tac clear_flag (sigma,(mkVar id,NoBindings))
+        end)
 
 let onInductionArg tac = function
   | clear_flag,ElimOnConstr cbl ->
@@ -1181,7 +1191,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)
@@ -1193,12 +1203,10 @@ let map_destruction_arg f sigma = function
   | clear_flag,ElimOnIdent id as x -> (sigma,x)
 
 let finish_delayed_evar_resolution with_evars env sigma f =
-  let ((c, lbind), sigma') = run_delayed env sigma f in
-  let pending = (sigma,sigma') in
-  let sigma' = Sigma.Unsafe.of_evar_map sigma' in
+  let (sigma', (c, lbind)) = f env sigma in
   let flags = tactic_infer_flags with_evars in
-  let Sigma (c, sigma', _) = finish_evar_resolution ~flags env sigma' (pending,c) in
-  (Sigma.to_evar_map sigma', (c, lbind))
+  let (sigma', c) = finish_evar_resolution ~flags env sigma' (sigma,c) in
+  (sigma', (c, lbind))
 
 let with_no_bindings (c, lbind) =
   if lbind != NoBindings then error "'with' clause not supported here.";
@@ -1214,45 +1222,46 @@ let force_destruction_arg with_evars env sigma c =
 let normalize_cut = false
 
 let cut c =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
-    let concl = Tacmach.New.pf_nf_concl gl in
+    let concl = Proofview.Goal.concl gl in
     let is_sort =
       try
         (** Backward compat: ensure that [c] is well-typed. *)
         let typ = Typing.unsafe_type_of env sigma c in
         let typ = whd_all env sigma typ in
-        match kind_of_term typ with
+        match EConstr.kind sigma typ with
         | Sort _ -> true
         | _ -> false
       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 ~unsafe:true { run = begin fun h ->
-        let Sigma (f, h, p) = Evarutil.new_evar ~principal:true env h (mkArrow c (Vars.lift 1 concl)) in
-        let Sigma (x, h, q) = Evarutil.new_evar env h c in
+      Refine.refine ~typecheck:false begin fun h ->
+        let (h, f) = Evarutil.new_evar ~principal:true env h (mkArrow c (Vars.lift 1 concl)) in
+        let (h, x) = Evarutil.new_evar env h c in
         let f = mkLetIn (Name id, x, c, mkApp (Vars.lift 1 f, [|mkRel 1|])) in
-        Sigma (f, h, p +> q)
-      end }
+        (h, f)
+      end
     else
       Tacticals.New.tclZEROMSG (str "Not a proposition or a type.")
-  end }
+  end
 
 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 errorlabstrm "" (str "Cannot find an instance for " ++ pr_id id ++ str".")
+  let id = match na with Name id -> id | _ -> anomaly (Pp.str "unnamed dependent meta.")
+  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
@@ -1261,7 +1270,7 @@ let check_unresolved_evars_of_metas sigma clenv =
   (meta_list clenv.evd)
 
 let do_replace id = function
-  | NamingMustBe (_,id') when Option.equal Id.equal id (Some id') -> true
+  | NamingMustBe {CAst.v=id'} when Option.equal Id.equal id (Some id') -> true
   | _ -> false
 
 (* For a clenv expressing some lemma [C[?1:T1,...,?n:Tn] : P] and some
@@ -1281,11 +1290,11 @@ let clenv_refine_in ?(sidecond_first=false) with_evars ?(with_classes=true)
   in
   let new_hyp_typ = clenv_type clenv in
   if not with_evars then check_unresolved_evars_of_metas sigma0 clenv;
-  if not with_evars && occur_meta new_hyp_typ then
+  if not with_evars && occur_meta clenv.evd new_hyp_typ then
     error_uninstantiated_metas new_hyp_typ clenv;
   let new_hyp_prf = clenv_value clenv in
   let exact_tac = Proofview.V82.tactic (Tacmach.refine_no_check new_hyp_prf) in
-  let naming = NamingMustBe (dloc,targetid) in
+  let naming = NamingMustBe (CAst.make targetid) in
   let with_clear = do_replace (Some id) naming in
   Tacticals.New.tclTHEN
     (Proofview.Unsafe.tclEVARS (clear_metas clenv.evd))
@@ -1300,90 +1309,50 @@ let clenv_refine_in ?(sidecond_first=false) with_evars ?(with_classes=true)
 (*       Elimination tactics                *)
 (********************************************)
 
-let last_arg c = match kind_of_term c with
+let last_arg sigma c = match EConstr.kind sigma c with
   | App (f,cl) ->
       Array.last cl
-  | _ -> anomaly (Pp.str "last_arg")
+  | _ -> anomaly (Pp.str "last_arg.")
 
-let nth_arg i c =
-  if Int.equal i (-1) then last_arg c else
-  match kind_of_term c with
+let nth_arg sigma i c =
+  if Int.equal i (-1) then last_arg sigma c else
+  match EConstr.kind sigma c with
   | App (f,cl) -> cl.(i)
-  | _ -> anomaly (Pp.str "nth_arg")
+  | _ -> anomaly (Pp.str "nth_arg.")
 
-let index_of_ind_arg t =
-  let rec aux i j t = match kind_of_term t with
+let index_of_ind_arg sigma t =
+  let rec aux i j t = match EConstr.kind sigma t with
   | Prod (_,t,u) ->
       (* heuristic *)
-      if isInd (fst (decompose_app t)) then aux (Some j) (j+1) u
+      if isInd sigma (fst (decompose_app sigma t)) then aux (Some j) (j+1) u
       else aux i (j+1) u
   | _ -> match i with
       | Some i -> i
       | None -> error "Could not find inductive argument of elimination scheme."
   in aux None 0 t
 
-let enforce_prop_bound_names rename tac =
-  let open Context.Rel.Declaration in
-  match rename with
-  | Some (isrec,nn) when Namegen.use_h_based_elimination_names () ->
-      (* Rename dependent arguments in Prop with name "H" *)
-      (* so as to avoid having hypothesis such as "t:True", "n:~A" when calling *)
-      (* elim or induction with schemes built by Indrec.build_induction_scheme *)
-      let rec aux env sigma i t =
-        if i = 0 then t else match kind_of_term t with
-        | Prod (Name _ as na,t,t') ->
-            let very_standard = true in
-            let na =
-              if Retyping.get_sort_family_of env sigma t = InProp then
-                (* "very_standard" says that we should have "H" names only, but
-                   this would break compatibility even more... *)
-                let s = match Namegen.head_name t with
-                  | Some id when not very_standard -> string_of_id id
-                  | _ -> "" in
-                Name (add_suffix Namegen.default_prop_ident s)
-              else
-                na in
-            mkProd (na,t,aux (push_rel (LocalAssum (na,t)) env) sigma (i-1) t')
-        | Prod (Anonymous,t,t') ->
-            mkProd (Anonymous,t,aux (push_rel (LocalAssum (Anonymous,t)) env) sigma (i-1) t')
-        | LetIn (na,c,t,t') ->
-            mkLetIn (na,c,t,aux (push_rel (LocalDef (na,c,t)) env) sigma (i-1) t')
-        | _ -> print_int i; Feedback.msg_notice (print_constr t); assert false in
-      let rename_branch i =
-        Proofview.Goal.nf_enter { enter = begin fun gl ->
-          let env = Proofview.Goal.env gl in
-          let sigma = Tacmach.New.project gl in
-          let t = Proofview.Goal.concl gl in
-          change_concl (aux env sigma i t)
-        end } in
-      (if isrec then Tacticals.New.tclTHENFIRSTn else Tacticals.New.tclTHENLASTn)
-        tac
-        (Array.map rename_branch nn)
-  | _ ->
-      tac
-
-let rec contract_letin_in_lam_header c =
-  match kind_of_term c with
-  | Lambda (x,t,c)  -> mkLambda (x,t,contract_letin_in_lam_header c)
-  | LetIn (x,b,t,c) -> contract_letin_in_lam_header (subst1 b c)
+let rec contract_letin_in_lam_header sigma c =
+  match EConstr.kind sigma c with
+  | Lambda (x,t,c)  -> mkLambda (x,t,contract_letin_in_lam_header sigma c)
+  | LetIn (x,b,t,c) -> contract_letin_in_lam_header sigma (subst1 b c)
   | _ -> c
 
 let elimination_clause_scheme with_evars ?(with_classes=true) ?(flags=elim_flags ()) 
     rename i (elim, elimty, bindings) indclause =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
-  let elim = contract_letin_in_lam_header elim in
+  let elim = contract_letin_in_lam_header sigma elim in
   let elimclause = make_clenv_binding env sigma (elim, elimty) bindings in
   let indmv =
-    (match kind_of_term (nth_arg i elimclause.templval.rebus) with
+    (match EConstr.kind sigma (nth_arg sigma i elimclause.templval.rebus) with
        | Meta mv -> mv
-       | _  -> errorlabstrm "elimination_clause"
+       | _  -> user_err ~hdr:"elimination_clause"
              (str "The type of elimination clause is not well-formed."))
   in
   let elimclause' = clenv_fchain ~flags indmv elimclause indclause in
-  enforce_prop_bound_names rename (Clenvtac.res_pf elimclause' ~with_evars ~with_classes ~flags)
-  end }
+  Clenvtac.res_pf elimclause' ~with_evars ~with_classes ~flags
+  end
 
 (*
  * Elimination tactic with bindings and using an arbitrary
@@ -1396,22 +1365,22 @@ let elimination_clause_scheme with_evars ?(with_classes=true) ?(flags=elim_flags
 type eliminator = {
   elimindex : int option;  (* None = find it automatically *)
   elimrename : (bool * int array) option; (** None = don't rename Prop hyps with H-names *)
-  elimbody : constr with_bindings
+  elimbody : EConstr.constr with_bindings
 }
 
 let general_elim_clause_gen elimtac indclause elim =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let (elimc,lbindelimc) = elim.elimbody in
   let elimt = Retyping.get_type_of env sigma elimc in
   let i =
-    match elim.elimindex with None -> index_of_ind_arg elimt | Some i -> i in
+    match elim.elimindex with None -> index_of_ind_arg sigma elimt | Some i -> i in
   elimtac elim.elimrename i (elimc, elimt, lbindelimc) indclause
-  end }
+  end
 
 let general_elim with_evars clear_flag (c, lbindc) elim =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let ct = Retyping.get_type_of env sigma c in
@@ -1423,33 +1392,34 @@ let general_elim with_evars clear_flag (c, lbindc) elim =
   Tacticals.New.tclTHEN
     (general_elim_clause_gen elimtac indclause elim)
     (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c)
-  end }
+  end
 
 (* Case analysis tactics *)
 
 let general_case_analysis_in_context with_evars clear_flag (c,lbindc) =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   let env = Proofview.Goal.env gl in
   let concl = Proofview.Goal.concl gl in
-  let t = Retyping.get_type_of env (Sigma.to_evar_map sigma) c in
-  let (mind,_) = reduce_to_quantified_ind env (Sigma.to_evar_map sigma) t in
+  let t = Retyping.get_type_of env sigma c in
+  let (mind,_) = reduce_to_quantified_ind env sigma t in
   let sort = Tacticals.New.elimination_sort_of_goal gl in
-  let Sigma (elim, sigma, p) =
-    if occur_term c concl then
+  let mind = on_snd (fun u -> EInstance.kind sigma u) mind in
+  let (sigma, elim) =
+    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
-  let tac =
+  let elim = EConstr.of_constr elim in
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
   (general_elim with_evars clear_flag (c,lbindc)
    {elimindex = None; elimbody = (elim,NoBindings);
     elimrename = Some (false, constructors_nrealdecls (fst mind))})
-  in
-  Sigma (tac, sigma, p)
-  end }
+  end
 
 let general_case_analysis with_evars clear_flag (c,lbindc as cx) =
-  match kind_of_term c with
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma c with
     | Var id when lbindc == NoBindings ->
 	Tacticals.New.tclTHEN (try_intros_until_id_check id)
 	  (general_case_analysis_in_context with_evars clear_flag cx)
@@ -1464,11 +1434,12 @@ 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
   let evd, c = Tacmach.New.pf_apply Evd.fresh_global gl gr in
+  let c = EConstr.of_constr c in
     evd, c
 
 let find_eliminator c gl =
@@ -1480,13 +1451,11 @@ let find_eliminator c gl =
 
 let default_elim with_evars clear_flag (c,_ as cx) =
   Proofview.tclORELSE
-    (Proofview.Goal.s_enter { s_enter = begin fun gl ->
+    (Proofview.Goal.enter begin fun gl ->
       let sigma, elim = find_eliminator c gl in
-      let tac =
-	  (general_elim with_evars clear_flag cx elim)
-      in
-      Sigma.Unsafe.of_pair (tac, sigma)
-    end })
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+      (general_elim with_evars clear_flag cx elim)
+    end)
     begin function (e, info) -> match e with
       | IsNonrec ->
           (* For records, induction principles aren't there by default
@@ -1502,7 +1471,8 @@ let elim_in_context with_evars clear_flag c = function
   | None -> default_elim with_evars clear_flag c
 
 let elim with_evars clear_flag (c,lbindc as cx) elim =
-  match kind_of_term c with
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match EConstr.kind sigma c with
     | Var id when lbindc == NoBindings ->
 	Tacticals.New.tclTHEN (try_intros_until_id_check id)
 	  (elim_in_context with_evars clear_flag cx elim)
@@ -1533,30 +1503,30 @@ let clenv_fchain_in id ?(flags=elim_flags ()) mv elimclause hypclause =
 
 let elimination_in_clause_scheme with_evars ?(flags=elim_flags ()) 
     id rename i (elim, elimty, bindings) indclause =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
-  let elim = contract_letin_in_lam_header elim in
+  let elim = contract_letin_in_lam_header sigma elim in
   let elimclause = make_clenv_binding env sigma (elim, elimty) bindings in
-  let indmv = destMeta (nth_arg i elimclause.templval.rebus) 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 _ -> errorlabstrm "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
   let hypclause = mk_clenv_from_env env sigma (Some 0) (hyp, hyp_typ) in
   let elimclause'' = clenv_fchain_in id ~flags hypmv elimclause' hypclause in
   let new_hyp_typ  = clenv_type elimclause'' in
-  if Term.eq_constr hyp_typ new_hyp_typ then
-    errorlabstrm "general_rewrite_in"
-      (str "Nothing to rewrite in " ++ pr_id id ++ str".");
+  if EConstr.eq_constr sigma hyp_typ new_hyp_typ then
+    user_err ~hdr:"general_rewrite_in"
+      (str "Nothing to rewrite in " ++ Id.print id ++ str".");
   clenv_refine_in with_evars id id sigma elimclause''
     (fun id -> Proofview.tclUNIT ())
-  end }
+  end
 
 let general_elim_clause with_evars flags id c e =
   let elim = match id with
@@ -1568,7 +1538,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 =
@@ -1576,21 +1546,23 @@ let make_projection env sigma params cstr sign elim i n c u =
   let elim = match elim with
   | NotADefinedRecordUseScheme elim ->
       (* bugs: goes from right to left when i increases! *)
-      let decl = List.nth cstr.cs_args i in
-      let t = get_type decl in
+      let cs_args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cstr.cs_args in
+      let decl = List.nth cs_args i in
+      let t = RelDecl.get_type decl in
       let b = match decl with LocalAssum _ -> mkRel (i+1) | LocalDef (_,b,_) -> b in
-      let branch = it_mkLambda_or_LetIn b cstr.cs_args in
+      let branch = it_mkLambda_or_LetIn b cs_args in
       if
 	(* excludes dependent projection types *)
-	noccur_between 1 (n-i-1) t
+	noccur_between sigma 1 (n-i-1) t
 	(* to avoid surprising unifications, excludes flexible
 	projection types or lambda which will be instantiated by Meta/Evar *)
-	&& not (isEvar (fst (whd_betaiota_stack sigma t)))
-	&& (accept_universal_lemma_under_conjunctions () || not (isRel t))
+	&& not (isEvar sigma (fst (whd_betaiota_stack sigma t)))
+	&& (accept_universal_lemma_under_conjunctions () || not (isRel sigma t))
       then
         let t = lift (i+1-n) t in
-	let abselim = beta_applist (elim,params@[t;branch]) in
-	let c = beta_applist (abselim, [mkApp (c, Context.Rel.to_extended_vect 0 sign)]) in
+	let abselim = beta_applist sigma (elim, params@[t;branch]) in
+	let args = Context.Rel.to_extended_vect mkRel 0 sign in
+	let c = beta_applist sigma (abselim, [mkApp (c, args)]) in
 	  Some (it_mkLambda_or_LetIn c sign, it_mkProd_or_LetIn t sign)
       else
 	None
@@ -1598,7 +1570,7 @@ let make_projection env sigma params cstr sign elim i n c u =
       (* goes from left to right when i increases! *)
       match List.nth l i with
       | Some proj ->
-	  let args = Context.Rel.to_extended_vect 0 sign in
+	  let args = Context.Rel.to_extended_vect mkRel 0 sign in
 	  let proj =
 	    if Environ.is_projection proj env then
 	      mkProj (Projection.make proj false, mkApp (c, args))
@@ -1613,30 +1585,32 @@ let make_projection env sigma params cstr sign elim i n c u =
   in elim
 
 let descend_in_conjunctions avoid tac (err, info) c =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   try
     let t = Retyping.get_type_of env sigma c in
     let ((ind,u),t) = reduce_to_quantified_ind env sigma t in
-    let sign,ccl = decompose_prod_assum t in
-    match match_with_tuple ccl with
+    let sign,ccl = EConstr.decompose_prod_assum sigma t in
+    match match_with_tuple sigma ccl with
     | Some (_,_,isrec) ->
 	let n = (constructors_nrealargs ind).(0) in
 	let sort = Tacticals.New.elimination_sort_of_goal gl in
 	let IndType (indf,_) = find_rectype env sigma ccl in
 	let (_,inst), params = dest_ind_family indf in
+	let params = List.map EConstr.of_constr params in
 	let cstr = (get_constructors env indf).(0) in
 	let elim =
 	  try DefinedRecord (Recordops.lookup_projections ind)
 	  with Not_found ->
-            let sigma = Sigma.Unsafe.of_evar_map sigma in
-	    let Sigma (elim, _, _) = build_case_analysis_scheme env sigma (ind,u) false sort in
+            let u = EInstance.kind sigma u in
+	    let (_, elim) = build_case_analysis_scheme env sigma (ind,u) false sort in
+	    let elim = EConstr.of_constr elim in
 	    NotADefinedRecordUseScheme elim in
 	Tacticals.New.tclORELSE0
 	(Tacticals.New.tclFIRST
 	  (List.init n (fun i ->
-            Proofview.Goal.enter { enter = begin fun gl ->
+            Proofview.Goal.enter begin fun gl ->
             let env = Proofview.Goal.env gl in
             let sigma = Tacmach.New.project gl in
 	    match make_projection env sigma params cstr sign elim i n c u with
@@ -1647,33 +1621,16 @@ let descend_in_conjunctions avoid tac (err, info) c =
 		[Proofview.V82.tactic (refine p);
 		 (* Might be ill-typed due to forbidden elimination. *)
 		 Tacticals.New.onLastHypId (tac (not isrec))]
-           end })))
+           end)))
           (Proofview.tclZERO ~info err)
     | None -> Proofview.tclZERO ~info err
   with RefinerError _|UserError _ -> Proofview.tclZERO ~info err
-  end }
+  end
 
 (****************************************************)
 (*            Resolution tactics                    *)
 (****************************************************)
 
-let solve_remaining_apply_goals =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-  let sigma = Proofview.Goal.sigma gl in
-  if !apply_solve_class_goals then
-    try 
-      let env = Proofview.Goal.env gl in
-      let evd = Sigma.to_evar_map sigma in
-      let concl = Proofview.Goal.concl gl in
-      if Typeclasses.is_class_type evd concl then
-        let evd', c' = Typeclasses.resolve_one_typeclass env evd concl in
-        let tac = Refine.refine ~unsafe:true { run = fun h -> Sigma.here c' h } in
-        Sigma.Unsafe.of_pair (tac, evd')
-	else Sigma.here (Proofview.tclUNIT ()) sigma
-    with Not_found -> Sigma.here (Proofview.tclUNIT ()) sigma
-  else Sigma.here (Proofview.tclUNIT ()) sigma
-  end }
-
 let tclORELSEOPT t k =
   Proofview.tclORELSE t
     (fun e -> match k e with
@@ -1682,25 +1639,27 @@ let tclORELSEOPT t k =
       Proofview.tclZERO ~info e
     | Some tac -> tac)
 
-let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind)) =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+let general_apply with_delta with_destruct with_evars clear_flag
+    {CAst.loc;v=(c,lbind : EConstr.constr with_bindings)} =
+  Proofview.Goal.enter begin fun gl ->
   let concl = Proofview.Goal.concl gl in
+  let sigma = Tacmach.New.project gl in
   let flags =
     if with_delta then default_unify_flags () else default_no_delta_unify_flags () in
   (* The actual type of the theorem. It will be matched against the
   goal. If this fails, then the head constant will be unfolded step by
   step. *)
-  let concl_nprod = nb_prod_modulo_zeta concl in
+  let concl_nprod = nb_prod_modulo_zeta sigma concl in
   let rec try_main_apply with_destruct c =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     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 thm_ty - nprod in
-        if n<0 then error "Applied theorem has not enough premisses.";
+        let n = nb_prod_modulo_zeta sigma thm_ty - nprod in
+        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 ->
@@ -1719,10 +1678,10 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind))
       with Redelimination ->
         (* Last chance: if the head is a variable, apply may try
             second order unification *)
-        let info = Loc.add_loc info loc in
+        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))
@@ -1746,14 +1705,12 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind))
       | PretypeError _|RefinerError _|UserError _|Failure _ ->
         Some (try_red_apply thm_ty0 (e, info))
       | _ -> None)
-    end }
+    end
   in
-    Tacticals.New.tclTHENLIST [
-      try_main_apply with_destruct c;
-      solve_remaining_apply_goals;
-      apply_clear_request clear_flag (use_clear_hyp_by_default ()) c
-    ]
-  end }
+    Tacticals.New.tclTHEN
+      (try_main_apply with_destruct c)
+      (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c)
+  end
 
 let rec apply_with_bindings_gen b e = function
   | [] -> Proofview.tclUNIT ()
@@ -1764,14 +1721,14 @@ let rec apply_with_bindings_gen b e = function
         (apply_with_bindings_gen b e cbl)
 
 let apply_with_delayed_bindings_gen b e l = 
-  let one k (loc, f) =
-    Proofview.Goal.enter { enter = begin fun gl ->
+  let one k {CAst.loc;v=f} =
+    Proofview.Goal.enter begin fun gl ->
       let sigma = Tacmach.New.project gl in
       let env = Proofview.Goal.env gl in
-      let (cb, sigma) = run_delayed env sigma f in
+      let (sigma, cb) = f env sigma in
 	Tacticals.New.tclWITHHOLES e
-          (general_apply b b e k (loc,cb)) sigma
-    end }
+          (general_apply b b e k CAst.(make ?loc cb)) sigma
+    end
   in
   let rec aux = function
     | [] -> Proofview.tclUNIT ()
@@ -1781,13 +1738,13 @@ let apply_with_delayed_bindings_gen b e l =
         (one k f) (aux cbl)
   in aux l
 
-let apply_with_bindings cb = apply_with_bindings_gen false false [None,(dloc,cb)]
+let apply_with_bindings cb = apply_with_bindings_gen false false [None,(CAst.make cb)]
 
-let eapply_with_bindings cb = apply_with_bindings_gen false true [None,(dloc,cb)]
+let eapply_with_bindings cb = apply_with_bindings_gen false true [None,(CAst.make cb)]
 
-let apply c = apply_with_bindings_gen false false [None,(dloc,(c,NoBindings))]
+let apply c = apply_with_bindings_gen false false [None,(CAst.make (c,NoBindings))]
 
-let eapply c = apply_with_bindings_gen false true [None,(dloc,(c,NoBindings))]
+let eapply c = apply_with_bindings_gen false true [None,(CAst.make (c,NoBindings))]
 
 let apply_list = function
   | c::l -> apply_with_bindings (c,ImplicitBindings l)
@@ -1811,31 +1768,44 @@ let find_matching_clause unifier clause =
     with NotExtensibleClause -> failwith "Cannot apply"
   in find clause
 
+exception UnableToApply
+
 let progress_with_clause flags innerclause clause =
   let ordered_metas = List.rev (clenv_independent clause) in
-  if List.is_empty ordered_metas then error "Statement without assumptions.";
+  if List.is_empty ordered_metas then raise UnableToApply;
   let f mv =
     try Some (find_matching_clause (clenv_fchain ~with_univs:false mv ~flags clause) innerclause)
     with Failure _ -> None
   in
   try List.find_map f ordered_metas
-  with Not_found -> error "Unable to unify."
-
-let apply_in_once_main flags innerclause env sigma (d,lbind) =
-  let thm = nf_betaiota sigma (Retyping.get_type_of env sigma d) in
+  with Not_found -> raise UnableToApply
+
+let explain_unable_to_apply_lemma ?loc env sigma thm innerclause =
+  user_err ?loc (hov 0
+    (Pp.str "Unable to apply lemma of type" ++ brk(1,1) ++
+     Pp.quote (Printer.pr_leconstr_env env sigma thm) ++ spc() ++
+     str "on hypothesis of type" ++ brk(1,1) ++
+     Pp.quote (Printer.pr_leconstr_env innerclause.env innerclause.evd (clenv_type innerclause)) ++
+     str "."))
+
+let apply_in_once_main flags innerclause env sigma (loc,d,lbind) =
+  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 ->
-    let e = CErrors.push e in
+    let e' = CErrors.push e in
     try aux (clenv_push_prod clause)
-    with NotExtensibleClause -> iraise e
+    with NotExtensibleClause ->
+      match e with
+      | UnableToApply -> explain_unable_to_apply_lemma ?loc env sigma thm innerclause
+      | _ -> iraise e'
   in
   aux (make_clenv_binding env sigma (d,thm) lbind)
 
 let apply_in_once sidecond_first with_delta with_destruct with_evars naming
-    id (clear_flag,(loc,(d,lbind))) tac =
+    id (clear_flag,{ CAst.loc; v= d,lbind}) tac =
   let open Context.Rel.Declaration in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
   let flags =
@@ -1844,11 +1814,11 @@ let apply_in_once sidecond_first with_delta with_destruct with_evars naming
   let innerclause = mk_clenv_from_env env sigma (Some 0) (mkVar id,t') in
   let targetid = find_name true (LocalAssum (Anonymous,t')) naming gl in
   let rec aux idstoclear with_destruct c =
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     try
-      let clause = apply_in_once_main flags innerclause env sigma (c,lbind) in
+      let clause = apply_in_once_main flags innerclause env sigma (loc,c,lbind) in
       clenv_refine_in ~sidecond_first with_evars targetid id sigma clause
         (fun id ->
           Tacticals.New.tclTHENLIST [
@@ -1858,25 +1828,25 @@ 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 }
+    end
   in
   aux [] with_destruct d
-  end }
+  end
 
 let apply_in_delayed_once sidecond_first with_delta with_destruct with_evars naming
-    id (clear_flag,(loc,f)) tac =
-  Proofview.Goal.enter { enter = begin fun gl ->
+    id (clear_flag,{CAst.loc;v=f}) tac =
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
-    let (c, sigma) = run_delayed env sigma f in
+    let (sigma, c) = f env sigma in
     Tacticals.New.tclWITHHOLES with_evars 
       (apply_in_once sidecond_first with_delta with_destruct with_evars
-         naming id (clear_flag,(loc,c)) tac)
+         naming id (clear_flag,CAst.(make ?loc c)) tac)
       sigma
-  end }
+  end
 
 (* A useful resolution tactic which, if c:A->B, transforms |- C into
    |- B -> C and |- A
@@ -1896,70 +1866,65 @@ let apply_in_delayed_once sidecond_first with_delta with_destruct with_evars nam
 *)
 
 let cut_and_apply c =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    match kind_of_term (Tacmach.New.pf_hnf_constr gl (Tacmach.New.pf_unsafe_type_of gl c)) with
-      | Prod (_,c1,c2) when not (dependent (mkRel 1) c2) ->
+  Proofview.Goal.enter begin fun gl ->
+    let sigma = Tacmach.New.project gl in
+    match EConstr.kind sigma (Tacmach.New.pf_hnf_constr gl (Tacmach.New.pf_unsafe_type_of gl c)) with
+      | Prod (_,c1,c2) when Vars.noccurn sigma 1 c2 ->
         let concl = Proofview.Goal.concl gl in
         let env = Tacmach.New.pf_env gl in
-        Refine.refine { run = begin fun sigma ->
+        Refine.refine ~typecheck:false begin fun sigma ->
           let typ = mkProd (Anonymous, c2, concl) in
-          let Sigma (f, sigma, p) = Evarutil.new_evar env sigma typ in
-          let Sigma (x, sigma, q) = Evarutil.new_evar env sigma c1 in
-          let ans = mkApp (f, [|mkApp (c, [|x|])|]) in
-          Sigma (ans, sigma, p +> q)
-        end }
+          let (sigma, f) = Evarutil.new_evar env sigma typ in
+          let (sigma, x) = Evarutil.new_evar env sigma c1 in
+          (sigma, mkApp (f, [|mkApp (c, [|x|])|]))
+        end
       | _ -> error "lapply needs a non-dependent product."
-  end }
+  end
 
 (********************************************************************)
 (*               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 ~unsafe:true { run = fun h -> Sigma.here c h }
+  Refine.refine ~typecheck:false (fun h -> (h,c))
 
 let exact_check c =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  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 = Sigma.to_evar_map sigma in
   let sigma, ct = Typing.type_of env sigma c in
-  let tac =
-      Tacticals.New.tclTHEN (convert_leq ct concl) (exact_no_check c)
-  in
-  Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+  Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  (Tacticals.New.tclTHEN (convert_leq ct concl) (exact_no_check c))
+  end
 
 let cast_no_check cast c =
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
-    exact_no_check (Term.mkCast (c, cast, concl))
-  end }
+  Proofview.Goal.enter begin fun gl ->
+    let concl = Proofview.Goal.concl gl in
+    exact_no_check (mkCast (c, cast, concl))
+  end
 
 let vm_cast_no_check c = cast_no_check Term.VMcast c
 let native_cast_no_check c = cast_no_check Term.NATIVEcast c
 
 let exact_proof c =
   let open Tacmach.New in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  Refine.refine { run = begin fun sigma ->
-    let sigma = Sigma.to_evar_map sigma in
+  Proofview.Goal.enter begin fun gl ->
+  Refine.refine ~typecheck:false begin fun sigma ->
     let (c, ctx) = Constrintern.interp_casted_constr (pf_env gl) sigma c (pf_concl gl) in
     let sigma = Evd.merge_universe_context sigma ctx in
-    Sigma.Unsafe.of_pair (c, sigma)
-  end }
-  end }
+    (sigma, c)
+  end
+  end
 
 let assumption =
-  let open Context.Named.Declaration in
   let rec arec gl only_eq = function
   | [] ->
     if only_eq then
@@ -1967,25 +1932,25 @@ let assumption =
       arec gl false hyps
     else Tacticals.New.tclZEROMSG (str "No such assumption.")
   | decl::rest ->
-    let t = get_type decl in
+    let t = NamedDecl.get_type decl in
     let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
     let (sigma, is_same_type) =
-      if only_eq then (sigma, Constr.equal t concl)
+      if only_eq then (sigma, EConstr.eq_constr sigma t concl)
       else
         let env = Proofview.Goal.env gl in
         infer_conv env sigma t concl
     in
     if is_same_type then
       (Proofview.Unsafe.tclEVARS sigma) <*>
-	exact_no_check (mkVar (get_id decl))
+	exact_no_check (mkVar (NamedDecl.get_id decl))
     else arec gl only_eq rest
   in
-  let assumption_tac = { enter = begin fun gl ->
+  let assumption_tac gl =
     let hyps = Proofview.Goal.hyps gl in
     arec gl true hyps
-  end } in
-  Proofview.Goal.nf_enter assumption_tac
+  in
+  Proofview.Goal.enter assumption_tac
 
 (*****************************************************************)
 (*          Modification of a local context                      *)
@@ -1993,8 +1958,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
 
@@ -2008,7 +1973,7 @@ let check_is_type env sigma ty =
 
 let check_decl env sigma decl =
   let open Context.Named.Declaration in
-  let ty = get_type decl in
+  let ty = NamedDecl.get_type decl in
   let evdref = ref sigma in
   try
     let _ = Typing.e_sort_of env evdref ty in
@@ -2018,20 +1983,20 @@ let check_decl env sigma decl =
     in
     !evdref
   with e when CErrors.noncritical e ->
-    let id = get_id decl in
+    let id = NamedDecl.get_id decl in
     raise (DependsOnBody (Some id))
 
 let clear_body ids =
   let open Context.Named.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  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
-        errorlabstrm "" (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 ->
@@ -2046,16 +2011,16 @@ let clear_body ids =
           (** Do no recheck hypotheses that do not depend *)
           let sigma =
             if not seen then sigma
-            else if List.exists (fun id -> occur_var_in_decl env id decl) ids then
+            else if List.exists (fun id -> occur_var_in_decl env sigma id decl) ids then
               check_decl env sigma decl
             else sigma
           in
-          let seen = seen || List.mem_f Id.equal (get_id decl) ids in
+          let seen = seen || List.mem_f Id.equal (NamedDecl.get_id decl) ids in
           (push_named decl env, sigma, seen)
         in
         let (env, sigma, _) = List.fold_left check (base_env, sigma, false) (List.rev ctx) in
         let sigma =
-          if List.exists (fun id -> occur_var env id concl) ids then
+          if List.exists (fun id -> occur_var env sigma id concl) ids then
             check_is_type env sigma concl
           else sigma
         in
@@ -2063,18 +2028,18 @@ 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
     check <*>
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
+    Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true concl
-    end }
-  end }
+    end
+  end
 
 let clear_wildcards ids =
-  Tacticals.New.tclMAP (fun (loc, id) -> clear [id]) ids
+  Tacticals.New.tclMAP (fun {CAst.loc;v=id} -> clear [id]) ids
 
 (*   Takes a list of booleans, and introduces all the variables
  *  quantified in the goal which are associated with a value
@@ -2090,22 +2055,23 @@ let rec intros_clearing = function
 (* Keeping only a few hypotheses *)
 
 let keep hyps =
-  let open Context.Named.Declaration in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   Proofview.tclENV >>= fun env ->
   let ccl = Proofview.Goal.concl gl in
+  let sigma = Tacmach.New.project gl in
   let cl,_ =
     fold_named_context_reverse (fun (clear,keep) decl ->
-      let hyp = get_id decl in
+      let decl = map_named_decl EConstr.of_constr decl in
+      let hyp = NamedDecl.get_id decl in
       if Id.List.mem hyp hyps
-        || List.exists (occur_var_in_decl env hyp) keep
-	|| occur_var env hyp ccl
+        || List.exists (occur_var_in_decl env sigma hyp) keep
+	|| occur_var env sigma hyp ccl
       then (clear,decl::keep)
       else (hyp::clear,keep))
       ~init:([],[]) (Proofview.Goal.env gl)
   in
   clear cl
-  end }
+  end
 
 (*********************************)
 (*  Basic generalization tactics *)
@@ -2115,17 +2081,17 @@ 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 =
-  Proofview.Goal.enter { enter = begin fun gl ->
+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 { run = begin fun sigma ->
-      let newcl = nf_betaiota (Sigma.to_evar_map sigma) newcl (* As in former Logic.refine *) in
-      let Sigma (ev, sigma, p) =
+    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), sigma, p)
-    end }
-  end }
+      (sigma, applist (ev, args))
+    end
+  end
 
 (* Given a context [hyps] with domain [x1..xn], possibly with let-ins,
    and well-typed in the current goal, [bring_hyps hyps] generalizes
@@ -2134,25 +2100,24 @@ let apply_type newcl args =
 let bring_hyps hyps =
   if List.is_empty hyps then Tacticals.New.tclIDTAC
   else
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
       let env = Proofview.Goal.env gl in
       let store = Proofview.Goal.extra gl in
-      let concl = Tacmach.New.pf_nf_concl gl in
+      let concl = Tacmach.New.pf_concl gl in
       let newcl = List.fold_right mkNamedProd_or_LetIn hyps concl in
-      let args = Array.of_list (Context.Named.to_instance hyps) in
-      Refine.refine { run = begin fun sigma ->
-        let Sigma (ev, sigma, p) =
+      let args = Array.of_list (Context.Named.to_instance mkVar hyps) in
+      Refine.refine ~typecheck:false begin fun sigma ->
+        let (sigma, ev) =
           Evarutil.new_evar env sigma ~principal:true ~store newcl in
-        Sigma (mkApp (ev, args), sigma, p)
-      end }
-    end }
+        (sigma, mkApp (ev, args))
+      end
+    end
 
 let revert hyps = 
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
+  Proofview.Goal.enter begin fun gl ->
     let ctx = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) hyps in
       (bring_hyps ctx) <*> (clear hyps)
-  end }
+  end
 
 (************************)
 (* Introduction tactics *)
@@ -2162,37 +2127,34 @@ let check_number_of_constructors expctdnumopt i nconstr =
   if Int.equal i 0 then error "The constructors are numbered starting from 1.";
   begin match expctdnumopt with
     | Some n when not (Int.equal n nconstr) ->
-	errorlabstrm "Tactics.check_number_of_constructors"
+	user_err ~hdr:"Tactics.check_number_of_constructors"
           (str "Not an inductive goal with " ++ int n ++ str (String.plural n " constructor") ++ str ".")
     | _ -> ()
   end;
   if i > nconstr then error "Not enough constructors."
 
-let constructor_tac with_evars expctdnumopt i lbind =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+let constructor_core with_evars cstr lbind =
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let cl = Tacmach.New.pf_nf_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, sigma, p) = Sigma.fresh_constructor_instance
-	(Proofview.Goal.env gl) sigma (fst mind, i) in
-      let cons = mkConstructU cons in
-	
-      let apply_tac = general_apply true false with_evars None (dloc,(cons,lbind)) in
-      let tac =
-	(Tacticals.New.tclTHENLIST
-           [
-	    convert_concl_no_check redcl DEFAULTcast;
-	    intros; apply_tac])
-      in
-      Sigma (tac, sigma, p)
-  end }
+    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 (CAst.make (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 ((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
 
@@ -2201,25 +2163,27 @@ 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
-  Proofview.Goal.enter { enter = begin fun gl ->
-    let cl = Tacmach.New.pf_nf_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 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 (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)
- end }
+    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
 let right_with_bindings with_evars = constructor_tac with_evars (Some 2) 2
@@ -2251,7 +2215,7 @@ let error_unexpected_extra_pattern loc bound pat =
   | IntroNaming (IntroIdentifier _) ->
       "name", (String.plural nb " introduction pattern"), "no"
   | _ -> "introduction pattern", "", "none" in
-  user_err_loc (loc,"",str "Unexpected " ++ str s1 ++ str " (" ++
+  user_err ?loc  (str "Unexpected " ++ str s1 ++ str " (" ++
     (if Int.equal nb 0 then (str s3 ++ str s2) else
       (str "at most " ++ int nb ++ str s2)) ++ spc () ++
        str (if Int.equal nb 1 then "was" else "were") ++
@@ -2269,34 +2233,34 @@ let my_find_eq_data_decompose gl t =
       -> None
   | Constr_matching.PatternMatchingFailure -> None
 
-let intro_decomp_eq loc l thin tac id =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+let intro_decomp_eq ?loc l thin tac id =
+  Proofview.Goal.enter begin fun gl ->
   let c = mkVar id in
   let t = Tacmach.New.pf_unsafe_type_of gl c in
   let _,t = Tacmach.New.pf_reduce_to_quantified_ind gl t in
   match my_find_eq_data_decompose gl t with
   | Some (eq,u,eq_args) ->
     !intro_decomp_eq_function
-    (fun n -> tac ((dloc,id)::thin) (Some (true,n)) l)
+    (fun n -> tac ((CAst.make id)::thin) (Some (true,n)) l)
     (eq,t,eq_args) (c, t)
   | None ->
     Tacticals.New.tclZEROMSG (str "Not a primitive equality here.")
-  end }
+  end
 
-let intro_or_and_pattern loc with_evars bracketed ll thin tac id =
-  Proofview.Goal.enter { enter = begin fun gl ->
+let intro_or_and_pattern ?loc with_evars bracketed ll thin tac id =
+  Proofview.Goal.enter begin fun gl ->
   let c = mkVar id in
   let t = Tacmach.New.pf_unsafe_type_of gl c in
   let (ind,t) = Tacmach.New.pf_reduce_to_quantified_ind gl t in
   let branchsigns = compute_constructor_signatures false ind in
   let nv_with_let = Array.map List.length branchsigns in
   let ll = fix_empty_or_and_pattern (Array.length branchsigns) ll in
-  let ll = get_and_check_or_and_pattern loc ll branchsigns in
+  let ll = get_and_check_or_and_pattern ?loc ll branchsigns in
   Tacticals.New.tclTHENLASTn
     (Tacticals.New.tclTHEN (simplest_ecase c) (clear [id]))
     (Array.map2 (fun n l -> tac thin (Some (bracketed,n)) l)
        nv_with_let ll)
-  end }
+  end
 
 let rewrite_hyp_then assert_style with_evars thin l2r id tac =
   let rew_on l2r =
@@ -2305,27 +2269,28 @@ let rewrite_hyp_then assert_style with_evars thin l2r id tac =
     Hook.get forward_subst_one true x (id,rhs,l2r) in
   let clear_var_and_eq id' = clear [id';id] in
   let early_clear id' thin =
-    List.filter (fun (_,id) -> not (Id.equal id id')) thin in
-  Proofview.Goal.enter { enter = begin fun gl ->
+    List.filter (fun {CAst.v=id} -> not (Id.equal id id')) thin in
+  Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
+    let sigma = Tacmach.New.project gl in
     let type_of = Tacmach.New.pf_unsafe_type_of gl in
     let whd_all = Tacmach.New.pf_apply whd_all gl in
     let t = whd_all (type_of (mkVar id)) in
-    let eqtac, thin = match match_with_equality_type t with
+    let eqtac, thin = match match_with_equality_type sigma t with
     | Some (hdcncl,[_;lhs;rhs]) ->
-        if l2r && isVar lhs && not (occur_var env (destVar lhs) rhs) then
-          let id' = destVar lhs in
+        if l2r && isVar sigma lhs && not (occur_var env sigma (destVar sigma lhs) rhs) then
+          let id' = destVar sigma lhs in
           subst_on l2r id' rhs, early_clear id' thin
-        else if not l2r && isVar rhs && not (occur_var env (destVar rhs) lhs) then
-          let id' = destVar rhs in
+        else if not l2r && isVar sigma rhs && not (occur_var env sigma (destVar sigma rhs) lhs) then
+          let id' = destVar sigma rhs in
           subst_on l2r id' lhs, early_clear id' thin
         else
           Tacticals.New.tclTHEN (rew_on l2r onConcl) (clear [id]),
           thin
     | Some (hdcncl,[c]) ->
         let l2r = not l2r in (* equality of the form eq_true *)
-        if isVar c then
-          let id' = destVar c in
+        if isVar sigma c then
+          let id' = destVar sigma c in
           Tacticals.New.tclTHEN (rew_on l2r allHypsAndConcl) 
 	    (clear_var_and_eq id'),
           early_clear id' thin
@@ -2337,39 +2302,63 @@ let rewrite_hyp_then assert_style with_evars thin l2r id tac =
         thin in
     (* Skip the side conditions of the rewriting step *)
     Tacticals.New.tclTHENFIRST eqtac (tac thin)
-  end }
+  end 
 
-let prepare_naming loc = function
-  | IntroIdentifier id -> NamingMustBe (loc,id)
-  | IntroAnonymous -> NamingAvoid []
-  | IntroFresh id -> NamingBasedOn (id,[])
+let prepare_naming ?loc = function
+  | IntroIdentifier id -> NamingMustBe (CAst.make ?loc 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
-| (_, IntroAction (IntroOrAndPattern l)) :: l' ->
+let rec explicit_intro_names = let open CAst in function
+| {v=IntroForthcoming _} :: l -> explicit_intro_names l
+| {v=IntroNaming (IntroIdentifier id)} :: l -> Id.Set.add id (explicit_intro_names l)
+| {v=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)
-| (_, IntroAction (IntroInjection l)) :: l' ->
+    let fold accu l = Id.Set.union accu (explicit_intro_names (l@l')) in
+    List.fold_left fold Id.Set.empty ll
+| {v=IntroAction (IntroInjection l)} :: l' ->
     explicit_intro_names (l@l')
-| (_, IntroAction (IntroApplyOn (c,pat))) :: l' ->
+| {v=IntroAction (IntroApplyOn (c,pat))} :: l' ->
     explicit_intro_names (pat::l')
-| (_, (IntroNaming (IntroAnonymous | IntroFresh _)
-     | IntroAction (IntroWildcard | IntroRewrite _))) :: l ->
+| {v=(IntroNaming (IntroAnonymous | IntroFresh _)
+     | IntroAction (IntroWildcard | IntroRewrite _))} :: l ->
      explicit_intro_names l
-| [] -> []
+| [] -> Id.Set.empty
+
+let rec check_name_unicity env ok seen = let open CAst in function
+| {v=IntroForthcoming _} :: l -> check_name_unicity env ok seen l
+| {loc;v=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 (Id.print id ++ str" is already used.")
+   with Not_found ->
+     if List.mem_f Id.equal id seen then
+       user_err ?loc (Id.print id ++ str" is used twice.")
+     else
+       check_name_unicity env ok (id::seen) l)
+| {v=IntroAction (IntroOrAndPattern l)} :: l' ->
+    let ll = match l with IntroAndPattern l -> [l] | IntroOrPattern ll -> ll in
+    List.iter (fun l -> check_name_unicity env ok seen (l@l')) ll
+| {v=IntroAction (IntroInjection l)} :: l' ->
+    check_name_unicity env ok seen (l@l')
+| {v=IntroAction (IntroApplyOn (c,pat))} :: l' ->
+    check_name_unicity env ok seen (pat::l')
+| {v=(IntroNaming (IntroAnonymous | IntroFresh _)
+     | IntroAction (IntroWildcard | IntroRewrite _))} :: l ->
+     check_name_unicity env ok seen l
+| [] -> ()
 
 let wild_id = Id.of_string "_tmp"
 
 let rec list_mem_assoc_right id = function
   | [] -> false
-  | (x,id')::l -> Id.equal id id' || list_mem_assoc_right id l
+  | {CAst.v=id'}::l -> Id.equal id id' || list_mem_assoc_right id l
 
 let check_thin_clash_then id thin avoid tac =
   if list_mem_assoc_right id thin then
     let newid = next_ident_away (add_suffix id "'") avoid in
     let thin =
-      List.map (on_snd (fun id' -> if Id.equal id id' then newid else id')) thin in
+      List.map CAst.(map (fun id' -> if Id.equal id id' then newid else id')) thin in
     Tacticals.New.tclTHEN (rename_hyp [id,newid]) (tac thin)
   else
     tac thin
@@ -2381,8 +2370,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 ((dloc,IntroAction pat)::l))
+  | IntroWildcard -> NamingBasedOn (wild_id, Id.Set.union avoid (explicit_intro_names l))
+  | pat -> NamingAvoid(Id.Set.union avoid (explicit_intro_names ((CAst.make @@ IntroAction pat)::l)))
 
 let fit_bound n = function
   | None -> true
@@ -2394,7 +2383,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
@@ -2418,19 +2407,19 @@ let rec intro_patterns_core with_evars b avoid ids thin destopt bound n tac =
   | [] ->
       (* Behave as IntroAnonymous *)
       intro_patterns_core with_evars b avoid ids thin destopt bound n tac
-        [dloc,IntroNaming IntroAnonymous]
-  | (loc,pat) :: l ->
+        [CAst.make @@ IntroNaming IntroAnonymous]
+  | {CAst.loc;v=pat} :: l ->
   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)
   | IntroAction pat ->
       intro_then_gen (make_tmp_naming avoid l pat)
 	destopt true false
-        (intro_pattern_action loc with_evars (b || not (List.is_empty l)) false
+        (intro_pattern_action ?loc with_evars (b || not (List.is_empty l)) false
           pat thin destopt
           (fun thin bound' -> intro_patterns_core with_evars b avoid ids thin destopt bound' 0
             (fun ids thin ->
@@ -2443,67 +2432,73 @@ and intro_pattern_naming loc with_evars b avoid ids pat thin destopt bound n tac
   match pat with
   | IntroIdentifier id ->
       check_thin_clash_then id thin avoid (fun thin ->
-        intro_then_gen (NamingMustBe (loc,id)) destopt true false
+        intro_then_gen (NamingMustBe CAst.(make ?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)
 
-and intro_pattern_action loc with_evars b style pat thin destopt tac id =
+and intro_pattern_action ?loc with_evars b style pat thin destopt tac id =
   match pat with
   | IntroWildcard ->
-      tac ((loc,id)::thin) None []
+      tac (CAst.(make ?loc id)::thin) None []
   | IntroOrAndPattern ll ->
-      intro_or_and_pattern loc with_evars b ll thin tac id
+      intro_or_and_pattern ?loc with_evars b ll thin tac id
   | IntroInjection l' ->
-      intro_decomp_eq loc l' thin tac id
+      intro_decomp_eq ?loc l' thin tac id
   | IntroRewrite l2r ->
       rewrite_hyp_then style with_evars thin l2r id (fun thin -> tac thin None [])
-  | IntroApplyOn (f,(loc,pat)) ->
+  | IntroApplyOn ({CAst.loc=loc';v=f},{CAst.loc;v=pat}) ->
       let naming,tac_ipat =
-        prepare_intros_loc loc with_evars (IntroIdentifier id) destopt pat in
+        prepare_intros ?loc with_evars (IntroIdentifier id) destopt pat in
       let doclear =
-        if naming = NamingMustBe (loc,id) then
+        if naming = NamingMustBe (CAst.make ?loc id) then
           Proofview.tclUNIT () (* apply_in_once do a replacement *)
         else
           clear [id] in
-      let f = { delayed = fun env sigma ->
-        let Sigma (c, sigma, p) = f.delayed env sigma in
-        Sigma ((c, NoBindings), sigma, p)
-      } in
-      apply_in_delayed_once false true true with_evars naming id (None,(loc,f))
+      let f env sigma = let (sigma, c) = f env sigma in (sigma,(c, NoBindings))
+      in
+      apply_in_delayed_once false true true with_evars naming id (None,CAst.make ?loc:loc' f)
         (fun id -> Tacticals.New.tclTHENLIST [doclear; tac_ipat id; tac thin None []])
 
-and prepare_intros_loc loc with_evars dft destopt = function
+and prepare_intros ?loc with_evars dft destopt = function
   | IntroNaming ipat ->
-      prepare_naming loc ipat,
+      prepare_naming ?loc ipat,
       (fun id -> move_hyp id destopt)
   | IntroAction ipat ->
-      prepare_naming loc dft,
+      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)
-  | IntroForthcoming _ -> user_err_loc
-      (loc,"",str "Introduction pattern for one hypothesis expected.")
+        intro_pattern_action ?loc with_evars true true ipat [] destopt tac id)
+  | IntroForthcoming _ -> user_err ?loc 
+      (str "Introduction pattern for one hypothesis expected.")
+
+let intro_patterns_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 Id.Set.empty [] [] destopt
+      bound 0 (fun _ l -> clear_wildcards l) pat
+  end
 
 let intro_patterns_bound_to with_evars n destopt =
-  intro_patterns_core with_evars true [] [] [] destopt
-    (Some (true,n)) 0 (fun _ l -> clear_wildcards l)
+  intro_patterns_head_core with_evars true destopt
+    (Some (true,n))
 
 let intro_patterns_to with_evars destopt =
-  intro_patterns_core with_evars (use_bracketing_last_or_and_intro_pattern ())
-    [] [] [] destopt None 0 (fun _ l -> clear_wildcards l)
+  intro_patterns_head_core with_evars (use_bracketing_last_or_and_intro_pattern ())
+    destopt None
 
 let intro_pattern_to with_evars destopt pat =
-  intro_patterns_to with_evars destopt [dloc,pat]
+  intro_patterns_to with_evars destopt [CAst.make pat]
 
 let intro_patterns with_evars = intro_patterns_to with_evars MoveLast
 
@@ -2516,20 +2511,20 @@ let intros_patterns with_evars = function
 (*   Forward reasoning    *)
 (**************************)
 
-let prepare_intros with_evars dft destopt = function
-  | None -> prepare_naming dloc dft, (fun _id -> Proofview.tclUNIT ())
-  | Some (loc,ipat) -> prepare_intros_loc loc with_evars dft destopt ipat
+let prepare_intros_opt with_evars dft destopt = function
+  | None -> prepare_naming dft, (fun _id -> Proofview.tclUNIT ())
+  | Some {CAst.loc;v=ipat} -> prepare_intros ?loc with_evars dft destopt ipat
 
 let ipat_of_name = function
   | Anonymous -> None
-  | Name id -> Some (dloc, IntroNaming (IntroIdentifier id))
+  | Name id -> Some (CAst.make @@ IntroNaming (IntroIdentifier id))
 
-let head_ident c =
-   let c = fst (decompose_app ((strip_lam_assum c))) in
-   if isVar c then Some (destVar c) else None
+let head_ident sigma c =
+   let c = fst (decompose_app sigma (snd (decompose_lam_assum sigma c))) in
+   if isVar sigma c then Some (destVar sigma c) else None
 
 let assert_as first hd ipat t =
-  let naming,tac = prepare_intros false IntroAnonymous MoveLast ipat in
+  let naming,tac = prepare_intros_opt false IntroAnonymous MoveLast ipat in
   let repl = do_replace hd naming in
   let tac = if repl then (fun id -> Proofview.tclUNIT ()) else tac in
   if first then assert_before_then_gen repl naming t tac
@@ -2542,19 +2537,22 @@ let general_apply_in sidecond_first with_delta with_destruct with_evars
   let tac (naming,lemma) tac id =
     apply_in_delayed_once sidecond_first with_delta with_destruct with_evars
       naming id lemma tac in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  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 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 with_evars (IntroIdentifier id) destopt ipat in
+    prepare_intros_opt with_evars (IntroIdentifier id) destopt ipat in
   let lemmas_target, last_lemma_target =
     let last,first = List.sep_last lemmas in
-    List.map (fun lem -> (NamingMustBe (dloc,id),lem)) first, (naming,last)
+    List.map (fun lem -> (NamingMustBe (CAst.make id),lem)) first, (naming,last)
   in
   (* We chain apply_in_once, ending with an intro pattern *)
   List.fold_right tac lemmas_target (tac last_lemma_target ipat_tac) id
-  end }
+  end
 
 (*
   if sidecond_first then
@@ -2565,7 +2563,7 @@ let general_apply_in sidecond_first with_delta with_destruct with_evars
 *)
 
 let apply_in simple with_evars id lemmas ipat =
-  let lemmas = List.map (fun (k,(loc,l)) -> k, (loc, { delayed = fun _ sigma -> Sigma.here l sigma })) lemmas in
+  let lemmas = List.map (fun (k,{CAst.loc;v=l}) -> k, CAst.make ?loc (fun _ sigma -> (sigma,l))) lemmas in
   general_apply_in false simple simple with_evars id lemmas ipat
 
 let apply_delayed_in simple with_evars id lemmas ipat =
@@ -2589,61 +2587,69 @@ let decode_hyp = function
 *)
 
 let letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
-    let Sigma (t, sigma, p) = match ty with
-    | Some t -> Sigma.here t sigma
+    let (sigma, t) = match ty with
+    | Some t -> (sigma, t)
     | None ->
       let t = typ_of env sigma c in
-      let sigma, c = Evarsolve.refresh_universes ~onlyalg:true (Some false) env (Sigma.to_evar_map sigma) t in
-      Sigma.Unsafe.of_pair (c, sigma)
+      Evarsolve.refresh_universes ~onlyalg:true (Some false) env sigma t
     in
-    let Sigma ((newcl, eq_tac), sigma, q) = match with_eq with
-      | Some (lr,(loc,ido)) ->
+    let (sigma, (newcl, eq_tac)) = match with_eq with
+      | Some (lr,{CAst.loc;v=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
-          let Sigma (eq, sigma, p) = Sigma.fresh_global env sigma eqdata.eq in
-          let Sigma (refl, sigma, q) = Sigma.fresh_global env sigma eqdata.refl in
+          let (sigma, eq) = Evd.fresh_global env sigma eqdata.eq in
+          let eq = EConstr.of_constr eq in
+          let (sigma, refl) = Evd.fresh_global env sigma eqdata.refl in
+          let refl = EConstr.of_constr refl in
           let eq = applist (eq,args) in
           let refl = applist (refl, [t;mkVar id]) in
 	  let term = mkNamedLetIn id c t (mkLetIn (Name heq, refl, eq, ccl)) in
-	  let sigma = Sigma.to_evar_map sigma in
 	  let sigma, _ = Typing.type_of env sigma term in
           let ans = term,
-            Tacticals.New.tclTHEN
-	      (intro_gen (NamingMustBe (loc,heq)) (decode_hyp lastlhyp) true false)
-	      (clear_body [heq;id])
+            Tacticals.New.tclTHENLIST
+	      [
+               intro_gen (NamingMustBe CAst.(make ?loc heq)) (decode_hyp lastlhyp) true false;
+	      clear_body [heq;id]]
           in
-          Sigma.Unsafe.of_pair (ans, sigma)
+          (sigma, ans)
       | None ->
-          Sigma.here (mkNamedLetIn id c t ccl, Proofview.tclUNIT ()) sigma
+          (sigma, (mkNamedLetIn id c t ccl, Proofview.tclUNIT ()))
     in
-    let tac =
       Tacticals.New.tclTHENLIST
-      [ convert_concl_no_check newcl DEFAULTcast;
-        intro_gen (NamingMustBe (dloc,id)) (decode_hyp lastlhyp) true false;
+      [ Proofview.Unsafe.tclEVARS sigma;
+        convert_concl_no_check newcl DEFAULTcast;
+        intro_gen (NamingMustBe (CAst.make id)) (decode_hyp lastlhyp) true false;
         Tacticals.New.tclMAP convert_hyp_no_check depdecls;
         eq_tac ]
-    in
-    Sigma (tac, sigma, p +> q)
-  end }
+  end
 
 let insert_before decls lasthyp env =
-  let open Context.Named.Declaration in
   match lasthyp with
   | None -> push_named_context decls env
   | Some id ->
   Environ.fold_named_context
     (fun _ d env ->
-      let env = if Id.equal id (get_id d) then push_named_context decls env else env in
+      let d = map_named_decl EConstr.of_constr d in
+      let env = if Id.equal id (NamedDecl.get_id d) then push_named_context decls env else env in
       push_named d env)
     ~init:(reset_context env) env
 
+let mk_eq_name env id {CAst.loc;v=ido} =
+  match ido with
+  | 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  (Id.print id ++ str" is already used.");
+    id
+
 (* unsafe *)
 
 let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
@@ -2653,30 +2659,25 @@ let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
 	     else LocalAssum (id,t)
   in
   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
-      | IntroIdentifier id ->
-          if List.mem id (ids_of_named_context (named_context env)) then
-            user_err_loc (loc,"",pr_id id ++ str" is already used.");
-          id in
+  | Some (lr,heq) ->
       let eqdata = build_coq_eq_data () in
       let args = if lr then [t;mkVar id;c] else [t;c;mkVar id]in
-      let Sigma (eq, sigma, p) = Sigma.fresh_global env sigma eqdata.eq in
-      let Sigma (refl, sigma, q) = Sigma.fresh_global env sigma eqdata.refl in
+      let (sigma, eq) = Evd.fresh_global env sigma eqdata.eq in
+      let eq = EConstr.of_constr eq in
+      let (sigma, refl) = Evd.fresh_global env sigma eqdata.refl in
+      let refl = EConstr.of_constr refl in
       let eq = applist (eq,args) in
       let refl = applist (refl, [t;mkVar id]) in
       let newenv = insert_before [LocalAssum (heq,eq); decl] lastlhyp env in
-      let Sigma (x, sigma, r) = new_evar newenv sigma ~principal:true ~store ccl in
-      Sigma (mkNamedLetIn id c t (mkNamedLetIn heq refl eq x), sigma, p +> q +> r)
+      let (sigma, x) = new_evar newenv sigma ~principal:true ~store ccl in
+      (sigma, mkNamedLetIn id c t (mkNamedLetIn heq refl eq x))
   | None ->
       let newenv = insert_before [decl] lastlhyp env in
-      let Sigma (x, sigma, p) = new_evar newenv sigma ~principal:true ~store ccl in
-      Sigma (mkNamedLetIn id c t x, sigma, p)
+      let (sigma, x) = new_evar newenv sigma ~principal:true ~store ccl in
+      (sigma, mkNamedLetIn id c t x)
 
 let letin_tac with_eq id c ty occs =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
     let ccl = Proofview.Goal.concl gl in
@@ -2684,40 +2685,39 @@ let letin_tac with_eq id c ty occs =
     let (id,_,depdecls,lastlhyp,ccl,res) = make_abstraction env sigma ccl abs in
     (* We keep the original term to match but record the potential side-effects
        of unifying universes. *)
-    let Sigma (c, sigma, p) = match res with
-      | None -> Sigma.here c sigma
-      | Some (Sigma (_, sigma, p)) -> Sigma (c, sigma, p)
+    let (sigma, c) = match res with
+      | None -> (sigma, c)
+      | Some (sigma, _) -> (sigma, c)
     in
-    let tac = letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty in
-    Sigma (tac, sigma, p)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty)
+  end
 
-let letin_pat_tac with_eq id c occs =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+let letin_pat_tac with_evars with_eq id c occs =
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
     let ccl = Proofview.Goal.concl gl in
     let check t = true in
     let abs = AbstractPattern (false,check,id,c,occs,false) in
     let (id,_,depdecls,lastlhyp,ccl,res) = make_abstraction env sigma ccl abs in
-    let Sigma (c, sigma, p) = match res with
-    | None -> finish_evar_resolution ~flags:(tactic_infer_flags false) env sigma c
+    let (sigma, c) = match res with
+    | None -> finish_evar_resolution ~flags:(tactic_infer_flags with_evars) env sigma c
     | Some res -> res in
-    let tac =
-      (letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) None)
-    in
-    Sigma (tac, sigma, p)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+    (letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) None)
+  end
 
 (* Tactics "pose proof" (usetac=None) and "assert"/"enough" (otherwise) *)
 let forward b usetac ipat c =
   match usetac with
   | None ->
-      Proofview.Goal.enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
       let t = Tacmach.New.pf_get_type_of gl c in
-      let hd = head_ident c in
+      let sigma = Tacmach.New.project gl in
+      let hd = head_ident sigma c in
       Tacticals.New.tclTHENFIRST (assert_as true hd ipat t) (exact_no_check c)
-      end }
+      end
   | Some tac ->
       let tac = match tac with
         | None -> Tacticals.New.tclIDTAC
@@ -2738,22 +2738,22 @@ let enough_by na t tac = forward false (Some (Some tac)) (ipat_of_name na) t
 
 (* Compute a name for a generalization *)
 
-let generalized_name c t ids cl = function
+let generalized_name env sigma c t ids cl = function
   | Name id as na ->
       if Id.List.mem id ids then
-	errorlabstrm "" (pr_id id ++ str " is already used.");
+	user_err  (Id.print id ++ str " is already used.");
       na
   | Anonymous ->
-      match kind_of_term c with
+      match EConstr.kind sigma c with
       | Var id ->
 	 (* Keep the name even if not occurring: may be used by intros later *)
 	  Name id
       | _ ->
-	  if noccurn 1 cl then Anonymous else
+	  if noccurn sigma 1 cl then Anonymous else
 	    (* On ne s'etait pas casse la tete : on avait pris pour nom de
                variable la premiere lettre du type, meme si "c" avait ete une
                constante dont on aurait pu prendre directement le nom *)
-	    named_hd (Global.env()) t Anonymous
+	    named_hd env sigma t Anonymous
 
 (* Abstract over [c] in [forall x1:A1(c)..xi:Ai(c).T(c)] producing
    [forall x, x1:A1(x1), .., xi:Ai(x). T(x)] with all [c] abtracted in [Ai]
@@ -2761,11 +2761,11 @@ let generalized_name c t ids cl = function
 
 let generalize_goal_gen env sigma ids i ((occs,c,b),na) t cl =
   let open Context.Rel.Declaration in
-  let decls,cl = decompose_prod_n_assum i cl in
+  let decls,cl = decompose_prod_n_assum sigma i cl in
   let dummy_prod = it_mkProd_or_LetIn mkProp decls in
-  let newdecls,_ = decompose_prod_n_assum i (subst_term_gen eq_constr_nounivs c dummy_prod) in
+  let newdecls,_ = decompose_prod_n_assum sigma i (subst_term_gen sigma EConstr.eq_constr_nounivs c dummy_prod) in
   let cl',sigma' = subst_closed_term_occ env sigma (AtOccs occs) c (it_mkProd_or_LetIn cl newdecls) in
-  let na = generalized_name c t ids cl' na in
+  let na = generalized_name env sigma c t ids cl' na in
   let decl = match b with
     | None -> LocalAssum (na,t)
     | Some b -> LocalDef (na,b,t)
@@ -2773,37 +2773,41 @@ let generalize_goal_gen env sigma ids i ((occs,c,b),na) t cl =
   mkProd_or_LetIn decl cl', sigma'
 
 let generalize_goal gl i ((occs,c,b),na as o) (cl,sigma) =
-  let env = Tacmach.pf_env gl in
-  let ids = Tacmach.pf_ids_of_hyps gl in
+  let open Tacmach.New in
+  let env = pf_env gl in
+  let ids = pf_ids_of_hyps gl in
   let sigma, t = Typing.type_of env sigma c in
   generalize_goal_gen env sigma ids i o t cl
 
-let old_generalize_dep ?(with_let=false) c gl =
-  let open Context.Named.Declaration in
+let generalize_dep ?(with_let=false) c =
+  let open Tacmach.New in
+  let open Tacticals.New in
+  Proofview.Goal.nf_enter begin fun gl ->
   let env = pf_env gl in
-  let sign = pf_hyps gl in
+  let sign = Proofview.Goal.hyps gl in
+  let sigma = project gl in
   let init_ids = ids_of_named_context (Global.named_context()) in
-  let seek (d:Context.Named.Declaration.t) (toquant:Context.Named.t) =
-    if List.exists (fun d' -> occur_var_in_decl env (get_id d') d) toquant
-      || dependent_in_decl c d then
+  let seek (d:named_declaration) (toquant:named_context) =
+    if List.exists (fun d' -> occur_var_in_decl env sigma (NamedDecl.get_id d') d) toquant
+      || dependent_in_decl sigma c d then
       d::toquant
     else
       toquant in
   let to_quantify = Context.Named.fold_outside seek sign ~init:[] in
   let to_quantify_rev = List.rev to_quantify in
-  let qhyps = List.map get_id to_quantify_rev in
+  let qhyps = List.map NamedDecl.get_id to_quantify_rev in
   let tothin = List.filter (fun id -> not (Id.List.mem id init_ids)) qhyps in
   let tothin' =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
       | Var id when mem_named_context_val id (val_of_named_context sign) && not (Id.List.mem id init_ids)
 	  -> id::tothin
       | _ -> tothin
   in
-  let cl' = it_mkNamedProd_or_LetIn (Tacmach.pf_concl gl) to_quantify in
+  let cl' = it_mkNamedProd_or_LetIn (pf_concl gl) to_quantify in
   let body =
     if with_let then
-      match kind_of_term c with
-      | Var id -> Tacmach.pf_get_hyp gl id |> get_value
+      match EConstr.kind sigma c with
+      | Var id -> id |> (fun id -> pf_get_hyp id gl) |> NamedDecl.get_value
       | _ -> None
     else None
   in
@@ -2811,35 +2815,30 @@ let old_generalize_dep ?(with_let=false) c gl =
     (cl',project gl) in
   (** Check that the generalization is indeed well-typed *)
   let (evd, _) = Typing.type_of env evd cl'' in
-  let args = Context.Named.to_instance to_quantify_rev in
+  let args = Context.Named.to_instance mkVar to_quantify_rev in
   tclTHENLIST
-    [tclEVARS evd;
-     Proofview.V82.of_tactic (apply_type cl'' (if Option.is_empty body then c::args else args));
-     Proofview.V82.of_tactic (clear (List.rev tothin'))]
-    gl
-
-let generalize_dep ?(with_let = false) c =
-  Proofview.V82.tactic (old_generalize_dep ~with_let c)
+    [ Proofview.Unsafe.tclEVARS evd;
+      apply_type ~typecheck:false cl'' (if Option.is_empty body then c::args else args);
+      clear (List.rev tothin')]
+  end
 
 (**  *)
-let generalize_gen_let lconstr = Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+let generalize_gen_let lconstr = Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let newcl, evd =
-    List.fold_right_i (Tacmach.New.of_old generalize_goal gl) 0 lconstr
+    List.fold_right_i (generalize_goal gl) 0 lconstr
       (Tacmach.New.pf_concl gl,Tacmach.New.project gl)
   in
   let (evd, _) = Typing.type_of env evd newcl in
   let map ((_, c, b),_) = if Option.is_empty b then Some c else None in
-  let tac = apply_type newcl (List.map_filter map lconstr) in
-  Sigma.Unsafe.of_pair (tac, evd)
-end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd)
+  (apply_type ~typecheck:false newcl (List.map_filter map lconstr))
+end
 
 let new_generalize_gen_let lconstr =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  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 sigma = Sigma.to_evar_map sigma in
     let env = Proofview.Goal.env gl in
     let ids = Tacmach.New.pf_ids_of_hyps gl in
     let newcl, sigma, args =
@@ -2851,14 +2850,12 @@ let new_generalize_gen_let lconstr =
           (cl, sigma, args))
 	0 lconstr (concl, sigma, [])
     in
-    let tac =
-	Refine.refine { run = begin fun sigma ->
-          let Sigma (ev, sigma, p) = Evarutil.new_evar env sigma ~principal:true newcl in
-          Sigma ((applist (ev, args)), sigma, p)
-	end }
-    in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+	(Refine.refine ~typecheck:false begin fun sigma ->
+          let (sigma, ev) = Evarutil.new_evar env sigma ~principal:true newcl in
+          (sigma, applist (ev, args))
+	 end)
+  end
 
 let generalize_gen lconstr =
   generalize_gen_let (List.map (fun (occs_c,na) ->
@@ -2886,38 +2883,77 @@ let quantify lconstr =
 
 (* Modifying/Adding an hypothesis  *)
 
+(* Instantiating some arguments (whatever their position) of an hypothesis
+   or any term, leaving other arguments quantified. If operating on an
+   hypothesis of the goal, the new hypothesis replaces it.
+
+   (c,lbind) are supposed to be of the form
+   ((t t1 t2 ... tm) , someBindings)
+
+   in which case we pose a proof with body
+
+   (fun y1...yp => H t1 t2 ... tm u1 ... uq) where yi are the
+   remaining arguments of H that lbind could not resolve, ui are a mix
+   of inferred args and yi. The overall effect is to remove from H as
+   much quantification as possible given lbind. *)
 let specialize (c,lbind) ipat =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+  let sigma = Proofview.Goal.sigma gl in
   let sigma, term =
     if lbind == NoBindings then
-      let sigma = Typeclasses.resolve_typeclasses env sigma in
-      sigma, nf_evar sigma c
+      sigma, c
     else
-      let clause = make_clenv_binding env sigma (c,Retyping.get_type_of env sigma c) lbind in
+      let typ_of_c = Retyping.get_type_of env sigma c in
+      (* If the term is lambda then we put a letin to put avoid
+         interaction between the term and the bindings. *)
+      let c = match EConstr.kind sigma c with
+        | Lambda(_,_,_) ->
+          mkLetIn(Name.Anonymous, c, typ_of_c, (mkRel 1))
+        | _ -> c in
+      let clause = make_clenv_binding env sigma (c,typ_of_c) lbind in
       let flags = { (default_unify_flags ()) with resolve_evars = true } in
       let clause = clenv_unify_meta_types ~flags clause in
-      let (thd,tstack) = whd_nored_stack clause.evd (clenv_value clause) in
-      let rec chk = function
-      | [] -> []
-      | t::l -> if occur_meta t then [] else t :: chk l
-      in
-      let tstack = chk tstack in
-      let term = applist(thd,List.map (nf_evar clause.evd) tstack) in
-      if occur_meta term then
-	errorlabstrm "" (str "Cannot infer an instance for " ++
-
-          pr_name (meta_name clause.evd (List.hd (collect_metas term))) ++
-	  str ".");
-      clause.evd, term in
+      let sigma = clause.evd in
+      let (thd,tstack) = whd_nored_stack sigma (clenv_value clause) in
+      let c_hd , c_args = decompose_app sigma c in
+      let liftrel x =
+        match kind sigma x with
+        | Rel n -> mkRel (n+1)
+        | _ -> x in
+      (* We grab names used in product to remember them at re-abstracting phase *)
+      let typ_of_c_hd = pf_get_type_of gl c_hd in
+      let lprod, concl = decompose_prod_assum sigma typ_of_c_hd in
+      (* accumulator args: arguments to apply to c_hd: all infered
+         args + re-abstracted rels *)
+      let rec rebuild_lambdas sigma lprd args hd l =
+        match lprd , l with
+        | _, [] -> sigma,applist (hd, (List.map (nf_evar sigma) args))
+        | Context.Rel.Declaration.LocalAssum(nme,_)::lp' , t::l' when occur_meta sigma t ->
+          (* nme has not been resolved, let us re-abstract it. Same
+             name but type updated by instanciation of other args. *)
+          let sigma,new_typ_of_t = Typing.type_of clause.env sigma t in
+          let liftedargs = List.map liftrel args in
+          (* lifting rels in the accumulator args *)
+          let sigma,hd' = rebuild_lambdas sigma lp' (liftedargs@[mkRel 1 ]) hd l' in
+          (* replace meta variable by the abstracted variable *)
+          let hd'' = subst_term sigma t hd' in
+          (* lambda expansion *)
+          sigma,mkLambda (nme,new_typ_of_t,hd'')
+        | Context.Rel.Declaration.LocalAssum(_,_)::lp' , t::l' ->
+          let sigma,hd' = rebuild_lambdas sigma lp' (args@[t]) hd l' in
+          sigma,hd'
+        | _ ,_ -> assert false in
+      let sigma,hd = rebuild_lambdas sigma (List.rev lprod) [] c_hd tstack in
+      Evd.clear_metas sigma, hd
+  in
   let typ = Retyping.get_type_of env sigma term in
   let tac =
-    match kind_of_term (fst(decompose_app (snd(decompose_lam_assum c)))) with
+    match EConstr.kind sigma (fst(EConstr.decompose_app sigma (snd(EConstr.decompose_lam_assum sigma c)))) with
     | Var id when Id.List.mem id (Tacmach.New.pf_ids_of_hyps gl) ->
       (* Like assert (id:=id args) but with the concept of specialization *)
       let naming,tac =
-        prepare_intros false (IntroIdentifier id) MoveLast ipat in
+        prepare_intros_opt false (IntroIdentifier id) MoveLast ipat in
       let repl = do_replace (Some id) naming in
       Tacticals.New.tclTHENFIRST
         (assert_before_then_gen repl naming typ tac)
@@ -2927,17 +2963,19 @@ let specialize (c,lbind) ipat =
       | None ->
         (* Like generalize with extra support for "with" bindings *)
         (* even though the "with" bindings forces full application *)
-        Tacticals.New.tclTHENLAST (cut typ) (exact_no_check term)
-      | Some (loc,ipat) ->
+        (* TODO: add intro to be more homogeneous. It will break
+           scripts but will be easy to fix *)
+         (Tacticals.New.tclTHENLAST (cut typ) (exact_no_check term))
+      | Some {CAst.loc;v=ipat} ->
         (* Like pose proof with extra support for "with" bindings *)
         (* even though the "with" bindings forces full application *)
-        let naming,tac = prepare_intros_loc loc false IntroAnonymous MoveLast ipat in
+        let naming,tac = prepare_intros ?loc false IntroAnonymous MoveLast ipat in
         Tacticals.New.tclTHENFIRST
           (assert_before_then_gen false naming typ tac)
 	  (exact_no_check term)
   in
   Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
-  end }
+  end
 
 (*****************************)
 (* Ad hoc unfold             *)
@@ -2947,22 +2985,23 @@ let specialize (c,lbind) ipat =
 (* Unfolds x by its definition everywhere *)
 let unfold_body x =
   let open Context.Named.Declaration in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  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 _ -> errorlabstrm "unfold_body"
-    (pr_id x ++ str" is not a defined hypothesis.")
+  | LocalAssum _ -> user_err ~hdr:"unfold_body"
+    (Id.print x ++ str" is not a defined hypothesis.")
   | LocalDef (_,xval,_) -> xval
   in
+  let xval = EConstr.of_constr xval in
   Tacticals.New.afterHyp x begin fun aft ->
-  let hl = List.fold_right (fun decl cl -> (get_id decl, InHyp) :: cl) aft [] in
+  let hl = List.fold_right (fun decl cl -> (NamedDecl.get_id decl, InHyp) :: cl) aft [] in
   let rfun _ _ c = replace_vars [x, xval] c in
   let reducth h = reduct_in_hyp rfun h in
   let reductc = reduct_in_concl (rfun, DEFAULTcast) in
   Tacticals.New.tclTHENLIST [Tacticals.New.tclMAP reducth hl; reductc]
   end
-  end }
+  end
 
 (* Either unfold and clear if defined or simply clear if not a definition *)
 let expand_hyp id = Tacticals.New.tclTRY (unfold_body id) <*> clear [id]
@@ -3001,35 +3040,35 @@ let expand_hyp id = Tacticals.New.tclTRY (unfold_body id) <*> clear [id]
 
  *)
 
-let warn_unused_intro_pattern =
+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_constr (fst (run_delayed (Global.env()) Evd.empty c)))) 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 names =
-  if not (List.is_empty names) && Flags.is_verbose () then
-    warn_unused_intro_pattern names
+let check_unused_names env sigma names =
+  if not (List.is_empty names) then
+    warn_unused_intro_pattern env sigma names
 
 let intropattern_of_name gl avoid = function
   | Anonymous -> IntroNaming IntroAnonymous
   | Name id -> IntroNaming (IntroIdentifier (new_fresh_id avoid id gl))
 
-let rec consume_pattern avoid na isdep gl = function
-  | [] -> ((dloc, intropattern_of_name gl avoid na), [])
-  | (loc,IntroForthcoming true)::names when not isdep ->
+let rec consume_pattern avoid na isdep gl = let open CAst in function
+  | [] -> ((CAst.make @@ intropattern_of_name gl avoid na), [])
+  | {loc;v=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
-      ((loc,intropattern_of_name gl avoid na), fullpat)
-  | (loc,IntroNaming IntroAnonymous)::names ->
-      let avoid = 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
-      ((loc,IntroNaming (IntroIdentifier (new_fresh_id avoid id' gl))), names)
+  | {loc;v=IntroForthcoming _}::names as fullpat ->
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
+      (CAst.make ?loc @@ intropattern_of_name gl avoid na, fullpat)
+  | {loc;v=IntroNaming IntroAnonymous}::names ->
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
+      (CAst.make ?loc @@ intropattern_of_name gl avoid na, names)
+  | {loc;v=IntroNaming (IntroFresh id')}::names ->
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
+      (CAst.make ?loc @@ IntroNaming (IntroIdentifier (new_fresh_id avoid id' gl)), names)
   | pat::names -> (pat,names)
 
 let re_intro_dependent_hypotheses (lstatus,rstatus) (_,tophyp) =
@@ -3048,7 +3087,7 @@ let safe_dest_intro_patterns with_evars avoid thin dest pat tac =
   Proofview.tclORELSE
     (dest_intro_patterns with_evars avoid thin dest pat tac)
     begin function (e, info) -> match e with
-      | UserError ("move_hyp",_) ->
+      | UserError (Some "move_hyp",_) ->
        (* May happen e.g. with "destruct x using s" with an hypothesis
           which is morally an induction hypothesis to be "MoveLast" if
           known as such but which is considered instead as a subterm of
@@ -3086,53 +3125,57 @@ 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) ::
         (IndArg,_,depind,hyprecname) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
         let (recpat,names) = match names with
-          | [loc,IntroNaming (IntroIdentifier id) as pat] ->
+          | [{CAst.loc;v=IntroNaming (IntroIdentifier id)} as pat] ->
               let id' = next_ident_away (add_prefix "IH" id) avoid in
-	      (pat, [dloc, IntroNaming (IntroIdentifier id')])
+              (pat, [CAst.make @@ IntroNaming (IntroIdentifier id')])
           | _ -> consume_pattern avoid (Name recvarname) deprec gl names in
         let dest = get_recarg_dest dests in
         dest_intro_patterns with_evars avoid thin dest [recpat] (fun ids thin ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
           let (hyprec,names) =
             consume_pattern avoid (Name hyprecname) depind gl names
           in
 	  dest_intro_patterns with_evars avoid thin MoveLast [hyprec] (fun ids' thin ->
 	    peel_tac ra' (update_dest dests ids') names thin)
-        end })
-        end }
+                             end)
+        end
     | (IndArg,_,dep,hyprecname) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
 	(* Rem: does not happen in Coq schemes, only in user-defined schemes *)
         let pat,names =
           consume_pattern avoid (Name hyprecname) dep gl names in
 	dest_intro_patterns with_evars avoid thin MoveLast [pat] (fun ids thin ->
         peel_tac ra' (update_dest dests ids) names thin)
-        end }
+        end
     | (RecArg,_,dep,recvarname) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
         let (pat,names) =
           consume_pattern avoid (Name recvarname) dep gl names in
         let dest = get_recarg_dest dests in
 	dest_intro_patterns with_evars avoid thin dest [pat] (fun ids thin ->
         peel_tac ra' dests names thin)
-        end }
+        end
     | (OtherArg,_,dep,_) :: ra' ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
         let (pat,names) = consume_pattern avoid Anonymous dep gl names in
         let dest = get_recarg_dest dests in
 	safe_dest_intro_patterns with_evars avoid thin dest [pat] (fun ids thin ->
         peel_tac ra' dests names thin)
-        end }
+        end
     | [] ->
-        check_unused_names names;
+        Proofview.Goal.enter begin fun gl ->
+        let env = Proofview.Goal.env gl in
+        let sigma = Proofview.Goal.sigma gl in
+        check_unused_names env sigma names;
         Tacticals.New.tclTHEN (clear_wildcards thin) (tac dests)
+        end
   in
   peel_tac ra dests names []
 
@@ -3141,26 +3184,26 @@ let induct_discharge with_evars dests avoid' tac (avoid,ra) names =
      substitutions aussi sur l'argument voisin *)
 
 let expand_projections env sigma c =
-  let sigma = Sigma.to_evar_map sigma in
   let rec aux env c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Proj (p, c) -> Retyping.expand_projection env sigma p (aux env c) []
-    | _ -> map_constr_with_full_binders push_rel aux env c
-  in aux env c
+    | _ -> map_constr_with_full_binders sigma push_rel aux env c
+  in
+  aux env c
 			       
 	   
 (* Marche pas... faut prendre en compte l'occurrence précise... *)
 
 let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 (Proofview.Goal.assume gl) in
+  let sigma = Tacmach.New.project 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 typ0 in
-  let hd,argl = decompose_app indtyp in
+  let prods, indtyp = decompose_prod_assum sigma typ0 in
+  let hd,argl = decompose_app sigma indtyp in
   let env' = push_rel_context prods env in
-  let sigma = Proofview.Goal.sigma gl in
   let params = List.firstn nparams argl in
   let params' = List.map (expand_projections env' sigma) params in
   (* le gl est important pour ne pas préévaluer *)
@@ -3172,17 +3215,18 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
         (tac avoid)
     else
       let c = List.nth argl (i-1) in
-      match kind_of_term c with
-	| Var id when not (List.exists (occur_var env id) args') &&
-                      not (List.exists (occur_var env id) params') ->
+      match EConstr.kind sigma c with
+	| Var id when not (List.exists (fun c -> occur_var env sigma id c) args') &&
+                      not (List.exists (fun c -> occur_var env sigma id c) params') ->
             (* 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
-            if List.exists (dependent c) params' ||
-               List.exists (dependent c) args'
+            let dependent t = dependent sigma c t in
+            if List.exists dependent params' ||
+               List.exists dependent args'
             then
               (* This is a case where the argument is constrained in a
                  way which would require some kind of inversion; we
@@ -3194,18 +3238,18 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
             (* We reason blindly on the term and do as if it were
                generalizable, ignoring the constraints coming from
                its structure *)
-            let id = match kind_of_term c with
+            let id = match EConstr.kind sigma c with
             | Var id -> id
             | _ ->
             let type_of = Tacmach.New.pf_unsafe_type_of gl in
-            id_of_name_using_hdchar (Global.env()) (type_of c) Anonymous in
+            id_of_name_using_hdchar env sigma (type_of c) Anonymous in
             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) [] [] []
-  end }
+  atomize_one (List.length argl) [] [] Id.Set.empty
+  end
 
 (* [cook_sign] builds the lists [beforetoclear] (preceding the
    ind. var.) and [aftertoclear] (coming after the ind. var.)  of hyps
@@ -3272,12 +3316,11 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
 
 exception Shunt of Id.t move_location
 
-let cook_sign hyp0_opt inhyps indvars env =
+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 open Context.Named.Declaration in
   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
@@ -3285,7 +3328,8 @@ let cook_sign hyp0_opt inhyps indvars env =
   let before = ref true in
   let maindep = ref false in
   let seek_deps env decl rhyp =
-    let hyp = get_id decl in
+    let decl = map_named_decl EConstr.of_constr decl in
+    let hyp = NamedDecl.get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false)
     then begin
       before:=false;
@@ -3293,24 +3337,24 @@ let cook_sign hyp0_opt inhyps indvars env =
          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;
       rhyp
     end else
       let dephyp0 = List.is_empty inhyps && 
-	(Option.cata (fun id -> occur_var_in_decl env id decl) false hyp0_opt)
+	(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 id decl) indvars ||
-         List.exists (fun decl' -> occur_var_in_decl env (get_id decl') decl) !decldeps)
+	(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;
@@ -3327,7 +3371,7 @@ let cook_sign hyp0_opt inhyps indvars env =
   let _ = fold_named_context seek_deps env ~init:MoveFirst in
   (* 2nd phase from R to L: get left hyp of [hyp0] and [lhyps] *)
   let compute_lstatus lhyp decl =
-    let hyp = get_id decl in
+    let hyp = NamedDecl.get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false) then
       raise (Shunt lhyp);
     if Id.List.mem hyp !ldeps then begin
@@ -3377,15 +3421,15 @@ type elim_scheme = {
   elimc: constr with_bindings option;
   elimt: types;
   indref: global_reference option;
-  params: Context.Rel.t;      (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  params: rel_context;      (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
   nparams: int;               (* number of parameters *)
-  predicates: Context.Rel.t;  (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  predicates: rel_context;  (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
   npredicates: int;           (* Number of predicates *)
-  branches: Context.Rel.t;    (* branchr,...,branch1 *)
+  branches: rel_context;    (* branchr,...,branch1 *)
   nbranches: int;             (* Number of branches *)
-  args: Context.Rel.t;        (* (xni, Ti_ni) ... (x1, Ti_1) *)
+  args: rel_context;        (* (xni, Ti_ni) ... (x1, Ti_1) *)
   nargs: int;                 (* number of arguments *)
-  indarg: Context.Rel.Declaration.t option; (* Some (H,I prm1..prmp x1...xni)
+  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni)
                                                if HI is in premisses, None otherwise *)
   concl: types;               (* Qi x1...xni HI (f...), HI and (f...)
 			         are optional and mutually exclusive *)
@@ -3434,44 +3478,44 @@ 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
 
 let error_ind_scheme s =
   let s = if not (String.is_empty s) then s^" " else s in
-  errorlabstrm "Tactics" (str "Cannot recognize " ++ str s ++ str "an induction scheme.")
+  user_err ~hdr:"Tactics" (str "Cannot recognize " ++ str s ++ str "an induction scheme.")
 
-let glob = Universes.constr_of_global
+let coq_eq sigma       = Evarutil.new_global sigma (Coqlib.build_coq_eq ())
+let coq_eq_refl sigma  = Evarutil.new_global sigma (Coqlib.build_coq_eq_refl ())
 
-let coq_eq = lazy (glob (Coqlib.build_coq_eq ()))
-let coq_eq_refl = lazy (glob (Coqlib.build_coq_eq_refl ()))
+let coq_heq_ref        = lazy (Coqlib.coq_reference"mkHEq" ["Logic";"JMeq"] "JMeq")
+let coq_heq sigma      = Evarutil.new_global sigma (Lazy.force coq_heq_ref)
+let coq_heq_refl sigma = Evarutil.new_global sigma (Coqlib.coq_reference "mkHEq" ["Logic";"JMeq"] "JMeq_refl")
 
-let coq_heq = lazy (Coqlib.coq_constant "mkHEq" ["Logic";"JMeq"] "JMeq")
-let coq_heq_refl = lazy (Coqlib.coq_constant "mkHEq" ["Logic";"JMeq"] "JMeq_refl")
+let mkEq sigma t x y =
+  let sigma, eq = coq_eq sigma in
+  sigma, mkApp (eq, [| t; x; y |])
 
+let mkRefl sigma t x =
+  let sigma, refl = coq_eq_refl sigma in
+  sigma, mkApp (refl, [| t; x |])
 
-let mkEq t x y =
-  mkApp (Lazy.force coq_eq, [| t; x; y |])
+let mkHEq sigma t x u y =
+  let sigma, c = coq_heq sigma in
+  sigma, mkApp (c,[| t; x; u; y |])
 
-let mkRefl t x =
-  mkApp (Lazy.force coq_eq_refl, [| t; x |])
-
-let mkHEq t x u y =
-  mkApp (Lazy.force coq_heq,
-	[| t; x; u; y |])
-
-let mkHRefl t x =
-  mkApp (Lazy.force coq_heq_refl,
-	[| t; x |])
+let mkHRefl sigma t x =
+  let sigma, c = coq_heq_refl sigma in
+  sigma, mkApp (c, [| t; x |])
 
 let lift_togethern n l =
   let l', _ =
@@ -3483,24 +3527,24 @@ let lift_togethern n l =
 
 let lift_list l = List.map (lift 1) l
 
-let ids_of_constr ?(all=false) vars c =
+let ids_of_constr sigma ?(all=false) vars c =
   let rec aux vars c =
-    match kind_of_term c with
+    match EConstr.kind sigma c with
     | Var id -> Id.Set.add id vars
     | App (f, args) ->
-	(match kind_of_term f with
+	(match EConstr.kind sigma f with
 	| Construct ((ind,_),_)
 	| Ind (ind,_) ->
             let (mib,mip) = Global.lookup_inductive ind in
 	      Array.fold_left_from
 		(if all then 0 else mib.Declarations.mind_nparams)
 		aux vars args
-	| _ -> fold_constr aux vars c)
-    | _ -> fold_constr aux vars c
+	| _ -> EConstr.fold sigma aux vars c)
+    | _ -> EConstr.fold sigma aux vars c
   in aux vars c
 
-let decompose_indapp f args =
-  match kind_of_term f with
+let decompose_indapp sigma f args =
+  match EConstr.kind sigma f with
   | Construct ((ind,_),_)
   | Ind (ind,_) ->
       let (mib,mip) = Global.lookup_inductive ind in
@@ -3509,23 +3553,29 @@ let decompose_indapp f args =
 	mkApp (f, pars), args
   | _ -> f, args
 
-let mk_term_eq env sigma ty t ty' t' =
-  let sigma = Sigma.to_evar_map sigma in
-  if Reductionops.is_conv env sigma ty ty' then
-    mkEq ty t t', mkRefl ty' t'
+let mk_term_eq homogeneous env sigma ty t ty' t' =
+  if homogeneous then
+    let sigma, eq = mkEq sigma ty t t' in
+    let sigma, refl = mkRefl sigma ty' t' in
+    sigma, (eq, refl)
   else
-    mkHEq ty t ty' t', mkHRefl ty' t'
+    let sigma, heq = mkHEq sigma ty t ty' t' in
+    let sigma, hrefl = mkHRefl sigma ty' t' in
+    sigma, (heq, hrefl)
 
 let make_abstract_generalize env id typ concl dep ctx body c eqs args refls =
   let open Context.Rel.Declaration in
-  Refine.refine { run = begin fun sigma ->
+  Refine.refine ~typecheck:false begin fun sigma ->
   let eqslen = List.length eqs in
     (* Abstract by the "generalized" hypothesis equality proof if necessary. *)
-  let abshypeq, abshypt =
+  let sigma, abshypeq, abshypt =
     if dep then
-      let eq, refl = mk_term_eq (push_rel_context ctx env) sigma (lift 1 c) (mkRel 1) typ (mkVar id) in
-	mkProd (Anonymous, eq, lift 1 concl), [| refl |]
-    else concl, [||]
+      let ty = lift 1 c in
+      let homogeneous = Reductionops.is_conv env sigma ty typ in
+      let sigma, (eq, refl) =
+        mk_term_eq homogeneous (push_rel_context ctx env) sigma ty (mkRel 1) typ (mkVar id) in
+      sigma, mkProd (Anonymous, eq, lift 1 concl), [| refl |]
+    else sigma, concl, [||]
   in
     (* Abstract by equalities *)
   let eqs = lift_togethern 1 eqs in (* lift together and past genarg *)
@@ -3539,7 +3589,7 @@ let make_abstract_generalize env id typ concl dep ctx body c eqs args refls =
     (* Abstract by the extension of the context *)
   let genctyp = it_mkProd_or_LetIn genarg ctx in
     (* The goal will become this product. *)
-  let Sigma (genc, sigma, p) = Evarutil.new_evar env sigma ~principal:true genctyp in
+  let (sigma, genc) = Evarutil.new_evar env sigma ~principal:true genctyp in
     (* Apply the old arguments giving the proper instantiation of the hyp *)
   let instc = mkApp (genc, Array.of_list args) in
     (* Then apply to the original instantiated hyp. *)
@@ -3547,21 +3597,20 @@ let make_abstract_generalize env id typ concl dep ctx body c eqs args refls =
     (* Apply the reflexivity proofs on the indices. *)
   let appeqs = mkApp (instc, Array.of_list refls) in
     (* Finally, apply the reflexivity proof for the original hyp, to get a term of type gl again. *)
-  Sigma (mkApp (appeqs, abshypt), sigma, p)
-  end }
+  (sigma, mkApp (appeqs, abshypt))
+  end
 
-let hyps_of_vars env sign nogen hyps =
-  let open Context.Named.Declaration in
+let hyps_of_vars env sigma sign nogen hyps =
   if Id.Set.is_empty hyps then []
   else
     let (_,lh) =
       Context.Named.fold_inside
         (fun (hs,hl) d ->
-          let x = get_id d in
+          let x = NamedDecl.get_id d in
 	  if Id.Set.mem x nogen then (hs,hl)
 	  else if Id.Set.mem x hs then (hs,x::hl)
 	  else
-	    let xvars = global_vars_set_of_decl env d in
+	    let xvars = global_vars_set_of_decl env sigma d in
 	      if not (Id.Set.is_empty (Id.Set.diff xvars hs)) then
 		(Id.Set.add x hs, x :: hl)
 	      else (hs, hl))
@@ -3571,11 +3620,11 @@ let hyps_of_vars env sign nogen hyps =
 
 exception Seen
 
-let linear vars args =
+let linear sigma vars args =
   let seen = ref vars in
     try
       Array.iter (fun i ->
-	let rels = ids_of_constr ~all:true Id.Set.empty i in
+	let rels = ids_of_constr sigma ~all:true Id.Set.empty i in
 	let seen' =
 	  Id.Set.fold (fun id acc ->
 	    if Id.Set.mem id acc then raise Seen
@@ -3587,19 +3636,19 @@ let linear vars args =
     with Seen -> false
 
 let is_defined_variable env id =
-  let open Context.Named.Declaration in
-  lookup_named id env |> is_local_def
+  env |> lookup_named id |> is_local_def
 
 let abstract_args gl generalize_vars dep id defined f args =
+  let open Tacmach.New in
   let open Context.Rel.Declaration in
-  let sigma = ref (Tacmach.project gl) in
-  let env = Tacmach.pf_env gl in
-  let concl = Tacmach.pf_concl gl in
-  let dep = dep || dependent (mkVar id) concl in
-  let avoid = ref [] in
+  let sigma = ref (Tacmach.New.project gl) in
+  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 Id.Set.empty in
   let get_id name =
-    let id = fresh_id !avoid (match name with Name n -> n | Anonymous -> Id.of_string "gen_x") gl in
-      avoid := id :: !avoid; id
+    let id = new_fresh_id !avoid (match name with Name n -> n | Anonymous -> Id.of_string "gen_x") gl in
+      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
@@ -3611,15 +3660,15 @@ let abstract_args gl generalize_vars dep id defined f args =
     let name, ty, arity =
       let rel, c = Reductionops.splay_prod_n env !sigma 1 prod in
       let decl = List.hd rel in
-      get_name decl, get_type decl, c
+      RelDecl.get_name decl, RelDecl.get_type decl, c
     in
-    let argty = Tacmach.pf_unsafe_type_of gl arg in
+    let argty = Tacmach.New.pf_unsafe_type_of gl arg in
     let sigma', ty = Evarsolve.refresh_universes (Some true) env !sigma ty in
     let () = sigma := sigma' in
     let lenctx = List.length ctx in
     let liftargty = lift lenctx argty in
-    let leq = constr_cmp Reduction.CUMUL liftargty ty in
-      match kind_of_term arg with
+    let leq = constr_cmp !sigma Reduction.CUMUL liftargty ty in
+      match EConstr.kind !sigma arg with
       | Var id when not (is_defined_variable env id) && leq && not (Id.Set.mem id nongenvars) ->
       	  (subst1 arg arity, ctx, ctxenv, mkApp (c, [|arg|]), args, eqs, refls,
       	  Id.Set.add id nongenvars, Id.Set.remove id vars, env)
@@ -3632,29 +3681,33 @@ let abstract_args gl generalize_vars dep id defined f args =
 	  let liftarg = lift (List.length ctx) arg in
 	  let eq, refl =
 	    if leq then
-	      mkEq (lift 1 ty) (mkRel 1) liftarg, mkRefl (lift (-lenctx) ty) arg
+	      let sigma', eq = mkEq !sigma (lift 1 ty) (mkRel 1) liftarg in
+              let sigma', refl = mkRefl sigma' (lift (-lenctx) ty) arg in
+              sigma := sigma'; eq, refl
 	    else
-	      mkHEq (lift 1 ty) (mkRel 1) liftargty liftarg, mkHRefl argty arg
+	      let sigma', eq = mkHEq !sigma (lift 1 ty) (mkRel 1) liftargty liftarg in
+              let sigma', refl = mkHRefl sigma' argty arg in
+              sigma := sigma'; eq, refl
 	  in
 	  let eqs = eq :: lift_list eqs in
 	  let refls = refl :: refls in
-	  let argvars = ids_of_constr vars arg in
+	  let argvars = ids_of_constr !sigma vars arg in
 	    (arity, ctx, push_rel decl ctxenv, c', args, eqs, refls,
 	    nongenvars, Id.Set.union argvars vars, env)
   in
-  let f', args' = decompose_indapp f args in
+  let f', args' = decompose_indapp !sigma f args in
   let dogen, f', args' =
-    let parvars = ids_of_constr ~all:true Id.Set.empty f' in
-      if not (linear parvars args') then true, f, args
+    let parvars = ids_of_constr !sigma ~all:true Id.Set.empty f' in
+      if not (linear !sigma parvars args') then true, f, args
       else
-	match Array.findi (fun i x -> not (isVar x) || is_defined_variable env (destVar x)) args' with
+	match Array.findi (fun i x -> not (isVar !sigma x) || is_defined_variable env (destVar !sigma x)) args' with
 	| None -> false, f', args'
 	| Some nonvar ->
 	    let before, after = Array.chop nonvar args' in
 	      true, mkApp (f', before), after
   in
     if dogen then
-      let tyf' = Tacmach.pf_unsafe_type_of gl f' in
+      let tyf' = Tacmach.New.pf_unsafe_type_of gl f' in
       let arity, ctx, ctxenv, c', args, eqs, refls, nogen, vars, env =
 	Array.fold_left aux (tyf',[],env,f',[],[],[],Id.Set.empty,Id.Set.empty,env) args'
       in
@@ -3662,14 +3715,14 @@ let abstract_args gl generalize_vars dep id defined f args =
       let vars =
 	if generalize_vars then
 	  let nogen = Id.Set.add id nogen in
-	    hyps_of_vars (pf_env gl) (pf_hyps gl) nogen vars
+	    hyps_of_vars (pf_env gl) (project gl) (Proofview.Goal.hyps gl) nogen vars
 	else []
       in
       let body, c' =
 	if defined then Some c', Retyping.get_type_of ctxenv !sigma c'
 	else None, c'
       in
-      let typ = Tacmach.pf_get_hyp_typ gl id in
+      let typ = Tacmach.New.pf_get_hyp_typ id gl in
       let tac = make_abstract_generalize (pf_env gl) id typ concl dep ctx body c' eqs args refls in
       let tac = Proofview.Unsafe.tclEVARS !sigma <*> tac in
 	Some (tac, dep, succ (List.length ctx), vars)
@@ -3677,21 +3730,22 @@ let abstract_args gl generalize_vars dep id defined f args =
 
 let abstract_generalize ?(generalize_vars=true) ?(force_dep=false) id =
   let open Context.Named.Declaration in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   Coqlib.check_required_library Coqlib.jmeq_module_name;
+  let sigma = Tacmach.New.project gl in
   let (f, args, def, id, oldid) =
     let oldid = Tacmach.New.pf_get_new_id id gl in
       match Tacmach.New.pf_get_hyp id gl with
-      | LocalAssum (_,t) -> let f, args = decompose_app t in
+      | LocalAssum (_,t) -> let f, args = decompose_app sigma t in
 	        (f, args, false, id, oldid)
       | LocalDef (_,t,_) ->
-	  let f, args = decompose_app t in
+	  let f, args = decompose_app sigma t in
 	  (f, args, true, id, oldid)
   in
   if List.is_empty args then Proofview.tclUNIT ()
   else
     let args = Array.of_list args in
-    let newc = Tacmach.New.of_old (fun gl -> abstract_args gl generalize_vars force_dep id def f args) gl in
+    let newc = abstract_args gl generalize_vars force_dep id def f args in
       match newc with
       | None -> Proofview.tclUNIT ()
       | Some (tac, dep, n, vars) ->
@@ -3712,35 +3766,41 @@ let abstract_generalize ?(generalize_vars=true) ?(force_dep=false) id =
                 [revert vars ;
 		 Tacticals.New.tclMAP (fun id ->
 		      Tacticals.New.tclTRY (generalize_dep ~with_let:true (mkVar id))) vars])
-  end }
+  end
 
-let rec compare_upto_variables x y =
-  if (isVar x || isRel x) && (isVar y || isRel y) then true
-  else compare_constr compare_upto_variables x y
+let compare_upto_variables sigma x y =
+  let rec compare x y =
+    if (isVar sigma x || isRel sigma x) && (isVar sigma y || isRel sigma y) then true
+    else compare_constr sigma compare x y
+  in
+  compare x y
 
-let specialize_eqs id gl =
+let specialize_eqs id =
   let open Context.Rel.Declaration in
-  let env = Tacmach.pf_env gl in
-  let ty = Tacmach.pf_get_hyp_typ gl id in
-  let evars = ref (project gl) in
+  Proofview.Goal.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
+  let ty = Tacmach.New.pf_get_hyp_typ id gl in
+  let evars = ref (Proofview.Goal.sigma gl) in
   let unif env evars c1 c2 =
-    compare_upto_variables c1 c2 && Evarconv.e_conv env evars c1 c2
+    compare_upto_variables !evars c1 c2 && Evarconv.e_conv env evars c1 c2
   in
   let rec aux in_eqs ctx acc ty =
-    match kind_of_term ty with
+    match EConstr.kind !evars ty with
     | Prod (na, t, b) ->
-	(match kind_of_term t with
-	| App (eq, [| eqty; x; y |]) when Term.eq_constr (Lazy.force coq_eq) eq ->
-	    let c = if noccur_between 1 (List.length ctx) x then y else x in
-	    let pt = mkApp (Lazy.force coq_eq, [| eqty; c; c |]) in
-	    let p = mkApp (Lazy.force coq_eq_refl, [| eqty; c |]) in
+	(match EConstr.kind !evars t with
+	| App (eq, [| eqty; x; y |]) when EConstr.is_global !evars (Lazy.force coq_eq_ref) eq ->
+	    let c = if noccur_between !evars 1 (List.length ctx) x then y else x in
+	    let pt = mkApp (eq, [| eqty; c; c |]) in
+            let ind = destInd !evars eq in
+	    let p = mkApp (mkConstructUi (ind,0), [| eqty; c |]) in
 	      if unif (push_rel_context ctx env) evars pt t then
 		aux true ctx (mkApp (acc, [| p |])) (subst1 p b)
 	      else acc, in_eqs, ctx, ty
-	| App (heq, [| eqty; x; eqty'; y |]) when Term.eq_constr heq (Lazy.force coq_heq) ->
-	    let eqt, c = if noccur_between 1 (List.length ctx) x then eqty', y else eqty, x in
-	    let pt = mkApp (Lazy.force coq_heq, [| eqt; c; eqt; c |]) in
-	    let p = mkApp (Lazy.force coq_heq_refl, [| eqt; c |]) in
+	| App (heq, [| eqty; x; eqty'; y |]) when EConstr.is_global !evars (Lazy.force coq_heq_ref) heq ->
+	    let eqt, c = if noccur_between !evars 1 (List.length ctx) x then eqty', y else eqty, x in
+	    let pt = mkApp (heq, [| eqt; c; eqt; c |]) in
+            let ind = destInd !evars heq in
+	    let p = mkApp (mkConstructUi (ind,0), [| eqt; c |]) in
 	      if unif (push_rel_context ctx env) evars pt t then
 		aux true ctx (mkApp (acc, [| p |])) (subst1 p b)
 	      else acc, in_eqs, ctx, ty
@@ -3754,7 +3814,7 @@ let specialize_eqs id gl =
   let acc, worked, ctx, ty = aux false [] (mkVar id) ty in
   let ctx' = nf_rel_context_evar !evars ctx in
   let ctx'' = List.map (function
-    | LocalDef (n,k,t) when isEvar k -> LocalAssum (n,t)
+    | LocalDef (n,k,t) when isEvar !evars k -> LocalAssum (n,t)
     | decl -> decl) ctx'
   in
   let ty' = it_mkProd_or_LetIn ty ctx'' in
@@ -3763,20 +3823,22 @@ let specialize_eqs id gl =
   and acc' = Tacred.whd_simpl env !evars acc' in
   let ty' = Evarutil.nf_evar !evars ty' in
     if worked then
-      tclTHENFIRST (Tacmach.internal_cut true id ty')
-	(Proofview.V82.of_tactic (exact_no_check ((* refresh_universes_strict *) acc'))) gl
-    else tclFAIL 0 (str "Nothing to do in hypothesis " ++ pr_id id) gl
-
+      Tacticals.New.tclTHENFIRST
+        (internal_cut true id ty')
+	(exact_no_check ((* refresh_universes_strict *) acc'))
+    else
+      Tacticals.New.tclFAIL 0 (str "Nothing to do in hypothesis " ++ Id.print id)
+  end
 
-let specialize_eqs id = Proofview.Goal.nf_enter { enter = begin fun gl ->
+let specialize_eqs id = Proofview.Goal.enter begin fun gl ->
   let msg = str "Specialization not allowed on dependent hypotheses" in
   Proofview.tclOR (clear [id])
     (fun _ -> Tacticals.New.tclZEROMSG msg) >>= fun () ->
-    Proofview.V82.tactic (specialize_eqs id)
-end }
+    specialize_eqs id
+end
 
-let occur_rel n c =
-  let res = not (noccurn n c) in
+let occur_rel sigma n c =
+  let res = not (noccurn sigma n c) in
   res
 
 (* This function splits the products of the induction scheme [elimt] into four
@@ -3787,20 +3849,20 @@ let occur_rel n c =
    if there is no branch, we try to fill in acc3 with args/indargs.
    We also return the conclusion.
 *)
-let decompose_paramspred_branch_args elimt =
+let decompose_paramspred_branch_args sigma elimt =
   let open Context.Rel.Declaration in
   let rec cut_noccur elimt acc2 =
-    match kind_of_term elimt with
+    match EConstr.kind sigma elimt with
       | Prod(nme,tpe,elimt') ->
-	  let hd_tpe,_ = decompose_app ((strip_prod_assum tpe)) in
-	  if not (occur_rel 1 elimt') && isRel hd_tpe
+	  let hd_tpe,_ = decompose_app sigma (snd (decompose_prod_assum sigma tpe)) in
+	  if not (occur_rel sigma 1 elimt') && isRel sigma hd_tpe
 	  then cut_noccur elimt' (LocalAssum (nme,tpe)::acc2)
-	  else let acc3,ccl = decompose_prod_assum elimt in acc2 , acc3 , ccl
+	  else let acc3,ccl = decompose_prod_assum sigma elimt in acc2 , acc3 , ccl
       | App(_, _) | Rel _ -> acc2 , [] , elimt
       | _ -> error_ind_scheme "" in
   let rec cut_occur elimt acc1 =
-    match kind_of_term elimt with
-      | Prod(nme,tpe,c) when occur_rel 1 c -> cut_occur c (LocalAssum (nme,tpe)::acc1)
+    match EConstr.kind sigma elimt with
+      | Prod(nme,tpe,c) when occur_rel sigma 1 c -> cut_occur c (LocalAssum (nme,tpe)::acc1)
       | Prod(nme,tpe,c) -> let acc2,acc3,ccl = cut_noccur elimt [] in acc1,acc2,acc3,ccl
       | App(_, _) | Rel _ -> acc1,[],[],elimt
       | _ -> error_ind_scheme "" in
@@ -3813,17 +3875,17 @@ let decompose_paramspred_branch_args elimt =
      args. We suppose there is only one predicate here. *)
   match acc2 with
   | [] ->
-    let hyps,ccl = decompose_prod_assum elimt in
-    let hd_ccl_pred,_ = decompose_app ccl in
-    begin match kind_of_term hd_ccl_pred with
+    let hyps,ccl = decompose_prod_assum sigma elimt in
+    let hd_ccl_pred,_ = decompose_app sigma ccl in
+    begin match EConstr.kind sigma hd_ccl_pred with
       | Rel i  -> let acc3,acc1 = List.chop (i-1) hyps in acc1 , [] , acc3 , ccl
       | _ -> error_ind_scheme ""
     end
   | _ -> acc1, acc2 , acc3, ccl
 
 
-let exchange_hd_app subst_hd t =
-  let hd,args= decompose_app t in mkApp (subst_hd,Array.of_list args)
+let exchange_hd_app sigma subst_hd t =
+  let hd,args= decompose_app sigma t in mkApp (subst_hd,Array.of_list args)
 
 (* Builds an elim_scheme from its type and calling form (const+binding). We
    first separate branches.  We obtain branches, hyps before (params + preds),
@@ -3841,14 +3903,14 @@ let exchange_hd_app subst_hd t =
      predicates are cited in the conclusion.
 
    - finish to fill in the elim_scheme: indarg/farg/args and finally indref. *)
-let compute_elim_sig ?elimc elimt =
+let compute_elim_sig sigma ?elimc elimt =
   let open Context.Rel.Declaration in
   let params_preds,branches,args_indargs,conclusion =
-    decompose_paramspred_branch_args elimt in
+    decompose_paramspred_branch_args sigma elimt in
 
-  let ccl = exchange_hd_app (mkVar (Id.of_string "__QI_DUMMY__")) conclusion in
+  let ccl = exchange_hd_app sigma (mkVar (Id.of_string "__QI_DUMMY__")) conclusion in
   let concl_with_args = it_mkProd_or_LetIn ccl args_indargs in
-  let nparams = Int.Set.cardinal (free_rels concl_with_args) in
+  let nparams = Int.Set.cardinal (free_rels sigma concl_with_args) in
   let preds,params = List.chop (List.length params_preds - nparams) params_preds in
 
   (* A first approximation, further analysis will tweak it *)
@@ -3857,7 +3919,7 @@ let compute_elim_sig ?elimc elimt =
     elimc = elimc; elimt = elimt; concl = conclusion;
     predicates = preds; npredicates = List.length preds;
     branches = branches; nbranches = List.length branches;
-    farg_in_concl = isApp ccl && isApp (last_arg ccl);
+    farg_in_concl = isApp sigma ccl && isApp sigma (last_arg sigma ccl);
     params = params; nparams = nparams;
     (* all other fields are unsure at this point. Including these:*)
     args = args_indargs; nargs = List.length args_indargs; } in
@@ -3878,9 +3940,9 @@ let compute_elim_sig ?elimc elimt =
       match List.hd args_indargs with
 	| LocalDef (hiname,_,hi) -> error_ind_scheme ""
 	| LocalAssum (hiname,hi) ->
-	    let hi_ind, hi_args = decompose_app hi in
+	    let hi_ind, hi_args = decompose_app sigma hi in
 	    let hi_is_ind = (* hi est d'un type globalisable *)
-	      match kind_of_term hi_ind with
+	      match EConstr.kind sigma hi_ind with
 		| Ind (mind,_)  -> true
 		| Var _ -> true
 		| Const _ -> true
@@ -3893,7 +3955,7 @@ let compute_elim_sig ?elimc elimt =
 	    else (* Last arg is the indarg *)
 	      res := {!res with
 		indarg = Some (List.hd !res.args);
-		indarg_in_concl = occur_rel 1 ccl;
+		indarg_in_concl = occur_rel sigma 1 ccl;
 		args = List.tl !res.args; nargs = !res.nargs - 1;
 	      };
 	    raise Exit);
@@ -3903,49 +3965,49 @@ let compute_elim_sig ?elimc elimt =
       | None -> !res (* No indref *)
       | Some (LocalDef _) -> error_ind_scheme ""
       | Some (LocalAssum (_,ind)) ->
-	  let indhd,indargs = decompose_app ind in
-	  try {!res with indref = Some (global_of_constr indhd) }
+	  let indhd,indargs = decompose_app sigma ind in
+	  try {!res with indref = Some (fst (Termops.global_of_constr sigma indhd)) }
 	  with e when CErrors.noncritical e ->
             error "Cannot find the inductive type of the inductive scheme."
 
-let compute_scheme_signature scheme names_info ind_type_guess =
+let compute_scheme_signature evd scheme names_info ind_type_guess =
   let open Context.Rel.Declaration in
-  let f,l = decompose_app scheme.concl in
+  let f,l = decompose_app evd scheme.concl in
   (* Vérifier que les arguments de Qi sont bien les xi. *)
   let cond, check_concl =
     match scheme.indarg with
       | Some (LocalDef _) ->
 	  error "Strange letin, cannot recognize an induction scheme."
       | None -> (* Non standard scheme *)
-	  let cond hd = Term.eq_constr hd ind_type_guess && not scheme.farg_in_concl
+	  let cond hd = EConstr.eq_constr evd hd ind_type_guess && not scheme.farg_in_concl
 	  in (cond, fun _ _ -> ())
       | Some (LocalAssum (_,ind)) -> (* Standard scheme from an inductive type *)
-	  let indhd,indargs = decompose_app ind in
-	  let cond hd = Term.eq_constr hd indhd in
+	  let indhd,indargs = decompose_app evd ind in
+	  let cond hd = EConstr.eq_constr evd hd indhd in
 	  let check_concl is_pred p =
 	    (* Check again conclusion *)
 	    let ccl_arg_ok = is_pred (p + scheme.nargs + 1) f == IndArg in
 	    let ind_is_ok =
-	      List.equal Term.eq_constr
+	      List.equal (fun c1 c2 -> EConstr.eq_constr evd c1 c2)
 		(List.lastn scheme.nargs indargs)
-		(Context.Rel.to_extended_list 0 scheme.args) in
+		(Context.Rel.to_extended_list mkRel 0 scheme.args) in
 	    if not (ccl_arg_ok && ind_is_ok) then
 	      error_ind_scheme "the conclusion of"
 	  in (cond, check_concl)
   in
   let is_pred n c =
-    let hd = fst (decompose_app c) in
-    match kind_of_term hd with
+    let hd = fst (decompose_app evd c) in
+    match EConstr.kind evd hd with
       | Rel q when n < q && q <= n+scheme.npredicates -> IndArg
       | _ when cond hd -> RecArg
       | _ -> OtherArg
   in
   let rec check_branch p c =
-    match kind_of_term c with
+    match EConstr.kind evd c with
       | Prod (_,t,c) ->
-	(is_pred p t, true, dependent (mkRel 1) c) :: check_branch (p+1) c
+	(is_pred p t, true, not (Vars.noccurn evd 1 c)) :: check_branch (p+1) c
       | LetIn (_,_,_,c) ->
-	(OtherArg, false, dependent (mkRel 1) c) :: check_branch (p+1) c
+	(OtherArg, false, not (Vars.noccurn evd 1 c)) :: check_branch (p+1) c
       | _ when is_pred p c == IndArg -> []
       | _ -> raise Exit
   in
@@ -3977,55 +4039,59 @@ let compute_scheme_signature scheme names_info ind_type_guess =
    the non standard case, naming of generated hypos is slightly
    different. *)
 let compute_elim_signature (evd,(elimc,elimt),ind_type_guess) names_info =
-  let scheme = compute_elim_sig ~elimc:elimc elimt in
-    evd, (compute_scheme_signature scheme names_info ind_type_guess, scheme)
+  let scheme = compute_elim_sig evd ~elimc:elimc elimt in
+    evd, (compute_scheme_signature evd scheme names_info ind_type_guess, scheme)
 
 let guess_elim isrec dep s hyp0 gl =
   let tmptyp0 =	Tacmach.New.pf_get_hyp_typ hyp0 gl in
-  let mind,_ = Tacmach.New.pf_reduce_to_quantified_ind gl tmptyp0 in
+  let (mind, u), _ = Tacmach.New.pf_reduce_to_quantified_ind gl tmptyp0 in
   let evd, elimc =
-    if isrec && not (is_nonrec (fst mind)) then find_ind_eliminator (fst mind) s gl
+    if isrec && not (is_nonrec mind) then find_ind_eliminator mind s gl
     else
       let env = Tacmach.New.pf_env gl in
-      let sigma = Sigma.Unsafe.of_evar_map (Tacmach.New.project gl) in
-      if use_dependent_propositions_elimination () && dep
-      then
-        let Sigma (ind, sigma, _) = build_case_analysis_scheme env sigma mind true s in
-        (Sigma.to_evar_map sigma, ind)
+      let sigma = Tacmach.New.project gl in
+      let u = EInstance.kind (Tacmach.New.project gl) u in
+      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)
       else
-        let Sigma (ind, sigma, _) = build_case_analysis_scheme_default env sigma mind s in
-        (Sigma.to_evar_map sigma, ind)
+        let (sigma, ind) = build_case_analysis_scheme_default env sigma (mind, u) s in
+        let ind = EConstr.of_constr ind in
+        (sigma, ind)
   in
   let elimt = Tacmach.New.pf_unsafe_type_of gl elimc in
-    evd, ((elimc, NoBindings), elimt), mkIndU mind
+    evd, ((elimc, NoBindings), elimt), mkIndU (mind, u)
 
 let given_elim hyp0 (elimc,lbind as e) gl =
+  let sigma = Tacmach.New.project gl in
   let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 gl in
-  let ind_type_guess,_ = decompose_app ((strip_prod tmptyp0)) in
-  Tacmach.New.project gl, (e, Tacmach.New.pf_unsafe_type_of gl elimc), ind_type_guess
+  let ind_type_guess,_ = decompose_app sigma (snd (decompose_prod sigma tmptyp0)) in
+  let elimt = Tacmach.New.pf_unsafe_type_of gl elimc in
+  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 * types) * scheme_signature
+  | ElimUsing of (eliminator * EConstr.types) * scheme_signature
   | ElimOver of bool * Id.t
 
 let find_induction_type isrec elim hyp0 gl =
+  let sigma = Tacmach.New.project gl in
   let scheme,elim =
     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 ~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 ~elimc elimt in
+	let scheme = compute_elim_sig sigma ~elimc elimt in
 	if Option.is_empty scheme.indarg then error "Cannot find induction type";
-	let indsign = compute_scheme_signature scheme hyp0 ind_guess in
+	let indsign = compute_scheme_signature evd scheme hyp0 ind_guess in
 	let elim = ({elimindex = Some(-1); elimbody = elimc; elimrename = None},elimt) in
 	scheme, ElimUsing (elim,indsign)
   in
@@ -4037,7 +4103,8 @@ let get_elim_signature elim hyp0 gl =
   compute_elim_signature (given_elim hyp0 elim gl) hyp0
 
 let is_functional_induction elimc gl =
-  let scheme = compute_elim_sig ~elimc (Tacmach.New.pf_unsafe_type_of gl (fst elimc)) in
+  let sigma = Tacmach.New.project gl in
+  let scheme = compute_elim_sig sigma ~elimc (Tacmach.New.pf_unsafe_type_of gl (fst elimc)) in
   (* The test is not safe: with non-functional induction on non-standard
      induction scheme, this may fail *)
   Option.is_empty scheme.indarg
@@ -4046,27 +4113,28 @@ let is_functional_induction elimc gl =
    need a dependent one or not *)
 
 let get_eliminator elim dep s gl =
-  let open Context.Rel.Declaration in
   match elim with
   | ElimUsing (elim,indsign) ->
       Tacmach.New.project gl, (* bugged, should be computed *) true, elim, indsign
   | ElimOver (isrec,id) ->
       let evd, (elimc,elimt),_ as elims = guess_elim isrec dep s id gl in
       let _, (l, s) = compute_elim_signature elims id in
-      let branchlengthes = List.map (fun d -> assert (is_local_assum d); pi1 (decompose_prod_letin (get_type d))) (List.rev s.branches) in
+      let branchlengthes = List.map (fun d -> assert (RelDecl.is_local_assum d); pi1 (decompose_prod_letin (Tacmach.New.project gl) (RelDecl.get_type d)))
+                                    (List.rev s.branches)
+      in
       evd, isrec, ({elimindex = None; elimbody = elimc; elimrename = Some (isrec,Array.of_list branchlengthes)}, elimt), l
 
 (* Instantiate all meta variables of elimclause using lid, some elts
    of lid are parameters (first ones), the other are
    arguments. Returns the clause obtained.  *)
 let recolle_clenv i params args elimclause gl =
-  let _,arr = destApp elimclause.templval.rebus in
+  let _,arr = destApp elimclause.evd elimclause.templval.rebus in
   let lindmv =
     Array.map
       (fun x ->
-	match kind_of_term x with
+	match EConstr.kind elimclause.evd x with
 	  | Meta mv -> mv
-	  | _  -> errorlabstrm "elimination_clause"
+	  | _  -> user_err ~hdr:"elimination_clause"
               (str "The type of the elimination clause is not well-formed."))
       arr in
   let k = match i with -1 -> Array.length lindmv - List.length args | _ -> i in
@@ -4085,7 +4153,7 @@ let recolle_clenv i params args elimclause gl =
       (* from_n (Some 0) means that x should be taken "as is" without
          trying to unify (which would lead to trying to apply it to
          evars if y is a product). *)
-      let indclause  = Tacmach.New.of_old (fun gl -> mk_clenv_from_n gl (Some 0) (x,y)) gl in
+      let indclause  = mk_clenv_from_n gl (Some 0) (x,y) in
       let elimclause' = clenv_fchain ~with_univs:false i acc indclause in
       elimclause')
     (List.rev clauses)
@@ -4096,49 +4164,49 @@ let recolle_clenv i params args elimclause gl =
     produce new ones). Then refine with the resulting term with holes.
 *)
 let induction_tac with_evars params indvars elim =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = Tacmach.New.project gl in
   let ({elimindex=i;elimbody=(elimc,lbindelimc);elimrename=rename},elimt) = elim in
-  let i = match i with None -> index_of_ind_arg elimt | Some i -> i in
+  let i = match i with None -> index_of_ind_arg sigma elimt | Some i -> i in
   (* elimclause contains this: (elimc ?i ?j ?k...?l) *)
-  let elimc = contract_letin_in_lam_header elimc in
+  let elimc = contract_letin_in_lam_header sigma elimc in
   let elimc = mkCast (elimc, DEFAULTcast, elimt) in
-  let elimclause = pf_apply make_clenv_binding gl (elimc,elimt) lbindelimc in
+  let elimclause = Tacmach.New.pf_apply make_clenv_binding gl (elimc,elimt) lbindelimc in
   (* elimclause' is built from elimclause by instanciating all args and params. *)
   let elimclause' = recolle_clenv i params indvars elimclause gl in
   (* one last resolution (useless?) *)
-  let resolved = Tacmach.New.of_old (clenv_unique_resolver ~flags:(elim_flags ()) elimclause') gl in
-  enforce_prop_bound_names rename (Clenvtac.clenv_refine with_evars resolved)
-  end }
+  let resolved = clenv_unique_resolver ~flags:(elim_flags ()) elimclause' gl in
+  Clenvtac.clenv_refine with_evars resolved
+  end
 
 (* Apply induction "in place" taking into account dependent
    hypotheses from the context, replacing the main hypothesis on which
    induction applies with the induction hypotheses *)
 
 let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_tac =
-  let open Context.Named.Declaration in
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
-    let sigma = Sigma.to_evar_map sigma in
-    let concl = Tacmach.New.pf_nf_concl gl in
-    let statuslists,lhyp0,toclear,deps,avoid,dep_in_hyps = cook_sign hyp0 inhyps indvars env in
-    let dep_in_concl = Option.cata (fun id -> occur_var env id concl) false hyp0 in
+    let concl = Tacmach.New.pf_concl gl in
+    let statuslists,lhyp0,toclear,deps,avoid,dep_in_hyps = cook_sign hyp0 inhyps indvars env sigma in
+    let dep_in_concl = Option.cata (fun id -> occur_var env sigma id concl) false hyp0 in
     let dep = dep_in_hyps || dep_in_concl in
     let tmpcl = it_mkNamedProd_or_LetIn concl deps in
     let s = Retyping.get_sort_family_of env sigma tmpcl in
     let deps_cstr =
       List.fold_left
-        (fun a decl -> if is_local_assum decl then (mkVar (get_id decl))::a else a) [] deps in
-    let (sigma, isrec, elim, indsign) = get_eliminator elim dep s (Proofview.Goal.assume gl) in
+        (fun a decl -> if NamedDecl.is_local_assum decl then (mkVar (NamedDecl.get_id decl))::a else a) [] deps in
+    let (sigma, isrec, elim, indsign) = get_eliminator elim dep s gl in
     let branchletsigns =
       let f (_,is_not_let,_,_) = is_not_let in
       Array.map (fun (_,l) -> List.map f l) indsign in
     let names = compute_induction_names branchletsigns names in
+    Array.iter (check_name_unicity env toclear []) names;
     let tac =
     (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;
@@ -4148,16 +4216,16 @@ let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_
             (re_intro_dependent_hypotheses statuslists))
          indsign names)
     in
-    Sigma.Unsafe.of_pair (tac, sigma)
-  end }
+    Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
+  end
 
 let induction_with_atomization_of_ind_arg isrec with_evars elim names hyp0 inhyps =
-  Proofview.Goal.enter { enter = begin fun gl ->
-  let elim_info = find_induction_type isrec elim hyp0 (Proofview.Goal.assume gl) in
+  Proofview.Goal.enter begin fun gl ->
+  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))
-  end }
+  end
 
 let msg_not_right_number_induction_arguments scheme =
   str"Not the right number of induction arguments (expected " ++
@@ -4174,7 +4242,7 @@ let msg_not_right_number_induction_arguments scheme =
    must be given, so we help a bit the unifier by making the "pattern"
    by hand before calling induction_tac *)
 let induction_without_atomization isrec with_evars elim names lid =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma, (indsign,scheme) = get_elim_signature elim (List.hd lid) gl in
   let nargs_indarg_farg =
     scheme.nargs + (if scheme.farg_in_concl then 1 else 0) in
@@ -4193,7 +4261,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;
@@ -4205,33 +4273,31 @@ let induction_without_atomization isrec with_evars elim names lid =
   ] in
   let elim = ElimUsing (({elimindex = Some (-1); elimbody = Option.get scheme.elimc; elimrename = None}, scheme.elimt), indsign) in
   apply_induction_in_context with_evars None [] elim indvars names induct_tac
-  end }
+  end
 
 (* assume that no occurrences are selected *)
 let clear_unselected_context id inhyps cls =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let open Context.Named.Declaration in
-  if occur_var (Tacmach.New.pf_env gl) id (Tacmach.New.pf_concl gl) &&
+  Proofview.Goal.enter begin fun gl ->
+  if occur_var (Tacmach.New.pf_env gl) (Tacmach.New.project gl) id (Tacmach.New.pf_concl gl) &&
     cls.concl_occs == NoOccurrences
-  then errorlabstrm ""
-    (str "Conclusion must be mentioned: it depends on " ++ pr_id id
+  then user_err 
+    (str "Conclusion must be mentioned: it depends on " ++ Id.print id
      ++ str ".");
   match cls.onhyps with
   | Some hyps ->
       let to_erase d =
-        let id' = get_id d in
+        let id' = NamedDecl.get_id d in
 	if Id.List.mem id' inhyps then (* if selected, do not erase *) None
 	else
 	  (* erase if not selected and dependent on id or selected hyps *)
-	  let test id = occur_var_in_decl (Tacmach.New.pf_env gl) id d in
+	  let test id = occur_var_in_decl (Tacmach.New.pf_env gl) (Tacmach.New.project gl) id d in
 	  if List.exists test (id::inhyps) then Some id' else None in
       let ids = List.map_filter to_erase (Proofview.Goal.hyps gl) in
       clear ids
   | None -> Proofview.tclUNIT ()
-  end }
+  end
 
 let use_bindings env sigma elim must_be_closed (c,lbind) typ =
-  let sigma = Sigma.to_evar_map sigma in
   let typ =
     if elim == None then
       (* w/o an scheme, the term has to be applied at least until
@@ -4250,11 +4316,10 @@ let use_bindings env sigma elim must_be_closed (c,lbind) typ =
   let rec find_clause typ =
     try
       let indclause = make_clenv_binding env sigma (c,typ) lbind in
-      if must_be_closed && occur_meta (clenv_value indclause) then
+      if must_be_closed && occur_meta indclause.evd (clenv_value indclause) then
         error "Need a fully applied argument.";
       (* We lose the possibility of coercions in with-bindings *)
-      let (sigma, c) = pose_all_metas_as_evars env indclause.evd (clenv_value indclause) in
-      Sigma.Unsafe.of_pair (c, sigma)
+      pose_all_metas_as_evars env indclause.evd (clenv_value indclause)
     with e when catchable_exception e ->
     try find_clause (try_red_product env sigma typ)
     with Redelimination -> raise e in
@@ -4268,20 +4333,19 @@ let check_expected_type env sigma (elimc,bl) elimt =
   if n == 0 then error "Scheme cannot be applied.";
   let sigma,cl = make_evar_clause env sigma ~len:(n - 1) elimt in
   let sigma = solve_evar_clause env sigma true cl bl in
-  let (_,u,_) = destProd cl.cl_concl in
+  let (_,u,_) = destProd sigma cl.cl_concl in
   fun t -> Evarconv.e_cumul env (ref sigma) t u
 
 let check_enough_applied env sigma elim =
-  let sigma = Sigma.to_evar_map sigma in
   (* A heuristic to decide whether the induction arg is enough applied *)
   match elim with
   | None ->
       (* No eliminator given *)
       fun u ->
-      let t,_ = decompose_app (whd_all env sigma u) in isInd t
+      let t,_ = decompose_app sigma (whd_all env sigma u) in isInd sigma t
   | Some elimc ->
       let elimt = Retyping.get_type_of env sigma (fst elimc) in
-      let scheme = compute_elim_sig ~elimc elimt in
+      let scheme = compute_elim_sig sigma ~elimc elimt in
       match scheme.indref with
       | None ->
          (* in the absence of information, do not assume it may be
@@ -4292,28 +4356,32 @@ 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 =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   let env = Proofview.Goal.env gl in
-  let ccl = Proofview.Goal.raw_concl gl in
+  let ccl = Proofview.Goal.concl gl in
   let store = Proofview.Goal.extra gl in
   let check = check_enough_applied env sigma elim in
-  let Sigma (c, sigma', p) = use_bindings env sigma elim false (c0,lbind) t0 in
+  let (sigma', c) = use_bindings env sigma elim false (c0,lbind) t0 in
   let abs = AbstractPattern (from_prefix,check,Name id,(pending,c),cls,false) in
   let (id,sign,_,lastlhyp,ccl,res) = make_abstraction env sigma' ccl abs in
   match res with
   | None ->
       (* pattern not found *)
-      let with_eq = Option.map (fun eq -> (false,eq)) eqname in
+      let with_eq = Option.map (fun eq -> (false,mk_eq_name env id eq)) eqname in
+      let inhyps = if List.is_empty inhyps then inhyps else Option.fold_left (fun inhyps (_,heq) -> heq::inhyps) inhyps with_eq in
       (* we restart using bindings after having tried type-class
          resolution etc. on the term given by the user *)
       let flags = tactic_infer_flags (with_evars && (* do not give a success semantics to edestruct on an open term yet *) false) in
-      let Sigma (c0, sigma, q) = finish_evar_resolution ~flags env sigma (pending,c0) in
+      let (sigma, c0) = finish_evar_resolution ~flags env sigma (pending,c0) in
       let tac =
       (if isrec then
           (* Historically, induction has side conditions last *)
@@ -4322,68 +4390,68 @@ let pose_induction_arg_then isrec with_evars (is_arg_pure_hyp,from_prefix) elim
           (* and destruct has side conditions first *)
           Tacticals.New.tclTHENLAST)
       (Tacticals.New.tclTHENLIST [
-        Refine.refine ~unsafe:true { run = begin fun sigma ->
+        Refine.refine ~typecheck:false begin fun sigma ->
           let b = not with_evars && with_eq != None in
-          let Sigma (c, sigma, p) = use_bindings env sigma elim b (c0,lbind) t0 in
-          let t = Retyping.get_type_of env (Sigma.to_evar_map sigma) c in
-          let Sigma (ans, sigma, q) = mkletin_goal env sigma store with_eq false (id,lastlhyp,ccl,c) (Some t) in
-          Sigma (ans, sigma, p +> q)
-        end };
+          let (sigma, c) = use_bindings env sigma elim b (c0,lbind) t0 in
+          let t = Retyping.get_type_of env sigma c in
+          mkletin_goal env sigma store with_eq false (id,lastlhyp,ccl,c) (Some t)
+        end;
         if with_evars then Proofview.shelve_unifiable else guard_no_unifiable;
         if is_arg_pure_hyp
-        then Tacticals.New.tclTRY (clear [destVar c0])
+        then Proofview.tclEVARMAP >>= fun sigma -> Tacticals.New.tclTRY (clear [destVar sigma c0])
         else Proofview.tclUNIT ();
         if isrec then Proofview.cycle (-1) else Proofview.tclUNIT ()
       ])
-      tac
+      (tac inhyps)
       in
-      Sigma (tac, sigma, q)
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
 
-  | Some (Sigma (c, sigma', q)) ->
+  | Some (sigma', c) ->
       (* pattern found *)
-      let with_eq = Option.map (fun eq -> (false,eq)) eqname in
       (* TODO: if ind has predicate parameters, use JMeq instead of eq *)
       let env = reset_with_named_context sign env in
+      let with_eq = Option.map (fun eq -> (false,mk_eq_name env id eq)) eqname in
+      let inhyps = if List.is_empty inhyps then inhyps else Option.fold_left (fun inhyps (_,heq) -> heq::inhyps) inhyps with_eq in
       let tac =
       Tacticals.New.tclTHENLIST [
-        Refine.refine ~unsafe:true { run = begin fun sigma ->
+        Refine.refine ~typecheck:false begin fun sigma ->
           mkletin_goal env sigma store with_eq true (id,lastlhyp,ccl,c) None
-        end };
-        tac
+        end;
+        (tac inhyps)
       ]
       in
-      Sigma (tac, sigma', p +> q)
-  end }
+      Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma') tac
+  end
 
-let has_generic_occurrences_but_goal cls id env ccl =
+let has_generic_occurrences_but_goal cls id env sigma ccl =
   clause_with_generic_context_selection cls &&
   (* TODO: whd_evar of goal *)
-  (cls.concl_occs != NoOccurrences || not (occur_var env id ccl))
+  (cls.concl_occs != NoOccurrences || not (occur_var env sigma id ccl))
 
 let induction_gen clear_flag isrec with_evars elim
     ((_pending,(c,lbind)),(eqname,names) as arg) cls =
   let inhyps = match cls with
   | Some {onhyps=Some hyps} -> List.map (fun ((_,id),_) -> id) hyps
   | _ -> [] in
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
-  let ccl = Proofview.Goal.raw_concl gl in
+  let evd = Proofview.Goal.sigma gl in
+  let ccl = Proofview.Goal.concl gl in
   let cls = Option.default allHypsAndConcl cls in
-  let t = typ_of env sigma c in
+  let t = typ_of env evd c in
   let is_arg_pure_hyp =
-    isVar c && not (mem_named_context_val (destVar c) (Global.named_context_val ()))
+    isVar evd c && not (mem_named_context_val (destVar evd c) (Global.named_context_val ()))
     && lbind == NoBindings && not with_evars && Option.is_empty eqname
     && clear_flag == None
-    && has_generic_occurrences_but_goal cls (destVar c) env ccl in
-  let enough_applied = check_enough_applied env sigma elim t in
+    && has_generic_occurrences_but_goal cls (destVar evd c) env evd ccl in
+  let enough_applied = check_enough_applied env evd elim t in
   if is_arg_pure_hyp && enough_applied then
     (* First case: induction on a variable already in an inductive type and
        with maximal abstraction over the variable.
        This is a situation where the induction argument is a
        clearable variable of the goal w/o occurrence selection
        and w/o equality kept: no need to generalize *)
-    let id = destVar c in
+    let id = destVar evd c in
     Tacticals.New.tclTHEN
       (clear_unselected_context id inhyps cls)
       (induction_with_atomization_of_ind_arg
@@ -4393,14 +4461,14 @@ let induction_gen clear_flag isrec with_evars elim
      declaring the induction argument as a new local variable *)
     let id =
     (* Type not the right one if partially applied but anyway for internal use*)
-      let x = id_of_name_using_hdchar (Global.env()) t Anonymous in
-      new_fresh_id [] x gl in
+      let x = id_of_name_using_hdchar env evd t Anonymous 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
     (induction_with_atomization_of_ind_arg
-       isrec with_evars elim names id inhyps)
-  end }
+       isrec with_evars elim names id)
+  end 
 
 (* Induction on a list of arguments. First make induction arguments
    atomic (using letins), then do induction. The specificity here is
@@ -4411,32 +4479,35 @@ let induction_gen_l isrec with_evars elim names lc =
   let newlc = ref [] in
   let lc = List.map (function
     | (c,None) -> c
-    | (c,Some(loc,eqname)) ->
-      user_err_loc (loc,"",str "Do not know what to do with " ++
+    | (c,Some{CAst.loc;v=eqname}) ->
+      user_err ?loc  (str "Do not know what to do with " ++
                          Miscprint.pr_intro_pattern_naming eqname)) lc in
   let rec atomize_list l =
     match l with
       | [] -> Proofview.tclUNIT ()
       | c::l' ->
-	  match kind_of_term c with
+          Proofview.tclEVARMAP >>= fun sigma ->
+	  match EConstr.kind sigma c with
 	    | Var id when not (mem_named_context_val id (Global.named_context_val ()))
 		&& not with_evars ->
 		let _ = newlc:= id::!newlc in
 		atomize_list l'
 
 	    | _ ->
-                Proofview.Goal.enter { enter = begin fun gl ->
+                Proofview.Goal.enter begin fun gl ->
                 let type_of = Tacmach.New.pf_unsafe_type_of gl in
+                let sigma = Tacmach.New.project gl in
+                Proofview.tclENV >>= fun env ->
                 let x =
-		  id_of_name_using_hdchar (Global.env()) (type_of c) Anonymous in
+		  id_of_name_using_hdchar env sigma (type_of c) Anonymous in
 
-                let id = new_fresh_id [] x gl in
-		let newl' = List.map (replace_term c (mkVar id)) l' 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
 		  (letin_tac None (Name id) c None allHypsAndConcl)
 		  (atomize_list newl')
-                end } in
+                end in
   Tacticals.New.tclTHENLIST
     [
       (atomize_list lc);
@@ -4453,7 +4524,7 @@ let induction_destruct isrec with_evars (lc,elim) =
   match lc with
   | [] -> assert false (* ensured by syntax, but if called inside caml? *)
   | [c,(eqname,names as allnames),cls] ->
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     match elim with
@@ -4470,9 +4541,9 @@ let induction_destruct isrec with_evars (lc,elim) =
       (* standard induction *)
       onOpenInductionArg env sigma
       (fun clear_flag c -> induction_gen clear_flag isrec with_evars elim (c,allnames) cls) c
-    end }
+    end
   | _ ->
-    Proofview.Goal.enter { enter = begin fun gl ->
+    Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     match elim with
@@ -4488,12 +4559,12 @@ let induction_destruct isrec with_evars (lc,elim) =
         (onOpenInductionArg env sigma (fun clear_flag a ->
           induction_gen clear_flag isrec with_evars None (a,b) cl) a)
         (Tacticals.New.tclMAP (fun (a,b,cl) ->
-          Proofview.Goal.enter { enter = begin fun gl ->
+          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)
+          end) l)
     | Some elim ->
       (* Several induction hyps with induction scheme *)
       let lc = List.map (on_pi1 (fun c -> snd (force_destruction_arg false env sigma c))) lc in
@@ -4512,39 +4583,15 @@ let induction_destruct isrec with_evars (lc,elim) =
         error "'as' clause with multiple arguments and 'using' clause can only occur last.";
       let newlc = List.map (fun (x,_) -> (x,None)) newlc in
       induction_gen_l isrec with_evars elim names newlc
-    end }
+    end
 
 let induction ev clr c l e =
-  induction_gen clr true ev e 
-    (((Evd.empty,Evd.empty),(c,NoBindings)),(None,l)) None
+  induction_gen clr true ev e
+    ((Evd.empty,(c,NoBindings)),(None,l)) None
 
 let destruct ev clr c l e =
   induction_gen clr false ev e
-    (((Evd.empty,Evd.empty),(c,NoBindings)),(None,l)) None
-
-(* The registered tactic, which calls the default elimination
- * if no elimination constant is provided. *)
-
-(* Induction tactics *)
-
-(* This was Induction before 6.3 (induction only in quantified premisses) *)
-let simple_induct_id s = Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_elim)
-let simple_induct_nodep n = Tacticals.New.tclTHEN (intros_until_n n) (Tacticals.New.onLastHyp simplest_elim)
-
-let simple_induct = function
-  | NamedHyp id -> simple_induct_id id
-  | AnonHyp n -> simple_induct_nodep n
-
-(* Destruction tactics *)
-
-let simple_destruct_id s    =
-  (Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_case))
-let simple_destruct_nodep n =
-  (Tacticals.New.tclTHEN (intros_until_n n)    (Tacticals.New.onLastHyp simplest_case))
-
-let simple_destruct = function
-  | NamedHyp id -> simple_destruct_id id
-  | AnonHyp n -> simple_destruct_nodep n
+    ((Evd.empty,(c,NoBindings)),(None,l)) None
 
 (*
  *  Eliminations giving the type instead of the proof.
@@ -4554,34 +4601,36 @@ let simple_destruct = function
  *)
 
 let elim_scheme_type elim t =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let clause = Tacmach.New.of_old (fun gl -> mk_clenv_type_of gl elim) gl in
-  match kind_of_term (last_arg clause.templval.rebus) with
+  Proofview.Goal.enter begin fun gl ->
+  let clause = mk_clenv_type_of gl elim in
+  match EConstr.kind clause.evd (last_arg clause.evd clause.templval.rebus) with
     | Meta mv ->
         let clause' =
 	  (* t is inductive, then CUMUL or CONV is irrelevant *)
 	  clenv_unify ~flags:(elim_flags ()) Reduction.CUMUL t
             (clenv_meta_type clause mv) clause in
 	Clenvtac.res_pf clause' ~flags:(elim_flags ()) ~with_evars:false
-    | _ -> anomaly (Pp.str "elim_scheme_type")
-  end }
+    | _ -> anomaly (Pp.str "elim_scheme_type.")
+  end
 
 let elim_type t =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let (ind,t) = Tacmach.New.pf_apply reduce_to_atomic_ind gl t in
   let evd, elimc = find_ind_eliminator (fst ind) (Tacticals.New.elimination_sort_of_goal gl) gl in
-  Sigma.Unsafe.of_pair (elim_scheme_type elimc t, evd)
-  end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd) (elim_scheme_type elimc t)
+  end
 
 let case_type t =
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   let env = Tacmach.New.pf_env gl in
-  let (ind,t) = reduce_to_atomic_ind env (Sigma.to_evar_map sigma) t in
+  let ((ind, u), t) = reduce_to_atomic_ind env sigma t in
+  let u = EInstance.kind sigma u in
   let s = Tacticals.New.elimination_sort_of_goal gl in
-  let Sigma (elimc, evd, p) = build_case_analysis_scheme_default env sigma ind s in
-  Sigma (elim_scheme_type elimc t, evd, p)
-  end }
+  let (evd, elimc) = build_case_analysis_scheme_default env sigma (ind, u) s in
+  let elimc = EConstr.of_constr elimc in
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd) (elim_scheme_type elimc t)
+  end
 
 
 (************************************************)
@@ -4593,7 +4642,7 @@ let case_type t =
 let (forward_setoid_reflexivity, setoid_reflexivity) = Hook.make ()
 
 let maybe_betadeltaiota_concl allowred gl =
-  let concl = Tacmach.New.pf_nf_concl gl in
+  let concl = Tacmach.New.pf_concl gl in
   let sigma = Tacmach.New.project gl in
   if not allowred then concl
   else
@@ -4601,15 +4650,16 @@ let maybe_betadeltaiota_concl allowred gl =
     whd_all env sigma concl
 
 let reflexivity_red allowred =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   (* PL: usual reflexivity don't perform any reduction when searching
      for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
+    let sigma = Tacmach.New.project gl in
     let concl = maybe_betadeltaiota_concl allowred gl in
-    match match_with_equality_type concl with
+    match match_with_equality_type sigma concl with
     | None -> Proofview.tclZERO NoEquationFound
     | Some _ -> one_constructor 1 NoBindings
-  end }
+  end
 
 let reflexivity =
   Proofview.tclORELSE
@@ -4643,27 +4693,29 @@ let prove_symmetry hdcncl eq_kind =
         Tacticals.New.onLastHyp simplest_case;
 	one_constructor 1 NoBindings ])
 
-let match_with_equation c =
+let match_with_equation sigma c =
+  Proofview.tclENV >>= fun env ->
   try
-    let res = match_with_equation c in
+    let res = match_with_equation env sigma c in
     Proofview.tclUNIT res
   with NoEquationFound ->
     Proofview.tclZERO NoEquationFound
 
 let symmetry_red allowred =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   (* PL: usual symmetry don't perform any reduction when searching
      for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
+  let sigma = Tacmach.New.project gl in
   let concl = maybe_betadeltaiota_concl allowred gl in
-  match_with_equation concl >>= fun with_eqn ->
+  match_with_equation sigma concl >>= fun with_eqn ->
   match with_eqn with
   | Some eq_data,_,_ ->
       Tacticals.New.tclTHEN
         (convert_concl_no_check concl DEFAULTcast)
-        (Tacticals.New.pf_constr_of_global eq_data.sym apply)
+        (Tacticals.New.pf_constr_of_global eq_data.sym >>= apply)
   | None,eq,eq_kind -> prove_symmetry eq eq_kind
-  end }
+  end
 
 let symmetry =
   Proofview.tclORELSE
@@ -4677,17 +4729,19 @@ let (forward_setoid_symmetry_in, setoid_symmetry_in) = Hook.make ()
 
 
 let symmetry_in id =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let sigma = Tacmach.New.project gl in
   let ctype = Tacmach.New.pf_unsafe_type_of gl (mkVar id) in
-  let sign,t = decompose_prod_assum ctype in
+  let sign,t = decompose_prod_assum sigma ctype in
   Proofview.tclORELSE
     begin
-      match_with_equation t >>= fun (_,hdcncl,eq) ->
-        let symccl = match eq with
+      match_with_equation sigma t >>= fun (_,hdcncl,eq) ->
+        let symccl =
+          match eq with
           | MonomorphicLeibnizEq (c1,c2) -> mkApp (hdcncl, [| c2; c1 |])
           | PolymorphicLeibnizEq (typ,c1,c2) -> mkApp (hdcncl, [| typ; c2; c1 |])
           | HeterogenousEq (t1,c1,t2,c2) -> mkApp (hdcncl, [| t2; c2; t1; c1 |]) in
-        Tacticals.New.tclTHENS (cut (it_mkProd_or_LetIn symccl sign))
+        Tacticals.New.tclTHENS (cut (EConstr.it_mkProd_or_LetIn symccl sign))
           [ intro_replacing id;
             Tacticals.New.tclTHENLIST [ intros; symmetry; apply (mkVar id); assumption ] ]
     end
@@ -4695,7 +4749,7 @@ let symmetry_in id =
       | NoEquationFound -> Hook.get forward_setoid_symmetry_in id
       | e -> Proofview.tclZERO ~info e
     end
-  end }
+  end
 
 let intros_symmetry =
   Tacticals.New.onClause
@@ -4720,7 +4774,7 @@ let (forward_setoid_transitivity, setoid_transitivity) = Hook.make ()
 
 (* This is probably not very useful any longer *)
 let prove_transitivity hdcncl eq_kind t =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let (eq1,eq2) = match eq_kind with
   | MonomorphicLeibnizEq (c1,c2) ->
       mkApp (hdcncl, [| c1; t|]), mkApp (hdcncl, [| t; c2 |])
@@ -4740,27 +4794,28 @@ let prove_transitivity hdcncl eq_kind t =
 	  [ Tacticals.New.tclDO 2 intro;
 	    Tacticals.New.onLastHyp simplest_case;
 	    assumption ]))
-  end }
+  end
 
 let transitivity_red allowred t =
-  Proofview.Goal.enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   (* PL: usual transitivity don't perform any reduction when searching
      for an equality, but we may need to do some when called back from
      inside setoid_reflexivity (see Optimize cases in setoid_replace.ml). *)
+  let sigma = Tacmach.New.project gl in
   let concl = maybe_betadeltaiota_concl allowred gl in
-  match_with_equation concl >>= fun with_eqn ->
+  match_with_equation sigma concl >>= fun with_eqn ->
   match with_eqn with
   | Some eq_data,_,_ ->
       Tacticals.New.tclTHEN
         (convert_concl_no_check concl DEFAULTcast)
         (match t with
-	  | None -> Tacticals.New.pf_constr_of_global eq_data.trans eapply
-	  | Some t -> Tacticals.New.pf_constr_of_global eq_data.trans (fun trans -> apply_list [trans;t]))
+	  | None -> Tacticals.New.pf_constr_of_global eq_data.trans >>= eapply
+	  | Some t -> Tacticals.New.pf_constr_of_global eq_data.trans >>= fun trans -> apply_list [trans; t])
    | None,eq,eq_kind ->
       match t with
       | None -> Tacticals.New.tclZEROMSG (str"etransitivity not supported for this relation.")
       | Some t -> prove_transitivity eq eq_kind t
-  end }
+  end
 
 let transitivity_gen t =
   Proofview.tclORELSE
@@ -4780,18 +4835,24 @@ let intros_transitivity  n  = Tacticals.New.tclTHEN intros (transitivity_gen n)
    is solved by tac *)
 
 (** d1 is the section variable in the global context, d2 in the goal context *)
-let interpretable_as_section_decl evd d1 d2 =
+let interpretable_as_section_decl env evd d1 d2 =
   let open Context.Named.Declaration in
+  let e_eq_constr_univs sigma c1 c2 = match eq_constr_universes env !sigma c1 c2 with
+  | None -> false
+  | Some cstr ->
+    try ignore (Evd.add_universe_constraints !sigma cstr); true
+    with UniversesDiffer -> false
+  in
   match d2, d1 with
   | LocalDef _, LocalAssum _ -> false
   | LocalDef (_,b1,t1), LocalDef (_,b2,t2) ->
     e_eq_constr_univs evd b1 b2 && e_eq_constr_univs evd t1 t2
-  | LocalAssum (_,t1), d2 -> e_eq_constr_univs evd t1 (get_type d2)
+  | LocalAssum (_,t1), d2 -> e_eq_constr_univs evd t1 (NamedDecl.get_type d2)
 
 let rec decompose len c t accu =
   let open Context.Rel.Declaration in
   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) ->
@@ -4799,7 +4860,8 @@ let rec decompose len c t accu =
   | _ -> assert false
 
 let rec shrink ctx sign c t accu =
-  let open Context.Rel.Declaration in
+  let open Constr in
+  let open CVars in
   match ctx, sign with
   | [], [] -> (c, t, accu)
   | p :: ctx, decl :: sign ->
@@ -4808,11 +4870,11 @@ 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 accu = if is_local_assum p then let open Context.Named.Declaration in
-                                            mkVar (get_id decl) :: accu
-                                       else accu
+        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
     in
     shrink ctx sign c t accu
 | _ -> assert false
@@ -4834,28 +4896,30 @@ let shrink_entry sign const =
   } in
   (const, args)
 
-let abstract_subproof id gk tac =
+let cache_term_by_tactic_then ~opaque ?(goal_type=None) id gk tac tacK =
   let open Tacticals.New in
   let open Tacmach.New in
   let open Proofview.Notations in
-  let open Context.Named.Declaration in
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let current_sign = Global.named_context_val ()
   and global_sign = Proofview.Goal.hyps gl in
-  let sigma = Sigma.to_evar_map sigma in
   let evdref = ref sigma in
   let sign,secsign =
     List.fold_right
       (fun d (s1,s2) ->
-        let id = get_id d in
+        let id = NamedDecl.get_id d in
 	if mem_named_context_val id current_sign &&
-          interpretable_as_section_decl evdref (lookup_named_val id current_sign) d
+          interpretable_as_section_decl env evdref (lookup_named_val id current_sign) d
         then (s1,push_named_context_val d s2)
 	else (Context.Named.add d s1,s2))
       global_sign (Context.Named.empty, empty_named_context_val) in
-  let id = next_global_ident_away id (pf_ids_of_hyps gl) in
-  let concl = it_mkNamedProd_or_LetIn (Proofview.Goal.concl gl) sign 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
+  let concl = it_mkNamedProd_or_LetIn concl sign in
   let concl =
     try flush_and_check_evars !evdref concl
     with Uninstantiated_evar _ ->
@@ -4867,6 +4931,7 @@ let abstract_subproof id gk tac =
     let ctx = Evd.universe_context_set evd in
       evd, ctx, nf concl
   in
+  let concl = EConstr.of_constr concl in
   let solve_tac = tclCOMPLETE (tclTHEN (tclDO (List.length sign) intro) tac) in
   let ectx = Evd.evar_universe_context evd in
   let (const, safe, ectx) =
@@ -4879,12 +4944,10 @@ let abstract_subproof id gk tac =
     let (_, info) = CErrors.push src in
     iraise (e, info)
   in
-  let const, args =
-    if !shrink_abstract then shrink_entry sign const
-    else (const, List.rev (Context.Named.to_instance sign))
-  in
-  let cd = Entries.DefinitionEntry const in
-  let decl = (cd, IsProof Lemma) in
+  let const, args = shrink_entry sign const in
+  let args = List.map EConstr.of_constr args in
+  let cd = Entries.DefinitionEntry { const with Entries.const_entry_opaque = opaque } in
+  let decl = (cd, if opaque then IsProof Lemma else IsDefinition Definition) in
   let cst () =
     (** do not compute the implicit arguments, it may be costly *)
     let () = Impargs.make_implicit_args false in
@@ -4892,8 +4955,21 @@ let abstract_subproof id gk tac =
     Declare.declare_constant ~internal:Declare.InternalTacticRequest ~local:true id decl
   in
   let cst = Impargs.with_implicit_protection cst () in
-  (* let evd, lem = Evd.fresh_global (Global.env ()) evd (ConstRef cst) in *)
-  let lem, ctx = Universes.unsafe_constr_of_global (ConstRef cst) in
+  let lem =
+    match const.Entries.const_entry_universes with
+    | Entries.Polymorphic_const_entry uctx ->
+      let uctx = Univ.ContextSet.of_context uctx in
+      (** Hack: the kernel may generate definitions whose universe variables are
+          not the same as requested in the entry because of constraints delayed
+          in the body, even in polymorphic mode. We mimick what it does for now
+          in hope it is fixed at some point. *)
+      let (_, body_uctx), _ = Future.force const.Entries.const_entry_body in
+      let uctx = Univ.ContextSet.to_context (Univ.ContextSet.union uctx body_uctx) in
+      let u = Univ.UContext.instance uctx in
+      mkConstU (cst, EInstance.make u)
+    | Entries.Monomorphic_const_entry _ ->
+      mkConst cst
+  in
   let evd = Evd.set_universe_context evd ectx in
   let open Safe_typing in
   let eff = private_con_of_con (Global.safe_env ()) cst in
@@ -4901,31 +4977,39 @@ let abstract_subproof id gk tac =
     Entries.(snd (Future.force const.const_entry_body)) in
   let solve =
     Proofview.tclEFFECTS effs <*>
-    exact_no_check (applist (lem, args))
+    tacK lem args
   in
   let tac = if not safe then Proofview.mark_as_unsafe <*> solve else solve in
-  Sigma.Unsafe.of_pair (tac, evd)
-  end }
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd) tac
+  end
+
+let abstract_subproof ~opaque id gk tac =
+  cache_term_by_tactic_then ~opaque id gk tac (fun lem args -> exact_no_check (applist (lem, args)))
 
 let anon_id = Id.of_string "anonymous"
 
-let tclABSTRACT name_op tac =
+let name_op_to_name name_op object_kind suffix =
   let open Proof_global in
-  let default_gk = (Global, false, Proof Theorem) in
-  let s, gk = match name_op with
-    | Some s ->
-      (try let _, gk, _ = current_proof_statement () in s, gk
-       with NoCurrentProof -> s, default_gk)
-    | None   ->
-      let name, gk =
-	try let name, gk, _ = current_proof_statement () in name, gk
-	with NoCurrentProof -> anon_id, default_gk in
-      add_suffix name "_subproof", gk
+  let default_gk = (Global, false, object_kind) in
+  let name, gk = match Proof_global.V82.get_current_initial_conclusions () with
+  | (id, (_, gk)) -> Some id, gk
+  | exception NoCurrentProof -> None, default_gk
   in
-  abstract_subproof s gk tac
+  match name_op with
+  | Some s -> s, gk
+  | None ->
+    let name = Option.default anon_id name in
+    add_suffix name suffix, gk
+
+let tclABSTRACT ?(opaque=true) name_op tac =
+  let s, gk = if opaque
+    then name_op_to_name name_op (Proof Theorem) "_subproof"
+    else name_op_to_name name_op (DefinitionBody Definition) "_subterm" in
+  abstract_subproof ~opaque s gk tac
 
 let unify ?(state=full_transparent_state) x y =
-  Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   try
     let core_flags =
@@ -4938,12 +5022,11 @@ let unify ?(state=full_transparent_state) x y =
       merge_unify_flags = core_flags;
       subterm_unify_flags = { core_flags with modulo_delta = empty_transparent_state } }
     in
-    let sigma = Sigma.to_evar_map sigma in
     let sigma = w_unify (Tacmach.New.pf_env gl) sigma Reduction.CONV ~flags x y in
-    Sigma.Unsafe.of_pair (Proofview.tclUNIT (), sigma)
+    Proofview.Unsafe.tclEVARS sigma
   with e when CErrors.noncritical e ->
-    Sigma.here (Tacticals.New.tclFAIL 0 (str"Not unifiable")) sigma
-  end }
+    Proofview.tclZERO (PretypeError (env, sigma, CannotUnify (x, y, None)))
+  end
 
 module Simple = struct
   (** Simplified version of some of the above tactics *)
@@ -4951,40 +5034,30 @@ module Simple = struct
   let intro x = intro_move (Some x) MoveLast
 
   let apply c =
-    apply_with_bindings_gen false false [None,(Loc.ghost,(c,NoBindings))]
+    apply_with_bindings_gen false false [None,(CAst.make (c,NoBindings))]
   let eapply c =
-    apply_with_bindings_gen false true [None,(Loc.ghost,(c,NoBindings))]
+    apply_with_bindings_gen false true [None,(CAst.make (c,NoBindings))]
   let elim c   = elim false None (c,NoBindings) None
   let case   c = general_case_analysis false None (c,NoBindings)
 
   let apply_in id c =
-    apply_in false false id [None,(Loc.ghost, (c, NoBindings))] None
+    apply_in false false id [None,(CAst.make (c, NoBindings))] None
 
 end
 
 
 (** Tacticals defined directly in term of Proofview *)
 module New = struct
-  open Proofview.Notations
-
-  let exact_proof c = exact_proof c
-
   open Genredexpr
   open Locus
 
   let reduce_after_refine =
-    let onhyps =
-      (** We reduced everywhere in the hyps before 8.6 *)
-      if Flags.version_compare !Flags.compat_version Flags.V8_5 == 0
-      then None
-      else Some []
-    in
     reduce
       (Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true;
 	     rZeta=false;rDelta=false;rConst=[]})
-      {onhyps; concl_occs=AllOccurrences }
+      {onhyps = Some []; concl_occs = AllOccurrences }
 
-  let refine ?unsafe c =
-    Refine.refine ?unsafe c <*>
+  let refine ~typecheck c =
+    Refine.refine ~typecheck c <*>
     reduce_after_refine
 end
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index fb033363..079baa3e 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -1,25 +1,28 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Loc
 open Names
-open Term
+open Constr
+open EConstr
 open Environ
 open Proof_type
 open Evd
 open Clenv
 open Redexpr
 open Globnames
-open Tacexpr
 open Pattern
 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
@@ -28,15 +31,15 @@ open Locus
 
 (** {6 General functions. } *)
 
-val is_quantified_hypothesis : Id.t -> ([`NF],'b) Proofview.Goal.t -> bool
+val is_quantified_hypothesis : Id.t -> Proofview.Goal.t -> bool
 
 (** {6 Primitive tactics. } *)
 
 val introduction    : ?check:bool -> Id.t -> unit Proofview.tactic
 val convert_concl   : ?check:bool -> types -> cast_kind -> unit Proofview.tactic
-val convert_hyp     : ?check:bool -> Context.Named.Declaration.t -> unit Proofview.tactic
+val convert_hyp     : ?check:bool -> named_declaration -> unit Proofview.tactic
 val convert_concl_no_check : types -> cast_kind -> unit Proofview.tactic
-val convert_hyp_no_check : Context.Named.Declaration.t -> unit Proofview.tactic
+val convert_hyp_no_check : named_declaration -> unit Proofview.tactic
 val mutual_fix      :
   Id.t -> int -> (Id.t * int * constr) list -> int -> unit Proofview.tactic
 val fix             : Id.t option -> int -> unit Proofview.tactic
@@ -48,18 +51,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 find_intro_names : Context.Rel.t -> goal sigma -> Id.t list
+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
@@ -74,7 +77,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 -> ([`NF],'b) Proofview.Goal.t -> int
+  bool -> quantified_hypothesis -> Proofview.Goal.t -> int
 
 val intros_until         : quantified_hypothesis -> unit Proofview.tactic
 
@@ -128,14 +131,16 @@ val exact_proof      : Constrexpr.constr_expr -> unit Proofview.tactic
 
 (** {6 Reduction tactics. } *)
 
-type tactic_reduction = env -> evar_map -> constr -> constr
+type tactic_reduction = Reductionops.reduction_function
+type e_tactic_reduction = Reductionops.e_reduction_function
 
-type change_arg = patvar_map -> constr Sigma.run
+type change_arg = patvar_map -> evar_map -> evar_map * constr
 
 val make_change_arg   : constr -> change_arg
 val reduct_in_hyp     : ?check:bool -> tactic_reduction -> hyp_location -> unit Proofview.tactic
 val reduct_option     : ?check:bool -> tactic_reduction * cast_kind -> goal_location -> unit Proofview.tactic
 val reduct_in_concl   : tactic_reduction * cast_kind -> unit Proofview.tactic
+val e_reduct_in_concl   : check:bool -> e_tactic_reduction * cast_kind -> unit Proofview.tactic
 val change_in_concl   : (occurrences * constr_pattern) option -> change_arg -> unit Proofview.tactic
 val change_concl      : constr -> unit Proofview.tactic
 val change_in_hyp     : (occurrences * constr_pattern) option -> change_arg ->
@@ -183,17 +188,17 @@ val revert        : Id.t list -> unit Proofview.tactic
 
 (** {6 Resolution tactics. } *)
 
-val apply_type : constr -> constr list -> unit Proofview.tactic
-val bring_hyps : Context.Named.t -> 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
 val eapply                : constr -> unit Proofview.tactic
 
 val apply_with_bindings_gen :
-  advanced_flag -> evars_flag -> (clear_flag * constr with_bindings located) list -> unit Proofview.tactic
+  advanced_flag -> evars_flag -> (clear_flag * constr with_bindings CAst.t) list -> unit Proofview.tactic
 
 val apply_with_delayed_bindings_gen :
-  advanced_flag -> evars_flag -> (clear_flag * delayed_open_constr_with_bindings located) list -> unit Proofview.tactic
+  advanced_flag -> evars_flag -> (clear_flag * delayed_open_constr_with_bindings CAst.t) list -> unit Proofview.tactic
 
 val apply_with_bindings   : constr with_bindings -> unit Proofview.tactic
 val eapply_with_bindings  : constr with_bindings -> unit Proofview.tactic
@@ -202,16 +207,14 @@ val cut_and_apply         : constr -> unit Proofview.tactic
 
 val apply_in :
   advanced_flag -> evars_flag -> Id.t -> 
-    (clear_flag * constr with_bindings located) list ->
+    (clear_flag * constr with_bindings CAst.t) list ->
     intro_pattern option -> unit Proofview.tactic
 
 val apply_delayed_in :
   advanced_flag -> evars_flag -> Id.t -> 
-    (clear_flag * delayed_open_constr_with_bindings located) list ->
+    (clear_flag * delayed_open_constr_with_bindings CAst.t) list ->
     intro_pattern option -> unit Proofview.tactic
 
-val run_delayed : Environ.env -> evar_map -> 'a delayed_open -> 'a * evar_map
-
 (** {6 Elimination tactics. } *)
 
 (*
@@ -243,15 +246,15 @@ type elim_scheme = {
   elimc: constr with_bindings option;
   elimt: types;
   indref: global_reference option;
-  params: Context.Rel.t;      (** (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  params: rel_context;      (** (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
   nparams: int;               (** number of parameters *)
-  predicates: Context.Rel.t;  (** (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  predicates: rel_context;  (** (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
   npredicates: int;           (** Number of predicates *)
-  branches: Context.Rel.t;    (** branchr,...,branch1 *)
+  branches: rel_context;    (** branchr,...,branch1 *)
   nbranches: int;             (** Number of branches *)
-  args: Context.Rel.t;        (** (xni, Ti_ni) ... (x1, Ti_1) *)
+  args: rel_context;        (** (xni, Ti_ni) ... (x1, Ti_1) *)
   nargs: int;                 (** number of arguments *)
-  indarg: Context.Rel.Declaration.t option;  (** Some (H,I prm1..prmp x1...xni)
+  indarg: rel_declaration option;  (** Some (H,I prm1..prmp x1...xni)
 	  		 	                 if HI is in premisses, None otherwise *)
   concl: types;               (** Qi x1...xni HI (f...), HI and (f...)
 			          are optional and mutually exclusive *)
@@ -259,7 +262,7 @@ type elim_scheme = {
   farg_in_concl: bool;        (** true if (f...) appears at the end of conclusion *)
 }
 
-val compute_elim_sig : ?elimc: constr with_bindings -> types -> elim_scheme
+val compute_elim_sig : evar_map -> ?elimc:constr with_bindings -> types -> elim_scheme
 
 (** elim principle with the index of its inductive arg *)
 type eliminator = {
@@ -271,7 +274,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 ->
@@ -280,8 +283,6 @@ val simplest_elim : constr -> unit Proofview.tactic
 val elim :
   evars_flag -> clear_flag -> constr with_bindings -> constr with_bindings option -> unit Proofview.tactic
 
-val simple_induct : quantified_hypothesis -> unit Proofview.tactic
-
 val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option ->
   constr with_bindings option -> unit Proofview.tactic
 
@@ -290,7 +291,6 @@ val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern optio
 val general_case_analysis : evars_flag -> clear_flag -> constr with_bindings ->  unit Proofview.tactic
 val simplest_case         : constr -> unit Proofview.tactic
 
-val simple_destruct       : quantified_hypothesis -> unit Proofview.tactic
 val destruct : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option ->
   constr with_bindings option -> unit Proofview.tactic
 
@@ -355,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"
@@ -384,8 +384,8 @@ val letin_tac : (bool * intro_pattern_naming) option ->
 
 (** Common entry point for user-level "set", "pose" and "remember" *)
 
-val letin_pat_tac : (bool * intro_pattern_naming) option ->
-  Name.t -> pending_constr -> clause -> unit Proofview.tactic
+val letin_pat_tac : evars_flag -> (bool * intro_pattern_naming) option ->
+  Name.t -> (evar_map * constr) -> clause -> unit Proofview.tactic
 
 (** {6 Generalize tactics. } *)
 
@@ -400,7 +400,9 @@ val generalize_dep  : ?with_let:bool (** Don't lose let bindings *) -> constr  -
 
 val unify           : ?state:Names.transparent_state -> constr -> constr -> unit Proofview.tactic
 
-val tclABSTRACT : Id.t option -> unit Proofview.tactic -> unit Proofview.tactic
+val cache_term_by_tactic_then : opaque:bool -> ?goal_type:(constr option) -> Id.t -> Decl_kinds.goal_kind -> unit Proofview.tactic -> (constr -> constr list -> unit Proofview.tactic) -> unit Proofview.tactic
+
+val tclABSTRACT : ?opaque:bool -> Id.t option -> unit Proofview.tactic -> unit Proofview.tactic
 
 val abstract_generalize : ?generalize_vars:bool -> ?force_dep:bool -> Id.t -> unit Proofview.tactic
 val specialize_eqs : Id.t -> unit Proofview.tactic
@@ -426,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
 
@@ -434,8 +436,8 @@ end
 
 module New : sig
 
-  val refine : ?unsafe:bool -> constr Sigma.run -> unit Proofview.tactic
-  (** [refine ?unsafe c] is [Refine.refine ?unsafe c]
+  val refine : typecheck:bool -> (evar_map -> evar_map * constr) -> unit Proofview.tactic
+  (** [refine ~typecheck c] is [Refine.refine ~typecheck c]
       followed by beta-iota-reduction of the conclusion. *)
 
   val reduce_after_refine : unit Proofview.tactic
diff --git a/tactics/tactics.mllib b/tactics/tactics.mllib
index 09330260..f54ad86a 100644
--- a/tactics/tactics.mllib
+++ b/tactics/tactics.mllib
@@ -16,7 +16,6 @@ Hints
 Auto
 Eauto
 Class_tactics
-Tactic_matching
 Term_dnet
 Eqdecide
 Autorewrite
diff --git a/tactics/term_dnet.ml b/tactics/term_dnet.ml
index e4b45489..753c608a 100644
--- a/tactics/term_dnet.ml
+++ b/tactics/term_dnet.ml
@@ -1,14 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i*)
 open Util
-open Term
+open Constr
 open Names
 open Globnames
 open Mod_subst
@@ -49,7 +51,7 @@ struct
     | DNil
 
   (* debug *)
-  let pr_dconstr f : 'a t -> std_ppcmds = function
+  let _pr_dconstr f : 'a t -> Pp.t = function
     | DRel -> str "*"
     | DSort -> str "Sort"
     | DRef _ -> str "Ref"
@@ -95,13 +97,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 +122,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 +134,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 +143,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 +197,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 +218,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 +283,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 +316,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
@@ -344,18 +370,19 @@ struct
     ) (pr_dconstr pr_term_pattern) p*)
 
   let search_pat cpat dpat dn =
-    let whole_c = cpat in
+    let whole_c = EConstr.of_constr cpat in
     (* if we are at the root, add an empty context *)
     let dpat = under_prod (empty_ctx dpat) in
     TDnet.Idset.fold
       (fun id acc ->
 	 let c_id = Opt.reduce (Ident.constr_of id) in
+	 let c_id = EConstr.of_constr c_id in
 	 let (ctx,wc) =
-	   try Termops.align_prod_letin whole_c c_id
+	   try Termops.align_prod_letin Evd.empty whole_c c_id (** FIXME *)
 	   with Invalid_argument _ -> [],c_id in
 	 let wc,whole_c = if Opt.direction then whole_c,wc else wc,whole_c in
 	 try
-          let _ = Termops.filtering ctx Reduction.CUMUL wc whole_c in
+          let _ = Termops.filtering Evd.empty ctx Reduction.CUMUL wc whole_c in
           id :: acc
 	 with Termops.CannotFilter -> (* msgnl(str"recon "++Termops.print_constr_env (Global.env()) wc); *) acc
       ) (TDnet.find_match dpat dn) []
diff --git a/tactics/term_dnet.mli b/tactics/term_dnet.mli
index fcc03bef..2c748f9c 100644
--- a/tactics/term_dnet.mli
+++ b/tactics/term_dnet.mli
@@ -1,12 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Term
+open Constr
 open Mod_subst
 
 (** Dnets on constr terms.
diff --git a/test-suite/.csdp.cache b/test-suite/.csdp.cache
index ba85286d..b99d80e9 100644
--- a/test-suite/.csdp.cache
+++ b/test-suite/.csdp.cache
diff --git a/test-suite/Makefile b/test-suite/Makefile
index c10cd4ed..85076418 100644
--- a/test-suite/Makefile
+++ b/test-suite/Makefile
@@ -1,10 +1,12 @@
-#######################################################################
-#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
-# <O___,, #     INRIA-Rocquencourt  &  CNRS-Universite Paris Diderot  #
-#   \VV/  #############################################################
-#    //   #      This file is distributed under the terms of the      #
-#         #       GNU Lesser General Public License Version 2.1       #
-#######################################################################
+##########################################################################
+##         #   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          ##
+##         #     (see LICENSE file for the text of the license)         ##
+##########################################################################
 
 # This is a standalone Makefile to run the test-suite. It can be used
 # outside of the Coq source tree (if BIN is overridden).
@@ -27,24 +29,27 @@
 
 # Default value when called from a freshly compiled Coq, but can be
 # easily overridden
-BIN := ../bin/
-LIB := $(shell cd ..; pwd)
+LIB := ..
+BIN := $(shell cd ..; pwd)/bin/
 
-coqtop := $(BIN)coqtop -boot -q -batch -test-mode -R prerequisite TestSuite
-bincoqc := $(BIN)coqc -coqlib $(LIB) -R prerequisite TestSuite
-bincoqchk := $(BIN)coqchk -coqlib $(LIB) -R prerequisite TestSuite
+coqtop := $(BIN)coqtop -coqlib $(LIB) -boot -q -batch -test-mode -R prerequisite TestSuite
+coqc := $(BIN)coqc -coqlib $(LIB) -R prerequisite TestSuite
+coqchk := $(BIN)coqchk -coqlib $(LIB) -R prerequisite TestSuite
+coqdoc := $(BIN)coqdoc
+coqtopbyte := $(BIN)coqtop.byte
 
-command := $(coqtop) -top Top -async-proofs-cache force -load-vernac-source
-coqc := $(coqtop) -compile
+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)
 
 # read out an emacs config and look for coq-prog-args; if such exists, return it
 get_coq_prog_args_helper = sed -n s'/^.*coq-prog-args:[[:space:]]*(\([^)]*\)).*/\1/p' $(1)
-get_coq_prog_args = $(strip $(filter-out "-emacs-U" "-emacs",$(shell $(call get_coq_prog_args_helper,$(1)))))
+get_coq_prog_args = $(strip $(shell $(call get_coq_prog_args_helper,$(1))))
 SINGLE_QUOTE="
 #" # double up on the quotes, in a comment, to appease the emacs syntax highlighter
 # wrap the arguments in parens, but only if they exist
@@ -52,7 +57,7 @@ get_coq_prog_args_in_parens = $(subst $(SINGLE_QUOTE),,$(if $(call get_coq_prog_
 # get the command to use with this set of arguments; if there's -compile, use coqc, else use coqtop
 has_compile_flag = $(filter "-compile",$(call get_coq_prog_args,$(1)))
 has_profile_ltac_or_compile_flag = $(filter "-profile-ltac-cutoff" "-profile-ltac" "-compile",$(call get_coq_prog_args,$(1)))
-get_command_based_on_flags = $(if $(call has_profile_ltac_or_compile_flag,$(1)),$(coqc),$(command))
+get_command_based_on_flags = $(if $(call has_profile_ltac_or_compile_flag,$(1)),$(coqtopcompile),$(coqtopload))
 
 
 bogomips:=
@@ -67,6 +72,7 @@ ifeq (,$(bogomips))
   $(warning cannot run complexity tests (no bogomips found))
 endif
 
+# keep these synced with test-suite/save-logs.sh
 log_success = "==========> SUCCESS <=========="
 log_segfault = "==========> FAILURE <=========="
 log_anomaly = "==========> FAILURE <=========="
@@ -82,14 +88,19 @@ COMPLEXITY := $(if $(bogomips),complexity)
 
 BUGS := bugs/opened bugs/closed
 
+INTERACTIVE := interactive
+
 VSUBSYSTEMS := prerequisite success failure $(BUGS) output \
-  output-modulo-time interactive micromega $(COMPLEXITY) modules stm
+  output-modulo-time $(INTERACTIVE) micromega $(COMPLEXITY) modules stm \
+  coqdoc
 
 # All subsystems
-SUBSYSTEMS := $(VSUBSYSTEMS) misc bugs ide vio coqchk
+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 prerequisite/module_bug8416.v.log \
+  prerequisite/module_bug7192.v.log
 
 #######################################################################
 # Phony targets
@@ -150,6 +161,9 @@ 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`; \
 	  nb_failure=`find . -name '*.log' -exec tail -n2 '{}' \; | grep -e $(log_failure) | wc -l`; \
 	  nb_tests=`expr $$nb_success + $$nb_failure`; \
@@ -162,7 +176,18 @@ summary.log:
 	$(SHOW) BUILDING SUMMARY FILE
 	$(HIDE)$(MAKE) --quiet summary > "$@"
 
+# 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
+endif #APPVEYOR
+
 report: summary.log
+	$(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 "${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
 
 #######################################################################
@@ -219,7 +244,7 @@ $(addsuffix .log,$(wildcard prerequisite/*.v)): %.v.log: %.v
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(coqc) "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
+	  $(coqtopcompile) "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
 	  if [ $$R != 0 ]; then \
 	    echo $(log_failure); \
 	    echo "    $<...could not be prepared" ; \
@@ -249,7 +274,7 @@ $(addsuffix .log,$(wildcard stm/*.v)): %.v.log: %.v
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(coqc) "$<" $(call get_coq_prog_args,"$<") -async-proofs on \
+	  $(coqtopcompile) "$<" $(call get_coq_prog_args,"$<") -async-proofs on \
 	    $$opts 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
@@ -286,7 +311,7 @@ $(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out $(PREREQUISITELOG)
 	    | grep -v "^<W>" \
 	    | sed 's/File "[^"]*"/File "stdin"/' \
 	    > $$tmpoutput; \
-	  diff -u $*.out $$tmpoutput 2>&1; R=$$?; times; \
+	  diff -u --strip-trailing-cr $*.out $$tmpoutput 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -297,6 +322,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){ \
@@ -321,7 +353,7 @@ $(addsuffix .log,$(wildcard output-modulo-time/*.v)): %.v.log: %.v %.out
 		-e 's/\s*[-+]inf\s*//g' \
 		-e 's/^[^a-zA-Z]*//' \
 	       $*.out | sort > $$tmpexpected; \
-	  diff -b -u $$tmpexpected $$tmpoutput 2>&1; R=$$?; times; \
+	  diff  --strip-trailing-cr -b -u $$tmpexpected $$tmpoutput 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -405,79 +437,31 @@ modules/%.vo: modules/%.v
 # Miscellaneous tests
 #######################################################################
 
-misc: misc/deps-order.log misc/universes.log misc/deps-checksum.log
+misc: $(patsubst %.sh,%.log,$(wildcard misc/*.sh))
 
-# Check that both coqdep and coqtop/coqc supports -R
-# Check that both coqdep and coqtop/coqc takes the later -R
-# See bugs 2242, 2337, 2339
-deps-order: misc/deps-order.log
-misc/deps-order.log:
-	@echo "TEST      misc/deps-order"
-	$(HIDE){ \
-	  echo $(call log_intro,deps-order); \
-	  rm -f misc/deps/*/*.vo; \
-	  tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`; \
-	  $(coqdep) -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 \
-	    | head -n 1 > $$tmpoutput; \
-	  diff -u misc/deps/deps.out $$tmpoutput 2>&1; R=$$?; times; \
-	  $(bincoqc) -R misc/deps/lib lib misc/deps/lib/foo.v 2>&1; \
-	  $(bincoqc) -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/foo.v 2>&1; \
-	  $(coqtop) -R misc/deps/lib lib -R misc/deps/client client -load-vernac-source misc/deps/client/bar.v 2>&1; \
-	  S=$$?; times; \
-	  if [ $$R = 0 -a $$S = 0 ]; then \
-	    echo $(log_success); \
-	    echo "    misc/deps-order...Ok"; \
-	  else \
-	    echo $(log_failure); \
-	    echo "    misc/deps-order...Error! (unexpected order)"; \
-	  fi; \
-	  rm $$tmpoutput; \
-	} > "$@"
-
-deps-checksum: misc/deps-checksum.log
-misc/deps-checksum.log:
-	@echo "TEST      misc/deps-checksum"
-	$(HIDE){ \
-	  echo $(call log_intro,deps-checksum); \
-	  rm -f misc/deps/*/*.vo; \
-	  $(bincoqc) -R misc/deps/A A misc/deps/A/A.v; \
-	  $(bincoqc) -R misc/deps/B A misc/deps/B/A.v; \
-	  $(bincoqc) -R misc/deps/B A misc/deps/B/B.v; \
-	  $(coqtop) -R misc/deps/B A -R misc/deps/A A -load-vernac-source misc/deps/checksum.v 2>&1; \
-	  if [ $$? = 0 ]; then \
-	    echo $(log_success); \
-	    echo "    misc/deps-checksum...Ok"; \
-	  else \
-	    echo $(log_failure); \
-	    echo "    misc/deps-checksum...Error!"; \
-	  fi; \
-	} > "$@"
+misc/universes.log: misc/universes/all_stdlib.v
 
+misc/universes/all_stdlib.v:
+	cd .. && $(MAKE) test-suite/$@
 
-# Sort universes for the whole standard library
-EXPECTED_UNIVERSES := 4 # Prop is not counted
-universes: misc/universes.log
-misc/universes.log: misc/universes/all_stdlib.v
-	@echo "TEST      misc/universes"
+$(patsubst %.sh,%.log,$(wildcard misc/*.sh)): %.log: %.sh $(PREREQUISITELOG)
+	@echo "TEST      $<"
 	$(HIDE){ \
-	  $(bincoqc) -R misc/universes Universes misc/universes/all_stdlib 2>&1; \
-	  $(bincoqc) -R misc/universes Universes misc/universes/universes 2>&1; \
-	  mv universes.txt misc/universes; \
-	  N=`awk '{print $$3}' misc/universes/universes.txt | sort -u | wc -l`; \
-	  times; \
-	  if [ "$$N" -eq $(EXPECTED_UNIVERSES) ]; then \
+	  echo $(call log_intro,$<); \
+	  export coqc="$(coqc)"; \
+	  export coqtop="$(coqtop)"; \
+	  export coqdep="$(coqdep)"; \
+	  export coqtopbyte="$(coqtopbyte)"; \
+	  "$<" 2>&1; R=$$?; times; \
+	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
-	    echo "    misc/universes...Ok ($(EXPECTED_UNIVERSES) universes)"; \
+	    echo "    $<...Ok"; \
 	  else \
 	    echo $(log_failure); \
-	    echo "    misc/universes...Error! ($$N/$(EXPECTED_UNIVERSES) universes)"; \
+	    echo "    $<...Error!"; \
 	  fi; \
 	} > "$@"
 
-misc/universes/all_stdlib.v:
-	cd .. && $(MAKE) test-suite/$@
-
-
 # IDE : some tests of backtracking for coqtop -ideslave
 
 ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake))
@@ -486,7 +470,7 @@ ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake))
 	@echo "TEST      $<"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(BIN)fake_ide $< "$(BIN)coqtop -boot -async-proofs on -async-proofs-tactic-error-resilience off -async-proofs-command-error-resilience off" 2>&1; \
+	  $(BIN)fake_ide $< "-coqlib $(LIB) -boot -async-proofs on -async-proofs-tactic-error-resilience off -async-proofs-command-error-resilience off" 2>&1; \
 	  if [ $$? = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -496,14 +480,16 @@ ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake))
 	  fi; \
 	} > "$@"
 
+# vio compilation
+
 vio: $(patsubst %.v,%.vio.log,$(wildcard vio/*.v))
 
 %.vio.log:%.v
 	@echo "TEST      $<"
 	$(HIDE){ \
-	  $(bincoqc) -quick -R vio vio $* 2>&1 && \
+	  $(coqc) -quick -R vio vio $* 2>&1 && \
 	  $(coqtop) -R vio vio -vio2vo $*.vio 2>&1 && \
-	  $(bincoqchk) -R vio vio -norec $(subst /,.,$*) 2>&1; \
+	  $(coqchk) -R vio vio -norec $(subst /,.,$*) 2>&1; \
 	  if [ $$? = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -513,13 +499,15 @@ vio: $(patsubst %.v,%.vio.log,$(wildcard vio/*.v))
 	  fi; \
 	} > "$@"
 
+# coqchk
+
 coqchk: $(patsubst %.v,%.chk.log,$(wildcard coqchk/*.v))
 
 %.chk.log:%.v
 	@echo "TEST      $<"
 	$(HIDE){ \
-	  $(bincoqc) -R coqchk coqchk $* 2>&1 && \
-	  $(bincoqchk) -R coqchk coqchk -norec $(subst /,.,$*) 2>&1; \
+	  $(coqc) -R coqchk coqchk $* 2>&1 && \
+	  $(coqchk) -R coqchk coqchk -norec $(subst /,.,$*) 2>&1; \
 	  if [ $$? = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -528,3 +516,66 @@ coqchk: $(patsubst %.v,%.chk.log,$(wildcard coqchk/*.v))
 	    echo "    $<...Error!"; \
 	  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))
+
+coq-makefile/%.log : coq-makefile/%/run.sh
+	@echo "TEST      coq-makefile/$*"
+	$(HIDE)(\
+	  export COQBIN=$(BIN);\
+	  cd coq-makefile/$* && \
+	  bash run.sh 2>&1; \
+	if [ $$? = 0 ]; then \
+	    echo $(log_success); \
+	    echo "    $<...Ok"; \
+	  else \
+	    echo $(log_failure); \
+	    echo "    $<...Error!"; \
+	  fi; \
+	) > "$@"
+
+# coqdoc
+
+coqdoc: $(patsubst %.sh,%.log,$(wildcard coqdoc/*.sh))
+
+$(addsuffix .log,$(wildcard coqdoc/*.v)): %.v.log: %.v %.html.out %.tex.out $(PREREQUISITELOG)
+	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
+	$(HIDE){ \
+	  echo $(call log_intro,$<); \
+	  $(coqc) -R coqdoc Coqdoc $* 2>&1; \
+	  cd coqdoc; \
+	  f=`basename $*`; \
+	  $(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 \
+	    echo $(log_success); \
+	    echo "    $<...Ok"; \
+	  else \
+	    echo $(log_failure); \
+	    echo "    $<...Error! (unexpected output)"; \
+	  fi; \
+	} > "$@"
diff --git a/test-suite/README.md b/test-suite/README.md
new file mode 100644
index 00000000..1d119564
--- /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/bench/lists-100.v b/test-suite/bench/lists-100.v
deleted file mode 100644
index 5c64716c..00000000
--- a/test-suite/bench/lists-100.v
+++ /dev/null
@@ -1,107 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-Inductive list0 : Set := nil0 : list0 | cons0 : Set -> list0 -> list0.
-Inductive list1 : Set := nil1 : list1 | cons1 : Set -> list1 -> list1.
-Inductive list2 : Set := nil2 : list2 | cons2 : Set -> list2 -> list2.
-Inductive list3 : Set := nil3 : list3 | cons3 : Set -> list3 -> list3.
-Inductive list4 : Set := nil4 : list4 | cons4 : Set -> list4 -> list4.
-Inductive list5 : Set := nil5 : list5 | cons5 : Set -> list5 -> list5.
-Inductive list6 : Set := nil6 : list6 | cons6 : Set -> list6 -> list6.
-Inductive list7 : Set := nil7 : list7 | cons7 : Set -> list7 -> list7.
-Inductive list8 : Set := nil8 : list8 | cons8 : Set -> list8 -> list8.
-Inductive list9 : Set := nil9 : list9 | cons9 : Set -> list9 -> list9.
-Inductive list10 : Set := nil10 : list10 | cons10 : Set -> list10 -> list10.
-Inductive list11 : Set := nil11 : list11 | cons11 : Set -> list11 -> list11.
-Inductive list12 : Set := nil12 : list12 | cons12 : Set -> list12 -> list12.
-Inductive list13 : Set := nil13 : list13 | cons13 : Set -> list13 -> list13.
-Inductive list14 : Set := nil14 : list14 | cons14 : Set -> list14 -> list14.
-Inductive list15 : Set := nil15 : list15 | cons15 : Set -> list15 -> list15.
-Inductive list16 : Set := nil16 : list16 | cons16 : Set -> list16 -> list16.
-Inductive list17 : Set := nil17 : list17 | cons17 : Set -> list17 -> list17.
-Inductive list18 : Set := nil18 : list18 | cons18 : Set -> list18 -> list18.
-Inductive list19 : Set := nil19 : list19 | cons19 : Set -> list19 -> list19.
-Inductive list20 : Set := nil20 : list20 | cons20 : Set -> list20 -> list20.
-Inductive list21 : Set := nil21 : list21 | cons21 : Set -> list21 -> list21.
-Inductive list22 : Set := nil22 : list22 | cons22 : Set -> list22 -> list22.
-Inductive list23 : Set := nil23 : list23 | cons23 : Set -> list23 -> list23.
-Inductive list24 : Set := nil24 : list24 | cons24 : Set -> list24 -> list24.
-Inductive list25 : Set := nil25 : list25 | cons25 : Set -> list25 -> list25.
-Inductive list26 : Set := nil26 : list26 | cons26 : Set -> list26 -> list26.
-Inductive list27 : Set := nil27 : list27 | cons27 : Set -> list27 -> list27.
-Inductive list28 : Set := nil28 : list28 | cons28 : Set -> list28 -> list28.
-Inductive list29 : Set := nil29 : list29 | cons29 : Set -> list29 -> list29.
-Inductive list30 : Set := nil30 : list30 | cons30 : Set -> list30 -> list30.
-Inductive list31 : Set := nil31 : list31 | cons31 : Set -> list31 -> list31.
-Inductive list32 : Set := nil32 : list32 | cons32 : Set -> list32 -> list32.
-Inductive list33 : Set := nil33 : list33 | cons33 : Set -> list33 -> list33.
-Inductive list34 : Set := nil34 : list34 | cons34 : Set -> list34 -> list34.
-Inductive list35 : Set := nil35 : list35 | cons35 : Set -> list35 -> list35.
-Inductive list36 : Set := nil36 : list36 | cons36 : Set -> list36 -> list36.
-Inductive list37 : Set := nil37 : list37 | cons37 : Set -> list37 -> list37.
-Inductive list38 : Set := nil38 : list38 | cons38 : Set -> list38 -> list38.
-Inductive list39 : Set := nil39 : list39 | cons39 : Set -> list39 -> list39.
-Inductive list40 : Set := nil40 : list40 | cons40 : Set -> list40 -> list40.
-Inductive list41 : Set := nil41 : list41 | cons41 : Set -> list41 -> list41.
-Inductive list42 : Set := nil42 : list42 | cons42 : Set -> list42 -> list42.
-Inductive list43 : Set := nil43 : list43 | cons43 : Set -> list43 -> list43.
-Inductive list44 : Set := nil44 : list44 | cons44 : Set -> list44 -> list44.
-Inductive list45 : Set := nil45 : list45 | cons45 : Set -> list45 -> list45.
-Inductive list46 : Set := nil46 : list46 | cons46 : Set -> list46 -> list46.
-Inductive list47 : Set := nil47 : list47 | cons47 : Set -> list47 -> list47.
-Inductive list48 : Set := nil48 : list48 | cons48 : Set -> list48 -> list48.
-Inductive list49 : Set := nil49 : list49 | cons49 : Set -> list49 -> list49.
-Inductive list50 : Set := nil50 : list50 | cons50 : Set -> list50 -> list50.
-Inductive list51 : Set := nil51 : list51 | cons51 : Set -> list51 -> list51.
-Inductive list52 : Set := nil52 : list52 | cons52 : Set -> list52 -> list52.
-Inductive list53 : Set := nil53 : list53 | cons53 : Set -> list53 -> list53.
-Inductive list54 : Set := nil54 : list54 | cons54 : Set -> list54 -> list54.
-Inductive list55 : Set := nil55 : list55 | cons55 : Set -> list55 -> list55.
-Inductive list56 : Set := nil56 : list56 | cons56 : Set -> list56 -> list56.
-Inductive list57 : Set := nil57 : list57 | cons57 : Set -> list57 -> list57.
-Inductive list58 : Set := nil58 : list58 | cons58 : Set -> list58 -> list58.
-Inductive list59 : Set := nil59 : list59 | cons59 : Set -> list59 -> list59.
-Inductive list60 : Set := nil60 : list60 | cons60 : Set -> list60 -> list60.
-Inductive list61 : Set := nil61 : list61 | cons61 : Set -> list61 -> list61.
-Inductive list62 : Set := nil62 : list62 | cons62 : Set -> list62 -> list62.
-Inductive list63 : Set := nil63 : list63 | cons63 : Set -> list63 -> list63.
-Inductive list64 : Set := nil64 : list64 | cons64 : Set -> list64 -> list64.
-Inductive list65 : Set := nil65 : list65 | cons65 : Set -> list65 -> list65.
-Inductive list66 : Set := nil66 : list66 | cons66 : Set -> list66 -> list66.
-Inductive list67 : Set := nil67 : list67 | cons67 : Set -> list67 -> list67.
-Inductive list68 : Set := nil68 : list68 | cons68 : Set -> list68 -> list68.
-Inductive list69 : Set := nil69 : list69 | cons69 : Set -> list69 -> list69.
-Inductive list70 : Set := nil70 : list70 | cons70 : Set -> list70 -> list70.
-Inductive list71 : Set := nil71 : list71 | cons71 : Set -> list71 -> list71.
-Inductive list72 : Set := nil72 : list72 | cons72 : Set -> list72 -> list72.
-Inductive list73 : Set := nil73 : list73 | cons73 : Set -> list73 -> list73.
-Inductive list74 : Set := nil74 : list74 | cons74 : Set -> list74 -> list74.
-Inductive list75 : Set := nil75 : list75 | cons75 : Set -> list75 -> list75.
-Inductive list76 : Set := nil76 : list76 | cons76 : Set -> list76 -> list76.
-Inductive list77 : Set := nil77 : list77 | cons77 : Set -> list77 -> list77.
-Inductive list78 : Set := nil78 : list78 | cons78 : Set -> list78 -> list78.
-Inductive list79 : Set := nil79 : list79 | cons79 : Set -> list79 -> list79.
-Inductive list80 : Set := nil80 : list80 | cons80 : Set -> list80 -> list80.
-Inductive list81 : Set := nil81 : list81 | cons81 : Set -> list81 -> list81.
-Inductive list82 : Set := nil82 : list82 | cons82 : Set -> list82 -> list82.
-Inductive list83 : Set := nil83 : list83 | cons83 : Set -> list83 -> list83.
-Inductive list84 : Set := nil84 : list84 | cons84 : Set -> list84 -> list84.
-Inductive list85 : Set := nil85 : list85 | cons85 : Set -> list85 -> list85.
-Inductive list86 : Set := nil86 : list86 | cons86 : Set -> list86 -> list86.
-Inductive list87 : Set := nil87 : list87 | cons87 : Set -> list87 -> list87.
-Inductive list88 : Set := nil88 : list88 | cons88 : Set -> list88 -> list88.
-Inductive list89 : Set := nil89 : list89 | cons89 : Set -> list89 -> list89.
-Inductive list90 : Set := nil90 : list90 | cons90 : Set -> list90 -> list90.
-Inductive list91 : Set := nil91 : list91 | cons91 : Set -> list91 -> list91.
-Inductive list92 : Set := nil92 : list92 | cons92 : Set -> list92 -> list92.
-Inductive list93 : Set := nil93 : list93 | cons93 : Set -> list93 -> list93.
-Inductive list94 : Set := nil94 : list94 | cons94 : Set -> list94 -> list94.
-Inductive list95 : Set := nil95 : list95 | cons95 : Set -> list95 -> list95.
-Inductive list96 : Set := nil96 : list96 | cons96 : Set -> list96 -> list96.
-Inductive list97 : Set := nil97 : list97 | cons97 : Set -> list97 -> list97.
-Inductive list98 : Set := nil98 : list98 | cons98 : Set -> list98 -> list98.
-Inductive list99 : Set := nil99 : list99 | cons99 : Set -> list99 -> list99.
diff --git a/test-suite/bench/lists_100.v b/test-suite/bench/lists_100.v
deleted file mode 100644
index 5c64716c..00000000
--- a/test-suite/bench/lists_100.v
+++ /dev/null
@@ -1,107 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-Inductive list0 : Set := nil0 : list0 | cons0 : Set -> list0 -> list0.
-Inductive list1 : Set := nil1 : list1 | cons1 : Set -> list1 -> list1.
-Inductive list2 : Set := nil2 : list2 | cons2 : Set -> list2 -> list2.
-Inductive list3 : Set := nil3 : list3 | cons3 : Set -> list3 -> list3.
-Inductive list4 : Set := nil4 : list4 | cons4 : Set -> list4 -> list4.
-Inductive list5 : Set := nil5 : list5 | cons5 : Set -> list5 -> list5.
-Inductive list6 : Set := nil6 : list6 | cons6 : Set -> list6 -> list6.
-Inductive list7 : Set := nil7 : list7 | cons7 : Set -> list7 -> list7.
-Inductive list8 : Set := nil8 : list8 | cons8 : Set -> list8 -> list8.
-Inductive list9 : Set := nil9 : list9 | cons9 : Set -> list9 -> list9.
-Inductive list10 : Set := nil10 : list10 | cons10 : Set -> list10 -> list10.
-Inductive list11 : Set := nil11 : list11 | cons11 : Set -> list11 -> list11.
-Inductive list12 : Set := nil12 : list12 | cons12 : Set -> list12 -> list12.
-Inductive list13 : Set := nil13 : list13 | cons13 : Set -> list13 -> list13.
-Inductive list14 : Set := nil14 : list14 | cons14 : Set -> list14 -> list14.
-Inductive list15 : Set := nil15 : list15 | cons15 : Set -> list15 -> list15.
-Inductive list16 : Set := nil16 : list16 | cons16 : Set -> list16 -> list16.
-Inductive list17 : Set := nil17 : list17 | cons17 : Set -> list17 -> list17.
-Inductive list18 : Set := nil18 : list18 | cons18 : Set -> list18 -> list18.
-Inductive list19 : Set := nil19 : list19 | cons19 : Set -> list19 -> list19.
-Inductive list20 : Set := nil20 : list20 | cons20 : Set -> list20 -> list20.
-Inductive list21 : Set := nil21 : list21 | cons21 : Set -> list21 -> list21.
-Inductive list22 : Set := nil22 : list22 | cons22 : Set -> list22 -> list22.
-Inductive list23 : Set := nil23 : list23 | cons23 : Set -> list23 -> list23.
-Inductive list24 : Set := nil24 : list24 | cons24 : Set -> list24 -> list24.
-Inductive list25 : Set := nil25 : list25 | cons25 : Set -> list25 -> list25.
-Inductive list26 : Set := nil26 : list26 | cons26 : Set -> list26 -> list26.
-Inductive list27 : Set := nil27 : list27 | cons27 : Set -> list27 -> list27.
-Inductive list28 : Set := nil28 : list28 | cons28 : Set -> list28 -> list28.
-Inductive list29 : Set := nil29 : list29 | cons29 : Set -> list29 -> list29.
-Inductive list30 : Set := nil30 : list30 | cons30 : Set -> list30 -> list30.
-Inductive list31 : Set := nil31 : list31 | cons31 : Set -> list31 -> list31.
-Inductive list32 : Set := nil32 : list32 | cons32 : Set -> list32 -> list32.
-Inductive list33 : Set := nil33 : list33 | cons33 : Set -> list33 -> list33.
-Inductive list34 : Set := nil34 : list34 | cons34 : Set -> list34 -> list34.
-Inductive list35 : Set := nil35 : list35 | cons35 : Set -> list35 -> list35.
-Inductive list36 : Set := nil36 : list36 | cons36 : Set -> list36 -> list36.
-Inductive list37 : Set := nil37 : list37 | cons37 : Set -> list37 -> list37.
-Inductive list38 : Set := nil38 : list38 | cons38 : Set -> list38 -> list38.
-Inductive list39 : Set := nil39 : list39 | cons39 : Set -> list39 -> list39.
-Inductive list40 : Set := nil40 : list40 | cons40 : Set -> list40 -> list40.
-Inductive list41 : Set := nil41 : list41 | cons41 : Set -> list41 -> list41.
-Inductive list42 : Set := nil42 : list42 | cons42 : Set -> list42 -> list42.
-Inductive list43 : Set := nil43 : list43 | cons43 : Set -> list43 -> list43.
-Inductive list44 : Set := nil44 : list44 | cons44 : Set -> list44 -> list44.
-Inductive list45 : Set := nil45 : list45 | cons45 : Set -> list45 -> list45.
-Inductive list46 : Set := nil46 : list46 | cons46 : Set -> list46 -> list46.
-Inductive list47 : Set := nil47 : list47 | cons47 : Set -> list47 -> list47.
-Inductive list48 : Set := nil48 : list48 | cons48 : Set -> list48 -> list48.
-Inductive list49 : Set := nil49 : list49 | cons49 : Set -> list49 -> list49.
-Inductive list50 : Set := nil50 : list50 | cons50 : Set -> list50 -> list50.
-Inductive list51 : Set := nil51 : list51 | cons51 : Set -> list51 -> list51.
-Inductive list52 : Set := nil52 : list52 | cons52 : Set -> list52 -> list52.
-Inductive list53 : Set := nil53 : list53 | cons53 : Set -> list53 -> list53.
-Inductive list54 : Set := nil54 : list54 | cons54 : Set -> list54 -> list54.
-Inductive list55 : Set := nil55 : list55 | cons55 : Set -> list55 -> list55.
-Inductive list56 : Set := nil56 : list56 | cons56 : Set -> list56 -> list56.
-Inductive list57 : Set := nil57 : list57 | cons57 : Set -> list57 -> list57.
-Inductive list58 : Set := nil58 : list58 | cons58 : Set -> list58 -> list58.
-Inductive list59 : Set := nil59 : list59 | cons59 : Set -> list59 -> list59.
-Inductive list60 : Set := nil60 : list60 | cons60 : Set -> list60 -> list60.
-Inductive list61 : Set := nil61 : list61 | cons61 : Set -> list61 -> list61.
-Inductive list62 : Set := nil62 : list62 | cons62 : Set -> list62 -> list62.
-Inductive list63 : Set := nil63 : list63 | cons63 : Set -> list63 -> list63.
-Inductive list64 : Set := nil64 : list64 | cons64 : Set -> list64 -> list64.
-Inductive list65 : Set := nil65 : list65 | cons65 : Set -> list65 -> list65.
-Inductive list66 : Set := nil66 : list66 | cons66 : Set -> list66 -> list66.
-Inductive list67 : Set := nil67 : list67 | cons67 : Set -> list67 -> list67.
-Inductive list68 : Set := nil68 : list68 | cons68 : Set -> list68 -> list68.
-Inductive list69 : Set := nil69 : list69 | cons69 : Set -> list69 -> list69.
-Inductive list70 : Set := nil70 : list70 | cons70 : Set -> list70 -> list70.
-Inductive list71 : Set := nil71 : list71 | cons71 : Set -> list71 -> list71.
-Inductive list72 : Set := nil72 : list72 | cons72 : Set -> list72 -> list72.
-Inductive list73 : Set := nil73 : list73 | cons73 : Set -> list73 -> list73.
-Inductive list74 : Set := nil74 : list74 | cons74 : Set -> list74 -> list74.
-Inductive list75 : Set := nil75 : list75 | cons75 : Set -> list75 -> list75.
-Inductive list76 : Set := nil76 : list76 | cons76 : Set -> list76 -> list76.
-Inductive list77 : Set := nil77 : list77 | cons77 : Set -> list77 -> list77.
-Inductive list78 : Set := nil78 : list78 | cons78 : Set -> list78 -> list78.
-Inductive list79 : Set := nil79 : list79 | cons79 : Set -> list79 -> list79.
-Inductive list80 : Set := nil80 : list80 | cons80 : Set -> list80 -> list80.
-Inductive list81 : Set := nil81 : list81 | cons81 : Set -> list81 -> list81.
-Inductive list82 : Set := nil82 : list82 | cons82 : Set -> list82 -> list82.
-Inductive list83 : Set := nil83 : list83 | cons83 : Set -> list83 -> list83.
-Inductive list84 : Set := nil84 : list84 | cons84 : Set -> list84 -> list84.
-Inductive list85 : Set := nil85 : list85 | cons85 : Set -> list85 -> list85.
-Inductive list86 : Set := nil86 : list86 | cons86 : Set -> list86 -> list86.
-Inductive list87 : Set := nil87 : list87 | cons87 : Set -> list87 -> list87.
-Inductive list88 : Set := nil88 : list88 | cons88 : Set -> list88 -> list88.
-Inductive list89 : Set := nil89 : list89 | cons89 : Set -> list89 -> list89.
-Inductive list90 : Set := nil90 : list90 | cons90 : Set -> list90 -> list90.
-Inductive list91 : Set := nil91 : list91 | cons91 : Set -> list91 -> list91.
-Inductive list92 : Set := nil92 : list92 | cons92 : Set -> list92 -> list92.
-Inductive list93 : Set := nil93 : list93 | cons93 : Set -> list93 -> list93.
-Inductive list94 : Set := nil94 : list94 | cons94 : Set -> list94 -> list94.
-Inductive list95 : Set := nil95 : list95 | cons95 : Set -> list95 -> list95.
-Inductive list96 : Set := nil96 : list96 | cons96 : Set -> list96 -> list96.
-Inductive list97 : Set := nil97 : list97 | cons97 : Set -> list97 -> list97.
-Inductive list98 : Set := nil98 : list98 | cons98 : Set -> list98 -> list98.
-Inductive list99 : Set := nil99 : list99 | cons99 : Set -> list99 -> list99.
diff --git a/test-suite/bugs/4623.v b/test-suite/bugs/4623.v
index 405d0980..7ecfd98b 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 a737afcd..f5ce981c 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 00000000..c9e3292b
--- /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/7333.v b/test-suite/bugs/7333.v
new file mode 100644
index 00000000..fba5b902
--- /dev/null
+++ b/test-suite/bugs/7333.v
@@ -0,0 +1,39 @@
+Module Example1.
+
+CoInductive wrap : Type :=
+ | item : unit -> wrap.
+
+Definition extract (t : wrap) : unit :=
+match t with
+| item x => x
+end.
+
+CoFixpoint close u : unit -> wrap :=
+match u with
+| tt => item
+end.
+
+Definition table : wrap := close tt tt.
+
+Eval vm_compute in (extract table).
+Eval vm_compute in (extract table).
+
+End Example1.
+
+Module Example2.
+
+Set Primitive Projections.
+CoInductive wrap : Type :=
+ item { extract : unit }.
+
+CoFixpoint close u : unit -> wrap :=
+match u with
+| tt => item
+end.
+
+Definition table : wrap := close tt tt.
+
+Eval vm_compute in (extract table).
+Eval vm_compute in (extract table).
+
+End Example2.
diff --git a/test-suite/bugs/closed/38.v b/test-suite/bugs/closed/1238.v
index 4fc8d7c9..6b6e8377 100644
--- a/test-suite/bugs/closed/38.v
+++ b/test-suite/bugs/closed/1238.v
@@ -14,7 +14,7 @@ Definition same := fun (l m : liste) => forall (x : A), e x l <-> e x m.
 
 Definition same_refl (x:liste) : (same x x).
   unfold same; split; intros; trivial.
-Save.
+Qed.
 
 Goal forall (x:liste), (same x x).
   intro.
diff --git a/test-suite/bugs/closed/1322.v b/test-suite/bugs/closed/1322.v
index 1ec7d452..6941ade4 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 8c5a3885..8c5a3885 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 00000000..6cafb9f0
--- /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 6be30174..775d278e 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/opened/1501.v b/test-suite/bugs/closed/1501.v
index b36f21da..e771e192 100644
--- a/test-suite/bugs/opened/1501.v
+++ b/test-suite/bugs/closed/1501.v
@@ -3,6 +3,7 @@ Set Implicit Arguments.
 
 Require Export Relation_Definitions.
 Require Export Setoid.
+Require Import Morphisms.
 
 
 Section Essais.
@@ -40,57 +41,27 @@ Parameter
 
 Hint Resolve equiv_refl equiv_sym equiv_trans: monad.
 
-Instance equiv_rel A: Equivalence (@equiv A).
-Proof.
- constructor.
- intros xa; apply equiv_refl.
- intros xa xb; apply equiv_sym.
- intros xa xb xc; apply equiv_trans.
-Defined.
-
-Definition fequiv (A B: Type)  (f g: A -> K B) := forall (x:A), (equiv (f x) (g
-x)).
-
-Lemma fequiv_refl : forall (A B: Type) (f : A -> K B), fequiv f f.
-Proof.
-  unfold fequiv; auto with monad.
-Qed.
-
-Lemma fequiv_sym : forall (A B: Type) (x y : A -> K B), fequiv x y -> fequiv y
-x.
-Proof.
-  unfold fequiv; auto with monad.
-Qed.
+Add Parametric Relation A : (K A) (@equiv A)
+    reflexivity proved by (@equiv_refl A)
+    symmetry proved by (@equiv_sym A)
+    transitivity proved by (@equiv_trans A)
+      as equiv_rel.
 
-Lemma fequiv_trans : forall (A B: Type) (x y z : A -> K B), fequiv x y ->
-fequiv
-y z -> fequiv x z.
+Add Parametric Morphism A B : (@bind A B)
+    with signature (@equiv A) ==> (pointwise_relation A (@equiv B)) ==> (@equiv B)
+      as bind_mor.
 Proof.
-  unfold fequiv; intros; eapply equiv_trans; auto with monad.
-Qed.
-
-Instance fequiv_re A B: Equivalence (@fequiv A B).
-Proof.
- constructor.
- intros f; apply fequiv_refl.
- intros f g; apply fequiv_sym.
- intros f g h; apply fequiv_trans.
-Defined.
-
-Instance bind_mor A B: Morphisms.Proper (@equiv _ ==> @fequiv _ _ ==> @equiv _) (@bind A B).
-Proof.
- unfold fequiv; intros x y xy_equiv f g fg_equiv; apply bind_compat; auto.
+  unfold pointwise_relation; intros; apply bind_compat; auto.
 Qed.
 
 Lemma test:
   forall (A B: Type) (m1 m2 m3: K A) (f: A -> A -> K B),
- (equiv m1 m2) -> (equiv m2 m3) ->
-   equiv (bind m1 (fun a => bind m2 (fun a' => f a a')))
-         (bind m2 (fun a => bind m3 (fun a' => f a a'))).
+    (equiv m1 m2) -> (equiv m2 m3) ->
+    equiv (bind m1 (fun a => bind m2 (fun a' => f a a')))
+          (bind m2 (fun a => bind m3 (fun a' => f a a'))).
 Proof.
   intros A B m1 m2 m3 f H1 H2.
   setoid_rewrite H1. (* this works *)
-  Fail setoid_rewrite H2.
-Abort.
-(*  trivial by equiv_refl.
-Qed.*)
+  setoid_rewrite H2.
+  reflexivity.
+Qed.
diff --git a/test-suite/bugs/closed/328.v b/test-suite/bugs/closed/1542.v
index 52cfbbc4..52cfbbc4 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 def6ed98..def6ed98 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 9ef796fa..9ef796fa 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 166fa7a9..166fa7a9 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 28cc5cb1..48f0b551 100644
--- a/test-suite/bugs/closed/348.v
+++ b/test-suite/bugs/closed/1551.v
@@ -9,5 +9,5 @@ End D.
 
 Module D' (M:S).
   Import M.
-  Definition empty:Set. exact nat. Save.
+  Definition empty:Set. exact nat. Qed.
 End D'.
diff --git a/test-suite/bugs/closed/545.v b/test-suite/bugs/closed/1584.v
index 926af7dd..926af7dd 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 c2926a2b..ef52c876 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/1859.v b/test-suite/bugs/closed/1859.v
new file mode 100644
index 00000000..43acfe4b
--- /dev/null
+++ b/test-suite/bugs/closed/1859.v
@@ -0,0 +1,20 @@
+Require Import Ring.
+Require Import ArithRing.
+
+Ltac ring_simplify_neq :=
+  match goal with
+  | [ H: ?X <> ?Y |- _ ] => progress ring_simplify X Y in H
+  end.
+
+Lemma toto : forall x y, x*1 <> y*1 -> y*1 <> x*1 -> x<>y.
+Proof.
+  intros.
+  ring_simplify_neq.
+  ring_simplify_neq.
+  (* make sure ring_simplify has simplified both hypotheses *)
+  match goal with
+  | [ H: context[_*1] |- _ ] => fail 1
+  | _ => idtac
+  end.
+  auto.
+Qed.
diff --git a/test-suite/bugs/closed/1900.v b/test-suite/bugs/closed/1900.v
index cf03efda..6eea5db0 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 7d86adbf..98e017f9 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 8c81d751..3b8a3d2f 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 7e62437d..2b0aed8c 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 5e61529b..7b430ace 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 a6b0fee5..37b0dde0 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/2001.v b/test-suite/bugs/closed/2001.v
index d0b3bf17..652c6570 100644
--- a/test-suite/bugs/closed/2001.v
+++ b/test-suite/bugs/closed/2001.v
@@ -7,7 +7,7 @@ Inductive T : Set :=
 | v : T.
 
 Definition f (s:nat) (t:T) : nat.
-fix 2.
+fix f 2.
 intros s t.
 refine
   match t with
diff --git a/test-suite/bugs/closed/2027.v b/test-suite/bugs/closed/2027.v
index fb53c6ef..ebc2bc07 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 d2b926f3..2fcfbe40 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 6c2023ab..b1f54b17 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 941ae530..22e33c8e 100644
--- a/test-suite/bugs/closed/2141.v
+++ b/test-suite/bugs/closed/2141.v
@@ -1,3 +1,4 @@
+Require Coq.extraction.Extraction.
 Require Import FSetList.
 Require Import OrderedTypeEx.
 
@@ -10,5 +11,6 @@ End FSetHide.
 
 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/2245.v b/test-suite/bugs/closed/2245.v
new file mode 100644
index 00000000..f0162f3b
--- /dev/null
+++ b/test-suite/bugs/closed/2245.v
@@ -0,0 +1,11 @@
+Module Type Test.
+
+Section Sec.
+Variables (A:Type).
+Context (B:Type).
+End Sec.
+
+Fail Check B. (* used to be found !!! *)
+Fail Check A.
+
+End Test.
diff --git a/test-suite/bugs/closed/2281.v b/test-suite/bugs/closed/2281.v
index 40948d90..8f549b92 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 7fae3287..14a3e5a7 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 e06fb975..73d95e91 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/2378.v b/test-suite/bugs/closed/2378.v
index 85ad41d1..23a58501 100644
--- a/test-suite/bugs/closed/2378.v
+++ b/test-suite/bugs/closed/2378.v
@@ -505,8 +505,6 @@ Qed.
 Require Export Coq.Logic.FunctionalExtensionality.
 Print PLanguage.
 
-Unset Standard Proposition Elimination Names.
-
 Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr): 
 Transformation (PLanguage l1) (PLanguage l2) :=
   mkTransformation (PLanguage l1) (PLanguage l2)
diff --git a/test-suite/bugs/closed/2417.v b/test-suite/bugs/closed/2417.v
new file mode 100644
index 00000000..b2f00ffc
--- /dev/null
+++ b/test-suite/bugs/closed/2417.v
@@ -0,0 +1,15 @@
+Parameter x y : nat.
+Axiom H : x = y.
+Hint Rewrite H : mybase.
+
+Ltac bar base := autorewrite with base.
+
+Tactic Notation "foo" ident(base) := autorewrite with base.
+
+Goal x = 0.
+  bar mybase.
+  now_show (y = 0).
+  Undo 2.
+  foo mybase.
+  now_show (y = 0).
+Abort.
diff --git a/test-suite/bugs/opened/2456.v b/test-suite/bugs/closed/2456.v
index 6cca5c9f..de28c7f4 100644
--- a/test-suite/bugs/opened/2456.v
+++ b/test-suite/bugs/closed/2456.v
@@ -50,4 +50,9 @@ Fail dependent destruction commute1;
 dependent destruction catchCommuteDetails;
 dependent destruction commute2;
 dependent destruction catchCommuteDetails generalizing X.
-Admitted.
+revert X.
+dependent destruction commute1;
+dependent destruction catchCommuteDetails;
+dependent destruction commute2;
+dependent destruction catchCommuteDetails.
+Abort.
diff --git a/test-suite/bugs/closed/2464.v b/test-suite/bugs/closed/2464.v
index af708587..b9db3035 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 fb676c7e..0e7c0c25 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 a5f4ae64..ef2e4e35 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 7e02e7f1..e57bcc25 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 f0744788..29c8ac16 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 38c1cfc8..26c0f334 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/2640.v b/test-suite/bugs/closed/2640.v
deleted file mode 100644
index da0cc68a..00000000
--- a/test-suite/bugs/closed/2640.v
+++ /dev/null
@@ -1,17 +0,0 @@
-(* Testing consistency of globalization and interpretation in some
-   extreme cases *)
-
-Section sect.
-
-  (* Simplification of the initial example *)
-  Hypothesis Other: True.
-
-  Lemma C2 : True.
-  proof.
-  Fail have True using Other.
-  Abort.
-
-  (* Variant of the same problem *)
-  Lemma C2 : True.
-  Fail clear; Other.
-  Abort.
diff --git a/test-suite/bugs/closed/2668.v b/test-suite/bugs/closed/2668.v
index 74c8fa34..d5bbfd3f 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 826361be..3210214e 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 fc580f10..9d65e51f 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/2800.v b/test-suite/bugs/closed/2800.v
index 2ee43893..54c75e34 100644
--- a/test-suite/bugs/closed/2800.v
+++ b/test-suite/bugs/closed/2800.v
@@ -4,3 +4,16 @@ intuition
   match goal with
   | |- _ => idtac " foo"
   end.
+
+  lazymatch goal with _ => idtac end.
+  match goal with _ => idtac end.
+  unshelve lazymatch goal with _ => idtac end.
+  unshelve match goal with _ => idtac end.
+  unshelve (let x := I in idtac).
+Abort.
+
+Require Import ssreflect.
+
+Goal True.
+match goal with _ => idtac end => //.
+Qed.
diff --git a/test-suite/bugs/opened/2814.v b/test-suite/bugs/closed/2814.v
index a740b438..99da1e3e 100644
--- a/test-suite/bugs/opened/2814.v
+++ b/test-suite/bugs/closed/2814.v
@@ -3,3 +3,4 @@ Require Import Program.
 Goal forall (x : Type) (f g : Type -> Type) (H : f x ~= g x), False.
   intros.
   Fail induction H.
+Abort.
diff --git a/test-suite/bugs/closed/2837.v b/test-suite/bugs/closed/2837.v
index 5d984463..52a56c2c 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 828e3b8c..e2346303 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/2850.v b/test-suite/bugs/closed/2850.v
deleted file mode 100644
index 64a93aeb..00000000
--- a/test-suite/bugs/closed/2850.v
+++ /dev/null
@@ -1,2 +0,0 @@
-Definition id {A} (x : A) := x.
-Fail Compute id.
diff --git a/test-suite/bugs/closed/2881.v b/test-suite/bugs/closed/2881.v
new file mode 100644
index 00000000..b4f09305
--- /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 45e24b5f..11fd7bad 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 15598352..ad763509 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 ba3acd08..b6c5b6df 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 3f3a979a..1979eda8 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/3036.v b/test-suite/bugs/closed/3036.v
index 451bec9b..3b57310d 100644
--- a/test-suite/bugs/closed/3036.v
+++ b/test-suite/bugs/closed/3036.v
@@ -15,11 +15,11 @@ Definition perm := Qc.
 Locate Qle_bool.
 
 Definition compatibleb (p1 p2 : perm) : bool :=
-let p1pos := Qle_bool 00 p1 in
-  let p2pos := Qle_bool 00 p2 in
+let p1pos := Qle_bool 0 p1 in
+  let p2pos := Qle_bool 0 p2 in
     negb (
          (p1pos && p2pos)
-      || ((p1pos || p2pos) && (negb (Qle_bool 00 ((p1 + p2)%Qc)))))%Qc.
+      || ((p1pos || p2pos) && (negb (Qle_bool 0 ((p1 + p2)%Qc)))))%Qc.
 
 Definition compatible (p1 p2 : perm) := compatibleb p1 p2 = true.
 
diff --git a/test-suite/bugs/closed/3080.v b/test-suite/bugs/closed/3080.v
index 7d0dc090..36ab7ff5 100644
--- a/test-suite/bugs/closed/3080.v
+++ b/test-suite/bugs/closed/3080.v
@@ -1,4 +1,4 @@
-(* -*- coq-prog-args: ("-emacs" "-nois") -*- *)
+(* -*- coq-prog-args: ("-nois") -*- *)
 Delimit Scope type_scope with type.
 Delimit Scope function_scope with function.
 
diff --git a/test-suite/bugs/opened/3100.v b/test-suite/bugs/closed/3100.v
index 6f35a74d..6f35a74d 100644
--- a/test-suite/bugs/opened/3100.v
+++ b/test-suite/bugs/closed/3100.v
diff --git a/test-suite/bugs/closed/3125.v b/test-suite/bugs/closed/3125.v
new file mode 100644
index 00000000..79714617
--- /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/opened/3230.v b/test-suite/bugs/closed/3230.v
index 265310b1..265310b1 100644
--- a/test-suite/bugs/opened/3230.v
+++ b/test-suite/bugs/closed/3230.v
diff --git a/test-suite/bugs/closed/3287.v b/test-suite/bugs/closed/3287.v
index 7c781312..4b3e7ff0 100644
--- a/test-suite/bugs/closed/3287.v
+++ b/test-suite/bugs/closed/3287.v
@@ -1,9 +1,12 @@
+Require Coq.extraction.Extraction.
+
 Module Foo.
 (* Definition foo := (I,I). *)
 Definition bar := true.
 End Foo.
 
 Recursive Extraction Foo.bar.
+Extraction TestCompile Foo.bar.
 
 Module Foo'.
 Definition foo := (I,I).
@@ -11,10 +14,6 @@ Definition bar := true.
 End Foo'.
 
 Recursive Extraction Foo'.bar.
+Extraction TestCompile Foo'.bar.
 
-Module Foo''.
-Definition foo := (I,I).
-Definition bar := true.
-End Foo''.
-
-Extraction Foo.bar.
+Extraction Foo'.bar.
diff --git a/test-suite/bugs/closed/3319.v b/test-suite/bugs/closed/3319.v
index 3b37e39e..fbf5d86d 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/opened/3320.v b/test-suite/bugs/closed/3320.v
index 05cf7328..a5c243d8 100644
--- a/test-suite/bugs/opened/3320.v
+++ b/test-suite/bugs/closed/3320.v
@@ -1,4 +1,5 @@
 Goal forall x : nat, True.
-  fix 1.
+  fix goal 1.
   assumption.
 Fail Qed.
+Undo.
diff --git a/test-suite/bugs/closed/3323.v b/test-suite/bugs/closed/3323.v
index 22b1603b..4622634e 100644
--- a/test-suite/bugs/closed/3323.v
+++ b/test-suite/bugs/closed/3323.v
@@ -1,5 +1,5 @@
 Require Import TestSuite.admit.
-(* -*- coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- coq-prog-args: ("-indices-matter") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 297 lines to 117 lines, then from 95 lines to 79 lines, then from 82 lines to 68 lines *)
 
 Set Universe Polymorphism.
diff --git a/test-suite/bugs/closed/3330.v b/test-suite/bugs/closed/3330.v
index e3b5e943..672fb3f1 100644
--- a/test-suite/bugs/closed/3330.v
+++ b/test-suite/bugs/closed/3330.v
@@ -41,6 +41,8 @@ Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function
 
 Open Scope function_scope.
 
+Set Printing Universes. Set Printing All.
+
 Inductive paths {A : Type} (a : A) : A -> Type :=
   idpath : paths a a.
 
@@ -156,7 +158,8 @@ Delimit Scope morphism_scope with morphism.
 
 Delimit Scope category_scope with category.
 Delimit Scope object_scope with object.
-
+Set Printing Universes.
+Set Printing All.
 Record PreCategory :=
   Build_PreCategory' {
       object :> Type;
@@ -1069,7 +1072,7 @@ Section Adjunction.
   Variable F : Functor C D.
   Variable G : Functor D C.
 
-  Let Adjunction_Type := 
+ Let Adjunction_Type := 
     Eval simpl in (hom_functor D) o (F^op, 1) <~=~> (hom_functor C) o (1, G).
 
   Record AdjunctionHom :=
diff --git a/test-suite/bugs/closed/3331.v b/test-suite/bugs/closed/3331.v
index 9cd44bd0..b7dbb290 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/3332.v b/test-suite/bugs/closed/3332.v
index d86470cd..a3564bfc 100644
--- a/test-suite/bugs/closed/3332.v
+++ b/test-suite/bugs/closed/3332.v
@@ -1,4 +1,4 @@
-(* -*- coq-prog-args: ("-emacs" "-time") -*- *)
+(* -*- coq-prog-args: ("-time") -*- *)
 Definition foo : True.
 Proof.
 Abort. (* Toplevel input, characters 15-21:
diff --git a/test-suite/bugs/closed/3346.v b/test-suite/bugs/closed/3346.v
index 638404f2..09bd7893 100644
--- a/test-suite/bugs/closed/3346.v
+++ b/test-suite/bugs/closed/3346.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 Monomorphic Inductive paths (A : Type) (a : A) : A -> Type := idpath : paths A a a.
 (* This should fail with -indices-matter *)
 Fail Check paths nat O O : Prop.
diff --git a/test-suite/bugs/closed/3348.v b/test-suite/bugs/closed/3348.v
index d9ac09d8..904de689 100644
--- a/test-suite/bugs/closed/3348.v
+++ b/test-suite/bugs/closed/3348.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 Set Universe Polymorphism.
 Set Printing Universes.
 Inductive Empty : Set := .
diff --git a/test-suite/bugs/closed/3350.v b/test-suite/bugs/closed/3350.v
index c041c401..c1ff292b 100644
--- a/test-suite/bugs/closed/3350.v
+++ b/test-suite/bugs/closed/3350.v
@@ -55,7 +55,7 @@ Lemma lower_ind (P: forall n (p i:Fin.t (S n)), option (Fin.t n) -> Prop)
                 P (S n) (Fin.FS p) (Fin.FS i) None) :
   forall n (p i:Fin.t (S n)), P n p i (lower p i).
 Proof.
-  fix 2. intros n p.
+  fix lower_ind 2. intros n p.
   refine (match p as p1 in Fin.t (S n1)
                 return forall (i1:Fin.t (S n1)), P n1 p1 i1 (lower p1 i1)
           with
diff --git a/test-suite/bugs/closed/3352.v b/test-suite/bugs/closed/3352.v
index f8113e4c..bf2f7a9d 100644
--- a/test-suite/bugs/closed/3352.v
+++ b/test-suite/bugs/closed/3352.v
@@ -20,7 +20,7 @@ while it is expected to have type "IsHProp (* Top.17 *) Empty"
 Defined.
 
 Module B.
-(* -*- coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- coq-prog-args: ("-indices-matter") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 7725 lines to 78 lines, then from 51 lines to 13 lines *)
 Set Universe Polymorphism.
 Inductive paths {A} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope.
@@ -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/3375.v b/test-suite/bugs/closed/3375.v
index d7ce02ea..1e0c8e61 100644
--- a/test-suite/bugs/closed/3375.v
+++ b/test-suite/bugs/closed/3375.v
@@ -1,5 +1,5 @@
 Require Import TestSuite.admit.
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-impredicative-set") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-impredicative-set") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 5968 lines to 11933 lines, then from 11239 lines to 11231 lines, then from 10365 lines to 446 lines, then from 456 lines to 379 lines, then from 391 lines to 373 lines, then from 369 lines to 351 lines, then from 350 lines to 340 lines, then from 348 lines to 320 lines, then from 328 lines to 302 lines, then from 330 lines to 45 lines *)
 
 Set Universe Polymorphism.
diff --git a/test-suite/bugs/closed/3387.v b/test-suite/bugs/closed/3387.v
index cb435e78..1d9e7833 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 3a598695..a03db775 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/3393.v b/test-suite/bugs/closed/3393.v
index f7ab5f76..ae8e41e2 100644
--- a/test-suite/bugs/closed/3393.v
+++ b/test-suite/bugs/closed/3393.v
@@ -1,5 +1,5 @@
 Require Import TestSuite.admit.
-(* -*- coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- coq-prog-args: ("-indices-matter") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 8760 lines to 7519 lines, then from 7050 lines to 909 lines, then from 846 lines to 578 lines, then from 497 lines to 392 lines, then from 365 lines to 322 lines, then from 252 lines to 205 lines, then from 215 lines to 204 lines, then from 210 lines to 182 lines, then from 175 lines to 157 lines *)
 Set Universe Polymorphism.
 Axiom admit : forall {T}, T.
diff --git a/test-suite/bugs/closed/3402.v b/test-suite/bugs/closed/3402.v
index ed47ec82..b4705780 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/3427.v b/test-suite/bugs/closed/3427.v
index 374a5392..9a57ca77 100644
--- a/test-suite/bugs/closed/3427.v
+++ b/test-suite/bugs/closed/3427.v
@@ -1,5 +1,5 @@
 Require Import TestSuite.admit.
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 0 lines to 7171 lines, then from 7184 lines to 558 lines, then from 556 lines to 209 lines *)
 Generalizable All Variables.
 Set Universe Polymorphism.
diff --git a/test-suite/bugs/closed/3428.v b/test-suite/bugs/closed/3428.v
index 3eb75e43..16ace90a 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 1ea24bf1..e8c2d8b8 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 50d29780..ddfb3394 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 dce73e1a..8a0c98c3 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 e9414864..3ed63604 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 a81837e7..35e0c51a 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/3481.v b/test-suite/bugs/closed/3481.v
index 89d476dc..38f03b16 100644
--- a/test-suite/bugs/closed/3481.v
+++ b/test-suite/bugs/closed/3481.v
@@ -3,7 +3,7 @@ Set Implicit Arguments.
 
 Require Import Logic.
 Module NonPrim.
-Local Set Record Elimination Schemes.
+Local Set Nonrecursive Elimination Schemes.
 Record prodwithlet (A B : Type) : Type :=
   pair' { fst : A; fst' := fst; snd : B }.
 
@@ -21,7 +21,7 @@ End NonPrim.
 
 Global Set Universe Polymorphism.
 Global Set Asymmetric Patterns.
-Local Set Record Elimination Schemes.
+Local Set Nonrecursive Elimination Schemes.
 Local Set Primitive Projections.
 
 Record prod (A B : Type) : Type :=
diff --git a/test-suite/bugs/closed/3482.v b/test-suite/bugs/closed/3482.v
index 34a5e73d..87fd2723 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 dc88a332..a0e15730 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 9ed0926a..1f0f3b0d 100644
--- a/test-suite/bugs/closed/3513.v
+++ b/test-suite/bugs/closed/3513.v
@@ -69,26 +69,6 @@ Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred)
     refine (P _ _)
   end; unfold Basics.flip.
   Focus 2.
-  Set Typeclasses Debug.
-  Set Typeclasses Legacy Resolution.
-  apply reflexivity.
-  (* Debug: 1.1: apply @IsPointed_catOP on
-(IsPointed (exists x0 : Actions, (catOP ?Goal O2 : OPred) x0))
-Debug: 1.1.1.1: apply OPred_inhabited on (IsPointed (exists x0 : Actions, ?Goal x0))
-Debug: 1.1.2.1: apply OPred_inhabited on (IsPointed (exists x : Actions, O2 x))
-Debug: 2.1: apply @Equivalence_Reflexive on (Reflexive lentails)
-Debug: 2.1.1: no match for (Equivalence lentails) , 5 possibilities
-Debug: Backtracking after apply @Equivalence_Reflexive
-Debug: 2.2: apply @PreOrder_Reflexive on (Reflexive lentails)
-Debug: 2.2.1.1: apply @lentailsPre on (PreOrder lentails)
-Debug: 2.2.1.1.1.1: apply ILFun_ILogic on (ILogic OPred)
-*)
-  Undo. Unset Typeclasses Legacy Resolution.
-  Test Typeclasses Unique Solutions.
-  Test Typeclasses Unique Instances.
-  Show Existentials.
-  Set Typeclasses Debug Verbosity 2.
-  Set Printing All.
   (* As in 8.5, allow a shelved subgoal to remain *)
   apply reflexivity.
-  
\ No newline at end of file
+  
diff --git a/test-suite/bugs/closed/3520.v b/test-suite/bugs/closed/3520.v
index c981207e..ea122e52 100644
--- a/test-suite/bugs/closed/3520.v
+++ b/test-suite/bugs/closed/3520.v
@@ -3,7 +3,7 @@ Set Primitive Projections.
 Record foo (A : Type) := 
   { bar : Type ; baz := Set; bad : baz = bar }.
 
-Set Record Elimination Schemes.
+Set Nonrecursive Elimination Schemes.
 
 Record notprim : Prop :=
   { irrel : True; relevant : nat }.
diff --git a/test-suite/bugs/closed/3531.v b/test-suite/bugs/closed/3531.v
index 764a7334..3502b4f5 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/3539.v b/test-suite/bugs/closed/3539.v
index d258bb31..b0c4b237 100644
--- a/test-suite/bugs/closed/3539.v
+++ b/test-suite/bugs/closed/3539.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 11678 lines to 11330 lines, then from 10721 lines to 9544 lines, then from 9549 lines to 794 lines, then from 810 lines to 785 lines, then from 628 lines to 246 lines, then from 220 lines to 89 lines, then from 80 lines to 47 lines *)
 (* coqc version trunk (August 2014) compiled on Aug 22 2014 4:17:28 with OCaml 4.01.0
    coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (a67cc6941434124465f20b14a1256f2ede31a60e) *)
diff --git a/test-suite/bugs/closed/3559.v b/test-suite/bugs/closed/3559.v
index da12b686..5210b270 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 65ce4fb6..a740675f 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 f6cbc929..ef4422ee 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 cb16b3ae..00c9c054 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 3d4660b4..37fe4637 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 3ef9270d..9fded85a 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 d1aae7b4..1f86f4bd 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 49dd7be5..1ee9a5d8 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/3612.v b/test-suite/bugs/closed/3612.v
index a5476850..33e5d532 100644
--- a/test-suite/bugs/closed/3612.v
+++ b/test-suite/bugs/closed/3612.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter" "-nois") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter" "-nois") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 3595 lines to 3518 lines, then from 3133 lines to 2950 lines, then from 2911 lines to 415 lines, then from 431 lines to 407 \
 lines, then from 421 lines to 428 lines, then from 444 lines to 429 lines, then from 434 lines to 66 lines, then from 163 lines to 48 lines *)
 (* coqc version trunk (September 2014) compiled on Sep 11 2014 14:48:8 with OCaml 4.01.0
@@ -38,7 +38,9 @@ Axiom path_path_sigma : forall {A : Type} (P : A -> Type) (u v : sigT P)
            (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2),
 p = q.
 
-Declare ML Module "coretactics".
+Declare ML Module "ltac_plugin".
+
+Set Default Proof Mode "Classic".
 
 Goal forall (A : Type) (B : forall _ : A, Type) (x : @sigT A (fun x : A => B x))
             (xx : @paths (@sigT A (fun x0 : A => B x0)) x x),
diff --git a/test-suite/bugs/closed/3618.v b/test-suite/bugs/closed/3618.v
index dc560ad5..674b4cc2 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 a05d5eb2..024243cf 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 6a952377..52bb3072 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 70144174..5441fbed 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 bdbfbb15..5dff98ba 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 f47f64ea..730ab3f4 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 ba6006ed..58aa1614 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/3649.v b/test-suite/bugs/closed/3649.v
index fc4c171e..a664a1ef 100644
--- a/test-suite/bugs/closed/3649.v
+++ b/test-suite/bugs/closed/3649.v
@@ -1,8 +1,9 @@
-(* -*- coq-prog-args: ("-emacs" "-nois") -*- *)
+(* -*- coq-prog-args: ("-nois") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 9518 lines to 404 lines, then from 410 lines to 208 lines, then from 162 lines to 77 lines *)
 (* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0
    coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *)
-Declare ML Module "coretactics".
+Declare ML Module "ltac_plugin".
+Set Default Proof Mode "Classic".
 Reserved Notation "x -> y" (at level 99, right associativity, y at level 200).
 Reserved Notation "x = y" (at level 70, no associativity).
 Delimit Scope type_scope with type.
@@ -12,7 +13,6 @@ Axiom admit : forall {T}, T.
 Notation "A -> B" := (forall (_ : A), B) : type_scope.
 Reserved Infix "o" (at level 40, left associativity).
 Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope.
-Ltac constr_eq a b := let test := constr:(@idpath _ _ : a = b) in idtac.
 Global Set Primitive Projections.
 Delimit Scope morphism_scope with morphism.
 Record PreCategory :=
diff --git a/test-suite/bugs/closed/3658.v b/test-suite/bugs/closed/3658.v
index 622c3c94..74f4e82d 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 fdca49bc..1f13ffcf 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/3662.v b/test-suite/bugs/closed/3662.v
index bd53389b..b8754bce 100644
--- a/test-suite/bugs/closed/3662.v
+++ b/test-suite/bugs/closed/3662.v
@@ -1,6 +1,6 @@
 Set Primitive Projections.
 Set Implicit Arguments.
-Set Record Elimination Schemes.
+Set Nonrecursive Elimination Schemes.
 Record prod A B := pair { fst : A ; snd : B }.
 Definition f : Set -> Type := fun x => x.
 
diff --git a/test-suite/bugs/closed/3664.v b/test-suite/bugs/closed/3664.v
index 63a81b6d..cd1427a1 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 e69ec109..c7bc2f22 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 da01ed00..1add3dba 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 283be495..b355e7e9 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 fd9640b8..fa30132a 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 31de8ec4..3882eee9 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 efa43252..dbb10f94 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 4e226524..bac443e3 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 72825007..feeb04d6 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 76beedf6..09f1149c 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 a50572ac..aced9615 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 c799d439..ca78987b 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 5bfbee94..f586438c 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 2dc50c17..16b0b8b6 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 e2171296..f7e2b543 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 108ebf59..a6286f03 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 a5c84e68..ac6a8501 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 355d23a5..0b9c3183 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 a327bbf2..7c60ddf3 100644
--- a/test-suite/bugs/closed/3881.v
+++ b/test-suite/bugs/closed/3881.v
@@ -1,4 +1,4 @@
-(* -*- coq-prog-args: ("-emacs" "-nois" "-R" "../theories" "Coq") -*- *)
+(* -*- coq-prog-args: ("-nois" "-R" "../theories" "Coq") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 2236 lines to 1877 lines, then from 1652 lines to 160 lines, then from 102 lines to 34 lines *)
 (* coqc version trunk (December 2014) compiled on Dec 23 2014 22:6:43 with OCaml 4.01.0
    coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (90ed6636dea41486ddf2cc0daead83f9f0788163) *)
@@ -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 2ac4abe5..b523b117 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 e83166aa..7754934c 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/3923.v b/test-suite/bugs/closed/3923.v
index 0aa029e7..1d9488c6 100644
--- a/test-suite/bugs/closed/3923.v
+++ b/test-suite/bugs/closed/3923.v
@@ -1,3 +1,5 @@
+Require Coq.extraction.Extraction.
+
 Module Type TRIVIAL.
 Parameter t:Type.
 End TRIVIAL.
@@ -31,3 +33,4 @@ Axiom empty_fieldstore : cert_fieldstore.
 End MkCertRuntimeTypes.
 
 Extraction MkCertRuntimeTypes. (* Was leading to an uncaught Not_found *)
+Extraction TestCompile MkCertRuntimeTypes.
diff --git a/test-suite/bugs/closed/3943.v b/test-suite/bugs/closed/3943.v
new file mode 100644
index 00000000..ac9c5036
--- /dev/null
+++ b/test-suite/bugs/closed/3943.v
@@ -0,0 +1,50 @@
+(* File reduced by coq-bug-finder from original input, then from 9492 lines to 119 lines *)
+(* coqc version 8.5beta1 (January 2015) compiled on Jan 18 2015 7:27:36 with OCaml 3.12.1
+   coqtop version 8.5beta1 (January 2015) *)
+
+Set Typeclasses Dependency Order.
+
+Inductive paths {A : Type} (a : A) : A -> Type :=
+  idpath : paths a a.
+Arguments idpath {A a} , [A] a.
+Notation "x = y" := (@paths _ x y) : type_scope.
+Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y
+  := match p with idpath => idpath end.
+
+Set Implicit Arguments.
+Delimit Scope morphism_scope with morphism.
+Delimit Scope category_scope with category.
+Delimit Scope object_scope with object.
+
+Record PreCategory := Build_PreCategory' {
+      object :> Type;
+      morphism : object -> object -> Type;
+      identity : forall x, morphism x x;
+      compose : forall s d d',
+                  morphism d d'
+                  -> morphism s d
+                  -> morphism s d' }.
+Arguments identity {!C%category} / x%object : rename.
+Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename.
+
+Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := {
+    morphism_inverse : morphism C d s;
+    left_inverse : compose morphism_inverse m = identity _;
+    right_inverse : compose m morphism_inverse = identity _ }.
+Arguments morphism_inverse {C s d} m {_}.
+Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope.
+
+Class Isomorphic {C : PreCategory} s d := {
+    morphism_isomorphic :> morphism C s d;
+    isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }.
+Coercion morphism_isomorphic : Isomorphic >-> morphism.
+
+Variable C : PreCategory.
+Variables s d : C.
+
+Definition path_isomorphic (i j : Isomorphic s d)
+: @morphism_isomorphic _ _ _ i = @morphism_isomorphic _ _ _ j -> i = j.
+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.
diff --git a/test-suite/bugs/closed/3956.v b/test-suite/bugs/closed/3956.v
index c19a2d4a..4957cc74 100644
--- a/test-suite/bugs/closed/3956.v
+++ b/test-suite/bugs/closed/3956.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter"); mode: visual-line -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter"); mode: visual-line -*- *)
 Set Universe Polymorphism.
 Set Primitive Projections.
 Close Scope nat_scope.
@@ -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 e56dcef7..35273124 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 b6be1595..3d9e06b6 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 95851c81..c7616b3a 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 ced13839..e17550e9 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 2b8641eb..6c23baff 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 61527764..606c6e08 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/4089.v b/test-suite/bugs/closed/4089.v
index e4d76732..fc1c504f 100644
--- a/test-suite/bugs/closed/4089.v
+++ b/test-suite/bugs/closed/4089.v
@@ -1,6 +1,6 @@
 Unset Strict Universe Declaration.
 Require Import TestSuite.admit.
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 6522 lines to 318 lines, then from 1139 lines to 361 lines *)
 (* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0
    coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *)
diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v
index ffd33d38..8d7dfbd4 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 02aa25e0..183b860d 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 a38b0509..75a26a06 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 00db8f7f..315dc0d2 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/4121.v b/test-suite/bugs/closed/4121.v
index d34a2b8b..b2368467 100644
--- a/test-suite/bugs/closed/4121.v
+++ b/test-suite/bugs/closed/4121.v
@@ -1,9 +1,11 @@
 Unset Strict Universe Declaration.
-(* -*- coq-prog-args: ("-emacs" "-nois") -*- *)
+(* -*- coq-prog-args: ("-nois") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 830 lines to 47 lines, then from 25 lines to 11 lines *)
 (* coqc version 8.5beta1 (March 2015) compiled on Mar 11 2015 18:51:36 with OCaml 4.01.0
    coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (8dbfee5c5f897af8186cb1bdfb04fd4f88eca677) *)
 
+Declare ML Module "ltac_plugin".
+
 Set Universe Polymorphism.
 Class Contr_internal (A : Type) := BuildContr { center : A }.
 Arguments center A {_}.
@@ -13,4 +15,4 @@ Definition contr_paths_contr0 {A} `{Contr A} : Contr A := {| center := center A
 Instance contr_paths_contr1 {A} `{Contr A} : Contr A := {| center := center A |}.
 Check @contr_paths_contr0@{i}.
 Check @contr_paths_contr1@{i}. (* Error: Universe instance should have length 2 *)
-(** It should have length 1, just like contr_paths_contr0 *)
\ No newline at end of file
+(** It should have length 1, just like contr_paths_contr0 *)
diff --git a/test-suite/bugs/closed/4132.v b/test-suite/bugs/closed/4132.v
new file mode 100644
index 00000000..806ffb77
--- /dev/null
+++ b/test-suite/bugs/closed/4132.v
@@ -0,0 +1,31 @@
+
+Require Import ZArith Omega.
+Open Scope Z_scope.
+
+(** bug 4132: omega was using "simpl" either on whole equations, or on
+   delimited but wrong spots. This was leading to unexpected reductions
+   when one atom (here [b]) is an evaluable reference instead of a variable. *)
+
+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.
+omega. (* was: Uncaught exception Invalid_argument("index out of bounds"). *)
+Qed.
+
+Lemma foo2 x y (b := 5) (H1 : x <= y) (H2 : y <= b) : x <= b.
+omega. (* Pierre L: according to a comment of bug report #4132,
+          this might have triggered "index out of bounds" in the past,
+          but I never managed to reproduce that in any version,
+          even before my fix. *)
+Qed.
+
+Lemma foo3 x y (b := 0) (H1 : x <= y) (H2 : y <= b) : x <= b.
+omega. (* Pierre L: according to a comment of bug report #4132,
+          this might have triggered "Failure(occurence 2)" in the past,
+          but I never managed to reproduce that. *)
+Qed.
diff --git a/test-suite/bugs/closed/4151.v b/test-suite/bugs/closed/4151.v
index fec64555..fc0b58cf 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 aa2b189b..d2003ab1 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/4202.v b/test-suite/bugs/closed/4202.v
new file mode 100644
index 00000000..522a3604
--- /dev/null
+++ b/test-suite/bugs/closed/4202.v
@@ -0,0 +1,10 @@
+Parameter g : nat -> Prop.
+Axiom a : forall n, g (S n).
+Lemma foo (H : True) : exists n, g n /\ g n.
+eexists.
+clear H.
+split.
+simple apply a.
+(* goal is "g (S ?Goal0@ {H:=H})" while H has long ceased to exist *)
+simpl.
+Abort.
diff --git a/test-suite/bugs/closed/4203.v b/test-suite/bugs/closed/4203.v
index 076a3c3d..eb6867a0 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 d684e8cf..2e620fce 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
new file mode 100644
index 00000000..f5d0d1a5
--- /dev/null
+++ b/test-suite/bugs/closed/4250.v
@@ -0,0 +1,11 @@
+Require Import FunInd.
+Require  Vector.
+Generalizable All Variables.
+
+Definition f `{n:nat , u:Vector.t A n} := n.
+
+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.
diff --git a/test-suite/bugs/closed/4251.v b/test-suite/bugs/closed/4251.v
index 66343d66..f112e7b4 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 591ea4b5..401e8664 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 ba82e6c3..ea9cbb21 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 43c9b512..757b71b2 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 3671c931..21d333fa 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 955c3017..a1daa193 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
new file mode 100644
index 00000000..28f028ad
--- /dev/null
+++ b/test-suite/bugs/closed/4306.v
@@ -0,0 +1,32 @@
+Require Import List.
+Require Import Arith.
+Require Import Recdef. 
+Require Import Omega.
+
+Function foo (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) + length (snd xys))} : list nat :=
+  match xys with
+    | (nil, _) => snd xys
+    | (_, nil) => fst xys
+    | (x :: xs', y :: ys') => match Compare_dec.nat_compare x y with
+                                | Lt => x :: foo (xs', y :: ys')
+                                | Eq => x :: foo (xs', ys')
+                                | Gt => y :: foo (x :: xs', ys')
+                              end
+  end.
+Proof.
+  intros; simpl; omega.
+  intros; simpl; omega.
+  intros; simpl; omega.
+Qed.
+
+Function bar (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) + length (snd xys))} : list nat :=
+  let (xs, ys) := xys in
+  match (xs, ys) with
+    | (nil, _) => ys
+    | (_, nil) => xs
+    | (x :: xs', y :: ys') => match Compare_dec.nat_compare x y with
+                                | Lt => x :: foo (xs', ys)
+                                | Eq => x :: foo (xs', ys')
+                                | Gt => y :: foo (xs, ys')
+                              end
+  end.
diff --git a/test-suite/bugs/closed/4328.v b/test-suite/bugs/closed/4328.v
index 8e1bb310..b40b3a48 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 e71ddaf7..c55b4cf0 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/4366.v b/test-suite/bugs/closed/4366.v
index 6a5e9a40..403c2d20 100644
--- a/test-suite/bugs/closed/4366.v
+++ b/test-suite/bugs/closed/4366.v
@@ -10,6 +10,6 @@ end.
 Goal True.
 Proof.
 pose (v := stupid 24).
-Timeout 2 vm_compute in v.
+Timeout 4 vm_compute in v.
 exact I.
 Qed.
diff --git a/test-suite/bugs/closed/4375.v b/test-suite/bugs/closed/4375.v
index 71e3a751..468bade1 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 a96a1370..c069b2d9 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/4394.v b/test-suite/bugs/closed/4394.v
deleted file mode 100644
index 60c93545..00000000
--- a/test-suite/bugs/closed/4394.v
+++ /dev/null
@@ -1,19 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
-
-Require Import Equality List.
-Inductive Foo (I : Type -> Type) (A : Type) : Type :=
-| foo (B : Type) : A -> I B -> Foo I A.
-Definition Family := Type -> Type.
-Definition FooToo : Family -> Family := Foo.
-Definition optionize (I : Type -> Type) (A : Type) := option (I A).
-Definition bar (I : Type -> Type) (A : Type) : A -> option (I A) -> Foo (optionize I) A := foo (optionize I) A A.
-Record Rec (I : Type -> Type) := { rec : forall A : Type, A -> I A -> Foo I A }.
-Definition barRec : Rec (optionize id) := {| rec := bar id |}.
-Inductive Empty {T} : T -> Prop := .
-Theorem empty (family : Family) (a : fold_right prod unit (map (Foo family) nil)) (b : unit) :
-  Empty (a, b) -> False.
-Proof.
-  intro e.
-  dependent induction e.
-Qed.
-
diff --git a/test-suite/bugs/closed/4400.v b/test-suite/bugs/closed/4400.v
deleted file mode 100644
index 5c23f840..00000000
--- a/test-suite/bugs/closed/4400.v
+++ /dev/null
@@ -1,19 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-require" "Coq.Compat.Coq84" "-compat" "8.4") -*- *)
-Require Import Coq.Lists.List Coq.Logic.JMeq Program.Equality.
-Set Printing Universes.
-Inductive Foo (I : Type -> Type) (A : Type) : Type :=
-| foo (B : Type) : A -> I B -> Foo I A.
-Definition Family := Type -> Type.
-Definition FooToo : Family -> Family := Foo.
-Definition optionize (I : Type -> Type) (A : Type) := option (I A).
-Definition bar (I : Type -> Type) (A : Type) : A -> option (I A) -> Foo(optionize I) A := foo (optionize I) A A.
-Record Rec (I : Type -> Type) := { rec : forall A : Type, A -> I A -> Foo I A }.
-Definition barRec : Rec (optionize id) := {| rec := bar id |}.
-Inductive Empty {T} : T -> Prop := .
-Theorem empty (family : Family) (a : fold_right prod unit (map (Foo family)
-nil)) (b : unit) :
-  Empty (a, b) -> False.
-Proof.
-  intro e.
-  dependent induction e.
-Qed.
diff --git a/test-suite/bugs/closed/4403.v b/test-suite/bugs/closed/4403.v
new file mode 100644
index 00000000..a80f38fe
--- /dev/null
+++ b/test-suite/bugs/closed/4403.v
@@ -0,0 +1,3 @@
+(* -*- coq-prog-args: ("-type-in-type"); -*- *)
+
+Definition some_prop : Prop := Type.
diff --git a/test-suite/bugs/closed/4416.v b/test-suite/bugs/closed/4416.v
index 3189685e..62b90b42 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 9eeb8646..83c0e3f8 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 66dfa0e6..a3a8717d 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 ecebaba8..c1fe4431 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/4456.v b/test-suite/bugs/closed/4456.v
index a32acf78..56a7b4f6 100644
--- a/test-suite/bugs/closed/4456.v
+++ b/test-suite/bugs/closed/4456.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Fiat" "-top" "BooleanRecognizerMin" "-R" "." "Top") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerMin" "-R" "." "Top") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 2475 lines to 729 lines, then from 746 lines to 658 lines, then from 675 lines to 658 lines *)
 (* coqc version 8.5beta3 (November 2015) compiled on Nov 11 2015 18:23:0 with OCaml 4.01.0
    coqtop version 8.5beta3 (November 2015) *)
diff --git a/test-suite/bugs/closed/4480.v b/test-suite/bugs/closed/4480.v
index 08a86330..98c05ee1 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 ccdb2ddd..379e46b3 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 f54d6433..5162f352 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 ccbc47d2..945183fa 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/4527.v b/test-suite/bugs/closed/4527.v
index 08628377..117d6523 100644
--- a/test-suite/bugs/closed/4527.v
+++ b/test-suite/bugs/closed/4527.v
@@ -1,10 +1,11 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_bad_univ_length_01") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_bad_univ_length_01") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 1199 lines to 
 430 lines, then from 444 lines to 430 lines, then from 964 lines to 255 lines, 
 then from 269 lines to 255 lines *)
 (* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 
 4.01.0
    coqtop version 8.5 (January 2016) *)
+Declare ML Module "ltac_plugin".
 Inductive False := .
 Axiom proof_admitted : False.
 Tactic Notation "admit" := case proof_admitted.
diff --git a/test-suite/bugs/closed/4533.v b/test-suite/bugs/closed/4533.v
index ae17fb14..c3e0da11 100644
--- a/test-suite/bugs/closed/4533.v
+++ b/test-suite/bugs/closed/4533.v
@@ -1,10 +1,11 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_lex_wrong_rewrite_02") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_lex_wrong_rewrite_02") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 1125 lines to 
 346 lines, then from 360 lines to 346 lines, then from 822 lines to 271 lines, 
 then from 285 lines to 271 lines *)
 (* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 
 4.01.0
    coqtop version 8.5 (January 2016) *)
+Declare ML Module "ltac_plugin".
 Inductive False := .
 Axiom proof_admitted : False.
 Tactic Notation "admit" := case proof_admitted.
@@ -223,4 +224,4 @@ v = _) r,
     | [ |- p2 @ p0 @ p1 @ eissect (to O A) (g x) = r ] => idtac "good"
     | [ |- ?G ] => fail 1 "bad" G
     end.
-    Fail rewrite concat_p_pp.
\ No newline at end of file
+    Fail rewrite concat_p_pp.
diff --git a/test-suite/bugs/closed/4544.v b/test-suite/bugs/closed/4544.v
index da140c93..4ad53bc6 100644
--- a/test-suite/bugs/closed/4544.v
+++ b/test-suite/bugs/closed/4544.v
@@ -1,7 +1,8 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_oog_looping_rewrite_01") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_oog_looping_rewrite_01") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 2553 lines to 1932 lines, then from 1946 lines to 1932 lines, then from 2467 lines to 1002 lines, then from 1016 lines to 1002 lines *)
 (* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 4.01.0
    coqtop version 8.5 (January 2016) *)
+Declare ML Module "ltac_plugin".
 Inductive False := .
 Axiom proof_admitted : False.
 Tactic Notation "admit" := case proof_admitted.
@@ -1004,4 +1005,4 @@ Proof.
   Fail Timeout 1 Time rewrite !loops_functor_group.
   (* 0.004 s in 8.5rc1, 8.677 s in 8.5 *)
   Timeout 1 do 3 rewrite loops_functor_group.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/bugs/closed/4603.v b/test-suite/bugs/closed/4603.v
index e7567623..2c90044d 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/4616.v b/test-suite/bugs/closed/4616.v
index c862f820..d6660e35 100644
--- a/test-suite/bugs/closed/4616.v
+++ b/test-suite/bugs/closed/4616.v
@@ -1,4 +1,7 @@
+Require Coq.extraction.Extraction.
+
 Set Primitive Projections.
 Record Foo' := Foo { foo : Type }.
-Axiom f : forall t : Foo', foo t.
+Definition f := forall t : Foo', foo t.
 Extraction f.
+Extraction TestCompile f.
diff --git a/test-suite/bugs/closed/4627.v b/test-suite/bugs/closed/4627.v
index e1206bb3..4f56e195 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/4656.v b/test-suite/bugs/closed/4656.v
deleted file mode 100644
index c89a86d6..00000000
--- a/test-suite/bugs/closed/4656.v
+++ /dev/null
@@ -1,4 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
-Goal True.
-  constructor 1.
-Qed.
diff --git a/test-suite/bugs/closed/4673.v b/test-suite/bugs/closed/4673.v
index 1ae50818..10e48db6 100644
--- a/test-suite/bugs/closed/4673.v
+++ b/test-suite/bugs/closed/4673.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Fiat" "-top" "BooleanRecognizerOptimized" "-R" "." "Top") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerOptimized" "-R" "." "Top") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 2407 lines to 22 lines, then from 528 lines to 35 lines, then from 331 lines to 42 lines, then from 56 lines to 42 lines, then from 63 lines to 46 lines, then from 60 lines to 46 lines *) (* coqc version 8.5 (February 2016) compiled on Feb 21 2016 15:26:16 with OCaml 4.02.3
    coqtop version 8.5 (February 2016) *)
 Axiom proof_admitted : False.
diff --git a/test-suite/bugs/closed/4679.v b/test-suite/bugs/closed/4679.v
index c94fa31a..3f41c5d6 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/4709.v b/test-suite/bugs/closed/4709.v
new file mode 100644
index 00000000..a9edcc80
--- /dev/null
+++ b/test-suite/bugs/closed/4709.v
@@ -0,0 +1,18 @@
+
+(** Bug 4709 https://coq.inria.fr/bug/4709
+    Extraction wasn't reducing primitive projections in types. *)
+
+Require Extraction.
+
+Set Primitive Projections.
+
+Record t := Foo { foo : Type }.
+Definition ty := foo (Foo nat).
+
+(* Without proper reduction of primitive projections in
+   [extract_type], the type [ty] was extracted as [Tunknown].
+   Let's check it isn't the case anymore. *)
+
+Parameter check : nat.
+Extract Constant check => "(O:ty)".
+Extraction TestCompile ty check.
diff --git a/test-suite/bugs/closed/4710.v b/test-suite/bugs/closed/4710.v
index fdc85010..e792a362 100644
--- a/test-suite/bugs/closed/4710.v
+++ b/test-suite/bugs/closed/4710.v
@@ -1,8 +1,9 @@
+Require Coq.extraction.Extraction.
+
 Set Primitive Projections.
 Record Foo' := Foo { foo : nat }.
 Extraction foo.
 Record Foo2 (a : nat) := Foo2c { foo2p : nat; foo2b : bool }.
-Extraction Language Ocaml.
 Extraction foo2p.
 
 Definition bla (x : Foo2 0) := foo2p _ x.
@@ -10,3 +11,5 @@ Extraction bla.
 
 Definition bla' (a : nat) (x : Foo2 a) := foo2b _ x.
 Extraction bla'.
+
+Extraction TestCompile foo foo2p bla bla'.
diff --git a/test-suite/bugs/closed/4717.v b/test-suite/bugs/closed/4717.v
new file mode 100644
index 00000000..1507fa4b
--- /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/4720.v b/test-suite/bugs/closed/4720.v
new file mode 100644
index 00000000..704331e7
--- /dev/null
+++ b/test-suite/bugs/closed/4720.v
@@ -0,0 +1,50 @@
+(** Bug 4720 : extraction and "with" in module type *)
+
+Module Type A.
+ Parameter t : Set.
+End A.
+
+Module A_instance <: A.
+ Definition t := nat.
+End A_instance.
+
+Module A_private : A.
+ Definition t := nat.
+End A_private.
+
+Module Type B.
+End B.
+
+Module Type C (b : B).
+ Declare Module a : A.
+End C.
+
+Module WithMod (a' : A) (b' : B) (c' : C b' with Module a := A_instance).
+End WithMod.
+
+Module WithDef (a' : A) (b' : B) (c' : C b' with Definition a.t := nat).
+End WithDef.
+
+Module WithModPriv (a' : A) (b' : B) (c' : C b' with Module a := A_private).
+End WithModPriv.
+
+(* The initial bug report was concerning the extraction of WithModPriv
+   in Coq 8.4, which was suboptimal: it was compiling, but could have been
+   turned into some faulty code since A_private and c'.a were not seen as
+   identical by the extraction.
+
+   In Coq 8.5 and 8.6, the extractions of WithMod, WithDef, WithModPriv
+   were all causing Anomaly or Assert Failure. This shoud be fixed now.
+*)
+
+Require Extraction.
+
+Recursive Extraction WithMod.
+
+Recursive Extraction WithDef.
+
+Recursive Extraction WithModPriv.
+
+(* Let's even check that all this extracted code is actually compilable: *)
+
+Extraction TestCompile WithMod WithDef WithModPriv.
diff --git a/test-suite/bugs/closed/4722.v b/test-suite/bugs/closed/4722.v
deleted file mode 100644
index f047624c..00000000
--- a/test-suite/bugs/closed/4722.v
+++ /dev/null
@@ -1 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-R" "4722" "Foo") -*- *)
diff --git a/test-suite/bugs/closed/4722/tata b/test-suite/bugs/closed/4722/tata
deleted file mode 120000
index b38e66e7..00000000
--- a/test-suite/bugs/closed/4722/tata
+++ /dev/null
@@ -1 +0,0 @@
-toto
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4723.v b/test-suite/bugs/closed/4723.v
index 88848121..5fb9696f 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/4727.v b/test-suite/bugs/closed/4727.v
deleted file mode 100644
index 3854bbff..00000000
--- a/test-suite/bugs/closed/4727.v
+++ /dev/null
@@ -1,10 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
-Goal forall (P : Set) (l : P) (P0 : Set) (w w0 : P0) (T : Type) (a : P * T) (o : P -> option P0),
-    (forall (l1 l2 : P) (w1 : P0), o l1 = Some w1 -> o l2 = Some w1 -> l1 = l2) ->
-    o l = Some w -> o (fst a) = Some w0 -> {w = w0} + {w <> w0} -> False.
-Proof.
-  clear; intros ???????? inj H0 H1 H2.
-  destruct H2; intuition subst.
-  eapply inj in H1; [ | eauto ].
-  progress subst. (* should succeed, used to not succeed *)
-Abort.
diff --git a/test-suite/bugs/closed/4733.v b/test-suite/bugs/closed/4733.v
deleted file mode 100644
index a6ebda61..00000000
--- a/test-suite/bugs/closed/4733.v
+++ /dev/null
@@ -1,52 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
-(*Suppose a user wants to declare a new list-like notation with support for singletons in both 8.4 and 8.5.  If they use*)
-Require Import Coq.Lists.List.
-Require Import Coq.Vectors.Vector.
-Import ListNotations.
-Import VectorNotations.
-Set Implicit Arguments.
-Inductive mylist T := mynil | mycons (_ : T) (_ : mylist T).
-Arguments mynil {_}, _.
-
-Delimit Scope mylist_scope with mylist.
-Bind Scope mylist_scope with mylist.
-Delimit Scope vector_scope with vector.
-
-Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
-Notation " [ x ] " := (mycons x mynil) : mylist_scope.
-Notation " [ x ; .. ; y ] " := (mycons x .. (mycons y mynil) ..) : mylist_scope.
-
-(** All of these should work fine in -compat 8.4 mode, just as they do in Coq 8.4.  There needs to be a way to specify notations above so that all of these [Check]s go through in both 8.4 and 8.5 *)
-Check [ ]%mylist : mylist _.
-Check [ ]%list : list _.
-Check []%vector : Vector.t _ _.
-Check [ _ ]%mylist : mylist _.
-Check [ _ ]%list : list _.
-Check [ _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ]%list : list _.
-Check [ _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ]%mylist : mylist _.
-Check [ _ ; _ ; _ ]%list : list _.
-Check [ _ ; _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ; _ ]%mylist : mylist _.
-Check [ _ ; _ ; _ ; _ ]%list : list _.
-Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ; _ ; _ ]%mylist : mylist _.
-
-Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z mynil) ..)) : mylist_scope.
-(* Now these all work, but not so in 8.4.  If we get the ability to remove notations, this section can also just be removed. *)
-Check [ ]%mylist : mylist _.
-Check [ ]%list : list _.
-Check []%vector : Vector.t _ _.
-Check [ _ ]%mylist : mylist _.
-Check [ _ ]%list : list _.
-Check [ _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ]%list : list _.
-Check [ _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ]%mylist : mylist _.
-Check [ _ ; _ ; _ ]%list : list _.
-Check [ _ ; _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ; _ ]%mylist : mylist _.
-Check [ _ ; _ ; _ ; _ ]%list : list _.
-Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ; _ ; _ ]%mylist : mylist _.
diff --git a/test-suite/bugs/closed/4754.v b/test-suite/bugs/closed/4754.v
index 5bb3cd1b..67d645a6 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 ae8ed0e6..9613b5c2 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 d87906f3..f0c91f7b 100644
--- a/test-suite/bugs/closed/4769.v
+++ b/test-suite/bugs/closed/4769.v
@@ -1,5 +1,5 @@
 
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-nois" "-R" "." "Top" "-top" "bug_hom_anom_10") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-nois" "-R" "." "Top" "-top" "bug_hom_anom_10") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 156 lines to 41 lines, then from 237 lines to 45 lines, then from 163 lines to 66 lines, then from 342 lines to 121 lines, then from 353 lines to 184 lines, then from 343 lines to 255 lines, then from 435 lines to 322 lines, then from 475 lines to 351 lines, then from 442 lines to 377 lines, then from 505 lines to 410 lines, then from 591 lines to 481 lines, then from 596 lines to 535 lines, then from 647 lines to 570 lines, then from 669 lines to 596 lines, then from 687 lines to 620 lines, then from 728 lines to 652 lines, then from 1384 lines to 683 lines, then from 984 lines to 707 lines, then from 1124 lines to 734 lines, then from 775 lines to 738 lines, then from 950 lines to 763 lines, then from 857 lines to 798 lines, then from 983 lines to 752 lines, then from 1598 lines to 859 lines, then from 873 lines to 859 lines, then from 875 lines to 862 lines, then from 901 lines to 863 lines, then from 1047 lines to 865 lines, then from 929 lines to 871 lines, then from 989 lines to 884 lines, then from 900 lines to 884 lines, then from 884 lines to 751 lines, then from 763 lines to 593 lines, then from 482 lines to 232 lines, then from 416 lines to 227 lines, then from 290 lines to 231 lines, then from 348 lines to 235 lines, then from 249 lines to 235 lines, then from 249 lines to 172 lines, then from 186 lines to 172 lines, then from 140 lines to 113 lines, then from 127 lines to 113 lines *) (* coqc version trunk (June 2016) compiled on Jun 2 2016 10:16:20 with OCaml 4.02.3
    coqtop version trunk (June 2016) *)
 
@@ -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/4780.v b/test-suite/bugs/closed/4780.v
index 4cec4318..71a51c63 100644
--- a/test-suite/bugs/closed/4780.v
+++ b/test-suite/bugs/closed/4780.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Top" "-top" "bug_bad_induction_01") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-R" "." "Top" "-top" "bug_bad_induction_01") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 1889 lines to 144 lines, then from 158 lines to 144 lines *)
 (* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3
    coqtop version 8.5pl1 (April 2016) *)
diff --git a/test-suite/bugs/closed/4785.v b/test-suite/bugs/closed/4785.v
index c3c97d3f..0d347b26 100644
--- a/test-suite/bugs/closed/4785.v
+++ b/test-suite/bugs/closed/4785.v
@@ -1,5 +1,4 @@
 Require Coq.Lists.List Coq.Vectors.Vector.
-Require Coq.Compat.Coq85.
 
 Module A.
 Import Coq.Lists.List Coq.Vectors.Vector.
@@ -21,12 +20,10 @@ Delimit Scope mylist_scope with mylist.
 Bind Scope mylist_scope with mylist.
 Arguments mynil {_}, _.
 Arguments mycons {_} _ _.
-Notation " [] " := mynil (compat "8.5") : mylist_scope.
 Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
 Notation " [ x ] " := (mycons x nil) : mylist_scope.
 Notation " [ x ; y ; .. ; z ] " :=  (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope.
 
-Import Coq.Compat.Coq85.
 Locate Module VectorNotations.
 Import VectorDef.VectorNotations.
 
@@ -35,11 +32,3 @@ Check []%mylist : mylist _.
 Check [ ]%mylist : mylist _.
 Check [ ]%list : list _.
 End A.
-
-Module B.
-Import Coq.Compat.Coq85.
-
-Goal True.
-  idtac; []. (* Check that importing the compat file doesn't break the [ | .. | ] syntax of Ltac *)
-Abort.
-End B.
diff --git a/test-suite/bugs/closed/4785_compat_85.v b/test-suite/bugs/closed/4785_compat_85.v
deleted file mode 100644
index 9d65840a..00000000
--- a/test-suite/bugs/closed/4785_compat_85.v
+++ /dev/null
@@ -1,46 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-compat" "8.5") -*- *)
-Require Coq.Lists.List Coq.Vectors.Vector.
-Require Coq.Compat.Coq85.
-
-Module A.
-Import Coq.Lists.List Coq.Vectors.Vector.
-Import ListNotations.
-Check [ ]%list : list _.
-Import VectorNotations ListNotations.
-Delimit Scope vector_scope with vector.
-Check [ ]%vector : Vector.t _ _.
-Check []%vector : Vector.t _ _.
-Check [ ]%list : list _.
-Fail Check []%list : list _.
-
-Goal True.
-  idtac; [ ]. (* Note that vector notations break the [ | .. | ] syntax of Ltac *)
-Abort.
-
-Inductive mylist A := mynil | mycons (x : A) (xs : mylist A).
-Delimit Scope mylist_scope with mylist.
-Bind Scope mylist_scope with mylist.
-Arguments mynil {_}, _.
-Arguments mycons {_} _ _.
-Notation " [] " := mynil (compat "8.5") : mylist_scope.
-Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
-Notation " [ x ] " := (mycons x nil) : mylist_scope.
-Notation " [ x ; y ; .. ; z ] " :=  (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope.
-
-Import Coq.Compat.Coq85.
-Locate Module VectorNotations.
-Import VectorDef.VectorNotations.
-
-Check []%vector : Vector.t _ _.
-Check []%mylist : mylist _.
-Check [ ]%mylist : mylist _.
-Check [ ]%list : list _.
-End A.
-
-Module B.
-Import Coq.Compat.Coq85.
-
-Goal True.
-  idtac; []. (* Check that importing the compat file doesn't break the [ | .. | ] syntax of Ltac *)
-Abort.
-End B.
diff --git a/test-suite/bugs/closed/4798.v b/test-suite/bugs/closed/4798.v
index dbc3d46f..6f2bcb96 100644
--- a/test-suite/bugs/closed/4798.v
+++ b/test-suite/bugs/closed/4798.v
@@ -1,3 +1,3 @@
 Check match 2 with 0 => 0 | S n => n end.
-Notation "|" := 1 (compat "8.4").
+Notation "|" := 1 (compat "8.6").
 Check match 2 with 0 => 0 | S n => n end. (* fails *)
diff --git a/test-suite/bugs/closed/4811.v b/test-suite/bugs/closed/4811.v
index a9149626..fe6e65a0 100644
--- a/test-suite/bugs/closed/4811.v
+++ b/test-suite/bugs/closed/4811.v
@@ -2,7 +2,7 @@
 
 (* Submitted by Jason Gross *)
 
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "src" "Crypto" "-R" "Bedrock" "Bedrock" "-R" "coqprime-8.5/Coqprime" "Coqprime" "-top" "GF255192") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-R" "src" "Crypto" "-R" "Bedrock" "Bedrock" "-R" "coqprime-8.5/Coqprime" "Coqprime" "-top" "GF255192") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 162 lines to 23 lines, then from 245 lines to 95 lines, then from 198 lines to 101 lines, then from 654 lines to 452 lines, then from 591 lines to 505 lines, then from 1770 lines to 580 lines, then from 2238 lines to 1715 lines, then from 1776 lines to 1738 lines, then from 1750 lines to 1679 lines, then from 1693 lines to 1679 lines *)
 (* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3
    coqtop version 8.5pl1 (April 2016) *)
diff --git a/test-suite/bugs/closed/4818.v b/test-suite/bugs/closed/4818.v
index 904abb22..e411ce62 100644
--- a/test-suite/bugs/closed/4818.v
+++ b/test-suite/bugs/closed/4818.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Prob" "-top" "Product") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-R" "." "Prob" "-top" "Product") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 391 lines to 77 lines, then from 857 lines to 119 lines, then from 1584 lines to 126 lines, then from 362 lines to 135 lines, then from 149 lines to 135 lines *)
 (* coqc version 8.5pl1 (June 2016) compiled on Jun 9 2016 17:27:17 with OCaml 4.02.3
    coqtop version 8.5pl1 (June 2016) *)
diff --git a/test-suite/bugs/closed/4844.v b/test-suite/bugs/closed/4844.v
new file mode 100644
index 00000000..f140939c
--- /dev/null
+++ b/test-suite/bugs/closed/4844.v
@@ -0,0 +1,47 @@
+
+(* Bug report 4844 (and 4824):
+   The Haskell extraction was erroneously considering [Any] and
+   [()] as convertible ([Tunknown] an [Tdummy] internally). *)
+
+(* A value with inner logical parts.
+   Its extracted type will be [Sum () ()]. *)
+
+Definition semilogic : True + True := inl I.
+
+(* Higher-order record, whose projection [ST] isn't expressible
+   as an Haskell (or OCaml) type. Hence [ST] is extracted as the
+   unknown type [Any] in Haskell. *)
+
+Record SomeType := { ST : Type }.
+
+Definition SomeTrue := {| ST := True |}.
+
+(* A first version of the issue:
+  [abstrSum] is extracted as [Sum Any Any], so an unsafeCoerce
+  is required to cast [semilogic] into [abstrSum SomeTrue]. *)
+
+Definition abstrSum (t : SomeType) := ((ST t) + (ST t))%type.
+
+Definition semilogic' : abstrSum SomeTrue := semilogic.
+
+(* A deeper version of the issue.
+   In the previous example, the extraction could have reduced
+   [abstrSum SomeTrue] into [True+True], solving the issue.
+   It might do so in future versions. But if we put an inductive
+   in the way, a reduction isn't helpful. *)
+
+Inductive box (t : SomeType) := Box : ST t + ST t -> box t.
+
+Definition boxed_semilogic : box SomeTrue :=
+ Box SomeTrue semilogic.
+
+Require Extraction.
+Extraction Language Haskell.
+Recursive Extraction semilogic' boxed_semilogic.
+(* Warning! To fully check that this bug is still closed,
+   you should run ghc on the extracted code:
+
+Extraction "bug4844.hs" semilogic' boxed_semilogic.
+ghc bug4844.hs
+
+*)
diff --git a/test-suite/bugs/closed/4852.v b/test-suite/bugs/closed/4852.v
new file mode 100644
index 00000000..5068ed9b
--- /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 6d21b66f..ac5d7ea2 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 f2f917b4..39299883 100644
--- a/test-suite/bugs/closed/4873.v
+++ b/test-suite/bugs/closed/4873.v
@@ -1,6 +1,5 @@
 Require Import Coq.Classes.Morphisms.
 Require Import Relation_Definitions.
-Require Import Coq.Compat.Coq85.
 
 Fixpoint tuple' T n : Type :=
   match n with
@@ -69,4 +68,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 7e3c78dc..7d153d98 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/4957.v b/test-suite/bugs/closed/4957.v
new file mode 100644
index 00000000..0efd87ac
--- /dev/null
+++ b/test-suite/bugs/closed/4957.v
@@ -0,0 +1,6 @@
+Ltac get_value H := eval cbv delta [H] in H.
+
+Goal True.
+refine (let X := _ in _).
+let e := get_value X in unify e Prop.
+Abort.
diff --git a/test-suite/bugs/closed/4969.v b/test-suite/bugs/closed/4969.v
new file mode 100644
index 00000000..4dee41e2
--- /dev/null
+++ b/test-suite/bugs/closed/4969.v
@@ -0,0 +1,11 @@
+Require Import Classes.Init.
+
+Class C A := c : A.
+Instance nat_C : C nat := 0.
+Instance bool_C : C bool := true.
+Lemma silly {A} `{C A} : 0 = 0 -> c = c -> True.
+Proof. auto. Qed.
+
+Goal True.
+  class_apply @silly; [reflexivity|].
+  reflexivity. Fail Qed.
diff --git a/test-suite/bugs/closed/5019.v b/test-suite/bugs/closed/5019.v
new file mode 100644
index 00000000..7c973f88
--- /dev/null
+++ b/test-suite/bugs/closed/5019.v
@@ -0,0 +1,5 @@
+Require Import Coq.ZArith.ZArith.
+Goal forall (T0 : Z -> Type) (k : nat) d (P : T0 (Z.of_nat (S k)) -> Prop), P d.
+  clear; intros.
+  Timeout 1 zify. (* used to loop forever; should take < 0.01 s *)
+Admitted.
diff --git a/test-suite/bugs/closed/5036.v b/test-suite/bugs/closed/5036.v
index 12c958be..83f16774 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 6bd677ba..932fee8b 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 bcde510e..17231bff 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/5153.v b/test-suite/bugs/closed/5153.v
new file mode 100644
index 00000000..be6407b5
--- /dev/null
+++ b/test-suite/bugs/closed/5153.v
@@ -0,0 +1,8 @@
+(* An example where it does not hurt having more type-classes resolution *)
+Class some_type := { Ty : Type }.
+Instance: some_type := { Ty := nat }.
+Arguments Ty : clear implicits.
+Goal forall (H : forall t : some_type, @Ty t -> False) (H' : False -> 1 = 2), 1 = 2.
+Proof.
+intros H H'.
+specialize (H' (@H _ O)). (* was failing *)
diff --git a/test-suite/bugs/closed/5177.v b/test-suite/bugs/closed/5177.v
new file mode 100644
index 00000000..7c8af1e4
--- /dev/null
+++ b/test-suite/bugs/closed/5177.v
@@ -0,0 +1,22 @@
+(* Bug 5177 https://coq.inria.fr/bug/5177 :
+   Extraction and module type containing application and "with" *)
+
+Module Type T.
+  Parameter t: Type.
+End T.
+
+Module Type A (MT: T).
+  Parameter t1: Type.
+  Parameter t2: Type.
+  Parameter bar: MT.t -> t1 -> t2.
+End A.
+
+Module MakeA(MT: T): A MT with Definition t1 := nat.
+  Definition t1 := nat.
+  Definition t2 := nat.
+  Definition bar (m: MT.t) (x:t1) := x.
+End MakeA.
+
+Require Extraction.
+Recursive Extraction MakeA.
+Extraction TestCompile MakeA.
diff --git a/test-suite/bugs/closed/5180.v b/test-suite/bugs/closed/5180.v
index 261092ee..05603a04 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/5193.v b/test-suite/bugs/closed/5193.v
new file mode 100644
index 00000000..cc8739af
--- /dev/null
+++ b/test-suite/bugs/closed/5193.v
@@ -0,0 +1,14 @@
+Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}.
+
+Typeclasses eauto := debug.
+Set Typeclasses Debug Verbosity 2.
+
+Inductive Finx(n : nat) : Set :=
+| Fx1(i : nat)(e : n = S i)
+| FxS(i : nat)(f : Finx i)(e : n = S i).
+
+Context `{Finx_eqdec : forall n, Eqdec (Finx n)}.
+
+Goal {x : Type & Eqdec x}.
+  eexists.
+  try typeclasses eauto 1 with typeclass_instances.
diff --git a/test-suite/bugs/closed/5198.v b/test-suite/bugs/closed/5198.v
index 7254afb4..72722f5f 100644
--- a/test-suite/bugs/closed/5198.v
+++ b/test-suite/bugs/closed/5198.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-boot" "-nois") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-boot" "-nois") -*- *)
 (* File reduced by coq-bug-finder from original input, then from 286 lines to 
 27 lines, then from 224 lines to 53 lines, then from 218 lines to 56 lines, 
 then from 269 lines to 180 lines, then from 132 lines to 48 lines, then from 
diff --git a/test-suite/bugs/closed/5203.v b/test-suite/bugs/closed/5203.v
index ed137395..3428e1a4 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/5205.v b/test-suite/bugs/closed/5205.v
new file mode 100644
index 00000000..406f37a4
--- /dev/null
+++ b/test-suite/bugs/closed/5205.v
@@ -0,0 +1,6 @@
+Definition foo (n : nat) (m : nat) : nat := m.
+
+Arguments foo {_} _, _ _.
+
+Check foo 1 1.
+Check foo (n:=1) 1.
diff --git a/test-suite/bugs/closed/5215.v b/test-suite/bugs/closed/5215.v
new file mode 100644
index 00000000..ecf52915
--- /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 00000000..399947f0
--- /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/5219.v b/test-suite/bugs/closed/5219.v
new file mode 100644
index 00000000..f7cec1a0
--- /dev/null
+++ b/test-suite/bugs/closed/5219.v
@@ -0,0 +1,10 @@
+(* Test surgical use of beta-iota in the type of variables coming from
+   pattern-matching for refine *)
+
+Goal forall x : sigT (fun x => x = 1), True.
+  intro x; refine match x with
+                  | existT _ x' e' => _
+                  end.
+  lazymatch goal with
+  | [ H : _ = _ |- _ ] => idtac
+  end.
diff --git a/test-suite/bugs/closed/5233.v b/test-suite/bugs/closed/5233.v
new file mode 100644
index 00000000..06286c74
--- /dev/null
+++ b/test-suite/bugs/closed/5233.v
@@ -0,0 +1,2 @@
+(* Implicit arguments on type were missing for recursive records *)
+Inductive foo {A : Type} : Type := { Foo : foo }.
diff --git a/test-suite/bugs/closed/5245.v b/test-suite/bugs/closed/5245.v
new file mode 100644
index 00000000..e5bca5b5
--- /dev/null
+++ b/test-suite/bugs/closed/5245.v
@@ -0,0 +1,18 @@
+Set Primitive Projections.
+
+Record foo := Foo {
+  foo_car : Type;
+  foo_rel : foo_car -> foo_car -> Prop
+}.
+Arguments foo_rel : simpl never.
+
+Definition foo_fun {A B} := Foo (A -> B) (fun f g => forall x, f x = g x).
+
+Goal @foo_rel foo_fun (fun x : nat => x) (fun x => x).
+Proof.
+intros x; exact eq_refl.
+Undo.
+progress hnf; intros; exact eq_refl.
+Undo.
+unfold foo_rel. intros x. exact eq_refl.
+Qed.
diff --git a/test-suite/bugs/closed/5255.v b/test-suite/bugs/closed/5255.v
new file mode 100644
index 00000000..5daaf9ed
--- /dev/null
+++ b/test-suite/bugs/closed/5255.v
@@ -0,0 +1,24 @@
+Section foo.
+  Context (x := 1).
+  Definition foo : x = 1 := eq_refl.
+End foo.
+
+Module Type Foo.
+  Context (x := 1).
+  Definition foo : x = 1 := eq_refl.
+End Foo.
+
+Set Universe Polymorphism.
+
+Inductive unit := tt.
+Inductive eq {A} (x y : A) : Type := eq_refl : eq x y.
+
+Section bar.
+  Context (x := tt).
+  Definition bar : eq x tt := eq_refl _ _.
+End bar.
+
+Module Type Bar.
+  Context (x := tt).
+  Definition bar : eq x tt := eq_refl _ _.
+End Bar.
diff --git a/test-suite/bugs/closed/5277.v b/test-suite/bugs/closed/5277.v
new file mode 100644
index 00000000..7abc38bf
--- /dev/null
+++ b/test-suite/bugs/closed/5277.v
@@ -0,0 +1,11 @@
+(* Scheme Equality not robust wrt names *)
+
+Module A1.
+  Inductive A (T : Type) := C (a : T).
+  Scheme Equality for A. (* success *)
+End A1.
+
+Module A2.
+  Inductive A (x : Type) := C (a : x).
+  Scheme Equality for A. 
+End A2.
diff --git a/test-suite/bugs/closed/5281.v b/test-suite/bugs/closed/5281.v
new file mode 100644
index 00000000..03bafdc9
--- /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 00000000..98d4e5c9
--- /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/5300.v b/test-suite/bugs/closed/5300.v
new file mode 100644
index 00000000..18202df5
--- /dev/null
+++ b/test-suite/bugs/closed/5300.v
@@ -0,0 +1,39 @@
+Module Test1.
+
+  Module Type Foo.
+    Parameter t : unit.
+  End Foo.
+
+  Module Bar : Foo.
+    Module Type Rnd. Definition t' : unit := tt. End Rnd.
+    Module Rnd_inst : Rnd. Definition t' : unit := tt. End Rnd_inst.
+    Definition t : unit.
+      exact Rnd_inst.t'.
+    Qed.
+  End Bar.
+
+  Print Assumptions Bar.t.
+End Test1.
+
+Module Test2.
+  Module Type Foo.
+    Parameter t1 : unit.
+    Parameter t2 : unit.
+  End Foo.
+
+  Module Bar : Foo.
+    Inductive ind := .
+    Definition t' : unit := tt.
+    Definition t1 : unit.
+    Proof.
+      exact ((fun (_ : ind -> False) => tt) (fun H => match H with end)).
+    Qed.
+    Definition t2 : unit.
+    Proof.
+      exact t'.
+    Qed.
+  End Bar.
+
+  Print Assumptions Bar.t1.
+  Print Assumptions Bar.t1.
+End Test2.
diff --git a/test-suite/bugs/closed/5315.v b/test-suite/bugs/closed/5315.v
new file mode 100644
index 00000000..d8824bff
--- /dev/null
+++ b/test-suite/bugs/closed/5315.v
@@ -0,0 +1,10 @@
+Require Import Recdef.
+
+Function dumb_works (a:nat) {struct a} :=
+  match (fun x => x) a with O => O | S n' => dumb_works n' end.
+
+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. 
diff --git a/test-suite/bugs/closed/5321.v b/test-suite/bugs/closed/5321.v
new file mode 100644
index 00000000..03514e23
--- /dev/null
+++ b/test-suite/bugs/closed/5321.v
@@ -0,0 +1,18 @@
+Definition proj1_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v)
+  : proj1_sig u = proj1_sig v
+  := f_equal (@proj1_sig _ _) p.
+
+Definition proj2_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v)
+  : eq_rect _ _ (proj2_sig u) _ (proj1_sig_path p) = proj2_sig v
+  := match p with eq_refl => eq_refl end.
+
+Goal forall sz : nat,
+    let sz' := sz in
+    forall pf : sz = sz',
+      let feq_refl := exist (fun x : nat => sz = x) sz' eq_refl in
+      let fpf := exist (fun x : nat => sz = x) sz' pf in feq_refl = fpf -> 
+proj2_sig feq_refl = proj2_sig fpf.
+Proof.
+  intros.
+  etransitivity; [ | exact (proj2_sig_path H) ].
+  Fail clearbody fpf.
diff --git a/test-suite/bugs/closed/5322.v b/test-suite/bugs/closed/5322.v
new file mode 100644
index 00000000..01aec8f2
--- /dev/null
+++ b/test-suite/bugs/closed/5322.v
@@ -0,0 +1,14 @@
+(* Regression in computing types of branches in "match" *)
+Inductive flat_type := Unit | Prod (A B : flat_type).
+Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type
+-> Type :=
+| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR.
+Inductive op : flat_type -> flat_type -> Type := a : op Unit Unit.
+Arguments Op {_ _ _ _} _ _.
+Definition bound_op {var}
+           {src2 dst2}
+           (opc2 : op src2 dst2)
+  : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2.
+  refine match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with
+         | _ => _
+         end.
diff --git a/test-suite/bugs/closed/5323.v b/test-suite/bugs/closed/5323.v
new file mode 100644
index 00000000..295b7cd9
--- /dev/null
+++ b/test-suite/bugs/closed/5323.v
@@ -0,0 +1,26 @@
+(* Revealed a missing re-consideration of postponed problems *)
+
+Module A.
+Inductive flat_type := Unit | Prod (A B : flat_type).
+Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type 
+-> Type :=
+| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR.
+Inductive op : flat_type -> flat_type -> Type := .
+Arguments Op {_ _ _ _} _ _.
+Definition bound_op {var}
+           {src2 dst2}
+           (opc2 : op src2 dst2)
+  : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2
+  := match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with end.
+End A.
+
+(* A shorter variant *)
+Module B.
+Inductive exprf (op : unit -> Type) : Type :=
+| A : exprf op
+| Op tR (opc : op tR) (args : exprf op) : exprf op.
+Inductive op : unit -> Type := .
+Definition bound_op (dst2 : unit) (opc2 : op dst2)
+  : forall (args2 : exprf op), Op op dst2 opc2 args2 = A op
+  := match opc2 in op h return (forall args2 : exprf ?[U], Op ?[V] ?[I] opc2 args2 = A op) with end.
+End B.
diff --git a/test-suite/bugs/closed/5331.v b/test-suite/bugs/closed/5331.v
new file mode 100644
index 00000000..28743736
--- /dev/null
+++ b/test-suite/bugs/closed/5331.v
@@ -0,0 +1,11 @@
+(* Checking no anomaly on some unexpected intropattern *)
+
+Ltac ih H := induction H as H.
+Ltac ih' H H' := induction H as H'.
+
+Goal True -> True.
+Fail intro H; ih H.
+intro H; ih' H ipattern:([]).
+exact I.
+Qed.
+
diff --git a/test-suite/bugs/closed/5345.v b/test-suite/bugs/closed/5345.v
new file mode 100644
index 00000000..d8448f35
--- /dev/null
+++ b/test-suite/bugs/closed/5345.v
@@ -0,0 +1,7 @@
+Ltac break_tuple :=
+  match goal with
+  | [ H: context[match ?a with | pair n m => _ end] |- _ ] =>
+    let n := fresh n in
+    let m := fresh m in
+    destruct a as [n m]
+  end.
diff --git a/test-suite/bugs/closed/5346.v b/test-suite/bugs/closed/5346.v
new file mode 100644
index 00000000..0118c187
--- /dev/null
+++ b/test-suite/bugs/closed/5346.v
@@ -0,0 +1,29 @@
+Inductive comp : Type -> Type :=
+| Ret {T} : forall (v:T), comp T
+| Bind {T T'} : forall (p: comp T') (p': T' -> comp T), comp T.
+
+Notation "'do' x .. y <- p1 ; p2" :=
+  (Bind p1 (fun x => .. (fun y => p2) ..))
+    (at level 60, right associativity,
+     x binder, y binder).
+
+Definition Fst1 A B (p: comp (A*B)) : comp A :=
+  do '(a, b) <- p;
+    Ret a.
+
+Definition Fst2 A B (p: comp (A*B)) : comp A :=
+  match tt with
+  | _ => Bind p (fun '(a, b) => Ret a)
+  end.
+
+Definition Fst3 A B (p: comp (A*B)) : comp A :=
+  match tt with
+  | _ => do a <- p;
+          Ret (fst a)
+  end.
+
+Definition Fst A B (p: comp (A * B)) : comp A :=
+  match tt with
+  | _ => do '(a, b) <- p;
+          Ret a
+  end.
diff --git a/test-suite/bugs/closed/5347.v b/test-suite/bugs/closed/5347.v
new file mode 100644
index 00000000..9267b3eb
--- /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/5359.v b/test-suite/bugs/closed/5359.v
new file mode 100644
index 00000000..87e69565
--- /dev/null
+++ b/test-suite/bugs/closed/5359.v
@@ -0,0 +1,218 @@
+Require Import Coq.nsatz.Nsatz.
+Goal False.
+
+  (* the first (succeeding) goal was reached by clearing one hypothesis in the second goal which overflows 6GB of stack space *)
+  let sugar := constr:( 0%Z ) in
+  let nparams := constr:( (-1)%Z ) in
+  let reified_goal := constr:(
+  (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z)
+     (Ring_polynom.PEmul
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2))
+              (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) 
+        (Ring_polynom.PEX Z 6))) ) in
+  let power := constr:( N.one ) in
+  let reified_givens := constr:(
+  (Ring_polynom.PEmul
+     (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2))
+                 (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3))
+           (Ring_polynom.PEX Z 6)))
+     (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z)
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2))
+                 (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3))
+           (Ring_polynom.PEX Z 6)))
+   :: Ring_polynom.PEsub
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                          (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5))
+                    (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))
+           (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z)
+      :: Ring_polynom.PEsub
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z)
+                 (Ring_polynom.PEmul
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                             (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5))
+                       (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))
+              (Ring_polynom.PEX Z 9)) (Ring_polynom.PEc 1%Z)
+         :: Ring_polynom.PEsub
+              (Ring_polynom.PEadd
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 1)
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 7)
+                       (Ring_polynom.PEX Z 7)))
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) (Ring_polynom.PEX Z 8)))
+              (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+                 (Ring_polynom.PEmul
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 7)
+                          (Ring_polynom.PEX Z 7)))
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 8)
+                       (Ring_polynom.PEX Z 8))))
+            :: Ring_polynom.PEsub
+                 (Ring_polynom.PEadd
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 1)
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 5)
+                          (Ring_polynom.PEX Z 5)))
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 6)
+                       (Ring_polynom.PEX Z 6)))
+                 (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 5)
+                             (Ring_polynom.PEX Z 5)))
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 6)
+                          (Ring_polynom.PEX Z 6))))
+               :: Ring_polynom.PEsub
+                    (Ring_polynom.PEadd
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 1)
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 2)
+                             (Ring_polynom.PEX Z 2)))
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 3)
+                          (Ring_polynom.PEX Z 3)))
+                    (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+                       (Ring_polynom.PEmul
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                             (Ring_polynom.PEmul (Ring_polynom.PEX Z 2)
+                                (Ring_polynom.PEX Z 2)))
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 3)
+                             (Ring_polynom.PEX Z 3)))) :: nil)%list ) in
+    Nsatz.nsatz_compute
+          (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))).
+  
+  let sugar := constr:( 0%Z ) in
+  let nparams := constr:( (-1)%Z ) in
+  let reified_goal := constr:(
+  (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z)
+     (Ring_polynom.PEmul
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2))
+              (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) 
+        (Ring_polynom.PEX Z 6))) ) in
+  let power := constr:( N.one ) in
+  let reified_givens := constr:(
+  (Ring_polynom.PEmul
+     (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2))
+                 (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3))
+           (Ring_polynom.PEX Z 6)))
+     (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z)
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2))
+                 (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3))
+           (Ring_polynom.PEX Z 6)))
+   :: Ring_polynom.PEadd
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                          (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5))
+                    (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))
+           (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z)
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                          (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5))
+                    (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))))
+        (Ring_polynom.PEmul
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                    (Ring_polynom.PEadd
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 2)
+                          (Ring_polynom.PEX Z 6))
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 3)
+                          (Ring_polynom.PEX Z 5)))) (Ring_polynom.PEX Z 7))
+              (Ring_polynom.PEsub
+                 (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 6))
+                 (Ring_polynom.PEmul
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 1)
+                       (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5))))
+           (Ring_polynom.PEX Z 8))
+      :: Ring_polynom.PEsub
+           (Ring_polynom.PEmul
+              (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+                 (Ring_polynom.PEmul
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                             (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5))
+                       (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))
+              (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z)
+         :: Ring_polynom.PEsub
+              (Ring_polynom.PEmul
+                 (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z)
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul
+                          (Ring_polynom.PEmul
+                             (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                                (Ring_polynom.PEX Z 2)) 
+                             (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3))
+                       (Ring_polynom.PEX Z 6))) (Ring_polynom.PEX Z 9))
+              (Ring_polynom.PEc 1%Z)
+            :: Ring_polynom.PEsub
+                 (Ring_polynom.PEadd
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 1)
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 7)
+                          (Ring_polynom.PEX Z 7)))
+                    (Ring_polynom.PEmul (Ring_polynom.PEX Z 8)
+                       (Ring_polynom.PEX Z 8)))
+                 (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+                    (Ring_polynom.PEmul
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 7)
+                             (Ring_polynom.PEX Z 7)))
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 8)
+                          (Ring_polynom.PEX Z 8))))
+               :: Ring_polynom.PEsub
+                    (Ring_polynom.PEadd
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 1)
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 5)
+                             (Ring_polynom.PEX Z 5)))
+                       (Ring_polynom.PEmul (Ring_polynom.PEX Z 6)
+                          (Ring_polynom.PEX Z 6)))
+                    (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+                       (Ring_polynom.PEmul
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                             (Ring_polynom.PEmul (Ring_polynom.PEX Z 5)
+                                (Ring_polynom.PEX Z 5)))
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 6)
+                             (Ring_polynom.PEX Z 6))))
+                  :: Ring_polynom.PEsub
+                       (Ring_polynom.PEadd
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 1)
+                             (Ring_polynom.PEmul (Ring_polynom.PEX Z 2)
+                                (Ring_polynom.PEX Z 2)))
+                          (Ring_polynom.PEmul (Ring_polynom.PEX Z 3)
+                             (Ring_polynom.PEX Z 3)))
+                       (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z)
+                          (Ring_polynom.PEmul
+                             (Ring_polynom.PEmul (Ring_polynom.PEX Z 4)
+                                (Ring_polynom.PEmul (Ring_polynom.PEX Z 2)
+                                   (Ring_polynom.PEX Z 2)))
+                             (Ring_polynom.PEmul (Ring_polynom.PEX Z 3)
+                                (Ring_polynom.PEX Z 3)))) :: nil)%list ) in
+    Nsatz.nsatz_compute
+          (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))).
diff --git a/test-suite/bugs/closed/5365.v b/test-suite/bugs/closed/5365.v
new file mode 100644
index 00000000..be360d24
--- /dev/null
+++ b/test-suite/bugs/closed/5365.v
@@ -0,0 +1,13 @@
+
+Inductive TupleT : nat -> Type :=
+| nilT : TupleT 0
+| consT {n} A : (A -> TupleT n) -> TupleT (S n).
+
+Inductive Tuple : forall n, TupleT n -> Type :=
+  nil : Tuple _ nilT
+| cons {n A} (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F).
+
+Inductive TupleMap : forall n, TupleT n -> TupleT n -> Type :=
+  tmNil : TupleMap _ nilT nilT
+| tmCons {n} {A B : Type} (F : A -> TupleT n) (G : B -> TupleT n)
+  : (forall x, sigT (fun y => TupleMap _ (F x) (G y))) -> TupleMap _ (consT A F) (consT B G).
diff --git a/test-suite/bugs/closed/5368.v b/test-suite/bugs/closed/5368.v
new file mode 100644
index 00000000..410fe170
--- /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/5372.v b/test-suite/bugs/closed/5372.v
new file mode 100644
index 00000000..e60244cd
--- /dev/null
+++ b/test-suite/bugs/closed/5372.v
@@ -0,0 +1,8 @@
+(* coq bug 5372: https://coq.inria.fr/bugs/show_bug.cgi?id=5372 *)
+Require Import FunInd.
+Function odd (n:nat) :=
+  match n with
+  | 0 => false
+  | S n => true
+  end
+with even (n:nat) := false.
diff --git a/test-suite/bugs/closed/5377.v b/test-suite/bugs/closed/5377.v
new file mode 100644
index 00000000..130d9f9a
--- /dev/null
+++ b/test-suite/bugs/closed/5377.v
@@ -0,0 +1,54 @@
+Goal ((forall (t : Type) (x y : t),
+          True ->
+          x = y)) -> False.
+Proof.
+  intro HG.
+  let P := lazymatch goal with
+  | [ H : forall t x y, True -> @?P t x y
+                        |- _ ]
+    => P
+  end in
+  pose (f := P).
+  unify f (fun (t : Type) (x y : t) => x = y).
+Abort.
+
+Goal True.
+Proof.
+let c := lazymatch constr:(fun (T : nat -> Type) (y : nat) (_ : T y) => y) with
+         | fun _ y _ => @?C y => C
+         end in
+pose (f := c).
+unify f (fun n : nat => n).
+Abort.
+
+Goal (forall x : nat, x = x -> x = x \/ x = x) -> True.
+Proof.
+intro.
+let P := lazymatch goal with
+| [ H : forall y, @?P y -> @?P y \/ _ |- _ ]
+  => P
+end in
+pose (f := P).
+unify f (fun x : nat => x = x).
+Abort.
+
+Goal (forall x : nat, x = x -> x = x \/ x = x) -> True.
+Proof.
+intro.
+lazymatch goal with
+| [ H : forall y, @?P y -> @?Q y \/ _ |- _ ]
+  => idtac
+end.
+Abort.
+
+Axiom eq : forall {T} (_ : T), Prop.
+
+Goal forall _ : (forall t (_ : eq t) (x : t), eq x), Prop.
+Proof.
+intro.
+let P := lazymatch goal with
+| [ H : forall t _ x, @?P t x |- _ ]
+  => P
+end in
+pose (f := P).
+Abort.
diff --git a/test-suite/bugs/closed/5401.v b/test-suite/bugs/closed/5401.v
new file mode 100644
index 00000000..95193b99
--- /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/5414.v b/test-suite/bugs/closed/5414.v
new file mode 100644
index 00000000..2522a274
--- /dev/null
+++ b/test-suite/bugs/closed/5414.v
@@ -0,0 +1,12 @@
+(* Use of idents bound to ltac names in a "match" *)
+
+Definition foo : Type.
+Proof.
+  let x := fresh "a" in
+  refine (forall k : nat * nat, let '(x, _) := k in (_ : Type)).
+  exact (a = a).
+Defined.
+Goal foo.
+intros k. elim k. (* elim because elim keeps names *)
+intros.
+Check a. (* We check that the name is "a" *)
diff --git a/test-suite/bugs/closed/5434.v b/test-suite/bugs/closed/5434.v
new file mode 100644
index 00000000..5d2460fa
--- /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/5435.v b/test-suite/bugs/closed/5435.v
new file mode 100644
index 00000000..60ace5ce
--- /dev/null
+++ b/test-suite/bugs/closed/5435.v
@@ -0,0 +1,2 @@
+Definition foo (x : nat) := Eval native_compute in x.
+
diff --git a/test-suite/bugs/closed/5449.v b/test-suite/bugs/closed/5449.v
new file mode 100644
index 00000000..d7fc2aaa
--- /dev/null
+++ b/test-suite/bugs/closed/5449.v
@@ -0,0 +1,6 @@
+(* An example of decide equality which was failing due to a lhs dep into the rhs *)
+
+Require Import Coq.PArith.BinPos.
+Goal forall x y, {Pos.compare_cont Gt x y = Gt} + {Pos.compare_cont Gt x y <> Gt}.
+intros.
+decide equality.
diff --git a/test-suite/bugs/closed/5460.v b/test-suite/bugs/closed/5460.v
new file mode 100644
index 00000000..50221cdd
--- /dev/null
+++ b/test-suite/bugs/closed/5460.v
@@ -0,0 +1,11 @@
+(* Bugs in computing dependencies in pattern-matching compilation *)
+
+Inductive A := a1 | a2.
+Inductive B := b.
+Inductive C : A -> Type := c : C a1 | d : C a2.
+Definition P (x : A) (y : C x) (z : B) : nat :=
+  match z, x, y with
+      | b, a1, c => 0
+      | b, a2, d => 0
+      | _, _, _ => 1
+  end.
diff --git a/test-suite/bugs/closed/5470.v b/test-suite/bugs/closed/5470.v
new file mode 100644
index 00000000..5b3984b6
--- /dev/null
+++ b/test-suite/bugs/closed/5470.v
@@ -0,0 +1,3 @@
+(* This used to raise an anomaly *)
+
+Fail Reserved Notation "x +++ y" (at level 70, x binder).
diff --git a/test-suite/bugs/closed/5476.v b/test-suite/bugs/closed/5476.v
new file mode 100644
index 00000000..b2d9d943
--- /dev/null
+++ b/test-suite/bugs/closed/5476.v
@@ -0,0 +1,28 @@
+Require Setoid.
+
+Goal forall (P : Prop) (T : Type) (m m' : T) (T0 T1 : Type) (P2 : forall _ : 
+Prop, Prop) 
+            (P0 : Set) (x0 : P0) (P1 : forall (_ : P0) (_ : T), Prop)
+            (P3 : forall (_ : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (_ : 
+T) (_ : Prop), Prop)
+            (o : forall _ : P0, option T1)
+            (_ : P3
+                   (fun (k : P0) (_ : T0) (_ : Prop) =>
+                      match o k return Prop with
+                      | Some _ => True
+                      | None => False
+                      end) m' P) (_ : P2 (P1 x0 m))
+            (_ : forall (f : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (m1 m2 
+: T) 
+                        (k : P0) (e : T0) (_ : P2 (P1 k m1)), iff (P3 f m2 P) 
+(f k e (P3 f m1 P))), False.
+Proof.
+  intros ???????????? H0 H H1.
+  rewrite H1 in H0; eauto with nocore.
+  { lazymatch goal with
+    | H : match ?X with _ => _ end |- _
+      => first [ lazymatch goal with
+                 | [ H' : context[X] |- _ ] => idtac H
+                 end
+               | fail 1 "could not find" X ]
+    end.
diff --git a/test-suite/bugs/closed/5486.v b/test-suite/bugs/closed/5486.v
new file mode 100644
index 00000000..39013316
--- /dev/null
+++ b/test-suite/bugs/closed/5486.v
@@ -0,0 +1,15 @@
+Axiom proof_admitted : False.
+Tactic Notation "admit" := abstract case proof_admitted.
+Goal forall (T : Type) (p : prod (prod T T) bool) (Fm : Set) (f : Fm) (k :
+									 forall _ : T, Fm),
+    @eq Fm
+	(k
+	   match p return T with
+	   | pair p0 swap => fst p0
+	   end) f.
+  intros.
+  (* next statement failed in Bug 5486 *)
+  match goal with
+  | [ |- ?f (let (a, b) := ?d in @?e a b) = ?rhs ]
+    => pose (let (a, b) := d in e a b) as t0
+  end.
diff --git a/test-suite/bugs/closed/5487.v b/test-suite/bugs/closed/5487.v
new file mode 100644
index 00000000..9b995f45
--- /dev/null
+++ b/test-suite/bugs/closed/5487.v
@@ -0,0 +1,9 @@
+(* Was a collision between an ltac pattern variable and an evar *)
+
+Goal forall n, exists m, n = m :> nat.
+Proof.
+  eexists.
+  Fail match goal with
+  | [ |- ?x = ?y ]
+    => match x with y => idtac end
+  end.
diff --git a/test-suite/bugs/closed/5501.v b/test-suite/bugs/closed/5501.v
new file mode 100644
index 00000000..24739a36
--- /dev/null
+++ b/test-suite/bugs/closed/5501.v
@@ -0,0 +1,21 @@
+Set Universe Polymorphism.
+
+Record Pred@{A} :=
+  { car :> Type@{A}
+  ; P : car -> Prop
+  }.
+
+Class All@{A} (A : Pred@{A}) : Type :=
+  { proof : forall (a : A), P A a
+  }.
+
+Record Pred_All@{A} : Type :=
+  { P' :> Pred@{A}
+  ; P'_All : All P'
+  }.
+
+Global Instance Pred_All_instance (A : Pred_All) : All A := P'_All A.
+
+Definition Pred_All_proof {A : Pred_All} (a : A) : P A a.
+Proof.
+solve[auto using proof].
diff --git a/test-suite/bugs/closed/5522.v b/test-suite/bugs/closed/5522.v
new file mode 100644
index 00000000..0fae9ede
--- /dev/null
+++ b/test-suite/bugs/closed/5522.v
@@ -0,0 +1,7 @@
+(* Checking support for scope delimiters and as clauses in 'pat
+   applied to notations with binders *)
+
+Notation "'multifun' x .. y 'in' f" := (fun x => .. (fun y => f) .. )
+  (at level 200, x binder, y binder, f at level 200).
+
+Check multifun '((x, y)%core as z) in (x+y,0)=z.
diff --git a/test-suite/bugs/closed/5523.v b/test-suite/bugs/closed/5523.v
new file mode 100644
index 00000000..d7582a37
--- /dev/null
+++ b/test-suite/bugs/closed/5523.v
@@ -0,0 +1,6 @@
+(* Support for complex constructions in recursive notations, especially "match". *)
+
+Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y.
+Notation "'dlet' x , y := v 'in' ( a , b , .. , c )"
+  := (Let_In v (fun '(x, y) => pair .. (pair a b) .. c))
+       (at level 0).
diff --git a/test-suite/bugs/closed/5526.v b/test-suite/bugs/closed/5526.v
new file mode 100644
index 00000000..88f219be
--- /dev/null
+++ b/test-suite/bugs/closed/5526.v
@@ -0,0 +1,3 @@
+Fail Notation "x === x" := (eq_refl x) (at level 10).
+Reserved Notation "x === x" (only printing, at level 10).
+Notation "x === x" := (eq_refl x) (only printing).
diff --git a/test-suite/bugs/closed/5532.v b/test-suite/bugs/closed/5532.v
new file mode 100644
index 00000000..ee5446e5
--- /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/5539.v b/test-suite/bugs/closed/5539.v
new file mode 100644
index 00000000..48e5568e
--- /dev/null
+++ b/test-suite/bugs/closed/5539.v
@@ -0,0 +1,15 @@
+Set Universe Polymorphism.
+
+Inductive D : nat -> Type :=
+| DO : D O
+| DS n : D n -> D (S n).
+
+Fixpoint follow (n : nat) : D n -> Prop :=
+  match n with
+  | O => fun d => let 'DO := d in True
+  | S n' => fun d => (let 'DS _ d' := d in fun f => f d') (follow n')
+  end.
+
+Definition step (n : nat) (d : D n) (H : follow n d) :
+  follow (S n) (DS n d)
+  := H.
diff --git a/test-suite/bugs/closed/5550.v b/test-suite/bugs/closed/5550.v
new file mode 100644
index 00000000..bb122248
--- /dev/null
+++ b/test-suite/bugs/closed/5550.v
@@ -0,0 +1,10 @@
+Section foo.
+
+  Variable bar : Prop.
+  Variable H : bar.
+
+  Goal bar.
+    typeclasses eauto with foobar.
+  Qed.
+
+End foo.
diff --git a/test-suite/bugs/closed/5578.v b/test-suite/bugs/closed/5578.v
new file mode 100644
index 00000000..b9f0bc45
--- /dev/null
+++ b/test-suite/bugs/closed/5578.v
@@ -0,0 +1,57 @@
+(* File reduced by coq-bug-finder from original input, then from 1549 lines to  298 lines, then from 277 lines to 133 lines, then from 985 lines to 138 lines,  then from 206 lines to 139 lines, then from 203 lines to 142 lines, then from  262 lines to 152 lines, then from 567 lines to 151 lines, then from 3746 lines  to 151 lines, then from 577 lines to 151 lines, then from 187 lines to 151  lines, thenfrom 981 lines to 940 lines, then from 938 lines to 175 lines, then  from 589 lines to 205 lines, then from 3797 lines to 205 lines, then from 628  lines to 206 lines, then from 238 lines to 205 lines, then from 1346 lines to  213 lines, then from 633 lines to 214 lines, then from 243 lines to 213 lines,  then from 5656 lines to 245 lines, then from 661 lines to 272 lines, then from  3856 lines to 352 lines, then from 1266 lines to 407 lines, then from 421 lines  to 406 lines, then from 424 lines to 91 lines, then from 105 lines to 91 lines,  then from 85 lines to 55 lines, then from 69 lines to 55 lines *)
+(* coqc version trunk (May 2017) compiled on May 30 2017 13:28:59 with OCaml 
+4.02.3
+   coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-trunk,trunk  (fd36c0451c26e44b1b7e93299d3367ad2d35fee3) *)
+
+Class Proper {A} (R : A -> A -> Prop) (m : A) := mkp : R m m.
+Definition respectful {A B} (R : A -> A -> Prop) (R' : B -> B -> Prop) (f g : A  -> B) := forall x y, R x y -> R' (f x) (g y).
+Set Implicit Arguments.
+
+Class EqDec (A : Set) := {
+  eqb : A -> A -> bool ;
+  eqb_leibniz : forall x y, eqb x y = true <-> x = y
+}.
+
+Infix "?=" := eqb (at level 70) : eq_scope.
+
+Inductive Comp : Set -> Type :=
+| Bind : forall (A B : Set), Comp B -> (B -> Comp A) -> Comp A.
+
+Open Scope eq_scope.
+
+Goal forall (Rat : Set) (PositiveMap_t : Set -> Set)
+            type (t : type) (interp_type_list_message interp_type_rand  interp_type_message : nat -> Set),
+    (forall eta : nat, PositiveMap_t (interp_type_rand eta) ->  interp_type_list_message eta -> interp_type_message eta) ->
+    ((nat -> Rat) -> Prop) ->
+    forall (interp_type_sbool : nat -> Set) (interp_type0 : type -> nat -> Set),
+      (forall eta : nat,
+          (interp_type_list_message eta -> interp_type_message eta) ->  PositiveMap_t (interp_type_rand eta) -> interp_type0 t eta)
+      -> (forall (t0 : type) (eta : nat), EqDec (interp_type0 t0 eta))
+      -> (bool -> Comp bool) -> False.
+  clear.
+  intros Rat PositiveMap_t type t interp_type_list_message interp_type_rand  interp_type_message adv negligible interp_type_sbool
+         interp_type interp_term_fixed_t_x
+         EqDec_interp_type ret_bool.
+  assert (forall f adv' k
+                 (lem : forall (eta : nat) (evil_rands rands : PositiveMap_t 
+(interp_type_rand eta)),
+                     (interp_term_fixed_t_x eta (adv eta evil_rands) rands
+                                            ?= interp_term_fixed_t_x eta (adv  eta evil_rands) rands) = true),
+             (forall (eta : nat), Proper (respectful eq eq) (f eta))
+             -> negligible
+                  (fun eta : nat =>
+                     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)))))).
+  Undo.
+  assert (forall f adv' k
+                 (lem : forall (eta : nat) (rands : PositiveMap_t 
+(interp_type_rand eta)),
+                     (interp_term_fixed_t_x eta (adv' eta) rands ?=  interp_term_fixed_t_x eta (adv' eta) rands) = true),
+             (forall (eta : nat), Proper (respectful eq eq) (f eta))
+             -> negligible
+                  (fun eta : nat =>
+                     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/. *)
diff --git a/test-suite/bugs/closed/5598.v b/test-suite/bugs/closed/5598.v
new file mode 100644
index 00000000..55fef1a5
--- /dev/null
+++ b/test-suite/bugs/closed/5598.v
@@ -0,0 +1,8 @@
+(* Checking when discharge of an existing class is possible *)
+Section foo.
+  Context {T} (a : T) (b : T).
+  Let k := eq_refl a.
+  Existing Class eq.
+  Fail Global Existing Instance k.
+  Existing Instance k.
+End foo.
diff --git a/test-suite/bugs/closed/5608.v b/test-suite/bugs/closed/5608.v
new file mode 100644
index 00000000..f02eae69
--- /dev/null
+++ b/test-suite/bugs/closed/5608.v
@@ -0,0 +1,33 @@
+Reserved Notation "'slet' x .. y := A 'in' b"
+  (at level 200, x binder, y binder, b at level 200, format "'slet'  x .. y  :=  A  'in' '//' b").
+Reserved Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )"
+  (at level 200, format "T  x [1]  =  { A } ; '//' 'return'  ( b0 ,  b1 ,  .. ,  b2 )").
+
+Delimit Scope ctype_scope with ctype.
+Local Open Scope ctype_scope.
+Delimit Scope expr_scope with expr.
+Inductive base_type := TZ | TWord (logsz : nat).
+Inductive flat_type := Tbase (T : base_type) | Prod (A B : flat_type).
+Context {var : base_type -> Type}.
+Fixpoint interp_flat_type (interp_base_type : base_type -> Type) (t : 
+flat_type) :=
+  match t with
+  | Tbase t => interp_base_type t
+  | Prod x y => prod (interp_flat_type interp_base_type x) (interp_flat_type 
+interp_base_type y)
+  end.
+Inductive exprf : flat_type -> Type :=
+| Var {t} (v : var t) : exprf (Tbase t)
+| LetIn {tx} (ex : exprf tx) {tC} (eC : interp_flat_type var tx -> exprf tC) : 
+exprf tC
+| Pair {tx} (ex : exprf tx) {ty} (ey : exprf ty) : exprf (Prod tx ty).
+Global Arguments Var {_} _.
+Global Arguments LetIn {_} _ {_} _.
+Global Arguments Pair {_} _ {_} _.
+Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" := (LetIn (tx:=T) A 
+(fun x => Pair .. (Pair b0%expr b1%expr) .. b2%expr)) : expr_scope.
+Definition foo :=
+  (fun x3 =>
+     (LetIn (Var x3) (fun x18 : var TZ
+                      => (Pair (Var x18) (Var x18))))).
+Print foo.
diff --git a/test-suite/bugs/closed/5618.v b/test-suite/bugs/closed/5618.v
new file mode 100644
index 00000000..47e0e92d
--- /dev/null
+++ b/test-suite/bugs/closed/5618.v
@@ -0,0 +1,9 @@
+Require Import FunInd.
+
+Function test {T} (v : T) (x : nat) : nat :=
+  match x with
+  | 0 => 0
+  | S x' => test v x'
+  end.
+
+Check R_test_complete.
diff --git a/test-suite/bugs/closed/5641.v b/test-suite/bugs/closed/5641.v
new file mode 100644
index 00000000..9f3246f3
--- /dev/null
+++ b/test-suite/bugs/closed/5641.v
@@ -0,0 +1,6 @@
+Set Universe Polymorphism.
+
+Definition foo@{i j} (A : Type@{i}) : Type@{j}.
+Proof.
+abstract (exact ltac:(abstract (exact A))).
+Defined.
diff --git a/test-suite/bugs/closed/5666.v b/test-suite/bugs/closed/5666.v
new file mode 100644
index 00000000..d55a6e57
--- /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/5671.v b/test-suite/bugs/closed/5671.v
new file mode 100644
index 00000000..c9a08504
--- /dev/null
+++ b/test-suite/bugs/closed/5671.v
@@ -0,0 +1,7 @@
+(* Fixing Meta-unclean specialize *)
+
+Require Import Setoid.
+Axiom a : forall x, x=0 -> True.
+Lemma lem (x y1 y2:nat) (H:x=0) (H0:eq y1 y2) : y1 = y2.
+specialize a with (1:=H). clear H x. intros _.
+setoid_rewrite H0.
diff --git a/test-suite/bugs/closed/5683.v b/test-suite/bugs/closed/5683.v
new file mode 100644
index 00000000..b5c6a48e
--- /dev/null
+++ b/test-suite/bugs/closed/5683.v
@@ -0,0 +1,71 @@
+Require Import Program.Tactics.
+Require Import FunctionalExtensionality.
+
+Inductive Succ A :=
+| Succ_O : Succ A
+| Succ_S : A -> Succ A.
+Arguments Succ_O {A}.
+Arguments Succ_S {A} _.
+
+Inductive Zero : Type :=.
+
+Inductive ty :=
+| ty_nat : ty
+| ty_arr : ty -> ty -> ty.
+
+Inductive term A :=
+| term_abs : ty -> term (Succ A) -> term A
+| term_app : term A -> term A -> term A
+| term_var : A -> term A
+| term_nat : nat -> term A.
+Arguments term_abs {A} _ _.
+Arguments term_app {A} _ _.
+Arguments term_var {A} _.
+Arguments term_nat {A} _.
+
+Class Functor F :=
+{
+  ret : forall {A}, A -> F A;
+  fmap : forall {A B}, (A -> B) -> F A -> F B;
+  fmap_id : forall {A} (fa : F A), fmap (@id A) fa = fa;
+  fmap_compose : forall {A B C} (fa : F A) (g : B -> C) (h : A -> B), fmap (fun
+a => g (h a)) fa = fmap g (fmap h fa)
+}.
+
+Class Monad M `{Functor M} :=
+{
+  bind : forall {A B}, M A -> (A -> M B) -> M B;
+  ret_left_id : forall {A B} (a : A) (f : A -> M B), bind (ret a) f = f a;
+  ret_right_id : forall {A} (m : M A), bind m ret = m;
+  bind_assoc : forall {A B C} (m : M A) (f : A -> M B) (g : B -> M C), bind
+(bind m f) g = bind m (fun x => bind (f x) g)
+}.
+
+Instance Succ_Functor : Functor Succ.
+Proof.
+  unshelve econstructor.
+  - intros A B f fa.
+    destruct fa.
+    + apply Succ_O.
+    + apply Succ_S. tauto.
+  - intros. apply Succ_S. assumption.
+  - intros A [|a]; reflexivity.
+  - intros A B C [|a] g h; reflexivity.
+Defined.
+
+(* Anomaly: Not an arity *)
+Program Fixpoint term_bind {A B} (tm : term A) (f : A -> term B) : term B :=
+    let Succ_f (var : Succ A) :=
+        match var with
+        | Succ_O => term_var Succ_O
+        | Succ_S var' => _
+        end in
+    match tm with
+    | term_app tm1 tm2 => term_app (term_bind tm1 f) (term_bind tm2 f)
+    | term_abs ty body => term_abs ty (term_bind body Succ_f)
+    | term_var a => f a
+    | term_nat n => term_nat n
+    end.
+Next Obligation.
+  intros.
+Admitted.
diff --git a/test-suite/bugs/closed/5692.v b/test-suite/bugs/closed/5692.v
new file mode 100644
index 00000000..4c8d464f
--- /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/5697.v b/test-suite/bugs/closed/5697.v
new file mode 100644
index 00000000..c653f992
--- /dev/null
+++ b/test-suite/bugs/closed/5697.v
@@ -0,0 +1,19 @@
+Set Primitive Projections.
+
+Record foo : Type := Foo { foo_car: nat }.
+
+Goal forall x y : nat, x <> y -> Foo x <> Foo y.
+Proof.
+intros.
+intros H'.
+congruence.
+Qed.
+
+Record bar (A : Type) : Type := Bar { bar_car: A }.
+
+Goal forall x y : nat, x <> y -> Bar nat x <> Bar nat y.
+Proof.
+intros.
+intros H'.
+congruence.
+Qed.
diff --git a/test-suite/bugs/closed/5707.v b/test-suite/bugs/closed/5707.v
new file mode 100644
index 00000000..785844c6
--- /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 00000000..9daf9647
--- /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 00000000..1bfd917d
--- /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 00000000..53ef4735
--- /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 00000000..f6598f19
--- /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 00000000..81bfe351
--- /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 00000000..6d0e21f5
--- /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 00000000..e07fdcf8
--- /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 00000000..0d0f2eed
--- /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 00000000..6f28d198
--- /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 00000000..55d36bd7
--- /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 00000000..343ab493
--- /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 00000000..42573aad
--- /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 00000000..20301ec4
--- /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 00000000..6c93a390
--- /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 ee5ec1fa..ee5ec1fa 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 ea3347a8..ea3347a8 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 32c78b4b..32c78b4b 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 00000000..49b16f62
--- /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 00000000..e4a2a2ba
--- /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 00000000..e0d91250
--- /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 00000000..a2860705
--- /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/6313.v b/test-suite/bugs/closed/6313.v
new file mode 100644
index 00000000..4d263c5a
--- /dev/null
+++ b/test-suite/bugs/closed/6313.v
@@ -0,0 +1,64 @@
+(* Former open goals in nested proofs were lost *)
+
+(* This used to fail with "Incorrect number of goals (expected 1 tactic)." *)
+
+Inductive foo := a | b | c.
+Goal foo -> foo.
+  intro x.
+  simple refine (match x with
+                 | a => _
+                 | b => ltac:(exact b)
+                 | c => _
+                 end); [exact a|exact c].
+Abort.
+
+(* This used to leave the goal on the shelf and fails at reflexivity *)
+
+Goal (True/\0=0 -> True) -> True.
+  intro f.
+  refine
+   (f ltac:(split; only 1:exact I)).
+  reflexivity.
+Qed.
+
+(* The "Unshelve" used to not see the explicitly "shelved" goal *)
+
+Lemma f (b:comparison) : b=b.
+refine (match b with
+   Eq => ltac:(shelve)
+ | Lt => ltac:(give_up)
+ | Gt => _
+ end).
+exact (eq_refl Gt).
+Unshelve.
+exact (eq_refl Eq).
+Fail auto. (* Check that there are no more regular subgoals *)
+Admitted.
+
+(* The "Unshelve" used to not see the explicitly "shelved" goal *)
+
+Lemma f2 (b:comparison) : b=b.
+refine (match b with
+   Eq => ltac:(shelve)
+ | Lt => ltac:(give_up)
+ | Gt => _
+ end).
+Unshelve. (* Note: Unshelve puts goals at the end *)
+exact (eq_refl Gt).
+exact (eq_refl Eq).
+Fail auto. (* Check that there are no more regular subgoals *)
+Admitted.
+
+(* The "unshelve" used to not see the explicitly "shelved" goal *)
+
+Lemma f3 (b:comparison) : b=b.
+unshelve refine (match b with
+   Eq => ltac:(shelve)
+ | Lt => ltac:(give_up)
+ | Gt => _
+ end).
+(* Note: unshelve puts goals at the beginning *)
+exact (eq_refl Eq).
+exact (eq_refl Gt).
+Fail auto. (* Check that there are no more regular subgoals *)
+Admitted.
diff --git a/test-suite/bugs/closed/6323.v b/test-suite/bugs/closed/6323.v
new file mode 100644
index 00000000..fdc33bef
--- /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 00000000..68ae7961
--- /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 00000000..dcf9ff29
--- /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 00000000..8d908199
--- /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 00000000..f5013994
--- /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 00000000..9cabd62d
--- /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/6631.v b/test-suite/bugs/closed/6631.v
new file mode 100644
index 00000000..100dc13f
--- /dev/null
+++ b/test-suite/bugs/closed/6631.v
@@ -0,0 +1,7 @@
+Require Import Coq.derive.Derive.
+
+Derive f SuchThat (f = 1 + 1) As feq.
+Proof.
+  transitivity 2; [refine (eq_refl 2)|].
+  transitivity 2.
+  2:abstract exact (eq_refl 2).
diff --git a/test-suite/bugs/closed/6634.v b/test-suite/bugs/closed/6634.v
new file mode 100644
index 00000000..7f33afcc
--- /dev/null
+++ b/test-suite/bugs/closed/6634.v
@@ -0,0 +1,6 @@
+From Coq Require Import ssreflect.
+
+Lemma normalizeP (p : tt = tt) : p = p.
+Proof.
+Fail move: {2} tt p.
+Abort.
diff --git a/test-suite/bugs/closed/6661.v b/test-suite/bugs/closed/6661.v
new file mode 100644
index 00000000..e88a3704
--- /dev/null
+++ b/test-suite/bugs/closed/6661.v
@@ -0,0 +1,259 @@
+(* -*- mode: coq; coq-prog-args: ("-noinit" "-indices-matter" "-w" "-notation-overridden,-deprecated-option") -*- *)
+(*
+    The Coq Proof Assistant, version 8.7.1 (January 2018)
+    compiled on Jan 21 2018 15:02:24 with OCaml 4.06.0
+    from commit 391bb5e196901a3a9426295125b8d1c700ab6992
+ *)
+
+
+Require Export Coq.Init.Notations.
+Notation "'�'  x .. y , P" := (forall x, .. (forall y, P) ..)
+  (at level 200, x binder, y binder, right associativity) : type_scope.
+Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..)
+  (at level 200, x binder, y binder, right associativity).
+Notation "A -> B" := (forall (_ : A), B) : type_scope.
+Reserved Notation "p @ q" (at level 60, right associativity).
+Reserved Notation "! p " (at level 50).
+
+Monomorphic Universe uu.
+Monomorphic Universe uu0.
+Monomorphic Universe uu1.
+Constraint uu0 < uu1.
+
+Global Set Universe Polymorphism.
+Global Set Polymorphic Inductive Cumulativity.
+Global Unset Universe Minimization ToSet.
+
+Notation UU  := Type (only parsing).
+Notation UU0 := Type@{uu0} (only parsing).
+
+Global Set Printing Universes.
+
+ Inductive unit : UU0 := tt : unit.
+
+Inductive paths@{i} {A:Type@{i}} (a:A) : A -> Type@{i} := idpath : paths a a.
+Hint Resolve idpath : core .
+Notation "a = b" := (paths a b) (at level 70, no associativity) : type_scope.
+
+Set Primitive Projections.
+Set Nonrecursive Elimination Schemes.
+
+Record total2@{i} { T: Type@{i} } ( P: T -> Type@{i} ) : Type@{i}
+  := tpair { pr1 : T; pr2 : P pr1 }.
+
+Arguments tpair {_} _ _ _.
+Arguments pr1 {_ _} _.
+Arguments pr2 {_ _} _.
+
+Notation "'∑'  x .. y , P" := (total2 (λ x, .. (total2 (λ y, P)) ..))
+  (at level 200, x binder, y binder, right associativity) : type_scope.
+
+Definition foo (X:Type) (xy : @total2 X (λ _, X)) : X.
+  induction xy as [x y].
+  exact x.
+Defined.
+
+Unset Automatic Introduction.
+
+Definition idfun (T : UU) := λ t:T, t.
+
+Definition pathscomp0 {X : UU} {a b c : X} (e1 : a = b) (e2 : b = c) : a = c.
+Proof.
+  intros. induction e1. exact e2.
+Defined.
+
+Hint Resolve @pathscomp0 : pathshints.
+
+Notation "p @ q" := (pathscomp0 p q).
+
+Definition pathsinv0 {X : UU} {a b : X} (e : a = b) : b = a.
+Proof.
+  intros. induction e. exact (idpath _).
+Defined.
+
+Notation "! p " := (pathsinv0 p).
+
+Definition maponpaths {T1 T2 : UU} (f : T1 -> T2) {t1 t2 : T1}
+           (e: t1 = t2) : f t1 = f t2.
+Proof.
+  intros. induction e. exact (idpath _).
+Defined.
+
+Definition map_on_two_paths {X Y Z : UU} (f : X -> Y -> Z) {x x' y y'} (ex : x = x') (ey: y = y') :
+  f x y = f x' y'.
+Proof.
+  intros. induction ex. induction ey. exact (idpath _).
+Defined.
+
+
+Definition maponpathscomp0 {X Y : UU} {x1 x2 x3 : X}
+           (f : X -> Y) (e1 : x1 = x2) (e2 : x2 = x3) :
+  maponpaths f (e1 @ e2) = maponpaths f e1 @ maponpaths f e2.
+Proof.
+  intros. induction e1. induction e2. exact (idpath _).
+Defined.
+
+Definition maponpathsinv0 {X Y : UU} (f : X -> Y)
+           {x1 x2 : X} (e : x1 = x2) : maponpaths f (! e) = ! (maponpaths f e).
+Proof.
+  intros. induction e. exact (idpath _).
+Defined.
+
+
+
+Definition constr1 {X : UU} (P : X -> UU) {x x' : X} (e : x = x') :
+  ∑ (f : P x -> P x'),
+  ∑ (ee : � p : P x, tpair _ x p = tpair _ x' (f p)),
+  � (pp : P x), maponpaths pr1 (ee pp) = e.
+Proof.
+  intros. induction e.
+  split with (idfun (P x)).
+  split with (λ p, idpath _).
+  unfold maponpaths. simpl.
+  intro. exact (idpath _).
+Defined.
+
+Definition transportf@{i} {X : Type@{i}} (P : X -> Type@{i}) {x x' : X}
+           (e : x = x') : P x -> P x' := pr1 (constr1 P e).
+
+Lemma two_arg_paths_f@{i} {A : Type@{i}} {B : A -> Type@{i}} {C:Type@{i}} {f : � a, B a -> C} {a1 b1 a2 b2}
+      (p : a1 = a2) (q : transportf B p b1 = b2) : f a1 b1 = f a2 b2.
+Proof.
+  intros. induction p. induction q. exact (idpath _).
+Defined.
+
+Definition iscontr@{i} (T:Type@{i}) : Type@{i} := ∑ cntr:T, � t:T, t=cntr.
+
+Lemma proofirrelevancecontr {X : UU} (is : iscontr X) (x x' : X) : x = x'.
+Proof.
+  intros.
+  induction is as [y fe].
+  exact (fe x @ !(fe x')).
+Defined.
+
+
+Definition hfiber@{i} {X Y : Type@{i}} (f : X -> Y) (y : Y) : Type@{i} := total2 (λ x, f x = y).
+
+Definition hfiberpair {X Y : UU} (f : X -> Y) {y : Y}
+           (x : X) (e : f x = y) : hfiber f y :=
+  tpair _ x e.
+
+Definition coconustot (T : UU) (t : T) := ∑ t' : T, t' = t.
+
+Definition coconustotpair (T : UU) {t t' : T} (e: t' = t) : coconustot T t
+  := tpair _ t' e.
+
+Lemma connectedcoconustot {T : UU} {t : T} (c1 c2 : coconustot T t) : c1 = c2.
+Proof.
+  intros.
+  induction c1 as [x0 x].
+  induction x.
+  induction c2 as [x1 y].
+  induction y.
+  exact (idpath _).
+Defined.
+
+Definition isweq@{i} {X Y : Type@{i}} (f : X -> Y) : Type@{i} :=
+  � y : Y, iscontr (hfiber f y).
+
+Lemma isProofIrrelevantUnit : � x x' : unit, x = x'.
+Proof.
+  intros. induction x. induction x'. exact (idpath _).
+Defined.
+
+Lemma unitl0 : tt = tt -> coconustot _ tt.
+Proof.
+  intros e. exact (coconustotpair unit e).
+Defined.
+
+Lemma unitl1: coconustot _ tt -> tt = tt.
+Proof.
+  intro cp. induction cp as [x t]. induction x. exact t.
+Defined.
+
+Lemma unitl2: � e : tt = tt, unitl1 (unitl0 e) = e.
+Proof.
+  intros. unfold unitl0. simpl. exact (idpath _).
+Defined.
+
+Lemma unitl3: � e : tt = tt, e = idpath tt.
+Proof.
+  intros.
+
+  assert (e0 : unitl0 (idpath tt) = unitl0 e).
+  { simple refine (connectedcoconustot _ _). }
+
+  set (e1 := maponpaths unitl1 e0).
+
+  exact (! (unitl2 e) @ (! e1) @ (unitl2 (idpath _))).
+Defined.
+
+Theorem iscontrpathsinunit (x x' : unit) : iscontr (x = x').
+Proof.
+  intros.
+  split with (isProofIrrelevantUnit x x').
+  intros e'.
+  induction x.
+  induction x'.
+  simpl.
+  apply unitl3.
+Qed.
+
+Lemma ifcontrthenunitl0 (e1 e2 : tt = tt) : e1 = e2.
+Proof.
+  intros.
+  simple refine (proofirrelevancecontr _ _ _).
+  exact (iscontrpathsinunit tt tt).
+Qed.
+
+Section isweqcontrtounit.
+
+  Universe i.
+
+  (* To see the bug, run it both with and without this constraint: *)
+
+  (* Constraint uu0 < i. *)
+
+  (* Without this constraint, we get i = uu0 in the next definition *)
+  Lemma isweqcontrtounit@{} {T : Type@{i}} (is : iscontr@{i} T) : isweq@{i} (λ _:T, tt).
+  Proof.
+    intros. intro y. induction y.
+    induction is as [c h].
+    split with (hfiberpair@{i i i} _ c (idpath tt)).
+    intros ha.
+    induction ha as [x e].
+    simple refine (two_arg_paths_f (h x) _).
+    simple refine (ifcontrthenunitl0 _ _).
+  Defined.
+
+  (*
+     Explanation of the bug:
+
+     With the constraint uu0 < i above we get:
+
+            |= uu0 <= bug.3
+               uu0 <= i
+               uu1 <= i
+               i <= bug.3
+
+     from this print statement: *)
+
+         Print isweqcontrtounit.
+
+  (*
+
+     Without the constraint uu0 < i above we get:
+
+            |= i <= bug.3
+               uu0 = i
+
+     Since uu0 = i is not inferred when we impose the constraint uu0 < i,
+     it is invalid to infer it when we don't.
+
+   *)
+
+  Context (X : Type@{uu1}).
+
+  Check (@isweqcontrtounit X). (* detect a universe inconsistency *)
+
+End isweqcontrtounit.
diff --git a/test-suite/bugs/closed/6677.v b/test-suite/bugs/closed/6677.v
new file mode 100644
index 00000000..99e47bb8
--- /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/6770.v b/test-suite/bugs/closed/6770.v
new file mode 100644
index 00000000..9bcc7408
--- /dev/null
+++ b/test-suite/bugs/closed/6770.v
@@ -0,0 +1,7 @@
+Section visibility.
+
+  Let Fixpoint by_proof (n:nat) : True.
+  Proof. exact I. Defined.
+End visibility.
+
+Fail Check by_proof.
diff --git a/test-suite/bugs/closed/6774.v b/test-suite/bugs/closed/6774.v
new file mode 100644
index 00000000..9625af91
--- /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/6775.v b/test-suite/bugs/closed/6775.v
new file mode 100644
index 00000000..206df23b
--- /dev/null
+++ b/test-suite/bugs/closed/6775.v
@@ -0,0 +1,43 @@
+(* Issue caused and fixed during the lifetime of #6775: unification
+   failing on partially applied cumulative inductives. *)
+
+Set Universe Polymorphism.
+
+Set Polymorphic Inductive Cumulativity.
+
+Unset Elimination Schemes.
+
+Inductive paths@{i} {A : Type@{i}} (a : A) : A -> Type@{i} :=
+  idpath : paths a a.
+
+Arguments idpath {A a} , [A] a.
+
+Notation "x = y :> A" := (@paths A x y) : type_scope.
+Notation "x = y" := (x = y :>_) : type_scope.
+
+Definition inverse {A : Type} {x y : A} (p : x = y) : y = x
+  := match p with idpath => idpath end.
+
+Arguments inverse {A x y} p : simpl nomatch.
+
+Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z :=
+  match p, q with idpath, idpath => idpath end.
+
+Arguments concat {A x y z} p q : simpl nomatch.
+
+Notation "1" := idpath.
+
+Reserved Notation "p @ q" (at level 20).
+Notation "p @ q" := (concat p q).
+
+Reserved Notation "p ^" (at level 3, format "p '^'").
+Notation "p ^" := (inverse p).
+
+Definition concat_pV_p {A} {x y z : A} (p : x = z) (q : y = z) :
+  (p @ q^) @ q = p
+  :=
+  (match q as i return forall p, (p @ i^) @ i = p with
+    idpath =>
+    fun p =>
+      match p with idpath => 1 end
+  end) p.
diff --git a/test-suite/bugs/closed/6878.v b/test-suite/bugs/closed/6878.v
new file mode 100644
index 00000000..70f1b312
--- /dev/null
+++ b/test-suite/bugs/closed/6878.v
@@ -0,0 +1,8 @@
+
+Set Universe Polymorphism.
+Module Type T.
+  Axiom foo : Prop.
+End T.
+
+(** Used to anomaly *)
+Fail Module M : T with Definition foo := Type.
diff --git a/test-suite/bugs/closed/6910.v b/test-suite/bugs/closed/6910.v
new file mode 100644
index 00000000..5167a536
--- /dev/null
+++ b/test-suite/bugs/closed/6910.v
@@ -0,0 +1,5 @@
+From Coq Require Import ssreflect ssrfun.
+
+(* We should be able to use Some_inj as a view: *)
+Lemma foo (x y : nat) : Some x = Some y -> x = y.
+Proof. by move/Some_inj. Qed.
diff --git a/test-suite/bugs/closed/6951.v b/test-suite/bugs/closed/6951.v
new file mode 100644
index 00000000..419f8d7c
--- /dev/null
+++ b/test-suite/bugs/closed/6951.v
@@ -0,0 +1,2 @@
+Record float2 : Set := Float2 { Fnum : unit }.
+Scheme Equality for float2.
diff --git a/test-suite/bugs/closed/6956.v b/test-suite/bugs/closed/6956.v
new file mode 100644
index 00000000..ee21adbb
--- /dev/null
+++ b/test-suite/bugs/closed/6956.v
@@ -0,0 +1,13 @@
+(** Used to trigger an anomaly with VM compilation *)
+
+Set Universe Polymorphism.
+
+Inductive t A : nat -> Type :=
+| nil : t A 0
+| cons : forall (h : A) (n : nat), t A n -> t A (S n).
+
+Definition case0 {A} (P : t A 0 -> Type) (H : P (nil A)) v : P v :=
+match v with
+| nil _ => H
+| _ => fun devil => False_ind (@IDProp) devil
+end.
diff --git a/test-suite/bugs/closed/7113.v b/test-suite/bugs/closed/7113.v
new file mode 100644
index 00000000..976e60f2
--- /dev/null
+++ b/test-suite/bugs/closed/7113.v
@@ -0,0 +1,10 @@
+Require Import Program.Tactics.
+Section visibility.
+
+  (* used to anomaly *)
+  Program Let Fixpoint ev' (n : nat) : bool := _.
+  Next Obligation. exact true. Qed.
+
+  Check ev'.
+End visibility.
+Fail Check ev'.
diff --git a/test-suite/bugs/closed/7195.v b/test-suite/bugs/closed/7195.v
new file mode 100644
index 00000000..ea97747a
--- /dev/null
+++ b/test-suite/bugs/closed/7195.v
@@ -0,0 +1,12 @@
+(* A disjoint-names condition was missing when matching names in Ltac
+   pattern-matching *)
+
+Goal True.
+  let x := (eval cbv beta zeta in (fun P => let Q := P in fun P => P + Q)) in
+  unify x (fun a b => b + a); (* success *)
+    let x' := lazymatch x with
+              | (fun (a : ?A) (b : ?B) => ?k)
+                => constr:(fun (a : A) (b : B) => k)
+              end in
+    unify x x'.
+Abort.
diff --git a/test-suite/bugs/closed/7392.v b/test-suite/bugs/closed/7392.v
new file mode 100644
index 00000000..cf465c65
--- /dev/null
+++ b/test-suite/bugs/closed/7392.v
@@ -0,0 +1,9 @@
+Inductive R : nat -> Prop := ER : forall n, R n -> R (S n).
+
+Goal (forall (n : nat), R n -> False) -> True -> False.
+Proof.
+intros H0 H1.
+eapply H0.
+clear H1.
+apply ER.
+simpl.
diff --git a/test-suite/bugs/closed/7462.v b/test-suite/bugs/closed/7462.v
new file mode 100644
index 00000000..40ca39e3
--- /dev/null
+++ b/test-suite/bugs/closed/7462.v
@@ -0,0 +1,13 @@
+(* Adding an only-printing notation should not override existing
+   interpretations for the same notation. *)
+
+Notation "$ x" := (@id nat x) (only parsing, at level 0).
+Notation "$ x" := (@id bool x) (only printing, at level 0).
+Check $1. (* Was: Error: Unknown interpretation for notation "$ _". *)
+
+(* Adding an only-printing notation should not let believe
+   that a parsing rule has been given *)
+
+Notation "$ x" := (@id bool x) (only printing, at level 0).
+Notation "$ x" := (@id nat x) (only parsing, at level 0).
+Check $1. (* Was: Error: Syntax Error: Lexer: Undefined token *)
diff --git a/test-suite/bugs/closed/7554.v b/test-suite/bugs/closed/7554.v
new file mode 100644
index 00000000..12b0aa2c
--- /dev/null
+++ b/test-suite/bugs/closed/7554.v
@@ -0,0 +1,12 @@
+Require Import Coq.Program.Tactics.
+
+(* these should not result in anomalies *)
+
+Fail Program Lemma foo:
+  forall P, forall H, forall (n:nat), P n.
+
+Fail Program Lemma foo:
+  forall a (P : list a -> Prop), forall H, forall (n:list a), P n.
+
+Fail Program Lemma foo:
+  forall (a : Type) (P : list a -> Prop), forall H, forall (n:list a), P n.
diff --git a/test-suite/bugs/closed/7615.v b/test-suite/bugs/closed/7615.v
new file mode 100644
index 00000000..cd8c4ad7
--- /dev/null
+++ b/test-suite/bugs/closed/7615.v
@@ -0,0 +1,19 @@
+Set Universe Polymorphism.
+
+Module Type S.
+Parameter Inline T@{i} : Type@{i+1}.
+End S.
+
+Module F (X : S).
+Definition X@{j i} : Type@{j} := X.T@{i}.
+End F.
+
+Module M.
+Definition T@{i} := Type@{i}.
+End M.
+
+Module N := F(M).
+
+Require Import Hurkens.
+
+Fail Definition eqU@{i j} : @eq Type@{j} N.X@{i Set} Type@{i} := eq_refl.
diff --git a/test-suite/bugs/closed/7631.v b/test-suite/bugs/closed/7631.v
new file mode 100644
index 00000000..34eb8b86
--- /dev/null
+++ b/test-suite/bugs/closed/7631.v
@@ -0,0 +1,21 @@
+Module NamedContext.
+
+Definition foo := true.
+
+Section Foo.
+
+Let bar := foo.
+
+Eval native_compute in bar.
+
+End Foo.
+
+End NamedContext.
+
+Module RelContext.
+
+Definition foo := true.
+
+Definition bar (x := foo) := Eval native_compute in x.
+
+End RelContext.
diff --git a/test-suite/bugs/closed/7695.v b/test-suite/bugs/closed/7695.v
new file mode 100644
index 00000000..42bdb076
--- /dev/null
+++ b/test-suite/bugs/closed/7695.v
@@ -0,0 +1,20 @@
+Require Import Hurkens.
+
+Universes i j k.
+Module Type T.
+  Parameter T1 : Type@{i+1}.
+  Parameter e : Type@{j} = T1 : Type@{k}.
+End T.
+
+Module M.
+  Definition T1 := Type@{j}.
+  Definition e : Type@{j} = T1 : Type@{k} := eq_refl.
+End M.
+
+Module F (A:T).
+  Definition bad := TypeNeqSmallType.paradox _ A.e.
+End F.
+
+Set Printing Universes.
+Fail Module X := F M.
+(* Universe inconsistency. Cannot enforce j <= i because i < Coq.Logic.Hurkens.105 = j. *)
diff --git a/test-suite/bugs/closed/7700.v b/test-suite/bugs/closed/7700.v
new file mode 100644
index 00000000..56f5481b
--- /dev/null
+++ b/test-suite/bugs/closed/7700.v
@@ -0,0 +1,9 @@
+(* Abbreviations to section variables were not located *)
+Section foo.
+  Let x := Set.
+  Notation y := x.
+  Check y.
+  Variable x' : Set.
+  Notation y' := x'.
+  Check y'.
+End foo.
diff --git a/test-suite/bugs/closed/7712.v b/test-suite/bugs/closed/7712.v
new file mode 100644
index 00000000..a4e9697f
--- /dev/null
+++ b/test-suite/bugs/closed/7712.v
@@ -0,0 +1,4 @@
+(* This used to raise an anomaly *)
+
+Fail Reserved Notation "'[tele_arg' x ';' .. ';' z ]"
+       (format "[tele_arg '[hv'  x .. z ']' ]").
diff --git a/test-suite/bugs/closed/7723.v b/test-suite/bugs/closed/7723.v
new file mode 100644
index 00000000..21629012
--- /dev/null
+++ b/test-suite/bugs/closed/7723.v
@@ -0,0 +1,58 @@
+Set Universe Polymorphism.
+
+Module Segfault.
+
+Inductive decision_tree : Type := .
+
+Fixpoint first_satisfying_helper {A B} (f : A -> option B) (ls : list A) : option B
+  := match ls with
+     | nil => None
+     | cons x xs
+       => match f x with
+          | Some v => Some v
+          | None => first_satisfying_helper f xs
+          end
+     end.
+
+Axiom admit : forall {T}, T.
+Definition dtree4 : option decision_tree :=
+  match first_satisfying_helper (fun pat : nat => Some pat) (cons 0 nil)
+  with
+  | Some _ => admit
+  | None => admit
+  end
+.
+Definition dtree'' := Eval vm_compute in dtree4. (* segfault *)
+
+End Segfault.
+
+Module OtherExample.
+
+Definition bar@{i} := Type@{i}.
+Definition foo@{i j} (x y z : nat) :=
+  @id Type@{j} bar@{i}.
+Eval vm_compute in foo.
+
+End OtherExample.
+
+Module LocalClosure.
+
+Definition bar@{i} := Type@{i}.
+
+Definition foo@{i j} (x y z : nat) :=
+  @id (nat -> Type@{j}) (fun _ => Type@{i}).
+Eval vm_compute in foo.
+
+End LocalClosure.
+
+Require Import Hurkens.
+Polymorphic Inductive unit := tt.
+
+Polymorphic Definition foo :=
+  let x := id tt in (x, x, Type).
+
+Lemma bad : False.
+  refine (TypeNeqSmallType.paradox (snd foo) _).
+  vm_compute.
+  Fail reflexivity.
+Abort.
diff --git a/test-suite/bugs/closed/7779.v b/test-suite/bugs/closed/7779.v
new file mode 100644
index 00000000..78936b59
--- /dev/null
+++ b/test-suite/bugs/closed/7779.v
@@ -0,0 +1,15 @@
+(* Checking that the "in" clause takes the "eqn" clause into account *)
+
+Definition test (x: nat): {y: nat | False }. Admitted.
+
+Parameter x: nat.
+Parameter z: nat.
+
+Goal
+  proj1_sig (test x) = z ->
+  False.
+Proof.
+  intro H.
+  destruct (test x) eqn:Heqs in H.
+  change (test x = exist (fun _ : nat => False) x0 f) in Heqs. (* Check it has the expected statement *)
+Abort.
diff --git a/test-suite/bugs/closed/7780.v b/test-suite/bugs/closed/7780.v
new file mode 100644
index 00000000..2318f4d6
--- /dev/null
+++ b/test-suite/bugs/closed/7780.v
@@ -0,0 +1,16 @@
+(* A lift was missing in expanding aliases under binders for unification *)
+
+(* Below, the lift was missing while expanding the reference to
+   [mkcons] in [?N] which was under binder [arg] *)
+
+Goal forall T (t : T) (P P0 : T -> Set), option (option (list (P0 t)) -> option (list (P t))).
+  intros ????.
+  refine (Some
+            (fun rls
+             => let mkcons := ?[M] in
+                let default arg := ?[N] in
+                match rls as rls (* 2 *) return option (list (P ?[O])) with
+                | Some _ => None
+                | None => None
+                end)).
+Abort.
diff --git a/test-suite/bugs/closed/7795.v b/test-suite/bugs/closed/7795.v
new file mode 100644
index 00000000..5db0f81c
--- /dev/null
+++ b/test-suite/bugs/closed/7795.v
@@ -0,0 +1,65 @@
+
+
+Definition fwd (b: bool) A (e2: A): A. Admitted.
+
+Ltac destruct_refinement_aux T :=
+  let m := fresh "mres" in
+  let r := fresh "r" in
+  let P := fresh "P" in
+  pose T as m;
+  destruct m as [ r P ].
+
+Ltac destruct_refinement :=
+  match goal with
+  | |- context[proj1_sig ?T] => destruct_refinement_aux T
+  end.
+
+Ltac t_base := discriminate || destruct_refinement.
+
+
+Inductive List (T: Type) :=
+| Cons_construct: T -> List T -> List T
+| Nil_construct: List T.
+
+Definition t (T: Type): List T. Admitted.
+Definition size (T: Type) (src: List T): nat. Admitted.
+Definition filter1_rt1_type (T: Type): Type := { res: List T | false = true }.
+Definition filter1 (T: Type): filter1_rt1_type T. Admitted.
+
+Definition hh_1:
+  forall T : Type,
+    (forall (T0 : Type),
+     False -> filter1_rt1_type T0) ->
+     False.
+Admitted.
+
+Definition hh_2:
+  forall (T : Type),
+    filter1_rt1_type T ->
+    filter1_rt1_type T.
+Admitted.
+
+Definition hh:
+  forall (T : Type) (f1 : forall (T0 : Type), False -> filter1_rt1_type T0),
+       fwd
+         (Nat.leb
+               (size T
+                  (fwd false (List T)
+                     (fwd false (List T)
+                        (proj1_sig
+                           (hh_2 T
+                              (f1 T (hh_1 T f1))))))) 0) bool
+         false = true.
+Admitted.
+
+Set Program Mode. (* removing this line prevents the bug *)
+Obligation Tactic := repeat t_base.
+
+Goal
+  forall T (h17: T),
+    filter1 T =
+    exist
+      _
+      (Nil_construct T)
+      (hh T (fun (T : Type) (_ : False) => filter1 T)).
+Abort.
diff --git a/test-suite/bugs/closed/7811.v b/test-suite/bugs/closed/7811.v
new file mode 100644
index 00000000..fee330f2
--- /dev/null
+++ b/test-suite/bugs/closed/7811.v
@@ -0,0 +1,114 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-top" "atomic" "-Q" "." "iris" "-R" "." "stdpp") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 140 lines to 26 lines, then from 141 lines to 27 lines, then from 142 lines to 27 lines, then from 272 lines to 61 lines, then from 291 lines to 94 lines, then from 678 lines to 142 lines, then from 418 lines to 161 lines, then from 538 lines to 189 lines, then from 840 lines to 493 lines, then from 751 lines to 567 lines, then from 913 lines to 649 lines, then from 875 lines to 666 lines, then from 784 lines to 568 lines, then from 655 lines to 173 lines, then from 317 lines to 94 lines, then from 172 lines to 86 lines, then from 102 lines to 86 lines, then from 130 lines to 86 lines, then from 332 lines to 112 lines, then from 279 lines to 111 lines, then from 3996 lines to 5697 lines, then from 153 lines to 117 lines, then from 146 lines to 108 lines, then from 124 lines to 108 lines *)
+(* coqc version 8.8.0 (May 2018) compiled on May 2 2018 16:49:46 with OCaml 4.02.3
+   coqtop version 8.8.0 (May 2018) *)
+
+(* This was triggering a "Not_found" at the time of printing/showing the goal *)
+
+Require Coq.Unicode.Utf8.
+
+Notation "t $ r" := (t r)
+  (at level 65, right associativity, only parsing).
+
+Inductive tele : Type :=
+  | TeleO : tele
+  | TeleS {X} (binder : X -> tele) : tele.
+
+Fixpoint tele_fun (TT : tele) (T : Type) : Type :=
+  match TT with
+  | TeleO => T
+  | TeleS b => forall x, tele_fun (b x) T
+  end.
+
+Inductive tele_arg : tele -> Type :=
+| TargO : tele_arg TeleO
+| TargS {X} {binder} (x : X) : tele_arg (binder x) -> tele_arg (TeleS binder).
+
+Axiom tele_app : forall {TT : tele} {T} (f : tele_fun TT T), tele_arg TT -> T.
+
+Coercion tele_arg : tele >-> Sortclass.
+
+Inductive val :=
+  | LitV
+  | PairV (v1 v2 : val)
+  | InjLV (v : val)
+  | InjRV (v : val).
+Axiom coPset : Set.
+Axiom atomic_update : forall {PROP : Type} {TA TB : tele}, coPset -> coPset -> (TA -> PROP) -> (TA -> TB -> PROP) -> (TA -> TB -> PROP) -> PROP.
+Import Coq.Unicode.Utf8.
+Notation "'AU' '<<' ∀ x1 .. xn , α '>>' @ Eo , Ei '<<' β , 'COMM' Φ '>>'" :=
+  (atomic_update (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. ))
+                 (TB:=TeleO)
+                 Eo Ei
+                 (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $
+                       λ x1, .. (λ xn, α) ..)
+                 (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $
+                       λ x1, .. (λ xn, tele_app (TT:=TeleO) β) .. )
+                 (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $
+                       λ x1, .. (λ xn, tele_app (TT:=TeleO) Φ) .. )
+  )
+  (at level 20, Eo, Ei, α, β, Φ at level 200, x1 binder, xn binder,
+   format "'[   ' 'AU'  '<<'  ∀  x1  ..  xn ,  α  '>>'  '/' @  Eo ,  Ei  '/' '[   ' '<<'  β ,  '/' COMM  Φ  '>>' ']' ']'") : bi_scope.
+
+Axiom ident : Set.
+Inductive env (A : Type) : Type :=  Enil : env A | Esnoc : env A → ident → A → env A.
+Record envs (PROP : Type) : Type
+  := Envs { env_spatial : env PROP }.
+Axiom positive : Set.
+Axiom Qp : Set.
+Axiom one : positive.
+Goal   forall (T : Type) (T0 : forall _ : T, Type) (P : Set)
+    (u : T) (γs : P) (Q : T0 u) (Φ o : forall _ : val, T0 u)
+    (stack_content0 : forall (_ : P) (_ : list val), T0 u)
+    (c c0 : coPset) (l : forall (A : Type) (_ : list A), list A)
+    (e0 : forall (_ : env (T0 u)) (_ : positive), envs (T0 u))
+    (i0 : ident) (o1 : forall (_ : Qp) (_ : val), T0 u)
+    (b0 : forall _ : env (T0 u), T0 u) (P0 : forall _ : T0 u, Type)
+    (u0 : forall (_ : T0 u) (_ : T0 u), T0 u),
+  P0
+    (@atomic_update (T0 u)
+       (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO))) TeleO c c0
+       (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO)))
+          (T0 u) (fun (v : val) (q : Qp) => o1 q v))
+       (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO)))
+          (forall _ : tele_arg TeleO, T0 u)
+          (fun (v : val) (q : Qp) => @tele_app TeleO (T0 u) (o1 q v)))
+       (@tele_app (@TeleS val (fun _ : val => @TeleS Qp (fun _ : Qp => TeleO)))
+          (forall _ : tele_arg TeleO, T0 u)
+          (fun (x : val) (_ : Qp) =>
+           @tele_app TeleO (T0 u)
+             (u0
+                (b0
+                   match
+                     e0
+                       (@Esnoc (T0 u) (@Enil (T0 u)) i0
+                          (@atomic_update (T0 u)
+                             (@TeleS (list val) (fun _ : list val => TeleO)) TeleO
+                             c c0
+                             (@tele_app
+                                (@TeleS (list val) (fun _ : list val => TeleO))
+                                (T0 u) (fun l0 : list val => stack_content0 γs l0))
+                             (@tele_app
+                                (@TeleS (list val) (fun _ : list val => TeleO))
+                                (forall _ : tele_arg TeleO, T0 u)
+                                (fun l0 : list val =>
+                                 @tele_app TeleO (T0 u)
+                                   (stack_content0 γs (l val l0))))
+                             (@tele_app
+                                (@TeleS (list val) (fun _ : list val => TeleO))
+                                (forall _ : tele_arg TeleO, T0 u)
+                                (fun x1 : list val =>
+                                 @tele_app TeleO (T0 u)
+                                   (u0 Q
+                                      (Φ
+                                         match x1 return val with
+                                         | nil => InjLV LitV
+                                         | cons v _ => InjRV v
+                                         end)))))) one
+                     return (env (T0 u))
+                   with
+                   | Envs _ env_spatial0 => env_spatial0
+                   end) (o x)))))
+.
+  Show.
+Abort.
diff --git a/test-suite/bugs/closed/7854.v b/test-suite/bugs/closed/7854.v
new file mode 100644
index 00000000..ab1a29b6
--- /dev/null
+++ b/test-suite/bugs/closed/7854.v
@@ -0,0 +1,10 @@
+Set Primitive Projections.
+
+CoInductive stream (A : Type) := cons {
+  hd : A;
+  tl : stream A;
+}.
+
+CoFixpoint const {A} (x : A) := cons A x (const x).
+
+Check (@eq_refl _ (const tt) <<: tl unit (const tt) = const tt).
diff --git a/test-suite/bugs/closed/7867.v b/test-suite/bugs/closed/7867.v
new file mode 100644
index 00000000..d0c79027
--- /dev/null
+++ b/test-suite/bugs/closed/7867.v
@@ -0,0 +1,4 @@
+(* Was a printer anomaly due to an internal lambda with no binders *)
+
+Class class := { foo : nat }.
+Fail Instance : class := { foo := 0 ; bar := 0 }.
diff --git a/test-suite/bugs/closed/8004.v b/test-suite/bugs/closed/8004.v
new file mode 100644
index 00000000..81863999
--- /dev/null
+++ b/test-suite/bugs/closed/8004.v
@@ -0,0 +1,47 @@
+Require Export Coq.Program.Tactics Coq.Classes.SetoidTactics Coq.Classes.CMorphisms .
+
+Set Universe Polymorphism.
+
+Delimit Scope category_theory_scope with category_theory.
+Open Scope category_theory_scope.
+
+Infix "∧" := prod (at level 80, right associativity) : category_theory_scope.
+
+Class Setoid A := {
+  equiv : crelation A;
+  setoid_equiv :> Equivalence equiv
+}.
+
+Notation "f ≈ g" := (equiv f g) (at level 79) : category_theory_scope.
+
+Open Scope list_scope.
+
+Generalizable All Variables.
+
+Fixpoint list_equiv `{Setoid A} (xs ys : list A) : Type :=
+  match xs, ys with
+  | nil, nil => True
+  | x :: xs, y :: ys => x ≈ y ∧ list_equiv xs ys
+  | _, _ => False
+  end.
+
+Axiom proof_admitted : False.
+Tactic Notation "admit" := abstract case proof_admitted.
+
+Program Instance list_equivalence `{Setoid A} : Equivalence list_equiv.
+Next Obligation.
+  repeat intro.
+  induction x; simpl; split; auto.
+  reflexivity.
+Qed.
+Next Obligation.
+  repeat intro.
+  generalize dependent y.
+  induction x, y; simpl; intros; auto.
+  destruct X; split.
+    now symmetry.
+  intuition.
+Qed.
+Next Obligation.
+admit.
+Defined.
diff --git a/test-suite/bugs/closed/808_2411.v b/test-suite/bugs/closed/808_2411.v
index 1c13e745..1169b203 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/8119.v b/test-suite/bugs/closed/8119.v
new file mode 100644
index 00000000..c6329a73
--- /dev/null
+++ b/test-suite/bugs/closed/8119.v
@@ -0,0 +1,46 @@
+Require Import Coq.Strings.String.
+
+Section T.
+  Eval vm_compute in let x := tt in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Eval vm_compute in let _ := Set in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Eval vm_compute in let _ := Prop in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+End T.
+
+Section U0.
+  Let n : unit := tt.
+  Eval vm_compute in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+End U0.
+
+Section S0.
+  Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "".
+  Eval vm_compute in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+End S0.
+
+Class T := { }.
+Section S1.
+  Context {p : T}.
+  Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "".
+  Eval vm_compute in _.
+(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *)
+  Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort.
+(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *)
+End S1.
+
+Class M := { m : Type }.
+Section S2.
+  Context {p : M}.
+  Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "".
+  Eval vm_compute in _.
+(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *)
+  Goal exists tt : unit, tt = tt. eexists. vm_compute. Abort.
+(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *)
+End S2.
diff --git a/test-suite/bugs/closed/8121.v b/test-suite/bugs/closed/8121.v
new file mode 100644
index 00000000..99267612
--- /dev/null
+++ b/test-suite/bugs/closed/8121.v
@@ -0,0 +1,46 @@
+Require Import Coq.Strings.String.
+
+Section T.
+  Eval native_compute in let x := tt in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Eval native_compute in let _ := Set in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Eval native_compute in let _ := Prop in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+End T.
+
+Section U0.
+  Let n : unit := tt.
+  Eval native_compute in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Goal exists tt : unit, tt = tt. eexists. native_compute. Abort.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+End U0.
+
+Section S0.
+  Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "".
+  Eval native_compute in _.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+  Goal exists tt : unit, tt = tt. eexists. native_compute. Abort.
+(* Error: Anomaly "Uncaught exception Constr.DestKO." Please report at http://coq.inria.fr/bugs/. *)
+End S0.
+
+Class T := { }.
+Section S1.
+  Context {p : T}.
+  Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "".
+  Eval native_compute in _.
+(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *)
+  Goal exists tt : unit, tt = tt. eexists. native_compute. Abort.
+(* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *)
+End S1.
+
+Class M := { m : Type }.
+Section S2.
+  Context {p : M}.
+  Let LF : string := String (Coq.Strings.Ascii.Ascii false true false true false false false false) "".
+  Eval native_compute in _.
+(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *)
+  Goal exists tt : unit, tt = tt. eexists. native_compute. Abort.
+(* Error: Anomaly "File "pretyping/vnorm.ml", line 60, characters 9-15: Assertion failed." *)
+End S2.
diff --git a/test-suite/bugs/closed/8288.v b/test-suite/bugs/closed/8288.v
new file mode 100644
index 00000000..0350be9c
--- /dev/null
+++ b/test-suite/bugs/closed/8288.v
@@ -0,0 +1,7 @@
+Set Universe Polymorphism.
+Set Printing Universes.
+
+Set Polymorphic Inductive Cumulativity.
+
+Inductive foo := C : (forall A : Type -> Type, A Type) -> foo.
+(* anomaly invalid subtyping relation *)
diff --git a/test-suite/bugs/closed/8432.v b/test-suite/bugs/closed/8432.v
new file mode 100644
index 00000000..844ee126
--- /dev/null
+++ b/test-suite/bugs/closed/8432.v
@@ -0,0 +1,39 @@
+Require Import Program.Tactics.
+
+Obligation Tactic := idtac.
+Set Universe Polymorphism.
+
+Inductive paths {A : Type} (a : A) : A -> Type :=
+  idpath : paths a a.
+
+Inductive Empty : Type :=.
+Inductive Unit : Type := tt.
+Definition not (A : Type) := A -> Empty.
+
+  Lemma nat_path_O_S (n : nat) (H : paths O (S n)) : Empty.
+  Proof. refine (
+    match H in paths _ i return
+      match i with
+      | O => Unit
+      | S _ => Empty
+      end
+    with
+    | idpath _ => tt
+    end
+  ). Defined.
+  Lemma symmetry {A} (x y : A) (p : paths x y) : paths y x.
+  Proof.
+    destruct p. apply idpath.
+  Defined.
+  Lemma nat_path_S_O (n : nat) (H : paths (S n) O) : Empty.
+  Proof. eapply nat_path_O_S. exact (symmetry _ _ H). Defined.
+Set Printing Universes.
+Program Fixpoint succ_not_zero (n:nat) : not (paths (S n) 0) :=
+match n as n return not (paths (S n) 0) with
+| 0 => nat_path_S_O _
+| S n' => let dummy := succ_not_zero n' in _
+end.
+Next Obligation.
+  intros f _ n dummy H. exact (nat_path_S_O _ H).
+  Show Universes.
+Defined.
diff --git a/test-suite/bugs/closed/8532.v b/test-suite/bugs/closed/8532.v
new file mode 100644
index 00000000..00aa66e7
--- /dev/null
+++ b/test-suite/bugs/closed/8532.v
@@ -0,0 +1,8 @@
+(* Checking Print Assumptions relatively to a bound module *)
+
+Module Type Typ.
+  Parameter Inline(10) t : Type.
+End Typ.
+Module  Terms_mod (SetVars : Typ).
+Print Assumptions SetVars.t.
+End Terms_mod.
diff --git a/test-suite/bugs/closed/HoTT_coq_012.v b/test-suite/bugs/closed/HoTT_coq_012.v
index a3c697f8..420aaf97 100644
--- a/test-suite/bugs/closed/HoTT_coq_012.v
+++ b/test-suite/bugs/closed/HoTT_coq_012.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 
 Definition UU := Type.
 Inductive toto (B : UU) : UU := c (x : B).
diff --git a/test-suite/bugs/closed/HoTT_coq_014.v b/test-suite/bugs/closed/HoTT_coq_014.v
index 223a98de..5c450366 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_032.v b/test-suite/bugs/closed/HoTT_coq_032.v
index 3f5d7b02..40abb215 100644
--- a/test-suite/bugs/closed/HoTT_coq_032.v
+++ b/test-suite/bugs/closed/HoTT_coq_032.v
@@ -1,4 +1,3 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-xml") -*- *)
 Set Implicit Arguments.
 Generalizable All Variables.
 Set Asymmetric Patterns.
diff --git a/test-suite/bugs/closed/HoTT_coq_053.v b/test-suite/bugs/closed/HoTT_coq_053.v
index e2bf1dbe..263dec48 100644
--- a/test-suite/bugs/closed/HoTT_coq_053.v
+++ b/test-suite/bugs/closed/HoTT_coq_053.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 Set Printing Universes.
 Set Implicit Arguments.
 Generalizable All Variables.
diff --git a/test-suite/bugs/closed/HoTT_coq_054.v b/test-suite/bugs/closed/HoTT_coq_054.v
index c6879659..635024e9 100644
--- a/test-suite/bugs/closed/HoTT_coq_054.v
+++ b/test-suite/bugs/closed/HoTT_coq_054.v
@@ -1,4 +1,3 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs") -*- *)
 Inductive Empty : Prop := .
 
 Inductive paths {A : Type} (a : A) : A -> Type :=
diff --git a/test-suite/bugs/closed/HoTT_coq_055.v b/test-suite/bugs/closed/HoTT_coq_055.v
index a2509877..561b7e55 100644
--- a/test-suite/bugs/closed/HoTT_coq_055.v
+++ b/test-suite/bugs/closed/HoTT_coq_055.v
@@ -1,5 +1,5 @@
 Require Import TestSuite.admit.
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 Set Universe Polymorphism.
 
 Inductive Empty : Prop := .
diff --git a/test-suite/bugs/closed/HoTT_coq_059.v b/test-suite/bugs/closed/HoTT_coq_059.v
index 9c7e394d..2e6c735c 100644
--- a/test-suite/bugs/closed/HoTT_coq_059.v
+++ b/test-suite/bugs/closed/HoTT_coq_059.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 Set Universe Polymorphism.
 
 Inductive eq {A} (x : A) : A -> Type := eq_refl : eq x x.
diff --git a/test-suite/bugs/closed/HoTT_coq_062.v b/test-suite/bugs/closed/HoTT_coq_062.v
index 90d1d183..e01f73f1 100644
--- a/test-suite/bugs/closed/HoTT_coq_062.v
+++ b/test-suite/bugs/closed/HoTT_coq_062.v
@@ -1,6 +1,6 @@
 Unset Strict Universe Declaration.
 Require Import TestSuite.admit.
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 (* File reduced by coq-bug-finder from 5012 lines to 4659 lines, then from 4220 lines to 501 lines, then from 513 lines to 495 lines, then from 513 lines to 495 lines, then from 412 lines to 79 lines, then from 412 lines to 79 lines. *)
 Set Universe Polymorphism.
 Definition admit {T} : T.
diff --git a/test-suite/bugs/closed/HoTT_coq_064.v b/test-suite/bugs/closed/HoTT_coq_064.v
index b4c74537..d02a5f12 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_077.v b/test-suite/bugs/closed/HoTT_coq_077.v
index 017780c1..f69c71a0 100644
--- a/test-suite/bugs/closed/HoTT_coq_077.v
+++ b/test-suite/bugs/closed/HoTT_coq_077.v
@@ -3,7 +3,7 @@ Set Implicit Arguments.
 Require Import Logic.
 
 Set Asymmetric Patterns.
-Set Record Elimination Schemes.
+Set Nonrecursive Elimination Schemes.
 Set Primitive Projections.
 
 Record prod (A B : Type) : Type :=
diff --git a/test-suite/bugs/closed/HoTT_coq_080.v b/test-suite/bugs/closed/HoTT_coq_080.v
index 6b07c304..a9e0bd26 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/HoTT_coq_097.v b/test-suite/bugs/closed/HoTT_coq_097.v
index 38e8007b..f2b2e57b 100644
--- a/test-suite/bugs/closed/HoTT_coq_097.v
+++ b/test-suite/bugs/closed/HoTT_coq_097.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 Set Universe Polymorphism.
 Set Printing Universes.
 Inductive Empty : Set := .
diff --git a/test-suite/bugs/closed/HoTT_coq_104.v b/test-suite/bugs/closed/HoTT_coq_104.v
index 5bb7fa8c..a6ff78d1 100644
--- a/test-suite/bugs/closed/HoTT_coq_104.v
+++ b/test-suite/bugs/closed/HoTT_coq_104.v
@@ -4,7 +4,7 @@ Require Import Logic.
 
 Global Set Universe Polymorphism.
 Global Set Asymmetric Patterns.
-Local Set Record Elimination Schemes.
+Local Set Nonrecursive Elimination Schemes.
 Local Set Primitive Projections.
 
 Record prod (A B : Type) : Type :=
diff --git a/test-suite/bugs/closed/HoTT_coq_107.v b/test-suite/bugs/closed/HoTT_coq_107.v
index 7c1ab8dc..fa4072a8 100644
--- a/test-suite/bugs/closed/HoTT_coq_107.v
+++ b/test-suite/bugs/closed/HoTT_coq_107.v
@@ -1,4 +1,4 @@
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-nois" "-R" "../theories" "Coq") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-nois" "-R" "../theories" "Coq") -*- *)
 (* File reduced by coq-bug-finder from 4897 lines to 2605 lines, then from 2297 lines to 236 lines, then from 239 lines to 137 lines, then from 118 lines to 67 lines, then from 520 lines to 76 lines. *)
 (** Note: The bug here is the same as the #113, that is, HoTT_coq_113.v *)
 Require Import Coq.Init.Logic.
diff --git a/test-suite/bugs/closed/HoTT_coq_108.v b/test-suite/bugs/closed/HoTT_coq_108.v
index b6c0da76..ea4bcd8b 100644
--- a/test-suite/bugs/closed/HoTT_coq_108.v
+++ b/test-suite/bugs/closed/HoTT_coq_108.v
@@ -1,5 +1,5 @@
 Require Import TestSuite.admit.
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") -*- *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *)
 (* NOTE: This bug is only triggered with -load-vernac-source / in interactive mode. *)
 (* File reduced by coq-bug-finder from 139 lines to 124 lines. *)
 Set Universe Polymorphism.
diff --git a/test-suite/bugs/closed/HoTT_coq_123.v b/test-suite/bugs/closed/HoTT_coq_123.v
index 6ee6e653..7bed956f 100644
--- a/test-suite/bugs/closed/HoTT_coq_123.v
+++ b/test-suite/bugs/closed/HoTT_coq_123.v
@@ -1,5 +1,5 @@
 Require Import TestSuite.admit.
-(* -*- mode: coq; coq-prog-args: ("-emacs" "-indices-matter") *)
+(* -*- mode: coq; coq-prog-args: ("-indices-matter") *)
 (* File reduced by coq-bug-finder from original input, then from 4988 lines to 856 lines, then from 648 lines to 398 lines, then from 401 lines to 332 lines, then from 287 lines to 250 lines, then from 257 lines to 241 lines, then from 223 lines to 175 lines *)
 Set Universe Polymorphism.
 Set Asymmetric Patterns.
@@ -104,11 +104,15 @@ Record Functor (C D : PreCategory) :=
     morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d)
   }.
 
+(** Workaround to simpl losing universe constraints, see bug #5645. *)
+Ltac simpl' :=
+  simpl; match goal with [ |- ?P ] => let T := type of P in idtac end.
+
 Global Instance trunc_forall `{Funext} `{P : A -> Type} `{forall a, IsTrunc n (P a)}
 : IsTrunc n (forall a, P a) | 100.
 Proof.
     generalize dependent P.
-  induction n as [ | n' IH]; (simpl; intros P ?).
+  induction n as [ | n' IH]; (simpl'; intros P ?).
   - admit.
   - pose (fun f g => trunc_equiv (@apD10 A P f g) ^-1); admit.
 Defined.
diff --git a/test-suite/bugs/closed/gh6165.v b/test-suite/bugs/closed/gh6165.v
new file mode 100644
index 00000000..b87a7caa
--- /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 00000000..cec84642
--- /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 00000000..3bbb664f
--- /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 7c5dc416..820022d9 100644
--- a/test-suite/bugs/opened/1596.v
+++ b/test-suite/bugs/opened/1596.v
@@ -2,7 +2,6 @@ Require Import Relations.
 Require Import FSets.
 Require Import Arith.
 Require Import Omega.
-Unset Standard Proposition Elimination Names.
 
 Set Keyed Unification.
 
@@ -258,4 +257,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 28257014..28257014 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 10c988fc..57c17443 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/3209.v b/test-suite/bugs/opened/3209.v
deleted file mode 100644
index 3203afa1..00000000
--- a/test-suite/bugs/opened/3209.v
+++ /dev/null
@@ -1,17 +0,0 @@
-Inductive eqT {A} (x : A) : A -> Type :=
-  reflT : eqT x x.
-Definition Bi_inv (A B : Type) (f : (A -> B)) :=
-  sigT (fun (g : B -> A) =>
-          sigT (fun (h : B -> A) =>
-                  sigT (fun (α : forall b : B, eqT (f (g b)) b) =>
-                          forall a : A, eqT (h (f a)) a))).
-Definition TEquiv (A B : Type) := sigT (fun (f : A -> B) => Bi_inv _ _ f).
-
-Axiom UA : forall (A B : Type), TEquiv (TEquiv A B) (eqT A B).
-Definition idtoeqv {A B} (e : eqT A B) : TEquiv A B :=
-  sigT_rect (fun _ => TEquiv A B)
-            (fun (f : TEquiv A B -> eqT A B) H =>
-               sigT_rect (fun _ => TEquiv A B)
-                         (fun g _ => g e)
-                         H)
-            (UA A B).
diff --git a/test-suite/bugs/opened/3263.v b/test-suite/bugs/opened/3263.v
deleted file mode 100644
index f0c707bd..00000000
--- a/test-suite/bugs/opened/3263.v
+++ /dev/null
@@ -1,232 +0,0 @@
-Require Import TestSuite.admit.
-(* File reduced by coq-bug-finder from originally 10918 lines, then 3649 lines to 3177 lines, then from 3189 lines to 3164 lines, then from 2653 lines to 2496 lines,  2653 lines, then from 1642 lines to 651 lines, then from 736 lines to 473 lines, then from 433 lines to 275 lines, then from 258 lines to 235 lines. *)
-Generalizable All Variables.
-Set Implicit Arguments.
-
-Arguments fst {_ _} _.
-Arguments snd {_ _} _.
-
-Axiom cheat : forall {T}, T.
-
-Reserved Notation "g 'o' f" (at level 40, left associativity).
-
-Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a.
-Arguments idpath {A a} , [A] a.
-Notation "x = y" := (paths x y) : type_scope.
-
-Definition symmetry {A : Type} {x y : A} (p : x = y) : y = x
-  := match p with idpath => idpath end.
-
-Delimit Scope morphism_scope with morphism.
-Delimit Scope category_scope with category.
-Delimit Scope object_scope with object.
-Record PreCategory (object : Type) :=
-  Build_PreCategory' {
-      object :> Type := object;
-      morphism : object -> object -> Type;
-      identity : forall x, morphism x x;
-      compose : forall s d d',
-                  morphism d d'
-                  -> morphism s d
-                  -> morphism s d'
-                              where "f 'o' g" := (compose f g);
-      associativity : forall x1 x2 x3 x4
-                             (m1 : morphism x1 x2)
-                             (m2 : morphism x2 x3)
-                             (m3 : morphism x3 x4),
-                        (m3 o m2) o m1 = m3 o (m2 o m1);
-      associativity_sym : forall x1 x2 x3 x4
-                                 (m1 : morphism x1 x2)
-                                 (m2 : morphism x2 x3)
-                                 (m3 : morphism x3 x4),
-                            m3 o (m2 o m1) = (m3 o m2) o m1;
-      left_identity : forall a b (f : morphism a b), identity b o f = f;
-      right_identity : forall a b (f : morphism a b), f o identity a = f;
-      identity_identity : forall x, identity x o identity x = identity x
-    }.
-Bind Scope category_scope with PreCategory.
-Arguments PreCategory {_}.
-Arguments identity {_} [!C%category] x%object : rename.
-
-Arguments compose {_} [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename.
-
-Infix "o" := compose : morphism_scope.
-
-Delimit Scope functor_scope with functor.
-Local Open Scope morphism_scope.
-Record Functor `(C : @PreCategory objC, D : @PreCategory objD) :=
-  {
-    object_of :> C -> D;
-    morphism_of : forall s d, morphism C s d
-                              -> morphism D (object_of s) (object_of d);
-    composition_of : forall s d d'
-                            (m1 : morphism C s d) (m2: morphism C d d'),
-                       morphism_of _ _ (m2 o m1)
-                       = (morphism_of _ _ m2) o (morphism_of _ _ m1);
-    identity_of : forall x, morphism_of _ _ (identity x)
-                            = identity (object_of x)
-  }.
-Bind Scope functor_scope with Functor.
-
-Arguments morphism_of {_} [C%category] {_} [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch.
-
-Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope.
-
-Class IsIsomorphism `{C : @PreCategory objC} {s d} (m : morphism C s d) :=
-  {
-    morphism_inverse : morphism C d s;
-    left_inverse : morphism_inverse o m = identity _;
-    right_inverse : m o morphism_inverse = identity _
-  }.
-
-Definition opposite `(C : @PreCategory objC) : PreCategory
-  := @Build_PreCategory'
-       C
-       (fun s d => morphism C d s)
-       (identity (C := C))
-       (fun _ _ _ m1 m2 => m2 o m1)
-       (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _ _)
-       (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _ _)
-       (fun _ _ => @right_identity _ _ _ _)
-       (fun _ _ => @left_identity _ _ _ _)
-       (@identity_identity _ C).
-
-Notation "C ^op" := (opposite C) (at level 3) : category_scope.
-
-Definition prod `(C : @PreCategory objC, D : @PreCategory objD) : @PreCategory (objC * objD).
-  refine (@Build_PreCategory'
-            (C * D)%type
-            (fun s d => (morphism C (fst s) (fst d)
-                         * morphism D (snd s) (snd d))%type)
-            (fun x => (identity (fst x), identity (snd x)))
-            (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1))
-            _
-            _
-            _
-            _
-            _); admit.
-Defined.
-Infix "*" := prod : category_scope.
-
-Definition compose_functor `(C : @PreCategory objC, D : @PreCategory objD, E : @PreCategory objE) (G : Functor D E) (F : Functor C D) : Functor C E
-  := Build_Functor
-       C E
-       (fun c => G (F c))
-       (fun _ _ m => morphism_of G (morphism_of F m))
-       cheat
-       cheat.
-
-Infix "o" := compose_functor : functor_scope.
-
-Record NaturalTransformation `(C : @PreCategory objC, D : @PreCategory objD) (F G : Functor C D) :=
-  Build_NaturalTransformation' {
-      components_of :> forall c, morphism D (F c) (G c);
-      commutes : forall s d (m : morphism C s d),
-                   components_of d o F _1 m = G _1 m o components_of s;
-
-      commutes_sym : forall s d (m : C.(morphism) s d),
-                       G _1 m o components_of s = components_of d o F _1 m
-    }.
-Definition functor_category `(C : @PreCategory objC, D : @PreCategory objD) : PreCategory
-  := @Build_PreCategory' (Functor C D)
-                         (@NaturalTransformation _ C _ D)
-                         cheat
-                         cheat
-                         cheat
-                         cheat
-                         cheat
-                         cheat
-                         cheat.
-
-Definition opposite_functor `(F : @Functor objC C objD D) : Functor C^op D^op
-  := Build_Functor (C^op) (D^op)
-                   (object_of F)
-                   (fun s d => morphism_of F (s := d) (d := s))
-                   (fun d' d s m1 m2 => composition_of F s d d' m2 m1)
-                   (identity_of F).
-
-Definition opposite_invL `(F : @Functor objC C^op objD D) : Functor C D^op
-  := Build_Functor C (D^op)
-                   (object_of F)
-                   (fun s d => morphism_of F (s := d) (d := s))
-                   (fun d' d s m1 m2 => composition_of F s d d' m2 m1)
-                   (identity_of F).
-Notation "F ^op" := (opposite_functor F) : functor_scope.
-
-Notation "F ^op'L" := (opposite_invL F) (at level 3) : functor_scope.
-Definition fst `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) C
-  := Build_Functor (C * D) C
-                   (@fst _ _)
-                   (fun _ _ => @fst _ _)
-                   (fun _ _ _ _ _ => idpath)
-                   (fun _ => idpath).
-
-Definition snd `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) D
-  := Build_Functor (C * D) D
-                   (@snd _ _)
-                   (fun _ _ => @snd _ _)
-                   (fun _ _ _ _ _ => idpath)
-                   (fun _ => idpath).
-Definition prod_functor `(F : @Functor objC C objD D, F' : @Functor objC C objD' D')
-: Functor C (D * D')
-  := Build_Functor
-       C (D * D')
-       (fun c => (F c, F' c))
-       (fun s d m => (F _1 m, F' _1 m))%morphism
-       cheat
-       cheat.
-Definition pair `(F : @Functor objC C objD D, F' : @Functor objC' C' objD' D') : Functor (C * C') (D * D')
-  := (prod_functor (F o fst) (F' o snd))%functor.
-Notation cat_of obj :=
-  (@Build_PreCategory' obj
-                       (fun x y => forall _ : x, y)
-                       (fun _ x => x)
-                       (fun _ _ _ f g x => f (g x))%core
-                       (fun _ _ _ _ _ _ _ => idpath)
-                       (fun _ _ _ _ _ _ _ => idpath)
-                       (fun _ _ _ => idpath)
-                       (fun _ _ _ => idpath)
-                       (fun _ => idpath)).
-
-Definition hom_functor `(C : @PreCategory objC) : Functor (C^op * C) (cat_of Type)
-  := Build_Functor _ _ cheat cheat cheat cheat.
-
-Definition induced_hom_natural_transformation `(F : @Functor objC C objD D)
-: NaturalTransformation (hom_functor C) (hom_functor D o pair F^op F)
-  := Build_NaturalTransformation' _ _ cheat cheat cheat.
-
-Class IsFullyFaithful `(F : @Functor objC C objD D)
-  := is_fully_faithful
-     : forall x y : C,
-         IsIsomorphism (induced_hom_natural_transformation F (x, y)).
-
-Definition coyoneda `(A : @PreCategory objA) : Functor A^op (@functor_category _ A _ (cat_of Type))
-  := cheat.
-
-Definition yoneda `(A : @PreCategory objA) : Functor A (@functor_category _ A^op _ (cat_of Type))
-  := (((coyoneda A^op)^op'L)^op'L)%functor.
-Definition coyoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@coyoneda _ A).
-Admitted.
-
-Definition yoneda_embedding_fast `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A).
-Proof.
-  intros a b.
-  pose proof (coyoneda_embedding A^op a b) as CYE.
-  unfold yoneda.
-  Time let t := (type of CYE) in
-  let t' := (eval simpl in t) in pose proof ((fun (x : t) => (x : t')) CYE) as CYE'. (* Finished transaction in 0. secs (0.216013u,0.004s) *)
-  Fail Timeout 1 let t := match goal with |- ?G => constr:(G) end in
-  let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE').
-  Time let t := match goal with |- ?G => constr:(G) end in
-  let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). (* Finished transaction in 0. secs (0.248016u,0.s) *)
-Fail Timeout 2 Defined.
-Time Defined. (* Finished transaction in 1. secs (0.432027u,0.s) *)
-
-Definition yoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A).
-Proof.
-  intros a b.
-  pose proof (coyoneda_embedding A^op a b) as CYE.
-  unfold yoneda; simpl in *.
-  Fail Timeout 1 exact CYE.
-  Time exact CYE. (* Finished transaction in 0. secs (0.012001u,0.s) *)
-Fail Timeout 60 Defined. (* Timeout! *)
diff --git a/test-suite/bugs/closed/3424.v b/test-suite/bugs/opened/3424.v
index ee8cabf1..d1c5bb68 100644
--- a/test-suite/bugs/closed/3424.v
+++ b/test-suite/bugs/opened/3424.v
@@ -13,12 +13,12 @@ Notation "0" := (trunc_S minus_one) : trunc_scope.
 Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A.
 Notation IsHProp := (IsTrunc minus_one).
 Notation IsHSet := (IsTrunc 0).
-Set Refolding Reduction.
 Goal forall (A : Type) (a b : A) (H' : IsHSet A), { x : Type & IsHProp x }.
 Proof.
 intros.
 eexists.
 (* exact (H' a b). *)
 (* Undo. *)
-apply (H' a b).
+Fail apply (H' a b).
+exact (H' a b).
 Qed.
diff --git a/test-suite/bugs/opened/3794.v b/test-suite/bugs/opened/3794.v
index 99ca6cb3..e4711a38 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/3916.v b/test-suite/bugs/opened/3916.v
deleted file mode 100644
index fd95503e..00000000
--- a/test-suite/bugs/opened/3916.v
+++ /dev/null
@@ -1,3 +0,0 @@
-Require Import List.
-
-Fail Hint Resolve -> in_map. (* Also happens when using <- instead of -> *)
diff --git a/test-suite/bugs/opened/3926.v b/test-suite/bugs/opened/3926.v
deleted file mode 100644
index cfad7635..00000000
--- a/test-suite/bugs/opened/3926.v
+++ /dev/null
@@ -1,30 +0,0 @@
-Notation compose := (fun g f x => g (f x)).
-Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope.
-Open Scope function_scope.
-Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope.
-Arguments idpath {A a} , [A] a.
-Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end.
-Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }.
-Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope.
-Local Open Scope equiv_scope.
-Axiom eisretr : forall {A B} (f : A -> B) `{IsEquiv A B f} x, f (f^-1 x) = x.
-Generalizable Variables A B C f g.
-Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (compose g f) | 1000
-  := Build_IsEquiv A C (compose g f) (compose f^-1 g^-1).
-Definition isequiv_homotopic {A B} (f : A -> B) {g : A -> B} `{IsEquiv A B f} (h : forall x, f x = g x) : IsEquiv g
-  := Build_IsEquiv _ _ g (f ^-1).
-Global Instance isequiv_inverse {A B} (f : A -> B) `{IsEquiv A B f} : IsEquiv f^-1 | 10000
-  := Build_IsEquiv B A f^-1 f.
-Definition cancelR_isequiv {A B C} (f : A -> B) {g : B -> C}
-  `{IsEquiv A B f} `{IsEquiv A C (g o f)}
-  : IsEquiv g.
-Proof.
-  Unset Typeclasses Modulo Eta.
-  exact (isequiv_homotopic (compose (compose g f) f^-1)
-                           (fun b => ap g (eisretr f b))) || fail "too early".
-  Undo.
-  Set Typeclasses Modulo Eta.
-  Set Typeclasses Dependency Order.
-  Set Typeclasses Debug.
-  Fail exact (isequiv_homotopic (compose (compose g f) f^-1)
-                           (fun b => ap g (eisretr f b))).
diff --git a/test-suite/bugs/opened/3948.v b/test-suite/bugs/opened/3948.v
deleted file mode 100644
index 16581308..00000000
--- a/test-suite/bugs/opened/3948.v
+++ /dev/null
@@ -1,25 +0,0 @@
-Module Type S.
-Parameter t : Type.
-End S.
-
-Module Bar(X : S).
-Proof.
-  Definition elt := X.t.
-  Axiom fold : elt.
-End Bar.
-
-Module Make (X: S) := Bar(X).
-
-Declare Module X : S.
-
-Module Type Interface.
-  Parameter constant : unit.
-End Interface.
-
-Module DepMap : Interface.
-  Module Dom := Make(X).
-  Definition constant : unit :=
-    let _ := @Dom.fold in tt.
-End DepMap.
-
-Print Assumptions DepMap.constant.
\ No newline at end of file
diff --git a/test-suite/bugs/opened/4717.v b/test-suite/bugs/opened/4717.v
deleted file mode 100644
index 9ad47467..00000000
--- 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/4803.v b/test-suite/bugs/opened/4803.v
deleted file mode 100644
index 4530548b..00000000
--- a/test-suite/bugs/opened/4803.v
+++ /dev/null
@@ -1,48 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
-(*Suppose a user wants to declare a new list-like notation with support for singletons in both 8.4 and 8.5.  If they use*)
-Require Import Coq.Lists.List.
-Require Import Coq.Vectors.Vector.
-Import ListNotations.
-Import VectorNotations.
-Set Implicit Arguments.
-Inductive mylist T := mynil | mycons (_ : T) (_ : mylist T).
-Arguments mynil {_}, _.
-
-Delimit Scope mylist_scope with mylist.
-Bind Scope mylist_scope with mylist.
-Delimit Scope vector_scope with vector.
-
-Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
-Notation " [ x ] " := (mycons x mynil) : mylist_scope.
-Notation " [ x ; .. ; y ] " := (mycons x .. (mycons y mynil) ..) : mylist_scope.
-
-(** All of these should work fine in -compat 8.4 mode, just as they do in Coq 8.4.  There needs to be a way to specify notations above so that all of these [Check]s go through in both 8.4 and 8.5 *)
-Check [ ]%mylist : mylist _.
-Check [ ]%list : list _.
-Check []%vector : Vector.t _ _.
-Check [ _ ]%mylist : mylist _.
-Check [ _ ]%list : list _.
-Check [ _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ]%list : list _.
-Check [ _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ]%mylist : mylist _.
-Check [ _ ; _ ; _ ]%list : list _.
-Check [ _ ; _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ; _ ]%mylist : mylist _.
-Check [ _ ; _ ; _ ; _ ]%list : list _.
-Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _.
-Check [ _ ; _ ; _ ; _ ]%mylist : mylist _.
-
-(** Now check that we can add and then remove notations from the parser *)
-(* We should be able to stick some vernacular here to remove [] from the parser *)
-Fail Remove Notation "[]".
-Goal True.
-  (* This should not be a syntax error; before moving this file to closed, uncomment this line. *)
-  (* idtac; []. *)
-  constructor.
-Qed.
-
-Check { _ : _ & _ }.
-Reserved Infix "&" (at level 0).
-Fail Remove Infix "&".
-(* Check { _ : _ & _ }. *)
diff --git a/test-suite/bugs/opened/4813.v b/test-suite/bugs/opened/4813.v
index b7517017..2ac55359 100644
--- a/test-suite/bugs/opened/4813.v
+++ b/test-suite/bugs/opened/4813.v
@@ -1,5 +1,5 @@
-(* An example one would like to see succeeding *)
+Require Import Program.Tactics.
 
 Record T := BT { t : Set }.
 Record U (x : T) := BU { u : t x -> Prop }.
-Fail Definition A (H : unit -> Prop) : U (BT unit) := BU _ H.
+Program Definition A (H : unit -> Prop) : U (BT unit) := BU _ H.
diff --git a/test-suite/bugs/opened/6393.v b/test-suite/bugs/opened/6393.v
new file mode 100644
index 00000000..8d5d0923
--- /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 00000000..3690adf9
--- /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 00000000..c5e19538
--- /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/arg/_CoqProject b/test-suite/coq-makefile/arg/_CoqProject
new file mode 100644
index 00000000..53dc9639
--- /dev/null
+++ b/test-suite/coq-makefile/arg/_CoqProject
@@ -0,0 +1,11 @@
+-R theories test
+-R src test
+-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/arg/run.sh b/test-suite/coq-makefile/arg/run.sh
new file mode 100755
index 00000000..e7de90ff
--- /dev/null
+++ b/test-suite/coq-makefile/arg/run.sh
@@ -0,0 +1,7 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
diff --git a/test-suite/coq-makefile/compat-subdirs/_CoqProject b/test-suite/coq-makefile/compat-subdirs/_CoqProject
new file mode 100644
index 00000000..4f44bde2
--- /dev/null
+++ b/test-suite/coq-makefile/compat-subdirs/_CoqProject
@@ -0,0 +1,11 @@
+-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
+subdir/
diff --git a/test-suite/coq-makefile/compat-subdirs/run.sh b/test-suite/coq-makefile/compat-subdirs/run.sh
new file mode 100755
index 00000000..221dcd7b
--- /dev/null
+++ b/test-suite/coq-makefile/compat-subdirs/run.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+exec test -f "subdir/done"
diff --git a/test-suite/coq-makefile/compat-subdirs/subdir/Makefile b/test-suite/coq-makefile/compat-subdirs/subdir/Makefile
new file mode 100644
index 00000000..846c9b79
--- /dev/null
+++ b/test-suite/coq-makefile/compat-subdirs/subdir/Makefile
@@ -0,0 +1,3 @@
+all:
+	test -f ../theories/test.vo
+	touch done
diff --git a/test-suite/coq-makefile/coqdoc1/_CoqProject b/test-suite/coq-makefile/coqdoc1/_CoqProject
new file mode 100644
index 00000000..35792066
--- /dev/null
+++ b/test-suite/coq-makefile/coqdoc1/_CoqProject
@@ -0,0 +1,11 @@
+-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
+theories/sub/testsub.v
diff --git a/test-suite/coq-makefile/coqdoc1/run.sh b/test-suite/coq-makefile/coqdoc1/run.sh
new file mode 100755
index 00000000..dc5a500d
--- /dev/null
+++ b/test-suite/coq-makefile/coqdoc1/run.sh
@@ -0,0 +1,51 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+make install-doc DSTROOT="$PWD/tmp"
+#make debug
+(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual
+sort -u > desired <<EOT
+.
+./test
+./test/test_plugin.cmi
+./test/test_plugin.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.glob
+./test/test.v
+./test/test.vo
+./test/sub
+./test/sub/testsub.glob
+./test/sub/testsub.v
+./test/sub/testsub.vo
+./test/mlihtml
+./test/mlihtml/index_exceptions.html
+./test/mlihtml/index.html
+./test/mlihtml/index_class_types.html
+./test/mlihtml/type_Test_aux.html
+./test/mlihtml/index_module_types.html
+./test/mlihtml/index_classes.html
+./test/mlihtml/type_Test.html
+./test/mlihtml/style.css
+./test/mlihtml/index_attributes.html
+./test/mlihtml/index_types.html
+./test/mlihtml/Test_aux.html
+./test/mlihtml/index_values.html
+./test/mlihtml/Test.html
+./test/mlihtml/index_extensions.html
+./test/mlihtml/index_methods.html
+./test/mlihtml/index_modules.html
+./test/html
+./test/html/index.html
+./test/html/test.sub.testsub.html
+./test/html/toc.html
+./test/html/coqdoc.css
+./test/html/test.test.html
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/coqdoc2/_CoqProject b/test-suite/coq-makefile/coqdoc2/_CoqProject
new file mode 100644
index 00000000..d2a547d4
--- /dev/null
+++ b/test-suite/coq-makefile/coqdoc2/_CoqProject
@@ -0,0 +1,11 @@
+-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
+theories/sub/testsub.v
diff --git a/test-suite/coq-makefile/coqdoc2/run.sh b/test-suite/coq-makefile/coqdoc2/run.sh
new file mode 100755
index 00000000..dc5a500d
--- /dev/null
+++ b/test-suite/coq-makefile/coqdoc2/run.sh
@@ -0,0 +1,51 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+make install-doc DSTROOT="$PWD/tmp"
+#make debug
+(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual
+sort -u > desired <<EOT
+.
+./test
+./test/test_plugin.cmi
+./test/test_plugin.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.glob
+./test/test.v
+./test/test.vo
+./test/sub
+./test/sub/testsub.glob
+./test/sub/testsub.v
+./test/sub/testsub.vo
+./test/mlihtml
+./test/mlihtml/index_exceptions.html
+./test/mlihtml/index.html
+./test/mlihtml/index_class_types.html
+./test/mlihtml/type_Test_aux.html
+./test/mlihtml/index_module_types.html
+./test/mlihtml/index_classes.html
+./test/mlihtml/type_Test.html
+./test/mlihtml/style.css
+./test/mlihtml/index_attributes.html
+./test/mlihtml/index_types.html
+./test/mlihtml/Test_aux.html
+./test/mlihtml/index_values.html
+./test/mlihtml/Test.html
+./test/mlihtml/index_extensions.html
+./test/mlihtml/index_methods.html
+./test/mlihtml/index_modules.html
+./test/html
+./test/html/index.html
+./test/html/test.sub.testsub.html
+./test/html/toc.html
+./test/html/coqdoc.css
+./test/html/test.test.html
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/emptyprefix/_CoqProject b/test-suite/coq-makefile/emptyprefix/_CoqProject
new file mode 100644
index 00000000..5678a8ed
--- /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 00000000..90ac541e
--- /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 00000000..a10e63b4
--- /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/extend-subdirs/Makefile.local b/test-suite/coq-makefile/extend-subdirs/Makefile.local
new file mode 100644
index 00000000..b031d30d
--- /dev/null
+++ b/test-suite/coq-makefile/extend-subdirs/Makefile.local
@@ -0,0 +1,4 @@
+pre-all::
+	$(MAKE) -C subdir pre
+post-all::
+	$(MAKE) -C subdir post
diff --git a/test-suite/coq-makefile/extend-subdirs/_CoqProject b/test-suite/coq-makefile/extend-subdirs/_CoqProject
new file mode 100644
index 00000000..69f47302
--- /dev/null
+++ b/test-suite/coq-makefile/extend-subdirs/_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/extend-subdirs/run.sh b/test-suite/coq-makefile/extend-subdirs/run.sh
new file mode 100755
index 00000000..221dcd7b
--- /dev/null
+++ b/test-suite/coq-makefile/extend-subdirs/run.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+exec test -f "subdir/done"
diff --git a/test-suite/coq-makefile/extend-subdirs/subdir/Makefile b/test-suite/coq-makefile/extend-subdirs/subdir/Makefile
new file mode 100644
index 00000000..23f52b15
--- /dev/null
+++ b/test-suite/coq-makefile/extend-subdirs/subdir/Makefile
@@ -0,0 +1,5 @@
+pre:
+	test ! -f ../theories/test.vo
+post:
+	test -f ../theories/test.vo
+	touch done
diff --git a/test-suite/coq-makefile/findlib-package/Makefile.local b/test-suite/coq-makefile/findlib-package/Makefile.local
new file mode 100644
index 00000000..0f4a7d99
--- /dev/null
+++ b/test-suite/coq-makefile/findlib-package/Makefile.local
@@ -0,0 +1 @@
+CAMLPKGS   += -package foo
diff --git a/test-suite/coq-makefile/findlib-package/_CoqProject b/test-suite/coq-makefile/findlib-package/_CoqProject
new file mode 100644
index 00000000..69f47302
--- /dev/null
+++ b/test-suite/coq-makefile/findlib-package/_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/findlib-package/findlib/foo/META b/test-suite/coq-makefile/findlib-package/findlib/foo/META
new file mode 100644
index 00000000..ff5f1c7c
--- /dev/null
+++ b/test-suite/coq-makefile/findlib-package/findlib/foo/META
@@ -0,0 +1,4 @@
+archive(byte)="foo.cma"
+archive(native)="foo.cmxa"
+linkopts="-linkall"
+requires="str"
diff --git a/test-suite/coq-makefile/findlib-package/findlib/foo/Makefile b/test-suite/coq-makefile/findlib-package/findlib/foo/Makefile
new file mode 100644
index 00000000..1615bfd0
--- /dev/null
+++ b/test-suite/coq-makefile/findlib-package/findlib/foo/Makefile
@@ -0,0 +1,14 @@
+-include ../../Makefile.conf
+
+CO="$(COQMF_OCAMLFIND)" opt
+CB="$(COQMF_OCAMLFIND)" ocamlc
+
+all:
+	$(CO) -c foolib.ml
+	$(CO) -a foolib.cmx -o foo.cmxa
+	$(CB) -c foolib.ml
+	$(CB) -a foolib.cmo -o foo.cma
+	$(CB) -c foo.mli # empty .mli file, to be understood
+
+clean:
+	rm -f *.cmo *.cma *.cmx *.cmxa *.cmi *.o *.a
diff --git a/test-suite/coq-makefile/findlib-package/findlib/foo/foo.mli b/test-suite/coq-makefile/findlib-package/findlib/foo/foo.mli
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/test-suite/coq-makefile/findlib-package/findlib/foo/foo.mli
diff --git a/test-suite/coq-makefile/findlib-package/findlib/foo/foolib.ml b/test-suite/coq-makefile/findlib-package/findlib/foo/foolib.ml
new file mode 100644
index 00000000..81306fb8
--- /dev/null
+++ b/test-suite/coq-makefile/findlib-package/findlib/foo/foolib.ml
@@ -0,0 +1,2 @@
+let foo () =
+  assert(Str.search_forward (Str.regexp "foo") "barfoobar" 0 = 3)
diff --git a/test-suite/coq-makefile/findlib-package/run.sh b/test-suite/coq-makefile/findlib-package/run.sh
new file mode 100755
index 00000000..5b24df63
--- /dev/null
+++ b/test-suite/coq-makefile/findlib-package/run.sh
@@ -0,0 +1,18 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+echo "let () = Foolib.foo ();;" >> src/test_aux.ml
+export OCAMLPATH=$OCAMLPATH:$PWD/findlib
+if which cygpath 2>/dev/null; then
+  # the only way I found to pass OCAMLPATH on win is to have it contain
+  # only one entry
+  export OCAMLPATH=`cygpath -w $PWD/findlib`
+fi
+make -C findlib/foo clean
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+cat Makefile.local
+make -C findlib/foo
+make
+make byte
diff --git a/test-suite/coq-makefile/latex1/_CoqProject b/test-suite/coq-makefile/latex1/_CoqProject
new file mode 100644
index 00000000..35792066
--- /dev/null
+++ b/test-suite/coq-makefile/latex1/_CoqProject
@@ -0,0 +1,11 @@
+-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
+theories/sub/testsub.v
diff --git a/test-suite/coq-makefile/latex1/run.sh b/test-suite/coq-makefile/latex1/run.sh
new file mode 100755
index 00000000..b2c5d566
--- /dev/null
+++ b/test-suite/coq-makefile/latex1/run.sh
@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+
+if which pdflatex; then
+
+. ../template/init.sh
+	
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+exec make all.pdf
+
+fi
+exit 0 # test skipped
diff --git a/test-suite/coq-makefile/merlin1/_CoqProject b/test-suite/coq-makefile/merlin1/_CoqProject
new file mode 100644
index 00000000..69f47302
--- /dev/null
+++ b/test-suite/coq-makefile/merlin1/_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/merlin1/run.sh b/test-suite/coq-makefile/merlin1/run.sh
new file mode 100755
index 00000000..1f262a93
--- /dev/null
+++ b/test-suite/coq-makefile/merlin1/run.sh
@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make .merlin
+cat > desired <<EOT
+B src
+S src
+EOT
+tail -2 .merlin > actual
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/mlpack1/_CoqProject b/test-suite/coq-makefile/mlpack1/_CoqProject
new file mode 100644
index 00000000..69f47302
--- /dev/null
+++ b/test-suite/coq-makefile/mlpack1/_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/mlpack1/run.sh b/test-suite/coq-makefile/mlpack1/run.sh
new file mode 100755
index 00000000..03df9cf0
--- /dev/null
+++ b/test-suite/coq-makefile/mlpack1/run.sh
@@ -0,0 +1,23 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+#make debug
+(cd `find tmp -name user-contrib` && find .) | sort > actual
+sort > desired <<EOT
+.
+./test
+./test/test.glob
+./test/test_plugin.cmi
+./test/test_plugin.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.v
+./test/test.vo
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/mlpack2/_CoqProject b/test-suite/coq-makefile/mlpack2/_CoqProject
new file mode 100644
index 00000000..51864a87
--- /dev/null
+++ b/test-suite/coq-makefile/mlpack2/_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/mlpack2/run.sh b/test-suite/coq-makefile/mlpack2/run.sh
new file mode 100755
index 00000000..03df9cf0
--- /dev/null
+++ b/test-suite/coq-makefile/mlpack2/run.sh
@@ -0,0 +1,23 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+#make debug
+(cd `find tmp -name user-contrib` && find .) | sort > actual
+sort > desired <<EOT
+.
+./test
+./test/test.glob
+./test/test_plugin.cmi
+./test/test_plugin.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.v
+./test/test.vo
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/multiroot/_CoqProject b/test-suite/coq-makefile/multiroot/_CoqProject
new file mode 100644
index 00000000..b384bb6d
--- /dev/null
+++ b/test-suite/coq-makefile/multiroot/_CoqProject
@@ -0,0 +1,12 @@
+-R theories/ test
+-R theories2 test2
+-R src/ test
+-I src/
+
+./src/test_plugin.mllib
+./src/test.ml4
+./src/test.mli
+./src/test_aux.ml
+./src/test_aux.mli
+./theories/test.v
+./theories2/test.v
diff --git a/test-suite/coq-makefile/multiroot/run.sh b/test-suite/coq-makefile/multiroot/run.sh
new file mode 100755
index 00000000..d3bb5310
--- /dev/null
+++ b/test-suite/coq-makefile/multiroot/run.sh
@@ -0,0 +1,56 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+cp -r theories theories2
+mv src/test_plugin.mlpack src/test_plugin.mllib
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+make install-doc DSTROOT="$PWD/tmp"
+#make debug
+(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual
+sort > desired <<EOT
+.
+./test
+./test/test.glob
+./test/test.cmi
+./test/test.cmx
+./test/test_aux.cmi
+./test/test_aux.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.v
+./test/test.vo
+./test2
+./test2/test.glob
+./test2/test.v
+./test2/test.vo
+./orphan_test_test2_test
+./orphan_test_test2_test/html
+./orphan_test_test2_test/html/coqdoc.css
+./orphan_test_test2_test/html/index.html
+./orphan_test_test2_test/html/test2.test.html
+./orphan_test_test2_test/html/test.test.html
+./orphan_test_test2_test/html/toc.html
+./orphan_test_test2_test/mlihtml
+./orphan_test_test2_test/mlihtml/index_attributes.html
+./orphan_test_test2_test/mlihtml/index_classes.html
+./orphan_test_test2_test/mlihtml/index_class_types.html
+./orphan_test_test2_test/mlihtml/index_exceptions.html
+./orphan_test_test2_test/mlihtml/index_extensions.html
+./orphan_test_test2_test/mlihtml/index.html
+./orphan_test_test2_test/mlihtml/index_methods.html
+./orphan_test_test2_test/mlihtml/index_modules.html
+./orphan_test_test2_test/mlihtml/index_module_types.html
+./orphan_test_test2_test/mlihtml/index_types.html
+./orphan_test_test2_test/mlihtml/index_values.html
+./orphan_test_test2_test/mlihtml/style.css
+./orphan_test_test2_test/mlihtml/Test_aux.html
+./orphan_test_test2_test/mlihtml/Test.html
+./orphan_test_test2_test/mlihtml/type_Test_aux.html
+./orphan_test_test2_test/mlihtml/type_Test.html
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/native1/_CoqProject b/test-suite/coq-makefile/native1/_CoqProject
new file mode 100644
index 00000000..a6fa1734
--- /dev/null
+++ b/test-suite/coq-makefile/native1/_CoqProject
@@ -0,0 +1,11 @@
+-R src test
+-R theories test
+-I src
+-arg -native-compiler
+
+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/native1/run.sh b/test-suite/coq-makefile/native1/run.sh
new file mode 100755
index 00000000..89bafe9a
--- /dev/null
+++ b/test-suite/coq-makefile/native1/run.sh
@@ -0,0 +1,33 @@
+#!/usr/bin/env bash
+
+NATIVECOMP=`grep "let no_native_compiler = false" ../../../config/coq_config.ml`||true
+if [[ `which ocamlopt` && $NATIVECOMP ]]; then
+
+. ../template/init.sh
+	
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+#make debug
+(cd `find tmp -name user-contrib` && find .) | sort > actual
+sort > desired <<EOT
+.
+./test
+./test/test.glob
+./test/test_plugin.cmi
+./test/test_plugin.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.v
+./test/test.vo
+./test/.coq-native
+./test/.coq-native/Ntest_test.cmi
+./test/.coq-native/Ntest_test.cmx
+./test/.coq-native/Ntest_test.cmxs
+EOT
+exec diff -u desired actual
+
+fi
+exit 0 # test skipped
diff --git a/test-suite/coq-makefile/only/_CoqProject b/test-suite/coq-makefile/only/_CoqProject
new file mode 100644
index 00000000..357384fd
--- /dev/null
+++ b/test-suite/coq-makefile/only/_CoqProject
@@ -0,0 +1,11 @@
+-R theories/ test
+-R src/ test
+-I src/
+
+./src/test_plugin.mlpack
+./src/test.ml4
+./src/test.mli
+./src/test_aux.ml
+./src/test_aux.mli
+./theories/test.v
+./theories/sub/testsub.v
diff --git a/test-suite/coq-makefile/only/run.sh b/test-suite/coq-makefile/only/run.sh
new file mode 100755
index 00000000..8cf04bf2
--- /dev/null
+++ b/test-suite/coq-makefile/only/run.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make only TGTS="src/test.cmi src/test_aux.cmi" -j2
+test -f src/test.cmi
+test -f src/test_aux.cmi
+! test -f src/test.cmo
diff --git a/test-suite/coq-makefile/plugin1/_CoqProject b/test-suite/coq-makefile/plugin1/_CoqProject
new file mode 100644
index 00000000..4eddc9d7
--- /dev/null
+++ b/test-suite/coq-makefile/plugin1/_CoqProject
@@ -0,0 +1,10 @@
+-R theories test
+-R src test
+-I src
+
+src/test_plugin.mllib
+src/test.ml4
+src/test.mli
+src/test_aux.ml
+src/test_aux.mli
+theories/test.v
diff --git a/test-suite/coq-makefile/plugin1/run.sh b/test-suite/coq-makefile/plugin1/run.sh
new file mode 100755
index 00000000..5433d9e9
--- /dev/null
+++ b/test-suite/coq-makefile/plugin1/run.sh
@@ -0,0 +1,26 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+mv src/test_plugin.mlpack src/test_plugin.mllib
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+#make debug
+(cd `find tmp -name user-contrib` && find .) | sort > actual
+sort > desired <<EOT
+.
+./test
+./test/test.glob
+./test/test.cmi
+./test/test.cmx
+./test/test_aux.cmi
+./test/test_aux.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.v
+./test/test.vo
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/plugin2/_CoqProject b/test-suite/coq-makefile/plugin2/_CoqProject
new file mode 100644
index 00000000..0bf1e07f
--- /dev/null
+++ b/test-suite/coq-makefile/plugin2/_CoqProject
@@ -0,0 +1,10 @@
+-R theories/ test
+-R src/ test
+-I src/
+
+src/test_plugin.mllib
+src/test.ml4
+src/test.mli
+src/test_aux.ml
+src/test_aux.mli
+theories/test.v
diff --git a/test-suite/coq-makefile/plugin2/run.sh b/test-suite/coq-makefile/plugin2/run.sh
new file mode 100755
index 00000000..5433d9e9
--- /dev/null
+++ b/test-suite/coq-makefile/plugin2/run.sh
@@ -0,0 +1,26 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+mv src/test_plugin.mlpack src/test_plugin.mllib
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+#make debug
+(cd `find tmp -name user-contrib` && find .) | sort > actual
+sort > desired <<EOT
+.
+./test
+./test/test.glob
+./test/test.cmi
+./test/test.cmx
+./test/test_aux.cmi
+./test/test_aux.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.v
+./test/test.vo
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/plugin3/_CoqProject b/test-suite/coq-makefile/plugin3/_CoqProject
new file mode 100644
index 00000000..2028d49a
--- /dev/null
+++ b/test-suite/coq-makefile/plugin3/_CoqProject
@@ -0,0 +1,10 @@
+-R theories/ test
+-R src/ test
+-I src/
+
+./src/test_plugin.mllib
+./src/test.ml4
+./src/test.mli
+./src/test_aux.ml
+./src/test_aux.mli
+./theories/test.v
diff --git a/test-suite/coq-makefile/plugin3/run.sh b/test-suite/coq-makefile/plugin3/run.sh
new file mode 100755
index 00000000..5433d9e9
--- /dev/null
+++ b/test-suite/coq-makefile/plugin3/run.sh
@@ -0,0 +1,26 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+mv src/test_plugin.mlpack src/test_plugin.mllib
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+#make debug
+(cd `find tmp -name user-contrib` && find .) | sort > actual
+sort > desired <<EOT
+.
+./test
+./test/test.glob
+./test/test.cmi
+./test/test.cmx
+./test/test_aux.cmi
+./test/test_aux.cmx
+./test/test_plugin.cmxa
+./test/test_plugin.cmxs
+./test/test.v
+./test/test.vo
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/quick2vo/_CoqProject b/test-suite/coq-makefile/quick2vo/_CoqProject
new file mode 100644
index 00000000..69f47302
--- /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 00000000..9e681223
--- /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
new file mode 100755
index 00000000..e19d168c
--- /dev/null
+++ b/test-suite/coq-makefile/template/init.sh
@@ -0,0 +1,17 @@
+. ../template/path-init.sh
+
+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
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 00000000..dd19ab2b
--- /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
new file mode 100644
index 00000000..72765abe
--- /dev/null
+++ b/test-suite/coq-makefile/template/src/test.ml4
@@ -0,0 +1,14 @@
+open Ltac_plugin
+DECLARE PLUGIN "test_plugin"
+let () = Mltop.add_known_plugin (fun () -> ()) "test_plugin";;
+
+VERNAC COMMAND EXTEND Test CLASSIFIED AS SIDEFF
+  | [ "TestCommand" ] -> [ () ]
+END
+
+TACTIC EXTEND test
+| [ "test_tactic" ] -> [ Test_aux.tac ]
+END
+
+
+
diff --git a/test-suite/coq-makefile/template/src/test.mli b/test-suite/coq-makefile/template/src/test.mli
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/test-suite/coq-makefile/template/src/test.mli
diff --git a/test-suite/coq-makefile/template/src/test_aux.ml b/test-suite/coq-makefile/template/src/test_aux.ml
new file mode 100644
index 00000000..a01d0865
--- /dev/null
+++ b/test-suite/coq-makefile/template/src/test_aux.ml
@@ -0,0 +1 @@
+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
new file mode 100644
index 00000000..10020f27
--- /dev/null
+++ b/test-suite/coq-makefile/template/src/test_aux.mli
@@ -0,0 +1 @@
+val tac : unit Proofview.tactic
diff --git a/test-suite/coq-makefile/template/src/test_plugin.mlpack b/test-suite/coq-makefile/template/src/test_plugin.mlpack
new file mode 100644
index 00000000..cf94d851
--- /dev/null
+++ b/test-suite/coq-makefile/template/src/test_plugin.mlpack
@@ -0,0 +1,2 @@
+Test_aux
+Test
diff --git a/test-suite/coq-makefile/template/theories/sub/testsub.v b/test-suite/coq-makefile/template/theories/sub/testsub.v
new file mode 100644
index 00000000..755fc343
--- /dev/null
+++ b/test-suite/coq-makefile/template/theories/sub/testsub.v
@@ -0,0 +1 @@
+Require Import test.
diff --git a/test-suite/coq-makefile/template/theories/test.v b/test-suite/coq-makefile/template/theories/test.v
new file mode 100644
index 00000000..744b5aad
--- /dev/null
+++ b/test-suite/coq-makefile/template/theories/test.v
@@ -0,0 +1,7 @@
+Declare ML Module "test_plugin".
+TestCommand.
+Goal True.
+Proof.
+test_tactic.
+exact I.
+Qed.
diff --git a/test-suite/coq-makefile/timing/after/Fast.v b/test-suite/coq-makefile/timing/after/Fast.v
new file mode 100644
index 00000000..54d3cfc3
--- /dev/null
+++ b/test-suite/coq-makefile/timing/after/Fast.v
@@ -0,0 +1,4 @@
+Require Coq.ZArith.BinInt.
+Definition foo0 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
+Definition foo1 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
+Definition foo2 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
diff --git a/test-suite/coq-makefile/timing/after/Slow.v b/test-suite/coq-makefile/timing/after/Slow.v
new file mode 100644
index 00000000..8b137891
--- /dev/null
+++ b/test-suite/coq-makefile/timing/after/Slow.v
@@ -0,0 +1 @@
+
diff --git a/test-suite/coq-makefile/timing/after/_CoqProject b/test-suite/coq-makefile/timing/after/_CoqProject
new file mode 100644
index 00000000..36c3a18c
--- /dev/null
+++ b/test-suite/coq-makefile/timing/after/_CoqProject
@@ -0,0 +1,2 @@
+Slow.v
+Fast.v
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
new file mode 100644
index 00000000..7900c034
--- /dev/null
+++ b/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired
@@ -0,0 +1,15 @@
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+COQDEP VFILES
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+COQC Slow.v
+Slow (real: 0.04, user: 0.02, sys: 0.01, mem: 45512 ko)
+COQC Fast.v
+Fast (real: 0.41, user: 0.37, sys: 0.04, mem: 395200 ko)
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
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
new file mode 100644
index 00000000..7ab0bc75
--- /dev/null
+++ b/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired
@@ -0,0 +1,15 @@
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+COQDEP VFILES
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
+COQC Slow.v
+Slow (real: 0.40, user: 0.35, sys: 0.04, mem: 394968 ko)
+COQC Fast.v
+Fast (real: 0.04, user: 0.03, sys: 0.00, mem: 46564 ko)
+Makefile:69: warning: undefined variable '*'
+Makefile:204: warning: undefined variable 'DSTROOT'
diff --git a/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired
new file mode 100644
index 00000000..72c52021
--- /dev/null
+++ b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired
@@ -0,0 +1,6 @@
+After    | File Name | Before   || Change    | % Change 
+--------------------------------------------------------
+0m00.34s | Total     | 0m00.49s || -0m00.14s | -30.61%  
+--------------------------------------------------------
+0m00.32s | Fast      | 0m00.02s || +0m00.30s | +1500.00%
+0m00.02s | Slow      | 0m00.47s || -0m00.44s | -95.74%  
\ No newline at end of file
diff --git a/test-suite/coq-makefile/timing/aggregate/Fast.v b/test-suite/coq-makefile/timing/aggregate/Fast.v
new file mode 100644
index 00000000..8b137891
--- /dev/null
+++ b/test-suite/coq-makefile/timing/aggregate/Fast.v
@@ -0,0 +1 @@
+
diff --git a/test-suite/coq-makefile/timing/aggregate/Slow.v b/test-suite/coq-makefile/timing/aggregate/Slow.v
new file mode 100644
index 00000000..54d3cfc3
--- /dev/null
+++ b/test-suite/coq-makefile/timing/aggregate/Slow.v
@@ -0,0 +1,4 @@
+Require Coq.ZArith.BinInt.
+Definition foo0 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
+Definition foo1 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
+Definition foo2 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
diff --git a/test-suite/coq-makefile/timing/aggregate/_CoqProject b/test-suite/coq-makefile/timing/aggregate/_CoqProject
new file mode 100644
index 00000000..36c3a18c
--- /dev/null
+++ b/test-suite/coq-makefile/timing/aggregate/_CoqProject
@@ -0,0 +1,2 @@
+Slow.v
+Fast.v
diff --git a/test-suite/coq-makefile/timing/before/Fast.v b/test-suite/coq-makefile/timing/before/Fast.v
new file mode 100644
index 00000000..8b137891
--- /dev/null
+++ b/test-suite/coq-makefile/timing/before/Fast.v
@@ -0,0 +1 @@
+
diff --git a/test-suite/coq-makefile/timing/before/Slow.v b/test-suite/coq-makefile/timing/before/Slow.v
new file mode 100644
index 00000000..54d3cfc3
--- /dev/null
+++ b/test-suite/coq-makefile/timing/before/Slow.v
@@ -0,0 +1,4 @@
+Require Coq.ZArith.BinInt.
+Definition foo0 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
+Definition foo1 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
+Definition foo2 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl.
diff --git a/test-suite/coq-makefile/timing/before/_CoqProject b/test-suite/coq-makefile/timing/before/_CoqProject
new file mode 100644
index 00000000..36c3a18c
--- /dev/null
+++ b/test-suite/coq-makefile/timing/before/_CoqProject
@@ -0,0 +1,2 @@
+Slow.v
+Fast.v
diff --git a/test-suite/coq-makefile/timing/error/A.v b/test-suite/coq-makefile/timing/error/A.v
new file mode 100644
index 00000000..932363a1
--- /dev/null
+++ b/test-suite/coq-makefile/timing/error/A.v
@@ -0,0 +1 @@
+Check I : I.
diff --git a/test-suite/coq-makefile/timing/error/_CoqProject b/test-suite/coq-makefile/timing/error/_CoqProject
new file mode 100644
index 00000000..790e0571
--- /dev/null
+++ b/test-suite/coq-makefile/timing/error/_CoqProject
@@ -0,0 +1 @@
+A.v
diff --git a/test-suite/coq-makefile/timing/per-file-after/A.v b/test-suite/coq-makefile/timing/per-file-after/A.v
new file mode 100644
index 00000000..851e2b97
--- /dev/null
+++ b/test-suite/coq-makefile/timing/per-file-after/A.v
@@ -0,0 +1,4 @@
+Require Coq.ZArith.BinInt.
+Declare Reduction comp := native_compute.
+Definition foo0 := Eval comp in (Coq.ZArith.BinInt.Z.div_eucl, Coq.ZArith.BinInt.Z.div_eucl).
+Definition foo1 := Eval comp in (foo0, foo0).
diff --git a/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired
new file mode 100644
index 00000000..74dad733
--- /dev/null
+++ b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired
@@ -0,0 +1,9 @@
+After     | Code                                                | Before    || Change    | % Change 
+----------------------------------------------------------------------------------------------------
+0m04.35s  | Total                                               | 0m00.58s  || +0m03.77s | +649.05% 
+----------------------------------------------------------------------------------------------------
+0m03.87s  | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m00.246s || +0m03.62s | +1473.17%
+0m00.322s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.189s || +0m00.13s | +70.37%  
+0m00.16s  | Chars 000 - 026 [Require~Coq.ZArith.BinInt.]        | 0m00.146s || +0m00.01s | +9.58%   
+0m00.s    | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] |    N/A    || +0m00.00s | N/A      
+   N/A    | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | 0m00.s    || +0m00.00s | N/A      
\ No newline at end of file
diff --git a/test-suite/coq-makefile/timing/per-file-after/_CoqProject b/test-suite/coq-makefile/timing/per-file-after/_CoqProject
new file mode 100644
index 00000000..790e0571
--- /dev/null
+++ b/test-suite/coq-makefile/timing/per-file-after/_CoqProject
@@ -0,0 +1 @@
+A.v
diff --git a/test-suite/coq-makefile/timing/per-file-before/A.v b/test-suite/coq-makefile/timing/per-file-before/A.v
new file mode 100644
index 00000000..115c1f95
--- /dev/null
+++ b/test-suite/coq-makefile/timing/per-file-before/A.v
@@ -0,0 +1,4 @@
+Require Coq.ZArith.BinInt.
+Declare Reduction comp :=     vm_compute.
+Definition foo0 := Eval comp in (Coq.ZArith.BinInt.Z.div_eucl, Coq.ZArith.BinInt.Z.div_eucl).
+Definition foo1 := Eval comp in (foo0, foo0).
diff --git a/test-suite/coq-makefile/timing/per-file-before/_CoqProject b/test-suite/coq-makefile/timing/per-file-before/_CoqProject
new file mode 100644
index 00000000..790e0571
--- /dev/null
+++ b/test-suite/coq-makefile/timing/per-file-before/_CoqProject
@@ -0,0 +1 @@
+A.v
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 00000000..4a50759b
--- /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 00000000..5757018e
--- /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 00000000..14102902
--- /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 00000000..159e6455
--- /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.04s | Total                                          | 21m25.27s || -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 00000000..4f39b3ce
--- /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 00000000..b9739ddb
--- /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.04s | 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 00000000..5757018e
--- /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 00000000..a918cceb
--- /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
new file mode 100755
index 00000000..f0e036ee
--- /dev/null
+++ b/test-suite/coq-makefile/timing/run.sh
@@ -0,0 +1,108 @@
+#!/usr/bin/env bash
+
+#set -x
+set -e
+
+. ../template/path-init.sh
+
+# reset MAKEFLAGS so that, e.g., `make -C test-suite -B coq-makefile` doesn't give us issues
+
+MAKEFLAGS=
+
+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
+    echo "Error: make pretty-timed should have failed"
+    exit 1
+fi
+
+cd ../aggregate
+coq_makefile -f _CoqProject -o Makefile
+make cleanall
+make pretty-timed TGTS="all" -j1 || exit $?
+
+cd ../before
+coq_makefile -f _CoqProject -o Makefile
+make cleanall
+make make-pretty-timed-before TGTS="all" -j1 || exit $?
+
+cd ../after
+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 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 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
+    -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; additionally, some N/A's show up where we expect to get -∞ on the per-line file, and so the ∞-replacement gets the sign wrong, so we must correct it
+)
+
+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
+    )
+
+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 "${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
+
+cd ../per-file-before
+coq_makefile -f _CoqProject -o Makefile
+make cleanall
+make all TIMING=before -j2 || exit $?
+
+cd ../per-file-after
+coq_makefile -f _CoqProject -o Makefile
+make cleanall
+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 "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_LINE[@]}" | sort > ${file}${ext}.processed
+    done
+done
+for file in A.v.timing.diff; do
+    diff -u $file.desired.processed $file.processed || exit $?
+done
+
+exit 0
diff --git a/test-suite/coq-makefile/uninstall1/_CoqProject b/test-suite/coq-makefile/uninstall1/_CoqProject
new file mode 100644
index 00000000..35792066
--- /dev/null
+++ b/test-suite/coq-makefile/uninstall1/_CoqProject
@@ -0,0 +1,11 @@
+-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
+theories/sub/testsub.v
diff --git a/test-suite/coq-makefile/uninstall1/run.sh b/test-suite/coq-makefile/uninstall1/run.sh
new file mode 100755
index 00000000..5354f794
--- /dev/null
+++ b/test-suite/coq-makefile/uninstall1/run.sh
@@ -0,0 +1,18 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+make install-doc DSTROOT="$PWD/tmp"
+make uninstall DSTROOT="$PWD/tmp"
+make uninstall-doc DSTROOT="$PWD/tmp"
+#make debug
+(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual
+sort -u > desired <<EOT
+.
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/uninstall2/_CoqProject b/test-suite/coq-makefile/uninstall2/_CoqProject
new file mode 100644
index 00000000..d2a547d4
--- /dev/null
+++ b/test-suite/coq-makefile/uninstall2/_CoqProject
@@ -0,0 +1,11 @@
+-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
+theories/sub/testsub.v
diff --git a/test-suite/coq-makefile/uninstall2/run.sh b/test-suite/coq-makefile/uninstall2/run.sh
new file mode 100755
index 00000000..5354f794
--- /dev/null
+++ b/test-suite/coq-makefile/uninstall2/run.sh
@@ -0,0 +1,18 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+make html mlihtml
+make install DSTROOT="$PWD/tmp"
+make install-doc DSTROOT="$PWD/tmp"
+make uninstall DSTROOT="$PWD/tmp"
+make uninstall-doc DSTROOT="$PWD/tmp"
+#make debug
+(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual
+sort -u > desired <<EOT
+.
+EOT
+exec diff -u desired actual
diff --git a/test-suite/coq-makefile/validate1/_CoqProject b/test-suite/coq-makefile/validate1/_CoqProject
new file mode 100644
index 00000000..69f47302
--- /dev/null
+++ b/test-suite/coq-makefile/validate1/_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/validate1/run.sh b/test-suite/coq-makefile/validate1/run.sh
new file mode 100755
index 00000000..43bf39de
--- /dev/null
+++ b/test-suite/coq-makefile/validate1/run.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+exec make validate
diff --git a/test-suite/coq-makefile/vio2vo/_CoqProject b/test-suite/coq-makefile/vio2vo/_CoqProject
new file mode 100644
index 00000000..69f47302
--- /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 00000000..85656da4
--- /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/bug_7539.v b/test-suite/coqchk/bug_7539.v
new file mode 100644
index 00000000..74ebe929
--- /dev/null
+++ b/test-suite/coqchk/bug_7539.v
@@ -0,0 +1,26 @@
+Set Primitive Projections.
+
+CoInductive Stream : Type := Cons { tl : Stream }.
+
+Fixpoint Str_nth_tl (n:nat) (s:Stream) : Stream :=
+  match n with
+  | O => s
+  | S m => Str_nth_tl m (tl s)
+  end.
+
+CoInductive EqSt (s1 s2: Stream) : Prop := eqst {
+  eqst_tl : EqSt (tl s1) (tl s2);
+}.
+
+Axiom EqSt_reflex : forall (s : Stream), EqSt s s.
+
+CoFixpoint map (s:Stream) : Stream := Cons (map (tl s)).
+
+Lemma Str_nth_tl_map : forall n s, EqSt (Str_nth_tl n (map s)) (map (Str_nth_tl n s)).
+Proof.
+induction n.
++ intros; apply EqSt_reflex.
++ cbn; intros s; apply IHn.
+Qed.
+
+Definition boom : forall s, tl (map s) = map (tl s) := fun s => eq_refl.
diff --git a/test-suite/coqchk/cumulativity.v b/test-suite/coqchk/cumulativity.v
new file mode 100644
index 00000000..03468405
--- /dev/null
+++ b/test-suite/coqchk/cumulativity.v
@@ -0,0 +1,67 @@
+Set Universe Polymorphism.
+Set Polymorphic Inductive Cumulativity.
+Set Printing Universes.
+
+Inductive List (A: Type) := nil | cons : A -> List A -> List A.
+
+Section ListLift.
+  Universe i j.
+
+  Constraint i < j.
+
+  Definition LiftL {A} : List@{i} A -> List@{j} A := fun x => x.
+
+End ListLift.
+
+Lemma LiftL_Lem A (l : List A) : l = LiftL l.
+Proof. reflexivity. Qed.
+
+Section ListLower.
+  Universe i j.
+
+  Constraint i < j.
+
+  Definition LowerL {A : Type@{i}} : List@{j} A -> List@{i} A := fun x => x.
+
+End ListLower.
+
+Lemma LowerL_Lem@{i j|j<i+} (A : Type@{j}) (l : List@{i} A) : l = LowerL@{j i} l.
+Proof. reflexivity. Qed.
+(*
+I disable these tests because cqochk can't process them when compiled with
+   ocaml-4.02.3+32bit and camlp5-4.16 which is the case for Travis!
+
+   I have added this file (including the commented parts below) in
+   test-suite/success/cumulativity.v which doesn't run coqchk on them.
+*)
+(* Inductive Tp := tp : Type -> Tp. *)
+
+(* Section TpLift. *)
+(*   Universe i j. *)
+
+(*   Constraint i < j. *)
+
+(*   Definition LiftTp : Tp@{i} -> Tp@{j} := fun x => x. *)
+
+(* End TpLift. *)
+
+(* Lemma LiftC_Lem (t : Tp) : LiftTp t = t. *)
+(* Proof. reflexivity. Qed. *)
+
+(* Section TpLower. *)
+(*   Universe i j. *)
+
+(*   Constraint i < j. *)
+
+(*   Fail Definition LowerTp : Tp@{j} -> Tp@{i} := fun x => x. *)
+
+(* End TpLower. *)
+
+
+(* Section subtyping_test. *)
+(*   Universe i j. *)
+(*   Constraint i < j. *)
+
+(*   Inductive TP2 := tp2 : Type@{i} -> Type@{j} -> TP2. *)
+
+(* End subtyping_test. *)
diff --git a/test-suite/coqchk/include.v b/test-suite/coqchk/include.v
new file mode 100644
index 00000000..6232c1b8
--- /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 00000000..f73c627e
--- /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/coqchk/univ.v b/test-suite/coqchk/univ.v
index 84a4009d..21633861 100644
--- a/test-suite/coqchk/univ.v
+++ b/test-suite/coqchk/univ.v
@@ -33,3 +33,57 @@ Inductive finite_of_order T (D : T -> Type) (n : natural) :=
     (rank_injective : injective_in T natural D rank)
     (rank_onto :
        forall i, equivalent (less_than i n) (in_image T natural D rank i)).
+
+(* Constraints *)
+Universes i j.
+Inductive constraint1 : (Type -> Type) -> Type := mk_constraint1 : constraint1 (fun x : Type@{i} => (x : Type@{j})).
+Constraint i < j.
+Inductive constraint2 : Type@{j} := mkc2 (_ : Type@{i}).
+Universes i' j'.
+Constraint i' = j'.
+Inductive constraint3 : (Type -> Type) -> Type := mk_constraint3 : constraint3 (fun x : Type@{i'} => (x : Type@{j'})).
+Inductive constraint4 : (Type -> Type) -> Type
+  := mk_constraint4 : let U1 := Type in
+                      let U2 := Type in
+                      constraint4 (fun x : U1 => (x : U2)).
+
+Module CMP_CON.
+  (* Comparison of opaque constants MUST be up to the universe graph.
+     See #6798. *)
+  Universe big.
+
+  Polymorphic Lemma foo@{u} : Type@{big}.
+  Proof. exact Type@{u}. Qed.
+
+  Universes U V.
+
+  Definition yo : foo@{U} = foo@{V} := eq_refl.
+End CMP_CON.
+
+Set Universe Polymorphism.
+
+Module POLY_SUBTYP.
+
+  Module Type T.
+    Axiom foo : Type.
+    Parameter bar@{u v|u = v} : foo@{u}.
+  End T.
+
+  Module M.
+    Axiom foo : Type.
+    Axiom bar@{u v|u = v} : foo@{v}.
+  End M.
+
+  Module F (A:T). End F.
+
+  Module X := F M.
+
+End POLY_SUBTYP.
+
+Module POLY_IND.
+
+  Polymorphic Inductive ind@{u v | u < v} : Prop := .
+
+  Polymorphic Definition cst@{u v | v < u} := Prop.
+
+End POLY_IND.
diff --git a/test-suite/coqdoc/bug5648.html.out b/test-suite/coqdoc/bug5648.html.out
new file mode 100644
index 00000000..5c5a2dc2
--- /dev/null
+++ b/test-suite/coqdoc/bug5648.html.out
@@ -0,0 +1,53 @@
+<!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.bug5648</title>
+</head>
+
+<body>
+
+<div id="page">
+
+<div id="header">
+</div>
+
+<div id="main">
+
+<h1 class="libtitle">Library Coqdoc.bug5648</h1>
+
+<div class="code">
+<span class="id" title="keyword">Lemma</span> <a name="a"><span class="id" title="lemma">a</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a>.<br/>
+<span class="id" title="keyword">Proof</span>.<br/>
+<span class="id" title="tactic">auto</span>.<br/>
+<span class="id" title="keyword">Qed</span>.<br/>
+
+<br/>
+<span class="id" title="keyword">Variant</span> <a name="t"><span class="id" title="inductive">t</span></a> :=<br/>
+| <a name="A"><span class="id" title="constructor">A</span></a> | <a name="Add"><span class="id" title="constructor">Add</span></a> | <a name="G"><span class="id" title="constructor">G</span></a> | <a name="Goal"><span class="id" title="constructor">Goal</span></a> | <a name="L"><span class="id" title="constructor">L</span></a> | <a name="Lemma"><span class="id" title="constructor">Lemma</span></a> | <a name="P"><span class="id" title="constructor">P</span></a> | <a name="Proof"><span class="id" title="constructor">Proof</span></a> .<br/>
+
+<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> ⇒ 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>
+
+<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/bug5648.tex.out b/test-suite/coqdoc/bug5648.tex.out
new file mode 100644
index 00000000..82f7da23
--- /dev/null
+++ b/test-suite/coqdoc/bug5648.tex.out
@@ -0,0 +1,59 @@
+\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.bug5648}{Library }{Coqdoc.bug5648}
+
+\begin{coqdoccode}
+\coqdocnoindent
+\coqdockw{Lemma} \coqdef{Coqdoc.bug5648.a}{a}{\coqdoclemma{a}} : \coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}.\coqdoceol
+\coqdocnoindent
+\coqdockw{Proof}.\coqdoceol
+\coqdocnoindent
+\coqdoctac{auto}.\coqdoceol
+\coqdocnoindent
+\coqdockw{Qed}.\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Variant} \coqdef{Coqdoc.bug5648.t}{t}{\coqdocinductive{t}} :=\coqdoceol
+\coqdocnoindent
+\ensuremath{|} \coqdef{Coqdoc.bug5648.A}{A}{\coqdocconstructor{A}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Add}{Add}{\coqdocconstructor{Add}} \ensuremath{|} \coqdef{Coqdoc.bug5648.G}{G}{\coqdocconstructor{G}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Goal}{Goal}{\coqdocconstructor{Goal}} \ensuremath{|} \coqdef{Coqdoc.bug5648.L}{L}{\coqdocconstructor{L}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Lemma}{Lemma}{\coqdocconstructor{Lemma}} \ensuremath{|} \coqdef{Coqdoc.bug5648.P}{P}{\coqdocconstructor{P}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Proof}{Proof}{\coqdocconstructor{Proof}} .\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.bug5648.d}{d}{\coqdocdefinition{d}} \coqdocvar{x} :=\coqdoceol
+\coqdocindent{1.00em}
+\coqdockw{match} \coqdocvariable{x} \coqdockw{with}\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.A}{\coqdocconstructor{A}} \ensuremath{\Rightarrow} 0\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.Add}{\coqdocconstructor{Add}} \ensuremath{\Rightarrow} 1\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.G}{\coqdocconstructor{G}} \ensuremath{\Rightarrow} 2\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.Goal}{\coqdocconstructor{Goal}} \ensuremath{\Rightarrow} 3\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.L}{\coqdocconstructor{L}} \ensuremath{\Rightarrow} 4\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.Lemma}{\coqdocconstructor{Lemma}} \ensuremath{\Rightarrow} 5\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.P}{\coqdocconstructor{P}} \ensuremath{\Rightarrow} 6\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqref{Coqdoc.bug5648.Proof}{\coqdocconstructor{Proof}} \ensuremath{\Rightarrow} 7\coqdoceol
+\coqdocindent{1.00em}
+\coqdockw{end}.\coqdoceol
+\end{coqdoccode}
+\end{document}
diff --git a/test-suite/coqdoc/bug5648.v b/test-suite/coqdoc/bug5648.v
new file mode 100644
index 00000000..9b62dd1e
--- /dev/null
+++ b/test-suite/coqdoc/bug5648.v
@@ -0,0 +1,19 @@
+Lemma a : True.
+Proof.
+auto.
+Qed.
+
+Variant t :=
+| A | Add | G | Goal | L | Lemma | P | Proof .
+
+Definition d x :=
+  match x with
+  | A => 0
+  | Add => 1
+  | G => 2
+  | Goal => 3
+  | L => 4
+  | Lemma => 5
+  | P => 6
+  | Proof => 7
+  end.
diff --git a/test-suite/coqdoc/bug5700.html.out b/test-suite/coqdoc/bug5700.html.out
new file mode 100644
index 00000000..b96fc628
--- /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 00000000..1a1af5df
--- /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 00000000..839034a4
--- /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
new file mode 100644
index 00000000..5e4b676c
--- /dev/null
+++ b/test-suite/coqdoc/links.html.out
@@ -0,0 +1,206 @@
+<!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.links</title>
+</head>
+
+<body>
+
+<div id="page">
+
+<div id="header">
+</div>
+
+<div id="main">
+
+<h1 class="libtitle">Library Coqdoc.links</h1>
+
+<div class="code">
+</div>
+
+<div class="doc">
+Various checks for coqdoc
+
+<div class="paragraph"> </div>
+
+<ul class="doclist">
+<li> symbols should not be inlined in string g
+
+</li>
+<li> links to both kinds of notations in a' should work to the right notation
+
+</li>
+<li> with utf8 option, forall must be unicode
+
+</li>
+<li> splitting between symbols and ident should be correct in a' and c
+
+</li>
+<li> ".." should be rendered correctly
+
+</li>
+</ul>
+
+</div>
+<div class="code">
+
+<br/>
+<span class="id" title="keyword">Require</span> <span class="id" title="keyword">Import</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Strings.String.html#"><span class="id" title="library">String</span></a>.<br/>
+
+<br/>
+<span class="id" title="keyword">Definition</span> <a name="g"><span class="id" title="definition">g</span></a> := "dfjkh""sdfhj forall &lt;&gt; * ~"%<span class="id" title="var">string</span>.<br/>
+
+<br/>
+<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">∀</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/>
+
+<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#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). 
+<br/>
+<span class="id" title="keyword">Notation</span> <a name="6b97e27793a3d22f5c0d1dd63170fd68"><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>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/>
+
+<br/>
+<span class="id" title="keyword">Notation</span> <a name="3e01fbae4590c7b7699ff99ce61580e1"><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>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/>
+
+<br/>
+<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">→</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="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/>
+
+<br/>
+<span class="id" title="keyword">Notation</span> <a name="548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">&quot;</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/>
+
+<br/>
+<span class="id" title="keyword">Definition</span> <a name="9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#6b97e27793a3d22f5c0d1dd63170fd68"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">))</span></a>.<br/>
+
+<br/>
+<span class="id" title="keyword">Notation</span> <a name="h"><span class="id" title="abbreviation">h</span></a> := <a class="idref" href="Coqdoc.links.html#a"><span class="id" title="definition">a</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;<span class="id" title="keyword">Section</span> <a name="test"><span class="id" title="section">test</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Variables</span> <a name="test.b'"><span class="id" title="variable">b'</span></a> <a name="test.b2"><span class="id" title="variable">b2</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/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Notation</span> <a name="4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">&quot;</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#3e01fbae4590c7b7699ff99ce61580e1"><span class="id" title="notation">â–µ</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Delimit</span> <span class="id" title="keyword">Scope</span> <span class="id" title="var">my_scope</span> <span class="id" title="keyword">with</span> <span class="id" title="var">my</span>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Notation</span> <a name="l"><span class="id" title="abbreviation">l</span></a> := 0.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Definition</span> <a name="ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<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="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Definition</span> <a name="c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Lemma</span> <a name="e"><span class="id" title="lemma">e</span></a> : <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="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#3dcaec3b772747610227247939f96b01"><span class="id" title="notation">+</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/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="var">Admitted</span>.<br/>
+
+<br/>
+&nbsp;&nbsp;<span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test"><span class="id" title="section">test</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;<span class="id" title="keyword">Section</span> <a name="test2"><span class="id" title="section">test2</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Variables</span> <a name="test2.b'"><span class="id" title="variable">b'</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/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Section</span> <a name="test2.test"><span class="id" title="section">test</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">Variables</span> <a name="test2.test.b2"><span class="id" title="variable">b2</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/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<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="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/>
+
+<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test2.test"><span class="id" title="section">test</span></a>.<br/>
+
+<br/>
+&nbsp;&nbsp;<span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test2"><span class="id" title="section">test2</span></a>.<br/>
+
+<br/>
+</div>
+
+<div class="doc">
+skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+<div class="paragraph"> </div>
+
+ skip 
+</div>
+<div class="code">
+
+<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/links.tex.out b/test-suite/coqdoc/links.tex.out
new file mode 100644
index 00000000..f42db99d
--- /dev/null
+++ b/test-suite/coqdoc/links.tex.out
@@ -0,0 +1,172 @@
+\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.links}{Library }{Coqdoc.links}
+
+\begin{coqdoccode}
+\end{coqdoccode}
+Various checks for coqdoc
+
+
+
+\begin{itemize}
+\item  symbols should not be inlined in string g
+
+\item  links to both kinds of notations in a' should work to the right notation
+
+\item  with utf8 option, forall must be unicode
+
+\item  splitting between symbols and ident should be correct in a' and c
+
+\item  ``..'' should be rendered correctly
+
+\end{itemize}
+\begin{coqdoccode}
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Require} \coqdockw{Import} \coqexternalref{}{http://coq.inria.fr/stdlib/Coq.Strings.String}{\coqdoclibrary{String}}.\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.links.g}{g}{\coqdocdefinition{g}} := "dfjkh""sdfhj forall <> * \~{}"\%\coqdocvar{string}.\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.links.a}{a}{\coqdocdefinition{a}} (\coqdocvar{b}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}) := \coqdocvariable{b}.\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.links.f}{f}{\coqdocdefinition{f}} := \coqdockw{\ensuremath{\forall}} \coqdocvar{C}:\coqdockw{Prop}, \coqdocvariable{C}.\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}).\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{mult}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{mult}} \coqdocvar{n} \coqdocvar{m}). \coqdocemptyline
+\coqdocnoindent
+\coqdockw{Notation} \coqdef{Coqdoc.links.::x '**' x}{"}{"}n ** m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Notation} \coqdef{Coqdoc.links.::x 'xE2x96xB5' x}{"}{"}n â–µ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Notation} \coqdef{Coqdoc.links.::x ''' ''' '++' 'x' x}{"}{"}n '\_' ++ 'x' m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 3).\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdocvar{A}:\coqdockw{Type}) (\coqdocvar{x}:\coqdocvariable{A}) : \coqdocvar{A} \coqexternalref{:type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqdocvariable{A}\coqdoceol
+\coqdocnoindent
+\coqdoceol
+\coqdocnoindent
+\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
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Notation} \coqdef{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{"}{"}( x \# y ; .. ; z )" := (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} .. (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} \coqdocvar{x} \coqdocvar{y}) .. \coqdocvar{z}).\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.links.b xCExB1}{b\_α}{\coqdocdefinition{b\_α}} := \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{(}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{\#}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{;}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{)}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{,}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}0 \coqref{Coqdoc.links.::x '**' x}{\coqdocnotation{**}} 0\coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{))}}.\coqdoceol
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Notation} \coqdef{Coqdoc.links.h}{h}{\coqdocabbreviation{h}} := \coqref{Coqdoc.links.a}{\coqdocdefinition{a}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{1.00em}
+\coqdockw{Section} \coqdef{Coqdoc.links.test}{test}{\coqdocsection{test}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Variables} \coqdef{Coqdoc.links.test.b'}{b'}{\coqdocvariable{b'}} \coqdef{Coqdoc.links.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Notation} \coqdef{Coqdoc.links.test.:my scope:x '+' x}{"}{"}n + m" := (\coqdocvar{n} \coqref{Coqdoc.links.::x 'xE2x96xB5' x}{\coqdocnotation{â–µ}} \coqdocvar{m}) : \coqdocvar{my\_scope}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Delimit} \coqdockw{Scope} \coqdocvar{my\_scope} \coqdockw{with} \coqdocvar{my}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Notation} \coqdef{Coqdoc.links.l}{l}{\coqdocabbreviation{l}} := 0.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Definition} \coqdef{Coqdoc.links.xCExB1}{α}{\coqdocdefinition{α}} := (0 \coqref{Coqdoc.links.test.:my scope:x '+' x}{\coqdocnotation{+}} \coqref{Coqdoc.links.l}{\coqdocabbreviation{l}})\%\coqdocvar{my}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdocvar{b} := \coqdocvariable{b'}\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}\coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Definition} \coqdef{Coqdoc.links.c}{c}{\coqdocdefinition{c}} := \coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}+\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Definition} \coqdef{Coqdoc.links.d}{d}{\coqdocdefinition{d}} := (1\coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}}2)\%\coqdocvar{nat}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Lemma} \coqdef{Coqdoc.links.e}{e}{\coqdoclemma{e}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} \coqexternalref{:type scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{+}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol
+\coqdocindent{2.00em}
+\coqdocvar{Admitted}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{1.00em}
+\coqdockw{End} \coqref{Coqdoc.links.test}{\coqdocsection{test}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{1.00em}
+\coqdockw{Section} \coqdef{Coqdoc.links.test2}{test2}{\coqdocsection{test2}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Variables} \coqdef{Coqdoc.links.test2.b'}{b'}{\coqdocvariable{b'}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{Section} \coqdef{Coqdoc.links.test2.test}{test}{\coqdocsection{test}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{3.00em}
+\coqdockw{Variables} \coqdef{Coqdoc.links.test2.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{3.00em}
+\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdocvar{b} := \coqdocvariable{b'} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b} \coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{End} \coqref{Coqdoc.links.test2.test}{\coqdocsection{test}}.\coqdoceol
+\coqdocemptyline
+\coqdocindent{1.00em}
+\coqdockw{End} \coqref{Coqdoc.links.test2}{\coqdocsection{test2}}.\coqdoceol
+\coqdocemptyline
+\end{coqdoccode}
+skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip \begin{coqdoccode}
+\coqdocemptyline
+\end{coqdoccode}
+\end{document}
diff --git a/test-suite/coqwc/BZ5637.out b/test-suite/coqwc/BZ5637.out
new file mode 100644
index 00000000..f0b5e4f7
--- /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 00000000..6428b10f
--- /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 00000000..039d1e50
--- /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 00000000..ccb12076
--- /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 00000000..14c5713f
--- /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 00000000..640f9ea7
--- /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 00000000..7a0fd777
--- /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 00000000..786df989
--- /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 00000000..d01507bf
--- /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 00000000..901c9074
--- /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/Tauto.v b/test-suite/failure/Tauto.v
index d91d159d..81d5b635 100644
--- a/test-suite/failure/Tauto.v
+++ b/test-suite/failure/Tauto.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (**** Tactics Tauto and Intuition ****)
 
diff --git a/test-suite/failure/circular_subtyping.v b/test-suite/failure/circular_subtyping.v
index ceccd460..9eb7e3bc 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/clash_cons.v b/test-suite/failure/clash_cons.v
index b3fbff68..89299110 100644
--- a/test-suite/failure/clash_cons.v
+++ b/test-suite/failure/clash_cons.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (* Teste la verification d'unicite des noms de constr *)
 
diff --git a/test-suite/failure/cofixpoint.v b/test-suite/failure/cofixpoint.v
index cb39893f..d193dc48 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/fixpoint1.v b/test-suite/failure/fixpoint1.v
index c2b521c2..eb3d9452 100644
--- a/test-suite/failure/fixpoint1.v
+++ b/test-suite/failure/fixpoint1.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 Fail Fixpoint PreParadox (u : unit) : False := PreParadox u.
 (*Definition Paradox := PreParadox tt.*)
diff --git a/test-suite/failure/fixpointeta.v b/test-suite/failure/fixpointeta.v
new file mode 100644
index 00000000..9af71932
--- /dev/null
+++ b/test-suite/failure/fixpointeta.v
@@ -0,0 +1,70 @@
+
+Set Primitive Projections.
+
+Record R := C { p : nat }.
+(* R is defined
+p is defined *)
+
+Unset Primitive Projections.
+Record R' := C' { p' : nat }.
+
+
+
+Fail Definition f := fix f (x : R) : nat := p x.
+(** Not allowed to make fixpoint defs on (non-recursive) records
+  having eta *)
+
+Fail Definition f := fix f (x : R') : nat := p' x.
+(** Even without eta (R' is not primitive here), as long as they're
+  found to be BiFinite (non-recursive), we disallow it *)
+
+(*
+
+(* Subject reduction failure example, if we allowed fixpoints *)
+
+Set Primitive Projections.
+
+Record R := C { p : nat }.
+
+Definition f := fix f (x : R) : nat := p x.
+
+(* eta rule for R *)
+Definition Rtr (P : R -> Type) x (v : P (C (p x))) : P x
+ := v.
+
+Definition goal := forall x, f x = p x.
+
+(* when we compute the Rtr away typechecking will fail *)
+Definition thing : goal := fun x =>
+(Rtr (fun x => f x = p x) x (eq_refl _)).
+
+Definition thing' := Eval compute in thing.
+
+Fail Check (thing = thing').
+(*
+The command has indeed failed with message:
+The term "thing'" has type "forall x : R, (let (p) := x in p) = (let (p) := x in p)"
+while it is expected to have type "goal" (cannot unify "(let (p) := x in p) = (let (p) := x in p)"
+and "f x = p x").
+*)
+
+Definition thing_refl := eq_refl thing.
+
+Fail Definition thing_refl' := Eval compute in thing_refl.
+(*
+The command has indeed failed with message:
+Illegal application:
+The term "@eq_refl" of type "forall (A : Type) (x : A), x = x"
+cannot be applied to the terms
+ "forall x : R, (fix f (x0 : R) : nat := let (p) := x0 in p) x = (let (p) := x in p)" : "Prop"
+ "fun x : R => eq_refl" : "forall x : R, (let (p) := x in p) = (let (p) := x in p)"
+The 2nd term has type "forall x : R, (let (p) := x in p) = (let (p) := x in p)"
+which should be coercible to
+ "forall x : R, (fix f (x0 : R) : nat := let (p) := x0 in p) x = (let (p) := x in p)".
+ *)
+
+Definition more_refls : thing_refl = thing_refl.
+Proof.
+  compute. reflexivity.
+Fail Defined. Abort.
+ *)
diff --git a/test-suite/failure/guard-cofix.v b/test-suite/failure/guard-cofix.v
index eda4a186..3ae87705 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/guard.v b/test-suite/failure/guard.v
index 8db27858..2a5ad778 100644
--- a/test-suite/failure/guard.v
+++ b/test-suite/failure/guard.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*
 Fixpoint F (n:nat) : False := F (match F n with end).
diff --git a/test-suite/failure/illtype1.v b/test-suite/failure/illtype1.v
index 8ed3af1c..ec43ea5f 100644
--- a/test-suite/failure/illtype1.v
+++ b/test-suite/failure/illtype1.v
@@ -1,8 +1,10 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 Fail Check (S S).
diff --git a/test-suite/failure/int31.v b/test-suite/failure/int31.v
index b1d11224..ed4c9f9c 100644
--- a/test-suite/failure/int31.v
+++ b/test-suite/failure/int31.v
@@ -1,4 +1,4 @@
-Require Import Int31 BigN.
+Require Import Int31 Cyclic31.
 
 Open Scope int31_scope.
 
diff --git a/test-suite/failure/positivity.v b/test-suite/failure/positivity.v
index 8089de2b..2798dcf9 100644
--- a/test-suite/failure/positivity.v
+++ b/test-suite/failure/positivity.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Negative occurrence *)
diff --git a/test-suite/failure/proofirrelevance.v b/test-suite/failure/proofirrelevance.v
index b62f9b68..bb9579d4 100644
--- a/test-suite/failure/proofirrelevance.v
+++ b/test-suite/failure/proofirrelevance.v
@@ -1,6 +1,5 @@
-(* This was working in version 8.1beta (bug in the Sort-polymorphism
-   of inductive types), but this is inconsistent with classical logic
-   in Prop *)
+(* This was working in version 8.1beta (bug in template polymorphism),
+   but this is inconsistent with classical logic in Prop *)
 
 Inductive bool_in_prop : Type := hide : bool -> bool_in_prop
 with bool : Type := true : bool | false : bool.
diff --git a/test-suite/failure/redef.v b/test-suite/failure/redef.v
index c8dc6303..981d1438 100644
--- a/test-suite/failure/redef.v
+++ b/test-suite/failure/redef.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 Definition toto := Set.
 Fail Definition toto := Set.
diff --git a/test-suite/failure/search.v b/test-suite/failure/search.v
index 648ab082..058c427c 100644
--- a/test-suite/failure/search.v
+++ b/test-suite/failure/search.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Fail SearchPattern (_ = _) outside n_existe_pas.
diff --git a/test-suite/failure/sortelim.v b/test-suite/failure/sortelim.v
index 2b3cf106..3d2eef6a 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/ide/blocking-futures.fake b/test-suite/ide/blocking-futures.fake
index b63f09bc..541fb798 100644
--- a/test-suite/ide/blocking-futures.fake
+++ b/test-suite/ide/blocking-futures.fake
@@ -4,6 +4,7 @@
 # Extraction will force the future computation, assert it is blocking
 # Example courtesy of Jonathan (jonikelee)
 #
+ADD { Require Coq.extraction.Extraction. }
 ADD { Require Import List. }
 ADD { Import ListNotations. }
 ADD { Definition myrev{A}(l : list A) : {rl : list A | rl = rev l}. }
diff --git a/test-suite/ide/bug7088.fake b/test-suite/ide/bug7088.fake
new file mode 100644
index 00000000..e2a2aa52
--- /dev/null
+++ b/test-suite/ide/bug7088.fake
@@ -0,0 +1,13 @@
+ADD { Arguments id T x : rename. }
+ADD { Lemma foo : True. }
+ADD here { Proof. }
+ADD { exact 3. }
+ADD { Qed. }
+WAIT
+EDIT_AT here
+ADD { Arguments id FOO BAR : rename. }
+ADD { exact I. }
+ADD { Qed. }
+ADD { Arguments id T x : assert. }
+JOIN
+
diff --git a/test-suite/ide/load.fake b/test-suite/ide/load.fake
new file mode 100644
index 00000000..f6a7ef4d
--- /dev/null
+++ b/test-suite/ide/load.fake
@@ -0,0 +1,11 @@
+ADD revert { Load "output/load/Load_noproof.v". }
+ADD { Load "output/load/Load_proof.v". }
+ADD { Fail Load "output/load/Load_openproof.v". }
+WAIT
+QUERY { Check f. }
+QUERY { Check u. }
+EDIT_AT revert
+QUERY { Check f. }
+QUERY { Fail Check u. }
+JOIN
+
diff --git a/test-suite/ide/undo.v b/test-suite/ide/undo.v
deleted file mode 100644
index ea392055..00000000
--- a/test-suite/ide/undo.v
+++ /dev/null
@@ -1,103 +0,0 @@
-(* Here are a sequences of scripts to test interactively with undo and
-   replay in coqide proof sessions *)
-
-(* Undoing arbitrary commands, as first step *)
-
-Theorem a : O=O. (* 2 *)
-Ltac f x := x. (* 1 * 3 *)
-assert True by trivial.
-trivial.
-Qed.
-
-(* Undoing arbitrary commands, as non-first step *)
-
-Theorem b : O=O.
-assert True by trivial.
-Ltac g x := x.
-assert True by trivial.
-trivial.
-Qed.
-
-(* Undoing declarations, as first step *)
-(* was bugged in 8.1 *)
-
-Theorem c : O=O.
-Inductive T : Type := I.
-trivial.
-Qed.
-
-(* Undoing declarations, as first step *)
-(* new in 8.2 *)
-
-Theorem d : O=O.
-Definition e := O.
-Definition f := O.
-assert True by trivial.
-trivial.
-Qed.
-
-(* Undoing declarations, as non-first step *)
-(* new in 8.2 *)
-
-Theorem h : O=O.
-assert True by trivial.
-Definition i := O.
-Definition j := O.
-assert True by trivial.
-trivial.
-Qed.
-
-(* Undoing declarations, interleaved with proof steps *)
-(* new in 8.2 *)
-
-Theorem k : O=O.
-assert True by trivial.
-Definition l := O.
-assert True by trivial.
-Definition m := O.
-assert True by trivial.
-trivial.
-Qed.
-
-(* Undoing declarations, interleaved with proof steps and commands *)
-(* new in 8.2 *)
-
-Theorem n : O=O.
-assert True by trivial.
-Definition o := O.
-Ltac h x := x.
-assert True by trivial.
-Focus.
-Definition p := O.
-assert True by trivial.
-trivial.
-Qed.
-
-(* Undoing declarations, not in proof *)
-
-Definition q := O.
-Definition r := O.
-
-(* Bug 2082 : Follow the numbers *)
-(* Broken due to proof engine rewriting *)
-
-Variable A : Prop.
-Variable B : Prop.
-
-Axiom OR : A \/ B.
-
-Lemma MyLemma2 : True.
-proof.
-per cases of (A \/ B) by OR.
-suppose A.
-    then (1 = 1).
-    then H1 : thesis. (* 4 *)
-    thus thesis by H1. (* 2 *)
-suppose B. (* 1 *) (* 3 *)
-    then (1 = 1).
-    then H2 : thesis.
-    thus thesis by H2.
-end cases.
-end proof.
-Qed. (* 5 if you made it here, there is no regression *)
-
diff --git a/test-suite/ide/undo011.fake b/test-suite/ide/undo011.fake
deleted file mode 100644
index 0be439b2..00000000
--- a/test-suite/ide/undo011.fake
+++ /dev/null
@@ -1,34 +0,0 @@
-# Script simulating a dialog between coqide and coqtop -ideslave
-# Run it via fake_ide
-#
-# Bug 2082
-# Broken due to proof engine rewriting
-#
-ADD { Variable A : Prop. }
-ADD { Variable B : Prop. }
-ADD { Axiom OR : A \/ B. }
-ADD { Lemma MyLemma2 : True. }
-ADD { proof. }
-ADD { per cases of (A \/ B) by OR. }
-ADD { suppose A. }
-ADD {     then (1 = 1). }
-ADD there {     then H1 : thesis. }
-ADD here {     thus thesis by H1. }
-ADD { suppose B. }
-QUERY { Show. }
-EDIT_AT here
-# <replay>
-ADD { suppose B. }
-# </replay>
-EDIT_AT there
-# <replay>
-ADD {    thus thesis by H1. }
-ADD { suppose B. }
-# </replay>
-QUERY { Show. }
-ADD {    then (1 = 1). }
-ADD {    then H2 : thesis. }
-ADD {    thus thesis by H2. }
-ADD { end cases. } 
-ADD { end proof. }
-ADD { Qed. }
diff --git a/test-suite/ideal-features/Apply.v b/test-suite/ideal-features/Apply.v
index c8e9af21..14eb1e3f 100644
--- a/test-suite/ideal-features/Apply.v
+++ b/test-suite/ideal-features/Apply.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This needs step by step unfolding *)
diff --git a/test-suite/ideal-features/complexity/evars_subst.v b/test-suite/ideal-features/complexity/evars_subst.v
index b3dfb33c..b9c35988 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 b3dfb33c..b9c35988 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 2ec72780..d75620c2 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 b813a79a..22364254 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 a96d4a5c..7fab2a58 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 31e34937..a865632e 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/kernel/inds.mv b/test-suite/kernel/inds.mv
deleted file mode 100644
index bd1cc49f..00000000
--- a/test-suite/kernel/inds.mv
+++ /dev/null
@@ -1,3 +0,0 @@
-Inductive [] nat : Set := O : nat | S : nat->nat.
-Check Construct nat 0 1.
-Check Construct nat 0 2.
diff --git a/test-suite/micromega/square.v b/test-suite/micromega/square.v
index abf8be72..d163dfbc 100644
--- a/test-suite/micromega/square.v
+++ b/test-suite/micromega/square.v
@@ -40,7 +40,7 @@ Proof.
 Qed.
 
 
-Lemma QdenZpower : forall x : Q, ' Qden (x ^ 2)%Q = ('(Qden x) ^ 2) %Z.
+Lemma QdenZpower : forall x : Q, Zpos (Qden (x ^ 2)%Q) = (Zpos (Qden x) ^ 2) %Z.
 Proof.
   intros.
   destruct x.
@@ -54,9 +54,9 @@ Qed.
 Theorem sqrt2_not_rational : ~exists x:Q, x^2==2#1.
 Proof.
  unfold Qeq; intros (x,HQeq); simpl (Qden (2#1)) in HQeq; rewrite Z.mul_1_r in HQeq.
- assert (Heq : (Qnum x ^ 2 = 2 * ' Qden x ^ 2%Q)%Z) by
+ assert (Heq : (Qnum x ^ 2 = 2 * Zpos (Qden x) ^ 2%Q)%Z) by
    (rewrite QnumZpower in HQeq ; rewrite QdenZpower in HQeq ; auto).
  assert (Hnx : (Qnum x <> 0)%Z)
  by (intros Hx; simpl in HQeq; rewrite Hx in HQeq; discriminate HQeq).
- apply integer_statement; exists (Qnum x); exists (' Qden x); auto.
+ apply integer_statement; exists (Qnum x); exists (Zpos (Qden x)); auto.
 Qed.
diff --git a/test-suite/misc/4722.sh b/test-suite/misc/4722.sh
new file mode 100755
index 00000000..86bc50b5
--- /dev/null
+++ b/test-suite/misc/4722.sh
@@ -0,0 +1,15 @@
+#!/bin/sh
+set -e
+
+# create test files
+mkdir -p misc/4722
+ln -sf toto misc/4722/tata
+touch misc/4722.v
+
+# run test
+$coqtop "-R" "misc/4722" "Foo" -top Top -load-vernac-source misc/4722.v
+
+# clean up test files
+rm misc/4722/tata
+rmdir misc/4722
+rm misc/4722.v
diff --git a/test-suite/misc/berardi_test.v b/test-suite/misc/berardi_test.v
deleted file mode 100644
index a64db4da..00000000
--- a/test-suite/misc/berardi_test.v
+++ /dev/null
@@ -1,153 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** This file formalizes Berardi's paradox which says that in
-   the calculus of constructions, excluded middle (EM) and axiom of
-   choice (AC) imply proof irrelevance (PI).
-   Here, the axiom of choice is not necessary because of the use
-   of inductive types.
-<<
-@article{Barbanera-Berardi:JFP96,
-   author    = {F. Barbanera and S. Berardi},
-   title     = {Proof-irrelevance out of Excluded-middle and Choice
-                in the Calculus of Constructions},
-   journal   = {Journal of Functional Programming},
-   year      = {1996},
-   volume    = {6},
-   number    = {3},
-   pages     = {519-525}
-}
->> *)
-
-Set Implicit Arguments.
-
-Section Berardis_paradox.
-
-(** Excluded middle *)
-Hypothesis EM : forall P:Prop, P \/ ~ P.
-
-(** Conditional on any proposition. *)
-Definition IFProp (P B:Prop) (e1 e2:P) :=
-  match EM B with
-  | or_introl _ => e1
-  | or_intror _ => e2
-  end.
-
-(** Axiom of choice applied to disjunction.
-    Provable in Coq because of dependent elimination. *)
-Lemma AC_IF :
- forall (P B:Prop) (e1 e2:P) (Q:P -> Prop),
-   (B -> Q e1) -> (~ B -> Q e2) -> Q (IFProp B e1 e2).
-Proof.
-intros P B e1 e2 Q p1 p2.
-unfold IFProp.
-case (EM B); assumption.
-Qed.
-
-
-(** We assume a type with two elements. They play the role of booleans.
-    The main theorem under the current assumptions is that [T=F] *)
-Variable Bool : Prop.
-Variable T : Bool.
-Variable F : Bool.
-
-(** The powerset operator *)
-Definition pow (P:Prop) := P -> Bool.
-
-
-(** A piece of theory about retracts *)
-Section Retracts.
-
-Variables A B : Prop.
-
-Record retract : Prop :=
-  {i : A -> B; j : B -> A; inv : forall a:A, j (i a) = a}.
-
-Record retract_cond : Prop :=
-  {i2 : A -> B; j2 : B -> A; inv2 : retract -> forall a:A, j2 (i2 a) = a}.
-
-
-(** The dependent elimination above implies the axiom of choice: *)
-Lemma AC : forall r:retract_cond, retract -> forall a:A, j2 r (i2 r a) = a.
-Proof.
-intros r.
-case r; simpl.
-trivial.
-Qed.
-
-End Retracts.
-
-(** This lemma is basically a commutation of implication and existential
-    quantification:  (EX x | A -> P(x))  <=> (A -> EX x | P(x))
-    which is provable in classical logic ( => is already provable in
-    intuitionnistic logic). *)
-
-Lemma L1 : forall A B:Prop, retract_cond (pow A) (pow B).
-Proof.
-intros A B.
-destruct (EM (retract (pow A) (pow B))) as [(f0,g0,e) | hf].
-  exists f0 g0; trivial.
-  exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F); intros;
-    destruct hf; auto.
-Qed.
-
-
-(** The paradoxical set *)
-Definition U := forall P:Prop, pow P.
-
-(** Bijection between [U] and [(pow U)] *)
-Definition f (u:U) : pow U := u U.
-
-Definition g (h:pow U) : U :=
-  fun X => let lX := j2 (L1 X U) in let rU := i2 (L1 U U) in lX (rU h).
-
-(** We deduce that the powerset of [U] is a retract of [U].
-    This lemma is stated in Berardi's article, but is not used
-    afterwards. *)
-Lemma retract_pow_U_U : retract (pow U) U.
-Proof.
-exists g f.
-intro a.
-unfold f, g; simpl.
-apply AC.
-exists (fun x:pow U => x) (fun x:pow U => x).
-trivial.
-Qed.
-
-(** Encoding of Russel's paradox *)
-
-(** The boolean negation. *)
-Definition Not_b (b:Bool) := IFProp (b = T) F T.
-
-(** the set of elements not belonging to itself *)
-Definition R : U := g (fun u:U => Not_b (u U u)).
-
-
-Lemma not_has_fixpoint : R R = Not_b (R R).
-Proof.
-unfold R at 1.
-unfold g.
-rewrite AC with (r := L1 U U) (a := fun u:U => Not_b (u U u)).
-trivial.
-exists (fun x:pow U => x) (fun x:pow U => x); trivial.
-Qed.
-
-
-Theorem classical_proof_irrelevence : T = F.
-Proof.
-generalize not_has_fixpoint.
-unfold Not_b.
-apply AC_IF.
-intros is_true is_false.
-elim is_true; elim is_false; trivial.
-
-intros not_true is_true.
-elim not_true; trivial.
-Qed.
-
-End Berardis_paradox.
diff --git a/test-suite/misc/coqc_dash_o.sh b/test-suite/misc/coqc_dash_o.sh
new file mode 100755
index 00000000..0ae7873f
--- /dev/null
+++ b/test-suite/misc/coqc_dash_o.sh
@@ -0,0 +1,15 @@
+#!/usr/bin/env bash
+
+DOUT=misc/tmp_coqc_dash_o/
+OUT=${DOUT}coqc_dash_o.vo
+
+
+mkdir -p "${DOUT}"
+rm -f "${OUT}"
+$coqc misc/coqc_dash_o.v -o "${OUT}"
+if [ ! -f "${OUT}" ]; then
+  printf "coqc -o not working"
+  exit 1
+fi
+rm -fr "${DOUT}"
+exit 0
diff --git a/test-suite/misc/coqc_dash_o.v b/test-suite/misc/coqc_dash_o.v
new file mode 100644
index 00000000..7426dff1
--- /dev/null
+++ b/test-suite/misc/coqc_dash_o.v
@@ -0,0 +1 @@
+Definition x := nat.
diff --git a/test-suite/misc/deps-checksum.sh b/test-suite/misc/deps-checksum.sh
new file mode 100755
index 00000000..e07612b8
--- /dev/null
+++ b/test-suite/misc/deps-checksum.sh
@@ -0,0 +1,5 @@
+rm -f misc/deps/A/*.vo misc/deps/B/*.vo
+$coqc -R misc/deps/A A misc/deps/A/A.v
+$coqc -R misc/deps/B A misc/deps/B/A.v
+$coqc -R misc/deps/B A misc/deps/B/B.v
+$coqtop -R misc/deps/B A -R misc/deps/A A -load-vernac-source misc/deps/checksum.v
diff --git a/test-suite/misc/deps-order.sh b/test-suite/misc/deps-order.sh
new file mode 100755
index 00000000..299f4946
--- /dev/null
+++ b/test-suite/misc/deps-order.sh
@@ -0,0 +1,20 @@
+# Check that both coqdep and coqtop/coqc supports -R
+# Check that both coqdep and coqtop/coqc takes the later -R
+# See bugs 2242, 2337, 2339
+rm -f misc/deps/lib/*.vo misc/deps/client/*.vo
+tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`
+$coqdep -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 | head -n 1 > $tmpoutput
+diff -u --strip-trailing-cr misc/deps/deps.out $tmpoutput 2>&1
+R=$?
+times
+$coqc -R misc/deps/lib lib misc/deps/lib/foo.v 2>&1
+$coqc -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/foo.v 2>&1
+$coqtop -R misc/deps/lib lib -R misc/deps/client client -load-vernac-source misc/deps/client/bar.v 2>&1
+S=$?
+if [ $R = 0 -a $S = 0 ]; then
+    printf "coqdep and coqtop agree\n"
+    exit 0
+else
+    printf "coqdep and coqtop disagree\n"
+    exit 1
+fi
diff --git a/test-suite/misc/deps-utf8.sh b/test-suite/misc/deps-utf8.sh
new file mode 100755
index 00000000..13e264c0
--- /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 00000000..f43a2d65
--- /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 00000000..e7fd25c0
--- /dev/null
+++ b/test-suite/misc/deps/αβ/εζ.v
@@ -0,0 +1 @@
+Require Import γδ.
diff --git a/test-suite/misc/exitstatus.sh b/test-suite/misc/exitstatus.sh
new file mode 100755
index 00000000..cea1de86
--- /dev/null
+++ b/test-suite/misc/exitstatus.sh
@@ -0,0 +1,7 @@
+$coqtop -load-vernac-source misc/exitstatus/illtyped.v
+N=$?
+$coqc misc/exitstatus/illtyped.v
+P=$?
+printf "On ill-typed input, coqtop returned $N.\n"
+printf "On ill-typed input, coqc returned $P.\n"
+if [ $N = 1 -a $P = 1 ]; then exit 0; else exit 1; fi
diff --git a/test-suite/misc/exitstatus/illtyped.v b/test-suite/misc/exitstatus/illtyped.v
new file mode 100644
index 00000000..df6bbb38
--- /dev/null
+++ b/test-suite/misc/exitstatus/illtyped.v
@@ -0,0 +1 @@
+Check S S.
diff --git a/test-suite/misc/printers.sh b/test-suite/misc/printers.sh
new file mode 100755
index 00000000..28e7dc36
--- /dev/null
+++ b/test-suite/misc/printers.sh
@@ -0,0 +1,3 @@
+printf "Drop. #use\"include\";; #quit;;\n" | $coqtopbyte 2>&1 | egrep "Error|Unbound"
+if [ $? = 0 ]; then exit 1; else exit 0; fi
+
diff --git a/test-suite/misc/universes.sh b/test-suite/misc/universes.sh
new file mode 100755
index 00000000..d87a8603
--- /dev/null
+++ b/test-suite/misc/universes.sh
@@ -0,0 +1,8 @@
+# Sort universes for the whole standard library
+EXPECTED_UNIVERSES=4 # Prop is not counted
+$coqc -R misc/universes Universes misc/universes/all_stdlib 2>&1
+$coqc -R misc/universes Universes misc/universes/universes 2>&1
+mv universes.txt misc/universes
+N=`awk '{print $3}' misc/universes/universes.txt | sort -u | wc -l`
+printf "Found %s/%s universes\n" $N $EXPECTED_UNIVERSES
+if [ "$N" -eq $EXPECTED_UNIVERSES ]; then exit 0; else exit 1; fi
diff --git a/test-suite/modules/Demo.v b/test-suite/modules/Demo.v
index 1f27fe1b..820fda17 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 57878a5f..d2116d21 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 6198f29a..8ba8525c 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 00000000..bbf72a76
--- /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 1d1b1e0a..ea495539 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/WithDefUBinders.v b/test-suite/modules/WithDefUBinders.v
new file mode 100644
index 00000000..e6834551
--- /dev/null
+++ b/test-suite/modules/WithDefUBinders.v
@@ -0,0 +1,15 @@
+
+Set Universe Polymorphism.
+Module Type T.
+  Axiom foo@{u v|u < v} : Type@{v}.
+End T.
+
+Module M : T with Definition foo@{u v} := Type@{u} : Type@{v}.
+  Definition foo@{u v} := Type@{u} : Type@{v}.
+End M.
+
+Fail Module M' : T with Definition foo := Type.
+
+(* Without the binder expression we have to do trickery to get the
+   universes in the right order. *)
+Module M' : T with Definition foo := let t := Type in t.
diff --git a/test-suite/modules/cumpoly.v b/test-suite/modules/cumpoly.v
new file mode 100644
index 00000000..654b86cb
--- /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 9657c685..11ad205e 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 d4ac7b3a..8b5969dd 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 1238ee9d..c8129eec 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 220e2b36..0a6b1f06 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 f806a7c4..51f5f400 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 50bfd960..c2f0fe3c 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/polymorphism.v b/test-suite/modules/polymorphism.v
new file mode 100644
index 00000000..63eaa382
--- /dev/null
+++ b/test-suite/modules/polymorphism.v
@@ -0,0 +1,81 @@
+Set Universe Polymorphism.
+
+(** Tests for module subtyping of polymorphic terms *)
+
+Module Type S.
+
+Section Foo.
+
+Universes i j.
+Constraint i <= j.
+
+Parameter foo : Type@{i} -> Type@{j}.
+
+End Foo.
+
+End S.
+
+(** Same constraints *)
+
+Module OK_1.
+
+Definition foo@{i j} (A : Type@{i}) : Type@{j} := A.
+
+End OK_1.
+
+Module OK_1_Test : S := OK_1.
+
+(** More general constraints *)
+
+Module OK_2.
+
+Inductive X@{i} : Type@{i} :=.
+Definition foo@{i j} (A : Type@{i}) : Type@{j} := X@{j}.
+
+End OK_2.
+
+Module OK_2_Test : S := OK_2.
+
+(** Wrong instance length *)
+
+Module KO_1.
+
+Definition foo@{i} (A : Type@{i}) : Type@{i} := A.
+
+End KO_1.
+
+Fail Module KO_Test_1 : S := KO_1.
+
+(** Less general constraints *)
+
+Module KO_2.
+
+Section Foo.
+
+Universe i j.
+Constraint i < j.
+
+Definition foo (A : Type@{i}) : Type@{j} := A.
+
+End Foo.
+
+End KO_2.
+
+Fail Module KO_Test_2 : S := KO_2.
+
+(** Less general constraints *)
+
+Module KO_3.
+
+Section Foo.
+
+Universe i j.
+Constraint i = j.
+
+Definition foo (A : Type@{i}) : Type@{j} := A.
+
+End Foo.
+
+End KO_3.
+
+Fail Module KO_Test_3 : S := KO_3.
diff --git a/test-suite/modules/polymorphism2.v b/test-suite/modules/polymorphism2.v
new file mode 100644
index 00000000..7e3327ee
--- /dev/null
+++ b/test-suite/modules/polymorphism2.v
@@ -0,0 +1,87 @@
+Set Universe Polymorphism.
+
+(** Tests for module subtyping of polymorphic terms *)
+
+Module Type S.
+
+Section Foo.
+
+Universes i j.
+Constraint i <= j.
+
+Inductive foo : Type@{i} -> Type@{j} :=.
+
+End Foo.
+
+End S.
+
+(** Same constraints *)
+
+Module OK_1.
+
+Section Foo.
+
+Universes i j.
+Constraint i <= j.
+
+Inductive foo : Type@{i} -> Type@{j} :=.
+
+End Foo.
+
+End OK_1.
+
+Module OK_1_Test : S := OK_1.
+
+(** More general constraints *)
+
+Module OK_2.
+
+Inductive foo@{i j} : Type@{i} -> Type@{j} :=.
+
+End OK_2.
+
+Module OK_2_Test : S := OK_2.
+
+(** Wrong instance length *)
+
+Module KO_1.
+
+Inductive foo@{i} : Type@{i} -> Type@{i} :=.
+
+End KO_1.
+
+Fail Module KO_Test_1 : S := KO_1.
+
+(** Less general constraints *)
+
+Module KO_2.
+
+Section Foo.
+
+Universe i j.
+Constraint i < j.
+
+Inductive foo : Type@{i} -> Type@{j} :=.
+
+End Foo.
+
+End KO_2.
+
+Fail Module KO_Test_2 : S := KO_2.
+
+(** Less general constraints *)
+
+Module KO_3.
+
+Section Foo.
+
+Universe i j.
+Constraint i = j.
+
+Inductive foo : Type@{i} -> Type@{j} :=.
+
+End Foo.
+
+End KO_3.
+
+Fail Module KO_Test_3 : S := KO_3.
diff --git a/test-suite/modules/pseudo_circular_with.v b/test-suite/modules/pseudo_circular_with.v
index 9e46d17e..6bf067fd 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 da5d25fa..fc936a51 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 cc04c2c9..5553e1b3 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.v b/test-suite/output-modulo-time/ltacprof.v
index 6611db70..1e9e9197 100644
--- a/test-suite/output-modulo-time/ltacprof.v
+++ b/test-suite/output-modulo-time/ltacprof.v
@@ -1,4 +1,4 @@
-(* -*- coq-prog-args: ("-emacs" "-profile-ltac-cutoff" "0.0") -*- *)
+(* -*- coq-prog-args: ("-profile-ltac-cutoff" "0.0") -*- *)
 Ltac sleep' := do 100 (do 100 (do 100 idtac)).
 Ltac sleep := sleep'.
 
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 00000000..fef4fa24
--- /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 00000000..10a76309
--- /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 0cd5777c..d91a38bb 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 50131470..ae5d51ba 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: ("-emacs" "-profile-ltac") -*- *)
+(* -*- 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/Arguments.out b/test-suite/output/Arguments.out
index a2ee2d4c..97939696 100644
--- a/test-suite/output/Arguments.out
+++ b/test-suite/output/Arguments.out
@@ -97,8 +97,8 @@ Expands to: Constant Top.f
 forall w : r, w 3 true = tt
      : Prop
 The command has indeed failed with message:
-Error: Unknown interpretation for notation "$".
+Unknown interpretation for notation "$".
 w 3 true = tt
      : Prop
 The command has indeed failed with message:
-Error: Extra arguments: _, _.
+Extra arguments: _, _.
diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out
index b084ad49..e73312c6 100644
--- a/test-suite/output/Arguments_renaming.out
+++ b/test-suite/output/Arguments_renaming.out
@@ -1,5 +1,5 @@
 The command has indeed failed with message:
-Error: To rename arguments the "rename" flag must be specified.
+To rename arguments the "rename" flag must be specified.
 Argument A renamed to B.
 File "stdin", line 2, characters 0-25:
 Warning: This command is just asserting the names of arguments of identity.
@@ -11,7 +11,7 @@ notation scopes add ': clear scopes' [arguments-assert,vernacular]
 eq_refl
      : ?y = ?y
 where
-?y : [ |- nat] 
+?y : [ |- nat]
 Inductive eq (A : Type) (x : A) : A -> Prop :=  eq_refl : x = x
 
 For eq_refl: Arguments are renamed to B, y
@@ -103,15 +103,15 @@ Expands to: Constant Top.myplus
 @myplus
      : forall Z : Type, Z -> nat -> nat -> nat
 The command has indeed failed with message:
-Error: Argument lists should agree on the names they provide.
+Argument lists should agree on the names they provide.
 The command has indeed failed with message:
-Error: Sequences of implicit arguments must be of different lengths.
+Sequences of implicit arguments must be of different lengths.
 The command has indeed failed with message:
-Error: Some argument names are duplicated: F
+Some argument names are duplicated: F
 The command has indeed failed with message:
-Error: Argument z cannot be declared implicit.
+Argument z cannot be declared implicit.
 The command has indeed failed with message:
-Error: Extra arguments: y.
+Extra arguments: y.
 The command has indeed failed with message:
-Error: To rename arguments the "rename" flag must be specified.
+To rename arguments the "rename" flag must be specified.
 Argument A renamed to R.
diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out
index 8ce6f979..419dcadb 100644
--- a/test-suite/output/Cases.out
+++ b/test-suite/output/Cases.out
@@ -2,18 +2,18 @@ t_rect =
 fun (P : t -> Type) (f : let x := t in forall x0 : x, P x0 -> P (k x0)) =>
 fix F (t : t) : P t :=
   match t as t0 return (P t0) with
-  | @k _ x0 => f x0 (F x0)
+  | k _ x0 => f x0 (F x0)
   end
      : forall P : t -> Type,
        (let x := t in forall x0 : x, P x0 -> P (k x0)) -> forall t : t, P t
 
 Argument scopes are [function_scope function_scope _]
      = fun d : TT => match d with
-                     | @CTT _ _ b => b
+                     | {| f3 := b |} => b
                      end
      : TT -> 0 = 0
      = fun d : TT => match d with
-                     | @CTT _ _ b => b
+                     | {| f3 := b |} => b
                      end
      : TT -> 0 = 0
 proj = 
@@ -72,3 +72,100 @@ e1 : texp t1
 e2 : texp t2
 The term "0" has type "nat" while it is expected to have type
  "typeDenote t0".
+fun '{{n, m, _}} => n + m
+     : J -> nat
+fun '{{n, m, p}} => n + m + p
+     : J -> nat
+fun '(D n m p q) => n + m + p + q
+     : J -> nat
+The command has indeed failed with message:
+The constructor D (in type J) expects 3 arguments.
+lem1 = 
+fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl
+     : forall k : nat * nat, k = k
+lem2 = 
+fun dd : bool => if dd as aa return (aa = aa) then eq_refl else eq_refl
+     : forall k : bool, k = k
+
+Argument scope is [bool_scope]
+lem3 = 
+fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl
+     : forall k : nat * nat, k = k
+1 subgoal
+  
+  x : nat
+  n, n0 := match x + 0 with
+           | 0 | S _ => 0
+           end : nat
+  e,
+  e0 := match x + 0 as y return (y = y) with
+        | 0 => eq_refl
+        | S n => eq_refl
+        end : x + 0 = x + 0
+  n1, n2 := match x with
+            | 0 | S _ => 0
+            end : nat
+  e1, e2 := match x return (x = x) with
+            | 0 => eq_refl
+            | S n => eq_refl
+            end : x = x
+  ============================
+  x + 0 = 0
+1 subgoal
+  
+  p : nat
+  a,
+  a0 := match eq_refl as y in (_ = e) return (y = y /\ e = e) with
+        | eq_refl => conj eq_refl eq_refl
+        end : eq_refl = eq_refl /\ p = p
+  a1,
+  a2 := match eq_refl in (_ = e) return (p = p /\ e = e) with
+        | eq_refl => conj eq_refl 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 40748964..caf3b287 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.
 
@@ -106,3 +108,111 @@ Fail Fixpoint texpDenote t (e:texp t):typeDenote t:=
   | TBinop t1 t2 _ b e1 e2 => O
   end.
 
+(* Test notations with local definitions in constructors *)
+
+Inductive J := D : forall n m, let p := n+m in nat -> J.
+Notation "{{ n , m , q }}" := (D n m q).
+
+Check fun x : J => let '{{n, m, _}} := x in n + m.
+Check fun x : J => let '{{n, m, p}} := x in n + m + p.
+
+(* Cannot use the notation because of the dependency in p *)
+
+Check fun x => let '(D n m p q) := x in n+m+p+q.
+
+(* This used to succeed, being interpreted as "let '{{n, m, p}} := ..." *)
+
+Fail Check fun x : J => let '{{n, m, _}} p := x in n + m + p.
+
+(* Test use of idents bound to ltac names in a "match" *)
+
+Lemma lem1 : forall k, k=k :>nat * nat.
+let x := fresh "aa" in
+let y := fresh "bb" in
+let z := fresh "cc" in
+let k := fresh "dd" in
+refine (fun k : nat * nat => match k as x return x = x with (y,z) => eq_refl end).
+Qed.
+Print lem1.
+
+Lemma lem2 : forall k, k=k :> bool.
+let x := fresh "aa" in
+let y := fresh "bb" in
+let z := fresh "cc" in
+let k := fresh "dd" in
+refine (fun k => if k as x return x = x then eq_refl else eq_refl).
+Qed.
+Print lem2.
+
+Lemma lem3 : forall k, k=k :>nat * nat.
+let x := fresh "aa" in
+let y := fresh "bb" in
+let z := fresh "cc" in
+let k := fresh "dd" in
+refine (fun k : nat * nat => let (y,z) as x return x = x := k in eq_refl).
+Qed.
+Print lem3.
+
+Lemma lem4 x : x+0=0.
+match goal with |- ?y = _ => pose (match y with 0 => 0 | S n => 0 end) end.
+match goal with |- ?y = _ => pose (match y as y with 0 => 0 | S n => 0 end) end.
+match goal with |- ?y = _ => pose (match y as y return y=y with 0 => eq_refl | S n => eq_refl end) end.
+match goal with |- ?y = _ => pose (match y return y=y with 0 => eq_refl | S n => eq_refl end) end.
+match goal with |- ?y + _ = _ => pose (match y with 0 => 0 | S n => 0 end) end.
+match goal with |- ?y + _ = _ => pose (match y as y with 0 => 0 | S n => 0 end) end.
+match goal with |- ?y + _ = _ => pose (match y as y return y=y with 0 => eq_refl | S n => eq_refl end) end.
+match goal with |- ?y + _ = _ => pose (match y return y=y with 0 => eq_refl | S n => eq_refl end) end.
+Show.
+
+Lemma lem5 (p:nat) : eq_refl p = eq_refl p.
+let y := fresh "n" in (* Checking that y is hidden *)
+  let z := fresh "e" in (* Checking that z is hidden *)
+  match goal with
+  |- ?y = _ => pose (match y as y in _ = z return y=y /\ z=z with eq_refl => conj eq_refl eq_refl end)
+  end.
+let y := fresh "n" in
+  let z := fresh "e" in
+  match goal with
+  |- ?y = _ => pose (match y in _ = z return y=y /\ z=z with eq_refl => conj eq_refl eq_refl end)
+  end.
+let y := fresh "n" in
+  let z := fresh "e" in
+  match goal with
+  |- eq_refl ?y = _ => pose (match eq_refl y in _ = z return y=y /\ z=z with eq_refl => conj eq_refl eq_refl end)
+  end.
+let p := fresh "p" in
+  let z := fresh "e" in
+  match goal with
+  |- 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.out b/test-suite/output/CompactContexts.out
new file mode 100644
index 00000000..9d1d1987
--- /dev/null
+++ b/test-suite/output/CompactContexts.out
@@ -0,0 +1,7 @@
+1 subgoal
+  
+  hP1 : True
+  a : nat   b : list nat   h : forall x : nat, {y : nat | y > x}
+  h2 : True
+  ============================
+  False
diff --git a/test-suite/output/CompactContexts.v b/test-suite/output/CompactContexts.v
new file mode 100644
index 00000000..c409c0ee
--- /dev/null
+++ b/test-suite/output/CompactContexts.v
@@ -0,0 +1,5 @@
+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.
diff --git a/test-suite/output/ErrorInCanonicalStructures.out b/test-suite/output/ErrorInCanonicalStructures.out
new file mode 100644
index 00000000..73da4f44
--- /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 00000000..49597df6
--- /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 00000000..63a2871b
--- /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 00000000..10ee177a
--- /dev/null
+++ b/test-suite/output/ErrorInCanonicalStructures2.v
@@ -0,0 +1,3 @@
+Definition bar := 99.
+
+Canonical Structure bar.
diff --git a/test-suite/output/ErrorInModule.out b/test-suite/output/ErrorInModule.out
new file mode 100644
index 00000000..776dfeb5
--- /dev/null
+++ b/test-suite/output/ErrorInModule.out
@@ -0,0 +1,3 @@
+File "stdin", line 3, characters 20-31:
+Error: The reference nonexistent was not found in the current environment.
+
diff --git a/test-suite/output/ErrorInModule.v b/test-suite/output/ErrorInModule.v
new file mode 100644
index 00000000..b2e3c3e9
--- /dev/null
+++ b/test-suite/output/ErrorInModule.v
@@ -0,0 +1,4 @@
+(* -*- mode: coq; coq-prog-args: ("-quick") -*- *)
+Module M.
+  Definition foo := nonexistent.
+End M.
diff --git a/test-suite/output/ErrorInSection.out b/test-suite/output/ErrorInSection.out
new file mode 100644
index 00000000..776dfeb5
--- /dev/null
+++ b/test-suite/output/ErrorInSection.out
@@ -0,0 +1,3 @@
+File "stdin", line 3, characters 20-31:
+Error: The reference nonexistent was not found in the current environment.
+
diff --git a/test-suite/output/ErrorInSection.v b/test-suite/output/ErrorInSection.v
new file mode 100644
index 00000000..505c5ce3
--- /dev/null
+++ b/test-suite/output/ErrorInSection.v
@@ -0,0 +1,4 @@
+(* -*- mode: coq; coq-prog-args: ("-quick") -*- *)
+Section S.
+  Definition foo := nonexistent.
+End S.
diff --git a/test-suite/output/Errors.out b/test-suite/output/Errors.out
index 06a6b2d1..38d055b2 100644
--- a/test-suite/output/Errors.out
+++ b/test-suite/output/Errors.out
@@ -7,4 +7,4 @@ In nested Ltac calls to "f" and "apply x", last call failed.
 Unable to unify "nat" with "True".
 The command has indeed failed with message:
 Ltac call to "instantiate ( (ident) := (lglob) )" failed.
-Error: Instance is not well-typed in the environment of ?x.
+Instance is not well-typed in the environment of ?x.
diff --git a/test-suite/output/Existentials.out b/test-suite/output/Existentials.out
index 9680d2bb..18f5d89f 100644
--- a/test-suite/output/Existentials.out
+++ b/test-suite/output/Existentials.out
@@ -1,4 +1,4 @@
-Existential 1 = ?Goal : [p : nat  q := S p : nat  n : nat  m : nat |- ?y = m] 
+Existential 1 = ?Goal : [p : nat  q := S p : nat  n : nat  m : nat |- ?y = m]
 Existential 2 =
-?y : [p : nat  q := S p : nat  n : nat  m : nat |- nat] (p, q cannot be used)
-Existential 3 = ?Goal0 : [q : nat  n : nat  m : nat |- n = ?y] 
+?y : [p : nat  q := S p : nat  n : nat  m : nat |- nat] (p, q cannot be used) (shelved)
+Existential 3 = ?Goal0 : [q : nat  n : nat  m : nat |- n = ?y]
diff --git a/test-suite/output/Extraction_infix.out b/test-suite/output/Extraction_infix.out
new file mode 100644
index 00000000..29d50775
--- /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 00000000..fe5926a3
--- /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/Extraction_matchs_2413.v b/test-suite/output/Extraction_matchs_2413.v
index 6c514b16..1ecd9771 100644
--- a/test-suite/output/Extraction_matchs_2413.v
+++ b/test-suite/output/Extraction_matchs_2413.v
@@ -1,5 +1,7 @@
 (** Extraction : tests of optimizations of pattern matching *)
 
+Require Coq.extraction.Extraction.
+
 (** First, a few basic tests *)
 
 Definition test1 b :=
diff --git a/test-suite/output/Fixpoint.out b/test-suite/output/Fixpoint.out
index a13ae462..6879cbc3 100644
--- a/test-suite/output/Fixpoint.out
+++ b/test-suite/output/Fixpoint.out
@@ -10,3 +10,5 @@ let fix f (m : nat) : nat := match m with
                              end in f 0
      : nat
 Ltac f id1 id2 := fix id1 2 with (id2 (n:_) (H:odd n) {struct H} : n >= 1)
+     = cofix inf : Inf := {| projS := inf |}
+     : Inf
diff --git a/test-suite/output/Fixpoint.v b/test-suite/output/Fixpoint.v
index 8afa50ba..61ae4edb 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
@@ -44,4 +44,7 @@ fix even_pos_odd_pos 2 with (odd_pos_even_pos n (H:odd n) {struct H} : n >= 1).
   omega.
 Qed.
 
-
+CoInductive Inf := S { projS : Inf }.
+Definition expand_Inf (x : Inf) := S (projS x).
+CoFixpoint inf := S inf.
+Eval compute in inf.
diff --git a/test-suite/output/FunExt.out b/test-suite/output/FunExt.out
new file mode 100644
index 00000000..8d2a125c
--- /dev/null
+++ b/test-suite/output/FunExt.out
@@ -0,0 +1,19 @@
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Already an intensional equality.
+The command has indeed failed with message:
+In nested Ltac calls to "extensionality in (var)" and
+"clearbody (ne_var_list)", last call failed.
+Hypothesis e depends on the body of H'
diff --git a/test-suite/output/FunExt.v b/test-suite/output/FunExt.v
new file mode 100644
index 00000000..7658ce71
--- /dev/null
+++ b/test-suite/output/FunExt.v
@@ -0,0 +1,168 @@
+Require Import FunctionalExtensionality.
+
+(* Basic example *)
+Goal (forall x y z, x+y+z = z+y+x) -> (fun x y z => z+y+x) = (fun x y z => x+y+z).
+intro H.
+extensionality in H.
+symmetry in H.
+assumption.
+Qed.
+
+(* Test rejection of non-equality *)
+Goal forall H:(forall A:Prop, A), H=H -> forall H'':True, H''=H''.
+intros H H' H''.
+Fail extensionality in H.
+clear H'.
+Fail extensionality in H.
+Fail extensionality in H''.
+Abort.
+
+(* Test success on dependent equality *)
+Goal forall (p : forall x, S x = x + 1), p = p -> S = fun x => x + 1.
+intros p H.
+extensionality in p.
+assumption.
+Qed.
+
+(* Test dependent functional extensionality *)
+Goal forall (P:nat->Type) (Q:forall a, P a -> Type) (f g:forall a (b:P a), Q a b),
+   (forall x y, f x y = g x y) -> f = g.
+intros * H.
+extensionality in H.
+assumption.
+Qed.
+
+(* Other tests, courtesy of Jason Gross *)
+
+Goal forall A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c), (forall a b c, f a b c = g a b c) -> f = g.
+Proof.
+  intros A B C D f g H.
+  extensionality in H.
+  match type of H with f = g => idtac end.
+  exact H.
+Qed.
+
+Section test_section.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a b c, f a b c = g a b c).
+  Goal f = g.
+  Proof.
+    extensionality in H.
+    match type of H with f = g => idtac end.
+    exact H.
+  Qed.
+End test_section.
+
+Section test2.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall b a c, f a b c = g a b c).
+  Goal (fun b a c => f a b c) = (fun b a c => g a b c).
+  Proof.
+    extensionality in H.
+    match type of H with (fun b a => f a b) = (fun b' a' => g a' b') => idtac end.
+    exact H.
+  Qed.
+End test2.
+
+Section test3.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a c, (fun b => f a b c) = (fun b => g a b c)).
+  Goal (fun a c b => f a b c) = (fun a c b => g a b c).
+  Proof.
+    extensionality in H.
+    match type of H with (fun a c b => f a b c) = (fun a' c' b' => g a' b' c') => idtac end.
+    exact H.
+  Qed.
+End test3.
+
+Section test4.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c -> Type)
+          (H : forall b, (forall a c d, f a b c d) = (forall a c d, g a b c d)).
+  Goal (fun b => forall a c d, f a b c d) = (fun b => forall a c d, g a b c d).
+  Proof.
+    extensionality in H.
+    exact H.
+  Qed.
+End test4.
+
+Section test5.
+  Goal nat -> True.
+  Proof.
+    intro n.
+    Fail extensionality in n.
+    constructor.
+  Qed.
+End test5.
+
+Section test6.
+  Goal let f := fun A (x : A) => x in let pf := fun A x => @eq_refl _ (f A x) in f = f.
+  Proof.
+    intros f pf.
+    extensionality in pf.
+    match type of pf with f = f => idtac end.
+    exact pf.
+  Qed.
+End test6.
+
+Section test7.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a b c, True -> f a b c = g a b c).
+  Goal True.
+  Proof.
+    extensionality in H.
+    match type of H with (fun a b c (_ : True) => f a b c) = (fun a' b' c' (_ : True) => g a' b' c') => idtac end.
+    constructor.
+  Qed.
+End test7.
+
+Section test8.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : True -> forall a b c, f a b c = g a b c).
+  Goal True.
+  Proof.
+    extensionality in H.
+    match type of H with (fun (_ : True) => f) = (fun (_ : True) => g) => idtac end.
+    constructor.
+  Qed.
+End test8.
+
+Section test9.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall b a c, f a b c = g a b c).
+  Goal (fun b a c => f a b c) = (fun b a c => g a b c).
+  Proof.
+    pose H as H'.
+    extensionality in H.
+    extensionality in H'.
+    let T := type of H in let T' := type of H' in constr_eq T T'.
+    match type of H with (fun b a => f a b) = (fun b' a' => g a' b') => idtac end.
+    exact H'.
+  Qed.
+End test9.
+
+Section test10.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : f = g).
+  Goal True.
+  Proof.
+    Fail extensionality in H.
+    constructor.
+  Qed.
+End test10.
+
+Section test11.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a b c, f a b c = f a b c).
+  Goal True.
+  Proof.
+    pose H as H'.
+    pose (eq_refl : H = H') as e.
+    extensionality in H.
+    Fail extensionality in H'.
+    clear e.
+    extensionality in H'.
+    let T := type of H in let T' := type of H' in constr_eq T T'.
+    lazymatch type of H with f = f => idtac end.
+    constructor.
+  Qed.
+End test11.
diff --git a/test-suite/output/Implicit.v b/test-suite/output/Implicit.v
index 7c9b89f9..306532c0 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 e912003f..af202ea0 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 8db8956e..8ff91268 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/Int31Syntax.out b/test-suite/output/Int31Syntax.out
new file mode 100644
index 00000000..4e8796c1
--- /dev/null
+++ b/test-suite/output/Int31Syntax.out
@@ -0,0 +1,14 @@
+I31
+     : digits31 int31
+2
+     : int31
+660865024
+     : int31
+2 + 2
+     : int31
+2 + 2
+     : int31
+     = 4
+     : int31
+     = 710436486
+     : int31
diff --git a/test-suite/output/Int31Syntax.v b/test-suite/output/Int31Syntax.v
new file mode 100644
index 00000000..83be3b97
--- /dev/null
+++ b/test-suite/output/Int31Syntax.v
@@ -0,0 +1,13 @@
+Require Import Int31 Cyclic31.
+
+Open Scope int31_scope.
+Check I31. (* Would be nice to have I31 : digits->digits->...->int31
+              For the moment, I31 : digits31 int31, which is better
+	      than (fix nfun .....) size int31 *)
+Check 2.
+Check 1000000000000000000. (* = 660865024, after modulo 2^31 *)
+Check (add31 2 2).
+Check (2+2).
+Eval vm_compute in 2+2.
+Eval vm_compute in 65675757 * 565675998.
+Close Scope int31_scope.
diff --git a/test-suite/output/InvalidDisjunctiveIntro.out b/test-suite/output/InvalidDisjunctiveIntro.out
new file mode 100644
index 00000000..25a306b4
--- /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 00000000..4febdf03
--- /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/Load.out b/test-suite/output/Load.out
new file mode 100644
index 00000000..0904d554
--- /dev/null
+++ b/test-suite/output/Load.out
@@ -0,0 +1,6 @@
+f = 2
+     : nat
+u = I
+     : True
+The command has indeed failed with message:
+Files processed by Load cannot leave open proofs.
diff --git a/test-suite/output/Load.v b/test-suite/output/Load.v
new file mode 100644
index 00000000..96750741
--- /dev/null
+++ b/test-suite/output/Load.v
@@ -0,0 +1,7 @@
+Load "output/load/Load_noproof.v".
+Print f.
+
+Load "output/load/Load_proof.v".
+Print u.
+
+Fail Load "output/load/Load_openproof.v".
diff --git a/test-suite/output/MExtraction.v b/test-suite/output/MExtraction.v
new file mode 100644
index 00000000..352e422c
--- /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 26eaca82..b60b1ee8 100644
--- a/test-suite/output/Notations.out
+++ b/test-suite/output/Notations.out
@@ -41,29 +41,29 @@ fun x : nat => ifn x is succ n then n else 0
 -4
      : Z
 The command has indeed failed with message:
-Error: 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:
-Error: in the right-hand side, y and z should appear in
+in the right-hand side, y and z should appear in
 term position as part of a recursive pattern.
 The command has indeed failed with message:
 The reference w was not found in the current environment.
 The command has indeed failed with message:
-Error: in the right-hand side, y and z should appear in
+in the right-hand side, y and z should appear in
 term position as part of a recursive pattern.
 The command has indeed failed with message:
-Error: z is expected to occur in binding position in the right-hand side.
+z is expected to occur in binding position in the right-hand side.
 The command has indeed failed with message:
-Error: as y is a non-closed binder, no such "," is allowed to occur.
+as y is a non-closed binder, no such "," is allowed to occur.
 The command has indeed failed with message:
-Error: Cannot find where the recursive pattern starts.
+Cannot find where the recursive pattern starts.
 The command has indeed failed with message:
-Error: Cannot find where the recursive pattern starts.
+Cannot find where the recursive pattern starts.
 The command has indeed failed with message:
-Error: Cannot find where the recursive pattern starts.
+Cannot find where the recursive pattern starts.
 The command has indeed failed with message:
-Error: Cannot find where the recursive pattern starts.
+Cannot find where the recursive pattern starts.
 The command has indeed failed with message:
-Error: Both ends of the recursive pattern are the same.
+Both ends of the recursive pattern are the same.
 SUM (nat * nat) nat
      : Set
 FST (0; 1)
@@ -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 2ccca829..fe6c05c3 100644
--- a/test-suite/output/Notations.v
+++ b/test-suite/output/Notations.v
@@ -1,3 +1,14 @@
+(* Bug 5568, don't warn for notations in repeated module import *)
+
+Module foo.
+Notation compose := (fun g f => g f).
+Notation "g & f" := (compose g f) (at level 10).
+End foo.
+
+Import foo.
+Import foo.
+Import foo.
+
 (**********************************************************************)
 (* Notations for if and let (submitted by Roland Zumkeller)           *)
 
@@ -280,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 ad60aecc..41d15937 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
@@ -32,11 +31,22 @@ let d := 2 in ∃ z : nat, let e := 3 in let f := 4 in x + y = z + d
      : Type -> Prop
 λ A : Type, ∀ n p : A, n = p
      : Type -> Prop
-let' f (x y : nat) (a:=0) (z : nat) (_ : bool) := x + y + z + 1 in f 0 1 2
+let' f (x y : nat) (a := 0) (z : nat) (_ : bool) := x + y + z + 1 in f 0 1 2
      : bool -> nat
 λ (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
+                 | list1 => 0
+                 | _ => 2
+                 end
+     : list(nat) -> nat
+λ n : list(nat),
+match n with
+| list1 => 0
+| nil | 0 :: _ | 1 :: _ :: _ | plus2 _ :: _ => 2
+end
+     : list(nat) -> nat
 λ n : list(nat),
 match n with
 | nil => 2
@@ -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 ceb29d1b..bcb24687 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).
 
@@ -78,6 +79,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 +153,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 360f3796..5ab61616 100644
--- a/test-suite/output/Notations3.out
+++ b/test-suite/output/Notations3.out
@@ -1,3 +1,5 @@
+{x : nat | x = 0} + {True /\ False} + {forall x : nat, x = 0}
+     : Set
 [<0, 2 >]
      : nat * nat * (nat * nat)
 [<0, 2 >]
@@ -31,24 +33,24 @@ fun f : forall x : nat * (bool * unit), ?T => CURRY (x : nat) (y : bool), f
      : (forall x : nat * (bool * unit), ?T) ->
        forall (x : nat) (y : bool), ?T@{x:=(x, (y, tt))}
 where
-?T : [x : nat * (bool * unit) |- Type] 
+?T : [x : nat * (bool * unit) |- Type]
 fun f : forall x : bool * (nat * unit), ?T =>
 CURRYINV (x : nat) (y : bool), f
      : (forall x : bool * (nat * unit), ?T) ->
        forall (x : nat) (y : bool), ?T@{x:=(y, (x, tt))}
 where
-?T : [x : bool * (nat * unit) |- Type] 
+?T : [x : bool * (nat * unit) |- Type]
 fun f : forall x : unit * nat * bool, ?T => CURRYLEFT (x : nat) (y : bool), f
      : (forall x : unit * nat * bool, ?T) ->
        forall (x : nat) (y : bool), ?T@{x:=(tt, x, y)}
 where
-?T : [x : unit * nat * bool |- Type] 
+?T : [x : unit * nat * bool |- Type]
 fun f : forall x : unit * bool * nat, ?T =>
 CURRYINVLEFT (x : nat) (y : bool), f
      : (forall x : unit * bool * nat, ?T) ->
        forall (x : nat) (y : bool), ?T@{x:=(tt, y, x)}
 where
-?T : [x : unit * bool * nat |- Type] 
+?T : [x : unit * bool * nat |- Type]
 forall n : nat, {#n | 1 > n}
      : Prop
 forall x : nat, {|x | x > 0|}
@@ -98,3 +100,149 @@ fun n : nat => foo4 n (fun _ y : nat => ETA z : nat, (fun _ : nat => y = 0))
      : nat -> Prop
 tele (t : Type) '(y, z) (x : t0) := tt
      : forall t : Type, nat * nat -> t -> fpack
+[fun x : nat => x + 0;; fun x : nat => x + 1;; fun x : nat => x + 2]
+     : (nat -> nat) *
+       ((nat -> nat) *
+        ((nat -> nat) *
+         ((nat -> nat) * ((nat -> nat) * ((nat -> nat) * (nat -> nat))))))
+foo5 x nat x
+     : nat -> nat
+fun x : ?A => x === x
+     : forall x : ?A, x = x
+where
+?A : [x : ?A |- Type] (x cannot be used)
+{{0, 1}}
+     : nat * nat
+{{0, 1, 2}}
+     : nat * (nat * nat)
+{{0, 1, 2, 3}}
+     : nat * (nat * (nat * nat))
+letpair x [1] = {0};
+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
+! '{{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
+foo = 
+fun l : list nat => match l with
+                    | _ :: (_ :: _) as l1 => l1
+                    | _ => l
+                    end
+     : list nat -> list nat
+
+Argument scope is [list_scope]
+Notation
+"'exists' x .. y , p" := ex (fun x => .. (ex (fun y => p)) ..) : type_scope
+(default interpretation)
+"'exists' ! x .. y , p" := ex
+                             (unique
+                                (fun x => .. (ex (unique (fun y => p))) ..))
+: type_scope (default interpretation)
+Notation
+"( x , y , .. , z )" := pair .. (pair x y) .. z : core_scope
+(default interpretation)
+1 subgoal
+  
+  ============================
+  ##@%
+   ^^^
diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v
index 4b8bfe31..876aaa39 100644
--- a/test-suite/output/Notations3.v
+++ b/test-suite/output/Notations3.v
@@ -1,4 +1,9 @@
 (**********************************************************************)
+(* Check precedence, spacing, etc. in printing with curly brackets    *)
+
+Check {x|x=0}+{True/\False}+{forall x, x=0}.
+
+(**********************************************************************)
 (* Check printing of notations with several instances of a recursive pattern *)
 (* Was wrong but I could not trigger a problem due to the collision between *)
 (* different instances of ".." *)
@@ -139,3 +144,258 @@ Notation "'tele' x .. z := b" :=
   (at level 85, x binder, z binder).
 
 Check tele (t:Type) '((y,z):nat*nat) (x:t) := tt.
+
+(* Checking that "fun" in a notation does not mixed up with the
+   detection of a recursive binder *)
+
+Notation "[ x ;; .. ;; y ]" := ((x,((fun u => S u), .. (y,(fun u => S u,fun v:nat => v)) ..))).
+Check [ fun x => x+0 ;; fun x => x+1 ;; fun x => x+2 ].
+
+(* Cyprien's part of bug #4765 *)
+
+Section Bug4765.
+
+Notation foo5 x T y := (fun x : T => y).
+Check foo5 x nat x.
+
+End Bug4765.
+
+(**********************************************************************)
+(* Test printing of #5526                                             *)
+
+Notation "x === x" := (eq_refl x) (only printing, at level 10).
+Check (fun x => eq_refl x).
+
+(* Test recursive notations with the recursive pattern repeated on the right *)
+
+Notation "{{ x , .. , y , z }}" := (pair x .. (pair y z) ..).
+Check {{0,1}}.
+Check {{0,1,2}}.
+Check {{0,1,2,3}}.
+
+(* Test printing of #5608                                             *)
+
+Reserved Notation "'letpair' x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )"
+  (at level 200, format "'letpair'  x  [1]  =  { A } ; '//' 'return'  ( b0 ,  b1 ,  .. ,  b2 )").
+Notation "'letpair' x [1] = { a } ; 'return' ( b0 , b1 , .. , b2 )" :=
+  (let x:=a in ( .. (b0,b1) .., b2)).
+Check letpair x [1] = {0}; return (1,2,3,4).
+
+(* Test spacing in #5569 *)
+
+Notation "{ { xL | xR // xcut } }" := (xL+xR+xcut)
+  (at level 0, xR at level 39, format "{ {  xL  |  xR  //  xcut  } }").
+Check 1+1+1.
+
+(* 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 *)
+
+Notation "* x" := (id x) (only printing, at level 15, format "* x").
+Notation "x . y" := (x + y) (only printing, at level 20, x at level 14, left associativity, format "x . y").
+Check (((id 1) + 2) + 3).
+Check (id (1 + 2)).
+
+(* 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 *)
+
+Module IfPat.
+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.
+End IfPat.
+
+(* 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 *)
+
+Module IfPat2.
+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.
+End IfPat2.
+
+(* 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).
+
+Module Issue7110.
+Open Scope list_scope.
+Notation "[ :: x1 , x2 , .. , xn & s ]" := (x1 :: x2 :: .. (xn :: s) ..)
+  (at level 0).
+Definition foo (l : list nat) :=
+  match l with
+  | a :: (b :: l) as l1 => l1
+  | _ => l
+end.
+Print foo.
+End Issue7110.
+
+Module LocateNotations.
+Locate "exists".
+Locate "( _ , _ , .. , _ )".
+End LocateNotations.
+
+Module Issue7731.
+
+Axiom (P : nat -> Prop).
+Parameter (X : nat).
+Notation "## @ E ^^^" := (P E) (at level 20, E at level 1, format "'[ ' ## '/' @ E '/' ^^^ ']'").
+Notation "%" := X.
+
+Set Printing Width 7.
+Goal ## @ % ^^^.
+Show.
+Abort.
+
+End Issue7731.
diff --git a/test-suite/output/NumbersSyntax.out b/test-suite/output/NumbersSyntax.out
deleted file mode 100644
index b2677b6a..00000000
--- a/test-suite/output/NumbersSyntax.out
+++ /dev/null
@@ -1,67 +0,0 @@
-I31
-     : digits31 int31
-2
-     : int31
-660865024
-     : int31
-2 + 2
-     : int31
-2 + 2
-     : int31
-     = 4
-     : int31
-     = 710436486
-     : int31
-2
-     : BigN.t'
-1000000000000000000
-     : BigN.t'
-2 + 2
-     : bigN
-2 + 2
-     : bigN
-     = 4
-     : bigN
-     = 37151199385380486
-     : bigN
-     = 1267650600228229401496703205376
-     : bigN
-2
-     : BigZ.t_
--1000000000000000000
-     : BigZ.t_
-2 + 2
-     : BigZ.t_
-2 + 2
-     : BigZ.t_
-     = 4
-     : BigZ.t_
-     = 37151199385380486
-     : BigZ.t_
-     = 1267650600228229401496703205376
-     : BigZ.t_
-2
-     : BigQ.t_
--1000000000000000000
-     : BigQ.t_
-2 + 2
-     : bigQ
-2 + 2
-     : bigQ
-     = 4
-     : bigQ
-     = 37151199385380486
-     : bigQ
-6562 # 456
-     : BigQ.t_
-     = 3281 # 228
-     : bigQ
-     = -1 # 10000
-     : bigQ
-     = 100
-     : bigQ
-     = 515377520732011331036461129765621272702107522001
-       # 1267650600228229401496703205376
-     : bigQ
-     = 1
-     : bigQ
diff --git a/test-suite/output/NumbersSyntax.v b/test-suite/output/NumbersSyntax.v
deleted file mode 100644
index 4fbf56ab..00000000
--- a/test-suite/output/NumbersSyntax.v
+++ /dev/null
@@ -1,50 +0,0 @@
-
-Require Import BigQ.
-
-Open Scope int31_scope.
-Check I31. (* Would be nice to have I31 : digits->digits->...->int31
-              For the moment, I31 : digits31 int31, which is better
-	      than (fix nfun .....) size int31 *)
-Check 2.
-Check 1000000000000000000. (* = 660865024, after modulo 2^31 *)
-Check (add31 2 2).
-Check (2+2).
-Eval vm_compute in 2+2.
-Eval vm_compute in 65675757 * 565675998.
-Close Scope int31_scope.
-
-Open Scope bigN_scope.
-Check 2.
-Check 1000000000000000000.
-Check (BigN.add 2 2).
-Check (2+2).
-Eval vm_compute in 2+2.
-Eval vm_compute in 65675757 * 565675998.
-Eval vm_compute in 2^100.
-Close Scope bigN_scope.
-
-Open Scope bigZ_scope.
-Check 2.
-Check -1000000000000000000.
-Check (BigZ.add 2 2).
-Check (2+2).
-Eval vm_compute in 2+2.
-Eval vm_compute in 65675757 * 565675998.
-Eval vm_compute in (-2)^100.
-Close Scope bigZ_scope.
-
-Open Scope bigQ_scope.
-Check 2.
-Check -1000000000000000000.
-Check (BigQ.add 2 2).
-Check (2+2).
-Eval vm_compute in 2+2.
-Eval vm_compute in 65675757 * 565675998.
-(* fractions *)
-Check (6562 # 456). (* Nota: # is BigQ.Qq i.e. base fractions *)
-Eval vm_compute in (BigQ.red (6562 # 456)).
-Eval vm_compute in (1/-10000).
-Eval vm_compute in (BigQ.red (1/(1/100))). (* back to integers... *)
-Eval vm_compute in ((2/3)^(-100)).
-Eval vm_compute in BigQ.red ((2/3)^(-1000) * (2/3)^(1000)).
-Close Scope bigQ_scope.
diff --git a/test-suite/output/PatternsInBinders.out b/test-suite/output/PatternsInBinders.out
index c012a86b..8a6d94c7 100644
--- a/test-suite/output/PatternsInBinders.out
+++ b/test-suite/output/PatternsInBinders.out
@@ -31,9 +31,17 @@ 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
 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 6fa357a9..d671053c 100644
--- a/test-suite/output/PatternsInBinders.v
+++ b/test-suite/output/PatternsInBinders.v
@@ -64,3 +64,11 @@ Check fun '((x,y) : A*B) '(z,t) => swap (x,y) = (z,t).
 Check forall '(x,y) '((z,t) : B*A), swap (x,y) = (z,t).
 
 End Suboptimal.
+
+(** 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/PrintAssumptions.out b/test-suite/output/PrintAssumptions.out
index 66458543..3f4d5ef5 100644
--- a/test-suite/output/PrintAssumptions.out
+++ b/test-suite/output/PrintAssumptions.out
@@ -18,3 +18,7 @@ Closed under the global context
 Closed under the global context
 Axioms:
 M.foo : False
+Closed under the global context
+Closed under the global context
+Closed under the global context
+Closed under the global context
diff --git a/test-suite/output/PrintAssumptions.v b/test-suite/output/PrintAssumptions.v
index c2003816..3d4dfe60 100644
--- a/test-suite/output/PrintAssumptions.v
+++ b/test-suite/output/PrintAssumptions.v
@@ -110,3 +110,40 @@ End N.
 Print Assumptions N.foo.
 
 End INCLUDE.
+
+(* Print Assumptions did not enter implementation of submodules (#7192) *)
+
+Module SUBMODULES.
+
+Definition a := True.
+Module Type B. Axiom f : Prop. End B.
+Module Type C. Declare Module D : B. End C.
+Module E: C.
+  Module D <: B. Definition f := a. End D.
+End E.
+Print Assumptions E.D.f.
+
+(* Idem in the scope of a functor *)
+
+Module Type T. End T.
+Module F (X : T).
+  Definition a := True.
+  Module Type B. Axiom f : Prop. End B.
+  Module Type C. Declare Module D : B. End C.
+  Module E: C.
+    Module D <: B. Definition f := a. End D.
+  End E.
+  Print Assumptions E.D.f.
+End F.
+
+End SUBMODULES.
+
+(* Testing a variant of #7192 across files *)
+(* This was missing in the original fix to #7192 *)
+Require Import module_bug7192.
+Print Assumptions M7192.D.f.
+
+(* Testing reporting assumptions from modules in files *)
+(* A regression introduced in the original fix to #7192 was missing implementations *)
+Require Import module_bug8416.
+Print Assumptions M8416.f.
diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v
index 08918981..a498db3e 100644
--- a/test-suite/output/PrintInfos.v
+++ b/test-suite/output/PrintInfos.v
@@ -26,6 +26,7 @@ About bar.
 Print bar.
 
 About Peano. (* Module *)
+Set Warnings "-deprecated".
 About existS2. (* Notation *)
 
 Arguments eq_refl {A} {x}, {A} x.
diff --git a/test-suite/output/Projections.out b/test-suite/output/Projections.out
new file mode 100644
index 00000000..e9c28faf
--- /dev/null
+++ b/test-suite/output/Projections.out
@@ -0,0 +1,2 @@
+fun S : store => S.(store_funcs)
+     : store -> host_func
diff --git a/test-suite/output/Projections.v b/test-suite/output/Projections.v
new file mode 100644
index 00000000..098a518d
--- /dev/null
+++ b/test-suite/output/Projections.v
@@ -0,0 +1,11 @@
+
+Set Printing Projections.
+
+Class HostFunction := host_func : Type.
+
+Section store.
+  Context `{HostFunction}.
+  Record store := { store_funcs : host_func }.
+End store.
+
+Check (fun (S:@store nat) => S.(store_funcs)).
diff --git a/test-suite/output/RecognizePluginWarning.out b/test-suite/output/RecognizePluginWarning.out
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/test-suite/output/RecognizePluginWarning.out
diff --git a/test-suite/output/RecognizePluginWarning.v b/test-suite/output/RecognizePluginWarning.v
new file mode 100644
index 00000000..cd667bbd
--- /dev/null
+++ b/test-suite/output/RecognizePluginWarning.v
@@ -0,0 +1,5 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-w" "extraction-logical-axiom") -*- *)
+
+(* Test that mentioning a warning defined in plugins works. The failure
+mode here is that these result in a warning about unknown warnings, since the
+plugins are not known at command line parsing time. *)
diff --git a/test-suite/output/Record.out b/test-suite/output/Record.out
index 36d643a4..d45343fe 100644
--- a/test-suite/output/Record.out
+++ b/test-suite/output/Record.out
@@ -14,3 +14,19 @@ build 5
      : test_r
 build_c 5
      : test_c
+fun '(C _ p) => p
+     : N -> True
+fun '{| T := T |} => T
+     : N -> Type
+fun '(C T p) => (T, p)
+     : N -> Type * True
+fun '{| q := p |} => p
+     : M -> True
+fun '{| U := T |} => T
+     : M -> Type
+fun '{| U := T; q := p |} => (T, p)
+     : M -> Type * True
+fun '{| U := T; a := a; q := p |} => (T, p, a)
+     : M -> Type * True * nat
+fun '{| U := T; a := a; q := p |} => (T, p, a)
+     : M -> Type * True * nat
diff --git a/test-suite/output/Record.v b/test-suite/output/Record.v
index 6aa3df98..d9a649fa 100644
--- a/test-suite/output/Record.v
+++ b/test-suite/output/Record.v
@@ -19,3 +19,15 @@ Check build 5.
 Check {| field := 5 |}.
 Check build_r 5.
 Check build_c 5.
+
+Record N := C { T : Type; _ : True }.
+Check fun x:N => let 'C _ p := x in p.
+Check fun x:N => let 'C T _ := x in T.
+Check fun x:N => let 'C T p := x in (T,p).
+
+Record M := D { U : Type; a := 0; q : True }.
+Check fun x:M => let 'D T _ p := x in p.
+Check fun x:M => let 'D T _ p := x in T.
+Check fun x:M => let 'D T p := x in (T,p).
+Check fun x:M => let 'D T a p := x in (T,p,a).
+Check fun x:M => let '{|U:=T;a:=a;q:=p|} := x in (T,p,a).
diff --git a/test-suite/output/Search.out b/test-suite/output/Search.out
index c17b285b..7446c17d 100644
--- a/test-suite/output/Search.out
+++ b/test-suite/output/Search.out
@@ -1,108 +1,116 @@
 le_n: forall n : nat, n <= n
+le_0_n: forall n : nat, 0 <= n
 le_S: forall n m : nat, n <= m -> n <= S m
+le_n_S: forall n m : nat, n <= m -> S n <= S m
+le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m
+le_S_n: forall n m : nat, S n <= S m -> n <= m
+min_l: forall n m : nat, n <= m -> Nat.min n m = n
+max_r: forall n m : nat, n <= m -> Nat.max n m = m
+min_r: forall n m : nat, m <= n -> Nat.min n m = m
+max_l: forall n m : nat, m <= n -> Nat.max n m = n
 le_ind:
   forall (n : nat) (P : nat -> Prop),
   P n ->
   (forall m : nat, n <= m -> P m -> P (S m)) ->
   forall n0 : nat, n <= n0 -> P n0
-le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m
-le_S_n: forall n m : nat, S n <= S m -> n <= m
-le_0_n: forall n : nat, 0 <= n
-le_n_S: forall n m : nat, n <= m -> S n <= S m
-max_l: forall n m : nat, m <= n -> Nat.max n m = n
-max_r: forall n m : nat, n <= m -> Nat.max n m = m
-min_l: forall n m : nat, n <= m -> Nat.min n m = n
-min_r: forall n m : nat, m <= n -> Nat.min n m = m
-true: bool
 false: bool
-bool_rect: forall P : bool -> Type, P true -> P false -> forall b : bool, P b
-bool_ind: forall P : bool -> Prop, P true -> P false -> forall b : bool, P b
-bool_rec: forall P : bool -> Set, P true -> P false -> forall b : bool, P b
-andb: bool -> bool -> bool
-orb: bool -> bool -> bool
-implb: bool -> bool -> bool
-xorb: bool -> bool -> bool
+true: bool
+is_true: bool -> Prop
 negb: bool -> bool
-andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
-andb_true_intro:
-  forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
 eq_true: bool -> Prop
-eq_true_rect:
-  forall P : bool -> Type, P true -> forall b : bool, eq_true b -> P b
-eq_true_ind:
-  forall P : bool -> Prop, P true -> forall b : bool, eq_true b -> P b
+implb: bool -> bool -> bool
+orb: bool -> bool -> bool
+andb: bool -> bool -> bool
+xorb: bool -> bool -> bool
+Nat.even: nat -> bool
+Nat.odd: nat -> bool
+BoolSpec: Prop -> Prop -> bool -> Prop
+Nat.eqb: nat -> nat -> bool
+Nat.testbit: nat -> nat -> bool
+Nat.ltb: nat -> nat -> bool
+Nat.leb: nat -> nat -> bool
+Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
+bool_ind: forall P : bool -> Prop, P true -> P false -> forall b : bool, P b
+bool_rec: forall P : bool -> Set, P true -> P false -> forall b : bool, P b
 eq_true_rec:
   forall P : bool -> Set, P true -> forall b : bool, eq_true b -> P b
-is_true: bool -> Prop
-eq_true_ind_r:
-  forall (P : bool -> Prop) (b : bool), P b -> eq_true b -> P true
-eq_true_rec_r:
-  forall (P : bool -> Set) (b : bool), P b -> eq_true b -> P true
+eq_true_ind:
+  forall P : bool -> Prop, P true -> forall b : bool, eq_true b -> P b
 eq_true_rect_r:
   forall (P : bool -> Type) (b : bool), P b -> eq_true b -> P true
-BoolSpec: Prop -> Prop -> bool -> Prop
+eq_true_rec_r:
+  forall (P : bool -> Set) (b : bool), P b -> eq_true b -> P true
+eq_true_rect:
+  forall P : bool -> Type, P true -> forall b : bool, eq_true b -> P b
+bool_rect: forall P : bool -> Type, P true -> P false -> forall b : bool, P b
+eq_true_ind_r:
+  forall (P : bool -> Prop) (b : bool), P b -> eq_true b -> P true
+andb_true_intro:
+  forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
+andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 BoolSpec_ind:
   forall (P Q : Prop) (P0 : bool -> Prop),
   (P -> P0 true) ->
   (Q -> P0 false) -> forall b : bool, BoolSpec P Q b -> P0 b
-Nat.eqb: nat -> nat -> bool
-Nat.leb: nat -> nat -> bool
-Nat.ltb: nat -> nat -> bool
-Nat.even: nat -> bool
-Nat.odd: nat -> bool
-Nat.testbit: nat -> nat -> bool
-Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
 bool_choice:
   forall (S : Set) (R1 R2 : S -> Prop),
   (forall x : S, {R1 x} + {R2 x}) ->
   {f : S -> bool | forall x : S, f x = true /\ R1 x \/ f x = false /\ R2 x}
-eq_S: forall x y : nat, x = y -> S x = S y
-f_equal_nat: forall (B : Type) (f : nat -> B) (x y : nat), x = y -> f x = f y
-f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
+mult_n_O: forall n : nat, 0 = n * 0
+plus_O_n: forall n : nat, 0 + n = n
+plus_n_O: forall n : nat, n = n + 0
+n_Sn: forall n : nat, n <> S n
 pred_Sn: forall n : nat, n = Nat.pred (S n)
+O_S: forall n : nat, 0 <> S n
+f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
+eq_S: forall x y : nat, x = y -> S x = S y
 eq_add_S: forall n m : nat, S n = S m -> n = m
+min_r: forall n m : nat, m <= n -> Nat.min n m = m
+min_l: forall n m : nat, n <= m -> Nat.min n m = n
+max_r: forall n m : nat, n <= m -> Nat.max n m = m
+max_l: forall n m : nat, m <= n -> Nat.max n m = n
+plus_Sn_m: forall n m : nat, S n + m = S (n + m)
+plus_n_Sm: forall n m : nat, S (n + m) = n + S m
+f_equal_nat: forall (B : Type) (f : nat -> B) (x y : nat), x = y -> f x = f y
 not_eq_S: forall n m : nat, n <> m -> S n <> S m
-O_S: forall n : nat, 0 <> S n
-n_Sn: forall n : nat, n <> S n
+mult_n_Sm: forall n m : nat, n * m + n = n * S m
 f_equal2_plus:
   forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2
+f_equal2_mult:
+  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2
 f_equal2_nat:
   forall (B : Type) (f : nat -> nat -> B) (x1 y1 x2 y2 : nat),
   x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2
-plus_n_O: forall n : nat, n = n + 0
-plus_O_n: forall n : nat, 0 + n = n
-plus_n_Sm: forall n m : nat, S (n + m) = n + S m
-plus_Sn_m: forall n m : nat, S n + m = S (n + m)
-f_equal2_mult:
-  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2
-mult_n_O: forall n : nat, 0 = n * 0
-mult_n_Sm: forall n m : nat, n * m + n = n * S m
-max_l: forall n m : nat, m <= n -> Nat.max n m = n
-max_r: forall n m : nat, n <= m -> Nat.max n m = m
-min_l: forall n m : nat, n <= m -> Nat.min n m = n
-min_r: forall n m : nat, m <= n -> Nat.min n m = m
-andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 andb_true_intro:
   forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
+andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 bool_choice:
   forall (S : Set) (R1 R2 : S -> Prop),
   (forall x : S, {R1 x} + {R2 x}) ->
   {f : S -> bool | forall x : S, f x = true /\ R1 x \/ f x = false /\ R2 x}
-andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 andb_true_intro:
   forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
 andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
+andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
+h: n <> newdef n
 h': newdef n <> n
 h: n <> newdef n
 h': newdef n <> n
 h: n <> newdef n
 h: n <> newdef n
 h: n <> newdef n
-h': ~ P n
+h': newdef n <> n
+The command has indeed failed with message:
+No such goal.
+The command has indeed failed with message:
+Query commands only support the single numbered goal selector.
+The command has indeed failed with message:
+Query commands only support the single numbered goal selector.
 h: P n
 h': ~ P n
 h: P n
 h': ~ P n
 h: P n
+h': ~ P n
 h: P n
 h: P n
diff --git a/test-suite/output/Search.v b/test-suite/output/Search.v
index 2a0f0b40..82096f29 100644
--- a/test-suite/output/Search.v
+++ b/test-suite/output/Search.v
@@ -10,11 +10,19 @@ Search (@eq _ _ _) true -false "prop" -"intro".  (* andb_prop *)
 Definition newdef := fun x:nat => x.
 
 Goal forall n:nat, n <> newdef n -> newdef n <> n -> False.
-  intros n h h'.
+  cut False.
+  intros _ n h h'.
   Search n.                             (* search hypothesis *)
   Search newdef.                        (* search hypothesis *)
   Search ( _ <> newdef _).              (* search hypothesis, pattern *)
   Search ( _ <> newdef _) -"h'".        (* search hypothesis, pattern *)
+
+  1:Search newdef.
+  2:Search newdef.
+
+  Fail 3:Search newdef.
+  Fail 1-2:Search newdef.
+  Fail all:Search newdef.
 Abort.
 
 Goal forall n (P:nat -> Prop), P n -> ~P n -> False.
diff --git a/test-suite/output/SearchHead.out b/test-suite/output/SearchHead.out
index 0d5924ec..7038eac2 100644
--- a/test-suite/output/SearchHead.out
+++ b/test-suite/output/SearchHead.out
@@ -1,39 +1,39 @@
 le_n: forall n : nat, n <= n
+le_0_n: forall n : nat, 0 <= n
 le_S: forall n m : nat, n <= m -> n <= S m
 le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m
-le_S_n: forall n m : nat, S n <= S m -> n <= m
-le_0_n: forall n : nat, 0 <= n
 le_n_S: forall n m : nat, n <= m -> S n <= S m
-true: bool
+le_S_n: forall n m : nat, S n <= S m -> n <= m
 false: bool
-andb: bool -> bool -> bool
-orb: bool -> bool -> bool
+true: bool
+negb: bool -> bool
 implb: bool -> bool -> bool
+orb: bool -> bool -> bool
+andb: bool -> bool -> bool
 xorb: bool -> bool -> bool
-negb: bool -> bool
-Nat.eqb: nat -> nat -> bool
-Nat.leb: nat -> nat -> bool
-Nat.ltb: nat -> nat -> bool
 Nat.even: nat -> bool
 Nat.odd: nat -> bool
+Nat.leb: nat -> nat -> bool
+Nat.ltb: nat -> nat -> bool
 Nat.testbit: nat -> nat -> bool
-eq_S: forall x y : nat, x = y -> S x = S y
-f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
+Nat.eqb: nat -> nat -> bool
+mult_n_O: forall n : nat, 0 = n * 0
+plus_O_n: forall n : nat, 0 + n = n
+plus_n_O: forall n : nat, n = n + 0
 pred_Sn: forall n : nat, n = Nat.pred (S n)
+f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
 eq_add_S: forall n m : nat, S n = S m -> n = m
-f_equal2_plus:
-  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2
-plus_n_O: forall n : nat, n = n + 0
-plus_O_n: forall n : nat, 0 + n = n
+eq_S: forall x y : nat, x = y -> S x = S y
+max_r: forall n m : nat, n <= m -> Nat.max n m = m
+max_l: forall n m : nat, m <= n -> Nat.max n m = n
+min_r: forall n m : nat, m <= n -> Nat.min n m = m
+min_l: forall n m : nat, n <= m -> Nat.min n m = n
 plus_n_Sm: forall n m : nat, S (n + m) = n + S m
 plus_Sn_m: forall n m : nat, S n + m = S (n + m)
+mult_n_Sm: forall n m : nat, n * m + n = n * S m
+f_equal2_plus:
+  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2
 f_equal2_mult:
   forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2
-mult_n_O: forall n : nat, 0 = n * 0
-mult_n_Sm: forall n m : nat, n * m + n = n * S m
-max_l: forall n m : nat, m <= n -> Nat.max n m = n
-max_r: forall n m : nat, n <= m -> Nat.max n m = m
-min_l: forall n m : nat, n <= m -> Nat.min n m = n
-min_r: forall n m : nat, m <= n -> Nat.min n m = m
 h: newdef n
 h: P n
diff --git a/test-suite/output/SearchPattern.out b/test-suite/output/SearchPattern.out
index f3c12eff..b0ac9ea2 100644
--- a/test-suite/output/SearchPattern.out
+++ b/test-suite/output/SearchPattern.out
@@ -1,77 +1,86 @@
-true: bool
 false: bool
-andb: bool -> bool -> bool
-orb: bool -> bool -> bool
+true: bool
+negb: bool -> bool
 implb: bool -> bool -> bool
+orb: bool -> bool -> bool
+andb: bool -> bool -> bool
 xorb: bool -> bool -> bool
-negb: bool -> bool
-Nat.eqb: nat -> nat -> bool
-Nat.leb: nat -> nat -> bool
-Nat.ltb: nat -> nat -> bool
 Nat.even: nat -> bool
 Nat.odd: nat -> bool
+Nat.leb: nat -> nat -> bool
+Nat.ltb: nat -> nat -> bool
 Nat.testbit: nat -> nat -> bool
-O: nat
-S: nat -> nat
-length: forall A : Type, list A -> nat
-Nat.zero: nat
-Nat.one: nat
+Nat.eqb: nat -> nat -> bool
 Nat.two: nat
+Nat.one: nat
+Nat.zero: nat
+O: nat
+Nat.div2: nat -> nat
+Nat.log2: nat -> nat
 Nat.succ: nat -> nat
+Nat.sqrt: nat -> nat
 Nat.pred: nat -> nat
-Nat.add: nat -> nat -> nat
 Nat.double: nat -> nat
-Nat.mul: nat -> nat -> nat
-Nat.sub: nat -> nat -> nat
+Nat.square: nat -> nat
+S: nat -> nat
+Nat.ldiff: nat -> nat -> nat
+Nat.tail_add: nat -> nat -> nat
+Nat.land: nat -> nat -> nat
+Nat.tail_mul: nat -> nat -> nat
+Nat.div: nat -> nat -> nat
+Nat.lor: nat -> nat -> nat
+Nat.gcd: 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.div: nat -> nat -> nat
-Nat.modulo: nat -> nat -> nat
-Nat.gcd: nat -> nat -> nat
-Nat.square: 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
 Nat.sqrt: nat -> nat
-Nat.log2_iter: nat -> nat -> nat -> nat -> nat
 Nat.log2: nat -> nat
-Nat.div2: nat -> nat
-Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
-Nat.land: nat -> nat -> nat
-Nat.lor: nat -> nat -> nat
-Nat.ldiff: nat -> nat -> nat
-Nat.lxor: nat -> nat -> nat
-S: nat -> nat
-Nat.succ: nat -> nat
-Nat.pred: nat -> nat
-Nat.add: nat -> nat -> nat
 Nat.double: nat -> nat
-Nat.mul: nat -> nat -> nat
-Nat.sub: nat -> nat -> nat
-Nat.max: nat -> nat -> nat
-Nat.min: nat -> nat -> nat
+Nat.pred: nat -> nat
+Nat.square: nat -> nat
+Nat.succ: nat -> nat
+S: nat -> nat
+Nat.ldiff: nat -> nat -> nat
 Nat.pow: nat -> nat -> nat
+Nat.land: nat -> nat -> nat
+Nat.lxor: nat -> nat -> nat
 Nat.div: 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.mul: nat -> nat -> nat
 Nat.gcd: nat -> nat -> nat
-Nat.square: nat -> nat
-Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
-Nat.sqrt: nat -> nat
+Nat.max: nat -> nat -> nat
+Nat.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.log2: nat -> nat
-Nat.div2: nat -> nat
+Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
 Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
-Nat.land: nat -> nat -> nat
-Nat.lor: nat -> nat -> nat
-Nat.ldiff: nat -> nat -> nat
-Nat.lxor: nat -> nat -> nat
 mult_n_Sm: forall n m : nat, n * m + n = n * S m
-identity_refl: forall (A : Type) (a : A), identity a a
 iff_refl: forall A : Prop, A <-> A
+le_n: forall n : nat, n <= n
+identity_refl: forall (A : Type) (a : A), identity a a
 eq_refl: forall (A : Type) (x : A), x = x
 Nat.divmod: nat -> nat -> nat -> nat -> nat * nat
-le_n: forall n : nat, n <= n
-pair: forall A B : Type, A -> B -> A * B
 conj: forall A B : Prop, A -> B -> A /\ B
+pair: forall A B : Type, A -> B -> A * B
 Nat.divmod: nat -> nat -> nat -> nat -> nat * nat
 h: n <> newdef n
 h: n <> newdef n
diff --git a/test-suite/output/SearchPattern.v b/test-suite/output/SearchPattern.v
index bde195a5..de9f4887 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/Show.out b/test-suite/output/Show.out
new file mode 100644
index 00000000..ca56f032
--- /dev/null
+++ b/test-suite/output/Show.out
@@ -0,0 +1,10 @@
+3 subgoals (ID 31)
+  
+  H : 0 = 0
+  ============================
+  1 = 1
+
+subgoal 2 (ID 35) is:
+ 1 = S (S m')
+subgoal 3 (ID 22) is:
+ S (S n') = S m
diff --git a/test-suite/output/Show.v b/test-suite/output/Show.v
new file mode 100644
index 00000000..60faac8d
--- /dev/null
+++ b/test-suite/output/Show.v
@@ -0,0 +1,11 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs") -*- *)
+
+(* tests of Show output with -emacs flag to coqtop; see bug 5535 *)
+
+Theorem nums : forall (n m : nat), n = m -> (S n) = (S m).
+Proof.
+  intros.
+  induction n as [| n'].  
+  induction m as [| m'].
+  Show.
+Admitted.
diff --git a/test-suite/output/ShowMatch.out b/test-suite/output/ShowMatch.out
new file mode 100644
index 00000000..e5520b8d
--- /dev/null
+++ b/test-suite/output/ShowMatch.out
@@ -0,0 +1,8 @@
+match # with
+ | f =>
+ end
+ 
+match # with
+ | A.f =>
+ end
+ 
diff --git a/test-suite/output/ShowMatch.v b/test-suite/output/ShowMatch.v
new file mode 100644
index 00000000..02b7eada
--- /dev/null
+++ b/test-suite/output/ShowMatch.v
@@ -0,0 +1,13 @@
+(* Bug 5546 complained about unqualified constructors in Show Match output, 
+   when qualification is needed to disambiguate them
+*)
+
+Module A.
+  Inductive foo := f.
+  Show Match foo. (* no need to disambiguate *)
+End A. 
+
+Module B.
+  Inductive foo := f.
+  (* local foo shadows A.foo, so constructor "f" needs disambiguation *)
+  Show Match A.foo. 
diff --git a/test-suite/output/ShowProof.out b/test-suite/output/ShowProof.out
new file mode 100644
index 00000000..2d4be8bc
--- /dev/null
+++ b/test-suite/output/ShowProof.out
@@ -0,0 +1 @@
+(fun x : Type => conj I ?Goal)
diff --git a/test-suite/output/ShowProof.v b/test-suite/output/ShowProof.v
new file mode 100644
index 00000000..73ecaf22
--- /dev/null
+++ b/test-suite/output/ShowProof.v
@@ -0,0 +1,6 @@
+(* Was #4524 *)
+Definition foo (x : Type) : True /\ True.
+Proof.
+split.
+- exact I.
+  Show Proof. (* Was not finding an evar name at some time *)
diff --git a/test-suite/output/SuggestProofUsing.out b/test-suite/output/SuggestProofUsing.out
new file mode 100644
index 00000000..8d67a4a4
--- /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 00000000..00b6f8e1
--- /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.out b/test-suite/output/Tactics.out
index 239edd1d..19c9fc44 100644
--- a/test-suite/output/Tactics.out
+++ b/test-suite/output/Tactics.out
@@ -2,3 +2,7 @@ Ltac f H := split; [ a H | e H ]
 Ltac g := match goal with
           | |- context [ if ?X then _ else _ ] => case X
           end
+The command has indeed failed with message:
+H is already used.
+The command has indeed failed with message:
+H is already used.
diff --git a/test-suite/output/Tactics.v b/test-suite/output/Tactics.v
index a7c497cf..75b66e46 100644
--- a/test-suite/output/Tactics.v
+++ b/test-suite/output/Tactics.v
@@ -7,7 +7,17 @@ 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 (BZ#5390) *)
+Lemma myid (P : Prop) : P <-> P.
+Proof. split; auto. Qed.
+
+Goal True -> (True /\ True) -> True.
+Proof.
+intros H.
+Fail intros [H%myid ?].
+Fail destruct 1 as [H%myid ?].
diff --git a/test-suite/output/TypeclassDebug.out b/test-suite/output/TypeclassDebug.out
new file mode 100644
index 00000000..8b38fe0f
--- /dev/null
+++ b/test-suite/output/TypeclassDebug.out
@@ -0,0 +1,18 @@
+Debug: 1: looking for foo without backtracking
+Debug: 1.1: simple apply H on foo, 1 subgoal(s)
+Debug: 1.1-1 : foo
+Debug: 1.1-1: looking for foo without backtracking
+Debug: 1.1-1.1: simple apply H on foo, 1 subgoal(s)
+Debug: 1.1-1.1-1 : foo
+Debug: 1.1-1.1-1: looking for foo without backtracking
+Debug: 1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s)
+Debug: 1.1-1.1-1.1-1 : foo
+Debug: 1.1-1.1-1.1-1: looking for foo without backtracking
+Debug: 1.1-1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s)
+Debug: 1.1-1.1-1.1-1.1-1 : foo
+Debug: 1.1-1.1-1.1-1.1-1: looking for foo without backtracking
+Debug: 1.1-1.1-1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s)
+Debug: 1.1-1.1-1.1-1.1-1.1-1 : foo
+The command has indeed failed with message:
+Ltac call to "typeclasses eauto (int_or_var_opt) with (ne_preident_list)" failed.
+Tactic failure: Proof search reached its limit.
diff --git a/test-suite/output/TypeclassDebug.v b/test-suite/output/TypeclassDebug.v
new file mode 100644
index 00000000..d38e2a50
--- /dev/null
+++ b/test-suite/output/TypeclassDebug.v
@@ -0,0 +1,8 @@
+(* show alternating separators in typeclass debug output; see discussion in PR #868 *)
+
+Parameter foo : Prop.
+Axiom H : foo -> foo.
+Hint Resolve H : foo.
+Goal foo.
+Typeclasses eauto := debug.
+Fail typeclasses eauto 5 with foo.
diff --git a/test-suite/output/UnclosedBlocks.out b/test-suite/output/UnclosedBlocks.out
new file mode 100644
index 00000000..b83e94ad
--- /dev/null
+++ b/test-suite/output/UnclosedBlocks.out
@@ -0,0 +1,3 @@
+
+Error: The section Baz, module type Bar and module Foo need to be closed.
+
diff --git a/test-suite/output/UnclosedBlocks.v b/test-suite/output/UnclosedBlocks.v
new file mode 100644
index 00000000..854bd6a6
--- /dev/null
+++ b/test-suite/output/UnclosedBlocks.v
@@ -0,0 +1,8 @@
+(* -*- mode: coq; coq-prog-args: ("-compile" "UnclosedBlocks.v") *)
+Module Foo.
+  Module Closed.
+  End Closed.
+  Module Type Bar.
+    Section Baz.
+      (* end-of-compilation error message reports unclosed sections, blocks, and
+      module types *)
diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out
new file mode 100644
index 00000000..23379afd
--- /dev/null
+++ b/test-suite/output/UnivBinders.out
@@ -0,0 +1,181 @@
+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) => punwrap _ p
+     : 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
+Type@{i} -> Type@{j}
+     : Type@{max(i+1,j+1)}
+(* {j i} |=  *)
+     = Type@{i} -> Type@{j}
+     : Type@{max(i+1,j+1)}
+(* {j i} |=  *)
+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.48 Top.49} : Type@{Top.48} -> Type@{i}
+(* i Top.48 Top.49 |=  *)
+
+axfoo is universe polymorphic
+Argument scope is [type_scope]
+Expands to: Constant Top.axfoo
+axbar@{i Top.48 Top.49} : Type@{Top.49} -> Type@{i}
+(* i Top.48 Top.49 |=  *)
+
+axbar is universe polymorphic
+Argument scope is [type_scope]
+Expands to: Constant Top.axbar
+axfoo' : Type@{Top.51} -> Type@{axbar'.i}
+
+axfoo' is not universe polymorphic
+Argument scope is [type_scope]
+Expands to: Constant Top.axfoo'
+axbar' : Type@{Top.51} -> 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
new file mode 100644
index 00000000..f806a9f4
--- /dev/null
+++ b/test-suite/output/UnivBinders.v
@@ -0,0 +1,154 @@
+Set Universe Polymorphism.
+Set Printing Universes.
+(* Unset Strict Universe Declaration. *)
+
+(* universe binders on inductive types and record projections *)
+Inductive Empty@{u} : Type@{u} := .
+Print Empty.
+
+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.
+
+Check Type@{i} -> Type@{j}.
+
+Eval cbv in Type@{i} -> Type@{j}.
+
+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.
+
+  Monomorphic Inductive monoind@{i} : Type@{i} := .
+  Monomorphic Record monorecord@{i} : Type@{i} := mkmonorecord {}.
+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/UsePluginWarning.out b/test-suite/output/UsePluginWarning.out
new file mode 100644
index 00000000..47409f3e
--- /dev/null
+++ b/test-suite/output/UsePluginWarning.out
@@ -0,0 +1 @@
+type foo = __
diff --git a/test-suite/output/UsePluginWarning.v b/test-suite/output/UsePluginWarning.v
new file mode 100644
index 00000000..c6e00546
--- /dev/null
+++ b/test-suite/output/UsePluginWarning.v
@@ -0,0 +1,7 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-w" "-extraction-logical-axiom") -*- *)
+
+Require Extraction.
+Axiom foo : Prop.
+
+Extraction foo.
+
diff --git a/test-suite/output/Warnings.out b/test-suite/output/Warnings.out
new file mode 100644
index 00000000..a70f8ca4
--- /dev/null
+++ b/test-suite/output/Warnings.out
@@ -0,0 +1,3 @@
+File "stdin", line 4, characters 0-22:
+Warning: Projection value has no head constant: fun x : B => x in canonical
+instance a of b, ignoring it. [projection-no-head-constant,typechecker]
diff --git a/test-suite/output/Warnings.v b/test-suite/output/Warnings.v
new file mode 100644
index 00000000..7465442c
--- /dev/null
+++ b/test-suite/output/Warnings.v
@@ -0,0 +1,5 @@
+(* Term in warning was not printed in the right environment at some time *)
+Record A := { B:Type; b:B->B }.
+Definition a B := {| B:=B; b:=fun x => x |}.
+Canonical Structure a.
+
diff --git a/test-suite/output/auto.out b/test-suite/output/auto.out
new file mode 100644
index 00000000..2761b87b
--- /dev/null
+++ b/test-suite/output/auto.out
@@ -0,0 +1,22 @@
+(* info auto: *)
+simple apply or_intror (in core).
+ intro.
+ assumption.
+Debug: (* debug auto: *)
+Debug: * assumption. (*fail*)
+Debug: * intro. (*fail*)
+Debug: * simple apply or_intror (in core). (*success*)
+Debug: ** assumption. (*fail*)
+Debug: ** intro. (*success*)
+Debug: ** assumption. (*success*)
+(* info eauto: *)
+simple apply or_intror.
+ intro.
+ exact H.
+Debug: (* debug eauto: *)
+Debug: 1 depth=5 
+Debug: 1.1 depth=4 simple apply or_intror
+Debug: 1.1.1 depth=4 intro
+Debug: 1.1.1.1 depth=4 exact H
+(* info trivial: *)
+exact I (in core).
diff --git a/test-suite/output/auto.v b/test-suite/output/auto.v
new file mode 100644
index 00000000..92917cdf
--- /dev/null
+++ b/test-suite/output/auto.v
@@ -0,0 +1,15 @@
+(* testing info/debug auto/eauto *)
+
+Goal False \/ (True -> True).
+info_auto.
+Undo.
+debug auto.
+Undo.
+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 00000000..91ceb1b5
--- /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 00000000..0dcd76ae
--- /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 00000000..7b12b532
--- /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 00000000..40627e33
--- /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/goal_output.out b/test-suite/output/goal_output.out
new file mode 100644
index 00000000..773533a8
--- /dev/null
+++ b/test-suite/output/goal_output.out
@@ -0,0 +1,8 @@
+Nat.t = nat
+     : Set
+Nat.t = nat
+     : Set
+1 subgoal
+  
+  ============================
+  False
diff --git a/test-suite/output/goal_output.v b/test-suite/output/goal_output.v
new file mode 100644
index 00000000..327b80b0
--- /dev/null
+++ b/test-suite/output/goal_output.v
@@ -0,0 +1,13 @@
+(* From
+   - https://coq.inria.fr/bugs/show_bug.cgi?id=5529
+   - https://coq.inria.fr/bugs/show_bug.cgi?id=5537
+ *)
+
+Print Nat.t.
+Timeout 1 Print Nat.t.
+
+Lemma toto: False.
+Set Printing All.
+Show.
+Abort.
+
diff --git a/test-suite/output/idtac.out b/test-suite/output/idtac.out
new file mode 100644
index 00000000..3855f88a
--- /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 00000000..ac60ea91
--- /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/inference.out b/test-suite/output/inference.out
index 576fbd7c..f7ffd195 100644
--- a/test-suite/output/inference.out
+++ b/test-suite/output/inference.out
@@ -4,15 +4,13 @@ fun e : option L => match e with
                     | None => None
                     end
      : option L -> option L
-fun (m n p : nat) (H : S m <= S n + p) => le_S_n m (n + p) H
-     : forall m n p : nat, S m <= S n + p -> m <= n + p
-fun n : nat => let x := A n : T n in ?y ?y0 : T n
+fun n : nat => let y : T n := A n in ?t ?x : T n
      : forall n : nat, T n
 where
-?y : [n : nat  x := A n : T n |- ?T -> T n] 
-?y0 : [n : nat  x := A n : T n |- ?T] 
-fun n : nat => ?y ?y0 : T n
+?t : [n : nat  y := A n : T n |- ?T -> T n]
+?x : [n : nat  y := A n : T n |- ?T]
+fun n : nat => ?t ?x : T n
      : forall n : nat, T n
 where
-?y : [n : nat |- ?T -> T n] 
-?y0 : [n : nat |- ?T] 
+?t : [n : nat |- ?T -> T n]
+?x : [n : nat |- ?T]
diff --git a/test-suite/output/inference.v b/test-suite/output/inference.v
index 1825db16..57a4739e 100644
--- a/test-suite/output/inference.v
+++ b/test-suite/output/inference.v
@@ -13,11 +13,6 @@ Definition P (e:option L) :=
 
 Print P.
 
-(* Check that plus is folded even if reduction is involved *)
-Set Refolding Reduction.
-Check (fun m n p (H : S m <= (S n) + p) => le_S_n _ _ H).
-
-
 (* Check that the heuristic to solve constraints is not artificially
    dependent on the presence of a let-in, and in particular that the
    second [_] below is not inferred to be n, as if obtained by
@@ -27,5 +22,5 @@ Check (fun m n p (H : S m <= (S n) + p) => le_S_n _ _ H).
 (* Note: exact numbers of evars are not important... *)
 
 Inductive T (n:nat) : Type := A : T n.
-Check fun n (x:=A n:T n) => _ _ : T n.
+Check fun n (y:=A n:T n) => _ _ : T n.
 Check fun n => _ _ : T n.
diff --git a/test-suite/output/load/Load_noproof.v b/test-suite/output/load/Load_noproof.v
new file mode 100644
index 00000000..aaf1ffe2
--- /dev/null
+++ b/test-suite/output/load/Load_noproof.v
@@ -0,0 +1 @@
+Definition f := 2.
diff --git a/test-suite/output/load/Load_openproof.v b/test-suite/output/load/Load_openproof.v
new file mode 100644
index 00000000..204d4ecb
--- /dev/null
+++ b/test-suite/output/load/Load_openproof.v
@@ -0,0 +1 @@
+Lemma k : True.
diff --git a/test-suite/output/load/Load_proof.v b/test-suite/output/load/Load_proof.v
new file mode 100644
index 00000000..e47f66a1
--- /dev/null
+++ b/test-suite/output/load/Load_proof.v
@@ -0,0 +1,2 @@
+Lemma u : True.
+Proof. exact I. Qed.
diff --git a/test-suite/output/ltac.out b/test-suite/output/ltac.out
index 1ff09e3a..eb9f5710 100644
--- a/test-suite/output/ltac.out
+++ b/test-suite/output/ltac.out
@@ -1,8 +1,7 @@
 The command has indeed failed with message:
-Error:
 Ltac variable y depends on pattern variable name z which is not bound in current context.
 Ltac f x y z :=
-  symmetry in x, y; auto with z; auto; intros **; clearbody x; generalize
+  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.
@@ -22,13 +21,20 @@ The term "I" has type "True" while it is expected to have type "False".
 The command has indeed failed with message:
 In nested Ltac calls to "h" and "injection (destruction_arg)", last call
 failed.
-Error: No primitive equality found.
+No primitive equality found.
 The command has indeed failed with message:
 In nested Ltac calls to "h" and "injection (destruction_arg)", last call
 failed.
-Error: No primitive equality found.
+No primitive equality found.
 Hx
 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 76c37625..6adbe95d 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 00000000..77e799d3
--- /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 00000000..4caf619f
--- /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
new file mode 100644
index 00000000..7326f137
--- /dev/null
+++ b/test-suite/output/ltac_missing_args.out
@@ -0,0 +1,40 @@
+The command has indeed failed with message:
+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:
+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:
+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:
+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:
+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:
+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:
+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:
+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:
+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:
+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
new file mode 100644
index 00000000..91331a1d
--- /dev/null
+++ b/test-suite/output/ltac_missing_args.v
@@ -0,0 +1,19 @@
+Ltac foo x := idtac x.
+Ltac bar x := fun y _ => idtac x y.
+Ltac baz := foo.
+Ltac qux := bar.
+Ltac mydo tac := tac ().
+Ltac rec x := rec.
+
+Goal True.
+  Fail foo.
+  Fail bar.
+  Fail bar True.
+  Fail baz.
+  Fail qux.
+  Fail mydo ltac:(fun _ _ => idtac).
+  Fail let tac := (fun _ => idtac) in tac.
+  Fail (fun _ => idtac).
+  Fail rec True.
+  Fail let rec tac x := tac in tac True.
+Abort.
diff --git a/test-suite/output/names.out b/test-suite/output/names.out
index 9471b892..48be63a4 100644
--- a/test-suite/output/names.out
+++ b/test-suite/output/names.out
@@ -3,3 +3,9 @@ In environment
 y : nat
 The term "a y" has type "{y0 : nat | y = y0}"
 while it is expected to have type "{x : nat | x = y}".
+1 focused subgoal
+(shelved: 1)
+  
+  H : ?n <= 3 -> 3 <= ?n -> ?n = 3
+  ============================
+  True
diff --git a/test-suite/output/names.v b/test-suite/output/names.v
index b3b5071a..f1efd0df 100644
--- a/test-suite/output/names.v
+++ b/test-suite/output/names.v
@@ -3,3 +3,7 @@
 
 Parameter a : forall x, {y:nat|x=y}.
 Fail Definition b y : {x:nat|x=y} := a y.
+
+Goal (forall n m, n <= m -> m <= n -> n = m) -> True.
+intro H; epose proof (H _ 3) as H.
+Show.
diff --git a/test-suite/output/optimize_heap.out b/test-suite/output/optimize_heap.out
new file mode 100644
index 00000000..94a0b191
--- /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 00000000..e566bd7b
--- /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/output/qualification.out b/test-suite/output/qualification.out
index 9300c3f5..e9c70d1e 100644
--- a/test-suite/output/qualification.out
+++ b/test-suite/output/qualification.out
@@ -1,3 +1,4 @@
 File "stdin", line 19, characters 0-7:
 Error: Signature components for label test do not match: expected type
 "Top.M2.t = Top.M2.M.t" but found type "Top.M2.t = Top.M2.t".
+
diff --git a/test-suite/output/ssr_clear.out b/test-suite/output/ssr_clear.out
new file mode 100644
index 00000000..15159540
--- /dev/null
+++ b/test-suite/output/ssr_clear.out
@@ -0,0 +1,3 @@
+The command has indeed failed with message:
+Ltac call to "move (ssrmovearg) (ssrclauses)" failed.
+No assumption is named NO_SUCH_NAME
diff --git a/test-suite/output/ssr_clear.v b/test-suite/output/ssr_clear.v
new file mode 100644
index 00000000..573ec47e
--- /dev/null
+++ b/test-suite/output/ssr_clear.v
@@ -0,0 +1,6 @@
+Require Import ssreflect.
+
+Example foo : True -> True.
+Proof.
+Fail move=> {NO_SUCH_NAME}.
+Abort.
diff --git a/test-suite/prerequisite/bind_univs.v b/test-suite/prerequisite/bind_univs.v
new file mode 100644
index 00000000..e834fde1
--- /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/prerequisite/module_bug7192.v b/test-suite/prerequisite/module_bug7192.v
new file mode 100644
index 00000000..82cfe560
--- /dev/null
+++ b/test-suite/prerequisite/module_bug7192.v
@@ -0,0 +1,9 @@
+(* Variant of #7192 to be tested in a file requiring this file *)
+(* #7192 is about Print Assumptions not entering implementation of submodules *)
+
+Definition a := True.
+Module Type B. Axiom f : Prop. End B.
+Module Type C. Declare Module D : B. End C.
+Module M7192: C.
+  Module D <: B. Definition f := a. End D.
+End M7192.
diff --git a/test-suite/prerequisite/module_bug8416.v b/test-suite/prerequisite/module_bug8416.v
new file mode 100644
index 00000000..70f43d13
--- /dev/null
+++ b/test-suite/prerequisite/module_bug8416.v
@@ -0,0 +1,2 @@
+Module Type A. Axiom f : True. End A.
+Module M8416 : A. Definition f := I. End M8416.
diff --git a/test-suite/save-logs.sh b/test-suite/save-logs.sh
new file mode 100755
index 00000000..9b8fff09
--- /dev/null
+++ b/test-suite/save-logs.sh
@@ -0,0 +1,19 @@
+#!/usr/bin/env bash
+
+SAVEDIR="logs"
+
+# reset for local builds
+rm -rf "$SAVEDIR"
+mkdir "$SAVEDIR"
+
+# keep this synced with test-suite/Makefile
+FAILMARK="==========> FAILURE <=========="
+
+FAILED=$(mktemp /tmp/coq-check-XXXXXX)
+find . '(' -path ./bugs/opened -prune ')' -o '(' -name '*.log' -exec grep "$FAILMARK" -q '{}' ';' -print0 ')' > "$FAILED"
+
+rsync -a --from0 --files-from="$FAILED" . "$SAVEDIR"
+cp summary.log "$SAVEDIR"/
+
+# cleanup
+rm "$FAILED"
diff --git a/test-suite/ssr/rew_polyuniv.v b/test-suite/ssr/rew_polyuniv.v
new file mode 100644
index 00000000..e2bbbc9e
--- /dev/null
+++ b/test-suite/ssr/rew_polyuniv.v
@@ -0,0 +1,90 @@
+From Coq Require Import Utf8 Setoid ssreflect.
+Set Default Proof Using "Type".
+
+Local Set Universe Polymorphism.
+
+(** Telescopes *)
+Inductive tele : Type :=
+  | TeleO : tele
+  | TeleS {X} (binder : X → tele) : tele.
+
+Arguments TeleS {_} _.
+
+(** The telescope version of Coq's function type *)
+Fixpoint tele_fun (TT : tele) (T : Type) : Type :=
+  match TT with
+  | TeleO => T
+  | TeleS b => ∀ x, tele_fun (b x) T
+  end.
+
+Notation "TT -t> A" :=
+  (tele_fun TT A) (at level 99, A at level 200, right associativity).
+
+(** A sigma-like type for an "element" of a telescope, i.e. the data it
+  takes to get a [T] from a [TT -t> T]. *)
+Inductive tele_arg : tele → Type :=
+| TargO : tele_arg TeleO
+(* the [x] is the only relevant data here *)
+| TargS {X} {binder} (x : X) : tele_arg (binder x) → tele_arg (TeleS binder).
+
+Definition tele_app {TT : tele} {T} (f : TT -t> T) : tele_arg TT → T :=
+  λ a, (fix rec {TT} (a : tele_arg TT) : (TT -t> T) → T :=
+     match a in tele_arg TT return (TT -t> T) → T with
+     | TargO => λ t : T, t
+     | TargS x a => λ f, rec a (f x)
+     end) TT a f.
+Arguments tele_app {!_ _} _ !_ /.
+
+Coercion tele_arg : tele >-> Sortclass.
+Coercion tele_app : tele_fun >-> Funclass.
+
+(** Inversion lemma for [tele_arg] *)
+Lemma tele_arg_inv {TT : tele} (a : TT) :
+  match TT as TT return TT → Prop with
+  | TeleO => λ a, a = TargO
+  | TeleS f => λ a, ∃ x a', a = TargS x a'
+  end a.
+Proof. induction a; eauto. Qed.
+Lemma tele_arg_O_inv (a : TeleO) : a = TargO.
+Proof. exact (tele_arg_inv a). Qed.
+Lemma tele_arg_S_inv {X} {f : X → tele} (a : TeleS f) :
+  ∃ x a', a = TargS x a'.
+Proof. exact (tele_arg_inv a). Qed.
+
+(** Operate below [tele_fun]s with argument telescope [TT]. *)
+Fixpoint tele_bind {U} {TT : tele} : (TT → U) → TT -t> U :=
+  match TT as TT return (TT → U) → TT -t> U with
+  | TeleO => λ F, F TargO
+  | @TeleS X b => λ (F : TeleS b → U) (x : X), (* b x -t> U *)
+                  tele_bind (λ a, F (TargS x a))
+  end.
+Arguments tele_bind {_ !_} _ /.
+
+(* Show that tele_app ∘ tele_bind is the identity. *)
+Lemma tele_app_bind {U} {TT : tele} (f : TT → U) x :
+  (tele_app (tele_bind f)) x = f x.
+Proof.
+  induction TT as [|X b IH]; simpl in *.
+  - rewrite (tele_arg_O_inv x). auto.
+  - destruct (tele_arg_S_inv x) as [x' [a' ->]]. simpl.
+    rewrite IH. auto.
+Qed.
+
+(** Notation-compatible telescope mapping *)
+(* This adds (tele_app ∘ tele_bind), which is an identity function, around every
+   binder so that, after simplifying, this matches the way we typically write
+   notations involving telescopes. *)
+Notation "'λ..' x .. y , e" :=
+  (tele_app (tele_bind (λ x, .. (tele_app (tele_bind (λ y, e))) .. )))
+  (at level 200, x binder, y binder, right associativity,
+   format "'[  ' 'λ..'  x  ..  y ']' ,  e").
+
+(* The testcase *)
+Lemma test {TA TB : tele} {X} (α' β' γ' : X → Prop) (Φ : TA → TB → Prop) x' :
+  (forall P Q, ((P /\ Q) = Q) * ((P -> Q) = Q)) ->
+  ∀ a b, Φ a b = (λ.. x y, β' x' ∧ (γ' x' → Φ x y)) a b.
+Proof.
+intros cheat a b.
+rewrite !tele_app_bind.
+by rewrite !cheat.
+Qed.
diff --git a/test-suite/ssr/set_polyuniv.v b/test-suite/ssr/set_polyuniv.v
new file mode 100644
index 00000000..436eeafc
--- /dev/null
+++ b/test-suite/ssr/set_polyuniv.v
@@ -0,0 +1,11 @@
+From Coq Require Import ssreflect.
+Set Default Proof Using "Type".
+
+Local Set Universe Polymorphism.
+
+Axiom foo : Type -> Prop.
+
+Lemma test : foo nat.
+Proof.
+set x := foo _. (* key @foo{i} matches @foo{j} *)
+Abort.
diff --git a/test-suite/success/Abstract.v b/test-suite/success/Abstract.v
index ffd50f6e..d52a853a 100644
--- a/test-suite/success/Abstract.v
+++ b/test-suite/success/Abstract.v
@@ -1,5 +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 00000000..ed035f52
--- /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/Case19.v b/test-suite/success/Case19.v
index c29e5297..ce98879a 100644
--- a/test-suite/success/Case19.v
+++ b/test-suite/success/Case19.v
@@ -1,5 +1,5 @@
 (* This used to fail in Coq version 8.1 beta due to a non variable
-   universe (issued by the inductive sort-polymorphism) being sent by
+   universe (issued by template polymorphism) being sent by
    pretyping to the kernel (bug #1182) *)
 
 Variable T : Type.
@@ -17,3 +17,22 @@ Fail exists (fun x =>
         with
         | eq_refl => eq_refl
         end).
+Abort.
+
+(* Some tests with ltac matching on building "if" and "let" *)
+
+Goal forall b c d, (if negb b then c else d) = 0.
+intros.
+match goal with
+|- (if ?b then ?c else ?d) = 0 => transitivity (if b then d else c)
+end.
+Abort.
+
+Definition swap {A} {B} '((x,y):A*B) := (y,x).
+
+Goal forall p, (let '(x,y) := swap p in x + y) = 0.
+intros.
+match goal with
+|- (let '(x,y) := ?p in x + y) = 0 => transitivity (let (x,y) := p in x+y)
+end.
+Abort.
diff --git a/test-suite/success/Case22.v b/test-suite/success/Case22.v
index 3c696502..465b3eb8 100644
--- a/test-suite/success/Case22.v
+++ b/test-suite/success/Case22.v
@@ -41,6 +41,7 @@ Definition F (x:IND True) (A:Type) :=
 Theorem paradox : False.
   (* This succeeded in 8.3, 8.4 and 8.5beta1 because F had wrong type *)
 Fail Proof (F C False).
+Abort.
 
 (* Another bug found in November 2015 (a substitution was wrongly
    reversed at pretyping level) *)
@@ -61,3 +62,30 @@ Inductive Ind2 (b:=1) (c:nat) : Type :=
   Constr2 : Ind2 c.
 
 Eval vm_compute in Constr2 2.
+
+(* A bug introduced in ade2363 (similar to #5322 and #5324). This
+   commit started to see that some List.rev was wrong in the "var"
+   case of a pattern-matching problem but it failed to see that a
+   transformation from a list of arguments into a substitution was
+   still needed. *)
+
+(* The order of real arguments was made wrong by ade2363 in the "var"
+   case of the compilation of "match" *)
+
+Inductive IND2 : forall X Y:Type, Type :=
+  CONSTR2 : IND2 unit Empty_set.
+
+Check fun x:IND2 bool nat =>
+  match x in IND2 a b return a with
+  | y => _
+  end = true.
+
+(* From January 2017, using the proper function to turn arguments into
+   a substitution up to a context possibly containing let-ins, so that
+   the following, which was wrong also before ade2363, now works
+   correctly *)
+
+Check fun x:Ind bool nat =>
+  match x in Ind _ X Y Z return Z with
+  | y => (true,0)
+  end.
diff --git a/test-suite/success/Cases.v b/test-suite/success/Cases.v
index 49c465b6..52fe98ac 100644
--- a/test-suite/success/Cases.v
+++ b/test-suite/success/Cases.v
@@ -1868,3 +1868,8 @@ Definition transport {A} (P : A->Type) {x y : A} (p : x=y) (u : P x) : P y :=
 Check match eq_refl 0 in _=O return O=O with eq_refl => eq_refl end.
 
 Check match niln in listn O return O=O with niln => eq_refl end.
+
+(* A test about nested "as" clauses *)
+(* (was failing up to May 2017) *)
+
+Check fun x => match x with (y,z) as t as w => (y+z,t) = (0,w) end.
diff --git a/test-suite/success/Check.v b/test-suite/success/Check.v
index e4ee351c..36fecf72 100644
--- a/test-suite/success/Check.v
+++ b/test-suite/success/Check.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (* Compiling the theories allows testing parsing and typing but not printing *)
 (* This file tests that pretty-printing does not fail                        *)
@@ -12,3 +14,5 @@
 Check 0.
 Check S.
 Check nat.
+
+Type Type : Type.
diff --git a/test-suite/success/Compat84.v b/test-suite/success/Compat84.v
deleted file mode 100644
index db6348fa..00000000
--- a/test-suite/success/Compat84.v
+++ /dev/null
@@ -1,19 +0,0 @@
-(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
-
-Goal True.
-  solve [ constructor 1 ]. Undo.
-  solve [ econstructor 1 ]. Undo.
-  solve [ constructor ]. Undo.
-  solve [ econstructor ]. Undo.
-  solve [ constructor (fail) ]. Undo.
-  solve [ econstructor (fail) ]. Undo.
-  split.
-Qed.
-
-Goal False \/ True.
-  solve [ constructor (constructor) ]. Undo.
-  solve [ econstructor (econstructor) ]. Undo.
-  solve [ constructor 2; constructor ]. Undo.
-  solve [ econstructor 2; econstructor ]. Undo.
-  right; esplit.
-Qed.
diff --git a/test-suite/success/CompatCurrentFlag.v b/test-suite/success/CompatCurrentFlag.v
new file mode 100644
index 00000000..288c9d1d
--- /dev/null
+++ b/test-suite/success/CompatCurrentFlag.v
@@ -0,0 +1,3 @@
+(* -*- coq-prog-args: ("-compat" "8.8") -*- *)
+(** Check that the current compatibility flag actually requires the relevant modules. *)
+Import Coq.Compat.Coq88.
diff --git a/test-suite/success/CompatOldFlag.v b/test-suite/success/CompatOldFlag.v
new file mode 100644
index 00000000..b7bbc505
--- /dev/null
+++ b/test-suite/success/CompatOldFlag.v
@@ -0,0 +1,5 @@
+(* -*- coq-prog-args: ("-compat" "8.6") -*- *)
+(** Check that the current-minus-two compatibility flag actually requires the relevant modules. *)
+Import Coq.Compat.Coq88.
+Import Coq.Compat.Coq87.
+Import Coq.Compat.Coq86.
diff --git a/test-suite/success/CompatPreviousFlag.v b/test-suite/success/CompatPreviousFlag.v
new file mode 100644
index 00000000..9cfe6039
--- /dev/null
+++ b/test-suite/success/CompatPreviousFlag.v
@@ -0,0 +1,4 @@
+(* -*- coq-prog-args: ("-compat" "8.7") -*- *)
+(** Check that the current-minus-one compatibility flag actually requires the relevant modules. *)
+Import Coq.Compat.Coq88.
+Import Coq.Compat.Coq87.
diff --git a/test-suite/success/Discriminate.v b/test-suite/success/Discriminate.v
index a7596741..6abfca4c 100644
--- a/test-suite/success/Discriminate.v
+++ b/test-suite/success/Discriminate.v
@@ -38,3 +38,10 @@ Abort.
 Goal ~ identity 0 1.
 discriminate.
 Qed.
+
+(* Check discriminate on types with local definitions *)
+
+Inductive A := B (T := unit) (x y : bool) (z := x).
+Goal forall x y, B x true = B y false -> False.
+discriminate.
+Qed.
diff --git a/test-suite/success/Field.v b/test-suite/success/Field.v
index 438e4613..fdf7797d 100644
--- a/test-suite/success/Field.v
+++ b/test-suite/success/Field.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (**** Tests of Field with real numbers ****)
diff --git a/test-suite/success/Fixpoint.v b/test-suite/success/Fixpoint.v
index 5fc703cf..efb32ef6 100644
--- a/test-suite/success/Fixpoint.v
+++ b/test-suite/success/Fixpoint.v
@@ -91,3 +91,33 @@ apply Cons2.
 exact b.
 apply (ex1 (S n) (negb b)).
 Defined.
+
+Section visibility.
+
+  Let Fixpoint imm (n:nat) : True := I.
+
+  Let Fixpoint by_proof (n:nat) : True.
+  Proof. exact I. Defined.
+End visibility.
+
+Fail Check imm.
+Fail Check by_proof.
+
+Module Import mod_local.
+  Fixpoint imm_importable (n:nat) : True := I.
+
+  Local Fixpoint imm_local (n:nat) : True := I.
+
+  Fixpoint by_proof_importable (n:nat) : True.
+  Proof. exact I. Defined.
+
+  Local Fixpoint by_proof_local (n:nat) : True.
+  Proof. exact I. Defined.
+End mod_local.
+
+Check imm_importable.
+Fail Check imm_local.
+Check mod_local.imm_local.
+Check by_proof_importable.
+Fail Check by_proof_local.
+Check mod_local.by_proof_local.
diff --git a/test-suite/success/Funind.v b/test-suite/success/Funind.v
index 3bf97c13..f87f2e2a 100644
--- a/test-suite/success/Funind.v
+++ b/test-suite/success/Funind.v
@@ -1,4 +1,6 @@
 
+Require Import Coq.funind.FunInd.
+
 Definition iszero (n : nat) : bool :=
   match n with
   | O => true
diff --git a/test-suite/success/FunindExtraction_compat86.v b/test-suite/success/FunindExtraction_compat86.v
new file mode 100644
index 00000000..8912197d
--- /dev/null
+++ b/test-suite/success/FunindExtraction_compat86.v
@@ -0,0 +1,506 @@
+(* -*- coq-prog-args: ("-compat" "8.6") -*- *)
+
+Definition iszero (n : nat) : bool :=
+  match n with
+  | O => true
+  | _ => false
+  end.
+
+Functional Scheme iszero_ind := Induction for iszero Sort Prop.
+
+Lemma toto : forall n : nat, n = 0 -> iszero n = true.
+intros x eg.
+ functional induction iszero x; simpl.
+trivial.
+inversion eg.
+Qed.
+
+
+Function ftest (n m : nat) : nat :=
+  match n with
+  | O => match m with
+         | O => 0
+         | _ => 1
+         end
+  | S p => 0
+  end.
+(* MS: FIXME: apparently can't define R_ftest_complete. Rest of the file goes through. *)
+
+Lemma test1 : forall n m : nat, ftest n m <= 2.
+intros n m.
+ functional induction ftest n m; auto.
+Qed.
+
+Lemma test2 : forall m n, ~ 2 = ftest n m.
+Proof.
+intros n m;intro H.
+functional inversion H ftest.
+Qed.
+
+Lemma test3 : forall n m, ftest n m = 0 -> (n = 0 /\ m = 0)  \/ n <> 0.
+Proof.
+functional inversion 1 ftest;auto.
+Qed.
+
+
+Require Import Arith.
+Lemma test11 : forall m : nat, ftest 0 m <= 2.
+intros m.
+ functional induction ftest 0 m.
+auto.
+auto.
+auto with *.
+Qed.
+
+Function lamfix (m n : nat) {struct n } : nat :=
+  match n with
+    | O => m
+    | S p => lamfix m p
+  end.
+
+(* Parameter v1 v2 : nat. *)
+
+Lemma lamfix_lem : forall v1 v2 : nat, lamfix v1 v2 = v1.
+intros v1 v2.
+ functional induction lamfix v1 v2.
+trivial.
+assumption.
+Defined.
+
+
+
+(* polymorphic function *)
+Require Import List.
+
+Functional Scheme app_ind := Induction for app Sort Prop.
+
+Lemma appnil : forall (A : Set) (l l' : list A), l' = nil -> l = l ++ l'.
+intros A l l'.
+ functional induction app A l l';  intuition.
+ rewrite <- H0; trivial.
+Qed.
+
+
+
+
+
+Require Export Arith.
+
+
+Function trivfun (n : nat) : nat :=
+  match n with
+  | O => 0
+  | S m => trivfun m
+  end.
+
+
+(* essaie de parametre variables non locaux:*)
+
+Parameter varessai : nat.
+
+Lemma first_try : trivfun varessai = 0.
+ functional induction trivfun varessai.
+trivial.
+assumption.
+Defined.
+
+
+ Functional Scheme triv_ind := Induction for trivfun Sort Prop.
+
+Lemma bisrepetita : forall n' : nat, trivfun n' = 0.
+intros n'.
+ functional induction trivfun n'.
+trivial.
+assumption.
+Qed.
+
+
+
+
+
+
+
+Function iseven (n : nat) : bool :=
+  match n with
+  | O => true
+  | S (S m) => iseven m
+  | _ => false
+  end.
+
+
+Function funex (n : nat) : nat :=
+  match iseven n with
+  | true => n
+  | false => match n with
+             | O => 0
+             | S r => funex r
+             end
+  end.
+
+
+Function nat_equal_bool (n m : nat) {struct n} : bool :=
+  match n with
+  | O => match m with
+         | O => true
+         | _ => false
+         end
+  | S p => match m with
+           | O => false
+           | S q => nat_equal_bool p q
+           end
+  end.
+
+
+Require Export Div2.
+Require Import Nat.
+Functional Scheme div2_ind := Induction for div2 Sort Prop.
+Lemma div2_inf : forall n : nat, div2 n <= n.
+intros n.
+ functional induction div2 n.
+auto.
+auto.
+
+apply le_S.
+apply le_n_S.
+exact IHn0.
+Qed.
+
+(* reuse this lemma as a scheme:*)
+
+Function nested_lam (n : nat) : nat -> nat :=
+  match n with
+  | O => fun m : nat => 0
+  | S n' => fun m : nat => m + nested_lam n' m
+  end.
+
+
+Lemma nest : forall n m : nat, nested_lam n m = n * m.
+intros n m.
+ functional induction nested_lam n m; simpl;auto.
+Qed.
+
+
+Function essai (x : nat) (p : nat * nat) {struct x} : nat :=
+  let (n, m) := (p: nat*nat) in
+  match n with
+  | O => 0
+  | S q => match x with
+           | O => 1
+           | S r => S (essai r (q, m))
+           end
+  end.
+
+Lemma essai_essai :
+ forall (x : nat) (p : nat * nat), let (n, m) := p in 0 < n -> 0 < essai x p.
+intros x p.
+ functional induction essai x p; intros.
+inversion H.
+auto with arith.
+ auto with arith.
+Qed.
+
+Function plus_x_not_five'' (n m : nat) {struct n} : nat :=
+  let x := nat_equal_bool m 5 in
+  let y := 0 in
+  match n with
+  | O => y
+  | S q =>
+      let recapp := plus_x_not_five'' q m in
+      match x with
+      | true => S recapp
+      | false => S recapp
+      end
+  end.
+
+Lemma notplusfive'' : forall x y : nat, y = 5 -> plus_x_not_five'' x y = x.
+intros a b.
+ functional induction plus_x_not_five'' a b; intros hyp; simpl; auto.
+Qed.
+
+Lemma iseq_eq : forall n m : nat, n = m -> nat_equal_bool n m = true.
+intros n m.
+ functional induction nat_equal_bool n m; simpl; intros hyp; auto.
+rewrite <- hyp in y; simpl in y;tauto.
+inversion hyp.
+Qed.
+
+Lemma iseq_eq' : forall n m : nat, nat_equal_bool n m = true -> n = m.
+intros n m.
+ functional induction nat_equal_bool n m; simpl; intros eg; auto.
+inversion eg.
+inversion eg.
+Qed.
+
+
+Inductive istrue : bool -> Prop :=
+    istrue0 : istrue true.
+
+Functional Scheme add_ind := Induction for add Sort Prop.
+
+Lemma inf_x_plusxy' : forall x y : nat, x <= x + y.
+intros n m.
+ functional induction add n m; intros.
+auto with arith.
+auto with arith.
+Qed.
+
+
+Lemma inf_x_plusxy'' : forall x : nat, x <= x + 0.
+intros n.
+unfold plus.
+ functional induction plus n 0; intros.
+auto with arith.
+apply le_n_S.
+assumption.
+Qed.
+
+Lemma inf_x_plusxy''' : forall x : nat, x <= 0 + x.
+intros n.
+ functional induction plus 0 n; intros; auto with arith.
+Qed.
+
+Function mod2 (n : nat) : nat :=
+  match n with
+  | O => 0
+  | S (S m) => S (mod2 m)
+  | _ => 0
+  end.
+
+Lemma princ_mod2 : forall n : nat, mod2 n <= n.
+intros n.
+ functional induction mod2 n; simpl; auto with arith.
+Qed.
+
+Function isfour (n : nat) : bool :=
+  match n with
+  | S (S (S (S O))) => true
+  | _ => false
+  end.
+
+Function isononeorfour (n : nat) : bool :=
+  match n with
+  | S O => true
+  | S (S (S (S O))) => true
+  | _ => false
+  end.
+
+Lemma toto'' : forall n : nat, istrue (isfour n) -> istrue (isononeorfour n).
+intros n.
+ functional induction isononeorfour n; intros istr; simpl;
+ inversion istr.
+apply istrue0.
+destruct n. inversion istr.
+destruct n. tauto.
+destruct n. inversion istr.
+destruct n. inversion istr.
+destruct n. tauto.
+simpl in *. inversion H0.
+Qed.
+
+Lemma toto' : forall n m : nat, n = 4 -> istrue (isononeorfour n).
+intros n.
+ functional induction isononeorfour n; intros m istr; inversion istr.
+apply istrue0.
+rewrite H in y; simpl in y;tauto.
+Qed.
+
+Function ftest4 (n m : nat) : nat :=
+  match n with
+  | O => match m with
+         | O => 0
+         | S q => 1
+         end
+  | S p => match m with
+           | O => 0
+           | S r => 1
+           end
+  end.
+
+Lemma test4 : forall n m : nat, ftest n m <= 2.
+intros n m.
+ functional induction ftest n m; auto with arith.
+Qed.
+
+Lemma test4' : forall n m : nat, ftest4 (S n) m <= 2.
+intros n m.
+assert ({n0 | n0 = S n}).
+exists (S n);reflexivity.
+destruct H as [n0 H1].
+rewrite <- H1;revert H1.
+ functional induction ftest4 n0 m.
+inversion 1.
+inversion 1.
+
+auto with arith.
+auto with arith.
+Qed.
+
+Function ftest44 (x : nat * nat) (n m : nat) : nat :=
+  let (p, q) := (x: nat*nat) in
+  match n with
+  | O => match m with
+         | O => 0
+         | S q => 1
+         end
+  | S p => match m with
+           | O => 0
+           | S r => 1
+           end
+  end.
+
+Lemma test44 :
+ forall (pq : nat * nat) (n m o r s : nat), ftest44 pq n (S m) <= 2.
+intros pq n m o r s.
+ functional induction ftest44 pq n (S m).
+auto with arith.
+auto with arith.
+auto with arith.
+auto with arith.
+Qed.
+
+Function ftest2 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => match m with
+         | O => 0
+         | S q => 0
+         end
+  | S p => ftest2 p m
+  end.
+
+Lemma test2' : forall n m : nat, ftest2 n m <= 2.
+intros n m.
+ functional induction ftest2 n m; simpl; intros; auto.
+Qed.
+
+Function ftest3 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => 0
+  | S p => match m with
+           | O => ftest3 p 0
+           | S r => 0
+           end
+  end.
+
+Lemma test3' : forall n m : nat, ftest3 n m <= 2.
+intros n m.
+ functional induction ftest3 n m.
+intros.
+auto.
+intros.
+auto.
+intros.
+simpl.
+auto.
+Qed.
+
+Function ftest5 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => 0
+  | S p => match m with
+           | O => ftest5 p 0
+           | S r => ftest5 p r
+           end
+  end.
+
+Lemma test5 : forall n m : nat, ftest5 n m <= 2.
+intros n m.
+ functional induction ftest5 n m.
+intros.
+auto.
+intros.
+auto.
+intros.
+simpl.
+auto.
+Qed.
+
+Function ftest7 (n : nat) : nat :=
+  match ftest5 n 0 with
+  | O => 0
+  | S r => 0
+  end.
+
+Lemma essai7 :
+ forall (Hrec : forall n : nat, ftest5 n 0 = 0 -> ftest7 n <= 2)
+   (Hrec0 : forall n r : nat, ftest5 n 0 = S r -> ftest7 n <= 2)
+   (n : nat), ftest7 n <= 2.
+intros hyp1 hyp2 n.
+ functional induction ftest7 n; auto.
+Qed.
+
+Function ftest6 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => 0
+  | S p => match ftest5 p 0 with
+           | O => ftest6 p 0
+           | S r => ftest6 p r
+           end
+  end.
+
+
+Lemma princ6 :
+ (forall n m : nat, n = 0 -> ftest6 0 m <= 2) ->
+ (forall n m p : nat,
+  ftest6 p 0 <= 2 -> ftest5 p 0 = 0 -> n = S p -> ftest6 (S p) m <= 2) ->
+ (forall n m p r : nat,
+  ftest6 p r <= 2 -> ftest5 p 0 = S r -> n = S p -> ftest6 (S p) m <= 2) ->
+ forall x y : nat, ftest6 x y <= 2.
+intros hyp1 hyp2 hyp3 n m.
+generalize hyp1 hyp2 hyp3.
+clear hyp1 hyp2 hyp3.
+ functional induction ftest6 n m; auto.
+Qed.
+
+Lemma essai6 : forall n m : nat, ftest6 n m <= 2.
+intros n m.
+ functional induction ftest6 n m; simpl; auto.
+Qed.
+
+(* Some tests with modules *)
+Module M.
+Function test_m (n:nat) : nat :=
+  match n with
+    | 0 => 0
+    | S n =>  S (S (test_m n))
+  end.
+
+Lemma test_m_is_double :  forall n, div2 (test_m n) = n.
+Proof.
+intros n.
+functional induction (test_m n).
+reflexivity.
+simpl;rewrite IHn0;reflexivity.
+Qed.
+End M.
+(* We redefine a new Function with the same name *)
+Function test_m (n:nat) : nat :=
+  pred n.
+
+Lemma test_m_is_pred : forall n, test_m n = pred n.
+Proof.
+intro n.
+functional induction (test_m n). (* the test_m_ind to use is the last defined  saying that test_m = pred*)
+reflexivity.
+Qed.
+
+(* Checks if the dot notation are correctly treated in infos *)
+Lemma M_test_m_is_double : forall n, div2 (M.test_m n) = n.
+intro n.
+(* here we should apply M.test_m_ind *)
+functional induction (M.test_m n).
+reflexivity.
+simpl;rewrite IHn0;reflexivity.
+Qed.
+
+Import M.
+(* Now test_m is the one which defines double *)
+
+Lemma test_m_is_double : forall n, div2 (M.test_m n) = n.
+intro n.
+(* here we should apply M.test_m_ind *)
+functional induction (test_m n).
+reflexivity.
+simpl;rewrite IHn0;reflexivity.
+Qed.
+
+Extraction iszero.
diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v
index 1abe1477..8d08f597 100644
--- a/test-suite/success/Hints.v
+++ b/test-suite/success/Hints.v
@@ -37,7 +37,6 @@ Hint Resolve predf | 0 : predconv.
 
 Goal exists n, pred n.
   eexists.
-  Fail Timeout 1 typeclasses eauto with pred.
   Set Typeclasses Filtered Unification.
   Set Typeclasses Debug Verbosity 2.
   (* predf is not tried as it doesn't match the goal *)
@@ -80,8 +79,6 @@ Qed.
 (** The other way around: goal contains redexes instead of instances *)
 Goal exists n, pred (0 + n).
   eexists.
-  (* predf is applied indefinitely *)
-  Fail Timeout 1 typeclasses eauto with pred.
   (* pred0 (pred _) matches the goal *)
   typeclasses eauto with predconv.
 Qed.
@@ -169,11 +166,20 @@ Instance foo f :
   E (id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘
      id ∘ id ∘ id ∘ id ∘ id ∘ f ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id).
 Proof.
-  Fail Timeout 1 apply _. (* 3.7s *)
-  
 Hint Cut [_* (a_is_b | b_is_c | c_is_d | d_is_e)
                  (a_compose | b_compose | c_compose | d_compose | e_compose)] : typeclass_instances.
 
   Timeout 1 Fail apply _. (* 0.06s *)
 Abort.
 End HintCut.
+
+
+(* Check that auto-like tactics do not prefer "eq_refl" over more complex solutions, *)
+(* e.g. those tactics when considering a goal with existential varibles *)
+(* like "m = ?n" won't pick "plus_n_O" hint over "eq_refl" hint. *)
+(* See this Coq club post for more detail: *)
+(* https://sympa.inria.fr/sympa/arc/coq-club/2017-12/msg00103.html *)
+
+Goal forall (m : nat), exists n, m = n /\ m = n.
+  intros m; eexists; split; [trivial | reflexivity].
+Qed.
diff --git a/test-suite/success/ImplicitArguments.v b/test-suite/success/ImplicitArguments.v
index f702aa62..921433ca 100644
--- a/test-suite/success/ImplicitArguments.v
+++ b/test-suite/success/ImplicitArguments.v
@@ -21,3 +21,14 @@ Fixpoint app {A : Type} {n m : nat} (v : vector A n) (w : vector A m) : vector A
 (* Test sharing information between different hypotheses *)
 
 Parameters (a:_) (b:a=0).
+
+(* These examples were failing due to a lifting wrongly taking let-in into account *)
+
+Definition foo6 (x:=1) : forall {n:nat}, n=n := fun n => eq_refl.
+
+Fixpoint foo7 (x:=1) (n:nat) {p:nat} {struct n} : nat.
+
+(* Some example which should succeed with local implicit arguments *)
+
+Inductive A {P:forall m {n}, n=m -> Prop} := C : P 0 eq_refl -> A.
+Inductive B (P:forall m {n}, n=m -> Prop) := D : P 0 eq_refl -> B P.
diff --git a/test-suite/success/Inductive.v b/test-suite/success/Inductive.v
index f746def5..5b1482fd 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,26 @@ 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.
+
+(* Test treatment of let-in in the definition of Records *)
+(* Should fail with "Sort expected" *)
+
+Fail Inductive foo (T : Type) : let T := Type in T :=
+  { r : forall x : T, x = x }.
diff --git a/test-suite/success/Injection.v b/test-suite/success/Injection.v
index da218384..78652fb6 100644
--- a/test-suite/success/Injection.v
+++ b/test-suite/success/Injection.v
@@ -150,6 +150,13 @@ match goal with
 end.
 Abort.
 
+(* Injection in the presence of local definitions *)
+Inductive A := B (T := unit) (x y : bool) (z := x).
+Goal forall x y x' y', B x y = B x' y' -> y = y'.
+intros * [= H1 H2].
+exact H2.
+Qed.
+
 (* Injection does not project at positions in Prop... allow it?
 
 Inductive t (A:Prop) : Set := c : A -> t A.
diff --git a/test-suite/success/Inversion.v b/test-suite/success/Inversion.v
index 850f0943..45c71615 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/InversionSigma.v b/test-suite/success/InversionSigma.v
new file mode 100644
index 00000000..51f33c7c
--- /dev/null
+++ b/test-suite/success/InversionSigma.v
@@ -0,0 +1,40 @@
+Section inversion_sigma.
+  Local Unset Implicit Arguments.
+  Context A (B : A -> Prop) (C C' : forall a, B a -> Prop)
+          (D : forall a b, C a b -> Prop) (E : forall a b c, D a b c -> Prop).
+
+  (* Require that, after destructing sigma types and inverting
+     equalities, we can subst equalities of variables only, and reduce
+     down to [eq_refl = eq_refl]. *)
+  Local Ltac test_inversion_sigma :=
+    intros;
+    repeat match goal with
+           | [ H : sig _ |- _ ] => destruct H
+           | [ H : sigT _ |- _ ] => destruct H
+           | [ H : sig2 _ _ |- _ ] => destruct H
+           | [ H : sigT2 _ _ |- _ ] => destruct H
+           end; simpl in *;
+    inversion_sigma;
+    repeat match goal with
+           | [ H : ?x = ?y |- _ ] => is_var x; is_var y; subst x; simpl in *
+           end;
+    match goal with
+    | [ |- eq_refl = eq_refl ] => reflexivity
+    end.
+
+  Goal forall (x y : { a : A & { b : { b : B a & C a b } & { d : D a (projT1 b) (projT2 b) & E _ _ _ d } } })
+              (p : x = y), p = p.
+  Proof. test_inversion_sigma. Qed.
+
+  Goal forall (x y : { a : A | { b : { b : B a | C a b } | { d : D a (proj1_sig b) (proj2_sig b) | E _ _ _ d } } })
+              (p : x = y), p = p.
+  Proof. test_inversion_sigma. Qed.
+
+  Goal forall (x y : { a : { a : A & B a } & C _ (projT2 a) & C' _ (projT2 a) })
+              (p : x = y), p = p.
+  Proof. test_inversion_sigma. Qed.
+
+  Goal forall (x y : { a : { a : A & B a } | C _ (projT2 a) & C' _ (projT2 a) })
+              (p : x = y), p = p.
+  Proof. test_inversion_sigma. Qed.
+End inversion_sigma.
diff --git a/test-suite/success/Mod_type.v b/test-suite/success/Mod_type.v
index d5e1a38c..6c59bf6e 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 07bbb60c..3c0ad207 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
@@ -121,6 +121,7 @@ Notation " |- {{ a }} b" := (a=b) (no associativity, at level 10).
 Goal True.
 {{ exact I. }}
 Qed.
+
 Check |- {{ 0 }} 0.
 
 (* Check parsing of { and } is not affected by notations #3479 *)
@@ -128,3 +129,27 @@ Notation " |- {{ a }} b" := (a=b) (no associativity, at level 10).
 Goal True.
 {{ exact I. }}
 Qed.
+
+(* Check that we can have notations without any symbol iff they are "only printing". *)
+Fail Notation "" := (@nil).
+Notation "" := (@nil) (only printing).
+
+(* Check that a notation cannot be neither parsing nor printing. *)
+Fail Notation "'foobarkeyword'" := (@nil) (only parsing, only printing).
+
+(* Check "where" clause for inductive types with parameters *)
+
+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 9505a56e..7c2cf3ee 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/NumberScopes.v b/test-suite/success/NumberScopes.v
index 6d787210..15586374 100644
--- a/test-suite/success/NumberScopes.v
+++ b/test-suite/success/NumberScopes.v
@@ -39,24 +39,3 @@ Definition f_nat (x:nat) := x.
 Definition f_nat' (x:Nat.t) := x.
 Check (f_nat 1).
 Check (f_nat' 1).
-
-Require Import BigN.
-Check (BigN.add 1 2).
-Check (BigN.add_comm 1 2).
-Check (BigN.min_comm 1 2).
-Definition f_bigN (x:bigN) := x.
-Check (f_bigN 1).
-
-Require Import BigZ.
-Check (BigZ.add 1 2).
-Check (BigZ.add_comm 1 2).
-Check (BigZ.min_comm 1 2).
-Definition f_bigZ (x:bigZ) := x.
-Check (f_bigZ 1).
-
-Require Import BigQ.
-Check (BigQ.add 1 2).
-Check (BigQ.add_comm 1 2).
-Check (BigQ.min_comm 1 2).
-Definition f_bigQ (x:bigQ) := x.
-Check (f_bigQ 1).
\ No newline at end of file
diff --git a/test-suite/success/Omega.v b/test-suite/success/Omega.v
index ecbf04e4..470e4f05 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 b8f8660e..6fd93693 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 c4d086a3..4e726335 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 681c4716..85d7a770 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 801ece9e..0df3d568 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 1348bb62..3ddf6a40 100644
--- a/test-suite/success/ROmega0.v
+++ b/test-suite/success/ROmega0.v
@@ -132,21 +132,37 @@ 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.
 intros.
 romega.
 Qed.
 
 Lemma test_romega_8b : forall x y:Z, x*x<y*y-> ~ y*y <= x*x.
+Proof.
 intros x y.
 romega.
 Qed.
 
-(* Besson #1298 *)
+(* Besson BZ#1298 *)
 
 Lemma test_romega9 : forall z z':Z, z<>z' -> z'=z -> False.
+Proof.
 intros.
 romega.
 Qed.
+
+(* Letouzey, May 2017 *)
+
+Lemma test_romega10 : forall x a a' b b',
+ a' <= b ->
+ a <= b' ->
+ b < b' ->
+ a < a' ->
+ a <= x < b' <-> a <= x < b \/ a' <= x < b'.
+Proof.
+ intros.
+ romega.
+Qed.
diff --git a/test-suite/success/ROmega2.v b/test-suite/success/ROmega2.v
index 87e8c8e3..43eda67e 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/ROmega3.v b/test-suite/success/ROmega3.v
new file mode 100644
index 00000000..fd4ff260
--- /dev/null
+++ b/test-suite/success/ROmega3.v
@@ -0,0 +1,31 @@
+
+Require Import ZArith ROmega.
+Local Open Scope Z_scope.
+
+(** Benchmark provided by Chantal Keller, that romega used to
+    solve far too slowly (compared to omega or lia). *)
+
+Parameter v4 : Z.
+Parameter v3 : Z.
+Parameter o4 : Z.
+Parameter s5 : Z.
+Parameter v2 : Z.
+Parameter o5 : Z.
+Parameter s6 : Z.
+Parameter v1 : Z.
+Parameter o6 : Z.
+Parameter s7 : Z.
+Parameter v0 : Z.
+Parameter o7 : Z.
+
+Lemma lemma_5833 :
+ ~ 16 * v4 + (8 * v3 + (-8192 * o4 + (-4096 * s5 + (4 * v2 +
+      (-4096 * o5 + (-2048 * s6 + (2 * v1 + (-2048 * o6 +
+         (-1024 * s7 + (v0 + -1024 * o7)))))))))) >= 8192
+\/
+  16 * v4 + (8 * v3 + (-8192 * o4 + (-4096 * s5 + (4 * v2 +
+      (-4096 * o5 + (-2048 * s6 + (2 * v1 + (-2048 * o6 +
+         (-1024 * s7 + (v0 + -1024 * o7)))))))))) >= 1024.
+Proof.
+Timeout 1 romega. (* should take a few milliseconds, not seconds *)
+Timeout 1 Qed. (* ditto *)
diff --git a/test-suite/success/ROmega4.v b/test-suite/success/ROmega4.v
new file mode 100644
index 00000000..58ae5b8f
--- /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/RecTutorial.v b/test-suite/success/RecTutorial.v
index d8f80424..84194049 100644
--- a/test-suite/success/RecTutorial.v
+++ b/test-suite/success/RecTutorial.v
@@ -147,6 +147,7 @@ Proof.
  intros; absurd (p < p); eauto with arith.
 Qed.
 
+Require Coq.extraction.Extraction.
 Extraction max.
 
 
diff --git a/test-suite/success/Record.v b/test-suite/success/Record.v
index 8334322c..6f27c1d3 100644
--- a/test-suite/success/Record.v
+++ b/test-suite/success/Record.v
@@ -87,3 +87,8 @@ Record R : Type := {
   P (A : Type) : Prop := exists x : A -> A, x = x;
   Q A : P A -> P A
 }.
+
+(* We allow reusing an implicit parameter named in non-recursive types *)
+(* This is used in a couple of development such as UniMatch *)
+
+Record S {A:Type} := { a : A; b : forall A:Type, A }.
diff --git a/test-suite/success/Rename.v b/test-suite/success/Rename.v
index 0576f3c6..2789c6c9 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/Scheme.v b/test-suite/success/Scheme.v
index dd5aa81d..855f2669 100644
--- a/test-suite/success/Scheme.v
+++ b/test-suite/success/Scheme.v
@@ -2,3 +2,26 @@
 
 Scheme Induction for eq Sort Prop.
 Check eq_ind_dep.
+
+(* This was broken in v8.5 *)
+
+Set Rewriting Schemes.
+Inductive myeq A (a:A) : A -> Prop := myrefl : myeq A a a.
+Unset Rewriting Schemes.
+
+Check myeq_rect.
+Check myeq_ind.
+Check myeq_rec.
+Check myeq_congr.
+Check myeq_sym_internal.
+Check myeq_rew.
+Check myeq_rew_dep.
+Check myeq_rew_fwd_dep.
+Check myeq_rew_r.
+Check internal_myeq_sym_involutive.
+Check myeq_rew_r_dep.
+Check myeq_rew_fwd_r_dep.
+
+Set Rewriting Schemes.
+Inductive myeq_true : bool -> Prop := myrefl_true : myeq_true true.
+Unset Rewriting Schemes.
diff --git a/test-suite/success/Scopes.v b/test-suite/success/Scopes.v
index 43e3493c..ca374671 100644
--- a/test-suite/success/Scopes.v
+++ b/test-suite/success/Scopes.v
@@ -20,3 +20,9 @@ Inductive U := A.
 Bind Scope u with U.
 Notation "'ε'" := A : u.
 Definition c := ε : U.
+
+(* Check activation of type scope for tactics such as assert *)
+
+Goal True.
+assert (nat * nat).
+
diff --git a/test-suite/success/ShowExtraction.v b/test-suite/success/ShowExtraction.v
new file mode 100644
index 00000000..a4a35003
--- /dev/null
+++ b/test-suite/success/ShowExtraction.v
@@ -0,0 +1,31 @@
+
+Require Extraction.
+Require Import List.
+
+Section Test.
+Variable A : Type.
+Variable decA : forall (x y:A), {x=y}+{x<>y}.
+
+(** Should fail when no proofs are started *)
+Fail Show Extraction.
+
+Lemma decListA : forall (xs ys : list A), {xs=ys}+{xs<>ys}.
+Proof.
+Show Extraction.
+fix decListA 1.
+destruct xs as [|x xs], ys as [|y ys].
+Show Extraction.
+- now left.
+- now right.
+- now right.
+- Show Extraction.
+  destruct (decA x y).
+  + destruct (decListA xs ys).
+    * left; now f_equal.
+    * Show Extraction.
+      right. congruence.
+  + right. congruence.
+Show Extraction.
+Defined.
+
+End Test.
diff --git a/test-suite/success/Tauto.v b/test-suite/success/Tauto.v
index 767f15be..7d01d3b0 100644
--- a/test-suite/success/Tauto.v
+++ b/test-suite/success/Tauto.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (**** Tactics Tauto and Intuition ****)
diff --git a/test-suite/success/TestRefine.v b/test-suite/success/TestRefine.v
index 023cb5f5..f1683078 100644
--- a/test-suite/success/TestRefine.v
+++ b/test-suite/success/TestRefine.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/test-suite/success/Try.v b/test-suite/success/Try.v
index 361c787e..76aac39a 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 6b1f0315..cd6eac35 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_chain.v b/test-suite/success/abstract_chain.v
new file mode 100644
index 00000000..0ff61e87
--- /dev/null
+++ b/test-suite/success/abstract_chain.v
@@ -0,0 +1,43 @@
+Lemma foo1 : nat -> True.
+Proof.
+intros _.
+assert (H : True -> True).
+{ abstract (exact (fun x => x)) using bar. }
+assert (H' : True).
+{ abstract (exact (bar I)) using qux. }
+exact H'.
+Qed.
+
+Lemma foo2 : True.
+Proof.
+assert (H : True -> True).
+{ abstract (exact (fun x => x)) using bar. }
+assert (H' : True).
+{ abstract (exact (bar I)) using qux. }
+assert (H'' : True).
+{ abstract (exact (bar qux)) using quz. }
+exact H''.
+Qed.
+
+Set Universe Polymorphism.
+
+Lemma foo3 : nat -> True.
+Proof.
+intros _.
+assert (H : True -> True).
+{ abstract (exact (fun x => x)) using bar. }
+assert (H' : True).
+{ abstract (exact (bar I)) using qux. }
+exact H'.
+Qed.
+
+Lemma foo4 : True.
+Proof.
+assert (H : True -> True).
+{ abstract (exact (fun x => x)) using bar. }
+assert (H' : True).
+{ abstract (exact (bar I)) using qux. }
+assert (H'' : True).
+{ abstract (exact (bar qux)) using quz. }
+exact H''.
+Qed.
diff --git a/test-suite/success/abstract_poly.v b/test-suite/success/abstract_poly.v
new file mode 100644
index 00000000..aa8da533
--- /dev/null
+++ b/test-suite/success/abstract_poly.v
@@ -0,0 +1,20 @@
+Set Universe Polymorphism.
+
+Inductive path@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := refl : path x x.
+Inductive unit@{i} : Type@{i} := tt.
+
+Lemma foo@{i j} : forall (m n : unit@{i}) (P : unit -> Type@{j}), path m n -> P m -> P n.
+Proof.
+intros m n P e p.
+abstract (rewrite e in p; exact p).
+Defined.
+
+Check foo_subproof@{Set Set}.
+
+Lemma bar : forall (m n : unit) (P : unit -> Type), path m n -> P m -> P n.
+Proof.
+intros m n P e p.
+abstract (rewrite e in p; exact p).
+Defined.
+
+Check bar_subproof@{Set Set}.
diff --git a/test-suite/success/all-check.v b/test-suite/success/all-check.v
new file mode 100644
index 00000000..391bc540
--- /dev/null
+++ b/test-suite/success/all-check.v
@@ -0,0 +1,3 @@
+Goal True.
+Fail all:Check _.
+Abort.
diff --git a/test-suite/success/bigQ.v b/test-suite/success/bigQ.v
deleted file mode 100644
index 7fd0cf66..00000000
--- a/test-suite/success/bigQ.v
+++ /dev/null
@@ -1,66 +0,0 @@
-Require Import BigQ.
-Import List.
-
-Definition pi_4_approx_low' := 
-(5066193963420194617885108698600649932059391557720145469382602092416947640628637390992675949693715109726079394291478795603894419483819297806310615866892414925850691415582239745615128821983865262221858109336884967754871321668348027076234335167119885298878199925731495390387858629042311908406056230882123787019283378509712244687397013657159455607193734144010901984756727174636853404278421831024545476850410085042498464474261035780891759930905778986584183710930670670301831474144997069400304290351567959717683444430666444319233768399342338059169002790777424962570605618705584660815518973602995097110557181643034682308210782171804373210646804613922337450953858508244032293753591878060539465788294318856859293281629951093130167801471787011911886414492513677892193100809508943832528344473873460853362957387889412799458784754514139679847887887544849825173792522272708046699681079289358082661375778523609867456540595586031625044964543428047238934233579184772793670436643502740076366994465457847106782560289782615794595755672643440040123002018908935362541166831619056664637901929131328502017686713274283777724453661234225382109584471950444925886358166551424008707439387934109226545596919797083495958300914344992836193126080289565652575543234385558967555959267746932292860747199382633363026440008828134867747920263181610216905129926037611247017868033961426567047355301676870662406173724238530061264149506666345040372864118731705584795947926329181826992456072045382170981478151356381437136818835196834068650217794381425547036331194595892801393225038235274901050364737353586927051766717037643833477566087835266968086513005761986678747515870298138062157791066648217784877968385924845017637219384732843791052551854695220023477365706464590594542001161575677402761543188277502092362285265847964496740584911576627239093631932307473445797386335961743298553548881544486940399236133577915988716682746485564575640818803540680574730591500432326858763829791848612343662539095316357052823005419355719381626599487868023399182174939253393897549026675976384326749445831606130546375395770778462506203752920470130305293966478109733954117063941901686840180727195741528561335809865193566993349413786715403053579411364371500063193205131503024022217701373077790337150298315820556080596579100618643147698304927957576213733526923182742441048553793831725592624850721293495085399785588171300815789795594858916409701139277050529011775828846362873246196866089783324522718656445008090114701320562608474099248873638488023114015981013142490827777895317580810590743940417298263300561876701828404744082864248409230009391001735746615476377303707782123483770118391136826609366946585715225248587168403619476143657107412319421501162805102723455593551478028055839072686207007765300258935153546418515706362733656094770289090398825190320430416955807878686642673124733998295439657633866090085982598765253268688814792672416195730086607425842181518560588819896560847103627615434844684536463752986969865794019299978956052589825441828842338163389851892617560591840546654410705167593310272272965900821031821380595084783691324416454359888103920904935692840264474003367023256964191100139001239923263691779167792867186165635514824889759796850863175082506408142175595463676408992027105356481220754473245821534527625758942093801142305560662681150069082553674495761075895588095760081401141419460482860852822686860785424514171214889677926763812031823537071721974799922995763666175738785000806081164280471363125324839717808977470218218571800106898347366938927189989988149888641129263448064762730769285877330997355234347773807099829665997515649429224335217107760728789764718885665291038706425454675746218345291274054088843647602239258308472486102933167465443294268551209015027897159307743987020521392788721231001835675584104894174434637260464035122611721657641428625505184886116917149318963070896162119215386541876236027342810162765609201440423207771441367926085768438143507025739041041240810056881304230519058117534418374553879198061289605354335880794397478047346975609179199801003098836622253165101961484972165230151495472006888128587168049198312469715081555662345452800468933420359802645393289853553618279788400476187713990872203669487294118461245455333004125835663010526985716431187034663870796866708678078952110615910196519835267441831874676895301527286826106517027821074816850326548617513767142627360001181210946100011774672126943957522004190414960909074050454565964857276407084991922274068961845339154089866785707764290964299529444616711194034827611771558783466230353209661849406004241580029437779784290315347968833708422223285859451369907260780956405036020581705441364379616715041818815829810906212826084485200785283123265202151252852134381195424724503189247411069117189489985791487434549080447866370484866697404176437230771558469231403088139693477706784802801265075586678597768511791952562627345622499328
-        # 100788726492580594349650258277496659410917619472657560321971265983799894639441017438166498752997098978003489632843381325240982516059309714013145358125224597827602157516585886911710102182473475545864474089191789296685473601331678556438310133356793199956062857423397512495293688453655805536015029176541424005214818033707522950635262669828538132795615008381824067071229426026518897202246241637377064076189277685257166926338187911595052586669184297526234794666364657344206795357967279911782849686515024121916258300642000317525374433525235296287037535618423661645124459323811792936193272341688261801253469089129439519903538495370298752436267926761998785090092411372633429302950606054074205533246665546979112178855223925266166034953000200646676762301817000435641690517142795144469005596172113586738287118865058604922865654348297975054956781513943444060257230946224520058527667925776273088622386666860662470481606622952298649177217986593047495967209669116410592230626047083795555559776477430548946990993890380787911273437967786556742804566652408275798339221179283430482118140020742719695900657696142739101628984271513292954605191778803974738871043737934546460016184719168074062912083778327025499841998124431899131874519812228674255796948879306477894924710085384116453080236862135706628989104070747737689294987000148388110561753028594988959655591699155508380909698460304884908709246116411180876105681720036833487450945730831039969246996849503525429840196651386469599438064049723005123629385485140945945416764414133189625489032807860400751723995946290581976152580477047961138617997133510128194027510895265424780627975864980749945631413855375897945293107842908479797077570371447220506451229526132919408351287454305932886749170523056147842439813407002950370505941417426433452282518739345666494683448699945734453214481915512562995906034771246088038719298959180199052759295868161570318718927430655393250250811804905393113074074574608255523847592006804881016594060188745212933427473833239777228852952217878690668413947367586040297784502192683200664398064682201012931468052982448022330449955215606614483165425935154496289535573901139223034819824408001205784146243892228030383941863746839845526558421740316887532141893650230936137269356278754487130882868595412163277284772124736531380334814212708066069618080153747333573454834500999083737284449542481264971030785043701582134343596645346132964567391370300568578875509971483039720438955919863275044932311289587494336123538202079503922025306586828117649623642521324286648529829664567232756108169459356549144779085080036654897525078792273443307070502103724611233768453196294899770515940520895908289018412144327894912660060761908970811602375085884115384049610753387776858733798341463052471017393165656926510611173543365663267563198760597092606598728110197523695339144204179424646442294307593146446562536865057987897899655645968129515654148044008249646703504419478535298270862753806142083172190778193001810574370442181909146645889199829207284871551220439225371051511970054965951914399901815408791418836185742573331879114400013259342896515702942707292473805188905427717363630137869116872433627556880809120353079342030725196065815470427569172350436988386579444534375353968759750750178342190349607711313840613843718547859929387259163285524671855725511880656411741012446023392964655239624520090988149679656514996202498334816938716757663800773997302639681907686195671083505910700098597156238624351157219093280177066146218516478636356056420098245995113668018177690728654922707281126889313941750547830163078886329630807850633273613622550216189245162735650139455042125252043274668279981753287687674520319519360593091620297805736177366738063651905396783336064579717230286821545930579779462534206093794040878198825916141099864730374109311705285661056855668930671948265232862757146615431791375559792290479316263924560826544387396762768331402198937951439504767950821089741987629257538953417586416459087855138539304027013800937360598578194413362672871055543854633921502486683911956250444582746421552178164852341035733290405311280719066037175324627429434912416361334254696649419037348733709488576582107382055914938194078813926926742828297826939120316120573453588052056773875836843924877773978390546387248009519202370375478981843515393806263037580338009594022254079586380520797699651840576286033587273591899639699077044271208886940540056794360292760863657703246410020854088849880453524038877935317875884698324859548991680533307680053872403383516589028793015681082435908524045497475001609824047204954932626536311826911363867426654549346914317405110707189532251727848751560224936842128628673253616256326013555922159336370177663785738170802777550686079119049748734352584409583136667752555307842739679930698964098088960000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)%bigQ
-.
-
-Definition pi_4_approx_high' := 
-(5066193963420194617885108698600649932059391557720145469382602092416947640628637390992675949693715109726079394291478795603894419483819297806310615866892414925850691415582239745615128821983865262221858109336884967754871321668348027076234335167119885298878199925731495390387858629042311908406056230882123787019283378509712244687397013657159455607193734144010901984756727174636853404278421831024545476850410085042498464474261035780891759930905778986584183710930670670301831474144997069400304290351567959717683444430666444319233768399342338059169002790777424962570605618705584660815518973602995097110557181643034682308210788409308322071457087096445676662503017187903223859814905546579050729173916234740628466315449085686468204847296426235788544874405450791749423436215032927889914519102361378633666267941326393265376660400091389373564825046526561381561278586121772300141564909333667988204680492088607706214346458601842899721615765319505314310192693665547163360402786722105590252780194994950097926184146718893770363322073641336811404180286358079915338791029818581497746089864894356686643882883410392601500048021013346713450539807687779704798018559373507951388092945938366448668853081682176581336156031434604604833692503597621519809826880683536141897075567053733515342478008373282599947520770191238802249392773327261328133194484586433840861730959791563023761306622956165536481335792721379318928171897265310054788931201902441066997927781894934061720760080768154565282051604447333036111267534150649674590201404453202347064545359869105856798745664471694795576801148562495225166002814304124970965817043547048503388910163287916513427409193998045119986267987892522931703487420953769290650229176116308194977201080691718825944370436642709192983358059711255925052564016519597530235976618244111239816418652282585432539731271068892992142956810775762851238126881225206289553948196520384709574383566733478326330112084307565420647201107231840508040019131253750047046446929758911912155202166566751947087545292626353331520202690130850009389387290465497377022080531269511355734944672010542204118978272180881335465227900174033380001851066811103401787656367819132934758616060307366679580043123632565656840669377840733018248707250548277181001911990237151790533341326223932843775840498222236867608395855700891719880219904948672458645420169533565809609056209006342663841718949396996175294237942265325043426430990062217643279654512512640557763489491751115437780462208361129433667449740743123546232162409802316714286708788831227582498585478334315076725145986771341647015244092760289407649044493584479944044779273447198382196766547779885914425854375158084417582279211000449529495605127376707776277159376010648950025135061284601443461110447113346277147728593420397807946636800365109579479211273476195727270004743568492888900356505584731622538401071221591141889158461271000051210318027818802379539544396973228585821742794928813630781709195703717312953337431290682263448669168179857644544116657440168099166467471736180072984407514757289757495435699300593165669101965987430482600019222913485092771346963058673132443387835726110205958057187517487684058179749952286341120230051432903482992282688283815697442898155194928723360957436110770317998431272108100149791425689283090777721270428030993332057319821685391144252815655146410678839177846108260765981523812232294638190350688210999605869296307711846463311346627138400477211801219366400312514793356564308532012682051019030257269068628100171220662165246389309014292764479226570049772046255291379151017129899157296574099437276707879597755725339406865738613810979022640265737120949077721294633786520294559343155148383011293584240192753971366644780434237846862975993387453786681995831719537733846579480995517357440575781962659282856696638992709756358478461648462532279323701121386551383509193782388241965285971965887701816406255233933761008649762854363984142178331798953040874526844255758512982810004271235810681505829473926495256537353108899526434200682024946218302499640511518360332022463196599199779172637638655415918976955930735312156870786600023896830267884391447789311101069654521354446521135407720085038662159974712373018912537116964809382149581004863115431780452188813210275393919111435118030412595133958954313836191108258769640843644195537185904547405641078708492098917460393911427237155683288565433183738513871595286090814836422982384810033331519971102974091067660369548406192526284519976668985518575216481570167748402860759832933071281814538397923687510782620605409323050353840034866296214149657376249634795555007199540807313397329050410326609108411299737760271566308288500400587417017113933243099961248847368789383209110747378488312550109911605079801570534271874115018095746872468910162721975463388518648962869080447866370484866697404176437230771558469231403088139693477706784802801265075586678597768511791952562627345622499328
-        # 100788726492580594349650258277496659410917619472657560321971265983799894639441017438166498752997098978003489632843381325240982516059309714013145358125224597827602157516585886911710102182473475545864474089191789296685473601331678556438310133356793199956062857423397512495293688453655805536015029176541424005214818033707522950635262669828538132795615008381824067071229426026518897202246241637377064076189277685257166926338187911595052586669184297526234794666364657344206795357967279911782849686515024121916258300642000317525374433525235296287037535618423661645124459323811792936193272341688261801253469089129439519903538495370298752436267926761998785090092411372633429302950606054074205533246665546979112178855223925266166034953000200646676762301817000435641690517142795144469005596172113586738287118865058604922865654348297975054956781513943444060257230946224520058527667925776273088622386666860662470481606622952298649177217986593047495967209669116410592230626047083795555559776477430548946990993890380787911273437967786556742804566652408275798339221179283430482118140020742719695900657696142739101628984271513292954605191778803974738871043737934546460016184719168074062912083778327025499841998124431899131874519812228674255796948879306477894924710085384116453080236862135706628989104070747737689294987000148388110561753028594988959655591699155508380909698460304884908709246116411180876105681720036833487450945730831039969246996849503525429840196651386469599438064049723005123629385485140945945416764414133189625489032807860400751723995946290581976152580477047961138617997133510128194027510895265424780627975864980749945631413855375897945293107842908479797077570371447220506451229526132919408351287454305932886749170523056147842439813407002950370505941417426433452282518739345666494683448699945734453214481915512562995906034771246088038719298959180199052759295868161570318718927430655393250250811804905393113074074574608255523847592006804881016594060188745212933427473833239777228852952217878690668413947367586040297784502192683200664398064682201012931468052982448022330449955215606614483165425935154496289535573901139223034819824408001205784146243892228030383941863746839845526558421740316887532141893650230936137269356278754487130882868595412163277284772124736531380334814212708066069618080153747333573454834500999083737284449542481264971030785043701582134343596645346132964567391370300568578875509971483039720438955919863275044932311289587494336123538202079503922025306586828117649623642521324286648529829664567232756108169459356549144779085080036654897525078792273443307070502103724611233768453196294899770515940520895908289018412144327894912660060761908970811602375085884115384049610753387776858733798341463052471017393165656926510611173543365663267563198760597092606598728110197523695339144204179424646442294307593146446562536865057987897899655645968129515654148044008249646703504419478535298270862753806142083172190778193001810574370442181909146645889199829207284871551220439225371051511970054965951914399901815408791418836185742573331879114400013259342896515702942707292473805188905427717363630137869116872433627556880809120353079342030725196065815470427569172350436988386579444534375353968759750750178342190349607711313840613843718547859929387259163285524671855725511880656411741012446023392964655239624520090988149679656514996202498334816938716757663800773997302639681907686195671083505910700098597156238624351157219093280177066146218516478636356056420098245995113668018177690728654922707281126889313941750547830163078886329630807850633273613622550216189245162735650139455042125252043274668279981753287687674520319519360593091620297805736177366738063651905396783336064579717230286821545930579779462534206093794040878198825916141099864730374109311705285661056855668930671948265232862757146615431791375559792290479316263924560826544387396762768331402198937951439504767950821089741987629257538953417586416459087855138539304027013800937360598578194413362672871055543854633921502486683911956250444582746421552178164852341035733290405311280719066037175324627429434912416361334254696649419037348733709488576582107382055914938194078813926926742828297826939120316120573453588052056773875836843924877773978390546387248009519202370375478981843515393806263037580338009594022254079586380520797699651840576286033587273591899639699077044271208886940540056794360292760863657703246410020854088849880453524038877935317875884698324859548991680533307680053872403383516589028793015681082435908524045497475001609824047204954932626536311826911363867426654549346914317405110707189532251727848751560224936842128628673253616256326013555922159336370177663785738170802777550686079119049748734352584409583136667752555307842739679930698964098088960000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)%bigQ
-.
-
-Fixpoint numden_Rcontfrac_tailrecB (accu: list bigZ) (n1 d1: bigZ) (n2 d2: bigZ) (fuel: nat) {struct fuel}:
-  (list bigZ * bigQ * bigQ) :=
-  let default := (rev_append accu nil, BigQ.div (BigQ.Qz n1) (BigQ.Qz d1), BigQ.div (BigQ.Qz n2) (BigQ.Qz d2)) in
-  match fuel with
-  | O => default
-  | S fuel' =>
-    let '(q1, r1) := BigZ.div_eucl n1 d1 in
-    let '(q2, r2) := BigZ.div_eucl n2 d2 in
-    match BigZ.eqb q1 q2 with
-    | false => default
-    | true =>
-      let r1_is_zero := BigZ.eqb r1 0 in
-      let r2_is_zero := BigZ.eqb r2 0 in
-      match Bool.eqb r1_is_zero r2_is_zero with
-      | false => default
-      | true =>
-        match r1_is_zero with
-          | true =>
-            match BigZ.eqb q1 1 with
-              | true => (rev_append accu nil, 1%bigQ, 1%bigQ)
-              | false => (rev_append ((q1 - 1)%bigZ :: accu) nil, 1%bigQ, 1%bigQ)
-            end
-          | false => numden_Rcontfrac_tailrecB (q1 :: accu) d1 r1 d2 r2 fuel'
-        end
-      end
-    end
-  end.
-
-Definition Bnum b :=
-  match b with
-  | BigQ.Qz t => t
-  | BigQ.Qq n d =>
-    if (d =? BigN.zero)%bigN then 0%bigZ else n
-  end.
-
-Definition Bden b :=
-  match b with
-  | BigQ.Qz _ => 1%bigN
-  | BigQ.Qq _ d => if (d =? BigN.zero)%bigN then 1%bigN else d 
-  end.
-
-Definition rat_Rcontfrac_tailrecB q1 q2 :=
-  numden_Rcontfrac_tailrecB nil (Bnum q1) (BigZ.Pos (Bden q1)) (Bnum q2) (BigZ.Pos (Bden q2)).
-
-Definition pi_4_contfrac :=
-  rat_Rcontfrac_tailrecB pi_4_approx_low' pi_4_approx_high' 3000.
-
-(* The following used to fail because of a non canonical representation of 0 in
-the bytecode interpreter. Bug reported privately by Tahina Ramananandro. *)
-Goal pi_4_contfrac = pi_4_contfrac.
-vm_compute.
-reflexivity.
-Qed.
diff --git a/test-suite/success/boundvars.v b/test-suite/success/boundvars.v
new file mode 100644
index 00000000..fafe2729
--- /dev/null
+++ b/test-suite/success/boundvars.v
@@ -0,0 +1,14 @@
+(* An example showing a bug in the detection of free variables *)
+(* "x" is not free in the common type of "x" and "y" *)
+
+Check forall (x z:unit) (x y : match z as x return x=x with tt => eq_refl end = eq_refl), x=x.
+
+(* An example showing a bug in the detection of bound variables *)
+
+Goal forall x, match x return x = x with 0 => eq_refl | _ => eq_refl end = eq_refl.
+intro.
+match goal with
+|- (match x as y in nat return y = y with O => _ | S n => _ end) = _ => assert (forall y, y = 0) end.
+intro.
+Check x0. (* Check that "y" has been bound to "x0" while matching "match x as x0 return x0=x0 with ... end" *)
+Abort.
diff --git a/test-suite/success/bteauto.v b/test-suite/success/bteauto.v
index 3178c6fc..730b367d 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
new file mode 100644
index 00000000..c98689c2
--- /dev/null
+++ b/test-suite/success/cbn.v
@@ -0,0 +1,18 @@
+(* cbn is able to refold mutual recursive calls *)
+
+Fixpoint foo (n : nat) :=
+  match n with
+  | 0 => true
+  | S n => g n
+  end
+with g (n : nat) : bool :=
+  match n with
+  | 0 => true
+  | S n => foo n
+  end.
+Goal forall n, foo (S n) = g n.
+  intros. cbn.
+  match goal with
+    |- g _ = g _ => reflexivity
+  end.
+Qed.
diff --git a/test-suite/success/cc.v b/test-suite/success/cc.v
index bbfe5ec4..49a8b9cf 100644
--- a/test-suite/success/cc.v
+++ b/test-suite/success/cc.v
@@ -151,3 +151,17 @@ Section JLeivant.
     congruence.
   Qed.
 End JLeivant.
+
+(* An example with primitive projections *)
+
+Module PrimitiveProjections.
+Set Primitive Projections.
+Record t (A:Type) := { f : A }.
+Goal forall g (a:t nat), @f nat = g -> f a = 0 -> g a = 0.
+congruence.
+Undo.
+intros.
+unfold f in H0. (* internally turn the projection to unfolded form *)
+congruence.
+Qed.
+End PrimitiveProjections.
diff --git a/test-suite/success/change.v b/test-suite/success/change.v
index 1f0b7d38..a9821b02 100644
--- a/test-suite/success/change.v
+++ b/test-suite/success/change.v
@@ -59,3 +59,12 @@ unfold x.
 (* check that n in 0+n is not interpreted as the n from "fun n" *)
 change n with (0+n).
 Abort.
+
+(* Check non-collision of non-normalized defined evars with pattern variables *)
+
+Goal exists x, 1=1 -> x=1/\x=1.
+eexists ?[n]; intros; split.
+eassumption.
+match goal with |- ?x=1 => change (x=1) with (0+x=1) end.
+match goal with |- 0+1=1 => trivial end.
+Qed.
diff --git a/test-suite/success/change_pattern.v b/test-suite/success/change_pattern.v
new file mode 100644
index 00000000..874abf49
--- /dev/null
+++ b/test-suite/success/change_pattern.v
@@ -0,0 +1,34 @@
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Axiom vector : Type -> nat -> Type.
+
+Record KleeneStore i j a := kleeneStore
+ { dim : nat
+ ; peek : vector j dim -> a
+ ; pos : vector i dim
+ }.
+
+Definition KSmap i j a b (f : a -> b) (s : KleeneStore i j a) : KleeneStore i j b :=
+  kleeneStore (fun v => f (peek v)) (pos s).
+
+Record KleeneCoalg (i o : Type -> Type) := kleeneCoalg
+  { coalg :> forall a b, (o a) -> KleeneStore (i a) (i b) (o b) }.
+
+Axiom free_b_dim : forall i o (k : KleeneCoalg i o) a b b' (x : o a), dim (coalg k b x) = dim (coalg k b' x).
+Axiom t : Type -> Type.
+Axiom traverse : KleeneCoalg (fun x => x) t.
+
+Definition size a (x:t a) : nat := dim (traverse a a x).
+
+Lemma iso1_iso2_2 a (y : {x : t unit & vector a (size x)}) : False.
+Proof.
+destruct y.
+pose (X := KSmap (traverse a unit) (traverse unit a x)).
+set (e :=(eq_sym (free_b_dim traverse (a:=unit) a unit x))).
+clearbody e.
+(** The pattern generated by change must have holes where there were implicit
+    arguments in the original user-provided term. This particular example fails
+    if this is not the case because the inferred argument does not coincide with
+    the one in the considered term. *)
+progress (change (dim (traverse unit a x)) with (dim X) in e).
diff --git a/test-suite/success/clear.v b/test-suite/success/clear.v
index e25510cf..03034cf1 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 b538d2ed..9389c9d3 100644
--- a/test-suite/success/coercions.v
+++ b/test-suite/success/coercions.v
@@ -130,4 +130,59 @@ 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
+End what_we_could_do.
+
+
+(** Unit test for Prop as source class *)
+
+Module TestPropAsSourceCoercion.
+
+  Parameter heap : Prop.
+
+  Parameter heap_empty : heap.
+
+  Definition hprop := heap -> Prop.
+
+  Coercion hpure (P:Prop) : hprop := fun h => h = heap_empty /\ P.
+
+  Parameter heap_single : nat -> nat -> hprop.
+
+  Parameter hstar : hprop -> hprop -> hprop.
+
+  Notation "H1 \* H2" := (hstar H1 H2) (at level 69).
+
+  Definition test := heap_single 4 5 \* (5 <> 4) \* heap_single 2 4 \* (True).
+
+  (* Print test. -- reveals [hpure] coercions *)
+
+End TestPropAsSourceCoercion.
+
+
+(** Unit test for Type as source class *)
+
+Module TestTypeAsSourceCoercion.
+
+  Require Import Coq.Setoids.Setoid.
+
+  Record setoid := { A : Type ; R : relation A ; eqv : Equivalence R }.
+
+  Definition default_setoid (T : Type) : setoid
+    := {| A := T ; R := eq ; eqv := _ |}.
+
+  Coercion default_setoid : Sortclass >-> setoid.
+
+  Definition foo := Type : setoid.
+
+  Inductive type := U | Nat.
+  Inductive term : type -> Type :=
+  | ty (_ : Type) : term U
+  | nv (_ : nat) : term Nat.
+
+  Coercion ty : Sortclass >-> term.
+
+  Definition ty1 := Type : term _.
+  Definition ty2 := Prop : term _.
+  Definition ty3 := Set : term _.
+  Definition ty4 := (Type : Type) : term _.
+
+End TestTypeAsSourceCoercion.
diff --git a/test-suite/success/coindprim.v b/test-suite/success/coindprim.v
index 5b9265b6..05ab9139 100644
--- a/test-suite/success/coindprim.v
+++ b/test-suite/success/coindprim.v
@@ -13,9 +13,10 @@ Definition eta {A} (s : Stream A) := {| hd := s.(hd); tl := s.(tl) |}.
 CoFixpoint ones := {| hd := 1; tl := ones |}.
 CoFixpoint ticks := {| hd := tt; tl := ticks |}.
 
-CoInductive stream_equiv {A} {s : Stream A} {s' : Stream A} : Prop :=
-  mkStreamEq { hdeq : s.(hd) = s'.(hd); tleq : stream_equiv _ s.(tl) s'.(tl) }.
-Arguments stream_equiv {A} s s'.
+CoInductive stream_equiv {A} (s : Stream A) (s' : Stream A) : Prop :=
+  mkStreamEq { hdeq : s.(hd) = s'.(hd); tleq : stream_equiv s.(tl) s'.(tl) }.
+Arguments hdeq {A} {s} {s'}.
+Arguments tleq {A} {s} {s'}.
 
 Program CoFixpoint ones_eq : stream_equiv ones ones.(tl) :=
   {| hdeq := eq_refl; tleq := ones_eq |}.
@@ -88,4 +89,4 @@ Lemma eq (x : U) : x = force x.
 Proof.
   Fail destruct x.
 Abort.
-  (* Impossible *)
\ No newline at end of file
+  (* Impossible *)
diff --git a/test-suite/success/cumulativity.v b/test-suite/success/cumulativity.v
new file mode 100644
index 00000000..3d97f27b
--- /dev/null
+++ b/test-suite/success/cumulativity.v
@@ -0,0 +1,139 @@
+Polymorphic Cumulative Inductive T1 := t1 : T1.
+Fail Monomorphic Cumulative Inductive T2 := t2 : T2.
+
+Polymorphic Cumulative Record R1 := { r1 : T1 }.
+Fail Monomorphic Cumulative Inductive R2 := {r2 : T1}.
+
+Set Universe Polymorphism.
+Set Polymorphic Inductive Cumulativity.
+Set Printing Universes.
+
+Inductive List (A: Type) := nil | cons : A -> List A -> List A.
+
+Definition LiftL@{k i j|k <= i, k <= j} {A:Type@{k}} : List@{i} A -> List@{j} A := fun x => x.
+
+Lemma LiftL_Lem A (l : List A) : l = LiftL l.
+Proof. reflexivity. Qed.
+
+Inductive Tp := tp : Type -> Tp.
+
+Definition LiftTp@{i j|i <= j} : Tp@{i} -> Tp@{j} := fun x => x.
+
+Fail Definition LowerTp@{i j|j < i} : Tp@{i} -> Tp@{j} := fun x => x.
+
+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.
+
+Section subtyping_test.
+  Universe i j.
+  Constraint i < j.
+
+  Inductive TP2 := tp2 : Type@{i} -> Type@{j} -> TP2.
+
+End subtyping_test.
+
+Record A : Type := { a :> Type; }.
+
+Record B (X : A) : Type := { b : X; }.
+
+NonCumulative Inductive NCList (A: Type)
+  := ncnil | nccons : A -> NCList A -> NCList A.
+
+Fail Definition LiftNCL@{k i j|k <= i, k <= j} {A:Type@{k}}
+  : NCList@{i} A -> NCList@{j} A := fun x => x.
+
+Inductive eq@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := eq_refl : eq x x.
+
+Definition funext_type@{a b e} (A : Type@{a}) (B : A -> Type@{b})
+  := forall f g : (forall a, B a),
+    (forall x, eq@{e} (f x) (g x))
+    -> eq@{e} f g.
+
+Section down.
+  Universes a b e e'.
+  Constraint e' < e.
+  Lemma funext_down {A B}
+    : @funext_type@{a b e} A B -> @funext_type@{a b e'} A B.
+  Proof.
+    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.
+
+(** Cumulative constructors *)
+
+
+Record twotys@{u v w} : Type@{w} :=
+  twoconstr { fstty : Type@{u}; sndty : Type@{v} }.
+
+Monomorphic Universes i j k l.
+
+Monomorphic Constraint i < j.
+Monomorphic Constraint j < k.
+Monomorphic Constraint k < l.
+
+Parameter Tyi : Type@{i}.
+
+Definition checkcumul :=
+  eq_refl _ : @eq twotys@{k k l} (twoconstr@{i j k} Tyi Tyi) (twoconstr@{j i k} Tyi Tyi).
+
+(* They can only be compared at the highest type *)
+Fail Definition checkcumul' :=
+  eq_refl _ : @eq twotys@{i k l} (twoconstr@{i j k} Tyi Tyi) (twoconstr@{j i k} Tyi Tyi).
+
+(* An inductive type with an irrelevant universe *)
+Inductive foo@{i} : Type@{i} := mkfoo { }.
+
+Definition bar := foo.
+
+(* The universe on mkfoo is flexible and should be unified with i. *)
+Definition foo1@{i} : foo@{i} := let x := mkfoo in x. (* fast path for conversion *)
+Definition foo2@{i} : bar@{i} := let x := mkfoo in x. (* must reduce *)
+
+(* Rigid universes however should not be unified unnecessarily. *)
+Definition foo3@{i j|} : foo@{i} := let x := mkfoo@{j} in x.
+Definition foo4@{i j|} : bar@{i} := let x := mkfoo@{j} in x.
+
+(* Constructors for an inductive with indices *)
+Module WithIndex.
+  Inductive foo@{i} : (Prop -> Prop) -> Prop := mkfoo: foo (fun x => x).
+
+  Monomorphic Universes i j.
+  Monomorphic Constraint i < j.
+  Definition bar : eq mkfoo@{i} mkfoo@{j} := eq_refl _.
+End WithIndex.
diff --git a/test-suite/success/decl_mode.v b/test-suite/success/decl_mode.v
deleted file mode 100644
index 58f79d45..00000000
--- a/test-suite/success/decl_mode.v
+++ /dev/null
@@ -1,182 +0,0 @@
-(* \sqrt 2 is irrationnal, (c) 2006 Pierre Corbineau *)
-
-Set Firstorder Depth 1.
-Require Import ArithRing Wf_nat Peano_dec Div2 Even Lt.
-
-Lemma double_div2: forall n, div2 (double n) = n.
-proof.
-  assume n:nat.
-  per induction on n.
-    suppose it is 0.
-     suffices (0=0) to show thesis.
-     thus thesis.
-    suppose it is (S m) and Hrec:thesis for m.
-      have (div2 (double (S m))= div2 (S (S (double m)))).
-           ~= (S (div2 (double m))).
-      thus ~= (S m) by Hrec.
-  end induction.
-end proof.
-Show Script.
-Qed.
-
-Lemma double_inv : forall n m, double n = double m -> n = m .
-proof.
-  let n, m be such that H:(double n = double m).
-have (n = div2 (double n)) by double_div2,H.
-       ~= (div2 (double m)) by H.
-  thus ~= m by double_div2.
-end proof.
-Qed.
-
-Lemma double_mult_l : forall n m, (double (n * m)=n * double m).
-proof.
-  assume n:nat and m:nat.
-  have (double (n * m) = n*m + n * m).
-       ~= (n * (m+m)) by * using ring.
-  thus ~= (n * double m).
-end proof.
-Qed.
-
-Lemma double_mult_r : forall n m, (double (n * m)=double n * m).
-proof.
-  assume n:nat and m:nat.
-  have (double (n * m) = n*m + n * m).
-       ~= ((n + n) * m) by * using ring.
-  thus ~= (double n * m).
-end proof.
-Qed.
-
-Lemma even_is_even_times_even: forall n, even (n*n) -> even n.
-proof.
-  let n be such that H:(even (n*n)).
-  per cases of (even n \/ odd n) by even_or_odd.
-    suppose (odd n).
-      hence thesis by H,even_mult_inv_r.
-  end cases.
-end proof.
-Qed.
-
-Lemma main_thm_aux: forall n,even n ->
-double (double (div2 n *div2 n))=n*n.
-proof.
-  given n such that H:(even n).
- *** have (double (double (div2 n * div2 n))
-        = double (div2 n) * double (div2 n))
-        by double_mult_l,double_mult_r.
-  thus ~= (n*n) by H,even_double.
-end proof.
-Qed.
-
-Require Import Omega.
-
-Lemma even_double_n: (forall m, even (double m)).
-proof.
-  assume m:nat.
-  per induction on m.
-    suppose it is 0.
-      thus thesis.
-    suppose it is (S mm) and thesis for mm.
-      then H:(even (S (S (mm+mm)))).
-      have (S (S (mm + mm)) = S mm + S mm)  using omega.
-      hence (even (S mm +S mm)) by H.
-  end induction.
-end proof.
-Qed.
-
-Theorem main_theorem: forall n p, n*n=double (p*p) -> p=0.
-proof.
-  assume n0:nat.
-  define P n as (forall p, n*n=double (p*p) -> p=0).
-  claim rec_step: (forall n, (forall m,m<n-> P m) -> P n).
-    let n be such that H:(forall m : nat, m < n -> P m) and p:nat .
-    per cases of ({n=0}+{n<>0}) by eq_nat_dec.
-      suppose H1:(n=0).
-        per cases on p.
-          suppose it is (S p').
-            assume (n * n = double (S p' * S p')).
-              =~ 0 by H1,mult_n_O.
-              ~= (S (  p' + p' * S p' + S p'* S p'))
-                by plus_n_Sm.
-            hence thesis .
-          suppose it is 0.
-            thus thesis.
-        end cases.
-      suppose H1:(n<>0).
-        assume H0:(n*n=double (p*p)).
-        have (even (double (p*p))) by even_double_n .
-        then (even (n*n)) by H0.
-        then H2:(even n) by even_is_even_times_even.
-        then (double (double (div2 n *div2 n))=n*n)
-          by main_thm_aux.
-          ~= (double (p*p)) by H0.
-        then H':(double (div2 n *div2 n)= p*p) by double_inv.
-        have (even (double (div2 n *div2 n))) by even_double_n.
-        then (even (p*p)) by even_double_n,H'.
-        then H3:(even p) by even_is_even_times_even.
-        have (double(double (div2 n * div2 n)) = n*n)
-          by H2,main_thm_aux.
-          ~= (double (p*p)) by H0.
-          ~= (double(double (double (div2 p * div2 p))))
-            by H3,main_thm_aux.
-        then H'':(div2 n * div2 n = double (div2 p * div2 p))
-          by double_inv.
-        then (div2 n < n) by lt_div2,neq_O_lt,H1.
-        then H4:(div2 p=0) by  (H (div2 n)),H''.
-        then (double (div2 p) = double 0).
-             =~ p by even_double,H3.
-        thus ~= 0.
-    end cases.
-  end claim.
-  hence thesis by (lt_wf_ind n0 P).
-end proof.
-Qed.
-
-Require Import Reals Field.
-(*Coercion INR: nat >->R.
-Coercion IZR: Z >->R.*)
-
-Open Scope R_scope.
-
-Lemma square_abs_square:
-  forall p,(INR (Z.abs_nat p) * INR (Z.abs_nat p)) = (IZR p * IZR p).
-proof.
-  assume p:Z.
-  per cases on p.
-    suppose it is (0%Z).
-      thus thesis.
-    suppose it is (Zpos z).
-      thus thesis.
-    suppose it is (Zneg z).
-      have ((INR (Z.abs_nat (Zneg z)) * INR (Z.abs_nat (Zneg z))) =
-      (IZR (Zpos z) * IZR (Zpos z))).
-           ~= ((- IZR (Zpos z)) * (- IZR (Zpos z))).
-      thus ~= (IZR (Zneg z) * IZR (Zneg z)).
-  end cases.
-end proof.
-Qed.
-
-Definition irrational (x:R):Prop :=
-  forall (p:Z) (q:nat),q<>0%nat -> x<> (IZR p/INR q).
-
-Theorem irrationnal_sqrt_2: irrational (sqrt (INR 2%nat)).
-proof.
-  let p:Z,q:nat be such that H:(q<>0%nat)
-                         and H0:(sqrt (INR 2%nat)=(IZR p/INR q)).
-  have H_in_R:(INR q<>0:>R) by H.
-  have triv:((IZR p/INR q* INR q) =IZR p :>R) by * using field.
-  have sqrt2:((sqrt (INR 2%nat) * sqrt (INR 2%nat))= INR 2%nat:>R) by sqrt_def.
-  have (INR (Z.abs_nat p * Z.abs_nat p)
-     = (INR (Z.abs_nat p) * INR (Z.abs_nat p)))
-    by mult_INR.
-    ~=  (IZR p* IZR p) by square_abs_square.
-    ~=  ((IZR p/INR q*INR q)*(IZR p/INR q*INR q)) by triv. (* we have to factor because field is too weak *)
-    ~=  ((IZR p/INR q)*(IZR p/INR q)*(INR q*INR q)) using ring.
-    ~=  (sqrt (INR 2%nat) * sqrt (INR 2%nat)*(INR q*INR q)) by H0.
-    ~= (INR (2%nat * (q*q)))  by sqrt2,mult_INR.
-  then  (Z.abs_nat p * Z.abs_nat p = 2* (q * q))%nat.
-    ~= ((q*q)+(q*q))%nat.
-    ~= (Div2.double (q*q)).
-  then (q=0%nat) by main_theorem.
-  hence thesis by H.
-end proof.
-Qed.
diff --git a/test-suite/success/decl_mode2.v b/test-suite/success/decl_mode2.v
deleted file mode 100644
index 46174e48..00000000
--- a/test-suite/success/decl_mode2.v
+++ /dev/null
@@ -1,249 +0,0 @@
-Theorem this_is_trivial: True.
-proof.
-  thus thesis.
-end proof.
-Qed.
-
-Theorem T: (True /\ True) /\ True.
-  split. split.
-proof. (* first subgoal *)
-  thus thesis.
-end proof.
-trivial. (* second subgoal *)
-proof. (* third subgoal *)
-  thus thesis.
-end proof.
-Abort.
-
-Theorem this_is_not_so_trivial: False.
-proof.
-end proof. (* here a warning is issued *)
-Fail Qed. (* fails: the proof in incomplete *)
-Admitted. (* Oops! *)
-
-Theorem T: True.
-proof.
-escape.
-auto.
-return.
-Abort.
-
-Theorem T: let a:=false in let b:= true in ( if a then True else False -> if b then True else False).
-intros a b.
-proof.
-assume H:(if a then True else False).
-reconsider H as False.
-reconsider thesis as True.
-Abort.
-
-Theorem T: forall x, x=2 -> 2+x=4.
-proof.
-let x be such that H:(x=2).
-have H':(2+x=2+2) by H.
-Abort.
-
-Theorem T: forall x, x=2 -> 2+x=4.
-proof.
-let x be such that H:(x=2).
-then (2+x=2+2).
-Abort.
-
-Theorem T: forall x, x=2 -> x + x = x * x.
-proof.
-let x be such that H:(x=2).
-have (4 = 4).
-        ~= (2 * 2).
-        ~= (x * x) by H.
-        =~ (2 + 2).
-        =~ H':(x + x) by H.
-Abort.
-
-Theorem T: forall x, x + x = x * x -> x = 0 \/ x = 2.
-proof.
-let x be such that H:(x + x = x * x).
-claim H':((x - 2) * x = 0).
-thus thesis. 
-end claim.
-Abort.
-
-Theorem T: forall (A B:Prop), A -> B -> A /\ B.
-intros A B HA HB.
-proof.
-hence B.
-Abort.
-
-Theorem T: forall (A B C:Prop), A -> B -> C -> A /\ B /\ C.
-intros A B C HA HB HC.
-proof.
-thus B by HB.
-Abort.
-
-Theorem T: forall (A B C:Prop), A -> B -> C -> A /\ B.
-intros A B C HA HB HC.
-proof.
-Fail hence C. (* fails *)
-Abort.
-
-Theorem T: forall (A B:Prop), B -> A \/ B.
-intros A B HB.
-proof.
-hence B.
-Abort.
-
-Theorem T: forall (A B C D:Prop), C -> D -> (A /\ B) \/ (C /\ D).
-intros A B C D HC HD.
-proof.
-thus C by HC.
-Abort.
-
-Theorem T: forall (P:nat -> Prop), P 2 -> exists x,P x.
-intros P HP.
-proof.
-take 2.
-Abort.
-
-Theorem T: forall (P:nat -> Prop), P 2 -> exists x,P x.
-intros P HP.
-proof.
-hence (P 2).
-Abort.
-
-Theorem T: forall (P:nat -> Prop) (R:nat -> nat -> Prop), P 2 -> R 0 2 -> exists x, exists y, P y /\ R x y.
-intros P R HP HR.
-proof.
-thus (P 2) by HP.
-Abort.
-
-Theorem T: forall (A B:Prop) (P:nat -> Prop), (forall x, P x -> B) -> A -> A /\ B.
-intros A B P HP HA.
-proof.
-suffices to have x such that HP':(P x) to show B by HP,HP'.
-Abort.
-
-Theorem T: forall (A:Prop) (P:nat -> Prop), P 2 -> A -> A /\ (forall x, x = 2 -> P x).
-intros A P HP HA.
-proof.
-(* BUG: the next line fails when it should succeed.
-Waiting for someone to investigate the bug.
-focus on (forall x, x = 2 -> P x).
-let x be such that (x = 2).
-hence thesis by HP.
-end focus.
-*)
-Abort.
-
-Theorem T: forall x, x = 0 -> x + x = x * x.
-proof.
-let x be such that H:(x = 0).
-define sqr x as (x * x).
-reconsider thesis as (x + x = sqr x).
-Abort.
-
-Theorem T: forall (P:nat -> Prop), forall x, P x -> P x.
-proof.
-let P:(nat -> Prop).
-let x:nat.
-assume HP:(P x).
-Abort.
-
-Theorem T: forall (P:nat -> Prop), forall x, P x -> P x.
-proof.
-let P:(nat -> Prop).
-Fail let x. (* fails because x's type is not clear *) 
-let x be such that HP:(P x). (* here x's type is inferred from (P x) *)
-Abort.
-
-Theorem T: forall (P:nat -> Prop), forall x, P x -> P x -> P x.
-proof.
-let P:(nat -> Prop).
-let x:nat.
-assume (P x). (* temporary name created *)
-Abort.
-
-Theorem T: forall (P:nat -> Prop), forall x, P x -> P x.
-proof.
-let P:(nat -> Prop).
-let x be such that (P x). (* temporary name created *)
-Abort.
-
-Theorem T: forall (P:nat -> Prop) (A:Prop), (exists x, (P x /\ A)) -> A.
-proof.
-let P:(nat -> Prop),A:Prop be such that H:(exists x, P x /\ A).
-consider x such that HP:(P x) and HA:A from H.
-Abort.
-
-(* Here is an example with pairs: *)
-
-Theorem T: forall p:(nat * nat)%type, (fst p >= snd p) \/ (fst p < snd p).
-proof.
-let p:(nat * nat)%type.
-consider x:nat,y:nat from p.
-reconsider thesis as (x >= y \/ x < y). 
-Abort.
-
-Theorem T: forall P:(nat -> Prop), (forall n, P n -> P (n - 1)) -> 
-(exists m, P m) -> P 0.
-proof.
-let P:(nat -> Prop) be such that HP:(forall n, P n -> P (n - 1)).
-given m such that Hm:(P m).  
-Abort.
-
-Theorem T: forall (A B C:Prop), (A -> C) -> (B -> C) -> (A \/ B) -> C.
-proof.
-let A:Prop,B:Prop,C:Prop be such that HAC:(A -> C) and HBC:(B -> C).
-assume HAB:(A \/ B).
-per cases on HAB.
-suppose A.
-  hence thesis by HAC.
-suppose HB:B.
-  thus thesis by HB,HBC.
-end cases.
-Abort.
-
-Section Coq.
-
-Hypothesis EM : forall P:Prop, P \/ ~ P.
-
-Theorem T: forall (A C:Prop), (A -> C) -> (~A -> C) -> C.
-proof.
-let A:Prop,C:Prop be such that HAC:(A -> C) and HNAC:(~A -> C).
-per cases of (A \/ ~A) by EM.
-suppose (~A).
-  hence thesis by HNAC.
-suppose A.
-  hence thesis by HAC.
-end cases.
-Abort.
-
-Theorem T: forall (A C:Prop), (A -> C) -> (~A -> C) -> C.
-proof.
-let A:Prop,C:Prop be such that HAC:(A -> C) and HNAC:(~A -> C).
-per cases on (EM A).
-suppose (~A).
-Abort.
-End Coq.
-
-Theorem T: forall (A B:Prop) (x:bool), (if x then A else B) -> A \/ B.
-proof.
-let A:Prop,B:Prop,x:bool.
-per cases on x.
-suppose it is true.
-  assume A.
-  hence A.
-suppose it is false.
-  assume B.
-  hence B.
-end cases.
-Abort.
-
-Theorem T: forall (n:nat), n + 0 = n.
-proof.
-let n:nat.
-per induction on n.
-suppose it is 0.
-  thus (0 + 0 = 0).
-suppose it is (S m) and H:thesis for m.
-  then (S (m + 0) = S m).
-  thus =~ (S m + 0).
-end induction.
-Abort.
\ No newline at end of file
diff --git a/test-suite/success/dependentind.v b/test-suite/success/dependentind.v
index 12ddbda8..f5bb884d 100644
--- a/test-suite/success/dependentind.v
+++ b/test-suite/success/dependentind.v
@@ -15,7 +15,7 @@ Proof.
   intros n H.
   dependent destruction H.
   assumption.
-Save.
+Qed.
 
 Require Import ProofIrrelevance.
 
@@ -25,7 +25,7 @@ Proof.
   dependent destruction v.
   exists v ; exists a.
   reflexivity.
-Save.
+Qed.
 
 (* Extraction Unnamed_thm. *)
 
diff --git a/test-suite/success/destruct.v b/test-suite/success/destruct.v
index 90a60daa..6fbe61a9 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 00000000..094b2f8b
--- /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/eauto.v b/test-suite/success/eauto.v
index 160f2d9d..c4474737 100644
--- a/test-suite/success/eauto.v
+++ b/test-suite/success/eauto.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Class A (A : Type).
diff --git a/test-suite/success/eqdecide.v b/test-suite/success/eqdecide.v
index 724e2998..9b3fb3c5 100644
--- a/test-suite/success/eqdecide.v
+++ b/test-suite/success/eqdecide.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Inductive T : Set :=
diff --git a/test-suite/success/evars.v b/test-suite/success/evars.v
index 4e2bf451..0f9fb745 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,11 +58,11 @@ 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))).
 
-(* This used to fail with anomaly (Pp.str "evar was not declared") in V8.0pl3 *)
+(* This used to fail with anomaly (Pp.str "evar was not declared.") in V8.0pl3 *)
 
 Theorem contradiction : forall p, ~ p -> p -> False.
 Proof. trivial. Qed.
@@ -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
@@ -414,4 +414,15 @@ Axiom test : forall P1 P2, P1 = P2 -> P1 -> P2.
 Import EqNotations.
 Definition test2 {A B:Type} {H:A=B} (a:A) : B := rew H in a.
 
+(* Check that pre-existing evars are not counted as newly undefined in "set" *)
+(* Reported by Théo *)
 
+Goal exists n : nat, n = n -> True.
+eexists.
+set (H := _ = _).
+Abort.
+
+(* Check interpretation of default evar instance in pretyping *)
+(* (reported as bug #7356) *)
+
+Check fun (P : nat -> Prop) (x:nat) (h:P x) => exist _ ?[z] (h : P ?z).
diff --git a/test-suite/success/extraction.v b/test-suite/success/extraction.v
index 0086e090..95ae0709 100644
--- a/test-suite/success/extraction.v
+++ b/test-suite/success/extraction.v
@@ -1,11 +1,14 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
+Require Coq.extraction.Extraction.
 Require Import Arith.
 Require Import List.
 
@@ -544,47 +547,96 @@ Recursive Extraction test_proj.
 
 (*** TO SUM UP: ***)
 
-(* Was previously producing a "test_extraction.ml" *)
-Recursive Extraction
-  idnat id id' test2 test3 test4 test5 test6 test7 d d2
-  d3 d4 d5 d6 test8 id id' test9 test10 test11 test12
-  test13 test19 test20 nat sumbool_rect c Finite tree
-  tree_size test14 test15 eta_c test16 test17 test18 bidon
-  tb fbidon fbidon2 fbidon2 test_0 test_1 eq eq_rect tp1
-  tp1bis Truc oups test24 loop horibilis PropSet natbool
-  zerotrue zeroTrue zeroprop test21 test22 test23 f f_prop
-  f_arity f_normal Boite boite1 boite2 test_boite Box box1
-  zarb test_proj.
+Module Everything.
+ Definition idnat := idnat.
+ Definition id := id.
+ Definition id' := id'.
+ Definition test2 := test2.
+ Definition test3 := test3.
+ Definition test4 := test4.
+ Definition test5 := test5.
+ Definition test6 := test6.
+ Definition test7 := test7.
+ Definition d := d.
+ Definition d2 := d2.
+ Definition d3 := d3.
+ Definition d4 := d4.
+ Definition d5 := d5.
+ Definition d6 := d6.
+ Definition test8 := test8.
+ Definition test9 := test9.
+ Definition test10 := test10.
+ Definition test11 := test11.
+ Definition test12 := test12.
+ Definition test13 := test13.
+ Definition test19 := test19.
+ Definition test20 := test20.
+ Definition nat := nat.
+ Definition sumbool_rect := sumbool_rect.
+ Definition c := c.
+ Definition Finite := Finite.
+ Definition tree := tree.
+ Definition tree_size := tree_size.
+ Definition test14 := test14.
+ Definition test15 := test15.
+ Definition eta_c := eta_c.
+ Definition test16 := test16.
+ Definition test17 := test17.
+ Definition test18 := test18.
+ Definition bidon := bidon.
+ Definition tb := tb.
+ Definition fbidon := fbidon.
+ Definition fbidon2 := fbidon2.
+ Definition test_0 := test_0.
+ Definition test_1 := test_1.
+ Definition eq_rect := eq_rect.
+ Definition tp1 := tp1.
+ Definition tp1bis := tp1bis.
+ Definition Truc := Truc.
+ Definition oups := oups.
+ Definition test24 := test24.
+ Definition loop := loop.
+ Definition horibilis := horibilis.
+ Definition PropSet := PropSet.
+ Definition natbool := natbool.
+ Definition zerotrue := zerotrue.
+ Definition zeroTrue := zeroTrue.
+ Definition zeroprop := zeroprop.
+ Definition test21 := test21.
+ Definition test22 := test22.
+ Definition test23 := test23.
+ Definition f := f.
+ Definition f_prop := f_prop.
+ Definition f_arity := f_arity.
+ Definition f_normal := f_normal.
+ Definition Boite := Boite.
+ Definition boite1 := boite1.
+ Definition boite2 := boite2.
+ Definition test_boite := test_boite.
+ Definition Box := Box.
+ Definition box1 := box1.
+ Definition zarb := zarb.
+ Definition test_proj := test_proj.
+End Everything.
+
+(* Extraction "test_extraction.ml" Everything. *)
+Recursive Extraction Everything.
+(* Check that the previous OCaml code is compilable *)
+Extraction TestCompile Everything.
 
 Extraction Language Haskell.
-(* Was previously producing a "Test_extraction.hs" *)
-Recursive Extraction
- idnat id id' test2 test3 test4 test5 test6 test7 d d2
- d3 d4 d5 d6 test8 id id' test9 test10 test11 test12
- test13 test19 test20 nat sumbool_rect c Finite tree
- tree_size test14 test15 eta_c test16 test17 test18 bidon
- tb fbidon fbidon2 fbidon2 test_0 test_1 eq eq_rect tp1
- tp1bis Truc oups test24 loop horibilis PropSet natbool
- zerotrue zeroTrue zeroprop test21 test22 test23 f f_prop
- f_arity f_normal Boite boite1 boite2 test_boite Box box1
- zarb test_proj.
+(* Extraction "Test_extraction.hs" Everything. *)
+Recursive Extraction Everything.
 
 Extraction Language Scheme.
-(* Was previously producing a "test_extraction.scm" *)
-Recursive Extraction
- idnat id id' test2 test3 test4 test5 test6 test7 d d2
- d3 d4 d5 d6 test8 id id' test9 test10 test11 test12
- test13 test19 test20 nat sumbool_rect c Finite tree
- tree_size test14 test15 eta_c test16 test17 test18 bidon
- tb fbidon fbidon2 fbidon2 test_0 test_1 eq eq_rect tp1
- tp1bis Truc oups test24 loop horibilis PropSet natbool
- zerotrue zeroTrue zeroprop test21 test22 test23 f f_prop
- f_arity f_normal Boite boite1 boite2 test_boite Box box1
- zarb test_proj.
+(* Extraction "test_extraction.scm" Everything. *)
+Recursive Extraction Everything.
 
 
 (*** Finally, a test more focused on everyday's life situations ***)
 
 Require Import ZArith.
 
-Recursive Extraction two_or_two_plus_one Zdiv_eucl_exist.
+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/extraction_dep.v b/test-suite/success/extraction_dep.v
index 11bb25fd..fb0adaba 100644
--- a/test-suite/success/extraction_dep.v
+++ b/test-suite/success/extraction_dep.v
@@ -1,8 +1,10 @@
 
 (** Examples of code elimination inside modules during extraction *)
 
+Require Coq.extraction.Extraction.
+
 (** NB: we should someday check the produced code instead of
-    simply running the commands. *)
+    extracting and just compiling. *)
 
 (** 1) Without signature ... *)
 
@@ -18,6 +20,7 @@ End A.
 Definition testA := A.u + A.B.x.
 
 Recursive Extraction testA. (* without: v w *)
+Extraction TestCompile testA.
 
 (** 1b) Same with an Include *)
 
@@ -29,6 +32,7 @@ End Abis.
 Definition testAbis := Abis.u + Abis.y.
 
 Recursive Extraction testAbis. (* without: A B v w x *)
+Extraction TestCompile testAbis.
 
 (** 2) With signature, we only keep elements mentionned in signature. *)
 
@@ -44,3 +48,4 @@ End Ater.
 Definition testAter := Ater.u.
 
 Recursive Extraction testAter. (* with only: u v *)
+Extraction TestCompile testAter.
diff --git a/test-suite/success/extraction_impl.v b/test-suite/success/extraction_impl.v
index dfdeff82..a38a688f 100644
--- a/test-suite/success/extraction_impl.v
+++ b/test-suite/success/extraction_impl.v
@@ -2,7 +2,9 @@
 (** Examples of extraction with manually-declared implicit arguments *)
 
 (** NB: we should someday check the produced code instead of
-    simply running the commands. *)
+    extracting and just compiling. *)
+
+Require Coq.extraction.Extraction.
 
 (** Bug #4243, part 1 *)
 
@@ -20,9 +22,11 @@ Proof.
 Defined.
 
 Recursive Extraction dnat_nat.
+Extraction TestCompile dnat_nat.
 
 Extraction Implicit dnat_nat [n].
 Recursive Extraction dnat_nat.
+Extraction TestCompile dnat_nat.
 
 (** Same, with a Fixpoint *)
 
@@ -33,9 +37,11 @@ Fixpoint dnat_nat' n (d:dnat n) :=
  end.
 
 Recursive Extraction dnat_nat'.
+Extraction TestCompile dnat_nat'.
 
 Extraction Implicit dnat_nat' [n].
 Recursive Extraction dnat_nat'.
+Extraction TestCompile dnat_nat'.
 
 (** Bug #4243, part 2 *)
 
@@ -54,6 +60,7 @@ Defined.
 Extraction Implicit es [n].
 Extraction Implicit enat_nat [n].
 Recursive Extraction enat_nat.
+Extraction TestCompile enat_nat.
 
 (** Same, with a Fixpoint *)
 
@@ -65,6 +72,7 @@ Fixpoint enat_nat' n (e:enat n) : nat :=
 
 Extraction Implicit enat_nat' [n].
 Recursive Extraction enat_nat'.
+Extraction TestCompile enat_nat'.
 
 (** Bug #4228 *)
 
@@ -80,3 +88,4 @@ Extraction Implicit two_course [n].
 End Food.
 
 Recursive Extraction Food.Meal.
+Extraction TestCompile Food.Meal.
diff --git a/test-suite/success/extraction_polyprop.v b/test-suite/success/extraction_polyprop.v
index 7215bd99..936d838c 100644
--- a/test-suite/success/extraction_polyprop.v
+++ b/test-suite/success/extraction_polyprop.v
@@ -3,6 +3,8 @@
    code that segfaults. See Table.error_singleton_become_prop
    or S. Glondu's thesis for more details. *)
 
+Require Coq.extraction.Extraction.
+
 Definition f {X} (p : (nat -> X) * True) : X * nat :=
   (fst p 0, 0).
 
diff --git a/test-suite/success/forward.v b/test-suite/success/forward.v
new file mode 100644
index 00000000..4e36dec1
--- /dev/null
+++ b/test-suite/success/forward.v
@@ -0,0 +1,29 @@
+(* Testing forward reasoning *)
+
+Goal 0=0.
+Fail assert (_ = _).
+eassert (_ = _)by reflexivity.
+eassumption.
+Qed.
+
+Goal 0=0.
+Fail set (S ?[nl]).
+eset (S ?[n]).
+remember (S ?n) as x.
+instantiate (n:=0).
+Fail remember (S (S _)).
+eremember (S (S ?[x])).
+instantiate (x:=0).
+reflexivity.
+Qed.
+
+(* Don't know if it is good or not but the compatibility tells that
+   the asserted goal to prove is subject to beta-iota but not the
+   asserted hypothesis *)
+
+Goal True.
+assert ((fun x => x) False).
+Fail match goal with |- (?f ?a) => idtac end. (* should be beta-iota reduced *)
+2:match goal with _: (?f ?a) |- _ => idtac end. (* should not be beta-iota reduced *)
+Abort.
+
diff --git a/test-suite/success/guard.v b/test-suite/success/guard.v
index b9181d43..3a1c6dab 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.v b/test-suite/success/hintdb_in_ltac.v
new file mode 100644
index 00000000..f12b4d1f
--- /dev/null
+++ b/test-suite/success/hintdb_in_ltac.v
@@ -0,0 +1,14 @@
+Definition x := 0.
+
+Hint Unfold x : mybase.
+
+Ltac autounfoldify base := autounfold with base.
+
+Tactic Notation "autounfoldify_bis" ident(base) := autounfold with base.
+
+Goal x = 0.
+  progress autounfoldify mybase.
+  Undo.
+  progress autounfoldify_bis mybase.
+  trivial.
+Qed.
diff --git a/test-suite/success/hintdb_in_ltac_bis.v b/test-suite/success/hintdb_in_ltac_bis.v
new file mode 100644
index 00000000..2bc3f9d2
--- /dev/null
+++ b/test-suite/success/hintdb_in_ltac_bis.v
@@ -0,0 +1,15 @@
+Parameter Foo : Prop.
+Axiom H : Foo.
+
+Hint Resolve H : mybase.
+
+Ltac foo base := eauto with base.
+
+Tactic Notation "bar" ident(base) :=
+  typeclasses eauto with base.
+
+Goal Foo.
+  progress foo mybase.
+  Undo.
+  progress bar mybase.
+Qed.
diff --git a/test-suite/success/if.v b/test-suite/success/if.v
index 9fde95e8..c81d2b9b 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 91b6dee2..a962c29f 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/inds_type_sec.v b/test-suite/success/inds_type_sec.v
index c729b23c..92fd6cb1 100644
--- a/test-suite/success/inds_type_sec.v
+++ b/test-suite/success/inds_type_sec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 Section S.
 Inductive T (U : Type) : Type :=
diff --git a/test-suite/success/induct.v b/test-suite/success/induct.v
index 1ed731f5..da7df69e 100644
--- a/test-suite/success/induct.v
+++ b/test-suite/success/induct.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Test des definitions inductives imbriquees *)
diff --git a/test-suite/success/intros.v b/test-suite/success/intros.v
index ee69df97..a329894a 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 b88c142b..5638a7d3 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/letproj.v b/test-suite/success/letproj.v
index a183be62..de2857b4 100644
--- a/test-suite/success/letproj.v
+++ b/test-suite/success/letproj.v
@@ -1,5 +1,5 @@
 Set Primitive Projections.
-Set Record Elimination Schemes.
+Set Nonrecursive Elimination Schemes.
 Record Foo (A : Type) := { bar : A -> A; baz : A }.
 
 Definition test (A : Type) (f : Foo A) := 
diff --git a/test-suite/success/ltac.v b/test-suite/success/ltac.v
index ce909905..0f22a1f0 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.
@@ -317,3 +317,34 @@ let T := constr:(fun a b : nat => a) in
   end.
 exact (eq_refl n).
 Qed.
+
+(* A variant of #2602 which was wrongly succeeding because "a", bound to
+   "?m", was then internally turned into a "_" in the second matching *)
+
+Goal exists m, S m > 0.
+eexists.
+Fail match goal with
+ | |- context [ S ?a ] =>
+     match goal with
+       | |- S a > a => idtac
+     end
+end.
+Abort.
+
+(* Test evar syntax *)
+
+Goal True.
+evar (0=0).
+Abort.
+
+(* Test location of hypothesis in "symmetry in H". This was broken in
+   8.6 where H, when the oldest hyp, was moved at the place of most
+   recent hypothesis *)
+
+Goal 0=1 -> True -> True.
+intros H H0.
+symmetry in H.
+(* H should be the first hypothesis *)
+match goal with h:_ |- _ => assert (h=h) end. (* h should be H0 *)
+exact (eq_refl H0).
+Abort.
diff --git a/test-suite/success/ltac_match_pattern_names.v b/test-suite/success/ltac_match_pattern_names.v
new file mode 100644
index 00000000..790cd1b3
--- /dev/null
+++ b/test-suite/success/ltac_match_pattern_names.v
@@ -0,0 +1,28 @@
+(* example from bug 5345 *)
+Ltac break_tuple :=
+  match goal with
+  | [ H: context[let '(n, m) := ?a in _] |- _ ] =>
+    let n := fresh n in
+    let m := fresh m in
+    destruct a as [n m]
+  end.
+
+(* desugared version of break_tuple *)
+Ltac break_tuple' :=
+  match goal with
+  | [ H: context[match ?a with | pair n m => _ end] |- _ ] =>
+    let n := fresh n in
+    let m := fresh m in
+    idtac
+  end.
+
+Ltac multiple_branches :=
+  match goal with
+  | [ H: match _ with
+         | left P => _
+         | right Q => _
+         end |- _ ] =>
+    let P := fresh P in
+    let Q := fresh Q in
+    idtac
+  end.
diff --git a/test-suite/success/ltac_plus.v b/test-suite/success/ltac_plus.v
index 8a08d646..01d477bd 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/mutual_ind.v b/test-suite/success/mutual_ind.v
index 45c1a5e5..2c76a135 100644
--- a/test-suite/success/mutual_ind.v
+++ b/test-suite/success/mutual_ind.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (* Definition mutuellement inductive et dependante *)
 
diff --git a/test-suite/success/name_mangling.v b/test-suite/success/name_mangling.v
new file mode 100644
index 00000000..e9824142
--- /dev/null
+++ b/test-suite/success/name_mangling.v
@@ -0,0 +1,191 @@
+(* -*- coq-prog-args: ("-mangle-names" "_") -*- *)
+
+(* Check that refine policy of redefining previous names make these names private *)
+(* abstract can change names in the environment! See bug #3146 *)
+
+Goal True -> True.
+intro.
+Fail exact H.
+exact _0.
+Abort.
+
+Unset Mangle Names.
+Goal True -> True.
+intro; exact H.
+Abort.
+
+Set Mangle Names.
+Set Mangle Names Prefix "baz".
+Goal True -> True.
+intro.
+Fail exact H.
+Fail exact _0.
+exact baz0.
+Abort.
+
+Goal True -> True.
+intro; assumption.
+Abort.
+
+Goal True -> True.
+intro x; exact x.
+Abort.
+
+Goal forall x y, x+y=0.
+intro x.
+refine (fun x => _).
+Fail Check x0.
+Check x.
+Abort.
+
+(* Example from Emilio *)
+
+Goal forall b : False, b = b.
+intro b.
+refine (let b := I in _).
+Fail destruct b0.
+Abort.
+
+(* Example from Cyprien *)
+
+Goal True -> True.
+Proof.
+  refine (fun _ => _).
+  Fail exact t.
+Abort.
+
+(* Example from Jason *)
+
+Goal False -> False.
+intro H.
+Fail abstract exact H.
+Abort.
+
+(* Variant *)
+
+Goal False -> False.
+intro.
+Fail abstract exact H.
+Abort.
+
+(* Example from Jason *)
+
+Goal False -> False.
+intro H.
+(* Name H' is from Ltac here, so it preserves the privacy *)
+(* But abstract messes everything up *)
+Fail let H' := H in abstract exact H'.
+let H' := H in exact H'.
+Qed.
+
+(* Variant *)
+
+Goal False -> False.
+intro.
+Fail let H' := H in abstract exact H'.
+Abort.
+
+(* Indirectly testing preservation of names by move (derived from Jason) *)
+
+Inductive nat2 := S2 (_ _ : nat2).
+Goal forall t : nat2, True.
+  intro t.
+  let IHt1 := fresh "IHt1" in
+  let IHt2 := fresh "IHt2" in
+  induction t as [? IHt1 ? IHt2].
+  Fail exact IHt1.
+Abort.
+
+(* Example on "pose proof" (from Jason) *)
+
+Goal False -> False.
+intro; pose proof I as H0.
+Fail exact H.
+Abort.
+
+(* Testing the approach for which non alpha-renamed quantified names are user-generated *)
+
+Section foo.
+Context (b : True).
+Goal forall b : False, b = b.
+Fail destruct b0.
+Abort.
+
+Goal forall b : False, b = b.
+now destruct b.
+Qed.
+End foo.
+
+(* Test stability of "fix" *)
+
+Lemma a : forall n, n = 0.
+Proof.
+fix a 1.
+Check a.
+Fail fix a 1.
+Abort.
+
+(* Test stability of "induction" *)
+
+Lemma a : forall n : nat, n = n.
+Proof.
+intro n; induction n as [ | n IHn ].
+- auto.
+- Check n.
+  Check IHn.
+Abort.
+
+Inductive I := C : I -> I -> I.
+
+Lemma a : forall n : I, n = n.
+Proof.
+intro n; induction n as [ n1 IHn1 n2 IHn2 ].
+Check n1.
+Check n2.
+apply f_equal2.
++ apply IHn1.
++ apply IHn2.
+Qed.
+
+(* Testing remember *)
+
+Lemma c : 0 = 0.
+Proof.
+remember 0 as x eqn:Heqx.
+Check Heqx.
+Abort.
+
+Lemma c : forall Heqx, Heqx -> 0 = 0.
+Proof.
+intros Heqx X.
+remember 0 as x.
+Fail Check Heqx0. (* Heqx0 is not canonical *)
+Abort.
+
+(* An example by Jason from the discussion for PR #268 *)
+
+Goal nat -> Set -> True.
+  intros x y.
+  match goal with
+  | [ x : _, y : _ |- _ ]
+    => let z := fresh "z" in
+      rename y into z, x into y;
+        let x' := fresh "x" in
+        rename z into x'
+  end.
+  revert y. (* x has been explicitly moved to y *)
+  Fail revert x. (* x comes from "fresh" *)
+Abort.
+
+Goal nat -> Set -> True.
+  intros.
+  match goal with
+  | [ x : _, y : _ |- _ ]
+    => let z := fresh "z" in
+      rename y into z, x into y;
+        let x' := fresh "x" in
+        rename z into x'
+  end.
+  Fail revert y. (* generated by intros *)
+  Fail revert x. (* generated by intros *)
+Abort.
diff --git a/test-suite/success/polymorphism.v b/test-suite/success/polymorphism.v
index 878875bd..d76b3079 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.
@@ -321,4 +373,98 @@ Definition unwrap' := fun (X : Type) (b : box X) => let (unw) := b in unw.
 Fail Definition bad : False := TypeNeqSmallType.paradox (unwrap' Type (wrap _
 Type)) eq_refl.
 
-End Hurkens'.
\ No newline at end of file
+End Hurkens'.
+
+Module Anonymous.
+  Set Universe Polymorphism.
+
+  Definition defaultid := (fun x => x) : Type -> Type.
+  Definition collapseid := defaultid@{_ _}.
+  Check collapseid@{_}.
+
+  Definition anonid := (fun x => x) : Type -> Type@{_}.
+  Check anonid@{_}.
+
+  Definition defaultalg := (fun x : Type => x) (Type : Type).
+  Definition usedefaultalg := defaultalg@{_ _ _}.
+  Check usedefaultalg@{_ _}.
+
+  Definition anonalg := (fun x : Type@{_} => x) (Type : Type).
+  Check anonalg@{_ _}.
+
+  Definition unrelated@{i j} := nat.
+  Definition useunrelated := unrelated@{_ _}.
+  Check useunrelated@{_ _}.
+
+  Definition inthemiddle@{i j k} :=
+    let _ := defaultid@{i j} in
+    anonalg@{k j}.
+  (* i <= j < k *)
+  Definition collapsethemiddle := inthemiddle@{i _ j}.
+  Check collapsethemiddle@{_ _}.
+
+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.
+End F.
+
+Set Universe Polymorphism.
+
+Cumulative Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }.
+
+Section test_letin_subtyping.
+  Universe i j k i' j' k'.
+  Constraint j < j'.
+
+  Context (W : Type) (X : box@{i j k} W).
+  Definition Y := X : box@{i' j' k'} W.
+
+  Universe i1 j1 k1 i2 j2 k2.
+  Constraint i1 < i2.
+  Constraint k2 < k1.
+  Context (V : Type).
+
+  Definition Z : box@{i1 j1 k1} V := {| unwrap := V |}.
+  Definition Z' : box@{i2 j2 k2} V := {| unwrap := V |}.
+  Lemma ZZ' : @eq (box@{i2 j2 k2} V) Z Z'.
+  Proof.
+    Set Printing All. Set Printing Universes.
+    cbv.
+    reflexivity.
+  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/primitiveproj.v b/test-suite/success/primitiveproj.v
index 2fa77049..31a1608c 100644
--- a/test-suite/success/primitiveproj.v
+++ b/test-suite/success/primitiveproj.v
@@ -1,5 +1,5 @@
 Set Primitive Projections.
-Set Record Elimination Schemes.
+Set Nonrecursive Elimination Schemes.
 Module Prim.
 
 Record F := { a : nat; b : a = a }.
@@ -181,7 +181,10 @@ Record wrap (A : Type) := { unwrap : A; unwrap2 : A }.
 
 Definition term (x : wrap nat) := x.(unwrap).
 Definition term' (x : wrap nat) := let f := (@unwrap2 nat) in f x.
+
+Require Coq.extraction.Extraction.
 Recursive Extraction term term'.
+Extraction TestCompile term term'.
 (*Unset Printing Primitive Projection Parameters.*)
 
 (* Primitive projections in the presence of let-ins (was not failing in beta3)*)
diff --git a/test-suite/success/programequality.v b/test-suite/success/programequality.v
index 414c572f..05f4a718 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 b3e41ab1..00000000
--- 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/record_syntax.v b/test-suite/success/record_syntax.v
index db2bbb0d..07a5bc06 100644
--- a/test-suite/success/record_syntax.v
+++ b/test-suite/success/record_syntax.v
@@ -45,3 +45,11 @@ Record Foo := { foo : unit; }.
 Definition foo_ := {| foo := tt; |}.
 
 End E.
+
+Module F.
+
+Record Foo := { foo : nat * nat -> nat -> nat }.
+
+Definition foo_ := {| foo '(x,y) n := x+y+n |}.
+
+End F.
diff --git a/test-suite/success/refine.v b/test-suite/success/refine.v
index 352abb2a..22fb4d75 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.v b/test-suite/success/rewrite.v
index 62249666..448d0082 100644
--- a/test-suite/success/rewrite.v
+++ b/test-suite/success/rewrite.v
@@ -151,10 +151,25 @@ Abort.
 
 (* Check that rewriting within evars still work (was broken in 8.5beta1) *)
 
-
 Goal forall (a: unit) (H: a = tt), exists x y:nat, x = y.
 intros; eexists; eexists.
 rewrite H.
 Undo.
 subst.
 Abort.
+
+(* Check that iterated rewriting does not rewrite in the side conditions *)
+(* Example from Sigurd Schneider, extracted from contrib containers *)
+
+Lemma EQ
+  : forall (e e' : nat), True -> e = e'.
+Admitted.
+
+Lemma test (v1 v2 v3: nat) (v' : v1 = v2) : v2 = v1.
+Proof.
+  rewrite <- (EQ v1 v2) in *.
+  exact v'.
+  (* There should be only two side conditions *)
+  exact I.
+  exact I.
+Qed.
diff --git a/test-suite/success/rewrite_dep.v b/test-suite/success/rewrite_dep.v
index d0aafd38..d73864e4 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_evar.v b/test-suite/success/rewrite_evar.v
new file mode 100644
index 00000000..f7ad261c
--- /dev/null
+++ b/test-suite/success/rewrite_evar.v
@@ -0,0 +1,8 @@
+Require Import Coq.Setoids.Setoid.
+
+Goal forall (T2 MT1 MT2 : Type) (x : T2) (M2 m2 : MT2) (M1 m1 : MT1) (F : T2 -> MT1 -> MT2 -> Prop),
+    (forall (defaultB : T2) (m3 : MT1) (m4 : MT2), F defaultB m3 m4 <-> True) -> F x M1 M2 -> F x m1 m2.
+  intros ????????? H' H.
+  rewrite (H' _) in *.
+  (** The above rewrite should also rewrite in H. *)
+  Fail progress rewrite H' in H.
diff --git a/test-suite/success/rewrite_strat.v b/test-suite/success/rewrite_strat.v
index 04c67556..a6e59fdd 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 1f24ef2a..c8dfcd2c 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 6baf7970..79467e54 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/shrink_abstract.v b/test-suite/success/shrink_abstract.v
index 3f6b9cb3..916bb846 100644
--- a/test-suite/success/shrink_abstract.v
+++ b/test-suite/success/shrink_abstract.v
@@ -1,5 +1,3 @@
-Set Shrink Abstract.
-
 Definition foo : forall (n m : nat), bool.
 Proof.
 pose (p := 0).
diff --git a/test-suite/success/simpl.v b/test-suite/success/simpl.v
index 5b87e877..1bfb8580 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/specialize.v b/test-suite/success/specialize.v
index fba05cd9..f12db8b0 100644
--- a/test-suite/success/specialize.v
+++ b/test-suite/success/specialize.v
@@ -17,6 +17,29 @@ specialize (eq_trans (x:=a)(y:=b)). intros _.
 specialize (eq_trans H H0). intros _.
 specialize (eq_trans H0 (z:=b)). intros _.
 
+(* incomplete bindings: y is left quantified and z is instantiated. *)
+specialize eq_trans with (x:=a)(z:=c).
+intro h.
+(* y can be instantiated now *)
+specialize h with (y:=b).
+(* z was instantiated above so this must fail. *)
+Fail specialize h with (z:=c).
+clear h.
+
+(* incomplete bindings: 1st dep hyp is instantiated thus A, x and y
+   instantiated too. *)
+specialize eq_trans with (1:=H).
+intro h.
+(* 2nd dep hyp can be instantiated now, which instatiates z too. *)
+specialize h with (1:=H0).
+(* checking that there is no more products in h. *)
+match type of h with
+| _ = _ => idtac
+| _ => fail "specialize test failed: hypothesis h should be an equality at this point"
+end.
+clear h.
+
+
 (* local "in place" specialization *)
 assert (Eq:=eq_trans).
 
@@ -31,6 +54,27 @@ specialize (Eq _ a b c). Undo.
 specialize (Eq _ _ _ _ H H0). Undo.
 specialize (Eq _ _ _ b H0). Undo.
 
+(* incomplete binding *)
+specialize Eq with (y:=b).
+(* A and y have been instantiated so this works *)
+specialize (Eq _ _ H H0).
+Undo 2.
+
+(* incomplete binding (dependent) *)
+specialize Eq with (1:=H).
+(* A, x and y have been instantiated so this works *)
+specialize (Eq _ H0).
+Undo 2.
+
+(* incomplete binding (dependent) *)
+specialize Eq with (1:=H) (2:=H0).
+(* A, x and y have been instantiated so this works *)
+match type of Eq with
+| _ = _ => idtac
+| _ => fail "specialize test failed: hypothesis Eq should be an equality at this point"
+end.
+Undo 2.
+
 (*
 (** strange behavior to inspect more precisely *)
 
@@ -40,7 +84,7 @@ specialize (Eq _ _ _ b H0). Undo.
 (* 2) echoue moins lorsque zero premise de mangé *)
 specialize eq_trans with (1:=Eq).  (* mal typé !! *)
 
-(* 3) *)
+(* 3) Seems fixed.*)
 specialize eq_trans with _ a b c. intros _.
 (* Anomaly: Evar ?88 was not declared. Please report. *)
 *)
@@ -72,3 +116,11 @@ intros.
 specialize (H 1) as ->.
 reflexivity.
 Qed.
+
+(* A test from corn *)
+
+Goal (forall x y, x=0 -> y=0 -> True) -> True.
+intros.
+specialize (fun z => H 0 z eq_refl).
+exact (H 0 eq_refl).
+Qed.
diff --git a/test-suite/success/ssr_delayed_clear_rename.v b/test-suite/success/ssr_delayed_clear_rename.v
new file mode 100644
index 00000000..951e5aff
--- /dev/null
+++ b/test-suite/success/ssr_delayed_clear_rename.v
@@ -0,0 +1,5 @@
+Require Import ssreflect.
+Example foo (t t1 t2 : True) : True /\ True -> True -> True.
+Proof.
+move=>[{t1 t2 t} t1 t2] t.
+Abort.
diff --git a/test-suite/success/transparent_abstract.v b/test-suite/success/transparent_abstract.v
new file mode 100644
index 00000000..ff4509c4
--- /dev/null
+++ b/test-suite/success/transparent_abstract.v
@@ -0,0 +1,21 @@
+Class by_transparent_abstract {T} (x : T) := make_by_transparent_abstract : T.
+Hint Extern 0 (@by_transparent_abstract ?T ?x) => change T; transparent_abstract exact_no_check x : typeclass_instances.
+
+Goal True /\ True.
+Proof.
+  split.
+  transparent_abstract exact I using foo.
+  let x := (eval hnf in foo) in constr_eq x I.
+  let x := constr:(ltac:(constructor) : True) in
+  let T := type of x in
+  let x := constr:(_ : by_transparent_abstract x) in
+  let x := (eval cbv delta [by_transparent_abstract] in (let y : T := x in y)) in
+  pose x as x'.
+  simpl in x'.
+  let v := eval cbv [x'] in x' in tryif constr_eq v I then fail 0 else idtac.
+  hnf in x'.
+  let v := eval cbv [x'] in x' in tryif constr_eq v I then idtac else fail 0.
+  exact x'.
+Defined.
+Check eq_refl : I = foo.
+Eval compute in foo.
diff --git a/test-suite/success/unfold.v b/test-suite/success/unfold.v
index d595cbc2..de8aa252 100644
--- a/test-suite/success/unfold.v
+++ b/test-suite/success/unfold.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (* Test le Hint Unfold sur des var locales *)
 
diff --git a/test-suite/success/unidecls.v b/test-suite/success/unidecls.v
new file mode 100644
index 00000000..c4a1d7c2
--- /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 296686e1..1ffc0267 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.
@@ -188,3 +188,14 @@ Proof.
   apply idpath.
   apply idpath.
 Defined.
+
+(* An example where it is necessary to evar-normalize the instance of
+   an evar to evaluate if it is a pattern *)
+
+Check
+  let a := ?[P] in
+  fun (H : forall y (P : nat -> Prop), y = 0 -> P y)
+      x (p:x=0) =>
+    H ?[y] a p : x = 0.
+(* We have to solve "?P ?y[x] == x = 0" knowing from
+   "p : (x=0) == (?y[x] = 0)" that "?y := x" *)
diff --git a/test-suite/success/univers.v b/test-suite/success/univers.v
index 269359ae..28634045 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/univnames.v b/test-suite/success/univnames.v
index 048b53d2..fe3b8c1d 100644
--- a/test-suite/success/univnames.v
+++ b/test-suite/success/univnames.v
@@ -21,6 +21,17 @@ Inductive bla@{l k} : Type@{k} := blaI : Type@{l} -> bla.
 Inductive blacopy@{k l} : Type@{k} := blacopyI : Type@{l} -> blacopy.
 
 
+Class Wrap A := wrap : A.
+
+Fail Instance bad@{} : Wrap Type := Type.
+
+Instance bad@{} : Wrap Type.
+Fail Proof Type.
+Abort.
+
+Instance bar@{u} : Wrap@{u} Set. Proof nat.
+
+
 Monomorphic Universe g.
 
-Inductive blacopy'@{l} : Type@{g} := blacopy'I : Type@{l} -> blacopy'.
\ No newline at end of file
+Inductive blacopy'@{l} : Type@{g} := blacopy'I : Type@{l} -> blacopy'.
diff --git a/test-suite/success/unshelve.v b/test-suite/success/unshelve.v
index 672222bd..a4fa544c 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/success/vm_evars.v b/test-suite/success/vm_evars.v
new file mode 100644
index 00000000..2c8b099e
--- /dev/null
+++ b/test-suite/success/vm_evars.v
@@ -0,0 +1,23 @@
+Fixpoint iter {A} (n : nat) (f : A -> A) (x : A) :=
+match n with
+| 0 => x
+| S n => iter n f (f x)
+end.
+
+Goal nat -> True.
+Proof.
+intros n.
+evar (f : nat -> nat).
+cut (iter 10 f 0 = 0).
+vm_compute.
+intros; constructor.
+instantiate (f := (fun x => x)).
+reflexivity.
+Qed.
+
+Goal exists x, x = 5 + 5.
+Proof.
+  eexists.
+  vm_compute.
+  reflexivity.
+Qed.
diff --git a/test-suite/typeclasses/NewSetoid.v b/test-suite/typeclasses/NewSetoid.v
index 49f20a23..81c4a146 100644
--- a/test-suite/typeclasses/NewSetoid.v
+++ b/test-suite/typeclasses/NewSetoid.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Certified Haskell Prelude.
diff --git a/test-suite/typeclasses/deftwice.v b/test-suite/typeclasses/deftwice.v
index 439782c9..13944770 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 663a837f..51891243 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/Arith/Arith.v b/theories/Arith/Arith.v
index 953f7e4d..1cba8faf 100644
--- a/theories/Arith/Arith.v
+++ b/theories/Arith/Arith.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Arith_base.
diff --git a/theories/Arith/Arith_base.v b/theories/Arith/Arith_base.v
index b378828e..e3a033a4 100644
--- a/theories/Arith/Arith_base.v
+++ b/theories/Arith/Arith_base.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export PeanoNat.
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index 58d3a2b3..25d84a62 100644
--- a/theories/Arith/Between.v
+++ b/theories/Arith/Between.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Le.
@@ -16,6 +18,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).
@@ -24,7 +28,7 @@ Section Between.
 
   Lemma bet_eq : forall k l, l = k -> between k l.
   Proof.
-    induction 1; auto with arith.
+    intros * ->; auto with arith.
   Qed.
 
   Hint Resolve bet_eq: arith.
@@ -37,9 +41,7 @@ Section Between.
 
   Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l.
   Proof.
-    intros k l H; induction H as [|l H].
-    intros; absurd (S k <= k); auto with arith.
-    destruct H; auto with arith.
+    induction 1 as [|* [|]]; auto with arith.
   Qed.
   Hint Resolve between_Sk_l: arith.
 
@@ -49,6 +51,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).
@@ -74,32 +78,32 @@ Section Between.
 
   Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r.
   Proof.
-    red; auto with arith.
+    split; assumption.
   Qed.
   Hint Resolve in_int_intro: arith.
 
   Lemma in_int_lt : forall p q r, in_int p q r -> p < q.
   Proof.
-    induction 1; intros.
-    apply le_lt_trans with r; auto with arith.
+    intros * [].
+    eapply le_lt_trans; eassumption.
   Qed.
 
   Lemma in_int_p_Sq :
-    forall p q r, in_int p (S q) r -> in_int p q r \/ r = q :>nat.
+    forall p q r, in_int p (S q) r -> in_int p q r \/ r = q.
   Proof.
-    induction 1; intros.
-    elim (le_lt_or_eq r q); auto with arith.
+    intros p q r [].
+    destruct (le_lt_or_eq r q); auto with arith.
   Qed.
 
   Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r.
   Proof.
-    induction 1; auto with arith.
+    intros * []; auto with arith.
   Qed.
   Hint Resolve in_int_S: arith.
 
   Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r.
   Proof.
-    induction 1; auto with arith.
+    intros * []; auto with arith.
   Qed.
   Hint Immediate in_int_Sp_q: arith.
 
@@ -107,10 +111,9 @@ Section Between.
     forall k l, between k l -> forall r, in_int k l r -> P r.
   Proof.
     induction 1; intros.
-    absurd (k < k); auto with arith.
-    apply in_int_lt with r; auto with arith.
-    elim (in_int_p_Sq k l r); intros; auto with arith.
-    rewrite H2; trivial with arith.
+    - absurd (k < k). { auto with arith. }
+      eapply in_int_lt; eassumption.
+    - destruct (in_int_p_Sq k l r) as [| ->]; auto with arith.
   Qed.
 
   Lemma in_int_between :
@@ -120,17 +123,17 @@ Section Between.
   Qed.
 
   Lemma exists_in_int :
-    forall k l, exists_between k l ->  exists2 m : nat, in_int k l m & Q m.
+    forall k l, exists_between k l -> exists2 m : nat, in_int k l m & Q m.
   Proof.
-    induction 1.
-    case IHexists_between; intros p inp Qp; exists p; auto with arith.
-    exists l; auto with arith.
+    induction 1 as [* ? (p, ?, ?)|].
+    - exists p; auto with arith.
+    - exists l; auto with arith.
   Qed.
 
   Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l.
   Proof.
-    destruct 1; intros.
-    elim H0; auto with arith.
+    intros * (?, lt_r_l) ?.
+    induction lt_r_l; auto with arith.
   Qed.
 
   Lemma between_or_exists :
@@ -139,9 +142,11 @@ Section Between.
       (forall n:nat, in_int k l n -> P n \/ Q n) ->
       between k l \/ exists_between k l.
   Proof.
-    induction 1; intros; auto with arith.
-    elim IHle; intro; auto with arith.
-    elim (H0 m); auto with arith.
+    induction 1 as [|m ? IHle].
+    - auto with arith.
+    - intros P_or_Q.
+      destruct IHle; auto with arith.
+      destruct (P_or_Q m); auto with arith.
   Qed.
 
   Lemma between_not_exists :
@@ -150,14 +155,14 @@ Section Between.
       (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l.
   Proof.
     induction 1; red; intros.
-    absurd (k < k); auto with arith.
-    absurd (Q l); auto with arith.
-    elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'.
-    replace l with l'; auto with arith.
-    elim inl'; intros.
-    elim (le_lt_or_eq l' l); auto with arith; intros.
-    absurd (exists_between k l); auto with arith.
-    apply in_int_exists with l'; auto with arith.
+    - absurd (k < k); auto with arith.
+    - absurd (Q l). { auto with arith. }
+      destruct (exists_in_int k (S l)) as (l',[],?).
+      + auto with arith.
+      + replace l with l'. { trivial. }
+        destruct (le_lt_or_eq l' l); auto with arith.
+        absurd (exists_between k l). { auto with arith. }
+        eapply in_int_exists; eauto with arith.
   Qed.
 
   Inductive P_nth (init:nat) : nat -> nat -> Prop :=
@@ -168,15 +173,16 @@ Section Between.
 
   Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l.
   Proof.
-    induction 1; intros; auto with arith.
-    apply le_trans with (S k); auto with arith.
+    induction 1.
+    - auto with arith.
+    - eapply le_trans; eauto with arith.
   Qed.
 
   Definition eventually (n:nat) :=  exists2 k : nat, k <= n & Q k.
 
   Lemma event_O : eventually 0 -> Q 0.
   Proof.
-    induction 1; intros.
+    intros (x, ?, ?).
     replace 0 with x; auto with arith.
   Qed.
 
diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v
index 602555b6..d892542e 100644
--- a/theories/Arith/Bool_nat.v
+++ b/theories/Arith/Bool_nat.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Compare_dec.
diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v
index 610e9a69..6778d6a0 100644
--- a/theories/Arith/Compare.v
+++ b/theories/Arith/Compare.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Equality is decidable on [nat] *)
diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v
index 976507b5..713aef85 100644
--- a/theories/Arith/Compare_dec.v
+++ b/theories/Arith/Compare_dec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Le Lt Gt Decidable PeanoNat.
@@ -133,11 +135,11 @@ Qed.
     See now [Nat.compare] and its properties.
     In scope [nat_scope], the notation for [Nat.compare] is "?=" *)
 
-Notation nat_compare := Nat.compare (compat "8.4").
+Notation nat_compare := Nat.compare (compat "8.6").
 
-Notation nat_compare_spec := Nat.compare_spec (compat "8.4").
-Notation nat_compare_eq_iff := Nat.compare_eq_iff (compat "8.4").
-Notation nat_compare_S := Nat.compare_succ (compat "8.4").
+Notation nat_compare_spec := Nat.compare_spec (compat "8.6").
+Notation nat_compare_eq_iff := Nat.compare_eq_iff (compat "8.6").
+Notation nat_compare_S := Nat.compare_succ (only parsing).
 
 Lemma nat_compare_lt n m : n<m <-> (n ?= m) = Lt.
 Proof.
@@ -198,9 +200,9 @@ Qed.
     See now [Nat.leb] and its properties.
     In scope [nat_scope], the notation for [Nat.leb] is "<=?" *)
 
-Notation leb := Nat.leb (compat "8.4").
+Notation leb := Nat.leb (only parsing).
 
-Notation leb_iff := Nat.leb_le (compat "8.4").
+Notation leb_iff := Nat.leb_le (only parsing).
 
 Lemma leb_iff_conv m n : (n <=? m) = false <-> m < n.
 Proof.
diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v
index 016cb85e..a5e45783 100644
--- a/theories/Arith/Div2.v
+++ b/theories/Arith/Div2.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Nota : this file is OBSOLETE, and left only for compatibility.
@@ -18,7 +20,7 @@ Implicit Type n : nat.
 
 (** Here we define [n/2] and prove some of its properties *)
 
-Notation div2 := Nat.div2 (compat "8.4").
+Notation div2 := Nat.div2 (only parsing).
 
 (** Since [div2] is recursively defined on [0], [1] and [(S (S n))], it is
     useful to prove the corresponding induction principle *)
@@ -28,7 +30,7 @@ Lemma ind_0_1_SS :
     P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n.
 Proof.
   intros P H0 H1 H2.
-  fix 1.
+  fix ind_0_1_SS 1.
   destruct n as [|[|n]].
   - exact H0.
   - exact H1.
@@ -84,7 +86,7 @@ Qed.
 
 (** Properties related to the double ([2n]) *)
 
-Notation double := Nat.double (compat "8.4").
+Notation double := Nat.double (only parsing).
 
 Hint Unfold double Nat.double: arith.
 
@@ -103,7 +105,7 @@ Hint Resolve double_S: arith.
 Lemma even_odd_double n :
   (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
 Proof.
-  revert n. fix 1. destruct n as [|[|n]].
+  revert n. fix even_odd_double 1. destruct n as [|[|n]].
   - (* n = 0 *)
     split; split; auto with arith. inversion 1.
   - (* n = 1 *)
diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v
index f998c19f..4b51dfc0 100644
--- a/theories/Arith/EqNat.v
+++ b/theories/Arith/EqNat.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import PeanoNat.
@@ -69,10 +71,10 @@ Defined.
    We reuse the one already defined in module [Nat].
    In scope [nat_scope], the notation "=?" can be used. *)
 
-Notation beq_nat := Nat.eqb (compat "8.4").
+Notation beq_nat := Nat.eqb (only parsing).
 
-Notation beq_nat_true_iff := Nat.eqb_eq (compat "8.4").
-Notation beq_nat_false_iff := Nat.eqb_neq (compat "8.4").
+Notation beq_nat_true_iff := Nat.eqb_eq (only parsing).
+Notation beq_nat_false_iff := Nat.eqb_neq (only parsing).
 
 Lemma beq_nat_refl n : true = (n =? n).
 Proof.
diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v
index fbe98d17..29f4d3e2 100644
--- a/theories/Arith/Euclid.v
+++ b/theories/Arith/Euclid.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Mult.
diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v
index 3c8c250a..a1d0e9fc 100644
--- a/theories/Arith/Even.v
+++ b/theories/Arith/Even.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Nota : this file is OBSOLETE, and left only for compatibility.
@@ -36,7 +38,7 @@ Hint Constructors odd: arith.
 
 Lemma even_equiv : forall n, even n <-> Nat.Even n.
 Proof.
- fix 1.
+ fix even_equiv 1.
  destruct n as [|[|n]]; simpl.
  - split; [now exists 0 | constructor].
  - split.
@@ -50,7 +52,7 @@ Qed.
 
 Lemma odd_equiv : forall n, odd n <-> Nat.Odd n.
 Proof.
- fix 1.
+ fix odd_equiv 1.
  destruct n as [|[|n]]; simpl.
  - split.
    + inversion_clear 1.
diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v
index b119bb00..22f586d7 100644
--- a/theories/Arith/Factorial.v
+++ b/theories/Arith/Factorial.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import PeanoNat Plus Mult Lt.
diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v
index 67c94fdf..52ecf131 100644
--- a/theories/Arith/Gt.v
+++ b/theories/Arith/Gt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Theorems about [gt] in [nat].
diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v
index 0fbcec57..69626cc1 100644
--- a/theories/Arith/Le.v
+++ b/theories/Arith/Le.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Order on natural numbers.
@@ -26,17 +28,17 @@ Local Open Scope nat_scope.
 
 (** * [le] is an order on [nat] *)
 
-Notation le_refl := Nat.le_refl (compat "8.4").
-Notation le_trans := Nat.le_trans (compat "8.4").
-Notation le_antisym := Nat.le_antisymm (compat "8.4").
+Notation le_refl := Nat.le_refl (only parsing).
+Notation le_trans := Nat.le_trans (only parsing).
+Notation le_antisym := Nat.le_antisymm (only parsing).
 
 Hint Resolve le_trans: arith.
 Hint Immediate le_antisym: arith.
 
 (** * Properties of [le] w.r.t 0 *)
 
-Notation le_0_n := Nat.le_0_l (compat "8.4").  (* 0 <= n *)
-Notation le_Sn_0 := Nat.nle_succ_0 (compat "8.4").  (* ~ S n <= 0 *)
+Notation le_0_n := Nat.le_0_l (only parsing).  (* 0 <= n *)
+Notation le_Sn_0 := Nat.nle_succ_0 (only parsing).  (* ~ S n <= 0 *)
 
 Lemma le_n_0_eq n : n <= 0 -> 0 = n.
 Proof.
@@ -53,8 +55,8 @@ Proof Peano.le_n_S.
 Theorem le_S_n : forall n m, S n <= S m -> n <= m.
 Proof Peano.le_S_n.
 
-Notation le_n_Sn := Nat.le_succ_diag_r (compat "8.4"). (* n <= S n *)
-Notation le_Sn_n := Nat.nle_succ_diag_l (compat "8.4"). (* ~ S n <= n *)
+Notation le_n_Sn := Nat.le_succ_diag_r (only parsing). (* n <= S n *)
+Notation le_Sn_n := Nat.nle_succ_diag_l (only parsing). (* ~ S n <= n *)
 
 Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
 Proof Nat.lt_le_incl.
@@ -65,8 +67,8 @@ Hint Immediate le_n_0_eq le_Sn_le le_S_n : arith.
 
 (** * Properties of [le] w.r.t predecessor *)
 
-Notation le_pred_n := Nat.le_pred_l (compat "8.4"). (* pred n <= n *)
-Notation le_pred := Nat.pred_le_mono (compat "8.4"). (* n<=m -> pred n <= pred m *)
+Notation le_pred_n := Nat.le_pred_l (only parsing). (* pred n <= n *)
+Notation le_pred := Nat.pred_le_mono (only parsing). (* n<=m -> pred n <= pred m *)
 
 Hint Resolve le_pred_n: arith.
 
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index bfc2b91a..0c7515c6 100644
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Strict order on natural numbers.
@@ -23,7 +25,7 @@ Local Open Scope nat_scope.
 
 (** * Irreflexivity *)
 
-Notation lt_irrefl := Nat.lt_irrefl (compat "8.4"). (* ~ x < x *)
+Notation lt_irrefl := Nat.lt_irrefl (only parsing). (* ~ x < x *)
 
 Hint Resolve lt_irrefl: arith.
 
@@ -62,12 +64,12 @@ Hint Immediate le_not_lt lt_not_le: arith.
 
 (** * Asymmetry *)
 
-Notation lt_asym := Nat.lt_asymm (compat "8.4"). (* n<m -> ~m<n *)
+Notation lt_asym := Nat.lt_asymm (only parsing). (* n<m -> ~m<n *)
 
 (** * Order and 0 *)
 
-Notation lt_0_Sn := Nat.lt_0_succ (compat "8.4"). (* 0 < S n *)
-Notation lt_n_0 := Nat.nlt_0_r (compat "8.4"). (* ~ n < 0 *)
+Notation lt_0_Sn := Nat.lt_0_succ (only parsing). (* 0 < S n *)
+Notation lt_n_0 := Nat.nlt_0_r (only parsing). (* ~ n < 0 *)
 
 Theorem neq_0_lt n : 0 <> n -> 0 < n.
 Proof.
@@ -84,8 +86,8 @@ Hint Immediate neq_0_lt lt_0_neq: arith.
 
 (** * Order and successor *)
 
-Notation lt_n_Sn := Nat.lt_succ_diag_r (compat "8.4"). (* n < S n *)
-Notation lt_S := Nat.lt_lt_succ_r (compat "8.4"). (* n < m -> n < S m *)
+Notation lt_n_Sn := Nat.lt_succ_diag_r (only parsing). (* n < S n *)
+Notation lt_S := Nat.lt_lt_succ_r (only parsing). (* n < m -> n < S m *)
 
 Theorem lt_n_S n m : n < m -> S n < S m.
 Proof.
@@ -107,6 +109,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.
@@ -122,28 +129,28 @@ Hint Resolve lt_pred_n_n: arith.
 
 (** * Transitivity properties *)
 
-Notation lt_trans := Nat.lt_trans (compat "8.4").
-Notation lt_le_trans := Nat.lt_le_trans (compat "8.4").
-Notation le_lt_trans := Nat.le_lt_trans (compat "8.4").
+Notation lt_trans := Nat.lt_trans (only parsing).
+Notation lt_le_trans := Nat.lt_le_trans (only parsing).
+Notation le_lt_trans := Nat.le_lt_trans (only parsing).
 
 Hint Resolve lt_trans lt_le_trans le_lt_trans: arith.
 
 (** * Large = strict or equal *)
 
-Notation le_lt_or_eq_iff := Nat.lt_eq_cases (compat "8.4").
+Notation le_lt_or_eq_iff := Nat.lt_eq_cases (only parsing).
 
 Theorem le_lt_or_eq n m : n <= m -> n < m \/ n = m.
 Proof.
  apply Nat.lt_eq_cases.
 Qed.
 
-Notation lt_le_weak := Nat.lt_le_incl (compat "8.4").
+Notation lt_le_weak := Nat.lt_le_incl (only parsing).
 
 Hint Immediate lt_le_weak: arith.
 
 (** * Dichotomy *)
 
-Notation le_or_lt := Nat.le_gt_cases (compat "8.4"). (* n <= m \/ m < n *)
+Notation le_or_lt := Nat.le_gt_cases (only parsing). (* n <= m \/ m < n *)
 
 Theorem nat_total_order n m : n <> m -> n < m \/ m < n.
 Proof.
diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v
index 49152549..1727fa37 100644
--- a/theories/Arith/Max.v
+++ b/theories/Arith/Max.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** THIS FILE IS DEPRECATED. Use [PeanoNat.Nat] instead. *)
diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v
index 38e59b7b..fcf0b14c 100644
--- a/theories/Arith/Min.v
+++ b/theories/Arith/Min.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** THIS FILE IS DEPRECATED. Use [PeanoNat.Nat] instead. *)
diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v
index 1fc8f790..3bf6cd95 100644
--- a/theories/Arith/Minus.v
+++ b/theories/Arith/Minus.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of subtraction between natural numbers.
@@ -46,7 +48,7 @@ Qed.
 
 (** * Diagonal *)
 
-Notation minus_diag := Nat.sub_diag (compat "8.4"). (* n - n = 0 *)
+Notation minus_diag := Nat.sub_diag (only parsing). (* n - n = 0 *)
 
 Lemma minus_diag_reverse n : 0 = n - n.
 Proof.
@@ -87,13 +89,13 @@ Qed.
 (** * Relation with order *)
 
 Notation minus_le_compat_r :=
-  Nat.sub_le_mono_r (compat "8.4"). (* n <= m -> n - p <= m - p. *)
+  Nat.sub_le_mono_r (only parsing). (* n <= m -> n - p <= m - p. *)
 
 Notation minus_le_compat_l :=
-  Nat.sub_le_mono_l (compat "8.4"). (* n <= m -> p - m <= p - n. *)
+  Nat.sub_le_mono_l (only parsing). (* n <= m -> p - m <= p - n. *)
 
-Notation le_minus := Nat.le_sub_l (compat "8.4"). (* n - m <= n *)
-Notation lt_minus := Nat.sub_lt (compat "8.4"). (* m <= n -> 0 < m -> n-m < n *)
+Notation le_minus := Nat.le_sub_l (only parsing). (* n - m <= n *)
+Notation lt_minus := Nat.sub_lt (only parsing). (* m <= n -> 0 < m -> n-m < n *)
 
 Lemma lt_O_minus_lt n m : 0 < n - m -> m < n.
 Proof.
diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v
index a173efc1..4f4aa183 100644
--- a/theories/Arith/Mult.v
+++ b/theories/Arith/Mult.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Properties of multiplication.
@@ -23,35 +25,35 @@ Local Open Scope nat_scope.
 
 (** ** Zero property *)
 
-Notation mult_0_l := Nat.mul_0_l (compat "8.4"). (* 0 * n = 0 *)
-Notation mult_0_r := Nat.mul_0_r (compat "8.4"). (* n * 0 = 0 *)
+Notation mult_0_l := Nat.mul_0_l (only parsing). (* 0 * n = 0 *)
+Notation mult_0_r := Nat.mul_0_r (only parsing). (* n * 0 = 0 *)
 
 (** ** 1 is neutral *)
 
-Notation mult_1_l := Nat.mul_1_l (compat "8.4"). (* 1 * n = n *)
-Notation mult_1_r := Nat.mul_1_r (compat "8.4"). (* n * 1 = n *)
+Notation mult_1_l := Nat.mul_1_l (only parsing). (* 1 * n = n *)
+Notation mult_1_r := Nat.mul_1_r (only parsing). (* n * 1 = n *)
 
 Hint Resolve mult_1_l mult_1_r: arith.
 
 (** ** Commutativity *)
 
-Notation mult_comm := Nat.mul_comm (compat "8.4"). (* n * m = m * n *)
+Notation mult_comm := Nat.mul_comm (only parsing). (* n * m = m * n *)
 
 Hint Resolve mult_comm: arith.
 
 (** ** Distributivity *)
 
 Notation mult_plus_distr_r :=
-  Nat.mul_add_distr_r (compat "8.4"). (* (n+m)*p = n*p + m*p *)
+  Nat.mul_add_distr_r (only parsing). (* (n+m)*p = n*p + m*p *)
 
 Notation mult_plus_distr_l :=
-  Nat.mul_add_distr_l (compat "8.4"). (* n*(m+p) = n*m + n*p *)
+  Nat.mul_add_distr_l (only parsing). (* n*(m+p) = n*m + n*p *)
 
 Notation mult_minus_distr_r :=
-  Nat.mul_sub_distr_r (compat "8.4"). (* (n-m)*p = n*p - m*p *)
+  Nat.mul_sub_distr_r (only parsing). (* (n-m)*p = n*p - m*p *)
 
 Notation mult_minus_distr_l :=
-  Nat.mul_sub_distr_l (compat "8.4"). (* n*(m-p) = n*m - n*p *)
+  Nat.mul_sub_distr_l (only parsing). (* n*(m-p) = n*m - n*p *)
 
 Hint Resolve mult_plus_distr_r: arith.
 Hint Resolve mult_minus_distr_r: arith.
@@ -59,7 +61,7 @@ Hint Resolve mult_minus_distr_l: arith.
 
 (** ** Associativity *)
 
-Notation mult_assoc := Nat.mul_assoc (compat "8.4"). (* n*(m*p)=n*m*p *)
+Notation mult_assoc := Nat.mul_assoc (only parsing). (* n*(m*p)=n*m*p *)
 
 Lemma mult_assoc_reverse n m p : n * m * p = n * (m * p).
 Proof.
@@ -83,8 +85,8 @@ Qed.
 
 (** ** Multiplication and successor *)
 
-Notation mult_succ_l := Nat.mul_succ_l (compat "8.4"). (* S n * m = n * m + m *)
-Notation mult_succ_r := Nat.mul_succ_r (compat "8.4"). (* n * S m = n * m + n *)
+Notation mult_succ_l := Nat.mul_succ_l (only parsing). (* S n * m = n * m + m *)
+Notation mult_succ_r := Nat.mul_succ_r (only parsing). (* n * S m = n * m + n *)
 
 (** * Compatibility with orders *)
 
diff --git a/theories/Arith/PeanoNat.v b/theories/Arith/PeanoNat.v
index e3240bb7..bc58995f 100644
--- a/theories/Arith/PeanoNat.v
+++ b/theories/Arith/PeanoNat.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
@@ -313,7 +315,7 @@ Import Private_Parity.
 
 Lemma even_spec : forall n, even n = true <-> Even n.
 Proof.
- fix 1.
+ fix even_spec 1.
   destruct n as [|[|n]]; simpl.
   - split; [ now exists 0 | trivial ].
   - split; [ discriminate | intro H; elim (Even_1 H) ].
@@ -323,7 +325,7 @@ Qed.
 Lemma odd_spec : forall n, odd n = true <-> Odd n.
 Proof.
  unfold odd.
- fix 1.
+ fix odd_spec 1.
   destruct n as [|[|n]]; simpl.
   - split; [ discriminate | intro H; elim (Odd_0 H) ].
   - split; [ now exists 0 | trivial ].
@@ -471,7 +473,7 @@ Notation "( x | y )" := (divide x y) (at level 0) : nat_scope.
 
 Lemma gcd_divide : forall a b, (gcd a b | a) /\ (gcd a b | b).
 Proof.
- fix 1.
+ fix gcd_divide 1.
  intros [|a] b; simpl.
  split.
   now exists 0.
@@ -500,7 +502,7 @@ Qed.
 
 Lemma gcd_greatest : forall a b c, (c|a) -> (c|b) -> (c|gcd a b).
 Proof.
- fix 1.
+ fix gcd_greatest 1.
  intros [|a] b; simpl; auto.
  fold (b mod (S a)).
  intros c H H'. apply gcd_greatest; auto.
@@ -534,7 +536,7 @@ Qed.
 Lemma le_div2 n : div2 (S n) <= n.
 Proof.
  revert n.
- fix 1.
+ fix le_div2 1.
  destruct n; simpl; trivial. apply lt_succ_r.
  destruct n; [simpl|]; trivial. now constructor.
 Qed.
@@ -724,6 +726,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 f8020a50..9a24c804 100644
--- a/theories/Arith/Peano_dec.v
+++ b/theories/Arith/Peano_dec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Decidable PeanoNat.
@@ -19,7 +21,7 @@ Proof.
   - left; exists n; auto.
 Defined.
 
-Notation eq_nat_dec := Nat.eq_dec (compat "8.4").
+Notation eq_nat_dec := Nat.eq_dec (only parsing).
 
 Hint Resolve O_or_S eq_nat_dec: arith.
 
@@ -57,4 +59,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/Arith/Plus.v b/theories/Arith/Plus.v
index 600e5e51..b8297c2d 100644
--- a/theories/Arith/Plus.v
+++ b/theories/Arith/Plus.v
@@ -1,9 +1,11 @@
- (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(************************************************************************)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of addition.
@@ -27,12 +29,12 @@ Local Open Scope nat_scope.
 
 (** * Neutrality of 0, commutativity, associativity *)
 
-Notation plus_0_l := Nat.add_0_l (compat "8.4").
-Notation plus_0_r := Nat.add_0_r (compat "8.4").
-Notation plus_comm := Nat.add_comm (compat "8.4").
-Notation plus_assoc := Nat.add_assoc (compat "8.4").
+Notation plus_0_l := Nat.add_0_l (only parsing).
+Notation plus_0_r := Nat.add_0_r (only parsing).
+Notation plus_comm := Nat.add_comm (only parsing).
+Notation plus_assoc := Nat.add_assoc (only parsing).
 
-Notation plus_permute := Nat.add_shuffle3 (compat "8.4").
+Notation plus_permute := Nat.add_shuffle3 (only parsing).
 
 Definition plus_Snm_nSm : forall n m, S n + m = n + S m :=
  Peano.plus_n_Sm.
@@ -138,7 +140,7 @@ Defined.
 
 (** * Derived properties *)
 
-Notation plus_permute_2_in_4 := Nat.add_shuffle1 (compat "8.4").
+Notation plus_permute_2_in_4 := Nat.add_shuffle1 (only parsing).
 
 (** * Tail-recursive plus *)
 
diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v
index 94bbd50a..b0228898 100644
--- a/theories/Arith/Wf_nat.v
+++ b/theories/Arith/Wf_nat.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Well-founded relations and natural numbers *)
diff --git a/theories/Arith/vo.itarget b/theories/Arith/vo.itarget
deleted file mode 100644
index 0b3d31e9..00000000
--- a/theories/Arith/vo.itarget
+++ /dev/null
@@ -1,22 +0,0 @@
-PeanoNat.vo
-Arith_base.vo
-Arith.vo
-Between.vo
-Bool_nat.vo
-Compare_dec.vo
-Compare.vo
-Div2.vo
-EqNat.vo
-Euclid.vo
-Even.vo
-Factorial.vo
-Gt.vo
-Le.vo
-Lt.vo
-Max.vo
-Minus.vo
-Min.vo
-Mult.vo
-Peano_dec.vo
-Plus.vo
-Wf_nat.vo
diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v
index 06096c66..edf78ed5 100644
--- a/theories/Bool/Bool.v
+++ b/theories/Bool/Bool.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The type [bool] is defined in the prelude as
diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v
index aec4f0bb..106a79e8 100644
--- a/theories/Bool/BoolEq.v
+++ b/theories/Bool/BoolEq.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Cuihtlauac Alvarado - octobre 2000 *)
diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v
index 09f643c8..aecdb59d 100644
--- a/theories/Bool/Bvector.v
+++ b/theories/Bool/Bvector.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *)
diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v
index 501366ce..f84aed19 100644
--- a/theories/Bool/DecBool.v
+++ b/theories/Bool/DecBool.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Set Implicit Arguments.
diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v
index 4257b4bc..6f99ea1d 100644
--- a/theories/Bool/IfProp.v
+++ b/theories/Bool/IfProp.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool.
diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v
index fd7f42e2..5333c741 100644
--- a/theories/Bool/Sumbool.v
+++ b/theories/Bool/Sumbool.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Here are collected some results about the type sumbool (see INIT/Specif.v)
diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v
index 16e47ac5..2420c0fd 100644
--- a/theories/Bool/Zerob.v
+++ b/theories/Bool/Zerob.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Arith.
diff --git a/theories/Bool/vo.itarget b/theories/Bool/vo.itarget
deleted file mode 100644
index 24cbf4ed..00000000
--- a/theories/Bool/vo.itarget
+++ /dev/null
@@ -1,7 +0,0 @@
-BoolEq.vo
-Bool.vo
-Bvector.vo
-DecBool.vo
-IfProp.vo
-Sumbool.vo
-Zerob.vo
diff --git a/theories/Classes/CEquivalence.v b/theories/Classes/CEquivalence.v
index bd01de47..03e611f5 100644
--- a/theories/Classes/CEquivalence.v
+++ b/theories/Classes/CEquivalence.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Typeclass-based setoids. Definitions on [Equivalence].
diff --git a/theories/Classes/CMorphisms.v b/theories/Classes/CMorphisms.v
index 1cfca416..09b35ca7 100644
--- a/theories/Classes/CMorphisms.v
+++ b/theories/Classes/CMorphisms.v
@@ -1,10 +1,12 @@
-(* -*- coding: utf-8 -*- *)
+(* -*- coding: utf-8; coq-prog-args: ("-coqlib" "../.." "-R" ".." "Coq" "-top" "Coq.Classes.CMorphisms") -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Typeclass-based morphism definition and standard, minimal instances
diff --git a/theories/Classes/CRelationClasses.v b/theories/Classes/CRelationClasses.v
index 3d7ef01f..bc821532 100644
--- a/theories/Classes/CRelationClasses.v
+++ b/theories/Classes/CRelationClasses.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Typeclass-based relations, tactics and standard instances
@@ -305,9 +307,7 @@ Section Binary.
     fun x y => sum (R x y) (R' x y).
   
   (** Relation equivalence is an equivalence, and subrelation defines a partial order. *)
-  
-  Set Automatic Introduction.
-  
+
   Global Instance relation_equivalence_equivalence :
     Equivalence relation_equivalence.
   Proof. split; red; unfold relation_equivalence, iffT. firstorder. 
diff --git a/theories/Classes/DecidableClass.v b/theories/Classes/DecidableClass.v
index a3b7e311..bffad2b3 100644
--- a/theories/Classes/DecidableClass.v
+++ b/theories/Classes/DecidableClass.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * A typeclass to ease the handling of decidable properties. *)
diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v
index 52313735..e9a9d6af 100644
--- a/theories/Classes/EquivDec.v
+++ b/theories/Classes/EquivDec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Decidable equivalences.
diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v
index 80b0b7e4..5217aedb 100644
--- a/theories/Classes/Equivalence.v
+++ b/theories/Classes/Equivalence.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Typeclass-based setoids. Definitions on [Equivalence].
diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v
index c13b36fd..8a04206b 100644
--- a/theories/Classes/Init.v
+++ b/theories/Classes/Init.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Initialization code for typeclasses, setting up the default tactic
diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v
index 06511ace..1858ba76 100644
--- a/theories/Classes/Morphisms.v
+++ b/theories/Classes/Morphisms.v
@@ -1,10 +1,12 @@
-(* -*- coding: utf-8 -*- *)
+(* -*- coding: utf-8; coq-prog-args: ("-coqlib" "../.." "-R" ".." "Coq" "-top" "Coq.Classes.Morphisms") -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Typeclass-based morphism definition and standard, minimal instances
diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v
index 15900177..8881fda5 100644
--- a/theories/Classes/Morphisms_Prop.v
+++ b/theories/Classes/Morphisms_Prop.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * [Proper] instances for propositional connectives.
diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v
index 6048fe06..a3e57501 100644
--- a/theories/Classes/Morphisms_Relations.v
+++ b/theories/Classes/Morphisms_Relations.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Morphism instances for relations.
diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v
index 11c204da..2ab3af20 100644
--- a/theories/Classes/RelationClasses.v
+++ b/theories/Classes/RelationClasses.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Typeclass-based relations, tactics and standard instances
@@ -433,9 +435,7 @@ Section Binary.
     @predicate_union (A::A::Tnil) R R'.
   
   (** Relation equivalence is an equivalence, and subrelation defines a partial order. *)
-  
-  Set Automatic Introduction.
-  
+
   Global Instance relation_equivalence_equivalence :
     Equivalence relation_equivalence.
   Proof. exact (@predicate_equivalence_equivalence (A::A::Tnil)). Qed.
diff --git a/theories/Classes/RelationPairs.v b/theories/Classes/RelationPairs.v
index 8d1c4982..7af2b0fc 100644
--- a/theories/Classes/RelationPairs.v
+++ b/theories/Classes/RelationPairs.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Relations over pairs *)
 
diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v
index 4b133a4d..2673a119 100644
--- a/theories/Classes/SetoidClass.v
+++ b/theories/Classes/SetoidClass.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Typeclass-based setoids, tactics and standard instances.
diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v
index 7201c0b1..f6b240bf 100644
--- a/theories/Classes/SetoidDec.v
+++ b/theories/Classes/SetoidDec.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Decidable setoid equality theory.
diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v
index 190397ae..3fab3c5a 100644
--- a/theories/Classes/SetoidTactics.v
+++ b/theories/Classes/SetoidTactics.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Tactics for typeclass-based setoids.
diff --git a/theories/Classes/vo.itarget b/theories/Classes/vo.itarget
deleted file mode 100644
index 18147f2a..00000000
--- a/theories/Classes/vo.itarget
+++ /dev/null
@@ -1,15 +0,0 @@
-DecidableClass.vo
-Equivalence.vo
-EquivDec.vo
-Init.vo
-Morphisms_Prop.vo
-Morphisms_Relations.vo
-Morphisms.vo
-RelationClasses.vo
-SetoidClass.vo
-SetoidDec.vo
-SetoidTactics.vo
-RelationPairs.vo
-CRelationClasses.vo
-CMorphisms.vo
-CEquivalence.vo
diff --git a/theories/Compat/AdmitAxiom.v b/theories/Compat/AdmitAxiom.v
index 4d9f55cf..f6b751bd 100644
--- a/theories/Compat/AdmitAxiom.v
+++ b/theories/Compat/AdmitAxiom.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Compatibility file for making the admit tactic act similar to Coq v8.4. In
diff --git a/theories/Compat/Coq84.v b/theories/Compat/Coq84.v
deleted file mode 100644
index a3e23f91..00000000
--- a/theories/Compat/Coq84.v
+++ /dev/null
@@ -1,79 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Compatibility file for making Coq act similar to Coq v8.4 *)
-
-(** Any compatibility changes to make future versions of Coq behave like Coq 8.5 are likely needed to make them behave like Coq 8.4. *)
-Require Export Coq.Compat.Coq85.
-
-(** See https://coq.inria.fr/bugs/show_bug.cgi?id=4319 for updates *)
-(** This is required in Coq 8.5 to use the [omega] tactic; in Coq 8.4, it's automatically available.  But ZArith_base puts infix ~ at level 7, and we don't want that, so we don't [Import] it. *)
-Require Coq.omega.Omega.
-Ltac omega := Coq.omega.Omega.omega.
-
-(** The number of arguments given in [match] statements has changed from 8.4 to 8.5. *)
-Global Set Asymmetric Patterns.
-
-(** The automatic elimination schemes for records were dropped by default in 8.5.  This restores the default behavior of Coq 8.4. *)
-Global Set Nonrecursive Elimination Schemes.
-
-(** See bug 3545 *)
-Global Set Universal Lemma Under Conjunction.
-
-(** Feature introduced in 8.5, disabled by default and configurable since 8.6. *)
-Global Unset Refolding Reduction.
-
-(** In 8.4, [constructor (tac)] allowed backtracking across the use of [constructor]; it has been subsumed by [constructor; tac]. *)
-Ltac constructor_84_n n := constructor n.
-Ltac constructor_84_tac tac := once (constructor; tac).
-
-Tactic Notation "constructor" := Coq.Init.Notations.constructor.
-Tactic Notation "constructor" int_or_var(n) := constructor_84_n n.
-Tactic Notation "constructor" "(" tactic(tac) ")" := constructor_84_tac tac.
-
-(** In 8.4, [econstructor (tac)] allowed backtracking across the use of [econstructor]; it has been subsumed by [econstructor; tac]. *)
-Ltac econstructor_84_n n := econstructor n.
-Ltac econstructor_84_tac tac := once (econstructor; tac).
-
-Tactic Notation "econstructor" := Coq.Init.Notations.econstructor.
-Tactic Notation "econstructor" int_or_var(n) := econstructor_84_n n.
-Tactic Notation "econstructor" "(" tactic(tac) ")" := econstructor_84_tac tac.
-
-(** Some tactic notations do not factor well with tactics; we add global parsing entries for some tactics that would otherwise be overwritten by custom variants. See https://coq.inria.fr/bugs/show_bug.cgi?id=4392. *)
-Tactic Notation "reflexivity" := reflexivity.
-Tactic Notation "assumption" := assumption.
-Tactic Notation "etransitivity" := etransitivity.
-Tactic Notation "cut" constr(c) := cut c.
-Tactic Notation "exact_no_check" constr(c) := exact_no_check c.
-Tactic Notation "vm_cast_no_check" constr(c) := vm_cast_no_check c.
-Tactic Notation "casetype" constr(c) := casetype c.
-Tactic Notation "elimtype" constr(c) := elimtype c.
-Tactic Notation "lapply" constr(c) := lapply c.
-Tactic Notation "transitivity" constr(c) := transitivity c.
-Tactic Notation "left" := left.
-Tactic Notation "eleft" := eleft.
-Tactic Notation "right" := right.
-Tactic Notation "eright" := eright.
-Tactic Notation "symmetry" := symmetry.
-Tactic Notation "split" := split.
-Tactic Notation "esplit" := esplit.
-
-(** Many things now import [PeanoNat] rather than [NPeano], so we require it so that the old absolute names in [NPeano.Nat] are available. *)
-Require Coq.Numbers.Natural.Peano.NPeano.
-
-(** The following coercions were declared by default in Specif.v. *)
-Coercion sig_of_sig2 : sig2 >-> sig.
-Coercion sigT_of_sigT2 : sigT2 >-> sigT.
-Coercion sigT_of_sig : sig >-> sigT.
-Coercion sig_of_sigT : sigT >-> sig.
-Coercion sigT2_of_sig2 : sig2 >-> sigT2.
-Coercion sig2_of_sigT2 : sigT2 >-> sig2.
-
-(** In 8.4, the statement of admitted lemmas did not depend on the section
-    variables. *)
-Unset Keep Admitted Variables.
diff --git a/theories/Compat/Coq85.v b/theories/Compat/Coq85.v
deleted file mode 100644
index 64ba6b1e..00000000
--- a/theories/Compat/Coq85.v
+++ /dev/null
@@ -1,36 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Compatibility file for making Coq act similar to Coq v8.5 *)
-
-(** Any compatibility changes to make future versions of Coq behave like Coq 8.6
-    are likely needed to make them behave like Coq 8.5. *)
-Require Export Coq.Compat.Coq86.
-
-(** We use some deprecated options in this file, so we disable the
-    corresponding warning, to silence the build of this file. *)
-Local Set Warnings "-deprecated-option".
-
-(* In 8.5, "intros [|]", taken e.g. on a goal "A\/B->C", does not
-   behave as "intros [H|H]" but leave instead hypotheses quantified in
-   the goal, here producing subgoals A->C and B->C. *)
-
-Global Unset Bracketing Last Introduction Pattern.
-Global Unset Regular Subst Tactic.
-Global Unset Structural Injection.
-Global Unset Shrink Abstract.
-Global Unset Shrink Obligations.
-Global Set Refolding Reduction.
-
-(** The resolution algorithm for type classes has changed. *)
-Global Set Typeclasses Legacy Resolution.
-Global Set Typeclasses Limit Intros.
-Global Unset Typeclasses Filtered Unification.
-
-(** Allow silently letting unification constraints float after a "." *)
-Global Unset Solve Unification Constraints.
diff --git a/theories/Compat/Coq86.v b/theories/Compat/Coq86.v
index 6952fdf1..666be207 100644
--- a/theories/Compat/Coq86.v
+++ b/theories/Compat/Coq86.v
@@ -1,9 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-(** Compatibility file for making Coq act similar to Coq v8.6 *)
\ No newline at end of file
+(** Compatibility file for making Coq act similar to Coq v8.6 *)
+Require Export Coq.Compat.Coq87.
+
+Require Export Coq.extraction.Extraction.
+Require Export Coq.funind.FunInd.
diff --git a/theories/Compat/Coq87.v b/theories/Compat/Coq87.v
new file mode 100644
index 00000000..dc1397af
--- /dev/null
+++ b/theories/Compat/Coq87.v
@@ -0,0 +1,23 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Compatibility file for making Coq act similar to Coq v8.7 *)
+Require Export Coq.Compat.Coq88.
+
+(* 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/Compat/Coq88.v b/theories/Compat/Coq88.v
new file mode 100644
index 00000000..4142af05
--- /dev/null
+++ b/theories/Compat/Coq88.v
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Compatibility file for making Coq act similar to Coq v8.8 *)
diff --git a/theories/Compat/vo.itarget b/theories/Compat/vo.itarget
deleted file mode 100644
index 7ffb86eb..00000000
--- a/theories/Compat/vo.itarget
+++ /dev/null
@@ -1,4 +0,0 @@
-AdmitAxiom.vo
-Coq84.vo
-Coq85.vo
-Coq86.vo
diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v
index c9e5b8dd..3485b9c6 100644
--- a/theories/FSets/FMapAVL.v
+++ b/theories/FSets/FMapAVL.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (* Finite map library.  *)
 
@@ -16,7 +18,7 @@
     See the comments at the beginning of FSetAVL for more details.
 *)
 
-Require Import FMapInterface FMapList ZArith Int.
+Require Import FunInd FMapInterface FMapList ZArith Int.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v
index 3c5690a7..99705966 100644
--- a/theories/FSets/FMapFacts.v
+++ b/theories/FSets/FMapFacts.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite maps library *)
 
@@ -24,7 +26,7 @@ Hint Extern 1 (Equivalence _) => constructor; congruence.
 
 Module WFacts_fun (E:DecidableType)(Import M:WSfun E).
 
-Notation option_map := option_map (compat "8.4").
+Notation option_map := option_map (compat "8.6").
 
 Notation eq_dec := E.eq_dec.
 Definition eqb x y := if eq_dec x y then true else false.
@@ -440,7 +442,7 @@ destruct (eq_dec x y); auto.
 Qed.
 
 Lemma map_o : forall m x (f:elt->elt'),
- find x (map f m) = option_map f (find x m).
+ find x (map f m) = Datatypes.option_map f (find x m).
 Proof.
 intros.
 generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x)
@@ -473,7 +475,7 @@ Qed.
 
 Lemma mapi_o : forall m x (f:key->elt->elt'),
  (forall x y e, E.eq x y -> f x e = f y e) ->
- find x (mapi f m) = option_map (f x) (find x m).
+ find x (mapi f m) = Datatypes.option_map (f x) (find x m).
 Proof.
 intros.
 generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x)
diff --git a/theories/FSets/FMapFullAVL.v b/theories/FSets/FMapFullAVL.v
index a7be3232..34529678 100644
--- a/theories/FSets/FMapFullAVL.v
+++ b/theories/FSets/FMapFullAVL.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (* Finite map library.  *)
 
@@ -25,7 +27,7 @@
 
 *)
 
-Require Import Recdef FMapInterface FMapList ZArith Int FMapAVL ROmega.
+Require Import FunInd Recdef FMapInterface FMapList ZArith Int FMapAVL ROmega.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
diff --git a/theories/FSets/FMapInterface.v b/theories/FSets/FMapInterface.v
index 4d89b562..38a96dc3 100644
--- a/theories/FSets/FMapInterface.v
+++ b/theories/FSets/FMapInterface.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite map library *)
 
diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v
index 5acdb7eb..3e98d119 100644
--- a/theories/FSets/FMapList.v
+++ b/theories/FSets/FMapList.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite map library *)
 
@@ -12,7 +14,7 @@
  [FMapInterface.S] using lists of pairs ordered (increasing) with respect to
  left projection. *)
 
-Require Import FMapInterface.
+Require Import FunInd FMapInterface.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v
index b1c0fdaa..0fc68b14 100644
--- a/theories/FSets/FMapPositive.v
+++ b/theories/FSets/FMapPositive.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * FMapPositive : an implementation of FMapInterface for [positive] keys. *)
 
@@ -654,19 +656,19 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
 
   Lemma xelements_bits_lt_1 : forall p p0 q m v,
      List.In (p0,v) (xelements m (append p (xO q))) -> E.bits_lt p0 p.
-  Proof.
+  Proof using.
   intros.
   generalize (xelements_complete _ _ _ _ H); clear H; intros.
-  revert p0 q m v H.
+  revert p0 H.
   induction p; destruct p0; simpl; intros; eauto; try discriminate.
   Qed.
 
   Lemma xelements_bits_lt_2 : forall p p0 q m v,
      List.In (p0,v) (xelements m (append p (xI q))) -> E.bits_lt p p0.
-  Proof.
+  Proof using.
   intros.
   generalize (xelements_complete _ _ _ _ H); clear H; intros.
-  revert p0 q m v H.
+  revert p0 H.
   induction p; destruct p0; simpl; intros; eauto; try discriminate.
   Qed.
 
diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v
index 130cbee8..67360965 100644
--- a/theories/FSets/FMapWeakList.v
+++ b/theories/FSets/FMapWeakList.v
@@ -1,17 +1,19 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite map library *)
 
 (** This file proposes an implementation of the non-dependent interface
  [FMapInterface.WS] using lists of pairs, unordered but without redundancy. *)
 
-Require Import FMapInterface.
+Require Import FunInd FMapInterface.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
diff --git a/theories/FSets/FMaps.v b/theories/FSets/FMaps.v
index 19b25d95..ec507635 100644
--- a/theories/FSets/FMaps.v
+++ b/theories/FSets/FMaps.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 
 Require Export OrderedType OrderedTypeEx OrderedTypeAlt.
diff --git a/theories/FSets/FSetAVL.v b/theories/FSets/FSetAVL.v
index df627a14..dcaea894 100644
--- a/theories/FSets/FSetAVL.v
+++ b/theories/FSets/FSetAVL.v
@@ -1,11 +1,13 @@
 (* -*- coding: utf-8 -*- *)
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * FSetAVL : Implementation of FSetInterface via AVL trees *)
 
@@ -13,7 +15,7 @@
     It follows the implementation from Ocaml's standard library,
 
     All operations given here expect and produce well-balanced trees
-    (in the ocaml sense: heigths of subtrees shouldn't differ by more
+    (in the ocaml sense: heights of subtrees shouldn't differ by more
     than 2), and hence has low complexities (e.g. add is logarithmic
     in the size of the set). But proving these balancing preservations
     is in fact not necessary for ensuring correct operational behavior
diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v
index 97f140b3..0c4ecb1f 100644
--- a/theories/FSets/FSetBridge.v
+++ b/theories/FSets/FSetBridge.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/FSets/FSetCompat.v b/theories/FSets/FSetCompat.v
index b1769da3..736c85da 100644
--- a/theories/FSets/FSetCompat.v
+++ b/theories/FSets/FSetCompat.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Compatibility functors between FSetInterface and MSetInterface. *)
 
@@ -165,13 +167,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 +184,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 +213,7 @@ Module Backport_Sets
     [ apply EQ | apply LT | apply GT ]; auto.
   Defined.
 
-  Module E := E.
+  Module E := O.
 
 End Backport_Sets.
 
@@ -342,13 +344,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 +361,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 +409,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/FSetDecide.v b/theories/FSets/FSetDecide.v
index 1db6a71e..83bb07ff 100644
--- a/theories/FSets/FSetDecide.v
+++ b/theories/FSets/FSetDecide.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (**************************************************************)
 (* FSetDecide.v                                               *)
diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v
index f2f4cc2c..56844f47 100644
--- a/theories/FSets/FSetEqProperties.v
+++ b/theories/FSets/FSetEqProperties.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v
index b240ede4..f4d281e9 100644
--- a/theories/FSets/FSetFacts.v
+++ b/theories/FSets/FSetFacts.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/FSets/FSetInterface.v b/theories/FSets/FSetInterface.v
index c791f49a..0926d3ae 100644
--- a/theories/FSets/FSetInterface.v
+++ b/theories/FSets/FSetInterface.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite set library *)
 
diff --git a/theories/FSets/FSetList.v b/theories/FSets/FSetList.v
index 9c3ec71a..2036d360 100644
--- a/theories/FSets/FSetList.v
+++ b/theories/FSets/FSetList.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/FSets/FSetPositive.v b/theories/FSets/FSetPositive.v
index 507f1cda..8a93f381 100644
--- a/theories/FSets/FSetPositive.v
+++ b/theories/FSets/FSetPositive.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** Efficient implementation of [FSetInterface.S] for positive keys,
     inspired from the [FMapPositive] module.
diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v
index 25b042ca..c9cfb94a 100644
--- a/theories/FSets/FSetProperties.v
+++ b/theories/FSets/FSetProperties.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
@@ -762,7 +764,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/FSetToFiniteSet.v b/theories/FSets/FSetToFiniteSet.v
index 3ac5d9e4..f8d13ed2 100644
--- a/theories/FSets/FSetToFiniteSet.v
+++ b/theories/FSets/FSetToFiniteSet.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library : conversion to old [Finite_sets] *)
 
diff --git a/theories/FSets/FSetWeakList.v b/theories/FSets/FSetWeakList.v
index 9dbea884..1dacd056 100644
--- a/theories/FSets/FSetWeakList.v
+++ b/theories/FSets/FSetWeakList.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/FSets/FSets.v b/theories/FSets/FSets.v
index 572f2865..7e9e7aae 100644
--- a/theories/FSets/FSets.v
+++ b/theories/FSets/FSets.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export OrderedType.
 Require Export OrderedTypeEx.
@@ -20,4 +22,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/FSets/vo.itarget b/theories/FSets/vo.itarget
deleted file mode 100644
index 0e7c11fb..00000000
--- a/theories/FSets/vo.itarget
+++ /dev/null
@@ -1,21 +0,0 @@
-FMapAVL.vo
-FMapFacts.vo
-FMapFullAVL.vo
-FMapInterface.vo
-FMapList.vo
-FMapPositive.vo
-FMaps.vo
-FMapWeakList.vo
-FSetCompat.vo
-FSetAVL.vo
-FSetPositive.vo
-FSetBridge.vo
-FSetDecide.vo
-FSetEqProperties.vo
-FSetFacts.vo
-FSetInterface.vo
-FSetList.vo
-FSetProperties.vo
-FSets.vo
-FSetToFiniteSet.vo
-FSetWeakList.vo
diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v
index ddaf08bf..05b741f0 100644
--- a/theories/Init/Datatypes.v
+++ b/theories/Init/Datatypes.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Set Implicit Arguments.
@@ -65,7 +67,7 @@ Infix "&&" := andb : bool_scope.
 
 Lemma andb_prop : forall a b:bool, andb a b = true -> a = true /\ b = true.
 Proof.
-  destruct a; destruct b; intros; split; try (reflexivity || discriminate).
+  destruct a, b; repeat split; assumption.
 Qed.
 Hint Resolve andb_prop: bool.
 
@@ -262,6 +264,11 @@ Inductive comparison : Set :=
   | Lt : comparison
   | Gt : comparison.
 
+Lemma comparison_eq_stable : forall c c' : comparison, ~~ c = c' -> c = c'.
+Proof.
+  destruct c, c'; intro H; reflexivity || destruct H; discriminate.
+Qed.
+
 Definition CompOpp (r:comparison) :=
   match r with
     | Eq => Eq
@@ -326,13 +333,12 @@ Lemma CompSpec2Type : forall A (eq lt:A->A->Prop) x y c,
  CompSpec eq lt x y c -> CompSpecT eq lt x y c.
 Proof. intros. apply CompareSpec2Type; assumption. Defined.
 
-
 (******************************************************************)
 (** * Misc Other Datatypes *)
 
 (** [identity A a] is the family of datatypes on [A] whose sole non-empty
     member is the singleton datatype [identity A a a] whose
-    sole inhabitant is denoted [refl_identity A a] *)
+    sole inhabitant is denoted [identity_refl A a] *)
 
 Inductive identity (A:Type) (a:A) : A -> Type :=
   identity_refl : identity a a.
@@ -355,14 +361,14 @@ Definition idProp : IDProp := fun A x => x.
 
 (* Compatibility *)
 
-Notation prodT := prod (compat "8.2").
-Notation pairT := pair (compat "8.2").
-Notation prodT_rect := prod_rect (compat "8.2").
-Notation prodT_rec := prod_rec (compat "8.2").
-Notation prodT_ind := prod_ind (compat "8.2").
-Notation fstT := fst (compat "8.2").
-Notation sndT := snd (compat "8.2").
-Notation prodT_uncurry := prod_uncurry (compat "8.2").
-Notation prodT_curry := prod_curry (compat "8.2").
+Notation prodT := prod (only parsing).
+Notation pairT := pair (only parsing).
+Notation prodT_rect := prod_rect (only parsing).
+Notation prodT_rec := prod_rec (only parsing).
+Notation prodT_ind := prod_ind (only parsing).
+Notation fstT := fst (only parsing).
+Notation sndT := snd (only parsing).
+Notation prodT_uncurry := prod_uncurry (only parsing).
+Notation prodT_curry := prod_curry (only parsing).
 
 (* end hide *)
diff --git a/theories/Init/Decimal.v b/theories/Init/Decimal.v
new file mode 100644
index 00000000..57163b1b
--- /dev/null
+++ b/theories/Init/Decimal.v
@@ -0,0 +1,163 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** * 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 85123cc4..15ca5abc 100644
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Set Implicit Arguments.
@@ -125,6 +127,25 @@ Proof.
   [apply Hl | apply Hr]; assumption.
 Qed.
 
+Theorem imp_iff_compat_l : forall A B C : Prop,
+  (B <-> C) -> ((A -> B) <-> (A -> C)).
+Proof.
+  intros ? ? ? [Hl Hr]; split; intros H ?; [apply Hl | apply Hr]; apply H; assumption.
+Qed.
+
+Theorem imp_iff_compat_r : forall A B C : Prop,
+  (B <-> C) -> ((B -> A) <-> (C -> A)).
+Proof.
+  intros ? ? ? [Hl Hr]; split; intros H ?; [apply H, Hr | apply H, Hl]; assumption.
+Qed.
+
+Theorem not_iff_compat : forall A B : Prop,
+  (A <-> B) -> (~ A <-> ~B).
+Proof.
+  intros; apply imp_iff_compat_r; assumption.
+Qed.
+
+
 (** Some equivalences *)
 
 Theorem neg_false : forall A : Prop, ~ A <-> (A <-> False).
@@ -204,7 +225,7 @@ Proof.
 Qed.
 
 (** [(IF_then_else P Q R)], written [IF P then Q else R] denotes
-    either [P] and [Q], or [~P] and [Q] *)
+    either [P] and [Q], or [~P] and [R] *)
 
 Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R.
 
@@ -243,9 +264,16 @@ Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..))
 
 Notation "'exists2' x , p & q" := (ex2 (fun x => p) (fun x => q))
   (at level 200, x ident, p at level 200, right associativity) : type_scope.
-Notation "'exists2' x : t , p & q" := (ex2 (fun x:t => p) (fun x:t => q))
-  (at level 200, x ident, t at level 200, p at level 200, right associativity,
-    format "'[' 'exists2'  '/  ' x  :  t ,  '/  ' '[' p  &  '/' q ']' ']'")
+Notation "'exists2' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q))
+  (at level 200, x ident, A at level 200, p at level 200, right associativity,
+    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 *)
@@ -294,8 +322,8 @@ Arguments eq_ind [A] x P _ y _.
 Arguments eq_rec [A] x P _ y _.
 Arguments eq_rect [A] x P _ y _.
 
-Hint Resolve I conj or_introl or_intror : core. 
-Hint Resolve eq_refl: core. 
+Hint Resolve I conj or_introl or_intror : core.
+Hint Resolve eq_refl: core.
 Hint Resolve ex_intro ex_intro2: core.
 
 Section Logic_lemmas.
@@ -424,7 +452,7 @@ Proof.
   destruct e. reflexivity.
 Defined.
 
-(** The goupoid structure of equality *)
+(** The groupoid structure of equality *)
 
 Theorem eq_trans_refl_l : forall A (x y:A) (e:x=y), eq_trans eq_refl e = e.
 Proof.
@@ -485,6 +513,11 @@ Proof.
   reflexivity.
 Defined.
 
+Lemma eq_refl_map_distr : forall A B x (f:A->B), f_equal f (eq_refl x) = eq_refl (f x).
+Proof.
+  reflexivity.
+Qed.
+
 Lemma eq_trans_map_distr : forall A B x y z (f:A->B) (e:x=y) (e':y=z), f_equal f (eq_trans e e') = eq_trans (f_equal f e) (f_equal f e').
 Proof.
 destruct e'.
@@ -503,16 +536,29 @@ destruct e, e'.
 reflexivity.
 Defined.
 
+Lemma eq_trans_rew_distr : forall A (P:A -> Type) (x y z:A) (e:x=y) (e':y=z) (k:P x),
+    rew (eq_trans e e') in k = rew e' in rew e in k.
+Proof.
+  destruct e, e'; reflexivity.
+Qed.
+
+Lemma rew_const : forall A P (x y:A) (e:x=y) (k:P),
+    rew [fun _ => P] e in k = k.
+Proof.
+  destruct e; reflexivity.
+Qed.
+
+
 (* Aliases *)
 
-Notation sym_eq := eq_sym (compat "8.3").
-Notation trans_eq := eq_trans (compat "8.3").
-Notation sym_not_eq := not_eq_sym (compat "8.3").
+Notation sym_eq := eq_sym (only parsing).
+Notation trans_eq := eq_trans (only parsing).
+Notation sym_not_eq := not_eq_sym (only parsing).
 
-Notation refl_equal := eq_refl (compat "8.3").
-Notation sym_equal := eq_sym (compat "8.3").
-Notation trans_equal := eq_trans (compat "8.3").
-Notation sym_not_equal := not_eq_sym (compat "8.3").
+Notation refl_equal := eq_refl (only parsing).
+Notation sym_equal := eq_sym (only parsing).
+Notation trans_equal := eq_trans (only parsing).
+Notation sym_not_equal := not_eq_sym (only parsing).
 
 Hint Immediate eq_sym not_eq_sym: core.
 
@@ -553,9 +599,10 @@ Proof.
   intros A P (x & Hp & Huniq); split.
   - intro; exists x; auto.
   - intros (x0 & HPx0 & HQx0) x1 HPx1.
-    replace x1 with x0 by (transitivity x; [symmetry|]; auto).
+    assert (H : x0 = x1) by (transitivity x; [symmetry|]; auto).
+    destruct H.
     assumption.
-Qed.   
+Qed.
 
 Lemma forall_exists_coincide_unique_domain :
   forall A (P:A->Prop),
@@ -567,7 +614,7 @@ Proof.
   exists x. split; [trivial|].
   destruct H with (Q:=fun x'=>x=x') as (_,Huniq).
   apply Huniq. exists x; auto.
-Qed.       
+Qed.
 
 (** * Being inhabited *)
 
@@ -589,6 +636,11 @@ Proof.
   destruct 1; auto.
 Qed.
 
+Lemma inhabited_covariant (A B : Type) : (A -> B) -> inhabited A -> inhabited B.
+Proof.
+  intros f [x];exact (inhabits (f x)).
+Qed.
+
 (** Declaration of stepl and stepr for eq and iff *)
 
 Lemma eq_stepl : forall (A : Type) (x y z : A), x = y -> x = z -> z = y.
@@ -606,3 +658,97 @@ Qed.
 
 Declare Left Step iff_stepl.
 Declare Right Step iff_trans.
+
+Local Notation "'rew' 'dependent' H 'in' H'"
+  := (match H with
+      | eq_refl => H'
+      end)
+       (at level 10, H' at level 10,
+        format "'[' 'rew'  'dependent'  '/    ' H  in  '/' H' ']'").
+
+(** Equality for [ex] *)
+Section ex.
+  Local Unset Implicit Arguments.
+  Definition eq_ex_uncurried {A : Type} (P : A -> Prop) {u1 v1 : A} {u2 : P u1} {v2 : P v1}
+             (pq : exists p : u1 = v1, rew p in u2 = v2)
+  : ex_intro P u1 u2 = ex_intro P v1 v2.
+  Proof.
+    destruct pq as [p q].
+    destruct q; simpl in *.
+    destruct p; reflexivity.
+  Qed.
+
+  Definition eq_ex {A : Type} {P : A -> Prop} (u1 v1 : A) (u2 : P u1) (v2 : P v1)
+             (p : u1 = v1) (q : rew p in u2 = v2)
+  : ex_intro P u1 u2 = ex_intro P v1 v2
+    := eq_ex_uncurried P (ex_intro _ p q).
+
+  Definition eq_ex_hprop {A} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q)
+             (u1 v1 : A) (u2 : P u1) (v2 : P v1)
+             (p : u1 = v1)
+    : ex_intro P u1 u2 = ex_intro P v1 v2
+    := eq_ex u1 v1 u2 v2 p (P_hprop _ _ _).
+
+  Lemma rew_ex {A x} {P : A -> Type} (Q : forall a, P a -> Prop) (u : exists p, Q x p) {y} (H : x = y)
+  : rew [fun a => exists p, Q a p] H in u
+    = match u with
+        | ex_intro _ u1 u2
+          => ex_intro
+               (Q y)
+               (rew H in u1)
+               (rew dependent H in u2)
+      end.
+  Proof.
+    destruct H, u; reflexivity.
+  Qed.
+End ex.
+
+(** Equality for [ex2] *)
+Section ex2.
+  Local Unset Implicit Arguments.
+
+  Definition eq_ex2_uncurried {A : Type} (P Q : A -> Prop) {u1 v1 : A}
+             {u2 : P u1} {v2 : P v1}
+             {u3 : Q u1} {v3 : Q v1}
+             (pq : exists2 p : u1 = v1, rew p in u2 = v2 & rew p in u3 = v3)
+  : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3.
+  Proof.
+    destruct pq as [p q r].
+    destruct r, q, p; simpl in *.
+    reflexivity.
+  Qed.
+
+  Definition eq_ex2 {A : Type} {P Q : A -> Prop}
+             (u1 v1 : A)
+             (u2 : P u1) (v2 : P v1)
+             (u3 : Q u1) (v3 : Q v1)
+             (p : u1 = v1) (q : rew p in u2 = v2) (r : rew p in u3 = v3)
+  : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3
+    := eq_ex2_uncurried P Q (ex_intro2 _ _ p q r).
+
+  Definition eq_ex2_hprop {A} {P Q : A -> Prop}
+             (P_hprop : forall (x : A) (p q : P x), p = q)
+             (Q_hprop : forall (x : A) (p q : Q x), p = q)
+             (u1 v1 : A) (u2 : P u1) (v2 : P v1) (u3 : Q u1) (v3 : Q v1)
+             (p : u1 = v1)
+    : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3
+    := eq_ex2 u1 v1 u2 v2 u3 v3 p (P_hprop _ _ _) (Q_hprop _ _ _).
+
+  Lemma rew_ex2 {A x} {P : A -> Type}
+        (Q : forall a, P a -> Prop)
+        (R : forall a, P a -> Prop)
+        (u : exists2 p, Q x p & R x p) {y} (H : x = y)
+  : rew [fun a => exists2 p, Q a p & R a p] H in u
+    = match u with
+        | ex_intro2 _ _ u1 u2 u3
+          => ex_intro2
+               (Q y)
+               (R y)
+               (rew H in u1)
+               (rew dependent H in u2)
+               (rew dependent H in u3)
+      end.
+  Proof.
+    destruct H, u; reflexivity.
+  Qed.
+End ex2.
diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v
index 4536dfc0..6f10a939 100644
--- a/theories/Init/Logic_Type.v
+++ b/theories/Init/Logic_Type.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module defines type constructors for types in [Type]
@@ -66,7 +68,7 @@ Defined.
 
 Hint Immediate identity_sym not_identity_sym: core.
 
-Notation refl_id := identity_refl (compat "8.3").
-Notation sym_id := identity_sym (compat "8.3").
-Notation trans_id := identity_trans (compat "8.3").
-Notation sym_not_id := not_identity_sym (compat "8.3").
+Notation refl_id := identity_refl (only parsing).
+Notation sym_id := identity_sym (only parsing).
+Notation trans_id := identity_trans (only parsing).
+Notation sym_not_id := not_identity_sym (only parsing).
diff --git a/theories/Init/Nat.v b/theories/Init/Nat.v
index b8920586..ad1bc717 100644
--- a/theories/Init/Nat.v
+++ b/theories/Init/Nat.v
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Notations Logic Datatypes.
-
+Require Decimal.
 Local Open Scope nat_scope.
 
 (**********************************************************************)
@@ -134,6 +136,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 48fbe079..72073bb4 100644
--- a/theories/Init/Notations.v
+++ b/theories/Init/Notations.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** These are the notations whose level and associativity are imposed by Coq *)
@@ -66,15 +68,46 @@ Reserved Notation "{ x }" (at level 0, x at level 99).
 
 (** Notations for sigma-types or subsets *)
 
+Reserved Notation "{ A }  + { B }" (at level 50, left associativity).
+Reserved Notation "A + { B }" (at level 50, left associativity).
+
 Reserved Notation "{ x  |  P }" (at level 0, x at level 99).
 Reserved Notation "{ x  |  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 "{ x  &  P }" (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.
@@ -88,9 +121,6 @@ Open Scope type_scope.
 
 (** ML Tactic Notations *)
 
-Declare ML Module "coretactics".
-Declare ML Module "extratactics".
-Declare ML Module "g_auto".
-Declare ML Module "g_class".
-Declare ML Module "g_eqdecide".
-Declare ML Module "g_rewrite".
+Declare ML Module "ltac_plugin".
+
+Global Set Default Proof Mode "Classic".
diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v
index 6c4a6350..d5322d09 100644
--- a/theories/Init/Peano.v
+++ b/theories/Init/Peano.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The type [nat] of Peano natural numbers (built from [O] and [S])
@@ -37,7 +39,7 @@ Hint Resolve f_equal_nat: core.
 
 (** The predecessor function *)
 
-Notation pred := Nat.pred (compat "8.4").
+Notation pred := Nat.pred (only parsing).
 
 Definition f_equal_pred := f_equal pred.
 
@@ -79,7 +81,7 @@ Hint Resolve n_Sn: core.
 
 (** Addition *)
 
-Notation plus := Nat.add (compat "8.4").
+Notation plus := Nat.add (only parsing).
 Infix "+" := Nat.add : nat_scope.
 
 Definition f_equal2_plus := f_equal2 plus.
@@ -90,7 +92,9 @@ Lemma plus_n_O : forall n:nat, n = n + 0.
 Proof.
   induction n; simpl; auto.
 Qed.
-Hint Resolve plus_n_O: core.
+
+Remove Hints eq_refl : core.
+Hint Resolve plus_n_O eq_refl: core.  (* We want eq_refl to have higher priority than plus_n_O *)
 
 Lemma plus_O_n : forall n:nat, 0 + n = n.
 Proof.
@@ -110,12 +114,12 @@ Qed.
 
 (** Standard associated names *)
 
-Notation plus_0_r_reverse := plus_n_O (compat "8.2").
-Notation plus_succ_r_reverse := plus_n_Sm (compat "8.2").
+Notation plus_0_r_reverse := plus_n_O (only parsing).
+Notation plus_succ_r_reverse := plus_n_Sm (only parsing).
 
 (** Multiplication *)
 
-Notation mult := Nat.mul (compat "8.4").
+Notation mult := Nat.mul (only parsing).
 Infix "*" := Nat.mul : nat_scope.
 
 Definition f_equal2_mult := f_equal2 mult.
@@ -137,12 +141,12 @@ Hint Resolve mult_n_Sm: core.
 
 (** Standard associated names *)
 
-Notation mult_0_r_reverse := mult_n_O (compat "8.2").
-Notation mult_succ_r_reverse := mult_n_Sm (compat "8.2").
+Notation mult_0_r_reverse := mult_n_O (only parsing).
+Notation mult_succ_r_reverse := mult_n_Sm (only parsing).
 
 (** Truncated subtraction: [m-n] is [0] if [n>=m] *)
 
-Notation minus := Nat.sub (compat "8.4").
+Notation minus := Nat.sub (only parsing).
 Infix "-" := Nat.sub : nat_scope.
 
 (** Definition of the usual orders, the basic properties of [le] and [lt]
@@ -219,8 +223,8 @@ Qed.
 
 (** Maximum and minimum : definitions and specifications *)
 
-Notation max := Nat.max (compat "8.4").
-Notation min := Nat.min (compat "8.4").
+Notation max := Nat.max (only parsing).
+Notation min := Nat.min (only parsing).
 
 Lemma max_l n m : m <= n -> Nat.max n m = n.
 Proof.
diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v
index 03f2328d..802f18c0 100644
--- a/theories/Init/Prelude.v
+++ b/theories/Init/Prelude.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Notations.
@@ -11,6 +13,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.
@@ -18,10 +21,7 @@ Require Export Coq.Init.Tactics.
 Require Export Coq.Init.Tauto.
 (* Initially available plugins
    (+ nat_syntax_plugin loaded in Datatypes) *)
-Declare ML Module "extraction_plugin".
-Declare ML Module "decl_mode_plugin".
 Declare ML Module "cc_plugin".
 Declare ML Module "ground_plugin".
-Declare ML Module "recdef_plugin".
 (* Default substrings not considered by queries like SearchAbout *)
-Add Search Blacklist "_subproof" "Private_".
+Add Search Blacklist "_subproof" "_subterm" "Private_".
diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v
index 9fc00e80..b6afba29 100644
--- a/theories/Init/Specif.v
+++ b/theories/Init/Specif.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Basic specifications : sets that may contain logical information *)
@@ -49,10 +51,20 @@ Notation "{ x  |  P  & Q }" := (sig2 (fun x => P) (fun x => Q)) : type_scope.
 Notation "{ x : A  |  P }" := (sig (A:=A) (fun x => P)) : type_scope.
 Notation "{ x : A  |  P  & Q }" := (sig2 (A:=A) (fun x => P) (fun x => Q)) :
   type_scope.
+Notation "{ x  &  P }" := (sigT (fun x => P)) : type_scope.
 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.
@@ -103,7 +115,7 @@ Definition sig_of_sig2 (A : Type) (P Q : A -> Prop) (X : sig2 P Q) : sig P
     of an [a] of type [A], a of a proof [h] that [a] satisfies [P],
     and a proof [h'] that [a] satisfies [Q].  Then
     [(proj1_sig (sig_of_sig2 y))] is the witness [a],
-    [(proj2_sig (sig_of_sig2 y))] is the proof of [(P a)], and 
+    [(proj2_sig (sig_of_sig2 y))] is the proof of [(P a)], and
     [(proj3_sig y)] is the proof of [(Q a)]. *)
 
 Section Subset_projections2.
@@ -190,6 +202,435 @@ Definition sig2_of_sigT2 (A : Type) (P Q : A -> Prop) (X : sigT2 P Q) : sig2 P Q
 Definition sigT2_of_sig2 (A : Type) (P Q : A -> Prop) (X : sig2 P Q) : sigT2 P Q
   := existT2 P Q (proj1_sig (sig_of_sig2 X)) (proj2_sig (sig_of_sig2 X)) (proj3_sig X).
 
+(** η Principles *)
+Definition sigT_eta {A P} (p : { a : A & P a })
+  : p = existT _ (projT1 p) (projT2 p).
+Proof. destruct p; reflexivity. Defined.
+
+Definition sig_eta {A P} (p : { a : A | P a })
+  : p = exist _ (proj1_sig p) (proj2_sig p).
+Proof. destruct p; reflexivity. Defined.
+
+Definition sigT2_eta {A P Q} (p : { a : A & P a & Q a })
+  : p = existT2 _ _ (projT1 (sigT_of_sigT2 p)) (projT2 (sigT_of_sigT2 p)) (projT3 p).
+Proof. destruct p; reflexivity. Defined.
+
+Definition sig2_eta {A P Q} (p : { a : A | P a & Q a })
+  : p = exist2 _ _ (proj1_sig (sig_of_sig2 p)) (proj2_sig (sig_of_sig2 p)) (proj3_sig p).
+Proof. destruct p; reflexivity. Defined.
+
+(** [exists x : A, B] is equivalent to [inhabited {x : A | B}] *)
+Lemma exists_to_inhabited_sig {A P} : (exists x : A, P x) -> inhabited {x : A | P x}.
+Proof.
+  intros [x y]. exact (inhabits (exist _ x y)).
+Qed.
+
+Lemma inhabited_sig_to_exists {A P} : inhabited {x : A | P x} -> exists x : A, P x.
+Proof.
+  intros [[x y]];exists x;exact y.
+Qed.
+
+(** Equality of sigma types *)
+Import EqNotations.
+Local Notation "'rew' 'dependent' H 'in' H'"
+  := (match H with
+      | eq_refl => H'
+      end)
+       (at level 10, H' at level 10,
+        format "'[' 'rew'  'dependent'  '/    ' H  in  '/' H' ']'").
+
+(** Equality for [sigT] *)
+Section sigT.
+  Local Unset Implicit Arguments.
+  (** Projecting an equality of a pair to equality of the first components *)
+  Definition projT1_eq {A} {P : A -> Type} {u v : { a : A & P a }} (p : u = v)
+    : projT1 u = projT1 v
+    := f_equal (@projT1 _ _) p.
+
+  (** Projecting an equality of a pair to equality of the second components *)
+  Definition projT2_eq {A} {P : A -> Type} {u v : { a : A & P a }} (p : u = v)
+    : rew projT1_eq p in projT2 u = projT2 v
+    := rew dependent p in eq_refl.
+
+  (** Equality of [sigT] is itself a [sigT] (forwards-reasoning version) *)
+  Definition eq_existT_uncurried {A : Type} {P : A -> Type} {u1 v1 : A} {u2 : P u1} {v2 : P v1}
+             (pq : { p : u1 = v1 & rew p in u2 = v2 })
+    : existT _ u1 u2 = existT _ v1 v2.
+  Proof.
+    destruct pq as [p q].
+    destruct q; simpl in *.
+    destruct p; reflexivity.
+  Defined.
+
+  (** Equality of [sigT] is itself a [sigT] (backwards-reasoning version) *)
+  Definition eq_sigT_uncurried {A : Type} {P : A -> Type} (u v : { a : A & P a })
+             (pq : { p : projT1 u = projT1 v & rew p in projT2 u = projT2 v })
+    : u = v.
+  Proof.
+    destruct u as [u1 u2], v as [v1 v2]; simpl in *.
+    apply eq_existT_uncurried; exact pq.
+  Defined.
+
+  (** Curried version of proving equality of sigma types *)
+  Definition eq_sigT {A : Type} {P : A -> Type} (u v : { a : A & P a })
+             (p : projT1 u = projT1 v) (q : rew p in projT2 u = projT2 v)
+    : u = v
+    := eq_sigT_uncurried u v (existT _ p q).
+
+  (** Equality of [sigT] when the property is an hProp *)
+  Definition eq_sigT_hprop {A P} (P_hprop : forall (x : A) (p q : P x), p = q)
+             (u v : { a : A & P a })
+             (p : projT1 u = projT1 v)
+    : u = v
+    := eq_sigT u v p (P_hprop _ _ _).
+
+  (** Equivalence of equality of [sigT] with a [sigT] of equality *)
+  (** We could actually prove an isomorphism here, and not just [<->],
+      but for simplicity, we don't. *)
+  Definition eq_sigT_uncurried_iff {A P}
+             (u v : { a : A & P a })
+    : u = v <-> { p : projT1 u = projT1 v & rew p in projT2 u = projT2 v }.
+  Proof.
+    split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sigT_uncurried ].
+  Defined.
+
+  (** Induction principle for [@eq (sigT _)] *)
+  Definition eq_sigT_rect {A P} {u v : { a : A & P a }} (Q : u = v -> Type)
+             (f : forall p q, Q (eq_sigT u v p q))
+    : forall p, Q p.
+  Proof. intro p; specialize (f (projT1_eq p) (projT2_eq p)); destruct u, p; exact f. Defined.
+  Definition eq_sigT_rec {A P u v} (Q : u = v :> { a : A & P a } -> Set) := eq_sigT_rect Q.
+  Definition eq_sigT_ind {A P u v} (Q : u = v :> { a : A & P a } -> Prop) := eq_sigT_rec Q.
+
+  (** Equivalence of equality of [sigT] involving hProps with equality of the first components *)
+  Definition eq_sigT_hprop_iff {A P} (P_hprop : forall (x : A) (p q : P x), p = q)
+             (u v : { a : A & P a })
+    : u = v <-> (projT1 u = projT1 v)
+    := conj (fun p => f_equal (@projT1 _ _) p) (eq_sigT_hprop P_hprop u v).
+
+  (** Non-dependent classification of equality of [sigT] *)
+  Definition eq_sigT_nondep {A B : Type} (u v : { a : A & B })
+             (p : projT1 u = projT1 v) (q : projT2 u = projT2 v)
+    : u = v
+    := @eq_sigT _ _ u v p (eq_trans (rew_const _ _) q).
+
+  (** Classification of transporting across an equality of [sigT]s *)
+  Lemma rew_sigT {A x} {P : A -> Type} (Q : forall a, P a -> Prop) (u : { p : P x & Q x p }) {y} (H : x = y)
+    : rew [fun a => { p : P a & Q a p }] H in u
+      = existT
+          (Q y)
+          (rew H in projT1 u)
+          (rew dependent H in (projT2 u)).
+  Proof.
+    destruct H, u; reflexivity.
+  Defined.
+End sigT.
+
+(** Equality for [sig] *)
+Section sig.
+  Local Unset Implicit Arguments.
+  (** Projecting an equality of a pair to equality of the first components *)
+  Definition proj1_sig_eq {A} {P : A -> Prop} {u v : { a : A | P a }} (p : u = v)
+    : proj1_sig u = proj1_sig v
+    := f_equal (@proj1_sig _ _) p.
+
+  (** Projecting an equality of a pair to equality of the second components *)
+  Definition proj2_sig_eq {A} {P : A -> Prop} {u v : { a : A | P a }} (p : u = v)
+    : rew proj1_sig_eq p in proj2_sig u = proj2_sig v
+    := rew dependent p in eq_refl.
+
+  (** Equality of [sig] is itself a [sig] (forwards-reasoning version) *)
+  Definition eq_exist_uncurried {A : Type} {P : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1}
+             (pq : { p : u1 = v1 | rew p in u2 = v2 })
+    : exist _ u1 u2 = exist _ v1 v2.
+  Proof.
+    destruct pq as [p q].
+    destruct q; simpl in *.
+    destruct p; reflexivity.
+  Defined.
+
+  (** Equality of [sig] is itself a [sig] (backwards-reasoning version) *)
+  Definition eq_sig_uncurried {A : Type} {P : A -> Prop} (u v : { a : A | P a })
+             (pq : { p : proj1_sig u = proj1_sig v | rew p in proj2_sig u = proj2_sig v })
+    : u = v.
+  Proof.
+    destruct u as [u1 u2], v as [v1 v2]; simpl in *.
+    apply eq_exist_uncurried; exact pq.
+  Defined.
+
+  (** Curried version of proving equality of sigma types *)
+  Definition eq_sig {A : Type} {P : A -> Prop} (u v : { a : A | P a })
+             (p : proj1_sig u = proj1_sig v) (q : rew p in proj2_sig u = proj2_sig v)
+    : u = v
+    := eq_sig_uncurried u v (exist _ p q).
+
+  (** Induction principle for [@eq (sig _)] *)
+  Definition eq_sig_rect {A P} {u v : { a : A | P a }} (Q : u = v -> Type)
+             (f : forall p q, Q (eq_sig u v p q))
+    : forall p, Q p.
+  Proof. intro p; specialize (f (proj1_sig_eq p) (proj2_sig_eq p)); destruct u, p; exact f. Defined.
+  Definition eq_sig_rec {A P u v} (Q : u = v :> { a : A | P a } -> Set) := eq_sig_rect Q.
+  Definition eq_sig_ind {A P u v} (Q : u = v :> { a : A | P a } -> Prop) := eq_sig_rec Q.
+
+  (** Equality of [sig] when the property is an hProp *)
+  Definition eq_sig_hprop {A} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q)
+             (u v : { a : A | P a })
+             (p : proj1_sig u = proj1_sig v)
+    : u = v
+    := eq_sig u v p (P_hprop _ _ _).
+
+  (** Equivalence of equality of [sig] with a [sig] of equality *)
+  (** We could actually prove an isomorphism here, and not just [<->],
+      but for simplicity, we don't. *)
+  Definition eq_sig_uncurried_iff {A} {P : A -> Prop}
+             (u v : { a : A | P a })
+    : u = v <-> { p : proj1_sig u = proj1_sig v | rew p in proj2_sig u = proj2_sig v }.
+  Proof.
+    split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sig_uncurried ].
+  Defined.
+
+  (** Equivalence of equality of [sig] involving hProps with equality of the first components *)
+  Definition eq_sig_hprop_iff {A} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q)
+             (u v : { a : A | P a })
+    : u = v <-> (proj1_sig u = proj1_sig v)
+    := conj (fun p => f_equal (@proj1_sig _ _) p) (eq_sig_hprop P_hprop u v).
+
+  Lemma rew_sig {A x} {P : A -> Type} (Q : forall a, P a -> Prop) (u : { p : P x | Q x p }) {y} (H : x = y)
+    : rew [fun a => { p : P a | Q a p }] H in u
+      = exist
+          (Q y)
+          (rew H in proj1_sig u)
+          (rew dependent H in proj2_sig u).
+  Proof.
+    destruct H, u; reflexivity.
+  Defined.
+End sig.
+
+(** Equality for [sigT] *)
+Section sigT2.
+  (* We make [sigT_of_sigT2] a coercion so we can use [projT1], [projT2] on [sigT2] *)
+  Local Coercion sigT_of_sigT2 : sigT2 >-> sigT.
+  Local Unset Implicit Arguments.
+  (** Projecting an equality of a pair to equality of the first components *)
+  Definition sigT_of_sigT2_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v)
+    : u = v :> { a : A & P a }
+    := f_equal _ p.
+  Definition projT1_of_sigT2_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v)
+    : projT1 u = projT1 v
+    := projT1_eq (sigT_of_sigT2_eq p).
+
+  (** Projecting an equality of a pair to equality of the second components *)
+  Definition projT2_of_sigT2_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v)
+    : rew projT1_of_sigT2_eq p in projT2 u = projT2 v
+    := rew dependent p in eq_refl.
+
+  (** Projecting an equality of a pair to equality of the third components *)
+  Definition projT3_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v)
+    : rew projT1_of_sigT2_eq p in projT3 u = projT3 v
+    := rew dependent p in eq_refl.
+
+  (** Equality of [sigT2] is itself a [sigT2] (forwards-reasoning version) *)
+  Definition eq_existT2_uncurried {A : Type} {P Q : A -> Type}
+             {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1}
+             (pqr : { p : u1 = v1
+                    & rew p in u2 = v2 & rew p in u3 = v3 })
+    : existT2 _ _ u1 u2 u3 = existT2 _ _ v1 v2 v3.
+  Proof.
+    destruct pqr as [p q r].
+    destruct r, q, p; simpl.
+    reflexivity.
+  Defined.
+
+  (** Equality of [sigT2] is itself a [sigT2] (backwards-reasoning version) *)
+  Definition eq_sigT2_uncurried {A : Type} {P Q : A -> Type} (u v : { a : A & P a & Q a })
+             (pqr : { p : projT1 u = projT1 v
+                    & rew p in projT2 u = projT2 v & rew p in projT3 u = projT3 v })
+    : u = v.
+  Proof.
+    destruct u as [u1 u2 u3], v as [v1 v2 v3]; simpl in *.
+    apply eq_existT2_uncurried; exact pqr.
+  Defined.
+
+  (** Curried version of proving equality of sigma types *)
+  Definition eq_sigT2 {A : Type} {P Q : A -> Type} (u v : { a : A & P a & Q a })
+             (p : projT1 u = projT1 v)
+             (q : rew p in projT2 u = projT2 v)
+             (r : rew p in projT3 u = projT3 v)
+    : u = v
+    := eq_sigT2_uncurried u v (existT2 _ _ p q r).
+
+  (** Equality of [sigT2] when the second property is an hProp *)
+  Definition eq_sigT2_hprop {A P Q} (Q_hprop : forall (x : A) (p q : Q x), p = q)
+             (u v : { a : A & P a & Q a })
+             (p : u = v :> { a : A & P a })
+    : u = v
+    := eq_sigT2 u v (projT1_eq p) (projT2_eq p) (Q_hprop _ _ _).
+
+  (** Equivalence of equality of [sigT2] with a [sigT2] of equality *)
+  (** We could actually prove an isomorphism here, and not just [<->],
+      but for simplicity, we don't. *)
+  Definition eq_sigT2_uncurried_iff {A P Q}
+             (u v : { a : A & P a & Q a })
+    : u = v
+      <-> { p : projT1 u = projT1 v
+          & rew p in projT2 u = projT2 v & rew p in projT3 u = projT3 v }.
+  Proof.
+    split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sigT2_uncurried ].
+  Defined.
+
+  (** Induction principle for [@eq (sigT2 _ _)] *)
+  Definition eq_sigT2_rect {A P Q} {u v : { a : A & P a & Q a }} (R : u = v -> Type)
+             (f : forall p q r, R (eq_sigT2 u v p q r))
+    : forall p, R p.
+  Proof.
+    intro p.
+    specialize (f (projT1_of_sigT2_eq p) (projT2_of_sigT2_eq p) (projT3_eq p)).
+    destruct u, p; exact f.
+  Defined.
+  Definition eq_sigT2_rec {A P Q u v} (R : u = v :> { a : A & P a & Q a } -> Set) := eq_sigT2_rect R.
+  Definition eq_sigT2_ind {A P Q u v} (R : u = v :> { a : A & P a & Q a } -> Prop) := eq_sigT2_rec R.
+
+  (** Equivalence of equality of [sigT2] involving hProps with equality of the first components *)
+  Definition eq_sigT2_hprop_iff {A P Q} (Q_hprop : forall (x : A) (p q : Q x), p = q)
+             (u v : { a : A & P a & Q a })
+    : u = v <-> (u = v :> { a : A & P a })
+    := conj (fun p => f_equal (@sigT_of_sigT2 _ _ _) p) (eq_sigT2_hprop Q_hprop u v).
+
+  (** Non-dependent classification of equality of [sigT] *)
+  Definition eq_sigT2_nondep {A B C : Type} (u v : { a : A & B & C })
+             (p : projT1 u = projT1 v) (q : projT2 u = projT2 v) (r : projT3 u = projT3 v)
+    : u = v
+    := @eq_sigT2 _ _ _ u v p (eq_trans (rew_const _ _) q) (eq_trans (rew_const _ _) r).
+
+  (** Classification of transporting across an equality of [sigT2]s *)
+  Lemma rew_sigT2 {A x} {P : A -> Type} (Q R : forall a, P a -> Prop)
+        (u : { p : P x & Q x p & R x p })
+        {y} (H : x = y)
+    : rew [fun a => { p : P a & Q a p & R a p }] H in u
+      = existT2
+          (Q y)
+          (R y)
+          (rew H in projT1 u)
+          (rew dependent H in projT2 u)
+          (rew dependent H in projT3 u).
+  Proof.
+    destruct H, u; reflexivity.
+  Defined.
+End sigT2.
+
+(** Equality for [sig2] *)
+Section sig2.
+  (* We make [sig_of_sig2] a coercion so we can use [proj1], [proj2] on [sig2] *)
+  Local Coercion sig_of_sig2 : sig2 >-> sig.
+  Local Unset Implicit Arguments.
+  (** Projecting an equality of a pair to equality of the first components *)
+  Definition sig_of_sig2_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v)
+    : u = v :> { a : A | P a }
+    := f_equal _ p.
+  Definition proj1_sig_of_sig2_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v)
+    : proj1_sig u = proj1_sig v
+    := proj1_sig_eq (sig_of_sig2_eq p).
+
+  (** Projecting an equality of a pair to equality of the second components *)
+  Definition proj2_sig_of_sig2_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v)
+    : rew proj1_sig_of_sig2_eq p in proj2_sig u = proj2_sig v
+    := rew dependent p in eq_refl.
+
+  (** Projecting an equality of a pair to equality of the third components *)
+  Definition proj3_sig_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v)
+    : rew proj1_sig_of_sig2_eq p in proj3_sig u = proj3_sig v
+    := rew dependent p in eq_refl.
+
+  (** Equality of [sig2] is itself a [sig2] (fowards-reasoning version) *)
+  Definition eq_exist2_uncurried {A} {P Q : A -> Prop}
+             {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1}
+             (pqr : { p : u1 = v1
+                    | rew p in u2 = v2 & rew p in u3 = v3 })
+    : exist2 _ _ u1 u2 u3 = exist2 _ _ v1 v2 v3.
+  Proof.
+    destruct pqr as [p q r].
+    destruct r, q, p; simpl.
+    reflexivity.
+  Defined.
+
+  (** Equality of [sig2] is itself a [sig2] (backwards-reasoning version) *)
+  Definition eq_sig2_uncurried {A} {P Q : A -> Prop} (u v : { a : A | P a & Q a })
+             (pqr : { p : proj1_sig u = proj1_sig v
+                    | rew p in proj2_sig u = proj2_sig v & rew p in proj3_sig u = proj3_sig v })
+    : u = v.
+  Proof.
+    destruct u as [u1 u2 u3], v as [v1 v2 v3]; simpl in *.
+    apply eq_exist2_uncurried; exact pqr.
+  Defined.
+
+  (** Curried version of proving equality of sigma types *)
+  Definition eq_sig2 {A} {P Q : A -> Prop} (u v : { a : A | P a & Q a })
+             (p : proj1_sig u = proj1_sig v)
+             (q : rew p in proj2_sig u = proj2_sig v)
+             (r : rew p in proj3_sig u = proj3_sig v)
+    : u = v
+    := eq_sig2_uncurried u v (exist2 _ _ p q r).
+
+  (** Equality of [sig2] when the second property is an hProp *)
+  Definition eq_sig2_hprop {A} {P Q : A -> Prop} (Q_hprop : forall (x : A) (p q : Q x), p = q)
+             (u v : { a : A | P a & Q a })
+             (p : u = v :> { a : A | P a })
+    : u = v
+    := eq_sig2 u v (proj1_sig_eq p) (proj2_sig_eq p) (Q_hprop _ _ _).
+
+  (** Equivalence of equality of [sig2] with a [sig2] of equality *)
+  (** We could actually prove an isomorphism here, and not just [<->],
+      but for simplicity, we don't. *)
+  Definition eq_sig2_uncurried_iff {A P Q}
+             (u v : { a : A | P a & Q a })
+    : u = v
+      <-> { p : proj1_sig u = proj1_sig v
+          | rew p in proj2_sig u = proj2_sig v & rew p in proj3_sig u = proj3_sig v }.
+  Proof.
+    split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sig2_uncurried ].
+  Defined.
+
+  (** Induction principle for [@eq (sig2 _ _)] *)
+  Definition eq_sig2_rect {A P Q} {u v : { a : A | P a & Q a }} (R : u = v -> Type)
+             (f : forall p q r, R (eq_sig2 u v p q r))
+    : forall p, R p.
+  Proof.
+    intro p.
+    specialize (f (proj1_sig_of_sig2_eq p) (proj2_sig_of_sig2_eq p) (proj3_sig_eq p)).
+    destruct u, p; exact f.
+  Defined.
+  Definition eq_sig2_rec {A P Q u v} (R : u = v :> { a : A | P a & Q a } -> Set) := eq_sig2_rect R.
+  Definition eq_sig2_ind {A P Q u v} (R : u = v :> { a : A | P a & Q a } -> Prop) := eq_sig2_rec R.
+
+  (** Equivalence of equality of [sig2] involving hProps with equality of the first components *)
+  Definition eq_sig2_hprop_iff {A} {P Q : A -> Prop} (Q_hprop : forall (x : A) (p q : Q x), p = q)
+             (u v : { a : A | P a & Q a })
+    : u = v <-> (u = v :> { a : A | P a })
+    := conj (fun p => f_equal (@sig_of_sig2 _ _ _) p) (eq_sig2_hprop Q_hprop u v).
+
+  (** Non-dependent classification of equality of [sig] *)
+  Definition eq_sig2_nondep {A} {B C : Prop} (u v : @sig2 A (fun _ => B) (fun _ => C))
+             (p : proj1_sig u = proj1_sig v) (q : proj2_sig u = proj2_sig v) (r : proj3_sig u = proj3_sig v)
+    : u = v
+    := @eq_sig2 _ _ _ u v p (eq_trans (rew_const _ _) q) (eq_trans (rew_const _ _) r).
+
+  (** Classification of transporting across an equality of [sig2]s *)
+  Lemma rew_sig2 {A x} {P : A -> Type} (Q R : forall a, P a -> Prop)
+        (u : { p : P x | Q x p & R x p })
+        {y} (H : x = y)
+    : rew [fun a => { p : P a | Q a p & R a p }] H in u
+      = exist2
+          (Q y)
+          (R y)
+          (rew H in proj1_sig u)
+          (rew dependent H in proj2_sig u)
+          (rew dependent H in proj3_sig u).
+  Proof.
+    destruct H, u; reflexivity.
+  Defined.
+End sig2.
+
+
 (** [sumbool] is a boolean type equipped with the justification of
     their value *)
 
@@ -263,10 +704,10 @@ Section Dependent_choice_lemmas.
     (forall x:X, {y | R x y}) ->
     forall x0, {f : nat -> X | f O = x0 /\ forall n, R (f n) (f (S n))}.
   Proof.
-    intros H x0. 
+    intros H x0.
     set (f:=fix f n := match n with O => x0 | S n' => proj1_sig (H (f n')) end).
     exists f.
-    split. reflexivity. 
+    split. reflexivity.
     induction n; simpl; apply proj2_sig.
   Defined.
 
@@ -304,16 +745,16 @@ Hint Resolve exist exist2 existT existT2: core.
 
 (* Compatibility *)
 
-Notation sigS := sigT (compat "8.2").
-Notation existS := existT (compat "8.2").
-Notation sigS_rect := sigT_rect (compat "8.2").
-Notation sigS_rec := sigT_rec (compat "8.2").
-Notation sigS_ind := sigT_ind (compat "8.2").
-Notation projS1 := projT1 (compat "8.2").
-Notation projS2 := projT2 (compat "8.2").
-
-Notation sigS2 := sigT2 (compat "8.2").
-Notation existS2 := existT2 (compat "8.2").
-Notation sigS2_rect := sigT2_rect (compat "8.2").
-Notation sigS2_rec := sigT2_rec (compat "8.2").
-Notation sigS2_ind := sigT2_ind (compat "8.2").
+Notation sigS := sigT (compat "8.6").
+Notation existS := existT (compat "8.6").
+Notation sigS_rect := sigT_rect (compat "8.6").
+Notation sigS_rec := sigT_rec (compat "8.6").
+Notation sigS_ind := sigT_ind (compat "8.6").
+Notation projS1 := projT1 (compat "8.6").
+Notation projS2 := projT2 (compat "8.6").
+
+Notation sigS2 := sigT2 (compat "8.6").
+Notation existS2 := existT2 (compat "8.6").
+Notation sigS2_rect := sigT2_rect (compat "8.6").
+Notation sigS2_rec := sigT2_rec (compat "8.6").
+Notation sigS2_ind := sigT2_ind (compat "8.6").
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
index 5d1e87ae..8df533e7 100644
--- a/theories/Init/Tactics.v
+++ b/theories/Init/Tactics.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Notations.
@@ -236,3 +238,93 @@ Tactic Notation "clear" "dependent" hyp(h) :=
 
 Tactic Notation "revert" "dependent" hyp(h) :=
  generalize dependent h.
+
+(** Provide an error message for dependent induction that reports an import is
+required to use it. Importing Coq.Program.Equality will shadow this notation
+with the actual [dependent induction] tactic. *)
+
+Tactic Notation "dependent" "induction" ident(H) :=
+  fail "To use dependent induction, first [Require Import Coq.Program.Equality.]".
+
+(** *** [inversion_sigma] *)
+(** The built-in [inversion] will frequently leave equalities of
+    dependent pairs.  When the first type in the pair is an hProp or
+    otherwise simplifies, [inversion_sigma] is useful; it will replace
+    the equality of pairs with a pair of equalities, one involving a
+    term casted along the other.  This might also prove useful for
+    writing a version of [inversion] / [dependent destruction] which
+    does not lose information, i.e., does not turn a goal which is
+    provable into one which requires axiom K / UIP.  *)
+
+Ltac simpl_proj_exist_in H :=
+  repeat match type of H with
+         | context G[proj1_sig (exist _ ?x ?p)]
+           => let G' := context G[x] in change G' in H
+         | context G[proj2_sig (exist _ ?x ?p)]
+           => let G' := context G[p] in change G' in H
+         | context G[projT1 (existT _ ?x ?p)]
+           => let G' := context G[x] in change G' in H
+         | context G[projT2 (existT _ ?x ?p)]
+           => let G' := context G[p] in change G' in H
+         | context G[proj3_sig (exist2 _ _ ?x ?p ?q)]
+           => let G' := context G[q] in change G' in H
+         | context G[projT3 (existT2 _ _ ?x ?p ?q)]
+           => let G' := context G[q] in change G' in H
+         | context G[sig_of_sig2 (@exist2 ?A ?P ?Q ?x ?p ?q)]
+           => let G' := context G[@exist A P x p] in change G' in H
+         | context G[sigT_of_sigT2 (@existT2 ?A ?P ?Q ?x ?p ?q)]
+           => let G' := context G[@existT A P x p] in change G' in H
+         end.
+Ltac induction_sigma_in_using H rect :=
+  let H0 := fresh H in
+  let H1 := fresh H in
+  induction H as [H0 H1] using (rect _ _ _ _);
+  simpl_proj_exist_in H0;
+  simpl_proj_exist_in H1.
+Ltac induction_sigma2_in_using H rect :=
+  let H0 := fresh H in
+  let H1 := fresh H in
+  let H2 := fresh H in
+  induction H as [H0 H1 H2] using (rect _ _ _ _ _);
+  simpl_proj_exist_in H0;
+  simpl_proj_exist_in H1;
+  simpl_proj_exist_in H2.
+Ltac inversion_sigma_step :=
+  match goal with
+  | [ H : _ = exist _ _ _ |- _ ]
+    => induction_sigma_in_using H @eq_sig_rect
+  | [ H : _ = existT _ _ _ |- _ ]
+    => induction_sigma_in_using H @eq_sigT_rect
+  | [ H : exist _ _ _ = _ |- _ ]
+    => induction_sigma_in_using H @eq_sig_rect
+  | [ H : existT _ _ _ = _ |- _ ]
+    => induction_sigma_in_using H @eq_sigT_rect
+  | [ H : _ = exist2 _ _ _ _ _ |- _ ]
+    => induction_sigma2_in_using H @eq_sig2_rect
+  | [ H : _ = existT2 _ _ _ _ _ |- _ ]
+    => induction_sigma2_in_using H @eq_sigT2_rect
+  | [ H : exist2 _ _ _ _ _ = _ |- _ ]
+    => induction_sigma_in_using H @eq_sig2_rect
+  | [ H : existT2 _ _ _ _ _ = _ |- _ ]
+    => 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.
+
+(** Useful combinators *)
+
+Ltac assert_fails tac :=
+  tryif tac then fail 0 tac "succeeds" else idtac.
+Ltac assert_succeeds tac :=
+  tryif (assert_fails tac) then fail 0 tac "fails" else idtac.
+Tactic Notation "assert_succeeds" tactic3(tac) :=
+  assert_succeeds tac.
+Tactic Notation "assert_fails" tactic3(tac) :=
+  assert_fails tac.
diff --git a/theories/Init/Tauto.v b/theories/Init/Tauto.v
index 1e409607..87b7a9a3 100644
--- a/theories/Init/Tauto.v
+++ b/theories/Init/Tauto.v
@@ -2,7 +2,7 @@ Require Import Notations.
 Require Import Datatypes.
 Require Import Logic.
 
-Local Declare ML Module "tauto".
+Declare ML Module "tauto_plugin".
 
 Local Ltac not_dep_intros :=
   repeat match goal with
@@ -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/Init/Wf.v b/theories/Init/Wf.v
index b5b17e5e..c27ffa33 100644
--- a/theories/Init/Wf.v
+++ b/theories/Init/Wf.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * This module proves the validity of
diff --git a/theories/Init/_CoqProject b/theories/Init/_CoqProject
new file mode 100644
index 00000000..bff79d34
--- /dev/null
+++ b/theories/Init/_CoqProject
@@ -0,0 +1,2 @@
+-R .. Coq
+-arg -noinit
diff --git a/theories/Init/vo.itarget b/theories/Init/vo.itarget
deleted file mode 100644
index 99877065..00000000
--- a/theories/Init/vo.itarget
+++ /dev/null
@@ -1,11 +0,0 @@
-Datatypes.vo
-Logic_Type.vo
-Logic.vo
-Notations.vo
-Peano.vo
-Prelude.vo
-Specif.vo
-Tactics.vo
-Wf.vo
-Nat.vo
-Tauto.vo
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index 30f1dec2..ca5f154e 100644
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Setoid.
@@ -27,7 +29,6 @@ Module ListNotations.
 Notation "[ ]" := nil (format "[ ]") : list_scope.
 Notation "[ x ]" := (cons x nil) : list_scope.
 Notation "[ x ; y ; .. ; z ]" :=  (cons x (cons y .. (cons z nil) ..)) : list_scope.
-Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..) (compat "8.4") : list_scope.
 End ListNotations.
 
 Import ListNotations.
@@ -419,7 +420,7 @@ Section Elts.
   Proof.
     unfold lt; induction n as [| n hn]; simpl.
     - destruct l; simpl; [ inversion 2 | auto ].
-    - destruct l as [| a l hl]; simpl.
+    - destruct l; simpl.
       * inversion 2.
       * intros d ie; right; apply hn; auto with arith.
   Qed.
@@ -1280,7 +1281,7 @@ End Fold_Right_Recursor.
     partition l = ([], []) <-> l = [].
   Proof.
     split.
-    - destruct l as [|a l' _].
+    - destruct l as [|a l'].
       * intuition.
       * simpl. destruct (f a), (partition l'); now intros [= -> ->].
     - now intros ->.
@@ -2110,13 +2111,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 +2153,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 +2180,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 +2197,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/Lists/ListDec.v b/theories/Lists/ListDec.v
index 3e2eeac0..e7e2cfc8 100644
--- a/theories/Lists/ListDec.v
+++ b/theories/Lists/ListDec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Decidability results about lists *)
diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v
index 655d3940..cc7d6f55 100644
--- a/theories/Lists/ListSet.v
+++ b/theories/Lists/ListSet.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** A library for finite sets, implemented as lists *)
diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v
index 537d5f68..843e3835 100644
--- a/theories/Lists/ListTactics.v
+++ b/theories/Lists/ListTactics.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinPos.
diff --git a/theories/Lists/SetoidList.v b/theories/Lists/SetoidList.v
index c95fb4d5..0c5fe55b 100644
--- a/theories/Lists/SetoidList.v
+++ b/theories/Lists/SetoidList.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export List.
 Require Export Sorted.
diff --git a/theories/Lists/SetoidPermutation.v b/theories/Lists/SetoidPermutation.v
index cea3e839..24b96514 100644
--- a/theories/Lists/SetoidPermutation.v
+++ b/theories/Lists/SetoidPermutation.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import Permutation SetoidList.
 (* Set Universe Polymorphism. *)
diff --git a/theories/Lists/StreamMemo.v b/theories/Lists/StreamMemo.v
index 5a16cc43..57f558de 100644
--- a/theories/Lists/StreamMemo.v
+++ b/theories/Lists/StreamMemo.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Eqdep_dec.
diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v
index 1c302b22..8a01b8fb 100644
--- a/theories/Lists/Streams.v
+++ b/theories/Lists/Streams.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Set Implicit Arguments.
@@ -194,7 +196,7 @@ Lemma ForAll_map : forall (P:Stream B -> Prop) (S:Stream A), ForAll (fun s => P
 (map s)) S <-> ForAll P (map S).
 Proof.
 intros P S.
-split; generalize S; clear S; cofix; intros S; constructor;
+split; generalize S; clear S; cofix ForAll_map; intros S; constructor;
 destruct H as [H0 H]; firstorder.
 Qed.
 
diff --git a/theories/Lists/vo.itarget b/theories/Lists/vo.itarget
deleted file mode 100644
index 82dd1be8..00000000
--- a/theories/Lists/vo.itarget
+++ /dev/null
@@ -1,8 +0,0 @@
-ListSet.vo
-ListTactics.vo
-List.vo
-ListDec.vo
-SetoidList.vo
-SetoidPermutation.vo
-StreamMemo.vo
-Streams.vo
diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v
index 1e0bd0fe..c6836a1c 100644
--- a/theories/Logic/Berardi.v
+++ b/theories/Logic/Berardi.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file formalizes Berardi's paradox which says that in
diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v
index 1420a000..238ac7df 100644
--- a/theories/Logic/ChoiceFacts.v
+++ b/theories/Logic/ChoiceFacts.v
@@ -1,93 +1,35 @@
-(* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
+(************************************************************************)
 (************************************************************************)
 
 (** Some facts and definitions concerning choice and description in
-       intuitionistic logic.
-
-We investigate the relations between the following choice and
-description principles
-
-- AC_rel  = relational form of the (non extensional) axiom of choice
-            (a "set-theoretic" axiom of choice)
-- AC_fun  = functional form of the (non extensional) axiom of choice
-            (a "type-theoretic" axiom of choice)
-- DC_fun  = functional form of the dependent axiom of choice
-- ACw_fun = functional form of the countable axiom of choice
-- AC!     = functional relation reification
-            (known as axiom of unique choice in topos theory,
-             sometimes called principle of definite description in
-             the context of constructive type theory)
-
-- GAC_rel = guarded relational form of the (non extensional) axiom of choice
-- GAC_fun = guarded functional form of the (non extensional) axiom of choice
-- GAC!    = guarded functional relation reification
-
-- OAC_rel = "omniscient" relational form of the (non extensional) axiom of choice
-- OAC_fun = "omniscient" functional form of the (non extensional) axiom of choice
-            (called AC* in Bell [[Bell]])
-- OAC!
-
-- ID_iota    = intuitionistic definite description
-- ID_epsilon = intuitionistic indefinite description
-
-- D_iota     = (weakly classical) definite description principle
-- D_epsilon  = (weakly classical) indefinite description principle
-
-- PI      = proof irrelevance
-- IGP     = independence of general premises
-            (an unconstrained generalisation of the constructive principle of
-             independence of premises)
-- Drinker = drinker's paradox (small form)
-            (called Ex in Bell [[Bell]])
-
-We let also
-
-- IPL_2   = 2nd-order impredicative minimal predicate logic (with ex. quant.)
-- IPL^2   = 2nd-order functional minimal predicate logic (with ex. quant.)
-- IPL_2^2 = 2nd-order impredicative, 2nd-order functional minimal pred. logic (with ex. quant.)
-
-with no prerequisite on the non-emptiness of domains
-
-Table of contents
-
-1. Definitions
-
-2. IPL_2^2 |- AC_rel + AC! = AC_fun
-
-3.1. typed IPL_2 + Sigma-types + PI |- AC_rel = GAC_rel  and  IPL_2 |- AC_rel + IGP -> GAC_rel and IPL_2 |- GAC_rel = OAC_rel
-
-3.2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker
-
-3.3. D_iota -> ID_iota  and  D_epsilon <-> ID_epsilon + Drinker
-
-4. Derivability of choice for decidable relations with well-ordered codomain
-
-5. Equivalence of choices on dependent or non dependent functional types
-
-6. Non contradiction of constructive descriptions wrt functional choices
-
-7. Definite description transports classical logic to the computational world
-
-8. Choice -> Dependent choice -> Countable choice
-
-References:
-
+       intuitionistic logic. *)
+(** * References: *)
+(**
 [[Bell]] John L. Bell, Choice principles in intuitionistic set theory,
 unpublished.
 
 [[Bell93]] John L. Bell, Hilbert's Epsilon Operator in Intuitionistic
 Type Theories, Mathematical Logic Quarterly, volume 39, 1993.
 
+[[Carlström04]] Jesper Carlström, EM + Ext_ + AC_int is equivalent to
+AC_ext, Mathematical Logic Quaterly, vol 50(3), pp 236-240, 2004.
+
 [[Carlström05]] Jesper Carlström, Interpreting descriptions in
 intentional type theory, Journal of Symbolic Logic 70(2):488-514, 2005.
+
+[[Werner97]] Benjamin Werner, Sets in Types, Types in Sets, TACS, 1997.
 *)
 
+Require Import RelationClasses Logic.
+
 Set Implicit Arguments.
 Local Unset Intuition Negation Unfolding.
 
@@ -108,59 +50,139 @@ Variables A B :Type.
 
 Variable P:A->Prop.
 
-Variable R:A->B->Prop.
-
 (** ** Constructive choice and description *)
 
-(** AC_rel *)
+(** AC_rel = relational form of the (non extensional) axiom of choice
+             (a "set-theoretic" axiom of choice) *)
 
 Definition RelationalChoice_on :=
   forall R:A->B->Prop,
     (forall x : A, exists y : B, R x y) ->
     (exists R' : A->B->Prop, subrelation R' R /\ forall x, exists! y, R' x y).
 
-(** AC_fun *)
+(** AC_fun = functional form of the (non extensional) axiom of choice
+             (a "type-theoretic" axiom of choice) *)
+
+(* Note: This is called Type-Theoretic Description Axiom (TTDA) in
+   [[Werner97]] (using a non-standard meaning of "description"). This
+   is called intensional axiom of choice (AC_int) in [[Carlström04]] *)
+
+Definition FunctionalChoice_on_rel (R:A->B->Prop) :=
+  (forall x:A, exists y : B, R x y) ->
+  exists f : A -> B, (forall x:A, R x (f x)).
 
 Definition FunctionalChoice_on :=
   forall R:A->B->Prop,
     (forall x : A, exists y : B, R x y) ->
     (exists f : A->B, forall x : A, R x (f x)).
 
-(** DC_fun *)
+(** AC_fun_dep = functional form of the (non extensional) axiom of
+                 choice, with dependent functions *)
+Definition DependentFunctionalChoice_on (A:Type) (B:A -> Type) :=
+  forall R:forall x:A, B x -> Prop,
+    (forall x:A, exists y : B x, R x y) ->
+    (exists f : (forall x:A, B x), forall x:A, R x (f x)).
+
+(** AC_trunc = axiom of choice for propositional truncations
+               (truncation and quantification commute) *)
+Definition InhabitedForallCommute_on (A : Type) (B : A -> Type) :=
+  (forall x, inhabited (B x)) -> inhabited (forall x, B x).
+
+(** DC_fun = functional form of the dependent axiom of choice *)
 
 Definition FunctionalDependentChoice_on :=
   forall (R:A->A->Prop),
     (forall x, exists y, R x y) -> forall x0,
     (exists f : nat -> A, f 0 = x0 /\ forall n, R (f n) (f (S n))).
 
-(** ACw_fun *)
+(** ACw_fun = functional form of the countable axiom of choice *)
 
 Definition FunctionalCountableChoice_on :=
   forall (R:nat->A->Prop),
     (forall n, exists y, R n y) ->
     (exists f : nat -> A, forall n, R n (f n)).
 
-(** AC! or Functional Relation Reification (known as Axiom of Unique Choice
-    in topos theory; also called principle of definite description *)
+(** AC! = functional relation reification
+          (known as axiom of unique choice in topos theory,
+           sometimes called principle of definite description in
+           the context of constructive type theory, sometimes
+           called axiom of no choice) *)
 
 Definition FunctionalRelReification_on :=
   forall R:A->B->Prop,
     (forall x : A, exists! y : B, R x y) ->
     (exists f : A->B, forall x : A, R x (f x)).
 
-(** ID_epsilon (constructive version of indefinite description;
-    combined with proof-irrelevance, it may be connected to
-    Carlström's type theory with a constructive indefinite description
-    operator) *)
+(** AC_dep! = functional relation reification, with dependent functions
+              see AC! *)
+Definition DependentFunctionalRelReification_on (A:Type) (B:A -> Type) :=
+  forall (R:forall x:A, B x -> Prop),
+    (forall x:A, exists! y : B x, R x y) ->
+    (exists f : (forall x:A, B x), forall x:A, R x (f x)).
+
+(** AC_fun_repr = functional choice of a representative in an equivalence class *)
+
+(* Note: This is called Type-Theoretic Choice Axiom (TTCA) in
+   [[Werner97]] (by reference to the extensional set-theoretic
+   formulation of choice); Note also a typo in its intended
+   formulation in [[Werner97]]. *)
+
+Definition RepresentativeFunctionalChoice_on :=
+  forall R:A->A->Prop,
+    (Equivalence R) ->
+    (exists f : A->A, forall x : A, (R x (f x)) /\ forall x', R x x' -> f x = f x').
+
+(** AC_fun_setoid = functional form of the (so-called extensional) axiom of
+                    choice from setoids *)
+
+Definition SetoidFunctionalChoice_on :=
+  forall R : A -> A -> Prop,
+  forall T : A -> B -> Prop,
+  Equivalence R ->
+  (forall x x' y, R x x' -> T x y -> T x' y) ->
+  (forall x, exists y, T x y) ->
+  exists f : A -> B, forall x : A, T x (f x) /\ (forall x' : A, R x x' -> f x = f x').
+
+(** AC_fun_setoid_gen = functional form of the general form of the (so-called
+                        extensional) axiom of choice over setoids *)
+
+(* Note: This is called extensional axiom of choice (AC_ext) in
+   [[Carlström04]]. *)
+
+Definition GeneralizedSetoidFunctionalChoice_on :=
+  forall R : A -> A -> Prop,
+  forall S : B -> B -> Prop,
+  forall T : A -> B -> Prop,
+  Equivalence R ->
+  Equivalence S ->
+  (forall x x' y y', R x x' -> S y y' -> T x y -> T x' y') ->
+  (forall x, exists y, T x y) ->
+  exists f : A -> B,
+    forall x : A, T x (f x) /\ (forall x' : A, R x x' -> S (f x) (f x')).
+
+(** AC_fun_setoid_simple = functional form of the (so-called extensional) axiom of
+                           choice from setoids on locally compatible relations *)
+
+Definition SimpleSetoidFunctionalChoice_on A B :=
+  forall R : A -> A -> Prop,
+  forall T : A -> B -> Prop,
+  Equivalence R ->
+  (forall x, exists y, forall x', R x x' -> T x' y) ->
+  exists f : A -> B, forall x : A, T x (f x) /\ (forall x' : A, R x x' -> f x = f x').
+
+(** ID_epsilon = constructive version of indefinite description;
+                 combined with proof-irrelevance, it may be connected to
+                 Carlström's type theory with a constructive indefinite description
+                 operator *)
 
 Definition ConstructiveIndefiniteDescription_on :=
   forall P:A->Prop,
     (exists x, P x) -> { x:A | P x }.
 
-(** ID_iota (constructive version of definite description; combined
-    with proof-irrelevance, it may be connected to Carlström's and
-    Stenlund's type theory with a constructive definite description
-    operator) *)
+(** ID_iota = constructive version of definite description;
+              combined with proof-irrelevance, it may be connected to
+              Carlström's and Stenlund's type theory with a
+              constructive definite description operator) *)
 
 Definition ConstructiveDefiniteDescription_on :=
   forall P:A->Prop,
@@ -168,7 +190,7 @@ Definition ConstructiveDefiniteDescription_on :=
 
 (** ** Weakly classical choice and description *)
 
-(** GAC_rel *)
+(** GAC_rel = guarded relational form of the (non extensional) axiom of choice *)
 
 Definition GuardedRelationalChoice_on :=
   forall P : A->Prop, forall R : A->B->Prop,
@@ -176,7 +198,7 @@ Definition GuardedRelationalChoice_on :=
     (exists R' : A->B->Prop,
       subrelation R' R /\ forall x, P x -> exists! y, R' x y).
 
-(** GAC_fun *)
+(** GAC_fun = guarded functional form of the (non extensional) axiom of choice *)
 
 Definition GuardedFunctionalChoice_on :=
   forall P : A->Prop, forall R : A->B->Prop,
@@ -184,7 +206,7 @@ Definition GuardedFunctionalChoice_on :=
     (forall x : A, P x -> exists y : B, R x y) ->
     (exists f : A->B, forall x, P x -> R x (f x)).
 
-(** GFR_fun *)
+(** GAC! = guarded functional relation reification *)
 
 Definition GuardedFunctionalRelReification_on :=
   forall P : A->Prop, forall R : A->B->Prop,
@@ -192,27 +214,28 @@ Definition GuardedFunctionalRelReification_on :=
     (forall x : A, P x -> exists! y : B, R x y) ->
     (exists f : A->B, forall x : A, P x -> R x (f x)).
 
-(** OAC_rel *)
+(** OAC_rel = "omniscient" relational form of the (non extensional) axiom of choice *)
 
 Definition OmniscientRelationalChoice_on :=
   forall R : A->B->Prop,
     exists R' : A->B->Prop,
       subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y.
 
-(** OAC_fun *)
+(** OAC_fun = "omniscient" functional form of the (non extensional) axiom of choice
+              (called AC* in Bell [[Bell]]) *)
 
 Definition OmniscientFunctionalChoice_on :=
   forall R : A->B->Prop,
     inhabited B ->
     exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x).
 
-(** D_epsilon *)
+(** D_epsilon = (weakly classical) indefinite description principle *)
 
 Definition EpsilonStatement_on :=
   forall P:A->Prop,
     inhabited A -> { x:A | (exists x, P x) -> P x }.
 
-(** D_iota *)
+(** D_iota = (weakly classical) definite description principle *)
 
 Definition IotaStatement_on :=
   forall P:A->Prop,
@@ -226,14 +249,28 @@ Notation RelationalChoice :=
   (forall A B : Type, RelationalChoice_on A B).
 Notation FunctionalChoice :=
   (forall A B : Type, FunctionalChoice_on A B).
-Definition FunctionalDependentChoice :=
+Notation DependentFunctionalChoice :=
+  (forall A (B:A->Type), DependentFunctionalChoice_on B).
+Notation InhabitedForallCommute :=
+  (forall A (B : A -> Type), InhabitedForallCommute_on B).
+Notation FunctionalDependentChoice :=
   (forall A : Type, FunctionalDependentChoice_on A).
-Definition FunctionalCountableChoice :=
+Notation FunctionalCountableChoice :=
   (forall A : Type, FunctionalCountableChoice_on A).
 Notation FunctionalChoiceOnInhabitedSet :=
   (forall A B : Type, inhabited B -> FunctionalChoice_on A B).
 Notation FunctionalRelReification :=
   (forall A B : Type, FunctionalRelReification_on A B).
+Notation DependentFunctionalRelReification :=
+  (forall A (B:A->Type), DependentFunctionalRelReification_on B).
+Notation RepresentativeFunctionalChoice :=
+  (forall A : Type, RepresentativeFunctionalChoice_on A).
+Notation SetoidFunctionalChoice :=
+  (forall A  B: Type, SetoidFunctionalChoice_on A B).
+Notation GeneralizedSetoidFunctionalChoice :=
+  (forall A B : Type, GeneralizedSetoidFunctionalChoice_on A B).
+Notation SimpleSetoidFunctionalChoice :=
+  (forall A B : Type, SimpleSetoidFunctionalChoice_on A B).
 
 Notation GuardedRelationalChoice :=
   (forall A B : Type, GuardedRelationalChoice_on A B).
@@ -259,18 +296,87 @@ Notation EpsilonStatement :=
 
 (** Subclassical schemes *)
 
+(** PI = proof irrelevance *)
 Definition ProofIrrelevance :=
   forall (A:Prop) (a1 a2:A), a1 = a2.
 
+(** IGP = independence of general premises
+          (an unconstrained generalisation of the constructive principle of
+           independence of premises) *)
 Definition IndependenceOfGeneralPremises :=
   forall (A:Type) (P:A -> Prop) (Q:Prop),
     inhabited A ->
     (Q -> exists x, P x) -> exists x, Q -> P x.
 
+(** Drinker = drinker's paradox (small form)
+              (called Ex in Bell [[Bell]]) *)
 Definition SmallDrinker'sParadox :=
   forall (A:Type) (P:A -> Prop), inhabited A ->
     exists x, (exists x, P x) -> P x.
 
+(** EM = excluded-middle *)
+Definition ExcludedMiddle :=
+  forall P:Prop, P \/ ~ P.
+
+(** Extensional schemes *)
+
+(** Ext_prop_repr = choice of a representative among extensional propositions *)
+Local Notation ExtensionalPropositionRepresentative :=
+  (forall (A:Type),
+   exists h : Prop -> Prop,
+   forall P : Prop, (P <-> h P) /\ forall Q, (P <-> Q) -> h P = h Q).
+
+(** Ext_pred_repr = choice of a representative among extensional predicates *)
+Local Notation ExtensionalPredicateRepresentative :=
+  (forall (A:Type),
+   exists h : (A->Prop) -> (A->Prop),
+   forall (P : A -> Prop), (forall x, P x <-> h P x) /\ forall Q, (forall x, P x <-> Q x) -> h P = h Q).
+
+(** Ext_fun_repr = choice of a representative among extensional functions *)
+Local Notation ExtensionalFunctionRepresentative :=
+  (forall (A B:Type),
+   exists h : (A->B) -> (A->B),
+   forall (f : A -> B), (forall x, f x = h f x) /\ forall g, (forall x, f x = g x) -> h f = h g).
+
+(** We let also
+
+- IPL_2   = 2nd-order impredicative minimal predicate logic (with ex. quant.)
+- IPL^2   = 2nd-order functional minimal predicate logic (with ex. quant.)
+- IPL_2^2 = 2nd-order impredicative, 2nd-order functional minimal pred. logic (with ex. quant.)
+
+with no prerequisite on the non-emptiness of domains
+*)
+
+(**********************************************************************)
+(** * Table of contents *)
+
+(* This is very fragile. *)
+(**
+1. Definitions
+
+2. IPL_2^2 |- AC_rel + AC! = AC_fun
+
+3.1. typed IPL_2 + Sigma-types + PI |- AC_rel = GAC_rel  and  IPL_2 |- AC_rel + IGP -> GAC_rel and IPL_2 |- GAC_rel = OAC_rel
+
+3.2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker
+
+3.3. D_iota -> ID_iota  and  D_epsilon <-> ID_epsilon + Drinker
+
+4. Derivability of choice for decidable relations with well-ordered codomain
+
+5. AC_fun = AC_fun_dep = AC_trunc
+
+6. Non contradiction of constructive descriptions wrt functional choices
+
+7. Definite description transports classical logic to the computational world
+
+8. Choice -> Dependent choice -> Countable choice
+
+9.1. AC_fun_setoid = AC_fun + Ext_fun_repr + EM
+
+9.2. AC_fun_setoid = AC_fun + Ext_pred_repr + PI
+ *)
+
 (**********************************************************************)
 (** * AC_rel + AC! = AC_fun
 
@@ -284,7 +390,7 @@ Definition SmallDrinker'sParadox :=
    relational formulation) without known inconsistency with classical logic,
    though functional relation reification conflicts with classical logic *)
 
-Lemma description_rel_choice_imp_funct_choice :
+Lemma functional_rel_reification_and_rel_choice_imp_fun_choice :
   forall A B : Type,
     FunctionalRelReification_on A B -> RelationalChoice_on A B -> FunctionalChoice_on A B.
 Proof.
@@ -298,7 +404,7 @@ Proof.
   apply HR'R; assumption.
 Qed.
 
-Lemma funct_choice_imp_rel_choice :
+Lemma fun_choice_imp_rel_choice :
   forall A B : Type, FunctionalChoice_on A B -> RelationalChoice_on A B.
 Proof.
   intros A B FunCh R H.
@@ -311,7 +417,7 @@ Proof.
     trivial.
 Qed.
 
-Lemma funct_choice_imp_description :
+Lemma fun_choice_imp_functional_rel_reification :
   forall A B : Type, FunctionalChoice_on A B -> FunctionalRelReification_on A B.
 Proof.
   intros A B FunCh R H.
@@ -324,15 +430,15 @@ Proof.
   exists f; exact H0.
 Qed.
 
-Corollary FunChoice_Equiv_RelChoice_and_ParamDefinDescr :
+Corollary fun_choice_iff_rel_choice_and_functional_rel_reification :
   forall A B : Type, FunctionalChoice_on A B <->
     RelationalChoice_on A B /\ FunctionalRelReification_on A B.
 Proof.
   intros A B. split.
   intro H; split;
-    [ exact (funct_choice_imp_rel_choice H)
-      | exact (funct_choice_imp_description H) ].
-  intros [H H0]; exact (description_rel_choice_imp_funct_choice H0 H).
+    [ exact (fun_choice_imp_rel_choice H)
+      | exact (fun_choice_imp_functional_rel_reification H) ].
+  intros [H H0]; exact (functional_rel_reification_and_rel_choice_imp_fun_choice H0 H).
 Qed.
 
 (**********************************************************************)
@@ -576,10 +682,6 @@ Qed.
 Require Import Wf_nat.
 Require Import Decidable.
 
-Definition FunctionalChoice_on_rel (A B:Type) (R:A->B->Prop) :=
-  (forall x:A, exists y : B, R x y) ->
-  exists f : A -> B, (forall x:A, R x (f x)).
-
 Lemma classical_denumerable_description_imp_fun_choice :
   forall A:Type,
     FunctionalRelReification_on A nat ->
@@ -601,18 +703,10 @@ Proof.
 Qed.
 
 (**********************************************************************)
-(** * Choice on dependent and non dependent function types are equivalent *)
+(** * AC_fun = AC_fun_dep = AC_trunc *)
 
 (** ** Choice on dependent and non dependent function types are equivalent *)
 
-Definition DependentFunctionalChoice_on (A:Type) (B:A -> Type) :=
-  forall R:forall x:A, B x -> Prop,
-    (forall x:A, exists y : B x, R x y) ->
-    (exists f : (forall x:A, B x), forall x:A, R x (f x)).
-
-Notation DependentFunctionalChoice :=
-  (forall A (B:A->Type), DependentFunctionalChoice_on B).
-
 (** The easy part *)
 
 Theorem dep_non_dep_functional_choice :
@@ -649,15 +743,34 @@ Proof.
   destruct Heq using eq_indd; trivial.
 Qed.
 
-(** ** Reification of dependent and non dependent functional relation  are equivalent *)
+(** ** Functional choice and truncation choice are equivalent *)
 
-Definition DependentFunctionalRelReification_on (A:Type) (B:A -> Type) :=
-  forall (R:forall x:A, B x -> Prop),
-    (forall x:A, exists! y : B x, R x y) ->
-    (exists f : (forall x:A, B x), forall x:A, R x (f x)).
+Theorem functional_choice_to_inhabited_forall_commute :
+  FunctionalChoice -> InhabitedForallCommute.
+Proof.
+  intros choose0 A B Hinhab.
+  pose proof (non_dep_dep_functional_choice choose0) as choose;clear choose0.
+  assert (Hexists : forall x, exists _ : B x, True).
+  { intros x;apply inhabited_sig_to_exists.
+    refine (inhabited_covariant _ (Hinhab x)).
+    intros y;exists y;exact I. }
+  apply choose in Hexists.
+  destruct Hexists as [f _].
+  exact (inhabits f).
+Qed.
 
-Notation DependentFunctionalRelReification :=
-  (forall A (B:A->Type), DependentFunctionalRelReification_on B).
+Theorem inhabited_forall_commute_to_functional_choice :
+  InhabitedForallCommute -> FunctionalChoice.
+Proof.
+  intros choose A B R Hexists.
+  assert (Hinhab : forall x, inhabited {y : B | R x y}).
+  { intros x;apply exists_to_inhabited_sig;trivial. }
+  apply choose in Hinhab. destruct Hinhab as [f].
+  exists (fun x => proj1_sig (f x)).
+  exact (fun x => proj2_sig (f x)).
+Qed.
+
+(** ** Reification of dependent and non dependent functional relation  are equivalent *)
 
 (** The easy part *)
 
@@ -862,3 +975,346 @@ Proof.
   rewrite Heq in HR.
   assumption.
 Qed.
+
+(**********************************************************************)
+(** * About the axiom of choice over setoids                          *)
+
+Require Import ClassicalFacts PropExtensionalityFacts.
+
+(**********************************************************************)
+(** ** Consequences of the choice of a representative in an equivalence class *)
+
+Theorem repr_fun_choice_imp_ext_prop_repr :
+  RepresentativeFunctionalChoice -> ExtensionalPropositionRepresentative.
+Proof.
+  intros ReprFunChoice A.
+  pose (R P Q := P <-> Q).
+  assert (Hequiv:Equivalence R) by (split; firstorder).
+  apply (ReprFunChoice _ R Hequiv).
+Qed.
+
+Theorem repr_fun_choice_imp_ext_pred_repr :
+  RepresentativeFunctionalChoice -> ExtensionalPredicateRepresentative.
+Proof.
+  intros ReprFunChoice A.
+  pose (R P Q := forall x : A, P x <-> Q x).
+  assert (Hequiv:Equivalence R) by (split; firstorder).
+  apply (ReprFunChoice _ R Hequiv).
+Qed.
+
+Theorem repr_fun_choice_imp_ext_function_repr :
+  RepresentativeFunctionalChoice -> ExtensionalFunctionRepresentative.
+Proof.
+  intros ReprFunChoice A B.
+  pose (R (f g : A -> B) := forall x : A, f x = g x).
+  assert (Hequiv:Equivalence R).
+  { split; try easy. firstorder using eq_trans. }
+  apply (ReprFunChoice _ R Hequiv).
+Qed.
+
+(** *** This is a variant of Diaconescu and Goodman-Myhill theorems *)
+
+Theorem repr_fun_choice_imp_excluded_middle :
+  RepresentativeFunctionalChoice -> ExcludedMiddle.
+Proof.
+  intros ReprFunChoice.
+  apply representative_boolean_partition_imp_excluded_middle, ReprFunChoice.
+Qed.
+
+Theorem repr_fun_choice_imp_relational_choice :
+  RepresentativeFunctionalChoice -> RelationalChoice.
+Proof.
+  intros ReprFunChoice A B T Hexists.
+  pose (D := (A*B)%type).
+  pose (R (z z':D) :=
+    let x := fst z in
+    let x' := fst z' in
+    let y := snd z in
+    let y' := snd z' in
+    x = x' /\ (T x y -> y = y' \/ T x y') /\ (T x y' -> y = y' \/ T x y)).
+  assert (Hequiv : Equivalence R).
+  { split.
+    - split. easy. firstorder.
+    - intros (x,y) (x',y') (H1,(H2,H2')). split. easy. simpl fst in *. simpl snd in *.
+      subst x'. split; intro H.
+      + destruct (H2' H); firstorder.
+      + destruct (H2 H); firstorder.
+    - intros (x,y) (x',y') (x'',y'') (H1,(H2,H2')) (H3,(H4,H4')).
+      simpl fst in *. simpl snd in *. subst x'' x'. split. easy. split; intro H.
+      + simpl fst in *. simpl snd in *. destruct (H2 H) as [<-|H0].
+        * destruct (H4 H); firstorder.
+        * destruct (H2' H0), (H4 H0); try subst y'; try subst y''; try firstorder.
+      + simpl fst in *. simpl snd in *. destruct (H4' H) as [<-|H0].
+        * destruct (H2' H); firstorder.
+        * destruct (H2' H0), (H4 H0); try subst y'; try subst y''; try firstorder. }
+  destruct (ReprFunChoice D R Hequiv) as (g,Hg).
+  set (T' x y := T x y /\ exists y', T x y' /\ g (x,y') = (x,y)).
+  exists T'. split.
+  - intros x y (H,_); easy.
+  - intro x. destruct (Hexists x) as (y,Hy).
+    exists (snd (g (x,y))).
+    destruct (Hg (x,y)) as ((Heq1,(H',H'')),Hgxyuniq); clear Hg.
+    destruct (H' Hy) as [Heq2|Hgy]; clear H'.
+    + split. split.
+      * rewrite <- Heq2. assumption.
+      * exists y. destruct (g (x,y)) as (x',y'). simpl in Heq1, Heq2. subst; easy.
+      * intros y' (Hy',(y'',(Hy'',Heq))).
+        rewrite (Hgxyuniq (x,y'')), Heq. easy. split. easy.
+        split; right; easy.
+    + split. split.
+      * assumption.
+      * exists y. destruct (g (x,y)) as (x',y'). simpl in Heq1. subst x'; easy.
+      * intros y' (Hy',(y'',(Hy'',Heq))).
+        rewrite (Hgxyuniq (x,y'')), Heq. easy. split. easy.
+        split; right; easy.
+Qed.
+
+(**********************************************************************)
+(** ** AC_fun_setoid = AC_fun_setoid_gen = AC_fun_setoid_simple       *)
+
+Theorem gen_setoid_fun_choice_imp_setoid_fun_choice  :
+  forall A B, GeneralizedSetoidFunctionalChoice_on A B -> SetoidFunctionalChoice_on A B.
+Proof.
+  intros A B GenSetoidFunChoice R T Hequiv Hcompat Hex.
+  apply GenSetoidFunChoice; try easy.
+  apply eq_equivalence.
+  intros * H <-. firstorder.
+Qed.
+
+Theorem setoid_fun_choice_imp_gen_setoid_fun_choice :
+  forall A B, SetoidFunctionalChoice_on A B -> GeneralizedSetoidFunctionalChoice_on A B.
+Proof.
+  intros A B SetoidFunChoice R S T HequivR HequivS Hcompat Hex.
+  destruct SetoidFunChoice with (R:=R) (T:=T) as (f,Hf); try easy.
+  { intros; apply (Hcompat x x' y y); try easy. }
+  exists f. intros x; specialize Hf with x as (Hf,Huniq). intuition. now erewrite Huniq.
+Qed.
+
+Corollary setoid_fun_choice_iff_gen_setoid_fun_choice :
+  forall A B, SetoidFunctionalChoice_on A B <-> GeneralizedSetoidFunctionalChoice_on A B.
+Proof.
+  split; auto using gen_setoid_fun_choice_imp_setoid_fun_choice, setoid_fun_choice_imp_gen_setoid_fun_choice.
+Qed.
+
+Theorem setoid_fun_choice_imp_simple_setoid_fun_choice  :
+   forall A B, SetoidFunctionalChoice_on A B -> SimpleSetoidFunctionalChoice_on A B.
+Proof.
+  intros A B SetoidFunChoice R T Hequiv Hexists.
+  pose (T' x y := forall x', R x x' -> T x' y).
+  assert (Hcompat : forall (x x' : A) (y : B), R x x' -> T' x y -> T' x' y) by firstorder.
+  destruct (SetoidFunChoice R T' Hequiv Hcompat Hexists) as (f,Hf).
+  exists f. firstorder.
+Qed.
+
+Theorem simple_setoid_fun_choice_imp_setoid_fun_choice :
+  forall A B, SimpleSetoidFunctionalChoice_on A B -> SetoidFunctionalChoice_on A B.
+Proof.
+  intros A B SimpleSetoidFunChoice R T Hequiv Hcompat Hexists.
+  destruct (SimpleSetoidFunChoice R T Hequiv) as (f,Hf); firstorder.
+Qed.
+
+Corollary setoid_fun_choice_iff_simple_setoid_fun_choice :
+  forall A B, SetoidFunctionalChoice_on A B <-> SimpleSetoidFunctionalChoice_on A B.
+Proof.
+  split; auto using simple_setoid_fun_choice_imp_setoid_fun_choice, setoid_fun_choice_imp_simple_setoid_fun_choice.
+Qed.
+
+(**********************************************************************)
+(** ** AC_fun_setoid = AC! + AC_fun_repr                              *)
+
+Theorem setoid_fun_choice_imp_fun_choice :
+  forall A B, SetoidFunctionalChoice_on A B -> FunctionalChoice_on A B.
+Proof.
+  intros A B SetoidFunChoice T Hexists.
+  destruct SetoidFunChoice with (R:=@eq A) (T:=T) as (f,Hf).
+  - apply eq_equivalence.
+  - now intros * ->.
+  - assumption.
+  - exists f. firstorder.
+Qed.
+
+Corollary setoid_fun_choice_imp_functional_rel_reification :
+  forall A B, SetoidFunctionalChoice_on A B -> FunctionalRelReification_on A B.
+Proof.
+  intros A B SetoidFunChoice.
+  apply fun_choice_imp_functional_rel_reification.
+  now apply setoid_fun_choice_imp_fun_choice.
+Qed.
+
+Theorem setoid_fun_choice_imp_repr_fun_choice :
+  SetoidFunctionalChoice -> RepresentativeFunctionalChoice .
+Proof.
+  intros SetoidFunChoice A R Hequiv.
+  apply SetoidFunChoice; firstorder.
+Qed.
+
+Theorem functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice :
+  FunctionalRelReification -> RepresentativeFunctionalChoice -> SetoidFunctionalChoice.
+Proof.
+  intros FunRelReify ReprFunChoice A B R T Hequiv Hcompat Hexists.
+  assert (FunChoice : FunctionalChoice).
+  { intros A' B'. apply functional_rel_reification_and_rel_choice_imp_fun_choice.
+    - apply FunRelReify.
+    - now apply repr_fun_choice_imp_relational_choice. }
+  destruct (FunChoice _ _ T Hexists) as (f,Hf).
+  destruct (ReprFunChoice A R Hequiv) as (g,Hg).
+  exists (fun a => f (g a)).
+  intro x. destruct (Hg x) as (Hgx,HRuniq).
+  split.
+  - eapply Hcompat. symmetry. apply Hgx. apply Hf.
+  - intros y Hxy. f_equal. auto.
+Qed.
+
+Theorem functional_rel_reification_and_repr_fun_choice_iff_setoid_fun_choice :
+  FunctionalRelReification /\ RepresentativeFunctionalChoice <-> SetoidFunctionalChoice.
+Proof.
+  split; intros.
+  - now apply functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice.
+  - split.
+    + now intros A B; apply setoid_fun_choice_imp_functional_rel_reification.
+    + now apply setoid_fun_choice_imp_repr_fun_choice.
+Qed.
+
+(** Note: What characterization to give of
+RepresentativeFunctionalChoice? A formulation of it as a functional
+relation would certainly be equivalent to the formulation of
+SetoidFunctionalChoice as a functional relation, but in their
+functional forms, SetoidFunctionalChoice seems strictly stronger *)
+
+(**********************************************************************)
+(** * AC_fun_setoid = AC_fun + Ext_fun_repr + EM                      *)
+
+Import EqNotations.
+
+(** ** This is the main theorem in [[Carlström04]] *)
+
+(** Note: all ingredients have a computational meaning when taken in
+  separation. However, to compute with the functional choice,
+  existential quantification has to be thought as a strong
+  existential, which is incompatible with the computational content of
+  excluded-middle *)
+
+Theorem fun_choice_and_ext_functions_repr_and_excluded_middle_imp_setoid_fun_choice :
+  FunctionalChoice -> ExtensionalFunctionRepresentative -> ExcludedMiddle -> RepresentativeFunctionalChoice.
+Proof.
+  intros FunChoice SetoidFunRepr EM A R (Hrefl,Hsym,Htrans).
+  assert (H:forall P:Prop, exists b, b = true <-> P).
+  { intros P. destruct (EM P).
+    - exists true; firstorder.
+    - exists false; easy. }
+  destruct (FunChoice _ _ _ H) as (c,Hc).
+  pose (class_of a y := c (R a y)).
+  pose (isclass f := exists x:A, f x = true).
+  pose (class := {f:A -> bool | isclass f}).
+  pose (contains (c:class) (a:A) := proj1_sig c a = true).
+  destruct (FunChoice class A contains) as (f,Hf).
+  - intros f. destruct (proj2_sig f) as (x,Hx).
+    exists x. easy.
+  - destruct (SetoidFunRepr A bool) as (h,Hh).
+    assert (Hisclass:forall a, isclass (h (class_of a))).
+    { intro a. exists a. destruct (Hh (class_of a)) as (Ha,Huniqa).
+      rewrite <- Ha. apply Hc. apply Hrefl. }
+   pose (f':= fun a => exist _ (h (class_of a)) (Hisclass a) : class).
+    exists (fun a => f (f' a)).
+    intros x. destruct (Hh (class_of x)) as (Hx,Huniqx). split.
+    + specialize Hf with (f' x). unfold contains in Hf. simpl in Hf. rewrite <- Hx in Hf. apply Hc. assumption.
+    + intros y Hxy.
+       f_equal.
+       assert (Heq1: h (class_of x) = h (class_of y)).
+       { apply Huniqx. intro z. unfold class_of.
+         destruct (c (R x z)) eqn:Hxz.
+         - symmetry. apply Hc. apply -> Hc in Hxz. firstorder.
+         - destruct (c (R y z)) eqn:Hyz.
+           + apply -> Hc in Hyz. rewrite <- Hxz. apply Hc. firstorder.
+           + easy. }
+       assert (Heq2:rew Heq1 in Hisclass x = Hisclass y).
+       { apply proof_irrelevance_cci, EM. }
+       unfold f'.
+       rewrite <- Heq2.
+       rewrite <- Heq1.
+       reflexivity.
+Qed.
+
+Theorem setoid_functional_choice_first_characterization :
+  FunctionalChoice /\ ExtensionalFunctionRepresentative /\ ExcludedMiddle <-> SetoidFunctionalChoice.
+Proof.
+  split.
+  - intros (FunChoice & SetoidFunRepr & EM).
+    apply functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice.
+    + intros A B. apply fun_choice_imp_functional_rel_reification, FunChoice.
+    + now apply fun_choice_and_ext_functions_repr_and_excluded_middle_imp_setoid_fun_choice.
+  - intro SetoidFunChoice. repeat split.
+    + now intros A B; apply setoid_fun_choice_imp_fun_choice.
+    + apply repr_fun_choice_imp_ext_function_repr.
+       now apply setoid_fun_choice_imp_repr_fun_choice.
+    + apply repr_fun_choice_imp_excluded_middle.
+       now apply setoid_fun_choice_imp_repr_fun_choice.
+Qed.
+
+(**********************************************************************)
+(** ** AC_fun_setoid = AC_fun + Ext_pred_repr + PI                    *)
+
+(** Note: all ingredients have a computational meaning when taken in
+  separation. However, to compute with the functional choice,
+  existential quantification has to be thought as a strong
+  existential, which is incompatible with proof-irrelevance which
+  requires existential quantification to be truncated *)
+
+Theorem fun_choice_and_ext_pred_ext_and_proof_irrel_imp_setoid_fun_choice :
+  FunctionalChoice -> ExtensionalPredicateRepresentative -> ProofIrrelevance -> RepresentativeFunctionalChoice.
+Proof.
+  intros FunChoice PredExtRepr PI A R (Hrefl,Hsym,Htrans).
+  pose (isclass P := exists x:A, P x).
+  pose (class := {P:A -> Prop | isclass P}).
+  pose (contains (c:class) (a:A) := proj1_sig c a).
+  pose (class_of a := R a).
+  destruct (FunChoice class A contains) as (f,Hf).
+  - intros c. apply proj2_sig.
+  - destruct (PredExtRepr A) as (h,Hh).
+    assert (Hisclass:forall a, isclass (h (class_of a))).
+    { intro a. exists a. destruct (Hh (class_of a)) as (Ha,Huniqa).
+      rewrite <- Ha; apply Hrefl. }
+    pose (f':= fun a => exist _ (h (class_of a)) (Hisclass a) : class).
+    exists (fun a => f (f' a)).
+    intros x. destruct (Hh (class_of x)) as (Hx,Huniqx). split.
+    + specialize Hf with (f' x). simpl in Hf. rewrite <- Hx in Hf. assumption.
+    + intros y Hxy.
+       f_equal.
+       assert (Heq1: h (class_of x) = h (class_of y)).
+       { apply Huniqx. intro z. unfold class_of. firstorder. }
+       assert (Heq2:rew Heq1 in Hisclass x = Hisclass y).
+       { apply PI. }
+       unfold f'.
+       rewrite <- Heq2.
+       rewrite <- Heq1.
+       reflexivity.
+Qed.
+
+Theorem setoid_functional_choice_second_characterization :
+  FunctionalChoice /\ ExtensionalPredicateRepresentative /\ ProofIrrelevance <-> SetoidFunctionalChoice.
+Proof.
+  split.
+  - intros (FunChoice & ExtPredRepr & PI).
+    apply functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice.
+    + intros A B. now apply fun_choice_imp_functional_rel_reification.
+    + now apply fun_choice_and_ext_pred_ext_and_proof_irrel_imp_setoid_fun_choice.
+  - intro SetoidFunChoice. repeat split.
+    + now intros A B; apply setoid_fun_choice_imp_fun_choice.
+    + apply repr_fun_choice_imp_ext_pred_repr.
+       now apply setoid_fun_choice_imp_repr_fun_choice.
+    + red. apply proof_irrelevance_cci.
+       apply repr_fun_choice_imp_excluded_middle.
+       now apply setoid_fun_choice_imp_repr_fun_choice.
+Qed.
+
+(**********************************************************************)
+(** * Compatibility notations *)
+Notation description_rel_choice_imp_funct_choice :=
+  functional_rel_reification_and_rel_choice_imp_fun_choice (only parsing).
+
+Notation funct_choice_imp_rel_choice := fun_choice_imp_rel_choice (only parsing).
+
+Notation FunChoice_Equiv_RelChoice_and_ParamDefinDescr :=
+ fun_choice_iff_rel_choice_and_functional_rel_reification (only parsing).
+
+Notation funct_choice_imp_description := fun_choice_imp_functional_rel_reification (only parsing).
diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v
index 14d83501..72f53a46 100644
--- a/theories/Logic/Classical.v
+++ b/theories/Logic/Classical.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File created for Coq V5.10.14b, Oct 1995 *)
diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v
index 7041ee40..016fa72f 100644
--- a/theories/Logic/ClassicalChoice.v
+++ b/theories/Logic/ClassicalChoice.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file provides classical logic and functional choice; this
diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v
index 9e6d07b2..6867c76e 100644
--- a/theories/Logic/ClassicalDescription.v
+++ b/theories/Logic/ClassicalDescription.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file provides classical logic and definite description, which is
diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v
index 0e91613d..77af9048 100644
--- a/theories/Logic/ClassicalEpsilon.v
+++ b/theories/Logic/ClassicalEpsilon.v
@@ -1,10 +1,12 @@
-(* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
+(************************************************************************)
 (************************************************************************)
 
 (** This file provides classical logic and indefinite description under
diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v
index afd64efd..b06384e9 100644
--- a/theories/Logic/ClassicalFacts.v
+++ b/theories/Logic/ClassicalFacts.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Some facts and definitions about classical logic
@@ -34,8 +36,11 @@ Table of contents:
 
 3 3. Independence of general premises and drinker's paradox
 
-4. Classical logic and principle of unrestricted minimization
+4. Principles equivalent to classical logic
 
+4.1 Classical logic = principle of unrestricted minimization
+
+4.2 Classical logic = choice of representatives in a partition of bool
 *)
 
 (************************************************************************)
@@ -94,12 +99,14 @@ Qed.
 (** A weakest form of propositional extensionality: extensionality for
     provable propositions only *)
 
+Require Import PropExtensionalityFacts.
+
 Definition provable_prop_extensionality := forall A:Prop, A -> A = True.
 
 Lemma provable_prop_ext :
   prop_extensionality -> provable_prop_extensionality.
 Proof.
-  intros Ext A Ha; apply Ext; split; trivial.
+  exact PropExt_imp_ProvPropExt.
 Qed.
 
 (************************************************************************)
@@ -516,7 +523,7 @@ End Weak_proof_irrelevance_CCI.
 (** ** Weak excluded-middle *)
 
 (** The weak classical logic based on [~~A \/ ~A] is referred to with
-    name KC in {[ChagrovZakharyaschev97]]
+    name KC in [[ChagrovZakharyaschev97]]
 
    [[ChagrovZakharyaschev97]] Alexander Chagrov and Michael
    Zakharyaschev, "Modal Logic", Clarendon Press, 1997.
@@ -661,6 +668,8 @@ Proof.
     exists x0; exact Hnot.
 Qed.
 
+(** * Axioms equivalent to classical logic *)
+
 (** ** Principle of unrestricted minimization *)
 
 Require Import Coq.Arith.PeanoNat.
@@ -736,3 +745,56 @@ Section Example_of_undecidable_predicate_with_the_minimization_property.
   Qed.
 
 End Example_of_undecidable_predicate_with_the_minimization_property.
+
+(** ** Choice of representatives in a partition of bool *)
+
+(** This is similar to Bell's "weak extensional selection principle"  in [[Bell]]
+
+   [[Bell]] John L. Bell, Choice principles in intuitionistic set theory, unpublished.
+*)
+
+Require Import RelationClasses.
+
+Local Notation representative_boolean_partition :=
+  (forall R:bool->bool->Prop,
+    Equivalence R -> exists f, forall x, R x (f x) /\ forall y, R x y -> f x = f y).
+
+Theorem representative_boolean_partition_imp_excluded_middle :
+  representative_boolean_partition -> excluded_middle.
+Proof.
+  intros ReprFunChoice P.
+  pose (R (b1 b2 : bool) := b1 = b2 \/ P).
+  assert (Equivalence R).
+  { split.
+    - now left.
+    - destruct 1. now left. now right.
+    - destruct 1, 1; try now right. left; now transitivity y. }
+  destruct (ReprFunChoice R H) as (f,Hf). clear H.
+  destruct (Bool.bool_dec (f true) (f false)) as [Heq|Hneq].
+  + left.
+     destruct (Hf false) as ([Hfalse|HP],_); try easy.
+     destruct (Hf true) as ([Htrue|HP],_); try easy.
+     congruence.
+  + right. intro HP.
+     destruct (Hf true) as (_,H). apply Hneq, H. now right.
+Qed.
+
+Theorem excluded_middle_imp_representative_boolean_partition :
+  excluded_middle -> representative_boolean_partition.
+Proof.
+  intros EM R H.
+  destruct (EM (R true false)).
+  - exists (fun _ => true).
+    intros []; firstorder.
+  - exists (fun b => b).
+    intro b. split.
+    + reflexivity.
+    + destruct b, y; intros HR; easy || now symmetry in HR.
+Qed.
+
+Theorem excluded_middle_iff_representative_boolean_partition :
+  excluded_middle <-> representative_boolean_partition.
+Proof.
+  split; auto using excluded_middle_imp_representative_boolean_partition,
+                    representative_boolean_partition_imp_excluded_middle.
+Qed.
diff --git a/theories/Logic/ClassicalUniqueChoice.v b/theories/Logic/ClassicalUniqueChoice.v
index 57f367e5..841bd1be 100644
--- a/theories/Logic/ClassicalUniqueChoice.v
+++ b/theories/Logic/ClassicalUniqueChoice.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file provides classical logic and unique choice; this is
diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v
index 6665798d..18820d3b 100644
--- a/theories/Logic/Classical_Pred_Type.v
+++ b/theories/Logic/Classical_Pred_Type.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file is a renaming for V5.10.14b, Oct 1995, of file Classical.v
diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v
index 2c69d4f0..9f5a2993 100644
--- a/theories/Logic/Classical_Prop.v
+++ b/theories/Logic/Classical_Prop.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File created for Coq V5.10.14b, Oct 1995 *)
@@ -97,12 +99,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/ConstructiveEpsilon.v b/theories/Logic/ConstructiveEpsilon.v
index a304dd24..6e3da423 100644
--- a/theories/Logic/ConstructiveEpsilon.v
+++ b/theories/Logic/ConstructiveEpsilon.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i $Id: ConstructiveEpsilon.v 12112 2009-04-28 15:47:34Z herbelin $ i*)
diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v
index 8b6054f9..35920d91 100644
--- a/theories/Logic/Decidable.v
+++ b/theories/Logic/Decidable.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (** Properties of decidable propositions *)
 
diff --git a/theories/Logic/Description.v b/theories/Logic/Description.v
index 0239222e..5c4f1960 100644
--- a/theories/Logic/Description.v
+++ b/theories/Logic/Description.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file provides a constructive form of definite description; it
diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v
index 23af5afc..3317766c 100644
--- a/theories/Logic/Diaconescu.v
+++ b/theories/Logic/Diaconescu.v
@@ -1,16 +1,18 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Diaconescu showed that the Axiom of Choice entails Excluded-Middle
-   in topoi [Diaconescu75]. Lacas and Werner adapted the proof to show
+   in topoi [[Diaconescu75]]. Lacas and Werner adapted the proof to show
    that the axiom of choice in equivalence classes entails
-   Excluded-Middle in Type Theory [LacasWerner99].
+   Excluded-Middle in Type Theory [[LacasWerner99]].
 
    Three variants of Diaconescu's result in type theory are shown below.
 
@@ -23,23 +25,24 @@
       Benjamin Werner)
 
    C. A proof that extensional Hilbert epsilon's description operator
-      entails excluded-middle (taken from Bell [Bell93])
+      entails excluded-middle (taken from Bell [[Bell93]])
 
-   See also [Carlström] for a discussion of the connection between the
+   See also [[Carlström04]] for a discussion of the connection between the
    Extensional Axiom of Choice and Excluded-Middle
 
-   [Diaconescu75] Radu Diaconescu, Axiom of Choice and Complementation,
+   [[Diaconescu75]] Radu Diaconescu, Axiom of Choice and Complementation,
    in Proceedings of AMS, vol 51, pp 176-178, 1975.
 
-   [LacasWerner99] Samuel Lacas, Benjamin Werner, Which Choices imply
+   [[LacasWerner99]] Samuel Lacas, Benjamin Werner, Which Choices imply
    the excluded middle?, preprint, 1999.
 
-   [Bell93] John L. Bell, Hilbert's epsilon operator and classical
+   [[Bell93]] John L. Bell, Hilbert's epsilon operator and classical
    logic, Journal of Philosophical Logic, 22: 1-18, 1993
 
-   [Carlström04] Jesper Carlström, EM + Ext_ + AC_int <-> AC_ext,
-   Mathematical Logic Quaterly, vol 50(3), pp 236-240, 2004.
+   [[Carlström04]] Jesper Carlström, EM + Ext_ + AC_int is equivalent
+   to AC_ext, Mathematical Logic Quaterly, vol 50(3), pp 236-240, 2004.
 *)
+Require ClassicalFacts ChoiceFacts.
 
 (**********************************************************************)
 (** * Pred. Ext. + Rel. Axiom of Choice -> Excluded-Middle       *)
@@ -54,7 +57,7 @@ Definition PredicateExtensionality :=
 (** From predicate extensionality we get propositional extensionality
    hence proof-irrelevance *)
 
-Require Import ClassicalFacts.
+Import ClassicalFacts.
 
 Variable pred_extensionality : PredicateExtensionality.
 
@@ -76,7 +79,7 @@ Qed.
 (** From proof-irrelevance and relational choice, we get guarded
    relational choice *)
 
-Require Import ChoiceFacts.
+Import ChoiceFacts.
 
 Variable rel_choice : RelationalChoice.
 
@@ -89,7 +92,7 @@ Qed.
 (** The form of choice we need: there is a functional relation which chooses
     an element in any non empty subset of bool *)
 
-Require Import Bool.
+Import Bool.
 
 Lemma AC_bool_subset_to_bool :
   exists R : (bool -> Prop) -> bool -> Prop,
@@ -161,6 +164,8 @@ End PredExt_RelChoice_imp_EM.
 
 Section ProofIrrel_RelChoice_imp_EqEM.
 
+Import ChoiceFacts.
+
 Variable rel_choice : RelationalChoice.
 
 Variable proof_irrelevance : forall P:Prop , forall x y:P, x=y.
@@ -263,7 +268,7 @@ End ProofIrrel_RelChoice_imp_EqEM.
 (**********************************************************************)
 (** * Extensional Hilbert's epsilon description operator -> Excluded-Middle *)
 
-(** Proof sketch from Bell [Bell93] (with thanks to P. Castéran) *)
+(** Proof sketch from Bell [[Bell93]] (with thanks to P. Castéran) *)
 
 Local Notation inhabited A := A (only parsing).
 
diff --git a/theories/Logic/Epsilon.v b/theories/Logic/Epsilon.v
index ffbb5758..d8c527c6 100644
--- a/theories/Logic/Epsilon.v
+++ b/theories/Logic/Epsilon.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file provides indefinite description under the form of
diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v
index 5ef86b8e..35bc4225 100644
--- a/theories/Logic/Eqdep.v
+++ b/theories/Logic/Eqdep.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File Eqdep.v created by Christine Paulin-Mohring in Coq V5.6, May 1992 *)
diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v
index bd59159b..d938b315 100644
--- a/theories/Logic/EqdepFacts.v
+++ b/theories/Logic/EqdepFacts.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* File Eqdep.v created by Christine Paulin-Mohring in Coq V5.6, May 1992 *)
@@ -123,7 +125,7 @@ Proof.
   apply eq_dep_intro.
 Qed.
 
-Notation eq_sigS_eq_dep := eq_sigT_eq_dep (compat "8.2"). (* Compatibility *)
+Notation eq_sigS_eq_dep := eq_sigT_eq_dep (compat "8.6"). (* Compatibility *)
 
 Lemma eq_dep_eq_sigT :
   forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q),
diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v
index b7b4dec2..0560d9ed 100644
--- a/theories/Logic/Eqdep_dec.v
+++ b/theories/Logic/Eqdep_dec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Bruno Barras, Jan 1998 *)
diff --git a/theories/Logic/ExtensionalFunctionRepresentative.v b/theories/Logic/ExtensionalFunctionRepresentative.v
new file mode 100644
index 00000000..0aac56bb
--- /dev/null
+++ b/theories/Logic/ExtensionalFunctionRepresentative.v
@@ -0,0 +1,26 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** This module states a limited form axiom of functional
+    extensionality which selects a canonical representative in each
+    class of extensional functions *)
+
+(** Its main interest is that it is the needed ingredient to provide
+    axiom of choice on setoids (a.k.a. axiom of extensional choice)
+    when combined with classical logic and axiom of (intensonal)
+    choice *)
+
+(** It provides extensionality of functions while still supporting (a
+    priori) an intensional interpretation of equality *)
+
+Axiom extensional_function_representative :
+  forall A B, exists repr, forall (f : A -> B),
+  (forall x, f x = repr f x) /\
+  (forall g, (forall x, f x = g x) -> repr f = repr g).
diff --git a/theories/Logic/ExtensionalityFacts.v b/theories/Logic/ExtensionalityFacts.v
index 0e34e7e9..02c8998a 100644
--- a/theories/Logic/ExtensionalityFacts.v
+++ b/theories/Logic/ExtensionalityFacts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Some facts and definitions about extensionality
diff --git a/theories/Logic/FinFun.v b/theories/Logic/FinFun.v
index 06466801..89f5a82a 100644
--- a/theories/Logic/FinFun.v
+++ b/theories/Logic/FinFun.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Functions on finite domains *)
diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v
index 04d9a670..95e1af2e 100644
--- a/theories/Logic/FunctionalExtensionality.v
+++ b/theories/Logic/FunctionalExtensionality.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module states the axiom of (dependent) functional extensionality and (dependent) eta-expansion.
@@ -56,6 +58,78 @@ Proof.
   apply functional_extensionality in H. destruct H. reflexivity.
 Defined.
 
+(** A version of [functional_extensionality_dep] which is provably
+    equal to [eq_refl] on [fun _ => eq_refl] *)
+Definition functional_extensionality_dep_good
+           {A} {B : A -> Type}
+           (f g : forall x : A, B x)
+           (H : forall x, f x = g x)
+  : f = g
+  := eq_trans (eq_sym (functional_extensionality_dep f f (fun _ => eq_refl)))
+              (functional_extensionality_dep f g H).
+
+Lemma functional_extensionality_dep_good_refl {A B} f
+  : @functional_extensionality_dep_good A B f f (fun _ => eq_refl) = eq_refl.
+Proof.
+  unfold functional_extensionality_dep_good; edestruct functional_extensionality_dep; reflexivity.
+Defined.
+
+Opaque functional_extensionality_dep_good.
+
+Lemma forall_sig_eq_rect
+      {A B} (f : forall a : A, B a)
+      (P : { g : _ | (forall a, f a = g a) } -> Type)
+      (k : P (exist (fun g => forall a, f a = g a) f (fun a => eq_refl)))
+      g
+: P g.
+Proof.
+  destruct g as [g1 g2].
+  set (g' := fun x => (exist _ (g1 x) (g2 x))).
+  change g2 with (fun x => proj2_sig (g' x)).
+  change g1 with (fun x => proj1_sig (g' x)).
+  clearbody g'; clear g1 g2.
+  cut (forall x, (exist _ (f x) eq_refl) = g' x).
+  { intro H'.
+    apply functional_extensionality_dep_good in H'.
+    destruct H'.
+    exact k. }
+  { intro x.
+    destruct (g' x) as [g'x1 g'x2].
+    destruct g'x2.
+    reflexivity. }
+Defined.
+
+Definition forall_eq_rect
+      {A B} (f : forall a : A, B a)
+      (P : forall g, (forall a, f a = g a) -> Type)
+      (k : P f (fun a => eq_refl))
+      g H
+  : P g H
+  := @forall_sig_eq_rect A B f (fun g => P (proj1_sig g) (proj2_sig g)) k (exist _ g H).
+
+Definition forall_eq_rect_comp {A B} f P k
+  : @forall_eq_rect A B f P k f (fun _ => eq_refl) = k.
+Proof.
+  unfold forall_eq_rect, forall_sig_eq_rect; simpl.
+  rewrite functional_extensionality_dep_good_refl; reflexivity.
+Qed.
+
+Definition f_equal__functional_extensionality_dep_good
+           {A B f g} H a
+  : f_equal (fun h => h a) (@functional_extensionality_dep_good A B f g H) = H a.
+Proof.
+  apply forall_eq_rect with (H := H); clear H g.
+  change (eq_refl (f a)) with (f_equal (fun h => h a) (eq_refl f)).
+  apply f_equal, functional_extensionality_dep_good_refl.
+Defined.
+
+Definition f_equal__functional_extensionality_dep_good__fun
+           {A B f g} H
+  : (fun a => f_equal (fun h => h a) (@functional_extensionality_dep_good A B f g H)) = H.
+Proof.
+  apply functional_extensionality_dep_good; intro a; apply f_equal__functional_extensionality_dep_good.
+Defined.
+
 (** Apply [functional_extensionality], introducing variable x. *)
 
 Tactic Notation "extensionality" ident(x) :=
@@ -68,13 +142,93 @@ Tactic Notation "extensionality" ident(x) :=
      apply forall_extensionality) ; intro x
   end.
 
-(** Eta expansion follows from extensionality. *)
+(** Iteratively apply [functional_extensionality] on an hypothesis
+    until finding an equality statement *)
+(* Note that you can write [Ltac extensionality_in_checker tac ::= tac tt.] to get a more informative error message. *)
+Ltac extensionality_in_checker tac :=
+  first [ tac tt | fail 1 "Anomaly: Unexpected error in extensionality tactic.  Please report." ].
+Tactic Notation "extensionality" "in" hyp(H) :=
+  let rec check_is_extensional_equality H :=
+      lazymatch type of H with
+      | _ = _ => constr:(Prop)
+      | forall a : ?A, ?T
+        => let Ha := fresh in
+           constr:(forall a : A, match H a with Ha => ltac:(let v := check_is_extensional_equality Ha in exact v) end)
+      end in
+  let assert_is_extensional_equality H :=
+      first [ let dummy := check_is_extensional_equality H in idtac
+            | fail 1 "Not an extensional equality" ] in
+  let assert_not_intensional_equality H :=
+      lazymatch type of H with
+      | _ = _ => fail "Already an intensional equality"
+      | _ => idtac
+      end in
+  let enforce_no_body H :=
+      (tryif (let dummy := (eval unfold H in H) in idtac)
+        then clearbody H
+        else idtac) in
+  let rec extensionality_step_make_type H :=
+      lazymatch type of H with
+      | forall a : ?A, ?f = ?g
+        => constr:({ H' | (fun a => f_equal (fun h => h a) H') = H })
+      | forall a : ?A, _
+        => let H' := fresh in
+           constr:(forall a : A, match H a with H' => ltac:(let ret := extensionality_step_make_type H' in exact ret) end)
+      end in
+  let rec eta_contract T :=
+      lazymatch (eval cbv beta in T) with
+      | context T'[fun a : ?A => ?f a]
+        => let T'' := context T'[f] in
+           eta_contract T''
+      | ?T => T
+      end in
+  let rec lift_sig_extensionality H :=
+      lazymatch type of H with
+      | sig _ => H
+      | forall a : ?A, _
+        => let Ha := fresh in
+           let ret := constr:(fun a : A => match H a with Ha => ltac:(let v := lift_sig_extensionality Ha in exact v) end) in
+           lazymatch type of ret with
+           | forall a : ?A, sig (fun b : ?B => @?f a b = @?g a b)
+             => eta_contract (exist (fun b : (forall a : A, B) => (fun a : A => f a (b a)) = (fun a : A => g a (b a)))
+                                    (fun a : A => proj1_sig (ret a))
+                                    (@functional_extensionality_dep_good _ _ _ _ (fun a : A => proj2_sig (ret a))))
+           end
+      end in
+  let extensionality_pre_step H H_out Heq :=
+      let T := extensionality_step_make_type H in
+      let H' := fresh in
+      assert (H' : T) by (intros; eexists; apply f_equal__functional_extensionality_dep_good__fun);
+      let H''b := lift_sig_extensionality H' in
+      case H''b; clear H';
+      intros H_out Heq in
+  let rec extensionality_rec H H_out Heq :=
+      lazymatch type of H with
+      | forall a, _ = _
+        => extensionality_pre_step H H_out Heq
+      | _
+        => let pre_H_out' := fresh H_out in
+           let H_out' := fresh pre_H_out' in
+           extensionality_pre_step H H_out' Heq;
+           let Heq' := fresh Heq in
+           extensionality_rec H_out' H_out Heq';
+           subst H_out'
+      end in
+  first [ assert_is_extensional_equality H | fail 1 "Not an extensional equality" ];
+  first [ assert_not_intensional_equality H | fail 1 "Already an intensional equality" ];
+  (tryif enforce_no_body H then idtac else clearbody H);
+  let H_out := fresh in
+  let Heq := fresh "Heq" in
+  extensionality_in_checker ltac:(fun tt => extensionality_rec H H_out Heq);
+  (* If we [subst H], things break if we already have another equation of the form [_ = H] *)
+  destruct Heq; rename H_out into H.
+
+(** Eta expansion 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/Logic/Hurkens.v b/theories/Logic/Hurkens.v
index 841f843c..6c4a8533 100644
--- a/theories/Logic/Hurkens.v
+++ b/theories/Logic/Hurkens.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                              Hurkens.v                               *)
 (************************************************************************)
@@ -360,13 +362,12 @@ Module NoRetractToModalProposition.
 Section Paradox.
 
 Variable M : Prop -> Prop.
-Hypothesis unit : forall A:Prop, A -> M A.
-Hypothesis join : forall A:Prop, M (M A) -> M A.
 Hypothesis incr : forall A B:Prop, (A->B) -> M A -> M B.
 
 Lemma strength: forall A (P:A->Prop), M(forall x:A,P x) -> forall x:A,M(P x).
 Proof.
-  eauto.
+  intros A P h x.
+  eapply incr in h; eauto.
 Qed.
 
 (** ** The universe of modal propositions *)
@@ -470,7 +471,7 @@ Hypothesis p2p2 : forall A:NProp, El A -> El (b2p (p2b A)).
 Theorem paradox : forall B:NProp, El B.
 Proof.
   intros B.
-  unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _ _ _))).
+  unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _))).
   + exact (fun P => ~~P).
   + exact bool.
   + exact p2b.
@@ -480,8 +481,6 @@ Proof.
   + cbn. auto.
   + cbn. auto.
   + cbn. auto.
-  + auto.
-  + auto.
 Qed.
 
 End Paradox.
@@ -516,7 +515,7 @@ Hypothesis p2p2 : forall A:NProp, El A -> El (b2p (p2b A)).
 Theorem mparadox : forall B:NProp, El B.
 Proof.
   intros B.
-  unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _ _ _))).
+  unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _))).
   + exact (fun P => P).
   + exact bool.
   + exact p2b.
@@ -526,8 +525,6 @@ Proof.
   + cbn. auto.
   + cbn. auto.
   + cbn. auto.
-  + auto.
-  + auto.
 Qed.
 
 End MParadox.
@@ -562,7 +559,7 @@ End Paradox.
 End NoRetractFromSmallPropositionToProp.
 
 
-(** * Large universes are no retracts of [Prop]. *)
+(** * Large universes are not retracts of [Prop]. *)
 
 (** The existence in the Calculus of Constructions with universes of a
     retract from some [Type] universe into [Prop] is inconsistent. *)
diff --git a/theories/Logic/IndefiniteDescription.v b/theories/Logic/IndefiniteDescription.v
index 21be5032..86e81529 100644
--- a/theories/Logic/IndefiniteDescription.v
+++ b/theories/Logic/IndefiniteDescription.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file provides a constructive form of indefinite description that
diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v
index 2f95856b..9c56b60a 100644
--- a/theories/Logic/JMeq.v
+++ b/theories/Logic/JMeq.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** John Major's Equality as proposed by Conor McBride
@@ -130,7 +132,7 @@ Qed.
     is as strong as [eq_dep U P p x q y] (this uses [JMeq_eq]) *)
 
 Lemma JMeq_eq_dep : 
-  forall U (P:U->Prop) p q (x:P p) (y:P q), 
+  forall U (P:U->Type) p q (x:P p) (y:P q), 
   p = q -> JMeq x y -> eq_dep U P p x q y.
 Proof.
 intros.
diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v
index 305839cd..134bf649 100644
--- a/theories/Logic/ProofIrrelevance.v
+++ b/theories/Logic/ProofIrrelevance.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file axiomatizes proof-irrelevance and derives some consequences *)
diff --git a/theories/Logic/ProofIrrelevanceFacts.v b/theories/Logic/ProofIrrelevanceFacts.v
index 19b3e9e6..10d9dbcd 100644
--- a/theories/Logic/ProofIrrelevanceFacts.v
+++ b/theories/Logic/ProofIrrelevanceFacts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This defines the functor that build consequences of proof-irrelevance *)
diff --git a/theories/Logic/PropExtensionality.v b/theories/Logic/PropExtensionality.v
new file mode 100644
index 00000000..80dd4e85
--- /dev/null
+++ b/theories/Logic/PropExtensionality.v
@@ -0,0 +1,24 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** This module states propositional extensionality and draws
+    consequences of it *)
+
+Axiom propositional_extensionality :
+  forall (P Q : Prop), (P <-> Q) -> P = Q.
+
+Require Import ClassicalFacts.
+
+Theorem proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2.
+Proof.
+  apply ext_prop_dep_proof_irrel_cic.
+  exact propositional_extensionality.
+Qed.
+
diff --git a/theories/Logic/PropExtensionalityFacts.v b/theories/Logic/PropExtensionalityFacts.v
new file mode 100644
index 00000000..2b303517
--- /dev/null
+++ b/theories/Logic/PropExtensionalityFacts.v
@@ -0,0 +1,111 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Some facts and definitions about propositional and predicate extensionality
+
+We investigate the relations between the following extensionality principles
+
+- Proposition extensionality
+- Predicate extensionality
+- Propositional functional extensionality
+- Provable-proposition extensionality
+- Refutable-proposition extensionality
+- Extensional proposition representatives
+- Extensional predicate representatives
+- Extensional propositional function representatives
+
+Table of contents
+
+1. Definitions
+
+2.1 Predicate extensionality <-> Proposition extensionality + Propositional functional extensionality
+
+2.2 Propositional extensionality -> Provable propositional extensionality
+
+2.3 Propositional extensionality -> Refutable propositional extensionality
+
+*)
+
+Set Implicit Arguments.
+
+(**********************************************************************)
+(** * Definitions *)
+
+(** Propositional extensionality *)
+
+Local Notation PropositionalExtensionality :=
+  (forall A B : Prop, (A <-> B) -> A = B).
+
+(** Provable-proposition extensionality *)
+
+Local Notation ProvablePropositionExtensionality :=
+  (forall A:Prop, A -> A = True).
+
+(** Refutable-proposition extensionality *)
+
+Local Notation RefutablePropositionExtensionality :=
+  (forall A:Prop, ~A -> A = False).
+
+(** Predicate extensionality *)
+
+Local Notation PredicateExtensionality :=
+  (forall (A:Type) (P Q : A -> Prop), (forall x, P x <-> Q x) -> P = Q).
+
+(** Propositional functional extensionality *)
+
+Local Notation PropositionalFunctionalExtensionality :=
+  (forall (A:Type) (P Q : A -> Prop), (forall x, P x = Q x) -> P = Q).
+
+(**********************************************************************)
+(** * Propositional and predicate extensionality                      *)
+
+(**********************************************************************)
+(** ** Predicate extensionality <-> Propositional extensionality + Propositional functional extensionality *)
+
+Lemma PredExt_imp_PropExt : PredicateExtensionality -> PropositionalExtensionality.
+Proof.
+  intros Ext A B Equiv. 
+  change A with ((fun _ => A) I).
+  now rewrite Ext with (P := fun _ : True =>A) (Q := fun _ => B).
+Qed.
+
+Lemma PredExt_imp_PropFunExt : PredicateExtensionality -> PropositionalFunctionalExtensionality.
+Proof.
+  intros Ext A P Q Eq. apply Ext. intros x. now rewrite (Eq x).
+Qed.
+
+Lemma PropExt_and_PropFunExt_imp_PredExt :
+  PropositionalExtensionality -> PropositionalFunctionalExtensionality -> PredicateExtensionality.
+Proof.
+  intros Ext FunExt A P Q Equiv.
+  apply FunExt. intros x. now apply Ext.
+Qed.
+
+Theorem PropExt_and_PropFunExt_iff_PredExt :
+  PropositionalExtensionality /\ PropositionalFunctionalExtensionality <-> PredicateExtensionality.
+Proof.
+  firstorder using PredExt_imp_PropExt, PredExt_imp_PropFunExt, PropExt_and_PropFunExt_imp_PredExt.
+Qed.
+
+(**********************************************************************)
+(** ** Propositional extensionality and provable proposition extensionality *)
+
+Lemma PropExt_imp_ProvPropExt : PropositionalExtensionality -> ProvablePropositionExtensionality.
+Proof.
+  intros Ext A Ha; apply Ext; split; trivial.
+Qed.
+
+(**********************************************************************)
+(** ** Propositional extensionality and refutable proposition extensionality *)
+
+Lemma PropExt_imp_RefutPropExt : PropositionalExtensionality -> RefutablePropositionExtensionality.
+Proof.
+  intros Ext A Ha; apply Ext; split; easy.
+Qed.
diff --git a/theories/Logic/PropFacts.v b/theories/Logic/PropFacts.v
index 309539e5..06787035 100644
--- a/theories/Logic/PropFacts.v
+++ b/theories/Logic/PropFacts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Basic facts about Prop as a type *)
diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v
index d16835f8..994f0785 100644
--- a/theories/Logic/RelationalChoice.v
+++ b/theories/Logic/RelationalChoice.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file axiomatizes the relational form of the axiom of choice *)
diff --git a/theories/Logic/SetIsType.v b/theories/Logic/SetIsType.v
index 33fce6cc..afa85514 100644
--- a/theories/Logic/SetIsType.v
+++ b/theories/Logic/SetIsType.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * The Set universe seen as a synonym for Type *)
diff --git a/theories/Logic/SetoidChoice.v b/theories/Logic/SetoidChoice.v
new file mode 100644
index 00000000..21bf7335
--- /dev/null
+++ b/theories/Logic/SetoidChoice.v
@@ -0,0 +1,62 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** This module states the functional form of the axiom of choice over
+  setoids, commonly called extensional axiom of choice [[Carlström04]],
+  [[Martin-Löf05]]. This is obtained by a decomposition of the axiom
+  into the following components:
+
+  - classical logic
+  - relational axiom of choice
+  - axiom of unique choice
+  - a limited form of functional extensionality
+
+  Among other results, it entails:
+  - proof irrelevance
+  - choice of a representative in equivalence classes
+
+  [[Carlström04]] Jesper Carlström, EM + Ext_ + AC_int is equivalent to
+  AC_ext, Mathematical Logic Quaterly, vol 50(3), pp 236-240, 2004.
+
+  [[Martin-Löf05] Per Martin-Löf, 100 years of Zermelo’s axiom of
+  choice: what was the problem with it?, lecture notes for KTH/SU
+  colloquium, 2005.
+
+*)
+
+Require Export ClassicalChoice. (* classical logic, relational choice, unique choice *)
+Require Export ExtensionalFunctionRepresentative.
+
+Require Import ChoiceFacts.
+Require Import ClassicalFacts.
+Require Import RelationClasses.
+
+Theorem setoid_choice :
+  forall A B,
+  forall R : A -> A -> Prop,
+  forall T : A -> B -> Prop,
+  Equivalence R ->
+  (forall x x' y, R x x' -> T x y -> T x' y) ->
+  (forall x, exists y, T x y) ->
+  exists f : A -> B, forall x : A, T x (f x) /\ (forall x' : A, R x x' -> f x = f x').
+Proof.
+  apply setoid_functional_choice_first_characterization. split; [|split].
+  - exact choice.
+  - exact extensional_function_representative.
+  - exact classic.
+Qed.
+
+Theorem representative_choice :
+  forall A (R:A->A->Prop), (Equivalence R) ->
+  exists f : A->A, forall x : A, R x (f x) /\ forall x', R x x' -> f x = f x'.
+Proof.
+  apply setoid_fun_choice_imp_repr_fun_choice.
+  exact setoid_choice.
+Qed.
diff --git a/theories/Logic/WKL.v b/theories/Logic/WKL.v
index 95f3e83f..579800b8 100644
--- a/theories/Logic/WKL.v
+++ b/theories/Logic/WKL.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** A constructive proof of a version of Weak König's Lemma over a
diff --git a/theories/Logic/WeakFan.v b/theories/Logic/WeakFan.v
index 4416d38d..c9822f47 100644
--- a/theories/Logic/WeakFan.v
+++ b/theories/Logic/WeakFan.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** A constructive proof of a non-standard version of the weak Fan Theorem
diff --git a/theories/Logic/vo.itarget b/theories/Logic/vo.itarget
deleted file mode 100644
index 32359739..00000000
--- a/theories/Logic/vo.itarget
+++ /dev/null
@@ -1,30 +0,0 @@
-Berardi.vo
-ChoiceFacts.vo
-ClassicalChoice.vo
-ClassicalDescription.vo
-ClassicalEpsilon.vo
-ClassicalFacts.vo
-Classical_Pred_Type.vo
-Classical_Prop.vo
-ClassicalUniqueChoice.vo
-Classical.vo
-ConstructiveEpsilon.vo
-Decidable.vo
-Description.vo
-Diaconescu.vo
-Epsilon.vo
-Eqdep_dec.vo
-EqdepFacts.vo
-Eqdep.vo
-WeakFan.vo
-WKL.vo
-FunctionalExtensionality.vo
-ExtensionalityFacts.vo
-Hurkens.vo
-IndefiniteDescription.vo
-JMeq.vo
-ProofIrrelevanceFacts.vo
-ProofIrrelevance.vo
-RelationalChoice.vo
-SetIsType.vo
-FinFun.vo
\ No newline at end of file
diff --git a/theories/MSets/MSetAVL.v b/theories/MSets/MSetAVL.v
index a3c265a2..b966f217 100644
--- a/theories/MSets/MSetAVL.v
+++ b/theories/MSets/MSetAVL.v
@@ -1,11 +1,13 @@
 (* -*- coding: utf-8 -*- *)
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * MSetAVL : Implementation of MSetInterface via AVL trees *)
 
@@ -31,7 +33,7 @@
     code after extraction.
 *)
 
-Require Import MSetInterface MSetGenTree BinInt Int.
+Require Import FunInd MSetInterface MSetGenTree BinInt Int.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
diff --git a/theories/MSets/MSetDecide.v b/theories/MSets/MSetDecide.v
index 9c622fd7..f228cbb3 100644
--- a/theories/MSets/MSetDecide.v
+++ b/theories/MSets/MSetDecide.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (**************************************************************)
 (* MSetDecide.v                                               *)
diff --git a/theories/MSets/MSetEqProperties.v b/theories/MSets/MSetEqProperties.v
index ae20edc8..1ee098cb 100644
--- a/theories/MSets/MSetEqProperties.v
+++ b/theories/MSets/MSetEqProperties.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/MSets/MSetFacts.v b/theories/MSets/MSetFacts.v
index 4e17618f..d57a7741 100644
--- a/theories/MSets/MSetFacts.v
+++ b/theories/MSets/MSetFacts.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/MSets/MSetGenTree.v b/theories/MSets/MSetGenTree.v
index 154c2384..95868861 100644
--- a/theories/MSets/MSetGenTree.v
+++ b/theories/MSets/MSetGenTree.v
@@ -1,17 +1,19 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * MSetGenTree : sets via generic trees
 
     This module factorizes common parts in implementations
     of finite sets as AVL trees and as Red-Black trees. The nodes
     of the trees defined here include an generic information
-    parameter, that will be the heigth in AVL trees and the color
+    parameter, that will be the height in AVL trees and the color
     in Red-Black trees. Without more details here about these
     information parameters, trees here are not known to be
     well-balanced, but simply binary-search-trees.
@@ -27,7 +29,7 @@
      - min_elt max_elt choose
 *)
 
-Require Import Orders OrdersFacts MSetInterface PeanoNat.
+Require Import FunInd Orders OrdersFacts MSetInterface PeanoNat.
 Local Open Scope list_scope.
 Local Open Scope lazy_bool_scope.
 
@@ -1144,4 +1146,4 @@ Proof.
  apply mindepth_cardinal.
 Qed.
 
-End Props.
\ No newline at end of file
+End Props.
diff --git a/theories/MSets/MSetInterface.v b/theories/MSets/MSetInterface.v
index 74a7f6df..f0e75715 100644
--- a/theories/MSets/MSetInterface.v
+++ b/theories/MSets/MSetInterface.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite set library *)
 
diff --git a/theories/MSets/MSetList.v b/theories/MSets/MSetList.v
index 05c20eb8..35fe4cee 100644
--- a/theories/MSets/MSetList.v
+++ b/theories/MSets/MSetList.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/MSets/MSetPositive.v b/theories/MSets/MSetPositive.v
index be95a037..a726eebd 100644
--- a/theories/MSets/MSetPositive.v
+++ b/theories/MSets/MSetPositive.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** Efficient implementation of [MSetInterface.S] for positive keys,
     inspired from the [FMapPositive] module.
diff --git a/theories/MSets/MSetProperties.v b/theories/MSets/MSetProperties.v
index 396067b5..3c7dea73 100644
--- a/theories/MSets/MSetProperties.v
+++ b/theories/MSets/MSetProperties.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/MSets/MSetRBT.v b/theories/MSets/MSetRBT.v
index 83a2343d..eab01a55 100644
--- a/theories/MSets/MSetRBT.v
+++ b/theories/MSets/MSetRBT.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * MSetRBT : Implementation of MSetInterface via Red-Black trees *)
 
diff --git a/theories/MSets/MSetToFiniteSet.v b/theories/MSets/MSetToFiniteSet.v
index e8087bc5..f456c407 100644
--- a/theories/MSets/MSetToFiniteSet.v
+++ b/theories/MSets/MSetToFiniteSet.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library : conversion to old [Finite_sets] *)
 
diff --git a/theories/MSets/MSetWeakList.v b/theories/MSets/MSetWeakList.v
index 2ac57a93..8df1ff1c 100644
--- a/theories/MSets/MSetWeakList.v
+++ b/theories/MSets/MSetWeakList.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * Finite sets library *)
 
diff --git a/theories/MSets/MSets.v b/theories/MSets/MSets.v
index f179bcd1..0c9bc20c 100644
--- a/theories/MSets/MSets.v
+++ b/theories/MSets/MSets.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export Orders.
 Require Export OrdersEx.
@@ -18,4 +20,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/MSets/vo.itarget b/theories/MSets/vo.itarget
deleted file mode 100644
index 7c5b6899..00000000
--- a/theories/MSets/vo.itarget
+++ /dev/null
@@ -1,13 +0,0 @@
-MSetGenTree.vo
-MSetAVL.vo
-MSetRBT.vo
-MSetDecide.vo
-MSetEqProperties.vo
-MSetFacts.vo
-MSetInterface.vo
-MSetList.vo
-MSetProperties.vo
-MSets.vo
-MSetToFiniteSet.vo
-MSetWeakList.vo
-MSetPositive.vo
\ No newline at end of file
diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v
index 4c398573..5d3ec5ab 100644
--- a/theories/NArith/BinNat.v
+++ b/theories/NArith/BinNat.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export BinNums.
@@ -956,95 +958,94 @@ Notation "( p | q )" := (N.divide p q) (at level 0) : N_scope.
 
 (** Compatibility notations *)
 
-(*Notation N := N (compat "8.3").*) (*hidden by module N above *)
 Notation N_rect := N_rect (only parsing).
 Notation N_rec := N_rec (only parsing).
 Notation N_ind := N_ind (only parsing).
 Notation N0 := N0 (only parsing).
 Notation Npos := N.pos (only parsing).
 
-Notation Ndiscr := N.discr (compat "8.3").
-Notation Ndouble_plus_one := N.succ_double (compat "8.3").
-Notation Ndouble := N.double (compat "8.3").
-Notation Nsucc := N.succ (compat "8.3").
-Notation Npred := N.pred (compat "8.3").
-Notation Nsucc_pos := N.succ_pos (compat "8.3").
-Notation Ppred_N := Pos.pred_N (compat "8.3").
-Notation Nplus := N.add (compat "8.3").
-Notation Nminus := N.sub (compat "8.3").
-Notation Nmult := N.mul (compat "8.3").
-Notation Neqb := N.eqb (compat "8.3").
-Notation Ncompare := N.compare (compat "8.3").
-Notation Nlt := N.lt (compat "8.3").
-Notation Ngt := N.gt (compat "8.3").
-Notation Nle := N.le (compat "8.3").
-Notation Nge := N.ge (compat "8.3").
-Notation Nmin := N.min (compat "8.3").
-Notation Nmax := N.max (compat "8.3").
-Notation Ndiv2 := N.div2 (compat "8.3").
-Notation Neven := N.even (compat "8.3").
-Notation Nodd := N.odd (compat "8.3").
-Notation Npow := N.pow (compat "8.3").
-Notation Nlog2 := N.log2 (compat "8.3").
-
-Notation nat_of_N := N.to_nat (compat "8.3").
-Notation N_of_nat := N.of_nat (compat "8.3").
-Notation N_eq_dec := N.eq_dec (compat "8.3").
-Notation Nrect := N.peano_rect (compat "8.3").
-Notation Nrect_base := N.peano_rect_base (compat "8.3").
-Notation Nrect_step := N.peano_rect_succ (compat "8.3").
-Notation Nind := N.peano_ind (compat "8.3").
-Notation Nrec := N.peano_rec (compat "8.3").
-Notation Nrec_base := N.peano_rec_base (compat "8.3").
-Notation Nrec_succ := N.peano_rec_succ (compat "8.3").
-
-Notation Npred_succ := N.pred_succ (compat "8.3").
-Notation Npred_minus := N.pred_sub (compat "8.3").
-Notation Nsucc_pred := N.succ_pred (compat "8.3").
-Notation Ppred_N_spec := N.pos_pred_spec (compat "8.3").
-Notation Nsucc_pos_spec := N.succ_pos_spec (compat "8.3").
-Notation Ppred_Nsucc := N.pos_pred_succ (compat "8.3").
-Notation Nplus_0_l := N.add_0_l (compat "8.3").
-Notation Nplus_0_r := N.add_0_r (compat "8.3").
-Notation Nplus_comm := N.add_comm (compat "8.3").
-Notation Nplus_assoc := N.add_assoc (compat "8.3").
-Notation Nplus_succ := N.add_succ_l (compat "8.3").
-Notation Nsucc_0 := N.succ_0_discr (compat "8.3").
-Notation Nsucc_inj := N.succ_inj (compat "8.3").
-Notation Nminus_N0_Nle := N.sub_0_le (compat "8.3").
-Notation Nminus_0_r := N.sub_0_r (compat "8.3").
-Notation Nminus_succ_r:= N.sub_succ_r (compat "8.3").
-Notation Nmult_0_l := N.mul_0_l (compat "8.3").
-Notation Nmult_1_l := N.mul_1_l (compat "8.3").
-Notation Nmult_1_r := N.mul_1_r (compat "8.3").
-Notation Nmult_comm := N.mul_comm (compat "8.3").
-Notation Nmult_assoc := N.mul_assoc (compat "8.3").
-Notation Nmult_plus_distr_r := N.mul_add_distr_r (compat "8.3").
-Notation Neqb_eq := N.eqb_eq (compat "8.3").
-Notation Nle_0 := N.le_0_l (compat "8.3").
-Notation Ncompare_refl := N.compare_refl (compat "8.3").
-Notation Ncompare_Eq_eq := N.compare_eq (compat "8.3").
-Notation Ncompare_eq_correct := N.compare_eq_iff (compat "8.3").
-Notation Nlt_irrefl := N.lt_irrefl (compat "8.3").
-Notation Nlt_trans := N.lt_trans (compat "8.3").
-Notation Nle_lteq := N.lt_eq_cases (compat "8.3").
-Notation Nlt_succ_r := N.lt_succ_r (compat "8.3").
-Notation Nle_trans := N.le_trans (compat "8.3").
-Notation Nle_succ_l := N.le_succ_l (compat "8.3").
-Notation Ncompare_spec := N.compare_spec (compat "8.3").
-Notation Ncompare_0 := N.compare_0_r (compat "8.3").
-Notation Ndouble_div2 := N.div2_double (compat "8.3").
-Notation Ndouble_plus_one_div2 := N.div2_succ_double (compat "8.3").
-Notation Ndouble_inj := N.double_inj (compat "8.3").
-Notation Ndouble_plus_one_inj := N.succ_double_inj (compat "8.3").
-Notation Npow_0_r := N.pow_0_r (compat "8.3").
-Notation Npow_succ_r := N.pow_succ_r (compat "8.3").
-Notation Nlog2_spec := N.log2_spec (compat "8.3").
-Notation Nlog2_nonpos := N.log2_nonpos (compat "8.3").
-Notation Neven_spec := N.even_spec (compat "8.3").
-Notation Nodd_spec := N.odd_spec (compat "8.3").
-Notation Nlt_not_eq := N.lt_neq (compat "8.3").
-Notation Ngt_Nlt := N.gt_lt (compat "8.3").
+Notation Ndiscr := N.discr (compat "8.6").
+Notation Ndouble_plus_one := N.succ_double (only parsing).
+Notation Ndouble := N.double (compat "8.6").
+Notation Nsucc := N.succ (compat "8.6").
+Notation Npred := N.pred (compat "8.6").
+Notation Nsucc_pos := N.succ_pos (compat "8.6").
+Notation Ppred_N := Pos.pred_N (compat "8.6").
+Notation Nplus := N.add (only parsing).
+Notation Nminus := N.sub (only parsing).
+Notation Nmult := N.mul (only parsing).
+Notation Neqb := N.eqb (compat "8.6").
+Notation Ncompare := N.compare (compat "8.6").
+Notation Nlt := N.lt (compat "8.6").
+Notation Ngt := N.gt (compat "8.6").
+Notation Nle := N.le (compat "8.6").
+Notation Nge := N.ge (compat "8.6").
+Notation Nmin := N.min (compat "8.6").
+Notation Nmax := N.max (compat "8.6").
+Notation Ndiv2 := N.div2 (compat "8.6").
+Notation Neven := N.even (compat "8.6").
+Notation Nodd := N.odd (compat "8.6").
+Notation Npow := N.pow (compat "8.6").
+Notation Nlog2 := N.log2 (compat "8.6").
+
+Notation nat_of_N := N.to_nat (only parsing).
+Notation N_of_nat := N.of_nat (only parsing).
+Notation N_eq_dec := N.eq_dec (compat "8.6").
+Notation Nrect := N.peano_rect (only parsing).
+Notation Nrect_base := N.peano_rect_base (only parsing).
+Notation Nrect_step := N.peano_rect_succ (only parsing).
+Notation Nind := N.peano_ind (only parsing).
+Notation Nrec := N.peano_rec (only parsing).
+Notation Nrec_base := N.peano_rec_base (only parsing).
+Notation Nrec_succ := N.peano_rec_succ (only parsing).
+
+Notation Npred_succ := N.pred_succ (compat "8.6").
+Notation Npred_minus := N.pred_sub (only parsing).
+Notation Nsucc_pred := N.succ_pred (compat "8.6").
+Notation Ppred_N_spec := N.pos_pred_spec (only parsing).
+Notation Nsucc_pos_spec := N.succ_pos_spec (compat "8.6").
+Notation Ppred_Nsucc := N.pos_pred_succ (only parsing).
+Notation Nplus_0_l := N.add_0_l (only parsing).
+Notation Nplus_0_r := N.add_0_r (only parsing).
+Notation Nplus_comm := N.add_comm (only parsing).
+Notation Nplus_assoc := N.add_assoc (only parsing).
+Notation Nplus_succ := N.add_succ_l (only parsing).
+Notation Nsucc_0 := N.succ_0_discr (only parsing).
+Notation Nsucc_inj := N.succ_inj (compat "8.6").
+Notation Nminus_N0_Nle := N.sub_0_le (only parsing).
+Notation Nminus_0_r := N.sub_0_r (only parsing).
+Notation Nminus_succ_r:= N.sub_succ_r (only parsing).
+Notation Nmult_0_l := N.mul_0_l (only parsing).
+Notation Nmult_1_l := N.mul_1_l (only parsing).
+Notation Nmult_1_r := N.mul_1_r (only parsing).
+Notation Nmult_comm := N.mul_comm (only parsing).
+Notation Nmult_assoc := N.mul_assoc (only parsing).
+Notation Nmult_plus_distr_r := N.mul_add_distr_r (only parsing).
+Notation Neqb_eq := N.eqb_eq (compat "8.6").
+Notation Nle_0 := N.le_0_l (only parsing).
+Notation Ncompare_refl := N.compare_refl (compat "8.6").
+Notation Ncompare_Eq_eq := N.compare_eq (only parsing).
+Notation Ncompare_eq_correct := N.compare_eq_iff (only parsing).
+Notation Nlt_irrefl := N.lt_irrefl (compat "8.6").
+Notation Nlt_trans := N.lt_trans (compat "8.6").
+Notation Nle_lteq := N.lt_eq_cases (only parsing).
+Notation Nlt_succ_r := N.lt_succ_r (compat "8.6").
+Notation Nle_trans := N.le_trans (compat "8.6").
+Notation Nle_succ_l := N.le_succ_l (compat "8.6").
+Notation Ncompare_spec := N.compare_spec (compat "8.6").
+Notation Ncompare_0 := N.compare_0_r (only parsing).
+Notation Ndouble_div2 := N.div2_double (only parsing).
+Notation Ndouble_plus_one_div2 := N.div2_succ_double (only parsing).
+Notation Ndouble_inj := N.double_inj (compat "8.6").
+Notation Ndouble_plus_one_inj := N.succ_double_inj (only parsing).
+Notation Npow_0_r := N.pow_0_r (compat "8.6").
+Notation Npow_succ_r := N.pow_succ_r (compat "8.6").
+Notation Nlog2_spec := N.log2_spec (compat "8.6").
+Notation Nlog2_nonpos := N.log2_nonpos (compat "8.6").
+Notation Neven_spec := N.even_spec (compat "8.6").
+Notation Nodd_spec := N.odd_spec (compat "8.6").
+Notation Nlt_not_eq := N.lt_neq (only parsing).
+Notation Ngt_Nlt := N.gt_lt (only parsing).
 
 (** More complex compatibility facts, expressed as lemmas
     (to preserve scopes for instance) *)
diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v
index 4df4242e..5de75537 100644
--- a/theories/NArith/BinNatDef.v
+++ b/theories/NArith/BinNatDef.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export BinNums.
@@ -378,4 +380,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/NArith/NArith.v b/theories/NArith/NArith.v
index 12d3ad2f..f3007970 100644
--- a/theories/NArith/NArith.v
+++ b/theories/NArith/NArith.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Library for binary natural numbers *)
diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v
index 37fd9dde..67c30f22 100644
--- a/theories/NArith/Ndec.v
+++ b/theories/NArith/Ndec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool.
@@ -20,11 +22,11 @@ Local Open Scope N_scope.
 (** Obsolete results about boolean comparisons over [N],
     kept for compatibility with IntMap and SMC. *)
 
-Notation Peqb := Pos.eqb (compat "8.3").
-Notation Neqb := N.eqb (compat "8.3").
-Notation Peqb_correct := Pos.eqb_refl (compat "8.3").
-Notation Neqb_correct := N.eqb_refl (compat "8.3").
-Notation Neqb_comm := N.eqb_sym (compat "8.3").
+Notation Peqb := Pos.eqb (compat "8.6").
+Notation Neqb := N.eqb (compat "8.6").
+Notation Peqb_correct := Pos.eqb_refl (only parsing).
+Notation Neqb_correct := N.eqb_refl (only parsing).
+Notation Neqb_comm := N.eqb_sym (only parsing).
 
 Lemma Peqb_complete p p' : Pos.eqb p p' = true -> p = p'.
 Proof. now apply Pos.eqb_eq. Qed.
@@ -274,7 +276,7 @@ Qed.
 
 (* Old results about [N.min] *)
 
-Notation Nmin_choice := N.min_dec (compat "8.3").
+Notation Nmin_choice := N.min_dec (only parsing).
 
 Lemma Nmin_le_1 a b : Nleb (N.min a b) a = true.
 Proof. rewrite Nleb_Nle. apply N.le_min_l. Qed.
diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v
index a1e51c9d..3ccaa721 100644
--- a/theories/NArith/Ndigits.v
+++ b/theories/NArith/Ndigits.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool Morphisms Setoid Bvector BinPos BinNat PeanoNat Pnat Nnat.
@@ -14,17 +16,17 @@ Local Open Scope N_scope.
 
 (** Compatibility names for some bitwise operations *)
 
-Notation Pxor := Pos.lxor (compat "8.3").
-Notation Nxor := N.lxor (compat "8.3").
-Notation Pbit := Pos.testbit_nat (compat "8.3").
-Notation Nbit := N.testbit_nat (compat "8.3").
+Notation Pxor := Pos.lxor (only parsing).
+Notation Nxor := N.lxor (only parsing).
+Notation Pbit := Pos.testbit_nat (only parsing).
+Notation Nbit := N.testbit_nat (only parsing).
 
-Notation Nxor_eq := N.lxor_eq (compat "8.3").
-Notation Nxor_comm := N.lxor_comm (compat "8.3").
-Notation Nxor_assoc := N.lxor_assoc (compat "8.3").
-Notation Nxor_neutral_left := N.lxor_0_l (compat "8.3").
-Notation Nxor_neutral_right := N.lxor_0_r (compat "8.3").
-Notation Nxor_nilpotent := N.lxor_nilpotent (compat "8.3").
+Notation Nxor_eq := N.lxor_eq (only parsing).
+Notation Nxor_comm := N.lxor_comm (only parsing).
+Notation Nxor_assoc := N.lxor_assoc (only parsing).
+Notation Nxor_neutral_left := N.lxor_0_l (only parsing).
+Notation Nxor_neutral_right := N.lxor_0_r (only parsing).
+Notation Nxor_nilpotent := N.lxor_nilpotent (only parsing).
 
 (** Equivalence of bit-testing functions,
     either with index in [N] or in [nat]. *)
@@ -249,7 +251,7 @@ Local Close Scope N_scope.
 (** Checking whether a number is odd, i.e.
    if its lower bit is set. *)
 
-Notation Nbit0 := N.odd (compat "8.3").
+Notation Nbit0 := N.odd (only parsing).
 
 Definition Nodd (n:N) := N.odd n = true.
 Definition Neven (n:N) := N.odd n = false.
@@ -498,7 +500,7 @@ Qed.
 
 (** Number of digits in a number *)
 
-Notation Nsize := N.size_nat (compat "8.3").
+Notation Nsize := N.size_nat (only parsing).
 
 (** conversions between N and bit vectors. *)
 
diff --git a/theories/NArith/Ndist.v b/theories/NArith/Ndist.v
index 0ab8be58..d9a58c05 100644
--- a/theories/NArith/Ndist.v
+++ b/theories/NArith/Ndist.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 Require Import Arith.
 Require Import Min.
diff --git a/theories/NArith/Ndiv_def.v b/theories/NArith/Ndiv_def.v
index 4bdf6529..7c9fd869 100644
--- a/theories/NArith/Ndiv_def.v
+++ b/theories/NArith/Ndiv_def.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinNat.
@@ -22,10 +24,10 @@ Lemma Pdiv_eucl_remainder a b :
   snd (Pdiv_eucl a b) < Npos b.
 Proof. now apply (N.pos_div_eucl_remainder a (Npos b)). Qed.
 
-Notation Ndiv_eucl := N.div_eucl (compat "8.3").
-Notation Ndiv := N.div (compat "8.3").
-Notation Nmod := N.modulo (compat "8.3").
+Notation Ndiv_eucl := N.div_eucl (compat "8.6").
+Notation Ndiv := N.div (compat "8.6").
+Notation Nmod := N.modulo (only parsing).
 
-Notation Ndiv_eucl_correct := N.div_eucl_spec (compat "8.3").
-Notation Ndiv_mod_eq := N.div_mod' (compat "8.3").
-Notation Nmod_lt := N.mod_lt (compat "8.3").
+Notation Ndiv_eucl_correct := N.div_eucl_spec (only parsing).
+Notation Ndiv_mod_eq := N.div_mod' (only parsing).
+Notation Nmod_lt := N.mod_lt (compat "8.6").
diff --git a/theories/NArith/Ngcd_def.v b/theories/NArith/Ngcd_def.v
index 277fd26f..70784d9c 100644
--- a/theories/NArith/Ngcd_def.v
+++ b/theories/NArith/Ngcd_def.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinPos BinNat.
diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v
index 4e007878..3488c8b4 100644
--- a/theories/NArith/Nnat.v
+++ b/theories/NArith/Nnat.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinPos BinNat PeanoNat Pnat.
@@ -208,30 +210,30 @@ Hint Rewrite Nat2N.id : Nnat.
 
 (** Compatibility notations *)
 
-Notation nat_of_N_inj := N2Nat.inj (compat "8.3").
-Notation N_of_nat_of_N := N2Nat.id (compat "8.3").
-Notation nat_of_Ndouble := N2Nat.inj_double (compat "8.3").
-Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (compat "8.3").
-Notation nat_of_Nsucc := N2Nat.inj_succ (compat "8.3").
-Notation nat_of_Nplus := N2Nat.inj_add (compat "8.3").
-Notation nat_of_Nmult := N2Nat.inj_mul (compat "8.3").
-Notation nat_of_Nminus := N2Nat.inj_sub (compat "8.3").
-Notation nat_of_Npred := N2Nat.inj_pred (compat "8.3").
-Notation nat_of_Ndiv2 := N2Nat.inj_div2 (compat "8.3").
-Notation nat_of_Ncompare := N2Nat.inj_compare (compat "8.3").
-Notation nat_of_Nmax := N2Nat.inj_max (compat "8.3").
-Notation nat_of_Nmin := N2Nat.inj_min (compat "8.3").
-
-Notation nat_of_N_of_nat := Nat2N.id (compat "8.3").
-Notation N_of_nat_inj := Nat2N.inj (compat "8.3").
-Notation N_of_double := Nat2N.inj_double (compat "8.3").
-Notation N_of_double_plus_one := Nat2N.inj_succ_double (compat "8.3").
-Notation N_of_S := Nat2N.inj_succ (compat "8.3").
-Notation N_of_pred := Nat2N.inj_pred (compat "8.3").
-Notation N_of_plus := Nat2N.inj_add (compat "8.3").
-Notation N_of_minus := Nat2N.inj_sub (compat "8.3").
-Notation N_of_mult := Nat2N.inj_mul (compat "8.3").
-Notation N_of_div2 := Nat2N.inj_div2 (compat "8.3").
-Notation N_of_nat_compare := Nat2N.inj_compare (compat "8.3").
-Notation N_of_min := Nat2N.inj_min (compat "8.3").
-Notation N_of_max := Nat2N.inj_max (compat "8.3").
+Notation nat_of_N_inj := N2Nat.inj (only parsing).
+Notation N_of_nat_of_N := N2Nat.id (only parsing).
+Notation nat_of_Ndouble := N2Nat.inj_double (only parsing).
+Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (only parsing).
+Notation nat_of_Nsucc := N2Nat.inj_succ (only parsing).
+Notation nat_of_Nplus := N2Nat.inj_add (only parsing).
+Notation nat_of_Nmult := N2Nat.inj_mul (only parsing).
+Notation nat_of_Nminus := N2Nat.inj_sub (only parsing).
+Notation nat_of_Npred := N2Nat.inj_pred (only parsing).
+Notation nat_of_Ndiv2 := N2Nat.inj_div2 (only parsing).
+Notation nat_of_Ncompare := N2Nat.inj_compare (only parsing).
+Notation nat_of_Nmax := N2Nat.inj_max (only parsing).
+Notation nat_of_Nmin := N2Nat.inj_min (only parsing).
+
+Notation nat_of_N_of_nat := Nat2N.id (only parsing).
+Notation N_of_nat_inj := Nat2N.inj (only parsing).
+Notation N_of_double := Nat2N.inj_double (only parsing).
+Notation N_of_double_plus_one := Nat2N.inj_succ_double (only parsing).
+Notation N_of_S := Nat2N.inj_succ (only parsing).
+Notation N_of_pred := Nat2N.inj_pred (only parsing).
+Notation N_of_plus := Nat2N.inj_add (only parsing).
+Notation N_of_minus := Nat2N.inj_sub (only parsing).
+Notation N_of_mult := Nat2N.inj_mul (only parsing).
+Notation N_of_div2 := Nat2N.inj_div2 (only parsing).
+Notation N_of_nat_compare := Nat2N.inj_compare (only parsing).
+Notation N_of_min := Nat2N.inj_min (only parsing).
+Notation N_of_max := Nat2N.inj_max (only parsing).
diff --git a/theories/NArith/Nsqrt_def.v b/theories/NArith/Nsqrt_def.v
index dd44b6e2..e771fe91 100644
--- a/theories/NArith/Nsqrt_def.v
+++ b/theories/NArith/Nsqrt_def.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinNat.
@@ -11,8 +13,8 @@ Require Import BinNat.
 (** Obsolete file, see [BinNat] now,
     only compatibility notations remain here. *)
 
-Notation Nsqrtrem := N.sqrtrem (compat "8.3").
-Notation Nsqrt := N.sqrt (compat "8.3").
-Notation Nsqrtrem_spec := N.sqrtrem_spec (compat "8.3").
-Notation Nsqrt_spec := (fun n => N.sqrt_spec n (N.le_0_l n)) (compat "8.3").
-Notation Nsqrtrem_sqrt := N.sqrtrem_sqrt (compat "8.3").
+Notation Nsqrtrem := N.sqrtrem (compat "8.6").
+Notation Nsqrt := N.sqrt (compat "8.6").
+Notation Nsqrtrem_spec := N.sqrtrem_spec (compat "8.6").
+Notation Nsqrt_spec := (fun n => N.sqrt_spec n (N.le_0_l n)) (only parsing).
+Notation Nsqrtrem_sqrt := N.sqrtrem_sqrt (compat "8.6").
diff --git a/theories/NArith/vo.itarget b/theories/NArith/vo.itarget
deleted file mode 100644
index e76033f7..00000000
--- a/theories/NArith/vo.itarget
+++ /dev/null
@@ -1,10 +0,0 @@
-BinNatDef.vo
-BinNat.vo
-NArith.vo
-Ndec.vo
-Ndigits.vo
-Ndist.vo
-Nnat.vo
-Ndiv_def.vo
-Nsqrt_def.vo
-Ngcd_def.vo
\ No newline at end of file
diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v
deleted file mode 100644
index bd893087..00000000
--- a/theories/Numbers/BigNumPrelude.v
+++ /dev/null
@@ -1,411 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-(** * BigNumPrelude *)
-
-(** Auxiliary functions & theorems used for arbitrary precision efficient
-    numbers. *)
-
-
-Require Import ArithRing.
-Require Export ZArith.
-Require Export Znumtheory.
-Require Export Zpow_facts.
-
-Declare ML Module "numbers_syntax_plugin".
-
-(* *** Nota Bene ***
-   All results that were general enough have been moved in ZArith.
-   Only remain here specialized lemmas and compatibility elements.
-   (P.L. 5/11/2007).
-*)
-
-
-Local Open Scope Z_scope.
-
-(* For compatibility of scripts, weaker version of some lemmas of Z.div *)
-
-Lemma Zlt0_not_eq : forall n, 0<n -> n<>0.
-Proof.
- auto with zarith.
-Qed.
-
-Definition Zdiv_mult_cancel_r a b c H := Zdiv.Zdiv_mult_cancel_r a b c (Zlt0_not_eq _ H).
-Definition Zdiv_mult_cancel_l a b c H := Zdiv.Zdiv_mult_cancel_r a b c (Zlt0_not_eq _ H).
-Definition Z_div_plus_l a b c H := Zdiv.Z_div_plus_full_l a b c (Zlt0_not_eq _ H).
-
-(* Automation *)
-
-Hint  Extern 2 (Z.le _ _) =>
- (match goal with
-   |- Zpos _ <= Zpos _ => exact (eq_refl _)
-|   H: _ <=  ?p |- _ <= ?p => apply Z.le_trans with (2 := H)
-|   H: _ <  ?p |- _ <= ?p => apply Z.lt_le_incl; apply Z.le_lt_trans with (2 := H)
-  end).
-
-Hint  Extern 2 (Z.lt _ _) =>
- (match goal with
-   |- Zpos _ < Zpos _ => exact (eq_refl _)
-|      H: _ <=  ?p |- _ <= ?p => apply Z.lt_le_trans with (2 := H)
-|   H: _ <  ?p |- _ <= ?p => apply Z.le_lt_trans with (2 := H)
-  end).
-
-
-Hint Resolve Z.lt_gt Z.le_ge Z_div_pos: zarith.
-
-(**************************************
-   Properties of order and product
- **************************************)
-
- Theorem beta_lex: forall a b c d beta,
-       a * beta + b <= c * beta + d ->
-       0 <= b < beta -> 0 <= d < beta ->
-       a <= c.
- Proof.
-  intros a b c d beta H1 (H3, H4) (H5, H6).
-  assert (a - c < 1); auto with zarith.
-  apply Z.mul_lt_mono_pos_r with beta; auto with zarith.
-  apply Z.le_lt_trans with (d  - b); auto with zarith.
-  rewrite Z.mul_sub_distr_r; auto with zarith.
- Qed.
-
- Theorem beta_lex_inv: forall a b c d beta,
-      a < c -> 0 <= b < beta ->
-      0 <= d < beta ->
-      a * beta + b < c * beta  + d.
- Proof.
-  intros a b c d beta H1 (H3, H4) (H5, H6).
-  case (Z.le_gt_cases (c * beta + d) (a * beta + b)); auto with zarith.
-  intros H7. contradict H1. apply Z.le_ngt. apply beta_lex with (1 := H7); auto.
- Qed.
-
- Lemma beta_mult : forall h l beta,
-   0 <= h < beta -> 0 <= l < beta -> 0 <= h*beta+l < beta^2.
- Proof.
-  intros h l beta H1 H2;split. auto with zarith.
-  rewrite <- (Z.add_0_r (beta^2)); rewrite Z.pow_2_r;
-   apply beta_lex_inv;auto with zarith.
- Qed.
-
- Lemma Zmult_lt_b :
-   forall b x y, 0 <= x < b -> 0 <= y < b -> 0 <= x * y <= b^2 - 2*b + 1.
- Proof.
-  intros b x y (Hx1,Hx2) (Hy1,Hy2);split;auto with zarith.
-  apply Z.le_trans with ((b-1)*(b-1)).
-  apply Z.mul_le_mono_nonneg;auto with zarith.
-  apply Z.eq_le_incl; ring.
- Qed.
-
- Lemma sum_mul_carry : forall xh xl yh yl wc cc beta,
-   1 < beta ->
-   0 <= wc < beta ->
-   0 <= xh < beta ->
-   0 <= xl < beta ->
-   0 <= yh < beta ->
-   0 <= yl < beta ->
-   0 <= cc < beta^2 ->
-   wc*beta^2 + cc = xh*yl + xl*yh ->
-   0 <= wc <= 1.
- Proof.
-  intros xh xl yh yl wc cc beta U H1 H2 H3 H4 H5 H6 H7.
-  assert (H8 := Zmult_lt_b beta xh yl H2 H5).
-  assert (H9 := Zmult_lt_b beta xl yh H3 H4).
-  split;auto with zarith.
-  apply beta_lex with (cc) (beta^2 - 2) (beta^2); auto with zarith.
- Qed.
-
- Theorem mult_add_ineq: forall x y cross beta,
-   0 <= x < beta ->
-   0 <= y < beta ->
-   0 <= cross < beta ->
-   0 <= x * y + cross < beta^2.
- Proof.
-  intros x y cross beta HH HH1 HH2.
-  split; auto with zarith.
-  apply Z.le_lt_trans with  ((beta-1)*(beta-1)+(beta-1)); auto with zarith.
-  apply Z.add_le_mono; auto with zarith.
-  apply Z.mul_le_mono_nonneg; auto with zarith.
-  rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r, Z.pow_2_r; auto with zarith.
- Qed.
-
- Theorem mult_add_ineq2: forall x y c cross beta,
-   0 <= x < beta ->
-   0 <= y < beta ->
-   0 <= c*beta + cross <= 2*beta - 2 ->
-   0 <= x * y + (c*beta + cross) < beta^2.
- Proof.
-  intros x y c cross beta HH HH1 HH2.
-  split; auto with zarith.
-  apply Z.le_lt_trans with ((beta-1)*(beta-1)+(2*beta-2));auto with zarith.
-  apply Z.add_le_mono; auto with zarith.
-  apply Z.mul_le_mono_nonneg; auto with zarith.
-  rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r, Z.pow_2_r; auto with zarith.
- Qed.
-
-Theorem mult_add_ineq3: forall x y c cross beta,
-   0 <= x < beta ->
-   0 <= y < beta ->
-   0 <= cross <= beta - 2 ->
-   0 <= c <= 1 ->
-   0 <= x * y + (c*beta + cross) < beta^2.
- Proof.
-  intros x y c cross beta HH HH1 HH2 HH3.
-  apply mult_add_ineq2;auto with zarith.
-  split;auto with zarith.
-  apply Z.le_trans with (1*beta+cross);auto with zarith.
- Qed.
-
-Hint Rewrite Z.mul_1_r Z.mul_0_r Z.mul_1_l Z.mul_0_l Z.add_0_l Z.add_0_r Z.sub_0_r: rm10.
-
-
-(**************************************
- Properties of Z.div and Z.modulo
-**************************************)
-
-Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
- Proof.
-  intros a b H H1;case (Z_mod_lt a b);auto with zarith;intros H2 H3;split;auto.
-  case (Z.le_gt_cases b a); intros H4; auto with zarith.
-  rewrite Zmod_small; auto with zarith.
- Qed.
-
-
- Theorem Zmod_distr: forall a b r t, 0 <= a <= b -> 0 <= r -> 0 <= t < 2 ^a ->
-  (2 ^a * r + t) mod (2 ^ b) = (2 ^a * r) mod (2 ^ b) + t.
- Proof.
-  intros a b r t (H1, H2) H3 (H4, H5).
-  assert (t < 2 ^ b).
-  apply Z.lt_le_trans with (1:= H5); auto with zarith.
-  apply Zpower_le_monotone; auto with zarith.
-  rewrite Zplus_mod; auto with zarith.
-  rewrite Zmod_small with (a := t); auto with zarith.
-  apply Zmod_small; auto with zarith.
-  split; auto with zarith.
-  assert (0 <= 2 ^a * r); auto with zarith.
-  apply Z.add_nonneg_nonneg; auto with zarith.
-  match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
-   auto with zarith.
-  pattern (2 ^ b) at 2; replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a);
-    try ring.
-  apply Z.add_le_lt_mono; auto with zarith.
-  replace b with ((b - a) + a); try ring.
-  rewrite Zpower_exp; auto with zarith.
-  pattern (2 ^a) at 4; rewrite <- (Z.mul_1_l (2 ^a));
-   try rewrite <- Z.mul_sub_distr_r.
-  rewrite (Z.mul_comm (2 ^(b - a))); rewrite  Zmult_mod_distr_l;
-   auto with zarith.
-  rewrite (Z.mul_comm (2 ^a)); apply Z.mul_le_mono_nonneg_r; auto with zarith.
-  match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
-   auto with zarith.
- Qed.
-
- Theorem Zmod_shift_r:
-   forall a b r t, 0 <= a <= b -> 0 <= r -> 0 <= t < 2 ^a ->
-     (r * 2 ^a + t) mod (2 ^ b) = (r * 2 ^a) mod (2 ^ b) + t.
- Proof.
-  intros a b r t (H1, H2) H3 (H4, H5).
-  assert (t < 2 ^ b).
-  apply Z.lt_le_trans with (1:= H5); auto with zarith.
-  apply Zpower_le_monotone; auto with zarith.
-  rewrite Zplus_mod; auto with zarith.
-  rewrite Zmod_small with (a := t); auto with zarith.
-  apply Zmod_small; auto with zarith.
-  split; auto with zarith.
-  assert (0 <= 2 ^a * r); auto with zarith.
-  apply Z.add_nonneg_nonneg; auto with zarith.
-  match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
-   auto with zarith.
-  pattern (2 ^ b) at 2;replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a); try ring.
-  apply Z.add_le_lt_mono; auto with zarith.
-  replace b with ((b - a) + a); try ring.
-  rewrite Zpower_exp; auto with zarith.
-  pattern (2 ^a) at 4; rewrite <- (Z.mul_1_l (2 ^a));
-   try rewrite <- Z.mul_sub_distr_r.
-  repeat rewrite (fun x => Z.mul_comm x (2 ^ a)); rewrite Zmult_mod_distr_l;
-   auto with zarith.
-  apply Z.mul_le_mono_nonneg_l; auto with zarith.
-  match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
-   auto with zarith.
- Qed.
-
-  Theorem Zdiv_shift_r:
-    forall a b r t, 0 <= a <= b -> 0 <= r -> 0 <= t < 2 ^a ->
-      (r * 2 ^a + t) /  (2 ^ b) = (r * 2 ^a) / (2 ^ b).
-  Proof.
-   intros a b r t (H1, H2) H3 (H4, H5).
-   assert (Eq: t < 2 ^ b); auto with zarith.
-   apply Z.lt_le_trans with (1 := H5); auto with zarith.
-   apply Zpower_le_monotone; auto with zarith.
-   pattern (r * 2 ^ a) at 1; rewrite Z_div_mod_eq with (b := 2 ^ b);
-    auto with zarith.
-   rewrite <- Z.add_assoc.
-   rewrite <- Zmod_shift_r; auto with zarith.
-   rewrite (Z.mul_comm (2 ^ b)); rewrite Z_div_plus_full_l; auto with zarith.
-   rewrite (fun x y => @Zdiv_small (x mod y)); auto with zarith.
-   match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
-    auto with zarith.
-  Qed.
-
-
- Lemma shift_unshift_mod : forall n p a,
-     0 <= a < 2^n ->
-     0 <= p <= n ->
-     a * 2^p = a / 2^(n - p) * 2^n + (a*2^p) mod 2^n.
- Proof.
-  intros n p a H1 H2.
-  pattern (a*2^p) at 1;replace (a*2^p) with
-     (a*2^p/2^n * 2^n + a*2^p mod 2^n).
-  2:symmetry;rewrite (Z.mul_comm (a*2^p/2^n));apply Z_div_mod_eq.
-  replace (a * 2 ^ p / 2 ^ n) with (a / 2 ^ (n - p));trivial.
-  replace (2^n) with (2^(n-p)*2^p).
-  symmetry;apply Zdiv_mult_cancel_r.
-  destruct H1;trivial.
-  cut (0 < 2^p); auto with zarith.
-  rewrite <- Zpower_exp.
-  replace (n-p+p) with n;trivial. ring.
-  omega. omega.
-  apply Z.lt_gt. apply Z.pow_pos_nonneg;auto with zarith.
- Qed.
-
-
- Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n ->
-   ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) =
-   a mod 2 ^ p.
- Proof.
- intros.
- rewrite Zmod_small.
- rewrite Zmod_eq by (auto with zarith).
- unfold Z.sub at 1.
- rewrite Z_div_plus_l by (auto with zarith).
- assert (2^n = 2^(n-p)*2^p).
-  rewrite <- Zpower_exp by (auto with zarith).
-  replace (n-p+p) with n; auto with zarith.
- rewrite H0.
- rewrite <- Zdiv_Zdiv, Z_div_mult by (auto with zarith).
- rewrite (Z.mul_comm (2^(n-p))), Z.mul_assoc.
- rewrite <- Z.mul_opp_l.
- rewrite Z_div_mult by (auto with zarith).
- symmetry; apply Zmod_eq; auto with zarith.
-
- remember (a * 2 ^ (n - p)) as b.
- destruct (Z_mod_lt b (2^n)); auto with zarith.
- split.
- apply Z_div_pos; auto with zarith.
- apply Zdiv_lt_upper_bound; auto with zarith.
- apply Z.lt_le_trans with (2^n); auto with zarith.
- rewrite <- (Z.mul_1_r (2^n)) at 1.
- apply Z.mul_le_mono_nonneg; auto with zarith.
- cut (0 < 2 ^ (n-p)); auto with zarith.
- Qed.
-
- Lemma div_le_0 : forall p x, 0 <= x -> 0 <= x / 2 ^ p.
- Proof.
-  intros p x Hle;destruct (Z_le_gt_dec 0 p).
-  apply  Zdiv_le_lower_bound;auto with zarith.
-  replace (2^p) with 0.
-  destruct x;compute;intro;discriminate.
-  destruct p;trivial;discriminate.
- Qed.
-
- Lemma div_lt : forall p x y, 0 <= x < y -> x / 2^p < y.
- Proof.
-  intros p x y H;destruct (Z_le_gt_dec 0 p).
-  apply Zdiv_lt_upper_bound;auto with zarith.
-  apply Z.lt_le_trans with y;auto with zarith.
-  rewrite <- (Z.mul_1_r y);apply Z.mul_le_mono_nonneg;auto with zarith.
-  assert (0 < 2^p);auto with zarith.
-  replace (2^p) with 0.
-  destruct x;change (0<y);auto with zarith.
-  destruct p;trivial;discriminate.
- Qed.
-
- Theorem Zgcd_div_pos a b:
-   0 < b -> 0 < Z.gcd a b -> 0 < b / Z.gcd a b.
- Proof.
- intros Hb Hg.
- assert (H : 0 <= b / Z.gcd a b) by (apply Z.div_pos; auto with zarith).
- Z.le_elim H; trivial.
- rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b), <- H, Z.mul_0_r in Hb;
-  auto using Z.gcd_divide_r with zarith.
- Qed.
-
- Theorem Zdiv_neg a b:
-   a < 0 -> 0 < b -> a / b < 0.
- Proof.
- intros Ha Hb.
- assert (b > 0) by omega.
- generalize (Z_mult_div_ge a _ H); intros.
- assert (b * (a / b) < 0)%Z.
-  apply Z.le_lt_trans with a; auto with zarith.
- destruct b; try (compute in Hb; discriminate).
- destruct (a/Zpos p)%Z.
- compute in H1; discriminate.
- compute in H1; discriminate.
- compute; auto.
- Qed.
-
- Lemma Zdiv_gcd_zero : forall a b, b / Z.gcd a b = 0 -> b <> 0 ->
-  Z.gcd a b = 0.
- Proof.
- intros.
- generalize (Zgcd_is_gcd a b); destruct 1.
- destruct H2 as (k,Hk).
- generalize H; rewrite Hk at 1.
- destruct (Z.eq_dec (Z.gcd a b) 0) as [H'|H']; auto.
- rewrite Z_div_mult_full; auto.
- intros; subst k; simpl in *; subst b; elim H0; auto.
- Qed.
-
- Lemma Zgcd_mult_rel_prime : forall a b c,
-  Z.gcd a c = 1 -> Z.gcd b c = 1 -> Z.gcd (a*b) c = 1.
- Proof.
- intros.
- rewrite Zgcd_1_rel_prime in *.
- apply rel_prime_sym; apply rel_prime_mult; apply rel_prime_sym; auto.
- Qed.
-
- Lemma Zcompare_gt : forall (A:Type)(a a':A)(p q:Z),
-  match (p?=q)%Z with Gt => a | _ => a' end =
-  if Z_le_gt_dec p q then a' else a.
- Proof.
- intros.
- destruct Z_le_gt_dec as [H|H].
- red in H.
- destruct (p?=q)%Z; auto; elim H; auto.
- rewrite H; auto.
- Qed.
-
-Theorem Zbounded_induction :
-  (forall Q : Z -> Prop, forall b : Z,
-    Q 0 ->
-    (forall n, 0 <= n -> n < b - 1 -> Q n -> Q (n + 1)) ->
-      forall n, 0 <= n -> n < b -> Q n)%Z.
-Proof.
-intros Q b Q0 QS.
-set (Q' := fun n => (n < b /\ Q n) \/ (b <= n)).
-assert (H : forall n, 0 <= n -> Q' n).
-apply natlike_rec2; unfold Q'.
-destruct (Z.le_gt_cases b 0) as [H | H]. now right. left; now split.
-intros n H IH. destruct IH as [[IH1 IH2] | IH].
-destruct (Z.le_gt_cases (b - 1) n) as [H1 | H1].
-right; auto with zarith.
-left. split; [auto with zarith | now apply (QS n)].
-right; auto with zarith.
-unfold Q' in *; intros n H1 H2. destruct (H n H1) as [[H3 H4] | H3].
-assumption. now apply Z.le_ngt in H3.
-Qed.
-
-Lemma Zsquare_le x : x <= x*x.
-Proof.
-destruct (Z.lt_ge_cases 0 x).
-- rewrite <- Z.mul_1_l at 1.
-  rewrite <- Z.mul_le_mono_pos_r; auto with zarith.
-- pose proof (Z.square_nonneg x); auto with zarith.
-Qed.
diff --git a/theories/Numbers/BinNums.v b/theories/Numbers/BinNums.v
index e4f3cd6c..f8b3d9e1 100644
--- a/theories/Numbers/BinNums.v
+++ b/theories/Numbers/BinNums.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Binary Numerical Datatypes *)
diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
index 3312161a..951a4ef2 100644
--- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
+++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
@@ -17,7 +19,7 @@ Set Implicit Arguments.
 
 Require Import ZArith.
 Require Import Znumtheory.
-Require Import BigNumPrelude.
+Require Import Zpow_facts.
 Require Import DoubleType.
 
 Local Open Scope Z_scope.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v b/theories/Numbers/Cyclic/Abstract/DoubleType.v
index abd567a8..fe0476e4 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
+++ b/theories/Numbers/Cyclic/Abstract/DoubleType.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
@@ -67,4 +69,3 @@ Fixpoint word (w:Type) (n:nat) : Type :=
  | O => w
  | S n => zn2z (word w n)
  end.
-
diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
index df9b8339..64935ffe 100644
--- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v
+++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
@@ -1,15 +1,18 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
 Require Export NZAxioms.
-Require Import BigNumPrelude.
+Require Import ZArith.
+Require Import Zpow_facts.
 Require Import DoubleType.
 Require Import CyclicAxioms.
 
@@ -139,6 +142,26 @@ rewrite 2 ZnZ.of_Z_correct; auto with zarith.
 symmetry; apply Zmod_small; auto with zarith.
 Qed.
 
+Theorem Zbounded_induction :
+  (forall Q : Z -> Prop, forall b : Z,
+    Q 0 ->
+    (forall n, 0 <= n -> n < b - 1 -> Q n -> Q (n + 1)) ->
+      forall n, 0 <= n -> n < b -> Q n)%Z.
+Proof.
+intros Q b Q0 QS.
+set (Q' := fun n => (n < b /\ Q n) \/ (b <= n)).
+assert (H : forall n, 0 <= n -> Q' n).
+apply natlike_rec2; unfold Q'.
+destruct (Z.le_gt_cases b 0) as [H | H]. now right. left; now split.
+intros n H IH. destruct IH as [[IH1 IH2] | IH].
+destruct (Z.le_gt_cases (b - 1) n) as [H1 | H1].
+right; auto with zarith.
+left. split; [auto with zarith | now apply (QS n)].
+right; auto with zarith.
+unfold Q' in *; intros n H1 H2. destruct (H n H1) as [[H3 H4] | H3].
+assumption. now apply Z.le_ngt in H3.
+Qed.
+
 Lemma B_holds : forall n : Z, 0 <= n < wB -> B n.
 Proof.
 intros n [H1 H2].
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
deleted file mode 100644
index 407bcca4..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
+++ /dev/null
@@ -1,317 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-
-Local Open Scope Z_scope.
-
-Section DoubleAdd.
- Variable w : Type.
- Variable w_0 : w.
- Variable w_1 : w.
- Variable w_WW : w -> w -> zn2z w.
- Variable w_W0 : w -> zn2z w.
- Variable ww_1 : zn2z w.
- Variable w_succ_c : w -> carry w.
- Variable w_add_c : w -> w -> carry w.
- Variable w_add_carry_c : w -> w -> carry w.
- Variable w_succ : w -> w.
- Variable w_add : w -> w -> w.
- Variable w_add_carry : w -> w -> w.
-
- Definition ww_succ_c x :=
-  match x with
-  | W0 => C0 ww_1
-  | WW xh xl =>
-    match w_succ_c xl with
-    | C0 l => C0 (WW xh l)
-    | C1 l =>
-      match w_succ_c xh with
-      | C0 h => C0 (WW h w_0)
-      | C1 h => C1 W0
-      end
-    end
-  end.
-
- Definition ww_succ x :=
-  match x with
-  | W0 => ww_1
-  | WW xh xl =>
-    match w_succ_c xl with
-    | C0 l => WW xh l
-    | C1 l => w_W0 (w_succ xh)
-    end
-  end.
-
- Definition ww_add_c x y :=
-  match x, y with
-  | W0, _ => C0 y
-  | _, W0 => C0 x
-  | WW xh xl, WW yh yl =>
-    match w_add_c xl yl with
-    | C0 l =>
-      match w_add_c xh yh with
-      | C0 h => C0 (WW h l)
-      | C1 h => C1 (w_WW h l)
-      end
-    | C1 l =>
-      match w_add_carry_c xh yh with
-      | C0 h => C0 (WW h l)
-      | C1 h => C1 (w_WW h l)
-      end
-    end
-  end.
-
- Variable R : Type.
- Variable f0 f1 : zn2z w -> R.
-
- Definition ww_add_c_cont x y :=
-  match x, y with
-  | W0, _ => f0 y
-  | _, W0 => f0 x
-  | WW xh xl, WW yh yl =>
-    match w_add_c xl yl with
-    | C0 l =>
-      match w_add_c xh yh with
-      | C0 h => f0 (WW h l)
-      | C1 h => f1 (w_WW h l)
-      end
-    | C1 l =>
-      match w_add_carry_c xh yh with
-      | C0 h => f0 (WW h l)
-      | C1 h => f1 (w_WW h l)
-      end
-    end
-  end.
-
- (* ww_add et ww_add_carry conserve la forme normale s'il n'y a pas
-    de debordement *)
- Definition ww_add x y :=
-  match x, y with
-  | W0, _ => y
-  | _, W0 => x
-  | WW xh xl, WW yh yl =>
-    match w_add_c xl yl with
-    | C0 l => WW (w_add xh yh) l
-    | C1 l => WW (w_add_carry xh yh) l
-    end
-  end.
-
- Definition ww_add_carry_c x y :=
-  match x, y with
-  | W0, W0 => C0 ww_1
-  | W0, WW yh yl => ww_succ_c (WW yh yl)
-  | WW xh xl, W0 => ww_succ_c (WW xh xl)
-  | WW xh xl, WW yh yl =>
-    match w_add_carry_c xl yl with
-    | C0 l =>
-      match w_add_c xh yh with
-      | C0 h => C0 (WW h l)
-      | C1 h => C1 (WW h l)
-      end
-    | C1 l =>
-      match w_add_carry_c xh yh with
-      | C0 h => C0 (WW h l)
-      | C1 h => C1 (w_WW h l)
-      end
-    end
-  end.
-
- Definition ww_add_carry x y :=
-  match x, y with
-  | W0, W0 => ww_1
-  | W0, WW yh yl => ww_succ (WW yh yl)
-  | WW xh xl, W0 => ww_succ (WW xh xl)
-  | WW xh xl, WW yh yl =>
-    match w_add_carry_c xl yl with
-    | C0 l => WW (w_add xh yh) l
-    | C1 l => WW (w_add_carry xh yh) l
-    end
-  end.
-
- (*Section DoubleProof.*)
-  Variable w_digits : positive.
-  Variable w_to_Z : w -> Z.
-
-
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[+| c |]" :=
-   (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
-  Notation "[-| c |]" :=
-   (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
-
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-  Notation "[+[ c ]]" :=
-   (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-  Notation "[-[ c ]]" :=
-   (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_w_1   : [|w_1|] = 1.
-  Variable spec_ww_1   : [[ww_1]] = 1.
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-  Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB.
-  Variable spec_w_succ_c : forall x, [+|w_succ_c x|] = [|x|] + 1.
-  Variable spec_w_add_c  : forall x y, [+|w_add_c x y|] = [|x|] + [|y|].
-  Variable spec_w_add_carry_c :
-         forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1.
-  Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB.
-  Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB.
-  Variable spec_w_add_carry :
-	 forall x y, [|w_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB.
-
-  Lemma spec_ww_succ_c : forall x, [+[ww_succ_c x]] = [[x]] + 1.
-  Proof.
-   destruct x as [ |xh xl];simpl. apply spec_ww_1.
-   generalize (spec_w_succ_c xl);destruct (w_succ_c xl) as [l|l];
-    intro H;unfold interp_carry in H. simpl;rewrite H;ring.
-   rewrite <- Z.add_assoc;rewrite <- H;rewrite Z.mul_1_l.
-   assert ([|l|] = 0). generalize (spec_to_Z xl)(spec_to_Z l);omega.
-   rewrite H0;generalize (spec_w_succ_c xh);destruct (w_succ_c xh) as [h|h];
-    intro H1;unfold interp_carry in H1.
-   simpl;rewrite H1;rewrite spec_w_0;ring.
-   unfold interp_carry;simpl ww_to_Z;rewrite wwB_wBwB.
-   assert ([|xh|] = wB - 1). generalize (spec_to_Z xh)(spec_to_Z h);omega.
-   rewrite H2;ring.
-  Qed.
-
-  Lemma spec_ww_add_c  : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]].
-  Proof.
-   destruct x as [ |xh xl];trivial.
-   destruct y as [ |yh yl]. rewrite Z.add_0_r;trivial.
-   simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]))
-   with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring.
-   generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
-    intros H;unfold interp_carry in H;rewrite <- H.
-   generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h];
-    intros H1;unfold interp_carry in *;rewrite <- H1. trivial.
-   repeat rewrite Z.mul_1_l;rewrite spec_w_WW;rewrite wwB_wBwB; ring.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh)
-    as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1.
-   simpl;ring.
-   repeat rewrite Z.mul_1_l;rewrite wwB_wBwB;rewrite spec_w_WW;ring.
-  Qed.
-
-  Section Cont.
-   Variable P : zn2z w -> zn2z w -> R -> Prop.
-   Variable x y : zn2z w.
-   Variable spec_f0 : forall r, [[r]] = [[x]] + [[y]] -> P x y (f0 r).
-   Variable spec_f1 : forall r, wwB + [[r]] = [[x]] + [[y]] -> P x y (f1 r).
-
-   Lemma spec_ww_add_c_cont  : P x y (ww_add_c_cont x y).
-   Proof.
-    destruct x as [ |xh xl];trivial.
-    apply spec_f0;trivial.
-    destruct y as [ |yh yl].
-    apply spec_f0;rewrite Z.add_0_r;trivial.
-    simpl.
-    generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
-     intros H;unfold interp_carry in H.
-    generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h];
-     intros H1;unfold interp_carry in *.
-    apply spec_f0. simpl;rewrite H;rewrite H1;ring.
-    apply spec_f1. simpl;rewrite spec_w_WW;rewrite H.
-    rewrite Z.add_assoc;rewrite wwB_wBwB. rewrite Z.pow_2_r; rewrite <- Z.mul_add_distr_r.
-    rewrite Z.mul_1_l in H1;rewrite H1;ring.
-    generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh)
-     as [h|h]; intros H1;unfold interp_carry in *.
-    apply spec_f0;simpl;rewrite H1. rewrite Z.mul_add_distr_r.
-    rewrite <- Z.add_assoc;rewrite H;ring.
-    apply spec_f1. rewrite spec_w_WW;rewrite wwB_wBwB.
-    rewrite Z.add_assoc; rewrite Z.pow_2_r; rewrite <- Z.mul_add_distr_r.
-    rewrite Z.mul_1_l in H1;rewrite H1. rewrite Z.mul_add_distr_r.
-    rewrite <- Z.add_assoc;rewrite H; simpl; ring.
-   Qed.
-
-  End Cont.
-
-  Lemma spec_ww_add_carry_c :
-         forall x y, [+[ww_add_carry_c x y]] = [[x]] + [[y]] + 1.
-  Proof.
-   destruct x as [ |xh xl];intro y.
-   exact (spec_ww_succ_c y).
-   destruct y as [ |yh yl].
-   rewrite Z.add_0_r;exact (spec_ww_succ_c (WW xh xl)).
-   simpl; replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1)
-   with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring.
-   generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl)
-    as [l|l];intros H;unfold interp_carry in H;rewrite <- H.
-   generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h];
-    intros H1;unfold interp_carry in H1;rewrite <- H1. trivial.
-   unfold interp_carry;repeat rewrite Z.mul_1_l;simpl;rewrite wwB_wBwB;ring.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh)
-    as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial.
-   unfold interp_carry;rewrite spec_w_WW;
-   repeat rewrite Z.mul_1_l;simpl;rewrite wwB_wBwB;ring.
-  Qed.
-
-  Lemma spec_ww_succ : forall x, [[ww_succ x]] = ([[x]] + 1) mod wwB.
-  Proof.
-   destruct x as [ |xh xl];simpl.
-   rewrite spec_ww_1;rewrite Zmod_small;trivial.
-   split;[intro;discriminate|apply wwB_pos].
-   rewrite <- Z.add_assoc;generalize (spec_w_succ_c xl);
-   destruct (w_succ_c xl) as[l|l];intro H;unfold interp_carry in H;rewrite <-H.
-   rewrite Zmod_small;trivial.
-   rewrite wwB_wBwB;apply beta_mult;apply spec_to_Z.
-   assert ([|l|] = 0). clear spec_ww_1 spec_w_1 spec_w_0.
-    assert (H1:= spec_to_Z l); assert (H2:= spec_to_Z xl); omega.
-   rewrite H0;rewrite Z.add_0_r;rewrite <- Z.mul_add_distr_r;rewrite wwB_wBwB.
-   rewrite Z.pow_2_r; rewrite Zmult_mod_distr_r;try apply lt_0_wB.
-   rewrite spec_w_W0;rewrite spec_w_succ;trivial.
-  Qed.
-
-  Lemma spec_ww_add : forall x y, [[ww_add x y]] = ([[x]] + [[y]]) mod wwB.
-  Proof.
-   destruct x as [ |xh xl];intros y.
-   rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial.
-   destruct y as [ |yh yl].
-   change [[W0]] with 0;rewrite Z.add_0_r.
-   rewrite Zmod_small;trivial.
-    exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)).
-   simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]))
-   with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring.
-   generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
-   unfold interp_carry;intros H;simpl;rewrite <- H.
-   rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial.
-  Qed.
-
-  Lemma spec_ww_add_carry :
-	 forall x y, [[ww_add_carry x y]] = ([[x]] + [[y]] + 1) mod wwB.
-  Proof.
-   destruct x as [ |xh xl];intros y.
-   exact (spec_ww_succ y).
-   destruct y as [ |yh yl].
-   change [[W0]] with 0;rewrite Z.add_0_r. exact (spec_ww_succ (WW xh xl)).
-   simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1)
-   with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring.
-   generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl)
-   as [l|l];unfold interp_carry;intros H;rewrite <- H;simpl ww_to_Z.
-   rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial.
-  Qed.
-
-(* End DoubleProof. *)
-End DoubleAdd.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
deleted file mode 100644
index e94a891d..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
+++ /dev/null
@@ -1,437 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith Ndigits.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-
-Local Open Scope Z_scope.
-
-Local Infix "<<" := Pos.shiftl_nat (at level 30).
-
-Section DoubleBase.
- Variable w : Type.
- Variable w_0   : w.
- Variable w_1   : w.
- Variable w_Bm1 : w.
- Variable w_WW  : w -> w -> zn2z w.
- Variable w_0W  : w -> zn2z w.
- Variable w_digits : positive.
- Variable w_zdigits: w.
- Variable w_add: w -> w -> zn2z w.
- Variable w_to_Z   : w -> Z.
- Variable w_compare : w -> w -> comparison.
-
- Definition ww_digits := xO w_digits.
-
- Definition ww_zdigits := w_add w_zdigits w_zdigits.
-
- Definition ww_to_Z := zn2z_to_Z (base w_digits) w_to_Z.
-
- Definition ww_1 := WW w_0 w_1.
-
- Definition ww_Bm1 := WW w_Bm1 w_Bm1.
-
- Definition ww_WW xh xl : zn2z (zn2z w) :=
-  match xh, xl with
-  | W0, W0 => W0
-  | _, _ => WW xh xl
-  end.
-
- Definition ww_W0 h : zn2z (zn2z w) :=
-  match h with
-  | W0 => W0
-  | _ => WW h W0
-  end.
-
- Definition ww_0W l : zn2z (zn2z w) :=
-  match l with
-  | W0 => W0
-  | _ => WW W0 l
-  end.
-
- Definition double_WW (n:nat) :=
-  match n return word w n -> word w n -> word w (S n) with
-  | O => w_WW
-  | S n =>
-    fun (h l : zn2z (word w n)) =>
-     match h, l with
-     | W0, W0 => W0
-     | _, _ => WW h l
-     end
-  end.
-
- Definition double_wB n := base (w_digits << n).
-
- Fixpoint double_to_Z (n:nat) : word w n -> Z :=
-  match n return word w n -> Z with
-  | O => w_to_Z
-  | S n => zn2z_to_Z (double_wB n) (double_to_Z n)
-  end.
-
- Fixpoint extend_aux (n:nat) (x:zn2z w) {struct n}: word w (S n) :=
-  match n return word w (S n) with
-  | O => x
-  | S n1 => WW W0 (extend_aux n1 x)
-  end.
-
- Definition extend (n:nat) (x:w) : word w (S n) :=
-  let r := w_0W x in
-  match r with
-  | W0 => W0
-  | _ => extend_aux n r
-  end.
-
- Definition double_0 n : word w n :=
-   match n return word w n with
-   | O => w_0
-   | S _ => W0
-   end.
-
- Definition double_split (n:nat) (x:zn2z (word w n)) :=
-  match x with
-  | W0 =>
-    match n return word w n * word w n with
-    | O => (w_0,w_0)
-    | S _ => (W0, W0)
-    end
-  | WW h l => (h,l)
-  end.
-
- Definition ww_compare x y :=
-  match x, y with
-  | W0, W0 => Eq
-  | W0, WW yh yl =>
-    match w_compare w_0 yh with
-    | Eq => w_compare w_0 yl
-    | _ => Lt
-    end
-  | WW xh xl, W0 =>
-    match w_compare xh w_0 with
-    | Eq => w_compare xl w_0
-    | _ => Gt
-    end
-  | WW xh xl, WW yh yl =>
-    match w_compare xh yh with
-    | Eq => w_compare xl yl
-    | Lt => Lt
-    | Gt => Gt
-    end
-  end.
-
-
- (* Return the low part of the composed word*)
- Fixpoint get_low (n : nat) {struct n}:
-  word w n -> w :=
-  match n return (word w n -> w) with
-  | 0%nat => fun x => x
-  | S n1 =>
-      fun x =>
-      match x with
-      | W0 => w_0
-      | WW _ x1 => get_low n1 x1
-      end
-  end.
-
-
- Section DoubleProof.
-  Notation wB  := (base w_digits).
-  Notation wwB := (base ww_digits).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[[ x ]]" := (ww_to_Z x)  (at level 0, x at level 99).
-  Notation "[+[ c ]]" :=
-   (interp_carry 1 wwB ww_to_Z c) (at level 0, c at level 99).
-  Notation "[-[ c ]]" :=
-   (interp_carry (-1) wwB ww_to_Z c) (at level 0, c at level 99).
-  Notation "[! n | x !]" := (double_to_Z n x) (at level 0, x at level 99).
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_w_1   : [|w_1|] = 1.
-  Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1.
-  Variable spec_w_WW  : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-  Variable spec_w_0W  : forall l, [[w_0W l]] = [|l|].
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_w_compare : forall x y,
-     w_compare x y = Z.compare [|x|] [|y|].
-
-  Lemma wwB_wBwB : wwB = wB^2.
-  Proof.
-   unfold base, ww_digits;rewrite Z.pow_2_r; rewrite (Pos2Z.inj_xO w_digits).
-   replace (2 * Zpos w_digits) with (Zpos w_digits + Zpos w_digits).
-   apply Zpower_exp; unfold Z.ge;simpl;intros;discriminate.
-   ring.
-  Qed.
-
-  Lemma spec_ww_1    : [[ww_1]] = 1.
-  Proof. simpl;rewrite spec_w_0;rewrite spec_w_1;ring. Qed.
-
-  Lemma spec_ww_Bm1  : [[ww_Bm1]] = wwB - 1.
-  Proof. simpl;rewrite spec_w_Bm1;rewrite wwB_wBwB;ring. Qed.
-
-  Lemma lt_0_wB : 0 < wB.
-  Proof.
-   unfold base;apply Z.pow_pos_nonneg. unfold Z.lt;reflexivity.
-   unfold Z.le;intros H;discriminate H.
-  Qed.
-
-  Lemma lt_0_wwB : 0 < wwB.
-  Proof. rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_pos_pos;apply lt_0_wB. Qed.
-
-  Lemma wB_pos: 1 < wB.
-  Proof.
-   unfold base;apply Z.lt_le_trans with (2^1).  unfold Z.lt;reflexivity.
-   apply Zpower_le_monotone.  unfold Z.lt;reflexivity.
-   split;unfold Z.le;intros H. discriminate H.
-   clear spec_w_0W w_0W spec_w_Bm1 spec_to_Z spec_w_WW w_WW.
-   destruct w_digits; discriminate H.
-  Qed.
-
-  Lemma wwB_pos: 1 < wwB.
-  Proof.
-   assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Z.mul_1_r 1).
-   rewrite Z.pow_2_r.
-   apply Zmult_lt_compat2;(split;[unfold Z.lt;reflexivity|trivial]).
-   apply Z.lt_le_incl;trivial.
-  Qed.
-
-  Theorem wB_div_2:  2 * (wB / 2) = wB.
-  Proof.
-   clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W
-    spec_to_Z;unfold base.
-   assert (2 ^ Zpos w_digits = 2 * (2 ^ (Zpos w_digits - 1))).
-   pattern 2 at 2; rewrite <- Z.pow_1_r.
-   rewrite <- Zpower_exp; auto with zarith.
-   f_equal; auto with zarith.
-   case w_digits; compute; intros; discriminate.
-   rewrite H; f_equal; auto with zarith.
-   rewrite Z.mul_comm; apply Z_div_mult; auto with zarith.
-  Qed.
-
-  Theorem wwB_div_2 : wwB / 2 = wB / 2 * wB.
-  Proof.
-   clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W
-    spec_to_Z.
-   rewrite wwB_wBwB; rewrite Z.pow_2_r.
-   pattern wB at 1; rewrite <- wB_div_2; auto.
-   rewrite <- Z.mul_assoc.
-   repeat (rewrite (Z.mul_comm 2); rewrite Z_div_mult); auto with zarith.
-  Qed.
-
-  Lemma mod_wwB : forall z x,
-   (z*wB + [|x|]) mod wwB = (z mod wB)*wB + [|x|].
-  Proof.
-   intros z x.
-   rewrite Zplus_mod.
-   pattern wwB at 1;rewrite wwB_wBwB; rewrite Z.pow_2_r.
-   rewrite Zmult_mod_distr_r;try apply lt_0_wB.
-   rewrite (Zmod_small [|x|]).
-   apply Zmod_small;rewrite wwB_wBwB;apply beta_mult;try apply spec_to_Z.
-   apply Z_mod_lt;apply Z.lt_gt;apply lt_0_wB.
-   destruct (spec_to_Z x);split;trivial.
-   change [|x|] with (0*wB+[|x|]). rewrite wwB_wBwB.
-   rewrite Z.pow_2_r;rewrite <- (Z.add_0_r (wB*wB));apply beta_lex_inv.
-   apply lt_0_wB. apply spec_to_Z. split;[apply Z.le_refl | apply lt_0_wB].
- Qed.
-
-  Lemma wB_div : forall x y, ([|x|] * wB + [|y|]) / wB = [|x|].
-  Proof.
-   clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
-   intros x y;unfold base;rewrite Zdiv_shift_r;auto with zarith.
-   rewrite Z_div_mult;auto with zarith.
-   destruct (spec_to_Z x);trivial.
-  Qed.
-
-  Lemma wB_div_plus : forall x y p,
-   0 <= p ->
-   ([|x|]*wB + [|y|]) / 2^(Zpos w_digits + p) = [|x|] / 2^p.
-  Proof.
-   clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
-   intros x y p Hp;rewrite Zpower_exp;auto with zarith.
-   rewrite <- Zdiv_Zdiv;auto with zarith.
-   rewrite wB_div;trivial.
-  Qed.
-
-  Lemma lt_wB_wwB : wB < wwB.
-  Proof.
-   clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
-   unfold base;apply Zpower_lt_monotone;auto with zarith.
-   assert (0 < Zpos w_digits). compute;reflexivity.
-   unfold ww_digits;rewrite Pos2Z.inj_xO;auto with zarith.
-  Qed.
-
-  Lemma w_to_Z_wwB : forall x, x < wB -> x < wwB.
-  Proof.
-   intros x H;apply Z.lt_trans with wB;trivial;apply lt_wB_wwB.
-  Qed.
-
-  Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB.
-  Proof.
-   clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
-   destruct x as [ |h l];simpl.
-   split;[apply Z.le_refl|apply lt_0_wwB].
-   assert (H:=spec_to_Z h);assert (L:=spec_to_Z l);split.
-   apply Z.add_nonneg_nonneg;auto with zarith.
-   rewrite <- (Z.add_0_r wwB);rewrite wwB_wBwB; rewrite Z.pow_2_r;
-    apply beta_lex_inv;auto with zarith.
-  Qed.
-
-  Lemma double_wB_wwB : forall n, double_wB n * double_wB n = double_wB (S n).
-  Proof.
-   intros n;unfold double_wB;simpl.
-   unfold base. rewrite (Pos2Z.inj_xO (_ << _)).
-   replace  (2 * Zpos (w_digits << n)) with
-     (Zpos (w_digits << n) + Zpos (w_digits << n)) by ring.
-   symmetry; apply Zpower_exp;intro;discriminate.
-  Qed.
-
-  Lemma double_wB_pos:
-   forall n, 0 <= double_wB n.
- Proof.
- intros n; unfold double_wB, base; auto with zarith.
- Qed.
-
-  Lemma double_wB_more_digits:
-  forall n, wB <= double_wB n.
-  Proof.
-  clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
-  intros n; elim n; clear n; auto.
-    unfold double_wB, "<<"; auto with zarith.
-  intros n H1; rewrite <- double_wB_wwB.
-  apply Z.le_trans with (wB * 1).
-    rewrite Z.mul_1_r; apply Z.le_refl.
-  unfold base; auto with zarith.
-  apply Z.mul_le_mono_nonneg; auto with zarith.
-  apply Z.le_trans with wB; auto with zarith.
-  unfold base.
-  rewrite <- (Z.pow_0_r 2).
-  apply Z.pow_le_mono_r; auto with zarith.
-  Qed.
-
-  Lemma spec_double_to_Z :
-   forall n (x:word w n), 0 <= [!n | x!] < double_wB n.
-  Proof.
-  clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
-  induction n;intros. exact (spec_to_Z x).
-  unfold double_to_Z;fold double_to_Z.
-  destruct x;unfold zn2z_to_Z.
-  unfold double_wB,base;split;auto with zarith.
-  assert (U0:= IHn w0);assert (U1:= IHn w1).
-  split;auto with zarith.
-  apply Z.lt_le_trans with ((double_wB n - 1) * double_wB n + double_wB n).
-  assert (double_to_Z n w0*double_wB n <= (double_wB n - 1)*double_wB n).
-  apply Z.mul_le_mono_nonneg_r;auto with zarith.
-  auto with zarith.
-  rewrite <- double_wB_wwB.
-  replace ((double_wB n - 1) * double_wB n + double_wB n) with (double_wB n * double_wB n);
-   [auto with zarith | ring].
-  Qed.
-
-  Lemma spec_get_low:
-  forall n x,
-     [!n | x!] < wB ->  [|get_low n x|] = [!n | x!].
-  Proof.
-  clear spec_w_1 spec_w_Bm1.
-  intros n; elim n; auto; clear n.
-  intros n Hrec x; case x; clear x; auto.
-  intros xx yy; simpl.
-  destruct (spec_double_to_Z n xx) as [F1 _]. Z.le_elim F1.
-  - (* 0 < [!n | xx!] *)
-    intros; exfalso.
-    assert (F3 := double_wB_more_digits n).
-    destruct (spec_double_to_Z n yy) as [F4 _].
-    assert (F5: 1 * wB <=  [!n | xx!] * double_wB n);
-     auto with zarith.
-    apply Z.mul_le_mono_nonneg; auto with zarith.
-    unfold base; auto with zarith.
-  - (* 0 = [!n | xx!] *)
-    rewrite <- F1; rewrite Z.mul_0_l, Z.add_0_l.
-    intros; apply Hrec; auto.
-  Qed.
-
-  Lemma spec_double_WW : forall n (h l : word w n),
-    [!S n|double_WW n h l!] = [!n|h!] * double_wB n + [!n|l!].
-  Proof.
-   induction n;simpl;intros;trivial.
-   destruct h;auto.
-   destruct l;auto.
-  Qed.
-
-  Lemma spec_extend_aux : forall n x, [!S n|extend_aux n x!] = [[x]].
-  Proof. induction n;simpl;trivial. Qed.
-
-  Lemma spec_extend : forall n x, [!S n|extend n x!] = [|x|].
-  Proof.
-   intros n x;assert (H:= spec_w_0W x);unfold extend.
-   destruct (w_0W x);simpl;trivial.
-   rewrite <- H;exact (spec_extend_aux n (WW w0 w1)).
-  Qed.
-
-  Lemma spec_double_0 : forall n, [!n|double_0 n!] = 0.
-  Proof. destruct n;trivial. Qed.
-
-  Lemma spec_double_split : forall n x,
-   let (h,l) := double_split n x in
-   [!S n|x!] = [!n|h!] * double_wB n + [!n|l!].
-  Proof.
-   destruct x;simpl;auto.
-   destruct n;simpl;trivial.
-   rewrite spec_w_0;trivial.
-  Qed.
-
-  Lemma wB_lex_inv: forall a b c d,
-      a < c ->
-      a * wB + [|b|] < c  * wB + [|d|].
-  Proof.
-   intros a b c d H1; apply beta_lex_inv with (1 := H1); auto.
-  Qed.
-
-  Ltac comp2ord := match goal with
-   | |- Lt = (?x ?= ?y) => symmetry; change (x < y)
-   | |- Gt = (?x ?= ?y) => symmetry; change (x > y); apply Z.lt_gt
-  end.
-
-  Lemma spec_ww_compare : forall x y,
-    ww_compare x y = Z.compare [[x]] [[y]].
-  Proof.
-   destruct x as [ |xh xl];destruct y as [ |yh yl];simpl;trivial.
-   (* 1st case *)
-   rewrite 2 spec_w_compare, spec_w_0.
-   destruct (Z.compare_spec 0 [|yh|]) as [H|H|H].
-   rewrite <- H;simpl. reflexivity.
-   symmetry. change (0 < [|yh|]*wB+[|yl|]).
-   change 0 with (0*wB+0). rewrite <- spec_w_0 at 2.
-   apply wB_lex_inv;trivial.
-   absurd (0 <= [|yh|]). apply Z.lt_nge; trivial.
-   destruct (spec_to_Z yh);trivial.
-   (* 2nd case *)
-   rewrite 2 spec_w_compare, spec_w_0.
-   destruct (Z.compare_spec [|xh|] 0) as [H|H|H].
-   rewrite H;simpl;reflexivity.
-   absurd (0 <= [|xh|]). apply Z.lt_nge; trivial.
-   destruct (spec_to_Z xh);trivial.
-   comp2ord.
-   change 0 with (0*wB+0). rewrite <- spec_w_0 at 2.
-   apply wB_lex_inv;trivial.
-   (* 3rd case *)
-   rewrite 2 spec_w_compare.
-   destruct (Z.compare_spec [|xh|] [|yh|]) as [H|H|H].
-   rewrite H.
-   symmetry. apply Z.add_compare_mono_l.
-   comp2ord. apply wB_lex_inv;trivial.
-   comp2ord. apply wB_lex_inv;trivial.
-  Qed.
-
-
- End DoubleProof.
-
-End DoubleBase.
-
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
deleted file mode 100644
index 4ebe8fac..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
+++ /dev/null
@@ -1,966 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-Require Import DoubleAdd.
-Require Import DoubleSub.
-Require Import DoubleMul.
-Require Import DoubleSqrt.
-Require Import DoubleLift.
-Require Import DoubleDivn1.
-Require Import DoubleDiv.
-Require Import CyclicAxioms.
-
-Local Open Scope Z_scope.
-
-
-Section Z_2nZ.
-
- Context {t : Type}{ops : ZnZ.Ops t}.
-
- Let w_digits      := ZnZ.digits.
- Let w_zdigits      := ZnZ.zdigits.
-
- Let w_to_Z        := ZnZ.to_Z.
- Let w_of_pos      := ZnZ.of_pos.
- Let w_head0       := ZnZ.head0.
- Let w_tail0       := ZnZ.tail0.
-
- Let w_0            := ZnZ.zero.
- Let w_1            := ZnZ.one.
- Let w_Bm1          := ZnZ.minus_one.
-
- Let w_compare     := ZnZ.compare.
- Let w_eq0         := ZnZ.eq0.
-
- Let w_opp_c       := ZnZ.opp_c.
- Let w_opp         := ZnZ.opp.
- Let w_opp_carry   := ZnZ.opp_carry.
-
- Let w_succ_c      := ZnZ.succ_c.
- Let w_add_c       := ZnZ.add_c.
- Let w_add_carry_c := ZnZ.add_carry_c.
- Let w_succ        := ZnZ.succ.
- Let w_add         := ZnZ.add.
- Let w_add_carry   := ZnZ.add_carry.
-
- Let w_pred_c      := ZnZ.pred_c.
- Let w_sub_c       := ZnZ.sub_c.
- Let w_sub_carry_c := ZnZ.sub_carry_c.
- Let w_pred        := ZnZ.pred.
- Let w_sub         := ZnZ.sub.
- Let w_sub_carry   := ZnZ.sub_carry.
-
-
- Let w_mul_c       := ZnZ.mul_c.
- Let w_mul         := ZnZ.mul.
- Let w_square_c    := ZnZ.square_c.
-
- Let w_div21       := ZnZ.div21.
- Let w_div_gt      := ZnZ.div_gt.
- Let w_div         := ZnZ.div.
-
- Let w_mod_gt      := ZnZ.modulo_gt.
- Let w_mod         := ZnZ.modulo.
-
- Let w_gcd_gt      := ZnZ.gcd_gt.
- Let w_gcd         := ZnZ.gcd.
-
- Let w_add_mul_div := ZnZ.add_mul_div.
-
- Let w_pos_mod := ZnZ.pos_mod.
-
- Let w_is_even     := ZnZ.is_even.
- Let w_sqrt2       := ZnZ.sqrt2.
- Let w_sqrt        := ZnZ.sqrt.
-
- Let _zn2z := zn2z t.
-
- Let wB := base w_digits.
-
- Let w_Bm2 := w_pred w_Bm1.
-
- Let ww_1 := ww_1 w_0 w_1.
- Let ww_Bm1 := ww_Bm1 w_Bm1.
-
- Let w_add2 a b := match w_add_c a b with C0 p => WW w_0 p | C1 p => WW w_1 p end.
-
- Let _ww_digits := xO w_digits.
-
- Let _ww_zdigits := w_add2 w_zdigits w_zdigits.
-
- Let to_Z := zn2z_to_Z wB w_to_Z.
-
- Let w_W0 := ZnZ.WO.
- Let w_0W := ZnZ.OW.
- Let w_WW := ZnZ.WW.
-
- Let ww_of_pos p :=
-  match w_of_pos p with
-  | (N0, l) => (N0, WW w_0 l)
-  | (Npos ph,l) =>
-    let (n,h) := w_of_pos ph in (n, w_WW h l)
-  end.
-
- Let head0 :=
-  Eval lazy beta delta [ww_head0] in
-  ww_head0 w_0 w_0W w_compare w_head0 w_add2 w_zdigits _ww_zdigits.
-
- Let tail0 :=
-  Eval lazy beta delta [ww_tail0] in
-  ww_tail0 w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits.
-
- Let ww_WW := Eval lazy beta delta [ww_WW] in (@ww_WW t).
- Let ww_0W := Eval lazy beta delta [ww_0W] in (@ww_0W t).
- Let ww_W0 := Eval lazy beta delta [ww_W0] in (@ww_W0 t).
-
- (* ** Comparison ** *)
- Let compare :=
-  Eval lazy beta delta[ww_compare] in ww_compare w_0 w_compare.
-
- Let eq0 (x:zn2z t) :=
-  match x with
-  | W0 => true
-  | _ => false
-  end.
-
- (* ** Opposites ** *)
- Let opp_c :=
-  Eval lazy beta delta [ww_opp_c] in ww_opp_c w_0 w_opp_c w_opp_carry.
-
- Let opp :=
-  Eval lazy beta delta [ww_opp] in ww_opp w_0 w_opp_c w_opp_carry w_opp.
-
- Let opp_carry :=
-  Eval lazy beta delta [ww_opp_carry] in ww_opp_carry w_WW ww_Bm1 w_opp_carry.
-
- (* ** Additions ** *)
-
- Let succ_c :=
-  Eval lazy beta delta [ww_succ_c] in ww_succ_c w_0 ww_1 w_succ_c.
-
- Let add_c :=
-  Eval lazy beta delta [ww_add_c] in ww_add_c w_WW w_add_c w_add_carry_c.
-
- Let add_carry_c :=
-  Eval lazy beta iota delta [ww_add_carry_c ww_succ_c] in
-  ww_add_carry_c w_0 w_WW ww_1 w_succ_c w_add_c w_add_carry_c.
-
- Let succ :=
-  Eval lazy beta delta [ww_succ] in ww_succ w_W0 ww_1 w_succ_c w_succ.
-
- Let add :=
-  Eval lazy beta delta [ww_add] in ww_add w_add_c w_add w_add_carry.
-
- Let add_carry :=
-  Eval lazy beta iota delta [ww_add_carry ww_succ] in
-  ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ w_add w_add_carry.
-
- (* ** Subtractions ** *)
-
- Let pred_c :=
-  Eval lazy beta delta [ww_pred_c] in ww_pred_c w_Bm1 w_WW ww_Bm1 w_pred_c.
-
- Let sub_c :=
-  Eval lazy beta iota delta [ww_sub_c ww_opp_c] in
-  ww_sub_c w_0 w_WW w_opp_c w_opp_carry w_sub_c w_sub_carry_c.
-
- Let sub_carry_c :=
-  Eval lazy beta iota delta [ww_sub_carry_c ww_pred_c ww_opp_carry] in
-  ww_sub_carry_c w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c w_sub_c w_sub_carry_c.
-
- Let pred :=
-  Eval lazy beta delta [ww_pred] in ww_pred w_Bm1 w_WW ww_Bm1 w_pred_c w_pred.
-
- Let sub :=
-  Eval lazy beta iota delta [ww_sub ww_opp] in
-  ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry.
-
- Let sub_carry :=
-  Eval lazy beta iota delta [ww_sub_carry ww_pred ww_opp_carry] in
-  ww_sub_carry w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c w_sub_carry_c w_pred
-  w_sub w_sub_carry.
-
-
- (* ** Multiplication ** *)
-
- Let mul_c :=
-  Eval lazy beta iota delta [ww_mul_c double_mul_c] in
-  ww_mul_c w_0 w_1 w_WW w_W0 w_mul_c add_c add add_carry.
-
- Let karatsuba_c :=
-  Eval lazy beta iota delta [ww_karatsuba_c double_mul_c kara_prod] in
-  ww_karatsuba_c w_0 w_1 w_WW w_W0 w_compare w_add w_sub w_mul_c
-    add_c add add_carry sub_c sub.
-
- Let mul :=
-  Eval lazy beta delta [ww_mul] in
-  ww_mul w_W0 w_add w_mul_c w_mul add.
-
- Let square_c :=
-  Eval lazy beta delta [ww_square_c] in
-  ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add add_carry.
-
- (* Division operation *)
-
- Let div32 :=
-   Eval lazy beta iota delta [w_div32] in
-   w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c
-   w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c.
-
- Let div21 :=
-  Eval lazy beta iota delta [ww_div21] in
-   ww_div21 w_0 w_0W div32 ww_1 compare sub.
-
- Let low (p: zn2z t) := match p with WW _ p1 => p1 | _ => w_0 end.
-
- Let add_mul_div :=
-  Eval lazy beta delta [ww_add_mul_div] in
-  ww_add_mul_div w_0 w_WW w_W0 w_0W compare w_add_mul_div sub w_zdigits low.
-
- Let div_gt :=
-  Eval lazy beta delta [ww_div_gt] in
-  ww_div_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp
-  w_opp_carry w_sub_c w_sub w_sub_carry
-  w_div_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits.
-
- Let div :=
-  Eval lazy beta delta [ww_div] in ww_div ww_1 compare div_gt.
-
- Let mod_gt :=
-  Eval lazy beta delta [ww_mod_gt] in
-  ww_mod_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry
-  w_mod_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits add_mul_div w_zdigits.
-
- Let mod_ :=
-  Eval lazy beta delta [ww_mod] in ww_mod compare mod_gt.
-
- Let pos_mod :=
-  Eval lazy beta delta [ww_pos_mod] in
-    ww_pos_mod w_0 w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits.
-
- Let is_even :=
-  Eval lazy beta delta [ww_is_even] in ww_is_even w_is_even.
-
- Let sqrt2 :=
-  Eval lazy beta delta [ww_sqrt2] in
-    ww_sqrt2 w_is_even w_compare w_0 w_1 w_Bm1 w_0W w_sub w_square_c
-    w_div21 w_add_mul_div w_zdigits w_add_c w_sqrt2 w_pred pred_c
-    pred add_c add sub_c add_mul_div.
-
- Let sqrt :=
-  Eval lazy beta delta [ww_sqrt] in
-    ww_sqrt w_is_even w_0 w_sub w_add_mul_div w_zdigits
-     _ww_zdigits w_sqrt2 pred add_mul_div head0 compare low.
-
- Let gcd_gt_fix :=
-  Eval cbv beta delta [ww_gcd_gt_aux ww_gcd_gt_body] in
-  ww_gcd_gt_aux w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry
-      w_sub_c w_sub w_sub_carry w_gcd_gt
-      w_add_mul_div w_head0 w_div21 div32 _ww_zdigits add_mul_div
-      w_zdigits.
-
- Let gcd_cont :=
-  Eval lazy beta delta [gcd_cont] in gcd_cont ww_1 w_1 w_compare.
-
- Let gcd_gt :=
-  Eval lazy beta delta [ww_gcd_gt] in
-  ww_gcd_gt w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont.
-
- Let gcd :=
-  Eval lazy beta delta [ww_gcd] in
-  ww_gcd compare w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont.
-
- Definition lor (x y : zn2z t) :=
-  match x, y with
-  | W0, _ => y
-  | _, W0 => x
-  | WW hx lx, WW hy ly => WW (ZnZ.lor hx hy) (ZnZ.lor lx ly)
-  end.
-
- Definition land (x y : zn2z t) :=
-  match x, y with
-  | W0, _ => W0
-  | _, W0 => W0
-  | WW hx lx, WW hy ly => WW (ZnZ.land hx hy) (ZnZ.land lx ly)
-  end.
-
- Definition lxor (x y : zn2z t) :=
-  match x, y with
-  | W0, _ => y
-  | _, W0 => x
-  | WW hx lx, WW hy ly => WW (ZnZ.lxor hx hy) (ZnZ.lxor lx ly)
-  end.
-
- (* ** Record of operators on 2 words *)
-
- Global Instance mk_zn2z_ops : ZnZ.Ops (zn2z t) | 1 :=
-  ZnZ.MkOps _ww_digits _ww_zdigits
-    to_Z ww_of_pos head0 tail0
-    W0 ww_1 ww_Bm1
-    compare eq0
-    opp_c opp opp_carry
-    succ_c add_c add_carry_c
-    succ add add_carry
-    pred_c sub_c sub_carry_c
-    pred sub sub_carry
-    mul_c mul square_c
-    div21 div_gt div
-    mod_gt mod_
-    gcd_gt gcd
-    add_mul_div
-    pos_mod
-    is_even
-    sqrt2
-    sqrt
-    lor
-    land
-    lxor.
-
- Global Instance mk_zn2z_ops_karatsuba : ZnZ.Ops (zn2z t) | 2 :=
-   ZnZ.MkOps _ww_digits _ww_zdigits
-    to_Z ww_of_pos head0 tail0
-    W0 ww_1 ww_Bm1
-    compare eq0
-    opp_c opp opp_carry
-    succ_c add_c add_carry_c
-    succ add add_carry
-    pred_c sub_c sub_carry_c
-    pred sub sub_carry
-    karatsuba_c mul square_c
-    div21 div_gt div
-    mod_gt mod_
-    gcd_gt gcd
-    add_mul_div
-    pos_mod
-    is_even
-    sqrt2
-    sqrt
-    lor
-    land
-    lxor.
-
- (* Proof *)
- Context {specs : ZnZ.Specs ops}.
- 
- Create HintDb ZnZ.
-
- Hint Resolve
-    ZnZ.spec_to_Z
-    ZnZ.spec_of_pos
-    ZnZ.spec_0
-    ZnZ.spec_1
-    ZnZ.spec_m1
-    ZnZ.spec_compare
-    ZnZ.spec_eq0
-    ZnZ.spec_opp_c
-    ZnZ.spec_opp
-    ZnZ.spec_opp_carry
-    ZnZ.spec_succ_c
-    ZnZ.spec_add_c
-    ZnZ.spec_add_carry_c
-    ZnZ.spec_succ
-    ZnZ.spec_add
-    ZnZ.spec_add_carry
-    ZnZ.spec_pred_c
-    ZnZ.spec_sub_c
-    ZnZ.spec_sub_carry_c
-    ZnZ.spec_pred
-    ZnZ.spec_sub
-    ZnZ.spec_sub_carry
-    ZnZ.spec_mul_c
-    ZnZ.spec_mul
-    ZnZ.spec_square_c
-    ZnZ.spec_div21
-    ZnZ.spec_div_gt
-    ZnZ.spec_div
-    ZnZ.spec_modulo_gt
-    ZnZ.spec_modulo
-    ZnZ.spec_gcd_gt
-    ZnZ.spec_gcd
-    ZnZ.spec_head0
-    ZnZ.spec_tail0
-    ZnZ.spec_add_mul_div
-    ZnZ.spec_pos_mod
-    ZnZ.spec_is_even
-    ZnZ.spec_sqrt2
-    ZnZ.spec_sqrt
-    ZnZ.spec_WO
-    ZnZ.spec_OW
-    ZnZ.spec_WW : ZnZ.
- 
- Ltac wwauto := unfold ww_to_Z; eauto with ZnZ.
-
- Let wwB := base _ww_digits.
-
- Notation "[| x |]" := (to_Z x)  (at level 0, x at level 99).
-
- Notation "[+| c |]" :=
-   (interp_carry 1 wwB to_Z c)  (at level 0, c at level 99).
-
- Notation "[-| c |]" :=
-   (interp_carry (-1) wwB to_Z c)  (at level 0, c at level 99).
-
- Notation "[[ x ]]" := (zn2z_to_Z wwB to_Z x)  (at level 0, x at level 99).
-
- Let spec_ww_to_Z   : forall x, 0 <= [| x |] < wwB.
- Proof. refine (spec_ww_to_Z w_digits w_to_Z _); wwauto. Qed.
-
- Let spec_ww_of_pos : forall p,
-     Zpos p = (Z.of_N (fst (ww_of_pos p)))*wwB + [|(snd (ww_of_pos p))|].
- Proof.
-  unfold ww_of_pos;intros.
-  rewrite (ZnZ.spec_of_pos p). unfold w_of_pos.
-  case (ZnZ.of_pos p); intros. simpl.
-  destruct n; simpl ZnZ.to_Z.
-  simpl;unfold w_to_Z,w_0; rewrite ZnZ.spec_0;trivial.
-  unfold Z.of_N.
-  rewrite (ZnZ.spec_of_pos p0).
-  case (ZnZ.of_pos p0); intros. simpl.
-  unfold fst, snd,Z.of_N, to_Z, wB, w_digits, w_to_Z, w_WW.
-  rewrite ZnZ.spec_WW.
-  replace wwB with (wB*wB).
-  unfold wB,w_to_Z,w_digits;destruct n;ring.
-  symmetry. rewrite <- Z.pow_2_r; exact (wwB_wBwB w_digits).
- Qed.
-
- Let spec_ww_0 : [|W0|] = 0.
- Proof. reflexivity. Qed.
-
- Let spec_ww_1 : [|ww_1|] = 1.
- Proof. refine (spec_ww_1 w_0 w_1 w_digits w_to_Z _ _);wwauto. Qed.
-
- Let spec_ww_Bm1 : [|ww_Bm1|] = wwB - 1.
- Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);wwauto. Qed.
-
- Let spec_ww_compare :
-  forall x y, compare x y = Z.compare [|x|] [|y|].
- Proof.
-  refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);wwauto.
- Qed.
-
- Let spec_ww_eq0 : forall x, eq0 x = true -> [|x|] = 0.
- Proof. destruct x;simpl;intros;trivial;discriminate. Qed.
-
- Let spec_ww_opp_c : forall x, [-|opp_c x|] = -[|x|].
- Proof.
-  refine(spec_ww_opp_c w_0 w_0 W0 w_opp_c w_opp_carry w_digits w_to_Z _ _ _ _);
-   wwauto.
- Qed.
-
- Let spec_ww_opp : forall x, [|opp x|] = (-[|x|]) mod wwB.
- Proof.
-  refine(spec_ww_opp w_0 w_0 W0 w_opp_c w_opp_carry w_opp
-   w_digits w_to_Z _ _ _ _ _);
-  wwauto.
- Qed.
-
- Let spec_ww_opp_carry : forall x, [|opp_carry x|] = wwB - [|x|] - 1.
- Proof.
-  refine (spec_ww_opp_carry w_WW ww_Bm1 w_opp_carry w_digits w_to_Z _ _ _);
-  wwauto.
- Qed.
-
- Let spec_ww_succ_c : forall x, [+|succ_c x|] = [|x|] + 1.
- Proof.
-  refine (spec_ww_succ_c w_0 w_0 ww_1 w_succ_c w_digits w_to_Z _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_add_c  : forall x y, [+|add_c x y|] = [|x|] + [|y|].
- Proof.
-  refine (spec_ww_add_c w_WW w_add_c w_add_carry_c w_digits w_to_Z _ _ _);wwauto.
- Qed.
-
- Let spec_ww_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|]+[|y|]+1.
- Proof.
-  refine (spec_ww_add_carry_c w_0 w_0 w_WW ww_1 w_succ_c w_add_c w_add_carry_c
-   w_digits w_to_Z _ _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_succ : forall x, [|succ x|] = ([|x|] + 1) mod wwB.
- Proof.
-  refine (spec_ww_succ w_W0 ww_1 w_succ_c w_succ w_digits w_to_Z _ _ _ _ _);
-  wwauto.
- Qed.
-
- Let spec_ww_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wwB.
- Proof.
-  refine (spec_ww_add w_add_c w_add w_add_carry w_digits w_to_Z _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_add_carry : forall x y, [|add_carry x y|]=([|x|]+[|y|]+1)mod wwB.
- Proof.
-  refine (spec_ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ
-  w_add w_add_carry w_digits w_to_Z _ _ _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_pred_c : forall x, [-|pred_c x|] = [|x|] - 1.
- Proof.
-  refine (spec_ww_pred_c w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_digits w_to_Z
-   _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|].
- Proof.
-  refine (spec_ww_sub_c w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c
-   w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|]-[|y|]-1.
- Proof.
-  refine (spec_ww_sub_carry_c w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c
-   w_sub_c w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_pred : forall x, [|pred x|] = ([|x|] - 1) mod wwB.
- Proof.
-  refine (spec_ww_pred w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_pred w_digits w_to_Z
-   _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wwB.
- Proof.
-  refine (spec_ww_sub w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c w_opp
-   w_sub w_sub_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_sub_carry : forall x y, [|sub_carry x y|]=([|x|]-[|y|]-1) mod wwB.
- Proof.
-  refine (spec_ww_sub_carry w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c
-   w_sub_carry_c w_pred w_sub w_sub_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _ _);
-  wwauto.
- Qed.
-
- Let spec_ww_mul_c : forall x y, [[mul_c x y ]] = [|x|] * [|y|].
- Proof.
-  refine (spec_ww_mul_c w_0 w_1 w_WW w_W0 w_mul_c add_c add add_carry w_digits
-   w_to_Z _ _ _ _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_karatsuba_c : forall x y, [[karatsuba_c x y ]] = [|x|] * [|y|].
- Proof.
- refine (spec_ww_karatsuba_c _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-          _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
-  unfold w_digits; apply ZnZ.spec_more_than_1_digit; auto.
- Qed.
-
- Let spec_ww_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wwB.
- Proof.
-  refine (spec_ww_mul w_W0 w_add w_mul_c w_mul add w_digits w_to_Z _ _ _ _ _);
-  wwauto.
- Qed.
-
- Let spec_ww_square_c : forall x, [[square_c x]] = [|x|] * [|x|].
- Proof.
-  refine (spec_ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add
-   add_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _ _);wwauto.
- Qed.
-
- Let spec_w_div32 : forall a1 a2 a3 b1 b2,
-       wB / 2 <= (w_to_Z b1) ->
-       [|WW a1 a2|] < [|WW b1 b2|] ->
-       let (q, r) := div32 a1 a2 a3 b1 b2 in
-       (w_to_Z a1) * wwB + (w_to_Z a2) * wB + (w_to_Z a3) =
-       (w_to_Z q) * ((w_to_Z b1)*wB + (w_to_Z b2)) + [|r|] /\
-       0 <= [|r|] < (w_to_Z b1)*wB + w_to_Z b2.
- Proof.
-  refine (spec_w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c
-   w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c w_digits w_to_Z
-   _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto.
-  unfold w_Bm2, w_to_Z, w_pred, w_Bm1.
-  rewrite ZnZ.spec_pred, ZnZ.spec_m1.
-  unfold w_digits;rewrite Zmod_small. ring.
-  assert (H:= wB_pos(ZnZ.digits)). omega.
-  exact ZnZ.spec_div21.
- Qed.
-
- Let spec_ww_div21 : forall a1 a2 b,
-      wwB/2 <= [|b|] ->
-      [|a1|] < [|b|] ->
-      let (q,r) := div21 a1 a2 b in
-      [|a1|] *wwB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
-      0 <= [|r|] < [|b|].
- Proof.
-  refine (spec_ww_div21 w_0 w_0W div32 ww_1 compare sub w_digits w_to_Z
-   _ _ _ _ _ _ _);wwauto. 
- Qed.
-
- Let spec_add2: forall x y,
-  [|w_add2 x y|] = w_to_Z x + w_to_Z y.
-  unfold w_add2.
-  intros xh xl; generalize (ZnZ.spec_add_c xh xl).
-  unfold w_add_c; case ZnZ.add_c; unfold interp_carry; simpl ww_to_Z.
-    intros w0 Hw0; simpl; unfold w_to_Z; rewrite Hw0.
-  unfold w_0; rewrite ZnZ.spec_0; simpl; auto with zarith.
-  intros w0; rewrite Z.mul_1_l; simpl.
-  unfold w_to_Z, w_1; rewrite ZnZ.spec_1; auto with zarith.
-  rewrite Z.mul_1_l; auto.
- Qed.
-
- Let spec_low: forall x,
-  w_to_Z (low x) = [|x|] mod wB. 
-  intros x; case x; simpl low.
-    unfold ww_to_Z, w_to_Z, w_0; rewrite ZnZ.spec_0; simpl; wwauto.
-  intros xh xl; simpl.
-  rewrite Z.add_comm; rewrite Z_mod_plus; auto with zarith.
-  rewrite Zmod_small; auto with zarith.
-  unfold wB, base; eauto with ZnZ zarith.
-  unfold wB, base; eauto with ZnZ zarith.
- Qed.
-
- Let spec_ww_digits:
-  [|_ww_zdigits|] = Zpos (xO w_digits).
- Proof.
- unfold w_to_Z, _ww_zdigits.
- rewrite spec_add2.
- unfold w_to_Z, w_zdigits, w_digits.
- rewrite ZnZ.spec_zdigits; auto.
- rewrite Pos2Z.inj_xO; auto with zarith.
- Qed.
-
-
- Let spec_ww_head00  : forall x,  [|x|] = 0 -> [|head0 x|] = Zpos _ww_digits.
- Proof.
- refine (spec_ww_head00 w_0 w_0W
-                w_compare w_head0 w_add2 w_zdigits _ww_zdigits
-                w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); wwauto.
- exact ZnZ.spec_head00.
- exact ZnZ.spec_zdigits.
- Qed.
-
- Let spec_ww_head0  : forall x,  0 < [|x|] ->
-	 wwB/ 2 <= 2 ^ [|head0 x|] * [|x|] < wwB.
- Proof.
-  refine (spec_ww_head0 w_0 w_0W w_compare w_head0
-           w_add2 w_zdigits _ww_zdigits
-   w_to_Z _ _ _ _ _ _ _);wwauto.
-  exact ZnZ.spec_zdigits.
- Qed.
-
- Let spec_ww_tail00  : forall x,  [|x|] = 0 -> [|tail0 x|] = Zpos _ww_digits.
- Proof.
- refine (spec_ww_tail00 w_0 w_0W
-                w_compare w_tail0 w_add2 w_zdigits _ww_zdigits
-                w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); wwauto.
- exact ZnZ.spec_tail00.
- exact ZnZ.spec_zdigits.
- Qed.
-
-
- Let spec_ww_tail0  : forall x,  0 < [|x|] ->
-  exists y, 0 <= y /\ [|x|] = (2 * y + 1) * 2 ^ [|tail0 x|].
- Proof.
-  refine (spec_ww_tail0 (w_digits := w_digits) w_0 w_0W w_compare w_tail0
-           w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ _ _ _ _);wwauto.
-  exact ZnZ.spec_zdigits.
- Qed.
-
- Lemma spec_ww_add_mul_div : forall x y p,
-       [|p|] <= Zpos _ww_digits ->
-       [| add_mul_div p x y |] =
-         ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (2 ^ ((Zpos _ww_digits) - [|p|]))) mod wwB.
- Proof.
- refine (@spec_ww_add_mul_div t w_0 w_WW w_W0 w_0W compare w_add_mul_div
-              sub w_digits w_zdigits low w_to_Z
-           _ _ _ _ _ _ _ _ _ _ _);wwauto.
-  exact ZnZ.spec_zdigits.
- Qed.
-
- Let spec_ww_div_gt : forall a b,
-      [|a|] > [|b|] -> 0 < [|b|] ->
-      let (q,r) := div_gt a b in
-      [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|].
- Proof.
-refine
-(@spec_ww_div_gt t w_digits w_0 w_WW w_0W w_compare w_eq0
-   w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt
-   w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
- _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-).
-  exact ZnZ.spec_0.
-  exact ZnZ.spec_to_Z.
-  wwauto.
-  wwauto.
-  exact ZnZ.spec_compare.
-  exact ZnZ.spec_eq0.
-  exact ZnZ.spec_opp_c.
-  exact ZnZ.spec_opp.
-  exact ZnZ.spec_opp_carry.
-  exact ZnZ.spec_sub_c.
-  exact ZnZ.spec_sub.
-  exact ZnZ.spec_sub_carry.
-  exact ZnZ.spec_div_gt.
-  exact ZnZ.spec_add_mul_div.
-  exact ZnZ.spec_head0.
-  exact ZnZ.spec_div21.
-  exact spec_w_div32.
-  exact ZnZ.spec_zdigits.
-  exact spec_ww_digits.
-  exact spec_ww_1.
-  exact spec_ww_add_mul_div.
- Qed.
-
- Let spec_ww_div : forall a b, 0 < [|b|] ->
-      let (q,r) := div a b in
-      [|a|] = [|q|] * [|b|] + [|r|] /\
-      0 <= [|r|] < [|b|].
- Proof.
-  refine (spec_ww_div w_digits ww_1 compare div_gt w_to_Z _ _ _ _);wwauto.
- Qed.
-
- Let spec_ww_mod_gt : forall a b,
-      [|a|] > [|b|] -> 0 < [|b|] ->
-      [|mod_gt a b|] = [|a|] mod [|b|].
- Proof.
-  refine (@spec_ww_mod_gt t w_digits w_0 w_WW w_0W w_compare w_eq0
-   w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_mod_gt
-   w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div
-   w_zdigits w_to_Z
-   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _ _ _);wwauto.
-  exact ZnZ.spec_div_gt.
-  exact ZnZ.spec_div21.
-  exact ZnZ.spec_zdigits.
-  exact spec_ww_add_mul_div.
- Qed.
-
- Let spec_ww_mod :  forall a b, 0 < [|b|] -> [|mod_ a b|] = [|a|] mod [|b|].
- Proof.
-  refine (spec_ww_mod w_digits W0 compare mod_gt w_to_Z _ _ _);wwauto.
- Qed.
-
- Let spec_ww_gcd_gt : forall a b, [|a|] > [|b|] ->
-      Zis_gcd [|a|] [|b|] [|gcd_gt a b|].
- Proof.
-  refine (@spec_ww_gcd_gt t w_digits W0 w_to_Z _
-    w_0 w_0 w_eq0 w_gcd_gt _ww_digits
-  _ gcd_gt_fix _ _ _ _ gcd_cont _);wwauto.
-  refine (@spec_ww_gcd_gt_aux t w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
-   w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0
-   w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
-   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _);wwauto.
-  exact ZnZ.spec_div21.
-  exact ZnZ.spec_zdigits.
-  exact spec_ww_add_mul_div.
-  refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
-   _ _);wwauto.
- Qed.
-
- Let spec_ww_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|].
- Proof.
-  refine (@spec_ww_gcd t w_digits W0 compare w_to_Z _ _ w_0 w_0 w_eq0 w_gcd_gt
-  _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);wwauto.
-  refine (@spec_ww_gcd_gt_aux t w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
-   w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0
-   w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
-   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _);wwauto.
-  exact ZnZ.spec_div21.
-  exact ZnZ.spec_zdigits.
-  exact spec_ww_add_mul_div.
-  refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
-   _ _);wwauto.
- Qed.
-
- Let spec_ww_is_even : forall x,
-      match is_even x with
-         true => [|x|] mod 2 = 0
-      | false => [|x|] mod 2 = 1
-      end.
- Proof.
- refine (@spec_ww_is_even t w_is_even w_digits _ _ ).
- exact ZnZ.spec_is_even.
- Qed.
-
- Let spec_ww_sqrt2 : forall x y,
-       wwB/ 4 <= [|x|] ->
-       let (s,r) := sqrt2 x y in
-          [[WW x y]] = [|s|] ^ 2 + [+|r|] /\
-          [+|r|] <= 2 * [|s|].
- Proof.
- intros x y H.
- refine (@spec_ww_sqrt2 t w_is_even w_compare w_0 w_1 w_Bm1
-               w_0W w_sub w_square_c w_div21 w_add_mul_div w_digits w_zdigits
-               _ww_zdigits
-               w_add_c w_sqrt2 w_pred pred_c pred add_c add sub_c add_mul_div
-                _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
- exact ZnZ.spec_zdigits.
- exact ZnZ.spec_more_than_1_digit.
- exact ZnZ.spec_is_even.
- exact ZnZ.spec_div21.
- exact spec_ww_add_mul_div.
- exact ZnZ.spec_sqrt2.
- Qed.
-
- Let spec_ww_sqrt : forall x,
-       [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2.
- Proof.
- refine (@spec_ww_sqrt t w_is_even w_0 w_1 w_Bm1
-           w_sub w_add_mul_div w_digits w_zdigits _ww_zdigits
-               w_sqrt2 pred add_mul_div head0 compare
-            _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
- exact ZnZ.spec_zdigits.
- exact ZnZ.spec_more_than_1_digit.
- exact ZnZ.spec_is_even.
- exact spec_ww_add_mul_div.
- exact ZnZ.spec_sqrt2.
- Qed.
-
- Let wB_pos : 0 < wB.
- Proof.
- unfold wB, base; apply Z.pow_pos_nonneg; auto with zarith.
- Qed.
- 
- Hint Transparent ww_to_Z.
-
- Let ww_testbit_high n x y : Z.pos w_digits <= n ->
-  Z.testbit [|WW x y|] n =
-  Z.testbit (ZnZ.to_Z x) (n - Z.pos w_digits).
- Proof.
-  intros Hn.
-  assert (E : ZnZ.to_Z x = [|WW x y|] / wB).
-  { simpl.
-    rewrite Z.div_add_l; eauto with ZnZ zarith.
-    now rewrite Z.div_small, Z.add_0_r; wwauto. }
-  rewrite E.
-  unfold wB, base. rewrite Z.div_pow2_bits.
-  - f_equal; auto with zarith.
-  - easy.
-  - auto with zarith.
- Qed.
-
- Let ww_testbit_low n x y : 0 <= n < Z.pos w_digits ->
-  Z.testbit [|WW x y|] n = Z.testbit (ZnZ.to_Z y) n.
- Proof.
-  intros (Hn,Hn').
-  assert (E : ZnZ.to_Z y = [|WW x y|] mod wB).
-  { simpl; symmetry.
-    rewrite Z.add_comm, Z.mod_add; auto with zarith nocore.
-    apply Z.mod_small; eauto with ZnZ zarith. }
-  rewrite E.
-  unfold wB, base. symmetry. apply Z.mod_pow2_bits_low; auto.
- Qed.
-
- Let spec_lor x y : [|lor x y|] = Z.lor [|x|] [|y|].
- Proof.
-  destruct x as [ |hx lx]. trivial.
-  destruct y as [ |hy ly]. now rewrite Z.lor_comm.
-  change ([|WW (ZnZ.lor hx hy) (ZnZ.lor lx ly)|] =
-          Z.lor [|WW hx lx|] [|WW hy ly|]).
-  apply Z.bits_inj'; intros n Hn.
-  rewrite Z.lor_spec.
-  destruct (Z.le_gt_cases (Z.pos w_digits) n) as [LE|GT].
-  - now rewrite !ww_testbit_high, ZnZ.spec_lor, Z.lor_spec.
-  - rewrite !ww_testbit_low; auto.
-    now rewrite ZnZ.spec_lor, Z.lor_spec.
- Qed.
-
- Let spec_land x y : [|land x y|] = Z.land [|x|] [|y|].
- Proof.
-  destruct x as [ |hx lx]. trivial.
-  destruct y as [ |hy ly]. now rewrite Z.land_comm.
-  change ([|WW (ZnZ.land hx hy) (ZnZ.land lx ly)|] =
-          Z.land [|WW hx lx|] [|WW hy ly|]).
-  apply Z.bits_inj'; intros n Hn.
-  rewrite Z.land_spec.
-  destruct (Z.le_gt_cases (Z.pos w_digits) n) as [LE|GT].
-  - now rewrite !ww_testbit_high, ZnZ.spec_land, Z.land_spec.
-  - rewrite !ww_testbit_low; auto.
-    now rewrite ZnZ.spec_land, Z.land_spec.
- Qed.
-
- Let spec_lxor x y : [|lxor x y|] = Z.lxor [|x|] [|y|].
- Proof.
-  destruct x as [ |hx lx]. trivial.
-  destruct y as [ |hy ly]. now rewrite Z.lxor_comm.
-  change ([|WW (ZnZ.lxor hx hy) (ZnZ.lxor lx ly)|] =
-          Z.lxor [|WW hx lx|] [|WW hy ly|]).
-  apply Z.bits_inj'; intros n Hn.
-  rewrite Z.lxor_spec.
-  destruct (Z.le_gt_cases (Z.pos w_digits) n) as [LE|GT].
-  - now rewrite !ww_testbit_high, ZnZ.spec_lxor, Z.lxor_spec.
-  - rewrite !ww_testbit_low; auto.
-    now rewrite ZnZ.spec_lxor, Z.lxor_spec.
- Qed.
-
- Global Instance mk_zn2z_specs : ZnZ.Specs mk_zn2z_ops.
- Proof.
-  apply ZnZ.MkSpecs; auto.
-  exact spec_ww_add_mul_div.
-
-  refine (@spec_ww_pos_mod t w_0 w_digits w_zdigits w_WW
-           w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z
-       _ _ _ _ _ _ _ _ _ _ _ _);wwauto.
-  exact ZnZ.spec_zdigits.
-  unfold w_to_Z, w_zdigits.
-  rewrite ZnZ.spec_zdigits.
-  rewrite <- Pos2Z.inj_xO; exact spec_ww_digits.
- Qed.
-
- Global Instance mk_zn2z_specs_karatsuba : ZnZ.Specs mk_zn2z_ops_karatsuba.
- Proof.
-  apply ZnZ.MkSpecs; auto.
-  exact spec_ww_add_mul_div.
-  refine (@spec_ww_pos_mod t w_0 w_digits w_zdigits w_WW
-           w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z
-       _ _ _ _ _ _ _ _ _ _ _ _);wwauto.
-  exact ZnZ.spec_zdigits.
-  unfold w_to_Z, w_zdigits.
-  rewrite ZnZ.spec_zdigits.
-  rewrite <- Pos2Z.inj_xO; exact spec_ww_digits.
- Qed.
-
-End Z_2nZ.
-
-
-Section MulAdd.
-
-  Context {t : Type}{ops : ZnZ.Ops t}{specs : ZnZ.Specs ops}.
-
-  Definition mul_add:= w_mul_add ZnZ.zero ZnZ.succ ZnZ.add_c ZnZ.mul_c.
-
-  Notation "[| x |]" := (ZnZ.to_Z x)  (at level 0, x at level 99).
-
-  Notation "[|| x ||]" :=
-   (zn2z_to_Z (base ZnZ.digits) ZnZ.to_Z x)  (at level 0, x at level 99).
-
-  Lemma spec_mul_add: forall x y z,
-     let (zh, zl) := mul_add x y z in
-  [||WW zh zl||] = [|x|] * [|y|] + [|z|].
-  Proof.
-  intros x y z.
-   refine (spec_w_mul_add _ _ _ _ _ _ _ _ _ _ _ _ x y z); auto.
-  exact ZnZ.spec_0.
-  exact ZnZ.spec_to_Z.
-  exact ZnZ.spec_succ.
-  exact ZnZ.spec_add_c.
-  exact ZnZ.spec_mul_c.
-  Qed.
-
-End MulAdd.
-
-
-(** Modular versions of DoubleCyclic *)
-
-Module DoubleCyclic (C:CyclicType) <: CyclicType.
- Definition t := zn2z C.t.
- Instance ops : ZnZ.Ops t := mk_zn2z_ops.
- Instance specs : ZnZ.Specs ops := mk_zn2z_specs.
-End DoubleCyclic.
-
-Module DoubleCyclicKaratsuba (C:CyclicType) <: CyclicType.
- Definition t := zn2z C.t.
- Definition ops : ZnZ.Ops t := mk_zn2z_ops_karatsuba.
- Definition specs : ZnZ.Specs ops := mk_zn2z_specs_karatsuba.
-End DoubleCyclicKaratsuba.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
deleted file mode 100644
index 09d7329b..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
+++ /dev/null
@@ -1,1494 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*         Benjamin Gregoire, Laurent Thery, INRIA, 2007                *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-Require Import DoubleDivn1.
-Require Import DoubleAdd.
-Require Import DoubleSub.
-
-Local Open Scope Z_scope.
-
-Ltac zarith := auto with zarith.
-
-
-Section POS_MOD.
-
- Variable w:Type.
- Variable w_0 : w.
- Variable w_digits : positive.
- Variable w_zdigits : w.
- Variable w_WW : w -> w -> zn2z w.
- Variable w_pos_mod : w -> w -> w.
- Variable w_compare : w -> w -> comparison.
- Variable ww_compare : zn2z w -> zn2z w -> comparison.
- Variable w_0W : w ->  zn2z w.
- Variable low: zn2z w -> w.
- Variable ww_sub: zn2z w -> zn2z w -> zn2z w.
- Variable ww_zdigits : zn2z w.
-
-
- Definition ww_pos_mod p x :=
-  let zdigits := w_0W w_zdigits in
-  match x with
-  | W0 => W0
-  | WW xh xl =>
-    match ww_compare p zdigits with
-    | Eq => w_WW w_0 xl
-    | Lt => w_WW w_0 (w_pos_mod (low p) xl)
-    | Gt =>
-      match ww_compare p ww_zdigits with
-      | Lt =>
-        let n := low (ww_sub p zdigits) in
-        w_WW (w_pos_mod n xh) xl
-      | _ => x
-      end
-    end
-  end.
-
-
-  Variable w_to_Z : w -> Z.
-
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-
-
-  Variable spec_w_0   : [|w_0|] = 0.
-
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-
-  Variable spec_to_w_Z  : forall x, 0 <= [[x]] < wwB.
-
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-
-  Variable spec_pos_mod : forall w p,
-       [|w_pos_mod p w|] = [|w|] mod (2 ^ [|p|]).
-
-  Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
-  Variable spec_ww_compare : forall x y,
-    ww_compare x y = Z.compare [[x]] [[y]].
- Variable spec_ww_sub: forall x y,
-   [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB.
-
- Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits.
- Variable spec_low: forall x, [| low x|] = [[x]] mod wB.
- Variable spec_ww_zdigits : [[ww_zdigits]] = 2 * [|w_zdigits|].
- Variable spec_ww_digits : ww_digits w_digits = xO w_digits.
-
-
-  Hint Rewrite spec_w_0 spec_w_WW : w_rewrite.
-
- Lemma spec_ww_pos_mod : forall w p,
-       [[ww_pos_mod p w]] = [[w]] mod (2 ^ [[p]]).
- assert (HHHHH:= lt_0_wB w_digits).
- assert (F0: forall x y, x - y + y = x); auto with zarith.
- intros w1 p; case (spec_to_w_Z p); intros HH1 HH2.
- unfold ww_pos_mod; case w1. reflexivity.
- intros xh xl; rewrite spec_ww_compare.
-    case Z.compare_spec;
-    rewrite spec_w_0W; rewrite spec_zdigits; fold wB;
-    intros H1.
-   rewrite H1; simpl ww_to_Z.
-   autorewrite with w_rewrite rm10.
-   rewrite Zplus_mod; auto with zarith.
-   rewrite Z_mod_mult; auto with zarith.
-   autorewrite with rm10.
-   rewrite Zmod_mod; auto with zarith.
-   rewrite Zmod_small; auto with zarith.
-   autorewrite with w_rewrite rm10.
-   simpl ww_to_Z.
-   rewrite spec_pos_mod.
-   assert (HH0: [|low p|] = [[p]]).
-     rewrite spec_low.
-     apply Zmod_small; auto with zarith.
-     case (spec_to_w_Z p); intros HHH1 HHH2; split; auto with zarith.
-     apply Z.lt_le_trans with (1 := H1).
-     unfold base; apply Zpower2_le_lin; auto with zarith.
-   rewrite HH0.
-   rewrite Zplus_mod; auto with zarith.
-   unfold base.
-   rewrite <- (F0 (Zpos w_digits) [[p]]).
-   rewrite Zpower_exp; auto with zarith.
-   rewrite Z.mul_assoc.
-   rewrite Z_mod_mult; auto with zarith.
-   autorewrite with w_rewrite rm10.
-   rewrite Zmod_mod; auto with zarith.
-  rewrite spec_ww_compare.
-    case Z.compare_spec; rewrite spec_ww_zdigits;
-                     rewrite spec_zdigits; intros H2.
-  replace (2^[[p]]) with wwB.
-    rewrite Zmod_small; auto with zarith.
-  unfold base; rewrite H2.
-  rewrite spec_ww_digits; auto.
-  assert (HH0: [|low (ww_sub p (w_0W w_zdigits))|] =
-         [[p]] - Zpos w_digits).
-    rewrite spec_low.
-    rewrite spec_ww_sub.
-    rewrite spec_w_0W; rewrite spec_zdigits.
-    rewrite <- Zmod_div_mod; auto with zarith.
-    rewrite Zmod_small; auto with zarith.
-    split; auto with zarith.
-    apply Z.lt_le_trans with (Zpos w_digits); auto with zarith.
-    unfold base; apply Zpower2_le_lin; auto with zarith.
-    exists wB; unfold base; rewrite <- Zpower_exp; auto with zarith.
-    rewrite spec_ww_digits;
-      apply f_equal with (f := Z.pow 2); rewrite Pos2Z.inj_xO; auto with zarith.
-   simpl ww_to_Z; autorewrite with w_rewrite.
-   rewrite spec_pos_mod; rewrite HH0.
-   pattern [|xh|] at 2;
-     rewrite Z_div_mod_eq with (b := 2 ^ ([[p]] - Zpos w_digits));
-     auto with zarith.
-   rewrite (fun x => (Z.mul_comm (2 ^ x))); rewrite Z.mul_add_distr_r.
-   unfold base; rewrite <- Z.mul_assoc; rewrite <- Zpower_exp;
-    auto with zarith.
-   rewrite F0; auto with zarith.
-   rewrite <- Z.add_assoc; rewrite Zplus_mod; auto with zarith.
-   rewrite Z_mod_mult; auto with zarith.
-   autorewrite with rm10.
-   rewrite Zmod_mod; auto with zarith.
-   symmetry; apply Zmod_small; auto with zarith.
-   case (spec_to_Z xh); intros U1 U2.
-   case (spec_to_Z xl); intros U3 U4.
-   split; auto with zarith.
-   apply Z.add_nonneg_nonneg; auto with zarith.
-   apply Z.mul_nonneg_nonneg; auto with zarith.
-   match goal with |- 0 <= ?X mod ?Y =>
-    case (Z_mod_lt X Y); auto with zarith
-   end.
-   match goal with |- ?X mod ?Y * ?U + ?Z < ?T =>
-    apply Z.le_lt_trans with ((Y - 1) * U + Z );
-     [case (Z_mod_lt X Y); auto with zarith | idtac]
-   end.
-   match goal with |- ?X * ?U + ?Y < ?Z =>
-    apply Z.le_lt_trans with (X * U + (U - 1))
-   end.
-   apply Z.add_le_mono_l; auto with zarith.
-   case (spec_to_Z xl); unfold base; auto with zarith.
-   rewrite Z.mul_sub_distr_r; rewrite <- Zpower_exp; auto with zarith.
-   rewrite F0; auto with zarith.
-  rewrite Zmod_small; auto with zarith.
-  case (spec_to_w_Z (WW xh xl)); intros U1 U2.
-  split; auto with zarith.
-  apply Z.lt_le_trans with (1:= U2).
-  unfold base; rewrite spec_ww_digits.
-  apply Zpower_le_monotone; auto with zarith.
-  split; auto with zarith.
-  rewrite Pos2Z.inj_xO; auto with zarith.
- Qed.
-
-End POS_MOD.
-
-Section DoubleDiv32.
-
- Variable w             : Type.
- Variable w_0           : w.
- Variable w_Bm1         : w.
- Variable w_Bm2         : w.
- Variable w_WW          : w -> w -> zn2z w.
- Variable w_compare     : w -> w -> comparison.
- Variable w_add_c       : w -> w -> carry w.
- Variable w_add_carry_c : w -> w -> carry w.
- Variable w_add         : w -> w -> w.
- Variable w_add_carry   : w -> w -> w.
- Variable w_pred        : w -> w.
- Variable w_sub         : w -> w -> w.
- Variable w_mul_c       : w -> w -> zn2z w.
- Variable w_div21       : w -> w -> w -> w*w.
- Variable ww_sub_c      : zn2z w -> zn2z w -> carry (zn2z w).
-
- Definition w_div32_body a1 a2 a3 b1 b2 :=
-  match w_compare a1 b1 with
-  | Lt =>
-    let (q,r) := w_div21 a1 a2 b1 in
-    match ww_sub_c (w_WW r a3) (w_mul_c q b2) with
-    | C0 r1 => (q,r1)
-    | C1 r1 =>
-      let q := w_pred q in
-      ww_add_c_cont w_WW w_add_c w_add_carry_c
-      (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2)))
-      (fun r2 => (q,r2))
-      r1 (WW b1 b2)
-    end
-  | Eq =>
-    ww_add_c_cont w_WW w_add_c w_add_carry_c
-    (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2)))
-    (fun r => (w_Bm1,r))
-    (WW (w_sub a2 b2) a3) (WW b1 b2)
-  | Gt => (w_0, W0) (* cas absurde *)
-  end.
-
- Definition w_div32 a1 a2 a3 b1 b2 :=
-  Eval lazy beta iota delta [ww_add_c_cont ww_add w_div32_body] in
-     w_div32_body a1 a2 a3 b1 b2.
-
- (* Proof *)
-
-  Variable w_digits      : positive.
-  Variable w_to_Z : w -> Z.
-
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[+| c |]" :=
-   (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
-  Notation "[-| c |]" :=
-   (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
-
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-  Notation "[-[ c ]]" :=
-   (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_w_Bm1   : [|w_Bm1|] = wB - 1.
-  Variable spec_w_Bm2   : [|w_Bm2|] = wB - 2.
-
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-  Variable spec_compare :
-     forall x y, w_compare x y = Z.compare [|x|] [|y|].
-  Variable spec_w_add_c  : forall x y, [+|w_add_c x y|] = [|x|] + [|y|].
-  Variable spec_w_add_carry_c :
-         forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1.
-
-  Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB.
-  Variable spec_w_add_carry :
-	 forall x y, [|w_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB.
-
-  Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB.
-  Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
-
-  Variable spec_mul_c : forall x y, [[ w_mul_c x y ]] = [|x|] * [|y|].
-  Variable spec_div21 : forall a1 a2 b,
-      wB/2 <= [|b|] ->
-      [|a1|] < [|b|] ->
-      let (q,r) := w_div21 a1 a2 b in
-      [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
-      0 <= [|r|] < [|b|].
-
-  Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]].
-
-  Ltac Spec_w_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_to_Z x).
-  Ltac Spec_ww_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x).
-
-  Theorem wB_div2: forall x, wB/2  <= x -> wB <= 2 * x.
-   intros x H; rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith.
-  Qed.
-
-  Lemma Zmult_lt_0_reg_r_2 : forall n m : Z, 0 <= n -> 0 < m * n -> 0 < m.
-  Proof.
-   intros n m H1 H2;apply Z.mul_pos_cancel_r with n;trivial.
-   Z.le_elim H1; trivial.
-   subst;rewrite Z.mul_0_r in H2;discriminate H2.
-  Qed.
-
-  Theorem spec_w_div32 : forall a1 a2 a3 b1 b2,
-     wB/2 <= [|b1|] ->
-     [[WW a1 a2]] < [[WW b1 b2]] ->
-     let (q,r) := w_div32 a1 a2 a3 b1 b2 in
-     [|a1|] * wwB + [|a2|] * wB  + [|a3|] =
-        [|q|] *  ([|b1|] * wB + [|b2|])  + [[r]] /\
-     0 <= [[r]] < [|b1|] * wB + [|b2|].
-  Proof.
-   intros a1 a2 a3 b1 b2 Hle Hlt.
-   assert (U:= lt_0_wB w_digits); assert (U1:= lt_0_wwB w_digits).
-   Spec_w_to_Z a1;Spec_w_to_Z a2;Spec_w_to_Z a3;Spec_w_to_Z b1;Spec_w_to_Z b2.
-   rewrite wwB_wBwB; rewrite Z.pow_2_r; rewrite Z.mul_assoc;rewrite <- Z.mul_add_distr_r.
-   change (w_div32 a1 a2 a3 b1 b2) with (w_div32_body a1 a2 a3 b1 b2).
-   unfold w_div32_body.
-   rewrite spec_compare. case Z.compare_spec; intro Hcmp.
-   simpl in Hlt.
-   rewrite Hcmp in Hlt;assert ([|a2|] < [|b2|]). omega.
-   assert ([[WW (w_sub a2 b2) a3]] = ([|a2|]-[|b2|])*wB + [|a3|] + wwB).
-    simpl;rewrite spec_sub.
-    assert ([|a2|] - [|b2|] = wB*(-1) + ([|a2|] - [|b2|] + wB)). ring.
-    assert (0 <= [|a2|] - [|b2|] + wB < wB). omega.
-    rewrite <-(Zmod_unique ([|a2|]-[|b2|]) wB (-1) ([|a2|]-[|b2|]+wB) H1 H0).
-    rewrite wwB_wBwB;ring.
-   assert (U2 := wB_pos w_digits).
-   eapply spec_ww_add_c_cont with (P :=
-     fun (x y:zn2z w) (res:w*zn2z w) =>
-     let (q, r) := res in
-     ([|a1|] * wB + [|a2|]) * wB + [|a3|] =
-     [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\
-     0 <= [[r]] < [|b1|] * wB + [|b2|]);eauto.
-   rewrite H0;intros r.
-   repeat
-    (rewrite spec_ww_add;eauto || rewrite spec_w_Bm1 || rewrite spec_w_Bm2);
-   simpl ww_to_Z;try rewrite Z.mul_1_l;intros H1.
-   assert (0<= ([[r]] + ([|b1|] * wB + [|b2|])) - wwB < [|b1|] * wB + [|b2|]).
-   Spec_ww_to_Z r;split;zarith.
-   rewrite H1.
-   assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB).
-   rewrite wwB_wBwB; rewrite Z.pow_2_r; zarith.
-   assert (-wwB < ([|a2|] - [|b2|]) * wB + [|a3|] < 0).
-   split. apply Z.lt_le_trans with (([|a2|] - [|b2|]) * wB);zarith.
-   rewrite wwB_wBwB;replace (-(wB^2)) with (-wB*wB);[zarith | ring].
-   apply Z.mul_lt_mono_pos_r;zarith.
-   apply Z.le_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith.
-   replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with
-     (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith | ring].
-   assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith.
-   replace 0 with (0*wB);zarith.
-   replace (([|a2|] - [|b2|]) * wB + [|a3|] + wwB + ([|b1|] * wB + [|b2|]) +
-              ([|b1|] * wB + [|b2|]) - wwB) with
-         (([|a2|] - [|b2|]) * wB + [|a3|] + 2*[|b1|] * wB + 2*[|b2|]);
-   [zarith | ring].
-   rewrite <- (Zmod_unique ([[r]] + ([|b1|] * wB + [|b2|])) wwB
-             1 ([[r]] + ([|b1|] * wB + [|b2|]) - wwB));zarith;try (ring;fail).
-   split. rewrite H1;rewrite Hcmp;ring. trivial.
-   Spec_ww_to_Z (WW b1 b2). simpl in HH4;zarith.
-   rewrite H0;intros r;repeat
-    (rewrite spec_w_Bm1 || rewrite spec_w_Bm2);
-   simpl ww_to_Z;try rewrite Z.mul_1_l;intros H1.
-   assert ([[r]]=([|a2|]-[|b2|])*wB+[|a3|]+([|b1|]*wB+[|b2|])). zarith.
-   split. rewrite H2;rewrite Hcmp;ring.
-   split. Spec_ww_to_Z r;zarith.
-   rewrite H2.
-   assert (([|a2|] - [|b2|]) * wB + [|a3|] < 0);zarith.
-   apply Z.le_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith.
-   replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with
-     (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith|ring].
-   assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith.
-   replace 0 with (0*wB);zarith.
-   (* Cas Lt *)
-   assert (Hdiv21 := spec_div21 a2 Hle Hcmp);
-    destruct (w_div21 a1 a2 b1) as (q, r);destruct Hdiv21.
-   rewrite H.
-   assert (Hq := spec_to_Z q).
-   generalize
-    (spec_ww_sub_c (w_WW r a3) (w_mul_c q b2));
-    destruct (ww_sub_c (w_WW r a3) (w_mul_c q b2))
-    as [r1|r1];repeat (rewrite spec_w_WW || rewrite spec_mul_c);
-    unfold interp_carry;intros H1.
-    rewrite H1.
-   split. ring. split.
-   rewrite <- H1;destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z r1);trivial.
-   apply Z.le_lt_trans with ([|r|] * wB + [|a3|]).
-   assert ( 0 <= [|q|] * [|b2|]);zarith.
-   apply beta_lex_inv;zarith.
-   assert ([[r1]] = [|r|] * wB + [|a3|] - [|q|] * [|b2|] + wwB).
-   rewrite <- H1;ring.
-   Spec_ww_to_Z r1; assert (0 <= [|r|]*wB). zarith.
-   assert (0 < [|q|] * [|b2|]). zarith.
-   assert (0 < [|q|]).
-    apply Zmult_lt_0_reg_r_2 with [|b2|];zarith.
-   eapply spec_ww_add_c_cont with (P :=
-     fun (x y:zn2z w) (res:w*zn2z w) =>
-     let (q0, r0) := res in
-      ([|q|] * [|b1|] + [|r|]) * wB + [|a3|] =
-      [|q0|] * ([|b1|] * wB + [|b2|]) + [[r0]] /\
-      0 <= [[r0]] < [|b1|] * wB + [|b2|]);eauto.
-   intros r2;repeat (rewrite spec_pred || rewrite spec_ww_add;eauto);
-   simpl ww_to_Z;intros H7.
-   assert (0 < [|q|] - 1).
-   assert (H6 : 1 <= [|q|]) by zarith.
-   Z.le_elim H6;zarith.
-   rewrite <- H6 in H2;rewrite H2 in H7.
-   assert (0 < [|b1|]*wB). apply Z.mul_pos_pos;zarith.
-   Spec_ww_to_Z r2. zarith.
-   rewrite (Zmod_small ([|q|] -1));zarith.
-   rewrite (Zmod_small ([|q|] -1 -1));zarith.
-   assert ([[r2]] + ([|b1|] * wB + [|b2|]) =
-       wwB * 1 +
-       ([|r|] * wB + [|a3|] - [|q|] * [|b2|] + 2 * ([|b1|] * wB + [|b2|]))).
-   rewrite H7;rewrite H2;ring.
-   assert
-    ([|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|])
-        < [|b1|]*wB + [|b2|]).
-   Spec_ww_to_Z r2;omega.
-   Spec_ww_to_Z (WW b1 b2). simpl in HH5.
-   assert
-    (0 <= [|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|])
-       < wwB). split;try omega.
-   replace (2*([|b1|]*wB+[|b2|])) with ((2*[|b1|])*wB+2*[|b2|]). 2:ring.
-   assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB).
-   rewrite wwB_wBwB; rewrite Z.pow_2_r; zarith. omega.
-   rewrite <- (Zmod_unique
-            ([[r2]] + ([|b1|] * wB + [|b2|]))
-            wwB
-            1
-            ([|r|] * wB + [|a3|] - [|q|] * [|b2|] + 2*([|b1|] * wB + [|b2|]))
-            H10 H8).
-   split. ring. zarith.
-   intros r2;repeat (rewrite spec_pred);simpl ww_to_Z;intros H7.
-   rewrite (Zmod_small ([|q|] -1));zarith.
-   split.
-   replace [[r2]] with  ([[r1]] + ([|b1|] * wB + [|b2|]) -wwB).
-   rewrite H2; ring. rewrite <- H7; ring.
-   Spec_ww_to_Z r2;Spec_ww_to_Z r1. omega.
-   simpl in Hlt.
-   assert ([|a1|] * wB + [|a2|] <= [|b1|] * wB + [|b2|]). zarith.
-   assert (H1 := beta_lex _ _ _ _ _ H HH0 HH3). rewrite spec_w_0;simpl;zarith.
-  Qed.
-
-
-End DoubleDiv32.
-
-Section DoubleDiv21.
- Variable w : Type.
- Variable w_0 : w.
-
- Variable w_0W : w -> zn2z w.
- Variable w_div32 : w -> w -> w -> w -> w -> w * zn2z w.
-
- Variable ww_1 : zn2z w.
- Variable ww_compare : zn2z w -> zn2z w -> comparison.
- Variable ww_sub : zn2z w -> zn2z w -> zn2z w.
-
-
- Definition ww_div21 a1 a2 b :=
-  match a1 with
-  | W0 =>
-    match ww_compare a2 b with
-    | Gt => (ww_1, ww_sub a2 b)
-    | Eq => (ww_1, W0)
-    | Lt => (W0, a2)
-    end
-  | WW a1h a1l =>
-    match a2 with
-    | W0 =>
-      match b with
-      | W0 => (W0,W0) (* cas absurde *)
-      | WW b1 b2 =>
-        let (q1, r)  := w_div32 a1h a1l w_0 b1 b2 in
-        match r with
-        | W0 => (WW q1 w_0, W0)
-        | WW r1 r2 =>
-	  let (q2, s)  := w_div32 r1 r2 w_0 b1 b2 in
-          (WW q1 q2, s)
-        end
-      end
-    | WW a2h a2l =>
-      match b with
-      | W0 => (W0,W0) (* cas absurde *)
-      | WW b1 b2 =>
-        let (q1, r)  := w_div32 a1h a1l a2h b1 b2 in
-        match r with
-        | W0 => (WW q1 w_0, w_0W a2l)
-        | WW r1 r2 =>
-	  let (q2, s)  := w_div32 r1 r2 a2l b1 b2 in
-          (WW q1 q2, s)
-        end
-      end
-    end
-  end.
-
- (* Proof *)
-
-  Variable w_digits : positive.
-  Variable w_to_Z : w -> Z.
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-  Notation "[-[ c ]]" :=
-   (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
-  Variable spec_w_div32 : forall a1 a2 a3 b1 b2,
-     wB/2 <= [|b1|] ->
-     [[WW a1 a2]] < [[WW b1 b2]] ->
-     let (q,r) := w_div32 a1 a2 a3 b1 b2 in
-     [|a1|] * wwB + [|a2|] * wB  + [|a3|] =
-        [|q|] *  ([|b1|] * wB + [|b2|])  + [[r]] /\
-     0 <= [[r]] < [|b1|] * wB + [|b2|].
-  Variable spec_ww_1 : [[ww_1]] = 1.
-  Variable spec_ww_compare :  forall x y,
-    ww_compare x y = Z.compare [[x]] [[y]].
-  Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB.
-
-  Theorem wwB_div: wwB  = 2 * (wwB / 2).
-  Proof.
-   rewrite wwB_div_2; rewrite  Z.mul_assoc; rewrite  wB_div_2; auto.
-   rewrite <- Z.pow_2_r; apply wwB_wBwB.
-  Qed.
-
-  Ltac Spec_w_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_to_Z x).
-  Ltac Spec_ww_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x).
-
-  Theorem   spec_ww_div21 : forall a1 a2 b,
-     wwB/2 <= [[b]] ->
-     [[a1]] < [[b]] ->
-     let (q,r) := ww_div21 a1 a2 b in
-     [[a1]] *wwB+[[a2]] = [[q]] *  [[b]] + [[r]] /\ 0 <= [[r]] < [[b]].
-  Proof.
-   assert (U:= lt_0_wB w_digits).
-   assert (U1:= lt_0_wwB w_digits).
-   intros a1 a2 b H Hlt; unfold ww_div21.
-   Spec_ww_to_Z b; assert (Eq: 0 < [[b]]).    Spec_ww_to_Z a1;omega.
-   generalize Hlt H ;clear Hlt H;case a1.
-   intros H1 H2;simpl in H1;Spec_ww_to_Z a2.
-   rewrite spec_ww_compare. case Z.compare_spec;
-   simpl;try rewrite spec_ww_1;autorewrite with rm10; intros;zarith.
-   rewrite spec_ww_sub;simpl. rewrite Zmod_small;zarith.
-   split. ring.
-   assert (wwB <= 2*[[b]]);zarith.
-   rewrite wwB_div;zarith.
-   intros a1h a1l.  Spec_w_to_Z a1h;Spec_w_to_Z a1l. Spec_ww_to_Z a2.
-   destruct a2 as [ |a3 a4];
-    (destruct b as [ |b1 b2];[unfold Z.le in Eq;discriminate Eq|idtac]);
-   try (Spec_w_to_Z a3; Spec_w_to_Z a4); Spec_w_to_Z b1; Spec_w_to_Z b2;
-   intros Hlt H;  match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] =>
-     generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U);
-     intros q1 r H0
-   end; (assert (Eq1: wB / 2 <= [|b1|]);[
-    apply (@beta_lex (wB / 2) 0 [|b1|] [|b2|] wB); auto with zarith;
-    autorewrite with rm10;repeat rewrite (Z.mul_comm wB);
-    rewrite <- wwB_div_2; trivial
-   | generalize (H0 Eq1 Hlt);clear H0;destruct r as [ |r1 r2];simpl;
-     try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Z.add_0_r;
-     intros (H1,H2) ]).
-   split;[rewrite wwB_wBwB; rewrite Z.pow_2_r | trivial].
-   rewrite Z.mul_assoc;rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc;
-   rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB;rewrite H1;ring.
-   destruct H2 as (H2,H3);match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] =>
-     generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U);
-     intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end.
-   split;[rewrite wwB_wBwB | trivial].
-   rewrite Z.pow_2_r.
-   rewrite Z.mul_assoc;rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc;
-   rewrite <- Z.pow_2_r.
-   rewrite <- wwB_wBwB;rewrite H1.
-   rewrite spec_w_0 in H4;rewrite Z.add_0_r in H4.
-   repeat rewrite Z.mul_add_distr_r. rewrite <- (Z.mul_assoc [|r1|]).
-   rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB;rewrite H4;simpl;ring.
-   split;[rewrite wwB_wBwB | split;zarith].
-   replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|]))
-   with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]).
-   rewrite H1;ring. rewrite wwB_wBwB;ring.
-   change [|a4|] with (0*wB+[|a4|]);apply beta_lex_inv;zarith.
-   assert (1 <= wB/2);zarith.
-    assert (H_:= wB_pos w_digits);apply Zdiv_le_lower_bound;zarith.
-   destruct H2 as (H2,H3);match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] =>
-     generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U);
-     intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end.
-   split;trivial.
-   replace (([|a1h|] * wB + [|a1l|]) * wwB + ([|a3|] * wB + [|a4|])) with
-   (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB + [|a4|]);
-   [rewrite H1 | rewrite wwB_wBwB;ring].
-   replace (([|q1|]*([|b1|]*wB+[|b2|])+([|r1|]*wB+[|r2|]))*wB+[|a4|]) with
-   (([|q1|]*([|b1|]*wB+[|b2|]))*wB+([|r1|]*wwB+[|r2|]*wB+[|a4|]));
-   [rewrite H4;simpl|rewrite wwB_wBwB];ring.
-  Qed.
-
-End DoubleDiv21.
-
-Section DoubleDivGt.
- Variable w : Type.
- Variable w_digits : positive.
- Variable w_0 : w.
-
- Variable w_WW : w -> w -> zn2z w.
- Variable w_0W : w -> zn2z w.
- Variable w_compare : w -> w -> comparison.
- Variable w_eq0 : w -> bool.
- Variable w_opp_c : w -> carry w.
- Variable w_opp w_opp_carry : w -> w.
- Variable w_sub_c : w -> w -> carry w.
- Variable w_sub w_sub_carry : w -> w -> w.
-
- Variable w_div_gt : w -> w -> w*w.
- Variable w_mod_gt : w -> w -> w.
- Variable w_gcd_gt : w -> w -> w.
- Variable w_add_mul_div : w -> w -> w -> w.
- Variable w_head0 : w -> w.
- Variable w_div21 : w -> w -> w -> w * w.
- Variable w_div32 : w -> w -> w -> w -> w -> w * zn2z w.
-
-
- Variable _ww_zdigits : zn2z w.
- Variable ww_1 : zn2z w.
- Variable ww_add_mul_div : zn2z w -> zn2z w -> zn2z w -> zn2z w.
-
- Variable w_zdigits : w.
-
- Definition ww_div_gt_aux ah al bh bl :=
-  Eval lazy beta iota delta [ww_sub ww_opp] in
-    let p := w_head0 bh in
-    match w_compare p w_0 with
-    | Gt =>
-      let b1 := w_add_mul_div p bh bl in
-      let b2 := w_add_mul_div p bl w_0 in
-      let a1 := w_add_mul_div p w_0 ah in
-      let a2 := w_add_mul_div p ah al in
-      let a3 := w_add_mul_div p al w_0 in
-      let (q,r) := w_div32 a1 a2 a3 b1 b2 in
-      (WW w_0 q, ww_add_mul_div
-        (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c
-            w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r)
-    | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c
-            w_opp w_sub w_sub_carry (WW ah al) (WW bh bl))
-    end.
-
- Definition ww_div_gt a b :=
-  Eval lazy beta iota delta [ww_div_gt_aux double_divn1
-  double_divn1_p double_divn1_p_aux double_divn1_0 double_divn1_0_aux
-  double_split double_0 double_WW] in
-  match a, b with
-  | W0, _ => (W0,W0)
-  | _, W0 => (W0,W0)
-  | WW ah al, WW bh bl =>
-    if w_eq0 ah then
-     let (q,r) := w_div_gt al bl in
-     (WW w_0 q, w_0W r)
-    else
-     match w_compare w_0 bh with
-     | Eq =>
-       let(q,r):=
-        double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21
-                  w_compare w_sub 1 a bl in
-       (q, w_0W r)
-     | Lt => ww_div_gt_aux ah al bh bl
-     | Gt => (W0,W0) (* cas absurde *)
-     end
-  end.
-
- Definition ww_mod_gt_aux ah al bh bl :=
-  Eval lazy beta iota delta [ww_sub ww_opp] in
-    let p := w_head0 bh in
-    match w_compare p w_0 with
-    | Gt =>
-      let b1 := w_add_mul_div p bh bl in
-      let b2 := w_add_mul_div p bl w_0 in
-      let a1 := w_add_mul_div p w_0 ah in
-      let a2 := w_add_mul_div p ah al in
-      let a3 := w_add_mul_div p al w_0 in
-      let (q,r) := w_div32 a1 a2 a3 b1 b2 in
-      ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c
-         w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r
-    | _ =>
-      ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c
-         w_opp w_sub w_sub_carry (WW ah al) (WW bh bl)
-    end.
-
- Definition ww_mod_gt a b :=
-  Eval lazy beta iota delta [ww_mod_gt_aux double_modn1
-  double_modn1_p double_modn1_p_aux double_modn1_0 double_modn1_0_aux
-  double_split double_0 double_WW snd] in
-  match a, b with
-  | W0, _ => W0
-  | _, W0 => W0
-  | WW ah al, WW bh bl =>
-    if w_eq0 ah then w_0W (w_mod_gt al bl)
-    else
-     match w_compare w_0 bh with
-     | Eq =>
-       w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21
-             w_compare w_sub 1 a bl)
-     | Lt => ww_mod_gt_aux ah al bh bl
-     | Gt => W0 (* cas absurde *)
-     end
-  end.
-
-  Definition ww_gcd_gt_body (cont: w->w->w->w->zn2z w) (ah al bh bl: w) :=
-   Eval lazy beta iota delta [ww_mod_gt_aux double_modn1
-   double_modn1_p double_modn1_p_aux double_modn1_0 double_modn1_0_aux
-   double_split double_0 double_WW snd] in
-    match w_compare w_0 bh with
-    | Eq =>
-      match w_compare w_0 bl with
-      | Eq => WW ah al (* normalement n'arrive pas si forme normale *)
-      | Lt =>
-	let m := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21
-                   w_compare w_sub 1 (WW ah al) bl in
-        WW w_0 (w_gcd_gt bl m)
-      | Gt => W0 (* absurde *)
-      end
-    | Lt =>
-      let m := ww_mod_gt_aux ah al bh bl in
-      match m with
-      | W0 => WW bh bl
-      | WW mh ml =>
-        match w_compare w_0 mh with
-        | Eq =>
-          match w_compare w_0 ml with
-          | Eq => WW bh bl
-          | _  =>
-            let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21
-                      w_compare w_sub 1 (WW bh bl) ml in
-            WW w_0 (w_gcd_gt ml r)
-          end
-        | Lt =>
-          let r := ww_mod_gt_aux bh bl mh ml in
-          match r with
-          | W0 => m
-          | WW rh rl => cont mh ml rh rl
-          end
-        | Gt => W0 (* absurde *)
-        end
-      end
-    | Gt => W0 (* absurde *)
-    end.
-
-  Fixpoint ww_gcd_gt_aux
-     (p:positive) (cont: w -> w -> w -> w -> zn2z w) (ah al bh bl : w)
-        {struct p} : zn2z w :=
-    ww_gcd_gt_body
-       (fun mh ml rh rl => match p with
-        | xH => cont mh ml rh rl
-        | xO p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl
-        | xI p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl
-        end) ah al bh bl.
-
-
-  (* Proof *)
-
-  Variable w_to_Z : w -> Z.
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[-| c |]" :=
-   (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
-
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_to_w_Z  : forall x, 0 <= [[x]] < wwB.
-
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-  Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
-  Variable spec_compare :
-     forall x y, w_compare x y = Z.compare [|x|] [|y|].
-  Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0.
-
-  Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|].
-  Variable spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB.
-  Variable spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1.
-
-  Variable spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|].
-  Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
-  Variable spec_sub_carry :
-	 forall x y, [|w_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB.
-
-  Variable spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
-      let (q,r) := w_div_gt a b in
-      [|a|] = [|q|] * [|b|] + [|r|] /\
-      0 <= [|r|] < [|b|].
-  Variable spec_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
-      [|w_mod_gt a b|] = [|a|] mod [|b|].
-  Variable spec_gcd_gt : forall a b, [|a|] > [|b|] ->
-      Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|].
-
-  Variable spec_add_mul_div : forall x y p,
-       [|p|] <= Zpos w_digits ->
-       [| w_add_mul_div p x y |] =
-         ([|x|] * (2 ^ ([|p|])) +
-          [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB.
-  Variable spec_head0  : forall x,  0 < [|x|] ->
-	 wB/ 2 <= 2 ^ [|w_head0 x|] * [|x|] < wB.
-
-  Variable spec_div21 : forall a1 a2 b,
-      wB/2 <= [|b|] ->
-      [|a1|] < [|b|] ->
-      let (q,r) := w_div21 a1 a2 b in
-      [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
-      0 <= [|r|] < [|b|].
-
-  Variable spec_w_div32 : forall a1 a2 a3 b1 b2,
-     wB/2 <= [|b1|] ->
-     [[WW a1 a2]] < [[WW b1 b2]] ->
-     let (q,r) := w_div32 a1 a2 a3 b1 b2 in
-     [|a1|] * wwB + [|a2|] * wB  + [|a3|] =
-        [|q|] *  ([|b1|] * wB + [|b2|])  + [[r]] /\
-     0 <= [[r]] < [|b1|] * wB + [|b2|].
-
-  Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits.
-
-  Variable spec_ww_digits_ : [[_ww_zdigits]] = Zpos (xO w_digits).
-  Variable spec_ww_1 : [[ww_1]] = 1.
-  Variable spec_ww_add_mul_div : forall x y p,
-       [[p]] <= Zpos (xO w_digits) ->
-       [[ ww_add_mul_div p x y ]] =
-         ([[x]] * (2^[[p]]) +
-          [[y]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB.
-
-  Ltac Spec_w_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_to_Z x).
-
-  Ltac Spec_ww_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x).
-
-  Lemma to_Z_div_minus_p : forall x p,
-   0 < [|p|] < Zpos w_digits  ->
-   0 <= [|x|] / 2 ^ (Zpos w_digits - [|p|]) < 2 ^ [|p|].
-  Proof.
-   intros x p H;Spec_w_to_Z x.
-   split. apply Zdiv_le_lower_bound;zarith.
-   apply Zdiv_lt_upper_bound;zarith.
-   rewrite <- Zpower_exp;zarith.
-   ring_simplify ([|p|] + (Zpos w_digits - [|p|])); unfold base in HH;zarith.
-  Qed.
-  Hint Resolve to_Z_div_minus_p : zarith.
-
-  Lemma spec_ww_div_gt_aux : forall ah al bh bl,
-      [[WW ah al]] > [[WW bh bl]] ->
-      0 < [|bh|] ->
-      let (q,r) := ww_div_gt_aux ah al bh bl in
-      [[WW ah al]] = [[q]] * [[WW bh bl]] + [[r]] /\
-      0 <= [[r]] < [[WW bh bl]].
-  Proof.
-   intros ah al bh bl Hgt Hpos;unfold ww_div_gt_aux.
-   change
-   (let (q, r) := let p := w_head0 bh in
-    match w_compare p w_0 with
-    | Gt =>
-      let b1 := w_add_mul_div p bh bl in
-      let b2 := w_add_mul_div p bl w_0 in
-      let a1 := w_add_mul_div p w_0 ah in
-      let a2 := w_add_mul_div p ah al in
-      let a3 := w_add_mul_div p al w_0 in
-      let (q,r) := w_div32 a1 a2 a3 b1 b2 in
-      (WW w_0 q, ww_add_mul_div
-        (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c
-            w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r)
-    | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c
-            w_opp w_sub w_sub_carry (WW ah al) (WW bh bl))
-    end in [[WW ah al]]=[[q]]*[[WW bh bl]]+[[r]] /\ 0 <=[[r]]< [[WW bh bl]]).
-   assert (Hh := spec_head0 Hpos).
-   lazy zeta.
-   rewrite spec_compare; case Z.compare_spec;
-    rewrite spec_w_0; intros HH.
-   generalize Hh; rewrite HH; simpl Z.pow;
-        rewrite Z.mul_1_l; intros (HH1, HH2); clear HH.
-   assert (wwB <= 2*[[WW bh bl]]).
-    apply Z.le_trans with (2*[|bh|]*wB).
-    rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_le_mono_nonneg_r; zarith.
-    rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; zarith.
-    simpl ww_to_Z;rewrite Z.mul_add_distr_l;rewrite Z.mul_assoc.
-    Spec_w_to_Z bl;zarith.
-   Spec_ww_to_Z (WW ah al).
-   rewrite spec_ww_sub;eauto.
-   simpl;rewrite spec_ww_1;rewrite Z.mul_1_l;simpl.
-   simpl ww_to_Z in Hgt, H, HH;rewrite Zmod_small;split;zarith.
-   case (spec_to_Z (w_head0 bh)); auto with zarith.
-   assert ([|w_head0 bh|] < Zpos w_digits).
-    destruct (Z_lt_ge_dec [|w_head0 bh|]  (Zpos w_digits));trivial.
-    exfalso.
-    assert (2 ^ [|w_head0 bh|] * [|bh|] >= wB);auto with zarith.
-    apply Z.le_ge; replace wB with (wB * 1);try ring.
-    Spec_w_to_Z bh;apply Z.mul_le_mono_nonneg;zarith.
-    unfold base;apply Zpower_le_monotone;zarith.
-   assert (HHHH : 0 < [|w_head0 bh|] < Zpos w_digits); auto with zarith.
-   assert (Hb:= Z.lt_le_incl _ _ H).
-   generalize (spec_add_mul_div w_0 ah Hb)
-    (spec_add_mul_div ah al Hb)
-    (spec_add_mul_div al w_0 Hb)
-    (spec_add_mul_div bh bl Hb)
-    (spec_add_mul_div bl w_0  Hb);
-   rewrite spec_w_0; repeat rewrite Z.mul_0_l;repeat rewrite Z.add_0_l;
-   rewrite Zdiv_0_l;repeat rewrite Z.add_0_r.
-   Spec_w_to_Z ah;Spec_w_to_Z bh.
-   unfold base;repeat rewrite Zmod_shift_r;zarith.
-   assert (H3:=to_Z_div_minus_p ah HHHH);assert(H4:=to_Z_div_minus_p al HHHH);
-   assert (H5:=to_Z_div_minus_p bl HHHH).
-   rewrite Z.mul_comm in Hh.
-   assert (2^[|w_head0 bh|] < wB). unfold base;apply Zpower_lt_monotone;zarith.
-   unfold base in H0;rewrite Zmod_small;zarith.
-   fold wB; rewrite (Zmod_small ([|bh|] * 2 ^ [|w_head0 bh|]));zarith.
-   intros U1 U2 U3 V1 V2.
-   generalize (@spec_w_div32 (w_add_mul_div (w_head0 bh) w_0 ah)
-               (w_add_mul_div (w_head0 bh) ah al)
-               (w_add_mul_div (w_head0 bh) al w_0)
-               (w_add_mul_div (w_head0 bh) bh bl)
-               (w_add_mul_div (w_head0 bh) bl w_0)).
-   destruct (w_div32 (w_add_mul_div (w_head0 bh) w_0 ah)
-              (w_add_mul_div (w_head0 bh) ah al)
-              (w_add_mul_div (w_head0 bh) al w_0)
-              (w_add_mul_div (w_head0 bh) bh bl)
-              (w_add_mul_div (w_head0 bh) bl w_0)) as (q,r).
-   rewrite V1;rewrite V2. rewrite Z.mul_add_distr_r.
-   rewrite <- (Z.add_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)).
-   unfold base;rewrite <- shift_unshift_mod;zarith. fold wB.
-   replace ([|bh|] * 2 ^ [|w_head0 bh|] * wB + [|bl|] * 2 ^ [|w_head0 bh|]) with
-    ([[WW bh bl]] * 2^[|w_head0 bh|]). 2:simpl;ring.
-   fold wwB. rewrite wwB_wBwB. rewrite Z.pow_2_r. rewrite U1;rewrite U2;rewrite U3.
-   rewrite Z.mul_assoc. rewrite Z.mul_add_distr_r.
-   rewrite (Z.add_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)).
-   rewrite <- Z.mul_add_distr_r.  rewrite <- Z.add_assoc.
-   unfold base;repeat rewrite <- shift_unshift_mod;zarith. fold wB.
-   replace ([|ah|] * 2 ^ [|w_head0 bh|] * wB + [|al|] * 2 ^ [|w_head0 bh|]) with
-    ([[WW ah al]] * 2^[|w_head0 bh|]). 2:simpl;ring.
-   intros Hd;destruct Hd;zarith.
-   simpl. apply beta_lex_inv;zarith. rewrite U1;rewrite V1.
-   assert ([|ah|] / 2 ^ (Zpos (w_digits) - [|w_head0 bh|]) < wB/2);zarith.
-   apply Zdiv_lt_upper_bound;zarith.
-   unfold base.
-   replace (2^Zpos (w_digits)) with (2^(Zpos (w_digits) - 1)*2).
-   rewrite Z_div_mult;zarith.  rewrite <- Zpower_exp;zarith.
-   apply Z.lt_le_trans with wB;zarith.
-   unfold base;apply Zpower_le_monotone;zarith.
-   pattern 2 at 2;replace 2 with (2^1);trivial.
-   rewrite <- Zpower_exp;zarith. ring_simplify (Zpos (w_digits) - 1 + 1);trivial.
-   change [[WW w_0 q]] with ([|w_0|]*wB+[|q|]);rewrite spec_w_0;rewrite
-   Z.mul_0_l;rewrite Z.add_0_l.
-   replace [[ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry
-       _ww_zdigits (w_0W (w_head0 bh))) W0 r]] with ([[r]]/2^[|w_head0 bh|]).
-   assert (0 < 2^[|w_head0 bh|]). apply Z.pow_pos_nonneg;zarith.
-   split.
-   rewrite <- (Z_div_mult [[WW ah al]] (2^[|w_head0 bh|]));zarith.
-   rewrite H1;rewrite Z.mul_assoc;apply Z_div_plus_l;trivial.
-   split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith.
-   rewrite spec_ww_add_mul_div.
-   rewrite spec_ww_sub; auto with zarith.
-   rewrite spec_ww_digits_.
-   change (Zpos (xO (w_digits))) with (2*Zpos (w_digits));zarith.
-   simpl ww_to_Z;rewrite Z.mul_0_l;rewrite Z.add_0_l.
-   rewrite spec_w_0W.
-   rewrite (fun x y => Zmod_small (x-y)); auto with zarith.
-   ring_simplify (2 * Zpos w_digits - (2 * Zpos w_digits - [|w_head0 bh|])).
-   rewrite Zmod_small;zarith.
-   split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith.
-   Spec_ww_to_Z r.
-   apply Z.lt_le_trans with wwB;zarith.
-   rewrite <- (Z.mul_1_r wwB);apply Z.mul_le_mono_nonneg;zarith.
-   split; auto with zarith.
-   apply Z.le_lt_trans with (2 * Zpos w_digits); auto with zarith.
-   unfold base, ww_digits; rewrite (Pos2Z.inj_xO w_digits).
-   apply Zpower2_lt_lin; auto with zarith.
-   rewrite spec_ww_sub; auto with zarith.
-   rewrite spec_ww_digits_; rewrite spec_w_0W.
-   rewrite Zmod_small;zarith.
-   rewrite Pos2Z.inj_xO; split; auto with zarith.
-   apply Z.le_lt_trans with (2 * Zpos w_digits); auto with zarith.
-   unfold base, ww_digits; rewrite (Pos2Z.inj_xO w_digits).
-   apply Zpower2_lt_lin; auto with zarith.
-   Qed.
-
-  Lemma spec_ww_div_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] ->
-      let (q,r) := ww_div_gt a b in
-      [[a]] = [[q]] * [[b]] + [[r]] /\
-      0 <= [[r]] < [[b]].
-  Proof.
-   intros a b Hgt Hpos;unfold ww_div_gt.
-   change (let (q,r) :=   match a, b with
-  | W0, _ => (W0,W0)
-  | _, W0 => (W0,W0)
-  | WW ah al, WW bh bl =>
-    if w_eq0 ah then
-     let (q,r) := w_div_gt al bl in
-     (WW w_0 q, w_0W r)
-    else
-     match w_compare w_0 bh with
-     | Eq =>
-       let(q,r):=
-        double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21
-                  w_compare w_sub 1 a bl in
-       (q, w_0W r)
-     | Lt => ww_div_gt_aux ah al bh bl
-     | Gt => (W0,W0) (* cas absurde *)
-     end
-  end in [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]).
-   destruct a as [ |ah al]. simpl in Hgt;omega.
-   destruct b as [ |bh bl]. simpl in Hpos;omega.
-   Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl.
-   assert (H:=@spec_eq0 ah);destruct (w_eq0 ah).
-   simpl ww_to_Z;rewrite H;trivial. simpl in Hgt;rewrite H in Hgt;trivial.
-   assert ([|bh|] <= 0).
-   apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith.
-   assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;rewrite H1;simpl in Hgt.
-   simpl. simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos.
-   assert (H2:=spec_div_gt Hgt Hpos);destruct (w_div_gt al bl).
-   repeat rewrite spec_w_0W;simpl;rewrite spec_w_0;simpl;trivial.
-   clear H.
-   rewrite spec_compare; case Z.compare_spec; intros Hcmp.
-   rewrite spec_w_0 in Hcmp. change [[WW bh bl]] with ([|bh|]*wB+[|bl|]).
-   rewrite <- Hcmp;rewrite Z.mul_0_l;rewrite Z.add_0_l.
-   simpl in Hpos;rewrite <- Hcmp in Hpos;simpl in Hpos.
-   assert (H2:= @spec_double_divn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div
-    w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0
-    spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hpos).
-   destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21
-              w_compare w_sub 1
-             (WW ah al) bl).
-   rewrite spec_w_0W;unfold ww_to_Z;trivial.
-   apply spec_ww_div_gt_aux;trivial. rewrite spec_w_0 in Hcmp;trivial.
-   rewrite spec_w_0 in Hcmp;exfalso;omega.
-  Qed.
-
-  Lemma spec_ww_mod_gt_aux_eq : forall ah al bh bl,
-   ww_mod_gt_aux ah al bh bl = snd (ww_div_gt_aux ah al bh bl).
-  Proof.
-   intros ah al bh bl. unfold ww_mod_gt_aux, ww_div_gt_aux.
-   case w_compare; auto.
-   case w_div32; auto.
-  Qed.
-
-  Lemma spec_ww_mod_gt_aux : forall ah al bh bl,
-   [[WW ah al]] > [[WW bh bl]] ->
-    0 < [|bh|] ->
-    [[ww_mod_gt_aux ah al bh bl]] = [[WW ah al]] mod [[WW bh bl]].
-  Proof.
-   intros. rewrite spec_ww_mod_gt_aux_eq;trivial.
-   assert (H3 := spec_ww_div_gt_aux ah al bl H H0).
-   destruct (ww_div_gt_aux ah al bh bl) as (q,r);simpl. simpl in H,H3.
-   destruct H3;apply Zmod_unique with [[q]];zarith.
-   rewrite H1;ring.
-  Qed.
-
-  Lemma spec_w_mod_gt_eq : forall a b, [|a|] > [|b|] -> 0 <[|b|] ->
-    [|w_mod_gt a b|] = [|snd (w_div_gt a b)|].
-  Proof.
-   intros a b Hgt Hpos.
-   rewrite spec_mod_gt;trivial.
-   assert (H:=spec_div_gt Hgt Hpos).
-   destruct (w_div_gt a b) as (q,r);simpl.
-   rewrite Z.mul_comm in H;destruct H.
-   symmetry;apply Zmod_unique with [|q|];trivial.
-  Qed.
-
-  Lemma spec_ww_mod_gt_eq : forall a b, [[a]] > [[b]] -> 0 < [[b]] ->
-      [[ww_mod_gt a b]] = [[snd (ww_div_gt a b)]].
-  Proof.
-   intros a b Hgt Hpos.
-   change (ww_mod_gt a b) with
-   (match a, b with
-  | W0, _ => W0
-  | _, W0 => W0
-  | WW ah al, WW bh bl =>
-    if w_eq0 ah then w_0W (w_mod_gt al bl)
-    else
-     match w_compare w_0 bh with
-     | Eq =>
-       w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21
-             w_compare w_sub 1 a bl)
-     | Lt => ww_mod_gt_aux ah al bh bl
-     | Gt => W0 (* cas absurde *)
-     end end).
-   change (ww_div_gt a b) with
-   (match a, b with
-  | W0, _ => (W0,W0)
-  | _, W0 => (W0,W0)
-  | WW ah al, WW bh bl =>
-    if w_eq0 ah then
-     let (q,r) := w_div_gt al bl in
-     (WW w_0 q, w_0W r)
-    else
-     match w_compare w_0 bh with
-     | Eq =>
-       let(q,r):=
-        double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21
-                  w_compare w_sub 1 a bl in
-       (q, w_0W r)
-     | Lt => ww_div_gt_aux ah al bh bl
-     | Gt => (W0,W0) (* cas absurde *)
-     end
-  end).
-   destruct a as [ |ah al];trivial.
-   destruct b as [ |bh bl];trivial.
-   Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl.
-   assert (H:=@spec_eq0 ah);destruct (w_eq0 ah).
-   simpl in Hgt;rewrite H in Hgt;trivial.
-   assert ([|bh|] <= 0).
-   apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith.
-   assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt.
-   simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos.
-   rewrite spec_w_0W;rewrite spec_w_mod_gt_eq;trivial.
-   destruct (w_div_gt al bl);simpl;rewrite spec_w_0W;trivial.
-   clear H.
-   rewrite spec_compare; case Z.compare_spec; intros H2.
-   rewrite (@spec_double_modn1_aux w w_zdigits w_0 w_WW w_head0 w_add_mul_div
-            w_div21 w_compare w_sub w_to_Z spec_w_0 spec_compare 1 (WW ah al) bl).
-   destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1
-             (WW ah al) bl);simpl;trivial.
-   rewrite spec_ww_mod_gt_aux_eq;trivial;symmetry;trivial.
-   trivial.
-  Qed.
-
-  Lemma spec_ww_mod_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] ->
-      [[ww_mod_gt a b]] = [[a]] mod [[b]].
-  Proof.
-   intros a b Hgt Hpos.
-   assert (H:= spec_ww_div_gt a b Hgt Hpos).
-   rewrite (spec_ww_mod_gt_eq a b Hgt Hpos).
-   destruct (ww_div_gt a b)as(q,r);destruct H.
-   apply Zmod_unique with[[q]];simpl;trivial.
-   rewrite Z.mul_comm;trivial.
-  Qed.
-
-  Lemma Zis_gcd_mod : forall a b d,
-   0 < b -> Zis_gcd b (a mod b) d -> Zis_gcd a b d.
-  Proof.
-   intros a b d H H1; apply Zis_gcd_for_euclid with (a/b).
-   pattern a at 1;rewrite (Z_div_mod_eq a b).
-   ring_simplify (b * (a / b) + a mod b - a / b * b);trivial. zarith.
-  Qed.
-
-  Lemma spec_ww_gcd_gt_aux_body :
-   forall ah al bh bl n cont,
-    [[WW bh bl]] <= 2^n ->
-    [[WW ah al]] > [[WW bh bl]] ->
-    (forall xh xl yh yl,
-     [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^(n-1) ->
-     Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) ->
-    Zis_gcd [[WW ah al]] [[WW bh bl]] [[ww_gcd_gt_body cont ah al bh bl]].
-  Proof.
-   intros ah al bh bl n cont Hlog Hgt Hcont.
-   change (ww_gcd_gt_body cont ah al bh bl) with (match w_compare w_0 bh with
-    | Eq =>
-      match w_compare w_0 bl with
-      | Eq => WW ah al (* normalement n'arrive pas si forme normale *)
-      | Lt =>
-	let m := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21
-                   w_compare w_sub 1 (WW ah al) bl in
-        WW w_0 (w_gcd_gt bl m)
-      | Gt => W0 (* absurde *)
-      end
-    | Lt =>
-      let m := ww_mod_gt_aux ah al bh bl in
-      match m with
-      | W0 => WW bh bl
-      | WW mh ml =>
-        match w_compare w_0 mh with
-        | Eq =>
-          match w_compare w_0 ml with
-          | Eq => WW bh bl
-          | _  =>
-            let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21
-                      w_compare w_sub 1 (WW bh bl) ml in
-            WW w_0 (w_gcd_gt ml r)
-          end
-        | Lt =>
-          let r := ww_mod_gt_aux bh bl mh ml in
-          match r with
-          | W0 => m
-          | WW rh rl => cont mh ml rh rl
-          end
-        | Gt => W0 (* absurde *)
-        end
-      end
-    | Gt => W0 (* absurde *)
-    end).
-   rewrite spec_compare, spec_w_0.
-   case Z.compare_spec; intros Hbh.
-   simpl ww_to_Z in *. rewrite <- Hbh.
-   rewrite Z.mul_0_l;rewrite Z.add_0_l.
-   rewrite spec_compare, spec_w_0.
-   case Z.compare_spec; intros Hbl.
-   rewrite <- Hbl;apply Zis_gcd_0.
-   simpl;rewrite spec_w_0;rewrite Z.mul_0_l;rewrite Z.add_0_l.
-   apply Zis_gcd_mod;zarith.
-   change ([|ah|] * wB + [|al|]) with (double_to_Z w_digits w_to_Z 1 (WW ah al)).
-   rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div
-    w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div
-    spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hbl).
-   apply spec_gcd_gt.
-   rewrite  (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial.
-   apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
-    destruct (Z_mod_lt x y);zarith end.
-   Spec_w_to_Z bl;exfalso;omega.
-   assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh).
-   assert (H2 : 0 < [[WW bh bl]]).
-   simpl;Spec_w_to_Z bl. apply Z.lt_le_trans with ([|bh|]*wB);zarith.
-   apply Z.mul_pos_pos;zarith.
-   apply Zis_gcd_mod;trivial. rewrite <- H.
-   simpl in *;destruct (ww_mod_gt_aux ah al bh bl) as [ |mh ml].
-   simpl;apply Zis_gcd_0;zarith.
-   rewrite spec_compare, spec_w_0; case Z.compare_spec; intros Hmh.
-   simpl;rewrite <- Hmh;simpl.
-   rewrite spec_compare, spec_w_0; case Z.compare_spec; intros Hml.
-   rewrite <- Hml;simpl;apply Zis_gcd_0.
-   simpl; rewrite spec_w_0; simpl.
-   apply Zis_gcd_mod;zarith.
-   change ([|bh|] * wB + [|bl|]) with (double_to_Z w_digits w_to_Z 1 (WW bh bl)).
-   rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div
-   w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div
-   spec_div21 spec_compare spec_sub 1 (WW bh bl) ml Hml).
-   apply spec_gcd_gt.
-   rewrite  (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial.
-   apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
-   destruct (Z_mod_lt x y);zarith end.
-   Spec_w_to_Z ml;exfalso;omega.
-   assert ([[WW bh bl]] > [[WW mh ml]]).
-   rewrite H;simpl; apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
-   destruct (Z_mod_lt x y);zarith end.
-   assert (H1:= spec_ww_mod_gt_aux _ _ _ H0 Hmh).
-   assert (H3 : 0 < [[WW mh ml]]).
-   simpl;Spec_w_to_Z ml. apply Z.lt_le_trans with ([|mh|]*wB);zarith.
-   apply Z.mul_pos_pos;zarith.
-   apply Zis_gcd_mod;zarith. simpl in *;rewrite <- H1.
-   destruct (ww_mod_gt_aux bh bl mh ml) as [ |rh rl]. simpl; apply Zis_gcd_0.
-   simpl;apply Hcont. simpl in H1;rewrite H1.
-   apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
-   destruct (Z_mod_lt x y);zarith end.
-   apply Z.le_trans with (2^n/2).
-   apply Zdiv_le_lower_bound;zarith.
-   apply Z.le_trans with ([|bh|] * wB + [|bl|]);zarith.
-   assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Z.lt_gt _ _ H3)).
-   assert (H4 : 0 <= [[WW bh bl]]/[[WW mh ml]]).
-   apply Z.ge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1.
-   pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3'.
-   Z.le_elim H4.
-   assert (H6' : [[WW bh bl]] mod [[WW mh ml]] =
-                  [[WW bh bl]] - [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])).
-   simpl;pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3';ring. simpl in H6'.
-   assert ([[WW mh ml]] <= [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])).
-   simpl;pattern ([|mh|]*wB+[|ml|]) at 1;rewrite <- Z.mul_1_r;zarith.
-   simpl in *;assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in H8;
-    zarith.
-   assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in *;zarith.
-   rewrite <- H4 in H3';rewrite Z.mul_0_r in H3';simpl in H3';zarith.
-   pattern n at 1;replace n with (n-1+1);try ring.
-   rewrite Zpower_exp;zarith. change (2^1) with 2.
-   rewrite Z_div_mult;zarith.
-   assert (2^1 <= 2^n). change (2^1) with 2;zarith.
-   assert (H7 := @Zpower_le_monotone_inv 2 1 n);zarith.
-   Spec_w_to_Z mh;exfalso;zarith.
-   Spec_w_to_Z bh;exfalso;zarith.
-  Qed.
-
-  Lemma spec_ww_gcd_gt_aux :
-   forall p cont n,
-   (forall xh xl yh yl,
-     [[WW xh xl]] > [[WW yh yl]] ->
-     [[WW yh yl]] <= 2^n ->
-      Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) ->
-   forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] ->
-     [[WW bh bl]] <= 2^(Zpos p + n) ->
-     Zis_gcd [[WW ah al]] [[WW bh bl]]
-        [[ww_gcd_gt_aux p cont ah al bh bl]].
-  Proof.
-   induction p;intros cont n Hcont ah al bh bl Hgt Hs;simpl ww_gcd_gt_aux.
-   assert (0 < Zpos p). unfold Z.lt;reflexivity.
-   apply spec_ww_gcd_gt_aux_body with (n := Zpos (xI p) + n);
-   trivial;rewrite Pos2Z.inj_xI.
-   intros. apply IHp with (n := Zpos p + n);zarith.
-   intros. apply IHp with (n := n );zarith.
-   apply Z.le_trans with (2 ^ (2* Zpos p + 1+ n -1));zarith.
-   apply Z.pow_le_mono_r;zarith.
-   assert (0 < Zpos p). unfold Z.lt;reflexivity.
-   apply spec_ww_gcd_gt_aux_body with (n := Zpos (xO p) + n );trivial.
-   rewrite (Pos2Z.inj_xO p).
-   intros. apply IHp with (n := Zpos p + n - 1);zarith.
-   intros. apply IHp with (n := n -1 );zarith.
-   intros;apply Hcont;zarith.
-   apply Z.le_trans with (2^(n-1));zarith.
-   apply Z.pow_le_mono_r;zarith.
-   apply Z.le_trans with (2 ^ (Zpos p + n -1));zarith.
-   apply Z.pow_le_mono_r;zarith.
-   apply Z.le_trans with (2 ^ (2*Zpos p + n -1));zarith.
-   apply Z.pow_le_mono_r;zarith.
-   apply spec_ww_gcd_gt_aux_body with (n := n+1);trivial.
-   rewrite Z.add_comm;trivial.
-   ring_simplify (n + 1 - 1);trivial.
-  Qed.
-
-End DoubleDivGt.
-
-Section DoubleDiv.
-
- Variable w : Type.
- Variable w_digits : positive.
- Variable ww_1 : zn2z w.
- Variable ww_compare : zn2z w -> zn2z w -> comparison.
-
- Variable ww_div_gt : zn2z w -> zn2z w -> zn2z w * zn2z w.
- Variable ww_mod_gt : zn2z w -> zn2z w -> zn2z w.
-
- Definition ww_div a b :=
-  match ww_compare a b with
-  | Gt => ww_div_gt a b
-  | Eq => (ww_1, W0)
-  | Lt => (W0, a)
-  end.
-
- Definition ww_mod a b :=
-  match ww_compare a b with
-  | Gt => ww_mod_gt a b
-  | Eq => W0
-  | Lt => a
-  end.
-
-  Variable w_to_Z : w -> Z.
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_ww_1 : [[ww_1]] = 1.
-  Variable spec_ww_compare :  forall x y,
-    ww_compare x y = Z.compare [[x]] [[y]].
-  Variable spec_ww_div_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] ->
-      let (q,r) := ww_div_gt a b in
-      [[a]] = [[q]] * [[b]] + [[r]] /\
-      0 <= [[r]] < [[b]].
-  Variable spec_ww_mod_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] ->
-      [[ww_mod_gt a b]] = [[a]] mod [[b]].
-
-  Ltac Spec_w_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_to_Z x).
-
-  Ltac Spec_ww_to_Z x :=
-   let H:= fresh "HH" in
-   assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x).
-
-  Lemma spec_ww_div : forall a b, 0 < [[b]] ->
-      let (q,r) := ww_div a b in
-      [[a]] = [[q]] * [[b]] + [[r]] /\
-      0 <= [[r]] < [[b]].
-  Proof.
-   intros a b Hpos;unfold ww_div.
-   rewrite spec_ww_compare; case Z.compare_spec; intros.
-   simpl;rewrite spec_ww_1;split;zarith.
-   simpl;split;[ring|Spec_ww_to_Z a;zarith].
-   apply spec_ww_div_gt;auto with zarith.
-  Qed.
-
-  Lemma  spec_ww_mod :  forall a b, 0 < [[b]] ->
-      [[ww_mod a b]] = [[a]] mod [[b]].
-  Proof.
-   intros a b Hpos;unfold ww_mod.
-   rewrite spec_ww_compare; case Z.compare_spec; intros.
-   simpl;apply Zmod_unique with 1;try rewrite H;zarith.
-   Spec_ww_to_Z a;symmetry;apply Zmod_small;zarith.
-   apply spec_ww_mod_gt;auto with zarith.
-  Qed.
-
-
- Variable w_0 : w.
- Variable w_1 : w.
- Variable w_compare : w -> w -> comparison.
- Variable w_eq0 : w -> bool.
- Variable w_gcd_gt : w -> w -> w.
- Variable _ww_digits : positive.
- Variable spec_ww_digits_ : _ww_digits = xO w_digits.
- Variable ww_gcd_gt_fix :
-   positive -> (w -> w -> w -> w -> zn2z w) ->
-             w -> w -> w -> w -> zn2z w.
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_w_1   : [|w_1|] = 1.
-  Variable spec_compare :
-    forall x y, w_compare x y = Z.compare [|x|] [|y|].
-  Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0.
-  Variable spec_gcd_gt : forall a b, [|a|] > [|b|] ->
-      Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|].
-  Variable spec_gcd_gt_fix :
-   forall p cont n,
-   (forall xh xl yh yl,
-     [[WW xh xl]] > [[WW yh yl]] ->
-     [[WW yh yl]] <= 2^n ->
-      Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) ->
-   forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] ->
-     [[WW bh bl]] <= 2^(Zpos p + n) ->
-     Zis_gcd [[WW ah al]] [[WW bh bl]]
-        [[ww_gcd_gt_fix p cont ah al bh bl]].
-
- Definition gcd_cont (xh xl yh yl:w) :=
-  match w_compare w_1 yl with
-  | Eq => ww_1
-  | _ => WW xh xl
-  end.
-
-  Lemma spec_gcd_cont : forall xh xl yh yl,
-     [[WW xh xl]] > [[WW yh yl]] ->
-     [[WW yh yl]] <= 1 ->
-      Zis_gcd [[WW xh xl]] [[WW yh yl]] [[gcd_cont xh xl yh yl]].
-  Proof.
-   intros xh xl yh yl Hgt' Hle. simpl in Hle.
-   assert ([|yh|] = 0).
-    change 1 with (0*wB+1) in Hle.
-    assert (0 <= 1 < wB). split;zarith. apply wB_pos.
-    assert (H1:= beta_lex _ _ _ _ _ Hle (spec_to_Z yl) H).
-    Spec_w_to_Z yh;zarith.
-   unfold gcd_cont; rewrite spec_compare, spec_w_1.
-   case Z.compare_spec; intros Hcmpy.
-   simpl;rewrite H;simpl;
-   rewrite spec_ww_1;rewrite <- Hcmpy;apply Zis_gcd_mod;zarith.
-   rewrite <- (Zmod_unique ([|xh|]*wB+[|xl|]) 1 ([|xh|]*wB+[|xl|]) 0);zarith.
-   rewrite H in Hle; exfalso;zarith.
-   assert (H0 : [|yl|] = 0) by (Spec_w_to_Z yl;zarith).
-   simpl. rewrite H0, H;simpl;apply Zis_gcd_0;trivial.
-  Qed.
-
-
-  Variable cont : w -> w -> w -> w -> zn2z w.
-  Variable spec_cont : forall xh xl yh yl,
-     [[WW xh xl]] > [[WW yh yl]] ->
-     [[WW yh yl]] <= 1 ->
-      Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]].
-
-  Definition ww_gcd_gt a b :=
-   match a, b with
-   | W0, _ => b
-   | _, W0 => a
-   | WW ah al, WW bh bl =>
-     if w_eq0 ah then (WW w_0 (w_gcd_gt al bl))
-     else ww_gcd_gt_fix _ww_digits cont ah al bh bl
-   end.
-
-  Definition ww_gcd a b :=
-   Eval lazy beta delta [ww_gcd_gt] in
-   match ww_compare a b with
-   | Gt => ww_gcd_gt a b
-   | Eq => a
-   | Lt => ww_gcd_gt b a
-   end.
-
-  Lemma spec_ww_gcd_gt : forall a b, [[a]] > [[b]] ->
-      Zis_gcd [[a]] [[b]] [[ww_gcd_gt a b]].
-  Proof.
-   intros a b Hgt;unfold ww_gcd_gt.
-   destruct a as [ |ah al]. simpl;apply Zis_gcd_sym;apply Zis_gcd_0.
-   destruct b as [ |bh bl]. simpl;apply Zis_gcd_0.
-   simpl in Hgt. generalize (@spec_eq0 ah);destruct (w_eq0 ah);intros.
-   simpl;rewrite H in Hgt;trivial;rewrite H;trivial;rewrite spec_w_0;simpl.
-   assert ([|bh|] <= 0).
-   apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith.
-   Spec_w_to_Z bh;assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt.
-   rewrite H1;simpl;auto. clear H.
-   apply spec_gcd_gt_fix with (n:= 0);trivial.
-   rewrite Z.add_0_r;rewrite spec_ww_digits_.
-   change (2 ^ Zpos (xO w_digits)) with wwB. Spec_ww_to_Z (WW bh bl);zarith.
-  Qed.
-
-  Lemma spec_ww_gcd : forall a b, Zis_gcd [[a]] [[b]] [[ww_gcd a b]].
-  Proof.
-   intros a b.
-   change (ww_gcd a b) with
-    (match ww_compare a b with
-     | Gt => ww_gcd_gt a b
-     | Eq => a
-     | Lt => ww_gcd_gt b a
-     end).
-   rewrite spec_ww_compare; case Z.compare_spec; intros Hcmp.
-   Spec_ww_to_Z b;rewrite Hcmp.
-   apply Zis_gcd_for_euclid with 1;zarith.
-   ring_simplify ([[b]] - 1 * [[b]]). apply Zis_gcd_0;zarith.
-   apply Zis_gcd_sym;apply spec_ww_gcd_gt;zarith.
-   apply spec_ww_gcd_gt;zarith.
-  Qed.
-
-End DoubleDiv.
-
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
deleted file mode 100644
index 195527dd..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
+++ /dev/null
@@ -1,519 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith Ndigits.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-
-Local Open Scope Z_scope.
-
-Local Infix "<<" := Pos.shiftl_nat (at level 30).
-
-Section GENDIVN1.
-
- Variable w             : Type.
- Variable w_digits      : positive.
- Variable w_zdigits     : w.
- Variable w_0           : w.
- Variable w_WW          : w -> w -> zn2z w.
- Variable w_head0       : w -> w.
- Variable w_add_mul_div : w -> w -> w -> w.
- Variable w_div21       : w -> w -> w -> w * w.
- Variable w_compare     : w -> w -> comparison.
- Variable w_sub         : w -> w -> w.
-
-
-
- (* ** For proofs ** *)
- Variable w_to_Z        : w -> Z.
-
- Notation wB := (base w_digits).
-
- Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
- Notation "[! n | x !]" := (double_to_Z w_digits w_to_Z n x)
-                                      (at level 0, x at level 99).
- Notation "[[ x ]]" := (zn2z_to_Z wB w_to_Z x)  (at level 0, x at level 99).
-
- Variable spec_to_Z   : forall x, 0 <= [| x |] < wB.
- Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits.
- Variable spec_0   : [|w_0|] = 0.
- Variable spec_WW  : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
- Variable spec_head0  : forall x,  0 < [|x|] ->
-	 wB/ 2 <= 2 ^ [|w_head0 x|] * [|x|] < wB.
- Variable spec_add_mul_div : forall x y p,
-        [|p|] <= Zpos w_digits ->
-       [| w_add_mul_div p x y |] =
-         ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB.
- Variable spec_div21 : forall a1 a2 b,
-     wB/2 <= [|b|] ->
-     [|a1|] < [|b|] ->
-     let (q,r) := w_div21 a1 a2 b in
-     [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
-     0 <= [|r|] < [|b|].
- Variable spec_compare :
-   forall x y, w_compare x y = Z.compare [|x|] [|y|].
- Variable spec_sub: forall x y,
-   [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
-
-
-
- Section DIVAUX.
-  Variable b2p : w.
-  Variable b2p_le : wB/2 <= [|b2p|].
-
-  Definition double_divn1_0_aux n (divn1: w -> word w n -> word w n * w) r h :=
-   let (hh,hl) := double_split w_0 n h in
-   let (qh,rh) := divn1 r hh in
-   let (ql,rl) := divn1 rh hl in
-   (double_WW w_WW n qh ql, rl).
-
-  Fixpoint double_divn1_0 (n:nat) : w -> word w n -> word w n * w :=
-   match n return w -> word w n -> word w n * w with
-   | O => fun r x => w_div21 r x b2p
-   | S n => double_divn1_0_aux n (double_divn1_0 n)
-   end.
-
-  Lemma spec_split : forall (n : nat) (x : zn2z (word w n)),
-       let (h, l) := double_split w_0 n x in
-       [!S n | x!] = [!n | h!] * double_wB w_digits n + [!n | l!].
-  Proof (spec_double_split w_0 w_digits w_to_Z spec_0).
-
-  Lemma spec_double_divn1_0 : forall n r a,
-    [|r|] < [|b2p|] ->
-    let (q,r') := double_divn1_0 n r a in
-    [|r|] * double_wB w_digits n + [!n|a!] = [!n|q!] * [|b2p|] + [|r'|] /\
-    0 <= [|r'|] < [|b2p|].
-  Proof.
-   induction n;intros.
-   exact (spec_div21 a b2p_le H).
-   simpl (double_divn1_0 (S n) r a); unfold double_divn1_0_aux.
-   assert (H1 := spec_split n a);destruct (double_split w_0 n a) as (hh,hl).
-   rewrite H1.
-   assert (H2 := IHn r hh H);destruct (double_divn1_0 n r hh) as (qh,rh).
-   destruct H2.
-   assert ([|rh|] < [|b2p|]). omega.
-   assert (H4 := IHn rh hl H3);destruct (double_divn1_0 n rh hl) as (ql,rl).
-   destruct H4;split;trivial.
-   rewrite spec_double_WW;trivial.
-   rewrite <- double_wB_wwB.
-   rewrite Z.mul_assoc;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   rewrite H0;rewrite Z.mul_add_distr_r;rewrite <- Z.add_assoc.
-   rewrite H4;ring.
-  Qed.
-
-  Definition double_modn1_0_aux n (modn1:w -> word w n -> w) r h :=
-   let (hh,hl) := double_split w_0 n h in modn1 (modn1 r hh) hl.
-
-  Fixpoint double_modn1_0 (n:nat) : w -> word w n -> w :=
-   match n return w -> word w n -> w with
-   | O => fun r x => snd (w_div21 r x b2p)
-   | S n => double_modn1_0_aux n (double_modn1_0 n)
-   end.
-
-  Lemma spec_double_modn1_0 : forall n r x,
-     double_modn1_0 n r x = snd (double_divn1_0 n r x).
-  Proof.
-   induction n;simpl;intros;trivial.
-   unfold double_modn1_0_aux, double_divn1_0_aux.
-   destruct (double_split w_0 n x) as (hh,hl).
-   rewrite (IHn r hh).
-   destruct (double_divn1_0 n r hh) as (qh,rh);simpl.
-   rewrite IHn. destruct (double_divn1_0 n rh hl);trivial.
-  Qed.
-
-  Variable p : w.
-  Variable p_bounded : [|p|] <= Zpos w_digits.
-
-  Lemma spec_add_mul_divp : forall x y,
-    [| w_add_mul_div p x y |] =
-       ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB.
-  Proof.
-   intros;apply spec_add_mul_div;auto.
-  Qed.
-
-  Definition double_divn1_p_aux n
-   (divn1 : w -> word w n -> word w n -> word w n * w) r h l :=
-   let (hh,hl) := double_split w_0 n h in
-   let (lh,ll) := double_split w_0 n l in
-   let (qh,rh) := divn1 r hh hl in
-   let (ql,rl) := divn1 rh hl lh in
-   (double_WW w_WW n qh ql, rl).
-
-  Fixpoint double_divn1_p (n:nat) : w -> word w n -> word w n -> word w n * w :=
-   match n return w -> word w n -> word w n ->  word w n * w with
-   | O => fun r h l => w_div21 r (w_add_mul_div p h l) b2p
-   | S n => double_divn1_p_aux n (double_divn1_p n)
-   end.
-
-  Lemma p_lt_double_digits : forall n, [|p|] <= Zpos (w_digits << n).
-  Proof.
-   induction n;simpl. trivial.
-   case (spec_to_Z p); rewrite Pos2Z.inj_xO;auto with zarith.
-  Qed.
-
-  Lemma spec_double_divn1_p : forall n r h l,
-    [|r|] < [|b2p|] ->
-    let (q,r') := double_divn1_p n r h l in
-    [|r|] * double_wB w_digits n +
-      ([!n|h!]*2^[|p|] +
-        [!n|l!] / (2^(Zpos(w_digits << n) - [|p|])))
-        mod double_wB w_digits n = [!n|q!] * [|b2p|] + [|r'|] /\
-    0 <= [|r'|] < [|b2p|].
-  Proof.
-   case (spec_to_Z p); intros HH0 HH1.
-   induction n;intros.
-   simpl (double_divn1_p 0 r h l).
-   unfold double_to_Z, double_wB, "<<".
-   rewrite <- spec_add_mul_divp.
-   exact (spec_div21 (w_add_mul_div p h l) b2p_le H).
-   simpl (double_divn1_p (S n) r h l).
-   unfold double_divn1_p_aux.
-   assert (H1 := spec_split n h);destruct (double_split w_0 n h) as (hh,hl).
-   rewrite H1. rewrite <- double_wB_wwB.
-   assert (H2 := spec_split n l);destruct (double_split w_0 n l) as (lh,ll).
-   rewrite H2.
-   replace ([|r|] * (double_wB w_digits n * double_wB w_digits n) +
-    (([!n|hh!] * double_wB w_digits n + [!n|hl!]) * 2 ^ [|p|] +
-    ([!n|lh!] * double_wB w_digits n + [!n|ll!]) /
-     2^(Zpos (w_digits << (S n)) - [|p|])) mod
-      (double_wB w_digits n * double_wB w_digits n)) with
-    (([|r|] * double_wB w_digits n + ([!n|hh!] * 2^[|p|] +
-      [!n|hl!] / 2^(Zpos (w_digits << n) - [|p|])) mod
-                      double_wB w_digits n) * double_wB w_digits n +
-     ([!n|hl!] * 2^[|p|] +
-      [!n|lh!] / 2^(Zpos (w_digits << n) - [|p|])) mod
-              double_wB w_digits n).
-   generalize (IHn r hh hl H);destruct (double_divn1_p n r hh hl) as (qh,rh);
-   intros (H3,H4);rewrite H3.
-   assert ([|rh|] < [|b2p|]). omega.
-   replace (([!n|qh!] * [|b2p|] + [|rh|]) * double_wB w_digits n +
-     ([!n|hl!] * 2 ^ [|p|] +
-      [!n|lh!] / 2 ^ (Zpos (w_digits << n) - [|p|])) mod
-      double_wB w_digits n)  with
-    ([!n|qh!] * [|b2p|] *double_wB w_digits n + ([|rh|]*double_wB w_digits n +
-      ([!n|hl!] * 2 ^ [|p|] +
-       [!n|lh!] / 2 ^ (Zpos (w_digits << n) - [|p|])) mod
-      double_wB w_digits n)). 2:ring.
-   generalize (IHn rh hl lh H0);destruct (double_divn1_p n rh hl lh) as (ql,rl);
-   intros (H5,H6);rewrite H5.
-   split;[rewrite spec_double_WW;trivial;ring|trivial].
-   assert (Uhh := spec_double_to_Z w_digits w_to_Z spec_to_Z n hh);
-    unfold double_wB,base in Uhh.
-   assert (Uhl := spec_double_to_Z w_digits w_to_Z spec_to_Z n hl);
-    unfold double_wB,base in Uhl.
-   assert (Ulh := spec_double_to_Z w_digits w_to_Z spec_to_Z n lh);
-    unfold double_wB,base in Ulh.
-   assert (Ull := spec_double_to_Z w_digits w_to_Z spec_to_Z n ll);
-    unfold double_wB,base in Ull.
-   unfold double_wB,base.
-   assert (UU:=p_lt_double_digits n).
-   rewrite Zdiv_shift_r;auto with zarith.
-   2:change (Zpos (w_digits << (S n)))
-     with (2*Zpos (w_digits << n));auto with zarith.
-   replace (2 ^ (Zpos (w_digits << (S n)) - [|p|])) with
-    (2^(Zpos (w_digits << n) - [|p|])*2^Zpos (w_digits << n)).
-   rewrite Zdiv_mult_cancel_r;auto with zarith.
-   rewrite Z.mul_add_distr_r with (p:=  2^[|p|]).
-   pattern  ([!n|hl!] * 2^[|p|]) at 2;
-   rewrite (shift_unshift_mod (Zpos(w_digits << n))([|p|])([!n|hl!]));
-    auto with zarith.
-   rewrite Z.add_assoc.
-   replace
-    ([!n|hh!] * 2^Zpos (w_digits << n)* 2^[|p|] +
-      ([!n|hl!] / 2^(Zpos (w_digits << n)-[|p|])*
-       2^Zpos(w_digits << n)))
-   with
-    (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl /
-       2^(Zpos (w_digits << n)-[|p|]))
-      * 2^Zpos(w_digits << n));try (ring;fail).
-   rewrite <- Z.add_assoc.
-   rewrite <- (Zmod_shift_r ([|p|]));auto with zarith.
-   replace
-     (2 ^ Zpos (w_digits << n) * 2 ^ Zpos (w_digits << n)) with
-     (2 ^ (Zpos (w_digits << n) + Zpos (w_digits << n))).
-   rewrite (Zmod_shift_r (Zpos (w_digits << n)));auto with zarith.
-   replace (2 ^ (Zpos (w_digits << n) + Zpos (w_digits << n)))
-   with (2^Zpos(w_digits << n) *2^Zpos(w_digits << n)).
-   rewrite (Z.mul_comm (([!n|hh!] * 2 ^ [|p|] +
-      [!n|hl!] / 2 ^ (Zpos (w_digits << n) - [|p|])))).
-   rewrite  Zmult_mod_distr_l;auto with zarith.
-   ring.
-   rewrite Zpower_exp;auto with zarith.
-   assert (0 < Zpos (w_digits << n)). unfold Z.lt;reflexivity.
-   auto with zarith.
-   apply Z_mod_lt;auto with zarith.
-   rewrite Zpower_exp;auto with zarith.
-   split;auto with zarith.
-   apply Zdiv_lt_upper_bound;auto with zarith.
-   rewrite <- Zpower_exp;auto with zarith.
-   replace ([|p|] + (Zpos (w_digits << n) - [|p|])) with
-     (Zpos(w_digits << n));auto with zarith.
-   rewrite <- Zpower_exp;auto with zarith.
-   replace (Zpos (w_digits << (S n)) - [|p|]) with
-       (Zpos (w_digits << n) - [|p|] +
-         Zpos (w_digits << n));trivial.
-   change (Zpos (w_digits << (S n))) with
-    (2*Zpos (w_digits << n)). ring.
-  Qed.
-
-  Definition double_modn1_p_aux n (modn1 : w -> word w n -> word w n -> w) r h l:=
-   let (hh,hl) := double_split w_0 n h in
-   let (lh,ll) := double_split w_0 n l in
-   modn1 (modn1 r hh hl) hl lh.
-
-  Fixpoint double_modn1_p (n:nat) : w -> word w n -> word w n -> w :=
-   match n return w -> word w n -> word w n -> w with
-   | O => fun r h l => snd (w_div21 r (w_add_mul_div p h l) b2p)
-   | S n => double_modn1_p_aux n (double_modn1_p n)
-   end.
-
-  Lemma spec_double_modn1_p : forall n r h l ,
-    double_modn1_p n r h l = snd (double_divn1_p n r h l).
-  Proof.
-   induction n;simpl;intros;trivial.
-   unfold double_modn1_p_aux, double_divn1_p_aux.
-   destruct(double_split w_0 n h)as(hh,hl);destruct(double_split w_0 n l) as (lh,ll).
-   rewrite (IHn r hh hl);destruct (double_divn1_p n r hh hl) as (qh,rh).
-   rewrite IHn;simpl;destruct (double_divn1_p n rh hl lh);trivial.
-  Qed.
-
- End DIVAUX.
-
- Fixpoint high (n:nat) : word w n -> w :=
-  match n return word w n -> w with
-  | O => fun a => a
-  | S n =>
-    fun (a:zn2z (word w n)) =>
-     match a with
-     | W0 => w_0
-     | WW h l => high n h
-     end
-  end.
-
- Lemma spec_double_digits:forall n, Zpos w_digits <= Zpos (w_digits << n).
- Proof.
-  induction n;simpl;auto with zarith.
-  change (Zpos (xO (w_digits << n))) with
-    (2*Zpos (w_digits << n)).
-  assert (0 < Zpos w_digits) by reflexivity.
-  auto with zarith.
- Qed.
-
- Lemma spec_high : forall n (x:word w n),
-   [|high n x|] = [!n|x!] / 2^(Zpos (w_digits << n) - Zpos w_digits).
- Proof.
-  induction n;intros.
-  unfold high,double_to_Z. rewrite Pshiftl_nat_0.
-  replace (Zpos w_digits - Zpos w_digits) with 0;try ring.
-  simpl. rewrite <- (Zdiv_unique [|x|] 1 [|x|] 0);auto with zarith.
-  assert (U2 := spec_double_digits n).
-  assert (U3 : 0 < Zpos w_digits). exact (eq_refl Lt).
-  destruct x;unfold high;fold high.
-  unfold double_to_Z,zn2z_to_Z;rewrite spec_0.
-  rewrite Zdiv_0_l;trivial.
-  assert (U0 := spec_double_to_Z w_digits w_to_Z spec_to_Z n w0);
-   assert (U1 := spec_double_to_Z w_digits w_to_Z spec_to_Z n w1).
-  simpl [!S n|WW w0 w1!].
-  unfold double_wB,base;rewrite Zdiv_shift_r;auto with zarith.
-  replace (2 ^ (Zpos (w_digits << (S n)) - Zpos w_digits)) with
-   (2^(Zpos (w_digits << n) - Zpos w_digits) *
-        2^Zpos (w_digits << n)).
-  rewrite Zdiv_mult_cancel_r;auto with zarith.
-  rewrite <- Zpower_exp;auto with zarith.
-  replace (Zpos (w_digits << n) - Zpos w_digits +
-    Zpos (w_digits << n)) with
-   (Zpos (w_digits << (S n)) - Zpos w_digits);trivial.
-  change (Zpos (w_digits << (S n))) with
-     (2*Zpos (w_digits << n));ring.
-  change (Zpos (w_digits << (S n))) with
-  (2*Zpos (w_digits << n)); auto with zarith.
- Qed.
-
- Definition double_divn1 (n:nat) (a:word w n) (b:w) :=
-  let p := w_head0 b in
-  match w_compare p w_0 with
-  | Gt =>
-    let b2p := w_add_mul_div p b w_0 in
-    let ha := high n a in
-    let k := w_sub w_zdigits p in
-    let lsr_n := w_add_mul_div k w_0 in
-    let r0 := w_add_mul_div p w_0 ha in
-    let (q,r) := double_divn1_p b2p p n r0 a (double_0 w_0 n) in
-    (q, lsr_n r)
-  | _ => double_divn1_0 b n w_0 a
-  end.
-
- Lemma spec_double_divn1 : forall n a b,
-    0 < [|b|] ->
-    let (q,r) := double_divn1 n a b in
-    [!n|a!] = [!n|q!] * [|b|] + [|r|] /\
-    0 <= [|r|] < [|b|].
-  Proof.
-   intros n a b H. unfold double_divn1.
-   case (spec_head0 H); intros H0 H1.
-   case (spec_to_Z (w_head0 b)); intros HH1 HH2.
-   rewrite spec_compare; case Z.compare_spec;
-     rewrite spec_0; intros H2; auto with zarith.
-   assert (Hv1: wB/2 <= [|b|]).
-     generalize H0; rewrite H2; rewrite Z.pow_0_r;
-       rewrite Z.mul_1_l; auto.
-   assert (Hv2: [|w_0|] < [|b|]).
-     rewrite spec_0; auto.
-   generalize (spec_double_divn1_0 Hv1 n a Hv2).
-   rewrite spec_0;rewrite Z.mul_0_l; rewrite Z.add_0_l; auto.
-   contradict H2; auto with zarith.
-   assert (HHHH : 0 < [|w_head0 b|]); auto with zarith.
-   assert ([|w_head0 b|] < Zpos w_digits).
-    case (Z.le_gt_cases (Zpos w_digits) [|w_head0 b|]); auto; intros HH.
-    assert (2 ^ [|w_head0 b|] < wB).
-     apply Z.le_lt_trans with (2 ^ [|w_head0 b|] * [|b|]);auto with zarith.
-     replace (2 ^ [|w_head0 b|]) with (2^[|w_head0 b|] * 1);try (ring;fail).
-     apply Z.mul_le_mono_nonneg;auto with zarith.
-     assert (wB <= 2^[|w_head0 b|]).
-     unfold base;apply Zpower_le_monotone;auto with zarith. omega.
-   assert ([|w_add_mul_div (w_head0 b) b w_0|] =
-               2 ^ [|w_head0 b|] * [|b|]).
-    rewrite (spec_add_mul_div b w_0); auto with zarith.
-    rewrite spec_0;rewrite Zdiv_0_l; try omega.
-    rewrite Z.add_0_r; rewrite Z.mul_comm.
-    rewrite Zmod_small; auto with zarith.
-   assert (H5 := spec_to_Z (high n a)).
-   assert
-    ([|w_add_mul_div (w_head0 b) w_0 (high n a)|]
-          <[|w_add_mul_div (w_head0 b) b w_0|]).
-    rewrite H4.
-    rewrite spec_add_mul_div;auto with zarith.
-    rewrite spec_0;rewrite Z.mul_0_l;rewrite Z.add_0_l.
-    assert (([|high n a|]/2^(Zpos w_digits - [|w_head0 b|])) < wB).
-     apply Zdiv_lt_upper_bound;auto with zarith.
-     apply Z.lt_le_trans with wB;auto with zarith.
-     pattern wB at 1;replace wB with (wB*1);try ring.
-     apply Z.mul_le_mono_nonneg;auto with zarith.
-     assert (H6 := Z.pow_pos_nonneg 2 (Zpos w_digits - [|w_head0 b|]));
-       auto with zarith.
-    rewrite Zmod_small;auto with zarith.
-    apply Zdiv_lt_upper_bound;auto with zarith.
-    apply Z.lt_le_trans with wB;auto with zarith.
-    apply Z.le_trans with (2 ^ [|w_head0 b|] * [|b|] * 2).
-    rewrite <- wB_div_2; try omega.
-    apply Z.mul_le_mono_nonneg;auto with zarith.
-    pattern 2 at 1;rewrite <- Z.pow_1_r.
-    apply Zpower_le_monotone;split;auto with zarith.
-   rewrite <- H4 in H0.
-   assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith.
-   assert (H7:= spec_double_divn1_p H0 Hb3 n a (double_0 w_0 n) H6).
-   destruct (double_divn1_p (w_add_mul_div (w_head0 b) b w_0) (w_head0 b) n
-             (w_add_mul_div (w_head0 b) w_0 (high n a)) a
-             (double_0 w_0 n)) as (q,r).
-   assert (U:= spec_double_digits n).
-   rewrite spec_double_0 in H7;trivial;rewrite Zdiv_0_l in H7.
-   rewrite Z.add_0_r in H7.
-   rewrite spec_add_mul_div in H7;auto with zarith.
-   rewrite spec_0 in H7;rewrite Z.mul_0_l in H7;rewrite Z.add_0_l in H7.
-   assert (([|high n a|] / 2 ^ (Zpos w_digits - [|w_head0 b|])) mod wB
-     = [!n|a!] / 2^(Zpos (w_digits << n) - [|w_head0 b|])).
-   rewrite Zmod_small;auto with zarith.
-   rewrite spec_high. rewrite Zdiv_Zdiv;auto with zarith.
-   rewrite <- Zpower_exp;auto with zarith.
-   replace (Zpos (w_digits << n) - Zpos w_digits +
-                       (Zpos w_digits - [|w_head0 b|]))
-    with (Zpos (w_digits << n) - [|w_head0 b|]);trivial;ring.
-   assert (H8 := Z.pow_pos_nonneg 2  (Zpos w_digits - [|w_head0 b|]));auto with zarith.
-   split;auto with zarith.
-   apply Z.le_lt_trans with ([|high n a|]);auto with zarith.
-   apply Zdiv_le_upper_bound;auto with zarith.
-   pattern ([|high n a|]) at 1;rewrite <- Z.mul_1_r.
-   apply Z.mul_le_mono_nonneg;auto with zarith.
-   rewrite H8 in H7;unfold double_wB,base in H7.
-   rewrite <- shift_unshift_mod in H7;auto with zarith.
-   rewrite H4 in H7.
-   assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|]
-               = [|r|]/2^[|w_head0 b|]).
-   rewrite spec_add_mul_div.
-   rewrite spec_0;rewrite Z.mul_0_l;rewrite Z.add_0_l.
-   replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|])
-      with ([|w_head0 b|]).
-   rewrite Zmod_small;auto with zarith.
-   assert (H9 := spec_to_Z r).
-   split;auto with zarith.
-   apply Z.le_lt_trans with ([|r|]);auto with zarith.
-   apply Zdiv_le_upper_bound;auto with zarith.
-   pattern ([|r|]) at 1;rewrite <- Z.mul_1_r.
-   apply Z.mul_le_mono_nonneg;auto with zarith.
-   assert (H10 := Z.pow_pos_nonneg 2  ([|w_head0 b|]));auto with zarith.
-   rewrite spec_sub.
-   rewrite Zmod_small; auto with zarith.
-   split; auto with zarith.
-   case (spec_to_Z w_zdigits); auto with zarith.
-   rewrite spec_sub.
-   rewrite Zmod_small; auto with zarith.
-   split; auto with zarith.
-   case (spec_to_Z w_zdigits); auto with zarith.
-  case H7; intros H71 H72.
-   split.
-   rewrite <- (Z_div_mult [!n|a!] (2^[|w_head0 b|]));auto with zarith.
-   rewrite H71;rewrite H9.
-   replace ([!n|q!] * (2 ^ [|w_head0 b|] * [|b|]))
-      with ([!n|q!] *[|b|] * 2^[|w_head0 b|]);
-     try (ring;fail).
-   rewrite Z_div_plus_l;auto with zarith.
-   assert (H10 := spec_to_Z
-       (w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r));split;
-    auto with zarith.
-   rewrite H9.
-   apply Zdiv_lt_upper_bound;auto with zarith.
-   rewrite Z.mul_comm;auto with zarith.
-   exact (spec_double_to_Z w_digits w_to_Z spec_to_Z n a).
- Qed.
-
-
- Definition double_modn1 (n:nat) (a:word w n) (b:w) :=
-  let p := w_head0 b in
-  match w_compare p w_0 with
-  | Gt =>
-    let b2p := w_add_mul_div p b w_0 in
-    let ha := high n a in
-    let k := w_sub w_zdigits p in
-    let lsr_n := w_add_mul_div k w_0 in
-    let r0 := w_add_mul_div p w_0 ha in
-    let r := double_modn1_p b2p p n r0 a (double_0 w_0 n) in
-    lsr_n r
-  | _ => double_modn1_0 b n w_0 a
-  end.
-
- Lemma spec_double_modn1_aux : forall n a b,
-    double_modn1 n a b = snd (double_divn1 n a b).
- Proof.
-  intros n a b;unfold double_divn1,double_modn1.
-  rewrite spec_compare; case Z.compare_spec;
-     rewrite spec_0; intros H2; auto with zarith.
-  apply spec_double_modn1_0.
-  apply spec_double_modn1_0.
-  rewrite spec_double_modn1_p.
-  destruct (double_divn1_p (w_add_mul_div (w_head0 b) b w_0) (w_head0 b) n
-            (w_add_mul_div (w_head0 b) w_0 (high n a)) a (double_0 w_0 n));simpl;trivial.
- Qed.
-
- Lemma spec_double_modn1 : forall n a b, 0 < [|b|] ->
-  [|double_modn1 n a b|] = [!n|a!] mod [|b|].
- Proof.
-  intros n a b H;assert (H1 := spec_double_divn1 n a H).
-  assert (H2 := spec_double_modn1_aux n a b).
-  rewrite H2;destruct (double_divn1 n a b) as (q,r).
-  simpl;apply Zmod_unique with (double_to_Z w_digits w_to_Z n q);auto with zarith.
-  destruct H1 as (h1,h2);rewrite h1;ring.
- Qed.
-
-End GENDIVN1.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
deleted file mode 100644
index f65b47c8..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
+++ /dev/null
@@ -1,475 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-
-Local Open Scope Z_scope.
-
-Section DoubleLift.
- Variable w : Type.
- Variable w_0 : w.
- Variable w_WW : w -> w -> zn2z w.
- Variable w_W0 : w ->  zn2z w.
- Variable w_0W : w ->  zn2z w.
- Variable w_compare : w -> w -> comparison.
- Variable ww_compare : zn2z w -> zn2z w -> comparison.
- Variable w_head0 : w -> w.
- Variable w_tail0 : w -> w.
- Variable w_add: w -> w -> zn2z w.
- Variable w_add_mul_div : w -> w -> w -> w.
- Variable ww_sub: zn2z w -> zn2z w -> zn2z w.
- Variable w_digits : positive.
- Variable ww_Digits : positive.
- Variable w_zdigits : w.
- Variable ww_zdigits : zn2z w.
- Variable low: zn2z w -> w.
-
- Definition ww_head0 x :=
-  match x with
-  | W0 => ww_zdigits
-  | WW xh xl =>
-    match w_compare w_0 xh with
-    | Eq => w_add w_zdigits (w_head0 xl)
-    | _ => w_0W (w_head0 xh)
-    end
-  end.
-
-
- Definition ww_tail0 x :=
-  match x with
-  | W0 => ww_zdigits
-  | WW xh xl =>
-    match w_compare w_0 xl with
-    | Eq => w_add w_zdigits (w_tail0 xh)
-    | _ => w_0W (w_tail0 xl)
-    end
-  end.
-
-
-  (* 0 < p < ww_digits *)
- Definition ww_add_mul_div p x y :=
-  let zdigits := w_0W w_zdigits in
-  match x, y with
-  | W0, W0 => W0
-  | W0, WW yh yl =>
-    match ww_compare p zdigits with
-    | Eq => w_0W yh
-    | Lt => w_0W (w_add_mul_div (low p) w_0 yh)
-    | Gt =>
-      let n := low (ww_sub p zdigits) in
-      w_WW (w_add_mul_div n w_0 yh) (w_add_mul_div n yh yl)
-    end
-  | WW xh xl, W0 =>
-    match ww_compare p zdigits with
-    | Eq => w_W0 xl
-    | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl w_0)
-    | Gt =>
-      let n := low (ww_sub p zdigits) in
-      w_W0 (w_add_mul_div n xl w_0)
-    end
-  | WW xh xl, WW yh yl =>
-    match ww_compare p zdigits with
-    | Eq => w_WW xl yh
-    | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl yh)
-    | Gt =>
-      let n := low (ww_sub p zdigits) in
-      w_WW (w_add_mul_div n xl yh) (w_add_mul_div n yh yl)
-    end
-  end.
-
- Section DoubleProof.
-  Variable w_to_Z : w -> Z.
-
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_to_w_Z  : forall x, 0 <= [[x]] < wwB.
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-  Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB.
-  Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
-  Variable spec_compare : forall x y,
-   w_compare x y = Z.compare [|x|] [|y|].
-  Variable spec_ww_compare : forall x y,
-   ww_compare x y = Z.compare [[x]] [[y]].
-  Variable spec_ww_digits : ww_Digits = xO w_digits.
-  Variable spec_w_head00  : forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits.
-  Variable spec_w_head0  : forall x,  0 < [|x|] ->
-	 wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB.
-  Variable spec_w_tail00  : forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits.
-  Variable spec_w_tail0 : forall x, 0 < [|x|] ->
-         exists y, 0 <= y /\ [|x|] = (2* y + 1) * (2 ^ [|w_tail0 x|]).
-  Variable spec_w_add_mul_div : forall x y p,
-       [|p|] <= Zpos w_digits ->
-       [| w_add_mul_div p x y |] =
-         ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB.
- Variable spec_w_add: forall x y,
-   [[w_add x y]] = [|x|] + [|y|].
- Variable spec_ww_sub: forall x y,
-   [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB.
-
- Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits.
- Variable spec_low: forall x, [| low x|] = [[x]] mod wB.
-
- Variable spec_ww_zdigits : [[ww_zdigits]] = Zpos ww_Digits.
-
-  Hint Resolve div_le_0 div_lt w_to_Z_wwB: lift.
-  Ltac zarith := auto with zarith lift.
-
-  Lemma spec_ww_head00  : forall x, [[x]] = 0 -> [[ww_head0 x]] = Zpos ww_Digits.
-  Proof.
-  intros x; case x; unfold ww_head0.
-    intros HH; rewrite spec_ww_zdigits; auto.
-  intros xh xl; simpl; intros Hx.
-  case (spec_to_Z xh); intros Hx1 Hx2.
-  case (spec_to_Z xl); intros Hy1 Hy2.
-  assert (F1: [|xh|] = 0).
-  { Z.le_elim Hy1; auto.
-    - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-      apply Z.lt_le_trans with (1 := Hy1); auto with zarith.
-      pattern [|xl|] at 1; rewrite <- (Z.add_0_l [|xl|]).
-      apply Z.add_le_mono_r; auto with zarith.
-    - Z.le_elim Hx1; auto.
-      absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-      rewrite <- Hy1; rewrite Z.add_0_r; auto with zarith.
-      apply Z.mul_pos_pos; auto with zarith. }
-  rewrite spec_compare. case Z.compare_spec.
-    intros H; simpl.
-    rewrite spec_w_add; rewrite spec_w_head00.
-    rewrite spec_zdigits; rewrite spec_ww_digits.
-    rewrite Pos2Z.inj_xO; auto with zarith.
-  rewrite F1 in Hx; auto with zarith.
-  rewrite spec_w_0; auto with zarith.
-  rewrite spec_w_0; auto with zarith.
-  Qed.
-
-  Lemma spec_ww_head0  : forall x,  0 < [[x]] ->
-	 wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB.
-  Proof.
-   clear spec_ww_zdigits.
-   rewrite wwB_div_2;rewrite Z.mul_comm;rewrite wwB_wBwB.
-   assert (U:= lt_0_wB w_digits); destruct x as [ |xh xl];simpl ww_to_Z;intros H.
-   unfold Z.lt in H;discriminate H.
-   rewrite spec_compare, spec_w_0. case Z.compare_spec; intros H0.
-   rewrite <- H0 in *. simpl Z.add. simpl in H.
-   case (spec_to_Z w_zdigits);
-     case (spec_to_Z (w_head0 xl)); intros HH1 HH2 HH3 HH4.
-   rewrite spec_w_add.
-   rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith.
-   case (spec_w_head0 H); intros H1 H2.
-   rewrite Z.pow_2_r; fold wB; rewrite <- Z.mul_assoc; split.
-     apply Z.mul_le_mono_nonneg_l; auto with zarith.
-   apply Z.mul_lt_mono_pos_l; auto with zarith.
-   assert (H1 := spec_w_head0 H0).
-   rewrite spec_w_0W.
-   split.
-   rewrite Z.mul_add_distr_l;rewrite Z.mul_assoc.
-   apply Z.le_trans with (2 ^ [|w_head0 xh|] * [|xh|] * wB).
-   rewrite Z.mul_comm; zarith.
-   assert (0 <= 2 ^ [|w_head0 xh|] * [|xl|]);zarith.
-   assert (H2:=spec_to_Z xl);apply Z.mul_nonneg_nonneg;zarith.
-   case (spec_to_Z (w_head0 xh)); intros H2 _.
-   generalize ([|w_head0 xh|]) H1 H2;clear H1 H2;
-     intros p H1 H2.
-   assert (Eq1 : 2^p < wB).
-     rewrite <- (Z.mul_1_r (2^p));apply Z.le_lt_trans with (2^p*[|xh|]);zarith.
-   assert (Eq2: p < Zpos w_digits).
-    destruct (Z.le_gt_cases (Zpos w_digits) p);trivial;contradict  Eq1.
-   apply Z.le_ngt;unfold base;apply Zpower_le_monotone;zarith.
-   assert (Zpos w_digits = p + (Zpos w_digits - p)). ring.
-   rewrite Z.pow_2_r.
-   unfold base at 2;rewrite H3;rewrite Zpower_exp;zarith.
-   rewrite <- Z.mul_assoc; apply Z.mul_lt_mono_pos_l; zarith.
-   rewrite <- (Z.add_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith.
-   apply Z.mul_lt_mono_pos_r with (2 ^ p); zarith.
-   rewrite <- Zpower_exp;zarith.
-   rewrite Z.mul_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith.
-   assert (H1 := spec_to_Z xh);zarith.
-  Qed.
-
-  Lemma spec_ww_tail00  : forall x, [[x]] = 0 -> [[ww_tail0 x]] = Zpos ww_Digits.
-  Proof.
-  intros x; case x; unfold ww_tail0.
-    intros HH; rewrite spec_ww_zdigits; auto.
-  intros xh xl; simpl; intros Hx.
-  case (spec_to_Z xh); intros Hx1 Hx2.
-  case (spec_to_Z xl); intros Hy1 Hy2.
-  assert (F1: [|xh|] = 0).
-  { Z.le_elim Hy1; auto.
-    - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-      apply Z.lt_le_trans with (1 := Hy1); auto with zarith.
-      pattern [|xl|] at 1; rewrite <- (Z.add_0_l [|xl|]).
-      apply Z.add_le_mono_r; auto with zarith.
-    - Z.le_elim Hx1; auto.
-      absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-      rewrite <- Hy1; rewrite Z.add_0_r; auto with zarith.
-      apply Z.mul_pos_pos; auto with zarith. }
-  assert (F2: [|xl|] = 0).
-    rewrite F1 in Hx; auto with zarith.
-  rewrite spec_compare; case Z.compare_spec.
-    intros H; simpl.
-    rewrite spec_w_add; rewrite spec_w_tail00; auto.
-    rewrite spec_zdigits; rewrite spec_ww_digits.
-    rewrite Pos2Z.inj_xO; auto with zarith.
-  rewrite spec_w_0; auto with zarith.
-  rewrite spec_w_0; auto with zarith.
-  Qed.
-
-  Lemma spec_ww_tail0  : forall x,  0 < [[x]] ->
-	 exists y, 0 <= y /\ [[x]] = (2 * y + 1) * 2 ^ [[ww_tail0 x]].
-  Proof.
-   clear spec_ww_zdigits.
-   destruct x as [ |xh xl];simpl ww_to_Z;intros H.
-   unfold Z.lt in H;discriminate H.
-   rewrite spec_compare, spec_w_0. case Z.compare_spec; intros H0.
-   rewrite <- H0; rewrite Z.add_0_r.
-   case (spec_to_Z (w_tail0 xh)); intros HH1 HH2.
-   generalize H; rewrite <- H0; rewrite Z.add_0_r; clear H; intros H.
-   case (@spec_w_tail0 xh).
-     apply Z.mul_lt_mono_pos_r with wB; auto with zarith.
-     unfold base; auto with zarith.
-   intros z (Hz1, Hz2); exists z; split; auto.
-   rewrite spec_w_add; rewrite (fun x => Z.add_comm [|x|]).
-   rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith.
-   rewrite Z.mul_assoc; rewrite <- Hz2; auto.
-
-   case (spec_to_Z (w_tail0 xh)); intros HH1 HH2.
-   case (spec_w_tail0 H0); intros z (Hz1, Hz2).
-   assert (Hp: [|w_tail0 xl|] < Zpos w_digits).
-     case (Z.le_gt_cases (Zpos w_digits) [|w_tail0 xl|]); auto; intros H1.
-     absurd (2 ^  (Zpos w_digits) <= 2 ^ [|w_tail0 xl|]).
-       apply Z.lt_nge.
-       case (spec_to_Z xl); intros HH3 HH4.
-       apply Z.le_lt_trans with (2 := HH4).
-       apply Z.le_trans with (1 * 2 ^ [|w_tail0 xl|]); auto with zarith.
-       rewrite Hz2.
-       apply Z.mul_le_mono_nonneg_r; auto with zarith.
-     apply Zpower_le_monotone; auto with zarith.
-   exists ([|xh|] * (2 ^ ((Zpos w_digits - [|w_tail0 xl|]) - 1)) + z); split.
-     apply Z.add_nonneg_nonneg; auto.
-     apply Z.mul_nonneg_nonneg; auto with zarith.
-     case (spec_to_Z xh); auto.
-   rewrite spec_w_0W.
-   rewrite (Z.mul_add_distr_l 2); rewrite <- Z.add_assoc.
-   rewrite Z.mul_add_distr_r; rewrite <- Hz2.
-   apply f_equal2 with (f := Z.add); auto.
-   rewrite (Z.mul_comm 2).
-   repeat rewrite <- Z.mul_assoc.
-   apply f_equal2 with (f := Z.mul); auto.
-   case (spec_to_Z (w_tail0 xl)); intros HH3 HH4.
-   pattern 2 at 2; rewrite <- Z.pow_1_r.
-   lazy beta; repeat rewrite <- Zpower_exp; auto with zarith.
-   unfold base; apply f_equal with (f := Z.pow 2); auto with zarith.
-
-   contradict H0; case (spec_to_Z xl); auto with zarith.
-  Qed.
-
-  Hint Rewrite Zdiv_0_l Z.mul_0_l Z.add_0_l Z.mul_0_r Z.add_0_r
-    spec_w_W0 spec_w_0W spec_w_WW spec_w_0
-    (wB_div w_digits w_to_Z spec_to_Z)
-    (wB_div_plus w_digits w_to_Z spec_to_Z) : w_rewrite.
-  Ltac w_rewrite := autorewrite with w_rewrite;trivial.
-
-  Lemma spec_ww_add_mul_div_aux : forall xh xl yh yl p,
-   let zdigits := w_0W w_zdigits in
-    [[p]] <= Zpos (xO w_digits) ->
-      [[match ww_compare p zdigits with
-        | Eq => w_WW xl yh
-        | Lt => w_WW (w_add_mul_div (low p) xh xl)
-                     (w_add_mul_div (low p) xl yh)
-        | Gt =>
-              let n := low (ww_sub p zdigits) in
-            w_WW (w_add_mul_div n xl yh) (w_add_mul_div n yh yl)
-        end]] =
-      ([[WW xh xl]] * (2^[[p]]) +
-       [[WW yh yl]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB.
-  Proof.
-   clear spec_ww_zdigits.
-   intros xh xl yh yl p zdigits;assert (HwwB := wwB_pos w_digits).
-   case (spec_to_w_Z p); intros Hv1 Hv2.
-   replace (Zpos (xO w_digits)) with (Zpos w_digits + Zpos w_digits).
-   2 : rewrite Pos2Z.inj_xO;ring.
-   replace (Zpos w_digits + Zpos w_digits - [[p]]) with
-     (Zpos w_digits + (Zpos w_digits - [[p]])). 2:ring.
-   intros Hp; assert (Hxh := spec_to_Z xh);assert (Hxl:=spec_to_Z xl);
-   assert (Hx := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl));
-   simpl in Hx;assert (Hyh := spec_to_Z yh);assert (Hyl:=spec_to_Z yl);
-   assert (Hy:=spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW yh yl));simpl in Hy.
-   rewrite spec_ww_compare; case Z.compare_spec; intros H1.
-   rewrite H1; unfold zdigits; rewrite spec_w_0W.
-   rewrite spec_zdigits; rewrite Z.sub_diag; rewrite Z.add_0_r.
-   simpl ww_to_Z; w_rewrite;zarith.
-   fold wB.
-   rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc;rewrite <- Z.add_assoc.
-   rewrite <- Z.pow_2_r.
-   rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|].
-   exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xl yh)). ring.
-   simpl ww_to_Z; w_rewrite;zarith.
-   assert (HH0: [|low p|] = [[p]]).
-     rewrite spec_low.
-     apply Zmod_small.
-     case (spec_to_w_Z p); intros HH1 HH2; split; auto.
-     generalize H1; unfold zdigits; rewrite spec_w_0W;
-      rewrite spec_zdigits; intros tmp.
-     apply Z.lt_le_trans with (1 := tmp).
-     unfold base.
-     apply Zpower2_le_lin; auto with zarith.
-   2: generalize H1; unfold zdigits; rewrite spec_w_0W;
-      rewrite spec_zdigits; auto with zarith.
-   generalize H1; unfold zdigits; rewrite spec_w_0W;
-      rewrite spec_zdigits; auto; clear H1; intros H1.
-   assert (HH: [|low p|] <= Zpos w_digits).
-     rewrite HH0; auto with zarith.
-   repeat rewrite spec_w_add_mul_div with (1 := HH).
-   rewrite HH0.
-   rewrite Z.mul_add_distr_r.
-   pattern ([|xl|] * 2 ^ [[p]]) at 2;
-   rewrite shift_unshift_mod with (n:= Zpos w_digits);fold wB;zarith.
-   replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite <- Z.add_assoc.
-   unfold base at 5;rewrite <- Zmod_shift_r;zarith.
-   unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits));
-   fold wB;fold wwB;zarith.
-   rewrite wwB_wBwB;rewrite Z.pow_2_r; rewrite  Zmult_mod_distr_r;zarith.
-   unfold ww_digits;rewrite Pos2Z.inj_xO;zarith. apply Z_mod_lt;zarith.
-   split;zarith. apply Zdiv_lt_upper_bound;zarith.
-   rewrite <- Zpower_exp;zarith.
-   ring_simplify ([[p]] + (Zpos w_digits - [[p]]));fold wB;zarith.
-   assert (Hv: [[p]] > Zpos w_digits).
-     generalize H1; clear H1.
-     unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits; auto with zarith.
-   clear H1.
-   assert (HH0: [|low (ww_sub p zdigits)|] = [[p]] - Zpos w_digits).
-     rewrite spec_low.
-     rewrite spec_ww_sub.
-     unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits.
-     rewrite <- Zmod_div_mod; auto with zarith.
-     rewrite Zmod_small; auto with zarith.
-     split; auto with zarith.
-     apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
-     unfold base; apply Zpower2_lt_lin; auto with zarith.
-     exists wB; unfold base.
-     unfold ww_digits; rewrite (Pos2Z.inj_xO w_digits).
-     rewrite <- Zpower_exp; auto with zarith.
-     apply f_equal with (f := fun x => 2 ^ x); auto with zarith.
-   assert (HH: [|low (ww_sub p zdigits)|] <= Zpos w_digits).
-     rewrite HH0; auto with zarith.
-   replace (Zpos w_digits + (Zpos w_digits - [[p]])) with
-       (Zpos w_digits - ([[p]] - Zpos w_digits)); zarith.
-   lazy zeta; simpl ww_to_Z; w_rewrite;zarith.
-   repeat rewrite spec_w_add_mul_div;zarith.
-   rewrite HH0.
-   pattern wB at 5;replace wB with
-    (2^(([[p]] - Zpos w_digits)
-         + (Zpos w_digits - ([[p]] - Zpos w_digits)))).
-   rewrite Zpower_exp;zarith. rewrite Z.mul_assoc.
-   rewrite Z_div_plus_l;zarith.
-   rewrite shift_unshift_mod with (a:= [|yh|]) (p:= [[p]] - Zpos w_digits)
-    (n := Zpos w_digits);zarith. fold wB.
-   set (u := [[p]] - Zpos w_digits).
-   replace [[p]] with (u + Zpos w_digits);zarith.
-   rewrite Zpower_exp;zarith. rewrite Z.mul_assoc. fold wB.
-   repeat rewrite Z.add_assoc. rewrite <- Z.mul_add_distr_r.
-   repeat rewrite <- Z.add_assoc.
-   unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits));
-   fold wB;fold wwB;zarith.
-   unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits)
-   (b:= Zpos w_digits);fold wB;fold wwB;zarith.
-   rewrite wwB_wBwB; rewrite Z.pow_2_r; rewrite  Zmult_mod_distr_r;zarith.
-   rewrite Z.mul_add_distr_r.
-   replace ([|xh|] * wB * 2 ^ u) with
-     ([|xh|]*2^u*wB). 2:ring.
-   repeat rewrite <- Z.add_assoc.
-   rewrite (Z.add_comm ([|xh|] * 2 ^ u * wB)).
-   rewrite Z_mod_plus;zarith. rewrite Z_mod_mult;zarith.
-   unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith.
-   unfold u; split;zarith.
-   split;zarith. unfold u; apply Zdiv_lt_upper_bound;zarith.
-   rewrite <- Zpower_exp;zarith.
-   fold u.
-   ring_simplify (u + (Zpos w_digits - u)); fold
-   wB;zarith. unfold ww_digits;rewrite Pos2Z.inj_xO;zarith.
-   unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith.
-   unfold u; split;zarith.
-   unfold u; split;zarith.
-   apply Zdiv_lt_upper_bound;zarith.
-   rewrite <- Zpower_exp;zarith.
-   fold u.
-   ring_simplify (u + (Zpos w_digits - u)); fold wB; auto with zarith.
-   unfold u;zarith.
-   unfold u;zarith.
-   set (u := [[p]] - Zpos w_digits).
-   ring_simplify (u + (Zpos w_digits - u)); fold wB; auto with zarith.
-  Qed.
-
-  Lemma spec_ww_add_mul_div : forall x y p,
-       [[p]] <= Zpos (xO w_digits) ->
-       [[ ww_add_mul_div p x y ]] =
-         ([[x]] * (2^[[p]]) +
-          [[y]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB.
-  Proof.
-   clear spec_ww_zdigits.
-   intros x y p H.
-   destruct x as [ |xh xl];
-   [assert (H1 := @spec_ww_add_mul_div_aux w_0 w_0)
-   |assert (H1 := @spec_ww_add_mul_div_aux xh xl)];
-   (destruct y as [ |yh yl];
-    [generalize (H1 w_0 w_0 p H) | generalize (H1 yh yl p H)];
-    clear H1;w_rewrite);simpl ww_add_mul_div.
-   replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial].
-   intros Heq;rewrite <- Heq;clear Heq; auto.
-   rewrite spec_ww_compare. case Z.compare_spec; intros H1; w_rewrite.
-   rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith.
-   generalize H1; w_rewrite; rewrite spec_zdigits; clear H1; intros H1.
-   assert (HH0: [|low p|] = [[p]]).
-     rewrite spec_low.
-     apply Zmod_small.
-     case (spec_to_w_Z p); intros HH1 HH2; split; auto.
-     apply Z.lt_le_trans with (1 := H1).
-     unfold base; apply Zpower2_le_lin; auto with zarith.
-   rewrite HH0; auto with zarith.
-   replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial].
-   intros Heq;rewrite <- Heq;clear Heq.
-   generalize (spec_ww_compare p (w_0W w_zdigits));
-     case ww_compare; intros H1; w_rewrite.
-   rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith.
-   rewrite Pos2Z.inj_xO in H;zarith.
-   assert (HH: [|low (ww_sub p (w_0W w_zdigits)) |] = [[p]] - Zpos w_digits).
-     symmetry in H1; change ([[p]] > [[w_0W w_zdigits]]) in H1.
-     revert H1.
-     rewrite spec_low.
-     rewrite spec_ww_sub; w_rewrite; intros H1.
-     rewrite <- Zmod_div_mod; auto with zarith.
-     rewrite Zmod_small; auto with zarith.
-     split; auto with zarith.
-     apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
-     unfold base; apply Zpower2_lt_lin; auto with zarith.
-     unfold base; auto with zarith.
-     unfold base; auto with zarith.
-     exists wB; unfold base.
-     unfold ww_digits; rewrite (Pos2Z.inj_xO w_digits).
-     rewrite <- Zpower_exp; auto with zarith.
-     apply f_equal with (f := fun x => 2 ^ x); auto with zarith.
-  case (spec_to_Z xh); auto with zarith.
-  Qed.
-
- End DoubleProof.
-
-End DoubleLift.
-
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
deleted file mode 100644
index b9901390..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
+++ /dev/null
@@ -1,621 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-
-Local Open Scope Z_scope.
-
-Section DoubleMul.
- Variable w : Type.
- Variable w_0 : w.
- Variable w_1 : w.
- Variable w_WW : w -> w -> zn2z w.
- Variable w_W0 : w -> zn2z w.
- Variable w_0W : w -> zn2z w.
- Variable w_compare : w -> w -> comparison.
- Variable w_succ : w -> w.
- Variable w_add_c : w -> w -> carry w.
- Variable w_add : w -> w -> w.
- Variable w_sub: w -> w -> w.
- Variable w_mul_c : w -> w -> zn2z w.
- Variable w_mul : w -> w -> w.
- Variable w_square_c : w -> zn2z w.
- Variable ww_add_c : zn2z w -> zn2z w -> carry (zn2z w).
- Variable ww_add   : zn2z w -> zn2z w -> zn2z w.
- Variable ww_add_carry : zn2z w -> zn2z w -> zn2z w.
- Variable ww_sub_c : zn2z w -> zn2z w -> carry (zn2z w).
- Variable ww_sub   : zn2z w -> zn2z w -> zn2z w.
-
- (* ** Multiplication ** *)
-
- (*   (xh*B+xl) (yh*B + yl)
-   xh*yh         = hh  = |hhh|hhl|B2
-   xh*yl +xl*yh  = cc  =     |cch|ccl|B
-   xl*yl         = ll  =         |llh|lll
-  *)
-
- Definition double_mul_c (cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w) x y :=
-  match x, y with
-  | W0, _ => W0
-  | _, W0 => W0
-  | WW xh xl, WW yh yl =>
-    let hh := w_mul_c xh yh in
-    let ll := w_mul_c xl yl in
-    let (wc,cc) := cross xh xl yh yl hh ll in
-    match cc with
-    | W0 => WW (ww_add hh (w_W0 wc)) ll
-    | WW cch ccl =>
-      match ww_add_c (w_W0 ccl) ll with
-      | C0 l => WW (ww_add hh (w_WW wc cch)) l
-      | C1 l => WW (ww_add_carry hh (w_WW wc cch)) l
-      end
-    end
-  end.
-
- Definition ww_mul_c :=
-  double_mul_c
-    (fun xh xl yh yl hh ll=>
-      match ww_add_c (w_mul_c xh yl) (w_mul_c xl yh) with
-      | C0 cc => (w_0, cc)
-      | C1 cc => (w_1, cc)
-      end).
-
- Definition w_2 := w_add w_1 w_1.
-
- Definition kara_prod xh xl yh yl hh ll :=
-    match ww_add_c hh ll with
-      C0 m =>
-         match w_compare xl xh with
-           Eq => (w_0, m)
-         | Lt =>
-           match w_compare yl yh with
-             Eq => (w_0, m)
-           | Lt => (w_0, ww_sub m (w_mul_c (w_sub xh xl) (w_sub yh yl)))
-           | Gt => match ww_add_c m (w_mul_c (w_sub xh xl) (w_sub yl yh)) with
-                      C1 m1 => (w_1, m1) | C0 m1 => (w_0, m1)
-                   end
-           end
-         | Gt =>
-           match w_compare yl yh with
-             Eq => (w_0, m)
-           | Lt => match ww_add_c m (w_mul_c (w_sub xl xh)  (w_sub yh yl)) with
-                      C1 m1 => (w_1, m1) | C0 m1 => (w_0, m1)
-                   end
-           | Gt => (w_0, ww_sub m (w_mul_c (w_sub xl xh)  (w_sub yl yh)))
-           end
-         end
-    | C1 m =>
-         match w_compare xl xh with
-           Eq => (w_1, m)
-         | Lt =>
-           match w_compare yl yh with
-             Eq => (w_1, m)
-           | Lt => match ww_sub_c m (w_mul_c (w_sub xh xl) (w_sub yh yl)) with
-                    C0 m1 => (w_1, m1) | C1 m1 => (w_0, m1)
-                   end
-           | Gt => match ww_add_c m (w_mul_c (w_sub xh xl) (w_sub yl yh)) with
-                      C1 m1 => (w_2, m1) | C0 m1 => (w_1, m1)
-                   end
-           end
-         | Gt =>
-           match w_compare yl yh with
-             Eq => (w_1, m)
-           | Lt => match ww_add_c m (w_mul_c (w_sub xl xh) (w_sub yh yl)) with
-                      C1 m1 => (w_2, m1) | C0 m1 => (w_1, m1)
-                   end
-           | Gt => match ww_sub_c m (w_mul_c (w_sub xl xh) (w_sub yl yh)) with
-                     C1 m1 => (w_0, m1) | C0 m1 => (w_1, m1)
-                   end
-           end
-         end
-    end.
-
- Definition ww_karatsuba_c :=  double_mul_c kara_prod.
-
- Definition ww_mul x y :=
-  match x, y with
-  | W0, _ => W0
-  | _, W0 => W0
-  | WW xh xl, WW yh yl =>
-    let ccl := w_add (w_mul xh yl) (w_mul xl yh) in
-    ww_add (w_W0 ccl) (w_mul_c xl yl)
-  end.
-
- Definition ww_square_c x  :=
-  match x with
-  | W0 => W0
-  | WW xh xl =>
-    let hh := w_square_c xh in
-    let ll := w_square_c xl in
-    let xhxl := w_mul_c xh xl in
-    let (wc,cc) :=
-      match ww_add_c xhxl xhxl with
-      | C0 cc => (w_0, cc)
-      | C1 cc => (w_1, cc)
-      end in
-    match cc with
-    | W0 => WW (ww_add hh (w_W0 wc)) ll
-    | WW cch ccl =>
-      match ww_add_c (w_W0 ccl) ll with
-      | C0 l => WW (ww_add hh (w_WW wc cch)) l
-      | C1 l => WW (ww_add_carry hh (w_WW wc cch)) l
-      end
-    end
-  end.
-
- Section DoubleMulAddn1.
-  Variable w_mul_add : w -> w -> w -> w * w.
-
-  Fixpoint double_mul_add_n1 (n:nat) : word w n -> w -> w -> w * word w n :=
-   match n return word w n -> w -> w -> w * word w n with
-   | O => w_mul_add
-   | S n1 =>
-     let mul_add := double_mul_add_n1 n1 in
-     fun x y r =>
-     match x with
-     | W0 => (w_0,extend w_0W n1 r)
-     | WW xh xl =>
-       let (rl,l) := mul_add xl y r in
-       let (rh,h) := mul_add xh y rl in
-       (rh, double_WW w_WW n1 h l)
-     end
-   end.
-
- End DoubleMulAddn1.
-
- Section DoubleMulAddmn1.
-  Variable wn: Type.
-  Variable extend_n : w -> wn.
-  Variable wn_0W : wn -> zn2z wn.
-  Variable wn_WW : wn -> wn -> zn2z wn.
-  Variable w_mul_add_n1 : wn -> w -> w -> w*wn.
-  Fixpoint double_mul_add_mn1 (m:nat) :
-	word wn m -> w -> w -> w*word wn m :=
-   match m return word wn m -> w -> w -> w*word wn m with
-   | O => w_mul_add_n1
-   | S m1 =>
-     let mul_add := double_mul_add_mn1 m1 in
-     fun x y r =>
-     match x with
-     | W0 => (w_0,extend wn_0W m1 (extend_n r))
-     | WW xh xl =>
-       let (rl,l) := mul_add xl y r in
-       let (rh,h) := mul_add xh y rl in
-       (rh, double_WW wn_WW m1 h l)
-     end
-   end.
-
- End DoubleMulAddmn1.
-
- Definition w_mul_add x y r :=
-  match w_mul_c x y with
-  | W0 => (w_0, r)
-  | WW h l =>
-    match w_add_c l r with
-    | C0 lr => (h,lr)
-    | C1 lr => (w_succ h, lr)
-    end
-  end.
-
-
- (*Section DoubleProof. *)
-  Variable w_digits : positive.
-  Variable w_to_Z : w -> Z.
-
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[+| c |]" :=
-   (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
-  Notation "[-| c |]" :=
-   (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
-
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-  Notation "[+[ c ]]" :=
-   (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-  Notation "[-[ c ]]" :=
-   (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-
-  Notation "[|| x ||]" :=
-    (zn2z_to_Z wwB (ww_to_Z w_digits w_to_Z) x)  (at level 0, x at level 99).
-
-  Notation "[! n | x !]" := (double_to_Z w_digits w_to_Z n x)
-    (at level 0, x at level 99).
-
-  Variable spec_more_than_1_digit: 1 < Zpos w_digits.
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_w_1   : [|w_1|] = 1.
-
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-  Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB.
-  Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
-  Variable spec_w_compare :
-     forall x y, w_compare x y = Z.compare [|x|] [|y|].
-  Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB.
-  Variable spec_w_add_c  : forall x y, [+|w_add_c x y|] = [|x|] + [|y|].
-  Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB.
-  Variable spec_w_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
-
-  Variable spec_w_mul_c : forall x y, [[ w_mul_c x y ]] = [|x|] * [|y|].
-  Variable spec_w_mul : forall x y, [|w_mul x y|] = ([|x|] * [|y|]) mod wB.
-  Variable spec_w_square_c : forall x, [[ w_square_c x]] = [|x|] * [|x|].
-
-  Variable spec_ww_add_c  : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]].
-  Variable spec_ww_add : forall x y, [[ww_add x y]] = ([[x]] + [[y]]) mod wwB.
-  Variable spec_ww_add_carry :
-	 forall x y, [[ww_add_carry x y]] = ([[x]] + [[y]] + 1) mod wwB.
-  Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB.
-  Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]].
-
-
-  Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB.
-  Proof. intros x;apply spec_ww_to_Z;auto. Qed.
-
-  Lemma spec_ww_to_Z_wBwB : forall x, 0 <= [[x]] < wB^2.
-  Proof. rewrite <- wwB_wBwB;apply spec_ww_to_Z. Qed.
-
-  Hint Resolve spec_ww_to_Z spec_ww_to_Z_wBwB : mult.
-  Ltac zarith := auto with zarith mult.
-
-  Lemma wBwB_lex: forall a b c d,
-      a * wB^2 + [[b]] <= c * wB^2 + [[d]] ->
-      a <= c.
-  Proof.
-   intros a b c d H; apply beta_lex with [[b]] [[d]] (wB^2);zarith.
-  Qed.
-
-  Lemma wBwB_lex_inv: forall a b c d,
-      a < c ->
-      a * wB^2 + [[b]] < c * wB^2 + [[d]].
-  Proof.
-   intros a b c d H; apply beta_lex_inv; zarith.
-  Qed.
-
-  Lemma sum_mul_carry : forall xh xl yh yl wc cc,
-   [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] ->
-   0 <= [|wc|] <= 1.
-  Proof.
-   intros.
-   apply (sum_mul_carry [|xh|] [|xl|] [|yh|] [|yl|] [|wc|][[cc]] wB);zarith.
-   apply wB_pos.
-  Qed.
-
-  Theorem mult_add_ineq: forall xH yH crossH,
-               0 <= [|xH|] * [|yH|] + [|crossH|] < wwB.
-  Proof.
-   intros;rewrite wwB_wBwB;apply mult_add_ineq;zarith.
-  Qed.
-
-  Hint Resolve mult_add_ineq : mult.
-
-  Lemma spec_mul_aux : forall xh xl yh yl wc (cc:zn2z w) hh ll,
-   [[hh]] = [|xh|] * [|yh|] ->
-   [[ll]] = [|xl|] * [|yl|] ->
-   [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] ->
-    [||match cc with
-      | W0 => WW (ww_add hh (w_W0 wc)) ll
-      | WW cch ccl =>
-          match ww_add_c (w_W0 ccl) ll with
-          | C0 l => WW (ww_add hh (w_WW wc cch)) l
-          | C1 l => WW (ww_add_carry hh (w_WW wc cch)) l
-          end
-      end||] = ([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|]).
-  Proof.
-   intros;assert (U1 := wB_pos w_digits).
-   replace (([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|])) with
-   ([|xh|]*[|yh|]*wB^2 + ([|xh|]*[|yl|] + [|xl|]*[|yh|])*wB + [|xl|]*[|yl|]).
-   2:ring. rewrite <- H1;rewrite <- H;rewrite <- H0.
-   assert (H2 := sum_mul_carry _ _ _ _ _ _ H1).
-   destruct cc as [ | cch ccl]; simpl zn2z_to_Z; simpl ww_to_Z.
-   rewrite spec_ww_add;rewrite spec_w_W0;rewrite Zmod_small;
-    rewrite wwB_wBwB. ring.
-   rewrite <- (Z.add_0_r ([|wc|]*wB));rewrite H;apply mult_add_ineq3;zarith.
-   simpl ww_to_Z in H1. assert (U:=spec_to_Z cch).
-   assert ([|wc|]*wB + [|cch|] <= 2*wB - 3).
-    destruct (Z_le_gt_dec ([|wc|]*wB + [|cch|]) (2*wB - 3)) as [Hle|Hgt];trivial.
-    assert ([|xh|] * [|yl|] + [|xl|] * [|yh|] <= (2*wB - 4)*wB + 2).
-     ring_simplify ((2*wB - 4)*wB + 2).
-     assert (H4 := Zmult_lt_b _ _ _ (spec_to_Z xh) (spec_to_Z yl)).
-     assert (H5 := Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)).
-     omega.
-   generalize H3;clear H3;rewrite <- H1.
-   rewrite Z.add_assoc; rewrite Z.pow_2_r; rewrite Z.mul_assoc;
-     rewrite <- Z.mul_add_distr_r.
-    assert (((2 * wB - 4) + 2)*wB <= ([|wc|] * wB + [|cch|])*wB).
-     apply Z.mul_le_mono_nonneg;zarith.
-    rewrite Z.mul_add_distr_r in H3.
-    intros. assert (U2 := spec_to_Z ccl);omega.
-   generalize (spec_ww_add_c (w_W0 ccl) ll);destruct (ww_add_c (w_W0 ccl) ll)
-   as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Z.mul_1_l;
-   simpl zn2z_to_Z;
-   try rewrite spec_ww_add;try rewrite spec_ww_add_carry;rewrite spec_w_WW;
-   rewrite Zmod_small;rewrite wwB_wBwB;intros.
-   rewrite H4;ring. rewrite H;apply mult_add_ineq2;zarith.
-   rewrite Z.add_assoc;rewrite Z.mul_add_distr_r.
-   rewrite Z.mul_1_l;rewrite <- Z.add_assoc;rewrite H4;ring.
-   repeat rewrite <- Z.add_assoc;rewrite H;apply mult_add_ineq2;zarith.
-  Qed.
-
-  Lemma spec_double_mul_c : forall cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w,
-     (forall xh xl yh yl hh ll,
-        [[hh]] = [|xh|]*[|yh|] ->
-        [[ll]] = [|xl|]*[|yl|] ->
-        let (wc,cc) :=  cross xh xl yh yl hh ll in
-        [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]) ->
-     forall x y, [||double_mul_c cross x y||] = [[x]] * [[y]].
-  Proof.
-   intros cross Hcross x y;destruct x as [ |xh xl];simpl;trivial.
-   destruct y as [ |yh yl];simpl. rewrite Z.mul_0_r;trivial.
-   assert (H1:= spec_w_mul_c xh yh);assert (H2:= spec_w_mul_c xl yl).
-   generalize (Hcross _ _ _ _ _ _ H1 H2).
-   destruct (cross xh xl yh yl (w_mul_c xh yh) (w_mul_c xl yl)) as (wc,cc).
-   intros;apply spec_mul_aux;trivial.
-   rewrite <- wwB_wBwB;trivial.
-  Qed.
-
-  Lemma spec_ww_mul_c : forall x y, [||ww_mul_c x y||] = [[x]] * [[y]].
-  Proof.
-   intros x y;unfold ww_mul_c;apply spec_double_mul_c.
-   intros xh xl yh yl hh ll H1 H2.
-   generalize (spec_ww_add_c (w_mul_c xh yl) (w_mul_c xl yh));
-   destruct (ww_add_c (w_mul_c xh yl) (w_mul_c xl yh)) as [c|c];
-   unfold interp_carry;repeat rewrite spec_w_mul_c;intros H;
-   (rewrite spec_w_0 || rewrite spec_w_1);rewrite H;ring.
-  Qed.
-
-  Lemma spec_w_2: [|w_2|] = 2.
-  unfold w_2; rewrite spec_w_add; rewrite spec_w_1; simpl.
-  apply Zmod_small; split; auto with zarith.
-  rewrite <- (Z.pow_1_r 2); unfold base; apply Zpower_lt_monotone; auto with zarith.
-  Qed.
-
-  Lemma kara_prod_aux : forall xh xl yh yl,
-   xh*yh + xl*yl - (xh-xl)*(yh-yl) = xh*yl + xl*yh.
-  Proof. intros;ring. Qed.
-
-  Lemma spec_kara_prod : forall xh xl yh yl hh ll,
-   [[hh]] = [|xh|]*[|yh|] ->
-   [[ll]] = [|xl|]*[|yl|] ->
-   let (wc,cc) := kara_prod xh xl yh yl hh ll in
-   [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|].
-  Proof.
-   intros xh xl yh yl hh ll H H0; rewrite <- kara_prod_aux;
-     rewrite <- H; rewrite <- H0; unfold kara_prod.
-   assert (Hxh := (spec_to_Z xh)); assert (Hxl := (spec_to_Z xl));
-     assert (Hyh := (spec_to_Z yh)); assert (Hyl := (spec_to_Z yl)).
-   generalize (spec_ww_add_c hh ll); case (ww_add_c hh ll);
-     intros z Hz; rewrite <- Hz; unfold interp_carry; assert (Hz1 := (spec_ww_to_Z z)).
-   rewrite spec_w_compare; case Z.compare_spec; intros Hxlh;
-    try rewrite Hxlh; try rewrite spec_w_0; try (ring; fail).
-   rewrite spec_w_compare; case Z.compare_spec; intros Hylh.
-   rewrite Hylh; rewrite spec_w_0; try (ring; fail).
-   rewrite spec_w_0; try (ring; fail).
-   repeat (rewrite spec_ww_sub || rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   split; auto with zarith.
-   simpl in Hz; rewrite Hz; rewrite H; rewrite H0.
-   rewrite kara_prod_aux; apply Z.add_nonneg_nonneg; apply Z.mul_nonneg_nonneg; auto with zarith.
-   apply Z.le_lt_trans with ([[z]]-0); auto with zarith.
-   unfold Z.sub; apply Z.add_le_mono_l; apply Z.le_0_sub; simpl; rewrite Z.opp_involutive.
-   apply Z.mul_nonneg_nonneg; auto with zarith.
-   match goal with |- context[ww_add_c ?x ?y] =>
-     generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_0;
-     intros z1 Hz2
-   end.
-   simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_1; unfold interp_carry in Hz2; rewrite Hz2;
-     repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_compare; case Z.compare_spec; intros Hylh.
-   rewrite Hylh; rewrite spec_w_0; try (ring; fail).
-   match goal with |- context[ww_add_c ?x ?y] =>
-     generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_0;
-     intros z1 Hz2
-   end.
-   simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_1; unfold interp_carry in Hz2; rewrite Hz2;
-     repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_0; try (ring; fail).
-   repeat (rewrite spec_ww_sub || rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   split.
-   match goal with |- context[(?x - ?y) * (?z - ?t)] =>
-     replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring]
-   end.
-   simpl in Hz; rewrite Hz; rewrite H; rewrite H0.
-   rewrite kara_prod_aux; apply Z.add_nonneg_nonneg; apply Z.mul_nonneg_nonneg; auto with zarith.
-   apply Z.le_lt_trans with ([[z]]-0); auto with zarith.
-   unfold Z.sub; apply Z.add_le_mono_l; apply Z.le_0_sub; simpl; rewrite Z.opp_involutive.
-   apply Z.mul_nonneg_nonneg; auto with zarith.
-   (** there is a carry in hh + ll **)
-   rewrite Z.mul_1_l.
-   rewrite spec_w_compare; case Z.compare_spec; intros Hxlh;
-    try rewrite Hxlh; try rewrite spec_w_1; try (ring; fail).
-   rewrite spec_w_compare; case Z.compare_spec; intros Hylh;
-     try rewrite Hylh; try rewrite spec_w_1; try (ring; fail).
-   match goal with |- context[ww_sub_c ?x ?y] =>
-     generalize (spec_ww_sub_c x y); case (ww_sub_c x y); try rewrite spec_w_1;
-     intros z1 Hz2
-   end.
-   simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_0; rewrite Z.mul_0_l; rewrite Z.add_0_l.
-   generalize Hz2; clear Hz2; unfold interp_carry.
-   repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   match goal with |- context[ww_add_c ?x ?y] =>
-     generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_1;
-     intros z1 Hz2
-   end.
-   simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_2; unfold interp_carry in Hz2.
-   transitivity (wwB + (1 * wwB + [[z1]])).
-   ring.
-   rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_compare; case Z.compare_spec; intros Hylh;
-     try rewrite Hylh; try rewrite spec_w_1; try (ring; fail).
-   match goal with |- context[ww_add_c ?x ?y] =>
-     generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_1;
-     intros z1 Hz2
-   end.
-   simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_2; unfold interp_carry in Hz2.
-   transitivity (wwB + (1 * wwB + [[z1]])).
-   ring.
-   rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   match goal with |- context[ww_sub_c ?x ?y] =>
-     generalize (spec_ww_sub_c x y); case (ww_sub_c x y); try rewrite spec_w_1;
-     intros z1 Hz2
-   end.
-   simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_0; rewrite Z.mul_0_l; rewrite Z.add_0_l.
-   match goal with |- context[(?x - ?y) * (?z - ?t)] =>
-     replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring]
-   end.
-   generalize Hz2; clear Hz2; unfold interp_carry.
-   repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
-   repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-  Qed.
-
-  Lemma sub_carry : forall xh xl yh yl z,
-    0 <= z ->
-    [|xh|]*[|yl|] + [|xl|]*[|yh|] = wwB + z ->
-    z < wwB.
-  Proof.
-   intros xh xl yh yl z Hle Heq.
-   destruct (Z_le_gt_dec wwB z);auto with zarith.
-   generalize (Zmult_lt_b _ _ _ (spec_to_Z xh) (spec_to_Z yl)).
-   generalize (Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)).
-   rewrite <- wwB_wBwB;intros H1 H2.
-   assert (H3 := wB_pos w_digits).
-   assert (2*wB <= wwB).
-    rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_le_mono_nonneg;zarith.
-   omega.
-  Qed.
-
-  Ltac Spec_ww_to_Z x :=
-   let H:= fresh "H" in
-   assert (H:= spec_ww_to_Z x).
-
-  Ltac Zmult_lt_b x y :=
-   let H := fresh "H" in
-   assert (H := Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)).
-
-  Lemma spec_ww_karatsuba_c : forall x y, [||ww_karatsuba_c x y||]=[[x]]*[[y]].
-  Proof.
-   intros x y; unfold ww_karatsuba_c;apply spec_double_mul_c.
-   intros; apply spec_kara_prod; auto.
-  Qed.
-
-  Lemma spec_ww_mul : forall x y, [[ww_mul x y]] = [[x]]*[[y]] mod wwB.
-  Proof.
-   assert (U:= lt_0_wB w_digits).
-   assert (U1:= lt_0_wwB w_digits).
-   intros x y; case x; auto; intros xh xl.
-   case y; auto.
-   simpl; rewrite Z.mul_0_r; rewrite Zmod_small; auto with zarith.
-   intros yh yl;simpl.
-   repeat (rewrite spec_ww_add || rewrite spec_w_W0 || rewrite spec_w_mul_c
-    || rewrite spec_w_add || rewrite spec_w_mul).
-   rewrite <- Zplus_mod; auto with zarith.
-   repeat (rewrite Z.mul_add_distr_r || rewrite Z.mul_add_distr_l).
-   rewrite <- Zmult_mod_distr_r; auto with zarith.
-   rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB; auto with zarith.
-   rewrite Zplus_mod; auto with zarith.
-   rewrite Zmod_mod; auto with zarith.
-   rewrite <- Zplus_mod; auto with zarith.
-   match goal with |- ?X mod _ = _ =>
-     rewrite <- Z_mod_plus with (a := X) (b := [|xh|] * [|yh|])
-   end; auto with zarith.
-   f_equal; auto; rewrite wwB_wBwB; ring.
-  Qed.
-
-  Lemma spec_ww_square_c : forall x, [||ww_square_c x||] = [[x]]*[[x]].
-  Proof.
-   destruct x as [ |xh xl];simpl;trivial.
-   case_eq match ww_add_c (w_mul_c xh xl) (w_mul_c xh xl) with
-          | C0 cc => (w_0, cc)
-          | C1 cc => (w_1, cc)
-          end;intros wc cc Heq.
-   apply (spec_mul_aux xh xl xh xl wc cc);trivial.
-   generalize Heq (spec_ww_add_c (w_mul_c xh xl) (w_mul_c xh xl));clear Heq.
-   rewrite spec_w_mul_c;destruct (ww_add_c (w_mul_c xh xl) (w_mul_c xh xl));
-   unfold interp_carry;try rewrite Z.mul_1_l;intros Heq Heq';inversion Heq;
-   rewrite (Z.mul_comm [|xl|]);subst.
-   rewrite spec_w_0;rewrite Z.mul_0_l;rewrite Z.add_0_l;trivial.
-   rewrite spec_w_1;rewrite Z.mul_1_l;rewrite <- wwB_wBwB;trivial.
-  Qed.
-
-  Section DoubleMulAddn1Proof.
-
-   Variable w_mul_add : w -> w -> w -> w * w.
-   Variable spec_w_mul_add : forall x y r,
-    let (h,l):= w_mul_add x y r in
-    [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|].
-
-   Lemma spec_double_mul_add_n1 : forall n x y r,
-     let (h,l) := double_mul_add_n1 w_mul_add n x y r in
-     [|h|]*double_wB w_digits n + [!n|l!] = [!n|x!]*[|y|]+[|r|].
-   Proof.
-    induction n;intros x y r;trivial.
-    exact (spec_w_mul_add x y r).
-    unfold double_mul_add_n1;destruct x as[ |xh xl];
-     fold(double_mul_add_n1 w_mul_add).
-    rewrite spec_w_0;rewrite spec_extend;simpl;trivial.
-    assert(H:=IHn xl y r);destruct (double_mul_add_n1 w_mul_add n xl y r)as(rl,l).
-   assert(U:=IHn xh y rl);destruct(double_mul_add_n1 w_mul_add n xh y rl)as(rh,h).
-    rewrite <- double_wB_wwB. rewrite spec_double_WW;simpl;trivial.
-    rewrite Z.mul_add_distr_r;rewrite <- Z.add_assoc;rewrite <- H.
-    rewrite Z.mul_assoc;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-    rewrite U;ring.
-   Qed.
-
-  End DoubleMulAddn1Proof.
-
-  Lemma spec_w_mul_add : forall x y r,
-    let (h,l):= w_mul_add x y r in
-    [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|].
-  Proof.
-   intros x y r;unfold w_mul_add;assert (H:=spec_w_mul_c x y);
-   destruct (w_mul_c x y) as [ |h l];simpl;rewrite <- H.
-   rewrite spec_w_0;trivial.
-   assert (U:=spec_w_add_c l r);destruct (w_add_c l r) as [lr|lr];unfold
-   interp_carry in U;try rewrite Z.mul_1_l in H;simpl.
-   rewrite U;ring. rewrite spec_w_succ. rewrite Zmod_small.
-   rewrite <- Z.add_assoc;rewrite <- U;ring.
-   simpl in H;assert (H1:= Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)).
-   rewrite <- H in H1.
-   assert (H2:=spec_to_Z h);split;zarith.
-   case H1;clear H1;intro H1;clear H1.
-   replace (wB ^ 2 - 2 * wB) with ((wB - 2)*wB). 2:ring.
-   intros H0;assert (U1:= wB_pos w_digits).
-   assert (H1 := beta_lex _ _ _ _ _ H0 (spec_to_Z l));zarith.
-  Qed.
-
-(* End DoubleProof. *)
-
-End DoubleMul.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
deleted file mode 100644
index d07ce301..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
+++ /dev/null
@@ -1,1369 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-
-Local Open Scope Z_scope.
-
-Section DoubleSqrt.
- Variable w              : Type.
- Variable w_is_even      : w -> bool.
- Variable w_compare      : w -> w -> comparison.
- Variable w_0            : w.
- Variable w_1            : w.
- Variable w_Bm1          : w.
- Variable w_WW           : w -> w -> zn2z w.
- Variable w_W0           : w -> zn2z w.
- Variable w_0W           : w -> zn2z w.
- Variable w_sub          : w -> w -> w.
- Variable w_sub_c        : w -> w -> carry w.
- Variable w_square_c     : w -> zn2z w.
- Variable w_div21        : w -> w -> w -> w * w.
- Variable w_add_mul_div  : w -> w -> w -> w.
- Variable w_digits       : positive.
- Variable w_zdigits      : w.
- Variable ww_zdigits     : zn2z w.
- Variable w_add_c        : w -> w -> carry w.
- Variable w_sqrt2        : w -> w -> w * carry w.
- Variable w_pred         : w -> w.
- Variable ww_pred_c      : zn2z w -> carry (zn2z w).
- Variable ww_pred        : zn2z w -> zn2z w.
- Variable ww_add_c       : zn2z w -> zn2z w -> carry (zn2z w).
- Variable ww_add         : zn2z w -> zn2z w -> zn2z w.
- Variable ww_sub_c       : zn2z w -> zn2z w -> carry (zn2z w).
- Variable ww_add_mul_div : zn2z w -> zn2z w -> zn2z w -> zn2z w.
- Variable ww_head0       : zn2z w -> zn2z w.
- Variable ww_compare     : zn2z w -> zn2z w -> comparison.
- Variable low            : zn2z w -> w.
-
- Let wwBm1 := ww_Bm1 w_Bm1.
-
- Definition ww_is_even x :=
-   match x with
-   | W0 => true
-   | WW xh xl => w_is_even xl
-   end.
-
- Let w_div21c x y z :=
-   match w_compare x z with
-   | Eq =>
-      match w_compare y z with
-        Eq => (C1 w_1, w_0)
-      | Gt => (C1 w_1, w_sub y z)
-      | Lt => (C1 w_0, y)
-      end
-   | Gt =>
-      let x1 := w_sub x z in
-      let (q, r) := w_div21 x1 y z in
-        (C1 q, r)
-   | Lt =>
-      let (q, r) := w_div21 x y z in
-        (C0 q, r)
-   end.
-
- Let w_div2s x y s :=
-  match x with
-   C1 x1 =>
-     let x2 := w_sub x1 s in
-     let (q, r) := w_div21c x2 y s in
-     match q with
-       C0 q1 =>
-         if w_is_even q1 then
-          (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), C0 r)
-         else
-          (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), w_add_c r s)
-     | C1 q1 =>
-         if w_is_even q1 then
-          (C1 (w_add_mul_div (w_pred w_zdigits) w_0 q1), C0 r)
-         else
-          (C1 (w_add_mul_div (w_pred w_zdigits) w_0 q1), w_add_c r s)
-     end
-  | C0 x1 =>
-     let (q, r) := w_div21c x1 y s in
-     match q with
-       C0 q1 =>
-         if w_is_even q1 then
-          (C0 (w_add_mul_div (w_pred w_zdigits) w_0 q1), C0 r)
-         else
-          (C0 (w_add_mul_div (w_pred w_zdigits) w_0 q1), w_add_c r s)
-     | C1 q1 =>
-         if w_is_even q1 then
-          (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), C0 r)
-         else
-          (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), w_add_c r s)
-     end
-  end.
-
- Definition split x :=
- match x with
-  | W0 => (w_0,w_0)
-  | WW h l => (h,l)
-  end.
-
- Definition ww_sqrt2 x y :=
-   let (x1, x2) := split x in
-   let (y1, y2) := split y in
-   let ( q, r)  := w_sqrt2 x1 x2 in
-   let (q1, r1) := w_div2s r y1 q in
-   match q1 with
-     C0 q1 =>
-      let q2 := w_square_c q1 in
-      let a  := WW q q1 in
-        match r1 with
-          C1 r2 =>
-           match ww_sub_c (WW r2 y2) q2 with
-             C0 r3 => (a, C1 r3)
-           | C1 r3 => (a, C0 r3)
-           end
-        | C0 r2 =>
-           match ww_sub_c (WW r2 y2) q2 with
-             C0 r3 => (a, C0 r3)
-           | C1 r3 =>
-              let a2 := ww_add_mul_div (w_0W w_1) a W0 in
-              match ww_pred_c a2 with
-                C0 a3 =>
-                  (ww_pred a, ww_add_c a3 r3)
-              | C1 a3 =>
-                  (ww_pred a, C0 (ww_add a3 r3))
-              end
-            end
-         end
-   | C1 q1 =>
-         let a1 := WW q w_Bm1 in
-         let a2 := ww_add_mul_div (w_0W w_1) a1 wwBm1 in
-            (a1, ww_add_c a2 y)
-   end.
-
- Definition ww_is_zero x :=
-  match ww_compare W0 x with
-   Eq => true
-  | _ => false
-  end.
-
- Definition ww_head1 x :=
-   let p := ww_head0 x in
-   if (ww_is_even p) then p else ww_pred p.
-
- Definition ww_sqrt x :=
-   if (ww_is_zero x) then W0
-   else
-    let p := ww_head1 x in
-    match ww_compare p W0 with
-    | Gt =>
-        match ww_add_mul_div p x W0 with
-         W0 => W0
-       | WW x1 x2 =>
-          let (r, _) := w_sqrt2 x1 x2 in
-            WW w_0 (w_add_mul_div
-                     (w_sub w_zdigits
-                     (low (ww_add_mul_div (ww_pred ww_zdigits)
-                              W0 p))) w_0 r)
-        end
-     | _ =>
-        match x with
-          W0 => W0
-        | WW x1 x2 => WW w_0 (fst (w_sqrt2 x1 x2))
-        end
-    end.
-
-
-  Variable w_to_Z : w -> Z.
-
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[+| c |]" :=
-   (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
-  Notation "[-| c |]" :=
-   (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
-
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-  Notation "[+[ c ]]" :=
-   (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-  Notation "[-[ c ]]" :=
-   (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-
-  Notation "[|| x ||]" :=
-    (zn2z_to_Z wwB (ww_to_Z w_digits w_to_Z) x)  (at level 0, x at level 99).
-
-  Notation "[! n | x !]" := (double_to_Z w_digits w_to_Z n x)
-    (at level 0, x at level 99).
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_w_1   : [|w_1|] = 1.
-  Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1.
-  Variable spec_w_zdigits : [|w_zdigits|] = Zpos w_digits.
-  Variable spec_more_than_1_digit: 1 < Zpos w_digits.
-
-  Variable spec_ww_zdigits : [[ww_zdigits]] = Zpos (xO w_digits).
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_to_w_Z  : forall x, 0 <= [[x]] < wwB.
-
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-  Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB.
-  Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
-  Variable spec_w_is_even : forall x,
-      if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1.
-  Variable spec_w_compare : forall x y,
-       w_compare x y = Z.compare [|x|] [|y|].
- Variable spec_w_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
- Variable spec_w_square_c : forall x, [[ w_square_c x]] = [|x|] * [|x|].
- Variable spec_w_div21 : forall a1 a2 b,
-     wB/2 <= [|b|] ->
-     [|a1|] < [|b|] ->
-     let (q,r) := w_div21 a1 a2 b in
-     [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
-     0 <= [|r|] < [|b|].
- Variable spec_w_add_mul_div : forall x y p,
-        [|p|] <= Zpos w_digits ->
-       [| w_add_mul_div p x y |] =
-         ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (Z.pow 2 ((Zpos w_digits) - [|p|]))) mod wB.
- Variable spec_ww_add_mul_div : forall x y p,
-       [[p]] <= Zpos (xO w_digits) ->
-       [[ ww_add_mul_div p x y ]] =
-         ([[x]] * (2^ [[p]]) +
-          [[y]] / (2^ (Zpos (xO w_digits) - [[p]]))) mod wwB.
- Variable spec_w_add_c  : forall x y, [+|w_add_c x y|] = [|x|] + [|y|].
- Variable spec_ww_add : forall x y, [[ww_add x y]] = ([[x]] + [[y]]) mod wwB.
- Variable spec_w_sqrt2 : forall x y,
-       wB/ 4 <= [|x|] ->
-       let (s,r) := w_sqrt2 x y in
-          [[WW x y]] = [|s|] ^ 2 + [+|r|] /\
-          [+|r|] <= 2 * [|s|].
- Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]].
- Variable spec_ww_pred_c : forall x, [-[ww_pred_c x]] = [[x]] - 1.
- Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB.
- Variable spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB.
- Variable spec_ww_add_c  : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]].
- Variable spec_ww_compare : forall x y,
-    ww_compare x y = Z.compare [[x]] [[y]].
- Variable spec_ww_head0  : forall x,  0 < [[x]] ->
-	 wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB.
- Variable spec_low: forall x, [|low x|] = [[x]] mod wB.
-
- Let spec_ww_Bm1 : [[wwBm1]] = wwB - 1.
- Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed.
-
- Hint Rewrite spec_w_0 spec_w_1 spec_w_WW spec_w_sub
-   spec_w_add_mul_div spec_ww_Bm1 spec_w_add_c : w_rewrite.
-
- Lemma spec_ww_is_even : forall x,
-      if ww_is_even x then [[x]] mod 2 = 0 else [[x]] mod 2 = 1.
-clear spec_more_than_1_digit.
-intros x; case x; simpl ww_is_even.
- reflexivity.
- simpl.
- intros w1 w2; simpl.
- unfold base.
- rewrite Zplus_mod; auto with zarith.
- rewrite (fun x y => (Zdivide_mod (x * y))); auto with zarith.
- rewrite Z.add_0_l; rewrite Zmod_mod; auto with zarith.
- apply spec_w_is_even; auto with zarith.
- apply Z.divide_mul_r; apply Zpower_divide; auto with zarith.
- Qed.
-
-
- Theorem  spec_w_div21c : forall a1 a2 b,
-     wB/2 <= [|b|] ->
-     let (q,r) := w_div21c a1 a2 b in
-     [|a1|] * wB + [|a2|] = [+|q|] *  [|b|] + [|r|] /\ 0 <= [|r|] < [|b|].
- intros a1 a2 b Hb; unfold w_div21c.
- assert (H: 0 < [|b|]); auto with zarith.
- assert (U := wB_pos w_digits).
- apply Z.lt_le_trans with (2 := Hb); auto with zarith.
- apply Z.lt_le_trans with 1; auto with zarith.
- apply Zdiv_le_lower_bound; auto with zarith.
- rewrite !spec_w_compare. repeat case Z.compare_spec.
- intros H1 H2; split.
- unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith.
- rewrite H1; rewrite H2; ring.
- autorewrite with w_rewrite; auto with zarith.
- intros H1 H2; split.
- unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith.
- rewrite H2; ring.
- destruct (spec_to_Z a2);auto with zarith.
- intros H1 H2; split.
- unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith.
- rewrite H2; rewrite Zmod_small; auto with zarith.
- ring.
- destruct (spec_to_Z a2);auto with zarith.
- rewrite spec_w_sub; auto with zarith.
- destruct (spec_to_Z a2) as [H3 H4];auto with zarith.
- rewrite Zmod_small; auto with zarith.
- split; auto with zarith.
- assert ([|a2|] < 2 * [|b|]); auto with zarith.
- apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith.
- rewrite wB_div_2; auto.
- intros H1.
- match goal with |- context[w_div21 ?y ?z ?t] =>
-   generalize (@spec_w_div21 y z t Hb H1);
-   case (w_div21 y z t); simpl; autorewrite with w_rewrite;
-   auto
- end.
- intros H1.
- assert (H2: [|w_sub a1 b|] < [|b|]).
- rewrite spec_w_sub; auto with zarith.
- rewrite Zmod_small; auto with zarith.
- assert ([|a1|] < 2 * [|b|]); auto with zarith.
- apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith.
- rewrite wB_div_2; auto.
- destruct (spec_to_Z a1);auto with zarith.
- destruct (spec_to_Z a1);auto with zarith.
- match goal with |- context[w_div21 ?y ?z ?t] =>
-   generalize (@spec_w_div21 y z t Hb H2);
-   case (w_div21 y z t); autorewrite with w_rewrite;
-   auto
- end.
- intros w0 w1; replace [+|C1 w0|] with (wB + [|w0|]).
- rewrite Zmod_small; auto with zarith.
- intros (H3, H4); split; auto.
- rewrite Z.mul_add_distr_r.
- rewrite <- Z.add_assoc; rewrite <- H3; ring.
- split; auto with zarith.
- assert ([|a1|] < 2 * [|b|]); auto with zarith.
- apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith.
- rewrite wB_div_2; auto.
- destruct (spec_to_Z a1);auto with zarith.
- destruct (spec_to_Z a1);auto with zarith.
- simpl; case wB; auto.
- Qed.
-
- Theorem C0_id: forall p, [+|C0 p|] = [|p|].
- intros p; simpl; auto.
- Qed.
-
- Theorem add_mult_div_2: forall w,
-    [|w_add_mul_div (w_pred w_zdigits) w_0 w|] = [|w|] / 2.
- intros w1.
- assert (Hp: [|w_pred w_zdigits|] = Zpos w_digits - 1).
-   rewrite spec_pred; rewrite spec_w_zdigits.
-   rewrite Zmod_small; auto with zarith.
-   split; auto with zarith.
-   apply Z.lt_le_trans with (Zpos w_digits); auto with zarith.
-   unfold base; apply Zpower2_le_lin; auto with zarith.
- rewrite spec_w_add_mul_div; auto with zarith.
- autorewrite with w_rewrite rm10.
- match goal with |- context[?X - ?Y] =>
-  replace (X - Y) with 1
- end.
- rewrite Z.pow_1_r; rewrite Zmod_small; auto with zarith.
- destruct (spec_to_Z w1) as [H1 H2];auto with zarith.
- split; auto with zarith.
- apply Zdiv_lt_upper_bound; auto with zarith.
- rewrite Hp; ring.
- Qed.
-
- Theorem add_mult_div_2_plus_1: forall w,
-    [|w_add_mul_div (w_pred w_zdigits) w_1 w|] =
-      [|w|] / 2 + 2 ^ Zpos (w_digits - 1).
- intros w1.
- assert (Hp: [|w_pred w_zdigits|] = Zpos w_digits - 1).
-   rewrite spec_pred; rewrite spec_w_zdigits.
-   rewrite Zmod_small; auto with zarith.
-   split; auto with zarith.
-   apply Z.lt_le_trans with (Zpos w_digits); auto with zarith.
-   unfold base; apply Zpower2_le_lin; auto with zarith.
- autorewrite with w_rewrite rm10; auto with zarith.
- match goal with |- context[?X - ?Y] =>
-  replace (X - Y) with 1
- end; rewrite Hp; try ring.
- rewrite Pos2Z.inj_sub_max; auto with zarith.
- rewrite Z.max_r; auto with zarith.
- rewrite Z.pow_1_r; rewrite Zmod_small; auto with zarith.
- destruct (spec_to_Z w1) as [H1 H2];auto with zarith.
- split; auto with zarith.
- unfold base.
- match goal with |- _ < _ ^ ?X =>
- assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
-  rewrite <- (tmp X); clear tmp
- end.
- rewrite Zpower_exp; try rewrite Z.pow_1_r; auto with zarith.
- assert (tmp: forall p, 1 + (p -1) - 1 = p - 1); auto with zarith;
-  rewrite tmp; clear tmp; auto with zarith.
- match goal with |- ?X + ?Y < _ =>
- assert (Y < X); auto with zarith
- end.
- apply Zdiv_lt_upper_bound; auto with zarith.
- pattern 2 at 2; rewrite <- Z.pow_1_r; rewrite <- Zpower_exp;
-  auto with zarith.
- assert (tmp: forall p, (p - 1) + 1 = p); auto with zarith;
-  rewrite tmp; clear tmp; auto with zarith.
- Qed.
-
- Theorem add_mult_mult_2: forall w,
-    [|w_add_mul_div w_1 w w_0|] = 2 * [|w|] mod wB.
- intros w1.
- autorewrite with w_rewrite rm10; auto with zarith.
- rewrite Z.pow_1_r; auto with zarith.
- rewrite Z.mul_comm; auto.
- Qed.
-
- Theorem ww_add_mult_mult_2: forall w,
-    [[ww_add_mul_div (w_0W w_1) w W0]] = 2 * [[w]] mod wwB.
- intros w1.
- rewrite spec_ww_add_mul_div; auto with zarith.
- autorewrite with w_rewrite rm10.
- rewrite spec_w_0W; rewrite spec_w_1.
- rewrite Z.pow_1_r; auto with zarith.
- rewrite Z.mul_comm; auto.
- rewrite spec_w_0W; rewrite spec_w_1; auto with zarith.
- red; simpl; intros; discriminate.
- Qed.
-
- Theorem ww_add_mult_mult_2_plus_1: forall w,
-    [[ww_add_mul_div (w_0W w_1) w wwBm1]] =
-      (2 * [[w]] + 1) mod wwB.
- intros w1.
- rewrite spec_ww_add_mul_div; auto with zarith.
- rewrite spec_w_0W; rewrite spec_w_1; auto with zarith.
- rewrite Z.pow_1_r; auto with zarith.
- f_equal; auto.
- rewrite Z.mul_comm; f_equal; auto.
- autorewrite with w_rewrite rm10.
- unfold ww_digits, base.
- symmetry; apply Zdiv_unique with (r := 2 ^ (Zpos (ww_digits w_digits) - 1) -1);
-  auto with zarith.
- unfold ww_digits; split; auto with zarith.
- match goal with  |- 0 <= ?X - 1 =>
-   assert (0 < X); auto with zarith
- end.
- apply Z.pow_pos_nonneg; auto with zarith.
- match goal with  |- 0 <= ?X - 1 =>
-   assert (0 < X); auto with zarith; red; reflexivity
- end.
- unfold ww_digits; autorewrite with rm10.
- assert (tmp: forall p q r, p + (q - r) = p + q - r); auto with zarith;
-  rewrite tmp; clear tmp.
- assert (tmp: forall p, p + p = 2 * p); auto with zarith;
-  rewrite tmp; clear tmp.
- f_equal; auto.
- pattern 2 at 2; rewrite <- Z.pow_1_r; rewrite <- Zpower_exp;
-  auto with zarith.
- assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
-  rewrite tmp; clear tmp; auto.
- match goal with  |- ?X - 1 >= 0 =>
-   assert (0 < X); auto with zarith; red; reflexivity
- end.
- rewrite spec_w_0W; rewrite spec_w_1; auto with zarith.
- red; simpl; intros; discriminate.
- Qed.
-
- Theorem Zplus_mod_one: forall a1 b1, 0 < b1 -> (a1 + b1) mod b1 = a1 mod b1.
- intros a1 b1 H; rewrite Zplus_mod; auto with zarith.
- rewrite Z_mod_same; try rewrite Z.add_0_r; auto with zarith.
- apply Zmod_mod; auto.
- Qed.
-
- Lemma C1_plus_wB: forall x, [+|C1 x|] = wB + [|x|].
- unfold interp_carry; auto with zarith.
- Qed.
-
- Theorem  spec_w_div2s : forall a1 a2 b,
-     wB/2 <= [|b|] -> [+|a1|] <= 2 * [|b|] ->
-     let (q,r) := w_div2s a1 a2 b in
-     [+|a1|] * wB + [|a2|] = [+|q|] *  (2 * [|b|]) + [+|r|] /\ 0 <= [+|r|] < 2 * [|b|].
- intros a1 a2 b H.
- assert (HH: 0 < [|b|]); auto with zarith.
- assert (U := wB_pos w_digits).
- apply Z.lt_le_trans with (2 := H); auto with zarith.
- apply Z.lt_le_trans with 1; auto with zarith.
- apply Zdiv_le_lower_bound; auto with zarith.
- unfold w_div2s; case a1; intros w0 H0.
- match goal with |- context[w_div21c ?y ?z ?t] =>
-   generalize (@spec_w_div21c y z t H);
-   case (w_div21c y z t); autorewrite with w_rewrite;
-   auto
- end.
- intros c w1; case c.
- simpl interp_carry; intros w2 (Hw1, Hw2).
- match goal with |- context[w_is_even ?y] =>
-   generalize (spec_w_is_even y);
-   case (w_is_even y)
- end.
- repeat rewrite C0_id.
- rewrite add_mult_div_2.
- intros H1; split; auto with zarith.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1; ring.
- repeat rewrite C0_id.
- rewrite add_mult_div_2.
- rewrite spec_w_add_c; auto with zarith.
- intros H1; split; auto with zarith.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1; ring.
- intros w2; rewrite C1_plus_wB.
- intros (Hw1, Hw2).
- match goal with |- context[w_is_even ?y] =>
-   generalize (spec_w_is_even y);
-   case (w_is_even y)
- end.
- repeat rewrite C0_id.
- intros H1; split; auto with zarith.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1.
- repeat rewrite C0_id.
- rewrite add_mult_div_2_plus_1; unfold base.
- match goal with |- context[_ ^ ?X] =>
- assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
-  rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Z.pow_1_r; auto with zarith
- end.
- rewrite Pos2Z.inj_sub_max; auto with zarith.
- rewrite Z.max_r; auto with zarith.
- ring.
- repeat rewrite C0_id.
- rewrite spec_w_add_c; auto with zarith.
- intros H1; split; auto with zarith.
- rewrite add_mult_div_2_plus_1.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1.
- unfold base.
- match goal with |- context[_ ^ ?X] =>
- assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
-  rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Z.pow_1_r; auto with zarith
- end.
- rewrite Pos2Z.inj_sub_max; auto with zarith.
- rewrite Z.max_r; auto with zarith.
- ring.
- repeat rewrite C1_plus_wB in H0.
- rewrite C1_plus_wB.
- match goal with |- context[w_div21c ?y ?z ?t] =>
-   generalize (@spec_w_div21c y z t H);
-   case (w_div21c y z t); autorewrite with w_rewrite;
-   auto
- end.
- intros c w1; case c.
- intros w2 (Hw1, Hw2); rewrite C0_id in Hw1.
- rewrite <- Zplus_mod_one in Hw1; auto with zarith.
- rewrite Zmod_small in Hw1; auto with zarith.
- match goal with |- context[w_is_even ?y] =>
-   generalize (spec_w_is_even y);
-   case (w_is_even y)
- end.
- repeat rewrite C0_id.
- intros H1; split; auto with zarith.
- rewrite add_mult_div_2_plus_1.
- replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
-  auto with zarith.
- rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1; unfold base.
- match goal with |- context[_ ^ ?X] =>
- assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
-  rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Z.pow_1_r; auto with zarith
- end.
- rewrite Pos2Z.inj_sub_max; auto with zarith.
- rewrite Z.max_r; auto with zarith.
- ring.
- repeat rewrite C0_id.
- rewrite add_mult_div_2_plus_1.
- rewrite spec_w_add_c; auto with zarith.
- intros H1; split; auto with zarith.
- replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
-  auto with zarith.
- rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1; unfold base.
- match goal with |- context[_ ^ ?X] =>
- assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
-  rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Z.pow_1_r; auto with zarith
- end.
- rewrite Pos2Z.inj_sub_max; auto with zarith.
- rewrite Z.max_r; auto with zarith.
- ring.
- split; auto with zarith.
- destruct (spec_to_Z b);auto with zarith.
- destruct (spec_to_Z w0);auto with zarith.
- destruct (spec_to_Z b);auto with zarith.
- destruct (spec_to_Z b);auto with zarith.
- intros w2; rewrite C1_plus_wB.
- rewrite <- Zplus_mod_one; auto with zarith.
- rewrite Zmod_small; auto with zarith.
- intros (Hw1, Hw2).
- match goal with |- context[w_is_even ?y] =>
-   generalize (spec_w_is_even y);
-   case (w_is_even y)
- end.
- repeat (rewrite C0_id || rewrite C1_plus_wB).
- intros H1; split; auto with zarith.
- rewrite add_mult_div_2.
- replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
-  auto with zarith.
- rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1; ring.
- repeat (rewrite C0_id || rewrite C1_plus_wB).
- rewrite spec_w_add_c; auto with zarith.
- intros H1; split; auto with zarith.
- rewrite add_mult_div_2.
- replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
-  auto with zarith.
- rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
- rewrite Hw1.
- pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
-  auto with zarith.
- rewrite H1; ring.
- split; auto with zarith.
- destruct (spec_to_Z b);auto with zarith.
- destruct (spec_to_Z w0);auto with zarith.
- destruct (spec_to_Z b);auto with zarith.
- destruct (spec_to_Z b);auto with zarith.
- Qed.
-
- Theorem wB_div_4:  4 * (wB / 4) = wB.
- Proof.
-  unfold base.
-  assert (2 ^ Zpos w_digits =
-              4 * (2 ^ (Zpos w_digits - 2))).
-  change 4 with (2 ^ 2).
-  rewrite <- Zpower_exp; auto with zarith.
-  f_equal; auto with zarith.
-  rewrite H.
-  rewrite (fun x => (Z.mul_comm 4 (2 ^x))).
-  rewrite Z_div_mult; auto with zarith.
- Qed.
-
- Theorem Zsquare_mult: forall p, p ^ 2 = p * p.
- intros p; change 2 with (1 + 1); rewrite Zpower_exp;
-  try rewrite Z.pow_1_r; auto with zarith.
- Qed.
-
- Theorem Zsquare_pos: forall p, 0 <= p ^ 2.
- intros p; case (Z.le_gt_cases 0 p); intros H1.
- rewrite Zsquare_mult; apply Z.mul_nonneg_nonneg; auto with zarith.
- rewrite Zsquare_mult; replace (p * p) with ((- p) * (- p)); try ring.
- apply Z.mul_nonneg_nonneg; auto with zarith.
- Qed.
-
- Lemma spec_split: forall x,
-  [|fst (split x)|] * wB + [|snd (split x)|] = [[x]].
- intros x; case x; simpl; autorewrite with w_rewrite;
-  auto with zarith.
- Qed.
-
- Theorem mult_wwB: forall x y, [|x|] * [|y|] < wwB.
- Proof.
-  intros x y; rewrite wwB_wBwB; rewrite Z.pow_2_r.
-  generalize (spec_to_Z x); intros U.
-  generalize (spec_to_Z y); intros U1.
-  apply Z.le_lt_trans with ((wB -1 ) * (wB - 1)); auto with zarith.
-  apply Z.mul_le_mono_nonneg; auto with zarith.
-  rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r; auto with zarith.
- Qed.
- Hint Resolve mult_wwB.
-
- Lemma spec_ww_sqrt2 : forall x y,
-       wwB/ 4 <= [[x]] ->
-       let (s,r) := ww_sqrt2 x y in
-          [||WW x y||] = [[s]] ^ 2 + [+[r]] /\
-          [+[r]] <= 2 * [[s]].
- intros x y H; unfold ww_sqrt2.
- repeat match goal with |- context[split ?x] =>
-   generalize (spec_split x); case (split x)
- end; simpl @fst; simpl @snd.
- intros w0 w1 Hw0 w2 w3 Hw1.
- assert (U: wB/4 <= [|w2|]).
- case (Z.le_gt_cases (wB / 4) [|w2|]); auto; intros H1.
- contradict H; apply Z.lt_nge.
- rewrite wwB_wBwB; rewrite Z.pow_2_r.
- pattern wB at 1; rewrite <- wB_div_4; rewrite <- Z.mul_assoc;
-   rewrite Z.mul_comm.
- rewrite Z_div_mult; auto with zarith.
- rewrite <- Hw1.
- match goal with |- _  < ?X =>
-  pattern X; rewrite <- Z.add_0_r; apply beta_lex_inv;
-  auto with zarith
- end.
- destruct (spec_to_Z w3);auto with zarith.
- generalize (@spec_w_sqrt2 w2 w3 U); case (w_sqrt2 w2 w3).
- intros w4 c (H1, H2).
- assert (U1: wB/2 <= [|w4|]).
- case (Z.le_gt_cases (wB/2) [|w4|]); auto with zarith.
- intros U1.
- assert (U2 : [|w4|] <= wB/2 -1); auto with zarith.
- assert (U3 : [|w4|] ^ 2 <= wB/4 * wB - wB + 1); auto with zarith.
- match goal with |- ?X ^ 2 <= ?Y =>
-  rewrite Zsquare_mult;
-  replace Y with ((wB/2 - 1) * (wB/2 -1))
- end.
- apply Z.mul_le_mono_nonneg; auto with zarith.
- destruct (spec_to_Z w4);auto with zarith.
- destruct (spec_to_Z w4);auto with zarith.
- pattern wB at 4 5; rewrite <- wB_div_2.
- rewrite Z.mul_assoc.
- replace ((wB / 4) * 2) with (wB / 2).
- ring.
- pattern wB at 1; rewrite <- wB_div_4.
- change 4 with (2 * 2).
- rewrite <- Z.mul_assoc; rewrite (Z.mul_comm 2).
- rewrite Z_div_mult; try ring; auto with zarith.
- assert (U4 : [+|c|]  <= wB -2); auto with zarith.
- apply Z.le_trans with (1 := H2).
- match goal with |- ?X <= ?Y =>
-  replace Y with (2 * (wB/ 2 - 1)); auto with zarith
- end.
- pattern wB at 2; rewrite <- wB_div_2; auto with zarith.
- match type of H1 with ?X = _ =>
-  assert (U5: X < wB / 4 * wB)
- end.
- rewrite H1; auto with zarith.
- contradict U; apply Z.lt_nge.
- apply Z.mul_lt_mono_pos_r with wB; auto with zarith.
- destruct (spec_to_Z w4);auto with zarith.
- apply Z.le_lt_trans with (2 := U5).
- unfold ww_to_Z, zn2z_to_Z.
- destruct (spec_to_Z w3);auto with zarith.
- generalize (@spec_w_div2s c w0 w4 U1 H2).
- case (w_div2s c w0 w4).
- intros c0; case c0; intros w5;
-   repeat (rewrite C0_id || rewrite C1_plus_wB).
- intros c1; case c1; intros w6;
-   repeat (rewrite C0_id || rewrite C1_plus_wB).
- intros (H3, H4).
- match goal with |- context [ww_sub_c ?y ?z] =>
-  generalize (spec_ww_sub_c y z); case (ww_sub_c y z)
- end.
- intros z; change [-[C0 z]] with ([[z]]).
- change [+[C0 z]] with ([[z]]).
- intros H5; rewrite spec_w_square_c in H5;
-  auto.
- split.
- unfold zn2z_to_Z; rewrite <- Hw1.
- unfold ww_to_Z, zn2z_to_Z in H1. rewrite H1.
- rewrite <- Hw0.
- match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
- end.
- repeat rewrite Zsquare_mult.
- rewrite wwB_wBwB; ring.
- rewrite H3.
- rewrite H5.
- unfold ww_to_Z, zn2z_to_Z.
- repeat rewrite Zsquare_mult; ring.
- rewrite H5.
- unfold ww_to_Z, zn2z_to_Z.
- match goal with |- ?X - ?Y * ?Y <= _ =>
-  assert (V := Zsquare_pos Y);
-  rewrite Zsquare_mult in V;
-  apply Z.le_trans with X; auto with zarith;
-  clear V
- end.
- match goal with |- ?X * wB + ?Y <= 2 * (?Z * wB + ?T) =>
-  apply Z.le_trans with ((2 * Z - 1) * wB + wB); auto with zarith
- end.
- destruct (spec_to_Z w1);auto with zarith.
- match goal with |- ?X <= _ =>
-  replace X with (2 * [|w4|] * wB); auto with zarith
- end.
- rewrite Z.mul_add_distr_l; rewrite Z.mul_assoc.
- destruct (spec_to_Z w5); auto with zarith.
- ring.
- intros z; replace [-[C1 z]] with (- wwB + [[z]]).
- 2: simpl; case wwB; auto with zarith.
- intros H5; rewrite spec_w_square_c in H5;
-  auto.
- match goal with |- context [ww_pred_c ?y] =>
-  generalize (spec_ww_pred_c y); case (ww_pred_c y)
- end.
- intros z1; change [-[C0 z1]] with ([[z1]]).
- rewrite ww_add_mult_mult_2.
- rewrite spec_ww_add_c.
- rewrite spec_ww_pred.
- rewrite <- Zmod_unique with (q := 1) (r := -wwB + 2 * [[WW w4 w5]]);
-  auto with zarith.
- intros Hz1; rewrite Zmod_small; auto with zarith.
- match type of H5 with -?X + ?Y = ?Z =>
-  assert (V: Y = Z + X);
-  try (rewrite <- H5; ring)
- end.
- split.
- unfold zn2z_to_Z; rewrite <- Hw1.
- unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1.
- rewrite <- Hw0.
- match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
- end.
- repeat rewrite Zsquare_mult.
- rewrite wwB_wBwB; ring.
- rewrite H3.
- rewrite V.
- rewrite Hz1.
- unfold ww_to_Z; simpl zn2z_to_Z.
- repeat rewrite Zsquare_mult; ring.
- rewrite Hz1.
- destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith.
- assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)).
- assert (0 <  [[WW w4 w5]]); auto with zarith.
- apply Z.lt_le_trans with (wB/ 2 * wB + 0); auto with zarith.
- autorewrite with rm10; apply Z.mul_pos_pos; auto with zarith.
- apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
- autorewrite with rm10.
- rewrite Z.mul_comm; rewrite wB_div_2; auto with zarith.
- case (spec_to_Z w5);auto with zarith.
- case (spec_to_Z w5);auto with zarith.
- simpl.
- assert (V2 := spec_to_Z w5);auto with zarith.
- assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith.
- split; auto with zarith.
- assert (wwB <= 2 * [[WW w4 w5]]); auto with zarith.
- apply Z.le_trans with (2 * ([|w4|] * wB)).
- rewrite wwB_wBwB; rewrite Z.pow_2_r.
- rewrite Z.mul_assoc; apply Z.mul_le_mono_nonneg_r; auto with zarith.
- assert (V2 := spec_to_Z w5);auto with zarith.
- rewrite <- wB_div_2; auto with zarith.
- simpl ww_to_Z; assert (V2 := spec_to_Z w5);auto with zarith.
- assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith.
- intros z1; change [-[C1 z1]] with (-wwB + [[z1]]).
- match goal with |- context[([+[C0 ?z]])] =>
-   change [+[C0 z]] with ([[z]])
- end.
- rewrite spec_ww_add; auto with zarith.
- rewrite spec_ww_pred; auto with zarith.
- rewrite ww_add_mult_mult_2.
- rename V1 into VV1.
- assert (VV2: 0 <  [[WW w4 w5]]); auto with zarith.
- apply Z.lt_le_trans with (wB/ 2 * wB + 0); auto with zarith.
- autorewrite with rm10; apply Z.mul_pos_pos; auto with zarith.
- apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
- autorewrite with rm10.
- rewrite Z.mul_comm; rewrite wB_div_2; auto with zarith.
- assert (VV3 := spec_to_Z w5);auto with zarith.
- assert (VV3 := spec_to_Z w5);auto with zarith.
- simpl.
- assert (VV3 := spec_to_Z w5);auto with zarith.
- assert (VV3: wwB <= 2 * [[WW w4 w5]]); auto with zarith.
- apply Z.le_trans with (2 * ([|w4|] * wB)).
- rewrite wwB_wBwB; rewrite Z.pow_2_r.
- rewrite Z.mul_assoc; apply Z.mul_le_mono_nonneg_r; auto with zarith.
- case (spec_to_Z w5);auto with zarith.
- rewrite <- wB_div_2; auto with zarith.
- simpl ww_to_Z; assert (V4 := spec_to_Z w5);auto with zarith.
- rewrite <- Zmod_unique with (q := 1) (r := -wwB + 2 * [[WW w4 w5]]);
-  auto with zarith.
- intros Hz1; rewrite Zmod_small; auto with zarith.
- match type of H5 with -?X + ?Y = ?Z =>
-  assert (V: Y = Z + X);
-  try (rewrite <- H5; ring)
- end.
- match type of Hz1 with -?X + ?Y = -?X + ?Z - 1 =>
-  assert (V1: Y = Z - 1);
-  [replace (Z - 1) with (X + (-X + Z -1));
-    [rewrite <- Hz1 | idtac]; ring
-    | idtac]
- end.
- rewrite <- Zmod_unique with (q := 1) (r := -wwB + [[z1]] + [[z]]);
-  auto with zarith.
- unfold zn2z_to_Z; rewrite <- Hw1.
- unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1.
- rewrite <- Hw0.
- split.
- match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
- end.
- repeat rewrite Zsquare_mult.
- rewrite wwB_wBwB; ring.
- rewrite H3.
- rewrite V.
- rewrite Hz1.
- unfold ww_to_Z; simpl zn2z_to_Z.
- repeat rewrite Zsquare_mult; ring.
- assert (V2 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith.
- assert (V2 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith.
- assert (V3 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z1);auto with zarith.
- split; auto with zarith.
- rewrite (Z.add_comm (-wwB)); rewrite <- Z.add_assoc.
- rewrite H5.
- match goal with |- 0 <= ?X + (?Y - ?Z)  =>
-  apply Z.le_trans with (X - Z); auto with zarith
- end.
- 2: generalize (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w6 w1)); unfold ww_to_Z; auto with zarith.
- rewrite V1.
- match goal with |- 0 <= ?X - 1 - ?Y =>
-   assert (Y < X); auto with zarith
- end.
- apply Z.lt_le_trans with wwB; auto with zarith.
- intros (H3, H4).
- match goal with |- context [ww_sub_c ?y ?z] =>
-  generalize (spec_ww_sub_c y z); case (ww_sub_c y z)
- end.
- intros z; change [-[C0 z]] with ([[z]]).
- match goal with |- context[([+[C1 ?z]])] =>
-   replace [+[C1 z]] with (wwB + [[z]])
- end.
- 2: simpl; case wwB; auto.
- intros H5; rewrite spec_w_square_c in H5;
-  auto.
- split.
- change ([||WW x y||]) with ([[x]] * wwB + [[y]]).
- rewrite <- Hw1.
- unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1.
- rewrite <- Hw0.
- match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
- end.
- repeat rewrite Zsquare_mult.
- rewrite wwB_wBwB; ring.
- rewrite H3.
- rewrite H5.
- unfold ww_to_Z; simpl zn2z_to_Z.
- rewrite wwB_wBwB.
- repeat rewrite Zsquare_mult; ring.
- simpl ww_to_Z.
- rewrite H5.
- simpl ww_to_Z.
- rewrite wwB_wBwB; rewrite Z.pow_2_r.
- match goal with |- ?X * ?Y + (?Z * ?Y + ?T - ?U) <= _ =>
-  apply Z.le_trans with (X * Y + (Z * Y + T - 0));
-  auto with zarith
- end.
- assert (V := Zsquare_pos [|w5|]);
- rewrite Zsquare_mult in V; auto with zarith.
- autorewrite with rm10.
- match goal with |- _ <= 2 * (?U * ?V + ?W) =>
-  apply Z.le_trans with (2 * U * V + 0);
-  auto with zarith
- end.
- match goal with |- ?X * ?Y + (?Z * ?Y + ?T) <= _ =>
-  replace (X * Y + (Z * Y + T)) with ((X + Z) * Y + T);
-  try ring
- end.
- apply Z.lt_le_incl; apply beta_lex_inv; auto with zarith.
- destruct (spec_to_Z w1);auto with zarith.
- destruct (spec_to_Z w5);auto with zarith.
- rewrite Z.mul_add_distr_l; auto with zarith.
- rewrite Z.mul_assoc; auto with zarith.
- intros z; replace [-[C1 z]] with (- wwB + [[z]]).
- 2: simpl; case wwB; auto with zarith.
- intros H5; rewrite spec_w_square_c in H5;
-  auto.
- match goal with |- context[([+[C0 ?z]])] =>
-   change [+[C0 z]] with ([[z]])
- end.
- match type of H5 with -?X + ?Y = ?Z =>
-  assert (V: Y = Z + X);
-  try (rewrite <- H5; ring)
- end.
- change ([||WW x y||]) with ([[x]] * wwB + [[y]]).
- simpl ww_to_Z.
- rewrite <- Hw1.
- simpl ww_to_Z in H1; rewrite H1.
- rewrite <- Hw0.
- split.
- match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
- end.
- repeat rewrite Zsquare_mult.
- rewrite wwB_wBwB; ring.
- rewrite H3.
- rewrite V.
- simpl ww_to_Z.
- rewrite wwB_wBwB.
- repeat rewrite Zsquare_mult; ring.
- rewrite V.
- simpl ww_to_Z.
- rewrite wwB_wBwB; rewrite Z.pow_2_r.
- match goal with |- (?Z * ?Y + ?T - ?U) + ?X * ?Y <= _ =>
-  apply Z.le_trans with ((Z * Y + T - 0) + X * Y);
-  auto with zarith
- end.
- assert (V1 := Zsquare_pos [|w5|]);
- rewrite Zsquare_mult in V1; auto with zarith.
- autorewrite with rm10.
- match goal with |- _ <= 2 * (?U * ?V + ?W) =>
-  apply Z.le_trans with (2 * U * V + 0);
-  auto with zarith
- end.
- match goal with |- (?Z * ?Y + ?T) + ?X * ?Y  <= _ =>
-  replace ((Z * Y + T) + X * Y) with ((X + Z) * Y + T);
-  try ring
- end.
- apply Z.lt_le_incl; apply beta_lex_inv; auto with zarith.
- destruct (spec_to_Z w1);auto with zarith.
- destruct (spec_to_Z w5);auto with zarith.
- rewrite Z.mul_add_distr_l; auto with zarith.
- rewrite Z.mul_assoc; auto with zarith.
- Z.le_elim H2.
- intros c1 (H3, H4).
- match type of H3 with ?X = ?Y => absurd (X < Y) end.
- apply Z.le_ngt; rewrite <- H3; auto with zarith.
- rewrite Z.mul_add_distr_r.
- apply Z.lt_le_trans with ((2 * [|w4|]) * wB + 0);
-  auto with zarith.
- apply beta_lex_inv; auto with zarith.
- destruct (spec_to_Z w0);auto with zarith.
- assert (V1 := spec_to_Z w5);auto with zarith.
- rewrite (Z.mul_comm wB); auto with zarith.
- assert (0 <= [|w5|] * (2 * [|w4|])); auto with zarith.
- intros c1 (H3, H4); rewrite H2 in H3.
- match type of H3 with ?X + ?Y = (?Z + ?T) * ?U + ?V =>
-  assert (VV: (Y = (T * U) + V));
-  [replace Y with ((X + Y) - X);
-    [rewrite H3; ring | ring] | idtac]
- end.
- assert (V1 := spec_to_Z w0);auto with zarith.
- assert (V2 := spec_to_Z w5);auto with zarith.
- case V2; intros V3 _.
- Z.le_elim V3; auto with zarith.
- match type of VV with ?X = ?Y => absurd (X < Y) end.
- apply Z.le_ngt; rewrite <- VV; auto with zarith.
- apply Z.lt_le_trans with wB; auto with zarith.
- match goal with |- _ <= ?X + _ =>
-  apply Z.le_trans with X; auto with zarith
- end.
- match goal with |- _ <= _ * ?X =>
-  apply Z.le_trans with (1 * X); auto with zarith
- end.
- autorewrite with rm10.
- rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith.
- rewrite <- V3 in VV; generalize VV; autorewrite with rm10;
- clear VV; intros VV.
- rewrite spec_ww_add_c; auto with zarith.
- rewrite ww_add_mult_mult_2_plus_1.
- match goal with |- context[?X mod wwB] =>
-   rewrite <- Zmod_unique with (q := 1) (r := -wwB + X)
- end; auto with zarith.
- simpl ww_to_Z.
- rewrite spec_w_Bm1; auto with zarith.
- split.
- change ([||WW x y||]) with ([[x]] * wwB + [[y]]).
- rewrite <- Hw1.
- simpl ww_to_Z in H1; rewrite H1.
- rewrite <- Hw0.
- match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
- end.
- repeat rewrite Zsquare_mult.
- rewrite wwB_wBwB; ring.
- rewrite H2.
- rewrite wwB_wBwB.
- repeat rewrite Zsquare_mult; ring.
- assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z y);auto with zarith.
- assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z y);auto with zarith.
- simpl ww_to_Z; unfold ww_to_Z.
- rewrite spec_w_Bm1; auto with zarith.
- split.
- rewrite wwB_wBwB; rewrite Z.pow_2_r.
- match goal with |- _ <= -?X + (2 * (?Z * ?T + ?U) + ?V) =>
-  assert (X <= 2 * Z * T); auto with zarith
- end.
- apply Z.mul_le_mono_nonneg_r; auto with zarith.
- rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith.
- rewrite Z.mul_add_distr_l; auto with zarith.
- rewrite Z.mul_assoc; auto with zarith.
- match goal with |- _ + ?X  < _ =>
-  replace X with ((2 * (([|w4|]) + 1) * wB) - 1); try ring
- end.
- assert (2 * ([|w4|] + 1) * wB <= 2 * wwB); auto with zarith.
- rewrite <- Z.mul_assoc; apply Z.mul_le_mono_nonneg_l; auto with zarith.
- rewrite wwB_wBwB; rewrite Z.pow_2_r.
- apply Z.mul_le_mono_nonneg_r; auto with zarith.
- case (spec_to_Z w4);auto with zarith.
-Qed.
-
- Lemma spec_ww_is_zero: forall x,
-   if ww_is_zero x then [[x]] = 0 else 0 < [[x]].
-  intro x; unfold ww_is_zero.
-  rewrite spec_ww_compare. case Z.compare_spec;
-   auto with zarith.
-  simpl ww_to_Z.
-  assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z x);auto with zarith.
-  Qed.
-
-  Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2.
-  pattern wwB at 1; rewrite wwB_wBwB; rewrite Z.pow_2_r.
-  rewrite <- wB_div_2.
-  match goal with |- context[(2 * ?X) * (2 * ?Z)] =>
-    replace ((2 * X) * (2 * Z)) with ((X * Z) * 4); try ring
-  end.
-  rewrite Z_div_mult; auto with zarith.
-  rewrite Z.mul_assoc; rewrite wB_div_2.
-  rewrite wwB_div_2; ring.
-  Qed.
-
-
-  Lemma spec_ww_head1
-       : forall x : zn2z w,
-         (ww_is_even (ww_head1 x) = true) /\
-         (0 < [[x]] -> wwB / 4 <= 2 ^ [[ww_head1 x]] * [[x]] < wwB).
-  assert (U := wB_pos w_digits).
-  intros x; unfold ww_head1.
-  generalize (spec_ww_is_even (ww_head0 x)); case_eq (ww_is_even (ww_head0 x)).
-    intros HH H1; rewrite HH; split; auto.
-  intros H2.
-  generalize (spec_ww_head0 x H2); case (ww_head0 x);  autorewrite with rm10.
-  intros (H3, H4); split; auto with zarith.
-  apply Z.le_trans with (2 := H3).
-  apply Zdiv_le_compat_l; auto with zarith.
-  intros xh xl (H3, H4); split; auto with zarith.
-  apply Z.le_trans with (2 := H3).
-  apply Zdiv_le_compat_l; auto with zarith.
-  intros H1.
-  case (spec_to_w_Z (ww_head0 x)); intros Hv1 Hv2.
-  assert (Hp0: 0 < [[ww_head0 x]]).
-    generalize (spec_ww_is_even (ww_head0 x)); rewrite H1.
-    generalize Hv1; case [[ww_head0 x]].
-    rewrite Zmod_small; auto with zarith.
-    intros; assert (0 < Zpos p); auto with zarith.
-    red; simpl; auto.
-    intros p H2; case H2; auto.
-  assert (Hp: [[ww_pred (ww_head0 x)]] = [[ww_head0 x]] - 1).
-    rewrite spec_ww_pred.
-    rewrite Zmod_small; auto with zarith.
-  intros H2; split.
-    generalize (spec_ww_is_even (ww_pred (ww_head0 x)));
-      case ww_is_even; auto.
-    rewrite Hp.
-    rewrite Zminus_mod; auto with zarith.
-    rewrite H2; repeat rewrite Zmod_small; auto with zarith.
-  intros H3; rewrite Hp.
-  case (spec_ww_head0 x); auto; intros Hv3 Hv4.
-  assert (Hu: forall u, 0 < u -> 2 *  2 ^ (u - 1) = 2 ^u).
-    intros u Hu.
-    pattern 2 at 1; rewrite <- Z.pow_1_r.
-    rewrite <- Zpower_exp; auto with zarith.
-    ring_simplify (1 + (u - 1)); auto with zarith.
-  split; auto with zarith.
-  apply Z.mul_le_mono_pos_r with 2; auto with zarith.
-  repeat rewrite (fun x => Z.mul_comm x 2).
-  rewrite wwB_4_2.
-  rewrite Z.mul_assoc; rewrite Hu; auto with zarith.
-  apply Z.le_lt_trans with (2 * 2 ^ ([[ww_head0 x]] - 1) * [[x]]); auto with zarith;
-    rewrite Hu; auto with zarith.
-  apply Z.mul_le_mono_nonneg_r; auto with zarith.
-  apply Zpower_le_monotone; auto with zarith.
-  Qed.
-
-  Theorem wwB_4_wB_4: wwB / 4 = wB / 4 * wB.
-  Proof.
-  symmetry; apply Zdiv_unique with 0; auto with zarith.
-  rewrite Z.mul_assoc; rewrite wB_div_4; auto with zarith.
-  rewrite wwB_wBwB; ring.
-  Qed.
-
-  Lemma spec_ww_sqrt : forall x,
-       [[ww_sqrt x]] ^ 2 <= [[x]] < ([[ww_sqrt x]] + 1) ^ 2.
-  assert (U := wB_pos w_digits).
-  intro x; unfold ww_sqrt.
-  generalize (spec_ww_is_zero x); case (ww_is_zero x).
-  simpl ww_to_Z; simpl Z.pow; unfold Z.pow_pos; simpl;
-    auto with zarith.
-  intros H1.
-  rewrite spec_ww_compare. case Z.compare_spec;
-    simpl ww_to_Z; autorewrite with rm10.
-  generalize H1; case x.
-  intros HH; contradict HH; simpl ww_to_Z; auto with zarith.
-  intros w0 w1; simpl ww_to_Z; autorewrite with w_rewrite rm10.
-  intros H2; case (spec_ww_head1 (WW w0 w1)); intros H3 H4 H5.
-  generalize (H4 H2); clear H4; rewrite H5; clear H5; autorewrite with rm10.
-  intros (H4, H5).
-  assert (V: wB/4 <= [|w0|]).
-  apply beta_lex with 0 [|w1|] wB; auto with zarith; autorewrite with rm10.
-  rewrite <- wwB_4_wB_4; auto.
-  generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith.
-  case (w_sqrt2 w0 w1); intros w2 c.
-  simpl ww_to_Z; simpl @fst.
-  case c; unfold interp_carry; autorewrite with rm10.
-  intros w3 (H6, H7); rewrite H6.
-  assert (V1 := spec_to_Z w3);auto with zarith.
-  split; auto with zarith.
-  apply Z.le_lt_trans with ([|w2|] ^2  + 2 * [|w2|]); auto with zarith.
-  match goal with |- ?X < ?Z =>
-    replace Z with (X + 1); auto with zarith
-  end.
-  repeat rewrite Zsquare_mult; ring.
-  intros w3 (H6, H7); rewrite H6.
-  assert (V1 := spec_to_Z w3);auto with zarith.
-  split; auto with zarith.
-  apply Z.le_lt_trans with ([|w2|] ^2  + 2 * [|w2|]); auto with zarith.
-  match goal with |- ?X < ?Z =>
-    replace Z with (X + 1); auto with zarith
-  end.
-  repeat rewrite Zsquare_mult; ring.
-  intros HH; case (spec_to_w_Z (ww_head1 x)); auto with zarith.
-  intros Hv1.
-  case (spec_ww_head1 x); intros Hp1 Hp2.
-  generalize (Hp2 H1); clear Hp2; intros Hp2.
-  assert (Hv2: [[ww_head1 x]] <= Zpos (xO w_digits)).
-    case (Z.le_gt_cases (Zpos (xO w_digits)) [[ww_head1 x]]); auto with zarith; intros HH1.
-    case Hp2; intros _ HH2; contradict HH2.
-    apply Z.le_ngt; unfold base.
-    apply Z.le_trans with (2 ^ [[ww_head1 x]]).
-      apply Zpower_le_monotone; auto with zarith.
-    pattern (2 ^ [[ww_head1 x]]) at 1;
-      rewrite <- (Z.mul_1_r (2 ^ [[ww_head1 x]])).
-    apply Z.mul_le_mono_nonneg_l; auto with zarith.
-  generalize (spec_ww_add_mul_div x W0 (ww_head1 x) Hv2);
-     case ww_add_mul_div.
-  simpl ww_to_Z; autorewrite with w_rewrite rm10.
-  rewrite Zmod_small; auto with zarith.
-  intros H2. symmetry in H2. rewrite Z.mul_eq_0 in H2. destruct H2 as [H2|H2].
-  rewrite H2; unfold Z.pow, Z.pow_pos; simpl; auto with zarith.
-  match type of H2 with ?X = ?Y =>
-   absurd (Y < X); try (rewrite H2; auto with zarith; fail)
-  end.
-  apply Z.pow_pos_nonneg; auto with zarith.
-  split; auto with zarith.
-  case Hp2; intros _ tmp; apply Z.le_lt_trans with (2 := tmp);
-   clear tmp.
-  rewrite Z.mul_comm; apply Z.mul_le_mono_nonneg_r; auto with zarith.
-  assert (Hv0: [[ww_head1 x]] = 2 * ([[ww_head1 x]]/2)).
-    pattern [[ww_head1 x]] at 1; rewrite (Z_div_mod_eq [[ww_head1 x]] 2);
-      auto with zarith.
-    generalize (spec_ww_is_even (ww_head1 x)); rewrite Hp1;
-      intros tmp; rewrite tmp; rewrite Z.add_0_r; auto.
-  intros w0 w1; autorewrite with w_rewrite rm10.
-  rewrite Zmod_small; auto with zarith.
-  2: rewrite Z.mul_comm; auto with zarith.
-  intros H2.
-  assert (V: wB/4 <= [|w0|]).
-  apply beta_lex with 0 [|w1|] wB; auto with zarith; autorewrite with rm10.
-  simpl ww_to_Z in H2; rewrite H2.
-  rewrite <- wwB_4_wB_4; auto with zarith.
-  rewrite Z.mul_comm; auto with zarith.
-  assert (V1 := spec_to_Z w1);auto with zarith.
-  generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith.
-  case (w_sqrt2 w0 w1); intros w2 c.
-  case (spec_to_Z w2); intros HH1 HH2.
-  simpl ww_to_Z; simpl @fst.
-  assert (Hv3: [[ww_pred ww_zdigits]]
-                 = Zpos (xO w_digits) - 1).
-    rewrite spec_ww_pred; rewrite spec_ww_zdigits.
-    rewrite Zmod_small; auto with zarith.
-    split; auto with zarith.
-    apply Z.lt_le_trans with (Zpos (xO w_digits)); auto with zarith.
-    unfold base; apply Zpower2_le_lin; auto with zarith.
-  assert (Hv4: [[ww_head1 x]]/2 < wB).
-    apply Z.le_lt_trans with (Zpos w_digits).
-    apply Z.mul_le_mono_pos_r with 2; auto with zarith.
-    repeat rewrite (fun x => Z.mul_comm x 2).
-    rewrite <- Hv0;  rewrite <- Pos2Z.inj_xO; auto.
-    unfold base; apply Zpower2_lt_lin; auto with zarith.
-  assert (Hv5: [[(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))]]
-                 = [[ww_head1 x]]/2).
-    rewrite spec_ww_add_mul_div.
-    simpl ww_to_Z; autorewrite with rm10.
-    rewrite Hv3.
-    ring_simplify (Zpos (xO w_digits) - (Zpos (xO w_digits) - 1)).
-    rewrite Z.pow_1_r.
-    rewrite Zmod_small; auto with zarith.
-    split; auto with zarith.
-    apply Z.lt_le_trans with (1 := Hv4); auto with zarith.
-    unfold base; apply Zpower_le_monotone; auto with zarith.
-    split; unfold ww_digits; try rewrite Pos2Z.inj_xO; auto with zarith.
-    rewrite Hv3; auto with zarith.
-  assert (Hv6: [|low(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))|]
-                 = [[ww_head1 x]]/2).
-    rewrite spec_low.
-    rewrite Hv5; rewrite Zmod_small; auto with zarith.
-  rewrite spec_w_add_mul_div; auto with zarith.
-  rewrite spec_w_sub; auto with zarith.
-  rewrite spec_w_0.
-  simpl ww_to_Z; autorewrite with rm10.
-  rewrite Hv6; rewrite spec_w_zdigits.
-  rewrite (fun x y => Zmod_small (x - y)).
-  ring_simplify (Zpos w_digits - (Zpos w_digits - [[ww_head1 x]] / 2)).
-  rewrite Zmod_small.
-  simpl ww_to_Z in H2; rewrite H2; auto with zarith.
-  intros (H4, H5); split.
-  apply Z.mul_le_mono_pos_r with (2 ^ [[ww_head1 x]]); auto with zarith.
-  rewrite H4.
-  apply Z.le_trans with ([|w2|] ^ 2); auto with zarith.
-  rewrite Z.mul_comm.
-  pattern [[ww_head1 x]] at 1;
-    rewrite Hv0; auto with zarith.
-  rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r;
-    auto with zarith.
-  assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2);
-   try (intros; repeat rewrite Zsquare_mult; ring);
-   rewrite tmp; clear tmp.
-  apply Zpower_le_monotone3; auto with zarith.
-  split; auto with zarith.
-  pattern [|w2|] at 2;
-     rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]] / 2)));
-     auto with zarith.
-  match goal with |- ?X <= ?X + ?Y =>
-    assert (0 <= Y); auto with zarith
-  end.
-  case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith.
-  case c; unfold interp_carry; autorewrite with rm10;
-    intros w3; assert (V3 := spec_to_Z w3);auto with zarith.
-  apply Z.mul_lt_mono_pos_r with (2 ^ [[ww_head1 x]]); auto with zarith.
-  rewrite H4.
-  apply Z.le_lt_trans with ([|w2|] ^ 2 + 2 * [|w2|]); auto with zarith.
-  apply Z.lt_le_trans with (([|w2|] + 1) ^ 2); auto with zarith.
-  match goal with |- ?X < ?Y =>
-    replace Y with (X + 1); auto with zarith
-  end.
-  repeat rewrite (Zsquare_mult); ring.
-  rewrite Z.mul_comm.
-  pattern [[ww_head1 x]] at 1; rewrite Hv0.
-  rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r;
-   auto with zarith.
-  assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2);
-   try (intros; repeat rewrite Zsquare_mult; ring);
-   rewrite tmp; clear tmp.
-  apply Zpower_le_monotone3; auto with zarith.
-  split; auto with zarith.
-  pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]]/2)));
-    auto with zarith.
-  rewrite <- Z.add_assoc; rewrite Z.mul_add_distr_l.
-  autorewrite with rm10; apply Z.add_le_mono_l; auto with zarith.
-  case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]]/2))); auto with zarith.
-  split; auto with zarith.
-  apply Z.le_lt_trans with ([|w2|]); auto with zarith.
-  apply Zdiv_le_upper_bound; auto with zarith.
-  pattern [|w2|] at 1; replace [|w2|] with ([|w2|] * 2 ^0);
-    auto with zarith.
-  apply Z.mul_le_mono_nonneg_l; auto with zarith.
-  apply Zpower_le_monotone; auto with zarith.
-  rewrite Z.pow_0_r; autorewrite with rm10; auto.
-  split; auto with zarith.
-  rewrite Hv0 in Hv2; rewrite (Pos2Z.inj_xO w_digits) in Hv2; auto with zarith.
-  apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
-  unfold base; apply Zpower2_lt_lin; auto with zarith.
-  rewrite spec_w_sub; auto with zarith.
-  rewrite Hv6; rewrite spec_w_zdigits; auto with zarith.
-  assert (Hv7: 0 < [[ww_head1 x]]/2); auto with zarith.
-  rewrite Zmod_small; auto with zarith.
-  split; auto with zarith.
-  assert ([[ww_head1 x]]/2 <= Zpos w_digits); auto with zarith.
-  apply Z.mul_le_mono_pos_r with 2; auto with zarith.
-  repeat rewrite (fun x => Z.mul_comm x 2).
-  rewrite <- Hv0; rewrite <- Pos2Z.inj_xO; auto with zarith.
-  apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
-  unfold base; apply Zpower2_lt_lin; auto with zarith.
-  Qed.
-
-End DoubleSqrt.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
deleted file mode 100644
index a2df2600..00000000
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
+++ /dev/null
@@ -1,356 +0,0 @@
-
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Set Implicit Arguments.
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import DoubleType.
-Require Import DoubleBase.
-
-Local Open Scope Z_scope.
-
-Section DoubleSub.
- Variable w : Type.
- Variable w_0 : w.
- Variable w_Bm1 : w.
- Variable w_WW : w -> w -> zn2z w.
- Variable ww_Bm1 : zn2z w.
- Variable w_opp_c : w -> carry w.
- Variable w_opp_carry : w -> w.
- Variable w_pred_c : w -> carry w.
- Variable w_sub_c : w -> w -> carry w.
- Variable w_sub_carry_c : w -> w -> carry w.
- Variable w_opp : w -> w.
- Variable w_pred : w -> w.
- Variable w_sub : w -> w -> w.
- Variable w_sub_carry : w -> w -> w.
-
- (* ** Opposites ** *)
- Definition ww_opp_c x :=
-  match x with
-  | W0 => C0 W0
-  | WW xh xl =>
-    match w_opp_c xl with
-    | C0 _ =>
-      match w_opp_c xh with
-      | C0 h => C0 W0
-      | C1 h => C1 (WW h w_0)
-      end
-    | C1 l => C1 (WW (w_opp_carry xh) l)
-    end
-  end.
-
- Definition ww_opp x :=
-  match x with
-  | W0 => W0
-  | WW xh xl =>
-    match w_opp_c xl with
-    | C0 _ => WW (w_opp xh) w_0
-    | C1 l => WW (w_opp_carry xh) l
-    end
-  end.
-
- Definition ww_opp_carry x :=
-  match x with
-  | W0 => ww_Bm1
-  | WW xh xl => w_WW (w_opp_carry xh) (w_opp_carry xl)
-  end.
-
- Definition ww_pred_c x :=
-  match x with
-  | W0 => C1 ww_Bm1
-  | WW xh xl =>
-    match w_pred_c xl with
-    | C0 l => C0 (w_WW xh l)
-    | C1 _ =>
-      match w_pred_c xh with
-      | C0 h => C0 (WW h w_Bm1)
-      | C1 _ => C1 ww_Bm1
-      end
-    end
-  end.
-
- Definition ww_pred x :=
-  match x with
-  | W0 => ww_Bm1
-  | WW xh xl =>
-    match w_pred_c xl with
-    | C0 l => w_WW xh l
-    | C1 l => WW (w_pred xh) w_Bm1
-    end
-  end.
-
- Definition ww_sub_c x y :=
-  match y, x with
-  | W0, _ => C0 x
-  | WW yh yl, W0 => ww_opp_c (WW yh yl)
-  | WW yh yl, WW xh xl =>
-    match w_sub_c xl yl with
-    | C0 l =>
-      match w_sub_c xh yh with
-      | C0 h => C0 (w_WW h l)
-      | C1 h => C1 (WW h l)
-      end
-    | C1 l =>
-      match w_sub_carry_c xh yh with
-      | C0 h => C0 (WW h l)
-      | C1 h => C1 (WW h l)
-      end
-    end
-  end.
-
- Definition ww_sub x y :=
-  match y, x with
-  | W0, _ => x
-  | WW yh yl, W0 => ww_opp (WW yh yl)
-  | WW yh yl, WW xh xl =>
-    match w_sub_c xl yl with
-    | C0 l => w_WW (w_sub xh yh) l
-    | C1 l => WW (w_sub_carry xh yh) l
-    end
-  end.
-
- Definition ww_sub_carry_c x y :=
-  match y, x with
-  | W0, W0 => C1 ww_Bm1
-  | W0, WW xh xl => ww_pred_c (WW xh xl)
-  | WW yh yl, W0 => C1 (ww_opp_carry (WW yh yl))
-  | WW yh yl, WW xh xl =>
-    match w_sub_carry_c xl yl with
-    | C0 l =>
-      match w_sub_c xh yh with
-      | C0 h => C0 (w_WW h l)
-      | C1 h => C1 (WW h l)
-      end
-    | C1 l =>
-      match w_sub_carry_c xh yh with
-      | C0 h => C0 (w_WW h l)
-      | C1 h => C1 (w_WW h l)
-      end
-    end
-  end.
-
- Definition ww_sub_carry x y :=
-  match y, x with
-  | W0, W0 => ww_Bm1
-  | W0, WW xh xl => ww_pred (WW xh xl)
-  | WW yh yl, W0 => ww_opp_carry (WW yh yl)
-  | WW yh yl, WW xh xl =>
-    match w_sub_carry_c xl yl with
-    | C0 l => w_WW (w_sub xh yh) l
-    | C1 l => w_WW (w_sub_carry xh yh) l
-    end
-  end.
-
- (*Section DoubleProof.*)
-  Variable w_digits : positive.
-  Variable w_to_Z : w -> Z.
-
-
-  Notation wB  := (base w_digits).
-  Notation wwB := (base (ww_digits w_digits)).
-  Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
-  Notation "[+| c |]" :=
-   (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
-  Notation "[-| c |]" :=
-   (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
-
-  Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
-  Notation "[+[ c ]]" :=
-   (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-  Notation "[-[ c ]]" :=
-   (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
-   (at level 0, c at level 99).
-
-  Variable spec_w_0   : [|w_0|] = 0.
-  Variable spec_w_Bm1   : [|w_Bm1|] = wB - 1.
-  Variable spec_ww_Bm1   : [[ww_Bm1]] = wwB - 1.
-  Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
-  Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
-
-  Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|].
-  Variable spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB.
-  Variable spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1.
-
-  Variable spec_pred_c : forall x, [-|w_pred_c x|] = [|x|] - 1.
-  Variable spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|].
-  Variable spec_sub_carry_c :
-   forall x y, [-|w_sub_carry_c x y|] = [|x|] - [|y|] - 1.
-
-  Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB.
-  Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
-  Variable spec_sub_carry :
-	 forall x y, [|w_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB.
-
-
-  Lemma spec_ww_opp_c : forall x, [-[ww_opp_c x]] = -[[x]].
-  Proof.
-   destruct x as [ |xh xl];simpl. reflexivity.
-   rewrite Z.opp_add_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl)
-   as [l|l];intros H;unfold interp_carry in H;rewrite <- H;
-   rewrite <- Z.mul_opp_l.
-   assert ([|l|] = 0).
-    assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega.
-   rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh)
-   as [h|h];intros H1;unfold interp_carry in *;rewrite <- H1.
-   assert ([|h|] = 0).
-    assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega.
-   rewrite H2;reflexivity.
-   simpl ww_to_Z;rewrite wwB_wBwB;rewrite spec_w_0;ring.
-   unfold interp_carry;simpl ww_to_Z;rewrite wwB_wBwB;rewrite spec_opp_carry;
-   ring.
-  Qed.
-
-  Lemma spec_ww_opp : forall x, [[ww_opp x]] = (-[[x]]) mod wwB.
-  Proof.
-   destruct x as [ |xh xl];simpl. reflexivity.
-   rewrite Z.opp_add_distr, <- Z.mul_opp_l.
-   generalize (spec_opp_c xl);destruct (w_opp_c xl)
-   as [l|l];intros H;unfold interp_carry in H;rewrite <- H;simpl ww_to_Z.
-   rewrite spec_w_0;rewrite Z.add_0_r;rewrite wwB_wBwB.
-   assert ([|l|] = 0).
-    assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega.
-   rewrite H0;rewrite Z.add_0_r; rewrite Z.pow_2_r;
-    rewrite Zmult_mod_distr_r;try apply lt_0_wB.
-   rewrite spec_opp;trivial.
-   apply Zmod_unique with (q:= -1).
-   exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW (w_opp_carry xh) l)).
-   rewrite spec_opp_carry;rewrite wwB_wBwB;ring.
-  Qed.
-
-  Lemma spec_ww_opp_carry : forall x, [[ww_opp_carry x]] = wwB - [[x]] - 1.
-  Proof.
-   destruct x as [ |xh xl];simpl. rewrite spec_ww_Bm1;ring.
-   rewrite spec_w_WW;simpl;repeat rewrite spec_opp_carry;rewrite wwB_wBwB;ring.
-  Qed.
-
-  Lemma spec_ww_pred_c : forall x, [-[ww_pred_c x]] = [[x]] - 1.
-  Proof.
-   destruct x as [ |xh xl];unfold ww_pred_c.
-   unfold interp_carry;rewrite spec_ww_Bm1;simpl ww_to_Z;ring.
-   simpl ww_to_Z;replace (([|xh|]*wB+[|xl|])-1) with ([|xh|]*wB+([|xl|]-1)).
-   2:ring. generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l];
-   intros H;unfold interp_carry in H;rewrite <- H. simpl;apply spec_w_WW.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   assert ([|l|] = wB - 1).
-     assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega.
-   rewrite H0;change ([|xh|] + -1) with ([|xh|] - 1).
-   generalize (spec_pred_c xh);destruct (w_pred_c xh) as [h|h];
-   intros H1;unfold interp_carry in H1;rewrite <- H1.
-   simpl;rewrite spec_w_Bm1;ring.
-   assert ([|h|] = wB - 1).
-     assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega.
-   rewrite H2;unfold interp_carry;rewrite spec_ww_Bm1;rewrite wwB_wBwB;ring.
-  Qed.
-
-  Lemma spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]].
-  Proof.
-   destruct y as [ |yh yl];simpl. ring.
-   destruct x as [ |xh xl];simpl. exact (spec_ww_opp_c (WW yh yl)).
-   replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]))
-   with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|])). 2:ring.
-   generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl) as [l|l];intros H;
-   unfold interp_carry in H;rewrite <- H.
-   generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1;
-   unfold interp_carry in H1;rewrite <- H1;unfold interp_carry;
-   try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1).
-   generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h];
-   intros H1;unfold interp_carry in *;rewrite <- H1;simpl ww_to_Z;
-   try rewrite wwB_wBwB;ring.
-  Qed.
-
-  Lemma spec_ww_sub_carry_c :
-     forall x y, [-[ww_sub_carry_c x y]] = [[x]] - [[y]] - 1.
-  Proof.
-   destruct y as [ |yh yl];simpl.
-   unfold Z.sub;simpl;rewrite Z.add_0_r;exact (spec_ww_pred_c x).
-   destruct x as [ |xh xl].
-   unfold interp_carry;rewrite spec_w_WW;simpl ww_to_Z;rewrite wwB_wBwB;
-   repeat rewrite spec_opp_carry;ring.
-   simpl ww_to_Z.
-   replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1)
-   with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|]-1)). 2:ring.
-   generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl)
-   as [l|l];intros H;unfold interp_carry in H;rewrite <- H.
-   generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1;
-   unfold interp_carry in H1;rewrite <- H1;unfold interp_carry;
-   try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1).
-   generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h];
-   intros H1;unfold interp_carry in *;rewrite <- H1;try rewrite spec_w_WW;
-   simpl ww_to_Z; try rewrite wwB_wBwB;ring.
-  Qed.
-
-  Lemma spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB.
-  Proof.
-   destruct x as [ |xh xl];simpl.
-   apply Zmod_unique with (-1). apply spec_ww_to_Z;trivial.
-   rewrite spec_ww_Bm1;ring.
-   replace ([|xh|]*wB + [|xl|] - 1) with ([|xh|]*wB + ([|xl|] - 1)). 2:ring.
-   generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l];intro H;
-   unfold interp_carry in H;rewrite <- H;simpl ww_to_Z.
-   rewrite Zmod_small. apply spec_w_WW.
-   exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh l)).
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   change ([|xh|] + -1) with ([|xh|] - 1).
-   assert ([|l|] = wB - 1).
-    assert (H1:= spec_to_Z l);assert (H2:= spec_to_Z xl);omega.
-   rewrite (mod_wwB w_digits w_to_Z);trivial.
-   rewrite spec_pred;rewrite spec_w_Bm1;rewrite <- H0;trivial.
-  Qed.
-
-  Lemma spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB.
-  Proof.
-   destruct y as [ |yh yl];simpl.
-   ring_simplify ([[x]] - 0);rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial.
-   destruct x as [ |xh xl];simpl. exact (spec_ww_opp (WW yh yl)).
-   replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]))
-   with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|])). 2:ring.
-   generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl)as[l|l];intros H;
-   unfold interp_carry in H;rewrite <- H.
-   rewrite spec_w_WW;rewrite (mod_wwB w_digits w_to_Z spec_to_Z).
-   rewrite spec_sub;trivial.
-   simpl ww_to_Z;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial.
-  Qed.
-
-  Lemma spec_ww_sub_carry :
-	 forall x y, [[ww_sub_carry x y]] = ([[x]] - [[y]] - 1) mod wwB.
-  Proof.
-   destruct y as [ |yh yl];simpl.
-   ring_simplify ([[x]] - 0);exact (spec_ww_pred x).
-   destruct x as [ |xh xl];simpl.
-   apply Zmod_unique with (-1).
-   apply spec_ww_to_Z;trivial.
-   fold (ww_opp_carry (WW yh yl)).
-   rewrite (spec_ww_opp_carry (WW yh yl));simpl ww_to_Z;ring.
-   replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1)
-   with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|] - 1)). 2:ring.
-   generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl)as[l|l];
-   intros H;unfold interp_carry in H;rewrite <- H;rewrite spec_w_WW.
-   rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub;trivial.
-   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
-   rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial.
-  Qed.
-
-(* End DoubleProof. *)
-
-End DoubleSub.
-
-
-
-
-
diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v
index 0e58b815..bd4f0279 100644
--- a/theories/Numbers/Cyclic/Int31/Cyclic31.v
+++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Int31 numbers defines indeed a cyclic structure : Z/(2^31)Z *)
@@ -18,13 +20,16 @@ Require Export Int31.
 Require Import Znumtheory.
 Require Import Zgcd_alt.
 Require Import Zpow_facts.
-Require Import BigNumPrelude.
 Require Import CyclicAxioms.
 Require Import ROmega.
 
+Declare ML Module "int31_syntax_plugin".
+
 Local Open Scope nat_scope.
 Local Open Scope int31_scope.
 
+Local Hint Resolve Z.lt_gt Z.div_pos : zarith.
+
 Section Basics.
 
  (** * Basic results about [iszero], [shiftl], [shiftr] *)
@@ -455,12 +460,19 @@ Section Basics.
  rewrite Z.succ_double_spec; auto with zarith.
  Qed.
 
- Lemma phi_bounded  : forall x, (0 <= phi x < 2 ^ (Z.of_nat size))%Z.
+ Lemma phi_nonneg : forall x, (0 <= phi x)%Z.
  Proof.
  intros.
  rewrite <- phibis_aux_equiv.
- split.
  apply phibis_aux_pos.
+ Qed.
+
+ Hint Resolve phi_nonneg : zarith.
+
+ Lemma phi_bounded  : forall x, (0 <= phi x < 2 ^ (Z.of_nat size))%Z.
+ Proof.
+ intros. split; [auto with zarith|].
+ rewrite <- phibis_aux_equiv.
  change x with (nshiftr x (size-size)).
  apply phibis_aux_bounded; auto.
  Qed.
@@ -1624,6 +1636,37 @@ Section Int31_Specs.
  rewrite Z.mul_comm, Z_div_mult; auto with zarith.
  Qed.
 
+ Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n ->
+   ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) =
+   a mod 2 ^ p.
+ Proof.
+ intros.
+ rewrite Zmod_small.
+ rewrite Zmod_eq by (auto with zarith).
+ unfold Z.sub at 1.
+ rewrite Z_div_plus_full_l
+  by (cut (0 < 2^(n-p)); auto with zarith).
+ assert (2^n = 2^(n-p)*2^p).
+  rewrite <- Zpower_exp by (auto with zarith).
+  replace (n-p+p) with n; auto with zarith.
+ rewrite H0.
+ rewrite <- Zdiv_Zdiv, Z_div_mult by (auto with zarith).
+ rewrite (Z.mul_comm (2^(n-p))), Z.mul_assoc.
+ rewrite <- Z.mul_opp_l.
+ rewrite Z_div_mult by (auto with zarith).
+ symmetry; apply Zmod_eq; auto with zarith.
+
+ remember (a * 2 ^ (n - p)) as b.
+ destruct (Z_mod_lt b (2^n)); auto with zarith.
+ split.
+ apply Z_div_pos; auto with zarith.
+ apply Zdiv_lt_upper_bound; auto with zarith.
+ apply Z.lt_le_trans with (2^n); auto with zarith.
+ rewrite <- (Z.mul_1_r (2^n)) at 1.
+ apply Z.mul_le_mono_nonneg; auto with zarith.
+ cut (0 < 2 ^ (n-p)); auto with zarith.
+ Qed.
+
  Lemma spec_pos_mod : forall w p,
        [|ZnZ.pos_mod p w|] = [|w|] mod (2 ^ [|p|]).
  Proof.
@@ -1654,7 +1697,7 @@ Section Int31_Specs.
  rewrite spec_add_mul_div by (rewrite H4; auto with zarith).
  change [|0|] with 0%Z; rewrite Zdiv_0_l, Z.add_0_r.
  rewrite H4.
- apply shift_unshift_mod_2; auto with zarith.
+ apply shift_unshift_mod_2; simpl; auto with zarith.
  Qed.
 
 
@@ -1973,32 +2016,24 @@ Section Int31_Specs.
  assert (Hp2: 0 < [|2|]) by exact (eq_refl Lt).
  intros Hi Hj Hij H31 Hrec; rewrite sqrt31_step_def.
  rewrite spec_compare, div31_phi; auto.
-   case Z.compare_spec; auto; intros Hc;
+ case Z.compare_spec; auto; intros Hc;
    try (split; auto; apply sqrt_test_true; auto with zarith; fail).
- apply Hrec; repeat rewrite div31_phi; auto with zarith.
- replace [|(j + fst (i / j)%int31)|] with ([|j|] + [|i|] / [|j|]).
- split.
+ assert (E : [|(j + fst (i / j)%int31)|] = [|j|] + [|i|] / [|j|]).
+ { rewrite spec_add, div31_phi; auto using Z.mod_small with zarith. }
+ apply Hrec; rewrite !div31_phi, E; auto using sqrt_main with zarith.
+ split; try apply sqrt_test_false; auto with zarith.
  apply Z.le_succ_l in Hj. change (1 <= [|j|]) in Hj.
  Z.le_elim Hj.
- replace ([|j|] + [|i|]/[|j|]) with
-        (1 * 2 + (([|j|] - 2) + [|i|] / [|j|])); try ring.
- rewrite Z_div_plus_full_l; auto with zarith.
- assert (0 <= [|i|]/ [|j|]) by (apply Z_div_pos; auto with zarith).
- assert (0 <= ([|j|] - 2 + [|i|] / [|j|]) / [|2|]) ; auto with zarith.
- rewrite <- Hj, Zdiv_1_r.
- replace (1 + [|i|])%Z with (1 * 2 + ([|i|] - 1))%Z; try ring.
- rewrite Z_div_plus_full_l; auto with zarith.
- assert (0 <= ([|i|] - 1) /2)%Z by (apply Z_div_pos; auto with zarith).
- change ([|2|]) with 2%Z; auto with zarith.
- apply sqrt_test_false; auto with zarith.
- rewrite spec_add, div31_phi; auto.
- symmetry; apply Zmod_small.
- split; auto with zarith.
- replace [|j + fst (i / j)%int31|] with ([|j|] + [|i|] / [|j|]).
- apply sqrt_main; auto with zarith.
- rewrite spec_add, div31_phi; auto.
- symmetry; apply Zmod_small.
- split; auto with zarith.
+ - replace ([|j|] + [|i|]/[|j|]) with
+   (1 * 2 + (([|j|] - 2) + [|i|] / [|j|])) by ring.
+   rewrite Z_div_plus_full_l; auto with zarith.
+   assert (0 <= [|i|]/ [|j|]) by auto with zarith.
+   assert (0 <= ([|j|] - 2 + [|i|] / [|j|]) / [|2|]); auto with zarith.
+ - rewrite <- Hj, Zdiv_1_r.
+   replace (1 + [|i|]) with (1 * 2 + ([|i|] - 1)) by ring.
+   rewrite Z_div_plus_full_l; auto with zarith.
+   assert (0 <= ([|i|] - 1) /2) by auto with zarith.
+   change ([|2|]) with 2; auto with zarith.
  Qed.
 
  Lemma iter31_sqrt_correct n rec i j: 0 < [|i|] -> 0 < [|j|] ->
@@ -2078,11 +2113,12 @@ Section Int31_Specs.
  case (phi_bounded j); intros Hbj _.
  case (phi_bounded il); intros Hbil _.
  case (phi_bounded ih); intros Hbih Hbih1.
- assert (([|ih|] < [|j|] + 1)%Z); auto with zarith.
+ assert ([|ih|] < [|j|] + 1); auto with zarith.
  apply Z.square_lt_simpl_nonneg; auto with zarith.
- repeat rewrite <-Z.pow_2_r; apply Z.le_lt_trans with (2 := H1).
- apply Z.le_trans with ([|ih|] * base)%Z; unfold phi2, base;
-  try rewrite Z.pow_2_r; auto with zarith.
+ rewrite <- ?Z.pow_2_r; apply Z.le_lt_trans with (2 := H1).
+ apply Z.le_trans with ([|ih|] * wB).
+ - rewrite ? Z.pow_2_r; auto with zarith.
+ - unfold phi2. change base with wB; auto with zarith.
  Qed.
 
  Lemma div312_phi ih il j: (2^30 <= [|j|] -> [|ih|] < [|j|] ->
@@ -2104,90 +2140,89 @@ Section Int31_Specs.
  Proof.
  assert (Hp2: (0 < [|2|])%Z) by exact (eq_refl Lt).
  intros Hih Hj Hij Hrec; rewrite sqrt312_step_def.
- assert (H1: ([|ih|] <= [|j|])%Z) by (apply sqrt312_lower_bound with il; auto).
+ assert (H1: ([|ih|] <= [|j|])) by (apply sqrt312_lower_bound with il; auto).
  case (phi_bounded ih); intros Hih1 _.
  case (phi_bounded il); intros Hil1 _.
  case (phi_bounded j); intros _ Hj1.
  assert (Hp3: (0 < phi2 ih il)).
- unfold phi2; apply Z.lt_le_trans with ([|ih|] * base)%Z; auto with zarith.
- apply Z.mul_pos_pos; auto with zarith.
- apply Z.lt_le_trans with (2:= Hih); auto with zarith.
+ { unfold phi2; apply Z.lt_le_trans with ([|ih|] * base); auto with zarith.
+   apply Z.mul_pos_pos; auto with zarith.
+   apply Z.lt_le_trans with (2:= Hih); auto with zarith. }
  rewrite spec_compare. case Z.compare_spec; intros Hc1.
- split; auto.
- apply sqrt_test_true; auto.
- unfold phi2, base; auto with zarith.
- unfold phi2; rewrite Hc1.
- assert (0 <= [|il|]/[|j|]) by (apply Z_div_pos; auto with zarith).
- rewrite Z.mul_comm, Z_div_plus_full_l; unfold base; auto with zarith.
- simpl wB in Hj1. unfold Z.pow_pos in Hj1. simpl in Hj1. auto with zarith.
- case (Z.le_gt_cases (2 ^ 30) [|j|]); intros Hjj.
- rewrite spec_compare; case Z.compare_spec;
-  rewrite div312_phi; auto; intros Hc;
-  try (split; auto; apply sqrt_test_true; auto with zarith; fail).
- apply Hrec.
- assert (Hf1: 0 <= phi2 ih il/ [|j|]) by (apply Z_div_pos; auto with zarith).
- apply Z.le_succ_l in Hj. change (1 <= [|j|]) in Hj.
- Z.le_elim Hj.
- 2: contradict Hc; apply Z.le_ngt; rewrite <- Hj, Zdiv_1_r; auto with zarith.
- assert (Hf3: 0 < ([|j|] + phi2 ih il / [|j|]) / 2).
- replace ([|j|] + phi2 ih il/ [|j|])%Z with
-        (1 * 2 + (([|j|] - 2) + phi2 ih il / [|j|])); try ring.
- rewrite Z_div_plus_full_l; auto with zarith.
- assert (0 <= ([|j|] - 2 + phi2 ih il / [|j|]) / 2) ; auto with zarith.
- assert (Hf4: ([|j|] + phi2 ih il / [|j|]) / 2 < [|j|]).
- apply sqrt_test_false; auto with zarith.
- generalize (spec_add_c j (fst (div3121 ih il j))).
- unfold interp_carry;  case add31c; intros r;
-  rewrite div312_phi; auto with zarith.
- rewrite div31_phi; change [|2|] with 2%Z; auto with zarith.
- intros HH; rewrite HH; clear HH; auto with zarith.
- rewrite spec_add, div31_phi; change [|2|] with 2%Z; auto.
- rewrite Z.mul_1_l; intros HH.
- rewrite Z.add_comm, <- Z_div_plus_full_l; auto with zarith.
- change (phi v30 * 2) with (2 ^ Z.of_nat size).
- rewrite HH, Zmod_small; auto with zarith.
- replace (phi
-    match j +c fst (div3121 ih il j) with
-    | C0 m1 => fst (m1 / 2)%int31
-    | C1 m1 => fst (m1 / 2)%int31 + v30
-    end) with ((([|j|] + (phi2 ih il)/([|j|]))/2)).
- apply sqrt_main; auto with zarith.
- generalize (spec_add_c j (fst (div3121 ih il j))).
- unfold interp_carry;  case add31c; intros r;
-  rewrite div312_phi; auto with zarith.
- rewrite div31_phi; auto with zarith.
- intros HH; rewrite HH; auto with zarith.
- intros HH; rewrite <- HH.
- change (1 * 2 ^ Z.of_nat size) with (phi (v30) * 2).
- rewrite Z_div_plus_full_l; auto with zarith.
- rewrite Z.add_comm.
- rewrite spec_add, Zmod_small.
- rewrite div31_phi; auto.
- split; auto with zarith.
- case (phi_bounded (fst (r/2)%int31));
-   case (phi_bounded v30); auto with zarith.
- rewrite div31_phi; change (phi 2) with 2%Z; auto.
- change (2 ^Z.of_nat size) with (base/2 + phi v30).
- assert (phi r / 2 < base/2); auto with zarith.
- apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
- change (base/2 * 2) with base.
- apply Z.le_lt_trans with (phi r).
- rewrite Z.mul_comm; apply Z_mult_div_ge; auto with zarith.
- case (phi_bounded r); auto with zarith.
- contradict Hij; apply Z.le_ngt.
- assert ((1 + [|j|]) <= 2 ^ 30); auto with zarith.
- apply Z.le_trans with ((2 ^ 30) * (2 ^ 30)); auto with zarith.
- assert (0 <= 1 + [|j|]); auto with zarith.
- apply Z.mul_le_mono_nonneg; auto with zarith.
- change ((2 ^ 30) * (2 ^ 30)) with ((2 ^ 29) * base).
- apply Z.le_trans with ([|ih|] * base); auto with zarith.
- unfold phi2, base; auto with zarith.
- split; auto.
- apply sqrt_test_true; auto.
- unfold phi2, base; auto with zarith.
- apply Z.le_ge; apply Z.le_trans with (([|j|] * base)/[|j|]).
- rewrite Z.mul_comm, Z_div_mult; auto with zarith.
- apply Z.ge_le; apply Z_div_ge; auto with zarith.
+ - split; auto.
+   apply sqrt_test_true; auto.
+   + unfold phi2, base; auto with zarith.
+   + unfold phi2; rewrite Hc1.
+     assert (0 <= [|il|]/[|j|]) by (apply Z_div_pos; auto with zarith).
+     rewrite Z.mul_comm, Z_div_plus_full_l; auto with zarith.
+     change base with wB. auto with zarith.
+ - case (Z.le_gt_cases (2 ^ 30) [|j|]); intros Hjj.
+   + rewrite spec_compare; case Z.compare_spec;
+     rewrite div312_phi; auto; intros Hc;
+     try (split; auto; apply sqrt_test_true; auto with zarith; fail).
+     apply Hrec.
+     * assert (Hf1: 0 <= phi2 ih il/ [|j|]) by auto with zarith.
+       apply Z.le_succ_l in Hj. change (1 <= [|j|]) in Hj.
+       Z.le_elim Hj;
+         [ | contradict Hc; apply Z.le_ngt;
+             rewrite <- Hj, Zdiv_1_r; auto with zarith ].
+       assert (Hf3: 0 < ([|j|] + phi2 ih il / [|j|]) / 2).
+       { replace ([|j|] + phi2 ih il/ [|j|]) with
+         (1 * 2 + (([|j|] - 2) + phi2 ih il / [|j|])); try ring.
+         rewrite Z_div_plus_full_l; auto with zarith.
+         assert (0 <= ([|j|] - 2 + phi2 ih il / [|j|]) / 2) ;
+         auto with zarith. }
+       assert (Hf4: ([|j|] + phi2 ih il / [|j|]) / 2 < [|j|]).
+       { apply sqrt_test_false; auto with zarith. }
+       generalize (spec_add_c j (fst (div3121 ih il j))).
+       unfold interp_carry;  case add31c; intros r;
+       rewrite div312_phi; auto with zarith.
+       { rewrite div31_phi; change [|2|] with 2; auto with zarith.
+         intros HH; rewrite HH; clear HH; auto with zarith. }
+       { rewrite spec_add, div31_phi; change [|2|] with 2; auto.
+         rewrite Z.mul_1_l; intros HH.
+         rewrite Z.add_comm, <- Z_div_plus_full_l; auto with zarith.
+         change (phi v30 * 2) with (2 ^ Z.of_nat size).
+         rewrite HH, Zmod_small; auto with zarith. }
+     * replace (phi _) with (([|j|] + (phi2 ih il)/([|j|]))/2);
+       [ apply sqrt_main; auto with zarith | ].
+       generalize (spec_add_c j (fst (div3121 ih il j))).
+       unfold interp_carry;  case add31c; intros r;
+       rewrite div312_phi; auto with zarith.
+       { rewrite div31_phi; auto with zarith.
+         intros HH; rewrite HH; auto with zarith. }
+       { intros HH; rewrite <- HH.
+         change (1 * 2 ^ Z.of_nat size) with (phi (v30) * 2).
+         rewrite Z_div_plus_full_l; auto with zarith.
+         rewrite Z.add_comm.
+         rewrite spec_add, Zmod_small.
+         - rewrite div31_phi; auto.
+         - split; auto with zarith.
+           + case (phi_bounded (fst (r/2)%int31));
+             case (phi_bounded v30); auto with zarith.
+           + rewrite div31_phi; change (phi 2) with 2; auto.
+             change (2 ^Z.of_nat size) with (base/2 + phi v30).
+             assert (phi r / 2 < base/2); auto with zarith.
+             apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
+             change (base/2 * 2) with base.
+             apply Z.le_lt_trans with (phi r).
+             * rewrite Z.mul_comm; apply Z_mult_div_ge; auto with zarith.
+             * case (phi_bounded r); auto with zarith. }
+   + contradict Hij; apply Z.le_ngt.
+     assert ((1 + [|j|]) <= 2 ^ 30); auto with zarith.
+     apply Z.le_trans with ((2 ^ 30) * (2 ^ 30)); auto with zarith.
+     * assert (0 <= 1 + [|j|]); auto with zarith.
+       apply Z.mul_le_mono_nonneg; auto with zarith.
+     * change ((2 ^ 30) * (2 ^ 30)) with ((2 ^ 29) * base).
+       apply Z.le_trans with ([|ih|] * base);
+         change wB with base in *; auto with zarith.
+       unfold phi2, base; auto with zarith.
+ - split; auto.
+   apply sqrt_test_true; auto.
+   + unfold phi2, base; auto with zarith.
+   + apply Z.le_ge; apply Z.le_trans with (([|j|] * base)/[|j|]).
+     * rewrite Z.mul_comm, Z_div_mult; auto with zarith.
+     * apply Z.ge_le; apply Z_div_ge; auto with zarith.
  Qed.
 
  Lemma iter312_sqrt_correct n rec ih il j:
@@ -2209,7 +2244,7 @@ Section Int31_Specs.
  intros j3 Hj3 Hpj3.
  apply HHrec; auto.
  rewrite Nat2Z.inj_succ, Z.pow_succ_r.
- apply Z.le_trans with (2 ^Z.of_nat n + [|j2|])%Z; auto with zarith.
+ apply Z.le_trans with (2 ^Z.of_nat n + [|j2|]); auto with zarith.
  apply Nat2Z.is_nonneg.
  Qed.
 
diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v
index ff4b998e..9f8da831 100644
--- a/theories/Numbers/Cyclic/Int31/Int31.v
+++ b/theories/Numbers/Cyclic/Int31/Int31.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
diff --git a/theories/Numbers/Cyclic/Int31/Ring31.v b/theories/Numbers/Cyclic/Int31/Ring31.v
index d160f5f1..b6935294 100644
--- a/theories/Numbers/Cyclic/Int31/Ring31.v
+++ b/theories/Numbers/Cyclic/Int31/Ring31.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Int31 numbers defines Z/(2^31)Z, and can hence be equipped
diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
index 04fc5a8d..784e8175 100644
--- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v
+++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Type [Z] viewed modulo a particular constant corresponds to [Z/nZ]
@@ -18,7 +20,7 @@ Set Implicit Arguments.
 Require Import Bool.
 Require Import ZArith.
 Require Import Znumtheory.
-Require Import BigNumPrelude.
+Require Import Zpow_facts.
 Require Import DoubleType.
 Require Import CyclicAxioms.
 
@@ -48,13 +50,14 @@ Section ZModulo.
 
  Lemma spec_more_than_1_digit: 1 < Zpos digits.
  Proof.
-  generalize digits_ne_1; destruct digits; auto.
+  generalize digits_ne_1; destruct digits; red; auto.
   destruct 1; auto.
  Qed.
  Let digits_gt_1 := spec_more_than_1_digit.
 
  Lemma wB_pos : wB > 0.
  Proof.
+  apply Z.lt_gt.
   unfold wB, base; auto with zarith.
  Qed.
  Hint Resolve wB_pos.
@@ -558,7 +561,7 @@ Section ZModulo.
  apply Zmod_small.
  generalize (Z_mod_lt [|w|] (2 ^ [|p|])); intros.
  split.
- destruct H; auto with zarith.
+ destruct H; auto using Z.lt_gt with zarith.
  apply Z.le_lt_trans with [|w|]; auto with zarith.
  apply Zmod_le; auto with zarith.
  Qed.
diff --git a/theories/Numbers/DecimalFacts.v b/theories/Numbers/DecimalFacts.v
new file mode 100644
index 00000000..0f490527
--- /dev/null
+++ b/theories/Numbers/DecimalFacts.v
@@ -0,0 +1,143 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** * 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 00000000..ef00e280
--- /dev/null
+++ b/theories/Numbers/DecimalN.v
@@ -0,0 +1,107 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** * 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 00000000..5ffe1688
--- /dev/null
+++ b/theories/Numbers/DecimalNat.v
@@ -0,0 +1,302 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** * 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 00000000..722e73d9
--- /dev/null
+++ b/theories/Numbers/DecimalPos.v
@@ -0,0 +1,383 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** * 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 00000000..1a3220f6
--- /dev/null
+++ b/theories/Numbers/DecimalString.v
@@ -0,0 +1,265 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 00000000..3a083796
--- /dev/null
+++ b/theories/Numbers/DecimalZ.v
@@ -0,0 +1,75 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** * 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/Integer/Abstract/ZAdd.v b/theories/Numbers/Integer/Abstract/ZAdd.v
index f7fdc179..c4c5174d 100644
--- a/theories/Numbers/Integer/Abstract/ZAdd.v
+++ b/theories/Numbers/Integer/Abstract/ZAdd.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/Abstract/ZAddOrder.v b/theories/Numbers/Integer/Abstract/ZAddOrder.v
index 6bf5e9d4..7f5b0df6 100644
--- a/theories/Numbers/Integer/Abstract/ZAddOrder.v
+++ b/theories/Numbers/Integer/Abstract/ZAddOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/Abstract/ZAxioms.v b/theories/Numbers/Integer/Abstract/ZAxioms.v
index ad10e65f..4f1ab775 100644
--- a/theories/Numbers/Integer/Abstract/ZAxioms.v
+++ b/theories/Numbers/Integer/Abstract/ZAxioms.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/Abstract/ZBase.v b/theories/Numbers/Integer/Abstract/ZBase.v
index 9b1b30f8..7fdd018d 100644
--- a/theories/Numbers/Integer/Abstract/ZBase.v
+++ b/theories/Numbers/Integer/Abstract/ZBase.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/Abstract/ZBits.v b/theories/Numbers/Integer/Abstract/ZBits.v
index c919e121..2da44528 100644
--- a/theories/Numbers/Integer/Abstract/ZBits.v
+++ b/theories/Numbers/Integer/Abstract/ZBits.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import
diff --git a/theories/Numbers/Integer/Abstract/ZDivEucl.v b/theories/Numbers/Integer/Abstract/ZDivEucl.v
index c2fa69e5..d7f25a66 100644
--- a/theories/Numbers/Integer/Abstract/ZDivEucl.v
+++ b/theories/Numbers/Integer/Abstract/ZDivEucl.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.
@@ -602,6 +604,14 @@ Proof.
  apply div_mod; order.
 Qed.
 
+Lemma mod_div: forall a b, b~=0 ->
+ a mod b / b == 0.
+Proof.
+ intros a b Hb.
+ rewrite div_small_iff by assumption.
+ auto using mod_always_pos.
+Qed.
+
 (** A last inequality: *)
 
 Theorem div_mul_le:
diff --git a/theories/Numbers/Integer/Abstract/ZDivFloor.v b/theories/Numbers/Integer/Abstract/ZDivFloor.v
index 310748dd..a0d1821b 100644
--- a/theories/Numbers/Integer/Abstract/ZDivFloor.v
+++ b/theories/Numbers/Integer/Abstract/ZDivFloor.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.
@@ -650,6 +652,14 @@ Proof.
  apply div_mod; order.
 Qed.
 
+Lemma mod_div: forall a b, b~=0 ->
+ a mod b / b == 0.
+Proof.
+ intros a b Hb.
+ rewrite div_small_iff by assumption.
+ auto using mod_bound_or.
+Qed.
+
 (** A last inequality: *)
 
 Theorem div_mul_le:
diff --git a/theories/Numbers/Integer/Abstract/ZDivTrunc.v b/theories/Numbers/Integer/Abstract/ZDivTrunc.v
index 04301077..31e42738 100644
--- a/theories/Numbers/Integer/Abstract/ZDivTrunc.v
+++ b/theories/Numbers/Integer/Abstract/ZDivTrunc.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.
@@ -622,6 +624,14 @@ Proof.
  apply quot_rem; order.
 Qed.
 
+Lemma rem_quot: forall a b, b~=0 ->
+ a rem b ÷ b == 0.
+Proof.
+ intros a b Hb.
+ rewrite quot_small_iff by assumption.
+ auto using rem_bound_abs.
+Qed.
+
 (** A last inequality: *)
 
 Theorem quot_mul_le:
diff --git a/theories/Numbers/Integer/Abstract/ZGcd.v b/theories/Numbers/Integer/Abstract/ZGcd.v
index 30adaeb4..f0b7bf9d 100644
--- a/theories/Numbers/Integer/Abstract/ZGcd.v
+++ b/theories/Numbers/Integer/Abstract/ZGcd.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of the greatest common divisor *)
diff --git a/theories/Numbers/Integer/Abstract/ZLcm.v b/theories/Numbers/Integer/Abstract/ZLcm.v
index ef33308c..0ab528de 100644
--- a/theories/Numbers/Integer/Abstract/ZLcm.v
+++ b/theories/Numbers/Integer/Abstract/ZLcm.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZAxioms ZMulOrder ZSgnAbs ZGcd ZDivTrunc ZDivFloor.
diff --git a/theories/Numbers/Integer/Abstract/ZLt.v b/theories/Numbers/Integer/Abstract/ZLt.v
index 0c92918d..726b041c 100644
--- a/theories/Numbers/Integer/Abstract/ZLt.v
+++ b/theories/Numbers/Integer/Abstract/ZLt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/Abstract/ZMaxMin.v b/theories/Numbers/Integer/Abstract/ZMaxMin.v
index 24a47f00..f3f3a861 100644
--- a/theories/Numbers/Integer/Abstract/ZMaxMin.v
+++ b/theories/Numbers/Integer/Abstract/ZMaxMin.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZAxioms ZMulOrder GenericMinMax.
diff --git a/theories/Numbers/Integer/Abstract/ZMul.v b/theories/Numbers/Integer/Abstract/ZMul.v
index 830c0a7d..120647dc 100644
--- a/theories/Numbers/Integer/Abstract/ZMul.v
+++ b/theories/Numbers/Integer/Abstract/ZMul.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/Abstract/ZMulOrder.v b/theories/Numbers/Integer/Abstract/ZMulOrder.v
index 320c8f35..cd9523d3 100644
--- a/theories/Numbers/Integer/Abstract/ZMulOrder.v
+++ b/theories/Numbers/Integer/Abstract/ZMulOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/Abstract/ZParity.v b/theories/Numbers/Integer/Abstract/ZParity.v
index 952d8e9c..a5e53b36 100644
--- a/theories/Numbers/Integer/Abstract/ZParity.v
+++ b/theories/Numbers/Integer/Abstract/ZParity.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool ZMulOrder NZParity.
diff --git a/theories/Numbers/Integer/Abstract/ZPow.v b/theories/Numbers/Integer/Abstract/ZPow.v
index 02b8501c..a4b964e5 100644
--- a/theories/Numbers/Integer/Abstract/ZPow.v
+++ b/theories/Numbers/Integer/Abstract/ZPow.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of the power function *)
diff --git a/theories/Numbers/Integer/Abstract/ZProperties.v b/theories/Numbers/Integer/Abstract/ZProperties.v
index 1dec3c58..e4b997cf 100644
--- a/theories/Numbers/Integer/Abstract/ZProperties.v
+++ b/theories/Numbers/Integer/Abstract/ZProperties.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export ZAxioms ZMaxMin ZSgnAbs ZParity ZPow ZDivTrunc ZDivFloor
diff --git a/theories/Numbers/Integer/Abstract/ZSgnAbs.v b/theories/Numbers/Integer/Abstract/ZSgnAbs.v
index a10552ab..dda12872 100644
--- a/theories/Numbers/Integer/Abstract/ZSgnAbs.v
+++ b/theories/Numbers/Integer/Abstract/ZSgnAbs.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of [abs] and [sgn] *)
diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v
deleted file mode 100644
index 7c76011f..00000000
--- a/theories/Numbers/Integer/BigZ/BigZ.v
+++ /dev/null
@@ -1,208 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Require Export BigN.
-Require Import ZProperties ZDivFloor ZSig ZSigZAxioms ZMake.
-
-(** * [BigZ] : arbitrary large efficient integers.
-
-    The following [BigZ] module regroups both the operations and
-    all the abstract properties:
-
-    - [ZMake.Make BigN] provides the operations and basic specs w.r.t. ZArith
-    - [ZTypeIsZAxioms] shows (mainly) that these operations implement
-      the interface [ZAxioms]
-    - [ZProp] adds all generic properties derived from [ZAxioms]
-    - [MinMax*Properties] provides properties of [min] and [max]
-
-*)
-
-Delimit Scope bigZ_scope with bigZ.
-
-Module BigZ <: ZType <: OrderedTypeFull <: TotalOrder :=
- ZMake.Make BigN
- <+ ZTypeIsZAxioms
- <+ ZBasicProp [no inline] <+ ZExtraProp [no inline]
- <+ HasEqBool2Dec [no inline]
- <+ MinMaxLogicalProperties [no inline]
- <+ MinMaxDecProperties [no inline].
-
-(** For precision concerning the above scope handling, see comment in BigN *)
-
-(** Notations about [BigZ] *)
-
-Local Open Scope bigZ_scope.
-
-Notation bigZ := BigZ.t.
-Bind Scope bigZ_scope with bigZ BigZ.t BigZ.t_.
-Arguments BigZ.Pos _%bigN.
-Arguments BigZ.Neg _%bigN.
-Local Notation "0" := BigZ.zero : bigZ_scope.
-Local Notation "1" := BigZ.one : bigZ_scope.
-Local Notation "2" := BigZ.two : bigZ_scope.
-Infix "+" := BigZ.add : bigZ_scope.
-Infix "-" := BigZ.sub : bigZ_scope.
-Notation "- x" := (BigZ.opp x) : bigZ_scope.
-Infix "*" := BigZ.mul : bigZ_scope.
-Infix "/" := BigZ.div : bigZ_scope.
-Infix "^" := BigZ.pow : bigZ_scope.
-Infix "?=" := BigZ.compare : bigZ_scope.
-Infix "=?" := BigZ.eqb (at level 70, no associativity) : bigZ_scope.
-Infix "<=?" := BigZ.leb (at level 70, no associativity) : bigZ_scope.
-Infix "<?" := BigZ.ltb (at level 70, no associativity) : bigZ_scope.
-Infix "==" := BigZ.eq (at level 70, no associativity) : bigZ_scope.
-Notation "x != y" := (~x==y) (at level 70, no associativity) : bigZ_scope.
-Infix "<" := BigZ.lt : bigZ_scope.
-Infix "<=" := BigZ.le : bigZ_scope.
-Notation "x > y" := (y < x) (only parsing) : bigZ_scope.
-Notation "x >= y" := (y <= x) (only parsing) : bigZ_scope.
-Notation "x < y < z" := (x<y /\ y<z) : bigZ_scope.
-Notation "x < y <= z" := (x<y /\ y<=z) : bigZ_scope.
-Notation "x <= y < z" := (x<=y /\ y<z) : bigZ_scope.
-Notation "x <= y <= z" := (x<=y /\ y<=z) : bigZ_scope.
-Notation "[ i ]" := (BigZ.to_Z i) : bigZ_scope.
-Infix "mod" := BigZ.modulo (at level 40, no associativity) : bigZ_scope.
-Infix "÷" := BigZ.quot (at level 40, left associativity) : bigZ_scope.
-
-(** Some additional results about [BigZ] *)
-
-Theorem spec_to_Z: forall n : bigZ,
-  BigN.to_Z (BigZ.to_N n) = ((Z.sgn [n]) * [n])%Z.
-Proof.
-intros n; case n; simpl; intros p;
-  generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
-intros p1 H1; case H1; auto.
-intros p1 H1; case H1; auto.
-Qed.
-
-Theorem spec_to_N n:
- ([n] = Z.sgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z.
-Proof.
-case n; simpl; intros p;
-  generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
-intros p1 H1; case H1; auto.
-intros p1 H1; case H1; auto.
-Qed.
-
-Theorem spec_to_Z_pos: forall n, (0 <= [n])%Z ->
-  BigN.to_Z (BigZ.to_N n) = [n].
-Proof.
-intros n; case n; simpl; intros p;
-  generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
-intros p1 _ H1; case H1; auto.
-intros p1 H1; case H1; auto.
-Qed.
-
-(** [BigZ] is a ring *)
-
-Lemma BigZring :
- ring_theory 0 1 BigZ.add BigZ.mul BigZ.sub BigZ.opp BigZ.eq.
-Proof.
-constructor.
-exact BigZ.add_0_l. exact BigZ.add_comm. exact BigZ.add_assoc.
-exact BigZ.mul_1_l. exact BigZ.mul_comm. exact BigZ.mul_assoc.
-exact BigZ.mul_add_distr_r.
-symmetry. apply BigZ.add_opp_r.
-exact BigZ.add_opp_diag_r.
-Qed.
-
-Lemma BigZeqb_correct : forall x y, (x =? y) = true -> x==y.
-Proof. now apply BigZ.eqb_eq. Qed.
-
-Definition BigZ_of_N n := BigZ.of_Z (Z.of_N n).
-
-Lemma BigZpower : power_theory 1 BigZ.mul BigZ.eq BigZ_of_N BigZ.pow.
-Proof.
-constructor.
-intros. unfold BigZ.eq, BigZ_of_N. rewrite BigZ.spec_pow, BigZ.spec_of_Z.
-rewrite Zpower_theory.(rpow_pow_N).
-destruct n; simpl. reflexivity.
-induction p; simpl; intros; BigZ.zify; rewrite ?IHp; auto.
-Qed.
-
-Lemma BigZdiv : div_theory BigZ.eq BigZ.add BigZ.mul (@id _)
- (fun a b => if b =? 0 then (0,a) else BigZ.div_eucl a b).
-Proof.
-constructor. unfold id. intros a b.
-BigZ.zify.
-case Z.eqb_spec.
-BigZ.zify. auto with zarith.
-intros NEQ.
-generalize (BigZ.spec_div_eucl a b).
-generalize (Z_div_mod_full [a] [b] NEQ).
-destruct BigZ.div_eucl as (q,r), Z.div_eucl as (q',r').
-intros (EQ,_). injection 1 as EQr EQq.
-BigZ.zify. rewrite EQr, EQq; auto.
-Qed.
-
-(** Detection of constants *)
-
-Ltac isBigZcst t :=
- match t with
- | BigZ.Pos ?t => isBigNcst t
- | BigZ.Neg ?t => isBigNcst t
- | BigZ.zero => constr:(true)
- | BigZ.one => constr:(true)
- | BigZ.two => constr:(true)
- | BigZ.minus_one => constr:(true)
- | _ => constr:(false)
- end.
-
-Ltac BigZcst t :=
- match isBigZcst t with
- | true => constr:(t)
- | false => constr:(NotConstant)
- end.
-
-Ltac BigZ_to_N t :=
- match t with
- | BigZ.Pos ?t => BigN_to_N t
- | BigZ.zero => constr:(0%N)
- | BigZ.one => constr:(1%N)
- | BigZ.two => constr:(2%N)
- | _ => constr:(NotConstant)
- end.
-
-(** Registration for the "ring" tactic *)
-
-Add Ring BigZr : BigZring
- (decidable BigZeqb_correct,
-  constants [BigZcst],
-  power_tac BigZpower [BigZ_to_N],
-  div BigZdiv).
-
-Section TestRing.
-Let test : forall x y, 1 + x*y + x^2 + 1 == 1*1 + 1 + (y + 1*x)*x.
-Proof.
-intros. ring_simplify. reflexivity.
-Qed.
-Let test' : forall x y, 1 + x*y + x^2 - 1*1 - y*x + 1*(-x)*x == 0.
-Proof.
-intros. ring_simplify. reflexivity.
-Qed.
-End TestRing.
-
-(** [BigZ] also benefits from an "order" tactic *)
-
-Ltac bigZ_order := BigZ.order.
-
-Section TestOrder.
-Let test : forall x y : bigZ, x<=y -> y<=x -> x==y.
-Proof. bigZ_order. Qed.
-End TestOrder.
-
-(** We can use at least a bit of (r)omega by translating to [Z]. *)
-
-Section TestOmega.
-Let test : forall x y : bigZ, x<=y -> y<=x -> x==y.
-Proof. intros x y. BigZ.zify. omega. Qed.
-End TestOmega.
-
-(** Todo: micromega *)
diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v
deleted file mode 100644
index fec6e068..00000000
--- a/theories/Numbers/Integer/BigZ/ZMake.v
+++ /dev/null
@@ -1,759 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Require Import ZArith.
-Require Import BigNumPrelude.
-Require Import NSig.
-Require Import ZSig.
-
-Open Scope Z_scope.
-
-(** * ZMake
-
-  A generic transformation from a structure of natural numbers
-  [NSig.NType] to a structure of integers [ZSig.ZType].
-*)
-
-Module Make (NN:NType) <: ZType.
-
- Inductive t_ :=
-  | Pos : NN.t -> t_
-  | Neg : NN.t -> t_.
-
- Definition t := t_.
-
- Definition zero := Pos NN.zero.
- Definition one  := Pos NN.one.
- Definition two := Pos NN.two.
- Definition minus_one := Neg NN.one.
-
- Definition of_Z x :=
-  match x with
-  | Zpos x => Pos (NN.of_N (Npos x))
-  | Z0 => zero
-  | Zneg x => Neg (NN.of_N (Npos x))
-  end.
-
- Definition to_Z x :=
-  match x with
-  | Pos nx => NN.to_Z nx
-  | Neg nx => Z.opp (NN.to_Z nx)
-  end.
-
- Theorem spec_of_Z: forall x, to_Z (of_Z x) = x.
- Proof.
- intros x; case x; unfold to_Z, of_Z, zero.
-   exact NN.spec_0.
-   intros; rewrite NN.spec_of_N; auto.
-   intros; rewrite NN.spec_of_N; auto.
- Qed.
-
- Definition eq x y := (to_Z x = to_Z y).
-
- Theorem spec_0: to_Z zero = 0.
- exact NN.spec_0.
- Qed.
-
- Theorem spec_1: to_Z one = 1.
- exact NN.spec_1.
- Qed.
-
- Theorem spec_2: to_Z two = 2.
- exact NN.spec_2.
- Qed.
-
- Theorem spec_m1: to_Z minus_one = -1.
- simpl; rewrite NN.spec_1; auto.
- Qed.
-
- Definition compare x y :=
-  match x, y with
-  | Pos nx, Pos ny => NN.compare nx ny
-  | Pos nx, Neg ny =>
-    match NN.compare nx NN.zero with
-    | Gt => Gt
-    | _ => NN.compare ny NN.zero
-    end
-  | Neg nx, Pos ny =>
-    match NN.compare NN.zero nx with
-    | Lt => Lt
-    | _ => NN.compare NN.zero ny
-    end
-  | Neg nx, Neg ny => NN.compare ny nx
-  end.
-
- Theorem spec_compare :
-  forall x y, compare x y = Z.compare (to_Z x) (to_Z y).
- Proof.
- unfold compare, to_Z.
- destruct x as [x|x], y as [y|y];
- rewrite ?NN.spec_compare, ?NN.spec_0, ?Z.compare_opp; auto;
- assert (Hx:=NN.spec_pos x); assert (Hy:=NN.spec_pos y);
- set (X:=NN.to_Z x) in *; set (Y:=NN.to_Z y) in *; clearbody X Y.
- - destruct (Z.compare_spec X 0) as [EQ|LT|GT].
-   + rewrite <- Z.opp_0 in EQ. now rewrite EQ, Z.compare_opp.
-   + exfalso. omega.
-   + symmetry. change (X > -Y). omega.
- - destruct (Z.compare_spec 0 X) as [EQ|LT|GT].
-   + rewrite <- EQ, Z.opp_0; auto.
-   + symmetry. change (-X < Y). omega.
-   + exfalso. omega.
- Qed.
-
- Definition eqb x y :=
-  match compare x y with
-  | Eq => true
-  | _ => false
-  end.
-
- Theorem spec_eqb x y : eqb x y = Z.eqb (to_Z x) (to_Z y).
- Proof.
- apply Bool.eq_iff_eq_true.
- unfold eqb. rewrite Z.eqb_eq, <- Z.compare_eq_iff, spec_compare.
- split; [now destruct Z.compare | now intros ->].
- Qed.
-
- Definition lt n m := to_Z n < to_Z m.
- Definition le n m := to_Z n <= to_Z m.
-
-
- Definition ltb (x y : t) : bool :=
-  match compare x y with
-  | Lt => true
-  | _  => false
-  end.
-
- Theorem spec_ltb x y : ltb x y = Z.ltb (to_Z x) (to_Z y).
- Proof.
- apply Bool.eq_iff_eq_true.
- rewrite Z.ltb_lt. unfold Z.lt, ltb. rewrite spec_compare.
- split; [now destruct Z.compare | now intros ->].
- Qed.
-
- Definition leb (x y : t) : bool :=
-  match compare x y with
-  | Gt => false
-  | _  => true
-  end.
-
- Theorem spec_leb x y : leb x y = Z.leb (to_Z x) (to_Z y).
- Proof.
- apply Bool.eq_iff_eq_true.
- rewrite Z.leb_le. unfold Z.le, leb. rewrite spec_compare.
- now destruct Z.compare; split.
- Qed.
-
- Definition min n m := match compare n m with Gt => m | _ => n end.
- Definition max n m := match compare n m with Lt => m | _ => n end.
-
- Theorem spec_min : forall n m, to_Z (min n m) = Z.min (to_Z n) (to_Z m).
- Proof.
- unfold min, Z.min. intros. rewrite spec_compare. destruct Z.compare; auto.
- Qed.
-
- Theorem spec_max : forall n m, to_Z (max n m) = Z.max (to_Z n) (to_Z m).
- Proof.
- unfold max, Z.max. intros. rewrite spec_compare. destruct Z.compare; auto.
- Qed.
-
- Definition to_N x :=
-  match x with
-  | Pos nx => nx
-  | Neg nx => nx
-  end.
-
- Definition abs x := Pos (to_N x).
-
- Theorem spec_abs: forall x, to_Z (abs x) = Z.abs (to_Z x).
- Proof.
- intros x; case x; clear x; intros x; assert (F:=NN.spec_pos x).
-    simpl; rewrite Z.abs_eq; auto.
- simpl; rewrite Z.abs_neq; simpl; auto with zarith.
- Qed.
-
- Definition opp x :=
-  match x with
-  | Pos nx => Neg nx
-  | Neg nx => Pos nx
-  end.
-
- Theorem spec_opp: forall x, to_Z (opp x) = - to_Z x.
- Proof.
- intros x; case x; simpl; auto with zarith.
- Qed.
-
- Definition succ x :=
-  match x with
-  | Pos n => Pos (NN.succ n)
-  | Neg n =>
-    match NN.compare NN.zero n with
-    | Lt => Neg (NN.pred n)
-    | _ => one
-    end
-  end.
-
- Theorem spec_succ: forall n, to_Z (succ n) = to_Z n + 1.
- Proof.
- intros x; case x; clear x; intros x.
-   exact (NN.spec_succ x).
- simpl. rewrite NN.spec_compare. case Z.compare_spec; rewrite ?NN.spec_0; simpl.
-  intros HH; rewrite <- HH; rewrite NN.spec_1; ring.
-  intros HH; rewrite NN.spec_pred, Z.max_r; auto with zarith.
- generalize (NN.spec_pos x); auto with zarith.
- Qed.
-
- Definition add x y :=
-  match x, y with
-  | Pos nx, Pos ny => Pos (NN.add nx ny)
-  | Pos nx, Neg ny =>
-    match NN.compare nx ny with
-    | Gt => Pos (NN.sub nx ny)
-    | Eq => zero
-    | Lt => Neg (NN.sub ny nx)
-    end
-  | Neg nx, Pos ny =>
-    match NN.compare nx ny with
-    | Gt => Neg (NN.sub nx ny)
-    | Eq => zero
-    | Lt => Pos (NN.sub ny nx)
-    end
-  | Neg nx, Neg ny => Neg (NN.add nx ny)
-  end.
-
- Theorem spec_add: forall x y, to_Z (add x y) = to_Z x +  to_Z y.
- Proof.
- unfold add, to_Z; intros [x | x] [y | y];
-   try (rewrite NN.spec_add; auto with zarith);
- rewrite NN.spec_compare; case Z.compare_spec;
-  unfold zero; rewrite ?NN.spec_0, ?NN.spec_sub; omega with *.
- Qed.
-
- Definition pred x :=
-  match x with
-  | Pos nx =>
-    match NN.compare NN.zero nx with
-    | Lt => Pos (NN.pred nx)
-    | _ => minus_one
-    end
-  | Neg nx => Neg (NN.succ nx)
-  end.
-
- Theorem spec_pred: forall x, to_Z (pred x) = to_Z x - 1.
- Proof.
- unfold pred, to_Z, minus_one; intros [x | x];
-   try (rewrite NN.spec_succ; ring).
- rewrite NN.spec_compare; case Z.compare_spec;
-  rewrite ?NN.spec_0, ?NN.spec_1, ?NN.spec_pred;
-  generalize (NN.spec_pos x); omega with *.
- Qed.
-
- Definition sub x y :=
-  match x, y with
-  | Pos nx, Pos ny =>
-    match NN.compare nx ny with
-    | Gt => Pos (NN.sub nx ny)
-    | Eq => zero
-    | Lt => Neg (NN.sub ny nx)
-    end
-  | Pos nx, Neg ny => Pos (NN.add nx ny)
-  | Neg nx, Pos ny => Neg (NN.add nx ny)
-  | Neg nx, Neg ny =>
-    match NN.compare nx ny with
-    | Gt => Neg (NN.sub nx ny)
-    | Eq => zero
-    | Lt => Pos (NN.sub ny nx)
-    end
-  end.
-
- Theorem spec_sub: forall x y, to_Z (sub x y) = to_Z x - to_Z y.
- Proof.
- unfold sub, to_Z; intros [x | x] [y | y];
-  try (rewrite NN.spec_add; auto with zarith);
- rewrite NN.spec_compare; case Z.compare_spec;
-  unfold zero; rewrite ?NN.spec_0, ?NN.spec_sub; omega with *.
- Qed.
-
- Definition mul x y :=
-  match x, y with
-  | Pos nx, Pos ny => Pos (NN.mul nx ny)
-  | Pos nx, Neg ny => Neg (NN.mul nx ny)
-  | Neg nx, Pos ny => Neg (NN.mul nx ny)
-  | Neg nx, Neg ny => Pos (NN.mul nx ny)
-  end.
-
- Theorem spec_mul: forall x y, to_Z (mul x y) = to_Z x * to_Z y.
- Proof.
- unfold mul, to_Z; intros [x | x] [y | y]; rewrite NN.spec_mul; ring.
- Qed.
-
- Definition square x :=
-  match x with
-  | Pos nx => Pos (NN.square nx)
-  | Neg nx => Pos (NN.square nx)
-  end.
-
- Theorem spec_square: forall x, to_Z (square x) = to_Z x *  to_Z x.
- Proof.
- unfold square, to_Z; intros [x | x]; rewrite NN.spec_square; ring.
- Qed.
-
- Definition pow_pos x p :=
-  match x with
-  | Pos nx => Pos (NN.pow_pos nx p)
-  | Neg nx =>
-    match p with
-    | xH => x
-    | xO _ => Pos (NN.pow_pos nx p)
-    | xI _ => Neg (NN.pow_pos nx p)
-    end
-  end.
-
- Theorem spec_pow_pos: forall x n, to_Z (pow_pos x n) = to_Z x ^ Zpos n.
- Proof.
- assert (F0: forall x, (-x)^2 = x^2).
-   intros x; rewrite Z.pow_2_r; ring.
- unfold pow_pos, to_Z; intros [x | x] [p | p |];
-   try rewrite NN.spec_pow_pos; try ring.
- assert (F: 0 <= 2 * Zpos p).
-  assert (0 <= Zpos p); auto with zarith.
- rewrite Pos2Z.inj_xI; repeat rewrite Zpower_exp; auto with zarith.
- repeat rewrite Z.pow_mul_r; auto with zarith.
- rewrite F0; ring.
- assert (F: 0 <= 2 * Zpos p).
-  assert (0 <= Zpos p); auto with zarith.
- rewrite Pos2Z.inj_xO; repeat rewrite Zpower_exp; auto with zarith.
- repeat rewrite Z.pow_mul_r; auto with zarith.
- rewrite F0; ring.
- Qed.
-
- Definition pow_N x n :=
-  match n with
-  | N0 => one
-  | Npos p => pow_pos x p
-  end.
-
- Theorem spec_pow_N: forall x n, to_Z (pow_N x n) = to_Z x ^ Z.of_N n.
- Proof.
- destruct n; simpl. apply NN.spec_1.
- apply spec_pow_pos.
- Qed.
-
- Definition pow x y :=
-  match to_Z y with
-  | Z0 => one
-  | Zpos p => pow_pos x p
-  | Zneg p => zero
-  end.
-
- Theorem spec_pow: forall x y, to_Z (pow x y) = to_Z x ^ to_Z y.
- Proof.
- intros. unfold pow. destruct (to_Z y); simpl.
- apply NN.spec_1.
- apply spec_pow_pos.
- apply NN.spec_0.
- Qed.
-
- Definition log2 x :=
-  match x with
-  | Pos nx => Pos (NN.log2 nx)
-  | Neg nx => zero
-  end.
-
- Theorem spec_log2: forall x, to_Z (log2 x) = Z.log2 (to_Z x).
- Proof.
-  intros. destruct x as [p|p]; simpl. apply NN.spec_log2.
-  rewrite NN.spec_0.
-  destruct (Z_le_lt_eq_dec _ _ (NN.spec_pos p)) as [LT|EQ].
-  rewrite Z.log2_nonpos; auto with zarith.
-  now rewrite <- EQ.
- Qed.
-
- Definition sqrt x :=
-  match x with
-  | Pos nx => Pos (NN.sqrt nx)
-  | Neg nx => Neg NN.zero
-  end.
-
- Theorem spec_sqrt: forall x, to_Z (sqrt x) = Z.sqrt (to_Z x).
- Proof.
-  destruct x as [p|p]; simpl.
-  apply NN.spec_sqrt.
-  rewrite NN.spec_0.
-  destruct (Z_le_lt_eq_dec _ _ (NN.spec_pos p)) as [LT|EQ].
-  rewrite Z.sqrt_neg; auto with zarith.
-  now rewrite <- EQ.
- Qed.
-
- Definition div_eucl x y :=
-  match x, y with
-  | Pos nx, Pos ny =>
-    let (q, r) := NN.div_eucl nx ny in
-    (Pos q, Pos r)
-  | Pos nx, Neg ny =>
-    let (q, r) := NN.div_eucl nx ny in
-    if NN.eqb NN.zero r
-    then (Neg q, zero)
-    else (Neg (NN.succ q), Neg (NN.sub ny r))
-  | Neg nx, Pos ny =>
-    let (q, r) := NN.div_eucl nx ny in
-    if NN.eqb NN.zero r
-    then (Neg q, zero)
-    else (Neg (NN.succ q), Pos (NN.sub ny r))
-  | Neg nx, Neg ny =>
-    let (q, r) := NN.div_eucl nx ny in
-    (Pos q, Neg r)
-  end.
-
- Ltac break_nonneg x px EQx :=
-  let H := fresh "H" in
-  assert (H:=NN.spec_pos x);
-  destruct (NN.to_Z x) as [|px|px] eqn:EQx;
-   [clear H|clear H|elim H; reflexivity].
-
- Theorem spec_div_eucl: forall x y,
-   let (q,r) := div_eucl x y in
-   (to_Z q, to_Z r) = Z.div_eucl (to_Z x) (to_Z y).
- Proof.
- unfold div_eucl, to_Z. intros [x | x] [y | y].
- (* Pos Pos *)
- generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y); auto.
- (* Pos Neg *)
- generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
- break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1 as Hq Hr; rewrite NN.spec_eqb, NN.spec_0, Hr;
-      simpl; rewrite Hq, NN.spec_0; auto).
- change (- Zpos py) with (Zneg py).
- assert (GT : Zpos py > 0) by (compute; auto).
- generalize (Z_div_mod (Zpos px) (Zpos py) GT).
- unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r').
- intros (EQ,MOD). injection 1 as Hq' Hr'.
- rewrite NN.spec_eqb, NN.spec_0, Hr'.
- break_nonneg r pr EQr.
- subst; simpl. rewrite NN.spec_0; auto.
- subst. lazy iota beta delta [Z.eqb].
- rewrite NN.spec_sub, NN.spec_succ, EQy, EQr. f_equal. omega with *.
- (* Neg Pos *)
- generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
- break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1 as Hq Hr; rewrite NN.spec_eqb, NN.spec_0, Hr;
-      simpl; rewrite Hq, NN.spec_0; auto).
- change (- Zpos px) with (Zneg px).
- assert (GT : Zpos py > 0) by (compute; auto).
- generalize (Z_div_mod (Zpos px) (Zpos py) GT).
- unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r').
- intros (EQ,MOD). injection 1 as Hq' Hr'.
- rewrite NN.spec_eqb, NN.spec_0, Hr'.
- break_nonneg r pr EQr.
- subst; simpl. rewrite NN.spec_0; auto.
- subst. lazy iota beta delta [Z.eqb].
- rewrite NN.spec_sub, NN.spec_succ, EQy, EQr. f_equal. omega with *.
- (* Neg Neg *)
- generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
- break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1 as -> ->; auto).
- simpl. intros <-; auto.
- Qed.
-
- Definition div x y := fst (div_eucl x y).
-
- Definition spec_div: forall x y,
-     to_Z (div x y) = to_Z x / to_Z y.
- Proof.
- intros x y; generalize (spec_div_eucl x y); unfold div, Z.div.
- case div_eucl; case Z.div_eucl; simpl; auto.
- intros q r q11 r1 H; injection H; auto.
- Qed.
-
- Definition modulo x y := snd (div_eucl x y).
-
- Theorem spec_modulo:
-   forall x y, to_Z (modulo x y) = to_Z x mod to_Z y.
- Proof.
- intros x y; generalize (spec_div_eucl x y); unfold modulo, Z.modulo.
- case div_eucl; case Z.div_eucl; simpl; auto.
- intros q r q11 r1 H; injection H; auto.
- Qed.
-
- Definition quot x y :=
-  match x, y with
-  | Pos nx, Pos ny => Pos (NN.div nx ny)
-  | Pos nx, Neg ny => Neg (NN.div nx ny)
-  | Neg nx, Pos ny => Neg (NN.div nx ny)
-  | Neg nx, Neg ny => Pos (NN.div nx ny)
-  end.
-
- Definition rem x y :=
-  if eqb y zero then x
-  else
-    match x, y with
-      | Pos nx, Pos ny => Pos (NN.modulo nx ny)
-      | Pos nx, Neg ny => Pos (NN.modulo nx ny)
-      | Neg nx, Pos ny => Neg (NN.modulo nx ny)
-      | Neg nx, Neg ny => Neg (NN.modulo nx ny)
-    end.
-
- Lemma spec_quot : forall x y, to_Z (quot x y) = (to_Z x) ÷ (to_Z y).
- Proof.
-  intros [x|x] [y|y]; simpl; symmetry; rewrite NN.spec_div;
-  (* Nota: we rely here on [forall a b, a ÷ 0 = b / 0] *)
-  destruct (Z.eq_dec (NN.to_Z y) 0) as [EQ|NEQ];
-    try (rewrite EQ; now destruct (NN.to_Z x));
-  rewrite ?Z.quot_opp_r, ?Z.quot_opp_l, ?Z.opp_involutive, ?Z.opp_inj_wd;
-  trivial; apply Z.quot_div_nonneg;
-   generalize (NN.spec_pos x) (NN.spec_pos y); Z.order.
- Qed.
-
- Lemma spec_rem : forall x y,
-   to_Z (rem x y) = Z.rem (to_Z x) (to_Z y).
- Proof.
-  intros x y. unfold rem. rewrite spec_eqb, spec_0.
-  case Z.eqb_spec; intros Hy.
-  (* Nota: we rely here on [Z.rem a 0 = a] *)
-  rewrite Hy. now destruct (to_Z x).
-  destruct x as [x|x], y as [y|y]; simpl in *; symmetry;
-   rewrite ?Z.eq_opp_l, ?Z.opp_0 in Hy;
-   rewrite NN.spec_modulo, ?Z.rem_opp_r, ?Z.rem_opp_l, ?Z.opp_involutive,
-    ?Z.opp_inj_wd;
-   trivial; apply Z.rem_mod_nonneg;
-    generalize (NN.spec_pos x) (NN.spec_pos y); Z.order.
- Qed.
-
- Definition gcd x y :=
-  match x, y with
-  | Pos nx, Pos ny => Pos (NN.gcd nx ny)
-  | Pos nx, Neg ny => Pos (NN.gcd nx ny)
-  | Neg nx, Pos ny => Pos (NN.gcd nx ny)
-  | Neg nx, Neg ny => Pos (NN.gcd nx ny)
-  end.
-
- Theorem spec_gcd: forall a b, to_Z (gcd a b) = Z.gcd (to_Z a) (to_Z b).
- Proof.
- unfold gcd, Z.gcd, to_Z; intros [x | x] [y | y]; rewrite NN.spec_gcd; unfold Z.gcd;
-  auto; case NN.to_Z; simpl; auto with zarith;
-  try rewrite Z.abs_opp; auto;
-  case NN.to_Z; simpl; auto with zarith.
- Qed.
-
- Definition sgn x :=
-  match compare zero x with
-   | Lt => one
-   | Eq => zero
-   | Gt => minus_one
-  end.
-
- Lemma spec_sgn : forall x, to_Z (sgn x) = Z.sgn (to_Z x).
- Proof.
- intros. unfold sgn. rewrite spec_compare. case Z.compare_spec.
- rewrite spec_0. intros <-; auto.
- rewrite spec_0, spec_1. symmetry. rewrite Z.sgn_pos_iff; auto.
- rewrite spec_0, spec_m1. symmetry. rewrite Z.sgn_neg_iff; auto with zarith.
- Qed.
-
- Definition even z :=
-  match z with
-   | Pos n => NN.even n
-   | Neg n => NN.even n
-  end.
-
- Definition odd z :=
-  match z with
-   | Pos n => NN.odd n
-   | Neg n => NN.odd n
-  end.
-
- Lemma spec_even : forall z, even z = Z.even (to_Z z).
- Proof.
-  intros [n|n]; simpl; rewrite NN.spec_even; trivial.
-  destruct (NN.to_Z n) as [|p|p]; now try destruct p.
- Qed.
-
- Lemma spec_odd : forall z, odd z = Z.odd (to_Z z).
- Proof.
-  intros [n|n]; simpl; rewrite NN.spec_odd; trivial.
-  destruct (NN.to_Z n) as [|p|p]; now try destruct p.
- Qed.
-
- Definition norm_pos z :=
-   match z with
-     | Pos _ => z
-     | Neg n => if NN.eqb n NN.zero then Pos n else z
-   end.
-
- Definition testbit a n :=
-   match norm_pos n, norm_pos a with
-     | Pos p, Pos a => NN.testbit a p
-     | Pos p, Neg a => negb (NN.testbit (NN.pred a) p)
-     | Neg p, _ => false
-   end.
-
- Definition shiftl a n :=
-   match norm_pos a, n with
-     | Pos a, Pos n => Pos (NN.shiftl a n)
-     | Pos a, Neg n => Pos (NN.shiftr a n)
-     | Neg a, Pos n => Neg (NN.shiftl a n)
-     | Neg a, Neg n => Neg (NN.succ (NN.shiftr (NN.pred a) n))
-   end.
-
- Definition shiftr a n := shiftl a (opp n).
-
- Definition lor a b :=
-   match norm_pos a, norm_pos b with
-     | Pos a, Pos b => Pos (NN.lor a b)
-     | Neg a, Pos b => Neg (NN.succ (NN.ldiff (NN.pred a) b))
-     | Pos a, Neg b => Neg (NN.succ (NN.ldiff (NN.pred b) a))
-     | Neg a, Neg b => Neg (NN.succ (NN.land (NN.pred a) (NN.pred b)))
-   end.
-
- Definition land a b :=
-   match norm_pos a, norm_pos b with
-     | Pos a, Pos b => Pos (NN.land a b)
-     | Neg a, Pos b => Pos (NN.ldiff b (NN.pred a))
-     | Pos a, Neg b => Pos (NN.ldiff a (NN.pred b))
-     | Neg a, Neg b => Neg (NN.succ (NN.lor (NN.pred a) (NN.pred b)))
-   end.
-
- Definition ldiff a b :=
-   match norm_pos a, norm_pos b with
-     | Pos a, Pos b => Pos (NN.ldiff a b)
-     | Neg a, Pos b => Neg (NN.succ (NN.lor (NN.pred a) b))
-     | Pos a, Neg b => Pos (NN.land a (NN.pred b))
-     | Neg a, Neg b => Pos (NN.ldiff (NN.pred b) (NN.pred a))
-   end.
-
- Definition lxor a b :=
-   match norm_pos a, norm_pos b with
-     | Pos a, Pos b => Pos (NN.lxor a b)
-     | Neg a, Pos b => Neg (NN.succ (NN.lxor (NN.pred a) b))
-     | Pos a, Neg b => Neg (NN.succ (NN.lxor a (NN.pred b)))
-     | Neg a, Neg b => Pos (NN.lxor (NN.pred a) (NN.pred b))
-   end.
-
- Definition div2 x := shiftr x one.
-
- Lemma Zlnot_alt1 : forall x, -(x+1) = Z.lnot x.
- Proof.
-  unfold Z.lnot, Z.pred; auto with zarith.
- Qed.
-
- Lemma Zlnot_alt2 : forall x, Z.lnot (x-1) = -x.
- Proof.
-  unfold Z.lnot, Z.pred; auto with zarith.
- Qed.
-
- Lemma Zlnot_alt3 : forall x, Z.lnot (-x) = x-1.
- Proof.
-  unfold Z.lnot, Z.pred; auto with zarith.
- Qed.
-
- Lemma spec_norm_pos : forall x, to_Z (norm_pos x) = to_Z x.
- Proof.
-  intros [x|x]; simpl; trivial.
-  rewrite NN.spec_eqb, NN.spec_0.
-  case Z.eqb_spec; simpl; auto with zarith.
- Qed.
-
- Lemma spec_norm_pos_pos : forall x y, norm_pos x = Neg y ->
-  0 < NN.to_Z y.
- Proof.
-  intros [x|x] y; simpl; try easy.
-  rewrite NN.spec_eqb, NN.spec_0.
-  case Z.eqb_spec; simpl; try easy.
-  inversion 2. subst. generalize (NN.spec_pos y); auto with zarith.
- Qed.
-
- Ltac destr_norm_pos x :=
-  rewrite <- (spec_norm_pos x);
-  let H := fresh in
-  let x' := fresh x in
-  assert (H := spec_norm_pos_pos x);
-  destruct (norm_pos x) as [x'|x'];
-   specialize (H x' (eq_refl _)) || clear H.
-
- Lemma spec_testbit: forall x p, testbit x p = Z.testbit (to_Z x) (to_Z p).
- Proof.
-  intros x p. unfold testbit.
-  destr_norm_pos p; simpl. destr_norm_pos x; simpl.
-  apply NN.spec_testbit.
-  rewrite NN.spec_testbit, NN.spec_pred, Z.max_r by auto with zarith.
-  symmetry. apply Z.bits_opp. apply NN.spec_pos.
-  symmetry. apply Z.testbit_neg_r; auto with zarith.
- Qed.
-
- Lemma spec_shiftl: forall x p, to_Z (shiftl x p) = Z.shiftl (to_Z x) (to_Z p).
- Proof.
-  intros x p. unfold shiftl.
-  destr_norm_pos x; destruct p as [p|p]; simpl;
-   assert (Hp := NN.spec_pos p).
-  apply NN.spec_shiftl.
-  rewrite Z.shiftl_opp_r. apply NN.spec_shiftr.
-  rewrite !NN.spec_shiftl.
-  rewrite !Z.shiftl_mul_pow2 by apply NN.spec_pos.
-  symmetry. apply Z.mul_opp_l.
-  rewrite Z.shiftl_opp_r, NN.spec_succ, NN.spec_shiftr, NN.spec_pred, Z.max_r
-   by auto with zarith.
-  now rewrite Zlnot_alt1, Z.lnot_shiftr, Zlnot_alt2.
- Qed.
-
- Lemma spec_shiftr: forall x p, to_Z (shiftr x p) = Z.shiftr (to_Z x) (to_Z p).
- Proof.
-  intros. unfold shiftr. rewrite spec_shiftl, spec_opp.
-  apply Z.shiftl_opp_r.
- Qed.
-
- Lemma spec_land: forall x y, to_Z (land x y) = Z.land (to_Z x) (to_Z y).
- Proof.
-  intros x y. unfold land.
-  destr_norm_pos x; destr_norm_pos y; simpl;
-   rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor,
-    ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith.
-  now rewrite Z.ldiff_land, Zlnot_alt2.
-  now rewrite Z.ldiff_land, Z.land_comm, Zlnot_alt2.
-  now rewrite Z.lnot_lor, !Zlnot_alt2.
- Qed.
-
- Lemma spec_lor: forall x y, to_Z (lor x y) = Z.lor (to_Z x) (to_Z y).
- Proof.
-  intros x y. unfold lor.
-  destr_norm_pos x; destr_norm_pos y; simpl;
-   rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor,
-    ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith.
-  now rewrite Z.lnot_ldiff, Z.lor_comm, Zlnot_alt2.
-  now rewrite Z.lnot_ldiff, Zlnot_alt2.
-  now rewrite Z.lnot_land, !Zlnot_alt2.
- Qed.
-
- Lemma spec_ldiff: forall x y, to_Z (ldiff x y) = Z.ldiff (to_Z x) (to_Z y).
- Proof.
-  intros x y. unfold ldiff.
-  destr_norm_pos x; destr_norm_pos y; simpl;
-   rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor,
-    ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith.
-  now rewrite Z.ldiff_land, Zlnot_alt3.
-  now rewrite Z.lnot_lor, Z.ldiff_land, <- Zlnot_alt2.
-  now rewrite 2 Z.ldiff_land, Zlnot_alt2, Z.land_comm, Zlnot_alt3.
- Qed.
-
- Lemma spec_lxor: forall x y, to_Z (lxor x y) = Z.lxor (to_Z x) (to_Z y).
- Proof.
-  intros x y. unfold lxor.
-  destr_norm_pos x; destr_norm_pos y; simpl;
-   rewrite ?NN.spec_succ, ?NN.spec_lxor, ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1;
-   auto with zarith.
-  now rewrite !Z.lnot_lxor_r, Zlnot_alt2.
-  now rewrite !Z.lnot_lxor_l, Zlnot_alt2.
-  now rewrite <- Z.lxor_lnot_lnot, !Zlnot_alt2.
- Qed.
-
- Lemma spec_div2: forall x, to_Z (div2 x) = Z.div2 (to_Z x).
- Proof.
-  intros x. unfold div2. now rewrite spec_shiftr, Z.div2_spec, spec_1.
- Qed.
-
-End Make.
diff --git a/theories/Numbers/Integer/Binary/ZBinary.v b/theories/Numbers/Integer/Binary/ZBinary.v
index eae8204d..bed827fd 100644
--- a/theories/Numbers/Integer/Binary/ZBinary.v
+++ b/theories/Numbers/Integer/Binary/ZBinary.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/NatPairs/ZNatPairs.v b/theories/Numbers/Integer/NatPairs/ZNatPairs.v
index 0aaf3365..4b2d5c13 100644
--- a/theories/Numbers/Integer/NatPairs/ZNatPairs.v
+++ b/theories/Numbers/Integer/NatPairs/ZNatPairs.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Integer/SpecViaZ/ZSig.v b/theories/Numbers/Integer/SpecViaZ/ZSig.v
deleted file mode 100644
index a360327a..00000000
--- a/theories/Numbers/Integer/SpecViaZ/ZSig.v
+++ /dev/null
@@ -1,135 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Require Import BinInt.
-
-Open Scope Z_scope.
-
-(** * ZSig *)
-
-(** Interface of a rich structure about integers.
-    Specifications are written via translation to Z.
-*)
-
-Module Type ZType.
-
- Parameter t : Type.
-
- Parameter to_Z : t -> Z.
- Local Notation "[ x ]" := (to_Z x).
-
- Definition eq x y := [x] = [y].
- Definition lt x y := [x] < [y].
- Definition le x y := [x] <= [y].
-
- Parameter of_Z : Z -> t.
- Parameter spec_of_Z: forall x, to_Z (of_Z x) = x.
-
- Parameter compare : t -> t -> comparison.
- Parameter eqb : t -> t -> bool.
- Parameter ltb : t -> t -> bool.
- Parameter leb : t -> t -> bool.
- Parameter min : t -> t -> t.
- Parameter max : t -> t -> t.
- Parameter zero : t.
- Parameter one : t.
- Parameter two : t.
- Parameter minus_one : t.
- Parameter succ : t -> t.
- Parameter add  : t -> t -> t.
- Parameter pred : t -> t.
- Parameter sub : t -> t -> t.
- Parameter opp : t -> t.
- Parameter mul : t -> t -> t.
- Parameter square : t -> t.
- Parameter pow_pos : t -> positive -> t.
- Parameter pow_N : t -> N -> t.
- Parameter pow : t -> t -> t.
- Parameter sqrt : t -> t.
- Parameter log2 : t -> t.
- Parameter div_eucl : t -> t -> t * t.
- Parameter div : t -> t -> t.
- Parameter modulo : t -> t -> t.
- Parameter quot : t -> t -> t.
- Parameter rem : t -> t -> t.
- Parameter gcd : t -> t -> t.
- Parameter sgn : t -> t.
- Parameter abs : t -> t.
- Parameter even : t -> bool.
- Parameter odd : t -> bool.
- Parameter testbit : t -> t -> bool.
- Parameter shiftr : t -> t -> t.
- Parameter shiftl : t -> t -> t.
- Parameter land : t -> t -> t.
- Parameter lor : t -> t -> t.
- Parameter ldiff : t -> t -> t.
- Parameter lxor : t -> t -> t.
- Parameter div2 : t -> t.
-
- Parameter spec_compare: forall x y, compare x y = ([x] ?= [y]).
- Parameter spec_eqb : forall x y, eqb x y = ([x] =? [y]).
- Parameter spec_ltb : forall x y, ltb x y = ([x] <? [y]).
- Parameter spec_leb : forall x y, leb x y = ([x] <=? [y]).
- Parameter spec_min : forall x y, [min x y] = Z.min [x] [y].
- Parameter spec_max : forall x y, [max x y] = Z.max [x] [y].
- Parameter spec_0: [zero] = 0.
- Parameter spec_1: [one] = 1.
- Parameter spec_2: [two] = 2.
- Parameter spec_m1: [minus_one] = -1.
- Parameter spec_succ: forall n, [succ n] = [n] + 1.
- Parameter spec_add: forall x y, [add x y] = [x] + [y].
- Parameter spec_pred: forall x, [pred x] = [x] - 1.
- Parameter spec_sub: forall x y, [sub x y] = [x] - [y].
- Parameter spec_opp: forall x, [opp x] = - [x].
- Parameter spec_mul: forall x y, [mul x y] = [x] * [y].
- Parameter spec_square: forall x, [square x] = [x] *  [x].
- Parameter spec_pow_pos: forall x n, [pow_pos x n] = [x] ^ Zpos n.
- Parameter spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z.of_N n.
- Parameter spec_pow: forall x n, [pow x n] = [x] ^ [n].
- Parameter spec_sqrt: forall x, [sqrt x] = Z.sqrt [x].
- Parameter spec_log2: forall x, [log2 x] = Z.log2 [x].
- Parameter spec_div_eucl: forall x y,
-   let (q,r) := div_eucl x y in ([q], [r]) = Z.div_eucl [x] [y].
- Parameter spec_div: forall x y, [div x y] = [x] / [y].
- Parameter spec_modulo: forall x y, [modulo x y] = [x] mod [y].
- Parameter spec_quot: forall x y, [quot x y] = [x] ÷ [y].
- Parameter spec_rem: forall x y, [rem x y] = Z.rem [x] [y].
- Parameter spec_gcd: forall a b, [gcd a b] = Z.gcd [a] [b].
- Parameter spec_sgn : forall x, [sgn x] = Z.sgn [x].
- Parameter spec_abs : forall x, [abs x] = Z.abs [x].
- Parameter spec_even : forall x, even x = Z.even [x].
- Parameter spec_odd : forall x, odd x = Z.odd [x].
- Parameter spec_testbit: forall x p, testbit x p = Z.testbit [x] [p].
- Parameter spec_shiftr: forall x p, [shiftr x p] = Z.shiftr [x] [p].
- Parameter spec_shiftl: forall x p, [shiftl x p] = Z.shiftl [x] [p].
- Parameter spec_land: forall x y, [land x y] = Z.land [x] [y].
- Parameter spec_lor: forall x y, [lor x y] = Z.lor [x] [y].
- Parameter spec_ldiff: forall x y, [ldiff x y] = Z.ldiff [x] [y].
- Parameter spec_lxor: forall x y, [lxor x y] = Z.lxor [x] [y].
- Parameter spec_div2: forall x, [div2 x] = Z.div2 [x].
-
-End ZType.
-
-Module Type ZType_Notation (Import Z:ZType).
- Notation "[ x ]" := (to_Z x).
- Infix "=="  := eq (at level 70).
- Notation "0" := zero.
- Notation "1" := one.
- Notation "2" := two.
- Infix "+" := add.
- Infix "-" := sub.
- Infix "*" := mul.
- Infix "^" := pow.
- Notation "- x" := (opp x).
- Infix "<=" := le.
- Infix "<" := lt.
-End ZType_Notation.
-
-Module Type ZType' := ZType <+ ZType_Notation.
diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
deleted file mode 100644
index 32410d1d..00000000
--- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
+++ /dev/null
@@ -1,527 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import Bool ZArith OrdersFacts Nnat ZAxioms ZSig.
-
-(** * The interface [ZSig.ZType] implies the interface [ZAxiomsSig] *)
-
-Module ZTypeIsZAxioms (Import ZZ : ZType').
-
-Hint Rewrite
- spec_0 spec_1 spec_2 spec_add spec_sub spec_pred spec_succ
- spec_mul spec_opp spec_of_Z spec_div spec_modulo spec_square spec_sqrt
- spec_compare spec_eqb spec_ltb spec_leb spec_max spec_min
- spec_abs spec_sgn spec_pow spec_log2 spec_even spec_odd spec_gcd
- spec_quot spec_rem spec_testbit spec_shiftl spec_shiftr
- spec_land spec_lor spec_ldiff spec_lxor spec_div2
- : zsimpl.
-
-Ltac zsimpl := autorewrite with zsimpl.
-Ltac zcongruence := repeat red; intros; zsimpl; congruence.
-Ltac zify := unfold eq, lt, le in *; zsimpl.
-
-Instance eq_equiv : Equivalence eq.
-Proof. unfold eq. firstorder. Qed.
-
-Local Obligation Tactic := zcongruence.
-
-Program Instance succ_wd : Proper (eq ==> eq) succ.
-Program Instance pred_wd : Proper (eq ==> eq) pred.
-Program Instance add_wd : Proper (eq ==> eq ==> eq) add.
-Program Instance sub_wd : Proper (eq ==> eq ==> eq) sub.
-Program Instance mul_wd : Proper (eq ==> eq ==> eq) mul.
-
-Theorem pred_succ : forall n, pred (succ n) == n.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem one_succ : 1 == succ 0.
-Proof.
-now zify.
-Qed.
-
-Theorem two_succ : 2 == succ 1.
-Proof.
-now zify.
-Qed.
-
-Section Induction.
-
-Variable A : ZZ.t -> Prop.
-Hypothesis A_wd : Proper (eq==>iff) A.
-Hypothesis A0 : A 0.
-Hypothesis AS : forall n, A n <-> A (succ n).
-
-Let B (z : Z) := A (of_Z z).
-
-Lemma B0 : B 0.
-Proof.
-unfold B; simpl.
-rewrite <- (A_wd 0); auto.
-zify. auto.
-Qed.
-
-Lemma BS : forall z : Z, B z -> B (z + 1).
-Proof.
-intros z H.
-unfold B in *. apply -> AS in H.
-setoid_replace (of_Z (z + 1)) with (succ (of_Z z)); auto.
-zify. auto.
-Qed.
-
-Lemma BP : forall z : Z, B z -> B (z - 1).
-Proof.
-intros z H.
-unfold B in *. rewrite AS.
-setoid_replace (succ (of_Z (z - 1))) with (of_Z z); auto.
-zify. auto with zarith.
-Qed.
-
-Lemma B_holds : forall z : Z, B z.
-Proof.
-intros; destruct (Z_lt_le_dec 0 z).
-apply natlike_ind; auto with zarith.
-apply B0.
-intros; apply BS; auto.
-replace z with (-(-z))%Z in * by (auto with zarith).
-remember (-z)%Z as z'.
-pattern z'; apply natlike_ind.
-apply B0.
-intros; rewrite Z.opp_succ; unfold Z.pred; apply BP; auto.
-subst z'; auto with zarith.
-Qed.
-
-Theorem bi_induction : forall n, A n.
-Proof.
-intro n. setoid_replace n with (of_Z (to_Z n)).
-apply B_holds.
-zify. auto.
-Qed.
-
-End Induction.
-
-Theorem add_0_l : forall n, 0 + n == n.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem add_succ_l : forall n m, (succ n) + m == succ (n + m).
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem sub_0_r : forall n, n - 0 == n.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem sub_succ_r : forall n m, n - (succ m) == pred (n - m).
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem mul_0_l : forall n, 0 * n == 0.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem mul_succ_l : forall n m, (succ n) * m == n * m + m.
-Proof.
-intros. zify. ring.
-Qed.
-
-(** Order *)
-
-Lemma eqb_eq x y : eqb x y = true <-> x == y.
-Proof.
- zify. apply Z.eqb_eq.
-Qed.
-
-Lemma leb_le x y : leb x y = true <-> x <= y.
-Proof.
- zify. apply Z.leb_le.
-Qed.
-
-Lemma ltb_lt x y : ltb x y = true <-> x < y.
-Proof.
- zify. apply Z.ltb_lt.
-Qed.
-
-Lemma compare_eq_iff n m : compare n m = Eq <-> n == m.
-Proof.
- intros. zify. apply Z.compare_eq_iff.
-Qed.
-
-Lemma compare_lt_iff n m : compare n m = Lt <-> n < m.
-Proof.
- intros. zify. reflexivity.
-Qed.
-
-Lemma compare_le_iff n m : compare n m <> Gt <-> n <= m.
-Proof.
- intros. zify. reflexivity.
-Qed.
-
-Lemma compare_antisym n m : compare m n = CompOpp (compare n m).
-Proof.
- intros. zify. apply Z.compare_antisym.
-Qed.
-
-Include BoolOrderFacts ZZ ZZ ZZ [no inline].
-
-Instance compare_wd : Proper (eq ==> eq ==> Logic.eq) compare.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance eqb_wd : Proper (eq ==> eq ==> Logic.eq) eqb.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance ltb_wd : Proper (eq ==> eq ==> Logic.eq) ltb.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance leb_wd : Proper (eq ==> eq ==> Logic.eq) leb.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance lt_wd : Proper (eq ==> eq ==> iff) lt.
-Proof.
-intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition.
-Qed.
-
-Theorem lt_succ_r : forall n m, n < (succ m) <-> n <= m.
-Proof.
-intros. zify. omega.
-Qed.
-
-Theorem min_l : forall n m, n <= m -> min n m == n.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-Theorem min_r : forall n m, m <= n -> min n m == m.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-Theorem max_l : forall n m, m <= n -> max n m == n.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-Theorem max_r : forall n m, n <= m -> max n m == m.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-(** Part specific to integers, not natural numbers *)
-
-Theorem succ_pred : forall n, succ (pred n) == n.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-(** Opp *)
-
-Program Instance opp_wd : Proper (eq ==> eq) opp.
-
-Theorem opp_0 : - 0 == 0.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem opp_succ : forall n, - (succ n) == pred (- n).
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-(** Abs / Sgn *)
-
-Theorem abs_eq : forall n, 0 <= n -> abs n == n.
-Proof.
-intros n. zify. omega with *.
-Qed.
-
-Theorem abs_neq : forall n, n <= 0 -> abs n == -n.
-Proof.
-intros n. zify. omega with *.
-Qed.
-
-Theorem sgn_null : forall n, n==0 -> sgn n == 0.
-Proof.
-intros n. zify. omega with *.
-Qed.
-
-Theorem sgn_pos : forall n, 0<n -> sgn n == 1.
-Proof.
-intros n. zify. omega with *.
-Qed.
-
-Theorem sgn_neg : forall n, n<0 -> sgn n == opp 1.
-Proof.
-intros n. zify. omega with *.
-Qed.
-
-(** Power *)
-
-Program Instance pow_wd : Proper (eq==>eq==>eq) pow.
-
-Lemma pow_0_r : forall a, a^0 == 1.
-Proof.
- intros. now zify.
-Qed.
-
-Lemma pow_succ_r : forall a b, 0<=b -> a^(succ b) == a * a^b.
-Proof.
- intros a b. zify. intros. now rewrite Z.add_1_r, Z.pow_succ_r.
-Qed.
-
-Lemma pow_neg_r : forall a b, b<0 -> a^b == 0.
-Proof.
- intros a b. zify. intros Hb.
- destruct [b]; reflexivity || discriminate.
-Qed.
-
-Lemma pow_pow_N : forall a b, 0<=b -> a^b == pow_N a (Z.to_N (to_Z b)).
-Proof.
- intros a b. zify. intros Hb. now rewrite spec_pow_N, Z2N.id.
-Qed.
-
-Lemma pow_pos_N : forall a p, pow_pos a p == pow_N a (Npos p).
-Proof.
- intros a b. red. now rewrite spec_pow_N, spec_pow_pos.
-Qed.
-
-(** Square *)
-
-Lemma square_spec n : square n == n * n.
-Proof.
- now zify.
-Qed.
-
-(** Sqrt *)
-
-Lemma sqrt_spec : forall n, 0<=n ->
- (sqrt n)*(sqrt n) <= n /\ n < (succ (sqrt n))*(succ (sqrt n)).
-Proof.
- intros n. zify. apply Z.sqrt_spec.
-Qed.
-
-Lemma sqrt_neg : forall n, n<0 -> sqrt n == 0.
-Proof.
- intros n. zify. apply Z.sqrt_neg.
-Qed.
-
-(** Log2 *)
-
-Lemma log2_spec : forall n, 0<n ->
- 2^(log2 n) <= n /\ n < 2^(succ (log2 n)).
-Proof.
- intros n. zify. apply Z.log2_spec.
-Qed.
-
-Lemma log2_nonpos : forall n, n<=0 -> log2 n == 0.
-Proof.
- intros n. zify. apply Z.log2_nonpos.
-Qed.
-
-(** Even / Odd *)
-
-Definition Even n := exists m, n == 2*m.
-Definition Odd n := exists m, n == 2*m+1.
-
-Lemma even_spec n : even n = true <-> Even n.
-Proof.
- unfold Even. zify. rewrite Z.even_spec.
- split; intros (m,Hm).
- - exists (of_Z m). now zify.
- - exists [m]. revert Hm. now zify.
-Qed.
-
-Lemma odd_spec n : odd n = true <-> Odd n.
-Proof.
- unfold Odd. zify. rewrite Z.odd_spec.
- split; intros (m,Hm).
- - exists (of_Z m). now zify.
- - exists [m]. revert Hm. now zify.
-Qed.
-
-(** Div / Mod *)
-
-Program Instance div_wd : Proper (eq==>eq==>eq) div.
-Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
-
-Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b).
-Proof.
-intros a b. zify. intros. apply Z.div_mod; auto.
-Qed.
-
-Theorem mod_pos_bound :
- forall a b, 0 < b -> 0 <= modulo a b /\ modulo a b < b.
-Proof.
-intros a b. zify. intros. apply Z_mod_lt; auto with zarith.
-Qed.
-
-Theorem mod_neg_bound :
- forall a b, b < 0 -> b < modulo a b /\ modulo a b <= 0.
-Proof.
-intros a b. zify. intros. apply Z_mod_neg; auto with zarith.
-Qed.
-
-Definition mod_bound_pos :
- forall a b, 0<=a -> 0<b -> 0 <= modulo a b /\ modulo a b < b :=
- fun a b _ H => mod_pos_bound a b H.
-
-(** Quot / Rem *)
-
-Program Instance quot_wd : Proper (eq==>eq==>eq) quot.
-Program Instance rem_wd : Proper (eq==>eq==>eq) rem.
-
-Theorem quot_rem : forall a b, ~b==0 -> a == b*(quot a b) + rem a b.
-Proof.
-intros a b. zify. apply Z.quot_rem.
-Qed.
-
-Theorem rem_bound_pos :
- forall a b, 0<=a -> 0<b -> 0 <= rem a b /\ rem a b < b.
-Proof.
-intros a b. zify. apply Z.rem_bound_pos.
-Qed.
-
-Theorem rem_opp_l : forall a b, ~b==0 -> rem (-a) b == -(rem a b).
-Proof.
-intros a b. zify. apply Z.rem_opp_l.
-Qed.
-
-Theorem rem_opp_r : forall a b, ~b==0 -> rem a (-b) == rem a b.
-Proof.
-intros a b. zify. apply Z.rem_opp_r.
-Qed.
-
-(** Gcd *)
-
-Definition divide n m := exists p, m == p*n.
-Local Notation "( x | y )" := (divide x y) (at level 0).
-
-Lemma spec_divide : forall n m, (n|m) <-> Z.divide [n] [m].
-Proof.
- intros n m. split.
- - intros (p,H). exists [p]. revert H; now zify.
- - intros (z,H). exists (of_Z z). now zify.
-Qed.
-
-Lemma gcd_divide_l : forall n m, (gcd n m | n).
-Proof.
- intros n m. apply spec_divide. zify. apply Z.gcd_divide_l.
-Qed.
-
-Lemma gcd_divide_r : forall n m, (gcd n m | m).
-Proof.
- intros n m. apply spec_divide. zify. apply Z.gcd_divide_r.
-Qed.
-
-Lemma gcd_greatest : forall n m p, (p|n) -> (p|m) -> (p|gcd n m).
-Proof.
- intros n m p. rewrite !spec_divide. zify. apply Z.gcd_greatest.
-Qed.
-
-Lemma gcd_nonneg : forall n m, 0 <= gcd n m.
-Proof.
- intros. zify. apply Z.gcd_nonneg.
-Qed.
-
-(** Bitwise operations *)
-
-Program Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit.
-
-Lemma testbit_odd_0 : forall a, testbit (2*a+1) 0 = true.
-Proof.
- intros. zify. apply Z.testbit_odd_0.
-Qed.
-
-Lemma testbit_even_0 : forall a, testbit (2*a) 0 = false.
-Proof.
- intros. zify. apply Z.testbit_even_0.
-Qed.
-
-Lemma testbit_odd_succ : forall a n, 0<=n ->
- testbit (2*a+1) (succ n) = testbit a n.
-Proof.
- intros a n. zify. apply Z.testbit_odd_succ.
-Qed.
-
-Lemma testbit_even_succ : forall a n, 0<=n ->
- testbit (2*a) (succ n) = testbit a n.
-Proof.
- intros a n. zify. apply Z.testbit_even_succ.
-Qed.
-
-Lemma testbit_neg_r : forall a n, n<0 -> testbit a n = false.
-Proof.
- intros a n. zify. apply Z.testbit_neg_r.
-Qed.
-
-Lemma shiftr_spec : forall a n m, 0<=m ->
- testbit (shiftr a n) m = testbit a (m+n).
-Proof.
- intros a n m. zify. apply Z.shiftr_spec.
-Qed.
-
-Lemma shiftl_spec_high : forall a n m, 0<=m -> n<=m ->
- testbit (shiftl a n) m = testbit a (m-n).
-Proof.
- intros a n m. zify. intros Hn H.
- now apply Z.shiftl_spec_high.
-Qed.
-
-Lemma shiftl_spec_low : forall a n m, m<n ->
- testbit (shiftl a n) m = false.
-Proof.
- intros a n m. zify. intros H. now apply Z.shiftl_spec_low.
-Qed.
-
-Lemma land_spec : forall a b n,
- testbit (land a b) n = testbit a n && testbit b n.
-Proof.
- intros a n m. zify. now apply Z.land_spec.
-Qed.
-
-Lemma lor_spec : forall a b n,
- testbit (lor a b) n = testbit a n || testbit b n.
-Proof.
- intros a n m. zify. now apply Z.lor_spec.
-Qed.
-
-Lemma ldiff_spec : forall a b n,
- testbit (ldiff a b) n = testbit a n && negb (testbit b n).
-Proof.
- intros a n m. zify. now apply Z.ldiff_spec.
-Qed.
-
-Lemma lxor_spec : forall a b n,
- testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
-Proof.
- intros a n m. zify. now apply Z.lxor_spec.
-Qed.
-
-Lemma div2_spec : forall a, div2 a == shiftr a 1.
-Proof.
- intros a. zify. now apply Z.div2_spec.
-Qed.
-
-End ZTypeIsZAxioms.
-
-Module ZType_ZAxioms (ZZ : ZType)
- <: ZAxiomsSig <: OrderFunctions ZZ <: HasMinMax ZZ
- := ZZ <+ ZTypeIsZAxioms.
diff --git a/theories/Numbers/NaryFunctions.v b/theories/Numbers/NaryFunctions.v
index eaac7d69..ee28628e 100644
--- a/theories/Numbers/NaryFunctions.v
+++ b/theories/Numbers/NaryFunctions.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*          Pierre Letouzey, Jerome Vouillon, PPS, Paris 7, 2008        *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZAdd.v b/theories/Numbers/NatInt/NZAdd.v
index 8cc52940..bc366c50 100644
--- a/theories/Numbers/NatInt/NZAdd.v
+++ b/theories/Numbers/NatInt/NZAdd.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZAddOrder.v b/theories/Numbers/NatInt/NZAddOrder.v
index 705f2910..99812ee3 100644
--- a/theories/Numbers/NatInt/NZAddOrder.v
+++ b/theories/Numbers/NatInt/NZAddOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZAxioms.v b/theories/Numbers/NatInt/NZAxioms.v
index 5a7f2072..8c364cde 100644
--- a/theories/Numbers/NatInt/NZAxioms.v
+++ b/theories/Numbers/NatInt/NZAxioms.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Initial Author : Evgeny Makarov, INRIA, 2007 *)
diff --git a/theories/Numbers/NatInt/NZBase.v b/theories/Numbers/NatInt/NZBase.v
index cf4ad354..595b2182 100644
--- a/theories/Numbers/NatInt/NZBase.v
+++ b/theories/Numbers/NatInt/NZBase.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZBits.v b/theories/Numbers/NatInt/NZBits.v
index 209bd947..eefa5157 100644
--- a/theories/Numbers/NatInt/NZBits.v
+++ b/theories/Numbers/NatInt/NZBits.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool NZAxioms NZMulOrder NZParity NZPow NZDiv NZLog.
diff --git a/theories/Numbers/NatInt/NZDiv.v b/theories/Numbers/NatInt/NZDiv.v
index b2c0be6f..550aa226 100644
--- a/theories/Numbers/NatInt/NZDiv.v
+++ b/theories/Numbers/NatInt/NZDiv.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Euclidean Division *)
diff --git a/theories/Numbers/NatInt/NZDomain.v b/theories/Numbers/NatInt/NZDomain.v
index 3881a27f..3d0c005f 100644
--- a/theories/Numbers/NatInt/NZDomain.v
+++ b/theories/Numbers/NatInt/NZDomain.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export NumPrelude NZAxioms.
diff --git a/theories/Numbers/NatInt/NZGcd.v b/theories/Numbers/NatInt/NZGcd.v
index 44088f8c..c38d1aac 100644
--- a/theories/Numbers/NatInt/NZGcd.v
+++ b/theories/Numbers/NatInt/NZGcd.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Greatest Common Divisor *)
diff --git a/theories/Numbers/NatInt/NZLog.v b/theories/Numbers/NatInt/NZLog.v
index 3dfa2eef..794851a9 100644
--- a/theories/Numbers/NatInt/NZLog.v
+++ b/theories/Numbers/NatInt/NZLog.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Base-2 Logarithm *)
diff --git a/theories/Numbers/NatInt/NZMul.v b/theories/Numbers/NatInt/NZMul.v
index 36cd0827..44cbc517 100644
--- a/theories/Numbers/NatInt/NZMul.v
+++ b/theories/Numbers/NatInt/NZMul.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZMulOrder.v b/theories/Numbers/NatInt/NZMulOrder.v
index 8569fc56..292f0837 100644
--- a/theories/Numbers/NatInt/NZMulOrder.v
+++ b/theories/Numbers/NatInt/NZMulOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZOrder.v b/theories/Numbers/NatInt/NZOrder.v
index 0b9d6598..60e1123b 100644
--- a/theories/Numbers/NatInt/NZOrder.v
+++ b/theories/Numbers/NatInt/NZOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZParity.v b/theories/Numbers/NatInt/NZParity.v
index 4a1352cc..93d99f08 100644
--- a/theories/Numbers/NatInt/NZParity.v
+++ b/theories/Numbers/NatInt/NZParity.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool NZAxioms NZMulOrder.
@@ -260,4 +262,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/Numbers/NatInt/NZPow.v b/theories/Numbers/NatInt/NZPow.v
index 261febbc..a1310667 100644
--- a/theories/Numbers/NatInt/NZPow.v
+++ b/theories/Numbers/NatInt/NZPow.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Power Function *)
diff --git a/theories/Numbers/NatInt/NZProperties.v b/theories/Numbers/NatInt/NZProperties.v
index 79a9d733..fbcf43e8 100644
--- a/theories/Numbers/NatInt/NZProperties.v
+++ b/theories/Numbers/NatInt/NZProperties.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/NatInt/NZSqrt.v b/theories/Numbers/NatInt/NZSqrt.v
index 7f9bb9c2..c2d2c4ae 100644
--- a/theories/Numbers/NatInt/NZSqrt.v
+++ b/theories/Numbers/NatInt/NZSqrt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Square Root Function *)
diff --git a/theories/Numbers/Natural/Abstract/NAdd.v b/theories/Numbers/Natural/Abstract/NAdd.v
index eecec3ac..dc5f8e53 100644
--- a/theories/Numbers/Natural/Abstract/NAdd.v
+++ b/theories/Numbers/Natural/Abstract/NAdd.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NAddOrder.v b/theories/Numbers/Natural/Abstract/NAddOrder.v
index 9d68a006..2da3f0bf 100644
--- a/theories/Numbers/Natural/Abstract/NAddOrder.v
+++ b/theories/Numbers/Natural/Abstract/NAddOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NAxioms.v b/theories/Numbers/Natural/Abstract/NAxioms.v
index 25e285d5..dd09ac5f 100644
--- a/theories/Numbers/Natural/Abstract/NAxioms.v
+++ b/theories/Numbers/Natural/Abstract/NAxioms.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NBase.v b/theories/Numbers/Natural/Abstract/NBase.v
index f949a0f6..ad0b3d3d 100644
--- a/theories/Numbers/Natural/Abstract/NBase.v
+++ b/theories/Numbers/Natural/Abstract/NBase.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NBits.v b/theories/Numbers/Natural/Abstract/NBits.v
index 3dd603e2..e1391f59 100644
--- a/theories/Numbers/Natural/Abstract/NBits.v
+++ b/theories/Numbers/Natural/Abstract/NBits.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool NAxioms NSub NPow NDiv NParity NLog.
diff --git a/theories/Numbers/Natural/Abstract/NDefOps.v b/theories/Numbers/Natural/Abstract/NDefOps.v
index b3a53617..8e1be0d7 100644
--- a/theories/Numbers/Natural/Abstract/NDefOps.v
+++ b/theories/Numbers/Natural/Abstract/NDefOps.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NDiv.v b/theories/Numbers/Natural/Abstract/NDiv.v
index 84e1219e..4c26a071 100644
--- a/theories/Numbers/Natural/Abstract/NDiv.v
+++ b/theories/Numbers/Natural/Abstract/NDiv.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import NAxioms NSub NZDiv.
diff --git a/theories/Numbers/Natural/Abstract/NGcd.v b/theories/Numbers/Natural/Abstract/NGcd.v
index 1eac134d..96fb4247 100644
--- a/theories/Numbers/Natural/Abstract/NGcd.v
+++ b/theories/Numbers/Natural/Abstract/NGcd.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of the greatest common divisor *)
diff --git a/theories/Numbers/Natural/Abstract/NIso.v b/theories/Numbers/Natural/Abstract/NIso.v
index e6cac0ba..d41d0aff 100644
--- a/theories/Numbers/Natural/Abstract/NIso.v
+++ b/theories/Numbers/Natural/Abstract/NIso.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NLcm.v b/theories/Numbers/Natural/Abstract/NLcm.v
index 3d749799..47b74193 100644
--- a/theories/Numbers/Natural/Abstract/NLcm.v
+++ b/theories/Numbers/Natural/Abstract/NLcm.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import NAxioms NSub NDiv NGcd.
diff --git a/theories/Numbers/Natural/Abstract/NLog.v b/theories/Numbers/Natural/Abstract/NLog.v
index 0c9da29b..fe6fcee5 100644
--- a/theories/Numbers/Natural/Abstract/NLog.v
+++ b/theories/Numbers/Natural/Abstract/NLog.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Base-2 Logarithm Properties *)
diff --git a/theories/Numbers/Natural/Abstract/NMaxMin.v b/theories/Numbers/Natural/Abstract/NMaxMin.v
index b4c9db91..3cf4d3f9 100644
--- a/theories/Numbers/Natural/Abstract/NMaxMin.v
+++ b/theories/Numbers/Natural/Abstract/NMaxMin.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import NAxioms NSub GenericMinMax.
diff --git a/theories/Numbers/Natural/Abstract/NMulOrder.v b/theories/Numbers/Natural/Abstract/NMulOrder.v
index a4b52396..b7f1c8e4 100644
--- a/theories/Numbers/Natural/Abstract/NMulOrder.v
+++ b/theories/Numbers/Natural/Abstract/NMulOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v
index 60e955f5..acaecad9 100644
--- a/theories/Numbers/Natural/Abstract/NOrder.v
+++ b/theories/Numbers/Natural/Abstract/NOrder.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NParity.v b/theories/Numbers/Natural/Abstract/NParity.v
index e1f573f6..cb89e1d7 100644
--- a/theories/Numbers/Natural/Abstract/NParity.v
+++ b/theories/Numbers/Natural/Abstract/NParity.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Bool NSub NZParity.
diff --git a/theories/Numbers/Natural/Abstract/NPow.v b/theories/Numbers/Natural/Abstract/NPow.v
index c9b2177f..fc1cc93b 100644
--- a/theories/Numbers/Natural/Abstract/NPow.v
+++ b/theories/Numbers/Natural/Abstract/NPow.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of the power function *)
diff --git a/theories/Numbers/Natural/Abstract/NProperties.v b/theories/Numbers/Natural/Abstract/NProperties.v
index 819a5be9..bcf906cf 100644
--- a/theories/Numbers/Natural/Abstract/NProperties.v
+++ b/theories/Numbers/Natural/Abstract/NProperties.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export NAxioms.
diff --git a/theories/Numbers/Natural/Abstract/NSqrt.v b/theories/Numbers/Natural/Abstract/NSqrt.v
index 4ae41407..6bffe693 100644
--- a/theories/Numbers/Natural/Abstract/NSqrt.v
+++ b/theories/Numbers/Natural/Abstract/NSqrt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Properties of Square Root Function *)
diff --git a/theories/Numbers/Natural/Abstract/NStrongRec.v b/theories/Numbers/Natural/Abstract/NStrongRec.v
index fa3a5351..f76d8ae8 100644
--- a/theories/Numbers/Natural/Abstract/NStrongRec.v
+++ b/theories/Numbers/Natural/Abstract/NStrongRec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Abstract/NSub.v b/theories/Numbers/Natural/Abstract/NSub.v
index 21f12037..453b0c0d 100644
--- a/theories/Numbers/Natural/Abstract/NSub.v
+++ b/theories/Numbers/Natural/Abstract/NSub.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v
deleted file mode 100644
index e8ff516f..00000000
--- a/theories/Numbers/Natural/BigN/BigN.v
+++ /dev/null
@@ -1,198 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** * Efficient arbitrary large natural numbers in base 2^31 *)
-
-(** Initial Author: Arnaud Spiwack *)
-
-Require Export Int31.
-Require Import CyclicAxioms Cyclic31 Ring31 NSig NSigNAxioms NMake
-  NProperties GenericMinMax.
-
-(** The following [BigN] module regroups both the operations and
-    all the abstract properties:
-
-    - [NMake.Make Int31Cyclic] provides the operations and basic specs
-       w.r.t. ZArith
-    - [NTypeIsNAxioms] shows (mainly) that these operations implement
-      the interface [NAxioms]
-    - [NProp] adds all generic properties derived from [NAxioms]
-    - [MinMax*Properties] provides properties of [min] and [max].
-
-*)
-
-Delimit Scope bigN_scope with bigN.
-
-Module BigN <: NType <: OrderedTypeFull <: TotalOrder :=
-  NMake.Make Int31Cyclic
-  <+ NTypeIsNAxioms
-  <+ NBasicProp [no inline] <+ NExtraProp [no inline]
-  <+ HasEqBool2Dec [no inline]
-  <+ MinMaxLogicalProperties [no inline]
-  <+ MinMaxDecProperties [no inline].
-
-(** Notations about [BigN] *)
-
-Local Open Scope bigN_scope.
-
-Notation bigN := BigN.t.
-Bind Scope bigN_scope with bigN BigN.t BigN.t'.
-Arguments BigN.N0 _%int31.
-Local Notation "0" := BigN.zero : bigN_scope. (* temporary notation *)
-Local Notation "1" := BigN.one : bigN_scope. (* temporary notation *)
-Local Notation "2" := BigN.two : bigN_scope. (* temporary notation *)
-Infix "+" := BigN.add : bigN_scope.
-Infix "-" := BigN.sub : bigN_scope.
-Infix "*" := BigN.mul : bigN_scope.
-Infix "/" := BigN.div : bigN_scope.
-Infix "^" := BigN.pow : bigN_scope.
-Infix "?=" := BigN.compare : bigN_scope.
-Infix "=?" := BigN.eqb (at level 70, no associativity) : bigN_scope.
-Infix "<=?" := BigN.leb (at level 70, no associativity) : bigN_scope.
-Infix "<?" := BigN.ltb (at level 70, no associativity) : bigN_scope.
-Infix "==" := BigN.eq (at level 70, no associativity) : bigN_scope.
-Notation "x != y" := (~x==y) (at level 70, no associativity) : bigN_scope.
-Infix "<" := BigN.lt : bigN_scope.
-Infix "<=" := BigN.le : bigN_scope.
-Notation "x > y" := (y < x) (only parsing) : bigN_scope.
-Notation "x >= y" := (y <= x) (only parsing) : bigN_scope.
-Notation "x < y < z" := (x<y /\ y<z) : bigN_scope.
-Notation "x < y <= z" := (x<y /\ y<=z) : bigN_scope.
-Notation "x <= y < z" := (x<=y /\ y<z) : bigN_scope.
-Notation "x <= y <= z" := (x<=y /\ y<=z) : bigN_scope.
-Notation "[ i ]" := (BigN.to_Z i) : bigN_scope.
-Infix "mod" := BigN.modulo (at level 40, no associativity) : bigN_scope.
-
-(** Example of reasoning about [BigN] *)
-
-Theorem succ_pred: forall q : bigN,
-  0 < q -> BigN.succ (BigN.pred q) == q.
-Proof.
-intros; apply BigN.succ_pred.
-intro H'; rewrite H' in H; discriminate.
-Qed.
-
-(** [BigN] is a semi-ring *)
-
-Lemma BigNring : semi_ring_theory 0 1 BigN.add BigN.mul BigN.eq.
-Proof.
-constructor.
-exact BigN.add_0_l. exact BigN.add_comm. exact BigN.add_assoc.
-exact BigN.mul_1_l. exact BigN.mul_0_l. exact BigN.mul_comm.
-exact BigN.mul_assoc. exact BigN.mul_add_distr_r.
-Qed.
-
-Lemma BigNeqb_correct : forall x y, (x =? y) = true -> x==y.
-Proof. now apply BigN.eqb_eq. Qed.
-
-Lemma BigNpower : power_theory 1 BigN.mul BigN.eq BigN.of_N BigN.pow.
-Proof.
-constructor.
-intros. red. rewrite BigN.spec_pow, BigN.spec_of_N.
-rewrite Zpower_theory.(rpow_pow_N).
-destruct n; simpl. reflexivity.
-induction p; simpl; intros; BigN.zify; rewrite ?IHp; auto.
-Qed.
-
-Lemma BigNdiv : div_theory BigN.eq BigN.add BigN.mul (@id _)
- (fun a b => if b =? 0 then (0,a) else BigN.div_eucl a b).
-Proof.
-constructor. unfold id. intros a b.
-BigN.zify.
-case Z.eqb_spec.
-BigN.zify. auto with zarith.
-intros NEQ.
-generalize (BigN.spec_div_eucl a b).
-generalize (Z_div_mod_full [a] [b] NEQ).
-destruct BigN.div_eucl as (q,r), Z.div_eucl as (q',r').
-intros (EQ,_). injection 1 as EQr EQq.
-BigN.zify. rewrite EQr, EQq; auto.
-Qed.
-
-
-(** Detection of constants *)
-
-Ltac isStaticWordCst t :=
- match t with
- | W0 => constr:(true)
- | WW ?t1 ?t2 =>
-   match isStaticWordCst t1 with
-   | false => constr:(false)
-   | true => isStaticWordCst t2
-   end
- | _ => isInt31cst t
- end.
-
-Ltac isBigNcst t :=
- match t with
- | BigN.N0 ?t => isStaticWordCst t
- | BigN.N1 ?t => isStaticWordCst t
- | BigN.N2 ?t => isStaticWordCst t
- | BigN.N3 ?t => isStaticWordCst t
- | BigN.N4 ?t => isStaticWordCst t
- | BigN.N5 ?t => isStaticWordCst t
- | BigN.N6 ?t => isStaticWordCst t
- | BigN.Nn ?n ?t => match isnatcst n with
-   | true => isStaticWordCst t
-   | false => constr:(false)
-   end
- | BigN.zero => constr:(true)
- | BigN.one => constr:(true)
- | BigN.two => constr:(true)
- | _ => constr:(false)
- end.
-
-Ltac BigNcst t :=
- match isBigNcst t with
- | true => constr:(t)
- | false => constr:(NotConstant)
- end.
-
-Ltac BigN_to_N t :=
- match isBigNcst t with
- | true => eval vm_compute in (BigN.to_N t)
- | false => constr:(NotConstant)
- end.
-
-Ltac Ncst t :=
- match isNcst t with
- | true => constr:(t)
- | false => constr:(NotConstant)
- end.
-
-(** Registration for the "ring" tactic *)
-
-Add Ring BigNr : BigNring
- (decidable BigNeqb_correct,
-  constants [BigNcst],
-  power_tac BigNpower [BigN_to_N],
-  div BigNdiv).
-
-Section TestRing.
-Let test : forall x y, 1 + x*y^1 + x^2 + 1 == 1*1 + 1 + y*x + 1*x*x.
-intros. ring_simplify. reflexivity.
-Qed.
-End TestRing.
-
-(** We benefit also from an "order" tactic *)
-
-Ltac bigN_order := BigN.order.
-
-Section TestOrder.
-Let test : forall x y : bigN, x<=y -> y<=x -> x==y.
-Proof. bigN_order. Qed.
-End TestOrder.
-
-(** We can use at least a bit of (r)omega by translating to [Z]. *)
-
-Section TestOmega.
-Let test : forall x y : bigN, x<=y -> y<=x -> x==y.
-Proof. intros x y. BigN.zify. omega. Qed.
-End TestOmega.
-
-(** Todo: micromega *)
diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v
deleted file mode 100644
index 1425041a..00000000
--- a/theories/Numbers/Natural/BigN/NMake.v
+++ /dev/null
@@ -1,1706 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-(** * NMake *)
-
-(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*)
-
-(** NB: This file contain the part which is independent from the underlying
-    representation. The representation-dependent (and macro-generated) part
-    is now in [NMake_gen]. *)
-
-Require Import Bool BigNumPrelude ZArith Nnat Ndigits CyclicAxioms DoubleType
-  Nbasic Wf_nat StreamMemo NSig NMake_gen.
-
-Module Make (W0:CyclicType) <: NType.
-
- (** Let's include the macro-generated part. Even if we can't functorize
-     things (due to Eval red_t below), the rest of the module only uses
-     elements mentionned in interface [NAbstract]. *)
-
- Include NMake_gen.Make W0.
-
- Open Scope Z_scope.
-
- Local Notation "[ x ]" := (to_Z x).
-
- Definition eq (x y : t) := [x] = [y].
-
- Declare Reduction red_t :=
-  lazy beta iota delta
-   [iter_t reduce same_level mk_t mk_t_S succ_t dom_t dom_op].
-
- Ltac red_t :=
-  match goal with |- ?u => let v := (eval red_t in u) in change v end.
-
- (** * Generic results *)
-
- Tactic Notation "destr_t" constr(x) "as" simple_intropattern(pat) :=
-  destruct (destr_t x) as pat; cbv zeta;
-  rewrite ?iter_mk_t, ?spec_mk_t, ?spec_reduce.
-
- Lemma spec_same_level : forall A (P:Z->Z->A->Prop)
-  (f : forall n, dom_t n -> dom_t n -> A),
-  (forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)) ->
-  forall x y, P [x] [y] (same_level f x y).
- Proof.
- intros. apply spec_same_level_dep with (P:=fun _ => P); auto.
- Qed.
-
- Theorem spec_pos: forall x, 0 <= [x].
- Proof.
- intros x. destr_t x as (n,x). now case (ZnZ.spec_to_Z x).
- Qed.
-
- Lemma digits_dom_op_incr : forall n m, (n<=m)%nat ->
-  (ZnZ.digits (dom_op n) <= ZnZ.digits (dom_op m))%positive.
- Proof.
- intros.
- change (Zpos (ZnZ.digits (dom_op n)) <= Zpos (ZnZ.digits (dom_op m))).
- rewrite !digits_dom_op, !Pshiftl_nat_Zpower.
- apply Z.mul_le_mono_nonneg_l; auto with zarith.
- apply Z.pow_le_mono_r; auto with zarith.
- Qed.
-
- Definition to_N (x : t) := Z.to_N (to_Z x).
-
- (** * Zero, One *)
-
- Definition zero := mk_t O ZnZ.zero.
- Definition one := mk_t O ZnZ.one.
-
- Theorem spec_0: [zero] = 0.
- Proof.
- unfold zero. rewrite spec_mk_t. exact ZnZ.spec_0.
- Qed.
-
- Theorem spec_1: [one] = 1.
- Proof.
- unfold one. rewrite spec_mk_t. exact ZnZ.spec_1.
- Qed.
-
- (** * Successor *)
-
- (** NB: it is crucial here and for the rest of this file to preserve
-     the let-in's. They allow to pre-compute once and for all the
-     field access to Z/nZ initial structures (when n=0..6). *)
-
- Local Notation succn := (fun n =>
-  let op := dom_op n in
-  let succ_c := ZnZ.succ_c in
-  let one := ZnZ.one in
-  fun x => match succ_c x with
-   | C0 r => mk_t n r
-   | C1 r => mk_t_S n (WW one r)
-  end).
-
- Definition succ : t -> t := Eval red_t in iter_t succn.
-
- Lemma succ_fold : succ = iter_t succn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_succ: forall n, [succ n] = [n] + 1.
- Proof.
-  intros x. rewrite succ_fold. destr_t x as (n,x).
-  generalize (ZnZ.spec_succ_c x); case ZnZ.succ_c.
-  intros. rewrite spec_mk_t. assumption.
-  intros. unfold interp_carry in *.
-  rewrite spec_mk_t_S. simpl. rewrite ZnZ.spec_1. assumption.
- Qed.
-
- (** Two *)
-
- (** Not really pretty, but since W0 might be Z/2Z, we're not sure
-     there's a proper 2 there. *)
-
- Definition two := succ one.
-
- Lemma spec_2 : [two] = 2.
- Proof.
-  unfold two. now rewrite spec_succ, spec_1.
- Qed.
-
- (** * Addition *)
-
- Local Notation addn := (fun n =>
-  let op := dom_op n in
-  let add_c := ZnZ.add_c in
-  let one := ZnZ.one in
-  fun x y =>match add_c x y with
-  | C0 r => mk_t n r
-  | C1 r => mk_t_S n (WW one r)
-  end).
-
- Definition add : t -> t -> t := Eval red_t in same_level addn.
-
- Lemma add_fold : add = same_level addn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_add: forall x y, [add x y] = [x] + [y].
- Proof.
-  intros x y. rewrite add_fold. apply spec_same_level; clear x y.
-  intros n x y. cbv beta iota zeta.
-  generalize (ZnZ.spec_add_c x y); case ZnZ.add_c; intros z H.
-  rewrite spec_mk_t. assumption.
-  rewrite spec_mk_t_S. unfold interp_carry in H.
-  simpl. rewrite ZnZ.spec_1. assumption.
- Qed.
-
- (** * Predecessor *)
-
- Local Notation predn := (fun n =>
-  let pred_c := ZnZ.pred_c in
-  fun x => match pred_c x with
-   | C0 r => reduce n r
-   | C1 _ => zero
-  end).
-
- Definition pred : t -> t := Eval red_t in iter_t predn.
-
- Lemma pred_fold : pred = iter_t predn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_pred_pos : forall x, 0 < [x] -> [pred x] = [x] - 1.
- Proof.
-  intros x. rewrite pred_fold. destr_t x as (n,x). intros H.
-  generalize (ZnZ.spec_pred_c x); case ZnZ.pred_c; intros y H'.
-  rewrite spec_reduce. assumption.
-  exfalso. unfold interp_carry in *.
-  generalize (ZnZ.spec_to_Z x) (ZnZ.spec_to_Z y); auto with zarith.
- Qed.
-
- Theorem spec_pred0 : forall x, [x] = 0 -> [pred x] = 0.
- Proof.
-  intros x. rewrite pred_fold. destr_t x as (n,x). intros H.
-  generalize (ZnZ.spec_pred_c x); case ZnZ.pred_c; intros y H'.
-  rewrite spec_reduce.
-  unfold interp_carry in H'.
-  generalize (ZnZ.spec_to_Z y); auto with zarith.
-  exact spec_0.
- Qed.
-
- Lemma spec_pred x : [pred x] = Z.max 0 ([x]-1).
- Proof.
- rewrite Z.max_comm.
- destruct (Z.max_spec ([x]-1) 0) as [(H,->)|(H,->)].
- - apply spec_pred0; generalize (spec_pos x); auto with zarith.
- - apply spec_pred_pos; auto with zarith.
- Qed.
-
- (** * Subtraction *)
-
- Local Notation subn := (fun n =>
-  let sub_c := ZnZ.sub_c in
-  fun x y => match sub_c x y with
-  | C0 r => reduce n r
-  | C1 r => zero
-  end).
-
- Definition sub : t -> t -> t := Eval red_t in same_level subn.
-
- Lemma sub_fold : sub = same_level subn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_sub_pos : forall x y, [y] <= [x] -> [sub x y] = [x] - [y].
- Proof.
-  intros x y. rewrite sub_fold. apply spec_same_level. clear x y.
-  intros n x y. simpl.
-  generalize (ZnZ.spec_sub_c x y); case ZnZ.sub_c; intros z H LE.
-  rewrite spec_reduce. assumption.
-  unfold interp_carry in H.
-  exfalso.
-  generalize (ZnZ.spec_to_Z z); auto with zarith.
- Qed.
-
- Theorem spec_sub0 : forall x y, [x] < [y] -> [sub x y] = 0.
- Proof.
-  intros x y. rewrite sub_fold. apply spec_same_level. clear x y.
-  intros n x y. simpl.
-  generalize (ZnZ.spec_sub_c x y); case ZnZ.sub_c; intros z H LE.
-  rewrite spec_reduce.
-  unfold interp_carry in H.
-  generalize (ZnZ.spec_to_Z z); auto with zarith.
-  exact spec_0.
- Qed.
-
- Lemma spec_sub : forall x y, [sub x y] = Z.max 0 ([x]-[y]).
- Proof.
- intros. destruct (Z.le_gt_cases [y] [x]).
- rewrite Z.max_r; auto with zarith. apply spec_sub_pos; auto.
- rewrite Z.max_l; auto with zarith. apply spec_sub0; auto.
- Qed.
-
- (** * Comparison *)
-
- Definition comparen_m n :
-  forall m, word (dom_t n) (S m) -> dom_t n -> comparison :=
-  let op := dom_op n in
-  let zero := ZnZ.zero (Ops:=op) in
-  let compare := ZnZ.compare (Ops:=op) in
-  let compare0 := compare zero in
-  fun m => compare_mn_1 (dom_t n) (dom_t n) zero compare compare0 compare (S m).
-
- Let spec_comparen_m:
-  forall n m (x : word (dom_t n) (S m)) (y : dom_t n),
-   comparen_m n m x y = Z.compare (eval n (S m) x) (ZnZ.to_Z y).
- Proof.
-  intros n m x y.
-  unfold comparen_m, eval.
-  rewrite nmake_double.
-  apply spec_compare_mn_1.
-  exact ZnZ.spec_0.
-  intros. apply ZnZ.spec_compare.
-  exact ZnZ.spec_to_Z.
-  exact ZnZ.spec_compare.
-  exact ZnZ.spec_compare.
-  exact ZnZ.spec_to_Z.
- Qed.
-
- Definition comparenm n m wx wy :=
-    let mn := Max.max n m in
-    let d := diff n m in
-    let op := make_op mn in
-    ZnZ.compare
-       (castm (diff_r n m) (extend_tr wx (snd d)))
-       (castm (diff_l n m) (extend_tr wy (fst d))).
-
- Local Notation compare_folded :=
-   (iter_sym _
-      (fun n => ZnZ.compare (Ops:=dom_op n))
-      comparen_m
-      comparenm
-      CompOpp).
-
- Definition compare : t -> t -> comparison :=
-  Eval lazy beta iota delta [iter_sym dom_op dom_t comparen_m] in
-  compare_folded.
-
- Lemma compare_fold : compare = compare_folded.
- Proof.
- lazy beta iota delta [iter_sym dom_op dom_t comparen_m]. reflexivity.
- Qed.
-
- Theorem spec_compare : forall x y,
-   compare x y = Z.compare [x] [y].
- Proof.
-  intros x y. rewrite compare_fold. apply spec_iter_sym; clear x y.
-  intros. apply ZnZ.spec_compare.
-  intros. cbv beta zeta. apply spec_comparen_m.
-  intros n m x y; unfold comparenm.
-  rewrite (spec_cast_l n m x), (spec_cast_r n m y).
-  unfold to_Z; apply ZnZ.spec_compare.
-  intros. subst. now rewrite <- Z.compare_antisym.
- Qed.
-
- Definition eqb (x y : t) : bool :=
-  match compare x y with
-  | Eq => true
-  | _  => false
-  end.
-
- Theorem spec_eqb x y : eqb x y = Z.eqb [x] [y].
- Proof.
- apply eq_iff_eq_true.
- unfold eqb. rewrite Z.eqb_eq, <- Z.compare_eq_iff, spec_compare.
- split; [now destruct Z.compare | now intros ->].
- Qed.
-
- Definition lt (n m : t) := [n] < [m].
- Definition le (n m : t) := [n] <= [m].
-
- Definition ltb (x y : t) : bool :=
-  match compare x y with
-  | Lt => true
-  | _  => false
-  end.
-
- Theorem spec_ltb x y : ltb x y = Z.ltb [x] [y].
- Proof.
- apply eq_iff_eq_true.
- rewrite Z.ltb_lt. unfold Z.lt, ltb. rewrite spec_compare.
- split; [now destruct Z.compare | now intros ->].
- Qed.
-
- Definition leb (x y : t) : bool :=
-  match compare x y with
-  | Gt => false
-  | _  => true
-  end.
-
- Theorem spec_leb x y : leb x y = Z.leb [x] [y].
- Proof.
- apply eq_iff_eq_true.
- rewrite Z.leb_le. unfold Z.le, leb. rewrite spec_compare.
- now destruct Z.compare; split.
- Qed.
-
- Definition min (n m : t) : t := match compare n m with Gt => m | _ => n end.
- Definition max (n m : t) : t := match compare n m with Lt => m | _ => n end.
-
- Theorem spec_max : forall n m, [max n m] = Z.max [n] [m].
- Proof.
- intros. unfold max, Z.max. rewrite spec_compare; destruct Z.compare; reflexivity.
- Qed.
-
- Theorem spec_min : forall n m, [min n m] = Z.min [n] [m].
- Proof.
- intros. unfold min, Z.min. rewrite spec_compare; destruct Z.compare; reflexivity.
- Qed.
-
- (** * Multiplication *)
-
- Definition wn_mul n : forall m, word (dom_t n) (S m) -> dom_t n -> t :=
-  let op := dom_op n in
-  let zero := ZnZ.zero in
-  let succ := ZnZ.succ (Ops:=op) in
-  let add_c := ZnZ.add_c (Ops:=op) in
-  let mul_c := ZnZ.mul_c (Ops:=op) in
-  let ww := @ZnZ.WW _ op in
-  let ow := @ZnZ.OW _ op in
-  let eq0 := ZnZ.eq0 in
-  let mul_add := @DoubleMul.w_mul_add _ zero succ add_c mul_c in
-  let mul_add_n1 := @DoubleMul.double_mul_add_n1 _ zero ww ow mul_add in
-  fun m x y =>
-   let (w,r) := mul_add_n1 (S m) x y zero in
-   if eq0 w then mk_t_w' n m r
-   else mk_t_w' n (S m) (WW (extend n m w) r).
-
- Definition mulnm n m x y :=
-    let mn := Max.max n m in
-    let d := diff n m in
-    let op := make_op mn in
-     reduce_n (S mn) (ZnZ.mul_c
-       (castm (diff_r n m) (extend_tr x (snd d)))
-       (castm (diff_l n m) (extend_tr y (fst d)))).
-
- Local Notation mul_folded :=
-  (iter_sym _
-    (fun n => let mul_c := ZnZ.mul_c in
-      fun x y => reduce (S n) (succ_t _ (mul_c x y)))
-    wn_mul
-    mulnm
-    (fun x => x)).
-
- Definition mul : t -> t -> t :=
-  Eval lazy beta iota delta
-   [iter_sym dom_op dom_t reduce succ_t extend zeron
-    wn_mul DoubleMul.w_mul_add mk_t_w'] in
-  mul_folded.
-
- Lemma mul_fold : mul = mul_folded.
- Proof.
-  lazy beta iota delta
-   [iter_sym dom_op dom_t reduce succ_t extend zeron
-    wn_mul  DoubleMul.w_mul_add mk_t_w']. reflexivity.
- Qed.
-
- Lemma spec_muln:
-   forall n (x: word _ (S n)) y,
-     [Nn (S n) (ZnZ.mul_c (Ops:=make_op n) x y)] = [Nn n x] * [Nn n y].
- Proof.
-    intros n x y; unfold to_Z.
-    rewrite <- ZnZ.spec_mul_c.
-    rewrite make_op_S.
-    case ZnZ.mul_c; auto.
- Qed.
-
- Lemma spec_mul_add_n1: forall n m x y z,
-  let (q,r) := DoubleMul.double_mul_add_n1 ZnZ.zero ZnZ.WW ZnZ.OW
-          (DoubleMul.w_mul_add ZnZ.zero ZnZ.succ ZnZ.add_c ZnZ.mul_c)
-          (S m) x y z in
-  ZnZ.to_Z q * (base (ZnZ.digits (nmake_op _ (dom_op n) (S m))))
-   + eval n (S m) r =
-  eval n (S m) x * ZnZ.to_Z y + ZnZ.to_Z z.
- Proof.
- intros n m x y z.
- rewrite digits_nmake.
- unfold eval. rewrite nmake_double.
- apply DoubleMul.spec_double_mul_add_n1.
- apply ZnZ.spec_0.
- exact ZnZ.spec_WW.
- exact ZnZ.spec_OW.
- apply DoubleCyclic.spec_mul_add.
- Qed.
-
- Lemma spec_wn_mul : forall n m x y,
-   [wn_mul n m x y] = (eval n (S m) x) * ZnZ.to_Z y.
- Proof.
-  intros; unfold wn_mul.
-  generalize (spec_mul_add_n1 n m x y ZnZ.zero).
-  case DoubleMul.double_mul_add_n1; intros q r Hqr.
-  rewrite ZnZ.spec_0, Z.add_0_r in Hqr. rewrite <- Hqr.
-  generalize (ZnZ.spec_eq0 q); case ZnZ.eq0; intros HH.
-  rewrite HH; auto. simpl. apply spec_mk_t_w'.
-  clear.
-  rewrite spec_mk_t_w'.
-  set (m' := S m) in *.
-  unfold eval.
-  rewrite nmake_WW. f_equal. f_equal.
-  rewrite <- spec_mk_t.
-  symmetry. apply spec_extend.
- Qed.
-
- Theorem spec_mul : forall x y, [mul x y] = [x] * [y].
- Proof.
-  intros x y. rewrite mul_fold. apply spec_iter_sym; clear x y.
-   intros n x y. cbv zeta beta.
-    rewrite spec_reduce, spec_succ_t, <- ZnZ.spec_mul_c; auto.
-   apply spec_wn_mul.
-   intros n m x y; unfold mulnm. rewrite spec_reduce_n.
-    rewrite (spec_cast_l n m x), (spec_cast_r n m y).
-    apply spec_muln.
-   intros. rewrite Z.mul_comm; auto.
- Qed.
-
- (** * Division by a smaller number *)
-
- Definition wn_divn1 n :=
-  let op := dom_op n in
-  let zd := ZnZ.zdigits op in
-  let zero := ZnZ.zero in
-  let ww := ZnZ.WW in
-  let head0 := ZnZ.head0 in
-  let add_mul_div := ZnZ.add_mul_div in
-  let div21 := ZnZ.div21 in
-  let compare := ZnZ.compare in
-  let sub := ZnZ.sub in
-  let ddivn1 :=
-    DoubleDivn1.double_divn1 zd zero ww head0 add_mul_div div21 compare sub in
-  fun m x y => let (u,v) := ddivn1 (S m) x y in (mk_t_w' n m u, mk_t n v).
-
- Definition div_gtnm n m wx wy :=
-    let mn := Max.max n m in
-    let d := diff n m in
-    let op := make_op mn in
-    let (q, r):= ZnZ.div_gt
-         (castm (diff_r n m) (extend_tr wx (snd d)))
-         (castm (diff_l n m) (extend_tr wy (fst d))) in
-    (reduce_n mn q, reduce_n mn r).
-
- Local Notation div_gt_folded :=
-   (iter _
-     (fun n => let div_gt := ZnZ.div_gt in
-       fun x y => let (u,v) := div_gt x y in (reduce n u, reduce n v))
-     (fun n =>
-       let div_gt := ZnZ.div_gt in
-       fun m x y =>
-         let y' := DoubleBase.get_low (zeron n) (S m) y in
-         let (u,v) := div_gt x y' in (reduce n u, reduce n v))
-      wn_divn1
-      div_gtnm).
-
- Definition div_gt :=
-  Eval lazy beta iota delta
-   [iter dom_op dom_t reduce zeron wn_divn1 mk_t_w' mk_t] in
-  div_gt_folded.
-
- Lemma div_gt_fold : div_gt = div_gt_folded.
- Proof.
-  lazy beta iota delta [iter dom_op dom_t reduce zeron wn_divn1 mk_t_w' mk_t].
-  reflexivity.
- Qed.
-
- Lemma spec_get_endn: forall n m x y,
-  eval n m x  <= [mk_t n y] ->
-   [mk_t n (DoubleBase.get_low (zeron n) m x)] = eval n m x.
- Proof.
-  intros n m x y H.
-  unfold eval. rewrite nmake_double.
-  rewrite spec_mk_t in *.
-  apply DoubleBase.spec_get_low.
-  apply spec_zeron.
-  exact ZnZ.spec_to_Z.
-  apply Z.le_lt_trans with (ZnZ.to_Z y); auto.
-    rewrite <- nmake_double; auto.
-  case (ZnZ.spec_to_Z y); auto.
- Qed.
-
- Definition spec_divn1 n :=
-   DoubleDivn1.spec_double_divn1
-    (ZnZ.zdigits (dom_op n)) (ZnZ.zero:dom_t n)
-    ZnZ.WW ZnZ.head0
-    ZnZ.add_mul_div ZnZ.div21
-    ZnZ.compare ZnZ.sub ZnZ.to_Z
-    ZnZ.spec_to_Z
-    ZnZ.spec_zdigits
-    ZnZ.spec_0 ZnZ.spec_WW ZnZ.spec_head0
-    ZnZ.spec_add_mul_div ZnZ.spec_div21
-    ZnZ.spec_compare ZnZ.spec_sub.
-
- Lemma spec_div_gt_aux : forall x y, [x] > [y] -> 0 < [y] ->
-   let (q,r) := div_gt x y in
-   [x] = [q] * [y] + [r] /\ 0 <= [r] < [y].
- Proof.
-  intros x y. rewrite div_gt_fold. apply spec_iter; clear x y.
-   intros n x y H1 H2. simpl.
-    generalize (ZnZ.spec_div_gt x y H1 H2); case ZnZ.div_gt.
-    intros u v. rewrite 2 spec_reduce. auto.
-   intros n m x y H1 H2. cbv zeta beta.
-    generalize (ZnZ.spec_div_gt x
-                (DoubleBase.get_low (zeron n) (S m) y)).
-    case ZnZ.div_gt.
-    intros u v H3; repeat rewrite spec_reduce.
-    generalize (spec_get_endn n (S m) y x). rewrite !spec_mk_t. intros H4.
-    rewrite H4 in H3; auto with zarith.
-   intros n m x y H1 H2.
-    generalize (spec_divn1 n (S m) x y H2).
-    unfold wn_divn1; case DoubleDivn1.double_divn1.
-    intros u v H3.
-    rewrite spec_mk_t_w', spec_mk_t.
-    rewrite <- !nmake_double in H3; auto.
-   intros n m x y H1 H2; unfold div_gtnm.
-    generalize (ZnZ.spec_div_gt
-                   (castm (diff_r n m)
-                     (extend_tr x (snd (diff n m))))
-                   (castm (diff_l n m)
-                     (extend_tr y (fst (diff n m))))).
-    case ZnZ.div_gt.
-    intros xx yy HH.
-    repeat rewrite spec_reduce_n.
-    rewrite (spec_cast_l n m x), (spec_cast_r n m y).
-    unfold to_Z; apply HH.
-    rewrite (spec_cast_l n m x) in H1; auto.
-    rewrite (spec_cast_r n m y) in H1; auto.
-    rewrite (spec_cast_r n m y) in H2; auto.
- Qed.
-
- Theorem spec_div_gt: forall x y, [x] > [y] -> 0 < [y] ->
-  let (q,r) := div_gt x y in
-  [q] = [x] / [y] /\ [r] = [x] mod [y].
- Proof.
-  intros x y H1 H2; generalize (spec_div_gt_aux x y H1 H2); case div_gt.
-  intros q r (H3, H4); split.
-  apply (Zdiv_unique [x] [y] [q] [r]); auto.
-  rewrite Z.mul_comm; auto.
-  apply (Zmod_unique [x] [y] [q] [r]); auto.
-  rewrite Z.mul_comm; auto.
- Qed.
-
- (** * General Division *)
-
- Definition div_eucl (x y : t) : t * t :=
-  if eqb y zero then (zero,zero) else
-  match compare x y with
-  | Eq => (one, zero)
-  | Lt => (zero, x)
-  | Gt => div_gt x y
-  end.
-
- Theorem spec_div_eucl: forall x y,
-      let (q,r) := div_eucl x y in
-      ([q], [r]) = Z.div_eucl [x] [y].
- Proof.
- intros x y. unfold div_eucl.
- rewrite spec_eqb, spec_compare, spec_0.
- case Z.eqb_spec.
- intros ->. rewrite spec_0. destruct [x]; auto.
- intros H'.
- assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith).
- clear H'.
- case Z.compare_spec; intros Cmp;
-   rewrite ?spec_0, ?spec_1; intros; auto with zarith.
- rewrite Cmp; generalize (Z_div_same [y] (Z.lt_gt _ _ H))
-                         (Z_mod_same [y] (Z.lt_gt _ _ H));
-  unfold Z.div, Z.modulo; case Z.div_eucl; intros; subst; auto.
- assert (LeLt: 0 <= [x] < [y]) by (generalize (spec_pos x); auto).
- generalize (Zdiv_small _ _ LeLt) (Zmod_small _ _ LeLt);
-  unfold Z.div, Z.modulo; case Z.div_eucl; intros; subst; auto.
- generalize (spec_div_gt _ _ (Z.lt_gt _ _ Cmp) H); auto.
- unfold Z.div, Z.modulo; case Z.div_eucl; case div_gt.
- intros a b c d (H1, H2); subst; auto.
- Qed.
-
- Definition div (x y : t) : t := fst (div_eucl x y).
-
- Theorem spec_div:
-   forall x y, [div x y] = [x] / [y].
- Proof.
- intros x y; unfold div; generalize (spec_div_eucl x y);
-   case div_eucl; simpl fst.
- intros xx yy; unfold Z.div; case Z.div_eucl; intros qq rr H;
-  injection H; auto.
- Qed.
-
- (** * Modulo by a smaller number *)
-
- Definition wn_modn1 n :=
-  let op := dom_op n in
-  let zd := ZnZ.zdigits op in
-  let zero := ZnZ.zero in
-  let head0 := ZnZ.head0 in
-  let add_mul_div := ZnZ.add_mul_div in
-  let div21 := ZnZ.div21 in
-  let compare := ZnZ.compare in
-  let sub := ZnZ.sub in
-  let dmodn1 :=
-    DoubleDivn1.double_modn1 zd zero head0 add_mul_div div21 compare sub in
-  fun m x y => reduce n (dmodn1 (S m) x y).
-
- Definition mod_gtnm n m wx wy :=
-    let mn := Max.max n m in
-    let d := diff n m in
-    let op := make_op mn in
-    reduce_n mn (ZnZ.modulo_gt
-         (castm (diff_r n m) (extend_tr wx (snd d)))
-         (castm (diff_l n m) (extend_tr wy (fst d)))).
-
- Local Notation mod_gt_folded :=
-   (iter _
-      (fun n => let modulo_gt := ZnZ.modulo_gt in
-        fun x y => reduce n (modulo_gt x y))
-      (fun n => let modulo_gt := ZnZ.modulo_gt in
-        fun m x y =>
-          reduce n (modulo_gt x (DoubleBase.get_low (zeron n) (S m) y)))
-      wn_modn1
-      mod_gtnm).
-
- Definition mod_gt :=
-  Eval lazy beta iota delta [iter dom_op dom_t reduce wn_modn1 zeron] in
-  mod_gt_folded.
-
- Lemma mod_gt_fold : mod_gt = mod_gt_folded.
- Proof.
-  lazy beta iota delta [iter dom_op dom_t reduce wn_modn1 zeron].
-  reflexivity.
- Qed.
-
- Definition spec_modn1 n :=
-   DoubleDivn1.spec_double_modn1
-    (ZnZ.zdigits (dom_op n)) (ZnZ.zero:dom_t n)
-    ZnZ.WW ZnZ.head0
-    ZnZ.add_mul_div ZnZ.div21
-    ZnZ.compare ZnZ.sub ZnZ.to_Z
-    ZnZ.spec_to_Z
-    ZnZ.spec_zdigits
-    ZnZ.spec_0 ZnZ.spec_WW ZnZ.spec_head0
-    ZnZ.spec_add_mul_div ZnZ.spec_div21
-    ZnZ.spec_compare ZnZ.spec_sub.
-
- Theorem spec_mod_gt:
-   forall x y, [x] > [y] -> 0 < [y] -> [mod_gt x y] = [x] mod [y].
- Proof.
- intros x y. rewrite mod_gt_fold. apply spec_iter; clear x y.
- intros n x y H1 H2. simpl. rewrite spec_reduce.
-   exact (ZnZ.spec_modulo_gt x y H1 H2).
- intros n m x y H1 H2. cbv zeta beta. rewrite spec_reduce.
-  rewrite <- spec_mk_t in H1.
-  rewrite <- (spec_get_endn n (S m) y x); auto with zarith.
-  rewrite spec_mk_t.
-  apply ZnZ.spec_modulo_gt; auto.
-  rewrite <- (spec_get_endn n (S m) y x), !spec_mk_t in H1; auto with zarith.
-  rewrite <- (spec_get_endn n (S m) y x), !spec_mk_t in H2; auto with zarith.
- intros n m x y H1 H2. unfold wn_modn1. rewrite spec_reduce.
-  unfold eval; rewrite nmake_double.
-  apply (spec_modn1 n); auto.
- intros n m x y H1 H2; unfold mod_gtnm.
-  repeat rewrite spec_reduce_n.
-  rewrite (spec_cast_l n m x), (spec_cast_r n m y).
-  unfold to_Z; apply ZnZ.spec_modulo_gt.
-  rewrite (spec_cast_l n m x) in H1; auto.
-  rewrite (spec_cast_r n m y) in H1; auto.
-  rewrite (spec_cast_r n m y) in H2; auto.
- Qed.
-
- (** * General Modulo *)
-
- Definition modulo (x y : t) : t :=
-  if eqb y zero then zero else
-  match compare x y with
-  | Eq => zero
-  | Lt => x
-  | Gt => mod_gt x y
-  end.
-
- Theorem spec_modulo:
-   forall x y, [modulo x y] = [x] mod [y].
- Proof.
- intros x y. unfold modulo.
- rewrite spec_eqb, spec_compare, spec_0.
- case Z.eqb_spec.
- intros ->; rewrite spec_0. destruct [x]; auto.
- intro H'.
- assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith).
- clear H'.
- case Z.compare_spec;
-   rewrite ?spec_0, ?spec_1; intros; try split; auto with zarith.
- rewrite H0; symmetry; apply Z_mod_same; auto with zarith.
- symmetry; apply Zmod_small; auto with zarith.
- generalize (spec_pos x); auto with zarith.
- apply spec_mod_gt; auto with zarith.
- Qed.
-
- (** * Square *)
-
- Local Notation squaren := (fun n =>
-   let square_c := ZnZ.square_c in
-   fun x => reduce (S n) (succ_t _ (square_c x))).
-
- Definition square : t -> t := Eval red_t in iter_t squaren.
-
- Lemma square_fold : square = iter_t squaren.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_square: forall x, [square x] = [x] * [x].
- Proof.
-  intros x. rewrite square_fold. destr_t x as (n,x).
-  rewrite spec_succ_t. exact (ZnZ.spec_square_c x).
- Qed.
-
- (** * Square Root *)
-
- Local Notation sqrtn := (fun n =>
-   let sqrt := ZnZ.sqrt in
-   fun x => reduce n (sqrt x)).
-
- Definition sqrt : t -> t := Eval red_t in iter_t sqrtn.
-
- Lemma sqrt_fold : sqrt = iter_t sqrtn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_sqrt_aux: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2.
- Proof.
-  intros x. rewrite sqrt_fold. destr_t x as (n,x). exact (ZnZ.spec_sqrt x).
- Qed.
-
- Theorem spec_sqrt: forall x, [sqrt x] = Z.sqrt [x].
- Proof.
-  intros x.
-  symmetry. apply Z.sqrt_unique.
-  rewrite <- ! Z.pow_2_r. apply spec_sqrt_aux.
- Qed.
-
- (** * Power *)
-
- Fixpoint pow_pos (x:t)(p:positive) : t :=
-  match p with
-  | xH => x
-  | xO p => square (pow_pos x p)
-  | xI p => mul (square (pow_pos x p)) x
-  end.
-
- Theorem spec_pow_pos: forall x n, [pow_pos x n] = [x] ^ Zpos n.
- Proof.
- intros x n; generalize x; elim n; clear n x; simpl pow_pos.
- intros; rewrite spec_mul; rewrite spec_square; rewrite H.
- rewrite Pos2Z.inj_xI; rewrite Zpower_exp; auto with zarith.
- rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith.
- rewrite Z.pow_2_r; rewrite Z.pow_1_r; auto.
- intros; rewrite spec_square; rewrite H.
- rewrite Pos2Z.inj_xO; auto with zarith.
- rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith.
- rewrite Z.pow_2_r; auto.
- intros; rewrite Z.pow_1_r; auto.
- Qed.
-
- Definition pow_N (x:t)(n:N) : t := match n with
-  | BinNat.N0 => one
-  | BinNat.Npos p => pow_pos x p
- end.
-
- Theorem spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z.of_N n.
- Proof.
- destruct n; simpl. apply spec_1.
- apply spec_pow_pos.
- Qed.
-
- Definition pow (x y:t) : t := pow_N x (to_N y).
-
- Theorem spec_pow : forall x y, [pow x y] = [x] ^ [y].
- Proof.
- intros. unfold pow, to_N.
- now rewrite spec_pow_N, Z2N.id by apply spec_pos.
- Qed.
-
-
- (** * digits
-
-     Number of digits in the representation of a numbers
-     (including head zero's).
-     NB: This function isn't a morphism for setoid [eq].
- *)
-
- Local Notation digitsn := (fun n =>
-   let digits := ZnZ.digits (dom_op n) in
-   fun _ => digits).
-
- Definition digits : t -> positive := Eval red_t in iter_t digitsn.
-
- Lemma digits_fold : digits = iter_t digitsn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x).
- Proof.
- intros x. rewrite digits_fold. destr_t x as (n,x). exact (ZnZ.spec_to_Z x).
- Qed.
-
- Lemma digits_level : forall x, digits x = ZnZ.digits (dom_op (level x)).
- Proof.
- intros x. rewrite digits_fold. unfold level. destr_t x as (n,x). reflexivity.
- Qed.
-
- (** * Gcd *)
-
- Definition gcd_gt_body a b cont :=
-  match compare b zero with
-  | Gt =>
-    let r := mod_gt a b in
-    match compare r zero with
-    | Gt => cont r (mod_gt b r)
-    | _ => b
-    end
-  | _ => a
-  end.
-
- Theorem Zspec_gcd_gt_body: forall a b cont p,
-    [a] > [b] -> [a] < 2 ^ p ->
-      (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] ->
-         Zis_gcd  [a1] [b1] [cont a1 b1]) ->
-      Zis_gcd [a] [b] [gcd_gt_body a b cont].
- Proof.
- intros a b cont p H2 H3 H4; unfold gcd_gt_body.
- rewrite ! spec_compare, spec_0. case Z.compare_spec.
-  intros ->; apply Zis_gcd_0.
- intros HH; absurd (0 <= [b]); auto with zarith.
- case (spec_digits b); auto with zarith.
- intros H5; case Z.compare_spec.
- intros H6; rewrite <- (Z.mul_1_r [b]).
- rewrite (Z_div_mod_eq [a] [b]); auto with zarith.
- rewrite <- spec_mod_gt; auto with zarith.
- rewrite H6; rewrite Z.add_0_r.
- apply Zis_gcd_mult; apply Zis_gcd_1.
- intros; apply False_ind.
- case (spec_digits (mod_gt a b)); auto with zarith.
- intros H6; apply DoubleDiv.Zis_gcd_mod; auto with zarith.
- apply DoubleDiv.Zis_gcd_mod; auto with zarith.
- rewrite <- spec_mod_gt; auto with zarith.
- assert (F2: [b] > [mod_gt a b]).
-   case (Z_mod_lt [a] [b]); auto with zarith.
-   repeat rewrite <- spec_mod_gt; auto with zarith.
- assert (F3: [mod_gt a b] > [mod_gt b  (mod_gt a b)]).
-   case (Z_mod_lt [b] [mod_gt a b]); auto with zarith.
-   rewrite <- spec_mod_gt; auto with zarith.
- repeat rewrite <- spec_mod_gt; auto with zarith.
- apply H4; auto with zarith.
- apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
- apply Z.le_lt_trans with ([b] + [mod_gt a b]); auto with zarith.
- apply Z.le_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith.
- - apply Z.add_le_mono_r.
-   rewrite <- (Z.mul_1_l [b]) at 1.
-   apply Z.mul_le_mono_nonneg_r; auto with zarith.
-   change 1 with (Z.succ 0). apply Z.le_succ_l.
-   apply Z.div_str_pos; auto with zarith.
- - rewrite Z.mul_comm; rewrite spec_mod_gt; auto with zarith.
-   rewrite <- Z_div_mod_eq; auto with zarith.
-   rewrite Z.mul_comm, <- Z.pow_succ_r, Z.sub_1_r, Z.succ_pred; auto.
-   apply Z.le_0_sub. change 1 with (Z.succ 0). apply Z.le_succ_l.
-   destruct p; simpl in H3; auto with zarith.
- Qed.
-
- Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) : t :=
-  gcd_gt_body a b
-    (fun a b =>
-       match p with
-       | xH => cont a b
-       | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b
-       | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b
-       end).
-
- Theorem Zspec_gcd_gt_aux: forall p n a b cont,
-    [a] > [b] -> [a] < 2 ^ (Zpos p + n) ->
-      (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] ->
-            Zis_gcd [a1] [b1] [cont a1 b1]) ->
-          Zis_gcd [a] [b] [gcd_gt_aux p cont a b].
- intros p; elim p; clear p.
- intros p Hrec n a b cont H2 H3 H4.
-   unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto.
-   intros a1 b1 H6 H7.
-     apply Hrec with (Zpos p + n); auto.
-       replace (Zpos p + (Zpos p + n)) with
-         (Zpos (xI p) + n  - 1); auto.
-       rewrite Pos2Z.inj_xI; ring.
-   intros a2 b2 H9 H10.
-     apply Hrec with n; auto.
- intros p Hrec n a b cont H2 H3 H4.
-   unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto.
-   intros a1 b1 H6 H7.
-     apply Hrec with (Zpos p + n - 1); auto.
-       replace (Zpos p + (Zpos p + n - 1)) with
-         (Zpos (xO p) + n  - 1); auto.
-       rewrite Pos2Z.inj_xO; ring.
-   intros a2 b2 H9 H10.
-     apply Hrec with (n - 1); auto.
-       replace (Zpos p + (n - 1)) with
-         (Zpos p + n  - 1); auto with zarith.
-   intros a3 b3 H12 H13; apply H4; auto with zarith.
-    apply Z.lt_le_trans with (1 := H12).
-    apply Z.pow_le_mono_r; auto with zarith.
- intros n a b cont H H2 H3.
-  simpl gcd_gt_aux.
-  apply Zspec_gcd_gt_body with (n + 1); auto with zarith.
-  rewrite Z.add_comm; auto.
-  intros a1 b1 H5 H6; apply H3; auto.
-  replace n with (n + 1 - 1); auto; try ring.
- Qed.
-
- Definition gcd_cont a b :=
-  match compare one b with
-  | Eq => one
-  | _ => a
-  end.
-
- Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b.
-
- Theorem spec_gcd_gt: forall a b,
-   [a] > [b] -> [gcd_gt a b] = Z.gcd [a] [b].
- Proof.
- intros a b H2.
- case (spec_digits (gcd_gt a b)); intros H3 H4.
- case (spec_digits a); intros H5 H6.
- symmetry; apply Zis_gcd_gcd; auto with zarith.
- unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith.
- intros a1 a2; rewrite Z.pow_0_r.
- case (spec_digits a2); intros H7 H8;
-   intros; apply False_ind; auto with zarith.
- Qed.
-
- Definition gcd (a b : t) : t :=
-  match compare a b with
-  | Eq => a
-  | Lt => gcd_gt b a
-  | Gt => gcd_gt a b
-  end.
-
- Theorem spec_gcd: forall a b, [gcd a b] = Z.gcd [a] [b].
- Proof.
- intros a b.
- case (spec_digits a); intros H1 H2.
- case (spec_digits b); intros H3 H4.
- unfold gcd. rewrite spec_compare. case Z.compare_spec.
- intros HH; rewrite HH; symmetry; apply Zis_gcd_gcd; auto.
-   apply Zis_gcd_refl.
- intros; transitivity (Z.gcd [b] [a]).
-   apply spec_gcd_gt; auto with zarith.
- apply Zis_gcd_gcd; auto with zarith.
- apply Z.gcd_nonneg.
- apply Zis_gcd_sym; apply Zgcd_is_gcd.
- intros; apply spec_gcd_gt; auto with zarith.
- Qed.
-
- (** * Parity test *)
-
- Definition even : t -> bool := Eval red_t in
-   iter_t (fun n x => ZnZ.is_even x).
-
- Definition odd x := negb (even x).
-
- Lemma even_fold : even = iter_t (fun n x => ZnZ.is_even x).
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_even_aux: forall x,
-   if even x then [x] mod 2 = 0 else [x] mod 2 = 1.
- Proof.
- intros x. rewrite even_fold. destr_t x as (n,x).
- exact (ZnZ.spec_is_even x).
- Qed.
-
- Theorem spec_even: forall x, even x = Z.even [x].
- Proof.
- intros x. assert (H := spec_even_aux x). symmetry.
- rewrite (Z.div_mod [x] 2); auto with zarith.
- destruct (even x); rewrite H, ?Z.add_0_r.
- rewrite Zeven_bool_iff. apply Zeven_2p.
- apply not_true_is_false. rewrite Zeven_bool_iff.
- apply Zodd_not_Zeven. apply Zodd_2p_plus_1.
- Qed.
-
- Theorem spec_odd: forall x, odd x = Z.odd [x].
- Proof.
- intros x. unfold odd.
- assert (H := spec_even_aux x). symmetry.
- rewrite (Z.div_mod [x] 2); auto with zarith.
- destruct (even x); rewrite H, ?Z.add_0_r; simpl negb.
- apply not_true_is_false. rewrite Zodd_bool_iff.
- apply Zeven_not_Zodd. apply Zeven_2p.
- apply Zodd_bool_iff. apply Zodd_2p_plus_1.
- Qed.
-
- (** * Conversion *)
-
- Definition pheight p :=
-   Peano.pred (Pos.to_nat (get_height (ZnZ.digits (dom_op 0)) (plength p))).
-
- Theorem pheight_correct: forall p,
-    Zpos p < 2 ^ (Zpos (ZnZ.digits (dom_op 0)) * 2 ^ (Z.of_nat (pheight p))).
- Proof.
- intros p; unfold pheight.
- rewrite Nat2Z.inj_pred by apply Pos2Nat.is_pos.
- rewrite positive_nat_Z.
- rewrite <- Z.sub_1_r.
- assert (F2:= (get_height_correct (ZnZ.digits (dom_op 0)) (plength p))).
- apply Z.lt_le_trans with (Zpos (Pos.succ p)).
-   rewrite Pos2Z.inj_succ; auto with zarith.
-  apply Z.le_trans with (1 := plength_pred_correct (Pos.succ p)).
- rewrite Pos.pred_succ.
- apply Z.pow_le_mono_r; auto with zarith.
- Qed.
-
- Definition of_pos (x:positive) : t  :=
-  let n := pheight x in
-  reduce n (snd (ZnZ.of_pos x)).
-
- Theorem spec_of_pos: forall x,
-   [of_pos x] = Zpos x.
- Proof.
- intros x; unfold of_pos.
- rewrite spec_reduce.
- simpl.
- apply ZnZ.of_pos_correct.
- unfold base.
- apply Z.lt_le_trans with (1 := pheight_correct x).
- apply Z.pow_le_mono_r; auto with zarith.
- rewrite (digits_dom_op (_ _)), Pshiftl_nat_Zpower. auto with zarith.
- Qed.
-
- Definition of_N (x:N) : t :=
-  match x with
-  | BinNat.N0 => zero
-  | Npos p => of_pos p
-  end.
-
- Theorem spec_of_N: forall x,
-   [of_N x] = Z.of_N x.
- Proof.
- intros x; case x.
-  simpl of_N. exact spec_0.
- intros p; exact (spec_of_pos p).
- Qed.
-
- (** * [head0] and [tail0]
-
-     Number of zero at the beginning and at the end of
-     the representation of the number.
-     NB: these functions are not morphism for setoid [eq].
- *)
-
- Local Notation head0n := (fun n =>
-   let head0 := ZnZ.head0 in
-   fun x => reduce n (head0 x)).
-
- Definition head0 : t -> t := Eval red_t in iter_t head0n.
-
- Lemma head0_fold : head0 = iter_t head0n.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_head00: forall x, [x] = 0 -> [head0 x] = Zpos (digits x).
- Proof.
- intros x. rewrite head0_fold, digits_fold. destr_t x as (n,x).
- exact (ZnZ.spec_head00 x).
- Qed.
-
- Lemma pow2_pos_minus_1 : forall z, 0<z -> 2^(z-1) = 2^z / 2.
- Proof.
-  intros. apply Zdiv_unique with 0; auto with zarith.
-  change 2 with (2^1) at 2.
-  rewrite <- Zpower_exp; auto with zarith.
-  rewrite Z.add_0_r. f_equal. auto with zarith.
- Qed.
-
- Theorem spec_head0: forall x, 0 < [x] ->
-   2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x).
- Proof.
- intros x. rewrite pow2_pos_minus_1 by (red; auto).
- rewrite head0_fold, digits_fold. destr_t x as (n,x). exact (ZnZ.spec_head0 x).
- Qed.
-
- Local Notation tail0n := (fun n =>
-  let tail0 := ZnZ.tail0 in
-  fun x => reduce n (tail0 x)).
-
- Definition tail0 : t -> t := Eval red_t in iter_t tail0n.
-
- Lemma tail0_fold : tail0 = iter_t tail0n.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_tail00: forall x, [x] = 0 -> [tail0 x] = Zpos (digits x).
- Proof.
- intros x. rewrite tail0_fold, digits_fold. destr_t x as (n,x).
- exact (ZnZ.spec_tail00 x).
- Qed.
-
- Theorem spec_tail0: forall x,
-   0 < [x] -> exists y, 0 <= y /\ [x] = (2 * y + 1) * 2 ^ [tail0 x].
- Proof.
- intros x. rewrite tail0_fold. destr_t x as (n,x). exact (ZnZ.spec_tail0 x).
- Qed.
-
- (** * [Ndigits]
-
-     Same as [digits] but encoded using large integers
-     NB: this function is not a morphism for setoid [eq].
- *)
-
- Local Notation Ndigitsn := (fun n =>
-  let d := reduce n (ZnZ.zdigits (dom_op n)) in
-  fun _ => d).
-
- Definition Ndigits : t -> t := Eval red_t in iter_t Ndigitsn.
-
- Lemma Ndigits_fold : Ndigits = iter_t Ndigitsn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x).
- Proof.
- intros x. rewrite Ndigits_fold, digits_fold. destr_t x as (n,x).
- apply ZnZ.spec_zdigits.
- Qed.
-
- (** * Binary logarithm *)
-
- Local Notation log2n := (fun n =>
-  let op := dom_op n in
-  let zdigits := ZnZ.zdigits op in
-  let head0 := ZnZ.head0 in
-  let sub_carry := ZnZ.sub_carry in
-  fun x => reduce n (sub_carry zdigits (head0 x))).
-
- Definition log2 : t -> t := Eval red_t in
-   let log2 := iter_t log2n in
-   fun x => if eqb x zero then zero else log2 x.
-
- Lemma log2_fold :
-   log2 = fun x => if eqb x zero then zero else iter_t log2n x.
- Proof. red_t; reflexivity. Qed.
-
- Lemma spec_log2_0 : forall x, [x] = 0 -> [log2 x] = 0.
- Proof.
- intros x H. rewrite log2_fold.
- rewrite spec_eqb, H. rewrite spec_0. simpl. exact spec_0.
- Qed.
-
- Lemma head0_zdigits : forall n (x : dom_t n),
-  0 < ZnZ.to_Z x ->
-  ZnZ.to_Z (ZnZ.head0 x) < ZnZ.to_Z (ZnZ.zdigits (dom_op n)).
- Proof.
- intros n x H.
- destruct (ZnZ.spec_head0 x H) as (_,H0).
- intros.
- assert (H1 := ZnZ.spec_to_Z (ZnZ.head0 x)).
- assert (H2 := ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))).
- unfold base in *.
- rewrite ZnZ.spec_zdigits in H2 |- *.
- set (h := ZnZ.to_Z (ZnZ.head0 x)) in *; clearbody h.
- set (d := ZnZ.digits (dom_op n)) in *; clearbody d.
- destruct (Z_lt_le_dec h (Zpos d)); auto. exfalso.
- assert (1 * 2^Zpos d <= ZnZ.to_Z x * 2^h).
-  apply Z.mul_le_mono_nonneg; auto with zarith.
-  apply Z.pow_le_mono_r; auto with zarith.
- rewrite Z.mul_comm in H0. auto with zarith.
- Qed.
-
- Lemma spec_log2_pos : forall x, [x]<>0 ->
-   2^[log2 x] <= [x] < 2^([log2 x]+1).
- Proof.
- intros x H. rewrite log2_fold.
- rewrite spec_eqb. rewrite spec_0.
- case Z.eqb_spec.
- auto with zarith.
- clear H.
- destr_t x as (n,x). intros H.
- rewrite ZnZ.spec_sub_carry.
- assert (H0 := ZnZ.spec_to_Z x).
- assert (H1 := ZnZ.spec_to_Z (ZnZ.head0 x)).
- assert (H2 := ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))).
- assert (H3 := head0_zdigits n x).
- rewrite Zmod_small by auto with zarith.
- rewrite Z.sub_simpl_r.
- rewrite (Z.mul_lt_mono_pos_l (2^(ZnZ.to_Z (ZnZ.head0 x))));
-  auto with zarith.
- rewrite (Z.mul_le_mono_pos_l _ _ (2^(ZnZ.to_Z (ZnZ.head0 x))));
-  auto with zarith.
- rewrite <- 2 Zpower_exp; auto with zarith.
- rewrite !Z.add_sub_assoc, !Z.add_simpl_l.
- rewrite ZnZ.spec_zdigits.
- rewrite pow2_pos_minus_1 by (red; auto).
- apply ZnZ.spec_head0; auto with zarith.
- Qed.
-
- Lemma spec_log2 : forall x, [log2 x] = Z.log2 [x].
- Proof.
-  intros. destruct (Z_lt_ge_dec 0 [x]).
-  symmetry. apply Z.log2_unique. apply spec_pos.
-  apply spec_log2_pos. intro EQ; rewrite EQ in *; auto with zarith.
-  rewrite spec_log2_0. rewrite Z.log2_nonpos; auto with zarith.
-  generalize (spec_pos x); auto with zarith.
- Qed.
-
- Lemma log2_digits_head0 : forall x, 0 < [x] ->
-   [log2 x] = Zpos (digits x) - [head0 x] - 1.
- Proof.
- intros. rewrite log2_fold.
- rewrite spec_eqb. rewrite spec_0.
- case Z.eqb_spec.
- auto with zarith.
- intros _. revert H. rewrite digits_fold, head0_fold. destr_t x as (n,x).
- rewrite ZnZ.spec_sub_carry.
- intros.
- generalize (head0_zdigits n x H).
- generalize (ZnZ.spec_to_Z (ZnZ.head0 x)).
- generalize (ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))).
- rewrite ZnZ.spec_zdigits. intros. apply Zmod_small.
- auto with zarith.
- Qed.
-
- (** * Right shift *)
-
- Local Notation shiftrn := (fun n =>
-   let op := dom_op n in
-   let zdigits := ZnZ.zdigits op in
-   let sub_c := ZnZ.sub_c in
-   let add_mul_div := ZnZ.add_mul_div in
-   let zzero := ZnZ.zero in
-   fun x p => match sub_c zdigits p with
-   | C0 d => reduce n (add_mul_div d zzero x)
-   | C1 _ => zero
-   end).
-
- Definition shiftr : t -> t -> t := Eval red_t in
-   same_level shiftrn.
-
- Lemma shiftr_fold : shiftr = same_level shiftrn.
- Proof. red_t; reflexivity. Qed.
-
- Lemma div_pow2_bound :forall x y z,
-   0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z.
- Proof.
-   intros x y z HH HH1 HH2.
-   split; auto with zarith.
-   apply Z.le_lt_trans with (2 := HH2); auto with zarith.
-   apply Zdiv_le_upper_bound; auto with zarith.
-   pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith.
-   apply Z.mul_le_mono_nonneg_l; auto.
-   apply Z.pow_le_mono_r; auto with zarith.
-   rewrite Z.pow_0_r; ring.
- Qed.
-
- Theorem spec_shiftr_pow2 : forall x n,
-  [shiftr x n] = [x] / 2 ^ [n].
- Proof.
-  intros x y. rewrite shiftr_fold. apply spec_same_level. clear x y.
-  intros n x p. simpl.
-  assert (Hx := ZnZ.spec_to_Z x).
-  assert (Hy := ZnZ.spec_to_Z p).
-  generalize (ZnZ.spec_sub_c (ZnZ.zdigits (dom_op n)) p).
-  case ZnZ.sub_c; intros d H; unfold interp_carry in *; simpl.
-  (** Subtraction without underflow : [ p <= digits ] *)
-  rewrite spec_reduce.
-  rewrite ZnZ.spec_zdigits in H.
-  rewrite ZnZ.spec_add_mul_div by auto with zarith.
-  rewrite ZnZ.spec_0, Z.mul_0_l, Z.add_0_l.
-  rewrite Zmod_small.
-  f_equal. f_equal. auto with zarith.
-  split. auto with zarith.
-  apply div_pow2_bound; auto with zarith.
-  (** Subtraction with underflow : [ digits < p ] *)
-  rewrite ZnZ.spec_0. symmetry.
-  apply Zdiv_small.
-  split; auto with zarith.
-  apply Z.lt_le_trans with (base (ZnZ.digits (dom_op n))); auto with zarith.
-  unfold base. apply Z.pow_le_mono_r; auto with zarith.
-  rewrite ZnZ.spec_zdigits in H.
-  generalize (ZnZ.spec_to_Z d); auto with zarith.
- Qed.
-
- Lemma spec_shiftr: forall x p, [shiftr x p] = Z.shiftr [x] [p].
- Proof.
-  intros.
-  now rewrite spec_shiftr_pow2, Z.shiftr_div_pow2 by apply spec_pos.
- Qed.
-
- (** * Left shift *)
-
- (** First an unsafe version, working correctly only if
-     the representation is large enough *)
-
- Local Notation unsafe_shiftln := (fun n =>
-   let op := dom_op n in
-   let add_mul_div := ZnZ.add_mul_div in
-   let zero := ZnZ.zero in
-   fun x p => reduce n (add_mul_div p x zero)).
-
- Definition unsafe_shiftl : t -> t -> t := Eval red_t in
-   same_level unsafe_shiftln.
-
- Lemma unsafe_shiftl_fold : unsafe_shiftl = same_level unsafe_shiftln.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_unsafe_shiftl_aux : forall x p K,
-  0 <= K ->
-  [x] < 2^K ->
-  [p] + K <= Zpos (digits x) ->
-  [unsafe_shiftl x p] = [x] * 2 ^ [p].
- Proof.
- intros x p.
- rewrite unsafe_shiftl_fold. rewrite digits_level.
- apply spec_same_level_dep.
- intros n m z z' r LE H K HK H1 H2. apply (H K); auto.
-  transitivity (Zpos (ZnZ.digits (dom_op n))); auto.
-  apply digits_dom_op_incr; auto.
- clear x p.
- intros n x p K HK Hx Hp. simpl. rewrite spec_reduce.
- destruct (ZnZ.spec_to_Z x).
- destruct (ZnZ.spec_to_Z p).
- rewrite ZnZ.spec_add_mul_div by (omega with *).
- rewrite ZnZ.spec_0, Zdiv_0_l, Z.add_0_r.
- apply Zmod_small. unfold base.
- split; auto with zarith.
- rewrite Z.mul_comm.
- apply Z.lt_le_trans with (2^(ZnZ.to_Z p + K)).
- rewrite Zpower_exp; auto with zarith.
- apply Z.mul_lt_mono_pos_l; auto with zarith.
- apply Z.pow_le_mono_r; auto with zarith.
- Qed.
-
- Theorem spec_unsafe_shiftl: forall x p,
-  [p] <= [head0 x] -> [unsafe_shiftl x p] = [x] * 2 ^ [p].
- Proof.
- intros.
- destruct (Z.eq_dec [x] 0) as [EQ|NEQ].
- (* [x] = 0 *)
- apply spec_unsafe_shiftl_aux with 0; auto with zarith.
- now rewrite EQ.
- rewrite spec_head00 in *; auto with zarith.
- (* [x] <> 0 *)
- apply spec_unsafe_shiftl_aux with ([log2 x] + 1); auto with zarith.
- generalize (spec_pos (log2 x)); auto with zarith.
- destruct (spec_log2_pos x); auto with zarith.
- rewrite log2_digits_head0; auto with zarith.
- generalize (spec_pos x); auto with zarith.
- Qed.
-
- (** Then we define a function doubling the size of the representation
-     but without changing the value of the number. *)
-
- Local Notation double_size_n := (fun n =>
-  let zero := ZnZ.zero in
-  fun x => mk_t_S n (WW zero x)).
-
- Definition double_size : t -> t := Eval red_t in
-   iter_t double_size_n.
-
- Lemma double_size_fold : double_size = iter_t double_size_n.
- Proof. red_t; reflexivity. Qed.
-
- Lemma double_size_level : forall x, level (double_size x) = S (level x).
- Proof.
- intros x. rewrite double_size_fold; unfold level at 2. destr_t x as (n,x).
- apply mk_t_S_level.
- Qed.
-
- Theorem spec_double_size_digits:
-   forall x, Zpos (digits (double_size x)) = 2 * (Zpos (digits x)).
- Proof.
- intros x. rewrite ! digits_level, double_size_level.
- rewrite 2 digits_dom_op, 2 Pshiftl_nat_Zpower,
-         Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith.
- ring.
- Qed.
-
- Theorem spec_double_size: forall x, [double_size x] = [x].
- Proof.
- intros x. rewrite double_size_fold. destr_t x as (n,x).
- rewrite spec_mk_t_S. simpl. rewrite ZnZ.spec_0. auto with zarith.
- Qed.
-
- Theorem spec_double_size_head0:
-   forall x, 2 * [head0 x] <= [head0 (double_size x)].
- Proof.
- intros x.
- assert (F1:= spec_pos (head0 x)).
- assert (F2: 0 < Zpos (digits x)).
-   red; auto.
- assert (HH := spec_pos x). Z.le_elim HH.
- generalize HH; rewrite <- (spec_double_size x); intros HH1.
- case (spec_head0 x HH); intros _ HH2.
- case (spec_head0 _ HH1).
- rewrite (spec_double_size x); rewrite (spec_double_size_digits x).
- intros HH3 _.
- case (Z.le_gt_cases ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4.
- absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto.
- apply Z.le_ngt.
- apply Z.mul_le_mono_nonneg_r; auto with zarith.
- apply Z.pow_le_mono_r; auto; auto with zarith.
- assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1)).
- { apply Z.le_succ_l in HH. change (1 <= [x]) in HH.
-   Z.le_elim HH.
-   - apply Z.mul_le_mono_pos_r with (2 ^ 1); auto with zarith.
-     rewrite <- (fun x y z => Z.pow_add_r x (y - z)); auto with zarith.
-     rewrite Z.sub_add.
-     apply Z.le_trans with (2 := Z.lt_le_incl _ _ HH2).
-     apply Z.mul_le_mono_nonneg_l; auto with zarith.
-     rewrite Z.pow_1_r; auto with zarith.
-   - apply Z.pow_le_mono_r; auto with zarith.
-     case (Z.le_gt_cases (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6.
-     absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith.
-     rewrite <- HH; rewrite Z.mul_1_r.
-     apply Z.pow_le_mono_r; auto with zarith. }
- rewrite (Z.mul_comm 2).
- rewrite Z.pow_mul_r; auto with zarith.
- rewrite Z.pow_2_r.
- apply Z.lt_le_trans with (2 := HH3).
- rewrite <- Z.mul_assoc.
- replace (2 * Zpos (digits x) - 1) with
-   ((Zpos (digits x) - 1) + (Zpos (digits x))).
- rewrite Zpower_exp; auto with zarith.
- apply Zmult_lt_compat2; auto with zarith.
- split; auto with zarith.
- apply Z.mul_pos_pos; auto with zarith.
- rewrite Pos2Z.inj_xO; ring.
- apply Z.lt_le_incl; auto.
- repeat rewrite spec_head00; auto.
- rewrite spec_double_size_digits.
- rewrite Pos2Z.inj_xO; auto with zarith.
- rewrite spec_double_size; auto.
- Qed.
-
- Theorem spec_double_size_head0_pos:
-   forall x, 0 < [head0 (double_size x)].
- Proof.
- intros x.
- assert (F := Pos2Z.is_pos (digits x)).
- assert (F0 := spec_pos (head0 (double_size x))).
- Z.le_elim F0; auto.
- assert (F1 := spec_pos (head0 x)).
- Z.le_elim F1.
-  apply Z.lt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith.
- assert (F3 := spec_pos x).
- Z.le_elim F3.
- generalize F3; rewrite <- (spec_double_size x); intros F4.
- absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x))).
- { apply Z.le_ngt.
-   apply Z.pow_le_mono_r; auto with zarith.
-   rewrite Pos2Z.inj_xO; auto with zarith. }
- case (spec_head0 x F3).
- rewrite <- F1; rewrite Z.pow_0_r; rewrite Z.mul_1_l; intros _ HH.
- apply Z.le_lt_trans with (2 := HH).
- case (spec_head0 _ F4).
- rewrite (spec_double_size x); rewrite (spec_double_size_digits x).
- rewrite <- F0; rewrite Z.pow_0_r; rewrite Z.mul_1_l; auto.
- generalize F1; rewrite (spec_head00 _ (eq_sym F3)); auto with zarith.
- Qed.
-
- (** Finally we iterate [double_size] enough before [unsafe_shiftl]
-     in order to get a fully correct [shiftl]. *)
-
- Definition shiftl_aux_body cont x n :=
-   match compare n (head0 x) with
-      Gt => cont (double_size x) n
-   |  _ => unsafe_shiftl x n
-   end.
-
- Theorem spec_shiftl_aux_body: forall n x p cont,
-       2^ Zpos p  <=  [head0 x]  ->
-      (forall x, 2 ^ (Zpos p + 1) <= [head0 x]->
-         [cont x n] = [x] * 2 ^ [n]) ->
-      [shiftl_aux_body cont x n] = [x] * 2 ^ [n].
- Proof.
- intros n x p cont H1 H2; unfold shiftl_aux_body.
- rewrite spec_compare; case Z.compare_spec; intros H.
-  apply spec_unsafe_shiftl; auto with zarith.
-  apply spec_unsafe_shiftl; auto with zarith.
- rewrite H2.
- rewrite spec_double_size; auto.
- rewrite Z.add_comm; rewrite Zpower_exp; auto with zarith.
- apply Z.le_trans with (2 := spec_double_size_head0 x).
- rewrite Z.pow_1_r; apply Z.mul_le_mono_nonneg_l; auto with zarith.
- Qed.
-
- Fixpoint shiftl_aux p cont x n :=
-   shiftl_aux_body
-       (fun x n => match p with
-        | xH => cont x n
-        | xO p => shiftl_aux p (shiftl_aux p cont) x n
-        | xI p => shiftl_aux p (shiftl_aux p cont) x n
-        end) x n.
-
- Theorem spec_shiftl_aux: forall p q x n cont,
-    2 ^ (Zpos q) <= [head0 x] ->
-      (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] ->
-         [cont x n] = [x] * 2 ^ [n]) ->
-      [shiftl_aux p cont x n] = [x] * 2 ^ [n].
- Proof.
- intros p; elim p; unfold shiftl_aux; fold shiftl_aux; clear p.
- intros p Hrec q x n cont H1 H2.
- apply spec_shiftl_aux_body with (q); auto.
- intros x1 H3; apply Hrec with (q + 1)%positive; auto.
- intros x2 H4; apply Hrec with (p + q + 1)%positive; auto.
- rewrite <- Pos.add_assoc.
- rewrite Pos2Z.inj_add; auto.
- intros x3 H5; apply H2.
- rewrite Pos2Z.inj_xI.
- replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1));
-   auto.
- rewrite !Pos2Z.inj_add; ring.
- intros p Hrec q n x cont H1 H2.
- apply spec_shiftl_aux_body with (q); auto.
- intros x1 H3; apply Hrec with (q); auto.
- apply Z.le_trans with (2 := H3); auto with zarith.
- apply Z.pow_le_mono_r; auto with zarith.
- intros x2 H4; apply Hrec with (p + q)%positive; auto.
- intros x3 H5; apply H2.
- rewrite (Pos2Z.inj_xO p).
- replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q));
-   auto.
- rewrite Pos2Z.inj_add; ring.
- intros q n x cont H1 H2.
- apply spec_shiftl_aux_body with (q); auto.
- rewrite Z.add_comm; auto.
- Qed.
-
- Definition shiftl x n :=
-  shiftl_aux_body
-   (shiftl_aux_body
-    (shiftl_aux (digits n) unsafe_shiftl)) x n.
-
- Theorem spec_shiftl_pow2 : forall x n,
-   [shiftl x n] = [x] * 2 ^ [n].
- Proof.
- intros x n; unfold shiftl, shiftl_aux_body.
- rewrite spec_compare; case Z.compare_spec; intros H.
-  apply spec_unsafe_shiftl; auto with zarith.
-  apply spec_unsafe_shiftl; auto with zarith.
- rewrite <- (spec_double_size x).
- rewrite spec_compare; case Z.compare_spec; intros H1.
-  apply spec_unsafe_shiftl; auto with zarith.
-  apply spec_unsafe_shiftl; auto with zarith.
- rewrite <- (spec_double_size (double_size x)).
- apply spec_shiftl_aux with 1%positive.
- apply Z.le_trans with (2 := spec_double_size_head0 (double_size x)).
- replace (2 ^ 1) with (2 * 1).
- apply Z.mul_le_mono_nonneg_l; auto with zarith.
- generalize (spec_double_size_head0_pos x); auto with zarith.
- rewrite Z.pow_1_r; ring.
- intros x1 H2; apply spec_unsafe_shiftl.
- apply Z.le_trans with (2 := H2).
- apply Z.le_trans with (2 ^ Zpos (digits n)); auto with zarith.
- case (spec_digits n); auto with zarith.
- apply Z.pow_le_mono_r; auto with zarith.
- Qed.
-
- Lemma spec_shiftl: forall x p, [shiftl x p] = Z.shiftl [x] [p].
- Proof.
-  intros.
-  now rewrite spec_shiftl_pow2, Z.shiftl_mul_pow2 by apply spec_pos.
- Qed.
-
- (** Other bitwise operations *)
-
- Definition testbit x n := odd (shiftr x n).
-
- Lemma spec_testbit: forall x p, testbit x p = Z.testbit [x] [p].
- Proof.
-  intros. unfold testbit. symmetry.
-  rewrite spec_odd, spec_shiftr. apply Z.testbit_odd.
- Qed.
-
- Definition div2 x := shiftr x one.
-
- Lemma spec_div2: forall x, [div2 x] = Z.div2 [x].
- Proof.
-  intros. unfold div2. symmetry.
-  rewrite spec_shiftr, spec_1. apply Z.div2_spec.
- Qed.
-
- Local Notation lorn := (fun n =>
-  let op := dom_op n in
-  let lor := ZnZ.lor in
-  fun x y => reduce n (lor x y)).
-
- Definition lor : t -> t -> t := Eval red_t in same_level lorn.
-
- Lemma lor_fold : lor = same_level lorn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_lor x y : [lor x y] = Z.lor [x] [y].
- Proof.
-  rewrite lor_fold. apply spec_same_level; clear x y.
-  intros n x y. simpl. rewrite spec_reduce. apply ZnZ.spec_lor.
- Qed.
-
- Local Notation landn := (fun n =>
-  let op := dom_op n in
-  let land := ZnZ.land in
-  fun x y => reduce n (land x y)).
-
- Definition land : t -> t -> t := Eval red_t in same_level landn.
-
- Lemma land_fold : land = same_level landn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_land x y : [land x y] = Z.land [x] [y].
- Proof.
-  rewrite land_fold. apply spec_same_level; clear x y.
-  intros n x y. simpl. rewrite spec_reduce. apply ZnZ.spec_land.
- Qed.
-
- Local Notation lxorn := (fun n =>
-  let op := dom_op n in
-  let lxor := ZnZ.lxor in
-  fun x y => reduce n (lxor x y)).
-
- Definition lxor : t -> t -> t := Eval red_t in same_level lxorn.
-
- Lemma lxor_fold : lxor = same_level lxorn.
- Proof. red_t; reflexivity. Qed.
-
- Theorem spec_lxor x y : [lxor x y] = Z.lxor [x] [y].
- Proof.
-  rewrite lxor_fold. apply spec_same_level; clear x y.
-  intros n x y. simpl. rewrite spec_reduce. apply ZnZ.spec_lxor.
- Qed.
-
- Local Notation ldiffn := (fun n =>
-  let op := dom_op n in
-  let lxor := ZnZ.lxor in
-  let land := ZnZ.land in
-  let m1 := ZnZ.minus_one in
-  fun x y => reduce n (land x (lxor y m1))).
-
- Definition ldiff : t -> t -> t := Eval red_t in same_level ldiffn.
-
- Lemma ldiff_fold : ldiff = same_level ldiffn.
- Proof. red_t; reflexivity. Qed.
-
- Lemma ldiff_alt x y p :
-  0 <= x < 2^p -> 0 <= y < 2^p ->
-  Z.ldiff x y = Z.land x (Z.lxor y (2^p - 1)).
- Proof.
-  intros (Hx,Hx') (Hy,Hy').
-  destruct p as [|p|p].
-  - simpl in *; replace x with 0; replace y with 0; auto with zarith.
-  - rewrite <- Z.shiftl_1_l. change (_ - 1) with (Z.ones (Z.pos p)).
-    rewrite <- Z.ldiff_ones_l_low; trivial.
-    rewrite !Z.ldiff_land, Z.land_assoc. f_equal.
-    rewrite Z.land_ones; try easy.
-    symmetry. apply Z.mod_small; now split.
-    Z.le_elim Hy.
-    + now apply Z.log2_lt_pow2.
-    + now subst.
-  - simpl in *; omega.
- Qed.
-
- Theorem spec_ldiff x y : [ldiff x y] = Z.ldiff [x] [y].
- Proof.
-  rewrite ldiff_fold. apply spec_same_level; clear x y.
-  intros n x y. simpl. rewrite spec_reduce.
-  rewrite ZnZ.spec_land, ZnZ.spec_lxor, ZnZ.spec_m1.
-  symmetry. apply ldiff_alt; apply ZnZ.spec_to_Z.
- Qed.
-
-End Make.
diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml
deleted file mode 100644
index 5177fae6..00000000
--- a/theories/Numbers/Natural/BigN/NMake_gen.ml
+++ /dev/null
@@ -1,1017 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-(*S NMake_gen.ml : this file generates NMake_gen.v *)
-
-
-(*s The parameter that control the generation: *)
-
-let size = 6 (* how many times should we repeat the Z/nZ --> Z/2nZ
-                process before relying on a generic construct *)
-
-(*s Some utilities *)
-
-let rec iter_str n s = if n = 0 then "" else (iter_str (n-1) s) ^ s
-
-let rec iter_str_gen n f = if n < 0 then "" else (iter_str_gen (n-1) f) ^ (f n)
-
-let rec iter_name i j base sep =
-  if i >= j then base^(string_of_int i)
-  else (iter_name i (j-1) base sep)^sep^" "^base^(string_of_int j)
-
-let pr s = Printf.printf (s^^"\n")
-
-(*s The actual printing *)
-
-let _ =
-
-pr
-"(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
-(*   \\VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-(** * NMake_gen *)
-
-(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*)
-
-(** Remark: File automatically generated by NMake_gen.ml, DO NOT EDIT ! *)
-
-Require Import BigNumPrelude ZArith Ndigits CyclicAxioms
- DoubleType DoubleMul DoubleDivn1 DoubleCyclic Nbasic
- Wf_nat StreamMemo.
-
-Module Make (W0:CyclicType) <: NAbstract.
-
- (** * The word types *)
-";
-
-pr " Local Notation w0 := W0.t.";
-for i = 1 to size do
-  pr " Definition w%i := zn2z w%i." i (i-1)
-done;
-pr "";
-
-pr " (** * The operation type classes for the word types *)
-";
-
-pr " Local Notation w0_op := W0.ops.";
-for i = 1 to min 3 size do
-  pr " Instance w%i_op : ZnZ.Ops w%i := mk_zn2z_ops w%i_op." i i (i-1)
-done;
-for i = 4 to size do
-  pr " Instance w%i_op : ZnZ.Ops w%i := mk_zn2z_ops_karatsuba w%i_op." i i (i-1)
-done;
-for i = size+1 to size+3 do
-  pr " Instance w%i_op : ZnZ.Ops (word w%i %i) := mk_zn2z_ops_karatsuba w%i_op." i size (i-size) (i-1)
-done;
-pr "";
-
-  pr " Section Make_op.";
-  pr "  Variable mk : forall w', ZnZ.Ops w' -> ZnZ.Ops (zn2z w').";
-  pr "";
-  pr "  Fixpoint make_op_aux (n:nat) : ZnZ.Ops (word w%i (S n)):=" size;
-  pr "   match n return ZnZ.Ops (word w%i (S n)) with" size;
-  pr "   | O => w%i_op" (size+1);
-  pr "   | S n1 =>";
-  pr "     match n1 return ZnZ.Ops (word w%i (S (S n1))) with" size;
-  pr "     | O => w%i_op" (size+2);
-  pr "     | S n2 =>";
-  pr "       match n2 return ZnZ.Ops (word w%i (S (S (S n2)))) with" size;
-  pr "       | O => w%i_op" (size+3);
-  pr "       | S n3 => mk _ (mk _ (mk _ (make_op_aux n3)))";
-  pr "       end";
-  pr "     end";
-  pr "   end.";
-  pr "";
-  pr " End Make_op.";
-  pr "";
-  pr " Definition omake_op := make_op_aux mk_zn2z_ops_karatsuba.";
-  pr "";
-  pr "";
-  pr " Definition make_op_list := dmemo_list _ omake_op.";
-  pr "";
-  pr " Instance make_op n : ZnZ.Ops (word w%i (S n))" size;
-  pr "  := dmemo_get _ omake_op n make_op_list.";
-  pr "";
-
-pr " Ltac unfold_ops := unfold omake_op, make_op_aux, w%i_op, w%i_op." (size+3) (size+2);
-
-pr
-"
- Lemma make_op_omake: forall n, make_op n = omake_op n.
- Proof.
- intros n; unfold make_op, make_op_list.
- refine (dmemo_get_correct _ _ _).
- Qed.
-
- Theorem make_op_S: forall n,
-   make_op (S n) = mk_zn2z_ops_karatsuba (make_op n).
- Proof.
- intros n. do 2 rewrite make_op_omake.
- revert n. fix IHn 1.
- do 3 (destruct n; [unfold_ops; reflexivity|]).
- simpl mk_zn2z_ops_karatsuba. simpl word in *.
- rewrite <- (IHn n). auto.
- Qed.
-
- (** * The main type [t], isomorphic with [exists n, word w0 n] *)
-";
-
-  pr " Inductive t' :=";
-  for i = 0 to size do
-    pr "  | N%i : w%i -> t'" i i
-  done;
-  pr "  | Nn : forall n, word w%i (S n) -> t'." size;
-  pr "";
-  pr " Definition t := t'.";
-  pr "";
-
-  pr " (** * A generic toolbox for building and deconstructing [t] *)";
-  pr "";
-
-  pr " Local Notation SizePlus n := %sn%s."
-    (iter_str size "(S ") (iter_str size ")");
-  pr " Local Notation Size := (SizePlus O).";
-  pr "";
-
-  pr " Tactic Notation (at level 3) \"do_size\" tactic3(t) := do %i t." (size+1);
-  pr "";
-
-  pr " Definition dom_t n := match n with";
-  for i = 0 to size do
-    pr "  | %i => w%i" i i;
-  done;
-  pr "  | %sn => word w%i n" (if size=0 then "" else "SizePlus ") size;
-  pr " end.";
-  pr "";
-
-pr
-" Instance dom_op n : ZnZ.Ops (dom_t n) | 10.
- Proof.
-  do_size (destruct n; [simpl;auto with *|]).
-  unfold dom_t. auto with *.
- Defined.
-";
-
-  pr " Definition iter_t {A:Type}(f : forall n, dom_t n -> A) : t -> A :=";
-  for i = 0 to size do
-   pr "  let f%i := f %i in" i i;
-  done;
-  pr "  let fn n := f (SizePlus (S n)) in";
-  pr "  fun x => match x with";
-  for i = 0 to size do
-    pr "   | N%i wx => f%i wx" i i;
-  done;
-  pr "   | Nn n wx => fn n wx";
-  pr "  end.";
-  pr "";
-
-  pr " Definition mk_t (n:nat) : dom_t n -> t :=";
-  pr "  match n as n' return dom_t n' -> t with";
-  for i = 0 to size do
-    pr "   | %i => N%i" i i;
-  done;
-  pr "   | %s(S n) => Nn n" (if size=0 then "" else "SizePlus ");
-  pr "  end.";
-  pr "";
-
-pr
-" Definition level := iter_t (fun n _ => n).
-
- Inductive View_t : t -> Prop :=
-  Mk_t : forall n (x : dom_t n), View_t (mk_t n x).
-
- Lemma destr_t : forall x, View_t x.
- Proof.
- intros x. generalize (Mk_t (level x)). destruct x; simpl; auto.
- Defined.
-
- Lemma iter_mk_t : forall A (f:forall n, dom_t n -> A),
- forall n x, iter_t f (mk_t n x) = f n x.
- Proof.
- do_size (destruct n; try reflexivity).
- Qed.
-
- (** * Projection to ZArith *)
-
- Definition to_Z : t -> Z :=
-  Eval lazy beta iota delta [iter_t dom_t dom_op] in
-  iter_t (fun _ x => ZnZ.to_Z x).
-
- Notation \"[ x ]\" := (to_Z x).
-
- Theorem spec_mk_t : forall n (x:dom_t n), [mk_t n x] = ZnZ.to_Z x.
- Proof.
- intros. change to_Z with (iter_t (fun _ x => ZnZ.to_Z x)).
- rewrite iter_mk_t; auto.
- Qed.
-
- (** * Regular make op, without memoization or karatsuba
-
-     This will normally never be used for actual computations,
-     but only for specification purpose when using
-     [word (dom_t n) m] intermediate values. *)
-
- Fixpoint nmake_op (ww:Type) (ww_op: ZnZ.Ops ww) (n: nat) :
-       ZnZ.Ops (word ww n) :=
-  match n return ZnZ.Ops (word ww n) with
-   O => ww_op
-  | S n1 => mk_zn2z_ops (nmake_op ww ww_op n1)
-  end.
-
- Definition eval n m := ZnZ.to_Z (Ops:=nmake_op _ (dom_op n) m).
-
- Theorem nmake_op_S: forall ww (w_op: ZnZ.Ops ww) x,
-   nmake_op _ w_op (S x) = mk_zn2z_ops (nmake_op _ w_op x).
- Proof.
- auto.
- Qed.
-
- Theorem digits_nmake_S :forall n ww (w_op: ZnZ.Ops ww),
-    ZnZ.digits (nmake_op _ w_op (S n)) =
-    xO (ZnZ.digits (nmake_op _ w_op n)).
- Proof.
- auto.
- Qed.
-
- Theorem digits_nmake : forall n ww (w_op: ZnZ.Ops ww),
-    ZnZ.digits (nmake_op _ w_op n) = Pos.shiftl_nat (ZnZ.digits w_op) n.
- Proof.
- induction n. auto.
- intros ww ww_op. rewrite Pshiftl_nat_S, <- IHn; auto.
- Qed.
-
- Theorem nmake_double: forall n ww (w_op: ZnZ.Ops ww),
-    ZnZ.to_Z (Ops:=nmake_op _ w_op n) =
-    @DoubleBase.double_to_Z _ (ZnZ.digits w_op) (ZnZ.to_Z (Ops:=w_op)) n.
- Proof.
- intros n; elim n; auto; clear n.
- intros n Hrec ww ww_op; simpl DoubleBase.double_to_Z; unfold zn2z_to_Z.
- rewrite <- Hrec; auto.
- unfold DoubleBase.double_wB; rewrite <- digits_nmake; auto.
- Qed.
-
- Theorem nmake_WW: forall ww ww_op n xh xl,
-  (ZnZ.to_Z (Ops:=nmake_op ww ww_op (S n)) (WW xh xl) =
-   ZnZ.to_Z (Ops:=nmake_op ww ww_op n) xh *
-    base (ZnZ.digits (nmake_op ww ww_op n)) +
-   ZnZ.to_Z (Ops:=nmake_op ww ww_op n) xl)%%Z.
- Proof.
- auto.
- Qed.
-
- (** * The specification proofs for the word operators *)
-";
-
-  if size <> 0 then
-  pr " Typeclasses Opaque %s." (iter_name 1 size "w" "");
-  pr "";
-
-  pr " Instance w0_spec: ZnZ.Specs w0_op := W0.specs.";
-  for i = 1 to min 3 size do
-    pr " Instance w%i_spec: ZnZ.Specs w%i_op := mk_zn2z_specs w%i_spec." i i (i-1)
-  done;
-  for i = 4 to size do
-    pr " Instance w%i_spec: ZnZ.Specs w%i_op := mk_zn2z_specs_karatsuba w%i_spec." i i (i-1)
-  done;
-  pr " Instance w%i_spec: ZnZ.Specs w%i_op := mk_zn2z_specs_karatsuba w%i_spec." (size+1) (size+1) size;
-
-
-pr "
- Instance wn_spec (n:nat) : ZnZ.Specs (make_op n).
- Proof.
-  induction n.
-  rewrite make_op_omake; simpl; auto with *.
-  rewrite make_op_S. exact (mk_zn2z_specs_karatsuba IHn).
- Qed.
-
- Instance dom_spec n : ZnZ.Specs (dom_op n) | 10.
- Proof.
-  do_size (destruct n; auto with *). apply wn_spec.
- Qed.
-
- Let make_op_WW : forall n x y,
-   (ZnZ.to_Z (Ops:=make_op (S n)) (WW x y) =
-    ZnZ.to_Z (Ops:=make_op n) x * base (ZnZ.digits (make_op n))
-     + ZnZ.to_Z (Ops:=make_op n) y)%%Z.
- Proof.
- intros n x y; rewrite make_op_S; auto.
- Qed.
-
- (** * Zero *)
-
- Definition zero0 : w0 := ZnZ.zero.
-
- Definition zeron n : dom_t n :=
-  match n with
-   | O => zero0
-   | SizePlus (S n) => W0
-   | _ => W0
-  end.
-
- Lemma spec_zeron : forall n, ZnZ.to_Z (zeron n) = 0%%Z.
- Proof.
-   do_size (destruct n;
-            [match goal with
-             |- @eq Z (_ (zeron ?n)) _ => 
-               apply (ZnZ.spec_0 (Specs:=dom_spec n))
-             end|]).
-  destruct n; auto. simpl. rewrite make_op_S. fold word. 
-  apply (ZnZ.spec_0 (Specs:=wn_spec (SizePlus 0))).
- Qed.
-
- (** * Digits *)
-
- Lemma digits_make_op_0 : forall n,
-  ZnZ.digits (make_op n) = Pos.shiftl_nat (ZnZ.digits (dom_op Size)) (S n).
- Proof.
- induction n.
- auto.
- replace (ZnZ.digits (make_op (S n))) with (xO (ZnZ.digits (make_op n))).
-  rewrite IHn; auto.
- rewrite make_op_S; auto.
- Qed.
-
- Lemma digits_make_op : forall n,
-  ZnZ.digits (make_op n) = Pos.shiftl_nat (ZnZ.digits w0_op) (SizePlus (S n)).
- Proof.
- intros. rewrite digits_make_op_0.
- replace (SizePlus (S n)) with (S n + Size) by (rewrite <- plus_comm; auto).
- rewrite Pshiftl_nat_plus. auto.
- Qed.
-
- Lemma digits_dom_op : forall n,
-  ZnZ.digits (dom_op n) = Pos.shiftl_nat (ZnZ.digits w0_op) n.
- Proof.
- do_size (destruct n; try reflexivity).
- exact (digits_make_op n).
- Qed.
-
- Lemma digits_dom_op_nmake : forall n m,
-  ZnZ.digits (dom_op (m+n)) = ZnZ.digits (nmake_op _ (dom_op n) m).
- Proof.
- intros. rewrite digits_nmake, 2 digits_dom_op. apply Pshiftl_nat_plus.
- Qed.
-
- (** * Conversion between [zn2z (dom_t n)] and [dom_t (S n)].
-
-     These two types are provably equal, but not convertible,
-     hence we need some work. We now avoid using generic casts
-     (i.e. rewrite via proof of equalities in types), since
-     proving things with them is a mess.
- *)
-
- Definition succ_t n : zn2z (dom_t n) -> dom_t (S n) :=
-  match n with
-   | SizePlus (S _) => fun x => x
-   | _ => fun x => x
-  end.
-
- Lemma spec_succ_t : forall n x,
-  ZnZ.to_Z (succ_t n x) =
-  zn2z_to_Z (base (ZnZ.digits (dom_op n))) ZnZ.to_Z x.
- Proof.
- do_size (destruct n ; [reflexivity|]).
- intros. simpl. rewrite make_op_S. simpl. auto.
- Qed.
-
- Definition pred_t n : dom_t (S n) -> zn2z (dom_t n) :=
-  match n with
-   | SizePlus (S _) => fun x => x
-   | _ => fun x => x
-  end.
-
- Lemma succ_pred_t : forall n x, succ_t n (pred_t n x) = x.
- Proof.
- do_size (destruct n ; [reflexivity|]). reflexivity.
- Qed.
-
- (** We can hence project from [zn2z (dom_t n)] to [t] : *)
-
- Definition mk_t_S n (x : zn2z (dom_t n)) : t :=
-  mk_t (S n) (succ_t n x).
-
- Lemma spec_mk_t_S : forall n x,
-  [mk_t_S n x] = zn2z_to_Z (base (ZnZ.digits (dom_op n))) ZnZ.to_Z x.
- Proof.
- intros. unfold mk_t_S. rewrite spec_mk_t. apply spec_succ_t.
- Qed.
-
- Lemma mk_t_S_level : forall n x, level (mk_t_S n x) = S n.
- Proof.
- intros. unfold mk_t_S, level. rewrite iter_mk_t; auto.
- Qed.
-
- (** * Conversion from [word (dom_t n) m] to [dom_t (m+n)].
-
-     Things are more complex here. We start with a naive version
-     that breaks zn2z-trees and reconstruct them. Doing this is
-     quite unfortunate, but I don't know how to fully avoid that.
-     (cast someday ?). Then we build an optimized version where
-     all basic cases (n<=6 or m<=7) are nicely handled.
- *)
-
- Definition zn2z_map {A} {B} (f:A->B) (x:zn2z A) : zn2z B :=
-  match x with
-   | W0 => W0
-   | WW h l => WW (f h) (f l)
-  end.
-
- Lemma zn2z_map_id : forall A f (x:zn2z A), (forall u, f u = u) ->
-   zn2z_map f x = x.
- Proof.
-  destruct x; auto; intros.
-  simpl; f_equal; auto.
- Qed.
-
- (** The naive version *)
-
- Fixpoint plus_t n m : word (dom_t n) m -> dom_t (m+n) :=
-  match m as m' return word (dom_t n) m' -> dom_t (m'+n) with
-   | O => fun x => x
-   | S m => fun x => succ_t _ (zn2z_map (plus_t n m) x)
-  end.
-
- Theorem spec_plus_t : forall n m (x:word (dom_t n) m),
-  ZnZ.to_Z (plus_t n m x) = eval n m x.
- Proof.
- unfold eval.
- induction m.
- simpl; auto.
- intros.
- simpl plus_t; simpl plus. rewrite spec_succ_t.
- destruct x.
- simpl; auto.
- fold word in w, w0.
- simpl. rewrite 2 IHm. f_equal. f_equal. f_equal.
- apply digits_dom_op_nmake.
- Qed.
-
- Definition mk_t_w n m (x:word (dom_t n) m) : t :=
-   mk_t (m+n) (plus_t n m x).
-
- Theorem spec_mk_t_w : forall n m (x:word (dom_t n) m),
-  [mk_t_w n m x] = eval n m x.
- Proof.
- intros. unfold mk_t_w. rewrite spec_mk_t. apply spec_plus_t.
- Qed.
-
- (** The optimized version.
-
-     NB: the last particular case for m could depend on n,
-     but it's simplier to just expand everywhere up to m=7
-     (cf [mk_t_w'] later).
- *)
-
- Definition plus_t' n : forall m, word (dom_t n) m -> dom_t (m+n) :=
-   match n return (forall m, word (dom_t n) m -> dom_t (m+n)) with
-     | SizePlus (S n') as n => plus_t n
-     | _ as n =>
-         fun m => match m return (word (dom_t n) m -> dom_t (m+n)) with
-                    | SizePlus (S (S m')) as m => plus_t n m
-                    | _ => fun x => x
-                  end
-   end.
-
- Lemma plus_t_equiv : forall n m x,
-  plus_t' n m x = plus_t n m x.
- Proof.
-  (do_size try destruct n); try reflexivity;
-   (do_size try destruct m); try destruct m; try reflexivity;
-     simpl; symmetry; repeat (intros; apply zn2z_map_id; trivial).
- Qed.
-
- Lemma spec_plus_t' : forall n m x,
-  ZnZ.to_Z (plus_t' n m x) = eval n m x.
- Proof.
- intros; rewrite plus_t_equiv. apply spec_plus_t.
- Qed.
-
- (** Particular cases [Nk x] = eval i j x with specific k,i,j
-     can be solved by the following tactic *)
-
- Ltac solve_eval :=
-  intros; rewrite <- spec_plus_t'; unfold to_Z; simpl dom_op; reflexivity.
-
- (** The last particular case that remains useful *)
-
- Lemma spec_eval_size : forall n x, [Nn n x] = eval Size (S n) x.
- Proof.
- induction n.
- solve_eval.
- destruct x as [ | xh xl ].
-  simpl. unfold eval. rewrite make_op_S. rewrite nmake_op_S. auto.
- simpl word in xh, xl |- *.
- unfold to_Z in *. rewrite make_op_WW.
- unfold eval in *. rewrite nmake_WW.
- f_equal; auto.
- f_equal; auto.
- f_equal.
- rewrite <- digits_dom_op_nmake. rewrite plus_comm; auto.
- Qed.
-
- (** An optimized [mk_t_w].
-
-     We could say mk_t_w' := mk_t _ (plus_t' n m x)
-     (TODO: WHY NOT, BTW ??).
-     Instead we directly define functions for all intersting [n],
-     reverting to naive [mk_t_w] at places that should normally
-     never be used (see [mul] and [div_gt]).
- *)
-";
-
-for i = 0 to size-1 do
-let pattern = (iter_str (size+1-i) "(S ") ^ "_" ^ (iter_str (size+1-i) ")") in
-pr
-" Definition mk_t_%iw m := Eval cbv beta zeta iota delta [ mk_t plus ] in
-  match m return word w%i (S m) -> t with
-    | %s as p => mk_t_w %i (S p)
-    | p => mk_t (%i+p)
-  end.
-" i i pattern i (i+1)
-done;
-
-pr
-" Definition mk_t_w' n : forall m, word (dom_t n) (S m) -> t :=
-  match n return (forall m, word (dom_t n) (S m) -> t) with";
-for i = 0 to size-1 do pr "    | %i => mk_t_%iw" i i done;
-pr
-"    | Size => Nn
-    | _ as n' => fun m => mk_t_w n' (S m)
-  end.
-";
-
-pr
-" Ltac solve_spec_mk_t_w' :=
-  rewrite <- spec_plus_t';
-  match goal with _ : word (dom_t ?n) ?m |- _ => apply (spec_mk_t (n+m)) end.
-
- Theorem spec_mk_t_w' :
-  forall n m x, [mk_t_w' n m x] = eval n (S m) x.
- Proof.
- intros.
- repeat (apply spec_mk_t_w || (destruct n;
-  [repeat (apply spec_mk_t_w || (destruct m; [solve_spec_mk_t_w'|]))|])).
- apply spec_eval_size.
- Qed.
-
- (** * Extend : injecting [dom_t n] into [word (dom_t n) (S m)] *)
-
- Definition extend n m (x:dom_t n) : word (dom_t n) (S m) :=
-  DoubleBase.extend_aux m (WW (zeron n) x).
-
- Lemma spec_extend : forall n m x,
-  [mk_t n x] = eval n (S m) (extend n m x).
- Proof.
- intros. unfold eval, extend.
- rewrite spec_mk_t.
- assert (H : forall (x:dom_t n),
-              (ZnZ.to_Z (zeron n) * base (ZnZ.digits (dom_op n)) + ZnZ.to_Z x =
-              ZnZ.to_Z x)%%Z).
-  clear; intros; rewrite spec_zeron; auto.
- rewrite <- (@DoubleBase.spec_extend _
-              (WW (zeron n)) (ZnZ.digits (dom_op n)) ZnZ.to_Z H m x).
- simpl. rewrite digits_nmake, <- nmake_double. auto.
- Qed.
-
- (** A particular case of extend, used in [same_level]:
-     [extend_size] is [extend Size] *)
-
- Definition extend_size := DoubleBase.extend (WW (W0:dom_t Size)).
-
- Lemma spec_extend_size : forall n x, [mk_t Size x] = [Nn n (extend_size n x)].
- Proof.
- intros. rewrite spec_eval_size. apply (spec_extend Size n).
- Qed.
-
- (** Misc results about extensions *)
-
- Let spec_extend_WW : forall n x,
-  [Nn (S n) (WW W0 x)] = [Nn n x].
- Proof.
- intros n x.
- set (N:=SizePlus (S n)).
- change ([Nn (S n) (extend N 0 x)]=[mk_t N x]).
- rewrite (spec_extend N 0).
- solve_eval.
- Qed.
-
- Let spec_extend_tr: forall m n w,
- [Nn (m + n) (extend_tr w m)] = [Nn n w].
- Proof.
- induction m; auto.
- intros n x; simpl extend_tr.
- simpl plus; rewrite spec_extend_WW; auto.
- Qed.
-
- Let spec_cast_l: forall n m x1,
- [Nn n x1] =
- [Nn (Max.max n m) (castm (diff_r n m) (extend_tr x1 (snd (diff n m))))].
- Proof.
- intros n m x1; case (diff_r n m); simpl castm.
- rewrite spec_extend_tr; auto.
- Qed.
-
- Let spec_cast_r: forall n m x1,
- [Nn m x1] =
- [Nn (Max.max n m) (castm (diff_l n m) (extend_tr x1 (fst (diff n m))))].
- Proof.
- intros n m x1; case (diff_l n m); simpl castm.
- rewrite spec_extend_tr; auto.
- Qed.
-
- Ltac unfold_lets :=
-  match goal with
-   | h : _ |- _ => unfold h; clear h; unfold_lets
-   | _ => idtac
-  end.
-
- (** * [same_level]
-
-     Generic binary operator construction, by extending the smaller
-     argument to the level of the other.
- *)
-
- Section SameLevel.
-
-  Variable res: Type.
-  Variable P : Z -> Z -> res -> Prop.
-  Variable f : forall n, dom_t n -> dom_t n -> res.
-  Variable Pf : forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y).
-";
-
-for i = 0 to size do
-pr "  Let f%i : w%i -> w%i -> res := f %i." i i i i
-done;
-pr
-"  Let fn n := f (SizePlus (S n)).
-
-  Let Pf' :
-   forall n x y u v, u = [mk_t n x] -> v = [mk_t n y] -> P u v (f n x y).
-  Proof.
-  intros. subst. rewrite 2 spec_mk_t. apply Pf.
-  Qed.
-";
-
-let ext i j s =
-  if j <= i then s else Printf.sprintf "(extend %i %i %s)" i (j-i-1) s
-in
-
-pr "  Notation same_level_folded := (fun x y => match x, y with";
-for i = 0 to size do
-  for j = 0 to size do
-    pr "  | N%i wx, N%i wy => f%i %s %s" i j (max i j) (ext i j "wx") (ext j i "wy")
-  done;
-  pr "  | N%i wx, Nn m wy => fn m (extend_size m %s) wy" i (ext i size "wx")
-done;
-for i = 0 to size do
-  pr "  | Nn n wx, N%i wy => fn n wx (extend_size n %s)" i (ext i size "wy")
-done;
-pr
-"  | Nn n wx, Nn m wy =>
-    let mn := Max.max n m in
-    let d := diff n m in
-     fn mn
-       (castm (diff_r n m) (extend_tr wx (snd d)))
-       (castm (diff_l n m) (extend_tr wy (fst d)))
-  end).
-";
-
-pr
-"  Definition same_level := Eval lazy beta iota delta
-   [ DoubleBase.extend DoubleBase.extend_aux extend zeron ]
-  in same_level_folded.
-
-  Lemma spec_same_level_0: forall x y, P [x] [y] (same_level x y).
-  Proof.
-  change same_level with same_level_folded. unfold_lets.
-  destruct x, y; apply Pf'; simpl mk_t; rewrite <- ?spec_extend_size;
-  match goal with
-   | |- context [ extend ?n ?m _ ] => apply (spec_extend n m)
-   | |- context [ castm _ _ ] => apply spec_cast_l || apply spec_cast_r
-   | _ => reflexivity
-  end.
-  Qed.
-
- End SameLevel.
-
- Arguments same_level [res] f x y.
-
- Theorem spec_same_level_dep :
-  forall res
-   (P : nat -> Z -> Z -> res -> Prop)
-   (Pantimon : forall n m z z' r, n <= m -> P m z z' r -> P n z z' r)
-   (f : forall n, dom_t n -> dom_t n -> res)
-   (Pf: forall n x y, P n (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)),
-   forall x y, P (level x) [x] [y] (same_level f x y).
- Proof.
- intros res P Pantimon f Pf.
- set (f' := fun n x y => (n, f n x y)).
- set (P' := fun z z' r => P (fst r) z z' (snd r)).
- assert (FST : forall x y, level x <= fst (same_level f' x y))
-  by (destruct x, y; simpl; omega with * ).
- assert (SND : forall x y, same_level f x y = snd (same_level f' x y))
-  by (destruct x, y; reflexivity).
- intros. eapply Pantimon; [eapply FST|].
- rewrite SND. eapply (@spec_same_level_0 _ P' f'); eauto.
- Qed.
-
- (** * [iter]
-
-     Generic binary operator construction, by splitting the larger
-     argument in blocks and applying the smaller argument to them.
- *)
-
- Section Iter.
-
-  Variable res: Type.
-  Variable P: Z -> Z -> res -> Prop.
-
-  Variable f : forall n, dom_t n -> dom_t n -> res.
-  Variable Pf : forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y).
-
-  Variable fd : forall n m, dom_t n -> word (dom_t n) (S m) -> res.
-  Variable fg : forall n m, word (dom_t n) (S m) -> dom_t n -> res.
-  Variable Pfd : forall n m x y, P (ZnZ.to_Z x) (eval n (S m) y) (fd n m x y).
-  Variable Pfg : forall n m x y, P (eval n (S m) x) (ZnZ.to_Z y) (fg n m x y).
-
-  Variable fnm: forall n m, word (dom_t Size) (S n) -> word (dom_t Size) (S m) -> res.
-  Variable Pfnm: forall n m x y, P [Nn n x] [Nn m y] (fnm n m x y).
-
-  Let Pf' :
-   forall n x y u v, u = [mk_t n x] -> v = [mk_t n y] -> P u v (f n x y).
-  Proof.
-  intros. subst. rewrite 2 spec_mk_t. apply Pf.
-  Qed.
-
-  Let Pfd' : forall n m x y u v, u = [mk_t n x] -> v = eval n (S m) y ->
-   P u v (fd n m x y).
-  Proof.
-  intros. subst. rewrite spec_mk_t. apply Pfd.
-  Qed.
-
-  Let Pfg' : forall n m x y u v, u = eval n (S m) x -> v = [mk_t n y] ->
-   P u v (fg n m x y).
-  Proof.
-  intros. subst. rewrite spec_mk_t. apply Pfg.
-  Qed.
-";
-
-for i = 0 to size do
-pr "  Let f%i := f %i." i i
-done;
-
-for i = 0 to size do
-pr "  Let f%in := fd %i." i i;
-pr "  Let fn%i := fg %i." i i;
-done;
-
-pr "  Notation iter_folded := (fun x y => match x, y with";
-for i = 0 to size do
-  for j = 0 to size do
-    pr "  | N%i wx, N%i wy => f%s wx wy" i j
-      (if i = j then string_of_int i
-       else if i < j then string_of_int i ^ "n " ^ string_of_int (j-i-1)
-       else "n" ^ string_of_int j ^ " " ^ string_of_int (i-j-1))
-  done;
-  pr "  | N%i wx, Nn m wy => f%in m %s wy" i size (ext i size "wx")
-done;
-for i = 0 to size do
-  pr "  | Nn n wx, N%i wy => fn%i n wx %s" i size (ext i size "wy")
-done;
-pr
-"  | Nn n wx, Nn m wy => fnm n m wx wy
-  end).
-";
-
-pr
-"  Definition iter := Eval lazy beta iota delta
-   [extend DoubleBase.extend DoubleBase.extend_aux zeron]
-   in iter_folded.
-
-  Lemma spec_iter: forall x y, P [x] [y] (iter x y).
-  Proof.
-  change iter with iter_folded; unfold_lets.
-  destruct x; destruct y; apply Pf' || apply Pfd' || apply Pfg' || apply Pfnm;
-  simpl mk_t;
-  match goal with
-   | |- ?x = ?x => reflexivity
-   | |- [Nn _ _] = _ => apply spec_eval_size
-   | |- context [extend ?n ?m _] => apply (spec_extend n m)
-   | _ => idtac
-  end;
-  unfold to_Z; rewrite <- spec_plus_t'; simpl dom_op; reflexivity.
-  Qed.
-
-  End Iter.
-";
-
-pr
-"  Definition switch
-  (P:nat->Type)%s
-  (fn:forall n, P n) n :=
-  match n return P n with"
-  (iter_str_gen size (fun i -> Printf.sprintf "(f%i:P %i)" i i));
-for i = 0 to size do pr "   | %i => f%i" i i done;
-pr
-"   | n => fn n
-  end.
-";
-
-pr
-"  Lemma spec_switch : forall P (f:forall n, P n) n,
-   switch P %sf n = f n.
-  Proof.
-  repeat (destruct n; try reflexivity).
-  Qed.
-" (iter_str_gen size (fun i -> Printf.sprintf "(f %i) " i));
-
-pr
-"  (** * [iter_sym]
-
-    A variant of [iter] for symmetric functions, or pseudo-symmetric
-    functions (when f y x can be deduced from f x y).
-  *)
-
-  Section IterSym.
-
-  Variable res: Type.
-  Variable P: Z -> Z -> res -> Prop.
-
-  Variable f : forall n, dom_t n -> dom_t n -> res.
-  Variable Pf : forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y).
-
-  Variable fg : forall n m, word (dom_t n) (S m) -> dom_t n -> res.
-  Variable Pfg : forall n m x y, P (eval n (S m) x) (ZnZ.to_Z y) (fg n m x y).
-
-  Variable fnm: forall n m, word (dom_t Size) (S n) -> word (dom_t Size) (S m) -> res.
-  Variable Pfnm: forall n m x y, P [Nn n x] [Nn m y] (fnm n m x y).
-
-  Variable opp: res -> res.
-  Variable Popp : forall u v r, P u v r -> P v u (opp r).
-";
-
-for i = 0 to size do
-pr "  Let f%i := f %i." i i
-done;
-
-for i = 0 to size do
-pr "  Let fn%i := fg %i." i i;
-done;
-
-pr "  Let f' := switch _ %s f." (iter_name 0 size "f" "");
-pr "  Let fg' := switch _ %s fg." (iter_name 0 size "fn" "");
-
-pr
-"  Local Notation iter_sym_folded :=
-   (iter res f' (fun n m x y => opp (fg' n m y x)) fg' fnm).
-
-  Definition iter_sym :=
-   Eval lazy beta zeta iota delta [iter f' fg' switch] in iter_sym_folded.
-
-  Lemma spec_iter_sym: forall x y, P [x] [y] (iter_sym x y).
-  Proof.
-  intros. change iter_sym with iter_sym_folded. apply spec_iter; clear x y.
-  unfold_lets.
-  intros. rewrite spec_switch. auto.
-  intros. apply Popp. unfold_lets. rewrite spec_switch; auto.
-  intros. unfold_lets. rewrite spec_switch; auto.
-  auto.
-  Qed.
-
-  End IterSym.
-
- (** * Reduction
-
-     [reduce] can be used instead of [mk_t], it will choose the
-     lowest possible level. NB: We only search and remove leftmost
-     W0's via ZnZ.eq0, any non-W0 block ends the process, even
-     if its value is 0.
- *)
-
- (** First, a direct version ... *)
-
- Fixpoint red_t n : dom_t n -> t :=
-  match n return dom_t n -> t with
-   | O => N0
-   | S n => fun x =>
-     let x' := pred_t n x in
-     reduce_n1 _ _ (N0 zero0) ZnZ.eq0 (red_t n) (mk_t_S n) x'
-  end.
-
- Lemma spec_red_t : forall n x, [red_t n x] = [mk_t n x].
- Proof.
- induction n.
- reflexivity.
- intros.
- simpl red_t. unfold reduce_n1.
- rewrite <- (succ_pred_t n x) at 2.
- remember (pred_t n x) as x'.
- rewrite spec_mk_t, spec_succ_t.
- destruct x' as [ | xh xl]. simpl. apply ZnZ.spec_0.
- generalize (ZnZ.spec_eq0 xh); case ZnZ.eq0; intros H.
- rewrite IHn, spec_mk_t. simpl. rewrite H; auto.
- apply spec_mk_t_S.
- Qed.
-
- (** ... then a specialized one *)
-";
-
-for i = 0 to size do
-pr " Definition eq0%i := @ZnZ.eq0 _ w%i_op." i i;
-done;
-
-pr "
- Definition reduce_0 := N0.";
-for i = 1 to size do
-  pr " Definition reduce_%i :=" i;
-  pr "  Eval lazy beta iota delta [reduce_n1] in";
-  pr "   reduce_n1 _ _ (N0 zero0) eq0%i reduce_%i N%i." (i-1) (i-1) i
-done;
-
-  pr " Definition reduce_%i :=" (size+1);
-  pr "  Eval lazy beta iota delta [reduce_n1] in";
-  pr "   reduce_n1 _ _ (N0 zero0) eq0%i reduce_%i (Nn 0)." size size;
-
-  pr " Definition reduce_n n :=";
-  pr "  Eval lazy beta iota delta [reduce_n] in";
-  pr "   reduce_n _ _ (N0 zero0) reduce_%i Nn n." (size + 1);
-  pr "";
-
-pr " Definition reduce n : dom_t n -> t :=";
-pr "  match n with";
-for i = 0 to size do
-pr "   | %i => reduce_%i" i i;
-done;
-pr "   | %s(S n) => reduce_n n" (if size=0 then "" else "SizePlus ");
-pr "  end.";
-pr "";
-
-pr " Ltac unfold_red := unfold reduce, %s." (iter_name 1 size "reduce_" ",");
-pr "";
-for i = 0 to size do
-pr " Declare Equivalent Keys reduce reduce_%i." i;
-done;
-pr " Declare Equivalent Keys reduce_n reduce_%i." (size + 1);
-
-pr "
- Ltac solve_red :=
- let H := fresh in let G := fresh in
- match goal with
-  | |- ?P (S ?n) => assert (H:P n) by solve_red
-  | _ => idtac
- end;
- intros n G x; destruct (le_lt_eq_dec _ _ G) as [LT|EQ];
- solve [
-  apply (H _ (lt_n_Sm_le _ _ LT)) |
-  inversion LT |
-  subst; change (reduce 0 x = red_t 0 x); reflexivity |
-  specialize (H (pred n)); subst; destruct x;
-   [|unfold_red; rewrite H; auto]; reflexivity
- ].
-
- Lemma reduce_equiv : forall n x, n <= Size -> reduce n x = red_t n x.
- Proof.
- set (P N := forall n, n <= N -> forall x, reduce n x = red_t n x).
- intros n x H. revert n H x. change (P Size). solve_red.
- Qed.
-
- Lemma spec_reduce_n : forall n x, [reduce_n n x] = [Nn n x].
- Proof.
- assert (H : forall x, reduce_%i x = red_t (SizePlus 1) x).
-  destruct x; [|unfold reduce_%i; rewrite (reduce_equiv Size)]; auto.
- induction n.
-   intros. rewrite H. apply spec_red_t.
- destruct x as [|xh xl].
- simpl. rewrite make_op_S. exact ZnZ.spec_0.
- fold word in *.
- destruct xh; auto.
- simpl reduce_n.
- rewrite IHn.
- rewrite spec_extend_WW; auto.
- Qed.
-" (size+1) (size+1);
-
-pr
-" Lemma spec_reduce : forall n x, [reduce n x] = ZnZ.to_Z x.
- Proof.
- do_size (destruct n;
-       [intros; rewrite reduce_equiv;[apply spec_red_t|auto with arith]|]).
- apply spec_reduce_n.
- Qed.
-
-End Make.
-";
diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v
deleted file mode 100644
index 18d0262c..00000000
--- a/theories/Numbers/Natural/BigN/Nbasic.v
+++ /dev/null
@@ -1,569 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Require Import ZArith Ndigits.
-Require Import BigNumPrelude.
-Require Import Max.
-Require Import DoubleType.
-Require Import DoubleBase.
-Require Import CyclicAxioms.
-Require Import DoubleCyclic.
-
-Arguments mk_zn2z_ops [t] ops.
-Arguments mk_zn2z_ops_karatsuba [t] ops.
-Arguments mk_zn2z_specs [t ops] specs.
-Arguments mk_zn2z_specs_karatsuba [t ops] specs.
-Arguments ZnZ.digits [t] Ops.
-Arguments ZnZ.zdigits [t] Ops.
-
-Lemma Pshiftl_nat_Zpower : forall n p,
-  Zpos (Pos.shiftl_nat p n) = Zpos p * 2 ^ Z.of_nat n.
-Proof.
- intros.
- rewrite Z.mul_comm.
- induction n. simpl; auto.
- transitivity (2 * (2 ^ Z.of_nat n * Zpos p)).
- rewrite <- IHn. auto.
- rewrite Z.mul_assoc.
- rewrite Nat2Z.inj_succ.
- rewrite <- Z.pow_succ_r; auto with zarith.
-Qed.
-
-(* To compute the necessary height *)
-
-Fixpoint plength (p: positive) : positive :=
-  match p with
-    xH => xH
-  | xO p1 => Pos.succ (plength p1)
-  | xI p1 => Pos.succ (plength p1)
-  end.
-
-Theorem plength_correct: forall p, (Zpos p < 2 ^ Zpos (plength p))%Z.
-assert (F: (forall p, 2 ^ (Zpos (Pos.succ p)) = 2 * 2 ^ Zpos p)%Z).
-intros p; replace (Zpos (Pos.succ p)) with (1 + Zpos p)%Z.
-rewrite Zpower_exp; auto with zarith.
-rewrite Pos2Z.inj_succ; unfold Z.succ; auto with zarith.
-intros p; elim p; simpl plength; auto.
-intros p1 Hp1; rewrite F; repeat rewrite Pos2Z.inj_xI.
-assert (tmp: (forall p, 2 * p = p + p)%Z);
-  try repeat rewrite tmp; auto with zarith.
-intros p1 Hp1; rewrite F; rewrite (Pos2Z.inj_xO p1).
-assert (tmp: (forall p, 2 * p = p + p)%Z);
-  try repeat rewrite tmp; auto with zarith.
-rewrite Z.pow_1_r; auto with zarith.
-Qed.
-
-Theorem plength_pred_correct: forall p, (Zpos p <= 2 ^ Zpos (plength (Pos.pred p)))%Z.
-intros p; case (Pos.succ_pred_or p); intros H1.
-subst; simpl plength.
-rewrite Z.pow_1_r; auto with zarith.
-pattern p at 1; rewrite <- H1.
-rewrite Pos2Z.inj_succ; unfold Z.succ; auto with zarith.
-generalize (plength_correct (Pos.pred p)); auto with zarith.
-Qed.
-
-Definition Pdiv p q :=
-  match Z.div (Zpos p) (Zpos q) with
-    Zpos q1 => match (Zpos p) - (Zpos q) * (Zpos q1) with
-                 Z0 => q1
-               | _ => (Pos.succ q1)
-               end
-  |  _ => xH
-  end.
-
-Theorem Pdiv_le: forall p q,
-  Zpos p <= Zpos q * Zpos (Pdiv p q).
-intros p q.
-unfold Pdiv.
-assert (H1: Zpos q > 0); auto with zarith.
-assert (H1b: Zpos p >= 0); auto with zarith.
-generalize (Z_div_ge0 (Zpos p) (Zpos q) H1 H1b).
-generalize (Z_div_mod_eq (Zpos p) (Zpos q) H1); case Z.div.
-  intros HH _; rewrite HH; rewrite Z.mul_0_r; rewrite Z.mul_1_r; simpl.
-case (Z_mod_lt (Zpos p) (Zpos q) H1); auto with zarith.
-intros q1 H2.
-replace (Zpos p - Zpos q * Zpos q1) with (Zpos p mod Zpos q).
-  2: pattern (Zpos p) at 2; rewrite H2; auto with zarith.
-generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2;
-  case Z.modulo.
-  intros HH _; rewrite HH; auto with zarith.
-  intros r1 HH (_,HH1); rewrite HH; rewrite Pos2Z.inj_succ.
-  unfold Z.succ; rewrite Z.mul_add_distr_l; auto with zarith.
-  intros r1 _ (HH,_); case HH; auto.
-intros q1 HH; rewrite HH.
-unfold Z.ge; simpl Z.compare; intros HH1; case HH1; auto.
-Qed.
-
-Definition is_one p := match p with xH => true | _ => false end.
-
-Theorem is_one_one: forall p, is_one p = true -> p = xH.
-intros p; case p; auto; intros p1 H1; discriminate H1.
-Qed.
-
-Definition get_height digits p :=
-  let r := Pdiv p digits in
-   if is_one r then xH else Pos.succ (plength (Pos.pred r)).
-
-Theorem get_height_correct:
-  forall digits N,
-   Zpos N <= Zpos digits * (2 ^ (Zpos (get_height digits N) -1)).
-intros digits N.
-unfold get_height.
-assert (H1 := Pdiv_le N digits).
-case_eq (is_one (Pdiv N digits)); intros H2.
-rewrite (is_one_one _ H2) in H1.
-rewrite Z.mul_1_r in H1.
-change (2^(1-1))%Z with 1; rewrite Z.mul_1_r; auto.
-clear H2.
-apply Z.le_trans with (1 := H1).
-apply Z.mul_le_mono_nonneg_l; auto with zarith.
-rewrite Pos2Z.inj_succ; unfold Z.succ.
-rewrite Z.add_comm; rewrite Z.add_simpl_l.
-apply plength_pred_correct.
-Qed.
-
-Definition zn2z_word_comm : forall w n, zn2z (word w n) = word (zn2z w) n.
- fix zn2z_word_comm 2.
- intros w n; case n.
-  reflexivity.
-  intros n0;simpl.
-  case (zn2z_word_comm w n0).
-  reflexivity.
-Defined.
-
-Fixpoint extend (n:nat) {struct n} : forall w:Type, zn2z w -> word w (S n) :=
- match n return forall w:Type, zn2z w -> word w (S n) with
- | O => fun w x => x
- | S m =>
-   let aux := extend m in
-   fun w x => WW W0 (aux w x)
- end.
-
-Section ExtendMax.
-
-Open Scope nat_scope.
-
-Fixpoint plusnS (n m: nat) {struct n} : (n + S m = S (n + m))%nat :=
-  match n return  (n + S m = S (n + m))%nat with
-  | 0 => eq_refl (S m)
-  | S n1 =>
-      let v := S (S n1 + m) in
-      eq_ind_r (fun n => S n = v) (eq_refl v) (plusnS n1 m)
-  end.
-
-Fixpoint plusn0 n : n + 0 = n :=
-  match n return (n + 0 = n) with
-  | 0 => eq_refl 0
-  | S n1 =>
-      let v := S n1 in
-      eq_ind_r (fun n : nat => S n = v) (eq_refl v) (plusn0 n1)
-  end.
-
- Fixpoint diff (m n: nat) {struct m}: nat * nat :=
-   match m, n with
-     O, n => (O, n)
-   | m, O => (m, O)
-   | S m1, S n1 => diff m1 n1
-   end.
-
-Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n :=
-  match m return fst (diff m n) + n = max m n with
-  | 0 =>
-      match n return (n = max 0 n) with
-      | 0 => eq_refl _
-      | S n0 => eq_refl _
-      end
-  | S m1 =>
-      match n return (fst (diff (S m1) n) + n = max (S m1) n)
-      with
-      | 0 => plusn0 _
-      | S n1 =>
-          let v := fst (diff m1 n1) + n1 in
-          let v1 := fst (diff m1 n1) + S n1 in
-          eq_ind v (fun n => v1 = S n)
-            (eq_ind v1 (fun n => v1 = n) (eq_refl v1) (S v) (plusnS _ _))
-            _ (diff_l _ _)
-      end
-  end.
-
-Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n :=
-  match m return (snd (diff m n) + m = max m n) with
-  | 0 =>
-      match n return (snd (diff 0 n) + 0 = max 0 n) with
-      | 0 => eq_refl _
-      | S _ => plusn0 _
-      end
-  | S m =>
-      match n return (snd (diff (S m) n) + S m = max (S m) n) with
-      | 0 => eq_refl (snd (diff (S m) 0) + S m)
-      | S n1 =>
-          let v := S (max m n1) in
-          eq_ind_r (fun n => n = v)
-            (eq_ind_r (fun n => S n = v)
-               (eq_refl v) (diff_r _ _)) (plusnS _ _)
-      end
-  end.
-
- Variable w: Type.
-
- Definition castm (m n: nat) (H: m = n) (x: word w (S m)):
-     (word w (S n)) :=
- match H in (_ = y) return (word w (S y)) with
- | eq_refl => x
- end.
-
-Variable m: nat.
-Variable v: (word w (S m)).
-
-Fixpoint extend_tr (n : nat) {struct n}: (word w (S (n + m))) :=
-  match n  return (word w (S (n + m))) with
-  | O => v
-  | S n1 => WW W0 (extend_tr n1)
-  end.
-
-End ExtendMax.
-
-Arguments extend_tr [w m] v n.
-Arguments castm     [w m n] H x.
-
-
-
-Section Reduce.
-
- Variable w : Type.
- Variable nT : Type.
- Variable N0 : nT.
- Variable eq0 : w -> bool.
- Variable reduce_n : w -> nT.
- Variable zn2z_to_Nt : zn2z w -> nT.
-
- Definition reduce_n1 (x:zn2z w) :=
-  match x with
-  | W0 => N0
-  | WW xh xl =>
-    if eq0 xh then reduce_n xl
-    else zn2z_to_Nt x
-  end.
-
-End Reduce.
-
-Section ReduceRec.
-
- Variable w : Type.
- Variable nT : Type.
- Variable N0 : nT.
- Variable reduce_1n : zn2z w -> nT.
- Variable c : forall n, word w (S n) -> nT.
-
- Fixpoint reduce_n (n:nat) : word w (S n) -> nT :=
-  match n return word w (S n) -> nT with
-  | O => reduce_1n
-  | S m => fun x =>
-    match x with
-    | W0 => N0
-    | WW xh xl =>
-      match xh with
-      | W0 => @reduce_n m xl
-      | _ => @c (S m) x
-      end
-    end
-  end.
-
-End ReduceRec.
-
-Section CompareRec.
-
- Variable wm w : Type.
- Variable w_0 : w.
- Variable compare : w -> w -> comparison.
- Variable compare0_m : wm -> comparison.
- Variable compare_m : wm -> w -> comparison.
-
- Fixpoint compare0_mn (n:nat) : word wm n -> comparison :=
-  match n return word wm n -> comparison with
-  | O => compare0_m
-  | S m => fun x =>
-    match x with
-    | W0 => Eq
-    | WW xh xl =>
-      match compare0_mn m xh with
-      | Eq => compare0_mn m xl
-      | r  => Lt
-      end
-    end
-  end.
-
- Variable wm_base: positive.
- Variable wm_to_Z: wm -> Z.
- Variable w_to_Z: w -> Z.
- Variable w_to_Z_0: w_to_Z w_0 = 0.
- Variable spec_compare0_m: forall x,
-   compare0_m x = (w_to_Z w_0 ?= wm_to_Z x).
- Variable wm_to_Z_pos: forall x, 0 <= wm_to_Z x < base wm_base.
-
- Let double_to_Z := double_to_Z wm_base wm_to_Z.
- Let double_wB := double_wB wm_base.
-
- Lemma base_xO: forall n, base (xO n) = (base n)^2.
- Proof.
- intros n1; unfold base.
- rewrite (Pos2Z.inj_xO n1); rewrite Z.mul_comm; rewrite Z.pow_mul_r; auto with zarith.
- Qed.
-
- Let double_to_Z_pos: forall n x, 0 <= double_to_Z n x < double_wB n :=
-   (spec_double_to_Z wm_base wm_to_Z wm_to_Z_pos).
-
- Declare Equivalent Keys compare0_mn compare0_m.
-
- Lemma spec_compare0_mn: forall n x,
-   compare0_mn n x = (0 ?= double_to_Z n x).
- Proof.
-  intros n; elim n; clear n; auto.
-  intros x; rewrite spec_compare0_m; rewrite w_to_Z_0; auto.
-  intros n Hrec x; case x; unfold compare0_mn; fold compare0_mn; auto.
-  fold word in *.
-  intros xh xl.
-  rewrite 2 Hrec.
-  simpl double_to_Z.
-  set (wB := DoubleBase.double_wB wm_base n).
-  case Z.compare_spec; intros Cmp.
-  rewrite <- Cmp. reflexivity.
-  symmetry. apply Z.gt_lt, Z.lt_gt. (* ;-) *)
-  assert (0 < wB).
-   unfold wB, DoubleBase.double_wB, base; auto with zarith.
-  change 0 with (0 + 0); apply Z.add_lt_le_mono; auto with zarith.
-  apply Z.mul_pos_pos; auto with zarith.
-  case (double_to_Z_pos n xl); auto with zarith.
-  case (double_to_Z_pos n xh); intros; exfalso; omega.
-  Qed.
-
- Fixpoint compare_mn_1 (n:nat) : word wm n -> w -> comparison :=
-  match n return word wm n -> w -> comparison with
-  | O => compare_m
-  | S m => fun x y =>
-    match x with
-    | W0 => compare w_0 y
-    | WW xh xl =>
-      match compare0_mn m xh with
-      | Eq => compare_mn_1 m xl y
-      | r  => Gt
-      end
-    end
-  end.
-
- Variable spec_compare: forall x y,
-   compare x y = Z.compare (w_to_Z x) (w_to_Z y).
- Variable spec_compare_m: forall x y,
-   compare_m x y = Z.compare (wm_to_Z x) (w_to_Z y).
- Variable wm_base_lt: forall x,
-   0 <= w_to_Z x < base (wm_base).
-
- Let double_wB_lt: forall n x,
-   0 <= w_to_Z x < (double_wB n).
- Proof.
- intros n x; elim n; simpl; auto; clear n.
- intros n (H0, H); split; auto.
- apply Z.lt_le_trans with (1:= H).
- unfold double_wB, DoubleBase.double_wB; simpl.
- rewrite base_xO.
- set (u := base (Pos.shiftl_nat wm_base n)).
- assert (0 < u).
-  unfold u, base; auto with zarith.
- replace (u^2) with (u * u); simpl; auto with zarith.
- apply Z.le_trans with (1 * u); auto with zarith.
- unfold Z.pow_pos; simpl; ring.
- Qed.
-
-
- Lemma spec_compare_mn_1: forall n x y,
-   compare_mn_1 n x y = Z.compare (double_to_Z n x) (w_to_Z y).
- Proof.
- intros n; elim n; simpl; auto; clear n.
- intros n Hrec x; case x; clear x; auto.
- intros y; rewrite spec_compare; rewrite w_to_Z_0. reflexivity.
- intros xh xl y; simpl;
- rewrite spec_compare0_mn, Hrec. case Z.compare_spec.
- intros H1b.
- rewrite <- H1b; rewrite Z.mul_0_l; rewrite Z.add_0_l; auto.
- symmetry. apply Z.lt_gt.
- case (double_wB_lt n y); intros _ H0.
- apply Z.lt_le_trans with (1:= H0).
- fold double_wB.
- case (double_to_Z_pos n xl); intros H1 H2.
- apply Z.le_trans with (double_to_Z n xh * double_wB n); auto with zarith.
- apply Z.le_trans with (1 * double_wB n); auto with zarith.
- case (double_to_Z_pos n xh); intros; exfalso; omega.
- Qed.
-
-End CompareRec.
-
-
-Section AddS.
-
- Variable w wm : Type.
- Variable incr : wm -> carry wm.
- Variable addr : w -> wm -> carry wm.
- Variable injr : w -> zn2z wm.
-
- Variable w_0 u: w.
- Fixpoint injs  (n:nat): word w (S n) :=
-  match n return (word w (S n)) with
-    O => WW w_0 u
-  | S n1 => (WW W0 (injs n1))
-  end.
-
- Definition adds x y :=
-   match y with
-    W0 => C0 (injr x)
-  | WW hy ly => match addr x ly with
-                  C0 z => C0 (WW hy z)
-                | C1 z => match incr hy with
-                            C0 z1 => C0 (WW z1 z)
-                          | C1 z1 => C1 (WW z1 z)
-                          end
-                 end
-   end.
-
-End AddS.
-
- Fixpoint length_pos x :=
-  match x with xH => O | xO x1 => S (length_pos x1) | xI x1 => S (length_pos x1) end.
-
- Theorem length_pos_lt: forall x y,
-   (length_pos x < length_pos y)%nat -> Zpos x < Zpos y.
- Proof.
- intros x; elim x; clear x; [intros x1 Hrec | intros x1 Hrec | idtac];
-   intros y; case y; clear y; intros y1 H || intros H; simpl length_pos;
-   try (rewrite (Pos2Z.inj_xI x1) || rewrite (Pos2Z.inj_xO x1));
-   try (rewrite (Pos2Z.inj_xI y1) || rewrite (Pos2Z.inj_xO y1));
-   try (inversion H; fail);
-   try (assert (Zpos x1 < Zpos y1); [apply Hrec; apply lt_S_n | idtac]; auto with zarith);
-   assert (0 < Zpos y1); auto with zarith; red; auto.
- Qed.
-
- Theorem cancel_app: forall A B (f g: A -> B) x, f = g -> f x = g x.
- Proof.
- intros A B f g x H; rewrite H; auto.
- Qed.
-
-
- Section SimplOp.
-
- Variable w: Type.
-
- Theorem digits_zop: forall t (ops : ZnZ.Ops t),
-  ZnZ.digits (mk_zn2z_ops ops) = xO (ZnZ.digits ops).
- Proof.
- intros ww x; auto.
- Qed.
-
- Theorem digits_kzop: forall t (ops : ZnZ.Ops t),
-  ZnZ.digits (mk_zn2z_ops_karatsuba ops) = xO (ZnZ.digits ops).
- Proof.
- intros ww x; auto.
- Qed.
-
- Theorem make_zop: forall t (ops : ZnZ.Ops t),
-  @ZnZ.to_Z _ (mk_zn2z_ops ops) =
-    fun z => match z with
-             | W0 => 0
-             | WW xh xl => ZnZ.to_Z xh * base (ZnZ.digits ops)
-                                + ZnZ.to_Z xl
-             end.
- Proof.
- intros ww x; auto.
- Qed.
-
- Theorem make_kzop: forall t (ops: ZnZ.Ops t),
-  @ZnZ.to_Z _ (mk_zn2z_ops_karatsuba ops) =
-    fun z => match z with
-             | W0 => 0
-             | WW xh xl => ZnZ.to_Z xh * base (ZnZ.digits ops)
-                                + ZnZ.to_Z xl
-             end.
- Proof.
- intros ww x; auto.
- Qed.
-
- End SimplOp.
-
-(** Abstract vision of a datatype of arbitrary-large numbers.
-    Concrete operations can be derived from these generic
-    fonctions, in particular from [iter_t] and [same_level].
-*)
-
-Module Type NAbstract.
-
-(** The domains: a sequence of [Z/nZ] structures *)
-
-Parameter dom_t : nat -> Type.
-Declare Instance dom_op n : ZnZ.Ops (dom_t n).
-Declare Instance dom_spec n : ZnZ.Specs (dom_op n).
-
-Axiom digits_dom_op : forall n,
-  ZnZ.digits (dom_op n) = Pos.shiftl_nat (ZnZ.digits (dom_op 0)) n.
-
-(** The type [t] of arbitrary-large numbers, with abstract constructor [mk_t]
-    and destructor [destr_t] and iterator [iter_t] *)
-
-Parameter t : Type.
-
-Parameter mk_t : forall (n:nat), dom_t n -> t.
-
-Inductive View_t : t -> Prop :=
- Mk_t : forall n (x : dom_t n), View_t (mk_t n x).
-
-Axiom destr_t : forall x, View_t x. (* i.e. every x is a (mk_t n xw) *)
-
-Parameter iter_t : forall {A:Type}(f : forall n, dom_t n -> A), t -> A.
-
-Axiom iter_mk_t : forall A (f:forall n, dom_t n -> A),
- forall n x, iter_t f (mk_t n x) = f n x.
-
-(** Conversion to [ZArith] *)
-
-Parameter to_Z : t -> Z.
-Local Notation "[ x ]" := (to_Z x).
-
-Axiom spec_mk_t : forall n x, [mk_t n x] = ZnZ.to_Z x.
-
-(** [reduce] is like [mk_t], but try to minimise the level of the number *)
-
-Parameter reduce : forall (n:nat), dom_t n -> t.
-Axiom spec_reduce : forall n x, [reduce n x] = ZnZ.to_Z x.
-
-(** Number of level in the tree representation of a number.
-    NB: This function isn't a morphism for setoid [eq]. *)
-
-Definition level := iter_t (fun n _ => n).
-
-(** [same_level] and its rich specification, indexed by [level] *)
-
-Parameter same_level : forall {A:Type}
- (f : forall n, dom_t n -> dom_t n -> A), t -> t -> A.
-
-Axiom spec_same_level_dep :
-  forall res
-   (P : nat -> Z -> Z -> res -> Prop)
-   (Pantimon : forall n m z z' r, (n <= m)%nat -> P m z z' r -> P n z z' r)
-   (f : forall n, dom_t n -> dom_t n -> res)
-   (Pf: forall n x y, P n (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)),
-   forall x y, P (level x) [x] [y] (same_level f x y).
-
-(** [mk_t_S] : building a number of the next level *)
-
-Parameter mk_t_S : forall (n:nat), zn2z (dom_t n) -> t.
-
-Axiom spec_mk_t_S : forall n (x:zn2z (dom_t n)),
-  [mk_t_S n x] = zn2z_to_Z (base (ZnZ.digits (dom_op n))) ZnZ.to_Z x.
-
-Axiom mk_t_S_level : forall n x, level (mk_t_S n x) = S n.
-
-End NAbstract.
diff --git a/theories/Numbers/Natural/Binary/NBinary.v b/theories/Numbers/Natural/Binary/NBinary.v
index 037b10d9..c9e1c640 100644
--- a/theories/Numbers/Natural/Binary/NBinary.v
+++ b/theories/Numbers/Natural/Binary/NBinary.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v
index d0168bd9..6000bdcf 100644
--- a/theories/Numbers/Natural/Peano/NPeano.v
+++ b/theories/Numbers/Natural/Peano/NPeano.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
@@ -18,74 +20,74 @@ Module Nat <: NAxiomsSig := Nat.
 
 (** Compat notations for stuff that used to be at the beginning of NPeano. *)
 
-Notation leb := Nat.leb (compat "8.4").
-Notation ltb := Nat.ltb (compat "8.4").
-Notation leb_le := Nat.leb_le (compat "8.4").
-Notation ltb_lt := Nat.ltb_lt (compat "8.4").
-Notation pow := Nat.pow (compat "8.4").
-Notation pow_0_r := Nat.pow_0_r (compat "8.4").
-Notation pow_succ_r := Nat.pow_succ_r (compat "8.4").
-Notation square := Nat.square (compat "8.4").
-Notation square_spec := Nat.square_spec (compat "8.4").
-Notation Even := Nat.Even (compat "8.4").
-Notation Odd := Nat.Odd (compat "8.4").
-Notation even := Nat.even (compat "8.4").
-Notation odd := Nat.odd (compat "8.4").
-Notation even_spec := Nat.even_spec (compat "8.4").
-Notation odd_spec := Nat.odd_spec (compat "8.4").
+Notation leb := Nat.leb (only parsing).
+Notation ltb := Nat.ltb (only parsing).
+Notation leb_le := Nat.leb_le (only parsing).
+Notation ltb_lt := Nat.ltb_lt (only parsing).
+Notation pow := Nat.pow (only parsing).
+Notation pow_0_r := Nat.pow_0_r (only parsing).
+Notation pow_succ_r := Nat.pow_succ_r (only parsing).
+Notation square := Nat.square (only parsing).
+Notation square_spec := Nat.square_spec (only parsing).
+Notation Even := Nat.Even (only parsing).
+Notation Odd := Nat.Odd (only parsing).
+Notation even := Nat.even (only parsing).
+Notation odd := Nat.odd (only parsing).
+Notation even_spec := Nat.even_spec (only parsing).
+Notation odd_spec := Nat.odd_spec (only parsing).
 
 Lemma Even_equiv n : Even n <-> Even.even n.
 Proof. symmetry. apply Even.even_equiv. Qed.
 Lemma Odd_equiv n : Odd n <-> Even.odd n.
 Proof. symmetry. apply Even.odd_equiv. Qed.
 
-Notation divmod := Nat.divmod (compat "8.4").
-Notation div := Nat.div (compat "8.4").
-Notation modulo := Nat.modulo (compat "8.4").
-Notation divmod_spec := Nat.divmod_spec (compat "8.4").
-Notation div_mod := Nat.div_mod (compat "8.4").
-Notation mod_bound_pos := Nat.mod_bound_pos (compat "8.4").
-Notation sqrt_iter := Nat.sqrt_iter (compat "8.4").
-Notation sqrt := Nat.sqrt (compat "8.4").
-Notation sqrt_iter_spec := Nat.sqrt_iter_spec (compat "8.4").
-Notation sqrt_spec := Nat.sqrt_spec (compat "8.4").
-Notation log2_iter := Nat.log2_iter (compat "8.4").
-Notation log2 := Nat.log2 (compat "8.4").
-Notation log2_iter_spec := Nat.log2_iter_spec (compat "8.4").
-Notation log2_spec := Nat.log2_spec (compat "8.4").
-Notation log2_nonpos := Nat.log2_nonpos (compat "8.4").
-Notation gcd := Nat.gcd (compat "8.4").
-Notation divide := Nat.divide (compat "8.4").
-Notation gcd_divide := Nat.gcd_divide (compat "8.4").
-Notation gcd_divide_l := Nat.gcd_divide_l (compat "8.4").
-Notation gcd_divide_r := Nat.gcd_divide_r (compat "8.4").
-Notation gcd_greatest := Nat.gcd_greatest (compat "8.4").
-Notation testbit := Nat.testbit (compat "8.4").
-Notation shiftl := Nat.shiftl (compat "8.4").
-Notation shiftr := Nat.shiftr (compat "8.4").
-Notation bitwise := Nat.bitwise (compat "8.4").
-Notation land := Nat.land (compat "8.4").
-Notation lor := Nat.lor (compat "8.4").
-Notation ldiff := Nat.ldiff (compat "8.4").
-Notation lxor := Nat.lxor (compat "8.4").
-Notation double_twice := Nat.double_twice (compat "8.4").
-Notation testbit_0_l := Nat.testbit_0_l (compat "8.4").
-Notation testbit_odd_0 := Nat.testbit_odd_0 (compat "8.4").
-Notation testbit_even_0 := Nat.testbit_even_0 (compat "8.4").
-Notation testbit_odd_succ := Nat.testbit_odd_succ (compat "8.4").
-Notation testbit_even_succ := Nat.testbit_even_succ (compat "8.4").
-Notation shiftr_spec := Nat.shiftr_spec (compat "8.4").
-Notation shiftl_spec_high := Nat.shiftl_spec_high (compat "8.4").
-Notation shiftl_spec_low := Nat.shiftl_spec_low (compat "8.4").
-Notation div2_bitwise := Nat.div2_bitwise (compat "8.4").
-Notation odd_bitwise := Nat.odd_bitwise (compat "8.4").
-Notation div2_decr := Nat.div2_decr (compat "8.4").
-Notation testbit_bitwise_1 := Nat.testbit_bitwise_1 (compat "8.4").
-Notation testbit_bitwise_2 := Nat.testbit_bitwise_2 (compat "8.4").
-Notation land_spec := Nat.land_spec (compat "8.4").
-Notation ldiff_spec := Nat.ldiff_spec (compat "8.4").
-Notation lor_spec := Nat.lor_spec (compat "8.4").
-Notation lxor_spec := Nat.lxor_spec (compat "8.4").
+Notation divmod := Nat.divmod (only parsing).
+Notation div := Nat.div (only parsing).
+Notation modulo := Nat.modulo (only parsing).
+Notation divmod_spec := Nat.divmod_spec (only parsing).
+Notation div_mod := Nat.div_mod (only parsing).
+Notation mod_bound_pos := Nat.mod_bound_pos (only parsing).
+Notation sqrt_iter := Nat.sqrt_iter (only parsing).
+Notation sqrt := Nat.sqrt (only parsing).
+Notation sqrt_iter_spec := Nat.sqrt_iter_spec (only parsing).
+Notation sqrt_spec := Nat.sqrt_spec (only parsing).
+Notation log2_iter := Nat.log2_iter (only parsing).
+Notation log2 := Nat.log2 (only parsing).
+Notation log2_iter_spec := Nat.log2_iter_spec (only parsing).
+Notation log2_spec := Nat.log2_spec (only parsing).
+Notation log2_nonpos := Nat.log2_nonpos (only parsing).
+Notation gcd := Nat.gcd (only parsing).
+Notation divide := Nat.divide (only parsing).
+Notation gcd_divide := Nat.gcd_divide (only parsing).
+Notation gcd_divide_l := Nat.gcd_divide_l (only parsing).
+Notation gcd_divide_r := Nat.gcd_divide_r (only parsing).
+Notation gcd_greatest := Nat.gcd_greatest (only parsing).
+Notation testbit := Nat.testbit (only parsing).
+Notation shiftl := Nat.shiftl (only parsing).
+Notation shiftr := Nat.shiftr (only parsing).
+Notation bitwise := Nat.bitwise (only parsing).
+Notation land := Nat.land (only parsing).
+Notation lor := Nat.lor (only parsing).
+Notation ldiff := Nat.ldiff (only parsing).
+Notation lxor := Nat.lxor (only parsing).
+Notation double_twice := Nat.double_twice (only parsing).
+Notation testbit_0_l := Nat.testbit_0_l (only parsing).
+Notation testbit_odd_0 := Nat.testbit_odd_0 (only parsing).
+Notation testbit_even_0 := Nat.testbit_even_0 (only parsing).
+Notation testbit_odd_succ := Nat.testbit_odd_succ (only parsing).
+Notation testbit_even_succ := Nat.testbit_even_succ (only parsing).
+Notation shiftr_spec := Nat.shiftr_spec (only parsing).
+Notation shiftl_spec_high := Nat.shiftl_spec_high (only parsing).
+Notation shiftl_spec_low := Nat.shiftl_spec_low (only parsing).
+Notation div2_bitwise := Nat.div2_bitwise (only parsing).
+Notation odd_bitwise := Nat.odd_bitwise (only parsing).
+Notation div2_decr := Nat.div2_decr (only parsing).
+Notation testbit_bitwise_1 := Nat.testbit_bitwise_1 (only parsing).
+Notation testbit_bitwise_2 := Nat.testbit_bitwise_2 (only parsing).
+Notation land_spec := Nat.land_spec (only parsing).
+Notation ldiff_spec := Nat.ldiff_spec (only parsing).
+Notation lor_spec := Nat.lor_spec (only parsing).
+Notation lxor_spec := Nat.lxor_spec (only parsing).
 
 Infix "<=?" := Nat.leb (at level 70) : nat_scope.
 Infix "<?" := Nat.ltb (at level 70) : nat_scope.
diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v
deleted file mode 100644
index 258e0315..00000000
--- a/theories/Numbers/Natural/SpecViaZ/NSig.v
+++ /dev/null
@@ -1,124 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
-(************************************************************************)
-
-Require Import BinInt.
-
-Open Scope Z_scope.
-
-(** * NSig *)
-
-(** Interface of a rich structure about natural numbers.
-    Specifications are written via translation to Z.
-*)
-
-Module Type NType.
-
- Parameter t : Type.
-
- Parameter to_Z : t -> Z.
- Local Notation "[ x ]" := (to_Z x).
- Parameter spec_pos: forall x, 0 <= [x].
-
- Parameter of_N : N -> t.
- Parameter spec_of_N: forall x, to_Z (of_N x) = Z.of_N x.
- Definition to_N n := Z.to_N (to_Z n).
-
- Definition eq n m := [n] = [m].
- Definition lt n m := [n] < [m].
- Definition le n m := [n] <= [m].
-
- Parameter compare : t -> t -> comparison.
- Parameter eqb : t -> t -> bool.
- Parameter ltb : t -> t -> bool.
- Parameter leb : t -> t -> bool.
- Parameter max : t -> t -> t.
- Parameter min : t -> t -> t.
- Parameter zero : t.
- Parameter one : t.
- Parameter two : t.
- Parameter succ : t -> t.
- Parameter pred : t -> t.
- Parameter add  : t -> t -> t.
- Parameter sub : t -> t -> t.
- Parameter mul : t -> t -> t.
- Parameter square : t -> t.
- Parameter pow_pos : t -> positive -> t.
- Parameter pow_N : t -> N -> t.
- Parameter pow : t -> t -> t.
- Parameter sqrt : t -> t.
- Parameter log2 : t -> t.
- Parameter div_eucl : t -> t -> t * t.
- Parameter div : t -> t -> t.
- Parameter modulo : t -> t -> t.
- Parameter gcd : t -> t -> t.
- Parameter even : t -> bool.
- Parameter odd : t -> bool.
- Parameter testbit : t -> t -> bool.
- Parameter shiftr : t -> t -> t.
- Parameter shiftl : t -> t -> t.
- Parameter land : t -> t -> t.
- Parameter lor : t -> t -> t.
- Parameter ldiff : t -> t -> t.
- Parameter lxor : t -> t -> t.
- Parameter div2 : t -> t.
-
- Parameter spec_compare: forall x y, compare x y = ([x] ?= [y]).
- Parameter spec_eqb : forall x y, eqb x y = ([x] =? [y]).
- Parameter spec_ltb : forall x y, ltb x y = ([x] <? [y]).
- Parameter spec_leb : forall x y, leb x y = ([x] <=? [y]).
- Parameter spec_max : forall x y, [max x y] = Z.max [x] [y].
- Parameter spec_min : forall x y, [min x y] = Z.min [x] [y].
- Parameter spec_0: [zero] = 0.
- Parameter spec_1: [one] = 1.
- Parameter spec_2: [two] = 2.
- Parameter spec_succ: forall n, [succ n] = [n] + 1.
- Parameter spec_add: forall x y, [add x y] = [x] + [y].
- Parameter spec_pred: forall x, [pred x] = Z.max 0 ([x] - 1).
- Parameter spec_sub: forall x y, [sub x y] = Z.max 0 ([x] - [y]).
- Parameter spec_mul: forall x y, [mul x y] = [x] * [y].
- Parameter spec_square: forall x, [square x] = [x] * [x].
- Parameter spec_pow_pos: forall x n, [pow_pos x n] = [x] ^ Zpos n.
- Parameter spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z.of_N n.
- Parameter spec_pow: forall x n, [pow x n] = [x] ^ [n].
- Parameter spec_sqrt: forall x, [sqrt x] = Z.sqrt [x].
- Parameter spec_log2: forall x, [log2 x] = Z.log2 [x].
- Parameter spec_div_eucl: forall x y,
-  let (q,r) := div_eucl x y in ([q], [r]) = Z.div_eucl [x] [y].
- Parameter spec_div: forall x y, [div x y] = [x] / [y].
- Parameter spec_modulo: forall x y, [modulo x y] = [x] mod [y].
- Parameter spec_gcd: forall a b, [gcd a b] = Z.gcd [a] [b].
- Parameter spec_even: forall x, even x = Z.even [x].
- Parameter spec_odd: forall x, odd x = Z.odd [x].
- Parameter spec_testbit: forall x p, testbit x p = Z.testbit [x] [p].
- Parameter spec_shiftr: forall x p, [shiftr x p] = Z.shiftr [x] [p].
- Parameter spec_shiftl: forall x p, [shiftl x p] = Z.shiftl [x] [p].
- Parameter spec_land: forall x y, [land x y] = Z.land [x] [y].
- Parameter spec_lor: forall x y, [lor x y] = Z.lor [x] [y].
- Parameter spec_ldiff: forall x y, [ldiff x y] = Z.ldiff [x] [y].
- Parameter spec_lxor: forall x y, [lxor x y] = Z.lxor [x] [y].
- Parameter spec_div2: forall x, [div2 x] = Z.div2 [x].
-
-End NType.
-
-Module Type NType_Notation (Import N:NType).
- Notation "[ x ]" := (to_Z x).
- Infix "==" := eq (at level 70).
- Notation "0" := zero.
- Notation "1" := one.
- Notation "2" := two.
- Infix "+" := add.
- Infix "-" := sub.
- Infix "*" := mul.
- Infix "^" := pow.
- Infix "<=" := le.
- Infix "<" := lt.
-End NType_Notation.
-
-Module Type NType' := NType <+ NType_Notation.
diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
deleted file mode 100644
index 355da4cc..00000000
--- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
+++ /dev/null
@@ -1,487 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import ZArith OrdersFacts Nnat NAxioms NSig.
-
-(** * The interface [NSig.NType] implies the interface [NAxiomsSig] *)
-
-Module NTypeIsNAxioms (Import NN : NType').
-
-Hint Rewrite
- spec_0 spec_1 spec_2 spec_succ spec_add spec_mul spec_pred spec_sub
- spec_div spec_modulo spec_gcd spec_compare spec_eqb spec_ltb spec_leb
- spec_square spec_sqrt spec_log2 spec_max spec_min spec_pow_pos spec_pow_N
- spec_pow spec_even spec_odd spec_testbit spec_shiftl spec_shiftr
- spec_land spec_lor spec_ldiff spec_lxor spec_div2 spec_of_N
- : nsimpl.
-Ltac nsimpl := autorewrite with nsimpl.
-Ltac ncongruence := unfold eq, to_N; repeat red; intros; nsimpl; congruence.
-Ltac zify := unfold eq, lt, le, to_N in *; nsimpl.
-Ltac omega_pos n := generalize (spec_pos n); omega with *.
-
-Local Obligation Tactic := ncongruence.
-
-Instance eq_equiv : Equivalence eq.
-Proof. unfold eq. firstorder. Qed.
-
-Program Instance succ_wd : Proper (eq==>eq) succ.
-Program Instance pred_wd : Proper (eq==>eq) pred.
-Program Instance add_wd : Proper (eq==>eq==>eq) add.
-Program Instance sub_wd : Proper (eq==>eq==>eq) sub.
-Program Instance mul_wd : Proper (eq==>eq==>eq) mul.
-
-Theorem pred_succ : forall n, pred (succ n) == n.
-Proof.
-intros. zify. omega_pos n.
-Qed.
-
-Theorem one_succ : 1 == succ 0.
-Proof.
-now zify.
-Qed.
-
-Theorem two_succ : 2 == succ 1.
-Proof.
-now zify.
-Qed.
-
-Definition N_of_Z z := of_N (Z.to_N z).
-
-Lemma spec_N_of_Z z : (0<=z)%Z -> [N_of_Z z] = z.
-Proof.
- unfold N_of_Z. zify. apply Z2N.id.
-Qed.
-
-Section Induction.
-
-Variable A : NN.t -> Prop.
-Hypothesis A_wd : Proper (eq==>iff) A.
-Hypothesis A0 : A 0.
-Hypothesis AS : forall n, A n <-> A (succ n).
-
-Let B (z : Z) := A (N_of_Z z).
-
-Lemma B0 : B 0.
-Proof.
-unfold B, N_of_Z; simpl.
-rewrite <- (A_wd 0); auto.
-red; rewrite spec_0, spec_of_N; auto.
-Qed.
-
-Lemma BS : forall z : Z, (0 <= z)%Z -> B z -> B (z + 1).
-Proof.
-intros z H1 H2.
-unfold B in *. apply -> AS in H2.
-setoid_replace (N_of_Z (z + 1)) with (succ (N_of_Z z)); auto.
-unfold eq. rewrite spec_succ, 2 spec_N_of_Z; auto with zarith.
-Qed.
-
-Lemma B_holds : forall z : Z, (0 <= z)%Z -> B z.
-Proof.
-exact (natlike_ind B B0 BS).
-Qed.
-
-Theorem bi_induction : forall n, A n.
-Proof.
-intro n. setoid_replace n with (N_of_Z (to_Z n)).
-apply B_holds. apply spec_pos.
-red. now rewrite spec_N_of_Z by apply spec_pos.
-Qed.
-
-End Induction.
-
-Theorem add_0_l : forall n, 0 + n == n.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem add_succ_l : forall n m, (succ n) + m == succ (n + m).
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem sub_0_r : forall n, n - 0 == n.
-Proof.
-intros. zify. omega_pos n.
-Qed.
-
-Theorem sub_succ_r : forall n m, n - (succ m) == pred (n - m).
-Proof.
-intros. zify. omega with *.
-Qed.
-
-Theorem mul_0_l : forall n, 0 * n == 0.
-Proof.
-intros. zify. auto with zarith.
-Qed.
-
-Theorem mul_succ_l : forall n m, (succ n) * m == n * m + m.
-Proof.
-intros. zify. ring.
-Qed.
-
-(** Order *)
-
-Lemma eqb_eq x y : eqb x y = true <-> x == y.
-Proof.
- zify. apply Z.eqb_eq.
-Qed.
-
-Lemma leb_le x y : leb x y = true <-> x <= y.
-Proof.
- zify. apply Z.leb_le.
-Qed.
-
-Lemma ltb_lt x y : ltb x y = true <-> x < y.
-Proof.
- zify. apply Z.ltb_lt.
-Qed.
-
-Lemma compare_eq_iff n m : compare n m = Eq <-> n == m.
-Proof.
- intros. zify. apply Z.compare_eq_iff.
-Qed.
-
-Lemma compare_lt_iff n m : compare n m = Lt <-> n < m.
-Proof.
- intros. zify. reflexivity.
-Qed.
-
-Lemma compare_le_iff n m : compare n m <> Gt <-> n <= m.
-Proof.
- intros. zify. reflexivity.
-Qed.
-
-Lemma compare_antisym n m : compare m n = CompOpp (compare n m).
-Proof.
- intros. zify. apply Z.compare_antisym.
-Qed.
-
-Include BoolOrderFacts NN NN NN [no inline].
-
-Instance compare_wd : Proper (eq ==> eq ==> Logic.eq) compare.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance eqb_wd : Proper (eq ==> eq ==> Logic.eq) eqb.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance ltb_wd : Proper (eq ==> eq ==> Logic.eq) ltb.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance leb_wd : Proper (eq ==> eq ==> Logic.eq) leb.
-Proof.
-intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
-Qed.
-
-Instance lt_wd : Proper (eq ==> eq ==> iff) lt.
-Proof.
-intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition.
-Qed.
-
-Theorem lt_succ_r : forall n m, n < succ m <-> n <= m.
-Proof.
-intros. zify. omega.
-Qed.
-
-Theorem min_l : forall n m, n <= m -> min n m == n.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-Theorem min_r : forall n m, m <= n -> min n m == m.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-Theorem max_l : forall n m, m <= n -> max n m == n.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-Theorem max_r : forall n m, n <= m -> max n m == m.
-Proof.
-intros n m. zify. omega with *.
-Qed.
-
-(** Properties specific to natural numbers, not integers. *)
-
-Theorem pred_0 : pred 0 == 0.
-Proof.
-zify. auto.
-Qed.
-
-(** Power *)
-
-Program Instance pow_wd : Proper (eq==>eq==>eq) pow.
-
-Lemma pow_0_r : forall a, a^0 == 1.
-Proof.
- intros. now zify.
-Qed.
-
-Lemma pow_succ_r : forall a b, 0<=b -> a^(succ b) == a * a^b.
-Proof.
- intros a b. zify. intros. now Z.nzsimpl.
-Qed.
-
-Lemma pow_neg_r : forall a b, b<0 -> a^b == 0.
-Proof.
- intros a b. zify. intro Hb. exfalso. omega_pos b.
-Qed.
-
-Lemma pow_pow_N : forall a b, a^b == pow_N a (to_N b).
-Proof.
- intros. zify. f_equal.
- now rewrite Z2N.id by apply spec_pos.
-Qed.
-
-Lemma pow_N_pow : forall a b, pow_N a b == a^(of_N b).
-Proof.
- intros. now zify.
-Qed.
-
-Lemma pow_pos_N : forall a p, pow_pos a p == pow_N a (Npos p).
-Proof.
- intros. now zify.
-Qed.
-
-(** Square *)
-
-Lemma square_spec n : square n == n * n.
-Proof.
- now zify.
-Qed.
-
-(** Sqrt *)
-
-Lemma sqrt_spec : forall n, 0<=n ->
- (sqrt n)*(sqrt n) <= n /\ n < (succ (sqrt n))*(succ (sqrt n)).
-Proof.
- intros n. zify. apply Z.sqrt_spec.
-Qed.
-
-Lemma sqrt_neg : forall n, n<0 -> sqrt n == 0.
-Proof.
- intros n. zify. intro H. exfalso. omega_pos n.
-Qed.
-
-(** Log2 *)
-
-Lemma log2_spec : forall n, 0<n ->
- 2^(log2 n) <= n /\ n < 2^(succ (log2 n)).
-Proof.
- intros n. zify. change (Z.log2 [n]+1)%Z with (Z.succ (Z.log2 [n])).
- apply Z.log2_spec.
-Qed.
-
-Lemma log2_nonpos : forall n, n<=0 -> log2 n == 0.
-Proof.
- intros n. zify. apply Z.log2_nonpos.
-Qed.
-
-(** Even / Odd *)
-
-Definition Even n := exists m, n == 2*m.
-Definition Odd n := exists m, n == 2*m+1.
-
-Lemma even_spec n : even n = true <-> Even n.
-Proof.
- unfold Even. zify. rewrite Z.even_spec.
- split; intros (m,Hm).
- - exists (N_of_Z m). zify. rewrite spec_N_of_Z; trivial. omega_pos n.
- - exists [m]. revert Hm; now zify.
-Qed.
-
-Lemma odd_spec n : odd n = true <-> Odd n.
-Proof.
- unfold Odd. zify. rewrite Z.odd_spec.
- split; intros (m,Hm).
- - exists (N_of_Z m). zify. rewrite spec_N_of_Z; trivial. omega_pos n.
- - exists [m]. revert Hm; now zify.
-Qed.
-
-(** Div / Mod *)
-
-Program Instance div_wd : Proper (eq==>eq==>eq) div.
-Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
-
-Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b).
-Proof.
-intros a b. zify. intros. apply Z.div_mod; auto.
-Qed.
-
-Theorem mod_bound_pos : forall a b, 0<=a -> 0<b ->
- 0 <= modulo a b /\ modulo a b < b.
-Proof.
-intros a b. zify. apply Z.mod_bound_pos.
-Qed.
-
-(** Gcd *)
-
-Definition divide n m := exists p, m == p*n.
-Local Notation "( x | y )" := (divide x y) (at level 0).
-
-Lemma spec_divide : forall n m, (n|m) <-> Z.divide [n] [m].
-Proof.
- intros n m. split.
- - intros (p,H). exists [p]. revert H; now zify.
- - intros (z,H). exists (of_N (Z.abs_N z)). zify.
-   rewrite N2Z.inj_abs_N.
-   rewrite <- (Z.abs_eq [m]), <- (Z.abs_eq [n]) by apply spec_pos.
-   now rewrite H, Z.abs_mul.
-Qed.
-
-Lemma gcd_divide_l : forall n m, (gcd n m | n).
-Proof.
- intros n m. apply spec_divide. zify. apply Z.gcd_divide_l.
-Qed.
-
-Lemma gcd_divide_r : forall n m, (gcd n m | m).
-Proof.
- intros n m. apply spec_divide. zify. apply Z.gcd_divide_r.
-Qed.
-
-Lemma gcd_greatest : forall n m p, (p|n) -> (p|m) -> (p|gcd n m).
-Proof.
- intros n m p. rewrite !spec_divide. zify. apply Z.gcd_greatest.
-Qed.
-
-Lemma gcd_nonneg : forall n m, 0 <= gcd n m.
-Proof.
- intros. zify. apply Z.gcd_nonneg.
-Qed.
-
-(** Bitwise operations *)
-
-Program Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit.
-
-Lemma testbit_odd_0 : forall a, testbit (2*a+1) 0 = true.
-Proof.
- intros. zify. apply Z.testbit_odd_0.
-Qed.
-
-Lemma testbit_even_0 : forall a, testbit (2*a) 0 = false.
-Proof.
- intros. zify. apply Z.testbit_even_0.
-Qed.
-
-Lemma testbit_odd_succ : forall a n, 0<=n ->
- testbit (2*a+1) (succ n) = testbit a n.
-Proof.
- intros a n. zify. apply Z.testbit_odd_succ.
-Qed.
-
-Lemma testbit_even_succ : forall a n, 0<=n ->
- testbit (2*a) (succ n) = testbit a n.
-Proof.
- intros a n. zify. apply Z.testbit_even_succ.
-Qed.
-
-Lemma testbit_neg_r : forall a n, n<0 -> testbit a n = false.
-Proof.
- intros a n. zify. apply Z.testbit_neg_r.
-Qed.
-
-Lemma shiftr_spec : forall a n m, 0<=m ->
- testbit (shiftr a n) m = testbit a (m+n).
-Proof.
- intros a n m. zify. apply Z.shiftr_spec.
-Qed.
-
-Lemma shiftl_spec_high : forall a n m, 0<=m -> n<=m ->
- testbit (shiftl a n) m = testbit a (m-n).
-Proof.
- intros a n m. zify. intros Hn H. rewrite Z.max_r by auto with zarith.
- now apply Z.shiftl_spec_high.
-Qed.
-
-Lemma shiftl_spec_low : forall a n m, m<n ->
- testbit (shiftl a n) m = false.
-Proof.
- intros a n m. zify. intros H. now apply Z.shiftl_spec_low.
-Qed.
-
-Lemma land_spec : forall a b n,
- testbit (land a b) n = testbit a n && testbit b n.
-Proof.
- intros a n m. zify. now apply Z.land_spec.
-Qed.
-
-Lemma lor_spec : forall a b n,
- testbit (lor a b) n = testbit a n || testbit b n.
-Proof.
- intros a n m. zify. now apply Z.lor_spec.
-Qed.
-
-Lemma ldiff_spec : forall a b n,
- testbit (ldiff a b) n = testbit a n && negb (testbit b n).
-Proof.
- intros a n m. zify. now apply Z.ldiff_spec.
-Qed.
-
-Lemma lxor_spec : forall a b n,
- testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
-Proof.
- intros a n m. zify. now apply Z.lxor_spec.
-Qed.
-
-Lemma div2_spec : forall a, div2 a == shiftr a 1.
-Proof.
- intros a. zify. now apply Z.div2_spec.
-Qed.
-
-(** Recursion *)
-
-Definition recursion (A : Type) (a : A) (f : NN.t -> A -> A) (n : NN.t) :=
-  N.peano_rect (fun _ => A) a (fun n a => f (NN.of_N n) a) (NN.to_N n).
-Arguments recursion [A] a f n.
-
-Instance recursion_wd (A : Type) (Aeq : relation A) :
- Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A).
-Proof.
-unfold eq.
-intros a a' Eaa' f f' Eff' x x' Exx'.
-unfold recursion.
-unfold NN.to_N.
-rewrite <- Exx'; clear x' Exx'.
-induction (Z.to_N [x]) using N.peano_ind.
-simpl; auto.
-rewrite 2 N.peano_rect_succ. now apply Eff'.
-Qed.
-
-Theorem recursion_0 :
-  forall (A : Type) (a : A) (f : NN.t -> A -> A), recursion a f 0 = a.
-Proof.
-intros A a f; unfold recursion, NN.to_N; rewrite NN.spec_0; simpl; auto.
-Qed.
-
-Theorem recursion_succ :
-  forall (A : Type) (Aeq : relation A) (a : A) (f : NN.t -> A -> A),
-    Aeq a a -> Proper (eq==>Aeq==>Aeq) f ->
-      forall n, Aeq (recursion a f (succ n)) (f n (recursion a f n)).
-Proof.
-unfold eq, recursion; intros A Aeq a f EAaa f_wd n.
-replace (to_N (succ n)) with (N.succ (to_N n)) by
- (zify; now rewrite <- Z2N.inj_succ by apply spec_pos).
-rewrite N.peano_rect_succ.
-apply f_wd; auto.
-zify. now rewrite Z2N.id by apply spec_pos.
-fold (recursion a f n). apply recursion_wd; auto. red; auto.
-Qed.
-
-End NTypeIsNAxioms.
-
-Module NType_NAxioms (NN : NType)
- <: NAxiomsSig <: OrderFunctions NN <: HasMinMax NN
- := NN <+ NTypeIsNAxioms.
diff --git a/theories/Numbers/NumPrelude.v b/theories/Numbers/NumPrelude.v
index f323aaeb..7cf13fea 100644
--- a/theories/Numbers/NumPrelude.v
+++ b/theories/Numbers/NumPrelude.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
diff --git a/theories/Numbers/Rational/BigQ/BigQ.v b/theories/Numbers/Rational/BigQ/BigQ.v
deleted file mode 100644
index 850afe53..00000000
--- a/theories/Numbers/Rational/BigQ/BigQ.v
+++ /dev/null
@@ -1,162 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** * BigQ: an efficient implementation of rational numbers *)
-
-(** Initial authors: Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-
-Require Export BigZ.
-Require Import Field Qfield QSig QMake Orders GenericMinMax.
-
-(** We choose for BigQ an implemention with
-    multiple representation of 0: 0, 1/0, 2/0 etc.
-    See [QMake.v] *)
-
-(** First, we provide translations functions between [BigN] and [BigZ] *)
-
-Module BigN_BigZ <: NType_ZType BigN.BigN BigZ.
- Definition Z_of_N := BigZ.Pos.
- Lemma spec_Z_of_N : forall n, BigZ.to_Z (Z_of_N n) = BigN.to_Z n.
- Proof.
- reflexivity.
- Qed.
- Definition Zabs_N := BigZ.to_N.
- Lemma spec_Zabs_N : forall z, BigN.to_Z (Zabs_N z) = Z.abs (BigZ.to_Z z).
- Proof.
- unfold Zabs_N; intros.
- rewrite BigZ.spec_to_Z, Z.mul_comm; apply Z.sgn_abs.
- Qed.
-End BigN_BigZ.
-
-(** This allows building [BigQ] out of [BigN] and [BigQ] via [QMake] *)
-
-Delimit Scope bigQ_scope with bigQ.
-
-Module BigQ <: QType <: OrderedTypeFull <: TotalOrder.
- Include QMake.Make BigN BigZ BigN_BigZ
-  <+ !QProperties <+ HasEqBool2Dec
-  <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties.
- Ltac order := Private_Tac.order.
-End BigQ.
-
-(** Notations about [BigQ] *)
-
-Local Open Scope bigQ_scope.
-
-Notation bigQ := BigQ.t.
-Bind Scope bigQ_scope with bigQ BigQ.t BigQ.t_.
-(** As in QArith, we use [#] to denote fractions *)
-Notation "p # q" := (BigQ.Qq p q) (at level 55, no associativity) : bigQ_scope.
-Local Notation "0" := BigQ.zero : bigQ_scope.
-Local Notation "1" := BigQ.one : bigQ_scope.
-Infix "+" := BigQ.add : bigQ_scope.
-Infix "-" := BigQ.sub : bigQ_scope.
-Notation "- x" := (BigQ.opp x) : bigQ_scope.
-Infix "*" := BigQ.mul : bigQ_scope.
-Infix "/" := BigQ.div : bigQ_scope.
-Infix "^" := BigQ.power : bigQ_scope.
-Infix "?=" := BigQ.compare : bigQ_scope.
-Infix "==" := BigQ.eq : bigQ_scope.
-Notation "x != y" := (~x==y) (at level 70, no associativity) : bigQ_scope.
-Infix "<" := BigQ.lt : bigQ_scope.
-Infix "<=" := BigQ.le : bigQ_scope.
-Notation "x > y" := (BigQ.lt y x) (only parsing) : bigQ_scope.
-Notation "x >= y" := (BigQ.le y x) (only parsing) : bigQ_scope.
-Notation "x < y < z" := (x<y /\ y<z) : bigQ_scope.
-Notation "x < y <= z" := (x<y /\ y<=z) : bigQ_scope.
-Notation "x <= y < z" := (x<=y /\ y<z) : bigQ_scope.
-Notation "x <= y <= z" := (x<=y /\ y<=z) : bigQ_scope.
-Notation "[ q ]" := (BigQ.to_Q q) : bigQ_scope.
-
-(** [BigQ] is a field *)
-
-Lemma BigQfieldth :
- field_theory 0 1 BigQ.add BigQ.mul BigQ.sub BigQ.opp
-  BigQ.div BigQ.inv BigQ.eq.
-Proof.
-constructor.
-constructor.
-exact BigQ.add_0_l. exact BigQ.add_comm. exact BigQ.add_assoc.
-exact BigQ.mul_1_l. exact BigQ.mul_comm. exact BigQ.mul_assoc.
-exact BigQ.mul_add_distr_r. exact BigQ.sub_add_opp.
-exact BigQ.add_opp_diag_r. exact BigQ.neq_1_0.
-exact BigQ.div_mul_inv. exact BigQ.mul_inv_diag_l.
-Qed.
-
-Declare Equivalent Keys pow_N pow_pos.
-
-Lemma BigQpowerth :
- power_theory 1 BigQ.mul BigQ.eq Z.of_N BigQ.power.
-Proof.
-constructor. intros. BigQ.qify.
-replace ([r] ^ Z.of_N n)%Q with (pow_N 1 Qmult [r] n)%Q by (now destruct n).
-destruct n. reflexivity.
-induction p; simpl; auto; rewrite ?BigQ.spec_mul, ?IHp; reflexivity.
-Qed.
-
-Ltac isBigQcst t :=
- match t with
- | BigQ.Qz ?t => isBigZcst t
- | BigQ.Qq ?n ?d => match isBigZcst n with
-             | true => isBigNcst d
-             | false => constr:(false)
-             end
- | BigQ.zero => constr:(true)
- | BigQ.one => constr:(true)
- | BigQ.minus_one => constr:(true)
- | _ => constr:(false)
- end.
-
-Ltac BigQcst t :=
- match isBigQcst t with
- | true => constr:(t)
- | false => constr:(NotConstant)
- end.
-
-Add Field BigQfield : BigQfieldth
- (decidable BigQ.eqb_correct,
-  completeness BigQ.eqb_complete,
-  constants [BigQcst],
-  power_tac BigQpowerth [Qpow_tac]).
-
-Section TestField.
-
-Let ex1 : forall x y z, (x+y)*z ==  (x*z)+(y*z).
-  intros.
-  ring.
-Qed.
-
-Let ex8 : forall x, x ^ 2 == x*x.
-  intro.
-  ring.
-Qed.
-
-Let ex10 : forall x y, y!=0 -> (x/y)*y == x.
-intros.
-field.
-auto.
-Qed.
-
-End TestField.
-
-(** [BigQ] can also benefit from an "order" tactic *)
-
-Ltac bigQ_order := BigQ.order.
-
-Section TestOrder.
-Let test : forall x y : bigQ, x<=y -> y<=x -> x==y.
-Proof. bigQ_order. Qed.
-End TestOrder.
-
-(** We can also reason by switching to QArith thanks to tactic
-    BigQ.qify. *)
-
-Section TestQify.
-Let test : forall x : bigQ, 0+x == 1*x.
-Proof. intro x. BigQ.qify. ring. Qed.
-End TestQify.
diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v
deleted file mode 100644
index b9fed9d5..00000000
--- a/theories/Numbers/Rational/BigQ/QMake.v
+++ /dev/null
@@ -1,1283 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** * QMake : a generic efficient implementation of rational numbers *)
-
-(** Initial authors : Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-
-Require Import BigNumPrelude ROmega.
-Require Import QArith Qcanon Qpower Qminmax.
-Require Import NSig ZSig QSig.
-
-(** We will build rationals out of an implementation of integers [ZType]
-    for numerators and an implementation of natural numbers [NType] for
-    denominators. But first we will need some glue between [NType] and
-    [ZType]. *)
-
-Module Type NType_ZType (NN:NType)(ZZ:ZType).
- Parameter Z_of_N : NN.t -> ZZ.t.
- Parameter spec_Z_of_N : forall n, ZZ.to_Z (Z_of_N n) = NN.to_Z n.
- Parameter Zabs_N : ZZ.t -> NN.t.
- Parameter spec_Zabs_N : forall z, NN.to_Z (Zabs_N z) = Z.abs (ZZ.to_Z z).
-End NType_ZType.
-
-Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
-
- (** The notation of a rational number is either an integer x,
-     interpreted as itself or a pair (x,y) of an integer x and a natural
-     number y interpreted as x/y. The pairs (x,0) and (0,y) are all
-     interpreted as 0. *)
-
- Inductive t_ :=
-  | Qz : ZZ.t -> t_
-  | Qq : ZZ.t -> NN.t -> t_.
-
- Definition t := t_.
-
- (** Specification with respect to [QArith] *)
-
- Local Open Scope Q_scope.
-
- Definition of_Z x: t := Qz (ZZ.of_Z x).
-
- Definition of_Q (q:Q) : t :=
-  let (x,y) := q in
-  match y with
-    | 1%positive => Qz (ZZ.of_Z x)
-    | _ => Qq (ZZ.of_Z x) (NN.of_N (Npos y))
-  end.
-
- Definition to_Q (q: t) :=
- match q with
-   | Qz x => ZZ.to_Z x # 1
-   | Qq x y => if NN.eqb y NN.zero then 0
-               else ZZ.to_Z x # Z.to_pos (NN.to_Z y)
- end.
-
- Notation "[ x ]" := (to_Q x).
-
- Lemma N_to_Z_pos :
-  forall x, (NN.to_Z x <> NN.to_Z NN.zero)%Z -> (0 < NN.to_Z x)%Z.
- Proof.
- intros x; rewrite NN.spec_0; generalize (NN.spec_pos x). romega.
- Qed.
-
- Ltac destr_zcompare := case Z.compare_spec; intros ?H.
-
- Ltac destr_eqb :=
-  match goal with
-   | |- context [ZZ.eqb ?x ?y] =>
-     rewrite (ZZ.spec_eqb x y);
-     case (Z.eqb_spec (ZZ.to_Z x) (ZZ.to_Z y));
-     destr_eqb
-   | |- context [NN.eqb ?x ?y] =>
-     rewrite (NN.spec_eqb x y);
-     case (Z.eqb_spec (NN.to_Z x) (NN.to_Z y));
-     [ | let H:=fresh "H" in
-         try (intro H;generalize (N_to_Z_pos _ H); clear H)];
-     destr_eqb
-   | _ => idtac
-  end.
-
- Hint Rewrite
-  Z.add_0_r Z.add_0_l Z.mul_0_r Z.mul_0_l Z.mul_1_r Z.mul_1_l
-  ZZ.spec_0 NN.spec_0 ZZ.spec_1 NN.spec_1 ZZ.spec_m1 ZZ.spec_opp
-  ZZ.spec_compare NN.spec_compare
-  ZZ.spec_add NN.spec_add ZZ.spec_mul NN.spec_mul ZZ.spec_div NN.spec_div
-  ZZ.spec_gcd NN.spec_gcd Z.gcd_abs_l Z.gcd_1_r
-  spec_Z_of_N spec_Zabs_N
- : nz.
-
- Ltac nzsimpl := autorewrite with nz in *.
-
- Ltac qsimpl := try red; unfold to_Q; simpl; intros;
-  destr_eqb; simpl; nzsimpl; intros;
-  rewrite ?Z2Pos.id by auto;
-  auto.
-
- Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q.
- Proof.
- intros(x,y); destruct y; simpl; rewrite ?ZZ.spec_of_Z; auto;
-  destr_eqb; now rewrite ?NN.spec_0, ?NN.spec_of_N.
- Qed.
-
- Theorem spec_of_Q: forall q: Q, [of_Q q] == q.
- Proof.
- intros; rewrite strong_spec_of_Q; red; auto.
- Qed.
-
- Definition eq x y := [x] == [y].
-
- Definition zero: t := Qz ZZ.zero.
- Definition one: t := Qz ZZ.one.
- Definition minus_one: t := Qz ZZ.minus_one.
-
- Lemma spec_0: [zero] == 0.
- Proof.
- simpl. nzsimpl. reflexivity.
- Qed.
-
- Lemma spec_1: [one] == 1.
- Proof.
- simpl. nzsimpl. reflexivity.
- Qed.
-
- Lemma spec_m1: [minus_one] == -(1).
- Proof.
- simpl. nzsimpl. reflexivity.
- Qed.
-
- Definition compare (x y: t) :=
-  match x, y with
-  | Qz zx, Qz zy => ZZ.compare zx zy
-  | Qz zx, Qq ny dy =>
-    if NN.eqb dy NN.zero then ZZ.compare zx ZZ.zero
-    else ZZ.compare (ZZ.mul zx (Z_of_N dy)) ny
-  | Qq nx dx, Qz zy =>
-    if NN.eqb dx NN.zero then ZZ.compare ZZ.zero zy
-    else ZZ.compare nx (ZZ.mul zy (Z_of_N dx))
-  | Qq nx dx, Qq ny dy =>
-    match NN.eqb dx NN.zero, NN.eqb dy NN.zero with
-    | true, true => Eq
-    | true, false => ZZ.compare ZZ.zero ny
-    | false, true => ZZ.compare nx ZZ.zero
-    | false, false => ZZ.compare (ZZ.mul nx (Z_of_N dy))
-                                (ZZ.mul ny (Z_of_N dx))
-    end
-  end.
-
- Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]).
- Proof.
- intros [z1 | x1 y1] [z2 | x2 y2];
-   unfold Qcompare, compare; qsimpl.
- Qed.
-
- Definition lt n m := [n] < [m].
- Definition le n m := [n] <= [m].
-
- Definition min n m := match compare n m with Gt => m | _ => n end.
- Definition max n m := match compare n m with Lt => m | _ => n end.
-
- Lemma spec_min : forall n m, [min n m] == Qmin [n] [m].
- Proof.
- unfold min, Qmin, GenericMinMax.gmin. intros.
- rewrite spec_compare; destruct Qcompare; auto with qarith.
- Qed.
-
- Lemma spec_max : forall n m, [max n m] == Qmax [n] [m].
- Proof.
- unfold max, Qmax, GenericMinMax.gmax. intros.
- rewrite spec_compare; destruct Qcompare; auto with qarith.
- Qed.
-
- Definition eq_bool n m :=
-  match compare n m with Eq => true | _ => false end.
-
- Theorem spec_eq_bool: forall x y, eq_bool x y = Qeq_bool [x] [y].
- Proof.
- intros. unfold eq_bool. rewrite spec_compare. reflexivity.
- Qed.
-
- (** [check_int] : is a reduced fraction [n/d] in fact a integer ? *)
-
- Definition check_int n d :=
-  match NN.compare NN.one d with
-  | Lt => Qq n d
-  | Eq => Qz n
-  | Gt => zero  (* n/0 encodes 0 *)
-  end.
-
- Theorem strong_spec_check_int : forall n d, [check_int n d] = [Qq n d].
- Proof.
- intros; unfold check_int.
- nzsimpl.
- destr_zcompare.
- simpl. rewrite <- H; qsimpl. congruence.
- reflexivity.
- qsimpl. exfalso; romega.
- Qed.
-
- (** Normalisation function *)
-
- Definition norm n d : t :=
-  let gcd := NN.gcd (Zabs_N n) d in
-  match NN.compare NN.one gcd with
-  | Lt => check_int (ZZ.div n (Z_of_N gcd)) (NN.div d gcd)
-  | Eq => check_int n d
-  | Gt => zero (* gcd = 0 => both numbers are 0 *)
-  end.
-
- Theorem spec_norm: forall n q, [norm n q] == [Qq n q].
- Proof.
- intros p q; unfold norm.
- assert (Hp := NN.spec_pos (Zabs_N p)).
- assert (Hq := NN.spec_pos q).
- nzsimpl.
- destr_zcompare.
- (* Eq *)
- rewrite strong_spec_check_int; reflexivity.
- (* Lt *)
- rewrite strong_spec_check_int.
- qsimpl.
- generalize (Zgcd_div_pos (ZZ.to_Z p) (NN.to_Z q)). romega.
- replace (NN.to_Z q) with 0%Z in * by assumption.
- rewrite Zdiv_0_l in *; auto with zarith.
- apply Zgcd_div_swap0; romega.
- (* Gt *)
- qsimpl.
- assert (H' : Z.gcd (ZZ.to_Z p) (NN.to_Z q) = 0%Z).
-  generalize (Z.gcd_nonneg (ZZ.to_Z p) (NN.to_Z q)); romega.
- symmetry; apply (Z.gcd_eq_0_l _ _ H'); auto.
- Qed.
-
- Theorem strong_spec_norm : forall p q, [norm p q] = Qred [Qq p q].
- Proof.
- intros.
- replace (Qred [Qq p q]) with (Qred [norm p q]) by
-  (apply Qred_complete; apply spec_norm).
- symmetry; apply Qred_identity.
- unfold norm.
- assert (Hp := NN.spec_pos (Zabs_N p)).
- assert (Hq := NN.spec_pos q).
- nzsimpl.
- destr_zcompare; rewrite ?strong_spec_check_int.
- (* Eq *)
- qsimpl.
- (* Lt *)
- qsimpl.
- rewrite Zgcd_1_rel_prime.
- destruct (Z_lt_le_dec 0 (NN.to_Z q)).
- apply Zis_gcd_rel_prime; auto with zarith.
- apply Zgcd_is_gcd.
- replace (NN.to_Z q) with 0%Z in * by romega.
- rewrite Zdiv_0_l in *; romega.
- (* Gt *)
- simpl; auto with zarith.
- Qed.
-
- (** Reduction function : producing irreducible fractions *)
-
- Definition red (x : t) : t :=
-  match x with
-   | Qz z => x
-   | Qq n d => norm n d
-  end.
-
- Class Reduced x := is_reduced : [red x] = [x].
-
- Theorem spec_red : forall x, [red x] == [x].
- Proof.
- intros [ z | n d ].
- auto with qarith.
- unfold red.
- apply spec_norm.
- Qed.
-
- Theorem strong_spec_red : forall x, [red x] = Qred [x].
- Proof.
- intros [ z | n d ].
- unfold red.
- symmetry; apply Qred_identity; simpl; auto with zarith.
- unfold red; apply strong_spec_norm.
- Qed.
-
- Definition add (x y: t): t :=
-  match x with
-  | Qz zx =>
-    match y with
-    | Qz zy => Qz (ZZ.add zx zy)
-    | Qq ny dy =>
-      if NN.eqb dy NN.zero then x
-      else Qq (ZZ.add (ZZ.mul zx (Z_of_N dy)) ny) dy
-    end
-  | Qq nx dx =>
-    if NN.eqb dx NN.zero then y
-    else match y with
-    | Qz zy => Qq (ZZ.add nx (ZZ.mul zy (Z_of_N dx))) dx
-    | Qq ny dy =>
-      if NN.eqb dy NN.zero then x
-      else
-       let n := ZZ.add (ZZ.mul nx (Z_of_N dy)) (ZZ.mul ny (Z_of_N dx)) in
-       let d := NN.mul dx dy in
-       Qq n d
-    end
-  end.
-
- Theorem spec_add : forall x y, [add x y] == [x] + [y].
- Proof.
- intros [x | nx dx] [y | ny dy]; unfold Qplus; qsimpl;
-  auto with zarith.
- rewrite Pos.mul_1_r, Z2Pos.id; auto.
- rewrite Pos.mul_1_r, Z2Pos.id; auto.
- rewrite Z.mul_eq_0 in *; intuition.
- rewrite Pos2Z.inj_mul, 2 Z2Pos.id; auto.
- Qed.
-
- Definition add_norm (x y: t): t :=
-  match x with
-  | Qz zx =>
-    match y with
-    | Qz zy => Qz (ZZ.add zx zy)
-    | Qq ny dy =>
-      if NN.eqb dy NN.zero then x
-      else norm (ZZ.add (ZZ.mul zx (Z_of_N dy)) ny) dy
-    end
-  | Qq nx dx =>
-    if NN.eqb dx NN.zero then y
-    else match y with
-    | Qz zy => norm (ZZ.add nx (ZZ.mul zy (Z_of_N dx))) dx
-    | Qq ny dy =>
-      if NN.eqb dy NN.zero then x
-      else
-       let n := ZZ.add (ZZ.mul nx (Z_of_N dy)) (ZZ.mul ny (Z_of_N dx)) in
-       let d := NN.mul dx dy in
-       norm n d
-    end
-  end.
-
- Theorem spec_add_norm : forall x y, [add_norm x y] == [x] + [y].
- Proof.
- intros x y; rewrite <- spec_add.
- destruct x; destruct y; unfold add_norm, add;
- destr_eqb; auto using Qeq_refl, spec_norm.
- Qed.
-
- Instance strong_spec_add_norm x y
-   `(Reduced x, Reduced y) : Reduced (add_norm x y).
- Proof.
- unfold Reduced; intros.
- rewrite strong_spec_red.
- rewrite <- (Qred_complete [add x y]);
-  [ | rewrite spec_add, spec_add_norm; apply Qeq_refl ].
- rewrite <- strong_spec_red.
- destruct x as [zx|nx dx]; destruct y as [zy|ny dy];
-  simpl; destr_eqb; nzsimpl; simpl; auto.
- Qed.
-
- Definition opp (x: t): t :=
-  match x with
-  | Qz zx => Qz (ZZ.opp zx)
-  | Qq nx dx => Qq (ZZ.opp nx) dx
-  end.
-
- Theorem strong_spec_opp: forall q, [opp q] = -[q].
- Proof.
- intros [z | x y]; simpl.
- rewrite ZZ.spec_opp; auto.
- match goal with  |- context[NN.eqb ?X ?Y] =>
-  generalize (NN.spec_eqb X Y); case NN.eqb
- end; auto; rewrite NN.spec_0.
- rewrite ZZ.spec_opp; auto.
- Qed.
-
- Theorem spec_opp : forall q, [opp q] == -[q].
- Proof.
- intros; rewrite strong_spec_opp; red; auto.
- Qed.
-
- Instance strong_spec_opp_norm q `(Reduced q) : Reduced (opp q).
- Proof.
- unfold Reduced; intros.
- rewrite strong_spec_opp, <- H, !strong_spec_red, <- Qred_opp.
- apply Qred_complete; apply spec_opp.
- Qed.
-
- Definition sub x y := add x (opp y).
-
- Theorem spec_sub : forall x y, [sub x y] == [x] - [y].
- Proof.
- intros x y; unfold sub; rewrite spec_add; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Definition sub_norm x y := add_norm x (opp y).
-
- Theorem spec_sub_norm : forall x y, [sub_norm x y] == [x] - [y].
- Proof.
- intros x y; unfold sub_norm; rewrite spec_add_norm; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Instance strong_spec_sub_norm x y
-  `(Reduced x, Reduced y) : Reduced (sub_norm x y).
- Proof.
- intros.
- unfold sub_norm.
- apply strong_spec_add_norm; auto.
- apply strong_spec_opp_norm; auto.
- Qed.
-
- Definition mul (x y: t): t :=
-  match x, y with
-  | Qz zx, Qz zy => Qz (ZZ.mul zx zy)
-  | Qz zx, Qq ny dy => Qq (ZZ.mul zx ny) dy
-  | Qq nx dx, Qz zy => Qq (ZZ.mul nx zy) dx
-  | Qq nx dx, Qq ny dy => Qq (ZZ.mul nx ny) (NN.mul dx dy)
-  end.
-
- Ltac nsubst :=
-  match goal with E : NN.to_Z _ = _ |- _ => rewrite E in * end.
-
- Theorem spec_mul : forall x y, [mul x y] == [x] * [y].
- Proof.
- intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl; qsimpl.
- rewrite Pos.mul_1_r, Z2Pos.id; auto.
- rewrite Z.mul_eq_0 in *; intuition.
- nsubst; auto with zarith.
- nsubst; auto with zarith.
- nsubst; nzsimpl; auto with zarith.
- rewrite Pos2Z.inj_mul, 2 Z2Pos.id; auto.
- Qed.
-
- Definition norm_denum n d :=
-  if NN.eqb d NN.one then Qz n else Qq n d.
-
- Lemma spec_norm_denum : forall n d,
-  [norm_denum n d] == [Qq n d].
- Proof.
- unfold norm_denum; intros; simpl; qsimpl.
- congruence.
- nsubst; auto with zarith.
- Qed.
-
- Definition irred n d :=
-   let gcd := NN.gcd (Zabs_N n) d in
-   match NN.compare gcd NN.one with
-     | Gt => (ZZ.div n (Z_of_N gcd), NN.div d gcd)
-     | _ => (n, d)
-   end.
-
- Lemma spec_irred : forall n d, exists g,
-  let (n',d') := irred n d in
-  (ZZ.to_Z n' * g = ZZ.to_Z n)%Z /\ (NN.to_Z d' * g = NN.to_Z d)%Z.
- Proof.
- intros.
- unfold irred; nzsimpl; simpl.
- destr_zcompare.
- exists 1%Z; nzsimpl; auto.
- exists 0%Z; nzsimpl.
- assert (Z.gcd (ZZ.to_Z n) (NN.to_Z d) = 0%Z).
-  generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega.
- clear H.
- split.
- symmetry; apply (Z.gcd_eq_0_l _ _ H0).
- symmetry; apply (Z.gcd_eq_0_r _ _ H0).
- exists (Z.gcd (ZZ.to_Z n) (NN.to_Z d)).
- simpl.
- split.
- nzsimpl.
- destruct (Zgcd_is_gcd (ZZ.to_Z n) (NN.to_Z d)).
- rewrite Z.mul_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
- nzsimpl.
- destruct (Zgcd_is_gcd (ZZ.to_Z n) (NN.to_Z d)).
- rewrite Z.mul_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
- Qed.
-
- Lemma spec_irred_zero : forall n d,
-   (NN.to_Z d = 0)%Z <-> (NN.to_Z (snd (irred n d)) = 0)%Z.
- Proof.
- intros.
- unfold irred.
- split.
- nzsimpl; intros.
- destr_zcompare; auto.
- simpl.
- nzsimpl.
- rewrite H, Zdiv_0_l; auto.
- nzsimpl; destr_zcompare; simpl; auto.
- nzsimpl.
- intros.
- generalize (NN.spec_pos d); intros.
- destruct (NN.to_Z d); auto.
- assert (0 < 0)%Z.
-  rewrite <- H0 at 2.
-  apply Zgcd_div_pos; auto with zarith.
-  compute; auto.
- discriminate.
- compute in H1; elim H1; auto.
- Qed.
-
- Lemma strong_spec_irred : forall n d,
-  (NN.to_Z d <> 0%Z) ->
-  let (n',d') := irred n d in Z.gcd (ZZ.to_Z n') (NN.to_Z d') = 1%Z.
- Proof.
- unfold irred; intros.
- nzsimpl.
- destr_zcompare; simpl; auto.
- elim H.
- apply (Z.gcd_eq_0_r (ZZ.to_Z n)).
- generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega.
-
- nzsimpl.
- rewrite Zgcd_1_rel_prime.
- apply Zis_gcd_rel_prime.
- generalize (NN.spec_pos d); romega.
- generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega.
- apply Zgcd_is_gcd; auto.
- Qed.
-
- Definition mul_norm_Qz_Qq z n d :=
-   if ZZ.eqb z ZZ.zero then zero
-   else
-    let gcd := NN.gcd (Zabs_N z) d in
-    match NN.compare gcd NN.one with
-      | Gt =>
-        let z := ZZ.div z (Z_of_N gcd) in
-        let d := NN.div d gcd in
-        norm_denum (ZZ.mul z n) d
-      | _  => Qq (ZZ.mul z n) d
-    end.
-
- Definition mul_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (ZZ.mul zx zy)
- | Qz zx, Qq ny dy => mul_norm_Qz_Qq zx ny dy
- | Qq nx dx, Qz zy => mul_norm_Qz_Qq zy nx dx
- | Qq nx dx, Qq ny dy =>
-    let (nx, dy) := irred nx dy in
-    let (ny, dx) := irred ny dx in
-    norm_denum (ZZ.mul ny nx) (NN.mul dx dy)
- end.
-
- Lemma spec_mul_norm_Qz_Qq : forall z n d,
-   [mul_norm_Qz_Qq z n d] == [Qq (ZZ.mul z n) d].
- Proof.
- intros z n d; unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
- destr_eqb; nzsimpl; intros Hz.
- qsimpl; rewrite Hz; auto.
- destruct Z_le_gt_dec as [LE|GT].
- qsimpl.
- rewrite spec_norm_denum.
- qsimpl.
- rewrite Zdiv_gcd_zero in GT; auto with zarith.
- nsubst. rewrite Zdiv_0_l in *; discriminate.
- rewrite <- Z.mul_assoc, (Z.mul_comm (ZZ.to_Z n)), Z.mul_assoc.
- rewrite Zgcd_div_swap0; try romega.
- ring.
- Qed.
-
- Instance strong_spec_mul_norm_Qz_Qq z n d :
-   forall `(Reduced (Qq n d)), Reduced (mul_norm_Qz_Qq z n d).
- Proof.
- unfold Reduced.
- rewrite 2 strong_spec_red, 2 Qred_iff.
- simpl; nzsimpl.
- destr_eqb; intros Hd H; simpl in *; nzsimpl.
-
- unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
- destr_eqb; intros Hz; simpl; nzsimpl; simpl; auto.
- destruct Z_le_gt_dec.
- simpl; nzsimpl.
- destr_eqb; simpl; nzsimpl; auto with zarith.
- unfold norm_denum. destr_eqb; simpl; nzsimpl.
- rewrite Hd, Zdiv_0_l; discriminate.
- intros _.
- destr_eqb; simpl; nzsimpl; auto.
- nzsimpl; rewrite Hd, Zdiv_0_l; auto with zarith.
-
- rewrite Z2Pos.id in H; auto.
- unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
- destr_eqb; intros Hz; simpl; nzsimpl; simpl; auto.
- destruct Z_le_gt_dec as [H'|H'].
- simpl; nzsimpl.
- destr_eqb; simpl; nzsimpl; auto.
- intros.
- rewrite Z2Pos.id; auto.
- apply Zgcd_mult_rel_prime; auto.
-  generalize (Z.gcd_eq_0_l (ZZ.to_Z z) (NN.to_Z d))
-    (Z.gcd_nonneg (ZZ.to_Z z) (NN.to_Z d)); romega.
- destr_eqb; simpl; nzsimpl; auto.
- unfold norm_denum.
- destr_eqb; nzsimpl; simpl; destr_eqb; simpl; auto.
- intros; nzsimpl.
- rewrite Z2Pos.id; auto.
- apply Zgcd_mult_rel_prime.
- rewrite Zgcd_1_rel_prime.
- apply Zis_gcd_rel_prime.
- generalize (NN.spec_pos d); romega.
- generalize (Z.gcd_nonneg (ZZ.to_Z z) (NN.to_Z d)); romega.
- apply Zgcd_is_gcd.
- destruct (Zgcd_is_gcd (ZZ.to_Z z) (NN.to_Z d)) as [ (z0,Hz0) (d0,Hd0) Hzd].
- replace (NN.to_Z d / Z.gcd (ZZ.to_Z z) (NN.to_Z d))%Z with d0.
- rewrite Zgcd_1_rel_prime in *.
- apply bezout_rel_prime.
- destruct (rel_prime_bezout _ _ H) as [u v Huv].
- apply Bezout_intro with u (v*(Z.gcd (ZZ.to_Z z) (NN.to_Z d)))%Z.
- rewrite <- Huv; rewrite Hd0 at 2; ring.
- rewrite Hd0 at 1.
- symmetry; apply Z_div_mult_full; auto with zarith.
- Qed.
-
- Theorem spec_mul_norm : forall x y, [mul_norm x y] == [x] * [y].
- Proof.
- intros x y; rewrite <- spec_mul; auto.
- unfold mul_norm, mul; destruct x; destruct y.
- apply Qeq_refl.
- apply spec_mul_norm_Qz_Qq.
- rewrite spec_mul_norm_Qz_Qq; qsimpl; ring.
-
- rename t0 into nx, t3 into dy, t2 into ny, t1 into dx.
- destruct (spec_irred nx dy) as (g & Hg).
- destruct (spec_irred ny dx) as (g' & Hg').
- assert (Hz := spec_irred_zero nx dy).
- assert (Hz':= spec_irred_zero ny dx).
- destruct irred as (n1,d1); destruct irred as (n2,d2).
- simpl @snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
- rewrite spec_norm_denum.
- qsimpl.
-
- match goal with E : (_ * _ = 0)%Z |- _ =>
-  rewrite Z.mul_eq_0 in E; destruct E as [Eq|Eq] end.
- rewrite Eq in *; simpl in *.
- rewrite <- Hg2' in *; auto with zarith.
- rewrite Eq in *; simpl in *.
- rewrite <- Hg2 in *; auto with zarith.
-
- match goal with E : (_ * _ = 0)%Z |- _ =>
-  rewrite Z.mul_eq_0 in E; destruct E as [Eq|Eq] end.
- rewrite Hz' in Eq; rewrite Eq in *; auto with zarith.
- rewrite Hz in Eq; rewrite Eq in *; auto with zarith.
-
- rewrite <- Hg1, <- Hg2, <- Hg1', <- Hg2'; ring.
- Qed.
-
- Instance strong_spec_mul_norm x y :
-  forall `(Reduced x, Reduced y), Reduced (mul_norm x y).
- Proof.
- unfold Reduced; intros.
- rewrite strong_spec_red, Qred_iff.
- destruct x as [zx|nx dx]; destruct y as [zy|ny dy].
- simpl in *; auto with zarith.
- simpl.
- rewrite <- Qred_iff, <- strong_spec_red, strong_spec_mul_norm_Qz_Qq; auto.
- simpl.
- rewrite <- Qred_iff, <- strong_spec_red, strong_spec_mul_norm_Qz_Qq; auto.
- simpl.
- destruct (spec_irred nx dy) as [g Hg].
- destruct (spec_irred ny dx) as [g' Hg'].
- assert (Hz := spec_irred_zero nx dy).
- assert (Hz':= spec_irred_zero ny dx).
- assert (Hgc := strong_spec_irred nx dy).
- assert (Hgc' := strong_spec_irred ny dx).
- destruct irred as (n1,d1); destruct irred as (n2,d2).
- simpl @snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
-
- unfold norm_denum; qsimpl.
-
- assert (NEQ : NN.to_Z dy <> 0%Z) by
-  (rewrite Hz; intros EQ; rewrite EQ in *; romega).
- specialize (Hgc NEQ).
-
- assert (NEQ' : NN.to_Z dx <> 0%Z) by
-  (rewrite Hz'; intro EQ; rewrite EQ in *; romega).
- specialize (Hgc' NEQ').
-
- revert H H0.
- rewrite 2 strong_spec_red, 2 Qred_iff; simpl.
- destr_eqb; simpl; nzsimpl; try romega; intros.
- rewrite Z2Pos.id in *; auto.
-
- apply Zgcd_mult_rel_prime; rewrite Z.gcd_comm;
-  apply Zgcd_mult_rel_prime; rewrite Z.gcd_comm; auto.
-
- rewrite Zgcd_1_rel_prime in *.
- apply bezout_rel_prime.
- destruct (rel_prime_bezout (ZZ.to_Z ny) (NN.to_Z dy)) as [u v Huv]; trivial.
- apply Bezout_intro with (u*g')%Z (v*g)%Z.
- rewrite <- Huv, <- Hg1', <- Hg2. ring.
-
- rewrite Zgcd_1_rel_prime in *.
- apply bezout_rel_prime.
- destruct (rel_prime_bezout (ZZ.to_Z nx) (NN.to_Z dx)) as [u v Huv]; trivial.
- apply Bezout_intro with (u*g)%Z (v*g')%Z.
- rewrite <- Huv, <- Hg2', <- Hg1. ring.
- Qed.
-
- Definition inv (x: t): t :=
- match x with
- | Qz z =>
-   match ZZ.compare ZZ.zero z with
-     | Eq => zero
-     | Lt => Qq ZZ.one (Zabs_N z)
-     | Gt => Qq ZZ.minus_one (Zabs_N z)
-   end
- | Qq n d =>
-   match ZZ.compare ZZ.zero n with
-     | Eq => zero
-     | Lt => Qq (Z_of_N d) (Zabs_N n)
-     | Gt => Qq (ZZ.opp (Z_of_N d)) (Zabs_N n)
-   end
- end.
-
- Theorem spec_inv : forall x, [inv x] == /[x].
- Proof.
- destruct x as [ z | n d ].
- (* Qz z *)
- simpl.
- rewrite ZZ.spec_compare; destr_zcompare.
- (* 0 = z *)
- rewrite <- H.
- simpl; nzsimpl; compute; auto.
- (* 0 < z *)
- simpl.
- destr_eqb; nzsimpl; [ intros; rewrite Z.abs_eq in *; romega | intros _ ].
- set (z':=ZZ.to_Z z) in *; clearbody z'.
- red; simpl.
- rewrite Z.abs_eq by romega.
- rewrite Z2Pos.id by auto.
- unfold Qinv; simpl; destruct z'; simpl; auto; discriminate.
- (* 0 > z *)
- simpl.
- destr_eqb; nzsimpl; [ intros; rewrite Z.abs_neq in *; romega | intros _ ].
- set (z':=ZZ.to_Z z) in *; clearbody z'.
- red; simpl.
- rewrite Z.abs_neq by romega.
- rewrite Z2Pos.id by romega.
- unfold Qinv; simpl; destruct z'; simpl; auto; discriminate.
- (* Qq n d *)
- simpl.
- rewrite ZZ.spec_compare; destr_zcompare.
- (* 0 = n *)
- rewrite <- H.
- simpl; nzsimpl.
- destr_eqb; intros; compute; auto.
- (* 0 < n *)
- simpl.
- destr_eqb; nzsimpl; intros.
- intros; rewrite Z.abs_eq in *; romega.
- intros; rewrite Z.abs_eq in *; romega.
- nsubst; compute; auto.
- set (n':=ZZ.to_Z n) in *; clearbody n'.
- rewrite Z.abs_eq by romega.
- red; simpl.
- rewrite Z2Pos.id by auto.
- unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate.
- rewrite Pos2Z.inj_mul, Z2Pos.id; auto.
- (* 0 > n *)
- simpl.
- destr_eqb; nzsimpl; intros.
- intros; rewrite Z.abs_neq in *; romega.
- intros; rewrite Z.abs_neq in *; romega.
- nsubst; compute; auto.
- set (n':=ZZ.to_Z n) in *; clearbody n'.
- red; simpl; nzsimpl.
- rewrite Z.abs_neq by romega.
- rewrite Z2Pos.id by romega.
- unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate.
- assert (T : forall x, Zneg x = Z.opp (Zpos x)) by auto.
- rewrite T, Pos2Z.inj_mul, Z2Pos.id; auto; ring.
- Qed.
-
- Definition inv_norm (x: t): t :=
-   match x with
-     | Qz z =>
-       match ZZ.compare ZZ.zero z with
-         | Eq => zero
-         | Lt => Qq ZZ.one (Zabs_N z)
-         | Gt => Qq ZZ.minus_one (Zabs_N z)
-       end
-     | Qq n d =>
-       if NN.eqb d NN.zero then zero else
-       match ZZ.compare ZZ.zero n with
-         | Eq => zero
-         | Lt =>
-           match ZZ.compare n ZZ.one with
-             | Gt => Qq (Z_of_N d) (Zabs_N n)
-             | _ => Qz (Z_of_N d)
-           end
-         | Gt =>
-           match ZZ.compare n ZZ.minus_one with
-             | Lt => Qq (ZZ.opp (Z_of_N d)) (Zabs_N n)
-             | _ => Qz (ZZ.opp (Z_of_N d))
-           end
-       end
-   end.
-
- Theorem spec_inv_norm : forall x, [inv_norm x] == /[x].
- Proof.
- intros.
- rewrite <- spec_inv.
- destruct x as [ z | n d ].
- (* Qz z *)
- simpl.
- rewrite ZZ.spec_compare; destr_zcompare; auto with qarith.
- (* Qq n d *)
- simpl; nzsimpl; destr_eqb.
- destr_zcompare; simpl; auto with qarith.
- destr_eqb; nzsimpl; auto with qarith.
- intros _ Hd; rewrite Hd; auto with qarith.
- destr_eqb; nzsimpl; auto with qarith.
- intros _ Hd; rewrite Hd; auto with qarith.
- (* 0 < n *)
- destr_zcompare; auto with qarith.
- destr_zcompare; nzsimpl; simpl; auto with qarith; intros.
- destr_eqb; nzsimpl; [ intros; rewrite Z.abs_eq in *; romega | intros _ ].
- rewrite H0; auto with qarith.
- romega.
- (* 0 > n *)
- destr_zcompare; nzsimpl; simpl; auto with qarith.
- destr_eqb; nzsimpl; [ intros; rewrite Z.abs_neq in *; romega | intros _ ].
- rewrite H0; auto with qarith.
- romega.
- Qed.
-
- Instance strong_spec_inv_norm x : Reduced x -> Reduced (inv_norm x).
- Proof.
- unfold Reduced.
- intros.
- destruct x as [ z | n d ].
- (* Qz *)
- simpl; nzsimpl.
- rewrite strong_spec_red, Qred_iff.
- destr_zcompare; simpl; nzsimpl; auto.
- destr_eqb; nzsimpl; simpl; auto.
- destr_eqb; nzsimpl; simpl; auto.
- (* Qq n d *)
- rewrite strong_spec_red, Qred_iff in H; revert H.
- simpl; nzsimpl.
- destr_eqb; nzsimpl; auto with qarith.
- destr_zcompare; simpl; nzsimpl; auto; intros.
- (* 0 < n *)
- destr_zcompare; simpl; nzsimpl; auto.
- destr_eqb; nzsimpl; simpl; auto.
- rewrite Z.abs_eq; romega.
- intros _.
- rewrite strong_spec_norm; simpl; nzsimpl.
- destr_eqb; nzsimpl.
- rewrite Z.abs_eq; romega.
- intros _.
- rewrite Qred_iff.
- simpl.
- rewrite Z.abs_eq; auto with zarith.
- rewrite Z2Pos.id in *; auto.
- rewrite Z.gcd_comm; auto.
- (* 0 > n *)
- destr_eqb; nzsimpl; simpl; auto; intros.
- destr_zcompare; simpl; nzsimpl; auto.
- destr_eqb; nzsimpl.
- rewrite Z.abs_neq; romega.
- intros _.
- rewrite strong_spec_norm; simpl; nzsimpl.
- destr_eqb; nzsimpl.
- rewrite Z.abs_neq; romega.
- intros _.
- rewrite Qred_iff.
- simpl.
- rewrite Z2Pos.id in *; auto.
- intros.
- rewrite Z.gcd_comm, Z.gcd_abs_l, Z.gcd_comm.
- apply Zis_gcd_gcd; auto with zarith.
- apply Zis_gcd_minus.
- rewrite Z.opp_involutive, <- H1; apply Zgcd_is_gcd.
- rewrite Z.abs_neq; romega.
- Qed.
-
- Definition div x y := mul x (inv y).
-
- Theorem spec_div x y: [div x y] == [x] / [y].
- Proof.
- unfold div; rewrite spec_mul; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Definition div_norm x y := mul_norm x (inv_norm y).
-
- Theorem spec_div_norm x y: [div_norm x y] == [x] / [y].
- Proof.
- unfold div_norm; rewrite spec_mul_norm; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv_norm; auto.
- Qed.
-
- Instance strong_spec_div_norm x y
-   `(Reduced x, Reduced y) : Reduced (div_norm x y).
- Proof.
- intros; unfold div_norm.
- apply strong_spec_mul_norm; auto.
- apply strong_spec_inv_norm; auto.
- Qed.
-
- Definition square (x: t): t :=
-  match x with
-  | Qz zx => Qz (ZZ.square zx)
-  | Qq nx dx => Qq (ZZ.square nx) (NN.square dx)
-  end.
-
- Theorem spec_square : forall x, [square x] == [x] ^ 2.
- Proof.
- destruct x as [ z | n d ].
- simpl; rewrite ZZ.spec_square; red; auto.
- simpl.
- destr_eqb; nzsimpl; intros.
- apply Qeq_refl.
- rewrite NN.spec_square in *; nzsimpl.
- rewrite Z.mul_eq_0 in *; romega.
- rewrite NN.spec_square in *; nzsimpl; nsubst; romega.
- rewrite ZZ.spec_square, NN.spec_square.
- red; simpl.
- rewrite Pos2Z.inj_mul; rewrite !Z2Pos.id; auto.
- apply Z.mul_pos_pos; auto.
- Qed.
-
- Definition power_pos (x : t) p : t :=
-  match x with
-  | Qz zx => Qz (ZZ.pow_pos zx p)
-  | Qq nx dx => Qq (ZZ.pow_pos nx p) (NN.pow_pos dx p)
-  end.
-
- Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p.
- Proof.
- intros [ z | n d ] p; unfold power_pos.
- (* Qz *)
- simpl.
- rewrite ZZ.spec_pow_pos, Qpower_decomp.
- red; simpl; f_equal.
- now rewrite Pos2Z.inj_pow, Z.pow_1_l.
- (* Qq *)
- simpl.
- rewrite ZZ.spec_pow_pos.
- destr_eqb; nzsimpl; intros.
- - apply Qeq_sym; apply Qpower_positive_0.
- - rewrite NN.spec_pow_pos in *.
-   assert (0 < NN.to_Z d ^ ' p)%Z by
-    (apply Z.pow_pos_nonneg; auto with zarith).
-   romega.
- - exfalso.
-   rewrite NN.spec_pow_pos in *. nsubst.
-   rewrite Z.pow_0_l' in *; [romega|discriminate].
- - rewrite Qpower_decomp.
-   red; simpl; do 3 f_equal.
-   apply Pos2Z.inj. rewrite Pos2Z.inj_pow.
-   rewrite 2 Z2Pos.id by (generalize (NN.spec_pos d); romega).
-   now rewrite NN.spec_pow_pos.
- Qed.
-
- Instance strong_spec_power_pos x p `(Reduced x) : Reduced (power_pos x p).
- Proof.
- destruct x as [z | n d]; simpl; intros.
- red; simpl; auto.
- red; simpl; intros.
- rewrite strong_spec_norm; simpl.
- destr_eqb; nzsimpl; intros.
- simpl; auto.
- rewrite Qred_iff.
- revert H.
- unfold Reduced; rewrite strong_spec_red, Qred_iff; simpl.
- destr_eqb; nzsimpl; simpl; intros.
- exfalso.
- rewrite NN.spec_pow_pos in *. nsubst.
- rewrite Z.pow_0_l' in *; [romega|discriminate].
- rewrite Z2Pos.id in *; auto.
- rewrite NN.spec_pow_pos, ZZ.spec_pow_pos; auto.
- rewrite Zgcd_1_rel_prime in *.
- apply rel_prime_Zpower; auto with zarith.
- Qed.
-
- Definition power (x : t) (z : Z) : t :=
-   match z with
-     | Z0 => one
-     | Zpos p => power_pos x p
-     | Zneg p => inv (power_pos x p)
-   end.
-
- Theorem spec_power : forall x z, [power x z] == [x]^z.
- Proof.
- destruct z.
- simpl; nzsimpl; red; auto.
- apply spec_power_pos.
- simpl.
- rewrite spec_inv, spec_power_pos; apply Qeq_refl.
- Qed.
-
- Definition power_norm (x : t) (z : Z) : t :=
-   match z with
-     | Z0 => one
-     | Zpos p => power_pos x p
-     | Zneg p => inv_norm (power_pos x p)
-   end.
-
- Theorem spec_power_norm : forall x z, [power_norm x z] == [x]^z.
- Proof.
- destruct z.
- simpl; nzsimpl; red; auto.
- apply spec_power_pos.
- simpl.
- rewrite spec_inv_norm, spec_power_pos; apply Qeq_refl.
- Qed.
-
- Instance strong_spec_power_norm x z :
-   Reduced x -> Reduced (power_norm x z).
- Proof.
- destruct z; simpl.
- intros _; unfold Reduced; rewrite strong_spec_red.
- unfold one.
- simpl to_Q; nzsimpl; auto.
- intros; apply strong_spec_power_pos; auto.
- intros; apply strong_spec_inv_norm; apply strong_spec_power_pos; auto.
- Qed.
-
-
- (** Interaction with [Qcanon.Qc] *)
-
- Open Scope Qc_scope.
-
- Definition of_Qc q := of_Q (this q).
-
- Definition to_Qc q := Q2Qc [q].
-
- Notation "[[ x ]]" := (to_Qc x).
-
- Theorem strong_spec_of_Qc : forall q, [of_Qc q] = q.
- Proof.
- intros (q,Hq); intros.
- unfold of_Qc; rewrite strong_spec_of_Q; auto.
- Qed.
-
- Instance strong_spec_of_Qc_bis q : Reduced (of_Qc q).
- Proof.
- intros; red; rewrite strong_spec_red, strong_spec_of_Qc.
- destruct q; simpl; auto.
- Qed.
-
- Theorem spec_of_Qc: forall q, [[of_Qc q]] = q.
- Proof.
- intros; apply Qc_decomp; simpl; intros.
- rewrite strong_spec_of_Qc. apply canon.
- Qed.
-
- Theorem spec_oppc: forall q, [[opp q]] = -[[q]].
- Proof.
- intros q; unfold Qcopp, to_Qc, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- rewrite spec_opp, <- Qred_opp, Qred_correct.
- apply Qeq_refl.
- Qed.
-
- Theorem spec_oppc_bis : forall q : Qc, [opp (of_Qc q)] = - q.
- Proof.
- intros.
- rewrite <- strong_spec_opp_norm by apply strong_spec_of_Qc_bis.
- rewrite strong_spec_red.
- symmetry; apply (Qred_complete (-q)%Q).
- rewrite spec_opp, strong_spec_of_Qc; auto with qarith.
- Qed.
-
- Theorem spec_comparec: forall q1 q2,
-  compare q1 q2 = ([[q1]] ?= [[q2]]).
- Proof.
- unfold Qccompare, to_Qc.
- intros q1 q2; rewrite spec_compare; simpl; auto.
- apply Qcompare_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_addc x y:
-  [[add x y]] = [[x]] + [[y]].
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_add; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_add_normc x y:
-  [[add_norm x y]] = [[x]] + [[y]].
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_add_norm; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_add_normc_bis : forall x y : Qc,
-   [add_norm (of_Qc x) (of_Qc y)] = x+y.
- Proof.
- intros.
- rewrite <- strong_spec_add_norm by apply strong_spec_of_Qc_bis.
- rewrite strong_spec_red.
- symmetry; apply (Qred_complete (x+y)%Q).
- rewrite spec_add_norm, ! strong_spec_of_Qc; auto with qarith.
- Qed.
-
- Theorem spec_subc x y:  [[sub x y]] = [[x]] - [[y]].
- Proof.
- unfold sub; rewrite spec_addc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Theorem spec_sub_normc x y:
-   [[sub_norm x y]] = [[x]] - [[y]].
- Proof.
- unfold sub_norm; rewrite spec_add_normc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Theorem spec_sub_normc_bis : forall x y : Qc,
-   [sub_norm (of_Qc x) (of_Qc y)] = x-y.
- Proof.
- intros.
- rewrite <- strong_spec_sub_norm by apply strong_spec_of_Qc_bis.
- rewrite strong_spec_red.
- symmetry; apply (Qred_complete (x+(-y)%Qc)%Q).
- rewrite spec_sub_norm, ! strong_spec_of_Qc.
- unfold Qcopp, Q2Qc, this. rewrite Qred_correct ; auto with qarith.
- Qed.
-
- Theorem spec_mulc x y:
-  [[mul x y]] = [[x]] * [[y]].
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_mul; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_mul_normc x y:
-   [[mul_norm x y]] = [[x]] * [[y]].
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_mul_norm; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_mul_normc_bis : forall x y : Qc,
-   [mul_norm (of_Qc x) (of_Qc y)] = x*y.
- Proof.
- intros.
- rewrite <- strong_spec_mul_norm by apply strong_spec_of_Qc_bis.
- rewrite strong_spec_red.
- symmetry; apply (Qred_complete (x*y)%Q).
- rewrite spec_mul_norm, ! strong_spec_of_Qc; auto with qarith.
- Qed.
-
- Theorem spec_invc x:
-   [[inv x]] =  /[[x]].
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_inv; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_inv_normc x:
-   [[inv_norm x]] =  /[[x]].
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_inv_norm; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_inv_normc_bis : forall x : Qc,
-   [inv_norm (of_Qc x)] = /x.
- Proof.
- intros.
- rewrite <- strong_spec_inv_norm by apply strong_spec_of_Qc_bis.
- rewrite strong_spec_red.
- symmetry; apply (Qred_complete (/x)%Q).
- rewrite spec_inv_norm, ! strong_spec_of_Qc; auto with qarith.
- Qed.
-
- Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]].
- Proof.
- unfold div; rewrite spec_mulc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
- Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]].
- Proof.
- unfold div_norm; rewrite spec_mul_normc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_inv_normc; auto.
- Qed.
-
- Theorem spec_div_normc_bis : forall x y : Qc,
-   [div_norm (of_Qc x) (of_Qc y)] = x/y.
- Proof.
- intros.
- rewrite <- strong_spec_div_norm by apply strong_spec_of_Qc_bis.
- rewrite strong_spec_red.
- symmetry; apply (Qred_complete (x*(/y)%Qc)%Q).
- rewrite spec_div_norm, ! strong_spec_of_Qc.
- unfold Qcinv, Q2Qc, this; rewrite Qred_correct; auto with qarith.
- Qed.
-
- Theorem spec_squarec x: [[square x]] = [[x]]^2.
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc ([x]^2)).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_square; auto.
- simpl Qcpower.
- replace (Q2Qc [x] * 1) with (Q2Qc [x]); try ring.
- simpl.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_power_posc x p:
-   [[power_pos x p]] = [[x]] ^ Pos.to_nat p.
- Proof.
- unfold to_Qc.
- transitivity (Q2Qc ([x]^Zpos p)).
- unfold Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete; apply spec_power_pos; auto.
- induction p using Pos.peano_ind.
- simpl; ring.
- rewrite Pos2Nat.inj_succ; simpl Qcpower.
- rewrite <- IHp; clear IHp.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; unfold this.
- apply Qred_complete.
- setoid_replace ([x] ^ ' Pos.succ p)%Q with ([x] * [x] ^ ' p)%Q.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- simpl.
- rewrite <- Pos.add_1_l.
- rewrite Qpower_plus_positive; simpl; apply Qeq_refl.
- Qed.
-
-End Make.
diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v
deleted file mode 100644
index 8e20fd06..00000000
--- a/theories/Numbers/Rational/SpecViaQ/QSig.v
+++ /dev/null
@@ -1,229 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import QArith Qpower Qminmax Orders RelationPairs GenericMinMax.
-
-Open Scope Q_scope.
-
-(** * QSig *)
-
-(** Interface of a rich structure about rational numbers.
-    Specifications are written via translation to Q.
-*)
-
-Module Type QType.
-
- Parameter t : Type.
-
- Parameter to_Q : t -> Q.
- Local Notation "[ x ]" := (to_Q x).
-
- Definition eq x y := [x] == [y].
- Definition lt x y := [x] < [y].
- Definition le x y := [x] <= [y].
-
- Parameter of_Q : Q -> t.
- Parameter spec_of_Q: forall x, to_Q (of_Q x) == x.
-
- Parameter red : t -> t.
- Parameter compare : t -> t -> comparison.
- Parameter eq_bool : t -> t -> bool.
- Parameter max : t -> t -> t.
- Parameter min : t -> t -> t.
- Parameter zero : t.
- Parameter one : t.
- Parameter minus_one : t.
- Parameter add : t -> t -> t.
- Parameter sub : t -> t -> t.
- Parameter opp : t -> t.
- Parameter mul : t -> t -> t.
- Parameter square : t -> t.
- Parameter inv : t -> t.
- Parameter div : t -> t -> t.
- Parameter power : t -> Z -> t.
-
- Parameter spec_red : forall x, [red x] == [x].
- Parameter strong_spec_red : forall x, [red x] = Qred [x].
- Parameter spec_compare : forall x y, compare x y = ([x] ?= [y]).
- Parameter spec_eq_bool : forall x y, eq_bool x y = Qeq_bool [x] [y].
- Parameter spec_max : forall x y, [max x y] == Qmax [x] [y].
- Parameter spec_min : forall x y, [min x y] == Qmin [x] [y].
- Parameter spec_0: [zero] == 0.
- Parameter spec_1: [one] == 1.
- Parameter spec_m1: [minus_one] == -(1).
- Parameter spec_add: forall x y, [add x y] == [x] + [y].
- Parameter spec_sub: forall x y, [sub x y] == [x] - [y].
- Parameter spec_opp: forall x, [opp x] == - [x].
- Parameter spec_mul: forall x y, [mul x y] == [x] * [y].
- Parameter spec_square: forall x, [square x] == [x] ^ 2.
- Parameter spec_inv : forall x, [inv x] == / [x].
- Parameter spec_div: forall x y, [div x y] == [x] / [y].
- Parameter spec_power: forall x z, [power x z] == [x] ^ z.
-
-End QType.
-
-(** NB: several of the above functions come with [..._norm] variants
-     that expect reduced arguments and return reduced results. *)
-
-(** TODO : also speak of specifications via Qcanon ... *)
-
-Module Type QType_Notation (Import Q : QType).
- Notation "[ x ]" := (to_Q x).
- Infix "=="  := eq (at level 70).
- Notation "x != y" := (~x==y) (at level 70).
- Infix "<=" := le.
- Infix "<" := lt.
- Notation "0" := zero.
- Notation "1" := one.
- Infix "+" := add.
- Infix "-" := sub.
- Infix "*" := mul.
- Notation "- x" := (opp x).
- Infix "/" := div.
- Notation "/ x" := (inv x).
- Infix "^" := power.
-End QType_Notation.
-
-Module Type QType' := QType <+ QType_Notation.
-
-
-Module QProperties (Import Q : QType').
-
-(** Conversion to Q *)
-
-Hint Rewrite
- spec_red spec_compare spec_eq_bool spec_min spec_max
- spec_add spec_sub spec_opp spec_mul spec_square spec_inv spec_div
- spec_power : qsimpl.
-Ltac qify := unfold eq, lt, le in *; autorewrite with qsimpl;
- try rewrite spec_0 in *; try rewrite spec_1 in *; try rewrite spec_m1 in *.
-
-(** NB: do not add [spec_0] in the autorewrite database. Otherwise,
-    after instantiation in BigQ, this lemma become convertible to 0=0,
-    and autorewrite loops. Idem for [spec_1] and [spec_m1] *)
-
-(** Morphisms *)
-
-Ltac solve_wd1 := intros x x' Hx; qify; now rewrite Hx.
-Ltac solve_wd2 := intros x x' Hx y y' Hy; qify; now rewrite Hx, Hy.
-
-Local Obligation Tactic := solve_wd2 || solve_wd1.
-
-Instance : Measure to_Q.
-Instance eq_equiv : Equivalence eq.
-Proof.
-  change eq with (RelCompFun Qeq to_Q); apply _.
-Defined.
-
-Program Instance lt_wd : Proper (eq==>eq==>iff) lt.
-Program Instance le_wd : Proper (eq==>eq==>iff) le.
-Program Instance red_wd : Proper (eq==>eq) red.
-Program Instance compare_wd : Proper (eq==>eq==>Logic.eq) compare.
-Program Instance eq_bool_wd : Proper (eq==>eq==>Logic.eq) eq_bool.
-Program Instance min_wd : Proper (eq==>eq==>eq) min.
-Program Instance max_wd : Proper (eq==>eq==>eq) max.
-Program Instance add_wd : Proper (eq==>eq==>eq) add.
-Program Instance sub_wd : Proper (eq==>eq==>eq) sub.
-Program Instance opp_wd : Proper (eq==>eq) opp.
-Program Instance mul_wd : Proper (eq==>eq==>eq) mul.
-Program Instance square_wd : Proper (eq==>eq) square.
-Program Instance inv_wd : Proper (eq==>eq) inv.
-Program Instance div_wd : Proper (eq==>eq==>eq) div.
-Program Instance power_wd : Proper (eq==>Logic.eq==>eq) power.
-
-(** Let's implement [HasCompare] *)
-
-Lemma compare_spec : forall x y, CompareSpec (x==y) (x<y) (y<x) (compare x y).
-Proof. intros. qify. destruct (Qcompare_spec [x] [y]); auto. Qed.
-
-(** Let's implement [TotalOrder] *)
-
-Definition lt_compat := lt_wd.
-Instance lt_strorder : StrictOrder lt.
-Proof.
-  change lt with (RelCompFun Qlt to_Q); apply _.
-Qed.
-
-Lemma le_lteq : forall x y, x<=y <-> x<y \/ x==y.
-Proof. intros. qify. apply Qle_lteq. Qed.
-
-Lemma lt_total : forall x y, x<y \/ x==y \/ y<x.
-Proof. intros. destruct (compare_spec x y); auto. Qed.
-
-(** Let's implement [HasEqBool] *)
-
-Definition eqb := eq_bool.
-
-Lemma eqb_eq : forall x y, eq_bool x y = true <-> x == y.
-Proof. intros. qify. apply Qeq_bool_iff. Qed.
-
-Lemma eqb_correct : forall x y, eq_bool x y = true -> x == y.
-Proof. now apply eqb_eq. Qed.
-
-Lemma eqb_complete : forall x y, x == y -> eq_bool x y = true.
-Proof. now apply eqb_eq. Qed.
-
-(** Let's implement [HasMinMax] *)
-
-Lemma max_l : forall x y, y<=x -> max x y == x.
-Proof. intros x y. qify. apply Qminmax.Q.max_l. Qed.
-
-Lemma max_r : forall x y, x<=y -> max x y == y.
-Proof. intros x y. qify. apply Qminmax.Q.max_r. Qed.
-
-Lemma min_l : forall x y, x<=y -> min x y == x.
-Proof. intros x y. qify. apply Qminmax.Q.min_l. Qed.
-
-Lemma min_r : forall x y, y<=x -> min x y == y.
-Proof. intros x y. qify. apply Qminmax.Q.min_r. Qed.
-
-(** Q is a ring *)
-
-Lemma add_0_l : forall x, 0+x == x.
-Proof. intros. qify. apply Qplus_0_l. Qed.
-
-Lemma add_comm : forall x y, x+y == y+x.
-Proof. intros. qify. apply Qplus_comm. Qed.
-
-Lemma add_assoc : forall x y z, x+(y+z) == x+y+z.
-Proof. intros. qify. apply Qplus_assoc. Qed.
-
-Lemma mul_1_l : forall x, 1*x == x.
-Proof. intros. qify. apply Qmult_1_l. Qed.
-
-Lemma mul_comm : forall x y, x*y == y*x.
-Proof. intros. qify. apply Qmult_comm. Qed.
-
-Lemma mul_assoc : forall x y z, x*(y*z) == x*y*z.
-Proof. intros. qify. apply Qmult_assoc. Qed.
-
-Lemma mul_add_distr_r : forall x y z, (x+y)*z == x*z + y*z.
-Proof. intros. qify. apply Qmult_plus_distr_l. Qed.
-
-Lemma sub_add_opp : forall x y, x-y == x+(-y).
-Proof. intros. qify. now unfold Qminus. Qed.
-
-Lemma add_opp_diag_r : forall x, x+(-x) == 0.
-Proof. intros. qify. apply Qplus_opp_r. Qed.
-
-(** Q is a field *)
-
-Lemma neq_1_0 : 1!=0.
-Proof. intros. qify. apply Q_apart_0_1. Qed.
-
-Lemma div_mul_inv : forall x y, x/y == x*(/y).
-Proof. intros. qify. now unfold Qdiv. Qed.
-
-Lemma mul_inv_diag_l : forall x, x!=0 -> /x * x == 1.
-Proof. intros x. qify. rewrite Qmult_comm. apply Qmult_inv_r. Qed.
-
-End QProperties.
-
-Module QTypeExt (Q : QType)
- <: QType <: TotalOrder <: HasCompare Q <: HasMinMax Q <: HasEqBool Q
- := Q <+ QProperties.
diff --git a/theories/Numbers/vo.itarget b/theories/Numbers/vo.itarget
deleted file mode 100644
index c69af03f..00000000
--- a/theories/Numbers/vo.itarget
+++ /dev/null
@@ -1,91 +0,0 @@
-BinNums.vo
-BigNumPrelude.vo
-Cyclic/Abstract/CyclicAxioms.vo
-Cyclic/Abstract/NZCyclic.vo
-Cyclic/DoubleCyclic/DoubleAdd.vo
-Cyclic/DoubleCyclic/DoubleBase.vo
-Cyclic/DoubleCyclic/DoubleCyclic.vo
-Cyclic/DoubleCyclic/DoubleDivn1.vo
-Cyclic/DoubleCyclic/DoubleDiv.vo
-Cyclic/DoubleCyclic/DoubleLift.vo
-Cyclic/DoubleCyclic/DoubleMul.vo
-Cyclic/DoubleCyclic/DoubleSqrt.vo
-Cyclic/DoubleCyclic/DoubleSub.vo
-Cyclic/DoubleCyclic/DoubleType.vo
-Cyclic/Int31/Int31.vo
-Cyclic/Int31/Cyclic31.vo
-Cyclic/Int31/Ring31.vo
-Cyclic/ZModulo/ZModulo.vo
-Integer/Abstract/ZAddOrder.vo
-Integer/Abstract/ZAdd.vo
-Integer/Abstract/ZAxioms.vo
-Integer/Abstract/ZBase.vo
-Integer/Abstract/ZLt.vo
-Integer/Abstract/ZMulOrder.vo
-Integer/Abstract/ZMul.vo
-Integer/Abstract/ZSgnAbs.vo
-Integer/Abstract/ZDivFloor.vo
-Integer/Abstract/ZDivTrunc.vo
-Integer/Abstract/ZDivEucl.vo
-Integer/Abstract/ZMaxMin.vo
-Integer/Abstract/ZParity.vo
-Integer/Abstract/ZPow.vo
-Integer/Abstract/ZGcd.vo
-Integer/Abstract/ZLcm.vo
-Integer/Abstract/ZBits.vo
-Integer/Abstract/ZProperties.vo
-Integer/BigZ/BigZ.vo
-Integer/BigZ/ZMake.vo
-Integer/Binary/ZBinary.vo
-Integer/NatPairs/ZNatPairs.vo
-Integer/SpecViaZ/ZSig.vo
-Integer/SpecViaZ/ZSigZAxioms.vo
-NaryFunctions.vo
-NatInt/NZAddOrder.vo
-NatInt/NZAdd.vo
-NatInt/NZAxioms.vo
-NatInt/NZBase.vo
-NatInt/NZMulOrder.vo
-NatInt/NZMul.vo
-NatInt/NZOrder.vo
-NatInt/NZProperties.vo
-NatInt/NZDomain.vo
-NatInt/NZParity.vo
-NatInt/NZDiv.vo
-NatInt/NZPow.vo
-NatInt/NZSqrt.vo
-NatInt/NZLog.vo
-NatInt/NZGcd.vo
-NatInt/NZBits.vo
-Natural/Abstract/NAddOrder.vo
-Natural/Abstract/NAdd.vo
-Natural/Abstract/NAxioms.vo
-Natural/Abstract/NBase.vo
-Natural/Abstract/NDefOps.vo
-Natural/Abstract/NIso.vo
-Natural/Abstract/NMulOrder.vo
-Natural/Abstract/NOrder.vo
-Natural/Abstract/NStrongRec.vo
-Natural/Abstract/NSub.vo
-Natural/Abstract/NProperties.vo
-Natural/Abstract/NDiv.vo
-Natural/Abstract/NMaxMin.vo
-Natural/Abstract/NParity.vo
-Natural/Abstract/NPow.vo
-Natural/Abstract/NSqrt.vo
-Natural/Abstract/NLog.vo
-Natural/Abstract/NGcd.vo
-Natural/Abstract/NLcm.vo
-Natural/Abstract/NBits.vo
-Natural/BigN/BigN.vo
-Natural/BigN/Nbasic.vo
-Natural/BigN/NMake_gen.vo
-Natural/BigN/NMake.vo
-Natural/Binary/NBinary.vo
-Natural/Peano/NPeano.vo
-Natural/SpecViaZ/NSigNAxioms.vo
-Natural/SpecViaZ/NSig.vo
-NumPrelude.vo
-Rational/BigQ/BigQ.vo
-Rational/BigQ/QMake.vo
-Rational/SpecViaQ/QSig.vo
diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v
index 7baf102a..000d895e 100644
--- a/theories/PArith/BinPos.v
+++ b/theories/PArith/BinPos.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export BinNums.
@@ -813,6 +815,34 @@ Proof.
   rewrite compare_cont_spec. unfold ge. destruct (p ?= q); easy'.
 Qed.
 
+Lemma compare_cont_Lt_not_Lt p q :
+  compare_cont Lt p q <> Lt <-> p > q.
+Proof.
+  rewrite compare_cont_Lt_Lt.
+  unfold gt, le, compare.
+  now destruct compare_cont; split; try apply comparison_eq_stable.
+Qed.
+
+Lemma compare_cont_Lt_not_Gt p q :
+  compare_cont Lt p q <> Gt <-> p <= q.
+Proof.
+  apply not_iff_compat, compare_cont_Lt_Gt.
+Qed.
+
+Lemma compare_cont_Gt_not_Lt p q :
+  compare_cont Gt p q <> Lt <-> p >= q.
+Proof.
+  apply not_iff_compat, compare_cont_Gt_Lt.
+Qed.
+
+Lemma compare_cont_Gt_not_Gt p q :
+  compare_cont Gt p q <> Gt <-> p < q.
+Proof.
+  rewrite compare_cont_Gt_Gt.
+  unfold ge, lt, compare.
+  now destruct compare_cont; split; try apply comparison_eq_stable.
+Qed.
+
 (** We can express recursive equations for [compare] *)
 
 Lemma compare_xO_xO p q : (p~0 ?= q~0) = (p ?= q).
@@ -1625,7 +1655,7 @@ Qed.
 
 Lemma sqrtrem_spec p : SqrtSpec (sqrtrem p) p.
 Proof.
-revert p. fix 1.
+revert p. fix sqrtrem_spec 1.
  destruct p; try destruct p; try (constructor; easy);
   apply sqrtrem_step_spec; auto.
 Qed.
@@ -1875,180 +1905,180 @@ Notation IsNul := Pos.IsNul (only parsing).
 Notation IsPos := Pos.IsPos (only parsing).
 Notation IsNeg := Pos.IsNeg (only parsing).
 
-Notation Psucc := Pos.succ (compat "8.3").
-Notation Pplus := Pos.add (compat "8.3").
-Notation Pplus_carry := Pos.add_carry (compat "8.3").
-Notation Ppred := Pos.pred (compat "8.3").
-Notation Piter_op := Pos.iter_op (compat "8.3").
-Notation Piter_op_succ := Pos.iter_op_succ (compat "8.3").
-Notation Pmult_nat := (Pos.iter_op plus) (compat "8.3").
-Notation nat_of_P := Pos.to_nat (compat "8.3").
-Notation P_of_succ_nat := Pos.of_succ_nat (compat "8.3").
-Notation Pdouble_minus_one := Pos.pred_double (compat "8.3").
-Notation positive_mask := Pos.mask (compat "8.3").
-Notation positive_mask_rect := Pos.mask_rect (compat "8.3").
-Notation positive_mask_ind := Pos.mask_ind (compat "8.3").
-Notation positive_mask_rec := Pos.mask_rec (compat "8.3").
-Notation Pdouble_plus_one_mask := Pos.succ_double_mask (compat "8.3").
-Notation Pdouble_mask := Pos.double_mask (compat "8.3").
-Notation Pdouble_minus_two := Pos.double_pred_mask (compat "8.3").
-Notation Pminus_mask := Pos.sub_mask (compat "8.3").
-Notation Pminus_mask_carry := Pos.sub_mask_carry (compat "8.3").
-Notation Pminus := Pos.sub (compat "8.3").
-Notation Pmult := Pos.mul (compat "8.3").
-Notation iter_pos := @Pos.iter (compat "8.3").
-Notation Ppow := Pos.pow (compat "8.3").
-Notation Pdiv2 := Pos.div2 (compat "8.3").
-Notation Pdiv2_up := Pos.div2_up (compat "8.3").
-Notation Psize := Pos.size_nat (compat "8.3").
-Notation Psize_pos := Pos.size (compat "8.3").
-Notation Pcompare x y m := (Pos.compare_cont m x y) (compat "8.3").
-Notation Plt := Pos.lt (compat "8.3").
-Notation Pgt := Pos.gt (compat "8.3").
-Notation Ple := Pos.le (compat "8.3").
-Notation Pge := Pos.ge (compat "8.3").
-Notation Pmin := Pos.min (compat "8.3").
-Notation Pmax := Pos.max (compat "8.3").
-Notation Peqb := Pos.eqb (compat "8.3").
-Notation positive_eq_dec := Pos.eq_dec (compat "8.3").
-Notation xI_succ_xO := Pos.xI_succ_xO (compat "8.3").
-Notation Psucc_discr := Pos.succ_discr (compat "8.3").
+Notation Psucc := Pos.succ (compat "8.6").
+Notation Pplus := Pos.add (only parsing).
+Notation Pplus_carry := Pos.add_carry (only parsing).
+Notation Ppred := Pos.pred (compat "8.6").
+Notation Piter_op := Pos.iter_op (compat "8.6").
+Notation Piter_op_succ := Pos.iter_op_succ (compat "8.6").
+Notation Pmult_nat := (Pos.iter_op plus) (only parsing).
+Notation nat_of_P := Pos.to_nat (only parsing).
+Notation P_of_succ_nat := Pos.of_succ_nat (only parsing).
+Notation Pdouble_minus_one := Pos.pred_double (only parsing).
+Notation positive_mask := Pos.mask (only parsing).
+Notation positive_mask_rect := Pos.mask_rect (only parsing).
+Notation positive_mask_ind := Pos.mask_ind (only parsing).
+Notation positive_mask_rec := Pos.mask_rec (only parsing).
+Notation Pdouble_plus_one_mask := Pos.succ_double_mask (only parsing).
+Notation Pdouble_mask := Pos.double_mask (compat "8.6").
+Notation Pdouble_minus_two := Pos.double_pred_mask (only parsing).
+Notation Pminus_mask := Pos.sub_mask (only parsing).
+Notation Pminus_mask_carry := Pos.sub_mask_carry (only parsing).
+Notation Pminus := Pos.sub (only parsing).
+Notation Pmult := Pos.mul (only parsing).
+Notation iter_pos := @Pos.iter (only parsing).
+Notation Ppow := Pos.pow (compat "8.6").
+Notation Pdiv2 := Pos.div2 (compat "8.6").
+Notation Pdiv2_up := Pos.div2_up (compat "8.6").
+Notation Psize := Pos.size_nat (only parsing).
+Notation Psize_pos := Pos.size (only parsing).
+Notation Pcompare x y m := (Pos.compare_cont m x y) (only parsing).
+Notation Plt := Pos.lt (compat "8.6").
+Notation Pgt := Pos.gt (compat "8.6").
+Notation Ple := Pos.le (compat "8.6").
+Notation Pge := Pos.ge (compat "8.6").
+Notation Pmin := Pos.min (compat "8.6").
+Notation Pmax := Pos.max (compat "8.6").
+Notation Peqb := Pos.eqb (compat "8.6").
+Notation positive_eq_dec := Pos.eq_dec (only parsing).
+Notation xI_succ_xO := Pos.xI_succ_xO (only parsing).
+Notation Psucc_discr := Pos.succ_discr (compat "8.6").
 Notation Psucc_o_double_minus_one_eq_xO :=
- Pos.succ_pred_double (compat "8.3").
+ Pos.succ_pred_double (only parsing).
 Notation Pdouble_minus_one_o_succ_eq_xI :=
- Pos.pred_double_succ (compat "8.3").
-Notation xO_succ_permute := Pos.double_succ (compat "8.3").
+ Pos.pred_double_succ (only parsing).
+Notation xO_succ_permute := Pos.double_succ (only parsing).
 Notation double_moins_un_xO_discr :=
- Pos.pred_double_xO_discr (compat "8.3").
-Notation Psucc_not_one := Pos.succ_not_1 (compat "8.3").
-Notation Ppred_succ := Pos.pred_succ (compat "8.3").
-Notation Psucc_pred := Pos.succ_pred_or (compat "8.3").
-Notation Psucc_inj := Pos.succ_inj (compat "8.3").
-Notation Pplus_carry_spec := Pos.add_carry_spec (compat "8.3").
-Notation Pplus_comm := Pos.add_comm (compat "8.3").
-Notation Pplus_succ_permute_r := Pos.add_succ_r (compat "8.3").
-Notation Pplus_succ_permute_l := Pos.add_succ_l (compat "8.3").
-Notation Pplus_no_neutral := Pos.add_no_neutral (compat "8.3").
-Notation Pplus_carry_plus := Pos.add_carry_add (compat "8.3").
-Notation Pplus_reg_r := Pos.add_reg_r (compat "8.3").
-Notation Pplus_reg_l := Pos.add_reg_l (compat "8.3").
-Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (compat "8.3").
-Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (compat "8.3").
-Notation Pplus_assoc := Pos.add_assoc (compat "8.3").
-Notation Pplus_xO := Pos.add_xO (compat "8.3").
-Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (compat "8.3").
-Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (compat "8.3").
-Notation Pplus_diag := Pos.add_diag (compat "8.3").
-Notation PeanoView := Pos.PeanoView (compat "8.3").
-Notation PeanoOne := Pos.PeanoOne (compat "8.3").
-Notation PeanoSucc := Pos.PeanoSucc (compat "8.3").
-Notation PeanoView_rect := Pos.PeanoView_rect (compat "8.3").
-Notation PeanoView_ind := Pos.PeanoView_ind (compat "8.3").
-Notation PeanoView_rec := Pos.PeanoView_rec (compat "8.3").
-Notation peanoView_xO := Pos.peanoView_xO (compat "8.3").
-Notation peanoView_xI := Pos.peanoView_xI (compat "8.3").
-Notation peanoView := Pos.peanoView (compat "8.3").
-Notation PeanoView_iter := Pos.PeanoView_iter (compat "8.3").
-Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (compat "8.3").
-Notation PeanoViewUnique := Pos.PeanoViewUnique (compat "8.3").
-Notation Prect := Pos.peano_rect (compat "8.3").
-Notation Prect_succ := Pos.peano_rect_succ (compat "8.3").
-Notation Prect_base := Pos.peano_rect_base (compat "8.3").
-Notation Prec := Pos.peano_rec (compat "8.3").
-Notation Pind := Pos.peano_ind (compat "8.3").
-Notation Pcase := Pos.peano_case (compat "8.3").
-Notation Pmult_1_r := Pos.mul_1_r (compat "8.3").
-Notation Pmult_Sn_m := Pos.mul_succ_l (compat "8.3").
-Notation Pmult_xO_permute_r := Pos.mul_xO_r (compat "8.3").
-Notation Pmult_xI_permute_r := Pos.mul_xI_r (compat "8.3").
-Notation Pmult_comm := Pos.mul_comm (compat "8.3").
-Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (compat "8.3").
-Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (compat "8.3").
-Notation Pmult_assoc := Pos.mul_assoc (compat "8.3").
-Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (compat "8.3").
-Notation Pmult_xO_discr := Pos.mul_xO_discr (compat "8.3").
-Notation Pmult_reg_r := Pos.mul_reg_r (compat "8.3").
-Notation Pmult_reg_l := Pos.mul_reg_l (compat "8.3").
-Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (compat "8.3").
-Notation Psquare_xO := Pos.square_xO (compat "8.3").
-Notation Psquare_xI := Pos.square_xI (compat "8.3").
-Notation iter_pos_swap_gen := Pos.iter_swap_gen (compat "8.3").
-Notation iter_pos_swap := Pos.iter_swap (compat "8.3").
-Notation iter_pos_succ := Pos.iter_succ (compat "8.3").
-Notation iter_pos_plus := Pos.iter_add (compat "8.3").
-Notation iter_pos_invariant := Pos.iter_invariant (compat "8.3").
-Notation Ppow_1_r := Pos.pow_1_r (compat "8.3").
-Notation Ppow_succ_r := Pos.pow_succ_r (compat "8.3").
-Notation Peqb_refl := Pos.eqb_refl (compat "8.3").
-Notation Peqb_eq := Pos.eqb_eq (compat "8.3").
-Notation Pcompare_refl_id := Pos.compare_cont_refl (compat "8.3").
-Notation Pcompare_eq_iff := Pos.compare_eq_iff (compat "8.3").
-Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (compat "8.3").
-Notation Pcompare_eq_Lt := Pos.compare_lt_iff (compat "8.3").
-Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (compat "8.3").
-
-Notation Pcompare_antisym := Pos.compare_cont_antisym (compat "8.3").
-Notation ZC1 := Pos.gt_lt (compat "8.3").
-Notation ZC2 := Pos.lt_gt (compat "8.3").
-Notation Pcompare_spec := Pos.compare_spec (compat "8.3").
-Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (compat "8.3").
-Notation Pcompare_succ_succ := Pos.compare_succ_succ (compat "8.3").
-Notation Pcompare_1 := Pos.nlt_1_r (compat "8.3").
-Notation Plt_1 := Pos.nlt_1_r (compat "8.3").
-Notation Plt_1_succ := Pos.lt_1_succ (compat "8.3").
-Notation Plt_lt_succ := Pos.lt_lt_succ (compat "8.3").
-Notation Plt_irrefl := Pos.lt_irrefl (compat "8.3").
-Notation Plt_trans := Pos.lt_trans (compat "8.3").
-Notation Plt_ind := Pos.lt_ind (compat "8.3").
-Notation Ple_lteq := Pos.le_lteq (compat "8.3").
-Notation Ple_refl := Pos.le_refl (compat "8.3").
-Notation Ple_lt_trans := Pos.le_lt_trans (compat "8.3").
-Notation Plt_le_trans := Pos.lt_le_trans (compat "8.3").
-Notation Ple_trans := Pos.le_trans (compat "8.3").
-Notation Plt_succ_r := Pos.lt_succ_r (compat "8.3").
-Notation Ple_succ_l := Pos.le_succ_l (compat "8.3").
-Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (compat "8.3").
-Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (compat "8.3").
-Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (compat "8.3").
-Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (compat "8.3").
-Notation Pplus_lt_mono := Pos.add_lt_mono (compat "8.3").
-Notation Pplus_le_mono_l := Pos.add_le_mono_l (compat "8.3").
-Notation Pplus_le_mono_r := Pos.add_le_mono_r (compat "8.3").
-Notation Pplus_le_mono := Pos.add_le_mono (compat "8.3").
-Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (compat "8.3").
-Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (compat "8.3").
-Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (compat "8.3").
-Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (compat "8.3").
-Notation Pmult_lt_mono := Pos.mul_lt_mono (compat "8.3").
-Notation Pmult_le_mono_l := Pos.mul_le_mono_l (compat "8.3").
-Notation Pmult_le_mono_r := Pos.mul_le_mono_r (compat "8.3").
-Notation Pmult_le_mono := Pos.mul_le_mono (compat "8.3").
-Notation Plt_plus_r := Pos.lt_add_r (compat "8.3").
-Notation Plt_not_plus_l := Pos.lt_not_add_l (compat "8.3").
-Notation Ppow_gt_1 := Pos.pow_gt_1 (compat "8.3").
-Notation Ppred_mask := Pos.pred_mask (compat "8.3").
-Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (compat "8.3").
-Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (compat "8.3").
-Notation Pminus_succ_r := Pos.sub_succ_r (compat "8.3").
-Notation Pminus_mask_diag := Pos.sub_mask_diag (compat "8.3").
-
-Notation Pplus_minus_eq := Pos.add_sub (compat "8.3").
-Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (compat "8.3").
-Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (compat "8.3").
-Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (compat "8.3").
-Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (compat "8.3").
-Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (compat "8.3").
-Notation Pminus_decr := Pos.sub_decr (compat "8.3").
-Notation Pminus_xI_xI := Pos.sub_xI_xI (compat "8.3").
-Notation Pplus_minus_assoc := Pos.add_sub_assoc (compat "8.3").
-Notation Pminus_plus_distr := Pos.sub_add_distr (compat "8.3").
-Notation Pminus_minus_distr := Pos.sub_sub_distr (compat "8.3").
-Notation Pminus_mask_Lt := Pos.sub_mask_neg (compat "8.3").
-Notation Pminus_Lt := Pos.sub_lt (compat "8.3").
-Notation Pminus_Eq := Pos.sub_diag (compat "8.3").
-Notation Psize_monotone := Pos.size_nat_monotone (compat "8.3").
-Notation Psize_pos_gt := Pos.size_gt (compat "8.3").
-Notation Psize_pos_le := Pos.size_le (compat "8.3").
+ Pos.pred_double_xO_discr (only parsing).
+Notation Psucc_not_one := Pos.succ_not_1 (only parsing).
+Notation Ppred_succ := Pos.pred_succ (compat "8.6").
+Notation Psucc_pred := Pos.succ_pred_or (only parsing).
+Notation Psucc_inj := Pos.succ_inj (compat "8.6").
+Notation Pplus_carry_spec := Pos.add_carry_spec (only parsing).
+Notation Pplus_comm := Pos.add_comm (only parsing).
+Notation Pplus_succ_permute_r := Pos.add_succ_r (only parsing).
+Notation Pplus_succ_permute_l := Pos.add_succ_l (only parsing).
+Notation Pplus_no_neutral := Pos.add_no_neutral (only parsing).
+Notation Pplus_carry_plus := Pos.add_carry_add (only parsing).
+Notation Pplus_reg_r := Pos.add_reg_r (only parsing).
+Notation Pplus_reg_l := Pos.add_reg_l (only parsing).
+Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (only parsing).
+Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (only parsing).
+Notation Pplus_assoc := Pos.add_assoc (only parsing).
+Notation Pplus_xO := Pos.add_xO (only parsing).
+Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (only parsing).
+Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (only parsing).
+Notation Pplus_diag := Pos.add_diag (only parsing).
+Notation PeanoView := Pos.PeanoView (only parsing).
+Notation PeanoOne := Pos.PeanoOne (only parsing).
+Notation PeanoSucc := Pos.PeanoSucc (only parsing).
+Notation PeanoView_rect := Pos.PeanoView_rect (only parsing).
+Notation PeanoView_ind := Pos.PeanoView_ind (only parsing).
+Notation PeanoView_rec := Pos.PeanoView_rec (only parsing).
+Notation peanoView_xO := Pos.peanoView_xO (only parsing).
+Notation peanoView_xI := Pos.peanoView_xI (only parsing).
+Notation peanoView := Pos.peanoView (only parsing).
+Notation PeanoView_iter := Pos.PeanoView_iter (only parsing).
+Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (only parsing).
+Notation PeanoViewUnique := Pos.PeanoViewUnique (only parsing).
+Notation Prect := Pos.peano_rect (only parsing).
+Notation Prect_succ := Pos.peano_rect_succ (only parsing).
+Notation Prect_base := Pos.peano_rect_base (only parsing).
+Notation Prec := Pos.peano_rec (only parsing).
+Notation Pind := Pos.peano_ind (only parsing).
+Notation Pcase := Pos.peano_case (only parsing).
+Notation Pmult_1_r := Pos.mul_1_r (only parsing).
+Notation Pmult_Sn_m := Pos.mul_succ_l (only parsing).
+Notation Pmult_xO_permute_r := Pos.mul_xO_r (only parsing).
+Notation Pmult_xI_permute_r := Pos.mul_xI_r (only parsing).
+Notation Pmult_comm := Pos.mul_comm (only parsing).
+Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (only parsing).
+Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (only parsing).
+Notation Pmult_assoc := Pos.mul_assoc (only parsing).
+Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (only parsing).
+Notation Pmult_xO_discr := Pos.mul_xO_discr (only parsing).
+Notation Pmult_reg_r := Pos.mul_reg_r (only parsing).
+Notation Pmult_reg_l := Pos.mul_reg_l (only parsing).
+Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (only parsing).
+Notation Psquare_xO := Pos.square_xO (compat "8.6").
+Notation Psquare_xI := Pos.square_xI (compat "8.6").
+Notation iter_pos_swap_gen := Pos.iter_swap_gen (only parsing).
+Notation iter_pos_swap := Pos.iter_swap (only parsing).
+Notation iter_pos_succ := Pos.iter_succ (only parsing).
+Notation iter_pos_plus := Pos.iter_add (only parsing).
+Notation iter_pos_invariant := Pos.iter_invariant (only parsing).
+Notation Ppow_1_r := Pos.pow_1_r (compat "8.6").
+Notation Ppow_succ_r := Pos.pow_succ_r (compat "8.6").
+Notation Peqb_refl := Pos.eqb_refl (compat "8.6").
+Notation Peqb_eq := Pos.eqb_eq (compat "8.6").
+Notation Pcompare_refl_id := Pos.compare_cont_refl (only parsing).
+Notation Pcompare_eq_iff := Pos.compare_eq_iff (only parsing).
+Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (only parsing).
+Notation Pcompare_eq_Lt := Pos.compare_lt_iff (only parsing).
+Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (only parsing).
+
+Notation Pcompare_antisym := Pos.compare_cont_antisym (only parsing).
+Notation ZC1 := Pos.gt_lt (only parsing).
+Notation ZC2 := Pos.lt_gt (only parsing).
+Notation Pcompare_spec := Pos.compare_spec (compat "8.6").
+Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (only parsing).
+Notation Pcompare_succ_succ := Pos.compare_succ_succ (compat "8.6").
+Notation Pcompare_1 := Pos.nlt_1_r (only parsing).
+Notation Plt_1 := Pos.nlt_1_r (only parsing).
+Notation Plt_1_succ := Pos.lt_1_succ (compat "8.6").
+Notation Plt_lt_succ := Pos.lt_lt_succ (compat "8.6").
+Notation Plt_irrefl := Pos.lt_irrefl (compat "8.6").
+Notation Plt_trans := Pos.lt_trans (compat "8.6").
+Notation Plt_ind := Pos.lt_ind (compat "8.6").
+Notation Ple_lteq := Pos.le_lteq (compat "8.6").
+Notation Ple_refl := Pos.le_refl (compat "8.6").
+Notation Ple_lt_trans := Pos.le_lt_trans (compat "8.6").
+Notation Plt_le_trans := Pos.lt_le_trans (compat "8.6").
+Notation Ple_trans := Pos.le_trans (compat "8.6").
+Notation Plt_succ_r := Pos.lt_succ_r (compat "8.6").
+Notation Ple_succ_l := Pos.le_succ_l (compat "8.6").
+Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (only parsing).
+Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (only parsing).
+Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (only parsing).
+Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (only parsing).
+Notation Pplus_lt_mono := Pos.add_lt_mono (only parsing).
+Notation Pplus_le_mono_l := Pos.add_le_mono_l (only parsing).
+Notation Pplus_le_mono_r := Pos.add_le_mono_r (only parsing).
+Notation Pplus_le_mono := Pos.add_le_mono (only parsing).
+Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (only parsing).
+Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (only parsing).
+Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (only parsing).
+Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (only parsing).
+Notation Pmult_lt_mono := Pos.mul_lt_mono (only parsing).
+Notation Pmult_le_mono_l := Pos.mul_le_mono_l (only parsing).
+Notation Pmult_le_mono_r := Pos.mul_le_mono_r (only parsing).
+Notation Pmult_le_mono := Pos.mul_le_mono (only parsing).
+Notation Plt_plus_r := Pos.lt_add_r (only parsing).
+Notation Plt_not_plus_l := Pos.lt_not_add_l (only parsing).
+Notation Ppow_gt_1 := Pos.pow_gt_1 (compat "8.6").
+Notation Ppred_mask := Pos.pred_mask (compat "8.6").
+Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (only parsing).
+Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (only parsing).
+Notation Pminus_succ_r := Pos.sub_succ_r (only parsing).
+Notation Pminus_mask_diag := Pos.sub_mask_diag (only parsing).
+
+Notation Pplus_minus_eq := Pos.add_sub (only parsing).
+Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (only parsing).
+Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (only parsing).
+Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (only parsing).
+Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (only parsing).
+Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (only parsing).
+Notation Pminus_decr := Pos.sub_decr (only parsing).
+Notation Pminus_xI_xI := Pos.sub_xI_xI (only parsing).
+Notation Pplus_minus_assoc := Pos.add_sub_assoc (only parsing).
+Notation Pminus_plus_distr := Pos.sub_add_distr (only parsing).
+Notation Pminus_minus_distr := Pos.sub_sub_distr (only parsing).
+Notation Pminus_mask_Lt := Pos.sub_mask_neg (only parsing).
+Notation Pminus_Lt := Pos.sub_lt (only parsing).
+Notation Pminus_Eq := Pos.sub_diag (only parsing).
+Notation Psize_monotone := Pos.size_nat_monotone (only parsing).
+Notation Psize_pos_gt := Pos.size_gt (only parsing).
+Notation Psize_pos_le := Pos.size_le (only parsing).
 
 (** More complex compatibility facts, expressed as lemmas
     (to preserve scopes for instance) *)
diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v
index 74a292c6..07031474 100644
--- a/theories/PArith/BinPosDef.v
+++ b/theories/PArith/BinPosDef.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (**********************************************************************)
@@ -557,4 +559,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/PArith/PArith.v b/theories/PArith/PArith.v
index 6ee8d6d7..2be3d07c 100644
--- a/theories/PArith/PArith.v
+++ b/theories/PArith/PArith.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Library for positive natural numbers *)
diff --git a/theories/PArith/POrderedType.v b/theories/PArith/POrderedType.v
index 7619f639..c454e8af 100644
--- a/theories/PArith/POrderedType.v
+++ b/theories/PArith/POrderedType.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinPos Equalities Orders OrdersTac.
diff --git a/theories/PArith/Pnat.v b/theories/PArith/Pnat.v
index 9c2608f4..26aba87f 100644
--- a/theories/PArith/Pnat.v
+++ b/theories/PArith/Pnat.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinPos PeanoNat.
@@ -382,36 +384,36 @@ End SuccNat2Pos.
 
 (** For compatibility, old names and old-style lemmas *)
 
-Notation Psucc_S := Pos2Nat.inj_succ (compat "8.3").
-Notation Pplus_plus := Pos2Nat.inj_add (compat "8.3").
-Notation Pmult_mult := Pos2Nat.inj_mul (compat "8.3").
-Notation Pcompare_nat_compare := Pos2Nat.inj_compare (compat "8.3").
-Notation nat_of_P_xH := Pos2Nat.inj_1 (compat "8.3").
-Notation nat_of_P_xO := Pos2Nat.inj_xO (compat "8.3").
-Notation nat_of_P_xI := Pos2Nat.inj_xI (compat "8.3").
-Notation nat_of_P_is_S := Pos2Nat.is_succ (compat "8.3").
-Notation nat_of_P_pos := Pos2Nat.is_pos (compat "8.3").
-Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (compat "8.3").
-Notation nat_of_P_inj := Pos2Nat.inj (compat "8.3").
-Notation Plt_lt := Pos2Nat.inj_lt (compat "8.3").
-Notation Pgt_gt := Pos2Nat.inj_gt (compat "8.3").
-Notation Ple_le := Pos2Nat.inj_le (compat "8.3").
-Notation Pge_ge := Pos2Nat.inj_ge (compat "8.3").
-Notation Pminus_minus := Pos2Nat.inj_sub (compat "8.3").
-Notation iter_nat_of_P := @Pos2Nat.inj_iter (compat "8.3").
-
-Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (compat "8.3").
-Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (compat "8.3").
-
-Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (compat "8.3").
-Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (compat "8.3").
-Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (compat "8.3").
-Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (compat "8.3").
-Notation lt_O_nat_of_P := Pos2Nat.is_pos (compat "8.3").
-Notation ZL4 := Pos2Nat.is_succ (compat "8.3").
-Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (compat "8.3").
-Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (compat "8.3").
-Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (compat "8.3").
+Notation Psucc_S := Pos2Nat.inj_succ (only parsing).
+Notation Pplus_plus := Pos2Nat.inj_add (only parsing).
+Notation Pmult_mult := Pos2Nat.inj_mul (only parsing).
+Notation Pcompare_nat_compare := Pos2Nat.inj_compare (only parsing).
+Notation nat_of_P_xH := Pos2Nat.inj_1 (only parsing).
+Notation nat_of_P_xO := Pos2Nat.inj_xO (only parsing).
+Notation nat_of_P_xI := Pos2Nat.inj_xI (only parsing).
+Notation nat_of_P_is_S := Pos2Nat.is_succ (only parsing).
+Notation nat_of_P_pos := Pos2Nat.is_pos (only parsing).
+Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (only parsing).
+Notation nat_of_P_inj := Pos2Nat.inj (only parsing).
+Notation Plt_lt := Pos2Nat.inj_lt (only parsing).
+Notation Pgt_gt := Pos2Nat.inj_gt (only parsing).
+Notation Ple_le := Pos2Nat.inj_le (only parsing).
+Notation Pge_ge := Pos2Nat.inj_ge (only parsing).
+Notation Pminus_minus := Pos2Nat.inj_sub (only parsing).
+Notation iter_nat_of_P := @Pos2Nat.inj_iter (only parsing).
+
+Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (only parsing).
+Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (only parsing).
+
+Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (only parsing).
+Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (only parsing).
+Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (only parsing).
+Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (only parsing).
+Notation lt_O_nat_of_P := Pos2Nat.is_pos (only parsing).
+Notation ZL4 := Pos2Nat.is_succ (only parsing).
+Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (only parsing).
+Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (only parsing).
+Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (only parsing).
 
 Lemma nat_of_P_minus_morphism p q :
  Pos.compare_cont Eq p q = Gt ->
diff --git a/theories/PArith/vo.itarget b/theories/PArith/vo.itarget
deleted file mode 100644
index 73044e2c..00000000
--- a/theories/PArith/vo.itarget
+++ /dev/null
@@ -1,5 +0,0 @@
-BinPosDef.vo
-BinPos.vo
-Pnat.vo
-POrderedType.vo
-PArith.vo
\ No newline at end of file
diff --git a/theories/Program/Basics.v b/theories/Program/Basics.v
index 644b9b5a..f55093ed 100644
--- a/theories/Program/Basics.v
+++ b/theories/Program/Basics.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (** Standard functions and combinators.
 
diff --git a/theories/Program/Combinators.v b/theories/Program/Combinators.v
index 772018aa..f78d06b1 100644
--- a/theories/Program/Combinators.v
+++ b/theories/Program/Combinators.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (** * Proofs about standard combinators, exports functional extensionality.
 
@@ -22,15 +24,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 +47,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 +55,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/Equality.v b/theories/Program/Equality.v
index d6f9bb9d..cf42ed18 100644
--- a/theories/Program/Equality.v
+++ b/theories/Program/Equality.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Tactics related to (dependent) equality and proof irrelevance. *)
diff --git a/theories/Program/Program.v b/theories/Program/Program.v
index 4a6f2786..de0a6d5d 100644
--- a/theories/Program/Program.v
+++ b/theories/Program/Program.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 Require Export Coq.Program.Utils.
 Require Export Coq.Program.Wf.
diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v
index 2a3ec926..1c89b6c3 100644
--- a/theories/Program/Subset.v
+++ b/theories/Program/Subset.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (** Tactics related to subsets and proof irrelevance. *)
 
diff --git a/theories/Program/Syntax.v b/theories/Program/Syntax.v
index 2fccf624..785b9437 100644
--- a/theories/Program/Syntax.v
+++ b/theories/Program/Syntax.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (** Custom notations and implicits for Coq prelude definitions.
 
diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v
index dfd6b0ea..bc838818 100644
--- a/theories/Program/Tactics.v
+++ b/theories/Program/Tactics.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module implements various tactics used to simplify the goals produced by Program,
@@ -328,4 +330,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/Program/Utils.v b/theories/Program/Utils.v
index 396c9618..78c36dc7 100644
--- a/theories/Program/Utils.v
+++ b/theories/Program/Utils.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Various syntactic shorthands that are useful with [Program]. *)
diff --git a/theories/Program/Wf.v b/theories/Program/Wf.v
index c490ea51..62787985 100644
--- a/theories/Program/Wf.v
+++ b/theories/Program/Wf.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (** Reformulation of the Wf module using subsets where possible, providing
    the support for [Program]'s treatment of well-founded definitions. *)
@@ -69,6 +71,7 @@ Section Well_founded.
 
 End Well_founded.
 
+Require Coq.extraction.Extraction.
 Extraction Inline Fix_F_sub Fix_sub.
 
 Set Implicit Arguments.
diff --git a/theories/Program/vo.itarget b/theories/Program/vo.itarget
deleted file mode 100644
index 864c815a..00000000
--- a/theories/Program/vo.itarget
+++ /dev/null
@@ -1,9 +0,0 @@
-Basics.vo
-Combinators.vo
-Equality.vo
-Program.vo
-Subset.vo
-Syntax.vo
-Tactics.vo
-Utils.vo
-Wf.vo
diff --git a/theories/QArith/QArith.v b/theories/QArith/QArith.v
index 5ad08b65..81390082 100644
--- a/theories/QArith/QArith.v
+++ b/theories/QArith/QArith.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export QArith_base.
diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v
index 62304876..35706e7f 100644
--- a/theories/QArith/QArith_base.v
+++ b/theories/QArith/QArith_base.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export ZArith.
@@ -171,6 +173,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 *)
@@ -205,9 +227,7 @@ Infix "/" := Qdiv : Q_scope.
 
 (** A light notation for [Zpos] *)
 
-Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope.
-
-Lemma Qmake_Qdiv a b : a#b==inject_Z a/inject_Z ('b).
+Lemma Qmake_Qdiv a b : a#b==inject_Z a/inject_Z (Zpos b).
 Proof.
 unfold Qeq. simpl. ring.
 Qed.
@@ -220,9 +240,9 @@ Proof.
   Open Scope Z_scope.
   intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *.
   simpl_mult; ring_simplify.
-  replace (p1 * 'r2 * 'q2) with (p1 * 'q2 * 'r2) by ring.
+  replace (p1 * Zpos r2 * Zpos q2) with (p1 * Zpos q2 * Zpos r2) by ring.
   rewrite H.
-  replace (r1 * 'p2 * 'q2 * 's2) with (r1 * 's2 * 'p2 * 'q2) by ring.
+  replace (r1 * Zpos p2 * Zpos q2 * Zpos s2) with (r1 * Zpos s2 * Zpos p2 * Zpos q2) by ring.
   rewrite H0.
   ring.
   Close Scope Z_scope.
@@ -233,7 +253,7 @@ Proof.
   unfold Qeq, Qopp; simpl.
   Open Scope Z_scope.
   intros x y H; simpl.
-  replace (- Qnum x * ' Qden y) with (- (Qnum x * ' Qden y)) by ring.
+  replace (- Qnum x * Zpos (Qden y)) with (- (Qnum x * Zpos (Qden y))) by ring.
   rewrite H;  ring.
   Close Scope Z_scope.
 Qed.
@@ -250,9 +270,9 @@ Proof.
   Open Scope Z_scope.
   intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *.
   intros; simpl_mult; ring_simplify.
-  replace (q1 * s1 * 'p2) with (q1 * 'p2 * s1) by ring.
+  replace (q1 * s1 * Zpos p2) with (q1 * Zpos p2 * s1) by ring.
   rewrite <- H.
-  replace (p1 * r1 * 'q2 * 's2) with (r1 * 's2 * p1 * 'q2) by ring.
+  replace (p1 * r1 * Zpos q2 * Zpos s2) with (r1 * Zpos s2 * p1 * Zpos q2) by ring.
   rewrite H0.
   ring.
   Close Scope Z_scope.
@@ -283,13 +303,13 @@ Proof.
   unfold Qeq, Qcompare.
   Open Scope Z_scope.
   intros (p1,p2) (q1,q2) H (r1,r2) (s1,s2) H'; simpl in *.
-  rewrite <- (Zcompare_mult_compat (q2*s2) (p1*'r2)).
-  rewrite <- (Zcompare_mult_compat (p2*r2) (q1*'s2)).
-  change ('(q2*s2)) with ('q2 * 's2).
-  change ('(p2*r2)) with ('p2 * 'r2).
-  replace ('q2 * 's2 * (p1*'r2)) with ((p1*'q2)*'r2*'s2) by ring.
+  rewrite <- (Zcompare_mult_compat (q2*s2) (p1*Zpos r2)).
+  rewrite <- (Zcompare_mult_compat (p2*r2) (q1*Zpos s2)).
+  change (Zpos (q2*s2)) with (Zpos q2 * Zpos s2).
+  change (Zpos (p2*r2)) with (Zpos p2 * Zpos r2).
+  replace (Zpos q2 * Zpos s2 * (p1*Zpos r2)) with ((p1*Zpos q2)*Zpos r2*Zpos s2) by ring.
   rewrite H.
-  replace ('q2 * 's2 * (r1*'p2)) with ((r1*'s2)*'q2*'p2) by ring.
+  replace (Zpos q2 * Zpos s2 * (r1*Zpos p2)) with ((r1*Zpos s2)*Zpos q2*Zpos p2) by ring.
   rewrite H'.
   f_equal; ring.
   Close Scope Z_scope.
@@ -550,8 +570,8 @@ Lemma Qle_trans : forall x y z, x<=y -> y<=z -> x<=z.
 Proof.
   unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
   Open Scope Z_scope.
-  apply Z.mul_le_mono_pos_r with ('y2); [easy|].
-  apply Z.le_trans with (y1 * 'x2 * 'z2).
+  apply Z.mul_le_mono_pos_r with (Zpos y2); [easy|].
+  apply Z.le_trans with (y1 * Zpos x2 * Zpos z2).
   - rewrite Z.mul_shuffle0. now apply Z.mul_le_mono_pos_r.
   - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1).
     now apply Z.mul_le_mono_pos_r.
@@ -598,8 +618,8 @@ Lemma Qle_lt_trans : forall x y z, x<=y -> y<z -> x<z.
 Proof.
   unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
   Open Scope Z_scope.
-  apply Z.mul_lt_mono_pos_r with ('y2); [easy|].
-  apply Z.le_lt_trans with (y1 * 'x2 * 'z2).
+  apply Z.mul_lt_mono_pos_r with (Zpos y2); [easy|].
+  apply Z.le_lt_trans with (y1 * Zpos x2 * Zpos z2).
   - rewrite Z.mul_shuffle0. now apply Z.mul_le_mono_pos_r.
   - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1).
     now apply Z.mul_lt_mono_pos_r.
@@ -610,8 +630,8 @@ Lemma Qlt_le_trans : forall x y z, x<y -> y<=z -> x<z.
 Proof.
   unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
   Open Scope Z_scope.
-  apply Z.mul_lt_mono_pos_r with ('y2); [easy|].
-  apply Z.lt_le_trans with (y1 * 'x2 * 'z2).
+  apply Z.mul_lt_mono_pos_r with (Zpos y2); [easy|].
+  apply Z.lt_le_trans with (y1 * Zpos x2 * Zpos z2).
   - rewrite Z.mul_shuffle0. now apply Z.mul_lt_mono_pos_r.
   - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1).
     now apply Z.mul_le_mono_pos_r.
@@ -701,9 +721,9 @@ Proof.
   match goal with |- ?a <= ?b => ring_simplify a b end.
   rewrite Z.add_comm.
   apply Z.add_le_mono.
-  match goal with |- ?a <= ?b => ring_simplify z1 t1 ('z2) ('t2) a b end.
+  match goal with |- ?a <= ?b => ring_simplify z1 t1 (Zpos z2) (Zpos t2) a b end.
   auto with zarith.
-  match goal with |- ?a <= ?b => ring_simplify x1 y1 ('x2) ('y2) a b end.
+  match goal with |- ?a <= ?b => ring_simplify x1 y1 (Zpos x2) (Zpos y2) a b end.
   auto with zarith.
   Close Scope Z_scope.
 Qed.
@@ -718,9 +738,9 @@ Proof.
   match goal with |- ?a < ?b => ring_simplify a b end.
   rewrite Z.add_comm.
   apply Z.add_le_lt_mono.
-  match goal with |- ?a <= ?b => ring_simplify z1 t1 ('z2) ('t2) a b end.
+  match goal with |- ?a <= ?b => ring_simplify z1 t1 (Zpos z2) (Zpos t2) a b end.
   auto with zarith.
-  match goal with |- ?a < ?b => ring_simplify x1 y1 ('x2) ('y2) a b end.
+  match goal with |- ?a < ?b => ring_simplify x1 y1 (Zpos x2) (Zpos y2) a b end.
   do 2 (apply Z.mul_lt_mono_pos_r;try easy).
   Close Scope Z_scope.
 Qed.
diff --git a/theories/QArith/QOrderedType.v b/theories/QArith/QOrderedType.v
index 25e98f0b..37b4b298 100644
--- a/theories/QArith/QOrderedType.v
+++ b/theories/QArith/QOrderedType.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import QArith_base Equalities Orders OrdersTac.
diff --git a/theories/QArith/Qabs.v b/theories/QArith/Qabs.v
index c60d0451..31eb41bc 100644
--- a/theories/QArith/Qabs.v
+++ b/theories/QArith/Qabs.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export QArith.
@@ -26,8 +28,8 @@ intros [xn xd] [yn yd] H.
 simpl.
 unfold Qeq in *.
 simpl in *.
-change (' yd)%Z with (Z.abs (' yd)).
-change (' xd)%Z with (Z.abs (' xd)).
+change (Zpos yd)%Z with (Z.abs (Zpos yd)).
+change (Zpos xd)%Z with (Z.abs (Zpos xd)).
 repeat rewrite <- Z.abs_mul.
 congruence.
 Qed.
@@ -86,8 +88,8 @@ unfold Qplus.
 unfold Qle.
 simpl.
 apply Z.mul_le_mono_nonneg_r;auto with *.
-change (' yd)%Z with (Z.abs (' yd)).
-change (' xd)%Z with (Z.abs (' xd)).
+change (Zpos yd)%Z with (Z.abs (Zpos yd)).
+change (Zpos xd)%Z with (Z.abs (Zpos xd)).
 repeat rewrite <- Z.abs_mul.
 apply Z.abs_triangle.
 Qed.
@@ -100,6 +102,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 c0ababff..f45868a7 100644
--- a/theories/QArith/Qcabs.v
+++ b/theories/QArith/Qcabs.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * An absolute value for normalized rational numbers. *)
@@ -22,7 +24,7 @@ Lemma Qcabs_canon (x : Q) : Qred x = x -> Qred (Qabs x) = Qabs x.
 Proof. intros H; now rewrite (Qred_abs x), H. Qed.
 
 Definition Qcabs (x:Qc) : Qc := {| canon := Qcabs_canon x (canon x) |}.
-Notation "[ q ]" := (Qcabs q) (q at next level, format "[ q ]") : Qc_scope.
+Notation "[ q ]" := (Qcabs q) : Qc_scope.
 
 Ltac Qc_unfolds :=
   unfold Qcabs, Qcminus, Qcopp, Qcplus, Qcmult, Qcle, Q2Qc, this.
@@ -126,4 +128,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/Qcanon.v b/theories/QArith/Qcanon.v
index 9f9651d8..1510a7b8 100644
--- a/theories/QArith/Qcanon.v
+++ b/theories/QArith/Qcanon.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Field.
@@ -28,7 +30,7 @@ Lemma Qred_identity :
 Proof.
   intros (a,b) H; simpl in *.
   rewrite <- Z.ggcd_gcd in H.
-  generalize (Z.ggcd_correct_divisors a ('b)).
+  generalize (Z.ggcd_correct_divisors a (Zpos b)).
   destruct Z.ggcd as (g,(aa,bb)); simpl in *; subst.
   rewrite !Z.mul_1_l. now intros (<-,<-).
 Qed.
@@ -37,7 +39,7 @@ Lemma Qred_identity2 :
   forall q:Q, Qred q = q -> Z.gcd (Qnum q) (QDen q) = 1%Z.
 Proof.
   intros (a,b) H; simpl in *.
-  generalize (Z.gcd_nonneg a ('b)) (Z.ggcd_correct_divisors a ('b)).
+  generalize (Z.gcd_nonneg a (Zpos b)) (Z.ggcd_correct_divisors a (Zpos b)).
   rewrite <- Z.ggcd_gcd.
   destruct Z.ggcd as (g,(aa,bb)); simpl in *.
   injection H as <- <-. intros H (_,H').
diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v
index bbaf6027..6cbb491b 100644
--- a/theories/QArith/Qfield.v
+++ b/theories/QArith/Qfield.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Field.
diff --git a/theories/QArith/Qminmax.v b/theories/QArith/Qminmax.v
index 86584d9e..264b2f92 100644
--- a/theories/QArith/Qminmax.v
+++ b/theories/QArith/Qminmax.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import QArith_base Orders QOrderedType GenericMinMax.
diff --git a/theories/QArith/Qpower.v b/theories/QArith/Qpower.v
index af89d300..01078220 100644
--- a/theories/QArith/Qpower.v
+++ b/theories/QArith/Qpower.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Zpow_facts Qfield Qreduction.
@@ -88,7 +90,7 @@ rewrite Qinv_power.
 reflexivity.
 Qed.
 
-Lemma Qinv_power_n : forall n p, (1#p)^n == /(inject_Z ('p))^n.
+Lemma Qinv_power_n : forall n p, (1#p)^n == /(inject_Z (Zpos p))^n.
 Proof.
 intros n p.
 rewrite Qmake_Qdiv.
@@ -188,7 +190,7 @@ unfold Z.succ.
 rewrite Zpower_exp; auto with *; try discriminate.
 rewrite Qpower_plus' by discriminate.
 rewrite <- IHn by discriminate.
-replace (a^'n*a^1)%Z with (a^'n*a)%Z by ring.
+replace (a^Zpos n*a^1)%Z with (a^Zpos n*a)%Z by ring.
 ring_simplify.
 reflexivity.
 Qed.
diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v
index 048e409c..c8329625 100644
--- a/theories/QArith/Qreals.v
+++ b/theories/QArith/Qreals.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Rbase.
@@ -15,7 +17,8 @@ Definition Q2R (x : Q) : R := (IZR (Qnum x) * / IZR (QDen x))%R.
 
 Lemma IZR_nz : forall p : positive, IZR (Zpos p) <> 0%R.
 Proof.
-intros; apply not_O_IZR; auto with qarith.
+intros.
+now apply not_O_IZR.
 Qed.
 
 Hint Resolve IZR_nz Rmult_integral_contrapositive.
@@ -48,8 +51,7 @@ assert ((X1 * Y2)%R = (Y1 * X2)%R).
  apply IZR_eq; auto.
 clear H.
 field_simplify_eq; auto.
-ring_simplify X1 Y2 (Y2 * X1)%R.
-rewrite H0;  ring.
+rewrite H0; ring.
 Qed.
 
 Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y.
@@ -66,10 +68,8 @@ replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto).
 replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto).
 apply Rmult_le_compat_r; auto.
 apply Rmult_le_pos.
-unfold X2; replace 0%R with (IZR 0); auto; apply IZR_le;
- auto with zarith.
-unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_le;
- auto with zarith.
+now apply IZR_le.
+now apply IZR_le.
 Qed.
 
 Lemma Qle_Rle : forall x y : Q, x<=y -> (Q2R x <= Q2R y)%R.
@@ -88,10 +88,8 @@ replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto).
 replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto).
 apply Rmult_le_compat_r; auto.
 apply Rmult_le_pos; apply Rlt_le; apply Rinv_0_lt_compat.
-unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
- auto with zarith.
-unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
- auto with zarith.
+now apply IZR_lt.
+now apply IZR_lt.
 Qed.
 
 Lemma Rlt_Qlt : forall x y : Q, (Q2R x < Q2R y)%R -> x<y.
@@ -108,10 +106,8 @@ replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto).
 replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto).
 apply Rmult_lt_compat_r; auto.
 apply Rmult_lt_0_compat.
-unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
- auto with zarith.
-unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
- auto with zarith.
+now apply IZR_lt.
+now apply IZR_lt.
 Qed.
 
 Lemma Qlt_Rlt : forall x y : Q, x<y -> (Q2R x < Q2R y)%R.
@@ -130,10 +126,8 @@ replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto).
 replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto).
 apply Rmult_lt_compat_r; auto.
 apply Rmult_lt_0_compat; apply Rinv_0_lt_compat.
-unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
- auto with zarith.
-unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
- auto with zarith.
+now apply IZR_lt.
+now apply IZR_lt.
 Qed.
 
 Lemma Q2R_plus : forall x y : Q, Q2R (x+y) = (Q2R x + Q2R y)%R.
@@ -173,8 +167,8 @@ unfold Qinv, Q2R, Qeq; intros (x1, x2). case x1; unfold Qnum, Qden.
 simpl; intros; elim H; trivial.
 intros; field; auto. 
 intros;
-  change (IZR (Zneg x2)) with (- IZR (' x2))%R;
-  change (IZR (Zneg p)) with (- IZR (' p))%R;
+  change (IZR (Zneg x2)) with (- IZR (Zpos x2))%R;
+  change (IZR (Zneg p)) with (- IZR (Zpos p))%R;
   simpl; field; (*auto 8 with real.*)
   repeat split; auto; auto with real.
 Qed.
diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v
index 131214f5..17307c82 100644
--- a/theories/QArith/Qreduction.v
+++ b/theories/QArith/Qreduction.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Normalisation functions for rational numbers. *)
@@ -11,22 +13,22 @@
 Require Export QArith_base.
 Require Import Znumtheory.
 
-Notation Z2P := Z.to_pos (compat "8.3").
-Notation Z2P_correct := Z2Pos.id (compat "8.3").
+Notation Z2P := Z.to_pos (only parsing).
+Notation Z2P_correct := Z2Pos.id (only parsing).
 
 (** Simplification of fractions using [Z.gcd].
   This version can compute within Coq. *)
 
 Definition Qred (q:Q) :=
   let (q1,q2) := q in
-  let (r1,r2) := snd (Z.ggcd q1 ('q2))
+  let (r1,r2) := snd (Z.ggcd q1 (Zpos q2))
   in r1#(Z.to_pos r2).
 
 Lemma Qred_correct : forall q, (Qred q) == q.
 Proof.
   unfold Qred, Qeq; intros (n,d); simpl.
-  generalize (Z.ggcd_gcd n ('d)) (Z.gcd_nonneg n ('d))
-    (Z.ggcd_correct_divisors n ('d)).
+  generalize (Z.ggcd_gcd n (Zpos d)) (Z.gcd_nonneg n (Zpos d))
+    (Z.ggcd_correct_divisors n (Zpos d)).
   destruct (Z.ggcd n (Zpos d)) as (g,(nn,dd)); simpl.
   Open Scope Z_scope.
   intros Hg LE (Hn,Hd). rewrite Hd, Hn.
@@ -43,13 +45,13 @@ Proof.
   unfold Qred, Qeq in *; simpl in *.
   Open Scope Z_scope.
   intros H.
-  generalize (Z.ggcd_gcd a ('b)) (Zgcd_is_gcd a ('b))
-    (Z.gcd_nonneg a ('b)) (Z.ggcd_correct_divisors a ('b)).
+  generalize (Z.ggcd_gcd a (Zpos b)) (Zgcd_is_gcd a (Zpos b))
+    (Z.gcd_nonneg a (Zpos b)) (Z.ggcd_correct_divisors a (Zpos b)).
   destruct (Z.ggcd a (Zpos b)) as (g,(aa,bb)).
   simpl. intros <- Hg1 Hg2 (Hg3,Hg4).
   assert (Hg0 : g <> 0) by (intro; now subst g).
-  generalize (Z.ggcd_gcd c ('d)) (Zgcd_is_gcd c ('d))
-    (Z.gcd_nonneg c ('d)) (Z.ggcd_correct_divisors c ('d)).
+  generalize (Z.ggcd_gcd c (Zpos d)) (Zgcd_is_gcd c (Zpos d))
+    (Z.gcd_nonneg c (Zpos d)) (Z.ggcd_correct_divisors c (Zpos d)).
   destruct (Z.ggcd c (Zpos d)) as (g',(cc,dd)).
   simpl. intros <- Hg'1 Hg'2 (Hg'3,Hg'4).
   assert (Hg'0 : g' <> 0) by (intro; now subst g').
@@ -101,7 +103,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 +127,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/QArith/Qring.v b/theories/QArith/Qring.v
index da11c2b1..7f972d56 100644
--- a/theories/QArith/Qring.v
+++ b/theories/QArith/Qring.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Qfield.
diff --git a/theories/QArith/Qround.v b/theories/QArith/Qround.v
index 0ed6d557..7c5ddbb6 100644
--- a/theories/QArith/Qround.v
+++ b/theories/QArith/Qround.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import QArith.
@@ -78,11 +80,11 @@ unfold Qlt.
 simpl.
 replace (n*1)%Z with n by ring.
 ring_simplify.
-replace (n / ' d * ' d + ' d)%Z with
-  (('d * (n / 'd) + n mod 'd) + 'd - n mod 'd)%Z by ring.
+replace (n / Zpos d * Zpos d + Zpos d)%Z with
+  ((Zpos d * (n / Zpos d) + n mod Zpos  d) + Zpos  d - n mod Zpos d)%Z by ring.
 rewrite <- Z_div_mod_eq; auto with*.
 rewrite <- Z.lt_add_lt_sub_r.
-destruct (Z_mod_lt n ('d)); auto with *.
+destruct (Z_mod_lt n (Zpos d)); auto with *.
 Qed.
 
 Hint Resolve Qlt_floor : qarith.
@@ -105,9 +107,9 @@ Proof.
 intros [xn xd] [yn yd] Hxy.
 unfold Qle in *.
 simpl in *.
-rewrite <- (Zdiv_mult_cancel_r xn ('xd) ('yd)); auto with *.
-rewrite <- (Zdiv_mult_cancel_r yn ('yd) ('xd)); auto with *.
-rewrite (Z.mul_comm ('yd) ('xd)).
+rewrite <- (Zdiv_mult_cancel_r xn (Zpos xd) (Zpos yd)); auto with *.
+rewrite <- (Zdiv_mult_cancel_r yn (Zpos yd) (Zpos xd)); auto with *.
+rewrite (Z.mul_comm (Zpos yd) (Zpos xd)).
 apply Z_div_le; auto with *.
 Qed.
 
@@ -141,7 +143,7 @@ Qed.
 Lemma Zdiv_Qdiv (n m: Z): (n / m)%Z = Qfloor (n / m).
 Proof.
  unfold Qfloor. intros. simpl.
- destruct m as [?|?|p]; simpl.
+ destruct m as [ | | p]; simpl.
   now rewrite Zdiv_0_r, Z.mul_0_r.
   now rewrite Z.mul_1_r.
  rewrite <- Z.opp_eq_mul_m1.
diff --git a/theories/QArith/vo.itarget b/theories/QArith/vo.itarget
deleted file mode 100644
index b550b471..00000000
--- a/theories/QArith/vo.itarget
+++ /dev/null
@@ -1,13 +0,0 @@
-Qabs.vo
-QArith_base.vo
-QArith.vo
-Qcanon.vo
-Qcabs.vo
-Qfield.vo
-Qpower.vo
-Qreals.vo
-Qreduction.vo
-Qring.vo
-Qround.vo
-QOrderedType.vo
-Qminmax.vo
\ No newline at end of file
diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v
index a98d529f..09aad1ec 100644
--- a/theories/Reals/Alembert.v
+++ b/theories/Reals/Alembert.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -78,7 +80,7 @@ Proof.
   ring.
   discrR.
   discrR.
-  pattern 1 at 3; replace 1 with (/ 1);
+  replace 1 with (/ 1);
     [ apply tech7; discrR | apply Rinv_1 ].
   replace (An (S x)) with (An (S x + 0)%nat).
   apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)).
diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v
index c3ab8edc..c17ad0cf 100644
--- a/theories/Reals/AltSeries.v
+++ b/theories/Reals/AltSeries.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -339,51 +341,24 @@ Proof.
   symmetry ; apply S_pred with 0%nat.
   assumption.
   apply Rle_lt_trans with (/ INR (2 * N)).
-  apply Rmult_le_reg_l with (INR (2 * N)).
+  apply Rinv_le_contravar.
   rewrite mult_INR; apply Rmult_lt_0_compat;
     [ simpl; prove_sup0 | apply lt_INR_0; assumption ].
-  rewrite <- Rinv_r_sym.
-  apply Rmult_le_reg_l with (INR (2 * n)).
-  rewrite mult_INR; apply Rmult_lt_0_compat;
-    [ simpl; prove_sup0 | apply lt_INR_0; assumption ].
-  rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym.
-  do 2 rewrite Rmult_1_r; apply le_INR.
-  apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
-  replace n with (S (pred n)).
-  apply not_O_INR; discriminate.
-  symmetry ; apply S_pred with 0%nat.
-  assumption.
-  replace N with (S (pred N)).
-  apply not_O_INR; discriminate.
-  symmetry ; apply S_pred with 0%nat.
-  assumption.
+  apply le_INR.
+  now apply mult_le_compat_l.
   rewrite mult_INR.
-  rewrite Rinv_mult_distr.
-  replace (INR 2) with 2; [ idtac | reflexivity ].
-  apply Rmult_lt_reg_l with 2.
-  prove_sup0.
-  rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ].
-  rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N).
-  apply lt_INR_0; assumption.
-  rewrite <- Rinv_r_sym.
-  apply Rmult_lt_reg_l with (/ (2 * eps)).
-  apply Rinv_0_lt_compat; assumption.
-  rewrite Rmult_1_r;
-    replace (/ (2 * eps) * (INR N * (2 * eps))) with
-      (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ].
-  rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; replace (INR N) with (IZR (Z.of_nat N)).
-  rewrite <- H4.
-  elim H1; intros; assumption.
-  symmetry ; apply INR_IZR_INZ.
-  apply prod_neq_R0;
-    [ discrR | red; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ].
-  apply not_O_INR.
-  red; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
-  replace (INR 2) with 2; [ discrR | reflexivity ].
-  apply not_O_INR.
-  red; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
+  apply Rmult_lt_reg_l with (INR N / eps).
+  apply Rdiv_lt_0_compat with (2 := H).
+  now apply (lt_INR 0).
+  replace (_ */ _) with (/(2 * eps)).
+  replace (_ / _ * _) with (INR N).
+  rewrite INR_IZR_INZ.
+  now rewrite <- H4.
+  field.
+  now apply Rgt_not_eq.
+  simpl (INR 2); field; split.
+  now apply Rgt_not_eq, (lt_INR 0).
+  now apply Rgt_not_eq.
   apply Rle_ge; apply PI_tg_pos.
   apply lt_le_trans with N; assumption.
   elim H1; intros H5 _.
@@ -395,7 +370,6 @@ Proof.
   elim (Rlt_irrefl _ (Rlt_trans _ _ _ H6 H5)).
   elim (lt_n_O _ H6).
   apply le_IZR.
-  simpl.
   left; apply Rlt_trans with (/ (2 * eps)).
   apply Rinv_0_lt_compat; assumption.
   elim H1; intros; assumption.
diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v
index 6fca9c8a..37240eb7 100644
--- a/theories/Reals/ArithProp.v
+++ b/theories/Reals/ArithProp.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -143,7 +145,7 @@ Proof.
   assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl;
     cut (0 < y).
   intro; unfold Rminus;
-    replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y);
+    replace (- ((IZR (up (x / y)) + -(1)) * y)) with ((1 - IZR (up (x / y))) * y);
       [ idtac | ring ].
   split.
   apply Rmult_le_reg_l with (/ y).
diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v
index f878abfa..271100a5 100644
--- a/theories/Reals/Binomial.v
+++ b/theories/Reals/Binomial.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v
index 5cf6f17d..306b09dc 100644
--- a/theories/Reals/Cauchy_prod.v
+++ b/theories/Reals/Cauchy_prod.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v
index b14d807d..d046ecf1 100644
--- a/theories/Reals/Cos_plus.v
+++ b/theories/Reals/Cos_plus.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -289,11 +291,9 @@ Proof.
   apply INR_fact_lt_0.
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r.
-  replace 1 with (INR 1).
-  apply le_INR.
+  apply (le_INR 1).
   apply lt_le_S.
   apply INR_lt; apply INR_fact_lt_0.
-  reflexivity.
   apply INR_fact_neq_0.
   apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
   apply INR_fact_lt_0.
@@ -576,11 +576,9 @@ Proof.
   apply INR_fact_lt_0.
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r.
-  replace 1 with (INR 1).
-  apply le_INR.
+  apply (le_INR 1).
   apply lt_le_S.
   apply INR_lt; apply INR_fact_lt_0.
-  reflexivity.
   apply INR_fact_neq_0.
   apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
   apply INR_fact_lt_0.
diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v
index f5fcac47..f9919278 100644
--- a/theories/Reals/Cos_rel.v
+++ b/theories/Reals/Cos_rel.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v
index 4e2a7c3c..f3bc2f22 100644
--- a/theories/Reals/DiscrR.v
+++ b/theories/Reals/DiscrR.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import RIneq.
@@ -22,18 +24,10 @@ Proof.
 intros; rewrite H; reflexivity.
 Qed.
 
-Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2.
-Proof.
-intros; red; intro; elim H; apply eq_IZR; assumption.
-Qed.
-
 Ltac discrR :=
   try
    match goal with
    |  |- (?X1 <> ?X2) =>
-       change 2 with (IZR 2);
-       change 1 with (IZR 1);
-       change 0 with (IZR 0);
        repeat
          rewrite <- plus_IZR ||
            rewrite <- mult_IZR ||
@@ -52,9 +46,6 @@ Ltac prove_sup0 :=
   end.
 
 Ltac omega_sup :=
-  change 2 with (IZR 2);
-  change 1 with (IZR 1);
-  change 0 with (IZR 0);
   repeat
     rewrite <- plus_IZR ||
       rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus;
@@ -72,9 +63,6 @@ Ltac prove_sup :=
   end.
 
 Ltac Rcompute :=
-  change 2 with (IZR 2);
-  change 1 with (IZR 1);
-  change 0 with (IZR 0);
   repeat
     rewrite <- plus_IZR ||
       rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus;
diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v
index 569518f7..3de131ea 100644
--- a/theories/Reals/Exp_prop.v
+++ b/theories/Reals/Exp_prop.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -439,20 +441,16 @@ Proof.
   repeat rewrite <- Rmult_assoc.
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l.
-  replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ].
-  rewrite Rmult_assoc.
-  rewrite Rmult_comm.
-  replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ].
+  change 4 with (Rsqr 2).
   rewrite <- Rsqr_mult.
   apply Rsqr_incr_1.
-  replace 2 with (INR 2).
-  rewrite <- mult_INR; apply H1.
-  reflexivity.
+  change 2 with (INR 2).
+  rewrite Rmult_comm, <- mult_INR; apply H1.
   left; apply lt_INR_0; apply H.
   left; apply Rmult_lt_0_compat.
-  prove_sup0.
   apply lt_INR_0; apply div2_not_R0.
   apply lt_n_S; apply H.
+  now apply IZR_lt.
   cut (1 < S N)%nat.
   intro; unfold Rsqr; apply prod_neq_R0; apply not_O_INR; intro;
     assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4;
@@ -536,7 +534,7 @@ Proof.
   apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))).
   apply INR_fact_lt_0.
   rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
-  replace 1 with (INR 1); [ apply le_INR | reflexivity ].
+  apply (le_INR 1).
   apply lt_le_S.
   apply INR_lt.
   apply INR_fact_lt_0.
diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v
index e3760e01..1f4fd576 100644
--- a/theories/Reals/Integration.v
+++ b/theories/Reals/Integration.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export NewtonInt.
diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v
index 26c51583..717df1b1 100644
--- a/theories/Reals/MVT.v
+++ b/theories/Reals/MVT.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Machin.v b/theories/Reals/Machin.v
index 19db476f..cdf98cbd 100644
--- a/theories/Reals/Machin.v
+++ b/theories/Reals/Machin.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Fourier.
@@ -53,7 +55,7 @@ assert (-(PI/4) <= atan x).
  destruct xm1 as [xm1 | xm1].
   rewrite <- atan_1, <- atan_opp; apply Rlt_le, atan_increasing.
   assumption.
- solve[rewrite <- xm1, atan_opp, atan_1; apply Rle_refl].
+ solve[rewrite <- xm1; change (-1) with (-(1)); rewrite atan_opp, atan_1; apply Rle_refl].
 assert (-(PI/4) < atan y).
  rewrite <- atan_1, <- atan_opp; apply atan_increasing.
  assumption.
diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v
index ed5ae90c..66918eee 100644
--- a/theories/Reals/NewtonInt.v
+++ b/theories/Reals/NewtonInt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v
index 03ac6582..61d1b5af 100644
--- a/theories/Reals/PSeries_reg.v
+++ b/theories/Reals/PSeries_reg.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v
index 37d54a6d..33feeac0 100644
--- a/theories/Reals/PartSum.v
+++ b/theories/Reals/PartSum.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v
index 379fee6f..59a10496 100644
--- a/theories/Reals/RIneq.v
+++ b/theories/Reals/RIneq.v
@@ -1,10 +1,12 @@
-(* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
+(************************************************************************)
 (************************************************************************)
 
 (*********************************************************)
@@ -1611,6 +1613,9 @@ Proof.
 Qed.
 Hint Resolve mult_INR: real.
 
+Lemma pow_INR (m n: nat) :  INR (m ^ n) = pow (INR m) n.
+Proof. now induction n as [|n IHn];[ | simpl; rewrite mult_INR, IHn]. Qed.
+
 (*********)
 Lemma lt_0_INR : forall n:nat, (0 < n)%nat -> 0 < INR n.
 Proof.
@@ -1629,7 +1634,7 @@ Hint Resolve lt_INR: real.
 
 Lemma lt_1_INR : forall n:nat, (1 < n)%nat -> 1 < INR n.
 Proof.
-  intros; replace 1 with (INR 1); auto with real.
+  apply lt_INR.
 Qed.
 Hint Resolve lt_1_INR: real.
 
@@ -1653,17 +1658,16 @@ Hint Resolve pos_INR: real.
 
 Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat.
 Proof.
-  double induction n m; intros.
-  simpl; exfalso; apply (Rlt_irrefl 0); auto.
-  auto with arith.
-  generalize (pos_INR (S n0)); intro; cut (INR 0 = 0);
-    [ intro H2; rewrite H2 in H0; idtac | simpl; trivial ].
-  generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; exfalso;
-    apply (Rlt_irrefl 0); auto.
-  do 2 rewrite S_INR in H1; cut (INR n1 < INR n0).
-  intro H2; generalize (H0 n0 H2); intro; auto with arith.
-  apply (Rplus_lt_reg_l 1 (INR n1) (INR n0)).
-  rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial.
+  intros n m. revert n.
+  induction m ; intros n H.
+  - elim (Rlt_irrefl 0).
+    apply Rle_lt_trans with (2 := H).
+    apply pos_INR.
+  - destruct n as [|n].
+    apply Nat.lt_0_succ.
+    apply lt_n_S, IHm.
+    rewrite 2!S_INR in H.
+    apply Rplus_lt_reg_r with (1 := H).
 Qed.
 Hint Resolve INR_lt: real.
 
@@ -1707,14 +1711,10 @@ Hint Resolve not_INR: real.
 
 Lemma INR_eq : forall n m:nat, INR n = INR m -> n = m.
 Proof.
-  intros; case (le_or_lt n m); intros H1.
-  case (le_lt_or_eq _ _ H1); intros H2; auto.
-  cut (n <> m).
-  intro H3; generalize (not_INR n m H3); intro H4; exfalso; auto.
-  omega.
-  symmetry ; cut (m <> n).
-  intro H3; generalize (not_INR m n H3); intro H4; exfalso; auto.
-  omega.
+  intros n m HR.
+  destruct (dec_eq_nat n m) as [H|H].
+  exact H.
+  now apply not_INR in H.
 Qed.
 Hint Resolve INR_eq: real.
 
@@ -1728,7 +1728,8 @@ Hint Resolve INR_le: real.
 
 Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1.
 Proof.
-  replace 1 with (INR 1); auto with real.
+  intros n.
+  apply not_INR.
 Qed.
 Hint Resolve not_1_INR: real.
 
@@ -1743,24 +1744,40 @@ Proof.
   intros z; idtac; apply Z_of_nat_complete; assumption.
 Qed.
 
+Lemma INR_IPR : forall p, INR (Pos.to_nat p) = IPR p.
+Proof.
+  assert (H: forall p, 2 * INR (Pos.to_nat p) = IPR_2 p).
+    induction p as [p|p|] ; simpl IPR_2.
+    rewrite Pos2Nat.inj_xI, S_INR, mult_INR, <- IHp.
+    now rewrite (Rplus_comm (2 * _)).
+    now rewrite Pos2Nat.inj_xO, mult_INR, <- IHp.
+    apply Rmult_1_r.
+  intros [p|p|] ; unfold IPR.
+  rewrite Pos2Nat.inj_xI, S_INR, mult_INR, <- H.
+  apply Rplus_comm.
+  now rewrite Pos2Nat.inj_xO, mult_INR, <- H.
+  easy.
+Qed.
+
 (**********)
 Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z.of_nat n).
 Proof.
-  simple induction n; auto with real.
-  intros; simpl; rewrite SuccNat2Pos.id_succ;
-    auto with real.
+  intros [|n].
+  easy.
+  simpl Z.of_nat. unfold IZR.
+  now rewrite <- INR_IPR, SuccNat2Pos.id_succ.
 Qed.
 
 Lemma plus_IZR_NEG_POS :
   forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q).
 Proof.
   intros p q; simpl. rewrite Z.pos_sub_spec.
-  case Pos.compare_spec; intros H; simpl.
+  case Pos.compare_spec; intros H; unfold IZR.
   subst. ring.
-  rewrite Pos2Nat.inj_sub by trivial.
+  rewrite <- 3!INR_IPR, Pos2Nat.inj_sub by trivial.
   rewrite minus_INR by (now apply lt_le_weak, Pos2Nat.inj_lt).
   ring.
-  rewrite Pos2Nat.inj_sub by trivial.
+  rewrite <- 3!INR_IPR, Pos2Nat.inj_sub by trivial.
   rewrite minus_INR by (now apply lt_le_weak, Pos2Nat.inj_lt).
   ring.
 Qed.
@@ -1769,26 +1786,18 @@ Qed.
 Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m.
 Proof.
   intro z; destruct z; intro t; destruct t; intros; auto with real.
-  simpl; intros; rewrite Pos2Nat.inj_add; auto with real.
+  simpl. unfold IZR. rewrite <- 3!INR_IPR, Pos2Nat.inj_add. apply plus_INR.
   apply plus_IZR_NEG_POS.
   rewrite Z.add_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS.
-  simpl; intros; rewrite Pos2Nat.inj_add; rewrite plus_INR;
-    auto with real.
+  simpl. unfold IZR. rewrite <- 3!INR_IPR, Pos2Nat.inj_add, plus_INR.
+  apply Ropp_plus_distr.
 Qed.
 
 (**********)
 Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m.
 Proof.
-  intros z t; case z; case t; simpl; auto with real.
-  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
-  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
-  rewrite Rmult_comm.
-  rewrite Ropp_mult_distr_l_reverse; auto with real.
-  apply Ropp_eq_compat; rewrite mult_comm; auto with real.
-  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
-  rewrite Ropp_mult_distr_l_reverse; auto with real.
-  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
-  rewrite Rmult_opp_opp; auto with real.
+  intros z t; case z; case t; simpl; auto with real;
+    unfold IZR; intros m n; rewrite <- 3!INR_IPR, Pos2Nat.inj_mul, mult_INR; ring.
 Qed.
 
 Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Z.pow z (Z.of_nat n)).
@@ -1804,13 +1813,13 @@ Qed.
 (**********)
 Lemma succ_IZR : forall n:Z, IZR (Z.succ n) = IZR n + 1.
 Proof.
-  intro; change 1 with (IZR 1); unfold Z.succ; apply plus_IZR.
+  intro; unfold Z.succ; apply plus_IZR.
 Qed.
 
 (**********)
 Lemma opp_IZR : forall n:Z, IZR (- n) = - IZR n.
 Proof.
-  intro z; case z; simpl; auto with real.
+  intros [|z|z]; unfold IZR; simpl; auto with real.
 Qed.
 
 Definition Ropp_Ropp_IZR := opp_IZR.
@@ -1833,10 +1842,12 @@ Qed.
 Lemma lt_0_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z.
 Proof.
   intro z; case z; simpl; intros.
-  absurd (0 < 0); auto with real.
-  unfold Z.lt; simpl; trivial.
-  case Rlt_not_le with (1 := H).
-  replace 0 with (-0); auto with real.
+  elim (Rlt_irrefl _ H).
+  easy.
+  elim (Rlt_not_le _ _ H).
+  unfold IZR.
+  rewrite <- INR_IPR.
+  auto with real.
 Qed.
 
 (**********)
@@ -1852,9 +1863,12 @@ Qed.
 Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z.
 Proof.
   intro z; destruct z; simpl; intros; auto with zarith.
-  case (Rlt_not_eq 0 (INR (Pos.to_nat p))); auto with real.
-  case (Rlt_not_eq (- INR (Pos.to_nat p)) 0); auto with real.
-  apply Ropp_lt_gt_0_contravar. unfold Rgt; apply pos_INR_nat_of_P.
+  elim Rgt_not_eq with (2 := H).
+  unfold IZR. rewrite <- INR_IPR.
+  apply lt_0_INR, Pos2Nat.is_pos.
+  elim Rlt_not_eq with (2 := H).
+  unfold IZR. rewrite <- INR_IPR.
+  apply Ropp_lt_gt_0_contravar, lt_0_INR, Pos2Nat.is_pos.
 Qed.
 
 (**********)
@@ -1892,8 +1906,8 @@ Qed.
 (**********)
 Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z.
 Proof.
-  pattern 1 at 1; replace 1 with (IZR 1); intros; auto.
-  apply le_IZR; trivial.
+  intros n.
+  apply le_IZR.
 Qed.
 
 (**********)
@@ -1917,12 +1931,23 @@ Proof.
   omega.
 Qed.
 
+Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2.
+Proof.
+intros; red; intro; elim H; apply eq_IZR; assumption.
+Qed.
+
+Hint Extern 0 (IZR _ <= IZR _) => apply IZR_le, Zle_bool_imp_le, eq_refl : real.
+Hint Extern 0 (IZR _ >= IZR _) => apply Rle_ge, IZR_le, Zle_bool_imp_le, eq_refl : real.
+Hint Extern 0 (IZR _ <  IZR _) => apply IZR_lt, eq_refl : real.
+Hint Extern 0 (IZR _ >  IZR _) => apply IZR_lt, eq_refl : real.
+Hint Extern 0 (IZR _ <> IZR _) => apply IZR_neq, Zeq_bool_neq, eq_refl : real.
+
 Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z.
 Proof.
   intros z [H1 H2].
   apply Z.le_antisymm.
   apply Z.lt_succ_r; apply lt_IZR; trivial.
-  replace 0%Z with (Z.succ (-1)); trivial.
+  change 0%Z with (Z.succ (-1)).
   apply Z.le_succ_l; apply lt_IZR; trivial.
 Qed.
 
@@ -1999,10 +2024,34 @@ Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2.
 Proof.
   intro; rewrite <- double; unfold Rdiv; rewrite <- Rmult_assoc;
     symmetry ; apply Rinv_r_simpl_m.
-  replace 2 with (INR 2);
-  [ apply not_0_INR; discriminate | unfold INR; ring ].
+  now apply not_0_IZR.
+Qed.
+
+Lemma R_rm : ring_morph
+  0%R 1%R Rplus Rmult Rminus Ropp eq
+  0%Z 1%Z Zplus Zmult Zminus Z.opp Zeq_bool IZR.
+Proof.
+constructor ; try easy.
+exact plus_IZR.
+exact minus_IZR.
+exact mult_IZR.
+exact opp_IZR.
+intros x y H.
+apply f_equal.
+now apply Zeq_bool_eq.
+Qed.
+
+Lemma Zeq_bool_IZR x y :
+  IZR x = IZR y -> Zeq_bool x y = true.
+Proof.
+intros H.
+apply Zeq_is_eq_bool.
+now apply eq_IZR.
 Qed.
 
+Add Field RField : Rfield
+  (completeness Zeq_bool_IZR, morphism R_rm, constants [IZR_tac], power_tac R_power_theory [Rpow_tac]).
+
 (*********************************************************)
 (** ** Other rules about < and <=                        *)
 (*********************************************************)
@@ -2017,42 +2066,18 @@ Qed.
 Lemma le_epsilon :
   forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2.
 Proof.
-  intros x y; intros; elim (Rtotal_order x y); intro.
-  left; assumption.
-  elim H0; intro.
-  right; assumption.
-  clear H0; generalize (Rgt_minus x y H1); intro H2; change (0 < x - y) in H2.
-  cut (0 < 2).
-  intro.
-  generalize (Rmult_lt_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0));
-    intro H3; generalize (H ((x - y) * / 2) H3);
-      replace (y + (x - y) * / 2) with ((y + x) * / 2).
-  intro H4;
-    generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4);
-      rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc;
-        rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; replace (2 * x) with (x + x).
-  rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption.
-  ring.
-  replace 2 with (INR 2); [ apply not_0_INR; discriminate | reflexivity ].
-  pattern y at 2; replace y with (y / 2 + y / 2).
-  unfold Rminus, Rdiv.
-  repeat rewrite Rmult_plus_distr_r.
-  ring.
-  cut (forall z:R, 2 * z = z + z).
-  intro.
-  rewrite <- (H4 (y / 2)).
-  unfold Rdiv.
-  rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
-  replace 2 with (INR 2).
-  apply not_0_INR.
-  discriminate.
-  unfold INR; reflexivity.
-  intro; ring.
-  cut (0%nat <> 2%nat);
-    [ intro H0; generalize (lt_0_INR 2 (neq_O_lt 2 H0)); unfold INR;
-      intro; assumption
-      | discriminate ].
+  intros x y H.
+  destruct (Rle_or_lt x y) as [H1|H1].
+  exact H1.
+  apply Rplus_le_reg_r with x.
+  replace (y + x) with (2 * (y + (x - y) * / 2)) by field.
+  replace (x + x) with (2 * x) by ring.
+  apply Rmult_le_compat_l.
+  now apply (IZR_le 0 2).
+  apply H.
+  apply Rmult_lt_0_compat.
+  now apply Rgt_minus.
+  apply Rinv_0_lt_compat, Rlt_0_2.
 Qed.
 
 (**********)
diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v
index 924d5117..e12937c7 100644
--- a/theories/Reals/RList.v
+++ b/theories/Reals/RList.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/ROrderedType.v b/theories/Reals/ROrderedType.v
index f2dc7fd0..ee65ee1d 100644
--- a/theories/Reals/ROrderedType.v
+++ b/theories/Reals/ROrderedType.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase Equalities Orders OrdersTac.
diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v
index b6d07283..77e2a1e0 100644
--- a/theories/Reals/R_Ifp.v
+++ b/theories/Reals/R_Ifp.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (**********************************************************)
@@ -42,28 +44,23 @@ Qed.
 Lemma up_tech :
   forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r.
 Proof.
-  intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H;
-    rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1;
-      cut (1 = IZR 1); auto with zarith real.
-  intro; generalize H1; pattern 1 at 1; rewrite H; intro; clear H H1;
-    rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1));
-      auto with zarith real.
+  intros.
+  apply tech_up with (1 := H0).
+  rewrite plus_IZR.
+  now apply Rplus_le_compat_r.
 Qed.
 
 (**********)
 Lemma fp_R0 : frac_part 0 = 0.
 Proof.
-  unfold frac_part; unfold Int_part; elim (archimed 0); intros;
-    unfold Rminus; elim (Rplus_ne (- IZR (up 0 - 1)));
-      intros a b; rewrite b; clear a b; rewrite <- Z_R_minus;
-        cut (up 0 = 1%Z).
-  intro; rewrite H1;
-    rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (eq_refl (IZR 1)));
-      apply Ropp_0.
-  elim (archimed 0); intros; clear H2; unfold Rgt in H1;
-    rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1);
-      intro; clear H1; generalize (le_IZR_R1 (up 0) H0);
-        intro; clear H H0; omega.
+  unfold frac_part, Int_part.
+  replace (up 0) with 1%Z.
+  now rewrite <- minus_IZR.
+  destruct (archimed 0) as [H1 H2].
+  apply lt_IZR in H1.
+  rewrite <- minus_IZR in H2.
+  apply le_IZR in H2.
+  omega.
 Qed.
 
 (**********)
@@ -112,21 +109,12 @@ Lemma base_Int_part :
 Proof.
   intro; unfold Int_part; elim (archimed r); intros.
   split; rewrite <- (Z_R_minus (up r) 1); simpl.
-  generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1;
-    rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1;
-      rewrite (Rplus_comm (- r) (-1)) in H1;
-        rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1;
-          fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1;
-            apply Rminus_le; auto with zarith real.
-  generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro;
-    rewrite (Rplus_comm (-1) (IZR (up r))) in H1;
-      generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1);
-        intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2;
-          fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2;
-            rewrite (Rplus_comm (- r) (-1 + r)) in H2;
-              rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2;
-                elim (Rplus_ne (-1)); intros a b; rewrite a in H2;
-                  clear a b; auto with zarith real.
+  apply Rminus_le.
+  replace (IZR (up r) - 1 - r) with (IZR (up r) - r - 1) by ring.
+  now apply Rle_minus.
+  apply Rminus_gt.
+  replace (IZR (up r) - 1 - r - -1) with (IZR (up r) - r) by ring.
+  now apply Rgt_minus.
 Qed.
 
 (**********)
@@ -238,9 +226,7 @@ Proof.
                                                                                                               rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H;
                                                                                                                 elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H;
                                                                                                                   clear a b; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
-                                                                                                                    rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
-                                                                                                                      cut (1 = IZR 1); auto with zarith real.
-  intro; rewrite H1 in H; clear H1;
+                                                                                                                    rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H.
     rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H;
       generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H);
         intros; clear H H0; unfold Int_part at 1;
@@ -324,12 +310,12 @@ Proof.
                                                                                                       rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0;
                                                                                                         elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0;
                                                                                                           clear a b; rewrite <- (Rplus_opp_l 1) in H0;
-                                                                                                            rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1)
+                                                                                                            rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-(1)) 1)
                                                                                                               in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H0;
                                                                                                                 rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
                                                                                                                   rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
-                                                                                                                    cut (1 = IZR 1); auto with zarith real.
-  intro; rewrite H1 in H; rewrite H1 in H0; clear H1;
+                                                                                                                    auto with zarith real.
+  change (_ + -1) with (IZR (Int_part r1 - Int_part r2) - 1) in H;
     rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H;
       rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H0;
         rewrite <- (plus_IZR (Int_part r1 - Int_part r2 - 1) 1) in H0;
@@ -442,9 +428,9 @@ Proof.
                                                                 in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
                                                                   elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0;
                                                                     clear a b;
+                                                                      change 2 with (1 + 1) in H0;
                                                                       rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0;
-                                                                        cut (1 = IZR 1); auto with zarith real.
-  intro; rewrite H1 in H0; rewrite H1 in H; clear H1;
+                                                                        auto with zarith real.
     rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H;
       rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0;
         rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H;
@@ -507,9 +493,7 @@ Proof.
                                                                 in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
                                                                   elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2)));
                                                                     intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2));
-                                                                      intros a b; rewrite b in H0; clear a b; cut (1 = IZR 1);
-                                                                        auto with zarith real.
-  intro; rewrite H in H1; clear H;
+                                                                      intros a b; rewrite b in H0; clear a b.
     rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0;
       rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1;
         rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1;
@@ -536,7 +520,7 @@ Proof.
                     rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
                       unfold Rminus;
                         rewrite
-                          (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1))
+                          (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-(1)))
                           ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1);
                             trivial with zarith real.
 Qed.
diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v
index 445ffcb2..a60bb7cf 100644
--- a/theories/Reals/R_sqr.v
+++ b/theories/Reals/R_sqr.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -296,56 +298,9 @@ Lemma canonical_Rsqr :
     a * Rsqr (x + b / (2 * a)) + (4 * a * c - Rsqr b) / (4 * a).
 Proof.
   intros.
-  rewrite Rsqr_plus.
-  repeat rewrite Rmult_plus_distr_l.
-  repeat rewrite Rplus_assoc.
-  apply Rplus_eq_compat_l.
-  unfold Rdiv, Rminus.
-  replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ].
-  rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))).
-  rewrite Rsqr_mult.
-  repeat rewrite Rinv_mult_distr.
-  repeat rewrite (Rmult_comm a).
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite (Rmult_comm 2).
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite (Rmult_comm (/ 2)).
-  rewrite (Rmult_comm 2).
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite (Rmult_comm a).
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite (Rmult_comm 2).
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  repeat rewrite Rplus_assoc.
-  rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))).
-  repeat rewrite Rplus_assoc.
-  rewrite (Rmult_comm x).
-  apply Rplus_eq_compat_l.
-  rewrite (Rmult_comm (/ a)).
-  unfold Rsqr; repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  ring.
-  apply (cond_nonzero a).
-  discrR.
-  apply (cond_nonzero a).
-  discrR.
-  discrR.
-  apply (cond_nonzero a).
-  discrR.
-  discrR.
-  discrR.
-  apply (cond_nonzero a).
-  discrR.
-  apply (cond_nonzero a).
+  unfold Rsqr.
+  field.
+  apply a.
 Qed.
 
 Lemma Rsqr_eq : forall x y:R, Rsqr x = Rsqr y -> x = y \/ x = - y.
diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v
index a6b1a26e..d4035fad 100644
--- a/theories/Reals/R_sqrt.v
+++ b/theories/Reals/R_sqrt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -359,107 +361,22 @@ Lemma Rsqr_sol_eq_0_1 :
     x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0.
 Proof.
   intros; elim H0; intro.
-  unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv;
-    repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg;
-      rewrite Rsqr_sqrt.
-  rewrite Rsqr_inv.
-  unfold Rsqr; repeat rewrite Rinv_mult_distr.
-  repeat rewrite Rmult_assoc; rewrite (Rmult_comm a).
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; rewrite Rmult_plus_distr_r.
-  repeat rewrite Rmult_assoc.
-  pattern 2 at 2; rewrite (Rmult_comm 2).
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite
-    (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a))
-    .
-  rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc.
-  replace
-  (- b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) +
-    (b * (- b * (/ 2 * / a)) +
-      (b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + c))) with
-  (b * (- b * (/ 2 * / a)) + c).
-  unfold Rminus; repeat rewrite <- Rplus_assoc.
-  replace (b * b + b * b) with (2 * (b * b)).
-  rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
-    rewrite (Rmult_comm 2).
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc;
-    rewrite (Rmult_comm 2).
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm a); rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; rewrite <- Rmult_opp_opp.
-  ring.
-  apply (cond_nonzero a).
-  discrR.
-  discrR.
-  discrR.
-  ring.
-  ring.
-  discrR.
-  apply (cond_nonzero a).
-  discrR.
-  apply (cond_nonzero a).
-  apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
-  apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
-  apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
-  assumption.
-  unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv;
-    repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg;
-      rewrite Rsqr_sqrt.
-  rewrite Rsqr_inv.
-  unfold Rsqr; repeat rewrite Rinv_mult_distr;
-    repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm a); repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; unfold Rminus; rewrite Rmult_plus_distr_r.
-  rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
-    pattern 2 at 2; rewrite (Rmult_comm 2).
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r;
-    rewrite
-      (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c)))))
-        (/ 2 * / a)).
-  rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc.
-  rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive.
-  replace
-  (b * (sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) +
-    (b * (- b * (/ 2 * / a)) +
-      (b * (- sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + c))) with
-  (b * (- b * (/ 2 * / a)) + c).
-  repeat rewrite <- Rplus_assoc; replace (b * b + b * b) with (2 * (b * b)).
-  rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc;
-    rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
-      rewrite <- Rinv_l_sym.
-  rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a);
-    rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; ring.
-  apply (cond_nonzero a).
-  discrR.
-  discrR.
-  discrR.
-  ring.
-  ring.
-  discrR.
-  apply (cond_nonzero a).
-  discrR.
-  discrR.
-  apply (cond_nonzero a).
-  apply prod_neq_R0; discrR || apply (cond_nonzero a).
-  apply prod_neq_R0; discrR || apply (cond_nonzero a).
-  apply prod_neq_R0; discrR || apply (cond_nonzero a).
-  assumption.
+  rewrite H1.
+  unfold sol_x1, Delta, Rsqr.
+  field_simplify.
+  rewrite <- (Rsqr_pow2 (sqrt _)), Rsqr_sqrt.
+  field.
+  apply a.
+  apply H.
+  apply a.
+  rewrite H1.
+  unfold sol_x2, Delta, Rsqr.
+  field_simplify.
+  rewrite <- (Rsqr_pow2 (sqrt _)), Rsqr_sqrt.
+  field.
+  apply a.
+  apply H.
+  apply a.
 Qed.
 
 Lemma Rsqr_sol_eq_0_0 :
@@ -505,10 +422,10 @@ Proof.
   rewrite (Rmult_comm (/ a)).
   rewrite Rmult_assoc.
   rewrite <- Rinv_mult_distr.
-  replace (2 * (2 * a) * a) with (Rsqr (2 * a)).
+  replace (4 * a * a) with (Rsqr (2 * a)).
   reflexivity.
   ring_Rsqr.
-  rewrite <- Rmult_assoc; apply prod_neq_R0;
+  apply prod_neq_R0;
     [ discrR | apply (cond_nonzero a) ].
   apply (cond_nonzero a).
   assumption.
diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v
index 88ebb88b..4bde9b60 100644
--- a/theories/Reals/Ranalysis.v
+++ b/theories/Reals/Ranalysis.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -26,4 +28,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/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v
index 9e3abd81..36ac738c 100644
--- a/theories/Reals/Ranalysis1.v
+++ b/theories/Reals/Ranalysis1.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v
index 0254218c..7a97ca63 100644
--- a/theories/Reals/Ranalysis2.v
+++ b/theories/Reals/Ranalysis2.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -88,17 +90,11 @@ Proof.
   right; unfold Rdiv.
   repeat rewrite Rabs_mult.
   rewrite Rabs_Rinv; discrR.
-  replace (Rabs 8) with 8.
-  replace 8 with 8; [ idtac | ring ].
-  rewrite Rinv_mult_distr; [ idtac | discrR | discrR ].
-  replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with
-  (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x)));
-  [ idtac | ring ].
-  replace (Rabs eps) with eps.
-  repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
-  ring.
-  symmetry ; apply Rabs_right; left; assumption.
-  symmetry ; apply Rabs_right; left; prove_sup.
+  rewrite (Rabs_pos_eq 8) by now apply IZR_le.
+  rewrite (Rabs_pos_eq eps).
+  field.
+  now apply Rabs_no_R0.
+  now apply Rlt_le.
 Qed.
 
 Lemma maj_term2 :
@@ -429,10 +425,7 @@ Proof.
   intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10);
     rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12;
       [ idtac | discrR ].
-  cut (IZR 1 < IZR 2).
-  unfold IZR; unfold INR, Pos.to_nat; simpl; intro;
-    elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)).
-  apply IZR_lt; omega.
+  now apply lt_IZR in H12.
   unfold Rabs; case (Rcase_abs (/ 2)) as [Hlt|Hge].
   assert (Hyp : 0 < 2).
   prove_sup0.
diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v
index 4e88714d..301d6d2c 100644
--- a/theories/Reals/Ranalysis3.v
+++ b/theories/Reals/Ranalysis3.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -201,8 +203,8 @@ Proof.
   apply Rabs_pos_lt.
   unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc.
   repeat apply prod_neq_R0; try assumption.
-  red; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6).
-  apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption.
+  now apply Rgt_not_eq.
+  apply Rinv_neq_0_compat; apply prod_neq_R0; [discrR | assumption].
   apply H13.
   split.
   apply D_x_no_cond; assumption.
@@ -213,8 +215,7 @@ Proof.
   red; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
   assumption.
   assumption.
-  apply Rinv_neq_0_compat; repeat apply prod_neq_R0;
-    [ discrR | discrR | discrR | assumption ].
+  apply Rinv_neq_0_compat; apply prod_neq_R0; [discrR | assumption].
 (***********************************)
 (*        Third case               *)
 (*     (f1 x)<>0  l1=0  l2=0       *)
@@ -224,11 +225,11 @@ Proof.
   elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
     [ idtac
       | apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc;
-        repeat apply prod_neq_R0;
+        repeat apply prod_neq_R0 ;
           [ assumption
             | assumption
-            | red; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6)
-            | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ].
+            | now apply Rgt_not_eq
+            | apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption ] ].
   intros alp_f2d H12.
   cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)).
   intro.
@@ -295,8 +296,10 @@ Proof.
   elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
     [ idtac
       | apply Rabs_pos_lt; unfold Rsqr, Rdiv;
-        repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0;
-          try assumption || discrR ].
+        repeat apply prod_neq_R0 ;
+          [ assumption..
+            | now apply Rgt_not_eq
+            | apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption ] ].
   intros alp_f2d H11.
   assert (H12 := derivable_continuous_pt _ _ X).
   unfold continuity_pt in H12.
@@ -380,15 +383,9 @@ Proof.
   repeat apply prod_neq_R0; try assumption.
   red; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6).
   apply Rinv_neq_0_compat; discrR.
-  apply Rinv_neq_0_compat; discrR.
-  apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; assumption.
   apply Rinv_neq_0_compat; assumption.
   discrR.
-  discrR.
-  discrR.
-  discrR.
-  discrR.
   apply prod_neq_R0; [ discrR | assumption ].
   elim H13; intros.
   apply H19.
@@ -408,16 +405,9 @@ Proof.
   repeat apply prod_neq_R0; try assumption.
   red; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6).
   apply Rinv_neq_0_compat; discrR.
-  apply Rinv_neq_0_compat; discrR.
-  apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; assumption.
   apply Rinv_neq_0_compat; assumption.
   apply prod_neq_R0; [ discrR | assumption ].
-  red; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
-  apply Rinv_neq_0_compat; discrR.
-  apply Rinv_neq_0_compat; discrR.
-  apply Rinv_neq_0_compat; discrR.
-  apply Rinv_neq_0_compat; assumption.
 (***********************************)
 (*         Fifth case              *)
 (*    (f1 x)<>0  l1<>0  l2=0       *)
diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v
index 661bc8c7..94f1757a 100644
--- a/theories/Reals/Ranalysis4.v
+++ b/theories/Reals/Ranalysis4.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -130,15 +132,8 @@ Proof.
   intro; exists (mkposreal (- x) H1); intros.
   rewrite (Rabs_left x).
   rewrite (Rabs_left (x + h)).
-  rewrite Rplus_comm.
-  rewrite Ropp_plus_distr.
-  unfold Rminus; rewrite Ropp_involutive; rewrite Rplus_assoc;
-    rewrite Rplus_opp_l.
-  rewrite Rplus_0_r; unfold Rdiv.
-  rewrite Ropp_mult_distr_l_reverse.
-  rewrite <- Rinv_r_sym.
-  rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0.
-  apply H2.
+  replace ((-(x + h) - - x) / h - -1) with 0 by now field.
+  rewrite Rabs_R0; apply H0.
   destruct (Rcase_abs h) as [Hlt|Hgt].
   apply Ropp_lt_cancel.
   rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat.
diff --git a/theories/Reals/Ranalysis5.v b/theories/Reals/Ranalysis5.v
index d172139f..afb78e1c 100644
--- a/theories/Reals/Ranalysis5.v
+++ b/theories/Reals/Ranalysis5.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -15,6 +17,7 @@ Require Import RiemannInt.
 Require Import SeqProp.
 Require Import Max.
 Require Import Omega.
+Require Import Lra.
 Local Open Scope R_scope.
 
 (** * Preliminaries lemmas *)
@@ -26,46 +29,34 @@ Lemma f_incr_implies_g_incr_interv : forall f g:R->R, forall lb ub,
        (forall x , f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
        (forall x y, f lb <= x -> x < y -> y <= f ub -> g x < g y).
 Proof.
-intros f g lb ub lb_lt_ub f_incr f_eq_g g_ok x y lb_le_x x_lt_y y_le_ub.
- assert (x_encad : f lb <= x <= f ub).
-  split ; [assumption | apply Rle_trans with (r2:=y) ; [apply Rlt_le|] ; assumption].
- assert (y_encad : f lb <= y <= f ub).
-  split ; [apply Rle_trans with (r2:=x) ; [|apply Rlt_le] ; assumption | assumption].
-  assert (Temp1 : lb <= lb) by intuition ; assert (Temp2 : ub <= ub) by intuition.
- assert (gx_encad := g_ok _ (proj1 x_encad) (proj2 x_encad)).
- assert (gy_encad := g_ok _ (proj1 y_encad) (proj2 y_encad)).
- clear Temp1 Temp2.
- case (Rlt_dec (g x) (g y)).
-  intuition.
+  intros f g lb ub lb_lt_ub f_incr f_eq_g g_ok x y lb_le_x x_lt_y y_le_ub.
+  assert (x_encad : f lb <= x <= f ub) by lra.
+  assert (y_encad : f lb <= y <= f ub) by lra.
+  assert (gx_encad := g_ok _ (proj1 x_encad) (proj2 x_encad)).
+  assert (gy_encad := g_ok _ (proj1 y_encad) (proj2 y_encad)).
+  case (Rlt_dec (g x) (g y)); [ easy |].
   intros Hfalse.
-   assert (Temp := Rnot_lt_le _ _ Hfalse).
-   assert (Hcontradiction : y <= x).
-   replace y with (id y) by intuition ; replace x with (id x) by intuition ;
-   rewrite <- f_eq_g. rewrite <- f_eq_g.
-   assert (f_incr2 : forall x y, lb <= x -> x <= y -> y < ub -> f x <= f y).
+  assert (Temp := Rnot_lt_le _ _ Hfalse).
+  enough (y <= x) by lra.
+  replace y with (id y) by easy.
+  replace x with (id x) by easy.
+  rewrite <- f_eq_g by easy.
+  rewrite <- f_eq_g by easy.
+  assert (f_incr2 : forall x y, lb <= x -> x <= y -> y < ub -> f x <= f y). {
     intros m n lb_le_m m_le_n n_lt_ub.
     case (m_le_n).
-     intros ; apply Rlt_le ; apply f_incr ; [| | apply Rlt_le] ; assumption.
-     intros Hyp ; rewrite Hyp ; apply Req_le ; reflexivity.
-   apply f_incr2.
-   intuition. intuition.
-   Focus 3. intuition.
-   Focus 2. intuition.
-   Focus 2. intuition. Focus 2. intuition.
-   assert (Temp2 : g x <> ub).
-   intro Hf.
-    assert (Htemp : (comp f g) x = f ub).
-     unfold comp ; rewrite Hf ; reflexivity.
-     rewrite f_eq_g in Htemp ; unfold id in Htemp.
-    assert (Htemp2 : x < f ub).
-     apply Rlt_le_trans with (r2:=y) ; intuition.
-    clear -Htemp Htemp2. fourier.
-    intuition. intuition.
-   clear -Temp2 gx_encad.
-   case (proj2 gx_encad).
-    intuition.
-    intro Hfalse ; apply False_ind ; apply Temp2 ; assumption.
-   apply False_ind. clear - Hcontradiction x_lt_y. fourier.
+    - intros; apply Rlt_le, f_incr, Rlt_le; assumption.
+    - intros Hyp; rewrite Hyp; apply Req_le; reflexivity.
+  }
+  apply f_incr2; intuition.
+  enough (g x <> ub) by lra.
+  intro Hf.
+  assert (Htemp : (comp f g) x = f ub). {
+    unfold comp; rewrite Hf; reflexivity.
+  }
+  rewrite f_eq_g in Htemp by easy.
+  unfold id in Htemp.
+  fourier.
 Qed.
 
 Lemma derivable_pt_id_interv : forall (lb ub x:R),
@@ -245,12 +236,8 @@ Lemma IVT_interv_prelim0 : forall (x y:R) (P:R->bool) (N:nat),
        x <= Dichotomy_ub x y P N <= y /\ x <= Dichotomy_lb x y P N <= y.
 Proof.
 assert (Sublemma : forall x y lb ub, lb <= x <= ub /\ lb <= y <= ub -> lb <= (x+y) / 2 <= ub).
- intros x y lb ub Hyp.
-  split.
-  replace lb with ((lb + lb) * /2) by field.
-  unfold Rdiv ; apply Rmult_le_compat_r ; intuition.
-  replace ub with ((ub + ub) * /2) by field.
-  unfold Rdiv ; apply Rmult_le_compat_r ; intuition.
+  intros x y lb ub Hyp.
+  lra.
 intros x y P N x_lt_y.
 induction N.
  simpl ; intuition.
@@ -1027,9 +1014,7 @@ Qed.
 Lemma ub_lt_2_pos : forall x ub lb, lb < x -> x < ub -> 0 < (ub-lb)/2.
 Proof.
 intros x ub lb lb_lt_x x_lt_ub.
- assert (T : 0 < ub - lb).
-  fourier.
- unfold Rdiv ; apply Rlt_mult_inv_pos ; intuition.
+lra.
 Qed.
 
 Definition mkposreal_lb_ub (x lb ub:R) (lb_lt_x:lb<x) (x_lt_ub:x<ub) : posreal.
@@ -1102,7 +1087,7 @@ assert (Main : Rabs ((f (x+h) - fn N (x+h)) - (f x - fn N x) + (fn N (x+h) - fn
     rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg.
     replace (- (fn N (x + h) - fn N x)) with (fn N x - fn N (x + h)) by field.
     assumption.
-   solve[apply Rlt_not_eq ; intuition].
+  now apply Rlt_not_eq, IZR_lt.
   rewrite <- Hc'; clear Hc Hc'.
   replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c).
   replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field.
diff --git a/theories/Reals/Ranalysis_reg.v b/theories/Reals/Ranalysis_reg.v
index 0c27d407..e1d4781b 100644
--- a/theories/Reals/Ranalysis_reg.v
+++ b/theories/Reals/Ranalysis_reg.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Ratan.v b/theories/Reals/Ratan.v
index e13ef1f2..ce39d5ff 100644
--- a/theories/Reals/Ratan.v
+++ b/theories/Reals/Ratan.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Fourier.
@@ -132,7 +134,7 @@ intros [ | N] Npos n decr to0 cv nN.
     unfold Rminus; apply Rplus_le_compat_l, Ropp_le_contravar.
     solve[apply Rge_le, (growing_prop _ _ _ (CV_ALT_step0 f decr) dist)].
    unfold Rminus; rewrite tech5, Ropp_plus_distr, <- Rplus_assoc.
-   unfold tg_alt at 2; rewrite pow_1_odd, Ropp_mult_distr_l_reverse; fourier.
+   unfold tg_alt at 2; rewrite pow_1_odd; fourier.
  rewrite Nodd; destruct (alternated_series_ineq _ _ p decr to0 cv) as [B _].
  destruct (alternated_series_ineq _ _ (S p) decr to0 cv) as [_ C].
  assert (keep : (2 * S p = S (S ( 2 * p)))%nat) by ring.
@@ -161,7 +163,6 @@ clear WLOG; intros Hyp [ | n] decr to0 cv _.
  generalize (alternated_series_ineq f l 0 decr to0 cv).
  unfold R_dist, tg_alt; simpl; rewrite !Rmult_1_l, !Rmult_1_r.
  assert (f 1%nat <= f 0%nat) by apply decr.
- rewrite Ropp_mult_distr_l_reverse.
  intros [A B]; rewrite Rabs_pos_eq; fourier.
 apply Rle_trans with (f 1%nat).
  apply (Hyp 1%nat (le_n 1) (S n) decr to0 cv).
@@ -320,31 +321,12 @@ apply PI2_lower_bound;[split; fourier | ].
 destruct (pre_cos_bound (3/2) 1) as [t _]; [fourier | fourier | ].
 apply Rlt_le_trans with (2 := t); clear t.
 unfold cos_approx; simpl; unfold cos_term.
-simpl mult; replace ((-1)^ 0) with 1 by ring; replace ((-1)^2) with 1 by ring;
- replace ((-1)^4) with 1 by ring; replace ((-1)^1) with (-1) by ring;
- replace ((-1)^3) with (-1) by ring; replace 3 with (IZR 3) by (simpl; ring);
- replace 2 with (IZR 2) by (simpl; ring); simpl Z.of_nat;
- rewrite !INR_IZR_INZ, Ropp_mult_distr_l_reverse, Rmult_1_l.
-match goal with |- _ < ?a =>
-replace a with ((- IZR 3 ^ 6 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) *
-    IZR (Z.of_nat (fact 4)) +
-    IZR 3 ^ 4 * IZR 2 ^ 2 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) *
-    IZR (Z.of_nat (fact 6)) -
-    IZR 3 ^ 2 * IZR 2 ^ 4 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 4)) *
-    IZR (Z.of_nat (fact 6)) +
-    IZR 2 ^ 6 * IZR (Z.of_nat (fact 2)) * IZR (Z.of_nat (fact 4)) *
-    IZR (Z.of_nat (fact 6))) /
-   (IZR 2 ^ 6 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) *
-    IZR (Z.of_nat (fact 4)) * IZR (Z.of_nat (fact 6))));[ | field;
-    repeat apply conj;((rewrite <- INR_IZR_INZ; apply INR_fact_neq_0) ||
-         (apply Rgt_not_eq; apply (IZR_lt 0); reflexivity)) ]
-end.
-rewrite !fact_simpl, !Nat2Z.inj_mul; simpl Z.of_nat.
-unfold Rdiv; apply Rmult_lt_0_compat.
-unfold Rminus; rewrite !pow_IZR, <- !opp_IZR, <- !mult_IZR, <- !opp_IZR, 
-  <- !plus_IZR; apply (IZR_lt 0); reflexivity.
-apply Rinv_0_lt_compat; rewrite !pow_IZR, <- !mult_IZR; apply (IZR_lt 0).
-reflexivity.
+rewrite !INR_IZR_INZ.
+simpl.
+field_simplify.
+unfold Rdiv.
+rewrite Rmult_0_l.
+apply Rdiv_lt_0_compat ; now apply IZR_lt.
 Qed.
 
 Lemma PI2_1 : 1 < PI/2.
@@ -502,11 +484,11 @@ split.
   rewrite (Rmult_comm (-1)); simpl ((/(Rabs y + 1)) ^ 0).
   unfold Rdiv; rewrite Rinv_1, !Rmult_assoc, <- !Rmult_plus_distr_l.
   apply tmp;[assumption | ].
-  rewrite Rplus_assoc, Rmult_1_l; pattern 1 at 3; rewrite <- Rplus_0_r.
+  rewrite Rplus_assoc, Rmult_1_l; pattern 1 at 2; rewrite <- Rplus_0_r.
   apply Rplus_lt_compat_l.
   rewrite <- Rmult_assoc.
   match goal with |- (?a * (-1)) + _ < 0 =>
-   rewrite <- (Rplus_opp_l a), Ropp_mult_distr_r_reverse, Rmult_1_r
+   rewrite <- (Rplus_opp_l a); change (-1) with (-(1)); rewrite Ropp_mult_distr_r_reverse, Rmult_1_r
   end.
   apply Rplus_lt_compat_l.
   assert (0 < u ^ 2) by (apply pow_lt; assumption).
@@ -853,6 +835,8 @@ intros x Hx eps Heps.
    apply Rlt_trans with (2 := H).
    apply Rinv_0_lt_compat.
    exact Heps.
+   unfold N.
+   rewrite INR_IZR_INZ, positive_nat_Z.
    exact HN.
    apply lt_INR.
    omega.
@@ -1076,8 +1060,9 @@ apply Rlt_not_eq; apply Rle_lt_trans with 0;[ | apply Rlt_0_1].
 assert (t := pow2_ge_0 x); fourier.
 replace (1 + x ^ 2) with (1 - - (x ^ 2)) by ring; rewrite <- (tech3 _ n dif).
 apply sum_eq; unfold tg_alt, Datan_seq; intros i _.
-rewrite pow_mult, <- Rpow_mult_distr, Ropp_mult_distr_l_reverse, Rmult_1_l.
-reflexivity.
+rewrite pow_mult, <- Rpow_mult_distr.
+f_equal.
+ring.
 Qed.
 
 Lemma Datan_seq_increasing : forall x y n, (n > 0)%nat -> 0 <= x < y -> Datan_seq x n < Datan_seq y n.
@@ -1165,6 +1150,7 @@ assert (tool : forall a b, a / b - /b = (-1 + a) /b).
  reflexivity.
 set (u := 1 + x ^ 2); rewrite tool; unfold Rminus; rewrite <- Rplus_assoc.
 unfold Rdiv, u.
+change (-1) with (-(1)).
 rewrite Rplus_opp_l, Rplus_0_l, Ropp_mult_distr_l_reverse, Rabs_Ropp.
 rewrite Rabs_mult; clear tool u.
 assert (tool : forall k, Rabs ((-x ^ 2) ^ k) = Rabs ((x ^ 2) ^ k)).
diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v
index 9fbda92a..6019d4fa 100644
--- a/theories/Reals/Raxioms.v
+++ b/theories/Reals/Raxioms.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*********************************************************)
@@ -115,19 +117,6 @@ Arguments INR n%nat.
 
 
 (**********************************************************)
-(** *    Injection from [Z] to [R]                        *)
-(**********************************************************)
-
-(**********)
-Definition IZR (z:Z) : R :=
-  match z with
-  | Z0 => 0
-  | Zpos n => INR (Pos.to_nat n)
-  | Zneg n => - INR (Pos.to_nat n)
-  end.
-Arguments IZR z%Z.
-
-(**********************************************************)
 (** *    [R] Archimedean                                  *)
 (**********************************************************)
 
diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v
index e56ce28d..b63c8e1c 100644
--- a/theories/Reals/Rbase.v
+++ b/theories/Reals/Rbase.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Rdefinitions.
diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v
index c889d734..aa886cee 100644
--- a/theories/Reals/Rbasic_fun.v
+++ b/theories/Reals/Rbasic_fun.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*********************************************************)
@@ -451,20 +453,16 @@ Qed.
 
 Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x.
 Proof.
-  intro; cut (- x = -1 * x).
-  intros; rewrite H.
+  intro; replace (-x) with (-1 * x) by ring.
   rewrite Rabs_mult.
-  cut (Rabs (-1) = 1).
-  intros; rewrite H0.
-  ring.
+  replace (Rabs (-1)) with 1.
+  apply Rmult_1_l.
   unfold Rabs; case (Rcase_abs (-1)).
   intro; ring.
-  intro H0; generalize (Rge_le (-1) 0 H0); intros.
-  generalize (Ropp_le_ge_contravar 0 (-1) H1).
-  rewrite Ropp_involutive; rewrite Ropp_0.
-  intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2);
-    intro; exfalso; auto.
-  ring.
+  rewrite <- Ropp_0.
+  intro H0; apply Ropp_ge_cancel in H0.
+  elim (Rge_not_lt _ _ H0).
+  apply Rlt_0_1.
 Qed.
 
 (*********)
@@ -613,11 +611,12 @@ Qed.
 
 Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Z.abs z).
 Proof.
-  intros z; case z; simpl; auto with real.
-  apply Rabs_right; auto with real.
-  intros p0; apply Rabs_right; auto with real zarith.
+  intros z; case z; unfold Z.abs.
+  apply Rabs_R0.
+  now intros p0; apply Rabs_pos_eq, (IZR_le 0).
+  unfold IZR at 1.
   intros p0; rewrite Rabs_Ropp.
-  apply Rabs_right; auto with real zarith.
+  now apply Rabs_pos_eq, (IZR_le 0).
 Qed.
 
 Lemma abs_IZR : forall z, IZR (Z.abs z) = Rabs (IZR z).
diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v
index 3520c26c..19cbbeca 100644
--- a/theories/Reals/Rcomplete.v
+++ b/theories/Reals/Rcomplete.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v
index f3f8f740..857b4ec3 100644
--- a/theories/Reals/Rdefinitions.v
+++ b/theories/Reals/Rdefinitions.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*********************************************************)
@@ -69,3 +71,32 @@ Notation "x <= y <= z" := (x <= y /\ y <= z) : R_scope.
 Notation "x <= y < z"  := (x <= y /\ y <  z) : R_scope.
 Notation "x < y < z"   := (x <  y /\ y <  z) : R_scope.
 Notation "x < y <= z"  := (x <  y /\ y <= z) : R_scope.
+
+(**********************************************************)
+(** *    Injection from [Z] to [R]                        *)
+(**********************************************************)
+
+(* compact representation for 2*p *)
+Fixpoint IPR_2 (p:positive) : R :=
+  match p with
+  | xH => R1 + R1
+  | xO p => (R1 + R1) * IPR_2 p
+  | xI p => (R1 + R1) * (R1 + IPR_2 p)
+  end.
+
+Definition IPR (p:positive) : R :=
+  match p with
+  | xH => R1
+  | xO p => IPR_2 p
+  | xI p => R1 + IPR_2 p
+  end.
+Arguments IPR p%positive : simpl never.
+
+(**********)
+Definition IZR (z:Z) : R :=
+  match z with
+  | Z0 => R0
+  | Zpos n => IPR n
+  | Zneg n => - IPR n
+  end.
+Arguments IZR z%Z : simpl never.
diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v
index bd330ac9..dfa5c710 100644
--- a/theories/Reals/Rderiv.v
+++ b/theories/Reals/Rderiv.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*********************************************************)
@@ -296,14 +298,10 @@ Proof.
       intros; generalize (H0 eps H1); clear H0; intro; elim H0;
         clear H0; intros; elim H0; clear H0; simpl;
           intros; split with x; split; auto.
-  intros; generalize (H2 x1 H3); clear H2; intro;
-    rewrite Ropp_mult_distr_l_reverse in H2;
-      rewrite Ropp_mult_distr_l_reverse in H2;
-        rewrite Ropp_mult_distr_l_reverse in H2;
-          rewrite (let (H1, H2) := Rmult_ne (f x1) in H2) in H2;
-            rewrite (let (H1, H2) := Rmult_ne (f x0) in H2) in H2;
-              rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2;
-                assumption.
+  intros; generalize (H2 x1 H3); clear H2; intro.
+  replace (- f x1 - - f x0) with (-1 * f x1 - -1 * f x0) by ring.
+  replace (- df x0) with (-1 * df x0) by ring.
+  exact H2.
 Qed.
 
 (*********)
diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v
index 8265f65a..b249b519 100644
--- a/theories/Reals/Reals.v
+++ b/theories/Reals/Reals.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The library REALS is divided in 6 parts :
diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v
index 0a49d498..77e53147 100644
--- a/theories/Reals/Rfunctions.v
+++ b/theories/Reals/Rfunctions.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i Some properties about pow and sum have been made with John Harrison i*)
@@ -416,8 +418,9 @@ Proof.
   simpl; apply Rabs_R1.
   replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ].
   rewrite Rabs_mult.
-  rewrite Hrecn; rewrite Rmult_1_l; simpl; rewrite Rmult_1_r;
-    rewrite Rabs_Ropp; apply Rabs_R1.
+  rewrite Hrecn; rewrite Rmult_1_l; simpl; rewrite Rmult_1_r.
+  change (-1) with (-(1)).
+  rewrite Rabs_Ropp; apply Rabs_R1.
 Qed.
 
 Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = (x ^ n1) ^ n2.
@@ -531,6 +534,36 @@ Qed.
 (*******************************)
 (*i Due to L.Thery i*)
 
+Section PowerRZ.
+
+Local Coercion Z_of_nat : nat >-> Z.
+
+(* the following section should probably be somewhere else, but not sure where *)
+Section Z_compl.
+
+Local Open Scope Z_scope.
+
+(* Provides a way to reason directly on Z in terms of nats instead of positive *)
+Inductive Z_spec (x : Z) : Z -> Type :=
+| ZintNull : x = 0 -> Z_spec x 0
+| ZintPos (n : nat) : x = n -> Z_spec x n
+| ZintNeg (n : nat) : x = - n -> Z_spec x (- n).
+
+Lemma intP (x : Z) : Z_spec x x.
+Proof.
+  destruct x as [|p|p].
+  - now apply ZintNull.
+  - rewrite <-positive_nat_Z at 2.
+    apply ZintPos.
+    now rewrite positive_nat_Z.
+  - rewrite <-Pos2Z.opp_pos.
+    rewrite <-positive_nat_Z at 2.
+    apply ZintNeg.
+    now rewrite positive_nat_Z.
+Qed.
+
+End Z_compl.
+
 Definition powerRZ (x:R) (n:Z) :=
   match n with
     | Z0 => 1
@@ -657,6 +690,74 @@ Proof.
     auto with real.
 Qed.
 
+Local Open Scope Z_scope.
+
+Lemma pow_powerRZ (r : R) (n : nat) :
+  (r ^ n)%R = powerRZ r (Z_of_nat n).
+Proof.
+  induction n; [easy|simpl].
+  now rewrite SuccNat2Pos.id_succ.
+Qed.
+
+Lemma powerRZ_ind (P : Z -> R -> R -> Prop) :
+  (forall x, P 0 x 1%R) ->
+  (forall x n, P (Z.of_nat n) x (x ^ n)%R) ->
+  (forall x n, P ((-(Z.of_nat n))%Z) x (Rinv (x ^ n))) ->
+  forall x (m : Z), P m x (powerRZ x m)%R.
+Proof.
+  intros ? ? ? x m.
+  destruct (intP m) as [Hm|n Hm|n Hm].
+  - easy.
+  - now rewrite <- pow_powerRZ.
+  - unfold powerRZ.
+    destruct n as [|n]; [ easy |].
+    rewrite Nat2Z.inj_succ, <- Zpos_P_of_succ_nat, Pos2Z.opp_pos.
+    now rewrite <- Pos2Z.opp_pos, <- positive_nat_Z.
+Qed.
+
+Lemma powerRZ_inv x alpha : (x <> 0)%R -> powerRZ (/ x) alpha = Rinv (powerRZ x alpha).
+Proof.
+  intros; destruct (intP alpha).
+  - now simpl; rewrite Rinv_1.
+  - now rewrite <-!pow_powerRZ, ?Rinv_pow, ?pow_powerRZ.
+  - unfold powerRZ.
+    destruct (- n).
+    + now rewrite Rinv_1.
+    + now rewrite Rinv_pow.
+    + now rewrite <-Rinv_pow.
+Qed.
+
+Lemma powerRZ_neg x : forall alpha, x <> R0 -> powerRZ x (- alpha) = powerRZ (/ x) alpha.
+Proof.
+  intros [|n|n] H ; simpl.
+  - easy.
+  - now rewrite Rinv_pow.
+  - rewrite Rinv_pow by now apply Rinv_neq_0_compat.
+    now rewrite Rinv_involutive.
+Qed.
+
+Lemma powerRZ_mult_distr :
+  forall m x y, ((0 <= m)%Z \/ (x * y <> 0)%R) ->
+           (powerRZ (x*y) m = powerRZ x m * powerRZ y m)%R.
+Proof.
+  intros m x0 y0 Hmxy.
+  destruct (intP m) as [ | | n Hm ].
+  - now simpl; rewrite Rmult_1_l.
+  - now rewrite <- !pow_powerRZ, Rpow_mult_distr.
+  - destruct Hmxy as [H|H].
+    + assert(m = 0) as -> by now omega.
+      now rewrite <- Hm, Rmult_1_l.
+    + assert(x0 <> 0)%R by now intros ->; apply H; rewrite Rmult_0_l.
+      assert(y0 <> 0)%R by now intros ->; apply H; rewrite Rmult_0_r.
+      rewrite !powerRZ_neg by assumption.
+      rewrite Rinv_mult_distr by assumption.
+      now rewrite <- !pow_powerRZ, Rpow_mult_distr.
+Qed.
+
+End PowerRZ.
+
+Local Infix "^Z" := powerRZ (at level 30, right associativity) : R_scope.
+
 (*******************************)
 (* For easy interface          *)
 (*******************************)
diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v
index 7423ffce..6c2f3ac6 100644
--- a/theories/Reals/Rgeom.v
+++ b/theories/Reals/Rgeom.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v
index 4c0466ac..f7d98fca 100644
--- a/theories/Reals/RiemannInt.v
+++ b/theories/Reals/RiemannInt.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rfunctions.
diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v
index 7885d697..ceac021e 100644
--- a/theories/Reals/RiemannInt_SF.v
+++ b/theories/Reals/RiemannInt_SF.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -83,11 +85,10 @@ Proof.
   cut (x = INR (pred x0)).
   intro H19; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18;
     rewrite <- H19; assumption.
-  rewrite H10; rewrite H8; rewrite <- INR_IZR_INZ; replace 1 with (INR 1);
-    [ idtac | reflexivity ]; rewrite <- minus_INR.
-  replace (x0 - 1)%nat with (pred x0);
-  [ reflexivity
-    | case x0; [ reflexivity | intro; simpl; apply minus_n_O ] ].
+  rewrite H10; rewrite H8; rewrite <- INR_IZR_INZ;
+    rewrite <- (minus_INR _ 1).
+  apply f_equal;
+    case x0; [ reflexivity | intro; apply sym_eq, minus_n_O ].
   induction x0 as [|x0 Hrecx0].
     rewrite H8 in H3. rewrite <- INR_IZR_INZ in H3; simpl in H3.
       elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H3)).
diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v
index e424a732..b14fcc4d 100644
--- a/theories/Reals/Rlimit.v
+++ b/theories/Reals/Rlimit.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*********************************************************)
@@ -29,59 +31,28 @@ Qed.
 Lemma eps2 : forall eps:R, eps * / 2 + eps * / 2 = eps.
 Proof.
   intro esp.
-  assert (H := double_var esp).
-  unfold Rdiv in H.
-  symmetry ; exact H.
+  apply eq_sym, double_var.
 Qed.
 
 (*********)
 Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2.
 Proof.
   intro eps.
-  replace (2 + 2) with 4.
-  pattern eps at 3; rewrite double_var.
-  rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)).
-  unfold Rdiv.
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_mult_distr.
-  reflexivity.
-  discrR.
-  discrR.
-  ring.
+  field.
 Qed.
 
 (*********)
 Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps.
 Proof.
   intros.
-  pattern eps at 2; rewrite <- Rmult_1_r.
-  repeat rewrite (Rmult_comm eps).
-  apply Rmult_lt_compat_r.
-  exact H.
-  apply Rmult_lt_reg_l with 2.
   fourier.
-  rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
-  fourier.
-  discrR.
 Qed.
 
 (*********)
 Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps.
 Proof.
   intros.
-  replace (2 + 2) with 4.
-  pattern eps at 2; rewrite <- Rmult_1_r.
-  repeat rewrite (Rmult_comm eps).
-  apply Rmult_lt_compat_r.
-  exact H.
-  apply Rmult_lt_reg_l with 4.
-  replace 4 with 4.
-  apply Rmult_lt_0_compat; fourier.
-  ring.
-  rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
   fourier.
-  discrR.
-  ring.
 Qed.
 
 (*********)
@@ -407,8 +378,7 @@ Proof.
                       generalize
                         (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0);
                         unfold R_dist; intros; rewrite (Rabs_minus_sym (f x2) l) in H1;
-                          rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1);
-                            elim (Rmult_ne eps); intros a b; rewrite a; clear a b;
+                          rewrite (Rmult_comm 2 eps); replace (eps *2) with (eps + eps) by ring;
                               generalize (R_dist_tri l l' (f x2)); unfold R_dist;
                                 intros;
                                   apply
diff --git a/theories/Reals/Rlogic.v b/theories/Reals/Rlogic.v
index b9a9458c..04f13477 100644
--- a/theories/Reals/Rlogic.v
+++ b/theories/Reals/Rlogic.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This module proves some logical properties of the axiomatic of Reals.
@@ -63,7 +65,7 @@ destruct (Rle_lt_dec l 0) as [Hl|Hl].
   now apply Rinv_0_lt_compat.
   now apply Hnp.
 left.
-set (N := Zabs_nat (up (/l) - 2)).
+set (N := Z.abs_nat (up (/l) - 2)).
 assert (H1l: (1 <= /l)%R).
   rewrite <- Rinv_1.
   apply Rinv_le_contravar with (1 := Hl).
@@ -75,7 +77,7 @@ assert (HN: (INR N + 1 = IZR (up (/ l)) - 1)%R).
   rewrite inj_Zabs_nat.
   replace (IZR (up (/ l)) - 1)%R with (IZR (up (/ l) - 2) + 1)%R.
   apply (f_equal (fun v => IZR v + 1)%R).
-  apply Zabs_eq.
+  apply Z.abs_eq.
   apply Zle_minus_le_0.
   apply (Zlt_le_succ 1).
   apply lt_IZR.
diff --git a/theories/Reals/Rminmax.v b/theories/Reals/Rminmax.v
index 152988dc..7f73f7c1 100644
--- a/theories/Reals/Rminmax.v
+++ b/theories/Reals/Rminmax.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Orders Rbase Rbasic_fun ROrderedType GenericMinMax.
diff --git a/theories/Reals/Rpow_def.v b/theories/Reals/Rpow_def.v
index 791718a4..0d921303 100644
--- a/theories/Reals/Rpow_def.v
+++ b/theories/Reals/Rpow_def.v
@@ -1,15 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rdefinitions.
 
 Fixpoint pow (r:R) (n:nat) : R :=
   match n with
-    | O => R1
+    | O => 1
     | S n => Rmult r (pow r n)
   end.
diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v
index b3ce6fa3..c6fac951 100644
--- a/theories/Reals/Rpower.v
+++ b/theories/Reals/Rpower.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i Due to L.Thery i*)
@@ -55,25 +57,8 @@ Proof.
     simpl in H0.
   replace (/ 3) with
   (1 * / 1 + -1 * 1 * / 1 + -1 * (-1 * 1) * / 2 +
-    -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)).
+    -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)) by field.
   apply H0.
-  repeat rewrite Rinv_1; repeat rewrite Rmult_1_r;
-    rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
-      rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r;
-        rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6.
-  rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6.
-  rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_l; replace 6 with 6.
-  do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym.
-  ring.
-  discrR.
-  discrR.
-  ring.
-  discrR.
-  ring.
-  discrR.
   apply H.
   unfold Un_decreasing; intros;
     apply Rmult_le_reg_l with (INR (fact n)).
@@ -448,9 +433,9 @@ Proof.
 Qed.
 
 Theorem Rpower_lt :
-  forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z.
+  forall x y z:R, 1 < x -> y < z -> x ^R y < x ^R z.
 Proof.
-  intros x y z H H0 H1.
+  intros x y z H H1.
   unfold Rpower.
   apply exp_increasing.
   apply Rmult_lt_compat_r.
@@ -473,7 +458,7 @@ Proof.
   unfold Rpower; auto.
   rewrite Rpower_mult.
   rewrite Rinv_l.
-  replace 1 with (INR 1); auto.
+  change 1 with (INR 1).
   repeat rewrite Rpower_pow; simpl.
   pattern x at 1; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)).
   ring.
@@ -490,12 +475,28 @@ Proof.
   apply exp_Ropp.
 Qed.
 
+Lemma powerRZ_Rpower x z : (0 < x)%R -> powerRZ x z = Rpower x (IZR z).
+Proof.
+  intros Hx.
+  assert (x <> 0)%R
+    by now intros Habs; rewrite Habs in Hx; apply (Rlt_irrefl 0).
+  destruct (intP z).
+  - now rewrite Rpower_O.
+  - rewrite <- pow_powerRZ, <- Rpower_pow by assumption.
+    now rewrite INR_IZR_INZ.
+  - rewrite opp_IZR, Rpower_Ropp.
+    rewrite powerRZ_neg, powerRZ_inv by assumption.
+    now rewrite <- pow_powerRZ, <- INR_IZR_INZ, Rpower_pow.
+Qed.
+
 Theorem Rle_Rpower :
-  forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m.
+  forall e n m:R, 1 <= e -> n <= m -> e ^R n <= e ^R m.
 Proof.
-  intros e n m H H0 H1; case H1.
-  intros H2; left; apply Rpower_lt; assumption.
-  intros H2; rewrite H2; right; reflexivity.
+  intros e n m [H | H]; intros H1.
+  case H1.
+    intros H2; left; apply Rpower_lt; assumption.
+    intros H2; rewrite H2; right; reflexivity.
+  now rewrite <- H; unfold Rpower; rewrite ln_1, !Rmult_0_r; apply Rle_refl.
 Qed.
 
 Theorem ln_lt_2 : / 2 < ln 2.
@@ -505,12 +506,9 @@ Proof.
   rewrite Rinv_r.
   apply exp_lt_inv.
   apply Rle_lt_trans with (1 := exp_le_3).
-  change (3 < 2 ^R 2).
+  change (3 < 2 ^R (1 + 1)).
   repeat rewrite Rpower_plus; repeat rewrite Rpower_1.
-  repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
-    repeat rewrite Rmult_1_l.
-  pattern 3 at 1; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1);
-    [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ].
+  now apply (IZR_lt 3 4).
   prove_sup0.
   discrR.
 Qed.
@@ -713,13 +711,18 @@ intros x y z x0 y0; unfold Rpower.
 rewrite <- exp_plus, ln_mult, Rmult_plus_distr_l; auto.
 Qed.
 
-Lemma Rle_Rpower_l a b c: 0 <= c -> 0 < a <= b -> Rpower a c <= Rpower b c. 
+Lemma Rlt_Rpower_l a b c: 0 < c -> 0 < a < b -> a ^R c < b ^R c.
+Proof.
+intros c0 [a0 ab]; apply exp_increasing.
+now apply Rmult_lt_compat_l; auto; apply ln_increasing; fourier.
+Qed.
+
+Lemma Rle_Rpower_l a b c: 0 <= c -> 0 < a <= b -> a ^R c <= b ^R c.
 Proof.
 intros [c0 | c0];
  [ | intros; rewrite <- c0, !Rpower_O; [apply Rle_refl | |] ].
   intros [a0 [ab|ab]].
-   left; apply exp_increasing.
-   now apply Rmult_lt_compat_l; auto; apply ln_increasing; fourier.
+  now apply Rlt_le, Rlt_Rpower_l;[ | split]; fourier.
   rewrite ab; apply Rle_refl.
  apply Rlt_le_trans with a; tauto.
 tauto.
@@ -732,7 +735,7 @@ Definition arcsinh x := ln (x + sqrt (x ^ 2 + 1)).
 Lemma arcsinh_sinh : forall x, arcsinh (sinh x) = x.
 intros x; unfold sinh, arcsinh.
 assert (Rminus_eq_0 : forall r, r - r = 0) by (intros; ring).
-pattern 1 at 5; rewrite <- exp_0, <- (Rminus_eq_0 x); unfold Rminus.
+rewrite <- exp_0, <- (Rminus_eq_0 x); unfold Rminus.
 rewrite exp_plus.
 match goal with |- context[sqrt ?a] => 
   replace a with (((exp x + exp(-x))/2)^2) by field
diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v
index 883e4e1a..17736af6 100644
--- a/theories/Reals/Rprod.v
+++ b/theories/Reals/Rprod.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Compare.
diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v
index 744fd664..3521a476 100644
--- a/theories/Reals/Rseries.v
+++ b/theories/Reals/Rseries.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -207,7 +209,7 @@ Section sequence.
 
     assert (Rabs (/2) < 1).
     rewrite Rabs_pos_eq.
-    rewrite <- Rinv_1 at 3.
+    rewrite <- Rinv_1.
     apply Rinv_lt_contravar.
     rewrite Rmult_1_l.
     now apply (IZR_lt 0 2).
diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v
index ced2b3da..83c60751 100644
--- a/theories/Reals/Rsigma.v
+++ b/theories/Reals/Rsigma.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v
index b3c9c744..6a3dd976 100644
--- a/theories/Reals/Rsqrt_def.v
+++ b/theories/Reals/Rsqrt_def.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Sumbool.
@@ -648,7 +650,7 @@ Proof.
 Qed.
 
 (** We can now define the square root function as the reciprocal
-   transformation of the square root function *)
+   transformation of the square function *)
 Lemma Rsqrt_exists :
   forall y:R, 0 <= y -> { z:R | 0 <= z /\ y = Rsqr z }.
 Proof.
diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v
index df3b95be..171dba55 100644
--- a/theories/Reals/Rtopology.v
+++ b/theories/Reals/Rtopology.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v
index ecef0d68..ffc0adf5 100644
--- a/theories/Reals/Rtrigo.v
+++ b/theories/Reals/Rtrigo.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Rtrigo1.v b/theories/Reals/Rtrigo1.v
index 4d241863..bf00f736 100644
--- a/theories/Reals/Rtrigo1.v
+++ b/theories/Reals/Rtrigo1.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -182,13 +184,10 @@ destruct (pre_cos_bound _ 0 lo up) as [_ upper].
 apply Rle_lt_trans with (1 := upper).
 apply Rlt_le_trans with (2 := lower).
 unfold cos_approx, sin_approx.
-simpl sum_f_R0; replace 7 with (IZR 7) by (simpl; field).
-replace 8 with (IZR 8) by (simpl; field).
+simpl sum_f_R0.
 unfold cos_term, sin_term; simpl fact; rewrite !INR_IZR_INZ.
-simpl plus; simpl mult.
-field_simplify;
-  try (repeat apply conj; apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity).
-unfold Rminus; rewrite !pow_IZR, <- !mult_IZR, <- !opp_IZR, <- ?plus_IZR.
+simpl plus; simpl mult; simpl Z_of_nat.
+field_simplify.
 match goal with 
   |- IZR ?a / ?b < ?c / ?d =>
   apply Rmult_lt_reg_r with d;[apply (IZR_lt 0); reflexivity |
@@ -198,7 +197,7 @@ match goal with
 end.
 unfold Rdiv; rewrite !Rmult_assoc, Rinv_l, Rmult_1_r;
  [ | apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity].
-repeat (rewrite <- !plus_IZR || rewrite <- !mult_IZR).
+rewrite <- !mult_IZR.
 apply IZR_lt; reflexivity.
 Qed.
 
@@ -323,6 +322,7 @@ Lemma sin_PI : sin PI = 0.
 Proof.
   assert (H := sin2_cos2 PI).
   rewrite cos_PI in H.
+  change (-1) with (-(1)) in H.
   rewrite <- Rsqr_neg in H.
   rewrite Rsqr_1 in H.
   cut (Rsqr (sin PI) = 0).
@@ -533,9 +533,8 @@ Qed.
 
 Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x.
 Proof.
-  intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l;
-    unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse;
-      rewrite Ropp_involutive; apply Rmult_1_l.
+  intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI.
+  ring.
 Qed.
 
 Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x.
@@ -593,9 +592,9 @@ Proof.
     generalize
       (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1)
         (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H)));
-      rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0;
+      rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0.
         generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
-          repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
+          repeat rewrite <- Rplus_assoc; change (-1) with (-(1)); rewrite Rplus_opp_l;
             rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
               generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
                 repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
@@ -603,6 +602,7 @@ Proof.
   auto with real.
   cut (sin x < -1).
   intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H);
+    change (-1) with (-(1));
     rewrite Ropp_involutive; clear H; intro;
       generalize
         (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1)
@@ -610,7 +610,7 @@ Proof.
         rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0;
           rewrite sin2 in H0; unfold Rminus in H0;
             generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
-              repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
+              rewrite <- Rplus_assoc; change (-1) with (-(1)); rewrite Rplus_opp_l;
                 rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
                   generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
                     repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
@@ -696,41 +696,38 @@ Proof.
     rewrite <- Rinv_l_sym.
   do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4).
   apply Rmult_le_compat_l.
-  replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n.
-  simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2);
-    [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a);
-    [ idtac | reflexivity ]; apply Rsqr_incr_1.
+  apply pos_INR.
+  simpl in |- *; rewrite Rmult_1_r; change 4 with (Rsqr 2);
+    apply Rsqr_incr_1.
   apply Rle_trans with (PI / 2);
     [ assumption
       | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2;
         [ prove_sup0
           | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m;
-            [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ].
+            [ apply PI_4 | discrR ] ] ].
   left; assumption.
   left; prove_sup0.
   rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))).
   do 2 rewrite fact_simpl; do 2 rewrite mult_INR.
   repeat rewrite <- Rmult_assoc.
   rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))).
-  rewrite Rmult_assoc.
   apply Rmult_lt_compat_l.
   apply lt_INR_0; apply neq_O_lt.
   assert (H2 := fact_neq_0 (2 * n + 1)).
   red in |- *; intro; elim H2; symmetry  in |- *; assumption.
   do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n);
     unfold INR in |- *.
-  replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
+  replace (((1 + 1) * x + 1 + 1 + 1) * ((1 + 1) * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
   [ idtac | ring ].
-  apply Rplus_lt_reg_l with (-4); rewrite Rplus_opp_l;
-    replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
+  apply Rplus_lt_reg_l with (-(4)); rewrite Rplus_opp_l;
+    replace (-(4) + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
     [ idtac | ring ].
   apply Rplus_le_lt_0_compat.
   cut (0 <= x).
   intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos;
     assumption || left; prove_sup.
-  unfold x in |- *; replace 0 with (INR 0);
-    [ apply le_INR; apply le_O_n | reflexivity ].
-  prove_sup0.
+  apply pos_INR.
+  now apply IZR_lt.
   ring.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
@@ -738,39 +735,33 @@ Proof.
 Qed.
 
 Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a.
+Proof.
   intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0).
 Qed.
 
 Lemma COS :
   forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a.
+Proof.
   intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0).
 Qed.
 
 (**********)
 Lemma _PI2_RLT_0 : - (PI / 2) < 0.
 Proof.
-  rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0.
+  assert (H := PI_RGT_0).
+  fourier.
 Qed.
 
 Lemma PI4_RLT_PI2 : PI / 4 < PI / 2.
 Proof.
-  unfold Rdiv in |- *; apply Rmult_lt_compat_l.
-  apply PI_RGT_0.
-  apply Rinv_lt_contravar.
-  apply Rmult_lt_0_compat; prove_sup0.
-  pattern 2 at 1 in |- *; rewrite <- Rplus_0_r.
-  replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ].
+  assert (H := PI_RGT_0).
+  fourier.
 Qed.
 
 Lemma PI2_Rlt_PI : PI / 2 < PI.
 Proof.
-  unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r.
-  apply Rmult_lt_compat_l.
-  apply PI_RGT_0.
-  pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar.
-  rewrite Rmult_1_l; prove_sup0.
-  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
-    apply Rlt_0_1.
+  assert (H := PI_RGT_0).
+  fourier.
 Qed.
 
 (***************************************************)
@@ -787,12 +778,10 @@ Proof.
   rewrite H3; rewrite sin_PI2; apply Rlt_0_1.
   rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3);
     intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4).
-  replace (PI + - x) with (PI - x).
   replace (PI + - (PI / 2)) with (PI / 2).
   intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6;
     change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6).
   rewrite Rplus_opp_r.
-  replace (PI + - x) with (PI - x).
   intro H7;
     elim
       (SIN (PI - x) (Rlt_le 0 (PI - x) H7)
@@ -800,9 +789,7 @@ Proof.
       intros H8 _;
         generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5));
           intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8).
-  reflexivity.
-  pattern PI at 2 in |- *; rewrite double_var; ring.
-  reflexivity.
+  field.
 Qed.
 
 Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x.
@@ -855,16 +842,12 @@ Proof.
     rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar;
       rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI).
   rewrite cos_period; apply cos_ge_0.
-  replace (- (PI / 2)) with (- PI + PI / 2).
+  replace (- (PI / 2)) with (- PI + PI / 2) by field.
   unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l;
     assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
   unfold Rminus in |- *; rewrite Rplus_comm;
-    replace (PI / 2) with (- PI + 3 * (PI / 2)).
+    replace (PI / 2) with (- PI + 3 * (PI / 2)) by field.
   apply Rplus_le_compat_l; assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
   unfold INR in |- *; ring.
 Qed.
 
@@ -905,16 +888,12 @@ Proof.
     apply Ropp_lt_gt_contravar; rewrite <- neg_cos;
       replace (x + PI) with (x - PI + 2 * INR 1 * PI).
   rewrite cos_period; apply cos_gt_0.
-  replace (- (PI / 2)) with (- PI + PI / 2).
+  replace (- (PI / 2)) with (- PI + PI / 2) by field.
   unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l;
     assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
   unfold Rminus in |- *; rewrite Rplus_comm;
-    replace (PI / 2) with (- PI + 3 * (PI / 2)).
+    replace (PI / 2) with (- PI + 3 * (PI / 2)) by field.
   apply Rplus_lt_compat_l; assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
   unfold INR in |- *; ring.
 Qed.
 
@@ -951,7 +930,7 @@ Lemma cos_ge_0_3PI2 :
   forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x.
 Proof.
   intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1);
-    unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x).
+    unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x) by ring.
   generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1;
     generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1;
       intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1).
@@ -960,36 +939,30 @@ Proof.
     generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3;
       intro H3;
         generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3).
-  replace (2 * PI + - (3 * (PI / 2))) with (PI / 2).
+  replace (2 * PI + - (3 * (PI / 2))) with (PI / 2) by field.
   intro H4;
     apply
       (cos_ge_0 (2 * PI - x)
         (Rlt_le (- (PI / 2)) (2 * PI - x)
           (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4).
-  rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring.
-  ring.
 Qed.
 
 Lemma form1 :
   forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2).
 Proof.
   intros p q; pattern p at 1 in |- *;
-    replace p with ((p - q) / 2 + (p + q) / 2).
-  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+    replace p with ((p - q) / 2 + (p + q) / 2) by field.
+  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2) by field.
   rewrite cos_plus; rewrite cos_minus; ring.
-  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma form2 :
   forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2).
 Proof.
   intros p q; pattern p at 1 in |- *;
-    replace p with ((p - q) / 2 + (p + q) / 2).
-  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+    replace p with ((p - q) / 2 + (p + q) / 2) by field.
+  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2) by field.
   rewrite cos_plus; rewrite cos_minus; ring.
-  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma form3 :
@@ -1007,11 +980,9 @@ Lemma form4 :
   forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2).
 Proof.
   intros p q; pattern p at 1 in |- *;
-    replace p with ((p - q) / 2 + (p + q) / 2).
-  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
+    replace p with ((p - q) / 2 + (p + q) / 2) by field.
+  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2) by field.
   rewrite sin_plus; rewrite sin_minus; ring.
-  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
 
 Qed.
 
@@ -1067,13 +1038,13 @@ Proof.
   repeat rewrite (Rmult_comm (/ 2)).
   clear H4; intro H4;
     generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1);
-      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+      replace (- (PI / 2) + - (PI / 2)) with (- PI) by field.
   intro H5;
     generalize
       (Rmult_le_compat_l (/ 2) (- PI) (x + y)
         (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5).
-  replace (/ 2 * (x + y)) with ((x + y) / 2).
-  replace (/ 2 * - PI) with (- (PI / 2)).
+  replace (/ 2 * (x + y)) with ((x + y) / 2) by apply Rmult_comm.
+  replace (/ 2 * - PI) with (- (PI / 2)) by field.
   clear H5; intro H5; elim H4; intro H40.
   elim H5; intro H50.
   generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6;
@@ -1095,13 +1066,6 @@ Proof.
   rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50;
     rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
       elim (Rlt_irrefl 0 H3).
-  unfold Rdiv in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rmult_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  pattern PI at 1 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  reflexivity.
 Qed.
 
 Lemma sin_increasing_1 :
@@ -1111,43 +1075,42 @@ Lemma sin_increasing_1 :
 Proof.
   intros; generalize (Rplus_lt_compat_l x x y H3); intro H4;
     generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H);
-      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+      replace (- (PI / 2) + - (PI / 2)) with (- PI) by field.
   assert (Hyp : 0 < 2).
   prove_sup0.
   intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6;
     generalize
       (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6);
-      replace (/ 2 * - PI) with (- (PI / 2)).
-  replace (/ 2 * (x + y)) with ((x + y) / 2).
+      replace (/ 2 * - PI) with (- (PI / 2)) by field.
+  replace (/ 2 * (x + y)) with ((x + y) / 2) by apply Rmult_comm.
   clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5;
     rewrite Rplus_comm in H5;
       generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2).
   rewrite <- double_var.
   intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7;
     generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7);
-      replace (/ 2 * PI) with (PI / 2).
-  replace (/ 2 * (x + y)) with ((x + y) / 2).
+      replace (/ 2 * PI) with (PI / 2) by apply Rmult_comm.
+  replace (/ 2 * (x + y)) with ((x + y) / 2) by apply Rmult_comm.
   clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1);
     rewrite Ropp_involutive; clear H1; intro H1;
       generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1;
         generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2;
           intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2);
             clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3);
-              replace (- y + x) with (x - y).
+              replace (- y + x) with (x - y) by apply Rplus_comm.
   rewrite Rplus_opp_l.
   intro H6;
     generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6);
-      rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2).
+      rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2) by apply Rmult_comm.
   clear H6; intro H6;
     generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2);
-      replace (- (PI / 2) + - (PI / 2)) with (- PI).
-  replace (x + - y) with (x - y).
+      replace (- (PI / 2) + - (PI / 2)) with (- PI) by field.
   intro H7;
     generalize
       (Rmult_le_compat_l (/ 2) (- PI) (x - y)
         (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7);
-      replace (/ 2 * - PI) with (- (PI / 2)).
-  replace (/ 2 * (x - y)) with ((x - y) / 2).
+      replace (/ 2 * - PI) with (- (PI / 2)) by field.
+  replace (/ 2 * (x - y)) with ((x - y) / 2) by apply Rmult_comm.
   clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4;
     generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8;
       generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8);
@@ -1162,23 +1125,6 @@ Proof.
             2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11;
           rewrite Rmult_comm; assumption.
   apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm.
-  reflexivity.
-  pattern PI at 1 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  reflexivity.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rminus in |- *; apply Rplus_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rmult_comm.
-  pattern PI at 1 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  reflexivity.
 Qed.
 
 Lemma sin_decreasing_0 :
@@ -1193,33 +1139,16 @@ Proof.
           generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
             generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
               generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
-                replace (- PI + x) with (x - PI).
-  replace (- PI + PI / 2) with (- (PI / 2)).
-  replace (- PI + y) with (y - PI).
-  replace (- PI + 3 * (PI / 2)) with (PI / 2).
-  replace (- (PI - x)) with (x - PI).
-  replace (- (PI - y)) with (y - PI).
+                replace (- PI + x) with (x - PI) by apply Rplus_comm.
+  replace (- PI + PI / 2) with (- (PI / 2)) by field.
+  replace (- PI + y) with (y - PI) by apply Rplus_comm.
+  replace (- PI + 3 * (PI / 2)) with (PI / 2) by field.
+  replace (- (PI - x)) with (x - PI) by ring.
+  replace (- (PI - y)) with (y - PI) by ring.
   intros; change (sin (y - PI) < sin (x - PI)) in H8;
-    apply Rplus_lt_reg_l with (- PI); rewrite Rplus_comm;
-      replace (y + - PI) with (y - PI).
-  rewrite Rplus_comm; replace (x + - PI) with (x - PI).
+    apply Rplus_lt_reg_l with (- PI); rewrite Rplus_comm.
+  rewrite (Rplus_comm _ x).
   apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8).
-  reflexivity.
-  reflexivity.
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  ring.
-  unfold Rminus in |- *; apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  ring.
-  unfold Rminus in |- *; apply Rplus_comm.
 Qed.
 
 Lemma sin_decreasing_1 :
@@ -1233,24 +1162,14 @@ Proof.
         generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
           generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
             generalize (Rplus_lt_compat_l (- PI) x y H3);
-              replace (- PI + PI / 2) with (- (PI / 2)).
-  replace (- PI + y) with (y - PI).
-  replace (- PI + 3 * (PI / 2)) with (PI / 2).
-  replace (- PI + x) with (x - PI).
+              replace (- PI + PI / 2) with (- (PI / 2)) by field.
+  replace (- PI + y) with (y - PI) by apply Rplus_comm.
+  replace (- PI + 3 * (PI / 2)) with (PI / 2) by field.
+  replace (- PI + x) with (x - PI) by apply Rplus_comm.
   intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg;
-    replace (- (PI - x)) with (x - PI).
-  replace (- (PI - y)) with (y - PI).
+    replace (- (PI - x)) with (x - PI) by ring.
+  replace (- (PI - y)) with (y - PI) by ring.
   apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4).
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  unfold Rminus in |- *; apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var; ring.
-  unfold Rminus in |- *; apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var; ring.
 Qed.
 
 Lemma cos_increasing_0 :
@@ -1260,44 +1179,22 @@ Proof.
   intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y);
     rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
       unfold INR in |- *;
-        replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
-  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+        replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))) by field.
+  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))) by field.
   repeat rewrite cos_shift; intro H5;
     generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
       generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
         generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
           generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4).
-  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
-  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)) by ring.
+  replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)) by ring.
+  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2) by field.
+  replace (-3 * (PI / 2) + PI) with (- (PI / 2)) by field.
   clear H1 H2 H3 H4; intros H1 H2 H3 H4;
     apply Rplus_lt_reg_l with (-3 * (PI / 2));
-      replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+      replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)) by ring.
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)) by ring.
   apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5).
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  pattern PI at 3 in |- *; rewrite double_var.
-  ring.
-  rewrite double; pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
 Qed.
 
 Lemma cos_increasing_1 :
@@ -1312,31 +1209,16 @@ Proof.
             generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5);
               rewrite <- (cos_neg x); rewrite <- (cos_neg y);
                 rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
-                  unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
-  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
+                  unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)) by ring.
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)) by ring.
+  replace (-3 * (PI / 2) + PI) with (- (PI / 2)) by field.
+  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2) by field.
   clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5;
-    replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
-  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+    replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))) by field.
+  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))) by field.
   repeat rewrite cos_shift;
     apply
       (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1).
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  pattern PI at 3 in |- *; rewrite double_var; ring.
-  unfold Rminus in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  unfold Rminus in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
 Qed.
 
 Lemma cos_decreasing_0 :
@@ -1375,31 +1257,8 @@ Lemma tan_diff :
     cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y).
 Proof.
   intros; unfold tan in |- *; rewrite sin_minus.
-  unfold Rdiv in |- *.
-  unfold Rminus in |- *.
-  rewrite Rmult_plus_distr_r.
-  rewrite Rinv_mult_distr.
-  repeat rewrite (Rmult_comm (sin x)).
-  repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm (cos y)).
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite (Rmult_comm (sin x)).
-  apply Rplus_eq_compat_l.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  rewrite <- Ropp_mult_distr_r_reverse.
-  rewrite (Rmult_comm (/ cos x)).
-  repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm (cos x)).
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  reflexivity.
-  assumption.
-  assumption.
-  assumption.
-  assumption.
+  field.
+  now split.
 Qed.
 
 Lemma tan_increasing_0 :
@@ -1436,10 +1295,9 @@ Proof.
         intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
           clear H11; intro H11;
             generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
-              generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10);
-                replace (x + - y) with (x - y).
-  replace (PI / 4 + PI / 4) with (PI / 2).
-  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+              generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10).
+  replace (PI / 4 + PI / 4) with (PI / 2) by field.
+  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)) by field.
   intros; case (Rtotal_order 0 (x - y)); intro H14.
   generalize
     (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI));
@@ -1447,28 +1305,6 @@ Proof.
   elim H14; intro H15.
   rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9).
   apply Rminus_lt; assumption.
-  pattern PI at 1 in |- *; rewrite double_var.
-  unfold Rdiv in |- *.
-  rewrite Rmult_plus_distr_r.
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_mult_distr.
-  rewrite Ropp_plus_distr.
-  replace 4 with 4.
-  reflexivity.
-  ring.
-  discrR.
-  discrR.
-  pattern PI at 1 in |- *; rewrite double_var.
-  unfold Rdiv in |- *.
-  rewrite Rmult_plus_distr_r.
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_mult_distr.
-  replace 4 with 4.
-  reflexivity.
-  ring.
-  discrR.
-  discrR.
-  reflexivity.
   case (Rcase_abs (sin (x - y))); intro H9.
   assumption.
   generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9;
@@ -1482,8 +1318,7 @@ Proof.
         (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13;
       elim
         (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)).
-  rewrite Rinv_mult_distr.
-  reflexivity.
+  apply Rinv_mult_distr.
   assumption.
   assumption.
 Qed.
@@ -1521,9 +1356,8 @@ Proof.
   clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
     intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
       clear H11; intro H11;
-        generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
-          replace (x + - y) with (x - y).
-  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+        generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11).
+  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)) by field.
   clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3;
     clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI;
       intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1);
@@ -1534,18 +1368,6 @@ Proof.
               generalize
                 (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8);
                 rewrite Rmult_0_r; intro H4; assumption.
-  pattern PI at 1 in |- *; rewrite double_var.
-  unfold Rdiv in |- *.
-  rewrite Rmult_plus_distr_r.
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_mult_distr.
-  replace 4 with 4.
-  rewrite Ropp_plus_distr.
-  reflexivity.
-  ring.
-  discrR.
-  discrR.
-  reflexivity.
   apply Rinv_mult_distr; assumption.
 Qed.
 
@@ -1737,7 +1559,7 @@ Proof.
   rewrite H5.
   rewrite mult_INR.
   simpl in |- *.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite <- (Rplus_0_l ((1 + 1) * INR x2 * PI)).
   rewrite sin_period.
   apply sin_0.
   rewrite H5.
@@ -1747,7 +1569,7 @@ Proof.
   rewrite Rmult_1_l; rewrite sin_plus.
   rewrite sin_PI.
   rewrite Rmult_0_r.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite <- (Rplus_0_l ((1 + 1) * INR x2 * PI)).
   rewrite sin_period.
   rewrite sin_0; ring.
   apply le_IZR.
@@ -1769,7 +1591,7 @@ Proof.
   rewrite H5.
   rewrite mult_INR.
   simpl in |- *.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite <- (Rplus_0_l ((1 + 1) * INR x2 * PI)).
   rewrite sin_period.
   rewrite sin_0; ring.
   rewrite H5.
@@ -1779,7 +1601,7 @@ Proof.
   rewrite Rmult_1_l; rewrite sin_plus.
   rewrite sin_PI.
   rewrite Rmult_0_r.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite <- (Rplus_0_l ((1 + 1) * INR x2 * PI)).
   rewrite sin_period.
   rewrite sin_0; ring.
   apply le_IZR.
@@ -1787,8 +1609,7 @@ Proof.
   rewrite Rplus_0_r.
   rewrite Ropp_Ropp_IZR.
   rewrite Rplus_opp_r.
-  left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ].
-  assumption.
+  now apply Rlt_le, IZR_lt.
   rewrite <- sin_neg.
   rewrite Ropp_mult_distr_l_reverse.
   rewrite Ropp_involutive.
@@ -1858,7 +1679,7 @@ Proof.
   - right; left; auto.
   - left.
     clear Hi. subst.
-    replace 0 with (IZR 0 * PI) by (simpl; ring). f_equal. f_equal.
+    replace 0 with (IZR 0 * PI) by apply Rmult_0_l. f_equal. f_equal.
     apply one_IZR_lt1.
     split.
     + apply Rlt_le_trans with 0;
diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v
index a5092d22..71b90fb4 100644
--- a/theories/Reals/Rtrigo_alt.v
+++ b/theories/Reals/Rtrigo_alt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -99,24 +101,22 @@ Proof.
   apply Rle_trans with 20.
   apply Rle_trans with 16.
   replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ].
-  replace (a * a) with (Rsqr a); [ idtac | reflexivity ].
   apply Rsqr_incr_1.
   assumption.
   assumption.
-  left; prove_sup0.
-  rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4);
-    [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
-  rewrite <- (Rplus_comm 20); pattern 20 at 1; rewrite <- Rplus_0_r;
-    apply Rplus_le_compat_l.
+  now apply IZR_le.
+  now apply IZR_le.
+  rewrite <- (Rplus_0_l 20) at 1;
+    apply Rplus_le_compat_r.
   apply Rplus_le_le_0_compat.
-  repeat apply Rmult_le_pos.
-  left; prove_sup0.
-  left; prove_sup0.
-  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
   apply Rmult_le_pos.
-  left; prove_sup0.
-  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  apply Rmult_le_pos.
+  now apply IZR_le.
+  apply pos_INR.
+  apply pos_INR.
+  apply Rmult_le_pos.
+  now apply IZR_le.
+  apply pos_INR.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   simpl; ring.
@@ -182,16 +182,14 @@ Proof.
   replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with
   (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ].
   apply sum_eq; intros; unfold sin_term, Un, tg_alt;
-    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+    change ((-1) ^ S i) with (-1 * (-1) ^ i).
   unfold Rdiv; ring.
-  reflexivity.
   replace (- sum_f_R0 (tg_alt Un) (2 * n)) with
   (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ].
   apply sum_eq; intros.
   unfold sin_term, Un, tg_alt;
-    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+    change ((-1) ^ S i) with (-1 * (-1) ^ i).
   unfold Rdiv; ring.
-  reflexivity.
   replace (2 * (n + 1))%nat with (S (S (2 * n))).
   reflexivity.
   ring.
@@ -279,26 +277,23 @@ Proof.
     with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ].
   apply Rle_trans with 12.
   apply Rle_trans with 4.
-  replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ].
-  replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ].
+  change 4 with (Rsqr 2).
   apply Rsqr_incr_1.
   assumption.
-  discrR.
   assumption.
-  left; prove_sup0.
-  pattern 4 at 1; rewrite <- Rplus_0_r; replace 12 with (4 + 8);
-    [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
-  rewrite <- (Rplus_comm 12); pattern 12 at 1; rewrite <- Rplus_0_r;
-    apply Rplus_le_compat_l.
+  now apply IZR_le.
+  now apply IZR_le.
+  rewrite <- (Rplus_0_l 12) at 1;
+    apply Rplus_le_compat_r.
   apply Rplus_le_le_0_compat.
-  repeat apply Rmult_le_pos.
-  left; prove_sup0.
-  left; prove_sup0.
-  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
   apply Rmult_le_pos.
-  left; prove_sup0.
-  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  apply Rmult_le_pos.
+  now apply IZR_le.
+  apply pos_INR.
+  apply pos_INR.
+  apply Rmult_le_pos.
+  now apply IZR_le.
+  apply pos_INR.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   simpl; ring.
@@ -320,7 +315,7 @@ Proof.
   (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
   unfold Rminus; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
     repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1);
-      rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc;
+      rewrite (Rplus_comm (-(1))); repeat rewrite Rplus_assoc;
         rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp;
           rewrite Ropp_plus_distr; rewrite Ropp_involutive;
             unfold Rminus in H6; apply H6.
@@ -351,15 +346,13 @@ Proof.
   replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with
   (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ].
   apply sum_eq; intros; unfold cos_term, Un, tg_alt;
-    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+    change ((-1) ^ S i) with (-1 * (-1) ^ i).
   unfold Rdiv; ring.
-  reflexivity.
   replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with
   (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ];
   apply sum_eq; intros; unfold cos_term, Un, tg_alt;
-    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+    change ((-1) ^ S i) with (-1 * (-1) ^ i).
   unfold Rdiv; ring.
-  reflexivity.
   replace (2 * (n0 + 1))%nat with (S (S (2 * n0))).
   reflexivity.
   ring.
@@ -367,10 +360,10 @@ Proof.
   reflexivity.
   ring.
   intro; elim H2; intros; split.
-  apply Rplus_le_reg_l with (-1).
+  apply Rplus_le_reg_l with (-(1)).
   rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
     rewrite (Rplus_comm (-1)); apply H3.
-  apply Rplus_le_reg_l with (-1).
+  apply Rplus_le_reg_l with (-(1)).
   rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
     rewrite (Rplus_comm (-1)); apply H4.
   unfold cos_term; simpl; unfold Rdiv; rewrite Rinv_1;
diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v
index 9ba14ee7..7cbfc630 100644
--- a/theories/Reals/Rtrigo_calc.v
+++ b/theories/Reals/Rtrigo_calc.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -32,48 +34,22 @@ Proof.
 Qed.
 
 Lemma sin_cos_PI4 : sin (PI / 4) = cos (PI / 4).
-Proof with trivial.
-  rewrite cos_sin...
-  replace (PI / 2 + PI / 4) with (- (PI / 4) + PI)...
-  rewrite neg_sin; rewrite sin_neg; ring...
-  cut (PI = PI / 2 + PI / 2); [ intro | apply double_var ]...
-  pattern PI at 2 3; rewrite H; pattern PI at 2 3; rewrite H...
-  assert (H0 : 2 <> 0);
-    [ discrR | unfold Rdiv; rewrite Rinv_mult_distr; try ring ]...
+Proof.
+  rewrite cos_sin.
+  replace (PI / 2 + PI / 4) with (- (PI / 4) + PI) by field.
+  rewrite neg_sin, sin_neg; ring.
 Qed.
 
 Lemma sin_PI3_cos_PI6 : sin (PI / 3) = cos (PI / 6).
-Proof with trivial.
-  replace (PI / 6) with (PI / 2 - PI / 3)...
-  rewrite cos_shift...
-  assert (H0 : 6 <> 0); [ discrR | idtac ]...
-  assert (H1 : 3 <> 0); [ discrR | idtac ]...
-  assert (H2 : 2 <> 0); [ discrR | idtac ]...
-  apply Rmult_eq_reg_l with 6...
-  rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
-  unfold Rdiv; repeat rewrite Rmult_assoc...
-  rewrite <- Rinv_l_sym...
-  rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
-  rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
-    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
-  ring...
+Proof.
+  replace (PI / 6) with (PI / 2 - PI / 3) by field.
+  now rewrite cos_shift.
 Qed.
 
 Lemma sin_PI6_cos_PI3 : cos (PI / 3) = sin (PI / 6).
-Proof with trivial.
-  replace (PI / 6) with (PI / 2 - PI / 3)...
-  rewrite sin_shift...
-  assert (H0 : 6 <> 0); [ discrR | idtac ]...
-  assert (H1 : 3 <> 0); [ discrR | idtac ]...
-  assert (H2 : 2 <> 0); [ discrR | idtac ]...
-  apply Rmult_eq_reg_l with 6...
-  rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
-  unfold Rdiv; repeat rewrite Rmult_assoc...
-  rewrite <- Rinv_l_sym...
-  rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
-  rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
-    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
-  ring...
+Proof.
+  replace (PI / 6) with (PI / 2 - PI / 3) by field.
+  now rewrite sin_shift.
 Qed.
 
 Lemma PI6_RGT_0 : 0 < PI / 6.
@@ -90,29 +66,20 @@ Proof.
 Qed.
 
 Lemma sin_PI6 : sin (PI / 6) = 1 / 2.
-Proof with trivial.
-  assert (H : 2 <> 0); [ discrR | idtac ]...
-  apply Rmult_eq_reg_l with (2 * cos (PI / 6))...
+Proof.
+  apply Rmult_eq_reg_l with (2 * cos (PI / 6)).
   replace (2 * cos (PI / 6) * sin (PI / 6)) with
-  (2 * sin (PI / 6) * cos (PI / 6))...
-  rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3)...
-  rewrite sin_PI3_cos_PI6...
-  unfold Rdiv; rewrite Rmult_1_l; rewrite Rmult_assoc;
-    pattern 2 at 2; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
-      rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_r...
-  unfold Rdiv; rewrite Rinv_mult_distr...
-  rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2);
-    repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_r...
-  discrR...
-  ring...
-  apply prod_neq_R0...
+  (2 * sin (PI / 6) * cos (PI / 6)) by ring.
+  rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3) by field.
+  rewrite sin_PI3_cos_PI6.
+  field.
+  apply prod_neq_R0.
+  discrR.
   cut (0 < cos (PI / 6));
     [ intro H1; auto with real
       | apply cos_gt_0;
         [ apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)
-          | apply PI6_RLT_PI2 ] ]...
+          | apply PI6_RLT_PI2 ] ].
 Qed.
 
 Lemma sqrt2_neq_0 : sqrt 2 <> 0.
@@ -188,20 +155,13 @@ Proof with trivial.
   apply Rinv_0_lt_compat; apply Rlt_sqrt2_0...
   rewrite Rsqr_div...
   rewrite Rsqr_1; rewrite Rsqr_sqrt...
-  assert (H : 2 <> 0); [ discrR | idtac ]...
   unfold Rsqr; pattern (cos (PI / 4)) at 1;
     rewrite <- sin_cos_PI4;
       replace (sin (PI / 4) * cos (PI / 4)) with
-      (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))...
-  rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)...
+      (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4))) by field.
+  rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2) by field.
   rewrite sin_PI2...
-  apply Rmult_1_r...
-  unfold Rdiv; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr...
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_r...
-  unfold Rdiv; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc...
-  rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_l...
+  field.
   left; prove_sup...
   apply sqrt2_neq_0...
 Qed.
@@ -219,24 +179,17 @@ Proof.
 Qed.
 
 Lemma cos3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2.
-Proof with trivial.
-  replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
-  rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4...
-  unfold Rdiv; rewrite Ropp_mult_distr_l_reverse...
-  unfold Rminus; rewrite Ropp_involutive; pattern PI at 1;
-    rewrite double_var; unfold Rdiv; rewrite Rmult_plus_distr_r;
-      repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
-        [ ring | discrR | discrR ]...
+Proof.
+  replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4)) by field.
+  rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4.
+  unfold Rdiv.
+  ring.
 Qed.
 
 Lemma sin3PI4 : sin (3 * (PI / 4)) = 1 / sqrt 2.
-Proof with trivial.
-  replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
-  rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4...
-  unfold Rminus; rewrite Ropp_involutive; pattern PI at 1;
-    rewrite double_var; unfold Rdiv; rewrite Rmult_plus_distr_r;
-      repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
-        [ ring | discrR | discrR ]...
+Proof.
+  replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4)) by field.
+  now rewrite sin_shift, cos_neg, cos_PI4.
 Qed.
 
 Lemma cos_PI6 : cos (PI / 6) = sqrt 3 / 2.
@@ -248,19 +201,11 @@ Proof with trivial.
   left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))...
   apply Rlt_sqrt3_0...
   apply Rinv_0_lt_compat; prove_sup0...
-  assert (H : 2 <> 0); [ discrR | idtac ]...
-  assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
   rewrite Rsqr_div...
   rewrite cos2; unfold Rsqr; rewrite sin_PI6; rewrite sqrt_def...
-  unfold Rdiv; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
-  rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3);
-    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
-  rewrite Rmult_1_l; rewrite Rmult_1_r...
-  rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc...
-  rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_l; rewrite <- Rinv_r_sym...
-  ring...
-  left; prove_sup0...
+  field.
+  left ; prove_sup0.
+  discrR.
 Qed.
 
 Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3.
@@ -306,56 +251,32 @@ Proof.
 Qed.
 
 Lemma cos_2PI3 : cos (2 * (PI / 3)) = -1 / 2.
-Proof with trivial.
-  assert (H : 2 <> 0); [ discrR | idtac ]...
-  assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
-  rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3;
-    unfold Rdiv; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
-  rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc;
-    rewrite (Rmult_comm 2)...
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_r; rewrite <- Rinv_r_sym...
-  pattern 2 at 4; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r...
-  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))...
-  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-  rewrite Rmult_1_r; rewrite sqrt_def...
-  ring...
-  left; prove_sup...
+Proof.
+  rewrite cos_2a, sin_PI3, cos_PI3.
+  replace (sqrt 3 / 2 * (sqrt 3 / 2)) with ((sqrt 3 * sqrt 3) / 4) by field.
+  rewrite sqrt_sqrt.
+  field.
+  left ; prove_sup0.
 Qed.
 
 Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3.
-Proof with trivial.
-  assert (H : 2 <> 0); [ discrR | idtac ]...
-  unfold tan; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv;
-    rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
-      rewrite <- Ropp_inv_permute...
-  rewrite Rinv_involutive...
-  rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym...
-  ring...
-  apply Rinv_neq_0_compat...
+Proof.
+  unfold tan; rewrite sin_2PI3, cos_2PI3.
+  field.
 Qed.
 
 Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2.
-Proof with trivial.
-  replace (5 * (PI / 4)) with (PI / 4 + PI)...
-  rewrite neg_cos; rewrite cos_PI4; unfold Rdiv;
-    rewrite Ropp_mult_distr_l_reverse...
-  pattern PI at 2; rewrite double_var; pattern PI at 2 3;
-    rewrite double_var; assert (H : 2 <> 0);
-      [ discrR | unfold Rdiv; repeat rewrite Rinv_mult_distr; try ring ]...
+Proof.
+  replace (5 * (PI / 4)) with (PI / 4 + PI) by field.
+  rewrite neg_cos; rewrite cos_PI4; unfold Rdiv.
+  ring.
 Qed.
 
 Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2.
-Proof with trivial.
-  replace (5 * (PI / 4)) with (PI / 4 + PI)...
-  rewrite neg_sin; rewrite sin_PI4; unfold Rdiv;
-    rewrite Ropp_mult_distr_l_reverse...
-  pattern PI at 2; rewrite double_var; pattern PI at 2 3;
-    rewrite double_var; assert (H : 2 <> 0);
-      [ discrR | unfold Rdiv; repeat rewrite Rinv_mult_distr; try ring ]...
+Proof.
+  replace (5 * (PI / 4)) with (PI / 4 + PI) by field.
+  rewrite neg_sin; rewrite sin_PI4; unfold Rdiv.
+  ring.
 Qed.
 
 Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)).
diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v
index 0d2a9a8b..d2faf95b 100644
--- a/theories/Reals/Rtrigo_def.v
+++ b/theories/Reals/Rtrigo_def.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase Rfunctions SeqSeries Rtrigo_fun Max.
@@ -157,7 +159,7 @@ Proof.
   apply Rinv_0_lt_compat; assumption.
   rewrite H3 in H0; assumption.
   apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ].
-  apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left;
+  apply le_IZR; left;
     apply Rlt_trans with (/ eps);
       [ apply Rinv_0_lt_compat; assumption | assumption ].
   assert (H0 := archimed (/ eps)).
@@ -194,30 +196,27 @@ Proof.
   elim H1; intros; assumption.
   apply lt_le_trans with (S n).
   unfold ge in H2; apply le_lt_n_Sm; assumption.
-  replace (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ].
+  replace (2 * n + 1)%nat with (S (2 * n)) by ring.
   apply le_n_S; apply le_n_2n.
   apply Rmult_lt_reg_l with (INR (2 * S n)).
   apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))).
   apply lt_O_Sn.
-  replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  replace (S n) with (n + 1)%nat by ring.
   ring.
   rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
+  rewrite Rmult_1_r.
+  apply (lt_INR 1).
   replace (2 * S n)%nat with (S (S (2 * n))).
   apply lt_n_S; apply lt_O_Sn.
-  replace (S n) with (n + 1)%nat; [ ring | ring ].
+  ring.
   apply not_O_INR; discriminate.
   apply not_O_INR; discriminate.
   replace (2 * n + 1)%nat with (S (2 * n));
   [ apply not_O_INR; discriminate | ring ].
   apply Rle_ge; left; apply Rinv_0_lt_compat.
   apply lt_INR_0.
-  replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 6 * n))).
+  replace (2 * S n * (2 * n + 1))%nat with (2 + (4 * (n * n) + 6 * n))%nat by ring.
   apply lt_O_Sn.
-  apply INR_eq.
-  repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR;
-    rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
-      replace (INR 0) with 0; [ ring | reflexivity ].
 Qed.
 
 Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0.
@@ -318,28 +317,25 @@ Proof.
   elim H1; intros; assumption.
   apply lt_le_trans with (S n).
   unfold ge in H2; apply le_lt_n_Sm; assumption.
-  replace (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ].
+  replace (2 * S n + 1)%nat with (S (2 * S n)) by ring.
   apply le_S; apply le_n_2n.
   apply Rmult_lt_reg_l with (INR (2 * S n)).
   apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n)));
-    [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ].
+    [ apply lt_O_Sn | ring ].
   rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
+  rewrite Rmult_1_r.
+  apply (lt_INR 1).
   replace (2 * S n)%nat with (S (S (2 * n))).
   apply lt_n_S; apply lt_O_Sn.
-  replace (S n) with (n + 1)%nat; [ ring | ring ].
+  ring.
   apply not_O_INR; discriminate.
   apply not_O_INR; discriminate.
   apply not_O_INR; discriminate.
-  left; change (0 < / INR ((2 * S n + 1) * (2 * S n)));
-    apply Rinv_0_lt_compat.
+  left; apply Rinv_0_lt_compat.
   apply lt_INR_0.
   replace ((2 * S n + 1) * (2 * S n))%nat with
-  (S (S (S (S (S (S (4 * (n * n) + 10 * n))))))).
+  (6 + (4 * (n * n) + 10 * n))%nat by ring.
   apply lt_O_Sn.
-  apply INR_eq; repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR;
-    rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
-      replace (INR 0) with 0; [ ring | reflexivity ].
 Qed.
 
 Lemma sin_no_R0 : forall n:nat, sin_n n <> 0.
diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v
index f395f9ae..744a99a1 100644
--- a/theories/Reals/Rtrigo_fun.v
+++ b/theories/Reals/Rtrigo_fun.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v
index eed612d9..456fb6a7 100644
--- a/theories/Reals/Rtrigo_reg.v
+++ b/theories/Reals/Rtrigo_reg.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -251,6 +253,7 @@ Proof.
   exists delta; intros.
   rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))).
   unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
+  change (-2) with (-(2)).
   unfold Rdiv; do 2 rewrite Ropp_mult_distr_l_reverse.
   rewrite Rabs_Ropp.
   replace (2 * Rsqr (sin (h * / 2)) * / h) with
@@ -266,7 +269,7 @@ Proof.
   apply Rabs_pos.
   assert (H9 := SIN_bound (h / 2)).
   unfold Rabs; case (Rcase_abs (sin (h / 2))); intro.
-  pattern 1 at 3; rewrite <- (Ropp_involutive 1).
+  rewrite <- (Ropp_involutive 1).
   apply Ropp_le_contravar.
   elim H9; intros; assumption.
   elim H9; intros; assumption.
@@ -395,15 +398,8 @@ Proof.
   apply Rlt_le_trans with alp.
   apply H7.
   unfold alp; apply Rmin_l.
-  rewrite sin_plus; unfold Rminus, Rdiv;
-    repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
-      repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc;
-        apply Rplus_eq_compat_l.
-  rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc;
-    apply Rplus_eq_compat_l.
-  rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse;
-    rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse;
-      rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm.
+  rewrite sin_plus.
+  now field.
   unfold alp; unfold Rmin; case (Rle_dec alp1 alp2); intro.
   apply (cond_pos alp1).
   apply (cond_pos alp2).
diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v
index 5a2a07c4..38b0b3c4 100644
--- a/theories/Reals/SeqProp.v
+++ b/theories/Reals/SeqProp.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -150,7 +152,7 @@ Definition sequence_lb (Un:nat -> R) (pr:has_lb Un)
 (* Compatibility *)
 Notation sequence_majorant := sequence_ub (only parsing).
 Notation sequence_minorant := sequence_lb (only parsing).
-Unset Standard Proposition Elimination Names.
+
 Lemma Wn_decreasing :
   forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_ub Un pr).
 Proof.
@@ -1167,7 +1169,7 @@ Proof.
   assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros.
   rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7.
   simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)).
-  replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S;
+  apply (le_INR 1); apply le_n_S;
     apply le_O_n.
   apply le_IZR; simpl; left; apply Rlt_trans with (Rabs x).
   assumption.
diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v
index 1123e7ee..ccd205e2 100644
--- a/theories/Reals/SeqSeries.v
+++ b/theories/Reals/SeqSeries.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v
index a78a6e19..aa67b677 100644
--- a/theories/Reals/SplitAbsolu.v
+++ b/theories/Reals/SplitAbsolu.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbasic_fun.
diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v
index 074a7631..a8ff60b0 100644
--- a/theories/Reals/SplitRmult.v
+++ b/theories/Reals/SplitRmult.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*)
diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v
index d43baee8..d6b386f1 100644
--- a/theories/Reals/Sqrt_reg.v
+++ b/theories/Reals/Sqrt_reg.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Rbase.
@@ -21,6 +23,7 @@ Proof.
   destruct (total_order_T h 0) as [[Hlt|Heq]|Hgt].
   repeat rewrite Rabs_left.
   unfold Rminus; do 2 rewrite <- (Rplus_comm (-1)).
+  change (-1) with (-(1)).
   do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive;
     apply Rplus_le_compat_l.
   apply Ropp_le_contravar; apply sqrt_le_1.
diff --git a/theories/Reals/vo.itarget b/theories/Reals/vo.itarget
deleted file mode 100644
index 0c8f0b97..00000000
--- a/theories/Reals/vo.itarget
+++ /dev/null
@@ -1,62 +0,0 @@
-Alembert.vo
-AltSeries.vo
-ArithProp.vo
-Binomial.vo
-Cauchy_prod.vo
-Cos_plus.vo
-Cos_rel.vo
-DiscrR.vo
-Exp_prop.vo
-Integration.vo
-Machin.vo
-MVT.vo
-NewtonInt.vo
-PartSum.vo
-PSeries_reg.vo
-Ranalysis1.vo
-Ranalysis2.vo
-Ranalysis3.vo
-Ranalysis4.vo
-Ranalysis5.vo
-Ranalysis.vo
-Ranalysis_reg.vo
-Ratan.vo
-Raxioms.vo
-Rbase.vo
-Rbasic_fun.vo
-Rcomplete.vo
-Rdefinitions.vo
-Rderiv.vo
-Reals.vo
-Rfunctions.vo
-Rgeom.vo
-RiemannInt_SF.vo
-RiemannInt.vo
-R_Ifp.vo
-RIneq.vo
-Rlimit.vo
-RList.vo
-Rlogic.vo
-Rpow_def.vo
-Rpower.vo
-Rprod.vo
-Rseries.vo
-Rsigma.vo
-Rsqrt_def.vo
-R_sqrt.vo
-R_sqr.vo
-Rtopology.vo
-Rtrigo_alt.vo
-Rtrigo_calc.vo
-Rtrigo_def.vo
-Rtrigo_fun.vo
-Rtrigo_reg.vo
-Rtrigo1.vo
-Rtrigo.vo
-SeqProp.vo
-SeqSeries.vo
-SplitAbsolu.vo
-SplitRmult.vo
-Sqrt_reg.vo
-ROrderedType.vo
-Rminmax.vo
diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v
index fe8a96ac..e82a6734 100644
--- a/theories/Relations/Operators_Properties.v
+++ b/theories/Relations/Operators_Properties.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v
index 9c98879c..53def474 100644
--- a/theories/Relations/Relation_Definitions.v
+++ b/theories/Relations/Relation_Definitions.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Section Relation_Definition.
diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v
index 88239475..529e4d08 100644
--- a/theories/Relations/Relation_Operators.v
+++ b/theories/Relations/Relation_Operators.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Relations/Relations.v b/theories/Relations/Relations.v
index ce6bdbc6..61344974 100644
--- a/theories/Relations/Relations.v
+++ b/theories/Relations/Relations.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Relation_Definitions.
diff --git a/theories/Relations/vo.itarget b/theories/Relations/vo.itarget
deleted file mode 100644
index 9d81dd07..00000000
--- a/theories/Relations/vo.itarget
+++ /dev/null
@@ -1,4 +0,0 @@
-Operators_Properties.vo
-Relation_Definitions.vo
-Relation_Operators.vo
-Relations.vo
diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v
index 55b301c3..af06bcf4 100644
--- a/theories/Setoids/Setoid.v
+++ b/theories/Setoids/Setoid.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Coq.Classes.SetoidTactics.
diff --git a/theories/Setoids/vo.itarget b/theories/Setoids/vo.itarget
deleted file mode 100644
index 8d608cf7..00000000
--- a/theories/Setoids/vo.itarget
+++ /dev/null
@@ -1 +0,0 @@
-Setoid.vo
\ No newline at end of file
diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v
index 837437a2..b68022f8 100644
--- a/theories/Sets/Classical_sets.v
+++ b/theories/Sets/Classical_sets.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v
index 6291248e..f2475af1 100644
--- a/theories/Sets/Constructive_sets.v
+++ b/theories/Sets/Constructive_sets.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Cpo.v b/theories/Sets/Cpo.v
index b5db9030..3977097e 100644
--- a/theories/Sets/Cpo.v
+++ b/theories/Sets/Cpo.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v
index 0fefb354..c3713207 100644
--- a/theories/Sets/Ensembles.v
+++ b/theories/Sets/Ensembles.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v
index edbc1efe..5c42cbe6 100644
--- a/theories/Sets/Finite_sets.v
+++ b/theories/Sets/Finite_sets.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v
index 31cc11e1..1c191613 100644
--- a/theories/Sets/Finite_sets_facts.v
+++ b/theories/Sets/Finite_sets_facts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Image.v b/theories/Sets/Image.v
index e74ef41e..3e28bbe9 100644
--- a/theories/Sets/Image.v
+++ b/theories/Sets/Image.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v
index 98eeb7d7..bdeeb6a7 100644
--- a/theories/Sets/Infinite_sets.v
+++ b/theories/Sets/Infinite_sets.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Integers.v b/theories/Sets/Integers.v
index 057fc9b6..225e388b 100644
--- a/theories/Sets/Integers.v
+++ b/theories/Sets/Integers.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Multiset.v b/theories/Sets/Multiset.v
index 42d0c76d..a79ddead 100644
--- a/theories/Sets/Multiset.v
+++ b/theories/Sets/Multiset.v
@@ -1,14 +1,17 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* G. Huet 1-9-95 *)
 
 Require Import Permut Setoid.
+Require Plus. (* comm. and ass. of plus *)
 
 Set Implicit Arguments.
 
@@ -67,9 +70,6 @@ Section multiset_defs.
     unfold meq; unfold munion; simpl; auto.
   Qed.
 
-
-  Require Plus. (* comm. and ass. of plus *)
-
   Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x).
   Proof.
     unfold meq; unfold multiplicity; unfold munion.
diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v
index 335fec5b..17fc0ed2 100644
--- a/theories/Sets/Partial_Order.v
+++ b/theories/Sets/Partial_Order.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Permut.v b/theories/Sets/Permut.v
index adbde18e..86a500df 100644
--- a/theories/Sets/Permut.v
+++ b/theories/Sets/Permut.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* G. Huet 1-9-95 *)
diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v
index 7c2435da..88bcd655 100644
--- a/theories/Sets/Powerset.v
+++ b/theories/Sets/Powerset.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v
index e802beac..7975a026 100644
--- a/theories/Sets/Powerset_Classical_facts.v
+++ b/theories/Sets/Powerset_Classical_facts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index e9696a1c..81b475ac 100644
--- a/theories/Sets/Powerset_facts.v
+++ b/theories/Sets/Powerset_facts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 (****************************************************************************)
 (*                                                                          *)
@@ -40,6 +42,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 +138,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 +269,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/Sets/Relations_1.v b/theories/Sets/Relations_1.v
index 45fb8134..1ed74599 100644
--- a/theories/Sets/Relations_1.v
+++ b/theories/Sets/Relations_1.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v
index bf8a4261..296ec42a 100644
--- a/theories/Sets/Relations_1_facts.v
+++ b/theories/Sets/Relations_1_facts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v
index 1e0b83fe..cc839506 100644
--- a/theories/Sets/Relations_2.v
+++ b/theories/Sets/Relations_2.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v
index da93e922..36da3684 100644
--- a/theories/Sets/Relations_2_facts.v
+++ b/theories/Sets/Relations_2_facts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v
index c05b5ee7..de3212e2 100644
--- a/theories/Sets/Relations_3.v
+++ b/theories/Sets/Relations_3.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v
index 89fb900c..0c1f670d 100644
--- a/theories/Sets/Relations_3_facts.v
+++ b/theories/Sets/Relations_3_facts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sets/Uniset.v b/theories/Sets/Uniset.v
index e297d97e..7940bda1 100644
--- a/theories/Sets/Uniset.v
+++ b/theories/Sets/Uniset.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Sets as characteristic functions *)
@@ -11,7 +13,7 @@
 (* G. Huet 1-9-95 *)
 (* Updated Papageno 12/98 *)
 
-Require Import Bool.
+Require Import Bool Permut.
 
 Set Implicit Arguments.
 
@@ -138,8 +140,6 @@ Hint Resolve seq_right.
 (** Here we should make uniset an abstract datatype, by hiding [Charac],
     [union], [charac]; all further properties are proved abstractly *)
 
-Require Import Permut.
-
 Lemma union_rotate :
  forall x y z:uniset, seq (union x (union y z)) (union z (union x y)).
 Proof.
diff --git a/theories/Sets/vo.itarget b/theories/Sets/vo.itarget
deleted file mode 100644
index 9ebe92f5..00000000
--- a/theories/Sets/vo.itarget
+++ /dev/null
@@ -1,22 +0,0 @@
-Classical_sets.vo
-Constructive_sets.vo
-Cpo.vo
-Ensembles.vo
-Finite_sets_facts.vo
-Finite_sets.vo
-Image.vo
-Infinite_sets.vo
-Integers.vo
-Multiset.vo
-Partial_Order.vo
-Permut.vo
-Powerset_Classical_facts.vo
-Powerset_facts.vo
-Powerset.vo
-Relations_1_facts.vo
-Relations_1.vo
-Relations_2_facts.vo
-Relations_2.vo
-Relations_3_facts.vo
-Relations_3.vo
-Uniset.vo
diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v
index 20c6feb9..2ef162be 100644
--- a/theories/Sorting/Heap.v
+++ b/theories/Sorting/Heap.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file is deprecated, for a tree on list, use [Mergesort.v]. *)
@@ -134,7 +136,7 @@ Section defs.
       (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) ->
       (forall a, HdRel leA a l1 -> HdRel leA a l2 -> HdRel leA a l) ->
       merge_lem l1 l2.
-  Require Import Morphisms.
+  Import Morphisms.
   
   Instance: Equivalence (@meq A).
   Proof. constructor; auto with datatypes. red. apply meq_trans. Defined.
@@ -146,10 +148,10 @@ Section defs.
     forall l1:list A, Sorted leA l1 ->
     forall l2:list A, Sorted leA l2 -> merge_lem l1 l2.
   Proof.
-    fix 1; intros; destruct l1.
+    fix merge 1; intros; destruct l1.
     apply merge_exist with l2; auto with datatypes.
     rename l1 into l.
-    revert l2 H0. fix 1. intros.
+    revert l2 H0. fix merge0 1. intros.
     destruct l2 as [|a0 l0]. 
     apply merge_exist with (a :: l); simpl; auto with datatypes. 
     induction (leA_dec a a0) as [Hle|Hle].
diff --git a/theories/Sorting/Mergesort.v b/theories/Sorting/Mergesort.v
index 4b967c16..824d000d 100644
--- a/theories/Sorting/Mergesort.v
+++ b/theories/Sorting/Mergesort.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** A modular implementation of mergesort (the complexity is O(n.log n) in
diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v
index 45d27e35..97297f7e 100644
--- a/theories/Sorting/PermutEq.v
+++ b/theories/Sorting/PermutEq.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Relations Setoid SetoidList List Multiset PermutSetoid Permutation Omega.
diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v
index 0697a5e4..08bc400f 100644
--- a/theories/Sorting/PermutSetoid.v
+++ b/theories/Sorting/PermutSetoid.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Omega Relations Multiset SetoidList.
diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v
index 44f8ff6a..7b99b362 100644
--- a/theories/Sorting/Permutation.v
+++ b/theories/Sorting/Permutation.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/Sorting/Sorted.v b/theories/Sorting/Sorted.v
index df03ff1c..89e9c7f3 100644
--- a/theories/Sorting/Sorted.v
+++ b/theories/Sorting/Sorted.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Made by Hugo Herbelin *)
diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v
index 6e9702f2..c2be1461 100644
--- a/theories/Sorting/Sorting.v
+++ b/theories/Sorting/Sorting.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Sorted.
diff --git a/theories/Sorting/vo.itarget b/theories/Sorting/vo.itarget
deleted file mode 100644
index 079eaad1..00000000
--- a/theories/Sorting/vo.itarget
+++ /dev/null
@@ -1,7 +0,0 @@
-Heap.vo
-Permutation.vo
-PermutSetoid.vo
-PermutEq.vo
-Sorted.vo
-Sorting.vo
-Mergesort.vo
diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v
index 55a533c5..5154b75b 100644
--- a/theories/Strings/Ascii.v
+++ b/theories/Strings/Ascii.v
@@ -1,10 +1,12 @@
-(* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
+(************************************************************************)
 (************************************************************************)
 
 (** Contributed by Laurent Théry (INRIA);
diff --git a/theories/Strings/String.v b/theories/Strings/String.v
index 451b65cb..2be6618a 100644
--- a/theories/Strings/String.v
+++ b/theories/Strings/String.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Contributed by Laurent Théry (INRIA);
@@ -163,6 +165,18 @@ intros n0 H; apply Rec; simpl; auto.
 apply Le.le_S_n; auto.
 Qed.
 
+(** *** Concatenating lists of strings *)
+
+(** [concat sep sl] concatenates the list of strings [sl], inserting
+    the separator string [sep] between each. *)
+
+Fixpoint concat (sep : string) (ls : list string) :=
+  match ls with
+  | nil => EmptyString
+  | cons x nil => x
+  | cons x xs => x ++ sep ++ concat sep xs
+  end.
+
 (** *** Test functions *)
 
 (** Test if [s1] is a prefix of [s2] *)
diff --git a/theories/Strings/vo.itarget b/theories/Strings/vo.itarget
deleted file mode 100644
index 20813b42..00000000
--- a/theories/Strings/vo.itarget
+++ /dev/null
@@ -1,2 +0,0 @@
-Ascii.vo
-String.vo
diff --git a/theories/Structures/DecidableType.v b/theories/Structures/DecidableType.v
index f85222df..24333ad8 100644
--- a/theories/Structures/DecidableType.v
+++ b/theories/Structures/DecidableType.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export SetoidList.
 Require Equalities.
@@ -86,7 +88,7 @@ Module KeyDecidableType(D:DecidableType).
 
   Lemma InA_eqk : forall p q m, eqk p q -> InA eqk p m -> InA eqk q m.
   Proof.
-   intros; apply InA_eqA with p; auto with *. 
+   intros; apply InA_eqA with p; auto using eqk_equiv.
   Qed.
 
   Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
@@ -109,7 +111,7 @@ Module KeyDecidableType(D:DecidableType).
 
   Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l.
   Proof.
-  intros; unfold MapsTo in *; apply InA_eqA with (x,e); eauto with *.
+    intros; unfold MapsTo in *; apply InA_eqA with (x,e); auto using eqke_equiv.
   Qed.
 
   Lemma In_eq : forall l x y, eq x y -> In x l -> In y l.
diff --git a/theories/Structures/DecidableTypeEx.v b/theories/Structures/DecidableTypeEx.v
index 163a40f2..8dd2e710 100644
--- a/theories/Structures/DecidableTypeEx.v
+++ b/theories/Structures/DecidableTypeEx.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import DecidableType OrderedType OrderedTypeEx.
 Set Implicit Arguments.
diff --git a/theories/Structures/Equalities.v b/theories/Structures/Equalities.v
index 747d03f8..5f60a979 100644
--- a/theories/Structures/Equalities.v
+++ b/theories/Structures/Equalities.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export RelationClasses.
 Require Import Bool Morphisms Setoid.
diff --git a/theories/Structures/EqualitiesFacts.v b/theories/Structures/EqualitiesFacts.v
index cee3d63f..7b6ee2ea 100644
--- a/theories/Structures/EqualitiesFacts.v
+++ b/theories/Structures/EqualitiesFacts.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import Equalities Bool SetoidList RelationPairs.
 
diff --git a/theories/Structures/GenericMinMax.v b/theories/Structures/GenericMinMax.v
index ac52d1bb..05edc6cc 100644
--- a/theories/Structures/GenericMinMax.v
+++ b/theories/Structures/GenericMinMax.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import Orders OrdersTac OrdersFacts Setoid Morphisms Basics.
 
diff --git a/theories/Structures/OrderedType.v b/theories/Structures/OrderedType.v
index 93ca383b..f6fc247d 100644
--- a/theories/Structures/OrderedType.v
+++ b/theories/Structures/OrderedType.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export SetoidList Morphisms OrdersTac.
 Set Implicit Arguments.
diff --git a/theories/Structures/OrderedTypeAlt.v b/theories/Structures/OrderedTypeAlt.v
index b054496e..278046a8 100644
--- a/theories/Structures/OrderedTypeAlt.v
+++ b/theories/Structures/OrderedTypeAlt.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 Require Import OrderedType.
 
 (** * An alternative (but equivalent) presentation for an Ordered Type
diff --git a/theories/Structures/OrderedTypeEx.v b/theories/Structures/OrderedTypeEx.v
index 3c6afc7b..f2a9a569 100644
--- a/theories/Structures/OrderedTypeEx.v
+++ b/theories/Structures/OrderedTypeEx.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import OrderedType.
 Require Import ZArith.
@@ -55,7 +57,7 @@ Module Nat_as_OT <: UsualOrderedType.
 
   Definition compare x y : Compare lt eq x y.
   Proof.
-    case_eq (nat_compare x y); intro.
+    case_eq (Nat.compare x y); intro.
     - apply EQ. now apply nat_compare_eq.
     - apply LT. now apply nat_compare_Lt_lt.
     - apply GT. now apply nat_compare_Gt_gt.
diff --git a/theories/Structures/Orders.v b/theories/Structures/Orders.v
index 724690b4..42756ad3 100644
--- a/theories/Structures/Orders.v
+++ b/theories/Structures/Orders.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export Relations Morphisms Setoid Equalities.
 Set Implicit Arguments.
diff --git a/theories/Structures/OrdersAlt.v b/theories/Structures/OrdersAlt.v
index 5dd917a7..ad6a3876 100644
--- a/theories/Structures/OrdersAlt.v
+++ b/theories/Structures/OrdersAlt.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (* Finite sets library.
  * Authors: Pierre Letouzey and Jean-Christophe Filliâtre
diff --git a/theories/Structures/OrdersEx.v b/theories/Structures/OrdersEx.v
index 89c56388..93168f7d 100644
--- a/theories/Structures/OrdersEx.v
+++ b/theories/Structures/OrdersEx.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (* Finite sets library.
  * Authors: Pierre Letouzey and Jean-Christophe Filliâtre
diff --git a/theories/Structures/OrdersFacts.v b/theories/Structures/OrdersFacts.v
index 0115d8a5..87df6b47 100644
--- a/theories/Structures/OrdersFacts.v
+++ b/theories/Structures/OrdersFacts.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import Bool Basics OrdersTac.
 Require Export Orders.
diff --git a/theories/Structures/OrdersLists.v b/theories/Structures/OrdersLists.v
index bf8529bc..abdb9eff 100644
--- a/theories/Structures/OrdersLists.v
+++ b/theories/Structures/OrdersLists.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Export RelationPairs SetoidList Orders EqualitiesFacts.
 
diff --git a/theories/Structures/OrdersTac.v b/theories/Structures/OrdersTac.v
index 475a25a4..ebd8ee8f 100644
--- a/theories/Structures/OrdersTac.v
+++ b/theories/Structures/OrdersTac.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 Require Import Setoid Morphisms Basics Equalities Orders.
 Set Implicit Arguments.
diff --git a/theories/Structures/vo.itarget b/theories/Structures/vo.itarget
deleted file mode 100644
index 674e9fba..00000000
--- a/theories/Structures/vo.itarget
+++ /dev/null
@@ -1,14 +0,0 @@
-Equalities.vo
-EqualitiesFacts.vo
-Orders.vo
-OrdersEx.vo
-OrdersFacts.vo
-OrdersLists.vo
-OrdersTac.vo
-OrdersAlt.vo
-GenericMinMax.vo
-DecidableType.vo
-DecidableTypeEx.vo
-OrderedTypeAlt.vo
-OrderedTypeEx.vo
-OrderedType.vo
diff --git a/theories/Unicode/Utf8.v b/theories/Unicode/Utf8.v
index d5c2fa73..6cc9ea09 100644
--- a/theories/Unicode/Utf8.v
+++ b/theories/Unicode/Utf8.v
@@ -1,10 +1,12 @@
 (* -*- coding:utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Utf8_core.
diff --git a/theories/Unicode/Utf8_core.v b/theories/Unicode/Utf8_core.v
index 44a0700a..5a8931a8 100644
--- a/theories/Unicode/Utf8_core.v
+++ b/theories/Unicode/Utf8_core.v
@@ -1,19 +1,23 @@
 (* -*- coding:utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
 
 (* 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 +29,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/Unicode/vo.itarget b/theories/Unicode/vo.itarget
deleted file mode 100644
index 7be1b996..00000000
--- a/theories/Unicode/vo.itarget
+++ /dev/null
@@ -1,2 +0,0 @@
-Utf8.vo
-Utf8_core.vo
diff --git a/theories/Vectors/Fin.v b/theories/Vectors/Fin.v
index 2955184f..4088843a 100644
--- a/theories/Vectors/Fin.v
+++ b/theories/Vectors/Fin.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Arith_base.
diff --git a/theories/Vectors/Vector.v b/theories/Vectors/Vector.v
index 672858fa..08158769 100644
--- a/theories/Vectors/Vector.v
+++ b/theories/Vectors/Vector.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Vectors.
@@ -21,4 +23,4 @@ Require VectorSpec.
 Require VectorEq.
 Include VectorDef.
 Include VectorSpec.
-Include VectorEq.
\ No newline at end of file
+Include VectorEq.
diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v
index 1f8b76cb..f6f3cafa 100644
--- a/theories/Vectors/VectorDef.v
+++ b/theories/Vectors/VectorDef.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Definitions of Vectors and functions to use them
@@ -147,6 +149,16 @@ Definition shiftrepeat {A} := @rectS _ (fun n _ => t A (S (S n)))
   (fun h =>  h :: h :: []) (fun h _ _ H => h :: H).
 Global Arguments shiftrepeat {A} {n} v.
 
+(** Take first [p] elements of a vector *)
+Fixpoint take {A} {n} (p:nat) (le:p <= n) (v:t A n) : t A p := 
+  match p as p return p <= n -> t A p with 
+  | 0 => fun _ => [] 
+  | S p' => match v in t _ n return S p' <= n -> t A (S p') with
+    | []=> fun le => False_rect _ (Nat.nle_succ_0 p' le)
+    | x::xs => fun le => x::take p' (le_S_n p' _ le) xs
+    end 
+  end le.
+
 (** Remove [p] last elements of a vector *)
 Lemma trunc : forall {A} {n} (p:nat), n > p -> t A n
   -> t A (n - p).
@@ -295,12 +307,10 @@ End VECTORLIST.
 Module VectorNotations.
 Delimit Scope vector_scope with vector.
 Notation "[ ]" := [] (format "[ ]") : vector_scope.
-Notation "[]" := [] (compat "8.5") : vector_scope.
 Notation "h :: t" := (h :: t) (at level 60, right associativity)
   : vector_scope.
 Notation "[ x ]" := (x :: []) : vector_scope.
 Notation "[ x ; y ; .. ; z ]" := (cons _ x _ (cons _ y _ .. (cons _ z _ (nil _)) ..)) : vector_scope.
-Notation "[ x ; .. ; y ]" := (cons _ x _ .. (cons _ y _ (nil _)) ..) (compat "8.4") : vector_scope.
 Notation "v [@ p ]" := (nth v p) (at level 1, format "v [@ p ]") : vector_scope.
 Open Scope vector_scope.
 End VectorNotations.
diff --git a/theories/Vectors/VectorEq.v b/theories/Vectors/VectorEq.v
index 04c57073..317f3f1c 100644
--- a/theories/Vectors/VectorEq.v
+++ b/theories/Vectors/VectorEq.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Equalities and Vector relations
diff --git a/theories/Vectors/VectorSpec.v b/theories/Vectors/VectorSpec.v
index c5278b91..34dbaf36 100644
--- a/theories/Vectors/VectorSpec.v
+++ b/theories/Vectors/VectorSpec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Proofs of specification for functions defined over Vector
@@ -122,3 +124,32 @@ induction l.
 - reflexivity.
 - unfold to_list; simpl. now f_equal.
 Qed.
+
+Lemma take_O : forall {A} {n} le (v:t A n), take 0 le v = [].
+Proof. 
+  reflexivity.
+Qed. 
+
+Lemma take_idem : forall {A} p n (v:t A n)  le le', 
+  take p le' (take p le v) = take p le v.
+Proof. 
+  induction p; intros n v le le'.
+  - auto. 
+  - destruct v. inversion le. simpl. apply f_equal. apply IHp. 
+Qed.
+
+Lemma take_app : forall {A} {n} (v:t A n) {m} (w:t A m) le, take n le (append v w) = v.
+Proof. 
+  induction v; intros m w le.
+  - reflexivity. 
+  - simpl. apply f_equal. apply IHv. 
+Qed.
+
+(* Proof is irrelevant for [take] *)
+Lemma take_prf_irr : forall {A} p {n} (v:t A n) le le', take p le v = take p le' v.
+Proof. 
+  induction p; intros n v le le'. 
+  - reflexivity.  
+  - destruct v. inversion le. simpl. apply f_equal. apply IHp. 
+Qed.
+
diff --git a/theories/Vectors/vo.itarget b/theories/Vectors/vo.itarget
deleted file mode 100644
index 779b1821..00000000
--- a/theories/Vectors/vo.itarget
+++ /dev/null
@@ -1,5 +0,0 @@
-Fin.vo
-VectorDef.vo
-VectorSpec.vo
-VectorEq.vo
-Vector.vo
diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v
index ebfc27b3..10d90274 100644
--- a/theories/Wellfounded/Disjoint_Union.v
+++ b/theories/Wellfounded/Disjoint_Union.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Author: Cristina Cornes
diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v
index 1ff9b005..ff233ef9 100644
--- a/theories/Wellfounded/Inclusion.v
+++ b/theories/Wellfounded/Inclusion.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Author: Bruno Barras *)
diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v
index 7786c8b3..4a4ab87d 100644
--- a/theories/Wellfounded/Inverse_Image.v
+++ b/theories/Wellfounded/Inverse_Image.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Author: Bruno Barras *)
diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v
index d90f9956..684efeeb 100644
--- a/theories/Wellfounded/Lexicographic_Exponentiation.v
+++ b/theories/Wellfounded/Lexicographic_Exponentiation.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Author: Cristina Cornes
diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v
index b2ada2f9..37fd2fb2 100644
--- a/theories/Wellfounded/Lexicographic_Product.v
+++ b/theories/Wellfounded/Lexicographic_Product.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Authors: Bruno Barras, Cristina Cornes *)
diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v
index eb12d5d7..59068623 100644
--- a/theories/Wellfounded/Transitive_Closure.v
+++ b/theories/Wellfounded/Transitive_Closure.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Author: Bruno Barras *)
diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v
index 61355c8d..9e671651 100644
--- a/theories/Wellfounded/Union.v
+++ b/theories/Wellfounded/Union.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Author: Bruno Barras *)
diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v
index b5acc287..fd363d02 100644
--- a/theories/Wellfounded/Well_Ordering.v
+++ b/theories/Wellfounded/Well_Ordering.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Author: Cristina Cornes.
diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v
index 397f35aa..bfe09e40 100644
--- a/theories/Wellfounded/Wellfounded.v
+++ b/theories/Wellfounded/Wellfounded.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export Disjoint_Union.
diff --git a/theories/Wellfounded/vo.itarget b/theories/Wellfounded/vo.itarget
deleted file mode 100644
index 034d5310..00000000
--- a/theories/Wellfounded/vo.itarget
+++ /dev/null
@@ -1,9 +0,0 @@
-Disjoint_Union.vo
-Inclusion.vo
-Inverse_Image.vo
-Lexicographic_Exponentiation.vo
-Lexicographic_Product.vo
-Transitive_Closure.vo
-Union.vo
-Wellfounded.vo
-Well_Ordering.vo
diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v
index 5aa397f8..cf7397b5 100644
--- a/theories/ZArith/BinInt.v
+++ b/theories/ZArith/BinInt.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export BinNums BinPos Pnat.
@@ -1367,7 +1369,7 @@ Lemma inj_testbit a n : 0<=n ->
  Z.testbit (Z.pos a) n = N.testbit (N.pos a) (Z.to_N n).
 Proof. apply Z.testbit_Zpos. Qed.
 
-(** Some results concerning Z.neg *)
+(** Some results concerning Z.neg and Z.pos *)
 
 Lemma inj_neg p q : Z.neg p = Z.neg q -> p = q.
 Proof. now injection 1. Qed.
@@ -1375,18 +1377,54 @@ Proof. now injection 1. Qed.
 Lemma inj_neg_iff p q : Z.neg p = Z.neg q <-> p = q.
 Proof. split. apply inj_neg. intros; now f_equal. Qed.
 
+Lemma inj_pos p q : Z.pos p = Z.pos q -> p = q.
+Proof. now injection 1. Qed.
+
+Lemma inj_pos_iff p q : Z.pos p = Z.pos q <-> p = q.
+Proof. split. apply inj_pos. intros; now f_equal. Qed.
+
 Lemma neg_is_neg p : Z.neg p < 0.
 Proof. reflexivity. Qed.
 
 Lemma neg_is_nonpos p : Z.neg p <= 0.
 Proof. easy. Qed.
 
+Lemma pos_is_pos p : 0 < Z.pos p.
+Proof. reflexivity. Qed.
+
+Lemma pos_is_nonneg p : 0 <= Z.pos p.
+Proof. easy. Qed.
+
+Lemma neg_le_pos p q : Zneg p <= Zpos q.
+Proof. easy. Qed.
+
+Lemma neg_lt_pos p q : Zneg p < Zpos q.
+Proof. easy. Qed.
+
+Lemma neg_le_neg p q : (q <= p)%positive -> Zneg p <= Zneg q.
+Proof. intros; unfold Z.le; simpl. now rewrite <- Pos.compare_antisym. Qed.
+
+Lemma neg_lt_neg p q : (q < p)%positive -> Zneg p < Zneg q.
+Proof. intros; unfold Z.lt; simpl. now rewrite <- Pos.compare_antisym. Qed.
+
+Lemma pos_le_pos p q : (p <= q)%positive -> Zpos p <= Zpos q.
+Proof. easy. Qed.
+
+Lemma pos_lt_pos p q : (p < q)%positive -> Zpos p < Zpos q.
+Proof. easy. Qed.
+
 Lemma neg_xO p : Z.neg p~0 = 2 * Z.neg p.
 Proof. reflexivity. Qed.
 
 Lemma neg_xI p : Z.neg p~1 = 2 * Z.neg p - 1.
 Proof. reflexivity. Qed.
 
+Lemma pos_xO p : Z.pos p~0 = 2 * Z.pos p.
+Proof. reflexivity. Qed.
+
+Lemma pos_xI p : Z.pos p~1 = 2 * Z.pos p + 1.
+Proof. reflexivity. Qed.
+
 Lemma opp_neg p : - Z.neg p = Z.pos p.
 Proof. reflexivity. Qed.
 
@@ -1402,6 +1440,9 @@ Proof. reflexivity. Qed.
 Lemma add_neg_pos p q : Z.neg p + Z.pos q = Z.pos_sub q p.
 Proof. reflexivity. Qed.
 
+Lemma add_pos_pos p q : Z.pos p + Z.pos q = Z.pos (p+q).
+Proof. reflexivity. Qed.
+
 Lemma divide_pos_neg_r n p : (n|Z.pos p) <-> (n|Z.neg p).
 Proof. apply Z.divide_Zpos_Zneg_r. Qed.
 
@@ -1412,6 +1453,10 @@ Lemma testbit_neg a n : 0<=n ->
  Z.testbit (Z.neg a) n = negb (N.testbit (Pos.pred_N a) (Z.to_N n)).
 Proof. apply Z.testbit_Zneg. Qed.
 
+Lemma testbit_pos a n : 0<=n ->
+ Z.testbit (Z.pos a) n = N.testbit (N.pos a) (Z.to_N n).
+Proof. apply Z.testbit_Zpos. Qed.
+
 End Pos2Z.
 
 Module Z2Pos.
@@ -1522,94 +1567,94 @@ End Z2Pos.
 
 (** Compatibility Notations *)
 
-Notation Zdouble_plus_one := Z.succ_double (compat "8.3").
-Notation Zdouble_minus_one := Z.pred_double (compat "8.3").
-Notation Zdouble := Z.double (compat "8.3").
-Notation ZPminus := Z.pos_sub (compat "8.3").
-Notation Zsucc' := Z.succ (compat "8.3").
-Notation Zpred' := Z.pred (compat "8.3").
-Notation Zplus' := Z.add (compat "8.3").
-Notation Zplus := Z.add (compat "8.3"). (* Slightly incompatible *)
-Notation Zopp := Z.opp (compat "8.3").
-Notation Zsucc := Z.succ (compat "8.3").
-Notation Zpred := Z.pred (compat "8.3").
-Notation Zminus := Z.sub (compat "8.3").
-Notation Zmult := Z.mul (compat "8.3").
-Notation Zcompare := Z.compare (compat "8.3").
-Notation Zsgn := Z.sgn (compat "8.3").
-Notation Zle := Z.le (compat "8.3").
-Notation Zge := Z.ge (compat "8.3").
-Notation Zlt := Z.lt (compat "8.3").
-Notation Zgt := Z.gt (compat "8.3").
-Notation Zmax := Z.max (compat "8.3").
-Notation Zmin := Z.min (compat "8.3").
-Notation Zabs := Z.abs (compat "8.3").
-Notation Zabs_nat := Z.abs_nat (compat "8.3").
-Notation Zabs_N := Z.abs_N (compat "8.3").
-Notation Z_of_nat := Z.of_nat (compat "8.3").
-Notation Z_of_N := Z.of_N (compat "8.3").
-
-Notation Zind := Z.peano_ind (compat "8.3").
-Notation Zopp_0 := Z.opp_0 (compat "8.3").
-Notation Zopp_involutive := Z.opp_involutive (compat "8.3").
-Notation Zopp_inj := Z.opp_inj (compat "8.3").
-Notation Zplus_0_l := Z.add_0_l (compat "8.3").
-Notation Zplus_0_r := Z.add_0_r (compat "8.3").
-Notation Zplus_comm := Z.add_comm (compat "8.3").
-Notation Zopp_plus_distr := Z.opp_add_distr (compat "8.3").
-Notation Zopp_succ := Z.opp_succ (compat "8.3").
-Notation Zplus_opp_r := Z.add_opp_diag_r (compat "8.3").
-Notation Zplus_opp_l := Z.add_opp_diag_l (compat "8.3").
-Notation Zplus_assoc := Z.add_assoc (compat "8.3").
-Notation Zplus_permute := Z.add_shuffle3 (compat "8.3").
-Notation Zplus_reg_l := Z.add_reg_l (compat "8.3").
-Notation Zplus_succ_l := Z.add_succ_l (compat "8.3").
-Notation Zplus_succ_comm := Z.add_succ_comm (compat "8.3").
-Notation Zsucc_discr := Z.neq_succ_diag_r (compat "8.3").
-Notation Zsucc_inj := Z.succ_inj (compat "8.3").
-Notation Zsucc'_inj := Z.succ_inj (compat "8.3").
-Notation Zsucc'_pred' := Z.succ_pred (compat "8.3").
-Notation Zpred'_succ' := Z.pred_succ (compat "8.3").
-Notation Zpred'_inj := Z.pred_inj (compat "8.3").
-Notation Zsucc'_discr := Z.neq_succ_diag_r (compat "8.3").
-Notation Zminus_0_r := Z.sub_0_r (compat "8.3").
-Notation Zminus_diag := Z.sub_diag (compat "8.3").
-Notation Zminus_plus_distr := Z.sub_add_distr (compat "8.3").
-Notation Zminus_succ_r := Z.sub_succ_r (compat "8.3").
-Notation Zminus_plus := Z.add_simpl_l (compat "8.3").
-Notation Zmult_0_l := Z.mul_0_l (compat "8.3").
-Notation Zmult_0_r := Z.mul_0_r (compat "8.3").
-Notation Zmult_1_l := Z.mul_1_l (compat "8.3").
-Notation Zmult_1_r := Z.mul_1_r (compat "8.3").
-Notation Zmult_comm := Z.mul_comm (compat "8.3").
-Notation Zmult_assoc := Z.mul_assoc (compat "8.3").
-Notation Zmult_permute := Z.mul_shuffle3 (compat "8.3").
-Notation Zmult_1_inversion_l := Z.mul_eq_1 (compat "8.3").
-Notation Zdouble_mult := Z.double_spec (compat "8.3").
-Notation Zdouble_plus_one_mult := Z.succ_double_spec (compat "8.3").
-Notation Zopp_mult_distr_l_reverse := Z.mul_opp_l (compat "8.3").
-Notation Zmult_opp_opp := Z.mul_opp_opp (compat "8.3").
-Notation Zmult_opp_comm := Z.mul_opp_comm (compat "8.3").
-Notation Zopp_eq_mult_neg_1 := Z.opp_eq_mul_m1 (compat "8.3").
-Notation Zmult_plus_distr_r := Z.mul_add_distr_l (compat "8.3").
-Notation Zmult_plus_distr_l := Z.mul_add_distr_r (compat "8.3").
-Notation Zmult_minus_distr_r := Z.mul_sub_distr_r (compat "8.3").
-Notation Zmult_reg_l := Z.mul_reg_l (compat "8.3").
-Notation Zmult_reg_r := Z.mul_reg_r (compat "8.3").
-Notation Zmult_succ_l := Z.mul_succ_l (compat "8.3").
-Notation Zmult_succ_r := Z.mul_succ_r (compat "8.3").
-
-Notation Zpos_xI := Pos2Z.inj_xI (compat "8.3").
-Notation Zpos_xO := Pos2Z.inj_xO (compat "8.3").
-Notation Zneg_xI := Pos2Z.neg_xI (compat "8.3").
-Notation Zneg_xO := Pos2Z.neg_xO (compat "8.3").
-Notation Zopp_neg := Pos2Z.opp_neg (compat "8.3").
-Notation Zpos_succ_morphism := Pos2Z.inj_succ (compat "8.3").
-Notation Zpos_mult_morphism := Pos2Z.inj_mul (compat "8.3").
-Notation Zpos_minus_morphism := Pos2Z.inj_sub (compat "8.3").
-Notation Zpos_eq_rev := Pos2Z.inj (compat "8.3").
-Notation Zpos_plus_distr := Pos2Z.inj_add (compat "8.3").
-Notation Zneg_plus_distr := Pos2Z.add_neg_neg (compat "8.3").
+Notation Zdouble_plus_one := Z.succ_double (only parsing).
+Notation Zdouble_minus_one := Z.pred_double (only parsing).
+Notation Zdouble := Z.double (compat "8.6").
+Notation ZPminus := Z.pos_sub (only parsing).
+Notation Zsucc' := Z.succ (compat "8.6").
+Notation Zpred' := Z.pred (compat "8.6").
+Notation Zplus' := Z.add (compat "8.6").
+Notation Zplus := Z.add (only parsing). (* Slightly incompatible *)
+Notation Zopp := Z.opp (compat "8.6").
+Notation Zsucc := Z.succ (compat "8.6").
+Notation Zpred := Z.pred (compat "8.6").
+Notation Zminus := Z.sub (only parsing).
+Notation Zmult := Z.mul (only parsing).
+Notation Zcompare := Z.compare (compat "8.6").
+Notation Zsgn := Z.sgn (compat "8.6").
+Notation Zle := Z.le (compat "8.6").
+Notation Zge := Z.ge (compat "8.6").
+Notation Zlt := Z.lt (compat "8.6").
+Notation Zgt := Z.gt (compat "8.6").
+Notation Zmax := Z.max (compat "8.6").
+Notation Zmin := Z.min (compat "8.6").
+Notation Zabs := Z.abs (compat "8.6").
+Notation Zabs_nat := Z.abs_nat (compat "8.6").
+Notation Zabs_N := Z.abs_N (compat "8.6").
+Notation Z_of_nat := Z.of_nat (only parsing).
+Notation Z_of_N := Z.of_N (only parsing).
+
+Notation Zind := Z.peano_ind (only parsing).
+Notation Zopp_0 := Z.opp_0 (compat "8.6").
+Notation Zopp_involutive := Z.opp_involutive (compat "8.6").
+Notation Zopp_inj := Z.opp_inj (compat "8.6").
+Notation Zplus_0_l := Z.add_0_l (only parsing).
+Notation Zplus_0_r := Z.add_0_r (only parsing).
+Notation Zplus_comm := Z.add_comm (only parsing).
+Notation Zopp_plus_distr := Z.opp_add_distr (only parsing).
+Notation Zopp_succ := Z.opp_succ (compat "8.6").
+Notation Zplus_opp_r := Z.add_opp_diag_r (only parsing).
+Notation Zplus_opp_l := Z.add_opp_diag_l (only parsing).
+Notation Zplus_assoc := Z.add_assoc (only parsing).
+Notation Zplus_permute := Z.add_shuffle3 (only parsing).
+Notation Zplus_reg_l := Z.add_reg_l (only parsing).
+Notation Zplus_succ_l := Z.add_succ_l (only parsing).
+Notation Zplus_succ_comm := Z.add_succ_comm (only parsing).
+Notation Zsucc_discr := Z.neq_succ_diag_r (only parsing).
+Notation Zsucc_inj := Z.succ_inj (compat "8.6").
+Notation Zsucc'_inj := Z.succ_inj (compat "8.6").
+Notation Zsucc'_pred' := Z.succ_pred (compat "8.6").
+Notation Zpred'_succ' := Z.pred_succ (compat "8.6").
+Notation Zpred'_inj := Z.pred_inj (compat "8.6").
+Notation Zsucc'_discr := Z.neq_succ_diag_r (only parsing).
+Notation Zminus_0_r := Z.sub_0_r (only parsing).
+Notation Zminus_diag := Z.sub_diag (only parsing).
+Notation Zminus_plus_distr := Z.sub_add_distr (only parsing).
+Notation Zminus_succ_r := Z.sub_succ_r (only parsing).
+Notation Zminus_plus := Z.add_simpl_l (only parsing).
+Notation Zmult_0_l := Z.mul_0_l (only parsing).
+Notation Zmult_0_r := Z.mul_0_r (only parsing).
+Notation Zmult_1_l := Z.mul_1_l (only parsing).
+Notation Zmult_1_r := Z.mul_1_r (only parsing).
+Notation Zmult_comm := Z.mul_comm (only parsing).
+Notation Zmult_assoc := Z.mul_assoc (only parsing).
+Notation Zmult_permute := Z.mul_shuffle3 (only parsing).
+Notation Zmult_1_inversion_l := Z.mul_eq_1 (only parsing).
+Notation Zdouble_mult := Z.double_spec (only parsing).
+Notation Zdouble_plus_one_mult := Z.succ_double_spec (only parsing).
+Notation Zopp_mult_distr_l_reverse := Z.mul_opp_l (only parsing).
+Notation Zmult_opp_opp := Z.mul_opp_opp (only parsing).
+Notation Zmult_opp_comm := Z.mul_opp_comm (only parsing).
+Notation Zopp_eq_mult_neg_1 := Z.opp_eq_mul_m1 (only parsing).
+Notation Zmult_plus_distr_r := Z.mul_add_distr_l (only parsing).
+Notation Zmult_plus_distr_l := Z.mul_add_distr_r (only parsing).
+Notation Zmult_minus_distr_r := Z.mul_sub_distr_r (only parsing).
+Notation Zmult_reg_l := Z.mul_reg_l (only parsing).
+Notation Zmult_reg_r := Z.mul_reg_r (only parsing).
+Notation Zmult_succ_l := Z.mul_succ_l (only parsing).
+Notation Zmult_succ_r := Z.mul_succ_r (only parsing).
+
+Notation Zpos_xI := Pos2Z.inj_xI (only parsing).
+Notation Zpos_xO := Pos2Z.inj_xO (only parsing).
+Notation Zneg_xI := Pos2Z.neg_xI (only parsing).
+Notation Zneg_xO := Pos2Z.neg_xO (only parsing).
+Notation Zopp_neg := Pos2Z.opp_neg (only parsing).
+Notation Zpos_succ_morphism := Pos2Z.inj_succ (only parsing).
+Notation Zpos_mult_morphism := Pos2Z.inj_mul (only parsing).
+Notation Zpos_minus_morphism := Pos2Z.inj_sub (only parsing).
+Notation Zpos_eq_rev := Pos2Z.inj (only parsing).
+Notation Zpos_plus_distr := Pos2Z.inj_add (only parsing).
+Notation Zneg_plus_distr := Pos2Z.add_neg_neg (only parsing).
 
 Notation Z := Z (only parsing).
 Notation Z_rect := Z_rect (only parsing).
diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v
index 8c2e7d94..db4de0b9 100644
--- a/theories/ZArith/BinIntDef.v
+++ b/theories/ZArith/BinIntDef.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Export BinNums.
@@ -299,6 +301,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 +635,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/Int.v b/theories/ZArith/Int.v
index 72021f2e..2f3bf9a3 100644
--- a/theories/ZArith/Int.v
+++ b/theories/ZArith/Int.v
@@ -1,10 +1,12 @@
-(***********************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
-(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
-(*   \VV/  *************************************************************)
-(*    //   *      This file is distributed under the terms of the      *)
-(*         *       GNU Lesser General Public License Version 2.1       *)
-(***********************************************************************)
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
 
 (** * An light axiomatization of integers (used in MSetAVL). *)
 
@@ -452,7 +454,7 @@ Module Z_as_Int <: Int.
   Proof. reflexivity. Qed.
 
   (** Compatibility notations for Coq v8.4 *)
-  Notation plus := add (compat "8.4").
-  Notation minus := sub (compat "8.4").
-  Notation mult := mul (compat "8.4").
+  Notation plus := add (only parsing).
+  Notation minus := sub (only parsing).
+  Notation mult := mul (only parsing).
 End Z_as_Int.
diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v
index 4fbbac26..86434208 100644
--- a/theories/ZArith/Wf_Z.v
+++ b/theories/ZArith/Wf_Z.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinInt.
diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v
index f86a7e52..0842920b 100644
--- a/theories/ZArith/ZArith.v
+++ b/theories/ZArith/ZArith.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Library for manipulating integers based on binary encoding *)
diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v
index a1da544d..3d6bcddc 100644
--- a/theories/ZArith/ZArith_base.v
+++ b/theories/ZArith/ZArith_base.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Library for manipulating integers based on binary encoding.
diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v
index 8947295e..9bcdb73a 100644
--- a/theories/ZArith/ZArith_dec.v
+++ b/theories/ZArith/ZArith_dec.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Sumbool.
@@ -32,7 +34,7 @@ Lemma Zcompare_rec (P:Set) (n m:Z) :
   ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
 Proof. apply Zcompare_rect. Defined.
 
-Notation Z_eq_dec := Z.eq_dec (compat "8.3").
+Notation Z_eq_dec := Z.eq_dec (compat "8.6").
 
 Section decidability.
 
diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v
index df9db5b2..0d8450e3 100644
--- a/theories/ZArith/Zabs.v
+++ b/theories/ZArith/Zabs.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Binary Integers : properties of absolute value *)
@@ -27,17 +29,17 @@ Local Open Scope Z_scope.
 (**********************************************************************)
 (** * Properties of absolute value *)
 
-Notation Zabs_eq := Z.abs_eq (compat "8.3").
-Notation Zabs_non_eq := Z.abs_neq (compat "8.3").
-Notation Zabs_Zopp := Z.abs_opp (compat "8.3").
-Notation Zabs_pos := Z.abs_nonneg (compat "8.3").
-Notation Zabs_involutive := Z.abs_involutive (compat "8.3").
-Notation Zabs_eq_case := Z.abs_eq_cases (compat "8.3").
-Notation Zabs_triangle := Z.abs_triangle (compat "8.3").
-Notation Zsgn_Zabs := Z.sgn_abs (compat "8.3").
-Notation Zabs_Zsgn := Z.abs_sgn (compat "8.3").
-Notation Zabs_Zmult := Z.abs_mul (compat "8.3").
-Notation Zabs_square := Z.abs_square (compat "8.3").
+Notation Zabs_eq := Z.abs_eq (compat "8.6").
+Notation Zabs_non_eq := Z.abs_neq (only parsing).
+Notation Zabs_Zopp := Z.abs_opp (only parsing).
+Notation Zabs_pos := Z.abs_nonneg (only parsing).
+Notation Zabs_involutive := Z.abs_involutive (compat "8.6").
+Notation Zabs_eq_case := Z.abs_eq_cases (only parsing).
+Notation Zabs_triangle := Z.abs_triangle (compat "8.6").
+Notation Zsgn_Zabs := Z.sgn_abs (only parsing).
+Notation Zabs_Zsgn := Z.abs_sgn (only parsing).
+Notation Zabs_Zmult := Z.abs_mul (only parsing).
+Notation Zabs_square := Z.abs_square (compat "8.6").
 
 (** * Proving a property of the absolute value by cases *)
 
@@ -68,11 +70,11 @@ Qed.
 
 (** * Some results about the sign function. *)
 
-Notation Zsgn_Zmult := Z.sgn_mul (compat "8.3").
-Notation Zsgn_Zopp := Z.sgn_opp (compat "8.3").
-Notation Zsgn_pos := Z.sgn_pos_iff (compat "8.3").
-Notation Zsgn_neg := Z.sgn_neg_iff (compat "8.3").
-Notation Zsgn_null := Z.sgn_null_iff (compat "8.3").
+Notation Zsgn_Zmult := Z.sgn_mul (only parsing).
+Notation Zsgn_Zopp := Z.sgn_opp (only parsing).
+Notation Zsgn_pos := Z.sgn_pos_iff (only parsing).
+Notation Zsgn_neg := Z.sgn_neg_iff (only parsing).
+Notation Zsgn_null := Z.sgn_null_iff (only parsing).
 
 (** A characterization of the sign function: *)
 
@@ -86,13 +88,13 @@ Qed.
 
 (** Compatibility *)
 
-Notation inj_Zabs_nat := Zabs2Nat.id_abs (compat "8.3").
-Notation Zabs_nat_Z_of_nat := Zabs2Nat.id (compat "8.3").
-Notation Zabs_nat_mult := Zabs2Nat.inj_mul (compat "8.3").
-Notation Zabs_nat_Zsucc := Zabs2Nat.inj_succ (compat "8.3").
-Notation Zabs_nat_Zplus := Zabs2Nat.inj_add (compat "8.3").
-Notation Zabs_nat_Zminus := (fun n m => Zabs2Nat.inj_sub m n) (compat "8.3").
-Notation Zabs_nat_compare := Zabs2Nat.inj_compare (compat "8.3").
+Notation inj_Zabs_nat := Zabs2Nat.id_abs (only parsing).
+Notation Zabs_nat_Z_of_nat := Zabs2Nat.id (only parsing).
+Notation Zabs_nat_mult := Zabs2Nat.inj_mul (only parsing).
+Notation Zabs_nat_Zsucc := Zabs2Nat.inj_succ (only parsing).
+Notation Zabs_nat_Zplus := Zabs2Nat.inj_add (only parsing).
+Notation Zabs_nat_Zminus := (fun n m => Zabs2Nat.inj_sub m n) (only parsing).
+Notation Zabs_nat_compare := Zabs2Nat.inj_compare (only parsing).
 
 Lemma Zabs_nat_le n m : 0 <= n <= m -> (Z.abs_nat n <= Z.abs_nat m)%nat.
 Proof.
diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v
index 41d1b2b5..632d41b6 100644
--- a/theories/ZArith/Zbool.v
+++ b/theories/ZArith/Zbool.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinInt.
@@ -33,10 +35,10 @@ Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x).
 (**********************************************************************)
 (** * Boolean comparisons of binary integers *)
 
-Notation Zle_bool := Z.leb (compat "8.3").
-Notation Zge_bool := Z.geb (compat "8.3").
-Notation Zlt_bool := Z.ltb (compat "8.3").
-Notation Zgt_bool := Z.gtb (compat "8.3").
+Notation Zle_bool := Z.leb (only parsing).
+Notation Zge_bool := Z.geb (only parsing).
+Notation Zlt_bool := Z.ltb (only parsing).
+Notation Zgt_bool := Z.gtb (only parsing).
 
 (** We now provide a direct [Z.eqb] that doesn't refer to [Z.compare].
    The old [Zeq_bool] is kept for compatibility. *)
@@ -87,7 +89,7 @@ Proof.
  apply Z.leb_le.
 Qed.
 
-Notation Zle_bool_refl := Z.leb_refl (compat "8.3").
+Notation Zle_bool_refl := Z.leb_refl (only parsing).
 
 Lemma Zle_bool_antisym n m :
  (n <=? m) = true -> (m <=? n) = true -> n = m.
diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v
index 2627f174..c8432e27 100644
--- a/theories/ZArith/Zcompare.v
+++ b/theories/ZArith/Zcompare.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Binary Integers : results about Z.compare *)
@@ -181,18 +183,18 @@ Qed.
 
 (** Compatibility notations *)
 
-Notation Zcompare_refl := Z.compare_refl (compat "8.3").
-Notation Zcompare_Eq_eq := Z.compare_eq (compat "8.3").
-Notation Zcompare_Eq_iff_eq := Z.compare_eq_iff (compat "8.3").
-Notation Zcompare_spec := Z.compare_spec (compat "8.3").
-Notation Zmin_l := Z.min_l (compat "8.3").
-Notation Zmin_r := Z.min_r (compat "8.3").
-Notation Zmax_l := Z.max_l (compat "8.3").
-Notation Zmax_r := Z.max_r (compat "8.3").
-Notation Zabs_eq := Z.abs_eq (compat "8.3").
-Notation Zabs_non_eq := Z.abs_neq (compat "8.3").
-Notation Zsgn_0 := Z.sgn_null (compat "8.3").
-Notation Zsgn_1 := Z.sgn_pos (compat "8.3").
-Notation Zsgn_m1 := Z.sgn_neg (compat "8.3").
+Notation Zcompare_refl := Z.compare_refl (compat "8.6").
+Notation Zcompare_Eq_eq := Z.compare_eq (only parsing).
+Notation Zcompare_Eq_iff_eq := Z.compare_eq_iff (only parsing).
+Notation Zcompare_spec := Z.compare_spec (compat "8.6").
+Notation Zmin_l := Z.min_l (compat "8.6").
+Notation Zmin_r := Z.min_r (compat "8.6").
+Notation Zmax_l := Z.max_l (compat "8.6").
+Notation Zmax_r := Z.max_r (compat "8.6").
+Notation Zabs_eq := Z.abs_eq (compat "8.6").
+Notation Zabs_non_eq := Z.abs_neq (only parsing).
+Notation Zsgn_0 := Z.sgn_null (only parsing).
+Notation Zsgn_1 := Z.sgn_pos (only parsing).
+Notation Zsgn_m1 := Z.sgn_neg (only parsing).
 
 (** Not kept: Zcompare_egal_dec *)
diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v
index 5bdb32fc..adf72a6a 100644
--- a/theories/ZArith/Zcomplements.v
+++ b/theories/ZArith/Zcomplements.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZArithRing.
diff --git a/theories/ZArith/Zdigits.v b/theories/ZArith/Zdigits.v
index bc3694bc..d1eef613 100644
--- a/theories/ZArith/Zdigits.v
+++ b/theories/ZArith/Zdigits.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Bit vectors interpreted as integers.
diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v
index 2ba865bd..15d0e487 100644
--- a/theories/ZArith/Zdiv.v
+++ b/theories/ZArith/Zdiv.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Euclidean Division *)
@@ -18,16 +20,16 @@ Local Open Scope Z_scope.
 (** The definition of the division is now in [BinIntDef], the initial
     specifications and properties are in [BinInt]. *)
 
-Notation Zdiv_eucl_POS := Z.pos_div_eucl (compat "8.3").
-Notation Zdiv_eucl := Z.div_eucl (compat "8.3").
-Notation Zdiv := Z.div (compat "8.3").
-Notation Zmod := Z.modulo (compat "8.3").
+Notation Zdiv_eucl_POS := Z.pos_div_eucl (only parsing).
+Notation Zdiv_eucl := Z.div_eucl (compat "8.6").
+Notation Zdiv := Z.div (compat "8.6").
+Notation Zmod := Z.modulo (only parsing).
 
-Notation Zdiv_eucl_eq := Z.div_eucl_eq (compat "8.3").
-Notation Z_div_mod_eq_full := Z.div_mod (compat "8.3").
-Notation Zmod_POS_bound := Z.pos_div_eucl_bound (compat "8.3").
-Notation Zmod_pos_bound := Z.mod_pos_bound (compat "8.3").
-Notation Zmod_neg_bound := Z.mod_neg_bound (compat "8.3").
+Notation Zdiv_eucl_eq := Z.div_eucl_eq (compat "8.6").
+Notation Z_div_mod_eq_full := Z.div_mod (only parsing).
+Notation Zmod_POS_bound := Z.pos_div_eucl_bound (only parsing).
+Notation Zmod_pos_bound := Z.mod_pos_bound (only parsing).
+Notation Zmod_neg_bound := Z.mod_neg_bound (only parsing).
 
 (** * Main division theorems *)
 
@@ -508,6 +510,13 @@ Qed.
 (** Unfortunately, the previous result isn't always true on negative numbers.
     For instance: 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) *)
 
+Lemma Zmod_div : forall a b, a mod b / b = 0.
+Proof.
+ intros a b.
+ zero_or_not b.
+ auto using Z.mod_div.
+Qed.
+
 (** A last inequality: *)
 
 Theorem Zdiv_mult_le:
diff --git a/theories/ZArith/Zeuclid.v b/theories/ZArith/Zeuclid.v
index 38a824cd..dc75db13 100644
--- a/theories/ZArith/Zeuclid.v
+++ b/theories/ZArith/Zeuclid.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Morphisms BinInt ZDivEucl.
diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v
index d4051ef7..00a58b51 100644
--- a/theories/ZArith/Zeven.v
+++ b/theories/ZArith/Zeven.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Binary Integers : Parity and Division by Two *)
@@ -58,8 +60,8 @@ Proof (Zodd_equiv n).
 
 (** Boolean tests of parity (now in BinInt.Z) *)
 
-Notation Zeven_bool := Z.even (compat "8.3").
-Notation Zodd_bool := Z.odd (compat "8.3").
+Notation Zeven_bool := Z.even (only parsing).
+Notation Zodd_bool := Z.odd (only parsing).
 
 Lemma Zeven_bool_iff n : Z.even n = true <-> Zeven n.
 Proof.
@@ -130,17 +132,17 @@ Qed.
 
 Hint Unfold Zeven Zodd: zarith.
 
-Notation Zeven_bool_succ := Z.even_succ (compat "8.3").
-Notation Zeven_bool_pred := Z.even_pred (compat "8.3").
-Notation Zodd_bool_succ := Z.odd_succ (compat "8.3").
-Notation Zodd_bool_pred := Z.odd_pred (compat "8.3").
+Notation Zeven_bool_succ := Z.even_succ (only parsing).
+Notation Zeven_bool_pred := Z.even_pred (only parsing).
+Notation Zodd_bool_succ := Z.odd_succ (only parsing).
+Notation Zodd_bool_pred := Z.odd_pred (only parsing).
 
 (******************************************************************)
 (** * Definition of [Z.quot2], [Z.div2] and properties wrt [Zeven]
   and [Zodd] *)
 
-Notation Zdiv2 := Z.div2 (compat "8.3").
-Notation Zquot2 := Z.quot2 (compat "8.3").
+Notation Zdiv2 := Z.div2 (compat "8.6").
+Notation Zquot2 := Z.quot2 (compat "8.6").
 
 (** Properties of [Z.div2] *)
 
diff --git a/theories/ZArith/Zgcd_alt.v b/theories/ZArith/Zgcd_alt.v
index 3977ca9d..cced1190 100644
--- a/theories/ZArith/Zgcd_alt.v
+++ b/theories/ZArith/Zgcd_alt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * Zgcd_alt : an alternate version of Z.gcd, based on Euclid's algorithm *)
diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v
index c4e201e3..bfcc60ed 100644
--- a/theories/ZArith/Zhints.v
+++ b/theories/ZArith/Zhints.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** This file centralizes the lemmas about [Z], classifying them
diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v
index fdfd71e1..24412e94 100644
--- a/theories/ZArith/Zlogarithm.v
+++ b/theories/ZArith/Zlogarithm.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v
index 529e9f1d..7f595fcf 100644
--- a/theories/ZArith/Zmax.v
+++ b/theories/ZArith/Zmax.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** THIS FILE IS DEPRECATED. *)
@@ -16,32 +18,32 @@ Local Open Scope Z_scope.
 
 (** Exact compatibility *)
 
-Notation Zmax_case := Z.max_case (compat "8.3").
-Notation Zmax_case_strong := Z.max_case_strong (compat "8.3").
-Notation Zmax_right := Z.max_r (compat "8.3").
-Notation Zle_max_l := Z.le_max_l (compat "8.3").
-Notation Zle_max_r := Z.le_max_r (compat "8.3").
-Notation Zmax_lub := Z.max_lub (compat "8.3").
-Notation Zmax_lub_lt := Z.max_lub_lt (compat "8.3").
-Notation Zle_max_compat_r := Z.max_le_compat_r (compat "8.3").
-Notation Zle_max_compat_l := Z.max_le_compat_l (compat "8.3").
-Notation Zmax_idempotent := Z.max_id (compat "8.3").
-Notation Zmax_n_n := Z.max_id (compat "8.3").
-Notation Zmax_comm := Z.max_comm (compat "8.3").
-Notation Zmax_assoc := Z.max_assoc (compat "8.3").
-Notation Zmax_irreducible_dec := Z.max_dec (compat "8.3").
-Notation Zmax_le_prime := Z.max_le (compat "8.3").
-Notation Zsucc_max_distr := Z.succ_max_distr (compat "8.3").
-Notation Zmax_SS := Z.succ_max_distr (compat "8.3").
-Notation Zplus_max_distr_l := Z.add_max_distr_l (compat "8.3").
-Notation Zplus_max_distr_r := Z.add_max_distr_r (compat "8.3").
-Notation Zmax_plus := Z.add_max_distr_r (compat "8.3").
-Notation Zmax1 := Z.le_max_l (compat "8.3").
-Notation Zmax2 := Z.le_max_r (compat "8.3").
-Notation Zmax_irreducible_inf := Z.max_dec (compat "8.3").
-Notation Zmax_le_prime_inf := Z.max_le (compat "8.3").
-Notation Zpos_max := Pos2Z.inj_max (compat "8.3").
-Notation Zpos_minus := Pos2Z.inj_sub_max (compat "8.3").
+Notation Zmax_case := Z.max_case (compat "8.6").
+Notation Zmax_case_strong := Z.max_case_strong (compat "8.6").
+Notation Zmax_right := Z.max_r (only parsing).
+Notation Zle_max_l := Z.le_max_l (compat "8.6").
+Notation Zle_max_r := Z.le_max_r (compat "8.6").
+Notation Zmax_lub := Z.max_lub (compat "8.6").
+Notation Zmax_lub_lt := Z.max_lub_lt (compat "8.6").
+Notation Zle_max_compat_r := Z.max_le_compat_r (only parsing).
+Notation Zle_max_compat_l := Z.max_le_compat_l (only parsing).
+Notation Zmax_idempotent := Z.max_id (only parsing).
+Notation Zmax_n_n := Z.max_id (only parsing).
+Notation Zmax_comm := Z.max_comm (compat "8.6").
+Notation Zmax_assoc := Z.max_assoc (compat "8.6").
+Notation Zmax_irreducible_dec := Z.max_dec (only parsing).
+Notation Zmax_le_prime := Z.max_le (only parsing).
+Notation Zsucc_max_distr := Z.succ_max_distr (compat "8.6").
+Notation Zmax_SS := Z.succ_max_distr (only parsing).
+Notation Zplus_max_distr_l := Z.add_max_distr_l (only parsing).
+Notation Zplus_max_distr_r := Z.add_max_distr_r (only parsing).
+Notation Zmax_plus := Z.add_max_distr_r (only parsing).
+Notation Zmax1 := Z.le_max_l (only parsing).
+Notation Zmax2 := Z.le_max_r (only parsing).
+Notation Zmax_irreducible_inf := Z.max_dec (only parsing).
+Notation Zmax_le_prime_inf := Z.max_le (only parsing).
+Notation Zpos_max := Pos2Z.inj_max (only parsing).
+Notation Zpos_minus := Pos2Z.inj_sub_max (only parsing).
 
 (** Slightly different lemmas *)
 
diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v
index 782a5158..6bc72227 100644
--- a/theories/ZArith/Zmin.v
+++ b/theories/ZArith/Zmin.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** THIS FILE IS DEPRECATED. *)
@@ -16,24 +18,24 @@ Local Open Scope Z_scope.
 
 (** Exact compatibility *)
 
-Notation Zmin_case := Z.min_case (compat "8.3").
-Notation Zmin_case_strong := Z.min_case_strong (compat "8.3").
-Notation Zle_min_l := Z.le_min_l (compat "8.3").
-Notation Zle_min_r := Z.le_min_r (compat "8.3").
-Notation Zmin_glb := Z.min_glb (compat "8.3").
-Notation Zmin_glb_lt := Z.min_glb_lt (compat "8.3").
-Notation Zle_min_compat_r := Z.min_le_compat_r (compat "8.3").
-Notation Zle_min_compat_l := Z.min_le_compat_l (compat "8.3").
-Notation Zmin_idempotent := Z.min_id (compat "8.3").
-Notation Zmin_n_n := Z.min_id (compat "8.3").
-Notation Zmin_comm := Z.min_comm (compat "8.3").
-Notation Zmin_assoc := Z.min_assoc (compat "8.3").
-Notation Zmin_irreducible_inf := Z.min_dec (compat "8.3").
-Notation Zsucc_min_distr := Z.succ_min_distr (compat "8.3").
-Notation Zmin_SS := Z.succ_min_distr (compat "8.3").
-Notation Zplus_min_distr_r := Z.add_min_distr_r (compat "8.3").
-Notation Zmin_plus := Z.add_min_distr_r (compat "8.3").
-Notation Zpos_min := Pos2Z.inj_min (compat "8.3").
+Notation Zmin_case := Z.min_case (compat "8.6").
+Notation Zmin_case_strong := Z.min_case_strong (compat "8.6").
+Notation Zle_min_l := Z.le_min_l (compat "8.6").
+Notation Zle_min_r := Z.le_min_r (compat "8.6").
+Notation Zmin_glb := Z.min_glb (compat "8.6").
+Notation Zmin_glb_lt := Z.min_glb_lt (compat "8.6").
+Notation Zle_min_compat_r := Z.min_le_compat_r (only parsing).
+Notation Zle_min_compat_l := Z.min_le_compat_l (only parsing).
+Notation Zmin_idempotent := Z.min_id (only parsing).
+Notation Zmin_n_n := Z.min_id (only parsing).
+Notation Zmin_comm := Z.min_comm (compat "8.6").
+Notation Zmin_assoc := Z.min_assoc (compat "8.6").
+Notation Zmin_irreducible_inf := Z.min_dec (only parsing).
+Notation Zsucc_min_distr := Z.succ_min_distr (compat "8.6").
+Notation Zmin_SS := Z.succ_min_distr (only parsing).
+Notation Zplus_min_distr_r := Z.add_min_distr_r (only parsing).
+Notation Zmin_plus := Z.add_min_distr_r (only parsing).
+Notation Zpos_min := Pos2Z.inj_min (only parsing).
 
 (** Slightly different lemmas *)
 
@@ -46,7 +48,7 @@ Qed.
 Lemma Zmin_irreducible n m : Z.min n m = n \/ Z.min n m = m.
 Proof. destruct (Z.min_dec n m); auto. Qed.
 
-Notation Zmin_or := Zmin_irreducible (compat "8.3").
+Notation Zmin_or := Zmin_irreducible (only parsing).
 
 Lemma Zmin_le_prime_inf n m p : Z.min n m <= p -> {n <= p} + {m <= p}.
 Proof. apply Z.min_case; auto. Qed.
diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v
index ea9a5f86..06919642 100644
--- a/theories/ZArith/Zminmax.v
+++ b/theories/ZArith/Zminmax.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Orders BinInt Zcompare Zorder.
@@ -12,11 +14,11 @@ Require Import Orders BinInt Zcompare Zorder.
 
 (*begin hide*)
 (* Compatibility with names of the old Zminmax file *)
-Notation Zmin_max_absorption_r_r := Z.min_max_absorption (compat "8.3").
-Notation Zmax_min_absorption_r_r := Z.max_min_absorption (compat "8.3").
-Notation Zmax_min_distr_r := Z.max_min_distr (compat "8.3").
-Notation Zmin_max_distr_r := Z.min_max_distr (compat "8.3").
-Notation Zmax_min_modular_r := Z.max_min_modular (compat "8.3").
-Notation Zmin_max_modular_r := Z.min_max_modular (compat "8.3").
-Notation max_min_disassoc := Z.max_min_disassoc (compat "8.3").
+Notation Zmin_max_absorption_r_r := Z.min_max_absorption (only parsing).
+Notation Zmax_min_absorption_r_r := Z.max_min_absorption (only parsing).
+Notation Zmax_min_distr_r := Z.max_min_distr (only parsing).
+Notation Zmin_max_distr_r := Z.min_max_distr (only parsing).
+Notation Zmax_min_modular_r := Z.max_min_modular (only parsing).
+Notation Zmin_max_modular_r := Z.min_max_modular (only parsing).
+Notation max_min_disassoc := Z.max_min_disassoc (only parsing).
 (*end hide*)
diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v
index 65831c78..c46241ce 100644
--- a/theories/ZArith/Zmisc.v
+++ b/theories/ZArith/Zmisc.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Wf_nat.
@@ -18,7 +20,7 @@ Local Open Scope Z_scope.
 
 (** [n]th iteration of the function [f] *)
 
-Notation iter := @Z.iter (compat "8.3").
+Notation iter := @Z.iter (only parsing).
 
 Lemma iter_nat_of_Z : forall n A f x, 0 <= n ->
   Z.iter n f x = iter_nat (Z.abs_nat n) A f x.
diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v
index 06428a7c..5c960da1 100644
--- a/theories/ZArith/Znat.v
+++ b/theories/ZArith/Znat.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
@@ -951,65 +953,65 @@ Definition inj_gt n m := proj1 (Nat2Z.inj_gt n m).
 
 (** For the others, a Notation is fine *)
 
-Notation inj_0 := Nat2Z.inj_0 (compat "8.3").
-Notation inj_S := Nat2Z.inj_succ (compat "8.3").
-Notation inj_compare := Nat2Z.inj_compare (compat "8.3").
-Notation inj_eq_rev := Nat2Z.inj (compat "8.3").
-Notation inj_eq_iff := (fun n m => iff_sym (Nat2Z.inj_iff n m)) (compat "8.3").
-Notation inj_le_iff := Nat2Z.inj_le (compat "8.3").
-Notation inj_lt_iff := Nat2Z.inj_lt (compat "8.3").
-Notation inj_ge_iff := Nat2Z.inj_ge (compat "8.3").
-Notation inj_gt_iff := Nat2Z.inj_gt (compat "8.3").
-Notation inj_le_rev := (fun n m => proj2 (Nat2Z.inj_le n m)) (compat "8.3").
-Notation inj_lt_rev := (fun n m => proj2 (Nat2Z.inj_lt n m)) (compat "8.3").
-Notation inj_ge_rev := (fun n m => proj2 (Nat2Z.inj_ge n m)) (compat "8.3").
-Notation inj_gt_rev := (fun n m => proj2 (Nat2Z.inj_gt n m)) (compat "8.3").
-Notation inj_plus := Nat2Z.inj_add (compat "8.3").
-Notation inj_mult := Nat2Z.inj_mul (compat "8.3").
-Notation inj_minus1 := Nat2Z.inj_sub (compat "8.3").
-Notation inj_minus := Nat2Z.inj_sub_max (compat "8.3").
-Notation inj_min := Nat2Z.inj_min (compat "8.3").
-Notation inj_max := Nat2Z.inj_max (compat "8.3").
-
-Notation Z_of_nat_of_P := positive_nat_Z (compat "8.3").
+Notation inj_0 := Nat2Z.inj_0 (only parsing).
+Notation inj_S := Nat2Z.inj_succ (only parsing).
+Notation inj_compare := Nat2Z.inj_compare (only parsing).
+Notation inj_eq_rev := Nat2Z.inj (only parsing).
+Notation inj_eq_iff := (fun n m => iff_sym (Nat2Z.inj_iff n m)) (only parsing).
+Notation inj_le_iff := Nat2Z.inj_le (only parsing).
+Notation inj_lt_iff := Nat2Z.inj_lt (only parsing).
+Notation inj_ge_iff := Nat2Z.inj_ge (only parsing).
+Notation inj_gt_iff := Nat2Z.inj_gt (only parsing).
+Notation inj_le_rev := (fun n m => proj2 (Nat2Z.inj_le n m)) (only parsing).
+Notation inj_lt_rev := (fun n m => proj2 (Nat2Z.inj_lt n m)) (only parsing).
+Notation inj_ge_rev := (fun n m => proj2 (Nat2Z.inj_ge n m)) (only parsing).
+Notation inj_gt_rev := (fun n m => proj2 (Nat2Z.inj_gt n m)) (only parsing).
+Notation inj_plus := Nat2Z.inj_add (only parsing).
+Notation inj_mult := Nat2Z.inj_mul (only parsing).
+Notation inj_minus1 := Nat2Z.inj_sub (only parsing).
+Notation inj_minus := Nat2Z.inj_sub_max (only parsing).
+Notation inj_min := Nat2Z.inj_min (only parsing).
+Notation inj_max := Nat2Z.inj_max (only parsing).
+
+Notation Z_of_nat_of_P := positive_nat_Z (only parsing).
 Notation Zpos_eq_Z_of_nat_o_nat_of_P :=
-  (fun p => eq_sym (positive_nat_Z p)) (compat "8.3").
-
-Notation Z_of_nat_of_N := N_nat_Z (compat "8.3").
-Notation Z_of_N_of_nat := nat_N_Z (compat "8.3").
-
-Notation Z_of_N_eq := (f_equal Z.of_N) (compat "8.3").
-Notation Z_of_N_eq_rev := N2Z.inj (compat "8.3").
-Notation Z_of_N_eq_iff := (fun n m => iff_sym (N2Z.inj_iff n m)) (compat "8.3").
-Notation Z_of_N_compare := N2Z.inj_compare (compat "8.3").
-Notation Z_of_N_le_iff := N2Z.inj_le (compat "8.3").
-Notation Z_of_N_lt_iff := N2Z.inj_lt (compat "8.3").
-Notation Z_of_N_ge_iff := N2Z.inj_ge (compat "8.3").
-Notation Z_of_N_gt_iff := N2Z.inj_gt (compat "8.3").
-Notation Z_of_N_le := (fun n m => proj1 (N2Z.inj_le n m)) (compat "8.3").
-Notation Z_of_N_lt := (fun n m => proj1 (N2Z.inj_lt n m)) (compat "8.3").
-Notation Z_of_N_ge := (fun n m => proj1 (N2Z.inj_ge n m)) (compat "8.3").
-Notation Z_of_N_gt := (fun n m => proj1 (N2Z.inj_gt n m)) (compat "8.3").
-Notation Z_of_N_le_rev := (fun n m => proj2 (N2Z.inj_le n m)) (compat "8.3").
-Notation Z_of_N_lt_rev := (fun n m => proj2 (N2Z.inj_lt n m)) (compat "8.3").
-Notation Z_of_N_ge_rev := (fun n m => proj2 (N2Z.inj_ge n m)) (compat "8.3").
-Notation Z_of_N_gt_rev := (fun n m => proj2 (N2Z.inj_gt n m)) (compat "8.3").
-Notation Z_of_N_pos := N2Z.inj_pos (compat "8.3").
-Notation Z_of_N_abs := N2Z.inj_abs_N (compat "8.3").
-Notation Z_of_N_le_0 := N2Z.is_nonneg (compat "8.3").
-Notation Z_of_N_plus := N2Z.inj_add (compat "8.3").
-Notation Z_of_N_mult := N2Z.inj_mul (compat "8.3").
-Notation Z_of_N_minus := N2Z.inj_sub_max (compat "8.3").
-Notation Z_of_N_succ := N2Z.inj_succ (compat "8.3").
-Notation Z_of_N_min := N2Z.inj_min (compat "8.3").
-Notation Z_of_N_max := N2Z.inj_max (compat "8.3").
-Notation Zabs_of_N := Zabs2N.id (compat "8.3").
-Notation Zabs_N_succ_abs := Zabs2N.inj_succ_abs (compat "8.3").
-Notation Zabs_N_succ := Zabs2N.inj_succ (compat "8.3").
-Notation Zabs_N_plus_abs := Zabs2N.inj_add_abs (compat "8.3").
-Notation Zabs_N_plus := Zabs2N.inj_add (compat "8.3").
-Notation Zabs_N_mult_abs := Zabs2N.inj_mul_abs (compat "8.3").
-Notation Zabs_N_mult := Zabs2N.inj_mul (compat "8.3").
+  (fun p => eq_sym (positive_nat_Z p)) (only parsing).
+
+Notation Z_of_nat_of_N := N_nat_Z (only parsing).
+Notation Z_of_N_of_nat := nat_N_Z (only parsing).
+
+Notation Z_of_N_eq := (f_equal Z.of_N) (only parsing).
+Notation Z_of_N_eq_rev := N2Z.inj (only parsing).
+Notation Z_of_N_eq_iff := (fun n m => iff_sym (N2Z.inj_iff n m)) (only parsing).
+Notation Z_of_N_compare := N2Z.inj_compare (only parsing).
+Notation Z_of_N_le_iff := N2Z.inj_le (only parsing).
+Notation Z_of_N_lt_iff := N2Z.inj_lt (only parsing).
+Notation Z_of_N_ge_iff := N2Z.inj_ge (only parsing).
+Notation Z_of_N_gt_iff := N2Z.inj_gt (only parsing).
+Notation Z_of_N_le := (fun n m => proj1 (N2Z.inj_le n m)) (only parsing).
+Notation Z_of_N_lt := (fun n m => proj1 (N2Z.inj_lt n m)) (only parsing).
+Notation Z_of_N_ge := (fun n m => proj1 (N2Z.inj_ge n m)) (only parsing).
+Notation Z_of_N_gt := (fun n m => proj1 (N2Z.inj_gt n m)) (only parsing).
+Notation Z_of_N_le_rev := (fun n m => proj2 (N2Z.inj_le n m)) (only parsing).
+Notation Z_of_N_lt_rev := (fun n m => proj2 (N2Z.inj_lt n m)) (only parsing).
+Notation Z_of_N_ge_rev := (fun n m => proj2 (N2Z.inj_ge n m)) (only parsing).
+Notation Z_of_N_gt_rev := (fun n m => proj2 (N2Z.inj_gt n m)) (only parsing).
+Notation Z_of_N_pos := N2Z.inj_pos (only parsing).
+Notation Z_of_N_abs := N2Z.inj_abs_N (only parsing).
+Notation Z_of_N_le_0 := N2Z.is_nonneg (only parsing).
+Notation Z_of_N_plus := N2Z.inj_add (only parsing).
+Notation Z_of_N_mult := N2Z.inj_mul (only parsing).
+Notation Z_of_N_minus := N2Z.inj_sub_max (only parsing).
+Notation Z_of_N_succ := N2Z.inj_succ (only parsing).
+Notation Z_of_N_min := N2Z.inj_min (only parsing).
+Notation Z_of_N_max := N2Z.inj_max (only parsing).
+Notation Zabs_of_N := Zabs2N.id (only parsing).
+Notation Zabs_N_succ_abs := Zabs2N.inj_succ_abs (only parsing).
+Notation Zabs_N_succ := Zabs2N.inj_succ (only parsing).
+Notation Zabs_N_plus_abs := Zabs2N.inj_add_abs (only parsing).
+Notation Zabs_N_plus := Zabs2N.inj_add (only parsing).
+Notation Zabs_N_mult_abs := Zabs2N.inj_mul_abs (only parsing).
+Notation Zabs_N_mult := Zabs2N.inj_mul (only parsing).
 
 Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z.of_nat (n - m) = 0.
 Proof.
diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v
index ee6efb3c..f5444c31 100644
--- a/theories/ZArith/Znumtheory.v
+++ b/theories/ZArith/Znumtheory.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZArith_base.
@@ -25,20 +27,20 @@ Open Scope Z_scope.
      - properties of the efficient [Z.gcd] function
 *)
 
-Notation Zgcd := Z.gcd (compat "8.3").
-Notation Zggcd := Z.ggcd (compat "8.3").
-Notation Zggcd_gcd := Z.ggcd_gcd (compat "8.3").
-Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (compat "8.3").
-Notation Zgcd_divide_l := Z.gcd_divide_l (compat "8.3").
-Notation Zgcd_divide_r := Z.gcd_divide_r (compat "8.3").
-Notation Zgcd_greatest := Z.gcd_greatest (compat "8.3").
-Notation Zgcd_nonneg := Z.gcd_nonneg (compat "8.3").
-Notation Zggcd_opp := Z.ggcd_opp (compat "8.3").
+Notation Zgcd := Z.gcd (compat "8.6").
+Notation Zggcd := Z.ggcd (compat "8.6").
+Notation Zggcd_gcd := Z.ggcd_gcd (compat "8.6").
+Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (compat "8.6").
+Notation Zgcd_divide_l := Z.gcd_divide_l (compat "8.6").
+Notation Zgcd_divide_r := Z.gcd_divide_r (compat "8.6").
+Notation Zgcd_greatest := Z.gcd_greatest (compat "8.6").
+Notation Zgcd_nonneg := Z.gcd_nonneg (compat "8.6").
+Notation Zggcd_opp := Z.ggcd_opp (compat "8.6").
 
 (** The former specialized inductive predicate [Z.divide] is now
     a generic existential predicate. *)
 
-Notation Zdivide := Z.divide (compat "8.3").
+Notation Zdivide := Z.divide (compat "8.6").
 
 (** Its former constructor is now a pseudo-constructor. *)
 
@@ -46,17 +48,17 @@ Definition Zdivide_intro a b q (H:b=q*a) : Z.divide a b := ex_intro _ q H.
 
 (** Results concerning divisibility*)
 
-Notation Zdivide_refl := Z.divide_refl (compat "8.3").
-Notation Zone_divide := Z.divide_1_l (compat "8.3").
-Notation Zdivide_0 := Z.divide_0_r (compat "8.3").
-Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (compat "8.3").
-Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (compat "8.3").
-Notation Zdivide_plus_r := Z.divide_add_r (compat "8.3").
-Notation Zdivide_minus_l := Z.divide_sub_r (compat "8.3").
-Notation Zdivide_mult_l := Z.divide_mul_l (compat "8.3").
-Notation Zdivide_mult_r := Z.divide_mul_r (compat "8.3").
-Notation Zdivide_factor_r := Z.divide_factor_l (compat "8.3").
-Notation Zdivide_factor_l := Z.divide_factor_r (compat "8.3").
+Notation Zdivide_refl := Z.divide_refl (compat "8.6").
+Notation Zone_divide := Z.divide_1_l (only parsing).
+Notation Zdivide_0 := Z.divide_0_r (only parsing).
+Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (only parsing).
+Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (only parsing).
+Notation Zdivide_plus_r := Z.divide_add_r (only parsing).
+Notation Zdivide_minus_l := Z.divide_sub_r (only parsing).
+Notation Zdivide_mult_l := Z.divide_mul_l (only parsing).
+Notation Zdivide_mult_r := Z.divide_mul_r (only parsing).
+Notation Zdivide_factor_r := Z.divide_factor_l (only parsing).
+Notation Zdivide_factor_l := Z.divide_factor_r (only parsing).
 
 Lemma Zdivide_opp_r a b : (a | b) -> (a | - b).
 Proof. apply Z.divide_opp_r. Qed.
@@ -91,12 +93,12 @@ Qed.
 
 (** Only [1] and [-1] divide [1]. *)
 
-Notation Zdivide_1 := Z.divide_1_r (compat "8.3").
+Notation Zdivide_1 := Z.divide_1_r (only parsing).
 
 (** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *)
 
-Notation Zdivide_antisym := Z.divide_antisym (compat "8.3").
-Notation Zdivide_trans := Z.divide_trans (compat "8.3").
+Notation Zdivide_antisym := Z.divide_antisym (compat "8.6").
+Notation Zdivide_trans := Z.divide_trans (compat "8.6").
 
 (** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *)
 
@@ -734,7 +736,7 @@ Qed.
 (** we now prove that [Z.gcd] is indeed a gcd in
    the sense of [Zis_gcd]. *)
 
-Notation Zgcd_is_pos := Z.gcd_nonneg (compat "8.3").
+Notation Zgcd_is_pos := Z.gcd_nonneg (only parsing).
 
 Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Z.gcd a b).
 Proof.
@@ -767,8 +769,8 @@ Proof.
   - subst. now case (Z.gcd a b).
 Qed.
 
-Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (compat "8.3").
-Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (compat "8.3").
+Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (only parsing).
+Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (only parsing).
 
 Theorem Zgcd_div_swap0 : forall a b : Z,
  0 < Z.gcd a b ->
@@ -798,16 +800,16 @@ Proof.
   rewrite <- Zdivide_Zdiv_eq; auto.
 Qed.
 
-Notation Zgcd_comm := Z.gcd_comm (compat "8.3").
+Notation Zgcd_comm := Z.gcd_comm (compat "8.6").
 
 Lemma Zgcd_ass a b c : Z.gcd (Z.gcd a b) c = Z.gcd a (Z.gcd b c).
 Proof.
  symmetry. apply Z.gcd_assoc.
 Qed.
 
-Notation Zgcd_Zabs := Z.gcd_abs_l (compat "8.3").
-Notation Zgcd_0 := Z.gcd_0_r (compat "8.3").
-Notation Zgcd_1 := Z.gcd_1_r (compat "8.3").
+Notation Zgcd_Zabs := Z.gcd_abs_l (only parsing).
+Notation Zgcd_0 := Z.gcd_0_r (only parsing).
+Notation Zgcd_1 := Z.gcd_1_r (only parsing).
 
 Hint Resolve Z.gcd_0_r Z.gcd_1_r : zarith.
 
diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v
index 73dee0cf..a1ec4b35 100644
--- a/theories/ZArith/Zorder.v
+++ b/theories/ZArith/Zorder.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Binary Integers : results about order predicates *)
@@ -38,9 +40,9 @@ Qed.
 (**********************************************************************)
 (** * Decidability of equality and order on Z *)
 
-Notation dec_eq := Z.eq_decidable (compat "8.3").
-Notation dec_Zle := Z.le_decidable (compat "8.3").
-Notation dec_Zlt := Z.lt_decidable (compat "8.3").
+Notation dec_eq := Z.eq_decidable (only parsing).
+Notation dec_Zle := Z.le_decidable (only parsing).
+Notation dec_Zlt := Z.lt_decidable (only parsing).
 
 Theorem dec_Zne n m : decidable (Zne n m).
 Proof.
@@ -64,12 +66,12 @@ Qed.
 
 (** * Relating strict and large orders *)
 
-Notation Zgt_lt := Z.gt_lt (compat "8.3").
-Notation Zlt_gt := Z.lt_gt (compat "8.3").
-Notation Zge_le := Z.ge_le (compat "8.3").
-Notation Zle_ge := Z.le_ge (compat "8.3").
-Notation Zgt_iff_lt := Z.gt_lt_iff (compat "8.3").
-Notation Zge_iff_le := Z.ge_le_iff (compat "8.3").
+Notation Zgt_lt := Z.gt_lt (compat "8.6").
+Notation Zlt_gt := Z.lt_gt (compat "8.6").
+Notation Zge_le := Z.ge_le (compat "8.6").
+Notation Zle_ge := Z.le_ge (compat "8.6").
+Notation Zgt_iff_lt := Z.gt_lt_iff (only parsing).
+Notation Zge_iff_le := Z.ge_le_iff (only parsing).
 
 Lemma Zle_not_lt n m : n <= m -> ~ m < n.
 Proof.
@@ -121,18 +123,18 @@ Qed.
 
 (** Reflexivity *)
 
-Notation Zle_refl := Z.le_refl (compat "8.3").
-Notation Zeq_le := Z.eq_le_incl (compat "8.3").
+Notation Zle_refl := Z.le_refl (compat "8.6").
+Notation Zeq_le := Z.eq_le_incl (only parsing).
 
 Hint Resolve Z.le_refl: zarith.
 
 (** Antisymmetry *)
 
-Notation Zle_antisym := Z.le_antisymm (compat "8.3").
+Notation Zle_antisym := Z.le_antisymm (only parsing).
 
 (** Asymmetry *)
 
-Notation Zlt_asym := Z.lt_asymm (compat "8.3").
+Notation Zlt_asym := Z.lt_asymm (only parsing).
 
 Lemma Zgt_asym n m : n > m -> ~ m > n.
 Proof.
@@ -141,8 +143,8 @@ Qed.
 
 (** Irreflexivity *)
 
-Notation Zlt_irrefl := Z.lt_irrefl (compat "8.3").
-Notation Zlt_not_eq := Z.lt_neq (compat "8.3").
+Notation Zlt_irrefl := Z.lt_irrefl (compat "8.6").
+Notation Zlt_not_eq := Z.lt_neq (only parsing).
 
 Lemma Zgt_irrefl n : ~ n > n.
 Proof.
@@ -151,8 +153,8 @@ Qed.
 
 (** Large = strict or equal *)
 
-Notation Zlt_le_weak := Z.lt_le_incl (compat "8.3").
-Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (compat "8.3").
+Notation Zlt_le_weak := Z.lt_le_incl (only parsing).
+Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (only parsing).
 
 Lemma Zle_lt_or_eq n m : n <= m -> n < m \/ n = m.
 Proof.
@@ -161,11 +163,11 @@ Qed.
 
 (** Dichotomy *)
 
-Notation Zle_or_lt := Z.le_gt_cases (compat "8.3").
+Notation Zle_or_lt := Z.le_gt_cases (only parsing).
 
 (** Transitivity of strict orders *)
 
-Notation Zlt_trans := Z.lt_trans (compat "8.3").
+Notation Zlt_trans := Z.lt_trans (compat "8.6").
 
 Lemma Zgt_trans n m p : n > m -> m > p -> n > p.
 Proof.
@@ -174,8 +176,8 @@ Qed.
 
 (** Mixed transitivity *)
 
-Notation Zlt_le_trans := Z.lt_le_trans (compat "8.3").
-Notation Zle_lt_trans := Z.le_lt_trans (compat "8.3").
+Notation Zlt_le_trans := Z.lt_le_trans (compat "8.6").
+Notation Zle_lt_trans := Z.le_lt_trans (compat "8.6").
 
 Lemma Zle_gt_trans n m p : m <= n -> m > p -> n > p.
 Proof.
@@ -189,7 +191,7 @@ Qed.
 
 (** Transitivity of large orders *)
 
-Notation Zle_trans := Z.le_trans (compat "8.3").
+Notation Zle_trans := Z.le_trans (compat "8.6").
 
 Lemma Zge_trans n m p : n >= m -> m >= p -> n >= p.
 Proof.
@@ -240,8 +242,8 @@ Qed.
 
 (** Special base instances of order *)
 
-Notation Zlt_succ := Z.lt_succ_diag_r (compat "8.3").
-Notation Zlt_pred := Z.lt_pred_l (compat "8.3").
+Notation Zlt_succ := Z.lt_succ_diag_r (only parsing).
+Notation Zlt_pred := Z.lt_pred_l (only parsing).
 
 Lemma Zgt_succ n : Z.succ n > n.
 Proof.
@@ -255,8 +257,8 @@ Qed.
 
 (** Relating strict and large order using successor or predecessor *)
 
-Notation Zlt_succ_r := Z.lt_succ_r (compat "8.3").
-Notation Zle_succ_l := Z.le_succ_l (compat "8.3").
+Notation Zlt_succ_r := Z.lt_succ_r (compat "8.6").
+Notation Zle_succ_l := Z.le_succ_l (compat "8.6").
 
 Lemma Zgt_le_succ n m : m > n -> Z.succ n <= m.
 Proof.
@@ -295,10 +297,10 @@ Qed.
 
 (** Weakening order *)
 
-Notation Zle_succ := Z.le_succ_diag_r (compat "8.3").
-Notation Zle_pred := Z.le_pred_l (compat "8.3").
-Notation Zlt_lt_succ := Z.lt_lt_succ_r (compat "8.3").
-Notation Zle_le_succ := Z.le_le_succ_r (compat "8.3").
+Notation Zle_succ := Z.le_succ_diag_r (only parsing).
+Notation Zle_pred := Z.le_pred_l (only parsing).
+Notation Zlt_lt_succ := Z.lt_lt_succ_r (only parsing).
+Notation Zle_le_succ := Z.le_le_succ_r (only parsing).
 
 Lemma Zle_succ_le n m : Z.succ n <= m -> n <= m.
 Proof.
@@ -334,12 +336,12 @@ Qed.
 
 (** Special cases of ordered integers *)
 
-Notation Zlt_0_1 := Z.lt_0_1 (compat "8.3").
-Notation Zle_0_1 := Z.le_0_1 (compat "8.3").
+Notation Zlt_0_1 := Z.lt_0_1 (compat "8.6").
+Notation Zle_0_1 := Z.le_0_1 (compat "8.6").
 
 Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q.
 Proof.
-  easy.
+  exact Pos2Z.neg_le_pos.
 Qed.
 
 Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0.
@@ -350,12 +352,12 @@ Qed.
 (* weaker but useful (in [Z.pow] for instance) *)
 Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p.
 Proof.
- easy.
+  exact Pos2Z.pos_is_nonneg.
 Qed.
 
 Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0.
 Proof.
- easy.
+  exact Pos2Z.neg_is_neg.
 Qed.
 
 Lemma Zle_0_nat : forall n:nat, 0 <= Z.of_nat n.
@@ -375,10 +377,10 @@ Qed.
 (** ** Addition *)
 (** Compatibility of addition wrt to order *)
 
-Notation Zplus_lt_le_compat := Z.add_lt_le_mono (compat "8.3").
-Notation Zplus_le_lt_compat := Z.add_le_lt_mono (compat "8.3").
-Notation Zplus_le_compat := Z.add_le_mono (compat "8.3").
-Notation Zplus_lt_compat := Z.add_lt_mono (compat "8.3").
+Notation Zplus_lt_le_compat := Z.add_lt_le_mono (only parsing).
+Notation Zplus_le_lt_compat := Z.add_le_lt_mono (only parsing).
+Notation Zplus_le_compat := Z.add_le_mono (only parsing).
+Notation Zplus_lt_compat := Z.add_lt_mono (only parsing).
 
 Lemma Zplus_gt_compat_l n m p : n > m -> p + n > p + m.
 Proof.
@@ -412,7 +414,7 @@ Qed.
 
 (** Compatibility of addition wrt to being positive *)
 
-Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (compat "8.3").
+Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (only parsing).
 
 (** Simplification of addition wrt to order *)
 
@@ -570,9 +572,9 @@ Qed.
 
 (** Compatibility of multiplication by a positive wrt to being positive *)
 
-Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (compat "8.3").
-Notation Zmult_lt_0_compat := Z.mul_pos_pos (compat "8.3").
-Notation Zmult_lt_O_compat := Z.mul_pos_pos (compat "8.3").
+Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (only parsing).
+Notation Zmult_lt_0_compat := Z.mul_pos_pos (only parsing).
+Notation Zmult_lt_O_compat := Z.mul_pos_pos (only parsing).
 
 Lemma Zmult_gt_0_compat n m : n > 0 -> m > 0 -> n * m > 0.
 Proof.
@@ -624,9 +626,9 @@ Qed.
 
 (** * Equivalence between inequalities *)
 
-Notation Zle_plus_swap := Z.le_add_le_sub_r (compat "8.3").
-Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (compat "8.3").
-Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (compat "8.3").
+Notation Zle_plus_swap := Z.le_add_le_sub_r (only parsing).
+Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (only parsing).
+Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (only parsing).
 
 Lemma Zeq_plus_swap n m p : n + p = m <-> n = m - p.
 Proof.
diff --git a/theories/ZArith/Zpow_alt.v b/theories/ZArith/Zpow_alt.v
index 79a5a555..983405ac 100644
--- a/theories/ZArith/Zpow_alt.v
+++ b/theories/ZArith/Zpow_alt.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinInt.
diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v
index 9eafa076..2b099671 100644
--- a/theories/ZArith/Zpow_def.v
+++ b/theories/ZArith/Zpow_def.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import BinInt Ring_theory.
@@ -14,12 +16,12 @@ Local Open Scope Z_scope.
 (** Nota : this file is mostly deprecated. The definition of [Z.pow]
     and its usual properties are now provided by module [BinInt.Z]. *)
 
-Notation Zpower_pos := Z.pow_pos (compat "8.3").
-Notation Zpower := Z.pow (compat "8.3").
-Notation Zpower_0_r := Z.pow_0_r (compat "8.3").
-Notation Zpower_succ_r := Z.pow_succ_r (compat "8.3").
-Notation Zpower_neg_r := Z.pow_neg_r (compat "8.3").
-Notation Zpower_Ppow := Pos2Z.inj_pow (compat "8.3").
+Notation Zpower_pos := Z.pow_pos (only parsing).
+Notation Zpower := Z.pow (only parsing).
+Notation Zpower_0_r := Z.pow_0_r (only parsing).
+Notation Zpower_succ_r := Z.pow_succ_r (only parsing).
+Notation Zpower_neg_r := Z.pow_neg_r (only parsing).
+Notation Zpower_Ppow := Pos2Z.inj_pow (only parsing).
 
 Lemma Zpower_theory : power_theory 1 Z.mul (@eq Z) Z.of_N Z.pow.
 Proof.
diff --git a/theories/ZArith/Zpow_facts.v b/theories/ZArith/Zpow_facts.v
index 2930e677..a9bc5bd0 100644
--- a/theories/ZArith/Zpow_facts.v
+++ b/theories/ZArith/Zpow_facts.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZArith_base ZArithRing Zcomplements Zdiv Znumtheory.
@@ -29,17 +31,17 @@ Proof. now apply (Z.pow_0_l (Zpos p)). Qed.
 Lemma Zpower_pos_pos x p : 0 < x -> 0 < Z.pow_pos x p.
 Proof. intros. now apply (Z.pow_pos_nonneg x (Zpos p)). Qed.
 
-Notation Zpower_1_r := Z.pow_1_r (compat "8.3").
-Notation Zpower_1_l := Z.pow_1_l (compat "8.3").
-Notation Zpower_0_l := Z.pow_0_l' (compat "8.3").
-Notation Zpower_0_r := Z.pow_0_r (compat "8.3").
-Notation Zpower_2 := Z.pow_2_r (compat "8.3").
-Notation Zpower_gt_0 := Z.pow_pos_nonneg (compat "8.3").
-Notation Zpower_ge_0 := Z.pow_nonneg (compat "8.3").
-Notation Zpower_Zabs := Z.abs_pow (compat "8.3").
-Notation Zpower_Zsucc := Z.pow_succ_r (compat "8.3").
-Notation Zpower_mult := Z.pow_mul_r (compat "8.3").
-Notation Zpower_le_monotone2 := Z.pow_le_mono_r (compat "8.3").
+Notation Zpower_1_r := Z.pow_1_r (only parsing).
+Notation Zpower_1_l := Z.pow_1_l (only parsing).
+Notation Zpower_0_l := Z.pow_0_l' (only parsing).
+Notation Zpower_0_r := Z.pow_0_r (only parsing).
+Notation Zpower_2 := Z.pow_2_r (only parsing).
+Notation Zpower_gt_0 := Z.pow_pos_nonneg (only parsing).
+Notation Zpower_ge_0 := Z.pow_nonneg (only parsing).
+Notation Zpower_Zabs := Z.abs_pow (only parsing).
+Notation Zpower_Zsucc := Z.pow_succ_r (only parsing).
+Notation Zpower_mult := Z.pow_mul_r (only parsing).
+Notation Zpower_le_monotone2 := Z.pow_le_mono_r (only parsing).
 
 Theorem Zpower_le_monotone a b c :
  0 < a -> 0 <= b <= c -> a^b <= a^c.
@@ -231,7 +233,7 @@ Qed.
 
 (** * Z.square: a direct definition of [z^2] *)
 
-Notation Psquare := Pos.square (compat "8.3").
-Notation Zsquare := Z.square (compat "8.3").
-Notation Psquare_correct := Pos.square_spec (compat "8.3").
-Notation Zsquare_correct := Z.square_spec (compat "8.3").
+Notation Psquare := Pos.square (compat "8.6").
+Notation Zsquare := Z.square (compat "8.6").
+Notation Psquare_correct := Pos.square_spec (only parsing).
+Notation Zsquare_correct := Z.square_spec (only parsing).
diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v
index 6f3a89f1..fa690535 100644
--- a/theories/ZArith/Zpower.v
+++ b/theories/ZArith/Zpower.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Wf_nat ZArith_base Omega Zcomplements.
diff --git a/theories/ZArith/Zquot.v b/theories/ZArith/Zquot.v
index 0d92f1d5..e93ebb1a 100644
--- a/theories/ZArith/Zquot.v
+++ b/theories/ZArith/Zquot.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import Nnat ZArith_base ROmega ZArithRing Zdiv Morphisms.
@@ -31,21 +33,21 @@ Local Open Scope Z_scope.
       exploiting the arbitrary value of division by 0).
 *)
 
-Notation Ndiv_Zquot := N2Z.inj_quot (compat "8.3").
-Notation Nmod_Zrem := N2Z.inj_rem (compat "8.3").
-Notation Z_quot_rem_eq := Z.quot_rem' (compat "8.3").
-Notation Zrem_lt := Z.rem_bound_abs (compat "8.3").
-Notation Zquot_unique := Z.quot_unique (compat "8.3").
-Notation Zrem_unique := Z.rem_unique (compat "8.3").
-Notation Zrem_1_r := Z.rem_1_r (compat "8.3").
-Notation Zquot_1_r := Z.quot_1_r (compat "8.3").
-Notation Zrem_1_l := Z.rem_1_l (compat "8.3").
-Notation Zquot_1_l := Z.quot_1_l (compat "8.3").
-Notation Z_quot_same := Z.quot_same (compat "8.3").
-Notation Z_quot_mult := Z.quot_mul (compat "8.3").
-Notation Zquot_small := Z.quot_small (compat "8.3").
-Notation Zrem_small := Z.rem_small (compat "8.3").
-Notation Zquot2_quot := Zquot2_quot (compat "8.3").
+Notation Ndiv_Zquot := N2Z.inj_quot (only parsing).
+Notation Nmod_Zrem := N2Z.inj_rem (only parsing).
+Notation Z_quot_rem_eq := Z.quot_rem' (only parsing).
+Notation Zrem_lt := Z.rem_bound_abs (only parsing).
+Notation Zquot_unique := Z.quot_unique (compat "8.6").
+Notation Zrem_unique := Z.rem_unique (compat "8.6").
+Notation Zrem_1_r := Z.rem_1_r (compat "8.6").
+Notation Zquot_1_r := Z.quot_1_r (compat "8.6").
+Notation Zrem_1_l := Z.rem_1_l (compat "8.6").
+Notation Zquot_1_l := Z.quot_1_l (compat "8.6").
+Notation Z_quot_same := Z.quot_same (compat "8.6").
+Notation Z_quot_mult := Z.quot_mul (only parsing).
+Notation Zquot_small := Z.quot_small (compat "8.6").
+Notation Zrem_small := Z.rem_small (compat "8.6").
+Notation Zquot2_quot := Zquot2_quot (compat "8.6").
 
 (** Particular values taken for [a÷0] and [(Z.rem a 0)].
     We avise to not rely on these arbitrary values. *)
diff --git a/theories/ZArith/Zsqrt_compat.v b/theories/ZArith/Zsqrt_compat.v
index f4baba19..bd090454 100644
--- a/theories/ZArith/Zsqrt_compat.v
+++ b/theories/ZArith/Zsqrt_compat.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZArithRing.
@@ -229,4 +231,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/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v
index 90754af3..a71ea4f3 100644
--- a/theories/ZArith/Zwf.v
+++ b/theories/ZArith/Zwf.v
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 Require Import ZArith_base.
diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v
index c6c38976..306a8563 100644
--- a/theories/ZArith/auxiliary.v
+++ b/theories/ZArith/auxiliary.v
@@ -1,10 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
diff --git a/theories/ZArith/vo.itarget b/theories/ZArith/vo.itarget
deleted file mode 100644
index 178111cd..00000000
--- a/theories/ZArith/vo.itarget
+++ /dev/null
@@ -1,33 +0,0 @@
-auxiliary.vo
-BinIntDef.vo
-BinInt.vo
-Int.vo
-Wf_Z.vo
-Zabs.vo
-ZArith_base.vo
-ZArith_dec.vo
-ZArith.vo
-Zdigits.vo
-Zbool.vo
-Zcompare.vo
-Zcomplements.vo
-Zdiv.vo
-Zeven.vo
-Zgcd_alt.vo
-Zpow_alt.vo
-Zhints.vo
-Zlogarithm.vo
-Zmax.vo
-Zminmax.vo
-Zmin.vo
-Zmisc.vo
-Znat.vo
-Znumtheory.vo
-Zquot.vo
-Zorder.vo
-Zpow_def.vo
-Zpower.vo
-Zpow_facts.vo
-Zsqrt_compat.vo
-Zwf.vo
-Zeuclid.vo
diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in
new file mode 100644
index 00000000..f7e30eae
--- /dev/null
+++ b/tools/CoqMakefile.in
@@ -0,0 +1,799 @@
+###############################################################################
+##  v      #                   The Coq Proof Assistant                       ##
+## <O___,, #                INRIA - CNRS - LIX - LRI - PPS                   ##
+##   \VV/  #                                                                 ##
+##    //   #                                                                 ##
+###############################################################################
+## GNUMakefile for Coq @COQ_VERSION@
+
+# For debugging purposes (must stay here, don't move below)
+INITIAL_VARS := $(.VARIABLES)
+# To implement recursion we save the name of the main Makefile
+SELF := $(lastword $(MAKEFILE_LIST))
+PARENT := $(firstword $(MAKEFILE_LIST))
+
+# This file is generated by coq_makefile and contains many variable
+# definitions, like the list of .v files or the path to Coq
+include @CONF_FILE@
+
+# Put in place old names
+VFILES            := $(COQMF_VFILES)
+MLIFILES          := $(COQMF_MLIFILES)
+MLFILES           := $(COQMF_MLFILES)
+ML4FILES          := $(COQMF_ML4FILES)
+MLPACKFILES       := $(COQMF_MLPACKFILES)
+MLLIBFILES        := $(COQMF_MLLIBFILES)
+CMDLINE_VFILES    := $(COQMF_CMDLINE_VFILES)
+INSTALLCOQDOCROOT := $(COQMF_INSTALLCOQDOCROOT)
+OTHERFLAGS        := $(COQMF_OTHERFLAGS)
+COQ_SRC_SUBDIRS   := $(COQMF_COQ_SRC_SUBDIRS)
+OCAMLLIBS         := $(COQMF_OCAMLLIBS)
+SRC_SUBDIRS       := $(COQMF_SRC_SUBDIRS)
+COQLIBS           := $(COQMF_COQLIBS)
+COQLIBS_NOML      := $(COQMF_COQLIBS_NOML)
+CMDLINE_COQLIBS   := $(COQMF_CMDLINE_COQLIBS)
+LOCAL             := $(COQMF_LOCAL)
+COQLIB            := $(COQMF_COQLIB)
+DOCDIR            := $(COQMF_DOCDIR)
+OCAMLFIND         := $(COQMF_OCAMLFIND)
+CAMLP5O           := $(COQMF_CAMLP5O)
+CAMLP5BIN         := $(COQMF_CAMLP5BIN)
+CAMLP5LIB         := $(COQMF_CAMLP5LIB)
+CAMLP5OPTIONS     := $(COQMF_CAMLP5OPTIONS)
+CAMLFLAGS         := $(COQMF_CAMLFLAGS)
+HASNATDYNLINK     := $(COQMF_HASNATDYNLINK)
+
+@CONF_FILE@: @PROJECT_FILE@
+	@COQ_MAKEFILE_INVOCATION@
+
+# This file can be created by the user to hook into double colon rules or
+# add any other Makefile code he may need
+-include @LOCAL_FILE@
+
+# Parameters ##################################################################
+#
+# Parameters are make variable assignments.
+# They can be passed to (each call to) make on the command line.
+# They can also be put in @LOCAL_FILE@ once an for all.
+# For retro-compatibility reasons they can be put in the _CoqProject, but this
+# practice is discouraged since _CoqProject better not contain make specific
+# code (be nice to user interfaces).
+
+# Print shell commands (set to non empty)
+VERBOSE ?=
+
+# Time the Coq process (set to non empty), and how (see default value)
+TIMED?=
+TIMECMD?=
+# Use command time on linux, gtime on Mac OS
+TIMEFMT?="$* (real: %e, user: %U, sys: %S, mem: %M ko)"
+ifneq (,$(TIMED))
+ifeq (0,$(shell command time -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?))
+STDTIME?=command time -f $(TIMEFMT)
+else
+ifeq (0,$(shell gtime -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?))
+STDTIME?=gtime -f $(TIMEFMT)
+else
+STDTIME?=command time
+endif
+endif
+else
+STDTIME?=command time -f $(TIMEFMT)
+endif
+
+# Coq binaries
+COQC     ?= "$(COQBIN)coqc"
+COQTOP   ?= "$(COQBIN)coqtop"
+COQCHK   ?= "$(COQBIN)coqchk"
+COQDEP   ?= "$(COQBIN)coqdep"
+GALLINA  ?= "$(COQBIN)gallina"
+COQDOC   ?= "$(COQBIN)coqdoc"
+COQMKFILE ?= "$(COQBIN)coq_makefile"
+
+# Timing scripts
+COQMAKE_ONE_TIME_FILE ?= "$(COQLIB)/tools/make-one-time-file.py"
+COQMAKE_BOTH_TIME_FILES ?= "$(COQLIB)/tools/make-both-time-files.py"
+COQMAKE_BOTH_SINGLE_TIMING_FILES ?= "$(COQLIB)/tools/make-both-single-timing-files.py"
+BEFORE ?=
+AFTER ?=
+
+# FIXME this should be generated by Coq (modules already linked by Coq)
+CAMLDONTLINK=camlp5.gramlib,unix,str
+
+# OCaml binaries
+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
+DESTDIR ?=
+
+# Debug builds, typically -g to OCaml, -debug to Coq.
+CAMLDEBUG ?=
+COQDEBUG ?=
+
+# 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
+TIME_OF_BUILD_AFTER_FILE         ?= time-of-build-after.log
+TIME_OF_PRETTY_BUILD_FILE        ?= time-of-build-pretty.log
+TIME_OF_PRETTY_BOTH_BUILD_FILE   ?= time-of-build-both.log
+TIME_OF_PRETTY_BUILD_EXTRA_FILES ?= - # also output to the command line
+
+########## End of parameters ##################################################
+# What follows may be relevant to you only if you need to
+# extend this Makefile.  If so, look for 'Extension point' here and
+# put in @LOCAL_FILE@ double colon rules accordingly.
+# E.g. to perform some work after the all target completes you can write
+#
+# post-all::
+# 	echo "All done!"
+#
+# in @LOCAL_FILE@
+#
+###############################################################################
+
+
+
+
+# Flags #######################################################################
+#
+# We define a bunch of variables combining the parameters
+
+SHOW := $(if $(VERBOSE),@true "",@echo "")
+HIDE := $(if $(VERBOSE),,@)
+
+TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))
+
+OPT?=
+
+# The DYNOBJ and DYNLIB variables are used by "coqdep -dyndep var" in .v.d
+ifeq '$(OPT)' '-byte'
+USEBYTE:=true
+DYNOBJ:=.cma
+DYNLIB:=.cma
+else
+USEBYTE:=
+DYNOBJ:=.cmxs
+DYNLIB:=.cmxs
+endif
+
+COQFLAGS?=-q $(OPT) $(COQLIBS) $(OTHERFLAGS)
+COQCHKFLAGS?=-silent -o $(COQLIBS)
+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)
+COQMAKEFILE_VERSION:=@COQ_VERSION@
+
+COQSRCLIBS?= $(foreach d,$(COQ_SRC_SUBDIRS), -I "$(COQLIB)$(d)")
+
+CAMLFLAGS+=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP5LIB)
+
+# 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
+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
+PP:=-pp '$(CAMLP5O) -I $(CAMLLIB) -I "$(COQLIB)/grammar" $(CAMLP5EXTEND) $(GRAMMARS) $(CAMLP5OPTIONS) -impl'
+endif
+
+ifneq (,$(TIMING))
+TIMING_ARG=-time
+ifeq (after,$(TIMING))
+TIMING_EXT=after-timing
+else
+ifeq (before,$(TIMING))
+TIMING_EXT=before-timing
+else
+TIMING_EXT=timing
+endif
+endif
+else
+TIMING_ARG=
+endif
+
+# Retro compatibility (DESTDIR is standard on Unix, DSTROOT is not)
+ifdef DSTROOT
+DESTDIR := $(DSTROOT)
+endif
+
+concat_path = $(if $(1),$(1)/$(if $(COQMF_WINDRIVE),$(subst $(COQMF_WINDRIVE),/,$(2)),$(2)),$(2))
+
+COQLIBINSTALL = $(call concat_path,$(DESTDIR),$(COQLIB)user-contrib)
+COQDOCINSTALL = $(call concat_path,$(DESTDIR),$(DOCDIR)user-contrib)
+COQTOPINSTALL = $(call concat_path,$(DESTDIR),$(COQLIB)toploop)
+
+# Files #######################################################################
+#
+# 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 := \
+	$(ML4FILES) \
+	$(MLFILES) \
+	$(MLPACKFILES) \
+	$(MLLIBFILES) \
+	$(MLIFILES)
+
+# helpers
+vo_to_obj = $(addsuffix .o,\
+  $(filter-out Warning: Error:,\
+  $(shell $(COQTOP) -q -noinit -batch -quiet -print-mod-uid $(1))))
+strip_dotslash = $(patsubst ./%,%,$(1))
+VO = vo
+
+VOFILES = $(VFILES:.v=.$(VO))
+GLOBFILES = $(VFILES:.v=.glob)
+GFILES = $(VFILES:.v=.g)
+HTMLFILES = $(VFILES:.v=.html)
+GHTMLFILES = $(VFILES:.v=.g.html)
+BEAUTYFILES = $(addsuffix .beautified,$(VFILES))
+TEXFILES = $(VFILES:.v=.tex)
+GTEXFILES = $(VFILES:.v=.g.tex)
+CMOFILES = \
+	$(ML4FILES:.ml4=.cmo) \
+	$(MLFILES:.ml=.cmo) \
+	$(MLPACKFILES:.mlpack=.cmo)
+CMXFILES = $(CMOFILES:.cmo=.cmx)
+OFILES = $(CMXFILES:.cmx=.o)
+CMAFILES = $(MLLIBFILES:.mllib=.cma) $(MLPACKFILES:.mlpack=.cma)
+CMXAFILES = $(CMAFILES:.cma=.cmxa)
+CMIFILES = \
+	$(CMOFILES:.cmo=.cmi) \
+	$(MLIFILES:.mli=.cmi)
+# the /if/ is because old _CoqProject did not list a .ml(pack|lib) but just
+# a .ml4 file
+CMXSFILES = \
+	$(MLPACKFILES:.mlpack=.cmxs) \
+	$(CMXAFILES:.cmxa=.cmxs) \
+	$(if $(MLPACKFILES)$(CMXAFILES),,\
+		$(ML4FILES:.ml4=.cmxs) $(MLFILES:.ml=.cmxs))
+
+# files that are packed into a plugin (no extension)
+PACKEDFILES = \
+	$(call strip_dotslash, \
+	  $(foreach lib, \
+            $(call strip_dotslash, \
+	       $(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES)),$($(lib))))
+# files that are archived into a .cma (mllib)
+LIBEDFILES = \
+	$(call strip_dotslash, \
+	  $(foreach lib, \
+            $(call strip_dotslash, \
+	       $(MLLIBFILES:.mllib=_MLLIB_DEPENDENCIES)),$($(lib))))
+CMIFILESTOINSTALL = $(filter-out $(addsuffix .cmi,$(PACKEDFILES)),$(CMIFILES))
+CMOFILESTOINSTALL = $(filter-out $(addsuffix .cmo,$(PACKEDFILES)),$(CMOFILES))
+OBJFILES = $(call vo_to_obj,$(VOFILES))
+ALLNATIVEFILES = \
+	$(OBJFILES:.o=.cmi) \
+	$(OBJFILES:.o=.cmx) \
+	$(OBJFILES:.o=.cmxs)
+# 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) \
+	$(NATIVEFILES) \
+	$(CMIFILESTOINSTALL)
+BYTEFILESTOINSTALL = \
+	$(CMOFILESTOINSTALL) \
+	$(CMAFILES)
+ifeq '$(HASNATDYNLINK)' 'true'
+DO_NATDYNLINK = yes
+FILESTOINSTALL += $(CMXSFILES) $(CMXAFILES) $(CMOFILESTOINSTALL:.cmo=.cmx)
+else
+DO_NATDYNLINK =
+endif
+
+ALLDFILES = $(addsuffix .d,$(ALLSRCFILES) $(VDFILE))
+
+# Compilation targets #########################################################
+
+all:
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all
+.PHONY: all
+
+all.timing.diff:
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all.timing.diff TIME_OF_PRETTY_BUILD_EXTRA_FILES=""
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all
+.PHONY: all.timing.diff
+
+make-pretty-timed-before:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_BEFORE_FILE)
+make-pretty-timed-after:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_AFTER_FILE)
+make-pretty-timed make-pretty-timed-before make-pretty-timed-after::
+	$(HIDE)rm -f pretty-timed-success.ok
+	$(HIDE)($(MAKE) --no-print-directory -f "$(PARENT)" $(TGTS) TIMED=1 2>&1 && touch pretty-timed-success.ok) | tee -a $(TIME_OF_BUILD_FILE)
+	$(HIDE)rm pretty-timed-success.ok # must not be -f; must fail if the touch failed
+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) --sort-by=$(TIMING_SORT_BY) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_BUILD_BEFORE_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 AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing'
+	$(HIDE)false
+else
+ifeq (,$(AFTER))
+print-pretty-single-time-diff::
+	@echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing'
+	$(HIDE)false
+else
+print-pretty-single-time-diff::
+	$(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) --sort-by=$(TIMING_SORT_BY) $(AFTER) $(BEFORE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
+endif
+endif
+pretty-timed:
+	$(HIDE)$(MAKE) --no-print-directory -f "$(PARENT)" make-pretty-timed
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-timed
+.PHONY: pretty-timed make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff
+
+# Extension points for actions to be performed before/after the all target
+pre-all::
+	@# Extension point
+	$(HIDE)if [ "$(COQMAKEFILE_VERSION)" != "$(COQ_VERSION)" ]; then\
+	  echo "W: This Makefile was generated by Coq $(COQMAKEFILE_VERSION)";\
+	  echo "W: while the current Coq version is $(COQ_VERSION)";\
+	fi
+.PHONY: pre-all
+
+post-all::
+	@# Extension point
+.PHONY: post-all
+
+real-all: $(VOFILES) $(if $(USEBYTE),bytefiles,optfiles)
+.PHONY: real-all
+
+real-all.timing.diff: $(VOFILES:.vo=.v.timing.diff)
+.PHONY: real-all.timing.diff
+
+bytefiles: $(CMOFILES) $(CMAFILES)
+.PHONY: bytefiles
+
+optfiles: $(if $(DO_NATDYNLINK),$(CMXSFILES))
+.PHONY: optfiles
+
+# FIXME, see Ralf's bugreport
+quick: $(VOFILES:.vo=.vio)
+.PHONY: quick
+
+vio2vo:
+	$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) \
+		-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) $^
+.PHONY: validate
+
+only: $(TGTS)
+.PHONY: only
+
+# Documentation targets #######################################################
+
+html: $(GLOBFILES) $(VFILES)
+	$(SHOW)'COQDOC -d html $(GAL)'
+	$(HIDE)mkdir -p html
+	$(HIDE)$(COQDOC) \
+		-toc $(COQDOCFLAGS) -html $(GAL) $(COQDOCLIBS) -d html $(VFILES)
+
+mlihtml: $(MLIFILES:.mli=.cmi)
+	$(SHOW)'CAMLDOC -d $@'
+	$(HIDE)mkdir $@ || rm -rf $@/*
+	$(HIDE)$(CAMLDOC) -html \
+		-d $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES)
+
+all-mli.tex: $(MLIFILES:.mli=.cmi)
+	$(SHOW)'CAMLDOC -latex $@'
+	$(HIDE)$(CAMLDOC) -latex \
+		-o $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES)
+
+gallina: $(GFILES)
+
+all.ps: $(VFILES)
+	$(SHOW)'COQDOC -ps $(GAL)'
+	$(HIDE)$(COQDOC) \
+		-toc $(COQDOCFLAGS) -ps $(GAL) $(COQDOCLIBS) \
+		-o $@ `$(COQDEP) -sort -suffix .v $(VFILES)`
+
+all.pdf: $(VFILES)
+	$(SHOW)'COQDOC -pdf $(GAL)'
+	$(HIDE)$(COQDOC) \
+		-toc $(COQDOCFLAGS) -pdf $(GAL) $(COQDOCLIBS) \
+		-o $@ `$(COQDEP) -sort -suffix .v $(VFILES)`
+
+# FIXME: not quite right, since the output name is different
+gallinahtml: GAL=-g
+gallinahtml: html
+
+all-gal.ps: GAL=-g
+all-gal.ps: all.ps
+
+all-gal.pdf: GAL=-g
+all-gal.pdf: all.pdf
+
+# ?
+beautify: $(BEAUTYFILES)
+	for file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done
+	@echo 'Do not do "make clean" until you are sure that everything went well!'
+	@echo 'If there were a problem, execute "for file in $$(find . -name \*.v.old -print); do mv $${file} $${file%.old}; done" in your shell/'
+.PHONY: beautify
+
+# Installation targets ########################################################
+#
+# There rules can be extended in @LOCAL_FILE@
+# Extensions can't assume when they run.
+
+install:
+	$(HIDE)for f in $(FILESTOINSTALL); do\
+	 df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\
+	 if [ "$$?" != "0" -o -z "$$df" ]; then\
+	   echo SKIP "$$f" since it has no logical path;\
+	 else\
+	   install -d "$(COQLIBINSTALL)/$$df" &&\
+	   install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\
+	   echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\
+	 fi;\
+	done
+	$(HIDE)$(MAKE) install-extra -f "$(SELF)"
+install-extra::
+	@# Extension point
+.PHONY: install install-extra
+
+install-byte:
+	$(HIDE)for f in $(BYTEFILESTOINSTALL); do\
+	 df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\
+	 if [ "$$?" != "0" -o -z "$$df" ]; then\
+	   echo SKIP "$$f" since it has no logical path;\
+	 else\
+	   install -d "$(COQLIBINSTALL)/$$df" &&\
+	   install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\
+	   echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\
+	 fi;\
+	done
+
+install-doc:: html mlihtml
+	@# Extension point
+	$(HIDE)install -d "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html"
+	$(HIDE)for i in html/*; do \
+	 dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\
+	 install -m 0644 "$$i" "$$dest";\
+	 echo INSTALL "$$i" "$$dest";\
+	done
+	$(HIDE)install -d \
+		"$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml"
+	$(HIDE)for i in mlihtml/*; do \
+	 dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\
+	 install -m 0644 "$$i" "$$dest";\
+	 echo INSTALL "$$i" "$$dest";\
+	done
+.PHONY: install-doc
+
+uninstall::
+	@# Extension point
+	$(HIDE)for f in $(FILESTOINSTALL); do \
+	 df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`" &&\
+	 instf="$(COQLIBINSTALL)/$$df/`basename $$f`" &&\
+	 rm -f "$$instf" &&\
+	 echo RM "$$instf" &&\
+	 (rmdir "$(call concat_path,,$(COQLIBINSTALL)/$$df/)" 2>/dev/null || true); \
+	done
+.PHONY: uninstall
+
+uninstall-doc::
+	@# Extension point
+	$(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html'
+	$(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html"
+	$(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml'
+	$(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml"
+	$(HIDE) rmdir "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/" || true
+.PHONY: uninstall-doc
+
+# Cleaning ####################################################################
+#
+# There rules can be extended in @LOCAL_FILE@
+# Extensions can't assume when they run.
+
+clean::
+	@# Extension point
+	$(SHOW)'CLEAN'
+	$(HIDE)rm -f $(CMOFILES)
+	$(HIDE)rm -f $(CMIFILES)
+	$(HIDE)rm -f $(CMAFILES)
+	$(HIDE)rm -f $(CMOFILES:.cmo=.cmx)
+	$(HIDE)rm -f $(CMXAFILES)
+	$(HIDE)rm -f $(CMXSFILES)
+	$(HIDE)rm -f $(CMOFILES:.cmo=.o)
+	$(HIDE)rm -f $(CMXAFILES:.cmxa=.a)
+	$(HIDE)rm -f $(ALLDFILES)
+	$(HIDE)rm -f $(NATIVEFILES)
+	$(HIDE)find . -name .coq-native -type d -empty -delete
+	$(HIDE)rm -f $(VOFILES)
+	$(HIDE)rm -f $(VOFILES:.vo=.vio)
+	$(HIDE)rm -f $(GFILES)
+	$(HIDE)rm -f $(BEAUTYFILES) $(VFILES:=.old)
+	$(HIDE)rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob all-mli.tex
+	$(HIDE)rm -f $(VFILES:.v=.glob)
+	$(HIDE)rm -f $(VFILES:.v=.tex)
+	$(HIDE)rm -f $(VFILES:.v=.g.tex)
+	$(HIDE)rm -f pretty-timed-success.ok
+	$(HIDE)rm -rf html mlihtml
+.PHONY: clean
+
+cleanall:: clean
+	@# Extension point
+	$(SHOW)'CLEAN *.aux *.timing'
+	$(HIDE)rm -f $(foreach f,$(VFILES:.v=),$(dir $(f)).$(notdir $(f)).aux)
+	$(HIDE)rm -f $(TIME_OF_BUILD_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.timing)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.before-timing)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.after-timing)
+	$(HIDE)rm -f $(VOFILES:.vo=.v.timing.diff)
+.PHONY: cleanall
+
+archclean::
+	@# Extension point
+	$(SHOW)'CLEAN *.cmx *.o'
+	$(HIDE)rm -f $(NATIVEFILES)
+	$(HIDE)rm -f $(CMOFILES:%.cmo=%.cmx)
+.PHONY: archclean
+
+
+# Compilation rules ###########################################################
+
+$(MLIFILES:.mli=.cmi): %.cmi: %.mli
+	$(SHOW)'CAMLC -c $<'
+	$(HIDE)$(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $<
+
+$(ML4FILES:.ml4=.cmo): %.cmo: %.ml4
+	$(SHOW)'CAMLC -pp -c $<'
+	$(HIDE)$(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $(PP) -impl $<
+
+$(ML4FILES:.ml4=.cmx): %.cmx: %.ml4
+	$(SHOW)'CAMLOPT -pp -c $(FOR_PACK) $<'
+	$(HIDE)$(CAMLOPTC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $(PP) $(FOR_PACK) -impl $<
+
+$(MLFILES:.ml=.cmo): %.cmo: %.ml
+	$(SHOW)'CAMLC -c $<'
+	$(HIDE)$(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $<
+
+$(MLFILES:.ml=.cmx): %.cmx: %.ml
+	$(SHOW)'CAMLOPT -c $(FOR_PACK) $<'
+	$(HIDE)$(CAMLOPTC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $(FOR_PACK) $<
+
+
+$(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa
+	$(SHOW)'CAMLOPT -shared -o $@'
+	$(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \
+		-linkall -shared -o $@ $<
+
+$(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib
+	$(SHOW)'CAMLC -a -o $@'
+	$(HIDE)$(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^
+
+$(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib
+	$(SHOW)'CAMLOPT -a -o $@'
+	$(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^
+
+
+$(MLPACKFILES:.mlpack=.cmxs): %.cmxs: %.cmxa
+	$(SHOW)'CAMLOPT -shared -o $@'
+	$(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \
+		-shared -linkall -o $@ $<
+
+$(MLPACKFILES:.mlpack=.cmxa): %.cmxa: %.cmx
+	$(SHOW)'CAMLOPT -a -o $@'
+	$(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -a -o $@ $<
+
+$(MLPACKFILES:.mlpack=.cma): %.cma: %.cmo | %.mlpack
+	$(SHOW)'CAMLC -a -o $@'
+	$(HIDE)$(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^
+
+$(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack
+	$(SHOW)'CAMLC -pack -o $@'
+	$(HIDE)$(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) -pack -o $@ $^
+
+$(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack
+	$(SHOW)'CAMLOPT -pack -o $@'
+	$(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -pack -o $@ $^
+
+# This rule is for _CoqProject with no .mllib nor .mlpack
+$(filter-out $(MLLIBFILES:.mllib=.cmxs) $(MLPACKFILES:.mlpack=.cmxs) $(addsuffix .cmxs,$(PACKEDFILES)) $(addsuffix .cmxs,$(LIBEDFILES)),$(MLFILES:.ml=.cmxs) $(ML4FILES:.ml4=.cmxs)): %.cmxs: %.cmx
+	$(SHOW)'[deprecated,use-mllib-or-mlpack] CAMLOPT -shared -o $@'
+	$(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \
+		-shared -o $@ $<
+
+ifneq (,$(TIMING))
+TIMING_EXTRA = > $<.$(TIMING_EXT)
+else
+TIMING_EXTRA =
+endif
+
+$(VOFILES): %.vo: %.v
+	$(SHOW)COQC $<
+	$(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(TIMING_ARG) $(COQFLAGS) $< $(TIMING_EXTRA)
+
+# FIXME ?merge with .vo / .vio ?
+$(GLOBFILES): %.glob: %.v
+	$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $<
+
+$(VFILES:.v=.vio): %.vio: %.v
+	$(SHOW)COQC -quick $<
+	$(HIDE)$(TIMER) $(COQC) -quick $(COQDEBUG) $(COQFLAGS) $<
+
+$(addsuffix .timing.diff,$(VFILES)): %.timing.diff : %.before-timing %.after-timing
+	$(SHOW)PYTHON TIMING-DIFF $<
+	$(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-single-time-diff BEFORE=$*.before-timing AFTER=$*.after-timing TIME_OF_PRETTY_BUILD_FILE="$@"
+
+$(BEAUTYFILES): %.v.beautified: %.v
+	$(SHOW)'BEAUTIFY $<'
+	$(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $<
+
+$(GFILES): %.g: %.v
+	$(SHOW)'GALLINA $<'
+	$(HIDE)$(GALLINA) $<
+
+$(TEXFILES): %.tex: %.v
+	$(SHOW)'COQDOC -latex $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@
+
+$(GTEXFILES): %.g.tex: %.v
+	$(SHOW)'COQDOC -latex -g $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@
+
+$(HTMLFILES): %.html: %.v %.glob
+	$(SHOW)'COQDOC -html $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS) -html $< -o $@
+
+$(GHTMLFILES): %.g.html: %.v %.glob
+	$(SHOW)'COQDOC -html -g $<'
+	$(HIDE)$(COQDOC) $(COQDOCFLAGS)  -html -g $< -o $@
+
+# Dependency files ############################################################
+
+ifneq ($(filter-out archclean clean cleanall printenv make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff,$(MAKECMDGOALS)),)
+ -include $(ALLDFILES)
+else
+ ifeq ($(MAKECMDGOALS),)
+  -include $(ALLDFILES)
+ endif
+endif
+
+.SECONDARY: $(ALLDFILES)
+
+redir_if_ok = > "$@" || ( RV=$$?; rm -f "$@"; exit $$RV )
+
+$(addsuffix .d,$(MLIFILES)): %.mli.d: %.mli
+	$(SHOW)'CAMLDEP $<'
+	$(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(ML4FILES)): %.ml4.d: %.ml4
+	$(SHOW)'CAMLDEP -pp $<'
+	$(HIDE)$(CAMLDEP) $(OCAMLLIBS) $(PP) -impl "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(MLFILES)): %.ml.d: %.ml
+	$(SHOW)'CAMLDEP $<'
+	$(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(MLLIBFILES)): %.mllib.d: %.mllib
+	$(SHOW)'COQDEP $<'
+	$(HIDE)$(COQDEP) $(OCAMLLIBS) -c "$<" $(redir_if_ok)
+
+$(addsuffix .d,$(MLPACKFILES)): %.mlpack.d: %.mlpack
+	$(SHOW)'COQDEP $<'
+	$(HIDE)$(COQDEP) $(OCAMLLIBS) -c "$<" $(redir_if_ok)
+
+# If this makefile is created using a _CoqProject we have coqdep get
+# options from it. This avoids argument length limits for pathological
+# projects. Note that extra options might be on the command line.
+VDFILE_FLAGS:=$(if @PROJECT_FILE@,-f @PROJECT_FILE@,) $(CMDLINE_COQLIBS) $(CMDLINE_VFILES)
+
+$(VDFILE).d: $(VFILES)
+	$(SHOW)'COQDEP VFILES'
+	$(HIDE)$(COQDEP) -dyndep var $(VDFILE_FLAGS) $(redir_if_ok)
+
+# Misc ########################################################################
+
+byte:
+	$(HIDE)$(MAKE) all "OPT:=-byte" -f "$(SELF)"
+.PHONY: byte
+
+opt:
+	$(HIDE)$(MAKE) all "OPT:=-opt" -f "$(SELF)"
+.PHONY:	opt
+
+# This is deprecated.  To extend this makefile use
+# extension points and @LOCAL_FILE@
+printenv::
+	$(warning printenv is deprecated)
+	$(warning write extensions in @LOCAL_FILE@ or include @CONF_FILE@)
+	@echo 'LOCAL = $(LOCAL)'
+	@echo 'COQLIB = $(COQLIB)'
+	@echo 'DOCDIR = $(DOCDIR)'
+	@echo 'OCAMLFIND = $(OCAMLFIND)'
+	@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)'
+	@echo 'OCAMLFIND = $(OCAMLFIND)'
+	@echo 'PP = $(PP)'
+	@echo 'COQFLAGS = $(COQFLAGS)'
+	@echo 'COQLIBINSTALL = $(COQLIBINSTALL)'
+	@echo 'COQDOCINSTALL = $(COQDOCINSTALL)'
+.PHONY:	printenv
+
+# Generate a .merlin file.  If you need to append directives to this
+# file you can extend the merlin-hook target in @LOCAL_FILE@
+.merlin:
+	$(SHOW)'FILL .merlin'
+	$(HIDE)echo 'FLG $(COQMF_CAMLFLAGS)' > .merlin
+	$(HIDE)echo 'B $(COQLIB)' >> .merlin
+	$(HIDE)echo 'S $(COQLIB)' >> .merlin
+	$(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \
+		echo 'B $(COQLIB)$(d)' >> .merlin;)
+	$(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \
+		echo 'S $(COQLIB)$(d)' >> .merlin;)
+	$(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'B $(d)' >> .merlin;)
+	$(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'S $(d)' >> .merlin;)
+	$(HIDE)$(MAKE) merlin-hook -f "$(SELF)"
+.PHONY: merlin
+
+merlin-hook::
+	@# Extension point
+.PHONY: merlin-hook
+
+# prints all variables
+debug:
+	$(foreach v,\
+		$(sort $(filter-out $(INITIAL_VARS) INITIAL_VARS,\
+	       		$(.VARIABLES))),\
+	       	$(info $(v) = $($(v))))
+.PHONY: debug
+
+.DEFAULT_GOAL := all
diff --git a/tools/TimeFileMaker.py b/tools/TimeFileMaker.py
new file mode 100644
index 00000000..8564aeff
--- /dev/null
+++ b/tools/TimeFileMaker.py
@@ -0,0 +1,219 @@
+from __future__ import with_statement
+from __future__ import division
+from __future__ import unicode_literals
+from __future__ import print_function
+import os, sys, re
+from io import open
+
+# This script parses the output of `make TIMED=1` into a dictionary
+# mapping names of compiled files to the number of minutes and seconds
+# that they took to compile.
+
+STRIP_REG = re.compile('^(coq/|contrib/|)(?:theories/|src/)?')
+STRIP_REP = r'\1'
+INFINITY  = '\u221e'
+
+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)
+    minutes, seconds = divmod(seconds, 60)
+    return '%dm%02d.%ss' % (minutes, seconds, milliseconds)
+
+def get_times(file_name):
+    '''
+    Reads the contents of file_name, which should be the output of
+    'make TIMED=1', and parses it to construct a dict mapping file
+    names to compile durations, as strings.  Removes common prefixes
+    using STRIP_REG and STRIP_REP.
+    '''
+    if file_name == '-':
+        lines = sys.stdin.read()
+    else:
+        with open(file_name, 'r', encoding="utf-8") as f:
+            lines = f.read()
+    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\.]+)[^\)]*?\)\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)
+    return dict((name, reformat_time_string(time)) for name, time in times)
+
+def get_single_file_times(file_name):
+    '''
+    Reads the contents of file_name, which should be the output of
+    'coqc -time', and parses it to construct a dict mapping lines to
+    to compile durations, as strings.
+    '''
+    if file_name == '-':
+        lines = sys.stdin.read()
+    else:
+        with open(file_name, 'r', encoding="utf-8") as f:
+            lines = f.read()
+    reg = re.compile(r'^Chars ([0-9]+) - ([0-9]+) ([^ ]+) ([0-9\.]+) secs (.*)$', re.MULTILINE)
+    times = reg.findall(lines)
+    if len(times) == 0: return dict()
+    longest = max(max((len(start), len(stop))) for start, stop, name, time, extra in times)
+    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')
+        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):
+    '''
+    Takes the output dict of get_times and returns the list of keys,
+    sorted by duration.
+    '''
+    return sorted(times_dict.keys(), key=make_sorting_key(times_dict, descending=descending))
+
+def to_seconds(time):
+    '''
+    Converts a string time into a number of seconds.
+    '''
+    minutes, seconds = time.replace('s', '').split('m')
+    sign = -1 if time[0] == '-' else 1
+    return sign * (abs(int(minutes)) * 60 + float(seconds))
+
+def from_seconds(seconds, signed=False):
+    '''
+    Converts a number of seconds into a string time.
+    '''
+    sign = ('-' if seconds < 0 else '+') if signed else ''
+    seconds = abs(seconds)
+    minutes = int(seconds) // 60
+    seconds -= minutes * 60
+    full_seconds = int(seconds)
+    partial_seconds = int(100 * (seconds - full_seconds))
+    return sign + '%dm%02d.%02ds' % (minutes, full_seconds, partial_seconds)
+
+def sum_times(times, signed=False):
+    '''
+    Takes the values of an output from get_times, parses the time
+    strings, and returns their sum, in the same string format.
+    '''
+    # sort the times before summing because floating point addition is not associative
+    return from_seconds(sum(sorted(map(to_seconds, times))), signed=signed)
+
+def format_percentage(num, signed=True):
+    sign = ('-' if num < 0 else '+') if signed else ''
+    num = abs(num)
+    whole_part = int(num * 100)
+    frac_part = int(100 * (num * 100 - whole_part))
+    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"):
+    # We first get the names of all of the compiled files: all files
+    # that were compiled either before or after.
+    all_names_dict = dict()
+    all_names_dict.update(right_times_dict)
+    all_names_dict.update(left_times_dict) # do the left (after) last, so that we give precedence to those ones
+    if len(all_names_dict.keys()) == 0: return 'No timing data'
+    prediff_times = tuple((name, to_seconds(left_times_dict.get(name,'0m0.0s')), to_seconds(right_times_dict.get(name,'0m0.0s')))
+                          for name in all_names_dict.keys())
+    diff_times_dict = dict((name, from_seconds(lseconds - rseconds, signed=True))
+                           for name, lseconds, rseconds in prediff_times)
+    percent_diff_times_dict = dict((name, ((format_percentage((lseconds - rseconds) / rseconds))
+                                           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_abs = make_sorting_key(all_names_dict, descending=descending)
+    get_key_diff_float = (lambda name: fix_sign_for_sorting(to_seconds(diff_times_dict[name]), descending=descending))
+    get_key_diff_absint = (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_float
+    else: # sort_by == 'auto'
+        get_key = (lambda name: (get_key_diff_absint(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())
+    right_sum = sum_times(right_times_dict.values())
+    left_sum_float = sum(sorted(map(to_seconds, left_times_dict.values())))
+    right_sum_float = sum(sorted(map(to_seconds, right_times_dict.values())))
+    diff_sum = from_seconds(left_sum_float - right_sum_float, signed=True)
+    percent_diff_sum = (format_percentage((left_sum_float - right_sum_float) / right_sum_float)
+                        if right_sum_float > 0 else 'N/A')
+    left_width = max(max(map(len, ['N/A'] + list(left_times_dict.values()))), len(left_sum))
+    right_width = max(max(map(len, ['N/A'] + list(right_times_dict.values()))), len(right_sum))
+    far_right_width = max(max(map(len, ['N/A', change_tag] + list(diff_times_dict.values()))), len(diff_sum))
+    far_far_right_width = max(max(map(len, ['N/A', percent_change_tag] + list(percent_diff_times_dict.values()))), len(percent_diff_sum))
+    middle_width = max(map(len, names + [tag, "Total"]))
+    format_string = ("%%(left)-%ds | %%(middle)-%ds | %%(right)-%ds || %%(far_right)-%ds"
+                     % (left_width, middle_width, right_width, far_right_width))
+    if with_percent:
+        format_string += " | %%(far_far_right)-%ds" % far_far_right_width
+    header = format_string % {'left': left_tag, 'middle': tag, 'right': right_tag, 'far_right': change_tag, 'far_far_right': percent_change_tag}
+    total = format_string % {'left': left_sum, 'middle': "Total", 'right': right_sum, 'far_right': diff_sum, 'far_far_right': percent_diff_sum}
+    # separator to go between headers and body
+    sep = '-' * len(header)
+    # the representation of the default value (0), to get replaced by N/A
+    left_rep, right_rep, far_right_rep, far_far_right_rep = ("%%-%ds | " % left_width) % 0, (" | %%-%ds || " % right_width) % 0, ("|| %%-%ds" % far_right_width) % 0, ("| %%-%ds" % far_far_right_width) % 0
+    return '\n'.join([header, sep, total, sep] +
+                     [format_string % {'left': left_times_dict.get(name, 0),
+                                       'middle': name,
+                                       'right': right_times_dict.get(name, 0),
+                                       'far_right': diff_times_dict.get(name, 0),
+                                       'far_far_right': percent_diff_times_dict.get(name, 0)}
+                      for name in names]).replace(left_rep, 'N/A'.center(len(left_rep) - 3) + ' | ').replace(right_rep, ' | ' + 'N/A'.center(len(right_rep) - 7) + ' || ').replace(far_right_rep, '|| ' + 'N/A'.center(len(far_right_rep) - 3)).replace(far_far_right_rep, '| ' + 'N/A'.center(len(far_far_right_rep) - 2))
+
+def make_table_string(times_dict,
+                      descending=True,
+                      tag="Time"):
+    if len(times_dict.keys()) == 0: return 'No timing data'
+    # We first get the names of all of the compiled files, sorted by
+    # duration
+    names = get_sorted_file_list_from_times_dict(times_dict, descending=descending)
+    # compute the widths of the columns
+    times_width = max(max(map(len, times_dict.values())), len(sum_times(times_dict.values())))
+    names_width = max(map(len, names + ["File Name", "Total"]))
+    format_string = "%%-%ds | %%-%ds" % (times_width, names_width)
+    header = format_string % (tag, "File Name")
+    total = format_string % (sum_times(times_dict.values()),
+                             "Total")
+    sep = '-' * len(header)
+    return '\n'.join([header, sep, total, sep] +
+                     [format_string % (times_dict[name],
+                                       name)
+                      for name in names])
+
+def print_or_write_table(table, files):
+    if len(files) == 0 or '-' in files:
+        try:
+            binary_stdout = sys.stdout.buffer
+        except AttributeError:
+            binary_stdout = sys.stdout
+        print(table.encode("utf-8"), file=binary_stdout)
+    for file_name in files:
+        if file_name != '-':
+            with open(file_name, 'w', encoding="utf-8") as f:
+                f.write(table)
diff --git a/tools/beautify-archive b/tools/beautify-archive
index 6bfa974a..a327ea44 100755
--- a/tools/beautify-archive
+++ b/tools/beautify-archive
@@ -23,7 +23,7 @@ cp -pr /tmp/$OLDARCHIVE.$$ $NEWARCHIVE
 cd $NEWARCHIVE
 rm description || true
 make clean
-make COQFLAGS='-beautify -q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)' || \
+make COQFLAGS='-beautify -q $(OPT) $(COQLIBS) $(OTHERFLAGS)' || \
  { echo ---- Failed to beautify; exit 1; }
 echo -------- Upgrading files in the beautification directory --------------
 beaufiles=`find . -name \*.v$BEAUTIFYSUFFIX`
diff --git a/tools/check-translate b/tools/check-translate
index 3dd82405..acb6f459 100755
--- a/tools/check-translate
+++ b/tools/check-translate
@@ -2,7 +2,7 @@
 
 echo -------------- Producing translated files ---------------------
 rm */*/*.v8 >& /dev/null
-make COQ_XML=-translate theories || { echo ---- Failed to translate; exit 1; }
+make COQOPTS=-translate theories || { echo ---- Failed to translate; exit 1; }
 if [ -e translated ]; then rm -r translated; fi
 if [ -e successful-translation ]; then rm -r successful-translation; fi
 if [ -e failed-translation ]; then rm -r failed-translation; fi
diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml
index eab909f5..5402765f 100644
--- a/tools/coq_makefile.ml
+++ b/tools/coq_makefile.ml
@@ -1,24 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Coq_makefile: automatically create a Makefile for a Coq development *)
 
+open CoqProject_file
+open Printf
+
+let (>) f g = fun x -> g (f x)
+
 let output_channel = ref stdout
 let makefile_name = ref "Makefile"
 let make_name = ref ""
 
-let some_vfile = ref false
-let some_mlfile = ref false
-let some_mlifile = ref false
-let some_ml4file = ref false
-let some_mllibfile = ref false
-let some_mlpackfile = ref false
-
 let print x = output_string !output_channel x
 let printf x = Printf.fprintf !output_channel x
 
@@ -31,85 +31,58 @@ let rec print_prefix_list sep = function
   | x :: l -> print sep; print x; print_prefix_list sep l
   | [] -> ()
 
-let section s =
-  let l = String.length s in
-  let print_com s =
-    print "#";
-    print s;
-    print "#\n" in
-  print_com (String.make (l+2) '#');
-  print_com (String.make (l+2) ' ');
-  print "# "; print s; print " #\n";
-  print_com (String.make (l+2) ' ');
-  print_com (String.make (l+2) '#');
-  print "\n"
-
-(* These are the Coq library directories that are used for
- * plugin development
- *)
-let lib_dirs =
-  ["kernel"; "lib"; "library"; "parsing";
-   "pretyping"; "interp"; "printing"; "intf";
-   "proofs"; "tactics"; "tools"; "ltacprof";
-   "toplevel"; "stm"; "grammar"; "config";
-   "ltac"; "engine"]
-
-
-let usage () =
-  output_string stderr "Usage summary:
-
-coq_makefile .... [file.v] ... [file.ml[i4]?] ... [file.ml{lib,pack}]
-  ... [any] ... [-extra[-phony] result dependencies command]
-  ... [-I dir] ... [-R physicalpath logicalpath]
-  ... [-Q physicalpath logicalpath] ... [VARIABLE = value]
-  ...  [-arg opt] ... [-opt|-byte] [-no-install] [-f file] [-o file]
-  [-h] [--help]
-
-[file.v]: Coq file to be compiled
-[file.ml[i4]?]: Objective Caml file to be compiled
-[file.ml{lib,pack}]: ocamlbuild file that describes a Objective Caml
-  library/module
-[any] : subdirectory that should be \"made\" and has a Makefile itself
-  to do so. Very fragile and discouraged.
-[-extra result dependencies command]: add target \"result\" with command
-  \"command\" and dependencies \"dependencies\". If \"result\" is not
-  generic (do not contains a %), \"result\" is built by _make all_ and
-  deleted by _make clean_.
-[-extra-phony result dependencies command]: add a PHONY target \"result\"
- with command \"command\" and dependencies \"dependencies\". Note that
- _-extra-phony foo bar \"\"_ is a regular way to add the target \"bar\" as
- as a dependencies of an already defined target \"foo\".
-[-I dir]: look for Objective Caml dependencies in \"dir\"
-[-R physicalpath logicalpath]: look for Coq dependencies resursively
-  starting from \"physicalpath\". The logical path associated to the
-  physical path is \"logicalpath\".
-[-Q physicalpath logicalpath]: look for Coq dependencies starting from
-  \"physicalpath\". The logical path associated to the physical path
-  is \"logicalpath\".
-[VARIABLE = value]: Add the variable definition \"VARIABLE=value\"
-[-byte]: compile with byte-code version of coq
-[-opt]: compile with native-code version of coq
-[-arg opt]: send option \"opt\" to coqc
-[-install opt]: where opt is \"user\" to force install into user directory,
-  \"none\" to build a makefile with no install target or
-  \"global\" to force install in $COQLIB directory
-[-f file]: take the contents of file as arguments
-[-o file]: output should go in file file
-	Output file outside the current directory is forbidden.
-[-h]: print this usage summary
-[--help]: equivalent to [-h]\n";
+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";
+  output_string stderr "\
+\nFull list of options:\
+\n\
+\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\
+\n  library/module\
+\n[any] : subdirectory that should be \"made\" and has a Makefile itself\
+\n  to do so. Very fragile and discouraged.\
+\n[-extra result dependencies command]: add target \"result\" with command\
+\n  \"command\" and dependencies \"dependencies\". If \"result\" is not\
+\n  generic (do not contains a %), \"result\" is built by _make all_ and\
+\n  deleted by _make clean_.\
+\n[-extra-phony result dependencies command]: add a PHONY target \"result\"\
+\n with command \"command\" and dependencies \"dependencies\". Note that\
+\n _-extra-phony foo bar \"\"_ is a regular way to add the target \"bar\" as\
+\n as a dependencies of an already defined target \"foo\".\
+\n[-I dir]: look for Objective Caml dependencies in \"dir\"\
+\n[-R physicalpath logicalpath]: look for Coq dependencies resursively\
+\n  starting from \"physicalpath\". The logical path associated to the\
+\n  physical path is \"logicalpath\".\
+\n[-Q physicalpath logicalpath]: look for Coq dependencies starting from\
+\n  \"physicalpath\". The logical path associated to the physical path\
+\n  is \"logicalpath\".\
+\n[VARIABLE = value]: Add the variable definition \"VARIABLE=value\"\
+\n[-byte]: compile with byte-code version of coq\
+\n[-opt]: compile with native-code version of coq\
+\n[-arg opt]: send option \"opt\" to coqc\
+\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[-f file]: take the contents of file as arguments\
+\n[-o file]: output should go in file file (recommended)\
+\n	Output file outside the current directory is forbidden.\
+\n[-h]: print this usage summary\
+\n[--help]: equivalent to [-h]\n";
   exit 1
 
 let is_genrule r = (* generic rule (like bar%foo: ...) *)
     let genrule = Str.regexp("%") in
       Str.string_match genrule r 0
 
-let string_prefix a b =
-  let rec aux i =
-    try if a.[i] = b.[i] then aux (i+1) else i with Invalid_argument _ -> i
-  in
-  String.sub a 0 (aux 0)
-
 let is_prefix dir1 dir2 =
   let l1 = String.length dir1 in
   let l2 = String.length dir2 in
@@ -122,836 +95,348 @@ let is_prefix dir1 dir2 =
   else false
 
 let physical_dir_of_logical_dir ldir =
-  let le = String.length ldir - 1 in
+  let ldir = Bytes.of_string ldir in
+  let le = Bytes.length ldir - 1 in
   let pdir =
-    if le >= 0 && ldir.[le] = '.' then String.sub ldir 0 (le - 1)
-    else String.copy ldir
+    if le >= 0 && Bytes.get ldir le = '.' then Bytes.sub ldir 0 (le - 1)
+    else Bytes.copy ldir
   in
   for i = 0 to le - 1 do
-    if pdir.[i] = '.' then pdir.[i] <- '/';
+    if Bytes.get pdir i = '.' then Bytes.set pdir i '/';
   done;
-  pdir
-
-let standard opt =
-  print "byte:\n";
-  print "\t$(MAKE) all \"OPT:=-byte\"\n\n";
-  print "opt:\n";
-  if not opt then print "\t@echo \"WARNING: opt is disabled\"\n";
-  print "\t$(MAKE) all \"OPT:="; print (if opt then "-opt" else "-byte");
-  print "\"\n\n"
-
-let classify_files_by_root var files (inc_ml,inc_i,inc_r) =
-  if List.exists (fun (pdir,_,_) -> pdir = ".") inc_r ||
-     List.exists (fun (pdir,_,_) -> pdir = ".") inc_i
-  then ()
-  else
-    let absdir_of_files =List.rev_map
-	(fun x -> CUnix.canonical_path_name (Filename.dirname x))
-	files
-    in
-    (* files in scope of a -I option (assuming they are no overlapping) *)
-    if List.exists (fun (_,a) -> List.mem a absdir_of_files) inc_ml then
-      begin
-	printf "%sINC=" var;
-	List.iter (fun (pdir,absdir) ->
-		   if List.mem absdir absdir_of_files
-		   then printf "$(filter $(wildcard %s/*),$(%s)) " pdir var)
-		  inc_ml;
-	printf "\n";
-      end;
-    (* Files in the scope of a -R option (assuming they are disjoint) *)
-    List.iteri (fun i (pdir,_,abspdir) ->
-		if List.exists (is_prefix abspdir) absdir_of_files then
-		  printf "%s%d=$(patsubst %s/%%,%%,$(filter %s/%%,$(%s)))\n"
-			 var i pdir pdir var)
-	       (inc_i@inc_r)
-
-let vars_to_put_by_root var_x_files_l (inc_ml,inc_i,inc_r) =
-  let var_x_absdirs_l =
-    List.rev_map
-      (fun (v,l) ->
-       (v,List.rev_map
-            (fun x -> CUnix.canonical_path_name (Filename.dirname x)) l))
-      var_x_files_l
-  in
-  let var_filter f g =
-    List.fold_left
-      (fun acc (var,dirs) -> if f dirs then (g var)::acc else acc)
-      [] var_x_absdirs_l
-  in
-  (* All files caught by a -R . option (assuming it is the only one) *)
-  match inc_i@inc_r with
-  |[(".",t,_)] ->
-    (None,[".",physical_dir_of_logical_dir t,List.rev_map fst var_x_files_l])
-  |l ->
-    try
-      let out = List.assoc "." (List.rev_map (fun (p,l,_) -> (p,l)) l) in
-      let () = prerr_string "Warning: install rule assumes that -R/-Q . _ is the only -R/-Q option\n"
-      in
-      (None,[".",physical_dir_of_logical_dir out,List.rev_map fst var_x_files_l])
-    with Not_found ->
-      (* vars for -Q options *)
-      let varq = var_filter
-                   (fun l -> List.exists (fun (_,a) -> List.mem a l) inc_ml)
-                   (fun x -> x)
-      in
-      (* (physical dir, physical dir of logical path,vars) for -R options
-	 (assuming physical dirs are disjoint) *)
-      let other =
-        if l = [] then
-	  [".","$(INSTALLDEFAULTROOT)",[]]
-        else
-	  Util.List.fold_left_i (fun i out (pdir,ldir,abspdir) ->
-	    let vars_r = var_filter
-                           (List.exists (is_prefix abspdir))
-                           (fun x -> x^string_of_int i)
-            in
-	    let pdir' = physical_dir_of_logical_dir ldir in
-	    (pdir,pdir',vars_r)::out) 0 [] l
-      in (Some varq, other)
-
-let install_include_by_root perms =
-  let install_dir for_i (pdir,pdir',vars) =
-    let b = vars <> [] in
-    if b then begin
-      printf "\tcd \"%s\" && for i in " pdir;
-      print_list " " (List.rev_map (Format.sprintf "$(%s)") vars);
-      print "; do \\\n";
-      printf "\t install -d \"`dirname \"$(DSTROOT)\"$(COQLIBINSTALL)/%s/$$i`\"; \\\n" pdir';
-      printf "\t install -m %s $$i \"$(DSTROOT)\"$(COQLIBINSTALL)/%s/$$i; \\\n" perms pdir';
-      printf "\tdone\n";
-    end;
-    for_i b pdir' in
-  let install_i = function
-    |[] -> fun _ _ -> ()
-    |l -> fun b d ->
-      if not b then printf "\tinstall -d \"$(DSTROOT)\"$(COQLIBINSTALL)/%s; \\\n" d;
-      print "\tfor i in ";
-      print_list " " (List.rev_map (Format.sprintf "$(%sINC)") l);
-      print "; do \\\n";
-      printf "\t install -m %s $$i \"$(DSTROOT)\"$(COQLIBINSTALL)/%s/`basename $$i`; \\\n" perms d;
-      printf "\tdone\n"
-  in function
-  |None,l -> List.iter (install_dir (fun _ _ -> ())) l
-  |Some v_i,l -> List.iter (install_dir (install_i v_i)) l
-
-let uninstall_by_root =
-  let uninstall_dir for_i (pdir,pdir',vars) =
-    printf "\tprintf 'cd \"$${DSTROOT}\"$(COQLIBINSTALL)/%s" pdir';
-    if vars <> [] then begin
-      print " && rm -f ";
-      print_list " " (List.rev_map (Format.sprintf "$(%s)") vars);
-    end;
-    for_i ();
-    print " && find . -type d -and -empty -delete\\n";
-    print "cd \"$${DSTROOT}\"$(COQLIBINSTALL) && ";
-    printf "find \"%s\" -maxdepth 0 -and -empty -exec rmdir -p \\{\\} \\;\\n' >> \"$@\"\n" pdir'
-in
-  let uninstall_i = function
-    |[] -> ()
-    |l ->
-      print " && \\\\\\nfor i in ";
-      print_list " " (List.rev_map (Format.sprintf "$(%sINC)") l);
-      print "; do rm -f \"`basename \"$$i\"`\"; done"
-  in function
-  |None,l -> List.iter (uninstall_dir (fun _ -> ())) l
-  |Some v_i,l -> List.iter (uninstall_dir (fun () -> uninstall_i v_i)) l
-
-let where_put_doc = function
-    |_,[],[] -> "$(INSTALLDEFAULTROOT)";
-    |_,((_,lp,_)::q as inc_i),[] ->
-      let pr = List.fold_left (fun a (_,b,_) -> string_prefix a b) lp q in
-      if (pr <> "") &&
-	((List.exists (fun(_,b,_) -> b = pr) inc_i)
-	 || pr.[String.length pr - 1] = '.')
-      then
-	physical_dir_of_logical_dir pr
-      else
-	let () = prerr_string "Warning: -Q options don't have a correct common prefix,
- install-doc will put anything in $INSTALLDEFAULTROOT\n" in
-	"$(INSTALLDEFAULTROOT)"
-    |_,inc_i,((_,lp,_)::q as inc_r) ->
-      let pr = List.fold_left (fun a (_,b,_) -> string_prefix a b) lp q in
-      let pr = List.fold_left (fun a (_,b,_) -> string_prefix a b) pr inc_i in
-      if (pr <> "") &&
-	((List.exists (fun(_,b,_) -> b = pr) inc_r)
-	 || (List.exists (fun(_,b,_) -> b = pr) inc_i)
-	 || pr.[String.length pr - 1] = '.')
-      then
-	physical_dir_of_logical_dir pr
-      else
-	let () = prerr_string "Warning: -R/-Q options don't have a correct common prefix,
- install-doc will put anything in $INSTALLDEFAULTROOT\n" in
-	"$(INSTALLDEFAULTROOT)"
-
-let install (vfiles,(mlis,ml4s,mls,mllibs,mlpacks),_,sds) inc = function
-  |Project_file.NoInstall -> ()
-  |is_install ->
-    let not_empty = function |[] -> false |_::_ -> true in
-    let cmos = List.rev_append mlpacks (List.rev_append mls ml4s) in
-    let cmis = List.rev_append mlis cmos in
-    let cmxss = List.rev_append cmos mllibs in
-    let where_what_cmxs = vars_to_put_by_root [("CMXSFILES",cmxss)] inc in
-    let where_what_oth = vars_to_put_by_root
-      [("VOFILES",vfiles);("VFILES",vfiles);
-       ("GLOBFILES",vfiles);("NATIVEFILES",vfiles);
-       ("CMOFILES",cmos);("CMIFILES",cmis);("CMAFILES",mllibs)]
-      inc in
-    let doc_dir = where_put_doc inc in
-    if is_install = Project_file.UnspecInstall then begin
-	print "userinstall:\n\t+$(MAKE) USERINSTALL=true install\n\n"
-    end;
-    if not_empty cmxss then begin
-      print "install-natdynlink:\n";
-      install_include_by_root "0755" where_what_cmxs;
-      print "\n";
-    end;
-    if not_empty cmxss then begin
-      print "install-toploop: $(MLLIBFILES:.mllib=.cmxs)\n";
-      printf "\t install -d \"$(DSTROOT)\"$(COQTOPINSTALL)/\n";
-      printf "\t install -m 0755 $?  \"$(DSTROOT)\"$(COQTOPINSTALL)/\n";
-      print "\n";
-    end;
-    print "install:";
-    if not_empty cmxss then begin
-      print "$(if $(HASNATDYNLINK_OR_EMPTY),install-natdynlink)";
+  Bytes.to_string pdir
+
+let read_whole_file s =
+  let ic = open_in s in
+  let b = Buffer.create (1 lsl 12) in
+  try
+     while true do
+       let s = input_line ic in
+       Buffer.add_string b s;
+       Buffer.add_char b '\n';
+     done;
+     assert false;
+  with End_of_file ->
+    close_in ic;
+    Buffer.contents b
+
+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 =
+    let template = "/tools/CoqMakefile.in" in
+    Envars.coqlib () ^ template in
+  let s = read_whole_file makefile_template in
+  let s = List.fold_left
+    (* 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;
+      "@PROJECT_FILE@", (Option.default "" project.project_file);
+      "@COQ_MAKEFILE_INVOCATION@",String.concat " " (List.map quote args);
+    ] in
+  output_string oc s
+;;
+
+let section oc s =
+  let pad = String.make (76 - String.length s) ' ' in
+  let sharps = String.make 79 '#' in
+  let spaces = "#" ^ String.make 77 ' ' ^ "#" in
+  fprintf oc "\n%s\n" sharps;
+  fprintf oc "%s\n" spaces;
+  fprintf oc "# %s%s#\n" s pad;
+  fprintf oc "%s\n" spaces;
+  fprintf oc "%s\n\n" sharps
+;;
+
+let clean_tgts = ["clean"; "cleanall"; "archclean"]
+
+let generate_conf_extra_target oc sps =
+  let pr_path { target; dependencies; phony; command } =
+    let target = if target = "all" then "custom-all" else target in
+    if phony then fprintf oc ".PHONY: %s\n" target;
+    if not (is_genrule target) && not phony then begin
+      fprintf oc "post-all::\n\t$(MAKE) -f $(SELF) %s\n" target;
+      if not phony then
+        fprintf oc "clean::\n\trm -f %s\n" target;
     end;
-    print "\n";
-    install_include_by_root "0644" where_what_oth;
-    List.iter
-      (fun x ->
-	printf "\t+cd %s && $(MAKE) DSTROOT=\"$(DSTROOT)\" INSTALLDEFAULTROOT=\"$(INSTALLDEFAULTROOT)/%s\" install\n" x x)
-      sds;
-    print "\n";
-    let install_one_kind kind dir =
-      printf "\tinstall -d \"$(DSTROOT)\"$(COQDOCINSTALL)/%s/%s\n" dir kind;
-      printf "\tfor i in %s/*; do \\\n" kind;
-      printf "\t install -m 0644 $$i \"$(DSTROOT)\"$(COQDOCINSTALL)/%s/$$i;\\\n" dir;
-      print "\tdone\n" in
-    print "install-doc:\n";
-    if not_empty vfiles then install_one_kind "html" doc_dir;
-    if not_empty mlis then install_one_kind "mlihtml" doc_dir;
-    print "\n";
-    let uninstall_one_kind kind dir =
-      printf "\tprintf 'cd \"$${DSTROOT}\"$(COQDOCINSTALL)/%s \\\\\\n' >> \"$@\"\n" dir;
-      printf "\tprintf '&& rm -f $(shell find \"%s\" -maxdepth 1 -and -type f -print)\\n' >> \"$@\"\n" kind;
-      print "\tprintf 'cd \"$${DSTROOT}\"$(COQDOCINSTALL) && ";
-      printf "find %s/%s -maxdepth 0 -and -empty -exec rmdir -p \\{\\} \\;\\n' >> \"$@\"\n" dir kind
-    in
-    printf "uninstall_me.sh: %s\n" !makefile_name;
-    print "\techo '#!/bin/sh' > $@\n";
-    if not_empty cmxss then uninstall_by_root where_what_cmxs;
-    uninstall_by_root where_what_oth;
-    if not_empty vfiles then uninstall_one_kind "html" doc_dir;
-    if not_empty mlis then uninstall_one_kind "mlihtml" doc_dir;
-    print "\tchmod +x $@\n";
-    print "\n";
-    print "uninstall: uninstall_me.sh\n";
-    print "\tsh $<\n\n"
-
-let make_makefile sds =
-  if !make_name <> "" then begin
-    printf "%s: %s\n" !makefile_name !make_name;
-    print "\tmv -f $@ $@.bak\n";
-    print "\t\"$(COQBIN)coq_makefile\" -f $< -o $@\n\n";
-    List.iter
-      (fun x -> print "\t+cd "; print x; print " && $(MAKE) Makefile\n")
-      sds;
-    print "\n";
+    fprintf oc "%s %s %s\n\t%s\n\n"
+       target
+       (if List.mem target clean_tgts then ":: " else ": ")
+       dependencies
+       command
+  in
+    if sps <> [] then
+      section oc "Extra targets. (-extra and -extra-phony, DEPRECATED)";
+    List.iter (forget_source > pr_path) sps
+
+let generate_conf_subdirs oc sds =
+  if sds <> [] then section oc "Subdirectories. (DEPRECATED)";
+  let iter f = List.iter (forget_source > f) in
+  iter (fprintf oc ".PHONY:%s\n") sds;
+  iter (fprintf oc "post-all::\n\tcd \"%s\" && $(MAKE) all\n") sds;
+  iter (fprintf oc "clean::\n\tcd \"%s\" && $(MAKE) clean\n") sds;
+  iter (fprintf oc "archclean::\n\tcd \"%s\" && $(MAKE) archclean\n") sds;
+  iter (fprintf oc "install-extra::\n\tcd \"%s\" && $(MAKE) install\n") sds
+   
+
+let generate_conf_includes oc { ml_includes; r_includes; q_includes } =
+  section oc "Path directives (-I, -R, -Q).";
+  let module S = String in
+  let map = map_sourced_list in
+  let dash1 opt v = sprintf "-%s %s" opt (quote v) in
+  let dash2 opt v1 v2 = sprintf "-%s %s %s" opt (quote v1) (quote v2) in
+  fprintf oc "COQMF_OCAMLLIBS = %s\n"
+    (S.concat " " (map (fun { path } -> dash1 "I" path) ml_includes));
+  fprintf oc "COQMF_SRC_SUBDIRS = %s\n"
+    (S.concat " " (map (fun { path } -> quote path) ml_includes));
+  fprintf oc "COQMF_COQLIBS = %s %s %s\n"
+    (S.concat " " (map (fun { path } -> dash1 "I" path) ml_includes))
+    (S.concat " " (map (fun ({ path },l) -> dash2 "Q" path l) q_includes))
+    (S.concat " " (map (fun ({ path },l) -> dash2 "R" path l) r_includes));
+  fprintf oc "COQMF_COQLIBS_NOML = %s %s\n"
+    (S.concat " " (map (fun ({ path },l) -> dash2 "Q" path l) q_includes))
+    (S.concat " " (map (fun ({ path },l) -> dash2 "R" path l) r_includes));
+  fprintf oc "COQMF_CMDLINE_COQLIBS = %s %s %s\n"
+    (S.concat " " (map_cmdline (fun { path } -> dash1 "I" path) ml_includes))
+    (S.concat " " (map_cmdline (fun ({ path },l) -> dash2 "Q" path l) q_includes))
+    (S.concat " " (map_cmdline (fun ({ path },l) -> dash2 "R" path l) r_includes));
+;;
+
+let windrive s =
+  if Coq_config.arch_is_win32 && Str.(string_match (regexp "^[a-zA-Z]:") s 0)
+  then Str.matched_string s
+  else ""
+;;
+
+let generate_conf_coq_config oc args =
+  section oc "Coq configuration.";
+  let src_dirs = Coq_config.all_src_dirs in
+  Envars.print_config ~prefix_var_name:"COQMF_" oc src_dirs;
+  fprintf oc "COQMF_WINDRIVE=%s\n" (windrive Coq_config.coqlib)
+;;
+
+let generate_conf_files oc
+  { v_files; mli_files; ml4_files; ml_files; mllib_files; mlpack_files; }
+=
+  let module S = String in
+  let map = map_sourced_list in
+  section oc "Project files.";
+  fprintf oc "COQMF_VFILES = %s\n"      (S.concat " " (map quote v_files));
+  fprintf oc "COQMF_MLIFILES = %s\n"    (S.concat " " (map quote mli_files));
+  fprintf oc "COQMF_MLFILES = %s\n"     (S.concat " " (map quote ml_files));
+  fprintf oc "COQMF_ML4FILES = %s\n"    (S.concat " " (map quote ml4_files));
+  fprintf oc "COQMF_MLPACKFILES = %s\n" (S.concat " " (map quote mlpack_files));
+  fprintf oc "COQMF_MLLIBFILES = %s\n"  (S.concat " " (map quote mllib_files));
+  let cmdline_vfiles = filter_cmdline v_files in
+  fprintf oc "COQMF_CMDLINE_VFILES = %s\n" (S.concat " " (List.map quote cmdline_vfiles));
+;;
+
+let rec all_start_with prefix = function
+  | [] -> true
+  | [] :: _ -> false
+  | (x :: _) :: rest -> x = prefix && all_start_with prefix rest
+
+let rec logic_gcd acc = function
+  | [] -> acc
+  | [] :: _ -> acc
+  | (hd :: tl) :: rest ->
+      if all_start_with hd rest
+      then logic_gcd (acc @ [hd]) (tl :: List.map List.tl rest)
+      else acc
+
+let generate_conf_doc oc { defs; q_includes; r_includes } =
+  let includes = List.map (forget_source > snd) (q_includes @ r_includes) in
+  let logpaths = List.map (CString.split '.') includes in
+  let gcd = logic_gcd [] logpaths in
+  let root =
+    if gcd = [] then
+      if not (List.exists (fun x -> fst x.thing = "INSTALLDEFAULTROOT") defs) then begin
+         let destination = "orphan_" ^ (String.concat "_" includes) in
+         eprintf "Warning: no common logical root\n";
+         eprintf "Warning: in such case INSTALLDEFAULTROOT must be defined\n";
+         eprintf "Warning: the install-doc target is going to install files\n";
+         eprintf "Warning: in %s\n" destination;
+         destination
+      end else "$(INSTALLDEFAULTROOT)"
+    else String.concat "/" gcd in
+  Printf.fprintf oc "COQMF_INSTALLCOQDOCROOT = %s\n" (quote root)
+
+let generate_conf_defs oc { defs; extra_args } =
+  section oc "Extra variables.";
+  List.iter (forget_source > (fun (k,v) -> Printf.fprintf oc "%s = %s\n" k v)) defs;
+  Printf.fprintf oc "COQMF_OTHERFLAGS = %s\n"
+    (String.concat " " (List.map forget_source extra_args))
+
+let generate_conf oc project args  =
+  fprintf oc "# This configuration file was generated by running:\n";
+  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;
+  generate_conf_defs oc project;
+  generate_conf_doc oc project;
+  generate_conf_extra_target oc project.extra_targets;
+  generate_conf_subdirs oc project.subdirs;
+;;
+
+let ensure_root_dir
+  ({ ml_includes; r_includes; q_includes;
+     v_files; ml_files; mli_files; ml4_files;
+     mllib_files; mlpack_files } as project)
+  =
+  let exists f = List.exists (forget_source > f) in
+  let here = Sys.getcwd () in
+  let not_tops = List.for_all (fun s -> s.thing <> Filename.basename s.thing) 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)
+  then
+    project
+  else
+    let source x = {thing=x; source=CmdLine} in
+    let here_path = { path = "."; canonical_path = here } in
+    { project with
+        ml_includes = source here_path :: ml_includes;
+        r_includes = source (here_path, "Top") :: r_includes }
+;;
+
+let warn_install_at_root_directory 
+  ({ q_includes; r_includes; } as project)
+=
+  let open CList in
+  let inc_top_p =
+    map_filter
+      (fun {thing=({ path } ,ldir)} -> if ldir = "" then Some path else None)
+      (r_includes @ q_includes) in
+  let files = all_files project in
+  let bad = filter (fun f -> mem (Filename.dirname f.thing) inc_top_p) files in
+  if bad <> [] then begin
+    eprintf "Warning: No file should be installed at the root of Coq's library.\n";
+    eprintf "Warning: No logical path (-R, -Q) applies to these files:\n";
+    List.iter (fun x -> eprintf "Warning:  %s\n" x.thing) bad;
+    eprintf "\n";
   end
+;;
 
-let clean sds sps =
-  print "clean::\n";
-  if !some_mlfile || !some_mlifile || !some_ml4file
-     || !some_mllibfile || !some_mlpackfile
-  then
-    begin
-      print "\trm -f $(ALLCMOFILES) $(CMIFILES) $(CMAFILES)\n";
-      print "\trm -f $(ALLCMOFILES:.cmo=.cmx) $(CMXAFILES) $(CMXSFILES) $(ALLCMOFILES:.cmo=.o) $(CMXAFILES:.cmxa=.a)\n";
-      print "\trm -f $(addsuffix .d,$(MLFILES) $(MLIFILES) $(ML4FILES) $(MLLIBFILES) $(MLPACKFILES))\n";
-    end;
-  if !some_vfile then
-    begin
-      print "\trm -f $(OBJFILES) $(OBJFILES:.o=.native) $(NATIVEFILES)\n";
-      print "\tfind . -name .coq-native -type d -empty -delete\n";
-      print "\trm -f $(VOFILES) $(VOFILES:.vo=.vio) $(GFILES) $(VFILES:.v=.v.d) $(VFILES:=.beautified) $(VFILES:=.old)\n"
-    end;
-  print "\trm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob $(VFILES:.v=.glob) $(VFILES:.v=.tex) $(VFILES:.v=.g.tex) all-mli.tex\n";
-  print "\t- rm -rf html mlihtml uninstall_me.sh\n";
-  List.iter
-    (fun (file,_,is_phony,_) ->
-       if not (is_phony || is_genrule file) then
-	 (print "\t- rm -rf "; print file; print "\n"))
-    sps;
-  List.iter
-    (fun x -> print "\t+cd "; print x; print " && $(MAKE) clean\n")
-    sds;
-  print "\n";
-  let () =
-    if !some_vfile then
-      let () = print "cleanall:: clean\n" in
-      print "\trm -f $(patsubst %.v,.%.aux,$(VFILES))\n\n" in
-  print "archclean::\n";
-  print "\trm -f *.cmx *.o\n";
-  List.iter
-    (fun x -> print "\t+cd "; print x; print " && $(MAKE) archclean\n")
-    sds;
-  print "\n";
-  print "printenv:\n\t@\"$(COQBIN)coqtop\" -config\n";
-  print "\t@echo 'OCAMLFIND =\t$(OCAMLFIND)'\n\t@echo 'PP =\t$(PP)'\n\t@echo 'COQFLAGS =\t$(COQFLAGS)'\n";
-  print "\t@echo 'COQLIBINSTALL =\t$(COQLIBINSTALL)'\n\t@echo 'COQDOCINSTALL =\t$(COQDOCINSTALL)'\n\n"
-
-let header_includes () = ()
-
-let implicit () =
-    section "Implicit rules.";
-  let mli_rules () =
-    print "$(MLIFILES:.mli=.cmi): %.cmi: %.mli\n";
-    print "\t$(SHOW)'CAMLC -c $<'\n";
-    print "\t$(HIDE)$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
-    print "$(addsuffix .d,$(MLIFILES)): %.mli.d: %.mli\n";
-    print "\t$(SHOW)'CAMLDEP $<'\n";
-    print "\t$(HIDE)$(CAMLDEP) $(OCAMLLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n"
-  in
-  let ml4_rules () =
-    print "$(ML4FILES:.ml4=.cmo): %.cmo: %.ml4\n";
-    print "\t$(SHOW)'CAMLC -pp -c $<'\n";
-    print "\t$(HIDE)$(CAMLC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<\n\n";
-    print "$(filter-out $(addsuffix .cmx,$(foreach lib,$(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES),$($(lib)))),$(ML4FILES:.ml4=.cmx)): %.cmx: %.ml4\n";
-    print "\t$(SHOW)'CAMLOPT -pp -c $<'\n";
-    print "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<\n\n";
-    print "$(addsuffix .d,$(ML4FILES)): %.ml4.d: %.ml4\n";
-    print "\t$(SHOW)'CAMLDEP -pp $<'\n";
-    print "\t$(HIDE)$(CAMLDEP) $(OCAMLLIBS) $(PP) -impl \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
-  let ml_rules () =
-    print "$(MLFILES:.ml=.cmo): %.cmo: %.ml\n";
-    print "\t$(SHOW)'CAMLC -c $<'\n";
-    print "\t$(HIDE)$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
-    print "$(filter-out $(addsuffix .cmx,$(foreach lib,$(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES),$($(lib)))),$(MLFILES:.ml=.cmx)): %.cmx: %.ml\n";
-    print "\t$(SHOW)'CAMLOPT -c $<'\n";
-    print "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
-    print "$(addsuffix .d,$(MLFILES)): %.ml.d: %.ml\n";
-    print "\t$(SHOW)'CAMLDEP $<'\n";
-    print "\t$(HIDE)$(CAMLDEP) $(OCAMLLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
-  let cmxs_rules () = (* order is important here when there is foo.ml and foo.mllib *)
-    print "$(filter-out $(MLLIBFILES:.mllib=.cmxs),$(MLFILES:.ml=.cmxs) $(ML4FILES:.ml4=.cmxs) $(MLPACKFILES:.mlpack=.cmxs)): %.cmxs: %.cmx\n";
-    print "\t$(SHOW)'CAMLOPT -shared -o $@'\n";
-    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -shared -o $@ $<\n\n";
-    print "$(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa\n";
-    print "\t$(SHOW)'CAMLOPT -shared -o $@'\n";
-    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -linkall -shared -o $@ $<\n\n"
-  in
-  let mllib_rules () =
-    print "$(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib\n";
-    print "\t$(SHOW)'CAMLC -a -o $@'\n";
-    print "\t$(HIDE)$(CAMLLINK) $(ZDEBUG) $(ZFLAGS) -a -o $@ $^\n\n";
-    print "$(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib\n";
-    print "\t$(SHOW)'CAMLOPT -a -o $@'\n";
-    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -a -o $@ $^\n\n";
-    print "$(addsuffix .d,$(MLLIBFILES)): %.mllib.d: %.mllib\n";
-    print "\t$(SHOW)'COQDEP $<'\n";
-    print "\t$(HIDE)$(COQDEP) $(OCAMLLIBS) -c \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n"
-  in
-  let mlpack_rules () =
-    print "$(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack\n";
-    print "\t$(SHOW)'CAMLC -pack -o $@'\n";
-    print "\t$(HIDE)$(CAMLLINK) $(ZDEBUG) $(ZFLAGS) -pack -o $@ $^\n\n";
-    print "$(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack\n";
-    print "\t$(SHOW)'CAMLOPT -pack -o $@'\n";
-    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -pack -o $@ $^\n\n";
-    print "$(addsuffix .d,$(MLPACKFILES)): %.mlpack.d: %.mlpack\n";
-    print "\t$(SHOW)'COQDEP $<'\n";
-    print "\t$(HIDE)$(COQDEP) $(OCAMLLIBS) -c \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n"
+let check_overlapping_include { q_includes; r_includes } =
+  let pwd = Sys.getcwd () in
+  let aux = function
+    | [] -> ()
+    | {thing = { path; canonical_path }, _} :: l ->
+	if not (is_prefix pwd canonical_path) then
+	  eprintf "Warning: %s (used in -R or -Q) is not a subdirectory of the current directory\n\n" path;
+        List.iter (fun {thing={ path = p; canonical_path = cp }, _} ->
+	  if is_prefix canonical_path cp  || is_prefix cp canonical_path then
+	    eprintf "Warning: %s and %s overlap (used in -R or -Q)\n\n"
+              path p) l
   in
-  let v_rules () =
-    print "$(VOFILES): %.vo: %.v\n";
-    print "\t$(SHOW)COQC $<\n";
-    print "\t$(HIDE)$(COQC) $(COQDEBUG) $(COQFLAGS) $<\n\n";
-    print "$(GLOBFILES): %.glob: %.v\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) $<\n\n";
-    print "$(VFILES:.v=.vio): %.vio: %.v\n\t$(COQC) -quick $(COQDEBUG) $(COQFLAGS) $<\n\n";
-    print "$(GFILES): %.g: %.v\n\t$(GALLINA) $<\n\n";
-    print "$(VFILES:.v=.tex): %.tex: %.v\n\t$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@\n\n";
-    print "$(HTMLFILES): %.html: %.v %.glob\n\t$(COQDOC) $(COQDOCFLAGS) -html $< -o $@\n\n";
-    print "$(VFILES:.v=.g.tex): %.g.tex: %.v\n\t$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@\n\n";
-    print "$(GHTMLFILES): %.g.html: %.v %.glob\n\t$(COQDOC) $(COQDOCFLAGS)  -html -g $< -o $@\n\n";
-    print "$(addsuffix .d,$(VFILES)): %.v.d: %.v\n";
-    print "\t$(SHOW)'COQDEP $<'\n";
-    print "\t$(HIDE)$(COQDEP) $(COQLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n";
-    print "$(addsuffix .beautified,$(VFILES)): %.v.beautified:\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $*.v\n\n"
+    aux (q_includes @ r_includes)
+;;
+
+let chop_prefix p f =
+  let len_p = String.length p in
+  let len_f = String.length f in
+  String.sub f len_p (len_f - len_p)
+
+let clean_path p =
+  Str.global_replace (Str.regexp_string "//") "/" p
+
+let destination_of { ml_includes; q_includes; r_includes; } file =
+  let file_dir = CUnix.canonical_path_name (Filename.dirname file) in
+  let includes = q_includes @ r_includes in
+  let mk_destination logic canonical_path =
+    clean_path (physical_dir_of_logical_dir logic ^ "/" ^
+                chop_prefix canonical_path file_dir ^ "/") in
+  let candidates =
+    CList.map_filter (fun {thing={ canonical_path }, logic} ->
+      if is_prefix canonical_path file_dir then
+        Some(mk_destination logic canonical_path)
+      else None) includes
   in
-    if !some_mlifile then mli_rules ();
-    if !some_ml4file then ml4_rules ();
-    if !some_mlfile then ml_rules ();
-    if !some_mlfile || !some_ml4file then cmxs_rules ();
-    if !some_mllibfile then mllib_rules ();
-    if !some_mlpackfile then mlpack_rules ();
-    if !some_vfile then v_rules ()
-
-let variables is_install opt (args,defs) =
-  let var_aux (v,def) = print v; print "="; print def; print "\n" in
-    section "Variables definitions.";
-    List.iter var_aux defs;
-    print "\n";
-    if not opt then
-      print "override OPT:=-byte\n"
-    else
-      print "OPT?=\n";
-    begin
-      match args with
-	|[] -> ()
-	|h::t -> print "OTHERFLAGS=";
-	  print h;
-	  List.iter (fun s -> print " ";print s) t;
-	  print "\n";
-    end;
-    (* Coq executables and relative variables *)
-    if !some_vfile || !some_mlpackfile || !some_mllibfile then
-      print "COQDEP?=\"$(COQBIN)coqdep\" -c\n";
-    if !some_vfile then begin
-    print "COQFLAGS?=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)\n";
-    print "COQCHKFLAGS?=-silent -o\n";
-    print "COQDOCFLAGS?=-interpolate -utf8\n";
-    print "COQC?=$(TIMER) \"$(COQBIN)coqc\"\n";
-    print "GALLINA?=\"$(COQBIN)gallina\"\n";
-    print "COQDOC?=\"$(COQBIN)coqdoc\"\n";
-    print "COQCHK?=\"$(COQBIN)coqchk\"\n";
-    print "COQMKTOP?=\"$(COQBIN)coqmktop\"\n\n";
-    end;
-    (* Caml executables and relative variables *)
-    if !some_ml4file || !some_mlfile || !some_mlifile then begin
-    print "COQSRCLIBS?=" ;
-    List.iter (fun c -> print "-I \"$(COQLIB)"; print c ; print "\" \\\n") lib_dirs ;
-    List.iter (fun c -> print " \\
-  -I \"$(COQLIB)/"; print c; print "\"") Coq_config.plugins_dirs; print "\n";
-    print "ZFLAGS=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP4LIB)\n\n";
-    print "CAMLC?=$(OCAMLFIND) ocamlc -c -rectypes -thread\n";
-    print "CAMLOPTC?=$(OCAMLFIND) opt -c -rectypes -thread\n";
-    print "CAMLLINK?=$(OCAMLFIND) ocamlc -rectypes -thread\n";
-    print "CAMLOPTLINK?=$(OCAMLFIND) opt -rectypes -thread\n";
-    print "CAMLDEP?=$(OCAMLFIND) ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack\n";
-    print "CAMLLIB?=$(shell $(OCAMLFIND) printconf stdlib)\n";
-    print "GRAMMARS?=grammar.cma\n";
-    print "ifeq ($(CAMLP4),camlp5)
-CAMLP4EXTEND=pa_extend.cmo q_MLast.cmo pa_macro.cmo
-else
-CAMLP4EXTEND=
-endif\n";
-    print "PP?=-pp '$(CAMLP4O) -I $(CAMLLIB) -I $(COQLIB)/grammar compat5.cmo \\
-  $(CAMLP4EXTEND) $(GRAMMARS) $(CAMLP4OPTIONS) -impl'\n\n";
-    end;
-    match is_install with
-      | Project_file.NoInstall -> ()
-      | Project_file.UnspecInstall ->
-        section "Install Paths.";
-	print "ifdef USERINSTALL\n";
-        print "XDG_DATA_HOME?=\"$(HOME)/.local/share\"\n";
-        print "COQLIBINSTALL=$(XDG_DATA_HOME)/coq\n";
-        print "COQDOCINSTALL=$(XDG_DATA_HOME)/doc/coq\n";
-	print "else\n";
-        print "COQLIBINSTALL=\"${COQLIB}user-contrib\"\n";
-        print "COQDOCINSTALL=\"${DOCDIR}user-contrib\"\n";
-        print "COQTOPINSTALL=\"${COQLIB}toploop\"\n";
-	print "endif\n\n"
-      | Project_file.TraditionalInstall ->
-          section "Install Paths.";
-          print "COQLIBINSTALL=\"${COQLIB}user-contrib\"\n";
-          print "COQDOCINSTALL=\"${DOCDIR}user-contrib\"\n";
-          print "COQTOPINSTALL=\"${COQLIB}toploop\"\n";
-          print "\n"
-      | Project_file.UserInstall ->
-          section "Install Paths.";
-          print "XDG_DATA_HOME?=\"$(HOME)/.local/share\"\n";
-          print "COQLIBINSTALL=$(XDG_DATA_HOME)/coq\n";
-          print "COQDOCINSTALL=$(XDG_DATA_HOME)/doc/coq\n";
-          print "COQTOPINSTALL=$(XDG_DATA_HOME)/coq/toploop\n";
-          print "\n"
-
-let parameters () =
-  print ".DEFAULT_GOAL := all\n\n";
-  print "# This Makefile may take arguments passed as environment variables:\n";
-  print "# COQBIN to specify the directory where Coq binaries resides;\n";
-  print "# TIMECMD set a command to log .v compilation time;\n";
-  print "# TIMED if non empty, use the default time command as TIMECMD;\n";
-  print "# ZDEBUG/COQDEBUG to specify debug flags for ocamlc&ocamlopt/coqc;\n";
-  print "# DSTROOT to specify a prefix to install path.\n";
-  print "# VERBOSE to disable the short display of compilation rules.\n\n";
-  print "VERBOSE?=\n";
-  print "SHOW := $(if $(VERBOSE),@true \"\",@echo \"\")\n";
-  print "HIDE := $(if $(VERBOSE),,@)\n\n";
-  print "# Here is a hack to make $(eval $(shell works:\n";
-  print "define donewline\n\n\nendef\n";
-  print "includecmdwithout@ = $(eval $(subst @,$(donewline),$(shell { $(1) | tr -d '\\r' | tr '\\n' '@'; })))\n";
-  print "$(call includecmdwithout@,$(COQBIN)coqtop -config)\n\n";
-  print "TIMED?=\nTIMECMD?=\nSTDTIME?=/usr/bin/time -f \"$* (user: %U mem: %M ko)\"\n";
-  print "TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))\n\n";
-  print "vo_to_obj = $(addsuffix .o,\\\n";
-  print "  $(filter-out Warning: Error:,\\\n";
-  print "  $(shell $(COQBIN)coqtop -q -noinit -batch -quiet -print-mod-uid $(1))))\n\n"
-
-let include_dirs (inc_ml,inc_q,inc_r) =
-  let parse_ml_includes l = List.map (fun (x,_) -> "-I \"" ^ x ^ "\"") l in
-  let includes =
-    List.map (fun (p,l,_) ->
-              let l' = if l = "" then "\"\"" else l in
-              " \"" ^ p ^ "\" " ^ l' ^"") in
-  let str_ml = parse_ml_includes inc_ml in
-  section "Libraries definitions.";
-  if !some_ml4file || !some_mlfile || !some_mlifile then begin
-    print "OCAMLLIBS?="; print_list "\\\n  " str_ml; print "\n";
-  end;
-  if !some_vfile || !some_mllibfile || !some_mlpackfile then begin
-    print "COQLIBS?=";
-    print_prefix_list "\\\n  -Q" (includes inc_q);
-    print_prefix_list "\\\n  -R" (includes inc_r);
-    print_prefix_list "\\\n  " str_ml;
-    print "\n";
-  end;
-  if !some_vfile then begin
-    print "COQCHKLIBS?=";
-    print_prefix_list "\\\n  -R" (includes inc_q);
-    print_prefix_list "\\\n  -R" (includes inc_r);
-    print "\n";
-    print "COQDOCLIBS?=";
-    print_prefix_list "\\\n  -R" (includes inc_q);
-    print_prefix_list "\\\n  -R" (includes inc_r);
-    print "\n";
+  match candidates with
+  | [] ->
+     (* BACKWARD COMPATIBILITY: -I into the only logical root *)
+     begin match
+        r_includes,
+        List.find (fun {thing={ canonical_path = p }} -> is_prefix p file_dir)
+          ml_includes
+     with
+        | [{thing={ canonical_path }, logic}], {thing={ canonical_path = p }} ->
+            let destination =
+              clean_path (physical_dir_of_logical_dir logic ^ "/" ^
+                          chop_prefix p file_dir ^ "/") in
+            Printf.printf "%s" (quote destination)
+        | _ -> () (* skip *)
+        | exception Not_found -> () (* skip *)
+     end
+  | [s] -> Printf.printf "%s" (quote s)
+  | _ -> assert false
+
+let share_prefix s1 s2 =
+  let s1 = CString.split '.' s1 in
+  let s2 = CString.split '.' s2 in
+  match s1, s2 with
+  | x :: _ , y :: _ -> x = y
+  | _ -> false
+
+let _ =
+  let _fhandle = Feedback.(add_feeder (console_feedback_listener Format.err_formatter)) in
+  let prog, args =
+    let args = Array.to_list Sys.argv in
+    let prog = List.hd args in
+    prog, List.tl args in
+
+  let only_destination, args = match args with
+    | "-destination-of" :: tgt :: rest -> Some tgt, rest
+    | _ -> None, args in
+
+  let project = 
+    try cmdline_args_to_project ~curdir:Filename.current_dir_name args
+    with Parsing_error s -> prerr_endline s; usage_coq_makefile () in
+
+  if only_destination <> None then begin
+    destination_of project (Option.get only_destination);
+    exit 0
   end;
-  print "\n"
 
-let double_colon = ["clean"; "cleanall"; "archclean"]
+  if project.makefile = None then
+    eprintf "Warning: Omitting -o is deprecated\n\n";
+    (* We want to know the name of the Makefile (say m) in order to
+     * generate m.conf and include m.local *)
 
-let custom sps =
-  let pr_path (file,dependencies,is_phony,com) =
-    print file;
-    print (if List.mem file double_colon then ":: " else ": ");
-    print dependencies; print "\n";
-    if com <> "" then (print "\t"; print com; print "\n");
-    print "\n"
-  in
-    if sps <> [] then section "Custom targets.";
-    List.iter pr_path sps
+  let conf_file = Option.default "CoqMakefile" project.makefile ^ ".conf" in
+  let local_file = Option.default "CoqMakefile" project.makefile ^ ".local" in
 
-let subdirs sds =
-  let pr_subdir s =
-    print s; print ":\n\t+cd \""; print s; print "\" && $(MAKE) all\n\n"
-  in
-  if sds <> [] then
-    let () =
-      Format.eprintf "@[Warning: Targets for subdirectories are very fragile.@ " in
-    let () =
-      Format.eprintf "For example,@ nothing is done to handle dependencies@ with them.@]@." in
-      section "Subdirectories.";
-    List.iter pr_subdir sds
-
-let forpacks l =
-  let () = if l <> [] then section "Ad-hoc implicit rules for mlpack." in
-  List.iter (fun it ->
-    let h = Filename.chop_extension it in
-    let pk = String.capitalize (Filename.basename h) in
-    printf "$(addsuffix .cmx,$(filter $(basename $(MLFILES)),$(%s_MLPACK_DEPENDENCIES))): %%.cmx: %%.ml\n" h;
-    printf "\t$(SHOW)'CAMLOPT -c -for-pack %s $<'\n" pk;
-    printf "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) -for-pack %s $<\n\n" pk;
-    printf "$(addsuffix .cmx,$(filter $(basename $(ML4FILES)),$(%s_MLPACK_DEPENDENCIES))): %%.cmx: %%.ml4\n" h;
-    printf "\t$(SHOW)'CAMLOPT -c -pp -for-pack %s $<'\n" pk;
-    printf "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) -for-pack %s $(PP) -impl $<\n\n" pk
-  ) l
-
-let main_targets vfiles (mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles) other_targets inc =
-  let decl_var var = function
-    |[] -> ()
-    |l ->
-      printf "%s:=" var; print_list "\\\n  " l; print "\n\n";
-      print "ifneq ($(filter-out archclean clean cleanall printenv,$(MAKECMDGOALS)),)\n";
-      printf "-include $(addsuffix .d,$(%s))\n" var;
-      print "else\nifeq ($(MAKECMDGOALS),)\n";
-      printf "-include $(addsuffix .d,$(%s))\n" var;
-      print "endif\nendif\n\n";
-      printf ".SECONDARY: $(addsuffix .d,$(%s))\n\n" var
-  in
-  section "Files dispatching.";
-  decl_var "VFILES" vfiles;
-  begin match vfiles with
-    |[] -> ()
-    |l ->
-      print "VO=vo\n";
-      print "VOFILES:=$(VFILES:.v=.$(VO))\n";
-      classify_files_by_root "VOFILES" l inc;
-      print "GLOBFILES:=$(VFILES:.v=.glob)\n";
-      print "GFILES:=$(VFILES:.v=.g)\n";
-      print "HTMLFILES:=$(VFILES:.v=.html)\n";
-      print "GHTMLFILES:=$(VFILES:.v=.g.html)\n";
-      print "OBJFILES=$(call vo_to_obj,$(VOFILES))\n";
-      print "ALLNATIVEFILES=$(OBJFILES:.o=.cmi) $(OBJFILES:.o=.cmo) $(OBJFILES:.o=.cmx) $(OBJFILES:.o=.cmxs)\n";
-      print "NATIVEFILES=$(foreach f, $(ALLNATIVEFILES), $(wildcard $f))\n";
-      classify_files_by_root "NATIVEFILES" l inc
+  if project.extra_targets <> [] then begin
+    eprintf "Warning: -extra and -extra-phony are deprecated.\n";
+    eprintf "Warning: Write the extra targets in %s.\n\n" local_file;
   end;
-  decl_var "ML4FILES" ml4files;
-  decl_var "MLFILES" mlfiles;
-  decl_var "MLPACKFILES" mlpackfiles;
-  decl_var "MLLIBFILES" mllibfiles;
-  decl_var "MLIFILES" mlifiles;
-  let mlsfiles = match ml4files,mlfiles,mlpackfiles with
-    |[],[],[] -> []
-    |[],[],_ -> Printf.eprintf "Mlpack cannot work without ml[4]?"; []
-    |[],ml,[] ->
-      print "ALLCMOFILES:=$(MLFILES:.ml=.cmo)\n";
-      ml
-    |ml4,[],[] ->
-      print "ALLCMOFILES:=$(ML4FILES:.ml4=.cmo)\n";
-      ml4
-    |ml4,ml,[] ->
-      print "ALLCMOFILES:=$(ML4FILES:.ml4=.cmo) $(MLFILES:.ml=.cmo)\n";
-      List.rev_append ml ml4
-    |[],ml,mlpack ->
-      print "ALLCMOFILES:=$(MLFILES:.ml=.cmo) $(MLPACKFILES:.mlpack=.cmo)\n";
-      List.rev_append mlpack ml
-    |ml4,[],mlpack ->
-      print "ALLCMOFILES:=$(ML4FILES:.ml4=.cmo) $(MLPACKFILES:.mlpack=.cmo)\n";
-      List.rev_append mlpack ml4
-    |ml4,ml,mlpack ->
-      print "ALLCMOFILES:=$(ML4FILES:.ml4=.cmo) $(MLFILES:.ml=.cmo) $(MLPACKFILES:.mlpack=.cmo)\n";
-      List.rev_append mlpack (List.rev_append ml ml4) in
-  begin match mlsfiles with
-    |[] -> ()
-    |l ->
-  print "CMOFILES=$(filter-out $(addsuffix .cmo,$(foreach lib,$(MLLIBFILES:.mllib=_MLLIB_DEPENDENCIES) $(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES),$($(lib)))),$(ALLCMOFILES))\n";
-      classify_files_by_root "CMOFILES" l inc;
-      print "CMXFILES=$(CMOFILES:.cmo=.cmx)\n";
-      print "OFILES=$(CMXFILES:.cmx=.o)\n";
-  end;
-  begin match mllibfiles with
-    |[] -> ()
-    |l ->
-      print "CMAFILES:=$(MLLIBFILES:.mllib=.cma)\n";
-	classify_files_by_root "CMAFILES" l inc;
-      print "CMXAFILES:=$(CMAFILES:.cma=.cmxa)\n";
-  end;
-  begin match mlifiles,mlsfiles with
-    |[],[] -> ()
-    |l,[] ->
-       print "CMIFILES:=$(MLIFILES:.mli=.cmi)\n";
-	classify_files_by_root "CMIFILES" l inc;
-    |[],l ->
-      print "CMIFILES=$(ALLCMOFILES:.cmo=.cmi)\n";
-      classify_files_by_root "CMIFILES" l inc;
-    |l1,l2 ->
-      print "CMIFILES=$(sort $(ALLCMOFILES:.cmo=.cmi) $(MLIFILES:.mli=.cmi))\n";
-      classify_files_by_root "CMIFILES" (l1@l2) inc;
+
+  if project.subdirs <> [] then begin
+    eprintf "Warning: Subdirectories are deprecated.\n";
+    eprintf "Warning: Use double colon rules in %s.\n\n" local_file;
   end;
-  begin match mllibfiles,mlsfiles with
-    |[],[] -> ()
-    |l,[] ->
-      print "CMXSFILES:=$(CMXAFILES:.cmxa=.cmxs)\n";
-      classify_files_by_root "CMXSFILES" l inc;
-    |[],l ->
-      print "CMXSFILES=$(CMXFILES:.cmx=.cmxs)\n";
-      classify_files_by_root "CMXSFILES" l inc;
-    |l1,l2 ->
-      print "CMXSFILES=$(CMXFILES:.cmx=.cmxs) $(CMXAFILES:.cmxa=.cmxs)\n";
-      classify_files_by_root "CMXSFILES" (l1@l2) inc;
+
+  let project = ensure_root_dir project in
+  
+  if project.install_kind <> (Some CoqProject_file.NoInstall) then begin
+    warn_install_at_root_directory project;
   end;
-  print "ifeq '$(HASNATDYNLINK)' 'true'\n";
-  print "HASNATDYNLINK_OR_EMPTY := yes\n";
-  print "else\n";
-  print "HASNATDYNLINK_OR_EMPTY :=\n";
-  print "endif\n\n";
-  section "Definition of the toplevel targets.";
-  print "all: ";
-  if !some_vfile then print "$(VOFILES) ";
-  if !some_mlfile || !some_ml4file || !some_mlpackfile then print "$(CMOFILES) ";
-  if !some_mllibfile then print "$(CMAFILES) ";
-  if !some_mlfile || !some_ml4file || !some_mllibfile || !some_mlpackfile
-  then print "$(if $(HASNATDYNLINK_OR_EMPTY),$(CMXSFILES)) ";
-  print_list "\\\n  " other_targets; print "\n\n";
-  if !some_mlifile then
-    begin
-      print "mlihtml: $(MLIFILES:.mli=.cmi)\n";
-      print "\t mkdir $@ || rm -rf $@/*\n";
-      print "\t$(OCAMLFIND) ocamldoc -html -rectypes -d $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)\n\n";
-      print "all-mli.tex: $(MLIFILES:.mli=.cmi)\n";
-      print "\t$(OCAMLFIND) ocamldoc -latex -rectypes -o $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)\n\n";
-    end;
-  if !some_vfile then
-    begin
-      print "quick: $(VOFILES:.vo=.vio)\n\n";
-      print "vio2vo:\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) -schedule-vio2vo $(J) $(VOFILES:%.vo=%.vio)\n";
-      print "checkproofs:\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) -schedule-vio-checking $(J) $(VOFILES:%.vo=%.vio)\n";
-      print "gallina: $(GFILES)\n\n";
-      print "html: $(GLOBFILES) $(VFILES)\n";
-      print "\t- mkdir -p html\n";
-      print "\t$(COQDOC) -toc $(COQDOCFLAGS) -html $(COQDOCLIBS) -d html $(VFILES)\n\n";
-      print "gallinahtml: $(GLOBFILES) $(VFILES)\n";
-      print "\t- mkdir -p html\n";
-      print "\t$(COQDOC) -toc $(COQDOCFLAGS) -html -g $(COQDOCLIBS) -d html $(VFILES)\n\n";
-      print "all.ps: $(VFILES)\n";
-      print "\t$(COQDOC) -toc $(COQDOCFLAGS) -ps $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`\n\n";
-      print "all-gal.ps: $(VFILES)\n";
-      print "\t$(COQDOC) -toc $(COQDOCFLAGS) -ps -g $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`\n\n";
-      print "all.pdf: $(VFILES)\n";
-      print "\t$(COQDOC) -toc $(COQDOCFLAGS) -pdf $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`\n\n";
-      print "all-gal.pdf: $(VFILES)\n";
-      print "\t$(COQDOC) -toc $(COQDOCFLAGS) -pdf -g $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`\n\n";
-      print "validate: $(VOFILES)\n";
-      print "\t$(COQCHK) $(COQCHKFLAGS) $(COQCHKLIBS) $(notdir $(^:.vo=))\n\n";
-      print "beautify: $(VFILES:=.beautified)\n";
-      print "\tfor file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done\n";
-      print "\t@echo \'Do not do \"make clean\" until you are sure that everything went well!\'\n";
-      print "\t@echo \'If there were a problem, execute \"for file in $$(find . -name \\*.v.old -print); do mv $${file} $${file%.old}; done\" in your shell/'\n\n"
-    end
-
-let all_target (vfiles, (_,_,_,_,mlpackfiles as mlfiles), sps, sds) inc =
-  let other_targets =
-    CList.map_filter
-      (fun (n,_,is_phony,_) -> if not (is_phony || is_genrule n) then Some n else None)
-      sps @ sds in
-  main_targets vfiles mlfiles other_targets inc;
-  print ".PHONY: ";
-  print_list
-    " "
-    ("all" :: "archclean" :: "beautify" :: "byte" :: "clean" :: "cleanall"
-     :: "gallina" :: "gallinahtml" :: "html" :: "install" :: "install-doc"
-     :: "install-natdynlink" :: "install-toploop" :: "opt" :: "printenv"
-     :: "quick" :: "uninstall" :: "userinstall" :: "validate" :: "vio2vo"
-     :: (sds@(CList.map_filter
-		(fun (n,_,is_phony,_) ->
-		 if is_phony then Some n else None) sps)));
-  print "\n\n";
-  custom sps;
-  subdirs sds;
-  forpacks mlpackfiles
-
-let banner () =
-  print (Printf.sprintf
-"#############################################################################
-##  v      #                   The Coq Proof Assistant                     ##
-## <O___,, #                INRIA - CNRS - LIX - LRI - PPS                 ##
-##   \\VV/  #                                                               ##
-##    //   #  Makefile automagically generated by coq_makefile V%s ##
-#############################################################################
-
-" (Coq_config.version ^ String.make (10 - String.length Coq_config.version) ' '))
-
-let warning () =
-  print "# WARNING\n#\n";
-  print "# This Makefile has been automagically generated\n";
-  print "# Edit at your own risks !\n";
-  print "#\n# END OF WARNING\n\n"
-
-let print_list l = List.iter (fun x -> print x; print " ") l
-
-let command_line args =
-  print "#\n# This Makefile was generated by the command line :\n";
-  print "# coq_makefile ";
-  print_list args;
-  print "\n#\n\n"
-
-let ensure_root_dir (vfiles,(mlis,ml4s,mls,mllibs,mlpacks),_,_) inc =
-  let (ml_inc,i_inc,r_inc) = inc in
-  let here = Sys.getcwd () in
-  let not_tops =  List.for_all (fun s -> s <> Filename.basename s) in
-  if List.exists (fun (_,_,x) -> x = here) i_inc
-    || List.exists (fun (_,_,x) -> is_prefix x here) r_inc
-    || (not_tops vfiles && not_tops mlis && not_tops ml4s && not_tops mls
-	&& not_tops mllibs && not_tops mlpacks)
-  then
-    inc
-  else
-    ((".",here)::ml_inc,i_inc,(".","Top",here)::r_inc)
-
-let warn_install_at_root_directory (vfiles,(mlis,ml4s,mls,mllibs,mlpacks),_,_) inc =
-  let (inc_ml,inc_i,inc_r) = inc in
-  let inc_top = List.filter (fun (_,ldir,_) -> ldir = "") (inc_r@inc_i) in
-  let inc_top_p = List.map (fun (p,_,_) -> p) inc_top in
-  let files = vfiles @ mlis @ ml4s @ mls @ mllibs @ mlpacks in
-  if List.exists (fun f -> List.mem (Filename.dirname f) inc_top_p) files
-  then
-    Printf.eprintf "Warning: install target will copy files at the first level of the coq contributions installation directory; option -R or -Q %sis recommended\n"
-      (if inc_top = [] then "" else "with non trivial logical root ")
 
-let check_overlapping_include (_,inc_i,inc_r) =
-  let pwd = Sys.getcwd () in
-  let aux = function
-    | [] -> ()
-    | (pdir,_,abspdir)::l ->
-	if not (is_prefix pwd abspdir) then
-	  Printf.eprintf "Warning: in option -R/-Q, %s is not a subdirectory of the current directory\n" pdir;
-	List.iter (fun (pdir',_,abspdir') ->
-	  if is_prefix abspdir abspdir' || is_prefix abspdir' abspdir then
-	    Printf.eprintf "Warning: in options -R/-Q, %s and %s overlap\n" pdir pdir') l;
-  in aux (inc_i@inc_r)
-
-(* Generate a .merlin file that references the standard library and
- * any -I included paths.
- *)
-let merlin targets (ml_inc,_,_) =
-  print ".merlin:\n";
-  print "\t@echo 'FLG -rectypes' > .merlin\n" ;
-  List.iter (fun c ->
-      printf "\t@echo \"B $(COQLIB)%s\" >> .merlin\n" c)
-    lib_dirs ;
-  List.iter (fun (_,c) ->
-      printf "\t@echo \"B %s\" >> .merlin\n" c;
-      printf "\t@echo \"S %s\" >> .merlin\n" c)
-    ml_inc;
-  print "\n"
-
-let do_makefile args =
-  let has_file var = function
-    |[] -> var := false
-    |_::_ -> var := true in
-  let (project_file,makefile,is_install,opt),l =
-    try
-      Project_file.process_cmd_line Filename.current_dir_name
-       (None,None,Project_file.UnspecInstall,true) [] args
-    with Project_file.Parsing_error -> usage () in
-  let (v_f,(mli_f,ml4_f,ml_f,mllib_f,mlpack_f),sps,sds as targets), inc, defs =
-    Project_file.split_arguments l in
-
-  let () = match project_file with |None -> () |Some f -> make_name := f in
-  let () = match makefile with
-    |None -> ()
-    |Some f -> makefile_name := f; output_channel := open_out f in
-  has_file some_vfile v_f; has_file some_mlifile mli_f;
-  has_file some_mlfile ml_f; has_file some_ml4file ml4_f;
-  has_file some_mllibfile mllib_f; has_file some_mlpackfile mlpack_f;
-  let check_dep f =
-    if Filename.check_suffix f ".v" then some_vfile := true
-    else if (Filename.check_suffix f ".mli") then some_mlifile := true
-    else if (Filename.check_suffix f ".ml4") then some_ml4file := true
-    else if (Filename.check_suffix f ".ml") then some_mlfile := true
-    else if (Filename.check_suffix f ".mllib") then some_mllibfile := true
-    else if (Filename.check_suffix f ".mlpack") then some_mlpackfile := true
-  in
-  List.iter (fun (_,dependencies,_,_) ->
-    List.iter check_dep (Str.split (Str.regexp "[ \t]+") dependencies)) sps;
+  check_overlapping_include project;
 
-  let inc = ensure_root_dir targets inc in
-  if is_install <> Project_file.NoInstall then begin
-    warn_install_at_root_directory targets inc;
-  end;
-  check_overlapping_include inc;
-  banner ();
-  header_includes ();
-  warning ();
-  command_line args;
-  parameters ();
-  include_dirs inc;
-  variables is_install opt defs;
-  all_target targets inc;
-  section "Special targets.";
-  standard opt;
-  install targets inc is_install;
-  merlin targets inc;
-  clean sds sps;
-  make_makefile sds;
-  implicit ();
-  warning ();
-  if not (makefile = None) then close_out !output_channel;
+  Envars.set_coqlib ~fail:(fun x -> Printf.eprintf "Error: %s\n" x; exit 1);
+  
+  let ocm = Option.cata open_out stdout project.makefile in
+  generate_makefile ocm conf_file local_file (prog :: args) project;
+  close_out ocm;
+  let occ = open_out conf_file in
+  generate_conf occ project (prog :: args);
+  close_out occ;
   exit 0
 
-let _ =
-  let args =
-    if Array.length Sys.argv = 1 then usage ();
-    List.tl (Array.to_list Sys.argv)
-  in
-    do_makefile args
diff --git a/tools/coq_tex.ml b/tools/coq_tex.ml
index e17011b3..0ffa5bd7 100644
--- a/tools/coq_tex.ml
+++ b/tools/coq_tex.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* coq-tex
diff --git a/tools/coqc.ml b/tools/coqc.ml
index b12d4871..90d8e67c 100644
--- a/tools/coqc.ml
+++ b/tools/coqc.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Coq compiler : coqc *)
@@ -77,25 +79,28 @@ let parse_args () =
     | ("-v"|"--version") :: _ -> Usage.version 0
 
     | ("-where") :: _ ->
-        Envars.set_coqlib (fun x -> x);
+        Envars.set_coqlib ~fail:(fun x -> x);
         print_endline (Envars.coqlib ());
         exit 0
 
     | ("-config" | "--config") :: _ ->
-        Envars.set_coqlib (fun x -> x);
-        Usage.print_config ();
+        Envars.set_coqlib ~fail:(fun x -> x);
+        Envars.print_config stdout Coq_config.all_src_dirs;
         exit 0
+      
+    | ("-print-version" | "--print-version") :: _ ->
+        Usage.machine_readable_version 0
 
 (* Options for coqtop : a) options with 0 argument *)
 
-    | ("-notactics"|"-bt"|"-debug"|"-nolib"|"-boot"|"-time"|"-profile-ltac"
+    | ("-bt"|"-debug"|"-nolib"|"-boot"|"-time"|"-profile-ltac"
       |"-batch"|"-noinit"|"-nois"|"-noglob"|"-no-glob"
-      |"-q"|"-full"|"-profile"|"-just-parsing"|"-echo" |"-unsafe"|"-quiet"
-      |"-silent"|"-m"|"-xml"|"-v7"|"-v8"|"-beautify"|"-strict-implicit"
-      |"-dont-load-proofs"|"-load-proofs"|"-force-load-proofs"
+      |"-q"|"-profile"|"-echo" |"-quiet"
+      |"-silent"|"-m"|"-beautify"|"-strict-implicit"
       |"-impredicative-set"|"-vm"|"-native-compiler"
       |"-indices-matter"|"-quick"|"-type-in-type"
       |"-async-proofs-always-delegate"|"-async-proofs-never-reopen-branch"
+      |"-stm-debug"
       as o) :: rem ->
 	parse (cfiles,o::args) rem
 
@@ -106,7 +111,7 @@ let parse_args () =
       |"-load-ml-source"|"-require"|"-load-ml-object"
       |"-init-file"|"-dump-glob"|"-compat"|"-coqlib"|"-top"
       |"-async-proofs-j" |"-async-proofs-private-flags" |"-async-proofs" |"-w"
-      |"-o"|"-profile-ltac-cutoff" 
+      |"-o"|"-profile-ltac-cutoff"|"-mangle-names"
       as o) :: rem ->
 	begin
 	  match rem with
diff --git a/tools/coqdep.ml b/tools/coqdep.ml
index a7c32e1d..12b5cab0 100644
--- a/tools/coqdep.ml
+++ b/tools/coqdep.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Printf
@@ -320,19 +322,25 @@ let treat_coq_file chan =
         List.fold_left (fun accu v -> mark_v_done from accu v) acc strl
       | Declare sl ->
         let declare suff dir s =
-          let base = file_name s dir in
-          let opt = if !option_natdynlk then " " ^ base ^ ".cmxs" else "" in
-          (escape base, suff ^ opt)
+          let base = escape (file_name s dir) in
+          match !option_dynlink with
+          | No -> []
+          | Byte -> [base,suff]
+          | Opt -> [base,".cmxs"]
+          | Both -> [base,suff; base,".cmxs"]
+          | Variable ->
+             if suff=".cmo" then [base,"$(DYNOBJ)"]
+             else [base,"$(DYNLIB)"]
         in
         let decl acc str =
           let s = basename_noext str in
           if not (StrSet.mem s !deja_vu_ml) then
             let () = deja_vu_ml := StrSet.add s !deja_vu_ml in
             match search_mllib_known s with
-            | Some mldir -> (declare ".cma" mldir s) :: acc
+            | Some mldir -> (declare ".cma" mldir s) @ acc
             | None ->
               match search_ml_known s with
-              | Some mldir -> (declare ".cmo" mldir s) :: acc
+              | Some mldir -> (declare ".cmo" mldir s) @ acc
               | None -> acc
           else acc
         in
@@ -435,9 +443,10 @@ let usage () =
      ML Module\" commands in coq files.\n";  *)
   (* Does not work anymore: *)
   (* eprintf " -D : Prints the missing ocmal module names. No dependency computed.\n"; *)
-  eprintf "  -boot : For coq developpers, prints dependencies over coq library files (omitted by default).\n";
+  eprintf "  -boot : For coq developers, prints dependencies over coq library files (omitted by default).\n";
   eprintf "  -sort : output the given file name ordered by dependencies\n";
   eprintf "  -noglob | -no-glob : \n";
+  eprintf "  -f file : read -I, -Q, -R and filenames from _CoqProject-formatted FILE.";
   eprintf "  -I dir -as logname : add (non recursively) dir to coq load path under logical name logname\n";
   eprintf "  -I dir : add (non recursively) dir to ocaml path\n";
   eprintf "  -R dir -as logname : add and import dir recursively to coq load path under logical name logname\n"; (* deprecate? *)
@@ -449,10 +458,24 @@ 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\n";
   exit 1
 
 let split_period = Str.split (Str.regexp (Str.quote "."))
 
+let add_q_include path l = add_rec_dir_no_import add_known path (split_period l)
+
+let add_r_include path l = add_rec_dir_import add_known path (split_period l)
+
+let treat_coqproject f =
+  let open CoqProject_file in
+  let iter_sourced f = List.iter (fun {thing} -> f thing) in
+  let project = read_project_file f in
+  iter_sourced (fun { path } -> add_caml_dir path) project.ml_includes;
+  iter_sourced (fun ({ path }, l) -> add_q_include path l) project.q_includes;
+  iter_sourced (fun ({ path }, l) -> add_r_include path l) project.r_includes;
+  iter_sourced (fun f -> treat_file None f) (all_files project)
+
 let rec parse = function
   | "-c" :: ll -> option_c := true; parse ll
   | "-D" :: ll -> option_D := true; parse ll
@@ -460,10 +483,11 @@ let rec parse = function
   | "-boot" :: ll -> option_boot := true; parse ll
   | "-sort" :: ll -> option_sort := true; parse ll
   | ("-noglob" | "-no-glob") :: ll -> option_noglob := true; parse ll
+  | "-f" :: f :: ll -> treat_coqproject f; parse ll
   | "-I" :: r :: ll -> add_caml_dir r; parse ll
   | "-I" :: [] -> usage ()
-  | "-R" :: r :: ln :: ll -> add_rec_dir_import add_known r (split_period ln); parse ll
-  | "-Q" :: r :: ln :: ll -> add_rec_dir_no_import add_known r (split_period ln); parse ll
+  | "-R" :: r :: ln :: ll -> add_r_include r ln; parse ll
+  | "-Q" :: r :: ln :: ll -> add_q_include r ln; parse ll
   | "-R" :: ([] | [_]) -> usage ()
   | "-dumpgraph" :: f :: ll -> option_dump := Some (false, f); parse ll
   | "-dumpgraphbox" :: f :: ll -> option_dump := Some (true, f); parse ll
@@ -476,17 +500,22 @@ let rec parse = function
   | "-slash" :: ll ->
     Printf.eprintf "warning: option -slash has no effect and is deprecated.\n";
     parse ll
+  | "-dyndep" :: "no" :: ll -> option_dynlink := No; parse ll
+  | "-dyndep" :: "opt" :: ll -> option_dynlink := Opt; parse ll
+  | "-dyndep" :: "byte" :: ll -> option_dynlink := Byte; parse ll
+  | "-dyndep" :: "both" :: ll -> option_dynlink := Both; parse ll
+  | "-dyndep" :: "var" :: ll -> option_dynlink := Variable; parse ll
   | ("-h"|"--help"|"-help") :: _ -> usage ()
   | f :: ll -> treat_file None f; parse ll
   | [] -> ()
 
 let coqdep () =
   if Array.length Sys.argv < 2 then usage ();
+  if not Coq_config.has_natdynlink then option_dynlink := No;
   parse (List.tl (Array.to_list Sys.argv));
   (* Add current dir with empty logical path if not set by options above. *)
   (try ignore (Coqdep_common.find_dir_logpath (Sys.getcwd()))
    with Not_found -> add_norec_dir_import add_known "." []);
-  if not Coq_config.has_natdynlink then option_natdynlk := false;
   (* NOTE: These directories are searched from last to first *)
   if !option_boot then begin
     add_rec_dir_import add_known "theories" ["Coq"];
@@ -495,14 +524,14 @@ let coqdep () =
     add_rec_dir_import (fun _ -> add_caml_known) "theories" ["Coq"];
     add_rec_dir_import (fun _ -> add_caml_known) "plugins" ["Coq"];
   end else begin
-    Envars.set_coqlib ~fail:CErrors.error;
+    Envars.set_coqlib ~fail:(fun msg -> CErrors.user_err Pp.(str msg));
     let coqlib = Envars.coqlib () in
     add_rec_dir_import add_coqlib_known (coqlib//"theories") ["Coq"];
     add_rec_dir_import add_coqlib_known (coqlib//"plugins") ["Coq"];
     let user = coqlib//"user-contrib" in
     if Sys.file_exists user then add_rec_dir_no_import add_coqlib_known user [];
     List.iter (fun s -> add_rec_dir_no_import add_coqlib_known s [])
-      (Envars.xdg_dirs (fun x -> Feedback.msg_warning (Pp.str x)));
+      (Envars.xdg_dirs ~warn:(fun x -> Feedback.msg_warning (Pp.str x)));
     List.iter (fun s -> add_rec_dir_no_import add_coqlib_known s []) Envars.coqpath;
   end;
   List.iter (fun (f,d) -> add_mli_known f d ".mli") !mliAccu;
@@ -526,5 +555,5 @@ let _ =
   try
     coqdep ()
   with CErrors.UserError(s,p) ->
-    let pp = if s <> "_" then Pp.(str s ++ str ": " ++ p) else p in
-    Feedback.msg_error pp
+    let pp = (match s with | None -> p | Some s -> Pp.(str s ++ str ": " ++ p))  in
+    Format.eprintf "%a@\n%!" Pp.pp_with pp
diff --git a/tools/coqdep_boot.ml b/tools/coqdep_boot.ml
index 6fc82683..aa023e69 100644
--- a/tools/coqdep_boot.ml
+++ b/tools/coqdep_boot.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Coqdep_common
@@ -16,7 +18,11 @@ open Coqdep_common
 *)
 
 let rec parse = function
-  | "-natdynlink" :: "no" :: ll -> option_natdynlk := false; parse ll
+  | "-dyndep" :: "no" :: ll -> option_dynlink := No; parse ll
+  | "-dyndep" :: "opt" :: ll -> option_dynlink := Opt; parse ll
+  | "-dyndep" :: "byte" :: ll -> option_dynlink := Byte; parse ll
+  | "-dyndep" :: "both" :: ll -> option_dynlink := Both; parse ll
+  | "-dyndep" :: "var" :: ll -> option_dynlink := Variable; parse ll
   | "-c" :: ll -> option_c := true; parse ll
   | "-boot" :: ll -> parse ll (* We're already in boot mode by default *)
   | "-mldep" :: ocamldep :: ll ->
diff --git a/tools/coqdep_common.ml b/tools/coqdep_common.ml
index 0064aebd..db69a3b7 100644
--- a/tools/coqdep_common.ml
+++ b/tools/coqdep_common.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Printf
@@ -15,7 +17,7 @@ open Minisys
     behavior is the one of [coqdep -boot]. Its only dependencies
     are [Coqdep_lexer], [Unix] and [Minisys], and it should stay so.
     If it need someday some additional information, pass it via
-    options (see for instance [option_natdynlk] below).
+    options (see for instance [option_dynlink] below).
 *)
 
 module StrSet = Set.Make(String)
@@ -26,9 +28,11 @@ module StrListMap = Map.Make(StrList)
 let stderr = Pervasives.stderr
 let stdout = Pervasives.stdout
 
+type dynlink = Opt | Byte | Both | No | Variable
+
 let option_c = ref false
 let option_noglob = ref false
-let option_natdynlk = ref true
+let option_dynlink = ref Both
 let option_boot = ref false
 let option_mldep = ref None
 
@@ -36,6 +40,10 @@ let norec_dirs = ref StrSet.empty
 
 let suffixe = ref ".vo"
 
+[@@@ocaml.warning "-3"]       (* String.capitalize_ascii since 4.03.0 GPR#124 *)
+let capitalize = String.capitalize
+[@@@ocaml.warning "+3"]
+
 type dir = string option
 
 (** [get_extension f l] checks whether [f] has one of the extensions
@@ -94,8 +102,18 @@ let safe_hash_add cmp clq q (k, (v, b)) =
     For the ML files, the string is the basename without extension.
 *)
 
+let same_path_opt s s' =
+  let nf s = (* ./foo/a.ml and foo/a.ml are the same file *)
+    if Filename.is_implicit s
+    then "." // s
+    else s
+  in
+  let s = match s with None -> "." | Some s -> nf s in
+  let s' = match s' with None -> "." | Some s' -> nf s' in
+  s = s'
+
 let warning_ml_clash x s suff s' suff' =
-  if suff = suff' then
+  if suff = suff' && not (same_path_opt s s') then
   eprintf
     "*** Warning: %s%s already found in %s (discarding %s%s)\n" x suff
     (match s with None -> "." | Some d -> d)
@@ -219,7 +237,6 @@ let register_dir_logpath,find_dir_logpath =
 
 let file_name s = function
   | None     -> s
-  | Some "." -> s
   | Some d   -> d // s
 
 let depend_ML str =
@@ -293,15 +310,15 @@ let traite_fichier_modules md ext =
       (fun a_faire str -> match search_mlpack_known str with
 	| Some mldir ->
 	  let file = file_name str mldir in
-	  a_faire^" "^file
+          a_faire @ [file]
 	| None ->
 	  match search_ml_known str with
 	    | Some mldir ->
 	      let file = file_name str mldir in
-	      a_faire^" "^file
-	    | None -> a_faire) "" list
+              a_faire @ [file]
+            | None -> a_faire) [] list
   with
-    | Sys_error _ -> ""
+    | Sys_error _ -> []
     | Syntax_error (i,j) -> error_cannot_parse (md^ext) (i,j)
 
 (* Makefile's escaping rules are awful: $ is escaped by doubling and
@@ -380,10 +397,16 @@ let rec traite_fichier_Coq suffixe verbose f =
        		end) strl
 	  | Declare sl ->
 	      let declare suff dir s =
-		let base = file_name s dir in
-		let opt = if !option_natdynlk then " "^base^".cmxs" else "" in
-		printf " %s%s%s" (escape base) suff opt
-	      in
+		let base = escape (file_name s dir) in
+                match !option_dynlink with
+                | No -> ()
+                | Byte -> printf " %s%s" base suff
+                | Opt -> printf " %s.cmxs" base
+                | Both -> printf " %s%s %s.cmxs" base suff base
+                | Variable ->
+                   printf " %s%s" base
+                    (if suff=".cmo" then "$(DYNOBJ)" else "$(DYNLIB)")
+              in
 	      let decl str =
                 let s = basename_noext str in
 		if not (StrSet.mem s !deja_vu_ml) then begin
@@ -443,7 +466,7 @@ let mL_dependencies () =
        let fullname = file_name name dirname in
        let dep = traite_fichier_modules fullname ".mllib" in
        let efullname = escape fullname in
-       printf "%s_MLLIB_DEPENDENCIES:=%s\n" efullname dep;
+       printf "%s_MLLIB_DEPENDENCIES:=%s\n" efullname (String.concat " " dep);
        printf "%s.cma:$(addsuffix .cmo,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname;
        printf "%s.cmxa:$(addsuffix .cmx,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname;
        flush stdout)
@@ -453,9 +476,13 @@ let mL_dependencies () =
        let fullname = file_name name dirname in
        let dep = traite_fichier_modules fullname ".mlpack" in
        let efullname = escape fullname in
-       printf "%s_MLPACK_DEPENDENCIES:=%s\n" efullname dep;
+       printf "%s_MLPACK_DEPENDENCIES:=%s\n" efullname (String.concat " " dep);
        printf "%s.cmo:$(addsuffix .cmo,$(%s_MLPACK_DEPENDENCIES))\n" efullname efullname;
        printf "%s.cmx:$(addsuffix .cmx,$(%s_MLPACK_DEPENDENCIES))\n" efullname efullname;
+       let efullname_capital = capitalize (Filename.basename efullname) in
+       List.iter (fun dep ->
+         printf "%s.cmx : FOR_PACK=-for-pack %s\n" dep efullname_capital)
+         dep;
        flush stdout)
     (List.rev !mlpackAccu)
 
@@ -544,13 +571,6 @@ let add_rec_dir_no_import add_file phys_dir log_dir =
 let add_rec_dir_import add_file phys_dir log_dir =
   add_directory true (add_file true) phys_dir log_dir
 
-(** -R semantic but only on immediate capitalized subdirs *)
-
-let add_rec_uppercase_subdirs add_file phys_dir log_dir =
-  process_subdirectories (fun phys_dir f ->
-    add_directory true (add_file true) phys_dir (log_dir@[String.capitalize f]))
-    phys_dir
-
 (** -I semantic: do not go in subdirs. *)
 let add_caml_dir phys_dir =
   add_directory false add_caml_known phys_dir []
diff --git a/tools/coqdep_common.mli b/tools/coqdep_common.mli
index 633c474a..d0d79324 100644
--- a/tools/coqdep_common.mli
+++ b/tools/coqdep_common.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 module StrSet : Set.S with type elt = string
@@ -19,7 +21,10 @@ val find_dir_logpath: string -> string list
 val option_c : bool ref
 val option_noglob : bool ref
 val option_boot : bool ref
-val option_natdynlk : bool ref
+
+type dynlink = Opt | Byte | Both | No | Variable
+
+val option_dynlink : dynlink ref
 val option_mldep : string option ref
 val norec_dirs : StrSet.t ref
 val suffixe : string ref
@@ -64,8 +69,5 @@ val add_rec_dir_no_import :
 val add_rec_dir_import :
   (bool -> string -> string list -> string -> unit) -> string -> string list -> unit
 
-val add_rec_uppercase_subdirs :
-  (bool -> string -> string list -> string -> unit) -> string -> string list -> unit
-
 val treat_file : dir -> string -> unit
 val error_cannot_parse : string -> int * int -> 'a
diff --git a/tools/coqdep_lexer.mli b/tools/coqdep_lexer.mli
index bb17fdf9..0e2b332f 100644
--- a/tools/coqdep_lexer.mli
+++ b/tools/coqdep_lexer.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 type mL_token = Use_module of string
diff --git a/tools/coqdep_lexer.mll b/tools/coqdep_lexer.mll
index eb233b8f..ade5e5be 100644
--- a/tools/coqdep_lexer.mll
+++ b/tools/coqdep_lexer.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 {
@@ -25,8 +27,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)
 
@@ -39,30 +39,33 @@
 
   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"]
 }
 
 let space = [' ' '\t' '\n' '\r']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
-  ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
+let lowercase = ['a'-'z']
+let uppercase = ['A'-'Z']
+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)
@@ -70,7 +73,9 @@ let dot = '.' ( space+ | eof)
 rule coq_action = parse
   | "Require" space+
       { require_modifiers None lexbuf }
-  | "Local"? "Declare" space+ "ML" space+ "Module" space+
+  | "Local" space+ "Declare" space+ "ML" space+ "Module" space+
+      { modules [] lexbuf }
+  | "Declare" space+ "ML" space+ "Module" space+
       { modules [] lexbuf }
   | "Load" space+
       { load_file lexbuf }
@@ -97,7 +102,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 }
@@ -154,7 +159,7 @@ and caml_action = parse
   | space +
       { caml_action lexbuf }
   | "open" space* (caml_up_ident as id)
-        { Use_module (String.uncapitalize id) }
+        { Use_module (uncapitalize id) }
   | "module" space+ caml_up_ident
         { caml_action lexbuf }
   | caml_low_ident { caml_action lexbuf }
@@ -236,7 +241,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 }
   | _
@@ -248,7 +253,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) }
@@ -273,7 +278,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 }
 
@@ -283,7 +288,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 }
   | _
@@ -296,7 +301,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
@@ -321,12 +326,12 @@ and modules mllist = parse
 
 and qual_id ml_module_name = parse
   | '.' [^ '.' '(' '[']
-      { Use_module (String.uncapitalize ml_module_name) }
+      { Use_module (uncapitalize ml_module_name) }
   | eof { raise Fin_fichier }
   | _ { caml_action lexbuf }
 
 and mllib_list = parse
-  | caml_up_ident { let s = String.uncapitalize (Lexing.lexeme lexbuf)
+  | caml_up_ident { let s = uncapitalize (Lexing.lexeme lexbuf)
 		in s :: mllib_list lexbuf }
   | "*predef*" { mllib_list lexbuf }
   | space+ { mllib_list lexbuf }
diff --git a/tools/coqdoc/alpha.ml b/tools/coqdoc/alpha.ml
index f817ed5a..269c1a1d 100644
--- a/tools/coqdoc/alpha.ml
+++ b/tools/coqdoc/alpha.ml
@@ -1,14 +1,20 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Cdglobals
 
-let norm_char_latin1 c = match Char.uppercase c with
+[@@@ocaml.warning "-3"]       (* Char.uppercase_ascii since 4.03.0 GPR#124 *)
+let uppercase = Char.uppercase
+[@@@ocaml.warning "+3"]
+
+let norm_char_latin1 c = match uppercase c with
   | '\192'..'\198' -> 'A'
   | '\199' -> 'C'
   | '\200'..'\203' -> 'E'
@@ -19,19 +25,14 @@ let norm_char_latin1 c = match Char.uppercase c with
   | '\221' -> 'Y'
   | c -> c
 
-let norm_char_utf8 c = Char.uppercase c
+let norm_char_utf8 c = uppercase c
 
 let norm_char c =
   if !utf8 then norm_char_utf8 c else
   if !latin1 then norm_char_latin1 c else
-  Char.uppercase c
-
-let norm_string s =
-  let u = String.copy s in
-  for i = 0 to String.length s - 1 do
-    u.[i] <- norm_char s.[i]
-  done;
-  u
+  uppercase c
+
+let norm_string = String.map (fun s -> norm_char s)
 
 let compare_char c1 c2 = match norm_char c1, norm_char c2 with
   | ('A'..'Z' as c1), ('A'..'Z' as c2) -> compare c1 c2
diff --git a/tools/coqdoc/alpha.mli b/tools/coqdoc/alpha.mli
index f6d47a55..86303450 100644
--- a/tools/coqdoc/alpha.mli
+++ b/tools/coqdoc/alpha.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Alphabetic order. *)
diff --git a/tools/coqdoc/cdglobals.ml b/tools/coqdoc/cdglobals.ml
index 5d48473d..0d3fb775 100644
--- a/tools/coqdoc/cdglobals.ml
+++ b/tools/coqdoc/cdglobals.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 
@@ -70,23 +72,21 @@ let normalize_filename f =
   let dirname = Filename.dirname f in
   normalize_path dirname, basename
 
+(** Add a local installation suffix (unless the suffix is itself
+    absolute in which case the prefix does not matter) *)
+let use_suffix prefix suffix =
+  if String.length suffix > 0 && suffix.[0] = '/' then suffix else prefix / suffix
+
 (** A weaker analog of the function in Envars *)
 
 let guess_coqlib () =
   let file = "theories/Init/Prelude.vo" in
-  match Coq_config.coqlib with
-    | Some coqlib when Sys.file_exists (coqlib / file) -> coqlib
-    | Some _ | None ->
-      let coqbin = normalize_path (Filename.dirname Sys.executable_name) in
-      let prefix = Filename.dirname coqbin in
-      let rpath =
-        if Coq_config.local then []
-        else if Coq_config.arch_is_win32 then ["lib"]
-        else ["lib/coq"]
-      in
-      let coqlib = List.fold_left (/) prefix rpath in
-      if Sys.file_exists (coqlib / file) then coqlib
-      else prefix
+  let coqbin = normalize_path (Filename.dirname Sys.executable_name) in
+  let prefix = Filename.dirname coqbin in
+  let coqlib = use_suffix prefix Coq_config.coqlibsuffix in
+  if Sys.file_exists (coqlib / file) then coqlib else
+  if not Coq_config.local && Sys.file_exists (Coq_config.coqlib / file)
+  then Coq_config.coqlib else prefix
 
 let header_trailer = ref true
 let header_file = ref ""
diff --git a/tools/coqdoc/cdglobals.mli b/tools/coqdoc/cdglobals.mli
new file mode 100644
index 00000000..2c9b3fb8
--- /dev/null
+++ b/tools/coqdoc/cdglobals.mli
@@ -0,0 +1,49 @@
+type target_language = LaTeX | HTML | TeXmacs | Raw
+val target_language : target_language ref
+type output_t = StdOut | MultFiles | File of string
+val output_dir : string ref
+val out_to : output_t ref
+val out_channel : out_channel ref
+val ( / ) : string -> string -> string
+val coqdoc_out : string -> string
+val open_out_file : string -> unit
+val close_out_file : unit -> unit
+type glob_source_t = NoGlob | DotGlob | GlobFile of string
+val glob_source : glob_source_t ref
+val normalize_path : string -> string
+val normalize_filename : string -> string * string
+val guess_coqlib : unit -> string
+val header_trailer : bool ref
+val header_file : string ref
+val header_file_spec : bool ref
+val footer_file : string ref
+val footer_file_spec : bool ref
+val quiet : bool ref
+val light : bool ref
+val gallina : bool ref
+val short : bool ref
+val index : bool ref
+val multi_index : bool ref
+val index_name : string ref
+val toc : bool ref
+val page_title : string ref
+val title : string ref
+val externals : bool ref
+val coqlib : string ref
+val coqlib_path : string ref
+val raw_comments : bool ref
+val parse_comments : bool ref
+val plain_comments : bool ref
+val toc_depth : int option ref
+val lib_name : string ref
+val lib_subtitles : bool ref
+val interpolate : bool ref
+val inline_notmono : bool ref
+val charset : string ref
+val inputenc : string ref
+val latin1 : bool ref
+val utf8 : bool ref
+val set_latin1 : unit -> unit
+val set_utf8 : unit -> unit
+type coq_module = string
+type file = Vernac_file of string * coq_module | Latex_file of string
diff --git a/tools/coqdoc/cpretty.mli b/tools/coqdoc/cpretty.mli
index 58b19184..7732610f 100644
--- a/tools/coqdoc/cpretty.mli
+++ b/tools/coqdoc/cpretty.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 val coq_file : string -> Cdglobals.coq_module -> unit
diff --git a/tools/coqdoc/cpretty.mll b/tools/coqdoc/cpretty.mll
index 919f37b9..1be440a7 100644
--- a/tools/coqdoc/cpretty.mll
+++ b/tools/coqdoc/cpretty.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (*s Utility functions for the scanners *)
@@ -682,7 +684,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 +709,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 +854,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 +894,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/coqdoc/index.ml b/tools/coqdoc/index.ml
index 9be791a8..df493fdf 100644
--- a/tools/coqdoc/index.ml
+++ b/tools/coqdoc/index.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Printf
@@ -117,7 +119,7 @@ let find_module m =
   if Hashtbl.mem local_modules m then
     Local
   else
-    try External (Filename.concat (find_external_library m) m)
+    try External (find_external_library m ^ "/" ^ m)
     with Not_found -> Unknown
 
 
@@ -155,10 +157,14 @@ let sort_entries el =
 
 let display_letter c = if c = '*' then "other" else String.make 1 c
 
+[@@@ocaml.warning "-3"]       (* String.lowercase_ascii since 4.03.0 GPR#124 *)
+let lowercase = String.lowercase
+[@@@ocaml.warning "+3"]
+
 let type_name = function
   | Library ->
       let ln = !lib_name in
-        if ln <> "" then String.lowercase ln else "library"
+        if ln <> "" then lowercase ln else "library"
   | Module -> "module"
   | Definition -> "definition"
   | Inductive -> "inductive"
@@ -197,7 +203,7 @@ let prepare_entry s = function
       let h = try String.index_from s 0 ':' with _ -> err () in
       let i = try String.index_from s (h+1) ':' with _ -> err () in
       let sc = String.sub s (h+1) (i-h-1) in
-      let ntn = String.make (String.length s - i) ' ' in
+      let ntn = Bytes.make (String.length s - i) ' ' in
       let k = ref 0 in
       let j = ref (i+1) in
       let quoted = ref false in
@@ -205,22 +211,22 @@ let prepare_entry s = function
       while !j <= l do
 	if not !quoted then begin
 	  (match s.[!j] with
-	  | '_' -> ntn.[!k] <- ' '; incr k
-	  | 'x' -> ntn.[!k] <- '_'; incr k
+	  | '_' -> Bytes.set ntn !k ' '; incr k
+	  | 'x' -> Bytes.set ntn !k '_'; incr k
 	  | '\'' -> quoted := true
 	  | _ -> assert false)
 	end
 	else
 	  if s.[!j] = '\'' then
 	    if (!j = l || s.[!j+1] = '_') then quoted := false
-	    else (incr j; ntn.[!k] <- s.[!j]; incr k)
+	    else (incr j; Bytes.set ntn !k s.[!j]; incr k)
 	  else begin
-	    ntn.[!k] <- s.[!j];
+	    Bytes.set ntn !k s.[!j];
 	    incr k
 	  end;
 	incr j
       done;
-      let ntn = String.sub ntn 0 !k in
+      let ntn = Bytes.sub_string ntn 0 !k in
       if sc = "" then ntn else ntn ^ " (" ^ sc ^ ")"
   | _ ->
       s
diff --git a/tools/coqdoc/index.mli b/tools/coqdoc/index.mli
index e44bbd59..5cd30138 100644
--- a/tools/coqdoc/index.mli
+++ b/tools/coqdoc/index.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Cdglobals
diff --git a/tools/coqdoc/main.ml b/tools/coqdoc/main.ml
index fe438738..11ec3d39 100644
--- a/tools/coqdoc/main.ml
+++ b/tools/coqdoc/main.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Modified by Lionel Elie Mamane <lionel@mamane.lu> on 9 & 10 Mar 2004:
diff --git a/tools/coqdoc/output.ml b/tools/coqdoc/output.ml
index 82d3d62b..d2522700 100644
--- a/tools/coqdoc/output.ml
+++ b/tools/coqdoc/output.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Cdglobals
@@ -19,6 +21,10 @@ let printf s = Printf.fprintf !out_channel s
 
 let sprintf = Printf.sprintf
 
+[@@@ocaml.warning "-3"]       (* String.{capitalize,lowercase}_ascii since 4.03.0 GPR#124 *)
+let capitalize = String.capitalize
+let lowercase = String.lowercase
+[@@@ocaml.warning "+3"]
 
 (*s Coq keywords *)
 
@@ -36,7 +42,7 @@ let is_keyword =
       "Hypothesis"; "Hypotheses";
       "Resolve"; "Unfold"; "Immediate"; "Extern"; "Constructors"; "Rewrite";
       "Implicit"; "Import"; "Inductive";
-      "Infix"; "Lemma"; "Let"; "Load"; "Local"; "Ltac";
+      "Infix"; "Lemma"; "Let"; "Load"; "Local"; "Locate"; "Ltac";
       "Module"; "Module Type"; "Declare Module"; "Include";
       "Mutual"; "Parameter"; "Parameters"; "Print"; "Printing"; "All"; "Proof"; "Proof with"; "Qed";
       "Record"; "Recursive"; "Remark"; "Require"; "Save"; "Scheme"; "Assumptions"; "Axioms"; "Universes";
@@ -58,9 +64,9 @@ let is_keyword =
       (*i (* coq terms *) *)
       "forall"; "match"; "as"; "in"; "return"; "with"; "end"; "let"; "fun";
       "if"; "then"; "else"; "Prop"; "Set"; "Type"; ":="; "where"; "struct"; "wf"; "measure";
-      "fix"; "cofix";
+      "fix"; "cofix"; "is";
       (* Ltac *)
-      "before"; "after"; "constr"; "ltac"; "goal"; "context"; "beta"; "delta"; "iota"; "zeta"; "lazymatch";
+      "before"; "after"; "constr"; "ltac"; "goal"; "context"; "beta"; "delta"; "iota"; "zeta"; "lazymatch"; "type"; "of"; "rec";
       (* Notations *)
       "level"; "associativity"; "no"
        ]
@@ -70,7 +76,7 @@ let is_tactic =
     [ "intro"; "intros"; "apply"; "rewrite"; "refine"; "case"; "clear"; "injection";
       "elimtype"; "progress"; "setoid_rewrite"; "left"; "right"; "constructor"; 
       "econstructor"; "decide equality"; "abstract"; "exists"; "cbv"; "simple destruct";
-      "info"; "fourier"; "field"; "specialize"; "evar"; "solve"; "instanciate";
+      "info"; "fourier"; "field"; "specialize"; "evar"; "solve"; "instanciate"; "info_auto"; "info_eauto";
       "quote"; "eexact"; "autorewrite";
       "destruct"; "destruction"; "destruct_call"; "dependent"; "elim"; "extensionality";
       "f_equal"; "generalize"; "generalize_eqs"; "generalize_eqs_vars"; "induction"; "rename"; "move"; "omega";
@@ -689,25 +695,21 @@ module Html = struct
     printf "<span class=\"id\" title=\"keyword\">%s</span>" (translate s)
 
   let ident s loc =
-    if is_keyword s then begin
-      printf "<span class=\"id\" title=\"keyword\">%s</span>" (translate s)
-    end else begin
-      try
-        match loc with
-        | None -> raise Not_found
-        | Some loc ->
-            reference (translate s) (Index.find (get_module false) loc)
-      with Not_found ->
-	if is_tactic s then
-	  printf "<span class=\"id\" title=\"tactic\">%s</span>" (translate s)
-	else
-	  if !Cdglobals.interpolate && !in_doc (* always a var otherwise *)
-	  then
-	    try reference (translate s) (Index.find_string (get_module false) s)
-	    with _ -> Tokens.output_tagged_ident_string s
-	  else
-	    Tokens.output_tagged_ident_string s
-    end
+    try
+      match loc with
+      | None -> raise Not_found
+      | Some loc ->
+         reference (translate s) (Index.find (get_module false) loc)
+    with Not_found ->
+      if is_tactic s then
+	printf "<span class=\"id\" title=\"tactic\">%s</span>" (translate s)
+      else if is_keyword s then
+        printf "<span class=\"id\" title=\"keyword\">%s</span>" (translate s)
+      else if !Cdglobals.interpolate && !in_doc (* always a var otherwise *) then
+	try reference (translate s) (Index.find_string (get_module false) s)
+	with Not_found -> Tokens.output_tagged_ident_string s
+      else
+	Tokens.output_tagged_ident_string s
 
   let proofbox () = printf "<font size=-2>&#9744;</font>"
 
@@ -846,7 +848,7 @@ module Html = struct
 	if t = Library then
          let ln = !lib_name in
            if ln <> "" then
-	       "[" ^ String.lowercase ln ^ "]", m ^ ".html", t
+	       "[" ^ lowercase ln ^ "]", m ^ ".html", t
            else
 	       "[library]", m ^ ".html", t
 	else
@@ -864,7 +866,7 @@ module Html = struct
 
   (* Impression de la table d'index *)
   let print_index_table_item i =
-    printf "<tr>\n<td>%s Index</td>\n" (String.capitalize i.idx_name);
+    printf "<tr>\n<td>%s Index</td>\n" (capitalize i.idx_name);
     List.iter
       (fun (c,l) ->
 	 if l <> [] then
@@ -912,7 +914,7 @@ module Html = struct
     let print_table () = print_index_table all_index in
     let print_one_index i =
       if i.idx_size > 0 then begin
-	printf "<hr/>\n<h1>%s Index</h1>\n" (String.capitalize i.idx_name);
+	printf "<hr/>\n<h1>%s Index</h1>\n" (capitalize i.idx_name);
 	all_letters i
       end
     in
diff --git a/tools/coqdoc/output.mli b/tools/coqdoc/output.mli
index 853bc29a..a8a50d75 100644
--- a/tools/coqdoc/output.mli
+++ b/tools/coqdoc/output.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Cdglobals
@@ -64,7 +66,6 @@ val keyword : string -> loc -> unit
 val ident : string -> loc option -> unit
 val sublexer : char -> loc -> unit
 val sublexer_in_doc : char -> unit
-val initialize : unit -> unit
 
 val proofbox : unit -> unit
 
diff --git a/tools/coqdoc/tokens.ml b/tools/coqdoc/tokens.ml
index b6a1057a..49f7ef2f 100644
--- a/tools/coqdoc/tokens.ml
+++ b/tools/coqdoc/tokens.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Application of printing rules based on a dictionary specific to the
diff --git a/tools/coqdoc/tokens.mli b/tools/coqdoc/tokens.mli
index f07efedf..00db2ad3 100644
--- a/tools/coqdoc/tokens.mli
+++ b/tools/coqdoc/tokens.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Type of dictionaries *)
diff --git a/tools/coqmktop.ml b/tools/coqmktop.ml
deleted file mode 100644
index eaf938e8..00000000
--- a/tools/coqmktop.ml
+++ /dev/null
@@ -1,305 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** {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
-
-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 =
-  String.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'
-let is_camlp5 = Coq_config.camlp4 = "camlp5"
-
-
-(** {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 "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 = if is_camlp5 then ["gramlib.cma"] else ["camlp4lib.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 =
-  if is_camlp5 then
-    ["camlp5_top.cma"; "pa_o.cmo"; "pa_extend.cmo"]
-  else
-    [ "Camlp4Top.cmo";
-      "Camlp4Parsers/Camlp4OCamlRevisedParser.cmo";
-      "Camlp4Parsers/Camlp4OCamlParser.cmo";
-      "Camlp4Parsers/Camlp4GrammarParser.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
-    | ("-v8"|"-full" as o) :: rem ->
-	Printf.eprintf "warning: option %s deprecated\n" o; 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.error (\"Could not load plugin \"^f));\
-\n        Mltop.use_file=Topdirs.dir_use ppf;\
-\n        Mltop.add_dir=Topdirs.dir_directory;\
-\n        Mltop.ml_loop=(fun () -> Toploop.loop ppf) };;\
-\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:CErrors.error in
-  let basedir = if !Flags.boot then None else Some (Envars.coqlib ()) in
-  (* Which ocaml compiler to invoke *)
-  let prog = if !opt then "opt" else "ocamlc" in
-  (* 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 b4fc738d..f0f13874 100644
--- a/tools/coqwc.mll
+++ b/tools/coqwc.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* coqwc - counts the lines of spec, proof and comments in Coq sources
@@ -94,7 +96,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 =
@@ -239,6 +241,7 @@ let process_channel ch =
   if !skip_header then read_header lb;
   spec lb
 
+[@@@ocaml.warning "-52"]
 let process_file f =
   try
     let ch = open_in f in
@@ -251,6 +254,7 @@ let process_file f =
 	flush stdout; eprintf "coqwc: %s: Is a directory\n" f; flush stderr
     | Sys_error s ->
 	flush stdout; eprintf "coqwc: %s\n" s; flush stderr
+[@@@ocaml.warning "+52"]
 
 (*s Parsing of the command line. *)
 
diff --git a/tools/coqworkmgr.ml b/tools/coqworkmgr.ml
index d7bdf907..68aadcfc 100644
--- a/tools/coqworkmgr.ml
+++ b/tools/coqworkmgr.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CoqworkmgrApi
@@ -14,7 +16,7 @@ type party = {
           sock     : Unix.file_descr;
           cout     : out_channel;
   mutable tokens   : int;
-          priority : Flags.priority;
+          priority : priority;
 }
 
 let answer party msg =
@@ -42,10 +44,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)
@@ -72,10 +74,13 @@ let really_read_fd fd s off len =
 let raw_input_line fd =
   try
     let b = Buffer.create 80 in
-    let s = String.make 1 '\000' in
-    while s <> "\n" do
+    let s = Bytes.make 1 '\000' in
+    let endl = Bytes.of_string "\n" in
+    let endr = Bytes.of_string "\r" in
+    while Bytes.compare s endl <> 0 do
       really_read_fd fd s 0 1;
-      if s <> "\n" && s <> "\r" then Buffer.add_string b s;
+      if Bytes.compare s endl <> 0 && Bytes.compare s endr <> 0
+      then Buffer.add_bytes b s;
     done;
     Buffer.contents b
   with Unix.Unix_error _ -> raise End_of_file
@@ -145,7 +150,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 8fcca535..d48c6d0a 100644
--- a/tools/fake_ide.ml
+++ b/tools/fake_ide.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Fake_ide : Simulate a [coqide] talking to a [coqtop -ideslave] *)
@@ -12,24 +14,15 @@ let error s =
   prerr_endline ("fake_id: error: "^s);
   exit 1
 
+let pperr_endline pp = Format.eprintf "@[%a@]\n%!" Pp.pp_with pp
+
 type coqtop = {
   xml_printer : Xml_printer.t;
   xml_parser : Xml_parser.t;
 }
 
-let print_xml chan xml =
-  let rec print = function
-  | Xml_datatype.PCData s -> output_string chan s
-  | Xml_datatype.Element (_, _, children) -> List.iter print children
-  in
-  print xml
-
-let error_xml s =
-  Printf.eprintf "fake_id: error: %a\n%!" print_xml s;
-  exit 1
-
-let logger level content =
-  Printf.eprintf "%a\n%! " print_xml (Richpp.repr content)
+let print_error msg =
+  Format.eprintf "fake_id: error: @[%a@]\n%!" Pp.pp_with msg
 
 let base_eval_call ?(print=true) ?(fail=true) call coqtop =
   if print then prerr_endline (Xmlprotocol.pr_call call);
@@ -37,20 +30,15 @@ let base_eval_call ?(print=true) ?(fail=true) call coqtop =
   Xml_printer.print coqtop.xml_printer xml_query;
   let rec loop () =
     let xml = Xml_parser.parse coqtop.xml_parser in
-    match Xmlprotocol.is_message xml with
-    | Some (level, _loc, content) ->
-      logger level content;
+    if Xmlprotocol.is_feedback xml then
       loop ()
-    | None ->
-      if Xmlprotocol.is_feedback xml then
-        loop ()
-      else Xmlprotocol.to_answer call xml
+    else Xmlprotocol.to_answer call xml
   in
   let res = loop () in
   if print then prerr_endline (Xmlprotocol.pr_full_value call res);
   match res with
-  | Interface.Fail (_,_,s) when fail -> error_xml (Richpp.repr s)
-  | Interface.Fail (_,_,s) as x -> Printf.eprintf "%a\n%!" print_xml (Richpp.repr s); x
+  | Interface.Fail (_,_,s) when fail -> print_error s; exit 1
+  | Interface.Fail (_,_,s) as x      -> print_error s; x
   | x -> x
 
 let eval_call c q = ignore(base_eval_call c q)
@@ -186,7 +174,7 @@ let print_document () =
           Str.global_replace (Str.regexp "^[\n ]*") ""
       (if String.length s > 20 then String.sub s 0 17 ^ "..."
        else s) in
-  prerr_endline (Pp.string_of_ppcmds
+  pperr_endline (
     (Document.print doc
       (fun b state_id { name; text } ->
         Pp.str (Printf.sprintf "%s[%10s, %3s] %s"
@@ -199,7 +187,7 @@ let print_document () =
 module GUILogic = struct
 
   let after_add = function
-    | Interface.Fail (_,_,s) -> error_xml (Richpp.repr s)
+    | Interface.Fail (_,_,s) -> print_error s; exit 1
     | Interface.Good (id, (Util.Inl (), _)) ->
         Document.assign_tip_id doc id
     | Interface.Good (id, (Util.Inr tip, _)) ->
@@ -211,7 +199,7 @@ module GUILogic = struct
   let at id id' _ = Stateid.equal id' id
   
   let after_edit_at (id,need_unfocus) = function
-    | Interface.Fail (_,_,s) -> error_xml (Richpp.repr s)
+    | Interface.Fail (_,_,s) -> print_error s; exit 1
     | Interface.Good (Util.Inl ()) ->
         if need_unfocus then Document.unfocus doc;
         ignore(Document.cut_at doc id);
@@ -261,16 +249,14 @@ let eval_print l coq =
       let to_id, need_unfocus = get_id id in
       after_edit_at (to_id, need_unfocus) (base_eval_call (edit_at to_id) coq)
   | [ Tok(_,"QUERY"); Top []; Tok(_,phrase) ] ->
-      eval_call (query (phrase,tip_id())) coq
+      eval_call (query (0,(phrase,tip_id()))) coq
   | [ Tok(_,"QUERY"); Top [Tok(_,id)]; Tok(_,phrase) ] ->
       let to_id, _ = get_id id in
-      eval_call (query (phrase, to_id)) coq
+      eval_call (query (0,(phrase, to_id))) coq
   | [ Tok(_,"WAIT") ] ->
-      let phrase = "Stm Wait." in
-      eval_call (query (phrase,tip_id())) coq
+      eval_call (wait ()) coq
   | [ Tok(_,"JOIN") ] ->
-      let phrase = "Stm JoinDocument." in
-      eval_call (query (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"
@@ -304,17 +290,31 @@ let usage () =
      (Filename.basename Sys.argv.(0))
      (Parser.print grammar))
 
-module Coqide = Spawn.Sync(struct end)
+module Coqide = Spawn.Sync ()
 
 let main =
-  Sys.set_signal Sys.sigpipe
+  if Sys.os_type = "Unix" then Sys.set_signal Sys.sigpipe
     (Sys.Signal_handle
        (fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1));
-  let coqtop_name, coqtop_args, input_file = match Sys.argv with
-    | [| _; f |] -> "coqtop",[|"-ideslave"|], f
+  let def_args = ["--xml_format=Ppcmds"; "-ideslave"] in
+  let coqtop_name = (* from ide/ideutils.ml *)
+    let prog_name = "fake_ide" in
+    let len_prog_name = String.length prog_name in
+    let fake_ide_path = Sys.executable_name in
+    let fake_ide_path_len = String.length fake_ide_path in
+    let pos = fake_ide_path_len - len_prog_name in
+    let rex = Str.regexp_string prog_name in
+    try
+      let i = Str.search_backward rex fake_ide_path pos in
+      String.sub fake_ide_path 0 i ^ "coqtop" ^
+      String.sub fake_ide_path (i + len_prog_name)
+        (fake_ide_path_len - i - len_prog_name) 
+    with Not_found -> assert false in
+  let coqtop_args, input_file = match Sys.argv with
+    | [| _; f |] -> Array.of_list def_args, f
     | [| _; f; ct |] ->
         let ct = Str.split (Str.regexp " ") ct in
-        List.hd ct, Array.of_list ("-ideslave" :: List.tl ct), f
+        Array.of_list (def_args @ ct), f
     | _ -> usage () in
   let inc = if input_file = "-" then stdin else open_in input_file in
   let coq =
@@ -334,7 +334,7 @@ let main =
   let finish () =
     match base_eval_call (Xmlprotocol.status true) coq with
     | Interface.Good _ -> exit 0
-    | Interface.Fail (_,_,s) -> error_xml (Richpp.repr s) in
+    | Interface.Fail (_,_,s) -> print_error s; exit 1 in
   (* The main loop *)
   init ();
   while true do
diff --git a/tools/gallina-db.el b/tools/gallina-db.el
index baabebb1..9664f69f 100644
--- a/tools/gallina-db.el
+++ b/tools/gallina-db.el
@@ -163,7 +163,7 @@ for DB structure."
 
 (defun coq-sort-menu-entries (menu)
   (sort menu 
-	'(lambda (x y) (string< 
+	(lambda (x y) (string< 
 			(downcase (elt x 0)) 
 			(downcase (elt y 0))))))
 
diff --git a/tools/gallina-syntax.el b/tools/gallina-syntax.el
index c25abece..662762b0 100644
--- a/tools/gallina-syntax.el
+++ b/tools/gallina-syntax.el
@@ -390,7 +390,7 @@
     ("Corollary" "cor" "Corollary # : #.\nProof.\n#\nQed." t "Corollary")
     ("Declare Module :" "dmi" "Declare Module # : #.\n#\nEnd #." t)
     ("Declare Module <:" "dmi2" "Declare Module # <: #.\n#\nEnd #." t)
-    ("Definition goal" "defg" "Definition #:#.\n#\nSave." t);; careful
+    ("Definition goal" "defg" "Definition #:#.\n#\nQed." t);; careful
     ("Fact" "fct" "Fact # : #." t "Fact")
     ("Goal" nil "Goal #." t "Goal")
     ("Lemma" "l" "Lemma # : #.\nProof.\n#\nQed." t "Lemma")
@@ -492,7 +492,6 @@
      ("Require" nil "Require #." t "Require")
      ("Reserved Notation" nil "Reserved Notation" nil "Reserved\\s-+Notation")
      ("Reset Extraction Inline" nil "Reset Extraction Inline." t "Reset\\s-+Extraction\\s-+Inline")
-     ("Save" nil "Save." t "Save")
      ("Search" nil "Search #" nil "Search")
      ("SearchAbout" nil "SearchAbout #" nil "SearchAbout")
      ("SearchPattern" nil "SearchPattern #" nil "SearchPattern")
@@ -710,7 +709,6 @@ Used by `coq-goal-command-p'"
 
 (defvar coq-keywords-save-strict
   '("Defined"
-    "Save"
     "Qed"
     "End"
     "Admitted"
diff --git a/tools/gallina.ml b/tools/gallina.ml
index 0bf98a8f..c7ff76be 100644
--- a/tools/gallina.ml
+++ b/tools/gallina.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Gallina_lexer
diff --git a/tools/gallina_lexer.mll b/tools/gallina_lexer.mll
index 449efd57..1a594aeb 100644
--- a/tools/gallina_lexer.mll
+++ b/tools/gallina_lexer.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 {
@@ -105,7 +107,6 @@ and end_of_line = parse
   | _	  		{ print (Lexing.lexeme lexbuf) }
 
 and skip_proof = parse
-  | "Save."	{ end_of_line lexbuf }
   | "Save" space
                 { skip_until_point lexbuf }
   | "Qed."  	{ end_of_line lexbuf }
diff --git a/tools/coq-inferior.el b/tools/inferior-coq.el
index b79d97d6..453bd139 100644
--- a/tools/coq-inferior.el
+++ b/tools/inferior-coq.el
@@ -265,7 +265,7 @@ With argument, position cursor at end of buffer."
     (let ((end (point)))
       (beginning-of-line)
       (coq-send-region (point) end)))
-  (next-line 1))
+  (forward-line 1))
 
 (defun coq-send-abort ()
   "Send the command \"Abort.\" to the inferior Coq process."
diff --git a/tools/make-both-single-timing-files.py b/tools/make-both-single-timing-files.py
new file mode 100755
index 00000000..32c52c7a
--- /dev/null
+++ b/tools/make-both-single-timing-files.py
@@ -0,0 +1,12 @@
+#!/usr/bin/env python
+import sys
+from TimeFileMaker import *
+
+if __name__ == '__main__':
+    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'''
+    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
new file mode 100755
index 00000000..f730a8d6
--- /dev/null
+++ b/tools/make-both-time-files.py
@@ -0,0 +1,16 @@
+#!/usr/bin/env python
+import sys
+from TimeFileMaker import *
+
+if __name__ == '__main__':
+    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...)
+'''
+    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/make-one-time-file.py b/tools/make-one-time-file.py
new file mode 100755
index 00000000..e66136df
--- /dev/null
+++ b/tools/make-one-time-file.py
@@ -0,0 +1,21 @@
+#!/usr/bin/env python
+import sys
+from TimeFileMaker import *
+
+if __name__ == '__main__':
+    USAGE = 'Usage: %s FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0]
+    HELP_STRING = r'''Formats timing information from the output 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) < 2 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:
+        times_dict = get_times(sys.argv[1])
+        table = make_table_string(times_dict)
+        print_or_write_table(table, sys.argv[2:])
diff --git a/tools/md5sum.ml b/tools/md5sum.ml
new file mode 100644
index 00000000..2fdcacc8
--- /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/tools/ocamllibdep.mll b/tools/ocamllibdep.mll
index bf82be09..382c39d3 100644
--- a/tools/ocamllibdep.mll
+++ b/tools/ocamllibdep.mll
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
+(*         *   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)         *)
 (************************************************************************)
 
 {
@@ -11,18 +13,25 @@
 
   let syntax_error lexbuf =
     raise (Syntax_error (Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf))
+
+  [@@@ocaml.warning "-3"]       (* String.(un)capitalize_ascii since 4.03.0 GPR#124 *)
+  let uncapitalize = String.uncapitalize
+
+  let capitalize = String.capitalize
+  [@@@ocaml.warning "+3"]
 }
 
 let space = [' ' '\t' '\n' '\r']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
-  ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
+let lowercase = ['a'-'z']
+let uppercase = ['A'-'Z']
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
 let caml_up_ident = uppercase identchar*
 let caml_low_ident = lowercase identchar*
 
 rule mllib_list = parse
-  | caml_up_ident { let s = String.uncapitalize (Lexing.lexeme lexbuf)
+  | uppercase+ { let s = Lexing.lexeme lexbuf in
+                 s :: mllib_list lexbuf }
+  | caml_up_ident { let s = uncapitalize (Lexing.lexeme lexbuf)
 		in s :: mllib_list lexbuf }
   | "*predef*" { mllib_list lexbuf }
   | space+ { mllib_list lexbuf }
@@ -107,8 +116,18 @@ let error_cannot_parse s (i,j) =
   Printf.eprintf "File \"%s\", characters %i-%i: Syntax error\n" s i j;
   exit 1
 
+let same_path_opt s s' =
+  let nf s = (* ./foo/a.ml and foo/a.ml are the same file *)
+    if Filename.is_implicit s
+    then "." // s
+    else s
+  in
+  let s = match s with None -> "." | Some s -> nf s in
+  let s' = match s' with None -> "." | Some s' -> nf s' in
+  s = s'
+
 let warning_ml_clash x s suff s' suff' =
-  if suff = suff' then
+  if suff = suff' && not (same_path_opt s s') then
   eprintf
     "*** Warning: %s%s already found in %s (discarding %s%s)\n" x suff
     (match s with None -> "." | Some d -> d)
@@ -185,7 +204,7 @@ let mlpack_dependencies () =
   List.iter
     (fun (name,dirname) ->
        let fullname = file_name name dirname in
-       let modname = String.capitalize name in
+       let modname = capitalize name in
        let deps = traite_fichier_modules fullname ".mlpack" in
        let sdeps = String.concat " " deps in
        let efullname = escape fullname in
diff --git a/toplevel/classes.ml b/toplevel/classes.ml
deleted file mode 100644
index 1528cbb2..00000000
--- a/toplevel/classes.ml
+++ /dev/null
@@ -1,408 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i*)
-open Names
-open Term
-open Vars
-open Environ
-open Nametab
-open CErrors
-open Util
-open Typeclasses_errors
-open Typeclasses
-open Libnames
-open Globnames
-open Constrintern
-open Constrexpr
-open Sigma.Notations
-open Context.Rel.Declaration
-(*i*)
-
-open Decl_kinds
-open Entries
-
-let refine_instance = ref true
-
-let _ = Goptions.declare_bool_option {
-  Goptions.optsync  = true;
-  Goptions.optdepr  = false;
-  Goptions.optname  = "definition of instances by refining";
-  Goptions.optkey   = ["Refine";"Instance";"Mode"];
-  Goptions.optread  = (fun () -> !refine_instance);
-  Goptions.optwrite = (fun b -> refine_instance := b)
-}
-
-let typeclasses_db = "typeclass_instances"
-
-let set_typeclass_transparency c local b = 
-  Hints.add_hints local [typeclasses_db] 
-    (Hints.HintsTransparencyEntry ([c], b))
-    
-let _ =
-  Hook.set Typeclasses.add_instance_hint_hook
-    (fun inst path local info poly ->
-     let inst' = match inst with IsConstr c -> Hints.IsConstr (c, Univ.ContextSet.empty)
-       | IsGlobal gr -> Hints.IsGlobRef gr
-     in
-     let info =
-       let open Vernacexpr in
-       { info with hint_pattern =
-		   Option.map
-		     (Constrintern.intern_constr_pattern (Global.env()))
-		     info.hint_pattern } in
-     Flags.silently (fun () ->
-	Hints.add_hints local [typeclasses_db]
-	  (Hints.HintsResolveEntry
-	     [info, poly, false, Hints.PathHints path, inst'])) ());
-  Hook.set Typeclasses.set_typeclass_transparency_hook set_typeclass_transparency;
-  Hook.set Typeclasses.classes_transparent_state_hook
-    (fun () -> Hints.Hint_db.transparent_state (Hints.searchtable_map typeclasses_db))
-
-open Vernacexpr
-
-(** TODO: add subinstances *)
-let existing_instance glob g info =
-  let c = global g in
-  let info = Option.default Hints.empty_hint_info info in
-  let instance = Global.type_of_global_unsafe c in
-  let _, r = decompose_prod_assum instance in
-    match class_of_constr r with
-      | Some (_, ((tc,u), _)) -> add_instance (new_instance tc info glob
-  (*FIXME*) (Flags.use_polymorphic_flag ()) c)
-      | None -> user_err_loc (loc_of_reference g, "declare_instance",
-			     Pp.str "Constant does not build instances of a declared type class.")
-
-let mismatched_params env n m = mismatched_ctx_inst env Parameters n m
-let mismatched_props env n m = mismatched_ctx_inst env Properties n m
-
-(* 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
-    decl :: ctx ->
-      let t' = substl subst (get_type decl) in
-      let c', l =
-	match decl with
-	| LocalAssum _ -> interp_casted_constr_evars env evars (List.hd l) t', List.tl l
-	| LocalDef (_,b,_) -> substl subst b, l
-      in
-      let d = get_name decl, Some c', t' in
-	aux (c' :: subst, d :: instctx) l ctx
-    | [] -> subst
-  in aux (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
-    | IndRef (kn,i) ->
-	let mip = (Environ.lookup_mind kn (Global.env ())).Declarations.mind_packets in
-	  mip.(0).Declarations.mind_typename
-    | _ -> assert false
-
-open Pp
-
-let instance_hook k info global imps ?hook cst =
-  Impargs.maybe_declare_manual_implicits false cst ~enriching:false imps;
-  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 kind = IsDefinition Instance in
-  let evm = 
-    let levels = Univ.LSet.union (Universes.universes_of_constr termtype) 
-				 (Universes.universes_of_constr term) in
-    Evd.restrict_universe_context evm levels 
-  in
-  let pl, uctx = Evd.universe_context ?names:pl evm in
-  let entry = 
-    Declare.definition_entry ~types:termtype ~poly ~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;
-    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 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 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) ->
-		let t = CHole (Loc.ghost, None, Misctypes.IntroAnonymous, None) in
-		  t, avoid
-	    | None -> failwith ("new instance: under-applied typeclass"))
-	  cl
-    | Explicit -> cl, Id.Set.empty
-  in
-  let tclass = 
-    if generalize then CGeneralization (Loc.ghost, 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 c', imps' = interp_type_evars_impls ~impls env' evars 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'' = ctx' @ ctx in
-    let k, args = Typeclasses.dest_class_app (push_rel_context ctx'' env) c in
-    let cl, u = Typeclasses.typeclass_univ_instance k in
-    let _, args = 
-      List.fold_right (fun decl (args, args') ->
-        let open Context.Rel.Declaration in
-	match decl with
-	| LocalAssum _ -> (List.tl args, List.hd args :: args')
-	| LocalDef (_,b,_) -> (args, substl args' b :: args'))
-	(snd cl.cl_context) (args, [])
-    in
-      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
-	      errorlabstrm "new_instance" (Nameops.pr_id 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)
-  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 (Evarutil.nf_evar !evars) subst in
-    if abstract then
-      begin
-	let subst = List.fold_left2
-	  (fun subst' s decl -> if is_local_assum decl then s :: subst' else subst')
-	  [] 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 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
-      end
-    else (
-      let props =
-	match props with
-	| Some (true, CRecord (loc, fs)) ->
-	    if List.length fs > List.length k.cl_props then
-	      mismatched_props env' (List.map snd fs) k.cl_props;
-	    Some (Inl fs)
-	| Some (_, t) -> Some (Inr t)
-	| None -> 
-	    if Flags.is_program_mode () then Some (Inl [])
-	    else None
-      in
-      let subst =
-	match props with
-	| None -> if List.is_empty k.cl_props then Some (Inl subst) else None
-	| Some (Inr term) ->
-	    let c = interp_casted_constr_evars env' evars term cty in
-	      Some (Inr (c, subst))
-	| Some (Inl props) ->
-	    let get_id =
-	      function
-		| Ident id' -> id'
-		| Qualid (loc,id') -> (loc, snd (repr_qualid id'))
-	    in
-	    let props, rest =
-	      List.fold_left
-		(fun (props, rest) decl ->
-		  if is_local_assum decl then
-		    try
-		      let is_id (id', _) = match get_name decl, get_id id' with
-			| Name id, (_, id') -> Id.equal id id'
-			| Anonymous, _ -> false
-                      in
-		       let (loc_mid, c) =
-			 List.find is_id rest 
-		       in
-		       let rest' = 
-			 List.filter (fun v -> not (is_id v)) rest 
-		       in
-		       let (loc, mid) = get_id loc_mid in
-			 List.iter (fun (n, _, x) -> 
-				      if Name.equal n (Name mid) then
-					Option.iter (fun x -> Dumpglob.add_glob loc (ConstRef x)) x)
-			   k.cl_projs;
-			 c :: props, rest'
-		     with Not_found ->
-		       (CHole (Loc.ghost, None(* Some Evar_kinds.GoalEvar *), Misctypes.IntroAnonymous, None) :: props), rest
-		   else props, rest)
-		([], props) k.cl_props
-	    in
-              match rest with
-              | (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 term, termtype =
-	match subst with
-	| None -> let termtype = it_mkProd_or_LetIn cty ctx in
-	    None, termtype
-	| Some (Inl subst) ->
-	  let subst = List.fold_left2
-	    (fun subst' s decl -> if is_local_assum decl then s :: subst' else subst')
-	    [] subst (k.cl_props @ snd k.cl_context)
-	  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
-	    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
-	    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 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 kind = Decl_kinds.Global, poly, Decl_kinds.DefinitionBody Decl_kinds.Instance in
-	    if Flags.is_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];
-		  Typeclasses.declare_instance (Some pri) (not global) (ConstRef cst)
-	      in
-	      let obls, constr, typ =
-		match term with 
-		| Some t -> 
-		  let obls, _, constr, typ = 
-		    Obligations.eterm_obligations env id evm 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
-		ignore (Obligations.add_definition id ?term:constr
- 			?pl typ ctx ~kind:(Global,poly,Instance) ~hook obls);
-		id
-	    else
-	      (Flags.silently 
-	       (fun () ->
-                  (* spiwack: it is hard to reorder the actions to do
-                     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 kind evm 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 { run = fun evm -> Sigma (Option.get term, evm, Sigma.refl) };
-                      Proofview.Unsafe.tclNEWGOALS gls;
-                      Tactics.New.reduce_after_refine;
-                    ]
-                  in
-		  ignore (Pfedit.by init_refine)
-		else if Flags.is_auto_intros () then
-		  ignore (Pfedit.by (Tacticals.New.tclDO len Tactics.intro));
-		(match tac with Some tac -> ignore (Pfedit.by tac) | None -> ())) ();
-	       id)
-	end
-      else CErrors.error "Unsolved obligations remaining.")
-	
-let named_of_rel_context l =
-  let acc, ctx =
-    List.fold_right
-      (fun decl (subst, ctx) ->
-        let id = match get_name decl with Anonymous -> invalid_arg "named_of_rel_context" | Name id -> id in
-	let d = match decl with
-	  | LocalAssum (_,t) -> id, None, substl subst t
-	  | LocalDef (_,b,t) -> id, Some (substl subst b), substl subst t in
-	  (mkVar id :: subst, d :: ctx))
-      l ([], [])
-  in ctx
-
-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 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 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 ->
-      error "Anonymous variables not allowed in contexts."
-  in
-  let uctx = ref (Evd.universe_context_set !evars) in
-  let fn status (id, b, t) =
-    if Lib.is_modtype () && not (Lib.sections_are_opened ()) then
-      let ctx = Univ.ContextSet.to_context !uctx in
-      (* Declare the universe context once *)
-      let () = uctx := Univ.ContextSet.empty in
-      let decl = (ParameterEntry (None,poly,(t,ctx),None), IsAssumption Logical) in
-      let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id decl in
-	match class_of_constr t with
-	| Some (rels, ((tc,_), args) as _cl) ->
-	    add_instance (Typeclasses.new_instance tc Hints.empty_hint_info false (*FIXME*)
-			    poly (ConstRef cst));
-            status
-	    (* declare_subclasses (ConstRef cst) cl *)
-	| None -> status
-    else
-      let test (x, _) = match x with
-      | ExplByPos (_, Some id') -> Id.equal id id'
-      | _ -> false
-      in
-      let impl = List.exists test impls in
-      let decl = (Discharge, poly, Definitional) in
-      let nstatus =
-        pi3 (Command.declare_assumption false decl (t, !uctx) [] [] impl
-          Vernacexpr.NoInline (Loc.ghost, id))
-      in
-      let () = uctx := Univ.ContextSet.empty in
-	status && nstatus
-  in List.fold_left fn true (List.rev ctx)
diff --git a/toplevel/command.ml b/toplevel/command.ml
deleted file mode 100644
index a9f2598e..00000000
--- a/toplevel/command.ml
+++ /dev/null
@@ -1,1355 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open 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 Sigma.Notations
-open Context.Rel.Declaration
-open Entries
-
-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 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 = function
-  | CProdN (loc,bl,c) -> CProdN (loc,bl,complete_conclusion a cs c)
-  | CLetIn (loc,b,t,c) -> CLetIn (loc,b,t,complete_conclusion a cs c)
-  | CHole (loc, k, _, _) ->
-      let (has_no_args,name,params) = a in
-      if not has_no_args then
-	user_err_loc (loc,"",
-	  strbrk"Cannot infer the non constant arguments of the conclusion of "
-	  ++ pr_id cs ++ str ".");
-      let args = List.map (fun id -> CRef(Ident(loc,id),None)) params in
-      CAppExpl (loc,(None,Ident(loc,name),None),List.rev args)
-  | 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 sigma = Sigma.Unsafe.of_evar_map sigma in
-        let Sigma (c, _, _) = redfun.e_redfun env sigma c in
-        c
-      in
-      { ce with const_entry_body = Future.chain ~greedy:true ~pure:true proof_out
-        (fun ((body,ctx),eff) -> (under_binders env sigma redfun n body,ctx),eff) }
-
-let warn_implicits_in_term =
-  CWarnings.create ~name:"implicits-in-term" ~category:"implicits"
-         (fun () ->
-          strbrk "Implicit arguments declaration relies on type." ++ spc () ++
-            strbrk "The term declares more implicits than the type here.")
-        
-let interp_definition pl bl p red_option c ctypopt =
-  let env = Global.env() in
-  let ctx = Evd.make_evar_universe_context env pl in
-  let evdref = ref (Evd.from_ctx ctx) in
-  let impls, ((env_bl, ctx), imps1) = interp_context_evars env evdref bl in
-  let nb_args = List.length 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 nf,subst = Evarutil.e_nf_evars_and_universes evdref in
-        let body = nf (it_mkLambda_or_LetIn c ctx) in
-	let vars = Universes.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 nf, subst = Evarutil.e_nf_evars_and_universes evdref in
-	let body = nf (it_mkLambda_or_LetIn c ctx) in
-	let typ = nf (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 (Universes.universes_of_constr body) 
-          (Universes.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,evd);
-  ce
-
-let warn_local_declaration =
-  CWarnings.create ~name:"local-declaration" ~category:"scope"
-         (fun (id,kind) ->
-          pr_id id ++ strbrk " is declared as a local " ++ str kind)
-
-let get_locality id ~kind = function
-| Discharge ->
-  (** If a Let is defined outside a section, then we consider it as a local definition *)
-   warn_local_declaration (id,kind);
-  true
-| Local -> true
-| Global -> false
-
-let declare_global_definition ident ce local k pl imps =
-  let local = get_locality ident ~kind:"definition" local in
-  let kn = declare_constant ident ~local (DefinitionEntry ce, IsDefinition k) in
-  let gr = ConstRef kn in
-  let () = maybe_declare_manual_implicits false gr imps in
-  let () = Universes.register_universe_binders gr pl in
-  let () = definition_message ident in
-  gr
-
-let declare_definition_hook = ref ignore
-let set_declare_definition_hook = (:=) declare_definition_hook
-let get_declare_definition_hook () = !declare_definition_hook
-
-let warn_definition_not_visible =
-  CWarnings.create ~name:"definition-not-visible" ~category:"implicits"
-         (fun ident ->
-          strbrk "Section definition " ++
-            pr_id ident ++ strbrk " is not visible from current goals")
-
-let declare_definition ident (local, p, k) ce pl imps hook =
-  let fix_exn = Future.fix_exn_of ce.const_entry_body in
-  let () = !declare_definition_hook ce in
-  let r = match local with
-  | Discharge when Lib.sections_are_opened () ->
-    let c = SectionLocalDef ce in
-    let _ = declare_variable ident (Lib.cwd(), c, IsDefinition k) in
-    let () = definition_message ident in
-    let gr = VarRef ident in
-    let () = maybe_declare_manual_implicits false gr imps in
-    let () = if Pfedit.refining () then
-	       warn_definition_not_visible ident
-    in
-    gr
-  | Discharge | Local | Global ->
-    declare_global_definition ident ce local k pl imps in
-  Lemmas.call_hook fix_exn hook local r
-
-let _ = Obligations.declare_definition_ref :=
-       (fun i k c imps hook -> declare_definition i k c [] imps hook)
-
-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 -> Retyping.get_type_of env evd 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(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 is_verbose () && Pfedit.refining () 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 = 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 = prod_constr_expr c bl in
-  interp_type_evars_impls env evdref ~impls c
-
-let declare_assumptions idl is_coe k (c,ctx) pl imps impl_is_on nl =
-  let refs, status, _ =
-    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_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,!evdref) in
-  (* The universe constraints come from the whole telescope. *)
-  let evd = Evd.nf_constraints evd in
-  let ctx = Evd.universe_context_set evd in
-  let l = List.map (on_pi2 (nf_evar evd)) l in
-  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 = nf ty in
-  let vars = Universes.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 (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 (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 list * structured_one_inductive_expr list
-
-let minductive_message warn = function
-  | []  -> error "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 arity in
-  (is_ml_type,indname,assums)
-
-let prepare_param = function
-  | LocalAssum (na,t) -> out_name na, LocalAssumEntry t
-  | LocalDef (na,b,_) -> out_name 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 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 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 imps = Implicit_quantifiers.implicits_of_glob_constr ~with_products:true c in
-  let t, impls = understand_tcc_evars env evdref ~expected_type:IsType c, imps in
-  let pseudo_poly = check_anonymous_type c in
-  let () = if not (Reduction.is_arity env t) then
-    user_err_loc (constr_loc ind.ind_arity, "", str "Not an arity")
-  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) 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 
-			    (nf_evar evd (Retyping.get_type_of env evd (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 (loc, "", msg)
-
-
-let check_param = function
-| LocalRawDef (na, _) -> check_named na
-| LocalRawAssum (nas, Default _, _) -> List.iter check_named nas
-| LocalRawAssum (nas, Generalized _, _) -> ()
-| LocalPattern _ -> assert false
-
-let interp_mutual_inductive (paramsl,indl) notations poly prv finite =
-  check_all_names_different indl;
-  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 _, ((env_params, ctx_params), userimpls) =
-    interp_context_evars env0 evdref paramsl
-  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 (fun decl -> out_name (get_name decl)) assums in
-
-  (* Interpret the arities *)
-  let arities = List.map (interp_ind_arity env_params evdref) indl in
-
-  let fullarities = List.map (fun (c, _, _) -> it_mkProd_or_LetIn c ctx_params) arities in
-  let env_ar = push_types env0 indnames fullarities in
-  let env_ar_params = push_rel_context ctx_params env_ar in
-
-  (* Compute interpretation metadatas *)
-  let 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 (Inductive params) 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 impls) 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,!evdref) 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 (check_evars env_params Evd.empty evd) arities;
-  Context.Rel.iter (check_evars env0 Evd.empty evd) ctx_params;
-  List.iter (fun (_,ctyps,_) ->
-    List.iter (check_evars env_ar_params Evd.empty evd) 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
-  (* Build the mutual inductive entry *)
-  { mind_entry_params = List.map prepare_param ctx_params;
-    mind_entry_record = None;
-    mind_entry_finite = finite;
-    mind_entry_inds = entries;
-    mind_entry_polymorphic = poly;
-    mind_entry_private = if prv then Some false else None;
-    mind_entry_universes = uctx;
-  },
-    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 error
-	"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) (CSort (Loc.ghost,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) ->
-        Termops.dependent (mkRel lift) 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
-        error "Records declared with the keywords Record or Structure cannot be recursive. You can, however, define recursive records using the Inductive or CoInductive command."
-      else
-        error ("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 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 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) 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 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 id' 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 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:(List.length before) 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 =
-  interp_type_evars_impls ~impls env evdref fix.fix_type
-
-let interp_fix_body env_rec evdref impls (_,ctx) fix ccl =
-  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 = it_mkProd_or_LetIn ccl ctx
-
-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
-  declare_definition f kind ce pl imps (Lemmas.mk_hook (fun _ r -> r))
-
-let _ = Obligations.declare_fix_ref :=
-  (fun ?opaque k ctx f d t imps -> declare_fix ?opaque k [] ctx f d t imps)
-
-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 (ids,_,na) =
-  match na 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 (List.length ids - 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.gen_reference "Command" dir s
-let init_constant dir s () = Coqlib.gen_constant "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 name typ prop =
-  mkApp (Universes.constr_of_global (delayed_force build_sigma).typ,
-	 [| typ; mkLambda (name, typ, prop) |])
-let sigT = Lazy.from_fun build_sigma_type
-
-let make_qref s = Qualid (Loc.ghost, qualid_of_string s)
-let lt_ref = make_qref "Init.Peano.lt"
-
-let rec telescope = function
-  | [] -> 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 = get_type decl in
-            let pred = mkLambda (get_name decl, t, ty) in
-	    let ty = Universes.constr_of_global (Lazy.force sigT).typ in
-	    let intro = Universes.constr_of_global (Lazy.force sigT).intro in
-	    let sigty = mkApp (ty, [|t; pred|]) in
-	    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 = get_type decl in
-	  let p1 = Universes.constr_of_global (Lazy.force sigT).proj1 in
-	  let p2 = Universes.constr_of_global (Lazy.force sigT).proj2 in
-	  let proj1 = applistc p1 [t; pred; prev] in
-	  let proj2 = applistc 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 tl in
-      ty, (LocalDef (n, b, t) :: subst), lift 1 term
-
-let nf_evar_context sigma ctx =
-  List.map (map_constr (Evarutil.nf_evar sigma)) ctx
-
-let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation =
-  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 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,
-		    "Command.build_wellfounded",
-		    Printer.pr_constr_env env !evdref rel ++ str " is not an homogeneous binary relation.")
-    in
-      try
-	let ctx, ar = Reductionops.splay_prod_n env !evdref 2 relty in
-	  match ctx, kind_of_term ar with
-	  | [LocalAssum (_,t); LocalAssum (_,u)], Sort (Prop Null)
-	      when Reductionops.is_conv env !evdref t u -> t
-	  | _, _ -> error ()
-      with e when CErrors.noncritical e -> error ()
-  in
-  let measure = interp_casted_constr_evars binders_env evdref measure relargty in
-  let wf_rel, wf_rel_fun, measure_fn =
-    let measure_body, measure =
-      it_mkLambda_or_LetIn measure letbinders,
-      it_mkLambda_or_LetIn measure binders
-    in
-    let comb = Universes.constr_of_global (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 wf_rel, wf_rel_fun, measure
-  in
-  let wf_proof = mkApp (delayed_force well_founded, [| argtyp ; wf_rel |]) in
-  let argid' = Id.of_string (Id.to_string argname ^ "'") in
-  let wfarg len = LocalAssum (Name argid',
-                              mkSubset (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 = (*FIXME*)Universes.constr_of_global (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 = (*FIXME*)Universes.constr_of_global (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 = Termops.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 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 (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 (Universes.constr_of_global (delayed_force fix_sub_ref),
-	  [| argtyp ; wf_rel ;
-	     Evarutil.e_new_evar env evdref
-	       ~src:(Loc.ghost, Evar_kinds.QuestionMark (Evar_kinds.Define false)) 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 (Universes.constr_of_global gr, [|make|])) binders_rel in
-	let ty = it_mkProd_or_LetIn top_arity binders_rel in
-	let pl, univs = Evd.universe_context ?names:pl !evdref in
-	  (*FIXME poly? *)
-	let ce = definition_entry ~poly ~types:ty ~univs (Evarutil.nf_evar !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 = Evarutil.nf_evar !evdref def in
-  let fullctyp = Evarutil.nf_evar !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 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
-	     error "(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 (nf_evar !evdref) fixtypes in
-  let fiximps = List.map3
-    (fun ctximps cclimps (_,ctx) -> ctximps@(Impargs.lift_implicits (List.length 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 (delayed_force fix_proto, [|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 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 (Option.map nf) fixdefs in
-  let fixtypes = List.map nf fixtypes in
-  let fixctxnames = List.map (fun (_,ctx) -> List.map get_name ctx) fixctxs in
-
-  (* Build the fix declaration block *)
-  (env,rec_sign,all_universes,evd), (fixnames,fixdefs,fixtypes), List.combine3 fixctxnames fiximps fixannots
-
-let check_recursive isfix env evd (fixnames,fixdefs,_) =
-  check_evars_are_solved env evd (Evd.empty,evd);
-  if List.for_all Option.has_some fixdefs then begin
-    let fixdefs = List.map Option.get fixdefs in
-    check_mutuality env 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 (len,imps,_) -> ((id,pl),(t,(len,imps))))
-		fixnames fixtypes fiximps in
-    let init_tac =
-      Some (List.map (Option.cata Tacmach.refine_no_check Tacticals.tclIDTAC)
-        fixdefs) in
-    let init_tac =
-      Option.map (List.map Proofview.V82.tactic) init_tac
-    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 Loc.ghost env indexes fixdecls in
-    let fiximps = List.map (fun (n,r,p) -> r) fiximps in
-    let vars = Universes.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 (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 (len,imps,_) -> ((id,pl),(t,(len,imps))))
-		fixnames fixtypes fiximps in
-    let init_tac =
-      Some (List.map (Option.cata Tacmach.refine_no_check Tacticals.tclIDTAC)
-        fixdefs) in
-    let init_tac =
-      Option.map (List.map Proofview.V82.tactic) init_tac
-    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 = Universes.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 (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
-  | _ -> error 
-      "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 -> error "Program Fixpoint needs defined bodies."
-
-let collect_evars_of_term evd c ty =
-  let evars = Evar.Set.union (Evd.evars_of_term c) (Evd.evars_of_term ty) in
-  Evar.Set.fold (fun ev acc -> Evd.add acc ev (Evd.find_undefined evd ev))
-  evars (Evd.from_ctx (Evd.evar_universe_context evd))
-
-let do_program_recursive local p fixkind fixl ntns =
-  let isfix = fixkind != Obligations.IsCoFixpoint in
-  let (env, rec_sign, pl, evd), fix, info = 
-    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 =
-      nf_evar evd (Termops.it_mkNamedLambda_or_LetIn def rec_sign)
-    and typ =
-      nf_evar evd (Termops.it_mkNamedProd_or_LetIn typ rec_sign)
-    in
-    let evm = collect_evars_of_term evd def typ in
-    let evars, _, def, typ = 
-      Obligations.eterm_obligations env id 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
-          Loc.ghost (Global.env ()) possible_indexes fixdecls in
-      List.iteri (fun i _ ->
-          Inductive.check_fix env
-                              ((indexes,i),fixdecls))
-        fixl
-  end in
-  let ctx = Evd.evar_universe_context evd in
-  let kind = match fixkind with
-  | 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 ->
-	      errorlabstrm "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 (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
-
-    | _, _ ->
-	errorlabstrm "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/toplevel/command.mli b/toplevel/command.mli
deleted file mode 100644
index 616afb91..00000000
--- a/toplevel/command.mli
+++ /dev/null
@@ -1,176 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Term
-open Entries
-open Libnames
-open Globnames
-open Vernacexpr
-open Constrexpr
-open Decl_kinds
-open Redexpr
-open Pfedit
-
-(** 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 Hooks for Pcoq} *)
-
-val set_declare_definition_hook : (Safe_typing.private_constants definition_entry -> unit) -> unit
-val get_declare_definition_hook : unit -> (Safe_typing.private_constants definition_entry -> unit)
-
-(** {6 Definitions/Let} *)
-
-val interp_definition :
-  lident list option -> local_binder 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 declare_definition : Id.t -> definition_kind ->
-  Safe_typing.private_constants definition_entry -> Universes.universe_binders -> Impargs.manual_implicits ->
-    Globnames.global_reference Lemmas.declaration_hook -> Globnames.global_reference
-
-val do_definition : Id.t -> definition_kind -> lident list option ->
-  local_binder 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 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 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 -> 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 -> 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 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 * 
-    (Name.t list * 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 * 
-    (Name.t list * 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 * 
-  (Name.t list * Impargs.manual_implicits * int option) list ->
-  lemma_possible_guards -> decl_notation list -> unit
-
-val declare_cofixpoint : locality -> polymorphic -> 
-  recursive_preentry * lident list option * Evd.evar_universe_context * 
-  (Name.t list * 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 -> bool -> (Id.t * types) list -> unit
-
-val declare_fix : ?opaque:bool -> definition_kind -> Universes.universe_binders -> Univ.universe_context -> Id.t ->
-  Safe_typing.private_constants Entries.proof_output -> types -> Impargs.manual_implicits -> global_reference
diff --git a/toplevel/coqargs.ml b/toplevel/coqargs.ml
new file mode 100644
index 00000000..eacd1dcf
--- /dev/null
+++ b/toplevel/coqargs.ml
@@ -0,0 +1,584 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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_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.Current -> add_vo_require opts "Coq.Compat.Coq88" None (Some false)
+
+let set_batch_mode opts =
+  Flags.quiet := true;
+  System.trust_file_cache := true;
+  { 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 get_identifier opt s =
+  try Names.Id.of_string s
+  with CErrors.UserError _ ->
+    prerr_endline ("Error: valid identifier expected after option "^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 ())
+
+    |"-mangle-names" ->
+      Namegen.set_mangle_names_mode (get_identifier opt (next ())); oval
+
+    |"-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 00000000..de9b6a68
--- /dev/null
+++ b/toplevel/coqargs.mli
@@ -0,0 +1,65 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 acbf909c..96a0bd5e 100644
--- a/toplevel/coqinit.ml
+++ b/toplevel/coqinit.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -20,21 +22,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() =
-  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 !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 ~echo: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 +39,8 @@ let load_rcfile() =
 	    Envars.home ~warn / "."^rcdefaultname^"."^Coq_config.version;
 	    Envars.home ~warn / "."^rcdefaultname
 	  ] in
-          Vernac.load_vernac false inferedrc
-	with Not_found -> ()
+          Vernac.load_vernac ~time ~echo:false ~interactive:false ~check:true ~state inferedrc
+        with Not_found -> state
 	(*
 	Flags.if_verbose
 	  mSGNL (str ("No coqrc or coqrc."^Coq_config.version^
@@ -54,89 +50,79 @@ let load_rcfile() =
       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.")
 
 (* 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 ());
-    List.iter add_subdir
-      [ [ "config" ]; [ "dev" ]; [ "lib" ]; [ "kernel" ]; [ "library" ];
-	[ "engine" ]; [ "pretyping" ]; [ "interp" ]; [ "parsing" ]; [ "proofs" ];
-	[ "tactics" ]; [ "toplevel" ]; [ "printing" ]; [ "intf" ];
-        [ "grammar" ]; [ "ide" ]; [ "ltac" ]; ]
-
-let get_compat_version = function
-  | "8.6" -> Flags.Current
-  | "8.5" -> Flags.V8_5
-  | "8.4" -> Flags.V8_4
-  | "8.3" -> Flags.V8_3
-  | "8.2" -> Flags.V8_2
-  | ("8.1" | "8.0") as s ->
-    CErrors.errorlabstrm "get_compat_version"
-      (str "Compatibility with version " ++ str s ++ str " not supported.")
-  | s -> CErrors.errorlabstrm "get_compat_version"
-      (str "Unknown compatibility version \"" ++ str s ++ str "\".")
+    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 4ff87628..71b5523c 100644
--- a/toplevel/coqinit.mli
+++ b/toplevel/coqinit.mli
@@ -1,28 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Initialization. *)
 
 val set_debug : unit -> unit
 
-val set_rcfile : string -> unit
-
-val no_load_rc : unit -> unit
-val load_rcfile : unit -> unit
-
-val push_include : string -> Names.DirPath.t -> bool -> unit
-(** [push_include phys_path log_path implicit] *)
-
-val push_ml_include : string -> unit
-
-val init_load_path : unit -> unit
-val init_library_roots : unit -> unit
+val load_rcfile : rcfile:(string option) -> time:bool -> state:Vernac.State.t -> Vernac.State.t
 
 val init_ocaml_path : unit -> unit
 
-val get_compat_version : string -> Flags.compat_version
+(* LoadPath for toploop toplevels *)
+val toplevel_init_load_path : unit ->  Mltop.coq_path list
+
+(* 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 e9771cfa..3239d360 100644
--- a/toplevel/coqloop.ml
+++ b/toplevel/coqloop.ml
@@ -1,36 +1,36 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
-open CErrors
-open Util
-open Flags
-open Vernac
-open Pcoq
 
-let top_stderr x = msg_with ~pp_tag:Ppstyle.pp_tag !Pp_control.err_ft x
+let print_emacs = ref false
+
+let top_stderr x =
+  Format.fprintf !Topfmt.err_ft "@[%a@]%!" pp_with x
 
 (* A buffer for the character read from a channel. We store the command
  * entered to be able to report errors without pretty-printing. *)
 
 type input_buffer = {
-  mutable prompt : unit -> string;
-  mutable str : string; (* buffer of already read characters *)
+  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 *)
-  mutable tokens : Gram.coq_parsable; (* stream of tokens *)
+  mutable tokens : Pcoq.Gram.coq_parsable; (* stream of tokens *)
   mutable start : int } (* stream count of the first char of the buffer *)
 
 (* Double the size of the buffer. *)
 
-let resize_buffer ibuf =
-  let nstr = String.create (2 * String.length ibuf.str + 1) in
-  String.blit ibuf.str 0 nstr 0 (String.length ibuf.str);
+let resize_buffer ibuf = let open Bytes in
+  let nstr = create (2 * length ibuf.str + 1) in
+  blit ibuf.str 0 nstr 0 (length ibuf.str);
   ibuf.str <- nstr
 
 (* Delete all irrelevant lines of the input buffer. Keep the last line
@@ -40,7 +40,7 @@ let resynch_buffer ibuf =
   match ibuf.bols with
     | ll::_ ->
         let new_len = ibuf.len - ll in
-        String.blit ibuf.str ll ibuf.str 0 new_len;
+        Bytes.blit ibuf.str ll ibuf.str 0 new_len;
         ibuf.len <- new_len;
         ibuf.bols <- [];
         ibuf.start <- ibuf.start + ll
@@ -49,24 +49,22 @@ let resynch_buffer ibuf =
 
 (* emacs special prompt tag for easy detection. No special character,
    to avoid interfering with utf8. Compatibility code removed. *)
-
-let emacs_prompt_startstring() = Printer.emacs_str "<prompt>"
-
-let emacs_prompt_endstring() = Printer.emacs_str "</prompt>"
+let emacs_prompt_startstring () = if !print_emacs then "<prompt>"  else ""
+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;
-    if ibuf.len == String.length ibuf.str then resize_buffer ibuf;
-    ibuf.str.[ibuf.len] <- c;
+    if ibuf.len == Bytes.length ibuf.str then resize_buffer ibuf;
+    Bytes.set ibuf.str ibuf.len c;
     ibuf.len <- ibuf.len + 1;
     Some c
   with End_of_file ->
@@ -74,21 +72,22 @@ let prompt_char ic ibuf count =
 
 (* Reinitialize the char stream (after a Drop) *)
 
-let reset_input_buffer ic ibuf =
-  ibuf.str <- "";
+let reset_input_buffer doc ic ibuf =
+  ibuf.str <- Bytes.empty;
   ibuf.len <- 0;
   ibuf.bols <- [];
-  ibuf.tokens <- 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. *)
+module TopErr = struct
 
 (* Given a location, returns the list of locations of each line. The last
    line is returned separately. It also checks the location bounds. *)
 
 let get_bols_of_loc ibuf (bp,ep) =
   let add_line (b,e) lines =
-    if b < 0 || e < b then anomaly (Pp.str "Bad location");
+    if b < 0 || e < b then CErrors.anomaly (Pp.str "Bad location.");
     match lines with
       | ([],None) -> ([], Some (b,e))
       | (fl,oe) -> ((b,e)::fl, oe)
@@ -109,86 +108,93 @@ let dotted_location (b,e) =
   else
     (String.make (e-b-1) '.', " ")
 
-let blanch_utf8_string s bp ep =
-  let s' = String.make (ep-bp) ' ' in
+let blanch_utf8_string s bp ep = let open Bytes in
+  let s' = make (ep-bp) ' ' in
   let j = ref 0 in
   for i = bp to ep - 1 do
-    let n = Char.code s.[i] in
+    let n = Char.code (get s i) in
     (* Heuristic: assume utf-8 chars are printed using a single
     fixed-size char and therefore contract all utf-8 code into one
     space; in any case, preserve tabulation so
     that its effective interpretation in terms of spacing is preserved *)
-    if s.[i] == '\t' then s'.[!j] <- '\t';
+    if get s i == '\t' then set s' !j '\t';
     if n < 0x80 || 0xC0 <= n then incr j
   done;
-  String.sub s' 0 !j
+  Bytes.sub_string s' 0 !j
+
+let adjust_loc_buf ib loc = let open Loc in
+  { loc with ep = loc.ep - ib.start; bp = loc.bp - ib.start }
 
 let print_highlight_location ib loc =
   let (bp,ep) = Loc.unloc loc in
-  let bp = bp - ib.start
-  and ep = ep - ib.start in
   let highlight_lines =
     match get_bols_of_loc ib (bp,ep) with
       | ([],(bl,el)) ->
 	  let shift = blanch_utf8_string ib.str bl bp in
 	  let span = String.length (blanch_utf8_string ib.str bp ep) in
-	  (str"> " ++ str(String.sub ib.str bl (el-bl-1)) ++ fnl () ++
+	  (str"> " ++ str(Bytes.sub_string ib.str bl (el-bl-1)) ++ fnl () ++
            str"> " ++ str(shift) ++ str(String.make span '^'))
       | ((b1,e1)::ml,(bn,en)) ->
           let (d1,s1) = dotted_location (b1,bp) in
           let (dn,sn) = dotted_location (ep,en) in
           let l1 = (str"> " ++ str d1 ++ str s1 ++
-                      str(String.sub ib.str bp (e1-bp))) in
+                      str(Bytes.sub_string ib.str bp (e1-bp))) in
           let li =
             prlist (fun (bi,ei) ->
-                      (str"> " ++ str(String.sub ib.str bi (ei-bi)))) ml in
-          let ln = (str"> " ++ str(String.sub ib.str bn (ep-bn)) ++
+                      (str"> " ++ str(Bytes.sub_string ib.str bi (ei-bi)))) ml in
+          let ln = (str"> " ++ str(Bytes.sub_string ib.str bn (ep-bn)) ++
                       str sn ++ str dn) in
 	  (l1 ++ li ++ ln)
   in
-  let loc  = Loc.make_loc (bp,ep) in
-  (Pp.pr_loc loc ++ highlight_lines ++ fnl ())
-
-(* Functions to report located errors in a file. *)
-
-let print_location_in_file loc =
-  let fname = loc.Loc.fname in
-  let errstrm = str"Error while reading " ++ str fname in
-  if Loc.is_ghost loc then
-    hov 1 (errstrm ++ spc() ++ str" (unknown location):") ++ fnl ()
-  else
-    let errstrm = mt ()
-      (* if String.equal outer_fname fname then mt() else errstrm ++ str":" ++ fnl() *)
-    in
-    let open Loc in
-    hov 0 (* No line break so as to follow emacs error message format *)
-	(errstrm ++ Pp.pr_loc loc)
+  highlight_lines
 
 let valid_buffer_loc ib loc =
-  not (Loc.is_ghost loc) &&
   let (b,e) = Loc.unloc loc in b-ib.start >= 0 && e-ib.start < ib.len && b<=e
 
+(* Toplevel error explanation. *)
+let error_info_for_buffer ?loc buf =
+  Option.map (fun loc ->
+      let fname = loc.Loc.fname in
+      let hl, loc =
+        (* We are in the toplevel *)
+        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 *)
+        | Loc.InFile _ ->
+           (mt (), loc)
+      in Topfmt.pr_loc loc ++ hl
+    ) loc
+
+(* Actual printing routine *)
+let print_error_for_buffer ?loc lvl msg buf =
+  let pre_hdr = error_info_for_buffer ?loc buf in
+  if !print_emacs
+  then Topfmt.emacs_logger ?pre_hdr lvl msg
+  else Topfmt.std_logger   ?pre_hdr lvl msg
+
+(*
+let print_toplevel_parse_error (e, info) buf =
+  let loc = Loc.get_loc info in
+  let lvl = Feedback.Error in
+  let msg = CErrors.iprint (e, info) in
+  print_error_for_buffer ?loc lvl msg buf
+*)
+end
+
 (*s The Coq prompt is the name of the focused proof, if any, and "Coq"
     otherwise. We trap all exceptions to prevent the error message printing
     from cycling. *)
 let make_prompt () =
   try
-    (Names.Id.to_string (Pfedit.get_current_proof_name ())) ^ " < "
+    (Names.Id.to_string (Proof_global.get_current_proof_name ())) ^ " < "
   with Proof_global.NoCurrentProof ->
     "Coq < "
 
-(*let build_pending_list l =
-  let pl = ref ">" in
-  let l' = ref l in
-  let res =
-    while List.length !l' > 1 do
-      pl := !pl ^ "|" Names.Id.to_string x;
-      l':=List.tl !l'
-    done in
-  let last = try List.hd !l' with _ ->   in
-  "<"^l'
-*)
-
 (* the coq prompt added to the default one when in emacs mode
    The prompt contains the current state label [n] (for global
    backtracking) and the current proof state [p] (for proof
@@ -197,70 +203,50 @@ 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 String.is_empty acc then "" else "|") ^ Names.Id.to_string x)
+      (fun acc x -> acc ^ (if CString.is_empty acc then "" else "|") ^ Names.Id.to_string x)
       "" pending in
   let proof_info = if dpth >= 0 then string_of_int dpth else "0" in
-  if !Flags.print_emacs then statnum ^ " |" ^ pendingprompt ^ "| " ^ proof_info ^ " < "
+  if !print_emacs then statnum ^ " |" ^ pendingprompt ^ "| " ^ proof_info ^ " < "
   else ""
 
 (* A buffer to store the current command read on stdin. It is
  * initialized when a vernac command is immediately followed by "\n",
  * or after a Drop. *)
 let top_buffer =
-  let pr() =
+  let pr doc =
     emacs_prompt_startstring()
     ^ make_prompt()
-    ^ make_emacs_prompt()
+    ^ make_emacs_prompt doc
     ^ emacs_prompt_endstring()
   in
   { prompt = pr;
-    str = "";
+    str = Bytes.empty;
     len = 0;
     bols = [];
-    tokens = Gram.parsable (Stream.of_list []);
+    tokens = Pcoq.Gram.parsable (Stream.of_list []);
     start = 0 }
 
 let set_prompt prompt =
   top_buffer.prompt
-  <- (fun () ->
+  <- (fun doc ->
     emacs_prompt_startstring()
     ^ prompt ()
     ^ emacs_prompt_endstring())
 
-(* The following exceptions need not be located. *)
-
-let locate_exn = function
-  | Out_of_memory | Stack_overflow | Sys.Break -> false
-  | _ -> true
-
-(* Toplevel error explanation. *)
-
-let print_toplevel_error (e, info) =
-  let loc = Option.default Loc.ghost (Loc.get_loc info) in
-  let fname = loc.Loc.fname in
-  let locmsg =
-    if Loc.is_ghost loc || String.equal fname "" then
-      if locate_exn e && valid_buffer_loc top_buffer loc then
-	print_highlight_location top_buffer loc
-      else mt ()
-    else print_location_in_file loc
-  in
-  locmsg ++ CErrors.iprint (e, info)
-
 (* Read the input stream until a dot is encountered *)
 let parse_to_dot =
-  let rec dot st = match Compat.get_tok (Stream.next st) with
+  let rec dot st = match Stream.next st with
     | Tok.KEYWORD ("."|"...") -> ()
-    | Tok.EOI -> raise End_of_input
+    | Tok.EOI -> raise Stm.End_of_input
     | _ -> dot st
   in
-  Gram.Entry.of_parser "Coqtoplevel.dot" dot
+  Pcoq.Gram.Entry.of_parser "Coqtoplevel.dot" dot
 
 (* If an error occurred while parsing, we try to read the input until a dot
    token is encountered.
@@ -268,20 +254,56 @@ let parse_to_dot =
 
 let rec discard_to_dot () =
   try
-    Gram.entry_parse parse_to_dot top_buffer.tokens
+    Pcoq.Gram.entry_parse parse_to_dot top_buffer.tokens
   with
-    | Compat.Token.Error _ | CLexer.Error.E _ -> discard_to_dot ()
-    | End_of_input -> raise End_of_input
+    | Token.Error _ | CLexer.Error.E _ -> discard_to_dot ()
+    | Stm.End_of_input -> raise Stm.End_of_input
     | e when CErrors.noncritical e -> ()
 
-let read_sentence input =
-  try
-    let (loc, _ as r) = Vernac.parse_sentence input in
-    CWarnings.set_current_loc loc; r
+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 ();
-    iraise reraise
+    (* The caller of read_sentence does the error printing now, this
+       should be re-enabled once we rely on the feedback error
+       printer again *)
+    (* TopErr.print_toplevel_parse_error reraise top_buffer; *)
+    Exninfo.iraise reraise
+
+let extract_default_loc loc doc_id sid : Loc.t option =
+  match loc with
+  | Some _ -> loc
+  | None ->
+    try
+      let doc = Stm.get_doc doc_id in
+      Option.cata fst None Stm.(get_ast ~doc sid)
+    with _ -> loc
+
+(** Coqloop Console feedback handler *)
+let coqloop_feed (fb : Feedback.feedback) = let open Feedback in
+  match fb.contents with
+  | Processed   -> ()
+  | Incomplete  -> ()
+  | Complete    -> ()
+  | ProcessingIn _ -> ()
+  | InProgress _ -> ()
+  | WorkerStatus (_,_) -> ()
+  | AddedAxiom  -> ()
+  | GlobRef (_,_,_,_,_) -> ()
+  | GlobDef (_,_,_,_) -> ()
+  | FileDependency (_,_) -> ()
+  | FileLoaded (_,_) -> ()
+  | Custom (_,_,_) -> ()
+  (* Re-enable when we switch back to feedback-based error printing *)
+  | Message (Error,loc,msg) -> ()
+  (* TopErr.print_error_for_buffer ?loc lvl msg top_buffer *)
+  | Message (Warning,loc,msg) ->
+    let loc = extract_default_loc loc fb.doc_id fb.span_id in
+    TopErr.print_error_for_buffer ?loc Warning msg top_buffer
+  | Message (lvl,loc,msg) ->
+    TopErr.print_error_for_buffer ?loc lvl msg top_buffer
 
 (** [do_vernac] reads and executes a toplevel phrase, and print error
     messages when an exception is raised, except for the following:
@@ -293,24 +315,29 @@ let read_sentence input =
     is caught and handled (i.e. not re-raised).
 *)
 
-let do_vernac () =
+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 top_buffer.tokens (read_sentence input)
+    Vernac.process_expr ~time ~state (read_sentence ~state (fst input))
   with
-    | End_of_input | CErrors.Quit ->
+    | 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.")
+        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. *)
     | any ->
-        let any = CErrors.push any in
-        let msg = print_toplevel_error any ++ fnl () in
-        pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.std_ft msg;
-        Format.pp_print_flush !Pp_control.std_ft ()
+      let (e, info) = CErrors.push any in
+      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;
+      state
 
 (** Main coq loop : read vernacular expressions until Drop is entered.
     Ctrl-C is handled internally as Sys.Break instead of aborting Coq.
@@ -318,37 +345,77 @@ let do_vernac () =
     exit the loop are Drop and Quit. Any other exception there indicates
     an issue with [print_toplevel_error] above. *)
 
-(*
-let feed_emacs = function
-  | { Interface.id = Interface.State id;
-      Interface.content = Interface.GlobRef (_,a,_,c,_) }  -> 
-    prerr_endline ("<info>" ^"<id>"^Stateid.to_string id ^"</id>"
-		   ^a^" "^c^ "</info>")
-  | _  -> ()
-*)
-
 (* Flush in a compatible order with 8.5 *)
 (* This mimics the semantics of the old Pp.flush_all *)
 let loop_flush_all () =
   Pervasives.flush stderr;
   Pervasives.flush stdout;
-  Format.pp_print_flush !Pp_control.std_ft ();
-  Format.pp_print_flush !Pp_control.err_ft ()
+  Format.pp_print_flush !Topfmt.std_ft ();
+  Format.pp_print_flush !Topfmt.err_ft ()
+
+let pr_open_cur_subgoals () =
+  try
+    let proof = Proof_global.give_me_the_proof () in
+    Printer.pr_open_subgoals ~proof
+  with Proof_global.NoCurrentProof -> Pp.str ""
+
+(* Goal equality heuristic. *)
+let pequal cmp1 cmp2 (a1,a2) (b1,b2) = cmp1 a1 b1 && cmp2 a2 b2
+let evleq e1 e2 = CList.equal Evar.equal e1 e2
+let cproof p1 p2 =
+  let (a1,a2,a3,a4,_),(b1,b2,b3,b4,_) = Proof.proof p1, Proof.proof p2 in
+  evleq a1 b1 &&
+  CList.equal (pequal evleq evleq) a2 b2 &&
+  CList.equal Evar.equal a3 b3 &&
+  CList.equal Evar.equal a4 b4
+
+(* We try to behave better when goal printing raises an exception
+   [usually Ctrl-C]
+
+   This is mostly a hack as we should protect printing in a more
+   generic way, but that'll do for now *)
+let top_goal_print oldp newp =
+  try
+    let proof_changed = not (Option.equal cproof oldp newp) in
+    let print_goals = not !Flags.quiet &&
+                      proof_changed && Proof_global.there_are_pending_proofs () in
+    if print_goals then Feedback.msg_notice (pr_open_cur_subgoals ())
+  with
+  | CErrors.Drop | CErrors.Quit as exn -> raise exn
+  | exn ->
+    let (e, info) = CErrors.push exn in
+    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
+
+let drop_last_doc = ref None
 
-let rec loop () =
+let rec loop ~time ~state =
+  let open Vernac.State in
   Sys.catch_break true;
-  if !Flags.print_emacs then Vernacentries.qed_display_script := false;
-  Flags.coqtop_ui := true;
   try
-    reset_input_buffer stdin top_buffer;
-    while true do do_vernac(); loop_flush_all () done
+    reset_input_buffer state.doc stdin top_buffer;
+    (* Be careful to keep this loop tail-recursive *)
+    let rec vernac_loop ~state =
+      let nstate = do_vernac ~time ~state in
+      top_goal_print state.proof nstate.proof;
+      loop_flush_all ();
+      vernac_loop ~state:nstate
+    in vernac_loop ~state
   with
-    | CErrors.Drop -> ()
+    | CErrors.Drop ->
+      (* Due to using exceptions as a form of control, state here goes
+         out of sync as [do_vernac] will never return. We must thus do
+         this hack until we make `Drop` a toplevel-only command. See
+         bug #6872. *)
+      let state = { state with sid = Stm.get_current_state ~doc:state.doc } in
+      drop_last_doc := Some state;
+      state
     | CErrors.Quit -> exit 0
     | any ->
-      Feedback.msg_error (str"Anomaly: main loop exited with exception: " ++
-                str (Printexc.to_string any) ++
-                fnl() ++
-                str"Please report" ++
-                strbrk" at " ++ str Coq_config.wwwbugtracker ++ str ".");
-      loop ()
+      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 ~time ~state
diff --git a/toplevel/coqloop.mli b/toplevel/coqloop.mli
index e40353e0..bbb9b138 100644
--- a/toplevel/coqloop.mli
+++ b/toplevel/coqloop.mli
@@ -1,21 +1,24 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
-
 (** The Coq toplevel loop. *)
 
+(** -emacs option: printing includes emacs tags. *)
+val print_emacs : bool ref
+
 (** A buffer for the character read from a channel. We store the command
  * entered to be able to report errors without pretty-printing. *)
 
 type input_buffer = {
-  mutable prompt : unit -> string;
-  mutable str : string; (** buffer of already read characters *)
+  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 *)
   mutable tokens : Pcoq.Gram.coq_parsable; (** stream of tokens *)
@@ -26,16 +29,14 @@ type input_buffer = {
 val top_buffer : input_buffer
 val set_prompt : (unit -> string) -> unit
 
-(** Toplevel error explanation, dealing with locations, Drop, Ctrl-D
-  May raise only the following exceptions: [Drop] and [End_of_input],
-  meaning we get out of the Coq loop. *)
-
-val print_toplevel_error : Exninfo.iexn -> std_ppcmds
+(** Toplevel feedback printer. *)
+val coqloop_feed : Feedback.feedback -> unit
 
 (** Parse and execute one vernac command. *)
-
-val do_vernac : unit -> unit
+val do_vernac : time:bool -> state:Vernac.State.t -> Vernac.State.t
 
 (** Main entry point of Coq: read and execute vernac commands. *)
+val loop : time:bool -> state:Vernac.State.t -> Vernac.State.t
 
-val loop : unit -> unit
+(** Last document seen after `Drop` *)
+val drop_last_doc : Vernac.State.t option ref
diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml
index d9f8ed88..943b66f6 100644
--- a/toplevel/coqtop.ml
+++ b/toplevel/coqtop.ml
@@ -1,19 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
-open CErrors
-open Util
-open Flags
-open Names
-open Libnames
-open States
-open Coqinit
+open Coqargs
 
 let () = at_exit flush_all
 
@@ -34,64 +30,31 @@ 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 warning s = Flags.(with_option warn Feedback.msg_warning (strbrk s))
 
-let toploop = ref None
+(* 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 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 *)
-      Feedback.init_color_output ()
-    | Some "" ->
-      (** No color output *)
-      ()
-    | Some s ->
-      (** Overwrite all colors *)
-      Ppstyle.clear_styles ();
-      Ppstyle.parse_config s;
-      Feedback.init_color_output ()
-  end
-
-let toploop_init = ref begin fun x ->
-  let () = init_color () in
-  let () = CoqworkmgrApi.(init !Flags.async_proofs_worker_priority) in
-  x
-  end
-
-let toploop_run = ref (fun () ->
+(* Default toplevel loop *)
+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 _ = Coqloop.loop ~time:opts.time ~state in
   (* Initialise and launch the Ocaml toplevel *)
   Coqinit.init_ocaml_path();
-  Mltop.ocaml_toploop())
+  Mltop.ocaml_toploop();
+  (* We let the feeder in place for users of Drop *)
+  Feedback.del_feeder tl_feed
 
-let output_context = ref false
+let toploop_run = ref console_toploop_run
 
 let memory_stat = ref false
-
 let print_memory_stat () =
   begin (* -m|--memory from the command-line *)
     if !memory_stat then
@@ -111,151 +74,319 @@ 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 = DirPath.make [Id.of_string "Top"]
-let toplevel_name = ref (Some toplevel_default_name)
-let set_toplevel_name dir =
-  if DirPath.is_empty dir then error "Need a non empty toplevel module name";
-  toplevel_name := Some dir
-let unset_toplevel_name () = toplevel_name := None
-
-let remove_top_ml () = Mltop.remove ()
-
-let warn_deprecated_inputstate =
-  CWarnings.create ~name:"deprecated-inputstate" ~category:"deprecated"
-         (fun () -> strbrk "The inputstate option is deprecated and discouraged.")
-
-let inputstate = ref ""
-let set_inputstate s =
-  warn_deprecated_inputstate ();
-  inputstate:=s
-let inputstate () =
-  if not (String.is_empty !inputstate) then
-    let fname = Loadpath.locate_file (CUnix.make_suffix !inputstate ".coq") in
-    intern_state fname
-
-let warn_deprecated_outputstate =
-  CWarnings.create ~name:"deprecated-outputstate" ~category:"deprecated"
-         (fun () ->
-          strbrk "The outputstate option is deprecated and discouraged.")
-
-let outputstate = ref ""
-let set_outputstate s =
-  warn_deprecated_outputstate ();
-  outputstate:=s
-let outputstate () =
-  if not (String.is_empty !outputstate) then
-    let fname = CUnix.make_suffix !outputstate ".coq" in
-    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 () =
-  List.iter
-    (fun (s,b) ->
-      let s = Loadpath.locate_file s in
-      if !Flags.beautify then
-	with_option beautify_file (Vernac.load_vernac b) s
-      else
-	Vernac.load_vernac b s)
-    (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.ghost, 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.ghost, 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_4 -> add_require "Coq.Compat.Coq84"
-  | Flags.V8_5 -> add_require "Coq.Compat.Coq85"
-  | _ -> ()
-
-let compile_list = ref ([] : (bool * string) list)
-
-let glob_opt = ref false
-
-let add_compile verbose s =
-  set_batch_mode ();
-  Flags.make_silent 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
+(******************************************************************************)
+(* 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 state (f_in, echo) ->
+      let s = Loadpath.locate_file f_in in
+      (* Should make the beautify logic clearer *)
+      let load_vernac f = Vernac.load_vernac ~time:opts.time ~echo ~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
+
+(******************************************************************************)
+(* 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_file (v,f) =
+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 ~echo ~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 ~echo ~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 ~echo ~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 ~echo ~f_in ~f_out =
+  ignore(CoqworkmgrApi.get 1);
+  compile opts ~echo ~f_in ~f_out;
+  CoqworkmgrApi.giveback 1
+
+let compile_file opts (f_in, echo) =
+  let f_out = opts.compilation_output_name in
   if !Flags.beautify then
-    with_option beautify_file (Vernac.compile v) f
+    Flags.with_option Flags.beautify_file
+      (fun f_in -> compile opts ~echo ~f_in ~f_out) f_in
   else
-    Vernac.compile v f
+    compile opts ~echo ~f_in ~f_out
 
-let compile_files () =
-  if !compile_list == [] then ()
-  else
-    let init_state = States.freeze ~marshallable:`No in
-    Feedback.(add_feeder debug_feeder);
-    List.iter (fun vf ->
-        States.unfreeze init_state;
-        compile_file vf)
-      (List.rev !compile_list)
+let compile_files opts =
+  let compile_list = List.rev opts.compile_list in
+  List.iter (compile_file opts) compile_list
 
-(** Options for proof general *)
-
-let set_emacs () =
-  if not (Option.is_empty !toploop) then
-    error "Flag -emacs is incompatible with a custom toplevel loop";
-  Flags.print_emacs := true;
-  Feedback.(set_logger emacs_logger);
-  Vernacentries.qed_display_script := false;
-  color := `OFF
-
-(** 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")
 
-let set_ideslave () =
-  if !Flags.print_emacs then error "Flags -ideslave and -emacs are incompatible";
-  toploop := Some "coqidetop";
-  Flags.ide_slave := true
+(* vio files *)
+let schedule_vio opts =
+  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 do_vio opts =
+  (* We must initialize the loadpath here as the vio scheduling
+     process happens outside of the STM *)
+  if opts.vio_files <> [] || opts.vio_tasks <> [] then
+    let iload_path = build_load_path opts in
+    List.iter Mltop.add_coq_path iload_path;
+
+  (* Vio compile pass *)
+  if opts.vio_files <> [] then schedule_vio opts;
+  (* Vio task pass *)
+  if opts.vio_tasks <> [] then check_vio_tasks opts
+
+
+(******************************************************************************)
+(* 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.default_styles ();
+      Topfmt.init_terminal_output ~color:true
+    | Some "" ->
+      (** No color output *)
+      Topfmt.init_terminal_output ~color:false
+    | Some s ->
+      (** Overwrite all colors *)
+      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 !Flags.print_emacs then error "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 *)
 
@@ -282,389 +413,112 @@ 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 () =
-  Envars.set_coqlib CErrors.error;
-  init_load_path ();
-  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 = Ppstyle.dump () in
-  let iter (t, st) =
-    let st = match st with Some st -> st | None -> Terminal.make () in
-    let opt =
-      Terminal.eval st ^
-      String.concat "." (Ppstyle.repr t) ^
-      Terminal.reset ^ "\n"
-    in
-    print_string opt
-  in
-  let make (t, st) = match st with
-  | None -> None
-  | Some st ->
-    let tags = List.map string_of_int (Terminal.repr st) in
-    let t = String.concat "." (Ppstyle.repr t) in
-    Some (t ^ "=" ^ String.concat ";" tags)
-  in
-  let repr = List.map_filter 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 (String.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.make_silent 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.make_silent 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 _ -> ""
-
-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 = get_compat_version (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 ()
-    |"-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
-    |"-notop" -> unset_toplevel_name ()
-    |"-output-context" -> output_context := true
-    |"-profile-ltac" -> Flags.profile_ltac := true
-    |"-q" -> no_load_rc ()
-    |"-quiet"|"-silent" -> Flags.make_silent true; Flags.make_warn false
-    |"-quick" -> Flags.compilation_mode := BuildVio
-    |"-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" -> Usage.machine_readable_version (exitcode ())
-    |"-where" -> print_where := true
-    |"-xml" -> Flags.xml_export := true
-
-    (* Deprecated options *)
-    |"-byte" -> warning "option -byte deprecated, call with .byte suffix"
-    |"-opt" -> warning "option -opt deprecated, call with .opt suffix"
-    |"-full" -> warning "option -full deprecated"
-    |"-notactics" -> warning "Obsolete option \"-notactics\"."; remove_top_ml ()
-    |"-emacs-U" ->
-      warning "Obsolete option \"-emacs-U\", use -emacs instead."; set_emacs ()
-    |"-v7" -> error "This version of Coq does not support v7 syntax"
-    |"-v8" -> warning "Obsolete option \"-v8\"."
-    |"-lazy-load-proofs" -> warning "Obsolete option \"-lazy-load-proofs\"."
-    |"-dont-load-proofs" -> warning "Obsolete option \"-dont-load-proofs\"."
-    |"-force-load-proofs" -> warning "Obsolete option \"-force-load-proofs\"."
-    |"-unsafe" -> warning "Obsolete option \"-unsafe\"."; ignore (next ())
-    |"-quality" -> warning "Obsolete option \"-quality\"."
-
-    (* Unknown option *)
-    | s -> extras := s :: !extras
-    end;
-    parse ()
-  in
-  try
-    parse ()
-  with
-    | UserError(_, s) as e ->
-      if is_empty s then exit 1
-      else fatal_error (CErrors.print e) false
-    | any -> fatal_error (CErrors.print any) (CErrors.is_anomaly any)
-
+(** Main init routine *)
 let init_toplevel arglist =
+  (* 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();
-  (* Default Proofb Mode starts with an alternative default. *)
-  Goptions.set_string_option_value ["Default";"Proof";"Mode"] "Classic";
-  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 CErrors.error;
-      if !print_where then (print_endline(Envars.coqlib ()); exit(exitcode ()));
-      if !print_config then (Usage.print_config (); exit (exitcode ()));
-      if !print_tags then (print_style_tags (); exit (exitcode ()));
-      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 not (List.is_empty extras) then begin
+      Envars.set_coqlib ~fail:(fun msg -> CErrors.user_err Pp.(str msg));
+      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 || List.is_empty !compile_list)
-         && Global.env_is_initial ()
-      then Option.iter Declaremods.start_library !toplevel_name;
-      init_library_roots ();
-      load_vernac_obj ();
-      require ();
-      Stm.init ();
-      load_rcfile();
-      load_vernacular ();
-      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;
+          (* Careful this will modify the load-path and state so after
+             this point some stuff may not be safe anymore. *)
+          do_vio opts;
+          (* Allow the user to output an arbitrary state *)
+          outputstate opts;
+          None, opts
+        with any -> flush_all(); fatal_error_exn any
+      end;
     with any ->
-      let any = CErrors.push any in
       flush_all();
-      let msg =
-        if !batch_mode then mt ()
-        else str "Error during initialization:" ++ fnl ()
-      in
-      let is_anomaly e = CErrors.is_anomaly e || not (CErrors.handled e) in
-      fatal_error (msg ++ Coqloop.print_toplevel_error any) (is_anomaly (fst any))
-  end;
-  if !batch_mode then begin
-    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
+      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 c9d1ba45..056279bb 100644
--- a/toplevel/coqtop.mli
+++ b/toplevel/coqtop.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** The Coq main module. The following function [start] will parse the
@@ -11,12 +13,10 @@
    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
 
-
 (* 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_byte_bin.ml b/toplevel/coqtop_byte_bin.ml
new file mode 100644
index 00000000..0b65cebb
--- /dev/null
+++ b/toplevel/coqtop_byte_bin.ml
@@ -0,0 +1,34 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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);
+           })
+
+(* Main coqtop initialization *)
+let _ =
+  drop_setup ();
+  Coqtop.start()
diff --git a/toplevel/coqtop_opt_bin.ml b/toplevel/coqtop_opt_bin.ml
new file mode 100644
index 00000000..ea4c0ea5
--- /dev/null
+++ b/toplevel/coqtop_opt_bin.ml
@@ -0,0 +1,16 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+let drop_setup () = Mltop.remove ()
+
+(* Main coqtop initialization *)
+let _ =
+  drop_setup ();
+  Coqtop.start()
diff --git a/toplevel/discharge.mli b/toplevel/discharge.mli
deleted file mode 100644
index 18d1b677..00000000
--- a/toplevel/discharge.mli
+++ /dev/null
@@ -1,14 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Declarations
-open Entries
-open Opaqueproof
-
-val process_inductive :
-  Context.Named.t Univ.in_universe_context -> work_list -> mutual_inductive_body -> mutual_inductive_entry
diff --git a/toplevel/doc.tex b/toplevel/doc.tex
deleted file mode 100644
index f2550fda..00000000
--- a/toplevel/doc.tex
+++ /dev/null
@@ -1,10 +0,0 @@
-
-\newpage
-\section*{The Coq toplevel}
-
-\ocwsection \label{toplevel}
-This chapter describes the highest modules of the \Coq\ system.
-They are organized as follows:
-
-\bigskip
-\begin{center}\epsfig{file=toplevel.dep.ps,width=\linewidth}\end{center}
diff --git a/toplevel/explainErr.mli b/toplevel/explainErr.mli
deleted file mode 100644
index a67c887a..00000000
--- a/toplevel/explainErr.mli
+++ /dev/null
@@ -1,21 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Toplevel Exception *)
-exception EvaluatedError of Pp.std_ppcmds * exn option
-
-(** Pre-explain a vernac interpretation error *)
-
-val process_vernac_interp_error : ?allow_uncaught:bool -> ?with_header:bool -> Util.iexn -> Util.iexn
-
-(** General explain function. Should not be used directly now,
-    see instead function [Errors.print] and variants *)
-
-val explain_exn_default : exn -> Pp.std_ppcmds
-
-val register_additional_error_info : (Util.iexn -> (Pp.std_ppcmds option * Loc.t) option) -> unit
diff --git a/toplevel/himsg.mli b/toplevel/himsg.mli
deleted file mode 100644
index ced54fd2..00000000
--- a/toplevel/himsg.mli
+++ /dev/null
@@ -1,42 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Indtypes
-open Environ
-open Type_errors
-open Pretype_errors
-open Typeclasses_errors
-open Indrec
-open Cases
-open Logic
-
-(** This module provides functions to explain the type errors. *)
-
-val explain_type_error : env -> Evd.evar_map -> type_error -> std_ppcmds
-
-val explain_pretype_error : env -> Evd.evar_map -> pretype_error -> std_ppcmds
-
-val explain_inductive_error : inductive_error -> std_ppcmds
-
-val explain_typeclass_error : env -> typeclass_error -> Pp.std_ppcmds
-
-val explain_recursion_scheme_error : recursion_scheme_error -> std_ppcmds
-
-val explain_refiner_error : refiner_error -> std_ppcmds
-
-val explain_pattern_matching_error :
-  env -> Evd.evar_map -> pattern_matching_error -> std_ppcmds
-
-val explain_reduction_tactic_error :
-  Tacred.reduction_tactic_error -> std_ppcmds
-
-val explain_module_error : Modops.module_typing_error -> std_ppcmds
-
-val explain_module_internalization_error :
-  Modintern.module_internalization_error -> std_ppcmds
diff --git a/toplevel/indschemes.mli b/toplevel/indschemes.mli
deleted file mode 100644
index e5d79fd5..00000000
--- a/toplevel/indschemes.mli
+++ /dev/null
@@ -1,49 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Loc
-open Names
-open Term
-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_eq_decidability : mutual_inductive -> unit
-
-(** Build and register a congruence scheme for an equality-like inductive type *)
-
-val declare_congr_scheme : inductive -> unit
-
-(** Build and register rewriting schemes for an equality-like inductive type *)
-
-val declare_rewriting_schemes : inductive -> unit
-
-(** Mutual Minimality/Induction scheme *)
-
-val do_mutual_induction_scheme :
-  (Id.t located * bool * inductive * glob_sort) list -> unit
-
-(** Main calls to interpret the Scheme command *)
-
-val do_scheme : (Id.t located option * scheme) list -> unit
-
-(** Combine a list of schemes into a conjunction of them *)
-
-val build_combined_scheme : env -> constant list -> constr * types
-
-val do_combined_scheme : Id.t located -> Id.t located list -> unit
-
-(** Hook called at each inductive type definition *)
-
-val declare_default_schemes : mutual_inductive -> unit
diff --git a/toplevel/locality.ml b/toplevel/locality.ml
deleted file mode 100644
index 154f787e..00000000
--- a/toplevel/locality.ml
+++ /dev/null
@@ -1,107 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-
-(** * 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.errorlabstrm "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.error "Cannot be simultaneously Local and Global."
-    | Some true when local ->
-	CErrors.error "Use only prefix \"Local\"."
-    | None ->
-	if local then begin
-	    warn_deprecated_local_syntax ();
-	    Some true
-	end else
-	None
-    | Some b -> Some b in
-  local
-
-(** Positioning locality for commands supporting discharging and export
-     outside of modules *)
-
-(* For commands whose default is to discharge and export:
-   Global is the default and is neutral;
-   Local in a section deactivates discharge,
-   Local not in a section deactivates export *)
-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 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.error "Local non allowed in this case"
-
-(* For commands whose default is to not discharge but to export:
-   Global in sections forces discharge, Global not in section is the default;
-   Local in sections is the default, Local not in section forces non-export *)
-
-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)
-
-(** Positioning locality for commands supporting export but not discharge *)
-
-(* For commands whose default is to export (if not in section):
-   Global in sections is forbidden, Global not in section is neutral;
-   Local in sections is the default, Local not in section forces non-export *)
-
-let make_module_locality = function
-  | Some false ->
-      if Lib.sections_are_opened () then
-	CErrors.error
-	  "This command does not support the Global option in sections.";
-      false
-  | 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
diff --git a/toplevel/metasyntax.ml b/toplevel/metasyntax.ml
deleted file mode 100644
index 008d5cf9..00000000
--- a/toplevel/metasyntax.ml
+++ /dev/null
@@ -1,1379 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Flags
-open CErrors
-open Util
-open Names
-open Constrexpr
-open Constrexpr_ops
-open Notation_term
-open Notation_ops
-open Ppextend
-open Extend
-open Libobject
-open Constrintern
-open Vernacexpr
-open Pcoq
-open Libnames
-open Tok
-open Egramcoq
-open Notation
-open Nameops
-
-(**********************************************************************)
-(* Tokens                                                             *)
-
-let cache_token (_,s) = CLexer.add_keyword s
-
-let inToken : string -> obj =
-  declare_object {(default_object "TOKEN") with
-       open_function = (fun i o -> if Int.equal i 1 then cache_token o);
-       cache_function = cache_token;
-       subst_function = Libobject.ident_subst_function;
-       classify_function = (fun o -> Substitute o)}
-
-let add_token_obj s = Lib.add_anonymous_leaf (inToken s)
-
-(**********************************************************************)
-(* Printing grammar entries                                           *)
-
-let entry_buf = Buffer.create 64
-
-let pr_entry e =
-  let () = Buffer.clear entry_buf in
-  let ft = Format.formatter_of_buffer entry_buf in
-  let () = Gram.entry_print ft e in
-  str (Buffer.contents entry_buf)
-
-let pr_grammar = function
-  | "constr" | "operconstr" | "binder_constr" ->
-      str "Entry constr is" ++ fnl () ++
-      pr_entry Pcoq.Constr.constr ++
-      str "and lconstr is" ++ fnl () ++
-      pr_entry Pcoq.Constr.lconstr ++
-      str "where binder_constr is" ++ fnl () ++
-      pr_entry Pcoq.Constr.binder_constr ++
-      str "and operconstr is" ++ fnl () ++
-      pr_entry Pcoq.Constr.operconstr
-  | "pattern" ->
-      pr_entry Pcoq.Constr.pattern
-  | "tactic" ->
-      str "Entry tactic_expr is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.tactic_expr ++
-      str "Entry binder_tactic is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.binder_tactic ++
-      str "Entry simple_tactic is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.simple_tactic ++
-      str "Entry tactic_arg is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.tactic_arg
-  | "vernac" ->
-      str "Entry vernac is" ++ fnl () ++
-      pr_entry Pcoq.Vernac_.vernac ++
-      str "Entry command is" ++ fnl () ++
-      pr_entry Pcoq.Vernac_.command ++
-      str "Entry syntax is" ++ fnl () ++
-      pr_entry Pcoq.Vernac_.syntax ++
-      str "Entry gallina is" ++ fnl () ++
-      pr_entry Pcoq.Vernac_.gallina ++
-      str "Entry gallina_ext is" ++ fnl () ++
-      pr_entry Pcoq.Vernac_.gallina_ext
-  | _ -> error "Unknown or unprintable grammar entry."
-
-(**********************************************************************)
-(* Parse a format (every terminal starting with a letter or a single
-   quote (except a single quote alone) must be quoted) *)
-
-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
-    | _ -> error "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 error "Incorrectly terminated quoted expression." in
-  let rec spaces n i =
-    if i < String.length str && 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 str.[i] == '\'' && quoted &&
-        (i+1 >= String.length str || str.[i+1] == ' ')
-      then if Int.equal n 0 then error "Empty quoted token." else n
-      else nonspaces quoted (n+1) (i+1)
-    else
-      if quoted then error "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))
-  and parse_quoted n i =
-    if i < String.length str 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)))
-      (* Parse " .. / .. " *)
-      | '/' when i <= String.length str ->
-	  let p = spaces 0 (i+1) in
-	  push_token (UnpCut (PpBrk (n,p)))
-            (parse_token (close_quotation (i+p+1)))
-      | c ->
-      (* The spaces are real spaces *)
-      push_white n (match c with
-      | '[' ->
-	  if i <= String.length str 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))
-		(* Parse " [v .. ",  *)
-	    | 'v' ->
-		    parse_box (fun n -> PpVB n) (i+2)
-		(* Parse " [ .. ",  *)
-	    | ' ' | '\'' ->
-		parse_box (fun n -> PpHOVB n) (i+1)
-	    | _ -> error "\"v\", \"hv\", \" \" expected after \"[\" in format."
-	  else error "\"v\", \"hv\" or \" \" expected after \"[\" in format."
-      (* Parse "]"  *)
-      | ']' ->
-	  ([] :: parse_token (close_quotation (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))))
-    else
-      if Int.equal n 0 then []
-      else error "Ending spaces non part of a format annotation."
-  and parse_box box i =
-    let n = spaces 0 i in
-    close_box i (box n) (parse_token (close_quotation (i+n)))
-  and parse_token i =
-    let n = spaces 0 i in
-    let i = i+n in
-    if i < l 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)))
-      (* Parse the beginning of a quoted expression *)
-      |	'\'' ->
-          parse_quoted (n-1) (i+1)
-      (* Otherwise *)
-      | _ ->
-          push_white (n-1) (parse_non_format i)
-    else push_white n [[]]
-  in
-  try
-    if not (String.is_empty str) then match parse_token 0 with
-      | [l] -> l
-      | _ -> error "Box closed without being opened in format."
-    else
-      error "Empty format."
-  with reraise ->
-    let (e, info) = CErrors.push reraise in
-    let info = Loc.add_loc info loc in
-    iraise (e, info)
-
-(***********************)
-(* 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
-
-let msg_expected_form_of_recursive_notation =
-  "In the notation, the special symbol \"..\" must occur in\na configuration of the form \"x symbs .. symbs y\"."
-
-let rec find_pattern nt xl = function
-  | Break n as x :: l, Break n' :: l' when Int.equal n n' ->
-      find_pattern nt (x::xl) (l,l')
-  | Terminal s as x :: l, Terminal s' :: l' when String.equal s s' ->
-      find_pattern nt (x::xl) (l,l')
-  | [], NonTerminal x' :: l' ->
-      (out_nt nt,x',List.rev xl),l'
-  | _, Break s :: _ | Break s :: _, _ ->
-      error ("A break occurs on one side of \"..\" but not on the other side.")
-  | _, Terminal s :: _ | Terminal s :: _, _ ->
-      errorlabstrm "Metasyntax.find_pattern"
-        (str "The token \"" ++ str s ++ str "\" occurs on one side of \"..\" but not on the other side.")
-  | _, [] ->
-      error msg_expected_form_of_recursive_notation
-  | ((SProdList _ | NonTerminal _) :: _), _ | _, (SProdList _ :: _) ->
-      anomaly (Pp.str "Only Terminal or Break expected on left, non-SProdList on right")
-
-let rec interp_list_parser hd = function
-  | [] -> [], List.rev hd
-  | NonTerminal id :: tl when Id.equal id ldots_var ->
-      if List.is_empty hd then error msg_expected_form_of_recursive_notation;
-      let hd = List.rev hd in
-      let ((x,y,sl),tl') = find_pattern (List.hd hd) [] (List.tl hd,tl) in
-      let xyl,tl'' = interp_list_parser [] tl' in
-      (* We remember each pair of variable denoting a recursive part to *)
-      (* remove the second copy of it afterwards *)
-      (x,y)::xyl, SProdList (x,sl) :: tl''
-  | (Terminal _ | Break _) as s :: tl ->
-      if List.is_empty hd then
-        let yl,tl' = interp_list_parser [] tl in
-        yl, s :: tl'
-      else
-        interp_list_parser (s::hd) tl
-  | NonTerminal _ as x :: tl ->
-      let xyl,tl' = interp_list_parser [x] tl in
-      xyl, List.rev_append hd tl'
-  | SProdList _ :: _ -> anomaly (Pp.str "Unexpected SProdList in interp_list_parser")
-
-
-(* Find non-terminal tokens of notation *)
-
-(* To protect alphabetic tokens and quotes from being seen as variables *)
-let quote_notation_token x =
-  let n = String.length x in
-  let norm = CLexer.is_ident x in
-  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 "_" :: _ -> error "_ 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]) ->
-      (try let _ = Bigint.of_string x in true with Failure _ -> false)
-  | _ ->
-      false
-
-let rec get_notation_vars = function
-  | [] -> []
-  | NonTerminal id :: sl ->
-      let vars = get_notation_vars sl in
-      if Id.equal id ldots_var then vars else
-	if Id.List.mem id vars then
-	  errorlabstrm "Metasyntax.get_notation_vars"
-            (str "Variable " ++ pr_id id ++ str " occurs more than once.")
-	else
-          id::vars
-  | (Terminal _ | Break _) :: sl -> get_notation_vars sl
-  | SProdList _ :: _ -> assert false
-
-let analyze_notation_tokens l =
-  let l = raw_analyze_notation_tokens l in
-  let vars = get_notation_vars 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 =
-  errorlabstrm "Metasyntax.error_not_name_scope"
-    (str "Variables " ++ pr_id x ++ str " and " ++ pr_id y ++ str " must be in the same scope.")
-
-(**********************************************************************)
-(* Build pretty-printing rules                                        *)
-
-let prec_assoc = function
-  | RightA -> (L,E)
-  | 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)) ->
-      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 (* ?? *)
-
-(* Some breaking examples *)
-(* "x = y" : "x /1 = y" (breaks before any symbol) *)
-(* "x =S y" : "x /1 =S /1 y" (protect from confusion; each side for symmetry)*)
-(* "+ {" : "+ {" may breaks reversibility without space but oth. not elegant *)
-(* "x y" : "x spc y" *)
-(* "{ x } + { y }" : "{ x } / + { y }" *)
-(* "< x , y > { z , t }" : "< x , / y > / { z , / t }" *)
-
-let starts_with_left_bracket s =
-  let l = String.length s in not (Int.equal l 0) &&
-  (s.[0] == '{' || s.[0] == '[' || s.[0] == '(')
-
-let ends_with_right_bracket s =
-  let l = String.length s in not (Int.equal l 0) &&
-  (s.[l-1] == '}' || s.[l-1] == ']' || s.[l-1] == ')')
-
-let is_left_bracket s =
-  starts_with_left_bracket s && not (ends_with_right_bracket s)
-
-let is_right_bracket s =
-  not (starts_with_left_bracket s) && ends_with_right_bracket s
-
-let is_comma s =
-  let l = String.length s in not (Int.equal l 0) &&
-  (s.[0] == ',' || s.[0] == ';')
-
-let is_operator s =
-  let l = String.length s in not (Int.equal l 0) &&
-  (s.[0] == '+' || s.[0] == '*' || s.[0] == '=' ||
-   s.[0] == '-' || s.[0] == '/' || s.[0] == '<' || s.[0] == '>' ||
-   s.[0] == '@' || s.[0] == '\\' || s.[0] == '&' || s.[0] == '~' || s.[0] == '$')
-
-let is_non_terminal = function
-  | NonTerminal _ | SProdList _ -> true
-  | _ -> false
-
-let is_next_non_terminal = function
-| [] -> false
-| 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_if_none n = function
-  | ((UnpCut (PpBrk _) :: _) | []) as l -> l
-  | l -> UnpCut (PpBrk(n,0)) :: l
-
-let check_open_binder isopen sl m =
-  let pr_token = function
-  | Terminal s -> str s
-  | Break n -> str "�"
-  | _ -> assert false
-  in
-  if isopen && not (List.is_empty sl) then
-    errorlabstrm "" (str "as " ++ pr_id m ++
-      str " is a non-closed binder, no such \"" ++
-      prlist_with_sep spc pr_token sl
-      ++ strbrk "\" is allowed to occur.")
-
-(* 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
-    | 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)
-	else
-	  u :: make_with_space prods
-    | Terminal s :: prods when 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)
-	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
-	else if not (is_next_break prods) then
-          (* Add rigid space, no break, unless user asked for something *)
-          UnpTerminal (s^" ") :: make prods
-        else
-          (* Rely on user spaces *)
-          UnpTerminal s :: make 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)
-
-    | Break n :: prods ->
-	add_break n (make prods)
-
-    | SProdList (m,sl) :: prods ->
-	let i = index_id m vars in
-	let typ = List.nth typs (i-1) in
-	let _,prec = precedence_of_entry_type from typ in
-        let sl' =
-          (* 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
-	let hunk = match typ with
-	  | ETConstr _ -> UnpListMetaVar (i,prec,sl')
-	  | ETBinder isopen ->
-	      check_open_binder isopen sl m;
-	      UnpBinderListMetaVar (i,isopen,sl')
-	  | _ -> assert false in
-	hunk :: make_with_space prods
-
-    | [] -> []
-
-  and make_with_space 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')
-        else if is_comma s' then
-          (* No space whatsoever before comma *)
-          make prods
-        else if is_right_bracket s' then
-          make prods
-        else
-          (* A breakable space between any other two terminals *)
-          add_break_if_none 1 (make prods)
-    | (NonTerminal _ | SProdList _) :: _ ->
-        (* A breakable space before a non-terminal *)
-        add_break_if_none 1 (make prods)
-    | Break _ :: _ ->
-        (* Rely on user wish *)
-        make prods
-    | [] -> []
-
-  in make symbols
-
-(* Build default printing rules from explicit format *)
-
-let error_format () = error "The format does not match the notation."
-
-let rec split_format_at_ldots hd = function
-  | UnpTerminal s :: fmt when String.equal s (Id.to_string ldots_var) -> 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) ->
-      (try
-        let _ = split_format_at_ldots [] fmt in
-        error ("The special symbol \"..\" must occur at the same formatting depth than the variables of which it is the ellipse.")
-      with Exit -> ())
-  | _ -> ()
-
-let skip_var_in_recursive_format = function
-  | UnpTerminal _ :: sl (* skip first var *) ->
-      (* To do, though not so important: check that the names match
-         the names in the notation *)
-      sl
-  | _ -> error_format ()
-
-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
-  let rec get_tail = function
-    | a :: sepfmt, b :: fmt when Pervasives.(=) a b -> get_tail (sepfmt, fmt) (* FIXME *)
-    | [], tail -> skip_var_in_recursive_format tail
-    | _ -> error "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
-  slfmt, get_tail (slfmt, fmt)
-
-let hunks_of_format (from,(vars,typs)) symfmt =
-  let rec aux = function
-  | 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
-      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') ->
-      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', b' = aux (symbs,b) in
-      let symbs', l = aux (symbs',fmt) in
-      symbs', UnpBox (a,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
-      let typ = List.nth typs (i-1) in
-      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 ();
-      let symbs, l = aux (symbs,fmt) in
-      let hunk = match typ with
-	| ETConstr _ -> UnpListMetaVar (i,prec,slfmt)
-	| ETBinder isopen ->
-	    check_open_binder isopen sl m;
-	    UnpBinderListMetaVar (i,isopen,slfmt)
-	| _ -> assert false in
-      symbs, hunk :: l
-  | symbs, [] -> symbs, []
-  | _, _ -> error_format ()
-  in
-  match aux symfmt with
-  | [], l -> l
-  | _ -> error_format ()
-
-(**********************************************************************)
-(* Build parsing rules                                                *)
-
-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
-  | _ -> false
-
-let rec define_keywords_aux = function
-  | GramConstrNonTerminal(e,Some _) as n1 :: GramConstrTerminal(IDENT k) :: l
-      when is_not_small_constr e ->
-      Flags.if_verbose Feedback.msg_info (str "Identifier '" ++ str k ++ str "' now a keyword");
-      CLexer.add_keyword k;
-      n1 :: GramConstrTerminal(KEYWORD k) :: define_keywords_aux l
-  | n :: l -> n :: define_keywords_aux l
-  | [] -> []
-
-  (* Ensure that IDENT articulation terminal symbols are keywords *)
-let define_keywords = function
-  | GramConstrTerminal(IDENT k)::l ->
-      Flags.if_verbose Feedback.msg_info (str "Identifier '" ++ str k ++ str "' now a keyword");
-      CLexer.add_keyword k;
-      GramConstrTerminal(KEYWORD k) :: define_keywords_aux l
-  | l -> define_keywords_aux l
-
-let distribute a ll = List.map (fun l -> a @ l) ll
-
-  (* Expand LIST1(t,sep) into the combination of t and t;sep;LIST1(t,sep)
-     as many times as expected in [n] argument *)
-let rec expand_list_rule typ tkl x n i hds ll =
-  if Int.equal i n then
-    let hds =
-      GramConstrListMark (n,true) :: hds
-      @	[GramConstrNonTerminal (ETConstrList (typ,tkl), Some x)] in
-    distribute hds ll
-  else
-    let camlp4_message_name = Some (add_suffix x ("_"^string_of_int n)) in
-    let main = GramConstrNonTerminal (ETConstr typ, camlp4_message_name) in
-    let tks = List.map (fun x -> GramConstrTerminal x) tkl in
-    distribute (GramConstrListMark (i+1,false) :: hds @ [main]) ll @
-      expand_list_rule typ tkl x n (i+1) (main :: tks @ hds) ll
-
-let make_production etyps symbols =
-  let prod =
-    List.fold_right
-      (fun t ll -> match t with
-        | NonTerminal m ->
-	    let typ = List.assoc m etyps in
-	    distribute [GramConstrNonTerminal (typ, Some m)] ll
-        | Terminal s ->
-	    distribute [GramConstrTerminal (CLexer.terminal s)] ll
-        | Break _ ->
-            ll
-        | SProdList (x,sl) ->
-            let tkl = List.flatten
-              (List.map (function Terminal s -> [CLexer.terminal s]
-                | Break _ -> []
-                | _ -> anomaly (Pp.str "Found a non terminal token in recursive notation separator")) sl) in
-	    match List.assoc x etyps with
-            | ETConstr typ -> expand_list_rule typ tkl x 1 0 [] ll
-            | ETBinder o ->
-		distribute
-                  [GramConstrNonTerminal (ETBinderList (o,tkl), Some x)] ll
-            | _ ->
-                error "Components of recursive patterns in notation must be terms or binders.")
-      symbols [[]] in
-  List.map define_keywords prod
-
-let rec find_symbols c_current c_next c_last = function
-  | [] -> []
-  | NonTerminal id :: sl ->
-      let prec = if not (List.is_empty sl) then c_current else c_last in
-      (id, prec) :: (find_symbols c_next c_next c_last sl)
-  | Terminal s :: sl -> find_symbols c_next c_next c_last sl
-  | Break n :: sl -> find_symbols c_current c_next c_last sl
-  | SProdList (x,_) :: sl' ->
-      (x,c_next)::(find_symbols c_next c_next c_last sl')
-
-let border = function
-  | (_,ETConstr(_,BorderProd (_,a))) :: _ -> a
-  | _ -> None
-
-let recompute_assoc typs =
-  match border typs, border (List.rev typs) with
-    | Some LeftA, Some RightA -> assert false
-    | Some LeftA, _ -> Some LeftA
-    | _, Some RightA -> Some RightA
-    | _ -> None
-
-(**************************************************************************)
-(* Registration of syntax extensions (parsing/printing, no interpretation)*)
-
-let pr_arg_level from = 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"
-
-let pr_level ntn (from,args) =
-  str "at level " ++ int from ++ spc () ++ str "with arguments" ++ spc() ++
-  prlist_with_sep pr_comma (pr_arg_level from) args
-
-let error_incompatible_level ntn oldprec prec =
-  errorlabstrm ""
-    (str "Notation " ++ str ntn ++ str " is already defined" ++ spc() ++
-    pr_level ntn oldprec ++
-    spc() ++ str "while it is now required to be" ++ spc() ++
-    pr_level ntn prec ++ str ".")
-
-type syntax_extension = {
-  synext_level : Notation.level;
-  synext_notation : notation;
-  synext_notgram : notation_grammar;
-  synext_unparsing : unparsing list;
-  synext_extra : (string * string) list;
-  synext_compat : Flags.compat_version option;
-}
-
-let is_active_compat = function
-| None -> true
-| Some v -> 0 <= Flags.version_compare v !Flags.compat_version
-
-type syntax_extension_obj = locality_flag * syntax_extension list
-
-let cache_one_syntax_extension se =
-  let ntn = se.synext_notation in
-  let prec = se.synext_level in
-  let onlyprint = se.synext_notgram.notgram_onlyprinting in
-  try
-    let oldprec = Notation.level_of_notation ntn in
-    if not (Notation.level_eq prec oldprec) then error_incompatible_level ntn oldprec prec
-  with Not_found ->
-    if is_active_compat se.synext_compat then begin
-      (* Reserve the notation level *)
-      Notation.declare_notation_level ntn prec;
-      (* Declare the parsing rule *)
-      if not onlyprint then Egramcoq.extend_constr_grammar prec se.synext_notgram;
-      (* Declare the notation rule *)
-      Notation.declare_notation_rule ntn
-        ~extra:se.synext_extra (se.synext_unparsing, fst prec) se.synext_notgram
-    end
-
-let cache_syntax_extension (_, (_, sy)) =
-  List.iter cache_one_syntax_extension sy
-
-let subst_parsing_rule subst x = x
-
-let subst_printing_rule subst x = x
-
-let subst_syntax_extension (subst, (local, sy)) =
-  let map sy = { sy with
-    synext_notgram = subst_parsing_rule subst sy.synext_notgram;
-    synext_unparsing = subst_printing_rule subst sy.synext_unparsing;
-  } in
-  (local, List.map map sy)
-
-let classify_syntax_definition (local, _ as o) =
-  if local then Dispose else Substitute o
-
-let inSyntaxExtension : syntax_extension_obj -> obj =
-  declare_object {(default_object "SYNTAX-EXTENSION") with
-       open_function = (fun i o -> if Int.equal i 1 then cache_syntax_extension o);
-       cache_function = cache_syntax_extension;
-       subst_function = subst_syntax_extension;
-       classify_function = classify_syntax_definition}
-
-(**************************************************************************)
-(* Precedences                                                            *)
-
-(* Interpreting user-provided modifiers *)
-
-let interp_modifiers modl =
-  let onlyparsing = ref false in
-  let onlyprinting = ref false in
-  let compat = ref None in
-  let rec interp assoc level etyps format extra = function
-    | [] ->
-	(assoc,level,etyps,!onlyparsing,!onlyprinting,!compat,format,extra)
-    | SetEntryType (s,typ) :: l ->
-	let id = Id.of_string s in
-	if Id.List.mem_assoc id etyps then
-	  errorlabstrm "Metasyntax.interp_modifiers"
-            (str s ++ str " is already assigned to an entry or constr level.");
-	interp assoc level ((id,typ)::etyps) format extra l
-    | SetItemLevel ([],n) :: l ->
-	interp assoc level etyps format extra l
-    | SetItemLevel (s::idl,n) :: l ->
-	let id = Id.of_string s in
-	if Id.List.mem_assoc id etyps then
-	  errorlabstrm "Metasyntax.interp_modifiers"
-            (str s ++ str " is already assigned to an entry or constr level.");
-	let typ = ETConstr (n,()) in
-	interp assoc level ((id,typ)::etyps) format extra (SetItemLevel (idl,n)::l)
-    | SetLevel n :: l ->
-	if not (Option.is_empty level) then error "A level is given more than once.";
-	interp assoc (Some n) etyps format extra l
-    | SetAssoc a :: l ->
-	if not (Option.is_empty assoc) then error"An associativity is given more than once.";
-	interp (Some a) level etyps format extra l
-    | SetOnlyParsing :: l ->
-	onlyparsing := true;
-	interp assoc level etyps format extra l
-    | SetOnlyPrinting :: l ->
-	onlyprinting := true;
-	interp assoc level etyps format extra l
-    | SetCompatVersion v :: l ->
-        compat := Some v;
-	interp assoc level etyps format extra l
-    | SetFormat ("text",s) :: l ->
-	if not (Option.is_empty format) then error "A format is given more than once.";
-	interp assoc level etyps (Some s) extra l
-    | SetFormat (k,(_,s)) :: l ->
-	interp assoc level etyps format ((k,s) :: extra) l
-  in interp None None [] None [] modl
-
-let check_infix_modifiers modifiers =
-  let (_, _, t, _, _, _, _, _) = interp_modifiers modifiers in
-  if not (List.is_empty t) then
-    error "Explicit entry level or type unexpected in infix notation."
-
-let check_useless_entry_types recvars mainvars etyps =
-  let vars = let (l1,l2) = List.split recvars in l1@l2@mainvars in
-  match List.filter (fun (x,etyp) -> not (List.mem x vars)) etyps with
-  | (x,_)::_ -> errorlabstrm "Metasyntax.check_useless_entry_types"
-                  (pr_id x ++ str " is unbound in the notation.")
-  | _ -> ()
-
-let not_a_syntax_modifier = function
-| SetOnlyParsing -> true
-| SetOnlyPrinting -> true
-| SetCompatVersion _ -> true
-| _ -> false
-
-let no_syntax_modifiers mods = List.for_all not_a_syntax_modifier mods
-
-let is_only_parsing mods =
-  let test = function SetOnlyParsing -> true | _ -> false in
-  List.exists test mods
-
-let is_only_printing mods =
-  let test = function SetOnlyPrinting -> true | _ -> false in
-  List.exists test mods
-
-let get_compat_version mods =
-  let test = function SetCompatVersion v -> Some v | _ -> None in
-  try Some (List.find_map test mods) with Not_found -> None
-
-(* Compute precedences from modifiers (or find default ones) *)
-
-let set_entry_type etyps (x,typ) =
-  let typ = try
-    match List.assoc x etyps, typ with
-      | ETConstr (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
-    with Not_found -> ETConstr typ
-  in (x,typ)
-
-let join_auxiliary_recursive_types recvars etyps =
-  List.fold_right (fun (x,y) typs ->
-    let xtyp = try Some (List.assoc x etyps) with Not_found -> None in
-    let ytyp = try Some (List.assoc y etyps) with Not_found -> None in
-    match xtyp,ytyp with
-    | None, None -> typs
-    | Some _, None -> typs
-    | None, Some ytyp -> (x,ytyp)::typs
-    | Some xtyp, Some ytyp when Pervasives.(=) xtyp ytyp -> typs (* FIXME *)
-    | Some xtyp, Some ytyp ->
-	errorlabstrm ""
-	  (strbrk "In " ++ pr_id x ++ str " .. " ++ pr_id 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 _ -> error "Not supported."
-  | ETBinderList _ | ETConstrList _ -> assert false
-
-let set_internalization_type typs =
-  List.map (fun (_, e) -> internalization_type_of_entry_type e) typs
-
-let make_internalization_vars recvars mainvars typs =
-  let maintyps = List.combine mainvars typs in
-  let extratyps = List.map (fun (x,y) -> (y,List.assoc x maintyps)) recvars in
-  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 -> error "Type binder is only for use in recursive notations for binders."
-
-let make_interpretation_vars recvars allvars =
-  let eq_subscope (sc1, l1) (sc2, l2) =
-    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
-    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
-
-let check_rule_productivity l =
-  if List.for_all (function NonTerminal _ | Break _ -> true | _ -> false) l then
-    error "A notation must include at least one symbol.";
-  if (match l with SProdList _ :: _ -> true | _ -> false) then
-    error "A recursive notation must start with at least one symbol."
-
-let warn_notation_bound_to_variable =
-  CWarnings.create ~name:"notation-bound-to-variable" ~category:"parsing"
-         (fun () ->
-          strbrk "This notation will not be used for printing as it is bound to a single variable.")
-
-let warn_non_reversible_notation =
-  CWarnings.create ~name:"non-reversible-notation" ~category:"parsing"
-         (fun () ->
-          strbrk "This notation will not be used for printing as it is not reversible.")
-
-let is_not_printable onlyparse nonreversible = function
-| NVar _ ->
-  if not onlyparse then warn_notation_bound_to_variable ();
-  true
-| _ ->
-   if not onlyparse && nonreversible then
-     (warn_non_reversible_notation (); true)
-  else onlyparse
-
-let find_precedence lev etyps symbols =
-  let first_symbol =
-    let rec aux = function
-      | Break _ :: t -> aux t
-      | h :: t -> h
-      | [] -> assert false (* rule is known to be productive *) in
-    aux symbols in
-  let last_is_terminal () =
-    let rec aux b = function
-      | Break _ :: t -> aux b t
-      | Terminal _ :: t -> aux true t
-      | _ :: t -> aux false t
-      | [] -> b in
-    aux false symbols in
-  match first_symbol with
-  | NonTerminal x ->
-      (try match List.assoc x etyps with
-	| ETConstr _ ->
-	    error "The level of the leftmost non-terminal cannot be changed."
-	| ETName | ETBigint | ETReference ->
-            begin match lev with
-            | None ->
-	      ([Feedback.msg_info ?loc:None ,strbrk "Setting notation at level 0."],0)
-            | Some 0 ->
-              ([],0)
-            | _ ->
-	      error "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
-	      error "Need an explicit level."
-	    else [],Option.get lev
-        | ETConstrList _ | ETBinderList _ ->
-	    assert false (* internally used in grammar only *)
-      with Not_found ->
-	if Option.is_empty lev then
-	  error "A left-recursive notation must have an explicit level."
-	else [],Option.get lev)
-  | Terminal _ when last_is_terminal () ->
-      if Option.is_empty lev then
-	([Feedback.msg_info ?loc:None ,strbrk "Setting notation at level 0."], 0)
-      else [],Option.get lev
-  | _ ->
-      if Option.is_empty lev then error "Cannot determine the level.";
-      [],Option.get lev
-
-let check_curly_brackets_notation_exists () =
-  try let _ = Notation.level_of_notation "{ _ }" in ()
-  with Not_found ->
-    error "Notations involving patterns of the form \"{ _ }\" are treated \n\
-specially and require that the notation \"{ _ }\" is already reserved."
-
-let warn_skip_spaces_curly =
-  CWarnings.create ~name:"skip-spaces-curly" ~category:"parsing"
-      (fun () ->strbrk "Skipping spaces inside curly brackets")
-
-(* Remove patterns of the form "{ _ }", unless it is the "{ _ }" notation *)
-let remove_curly_brackets l =
-  let rec skip_break acc = function
-    | Break _ as br :: l -> skip_break (br::acc) l
-    | l -> List.rev acc, l in
-  let rec aux deb = function
-  | [] -> []
-  | Terminal "{" as t1 :: l ->
-      let br,next = skip_break [] l in
-      (match next with
-        | NonTerminal _ as x :: l' as l0 ->
-            let br',next' = skip_break [] l' in
-            (match next' with
-              | Terminal "}" as t2 :: l'' as l1 ->
-                 if not (List.equal Notation.symbol_eq l l0) ||
-		      not (List.equal Notation.symbol_eq l' l1) then
-		  warn_skip_spaces_curly ();
-		  if deb && List.is_empty l'' then [t1;x;t2] else begin
-                    check_curly_brackets_notation_exists ();
-                    x :: aux false l''
-                  end
-              | l1 -> t1 :: br @ x :: br' @ aux false l1)
-        | l0 -> t1 :: aux false l0)
-  | x :: l -> x :: aux false l
-  in aux true l
-
-let compute_syntax_data df modifiers =
-  let (assoc,n,etyps,onlyparse,onlyprint,compat,fmt,extra) = interp_modifiers modifiers in
-  let assoc = match assoc with None -> (* default *) Some NonA | a -> a in
-  let toks = split_notation_string df in
-  let (recvars,mainvars,symbols) = analyze_notation_tokens toks in
-  let _ = check_useless_entry_types recvars mainvars etyps in
-  let ntn_for_interp = make_notation_key symbols in
-  let symbols' = remove_curly_brackets symbols in
-  let need_squash = not (List.equal Notation.symbol_eq symbols symbols') in
-  let ntn_for_grammar = make_notation_key symbols' in
-  check_rule_productivity symbols';
-  let msgs,n = find_precedence n etyps symbols' in
-  let innerlevel = NumLevel 200 in
-  let typs =
-    find_symbols
-      (NumLevel n,BorderProd(Left,assoc))
-      (innerlevel,InternalProd)
-      (NumLevel n,BorderProd(Right,assoc))
-      symbols' in
-  (* To globalize... *)
-  let etyps = join_auxiliary_recursive_types recvars etyps in
-  let sy_typs = List.map (set_entry_type etyps) typs in
-  let prec = (n,List.map (assoc_of_type n) sy_typs) in
-  let i_typs = set_internalization_type sy_typs in
-  let sy_data = (n,sy_typs,symbols',fmt) in
-  let sy_fulldata = (i_typs,ntn_for_grammar,prec,need_squash,sy_data) in
-  let df' = ((Lib.library_dp(),Lib.current_dirpath true),df) in
-  let i_data = (onlyparse,onlyprint,compat,recvars,mainvars,(ntn_for_interp,df')) in
-  (* Return relevant data for interpretation and for parsing/printing *)
-  (msgs,i_data,i_typs,sy_fulldata,extra)
-
-let compute_pure_syntax_data df mods =
-  let (msgs,(onlyparse,onlyprint,_,_,_,_),_,sy_data,extra) = compute_syntax_data df mods in
-  let msgs =
-    if onlyparse then
-      (Feedback.msg_warning ?loc:None,
-      strbrk "The only parsing modifier has no effect in Reserved Notation.")::msgs
-    else msgs in
-  msgs, sy_data, extra, onlyprint
-
-(**********************************************************************)
-(* Registration of notations interpretation                            *)
-
-type notation_obj = {
-  notobj_local : bool;
-  notobj_scope : scope_name option;
-  notobj_interp : interpretation;
-  notobj_onlyparse : bool;
-  notobj_onlyprint : bool;
-  notobj_compat : Flags.compat_version option;
-  notobj_notation : notation * notation_location;
-}
-
-let load_notation _ (_, nobj) =
-  Option.iter Notation.declare_scope nobj.notobj_scope
-
-let open_notation i (_, nobj) =
-  let scope = nobj.notobj_scope in
-  let (ntn, df) = nobj.notobj_notation in
-  let pat = nobj.notobj_interp in
-  let fresh = not (Notation.exists_notation_in_scope scope ntn pat) in
-  let active = is_active_compat nobj.notobj_compat in
-  if Int.equal i 1 && fresh && active then begin
-    (* Declare the interpretation *)
-    let onlyprint = nobj.notobj_onlyprint  in
-    let () = Notation.declare_notation_interpretation ntn scope pat df ~onlyprint in
-    (* Declare the uninterpretation *)
-    if not nobj.notobj_onlyparse then
-      Notation.declare_uninterpretation (NotationRule (scope, ntn)) pat
-  end
-
-let cache_notation o =
-  load_notation 1 o;
-  open_notation 1 o
-
-let subst_notation (subst, nobj) =
-  { nobj with notobj_interp = subst_interpretation subst nobj.notobj_interp; }
-
-let classify_notation nobj =
-  if nobj.notobj_local then Dispose else Substitute nobj
-
-let inNotation : notation_obj -> obj =
-  declare_object {(default_object "NOTATION") with
-       open_function = open_notation;
-       cache_function = cache_notation;
-       subst_function = subst_notation;
-       load_function = load_notation;
-       classify_function = classify_notation}
-
-(**********************************************************************)
-
-let with_lib_stk_protection f x =
-  let fs = Lib.freeze `No in
-  try let a = f x in Lib.unfreeze fs; a
-  with reraise ->
-    let reraise = CErrors.push reraise in
-    let () = Lib.unfreeze fs in
-    iraise reraise
-
-let with_syntax_protection f x =
-  with_lib_stk_protection
-    (with_grammar_rule_protection
-       (with_notation_protection f)) x
-
-(**********************************************************************)
-(* Recovering existing syntax                                         *)
-
-let contract_notation ntn =
-  if String.equal ntn "{ _ }" then ntn else
-  let rec aux ntn i =
-    if i <= String.length ntn - 5 then
-      let ntn' =
-        if String.is_sub "{ _ }" ntn i &&
-           (i = 0 || ntn.[i-1] = ' ') &&
-           (i = String.length ntn - 5 || ntn.[i+5] = ' ')
-        then
-          String.sub ntn 0 i ^ "_" ^
-          String.sub ntn (i+5) (String.length ntn -i-5)
-        else ntn in
-      aux ntn' (i+1)
-    else ntn in
-  aux ntn 0
-
-exception NoSyntaxRule
-
-let recover_syntax ntn =
-  try
-    let prec = Notation.level_of_notation ntn in
-    let pp_rule,_ = Notation.find_notation_printing_rule ntn in
-    let pp_extra_rules = Notation.find_notation_extra_printing_rules ntn in
-    let pa_rule = Notation.find_notation_parsing_rules ntn in
-    { synext_level = prec;
-      synext_notation = ntn;
-      synext_notgram = pa_rule;
-      synext_unparsing = pp_rule;
-      synext_extra = pp_extra_rules;
-      synext_compat = None;
-    }
-  with Not_found ->
-    raise NoSyntaxRule
-
-let recover_squash_syntax sy =
-  let sq = recover_syntax "{ _ }" in
-  [sy; sq]
-
-let recover_notation_syntax rawntn =
-  let ntn = contract_notation rawntn in
-  let sy = recover_syntax ntn in
-  let need_squash = not (String.equal ntn rawntn) in
-  let rules = if need_squash then recover_squash_syntax sy else [sy] in
-  sy.synext_notgram.notgram_typs, rules, sy.synext_notgram.notgram_onlyprinting
-
-(**********************************************************************)
-(* Main entry point for building parsing and printing rules           *)
-
-let make_pa_rule i_typs (n,typs,symbols,_) ntn onlyprint =
-  let assoc = recompute_assoc typs in
-  let prod = make_production typs symbols in
-  { notgram_level = n;
-    notgram_assoc = assoc;
-    notgram_notation = ntn;
-    notgram_prods = prod;
-    notgram_typs = i_typs;
-    notgram_onlyprinting = onlyprint;
-  }
-
-let make_pp_rule (n,typs,symbols,fmt) =
-  match fmt with
-  | None -> [UnpBox (PpHOVB 0, make_hunks typs symbols n)]
-  | Some fmt -> hunks_of_format (n, List.split typs) (symbols, parse_format fmt)
-
-let make_syntax_rules (i_typs,ntn,prec,need_squash,sy_data) extra onlyprint compat =
-  let pa_rule = make_pa_rule i_typs sy_data ntn onlyprint in
-  let pp_rule = make_pp_rule sy_data in
-  let sy = {
-    synext_level = prec;
-    synext_notation = ntn;
-    synext_notgram = pa_rule;
-    synext_unparsing = pp_rule;
-    synext_extra = extra;
-    synext_compat = compat;
-  } in
-  (* By construction, the rule for "{ _ }" is declared, but we need to
-     redeclare it because the file where it is declared needs not be open
-     when the current file opens (especially in presence of -nois) *)
-  if need_squash then recover_squash_syntax sy else [sy]
-
-(**********************************************************************)
-(* Main functions about notations                                     *)
-
-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 (msgs,i_data,i_typs,sy_data,extra) = compute_syntax_data df mods in
-  (* Prepare the interpretation *)
-  let (onlyparse, onlyprint, compat, recvars,mainvars, df') = i_data in
-  (* Prepare the parsing and printing rules *)
-  let sy_rules = make_syntax_rules sy_data extra onlyprint compat in
-  let i_vars = make_internalization_vars recvars mainvars i_typs in
-  let nenv = {
-    ninterp_var_type = to_map i_vars;
-    ninterp_rec_vars = to_map recvars;
-  } in
-  let (acvars, ac, reversible) = interp_notation_constr nenv c in
-  let interp = make_interpretation_vars recvars acvars in
-  let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in
-  let onlyparse = is_not_printable onlyparse (not reversible) ac in
-  let notation = {
-    notobj_local = local;
-    notobj_scope = scope;
-    notobj_interp = (List.map_filter map i_vars, ac);
-    (** Order is important here! *)
-    notobj_onlyparse = onlyparse;
-    notobj_onlyprint = onlyprint;
-    notobj_compat = compat;
-    notobj_notation = df';
-  } in
-  (* Ready to change the global state *)
-  Flags.if_verbose (List.iter (fun (f,x) -> f x)) msgs;
-  Lib.add_anonymous_leaf (inSyntaxExtension (local, sy_rules));
-  Lib.add_anonymous_leaf (inNotation notation);
-  df'
-
-let add_notation_interpretation_core local df ?(impls=empty_internalization_env) c scope onlyparse onlyprint compat =
-  let dfs = split_notation_string df in
-  let (recvars,mainvars,symbs) = analyze_notation_tokens dfs in
-  (* Recover types of variables and pa/pp rules; redeclare them if needed *)
-  let i_typs, onlyprint = if not (is_numeral symbs) then begin
-    let i_typs,sy_rules,onlyprint' = recover_notation_syntax (make_notation_key symbs) in
-    let () = Lib.add_anonymous_leaf (inSyntaxExtension (local,sy_rules)) in
-    (** If the only printing flag has been explicitly requested, put it back *)
-    let onlyprint = onlyprint || onlyprint' in
-    i_typs, onlyprint
-  end else [], false in
-  (* Declare interpretation *)
-  let path = (Lib.library_dp(),Lib.current_dirpath true) in
-  let df' = (make_notation_key symbs,(path,df)) in
-  let i_vars = make_internalization_vars recvars mainvars i_typs in
-  let nenv = {
-    ninterp_var_type = to_map i_vars;
-    ninterp_rec_vars = to_map recvars;
-  } in
-  let (acvars, ac, reversible) = interp_notation_constr ~impls nenv c in
-  let interp = make_interpretation_vars recvars acvars in
-  let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in
-  let onlyparse = is_not_printable onlyparse (not reversible) ac in
-  let notation = {
-    notobj_local = local;
-    notobj_scope = scope;
-    notobj_interp = (List.map_filter map i_vars, ac);
-    (** Order is important here! *)
-    notobj_onlyparse = onlyparse;
-    notobj_onlyprint = onlyprint;
-    notobj_compat = compat;
-    notobj_notation = df';
-  } in
-  Lib.add_anonymous_leaf (inNotation notation);
-  df'
-
-(* Notations without interpretation (Reserved Notation) *)
-
-let add_syntax_extension local ((loc,df),mods) =
-  let msgs, sy_data, extra, onlyprint = compute_pure_syntax_data df mods in
-  let sy_rules = make_syntax_rules sy_data extra onlyprint None in
-  Flags.if_verbose (List.iter (fun (f,x) -> f x)) msgs;
-  Lib.add_anonymous_leaf (inSyntaxExtension(local,sy_rules))
-
-(* Notations with only interpretation *)
-
-let add_notation_interpretation ((loc,df),c,sc) =
-  let df' = add_notation_interpretation_core false df c sc false false None in
-  Dumpglob.dump_notation (loc,df') sc true
-
-let set_notation_for_interpretation impls ((_,df),c,sc) =
-  (try ignore
-    (silently (fun () -> add_notation_interpretation_core false df ~impls c sc false false None) ());
-  with NoSyntaxRule ->
-    error "Parsing rule for this notation has to be previously declared.");
-  Option.iter (fun sc -> Notation.open_close_scope (false,true,sc)) sc
-
-(* Main entry point *)
-
-let add_notation local c ((loc,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
-    with NoSyntaxRule ->
-      (* Try to determine a default syntax rule *)
-      add_notation_in_scope local df c modifiers sc
-   else
-    (* Declare both syntax and interpretation *)
-    add_notation_in_scope local df c modifiers sc
-  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 dfs in
-    make_notation_key symbs in
-  Notation.add_notation_extra_printing_rule notk k v
-
-(* Infix notations *)
-
-let inject_var x = CRef (Ident (Loc.ghost, Id.of_string x),None)
-
-let add_infix local ((loc,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
-
-(**********************************************************************)
-(* Delimiters and classes bound to scopes                             *)
-
-type scope_command =
-  | ScopeDelim of string
-  | ScopeClasses of scope_class list
-  | ScopeRemove
-
-let load_scope_command _ (_,(scope,dlm)) =
-  Notation.declare_scope scope
-
-let open_scope_command i (_,(scope,o)) =
-  if Int.equal i 1 then
-    match o with
-    | ScopeDelim dlm -> Notation.declare_delimiters scope dlm
-    | ScopeClasses cl -> List.iter (Notation.declare_scope_class scope) cl
-    | ScopeRemove -> Notation.remove_delimiters scope
-
-let cache_scope_command o =
-  load_scope_command 1 o;
-  open_scope_command 1 o
-
-let subst_scope_command (subst,(scope,o as x)) = match o with
-  | ScopeClasses cl ->
-      let cl' = List.map_filter (subst_scope_class subst) cl in
-      let cl' =
-        if List.for_all2eq (==) cl cl' then cl
-        else cl' in
-      scope, ScopeClasses cl'
-  | _ -> x
-
-let inScopeCommand : scope_name * scope_command -> obj =
-  declare_object {(default_object "DELIMITERS") with
-      cache_function = cache_scope_command;
-      open_function = open_scope_command;
-      load_function = load_scope_command;
-      subst_function = subst_scope_command;
-      classify_function = (fun obj -> Substitute obj)}
-
-let add_delimiters scope key =
-  Lib.add_anonymous_leaf (inScopeCommand(scope,ScopeDelim key))
-
-let remove_delimiters scope =
-  Lib.add_anonymous_leaf (inScopeCommand(scope,ScopeRemove))
-
-let add_class_scope scope cl =
-  Lib.add_anonymous_leaf (inScopeCommand(scope,ScopeClasses cl))
-
-(* Check if abbreviation to a name and avoid early insertion of
-   maximal implicit arguments *)
-let try_interp_name_alias = function
-  | [], 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))
-    with Not_found ->
-      let fold accu id = Id.Map.add id NtnInternTypeConstr 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
-  in
-  let onlyparse = match onlyparse with
-    | None when (is_not_printable false !nonprintable pat) -> Some Flags.Current
-    | p -> p
-  in
-  Syntax_def.declare_syntactic_definition local ident onlyparse (vars,pat)
-
diff --git a/toplevel/record.mli b/toplevel/record.mli
deleted file mode 100644
index c50e5778..00000000
--- a/toplevel/record.mli
+++ /dev/null
@@ -1,46 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open 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 ->
-  bool (** polymorphic?*) -> Univ.universe_context ->
-  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
-
-val definition_structure :
-  inductive_kind * Decl_kinds.polymorphic * Decl_kinds.recursivity_kind *
-  plident with_coercion * local_binder list *
-  (local_decl_expr with_instance with_priority with_notation) list *
-  Id.t * constr_expr option -> global_reference
-
-val declare_existing_class : global_reference -> unit
diff --git a/toplevel/toplevel.mllib b/toplevel/toplevel.mllib
index d6892236..9fb2e33d 100644
--- a/toplevel/toplevel.mllib
+++ b/toplevel/toplevel.mllib
@@ -1,21 +1,6 @@
-Himsg
-ExplainErr
-Class
-Locality
-Metasyntax
-Auto_ind_decl
-Search
-Indschemes
-Obligations
-Command
-Classes
-Record
-Assumptions
-Vernacinterp
-Mltop
-Vernacentries
 Vernac
 Usage
 Coqloop
 Coqinit
+Coqargs
 Coqtop
diff --git a/toplevel/usage.ml b/toplevel/usage.ml
index 38ceacf5..504ffa52 100644
--- a/toplevel/usage.ml
+++ b/toplevel/usage.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 let version ret =
@@ -30,7 +32,7 @@ let print_usage_channel co command =
 \n  -R dir coqdir          recursively map physical dir to logical coqdir\
 \n  -Q dir coqdir          map physical dir to logical coqdir\
 \n  -top coqdir            set the toplevel name to be coqdir instead of Top\
-\n  -notop                 set the toplevel name to be the empty logical path\
+\n  -coqlib dir            set the coq standard library directory\
 \n  -exclude-dir f         exclude subdirectories named f for option -R\
 \n\
 \n  -noinit                start without loading the Init library\
@@ -56,7 +58,8 @@ let print_usage_channel co command =
 \n\
 \n  -where                 print Coq's standard library location and exit\
 \n  -config, --config      print Coq's configuration information and exit\
-\n  -v                     print Coq version and exit\
+\n  -v, --version          print Coq version and exit\
+\n  -print-version         print Coq version in easy to parse format and exit\
 \n  -list-tags             print highlight color tags known by Coq and exit\
 \n\
 \n  -quiet                 unset display of extra information (implies -w \"-all\")\
@@ -69,22 +72,20 @@ let print_usage_channel co command =
 \n  -boot                  boot mode (implies -q and -batch)\
 \n  -bt                    print backtraces (requires configure debug flag)\
 \n  -debug                 debug mode (implies -bt)\
+\n  -stm-debug             STM debug mode (will trace every transaction) \
 \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\
-\n  -xml                   export XML files either to the hierarchy rooted in\
-\n                         the directory $COQ_XML_LIBRARY_ROOT (if set) or to\
-\n                         stdout (if unset)\
+\n  -mangle-names x        mangle auto-generated names using prefix x\
 \n  -time                  display the time taken by each command\
 \n  -profile-ltac          display the time taken by each (sub)tactic\
 \n  -m, --memory           display total heap size at program exit\
 \n                         (use environment variable\
 \n                          OCAML_GC_STATS=\"/tmp/gclog.txt\"\
-\n                          for full Gc stats dump)
+\n                          for full Gc stats dump)\
 \n  -native-compiler       precompile files for the native_compute machinery\
 \n  -h, -help, --help      print this list of options\
 \n";
@@ -115,16 +116,3 @@ let print_usage_coqc () =
   flush stderr ;
   exit 1
 
-(* Print the configuration information *)
-
-let print_config () =
-  if Coq_config.local then Printf.printf "LOCAL=1\n" else Printf.printf "LOCAL=0\n";
-  Printf.printf "COQLIB=%s/\n" (Envars.coqlib ());
-  Printf.printf "DOCDIR=%s/\n" (Envars.docdir ());
-  Printf.printf "OCAMLFIND=%s\n" (Envars.ocamlfind ());
-  Printf.printf "CAMLP4=%s\n" Coq_config.camlp4;
-  Printf.printf "CAMLP4O=%s\n" Coq_config.camlp4o;
-  Printf.printf "CAMLP4BIN=%s/\n" (Envars.camlp4bin ());
-  Printf.printf "CAMLP4LIB=%s\n" (Envars.camlp4lib ());
-  Printf.printf "CAMLP4OPTIONS=%s\n" Coq_config.camlp4compat;
-  Printf.printf "HASNATDYNLINK=%s\n" (if Coq_config.has_natdynlink then "true" else "false")
diff --git a/toplevel/usage.mli b/toplevel/usage.mli
index dccb40e7..fbb0117d 100644
--- a/toplevel/usage.mli
+++ b/toplevel/usage.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {6 Prints the version number on the standard output and exits (with 0). } *)
@@ -21,5 +23,3 @@ val add_to_usage : string -> string -> unit
 val print_usage_coqtop : unit -> unit
 val print_usage_coqc : unit -> unit
 
-(** {6 Prints the configuration information } *)
-val print_config : unit -> unit
diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml
index bfdae85d..fdd0d4ed 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Parsing of vernacular. *)
@@ -11,165 +13,48 @@
 open Pp
 open CErrors
 open Util
-open Flags
 open Vernacexpr
+open Vernacprop
 
 (* The functions in this module may raise (unexplainable!) exceptions.
    Use the module Coqtoplevel, which catches these exceptions
    (the exceptions are explained only at the toplevel). *)
 
-let user_error loc s = CErrors.user_err_loc (loc,"_",str s)
-
-(* Navigation commands are allowed in a coqtop session but not in a .v file *)
-
-let rec is_navigation_vernac = function
-  | VernacResetInitial
-  | VernacResetName _
-  | VernacBacktrack _
-  | VernacBackTo _
-  | VernacBack _
-  | 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
-  | _ -> false
-
-(* NB: Reset is now allowed again as asked by A. Chlipala *)
-
-let is_reset = function
-  | VernacResetInitial | VernacResetName _ -> true
-  | _ -> false
-
-let checknav_simple loc cmd =
+let checknav_simple {CAst.loc;v=cmd} =
   if is_navigation_vernac cmd && not (is_reset cmd) then
-    user_error loc "Navigation commands forbidden in files."
+    CErrors.user_err ?loc (str "Navigation commands forbidden in files.")
 
-let checknav_deep loc ast =
+let checknav_deep {CAst.loc;v=ast} =
   if is_deep_navigation_vernac ast then
-    user_error loc "Navigation commands forbidden in nested commands."
-
-(* When doing Load on a file, two behaviors are possible:
-
-   - either the history stack is grown by only one command,
-     the "Load" itself. This is mandatory for command-counting
-     interfaces (CoqIDE).
-
-   - either each individual sub-commands in the file is added
-     to the history stack. This allows commands like Show Script
-     to work across the loaded file boundary (cf. bug #2820).
-
-   The best of the two could probably be combined someday,
-   in the meanwhile we use a flag. *)
-
-let atomic_load = ref true
-
-let _ =
-  Goptions.declare_bool_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
-      Goptions.optname  = "atomic registration of commands in a Load";
-      Goptions.optkey   = ["Atomic";"Load"];
-      Goptions.optread  = (fun () -> !atomic_load);
-      Goptions.optwrite = ((:=) atomic_load) }
+    CErrors.user_err ?loc (str "Navigation commands forbidden in nested commands.")
 
 let disable_drop = function
-  | Drop -> CErrors.error "Drop is forbidden."
+  | Drop -> CErrors.user_err Pp.(str "Drop is forbidden.")
   | e -> e
 
-(* Opening and closing a channel. Open it twice when verbose: the first
-   channel is used to read the commands, and the second one to print them.
-   Note: we could use only one thanks to seek_in, but seeking on and on in
-   the file we parse seems a bit risky to me.  B.B.  *)
-
-let open_file_twice_if verbosely longfname =
-  let in_chan = open_utf8_file_in longfname in
-  let verb_ch =
-    if verbosely then Some (open_utf8_file_in longfname) else None in
-  let po = Pcoq.Gram.parsable ~file:longfname (Stream.of_channel in_chan) in
-  (in_chan, longfname, (po, verb_ch))
-
-let close_input in_chan (_,verb) =
-  try
-    close_in in_chan;
-    match verb with
-      | Some verb_ch -> close_in verb_ch
-      | _ -> ()
-  with e when CErrors.noncritical e -> ()
-
-let verbose_phrase verbch loc =
-  let loc = Loc.unloc loc in
-  match verbch with
-    | Some ch ->
-	let len = snd loc - fst loc in
-	let s = String.create len in
-        seek_in ch (fst loc);
-        really_input ch s 0 len;
-        Feedback.msg_notice (str s)
-    | None -> ()
-
-exception End_of_input
-
-let parse_sentence = Flags.with_option Flags.we_are_parsing
-  (fun (po, verbch) ->
-  match Pcoq.Gram.entry_parse Pcoq.main_entry po with
-    | Some (loc,_ as com) -> verbose_phrase verbch loc; com
-    | None -> raise End_of_input)
-
-(* vernac parses the given stream, executes interpfun on the syntax tree it
- * parses, and is verbose on "primitives" commands if verbosely is true *)
-
-let chan_beautify = ref stdout
-let beautify_suffix = ".beautified"
-
-let set_formatter_translator ch =
-  let out s b e = output ch s b e in
-  Format.set_formatter_output_functions out (fun () -> flush ch);
-  Format.set_max_boxes max_int
-
-let pr_new_syntax_in_context loc chan_beautify ocom =
-  let loc = Loc.unloc 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.msg_with !Pp_control.std_ft (hov 0 (before ++ com ++ after))
-    else
-      Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com)));
-    States.unfreeze fs;
-    Format.set_formatter_out_channel stdout
-  with any ->
-    States.unfreeze fs;
-    Format.set_formatter_out_channel stdout
-
-let pr_new_syntax po loc chan_beautify ocom =
-  (* Reinstall the context of parsing which includes the bindings of comments to locations *)
-  Pcoq.Gram.with_parsable po (pr_new_syntax_in_context chan_beautify loc) ocom
+(* Echo from a buffer based on position.
+   XXX: Should move to utility file. *)
+let vernac_echo ?loc in_chan = let open Loc in
+  Option.iter (fun loc ->
+      let len = loc.ep - loc.bp in
+      seek_in in_chan loc.bp;
+      Feedback.msg_notice @@ str @@ really_input_string in_chan len
+    ) loc
 
 (* For coqtop -time, we display the position in the file,
    and a glimpse of the executed command *)
 
-let pp_cmd_header loc com =
-  let shorten s = try (String.sub s 0 30)^"..." with _ -> s in
-  let noblank s =
-    for i = 0 to String.length s - 1 do
-      match s.[i] with
-	| ' ' | '\n' | '\t' | '\r' -> s.[i] <- '~'
-	| _ -> ()
-    done;
-    s
+let pp_cmd_header {CAst.loc;v=com} =
+  let shorten s =
+    if Unicode.utf8_length s > 33 then (Unicode.utf8_sub s 0 30) ^ "..." else s
   in
-  let (start,stop) = Loc.unloc loc in
+  let noblank s = String.map (fun c ->
+      match c with
+	| ' ' | '\n' | '\t' | '\r' -> '~'
+	| x -> x
+      ) s
+  in
+  let (start,stop) = Option.cata Loc.unloc (0,0) loc in
   let safe_pr_vernac x =
     try Ppvernac.pr_vernac x
     with e -> str (Printexc.to_string e) in
@@ -180,173 +65,164 @@ let pp_cmd_header loc com =
 (* This is a special case where we assume we are in console batch mode
    and take control of the console.
  *)
-let print_cmd_header loc com =
-  Pp.pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.std_ft (pp_cmd_header loc com);
-  Format.pp_print_flush !Pp_control.std_ft ()
+let print_cmd_header com =
+  Pp.pp_with !Topfmt.std_ft (pp_cmd_header com);
+  Format.pp_print_flush !Topfmt.std_ft ()
 
-let rec interp_vernac po chan_beautify checknav (loc,com) =
-  let interp = function
-    | VernacLoad (verbosely, fname) ->
-	let fname = Envars.expand_path_macros ~warn:(fun x -> Feedback.msg_warning (str x)) fname in
-        let fname = CUnix.make_suffix fname ".v" in
-        let f = Loadpath.locate_file fname in
-        load_vernac verbosely f
+(* Reenable when we get back to feedback printing *)
+(* let is_end_of_input any = match any with *)
+(*     Stm.End_of_input -> true *)
+(*   | _ -> false *)
 
-    | v -> Stm.interp (Flags.is_verbose()) (loc,v)
-  in
+module State = struct
+
+  type t = {
+    doc : Stm.doc;
+    sid : Stateid.t;
+    proof : Proof.t option;
+  }
+
+end
+
+let interp_vernac ~time ~check ~interactive ~state ({CAst.loc;_} as com) =
+  let open State in
     try
-      checknav loc com;
-      if !beautify then pr_new_syntax po chan_beautify loc (Some com);
-      (* XXX: This is not 100% correct if called from an IDE context *)
-      if !Flags.time then print_cmd_header loc com;
-      let com = if !Flags.time then VernacTime (loc,com) else com in
-      interp com
+      (* The -time option is only supported from console-based clients
+         due to the way it prints. *)
+      if time then print_cmd_header com;
+      let com = if time then CAst.make ?loc @@ VernacTime(time,com) else com in
+      let doc, nsid, ntip = Stm.add ~doc:state.doc ~ontop:state.sid (not !Flags.quiet) com 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 ndoc = if check then Stm.finish ~doc else doc in
+      let new_proof = Proof_global.give_me_the_proof_opt () in
+      { doc = ndoc; sid = nsid; proof = new_proof }
     with reraise ->
+      (* XXX: In non-interactive mode edit_at seems to do very weird
+         things, so we better avoid it while we investigate *)
+      if interactive then ignore(Stm.edit_at ~doc:state.doc state.sid);
       let (reraise, info) = CErrors.push reraise in
-      let loc' = Option.default Loc.ghost (Loc.get_loc info) in
-      if Loc.is_ghost loc' then iraise (reraise, Loc.add_loc info loc)
-      else iraise (reraise, info)
+      let info = begin
+        match Loc.get_loc info with
+        | None   -> Option.cata (Loc.add_loc info) info loc
+        | Some _ -> info
+      end in iraise (reraise, info)
 
 (* Load a vernac file. CErrors are annotated with file and location *)
-and load_vernac verbosely file =
-  let chan_beautify =
-    if !Flags.beautify_file then open_out (file^beautify_suffix) else stdout in
-  let (in_chan, fname, input) = open_file_twice_if verbosely file in
+let load_vernac_core ~time ~echo ~check ~interactive ~state file =
+  (* Keep in sync *)
+  let in_chan = open_utf8_file_in file in
+  let in_echo = if echo then Some (open_utf8_file_in file) else None in
+  let input_cleanup () = close_in in_chan; Option.iter close_in in_echo in
+
+  let in_pa   = Pcoq.Gram.parsable ~file:(Loc.InFile file) (Stream.of_channel in_chan) in
+  let rstate  = ref state in
+  (* For beautify, list of parsed sids *)
+  let rids    = ref [] 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 = Flags.silently parse_sentence input in
-      CWarnings.set_current_loc (fst loc_ast);
-      Flags.silently (interp_vernac (fst input) chan_beautify checknav_simple) loc_ast;
-    done
+      let { CAst.loc; _ } as ast =
+          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
+           all the errors as feedback events, thus in this case we
+           should relay the exception here for convenience. A
+           possibility is shown below, however we may want to refactor
+           this code:
+
+        try Stm.parse_sentence !rsid in_pa
+        with
+        | any when not is_end_of_input any ->
+          let (e, info) = CErrors.push any in
+          let loc = Loc.get_loc info in
+          let msg = CErrors.iprint (e, info) in
+          Feedback.msg_error ?loc msg;
+          iraise (e, info)
+       *)
+      in
+      (* Printing of vernacs *)
+      Option.iter (vernac_echo ?loc) in_echo;
+
+      checknav_simple ast;
+      let state = Flags.silently (interp_vernac ~time ~check ~interactive ~state:!rstate) ast in
+      rids := state.sid :: !rids;
+      rstate := state;
+    done;
+    input_cleanup ();
+    !rstate, !rids, Pcoq.Gram.comment_state in_pa
   with any ->   (* whatever the exception *)
     let (e, info) = CErrors.push any in
-    close_input in_chan input;    (* we must close the file first *)
+    input_cleanup ();
     match e with
-      | End_of_input ->
-          if !beautify then
-            pr_new_syntax (fst input) chan_beautify (Loc.make_loc (max_int,max_int)) None;
-          if !Flags.beautify_file then close_out chan_beautify;
-      | reraise ->
-         if !Flags.beautify_file then close_out chan_beautify;
-	 iraise (disable_drop e, info)
-
-(** [eval_expr : ?preserving:bool -> Loc.t * Vernacexpr.vernac_expr -> unit]
-   It executes one vernacular command. By default the command is
-   considered as non-state-preserving, in which case we add it to the
-   Backtrack stack (triggering a save of a frozen state and the generation
-   of a new state label). An example of state-preserving command is one coming
-   from the query panel of Coqide. *)
-
-let process_expr po loc_ast = interp_vernac po stdout checknav_deep loc_ast
-
-(* XML output hooks *)
-let (f_xml_start_library, xml_start_library) = Hook.make ~default:ignore ()
-let (f_xml_end_library, xml_end_library) = Hook.make ~default:ignore ()
+    | Stm.End_of_input -> !rstate, !rids, Pcoq.Gram.comment_state in_pa
+    | reraise -> iraise (disable_drop e, info)
 
-let warn_file_no_extension =
-  CWarnings.create ~name:"file-no-extension" ~category:"filesystem"
-         (fun (f,ext) ->
-          str "File \"" ++ str f ++
-            strbrk "\" has been implicitly expanded to \"" ++
-            str f ++ str ext ++ str "\"")
+let process_expr ~time ~state loc_ast =
+  checknav_deep loc_ast;
+  interp_vernac ~time ~interactive:true ~check:true ~state loc_ast
 
-let ensure_ext ext f =
-  if Filename.check_suffix f ext then f
-  else begin
-    warn_file_no_extension (f,ext);
-    f ^ ext
-  end
+(******************************************************************************)
+(* Beautify-specific code                                                     *)
+(******************************************************************************)
 
-let chop_extension f =
-  try Filename.chop_extension f with _ -> f
-
-let ensure_bname src tgt =
-  let src, tgt = Filename.basename src, Filename.basename tgt in
-  let src, tgt = chop_extension src, chop_extension tgt in
-  if src <> tgt then begin
-    Feedback.msg_error (str "Source and target file names must coincide, directories can differ");
-    Feedback.msg_error (str "Source: " ++ str src);
-    Feedback.msg_error (str "Target: " ++ str tgt);
-    flush_all ();
-    exit 1
-  end
-
-let ensure ext src tgt = ensure_bname src tgt; ensure_ext ext tgt
-
-let ensure_v v = ensure ".v" v v
-let ensure_vo v vo = ensure ".vo" v vo
-let ensure_vio v vio = ensure ".vio" v vio
-
-let ensure_exists f =
-  if not (Sys.file_exists f) then begin
-    Feedback.msg_error (hov 0 (str "Can't find file" ++ spc () ++ str f));
-    exit 1
-  end
-
-(* Compile a vernac file *)
-let compile verbosely f =
-  let check_pending_proofs () =
-    let pfs = Pfedit.get_all_proof_names () in
-    if not (List.is_empty pfs) then
-      (Feedback.msg_error (str "There are pending proofs"); flush_all (); exit 1) 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");
-      if !Flags.xml_export then Hook.get f_xml_start_library ();
-      let wall_clock1 = Unix.gettimeofday () in
-      let _ = load_vernac verbosely 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 Loc.ghost "vo_compile_time"
-        (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1));
-      Aux_file.stop_aux_file ();
-      if !Flags.xml_export then Hook.get f_xml_end_library ();
-      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 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
+(* vernac parses the given stream, executes interpfun on the syntax tree it
+ * parses, and is verbose on "primitives" commands if verbosely is true *)
+let beautify_suffix = ".beautified"
 
-let () = Hook.set Stm.process_error_hook
-  ExplainErr.process_vernac_interp_error
+let set_formatter_translator ch =
+  let out s b e = output_substring ch s b e in
+  let ft = Format.make_formatter out (fun () -> flush ch) in
+  Format.pp_set_max_boxes ft max_int;
+  ft
+
+let pr_new_syntax ?loc ft_beautify ocom =
+  let loc = Option.cata Loc.unloc (0,0) loc in
+  let before = comment (Pputils.extract_comments (fst loc)) in
+  let com = Option.cata Ppvernac.pr_vernac (mt ()) ocom in
+  let after = comment (Pputils.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)))
+
+(* load_vernac with beautify *)
+let beautify_pass ~doc ~comments ~ids ~filename =
+  let ft_beautify, close_beautify =
+    if !Flags.beautify_file then
+      let chan_beautify = open_out (filename^beautify_suffix) in
+      set_formatter_translator chan_beautify, fun () -> close_out chan_beautify;
+    else
+      !Topfmt.std_ft, fun () -> ()
+  in
+  (* The interface to the comment printer is imperative, so we first
+     set the comments, then we call print. This has to be done for
+     each file. *)
+  Pputils.beautify_comments := comments;
+  List.iter (fun id ->
+      Option.iter (fun (loc,ast) ->
+          pr_new_syntax ?loc ft_beautify (Some ast))
+        (Stm.get_ast ~doc id)) ids;
+
+  (* Is this called so comments at EOF are printed? *)
+  pr_new_syntax ~loc:(Loc.make_loc (max_int,max_int)) ft_beautify None;
+  close_beautify ()
+
+(* Main driver for file loading. For now, we only do one beautify
+   pass. *)
+let load_vernac ~time ~echo ~check ~interactive ~state filename =
+  let ostate, ids, comments = load_vernac_core ~time ~echo ~check ~interactive ~state filename in
+  (* Pass for beautify *)
+  if !Flags.beautify then beautify_pass ~doc:ostate.State.doc ~comments ~ids:List.(rev ids) ~filename;
+  (* End pass *)
+  ostate
diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli
index 0d9f5871..51758642 100644
--- a/toplevel/vernac.mli
+++ b/toplevel/vernac.mli
@@ -1,37 +1,32 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** Parsing of vernacular. *)
-
-(** Read a vernac command on the specified input (parse only).
-   Raises [End_of_file] if EOF (or Ctrl-D) is reached. *)
-
-val parse_sentence : Pcoq.Gram.coq_parsable * in_channel option ->
- Loc.t * Vernacexpr.vernac_expr
-
-(** Reads and executes vernac commands from a stream. *)
-
-exception End_of_input
-
-val process_expr : Pcoq.Gram.coq_parsable -> Loc.t * Vernacexpr.vernac_expr -> unit
-
-(** Set XML hooks *)
-val xml_start_library : (unit -> unit) Hook.t
-val xml_end_library   : (unit -> unit) Hook.t
-
-(** Load a vernac file, verbosely or not. Errors are annotated with file
-   and location *)
-
-val load_vernac : bool -> string -> unit
-
-
-(** Compile a vernac file, verbosely or not (f is assumed without .v suffix) *)
-
-val compile : bool -> string -> unit
-
-val is_navigation_vernac : Vernacexpr.vernac_expr -> bool
+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 : time:bool -> state:State.t -> Vernacexpr.vernac_control CAst.t -> 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 : time:bool -> echo:bool -> check:bool -> interactive:bool ->
+  state:State.t -> string -> State.t
diff --git a/toplevel/vernacentries.mli b/toplevel/vernacentries.mli
deleted file mode 100644
index 4e7fa4a0..00000000
--- a/toplevel/vernacentries.mli
+++ /dev/null
@@ -1,66 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Misctypes
-
-val dump_global : Libnames.reference or_by_notation -> unit
-
-(** Vernacular entries *)
-
-val show_prooftree : unit -> unit
-
-val show_node : unit -> unit
-
-val vernac_require :
-  Libnames.reference option -> bool option -> Libnames.reference list -> unit
-
-(** This function can be used by any command that want to observe terms
-   in the context of the current goal *)
-val get_current_context_of_args : int option -> Evd.evar_map * Environ.env
-
-(** The main interpretation function of vernacular expressions *)
-val interp : 
-  ?verbosely:bool ->
-  ?proof:Proof_global.closed_proof ->
-    Loc.t * Vernacexpr.vernac_expr -> unit
-
-(** Print subgoals when the verbose flag is on.
-    Meant to be used inside vernac commands from plugins. *)
-
-val print_subgoals : unit -> unit
-val try_print_subgoals : unit -> unit
-
-(** The printing of goals via [print_subgoals] or during
-    [interp] can be controlled by the following flag.
-    Used for instance by coqide, since it has its own
-    goal-fetching mechanism. *)
-
-val enable_goal_printing : bool ref
-
-(** Should Qed try to display the proof script ?
-    True by default, but false in ProofGeneral and coqIDE *)
-
-val qed_display_script : bool ref
-
-(** Prepare a "match" template for a given inductive type.
-    For each branch of the match, we list the constructor name
-    followed by enough pattern variables.
-    [Not_found] is raised if the given string isn't the qualid of
-    a known inductive type. *)
-
-val make_cases : string -> string list list
-
-val vernac_end_proof :
-  ?proof:Proof_global.closed_proof -> Vernacexpr.proof_end -> unit
-
-val with_fail : bool -> (unit -> unit) -> unit
-
-val command_focus : unit Proof.focus_kind
-
-val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Tacexpr.raw_red_expr ->
-  Evd.evar_map * Redexpr.red_expr) Hook.t
diff --git a/toplevel/vernacinterp.mli b/toplevel/vernacinterp.mli
deleted file mode 100644
index 5149b541..00000000
--- a/toplevel/vernacinterp.mli
+++ /dev/null
@@ -1,20 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** 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
-
-val vinterp_init : unit -> unit
-val call : ?locality:bool -> Vernacexpr.extend_name * Genarg.raw_generic_argument list -> unit
diff --git a/toplevel/assumptions.ml b/vernac/assumptions.ml
index 45c539e2..742ff3a9 100644
--- a/toplevel/assumptions.ml
+++ b/vernac/assumptions.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* The following definitions are used by the function
@@ -18,13 +20,15 @@ open Pp
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Mod_subst
 open Globnames
 open Printer
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (** For a constant c in a module sealed by an interface (M:T and
     not M<:T), [Global.lookup_constant] may return a [constant_body]
     without body. We fix this by looking in the implementation
@@ -42,6 +46,11 @@ let rec search_cst_label lab = function
   | (l, SFBconst cb) :: _ when Label.equal l lab -> cb
   | _ :: fields -> search_cst_label lab fields
 
+let rec search_mind_label lab = function
+  | [] -> raise Not_found
+  | (l, SFBmind mind) :: _ when Label.equal l lab -> mind
+  | _ :: fields -> search_mind_label lab fields
+
 (* TODO: using [empty_delta_resolver] below is probably slightly incorrect. But:
     a) I don't see currently what should be used instead
     b) this shouldn't be critical for Print Assumption. At worse some
@@ -60,16 +69,15 @@ let rec fields_of_functor f subs mp0 args = function
       fields_of_functor f subs mp0 args e
 
 let rec lookup_module_in_impl mp =
-  try Global.lookup_module mp
-  with Not_found ->
-    (* The module we search might not be exported by its englobing module(s).
-       We access the upper layer, and then do a manual search *)
     match mp with
-    | MPfile _ -> raise Not_found (* can happen if mp is an open module *)
-    | MPbound _ -> assert false
+    | MPfile _ -> Global.lookup_module mp
+    | MPbound _ -> Global.lookup_module mp
     | MPdot (mp',lab') ->
-       let fields = memoize_fields_of_mp mp' in
-       search_mod_label lab' fields
+       if ModPath.equal mp' (Global.current_modpath ()) then
+         Global.lookup_module mp
+       else
+         let fields = memoize_fields_of_mp mp' in
+         search_mod_label lab' fields
 
 and memoize_fields_of_mp mp =
   try MPmap.find mp !modcache
@@ -82,7 +90,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
@@ -111,7 +119,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 : *)
@@ -124,7 +132,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)
+      | None -> anomaly (str "Print Assumption: unknown constant " ++ Constant.print cst ++ str ".")
 
 let lookup_constant cst =
   try
@@ -133,21 +141,54 @@ let lookup_constant cst =
     else lookup_constant_in_impl cst (Some cb)
   with Not_found -> lookup_constant_in_impl cst None
 
+let lookup_mind_in_impl mind =
+  try
+    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 ->
+    anomaly (str "Print Assumption: unknown inductive " ++ MutInd.print mind ++ str ".")
+
+let lookup_mind mind =
+  try Global.lookup_mind mind
+  with Not_found -> lookup_mind_in_impl mind
+
 (** Graph traversal of an object, collecting on the way the dependencies of
     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 rec traverse current ctx accu t = match kind_of_term t with
+let fold_constr_with_full_binders g f n acc c =
+  let open Context.Rel.Declaration in
+  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
+  | Lambda (na,t,c) -> f (g (LocalAssum (na,t)) n) (f n acc t) c
+  | LetIn (na,b,t,c) -> f (g (LocalDef (na,b,t)) n) (f n (f n acc b) t) c
+  | App (c,l) -> Array.fold_left (f n) (f n acc c) l
+  | Proj (p,c) -> f n acc c
+  | Evar (_,l) -> Array.fold_left (f n) acc l
+  | Case (_,p,c,bl) -> Array.fold_left (f n) (f n (f n acc p) c) bl
+  | Fix (_,(lna,tl,bl)) ->
+      let n' = CArray.fold_left2 (fun c n t -> g (LocalAssum (n,t)) c) n lna tl in
+      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
+  | CoFix (_,(lna,tl,bl)) ->
+      let n' = CArray.fold_left2 (fun c n t -> g (LocalAssum (n,t)) c) n lna tl in
+      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 Constr.kind t with
 | Var id ->
-  let body () = Global.lookup_named id |> get_value in
+  let body () = id |> Global.lookup_named |> NamedDecl.get_value in
   traverse_object accu body (VarRef id)
 | Const (kn, _) ->
-  let body () = Global.body_of_constant_body (lookup_constant kn) in
+  let body () = Option.map fst (Global.body_of_constant_body (lookup_constant kn)) in
   traverse_object accu body (ConstRef kn)
 | Ind ((mind, _) as ind, _) ->
   traverse_inductive accu mind (IndRef ind)
@@ -160,14 +201,14 @@ let rec traverse current ctx accu t = match kind_of_term t with
     | Lambda(_,_,oty), Const (kn, _)
       when Vars.noccurn 1 oty &&
       not (Declareops.constant_has_body (lookup_constant kn)) ->
-        let body () = Global.body_of_constant_body (lookup_constant kn) in
+        let body () = Option.map fst (Global.body_of_constant_body (lookup_constant kn)) in
         traverse_object
           ~inhabits:(current,ctx,Vars.subst1 mkProp oty) accu body (ConstRef kn)
     | _ ->
-        Termops.fold_constr_with_full_binders
+        fold_constr_with_full_binders
           Context.Rel.add (traverse current) ctx accu t
     end
-| _ -> Termops.fold_constr_with_full_binders
+| _ -> fold_constr_with_full_binders
           Context.Rel.add (traverse current) ctx accu t
 
 and traverse_object ?inhabits (curr, data, ax2ty) body obj =
@@ -204,7 +245,7 @@ and traverse_inductive (curr, data, ax2ty) mind obj =
       where I_0, I_1, ... are in the same mutual definition and c_ij
       are all their constructors. *)
    if Refmap_env.mem firstind_ref data then data, ax2ty else
-     let mib = Global.lookup_mind mind in
+     let mib = lookup_mind mind in
      (* Collects references of parameters *)
      let param_ctx = mib.mind_params_ctxt in
      let nparam = List.length param_ctx in
@@ -271,10 +312,7 @@ let traverse current t =
 (** Hopefully bullet-proof function to recover the type of a constant. It just
     ignores all the universe stuff. There are many issues that can arise when
     considering terms out of any valid environment, so use with caution. *)
-let type_of_constant cb = match cb.Declarations.const_type with
-| Declarations.RegularArity ty -> ty
-| Declarations.TemplateArity (ctx, arity) ->
-  Term.mkArity (ctx, Sorts.sort_of_univ arity.Declarations.template_level)
+let type_of_constant cb = cb.Declarations.const_type
 
 let assumptions ?(add_opaque=false) ?(add_transparent=false) st gr t =
   let (idts, knst) = st in
@@ -308,7 +346,7 @@ let assumptions ?(add_opaque=false) ?(add_transparent=false) st gr t =
     else
       accu
   | IndRef (m,_) | ConstructRef ((m,_),_) ->
-      let mind = Global.lookup_mind m in
+      let mind = lookup_mind m in
       if mind.mind_typing_flags.check_guarded then
         accu
       else
diff --git a/toplevel/assumptions.mli b/vernac/assumptions.mli
index 07267578..7e13f8f2 100644
--- a/toplevel/assumptions.mli
+++ b/vernac/assumptions.mli
@@ -1,13 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Globnames
 open Printer
 
@@ -21,11 +23,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/toplevel/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 0561fc4b..0404d015 100644
--- a/toplevel/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -1,33 +1,33 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* This file is about the automatic generation of schemes about
    decidable equality, created by Vincent Siles, Oct 2007 *)
 
-open Tacmach
 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
 open Misctypes
 open Proofview.Notations
-open Context.Rel.Declaration
 
-let out_punivs = Univ.out_punivs
+module RelDecl = Context.Rel.Declaration
 
 (**********************************************************************)
 (* Generic synthesis of boolean equality *)
@@ -57,17 +57,17 @@ exception InductiveWithSort
 exception ParameterWithoutEquality of global_reference
 exception NonSingletonProp of inductive
 exception DecidabilityMutualNotSupported
-
-let dl = Loc.ghost
+exception NoDecidabilityCoInductive
 
 let constr_of_global g = lazy (Universes.constr_of_global g)
 
 (* Some pre declaration of constant we are going to use *)
 let bb = constr_of_global Coqlib.glob_bool
 
-let andb_prop = fun _ -> (Coqlib.build_bool_type()).Coqlib.andb_prop
+let andb_prop = fun _ -> Universes.constr_of_global (Coqlib.build_bool_type()).Coqlib.andb_prop
 
 let andb_true_intro = fun _ ->
+  Universes.constr_of_global
     (Coqlib.build_bool_type()).Coqlib.andb_true_intro
 
 let tt = constr_of_global Coqlib.glob_true
@@ -76,9 +76,9 @@ let ff = constr_of_global Coqlib.glob_false
 
 let eq = constr_of_global Coqlib.glob_eq
 
-let sumbool = Coqlib.build_coq_sumbool
+let sumbool () = Universes.constr_of_global (Coqlib.build_coq_sumbool ())
 
-let andb = fun _ -> (Coqlib.build_bool_type()).Coqlib.andb
+let andb = fun _ -> Universes.constr_of_global (Coqlib.build_bool_type()).Coqlib.andb
 
 let induct_on c = induction false None c None None
 
@@ -86,14 +86,23 @@ let destruct_on c = destruct false None c None None
 
 let destruct_on_using c id =
   destruct false None c
-    (Some (dl,IntroOrPattern [[dl,IntroNaming IntroAnonymous];
-               [dl,IntroNaming (IntroIdentifier id)]]))
+    (Some (CAst.make @@ IntroOrPattern [[CAst.make @@ IntroNaming IntroAnonymous];
+               [CAst.make @@ IntroNaming (IntroIdentifier id)]]))
     None
 
 let destruct_on_as c l =
-  destruct false None c (Some (dl,l)) None
+  destruct false None c (Some (CAst.make 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 *)
+  }
 
-(* reconstruct the inductive with the correct deBruijn indexes *)
+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
   let nparams = mib.mind_nparams in
@@ -103,11 +112,11 @@ let mkFullInd (ind,u) n =
     context_chop (nparams-nparrec) mib.mind_params_ctxt in
   if nparrec > 0
     then mkApp (mkIndU (ind,u),
-      Array.of_list(Context.Rel.to_extended_list (nparrec+n) lnamesparrec))
+      Array.of_list(Context.Rel.to_extended_list mkRel (nparrec+n) lnamesparrec))
     else mkIndU (ind,u)
 
 let check_bool_is_defined () =
-  try let _ = Global.type_of_global_unsafe Coqlib.glob_bool in ()
+  try let _ = Global.type_of_global_in_context (Global.env ()) Coqlib.glob_bool in ()
   with e when CErrors.noncritical e -> raise (UndefinedCst "bool")
 
 let beq_scheme_kind_aux = ref (fun _ -> failwith "Undefined")
@@ -138,7 +147,7 @@ let build_beq_scheme mode kn =
         | Name s -> Id.of_string ("eq_"^(Id.to_string s))
         | Anonymous -> Id.of_string "eq_A"
     in
-    let ext_rel_list = Context.Rel.to_extended_list 0 lnamesparrec in
+    let ext_rel_list = Context.Rel.to_extended_list mkRel 0 lnamesparrec in
       let lift_cnt = ref 0 in
       let eqs_typ = List.map (fun aa ->
                                 let a = lift !lift_cnt aa in
@@ -150,14 +159,14 @@ let build_beq_scheme mode kn =
           ( fun a b decl -> (* mkLambda(n,b,a) ) *)
                 (* here I leave the Naming thingy so that the type of
                   the function is more readable for the user *)
-                mkNamedLambda (eqName (get_name decl)) b a )
+                mkNamedLambda (eqName (RelDecl.get_name decl)) b a )
                 c (List.rev eqs_typ) lnamesparrec
        in
         List.fold_left (fun a decl ->(* mkLambda(n,t,a)) eq_input rel_list *)
           (* Same here , hoping the auto renaming will do something good ;)  *)
           mkNamedLambda
-                (match get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl)  a) eq_input lnamesparrec
+                (match RelDecl.get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
+                (RelDecl.get_type decl)  a) eq_input lnamesparrec
  in
  let make_one_eq cur =
   let u = Univ.Instance.empty in
@@ -172,26 +181,27 @@ let build_beq_scheme mode kn =
     (* give a type A, this function tries to find the equality on A declared
        previously *)
     (*  nlist = the number of args (A , B , ... )
-        eqA   = the deBruijn index of the first eq param
+        eqA   = the de Bruijn index of the first eq param
         ndx   = how much to translate due to the 2nd Case
     *)
     let compute_A_equality rel_list nlist eqA ndx t =
       let lifti = ndx in
+      let sigma = Evd.empty (** FIXME *) in
       let rec aux c =
 	let (c,a) = Reductionops.whd_betaiota_stack Evd.empty c in
-	match kind_of_term c with
+	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))
           in
           mkVar eid, Safe_typing.empty_private_constants
-        | Cast (x,_,_) -> aux (applist (x,a))
+        | 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 =
@@ -204,26 +214,27 @@ let build_beq_scheme mode kn =
                   in
                 let args =
                   Array.append 
-                    (Array.of_list (List.map (fun x -> lift lifti x) a)) eqa in
+                    (Array.of_list (List.map (fun x -> lift lifti (EConstr.Unsafe.to_constr x)) a)) eqa in
                 if Int.equal (Array.length args) 0 then eq, eff
                 else mkApp (eq, args), eff
               with Not_found -> raise(EqNotFound (ind', fst ind))
             end
         | Sort _  -> raise InductiveWithSort
         | Prod _ -> raise InductiveWithProduct
-        | Lambda _-> raise (EqUnknown "Lambda")
-        | LetIn _ -> raise (EqUnknown "LetIn")
-        | Const kn ->
-	    (match Environ.constant_opt_value_in env kn with
-	      | None -> raise (ParameterWithoutEquality (ConstRef (fst kn)))
-	      | Some c -> aux (applist (c,a)))
-        | Proj _ -> raise (EqUnknown "Proj")
-        | Construct _ -> raise (EqUnknown "Construct")
-        | Case _ -> raise (EqUnknown "Case")
-        | CoFix _ -> raise (EqUnknown "CoFix")
-        | Fix _   -> raise (EqUnknown "Fix")
-        | Meta _  -> raise (EqUnknown "Meta")
-        | Evar _  -> raise (EqUnknown "Evar")
+        | Lambda _-> raise (EqUnknown "abstraction")
+        | LetIn _ -> raise (EqUnknown "let-in")
+        | Const (kn, u) ->
+            let u = EConstr.EInstance.kind sigma u in
+	    (match Environ.constant_opt_value_in env (kn, u) with
+	      | None -> raise (ParameterWithoutEquality (ConstRef kn))
+	      | Some c -> aux (EConstr.applist (EConstr.of_constr c,a)))
+        | Proj _ -> raise (EqUnknown "projection")
+        | Construct _ -> raise (EqUnknown "constructor")
+        | Case _ -> raise (EqUnknown "match")
+        | CoFix _ -> raise (EqUnknown "cofix")
+        | Fix _   -> raise (EqUnknown "fix")
+        | Meta _  -> raise (EqUnknown "meta-variable")
+        | Evar _  -> raise (EqUnknown "existential variable")
     in
       aux t
   in
@@ -240,7 +251,7 @@ let build_beq_scheme mode kn =
                Cn => match Y with ... end |]  part *)
     let ci = make_case_info env (fst ind) MatchStyle in
     let constrs n = get_constructors env (make_ind_family (ind,
-      Context.Rel.to_extended_list (n+nb_ind-1) mib.mind_params_ctxt)) in
+      Context.Rel.to_extended_list mkRel (n+nb_ind-1) mib.mind_params_ctxt)) in
     let constrsi = constrs (3+nparrec) in
     let n = Array.length constrsi in
     let ar = Array.make n (Lazy.force ff) in
@@ -255,12 +266,12 @@ let build_beq_scheme mode kn =
                     | 0 -> Lazy.force tt
                     | _ -> let eqs = Array.make nb_cstr_args (Lazy.force tt) in
                       for ndx = 0 to nb_cstr_args-1 do
-                        let cc = get_type (List.nth constrsi.(i).cs_args ndx) in
+                        let cc = RelDecl.get_type (List.nth constrsi.(i).cs_args ndx) in
                           let eqA, eff' = compute_A_equality rel_list
                                           nparrec
                                           (nparrec+3+2*nb_cstr_args)
                                           (nb_cstr_args+ndx+1)
-                                          cc
+                                          (EConstr.of_constr cc)
                           in
                           eff := Safe_typing.concat_private eff' !eff;
                           Array.set eqs ndx
@@ -274,14 +285,14 @@ let build_beq_scheme mode kn =
                           (Array.sub eqs 1 (nb_cstr_args - 1))
                   )
    		  in
-		    (List.fold_left (fun a decl -> mkLambda (get_name decl, get_type decl, a)) cc
+		    (List.fold_left (fun a decl -> mkLambda (RelDecl.get_name decl, RelDecl.get_type decl, a)) cc
                     (constrsj.(j).cs_args)
 		)
 	      else ar2.(j) <- (List.fold_left (fun a decl ->
-			mkLambda (get_name decl, get_type decl, a)) (Lazy.force ff) (constrsj.(j).cs_args) )
+			mkLambda (RelDecl.get_name decl, RelDecl.get_type decl, a)) (Lazy.force ff) (constrsj.(j).cs_args) )
 	    done;
 
-	  ar.(i) <- (List.fold_left (fun a decl -> mkLambda (get_name decl, get_type decl, a))
+	  ar.(i) <- (List.fold_left (fun a decl -> mkLambda (RelDecl.get_name decl, RelDecl.get_type decl, a))
 			(mkCase (ci,do_predicate rel_list nb_cstr_args,
 				  mkVar (Id.of_string "Y") ,ar2))
 			 (constrsi.(i).cs_args))
@@ -308,9 +319,19 @@ 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));
-        let fix = mkFix (((Array.make nb_ind 0),i),(names,types,cores)) in
+        let fix = match mib.mind_finite with
+        | CoFinite ->
+	  raise NoDecidabilityCoInductive;
+        | Finite ->
+          mkFix (((Array.make nb_ind 0),i),(names,types,cores))
+        | BiFinite ->
+          (** If the inductive type is not recursive, the fixpoint is not
+              used, so let's replace it with garbage *)
+          let subst = List.init nb_ind (fun _ -> mkProp) in
+          Vars.substl subst cores.(i)
+        in
         create_input fix),
-       Evd.make_evar_universe_context (Global.env ()) None),
+       UState.make (Global.universes ())),
       !eff
 
 let beq_scheme_kind = declare_mutual_scheme_object "_beq" build_beq_scheme
@@ -320,11 +341,12 @@ let _ = beq_scheme_kind_aux := fun () -> beq_scheme_kind
 (* This function tryies to get the [inductive] between a constr
   the constr should be Ind i or App(Ind i,[|args|])
 *)
-let destruct_ind c =
-    try let u,v =  destApp c in
-          let indc = destInd u in
+let destruct_ind sigma c =
+  let open EConstr in
+    try let u,v =  destApp sigma c in
+          let indc = destInd sigma u in
             indc,v
-    with DestKO -> let indc = destInd c in
+    with DestKO -> let indc = destInd sigma c in
             indc,[||]
 
 (*
@@ -333,40 +355,43 @@ let destruct_ind c =
   then avoid should be
  [| lb_An ... lb _A1  (resp. bl_An ... bl_A1)
     eq_An .... eq_A1 An ... A1 |]
-so from Ai we can find the the correct eq_Ai bl_ai or lb_ai
+so from Ai we can find the correct eq_Ai bl_ai or lb_ai
 *)
 (* used in the leib -> bool side*)
 let do_replace_lb mode lb_scheme_key aavoid narg p q =
+  let open EConstr in
   let avoid = Array.of_list aavoid in
-  let do_arg v offset =
+  let do_arg sigma v offset =
   try
     let x = narg*offset in
-    let s = destVar v in
+    let s = destVar sigma v in
     let n = Array.length avoid in
     let rec find i =
       if Id.equal avoid.(n-i) s then avoid.(n-i-x)
       else (if i<n then find (i+1)
-            else errorlabstrm "AutoIndDecl.do_replace_lb"
-                   (str "Var " ++ pr_id s ++ str " seems unknown.")
+            else user_err ~hdr:"AutoIndDecl.do_replace_lb"
+                   (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 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")
         )))
       )
   in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let type_of_pq = Tacmach.New.of_old (fun gl -> pf_unsafe_type_of gl p) gl in
-    let u,v = destruct_ind type_of_pq
+  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
-          let c, eff = find_scheme ~mode lb_scheme_key (out_punivs u) (*FIXME*) in
+          let c, eff = find_scheme ~mode lb_scheme_key (fst u) (*FIXME*) in
           Proofview.tclUNIT (mkConst c, eff)
         with Not_found ->
           (* spiwack: the format of this error message should probably
@@ -375,45 +400,47 @@ 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_constr type_of_pq ++
+             Printer.pr_econstr_env env sigma type_of_pq ++
 	     str " first.")
           in
           Tacticals.New.tclZEROMSG err_msg
        in
        lb_type_of_p >>= fun (lb_type_of_p,eff) ->
+       Proofview.tclEVARMAP >>= fun sigma ->
        let lb_args = Array.append (Array.append
                           (Array.map (fun x -> x) v)
-                          (Array.map (fun x -> do_arg x 1) v))
-                          (Array.map (fun x -> do_arg x 2) v)
-        in let app =  if Array.equal eq_constr lb_args [||]
+                          (Array.map (fun x -> do_arg sigma x 1) v))
+                          (Array.map (fun x -> do_arg sigma x 2) v)
+        in let app =  if Array.is_empty lb_args
                        then lb_type_of_p else mkApp (lb_type_of_p,lb_args)
            in
            Tacticals.New.tclTHENLIST [
              Proofview.tclEFFECTS eff;
              Equality.replace p q ; apply app ; Auto.default_auto]
-  end }
+  end
 
 (* used in the bool -> leib side *)
 let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
+  let open EConstr in
   let avoid = Array.of_list aavoid in
-  let do_arg v offset =
+  let do_arg sigma v offset =
   try
     let x = narg*offset in
-    let s = destVar v in
+    let s = destVar sigma v in
     let n = Array.length avoid in
     let rec find i =
       if Id.equal avoid.(n-i) s then avoid.(n-i-x)
       else (if i<n then find (i+1)
-            else errorlabstrm "AutoIndDecl.do_replace_bl"
-                   (str "Var " ++ pr_id s ++ str " seems unknown.")
+            else user_err ~hdr:"AutoIndDecl.do_replace_bl"
+                   (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 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")
         )))
@@ -423,11 +450,13 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
   let rec aux l1 l2 =
     match (l1,l2) with
     | (t1::q1,t2::q2) ->
-        Proofview.Goal.enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
         let tt1 = Tacmach.New.pf_unsafe_type_of gl t1 in
-        if eq_constr t1 t2 then aux q1 q2
+        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 tt1
+          let u,v = try  destruct_ind sigma tt1
           (* trick so that the good sequence is returned*)
                 with e when CErrors.noncritical e -> indu,[||]
           in if eq_ind (fst u) ind
@@ -435,26 +464,26 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
              else (
                let bl_t1, eff =
                try 
-                 let c, eff = find_scheme bl_scheme_key (out_punivs u) (*FIXME*) in
+                 let c, eff = find_scheme bl_scheme_key (fst u) (*FIXME*) in
                  mkConst c, eff
                with Not_found ->
 		 (* spiwack: the format of this error message should probably
 	                     be improved. *)
-		 let err_msg = string_of_ppcmds
+		 let err_msg =
 	                                (str "boolean->Leibniz:" ++
                                          str "You have to declare the" ++
 			   	         str "decidability over " ++
-				         Printer.pr_constr tt1 ++
+                                         Printer.pr_econstr_env env sigma tt1 ++
 				         str " first.")
 		 in
-		 error err_msg
+		 user_err err_msg
                in let bl_args =
                         Array.append (Array.append
                           (Array.map (fun x -> x) v)
-                          (Array.map (fun x -> do_arg x 1) v))
-                          (Array.map (fun x -> do_arg x 2) v )
+                          (Array.map (fun x -> do_arg sigma x 1) v))
+                          (Array.map (fun x -> do_arg sigma x 2) v )
                 in
-                let app =  if Array.equal eq_constr bl_args [||]
+                let app =  if Array.is_empty bl_args
                            then bl_t1 else mkApp (bl_t1,bl_args)
                 in
                 Tacticals.New.tclTHENLIST [
@@ -464,29 +493,30 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
                   aux q1 q2 ]
               )
         )
-        end }
+        end
     | ([],[]) -> Proofview.tclUNIT ()
     | _ -> Tacticals.New.tclZEROMSG (str "Both side of the equality must have the same arity.")
   in
-  begin try Proofview.tclUNIT (destApp lft)
+  Proofview.tclEVARMAP >>= fun sigma ->
+  begin try Proofview.tclUNIT (destApp sigma lft)
     with DestKO -> Tacticals.New.tclZEROMSG (str "replace failed.")
   end >>= fun (ind1,ca1) ->
-  begin try Proofview.tclUNIT (destApp rgt)
+  begin try Proofview.tclUNIT (destApp sigma rgt)
     with DestKO -> Tacticals.New.tclZEROMSG (str "replace failed.")
   end >>= fun (ind2,ca2) ->
-  begin try Proofview.tclUNIT (out_punivs (destInd ind1))
+  begin try Proofview.tclUNIT (fst (destInd sigma ind1))
     with DestKO ->
-      begin try Proofview.tclUNIT (fst (fst (destConstruct ind1)))
+      begin try Proofview.tclUNIT (fst (fst (destConstruct sigma ind1)))
         with DestKO -> Tacticals.New.tclZEROMSG (str "The expected type is an inductive one.")
       end
   end >>= fun (sp1,i1) ->
-  begin try Proofview.tclUNIT (out_punivs (destInd ind2))
+  begin try Proofview.tclUNIT (fst (destInd sigma ind2))
     with DestKO ->
-      begin try Proofview.tclUNIT (fst (fst (destConstruct ind2)))
+      begin try Proofview.tclUNIT (fst (fst (destConstruct sigma ind2)))
         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)
 
@@ -495,7 +525,7 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
   [(in,eq_in,in_bl,in_al),,...,(i1,eq_i1,i1_bl_i1_al  )]
 *)
 let list_id l = List.fold_left ( fun a decl -> let s' =
-      match get_name decl with
+      match RelDecl.get_name decl with
         Name s -> Id.to_string s
       | Anonymous -> "A" in
           (Id.of_string s',Id.of_string ("eq_"^s'),
@@ -512,19 +542,22 @@ let eqI ind l =
                            (List.map (fun (_,seq,_,_)-> mkVar seq) list_id ))
   and e, eff = 
     try let c, eff = find_scheme beq_scheme_kind ind in mkConst c, eff 
-    with Not_found -> errorlabstrm "AutoIndDecl.eqI"
-      (str "The boolean equality on " ++ pr_mind (fst ind) ++ str " is needed.");
-  in (if Array.equal eq_constr eA [||] then e else mkApp(e,eA)), eff
+    with Not_found -> user_err ~hdr:"AutoIndDecl.eqI"
+      (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 *)
 
+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.Set.add id l)) (List.map RelDecl.get_name lnamesparrec) Id.Set.empty in
   let create_input c =
-    let x = Id.of_string "x" and
-        y = Id.of_string "y" in
+    let x = next_ident_away (Id.of_string "x") avoid and
+        y = next_ident_away (Id.of_string "y") avoid in
       let bl_typ = List.map (fun (s,seq,_,_) ->
         mkNamedProd x (mkVar s) (
             mkNamedProd y (mkVar s) (
@@ -543,11 +576,11 @@ let compute_bl_goal ind lnamesparrec nparrec =
         mkNamedProd seq b a
       ) bl_input (List.rev list_id) (List.rev eqs_typ) in
       List.fold_left (fun a decl -> mkNamedProd
-                (match get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl) a) eq_input lnamesparrec
+                (match RelDecl.get_name decl with Name s -> s | Anonymous -> next_ident_away (Id.of_string "A") avoid)
+                (RelDecl.get_type decl) a) eq_input lnamesparrec
     in
-      let n = Id.of_string "x" and
-          m = Id.of_string "y" in
+      let n = next_ident_away (Id.of_string "x") avoid and
+          m = next_ident_away (Id.of_string "y") avoid in
       let u = Univ.Instance.empty in
      create_input (
         mkNamedProd n (mkFullInd (ind,u) nparrec) (
@@ -566,12 +599,10 @@ let compute_bl_tact mode bl_scheme_key ind lnamesparrec nparrec =
         ( List.map (fun (_,_,sbl,_ ) -> sbl) list_id )
       in
       let fresh_id s gl =
-        Tacmach.New.of_old begin fun gsig ->
-          let fresh = fresh_id (!avoid) s gsig in
+          let fresh = fresh_id_in_env (Id.Set.of_list !avoid) s (Proofview.Goal.env gl) in
           avoid := fresh::(!avoid); fresh
-        end gl
       in
-      Proofview.Goal.nf_enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
       let fresh_first_intros = List.map (fun id -> fresh_id id gl) first_intros in
       let freshn = fresh_id (Id.of_string "x") gl in
       let freshm = fresh_id (Id.of_string "y") gl in
@@ -579,13 +610,13 @@ let compute_bl_tact mode bl_scheme_key ind lnamesparrec nparrec =
   (* try with *)
       Tacticals.New.tclTHENLIST [ intros_using fresh_first_intros;
                      intro_using freshn ;
-                     induct_on (mkVar freshn);
+                     induct_on (EConstr.mkVar freshn);
                      intro_using freshm;
-                     destruct_on (mkVar freshm);
+                     destruct_on (EConstr.mkVar freshm);
                      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);
 (*
@@ -593,23 +624,24 @@ repeat ( apply andb_prop in z;let z1:= fresh "Z" in destruct z as [z1 z]).
 *)
                     Tacticals.New.tclREPEAT (
                       Tacticals.New.tclTHENLIST [
-                         Simple.apply_in freshz (andb_prop());
-                         Proofview.Goal.nf_enter { enter = begin fun gl ->
+                         Simple.apply_in freshz (EConstr.of_constr (andb_prop()));
+                         Proofview.Goal.enter begin fun gl ->
                            let fresht = fresh_id (Id.of_string "Z") gl in
-                            destruct_on_as (mkVar freshz)
-                                  (IntroOrPattern [[dl,IntroNaming (IntroIdentifier fresht);
-                                    dl,IntroNaming (IntroIdentifier freshz)]])
-                         end }
+                            destruct_on_as (EConstr.mkVar freshz)
+                                  (IntroOrPattern [[CAst.make @@ IntroNaming (IntroIdentifier fresht);
+                                    CAst.make @@ IntroNaming (IntroIdentifier freshz)]])
+                         end
                         ]);
 (*
   Ci a1 ... an = Ci b1 ... bn
  replace bi with ai; auto || replace bi with ai by  apply typeofbi_prod ; auto
 *)
-                      Proofview.Goal.nf_enter { enter = begin fun gls ->
-                        let gl = Proofview.Goal.concl gls in
-                        match (kind_of_term gl) with
+                      Proofview.Goal.enter begin fun gl ->
+                        let concl = Proofview.Goal.concl gl in
+                        let sigma = Tacmach.New.project gl in
+                        match EConstr.kind sigma concl with
                         | App (c,ca) -> (
-                          match (kind_of_term c) with
+                          match EConstr.kind sigma c with
                           | Ind (indeq, u) ->
                               if eq_gr (IndRef indeq) Coqlib.glob_eq
                               then
@@ -624,10 +656,10 @@ repeat ( apply andb_prop in z;let z1:= fresh "Z" in destruct z as [z1 z]).
                           | _ -> Tacticals.New.tclZEROMSG (str" Failure while solving Boolean->Leibniz.")
                         )
                         | _ -> Tacticals.New.tclZEROMSG (str "Failure while solving Boolean->Leibniz.")
-                      end }
+                      end
 
                     ]
-      end }
+      end
 
 let bl_scheme_kind_aux = ref (fun _ -> failwith "Undefined")
 
@@ -639,7 +671,7 @@ let side_effect_of_mode = function
 let make_bl_scheme mode mind =
   let mib = Global.lookup_mind mind in
   if not (Int.equal (Array.length mib.mind_packets) 1) then
-    errorlabstrm ""
+    user_err 
       (str "Automatic building of boolean->Leibniz lemmas not supported");
   let ind = (mind,0) in
   let nparams = mib.mind_nparams in
@@ -647,10 +679,11 @@ let make_bl_scheme mode mind =
   let lnonparrec,lnamesparrec = (* TODO subst *)
     context_chop (nparams-nparrec) mib.mind_params_ctxt in
   let bl_goal, eff = compute_bl_goal ind lnamesparrec nparrec in
-  let ctx = Evd.make_evar_universe_context (Global.env ()) None in
+  let ctx = UState.make (Global.universes ()) in
   let side_eff = side_effect_of_mode mode in
+  let bl_goal = EConstr.of_constr bl_goal in
   let (ans, _, ctx) = Pfedit.build_by_tactic ~side_eff (Global.env()) ctx bl_goal
-    (compute_bl_tact mode (!bl_scheme_kind_aux()) (ind, Univ.Instance.empty) lnamesparrec nparrec)
+    (compute_bl_tact mode (!bl_scheme_kind_aux()) (ind, EConstr.EInstance.empty) lnamesparrec nparrec)
   in
   ([|ans|], ctx), eff
 
@@ -664,10 +697,11 @@ let _ = bl_scheme_kind_aux := fun () -> bl_scheme_kind
 let compute_lb_goal ind lnamesparrec nparrec =
   let list_id = list_id lnamesparrec in
   let eq = Lazy.force eq and tt = Lazy.force tt and bb = Lazy.force bb in
+  let avoid = List.fold_right (Nameops.Name.fold_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 = Id.of_string "x" and
-          y = Id.of_string "y" in
+      let x = next_ident_away (Id.of_string "x") avoid and
+          y = next_ident_away (Id.of_string "y") avoid in
       let lb_typ = List.map (fun (s,seq,_,_) ->
         mkNamedProd x (mkVar s) (
             mkNamedProd y (mkVar s) (
@@ -686,11 +720,11 @@ let compute_lb_goal ind lnamesparrec nparrec =
         mkNamedProd seq b a
       ) lb_input (List.rev list_id) (List.rev eqs_typ) in
       List.fold_left (fun a decl -> mkNamedProd
-                (match (get_name decl) with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl)  a) eq_input lnamesparrec
+                (match (RelDecl.get_name decl) with Name s -> s | Anonymous ->  Id.of_string "A")
+                (RelDecl.get_type decl)  a) eq_input lnamesparrec
     in
-      let n = Id.of_string "x" and
-          m = Id.of_string "y" in
+      let n = next_ident_away (Id.of_string "x") avoid and
+          m = next_ident_away (Id.of_string "y") avoid in
       let u = Univ.Instance.empty in
       create_input (
         mkNamedProd n (mkFullInd (ind,u) nparrec) (
@@ -709,12 +743,10 @@ let compute_lb_tact mode lb_scheme_key ind lnamesparrec nparrec =
         ( List.map (fun (_,_,_,slb) -> slb) list_id )
       in
       let fresh_id s gl =
-        Tacmach.New.of_old begin fun gsig ->
-          let fresh = fresh_id (!avoid) s gsig in
+          let fresh = fresh_id_in_env (Id.Set.of_list !avoid) s (Proofview.Goal.env gl) in
           avoid := fresh::(!avoid); fresh
-        end gl
       in
-      Proofview.Goal.nf_enter { enter = begin fun gl ->
+      Proofview.Goal.enter begin fun gl ->
       let fresh_first_intros = List.map (fun id -> fresh_id id gl) first_intros in
       let freshn = fresh_id (Id.of_string "x") gl in
       let freshm = fresh_id (Id.of_string "y") gl in
@@ -722,26 +754,27 @@ let compute_lb_tact mode lb_scheme_key ind lnamesparrec nparrec =
   (* try with *)
       Tacticals.New.tclTHENLIST [ intros_using fresh_first_intros;
                      intro_using freshn ;
-                     induct_on (mkVar freshn);
+                     induct_on (EConstr.mkVar freshn);
                      intro_using freshm;
-                     destruct_on (mkVar freshm);
+                     destruct_on (EConstr.mkVar freshm);
                      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 (mkVar freshz,NoBindings);
+                     my_inj_tac freshz;
 		     intros; simpl_in_concl;
                      Auto.default_auto;
                      Tacticals.New.tclREPEAT (
-                      Tacticals.New.tclTHENLIST [apply (andb_true_intro());
+                      Tacticals.New.tclTHENLIST [apply (EConstr.of_constr (andb_true_intro()));
                                   simplest_split ;Auto.default_auto ]
                       );
-                      Proofview.Goal.nf_enter { enter = begin fun gls ->
-                        let gl = Proofview.Goal.concl gls in
+                      Proofview.Goal.enter begin fun gls ->
+                        let concl = Proofview.Goal.concl gls in
+                        let sigma = Tacmach.New.project gl in
                         (* assume the goal to be eq (eq_type ...) = true *)
-                        match (kind_of_term gl) with
-                        | App(c,ca) -> (match (kind_of_term ca.(1)) with
+                        match EConstr.kind sigma concl with
+                        | App(c,ca) -> (match (EConstr.kind sigma ca.(1)) with
                           | App(c',ca') ->
                               let n = Array.length ca' in
                               do_replace_lb mode lb_scheme_key
@@ -753,16 +786,16 @@ let compute_lb_tact mode lb_scheme_key ind lnamesparrec nparrec =
                         )
                         | _ ->
                             Tacticals.New.tclZEROMSG (str "Failure while solving Leibniz->Boolean.")
-                      end }
+                      end
                     ]
-      end }
+      end
 
 let lb_scheme_kind_aux = ref (fun () -> failwith "Undefined")
 
 let make_lb_scheme mode mind =
   let mib = Global.lookup_mind mind in
   if not (Int.equal (Array.length mib.mind_packets) 1) then
-    errorlabstrm ""
+    user_err 
       (str "Automatic building of Leibniz->boolean lemmas not supported");
   let ind = (mind,0) in
   let nparams = mib.mind_nparams in
@@ -770,8 +803,9 @@ let make_lb_scheme mode mind =
   let lnonparrec,lnamesparrec =
     context_chop (nparams-nparrec) mib.mind_params_ctxt in
   let lb_goal, eff = compute_lb_goal ind lnamesparrec nparrec in
-  let ctx = Evd.make_evar_universe_context (Global.env ()) None in
+  let ctx = UState.make (Global.universes ()) in
   let side_eff = side_effect_of_mode mode in
+  let lb_goal = EConstr.of_constr lb_goal in
   let (ans, _, ctx) = Pfedit.build_by_tactic ~side_eff (Global.env()) ctx lb_goal
     (compute_lb_tact mode (!lb_scheme_kind_aux()) ind lnamesparrec nparrec)
   in
@@ -793,9 +827,10 @@ 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.Set.add id l)) (List.map RelDecl.get_name lnamesparrec) Id.Set.empty in
     let create_input c =
-      let x = Id.of_string "x" and
-          y = Id.of_string "y" in
+      let x = next_ident_away (Id.of_string "x") avoid and
+          y = next_ident_away (Id.of_string "y") avoid in
       let lb_typ = List.map (fun (s,seq,_,_) ->
         mkNamedProd x (mkVar s) (
             mkNamedProd y (mkVar s) (
@@ -827,16 +862,16 @@ let compute_dec_goal ind lnamesparrec nparrec =
         mkNamedProd seq b a
       ) bl_input (List.rev list_id) (List.rev eqs_typ) in
       List.fold_left (fun a decl -> mkNamedProd
-                (match get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl) a) eq_input lnamesparrec
+                (match RelDecl.get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
+                (RelDecl.get_type decl) a) eq_input lnamesparrec
     in
-      let n = Id.of_string "x" and
-          m = Id.of_string "y" in
+      let n = next_ident_away (Id.of_string "x") avoid and
+          m = next_ident_away (Id.of_string "y") avoid in
         let eqnm = mkApp(eq,[|mkFullInd ind (2*nparrec+2);mkVar n;mkVar m|]) in
         create_input (
           mkNamedProd n (mkFullInd ind (2*nparrec)) (
             mkNamedProd m (mkFullInd ind (2*nparrec+1)) (
-              mkApp(sumbool(),[|eqnm;mkApp (Coqlib.build_coq_not(),[|eqnm|])|])
+              mkApp(sumbool(),[|eqnm;mkApp (Universes.constr_of_global @@ Coqlib.build_coq_not(),[|eqnm|])|])
           )
         )
       )
@@ -856,12 +891,10 @@ let compute_dec_tact ind lnamesparrec nparrec =
       ( List.map (fun (_,_,_,slb) -> slb) list_id )
   in
   let fresh_id s gl =
-    Tacmach.New.of_old begin fun gsig ->
-      let fresh = fresh_id (!avoid) s gsig in
+      let fresh = fresh_id_in_env (Id.Set.of_list !avoid) s (Proofview.Goal.env gl) in
       avoid := fresh::(!avoid); fresh
-    end gl
   in
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter begin fun gl ->
   let fresh_first_intros = List.map (fun id -> fresh_id id gl) first_intros in
   let freshn = fresh_id (Id.of_string "x") gl in
   let freshm = fresh_id (Id.of_string "y") gl in
@@ -887,24 +920,24 @@ let compute_dec_tact ind lnamesparrec nparrec =
         intros_using fresh_first_intros;
         intros_using [freshn;freshm];
 	(*we do this so we don't have to prove the same goal twice *)
-        assert_by (Name freshH) (
+        assert_by (Name freshH) (EConstr.of_constr (
           mkApp(sumbool(),[|eqtrue eqbnm; eqfalse eqbnm|])
-	)
-	  (Tacticals.New.tclTHEN (destruct_on eqbnm) Auto.default_auto);
+	))
+	  (Tacticals.New.tclTHEN (destruct_on (EConstr.of_constr eqbnm)) Auto.default_auto);
 
-        Proofview.Goal.nf_enter { enter = begin fun gl ->
+        Proofview.Goal.enter begin fun gl ->
           let freshH2 = fresh_id (Id.of_string "H") gl in
-	  Tacticals.New.tclTHENS (destruct_on_using (mkVar freshH) freshH2) [
+	  Tacticals.New.tclTHENS (destruct_on_using (EConstr.mkVar freshH) freshH2) [
 	    (* left *)
 	    Tacticals.New.tclTHENLIST [
 	      simplest_left;
-              apply (mkApp(blI,Array.map(fun x->mkVar x) xargs));
+              apply (EConstr.of_constr (mkApp(blI,Array.map(fun x->mkVar x) xargs)));
               Auto.default_auto
             ]
             ;
 
 	    (*right *)
-            Proofview.Goal.nf_enter { enter = begin fun gl ->
+            Proofview.Goal.enter begin fun gl ->
             let freshH3 = fresh_id (Id.of_string "H") gl in
             Tacticals.New.tclTHENLIST [
 	      simplest_right ;
@@ -912,25 +945,25 @@ let compute_dec_tact ind lnamesparrec nparrec =
               intro;
               Equality.subst_all ();
               assert_by (Name freshH3)
-		(mkApp(eq,[|bb;mkApp(eqI,[|mkVar freshm;mkVar freshm|]);tt|]))
+		(EConstr.of_constr (mkApp(eq,[|bb;mkApp(eqI,[|mkVar freshm;mkVar freshm|]);tt|])))
 		(Tacticals.New.tclTHENLIST [
-		  apply (mkApp(lbI,Array.map (fun x->mkVar x) xargs));
+		  apply (EConstr.of_constr (mkApp(lbI,Array.map (fun x->mkVar x) xargs)));
                   Auto.default_auto
 		]);
 	      Equality.general_rewrite_bindings_in true
 	                      Locus.AllOccurrences true false
                               (List.hd !avoid)
-                              ((mkVar (List.hd (List.tl !avoid))),
+                              ((EConstr.mkVar (List.hd (List.tl !avoid))),
                                 NoBindings
                               )
                               true;
-              Equality.discr_tac false None
+              my_discr_tac
 	    ]
-            end }
+            end
 	  ]
-        end }
+        end
   ]
-  end }
+  end
 
 let make_eq_decidability mode mind =
   let mib = Global.lookup_mind mind in
@@ -940,12 +973,12 @@ let make_eq_decidability mode mind =
   let nparams = mib.mind_nparams in
   let nparrec = mib.mind_nparams_rec in
   let u = Univ.Instance.empty in
-  let ctx = Evd.make_evar_universe_context (Global.env ()) None in
+  let ctx = UState.make (Global.universes ()) in
   let lnonparrec,lnamesparrec =
     context_chop (nparams-nparrec) mib.mind_params_ctxt in
   let side_eff = side_effect_of_mode mode in
   let (ans, _, ctx) = Pfedit.build_by_tactic ~side_eff (Global.env()) ctx
-    (compute_dec_goal (ind,u) lnamesparrec nparrec)
+    (EConstr.of_constr (compute_dec_goal (ind,u) lnamesparrec nparrec))
     (compute_dec_tact ind lnamesparrec nparrec)
   in
   ([|ans|], ctx), Safe_typing.empty_private_constants
diff --git a/toplevel/auto_ind_decl.mli b/vernac/auto_ind_decl.mli
index fa5c6148..5cc783df 100644
--- a/toplevel/auto_ind_decl.mli
+++ b/vernac/auto_ind_decl.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -24,6 +26,7 @@ exception InductiveWithSort
 exception ParameterWithoutEquality of Globnames.global_reference
 exception NonSingletonProp of inductive
 exception DecidabilityMutualNotSupported
+exception NoDecidabilityCoInductive
 
 val beq_scheme_kind : mutual scheme_kind
 val build_beq_scheme : mutual_scheme_object_function
diff --git a/toplevel/class.ml b/vernac/class.ml
index 6d53ec9d..59d93310 100644
--- a/toplevel/class.ml
+++ b/vernac/class.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
@@ -11,6 +13,7 @@ open Util
 open Pp
 open Names
 open Term
+open Constr
 open Vars
 open Termops
 open Entries
@@ -62,7 +65,9 @@ let explain_coercion_error g = function
 (* Verifications pour l'ajout d'une classe *)
 
 let check_reference_arity ref =
-  if not (Reductionops.is_arity (Global.env()) Evd.empty (Global.type_of_global_unsafe ref)) then
+  let env = Global.env () in
+  let c, _ = Global.type_of_global_in_context env ref in
+  if not (Reductionops.is_arity env Evd.empty (EConstr.of_constr c)) (** FIXME *) then
     raise (CoercionError (NotAClass ref))
 
 let check_arity = function
@@ -81,15 +86,9 @@ let check_target clt = function
 
 (* condition d'heritage uniforme *)
 
-let uniform_cond nargs lt =
-  let rec aux = function
-    | (0,[]) -> true
-    | (n,t::l) ->
-      let t = strip_outer_cast t in
-      isRel t && Int.equal (destRel 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 -> 
@@ -98,7 +97,7 @@ let class_of_global = function
   | IndRef sp -> CL_IND sp
   | VarRef id -> CL_SECVAR id
   | ConstructRef _ as c ->
-      errorlabstrm "class_of_global"
+      user_err ~hdr:"class_of_global"
 	(str "Constructors, such as " ++ Printer.pr_global c ++
 	   str ", cannot be used as a class.")
 
@@ -115,43 +114,39 @@ 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 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 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
     CL_FUN
   else
-    match pi1 (find_class_type Evd.empty t) with
+    match pi1 (find_class_type Evd.empty (EConstr.of_constr t)) with
     | CL_CONST p when Environ.is_projection p (Global.env ()) -> 
       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
@@ -170,14 +165,14 @@ 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 *)
 
 let error_not_transparent source =
-  errorlabstrm "build_id_coercion"
+  user_err ~hdr:"build_id_coercion"
     (pr_class source ++ str " must be a transparent constant.")
 
 let build_id_coercion idf_opt source poly =
@@ -193,35 +188,36 @@ let build_id_coercion idf_opt source poly =
   let val_f =
     it_mkLambda_or_LetIn
       (mkLambda (Name Namegen.default_dependent_ident,
-		 applistc vs (Context.Rel.to_extended_list 0 lams),
+		 applistc vs (Context.Rel.to_extended_list mkRel 0 lams),
 		 mkRel 1))
        lams
   in
   let typ_f =
-    it_mkProd_wo_LetIn
-      (mkProd (Anonymous, applistc vs (Context.Rel.to_extended_list 0 lams), lift 1 t))
+    List.fold_left (fun d c -> Term.mkProd_wo_LetIn c d)
+      (mkProd (Anonymous, applistc vs (Context.Rel.to_extended_list mkRel 0 lams), lift 1 t))
       lams
   in
   (* juste pour verification *)
   let _ =
     if not
       (Reductionops.is_conv_leq env sigma
-	(Typing.unsafe_type_of env sigma val_f) typ_f)
+	(Typing.unsafe_type_of env sigma (EConstr.of_constr val_f)) (EConstr.of_constr typ_f))
     then
-      errorlabstrm "" (strbrk
+      user_err  (strbrk
 	"Cannot be defined as coercion (maybe a bad number of arguments).")
   in
   let idf =
     match idf_opt with
       | Some idf -> idf
       | None ->
-	  let cl,u,_ = find_class_type sigma t in
+	  let cl,u,_ = find_class_type sigma (EConstr.of_constr t) in
 	  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
@@ -229,7 +225,7 @@ let build_id_coercion idf_opt source poly =
   ConstRef kn
 
 let check_source = function
-| Some (CL_FUN|CL_SORT as s) -> raise (CoercionError (ForbiddenSourceClass s))
+| Some (CL_FUN as s) -> raise (CoercionError (ForbiddenSourceClass s))
 | _ -> ()
 
 (*
@@ -251,19 +247,20 @@ let warn_uniform_inheritance =
 
 let add_new_coercion_core coef stre poly source target isid =
   check_source source;
-  let t = Global.type_of_global_unsafe coef in
+  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 (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
@@ -284,7 +281,7 @@ let add_new_coercion_core coef stre poly source target isid =
 let try_add_new_coercion_core ref ~local c d e f =
   try add_new_coercion_core ref (loc_of_bool local) c d e f
   with CoercionError e ->
-      errorlabstrm "try_add_new_coercion_core"
+      user_err ~hdr:"try_add_new_coercion_core"
         (explain_coercion_error ref e ++ str ".")
 
 let try_add_new_coercion ref ~local poly =
@@ -310,7 +307,7 @@ let add_coercion_hook poly local ref =
   | Global -> false
   | Discharge -> assert false
   in
-  let () = try_add_new_coercion ref stre poly in
+  let () = try_add_new_coercion ref ~local:stre poly in
   let msg = pr_global_env Id.Set.empty ref ++ str " is now a coercion" in
   Flags.if_verbose Feedback.msg_info msg
 
@@ -323,6 +320,6 @@ let add_subclass_hook poly local ref =
   | Discharge -> assert false
   in
   let cl = class_of_global ref in
-  try_add_new_coercion_subclass cl stre poly
+  try_add_new_coercion_subclass cl ~local:stre poly
 
 let add_subclass_hook poly = Lemmas.mk_hook (add_subclass_hook poly)
diff --git a/toplevel/class.mli b/vernac/class.mli
index 5f9ae28f..33d31fe1 100644
--- a/toplevel/class.mli
+++ b/vernac/class.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
diff --git a/vernac/classes.ml b/vernac/classes.ml
new file mode 100644
index 00000000..76d427ad
--- /dev/null
+++ b/vernac/classes.ml
@@ -0,0 +1,438 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(*i*)
+open Names
+open EConstr
+open Nametab
+open CErrors
+open Util
+open Typeclasses_errors
+open Typeclasses
+open Libnames
+open Globnames
+open Constrintern
+open Constrexpr
+open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+(*i*)
+
+open Decl_kinds
+open Entries
+
+let refine_instance = ref true
+
+let _ = Goptions.declare_bool_option {
+  Goptions.optdepr  = false;
+  Goptions.optname  = "definition of instances by refining";
+  Goptions.optkey   = ["Refine";"Instance";"Mode"];
+  Goptions.optread  = (fun () -> !refine_instance);
+  Goptions.optwrite = (fun b -> refine_instance := b)
+}
+
+let typeclasses_db = "typeclass_instances"
+
+let set_typeclass_transparency c local b = 
+  Hints.add_hints local [typeclasses_db] 
+    (Hints.HintsTransparencyEntry ([c], b))
+    
+let _ =
+  Hook.set Typeclasses.add_instance_hint_hook
+    (fun inst path local info poly ->
+     let inst' = match inst with IsConstr c -> Hints.IsConstr (EConstr.of_constr c, Univ.ContextSet.empty)
+       | IsGlobal gr -> Hints.IsGlobRef gr
+     in
+     let info =
+       let open Vernacexpr in
+       { info with hint_pattern =
+		   Option.map
+                     (Constrintern.intern_constr_pattern (Global.env()) Evd.(from_env Global.(env())))
+		     info.hint_pattern } in
+     Flags.silently (fun () ->
+	Hints.add_hints local [typeclasses_db]
+	  (Hints.HintsResolveEntry
+	     [info, poly, false, Hints.PathHints path, inst'])) ());
+  Hook.set Typeclasses.set_typeclass_transparency_hook set_typeclass_transparency;
+  Hook.set Typeclasses.classes_transparent_state_hook
+    (fun () -> Hints.Hint_db.transparent_state (Hints.searchtable_map typeclasses_db))
+
+(** TODO: add subinstances *)
+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 = 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 c)
+      | None -> user_err ?loc:g.CAst.loc
+                         ~hdr:"declare_instance"
+                         (Pp.str "Constant does not build instances of a declared type class.")
+
+let mismatched_params env n m = mismatched_ctx_inst env Parameters n m
+let mismatched_props env n m = mismatched_ctx_inst env Properties n m
+
+(* Declare everything in the parameters as implicit, and the class instance as well *)
+
+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 (sigma, c'), l =
+	match decl with
+        | 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 (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 = 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
+    | _ -> assert false
+
+open Pp
+
+let instance_hook k info global imps ?hook cst =
+  Impargs.maybe_declare_manual_implicits false cst ~enriching:false imps;
+  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 decl poly sigma term termtype =
+  let kind = IsDefinition Instance in
+  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 uctx = Evd.check_univ_decl ~poly sigma decl in
+  let entry = 
+    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;
+    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)
+  ~program_mode poly ctx (instid, bk, cl) props ?(generalize=true)
+  ?(tac:unit Proofview.tactic option) ?hook pri =
+  let env = Global.env() 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 ->
+		let t = CAst.make @@ CHole (None, Misctypes.IntroAnonymous, None) in
+		  t, avoid
+	    | None -> failwith ("new instance: under-applied typeclass"))
+	  cl
+    | Explicit -> cl, Id.Set.empty
+  in
+  let tclass = 
+    if generalize then CAst.make @@ CGeneralization (Implicit, Some AbsPi, tclass) 
+    else tclass 
+  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 sigma c' in
+    let ctx'' = ctx' @ ctx in
+    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, Vars.substl args' b :: args'))
+        cl_context (args, [])
+    in
+      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" (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.vars_of_env env)
+  in
+  let env' = push_rel_context ctx env 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
+	  (fun subst' s decl -> if is_local_assum decl then s :: subst' else subst')
+	  [] subst (snd k.cl_context)
+	in
+	let (_, ty_constr) = instance_constructor (k,u) subst in
+        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 =
+	match props with
+	| Some (true, { CAst.v = CRecord fs }) ->
+	    if List.length fs > List.length k.cl_props then
+	      mismatched_props env' (List.map snd fs) k.cl_props;
+	    Some (Inl fs)
+	| Some (_, t) -> Some (Inr t)
+	| None -> 
+            if program_mode then Some (Inl [])
+	    else None
+      in
+      let subst, sigma =
+	match props with
+        | None ->
+          (if List.is_empty k.cl_props then Some (Inl subst) else None), sigma
+	| Some (Inr term) ->
+            let sigma, c = interp_casted_constr_evars env' sigma term cty in
+            Some (Inr (c, subst)), sigma
+	| Some (Inl props) ->
+            let get_id = CAst.map (function
+                | Ident id' -> id'
+                | Qualid id' -> snd (repr_qualid id'))
+	    in
+	    let props, rest =
+	      List.fold_left
+		(fun (props, rest) decl ->
+		  if is_local_assum decl then
+		    try
+		      let is_id (id', _) = match RelDecl.get_name decl, get_id id' with
+                        | Name id, {CAst.v=id'} -> Id.equal id id'
+			| Anonymous, _ -> false
+                      in
+		       let (loc_mid, c) =
+			 List.find is_id rest 
+		       in
+		       let rest' = 
+			 List.filter (fun v -> not (is_id v)) rest 
+		       in
+                       let {CAst.loc;v=mid} = get_id loc_mid in
+			 List.iter (fun (n, _, x) -> 
+				      if Name.equal n (Name mid) then
+					Option.iter (fun x -> Dumpglob.add_glob ?loc (ConstRef x)) x)
+			   k.cl_projs;
+			 c :: props, rest'
+		     with Not_found ->
+		       ((CAst.make @@ CHole (None(* Some Evar_kinds.GoalEvar *), Misctypes.IntroAnonymous, None)) :: props), rest
+		   else props, rest)
+		([], props) k.cl_props
+	    in
+              match rest with
+              | (n, _) :: _ ->
+		unbound_method env' k.cl_impl (get_id n)
+              | _ ->
+                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
+	    None, termtype
+	| Some (Inl subst) ->
+	  let subst = List.fold_left2
+	    (fun subst' s decl -> if is_local_assum decl then s :: subst' else subst')
+	    [] subst (k.cl_props @ snd k.cl_context)
+	  in
+	  let (app, ty_constr) = instance_constructor (k,u) subst in
+	  let termtype = it_mkProd_or_LetIn ty_constr (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 = it_mkLambda_or_LetIn def ctx in
+	    Some term, termtype
+      in
+      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 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];
+		  Typeclasses.declare_instance (Some pri) (not global) (ConstRef cst)
+	      in
+	      let obls, constr, typ =
+		match term with 
+		| Some t -> 
+		  let obls, _, constr, typ = 
+                    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 sigma in
+		ignore (Obligations.add_definition id ?term:constr
+ 			~univdecl:decl typ ctx ~kind:(Global,poly,Instance) ~hook obls);
+		id
+	    else
+	      (Flags.silently 
+	       (fun () ->
+                  (* spiwack: it is hard to reorder the actions to do
+                     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 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 sigma -> (sigma,EConstr.of_constr (Option.get term)));
+                      Proofview.Unsafe.tclNEWGOALS (CList.map Proofview.with_empty_state gls);
+                      Tactics.New.reduce_after_refine;
+                    ]
+                  in
+		  ignore (Pfedit.by init_refine)
+		else if Flags.is_auto_intros () then
+		  ignore (Pfedit.by (Tacticals.New.tclDO len Tactics.intro));
+		(match tac with Some tac -> ignore (Pfedit.by tac) | None -> ())) ();
+	       id)
+	end
+      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) ->
+        let id = match RelDecl.get_name decl with Anonymous -> invalid_arg "named_of_rel_context" | Name id -> id in
+	let d = match decl with
+	  | LocalAssum (_,t) -> id, None, substl subst t
+	  | LocalDef (_,b,t) -> id, Some (substl subst b), substl subst t in
+	  (mkVar id :: subst, d :: ctx))
+      l ([], [])
+  in ctx
+
+let context poly l =
+  let env = Global.env() 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 univs =
+    let uctx = Evd.universe_context_set sigma in
+    match ctx with
+    | [] -> assert false
+    | [_] ->
+      if poly
+      then Polymorphic_const_entry (Univ.ContextSet.to_context uctx)
+      else Monomorphic_const_entry uctx
+    | _::_::_ ->
+      if Lib.sections_are_opened ()
+      then
+        begin
+          Declare.declare_universe_context poly uctx;
+          if poly then Polymorphic_const_entry Univ.UContext.empty
+          else Monomorphic_const_entry Univ.ContextSet.empty
+        end
+      else if poly
+      then Polymorphic_const_entry (Univ.ContextSet.to_context uctx)
+      else
+        begin
+          Declare.declare_universe_context poly uctx;
+          Monomorphic_const_entry Univ.ContextSet.empty
+        end
+  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
+      (* Declare the universe context once *)
+      let decl = match b with
+      | None ->
+        (ParameterEntry (None,(t,univs),None), IsAssumption Logical)
+      | Some b ->
+        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 sigma (of_constr t) with
+	| Some (rels, ((tc,_), args) as _cl) ->
+            add_instance (Typeclasses.new_instance tc Hints.empty_hint_info false (ConstRef cst));
+            status
+	    (* declare_subclasses (ConstRef cst) cl *)
+	| None -> status
+    else
+      let test (x, _) = match x with
+      | ExplByPos (_, Some id') -> Id.equal id id'
+      | _ -> false
+      in
+      let impl = List.exists test impls in
+      let decl = (Discharge, poly, Definitional) in
+      let nstatus = match b with
+      | None ->
+        pi3 (ComAssumption.declare_assumption false decl (t, univs) Universes.empty_binders [] impl
+          Vernacexpr.NoInline (CAst.make id))
+      | Some b ->
+        let decl = (Discharge, poly, Definition) 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 Universes.empty_binders [] hook in
+        Lib.sections_are_opened () || Lib.is_modtype_strict ()
+      in
+	status && nstatus
+  in 
+  List.fold_left fn true (List.rev ctx)
diff --git a/toplevel/classes.mli b/vernac/classes.mli
index d2cb788e..0342c840 100644
--- a/toplevel/classes.mli
+++ b/vernac/classes.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -30,20 +32,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 list ->
-  typeclass_constraint ->
+  local_binder_expr list ->
+  Vernacexpr.typeclass_constraint ->
   (bool * constr_expr) option ->
   ?generalize:bool ->
   ?tac:unit Proofview.tactic  ->
@@ -63,4 +66,4 @@ val id_of_class : typeclass -> Id.t
 
 (** returns [false] if, for lack of section, it declares an assumption
     (unless in a module type). *)
-val context : Decl_kinds.polymorphic -> local_binder list -> bool
+val context : Decl_kinds.polymorphic -> local_binder_expr list -> bool
diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml
new file mode 100644
index 00000000..6a590758
--- /dev/null
+++ b/vernac/comAssumption.ml
@@ -0,0 +1,182 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pp
+open CErrors
+open Util
+open Vars
+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
+  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 =
+      EConstr.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 sigma 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.minimize_universes sigma in
+  let nf_evar c = EConstr.to_constr sigma 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 00000000..56e32437
--- /dev/null
+++ b/vernac/comAssumption.mli
@@ -0,0 +1,36 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 -> (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 00000000..b18a60a1
--- /dev/null
+++ b/vernac/comDefinition.ml
@@ -0,0 +1,134 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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.minimize_universes 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 00000000..6f81c457
--- /dev/null
+++ b/vernac/comDefinition.mli
@@ -0,0 +1,32 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Entries
+open Decl_kinds
+open Redexpr
+open Constrexpr
+
+(** {6 Definitions/Let} *)
+
+val do_definition : program_mode:bool ->
+  Id.t -> definition_kind -> 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 :
+  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 00000000..1c141c01
--- /dev/null
+++ b/vernac/comFixpoint.ml
@@ -0,0 +1,353 @@
+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
+
+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 impls = compute_internalization_env env sigma 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_evars_and_universes sigma in
+  let fixdefs = List.map (fun c -> Option.map EConstr.(to_constr sigma) c) fixdefs in
+  let fixtypes = List.map EConstr.(to_constr sigma) 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 (local,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 00000000..36c2993a
--- /dev/null
+++ b/vernac/comFixpoint.mli
@@ -0,0 +1,95 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 : Constrexpr.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 00000000..05c40dbd
--- /dev/null
+++ b/vernac/comInductive.ml
@@ -0,0 +1,453 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pp
+open CErrors
+open Sorts
+open Util
+open Constr
+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(make ?loc @@ Ident id,None))) params in
+      CAppExpl ((None,CAst.make ?loc @@ Ident name,None),List.rev args)
+  | c -> c
+  )
+
+let push_types env idl tl =
+  List.fold_left2 (fun env id t -> EConstr.push_rel (LocalAssum (Name id,t)) env)
+    env idl tl
+
+type structured_one_inductive_expr = {
+  ind_name : Id.t;
+  ind_univs : 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 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 sigma 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
+  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 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, _, _) -> EConstr.it_mkProd_or_LetIn c ctx_params) arities in
+  let env_ar = push_types env0 indnames fullarities in
+  let env_ar_params = EConstr.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 sigma ~impls (Inductive (params,true)) indnames fullarities indimpls in
+  let ntn_impls = compute_internalization_env env0 sigma (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 constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf cl,impsl)) constructors in
+  let arities = List.map EConstr.(to_constr sigma) arities 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 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 = List.map Termops.(map_rel_decl (EConstr.to_constr sigma)) 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 00000000..83393572
--- /dev/null
+++ b/vernac/comInductive.mli
@@ -0,0 +1,67 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 : 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 00000000..b95741ca
--- /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 = CAst.make @@ Qualid (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 sigma
+        Constrintern.Recursive 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 00000000..943cb8ef
--- /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/declareDef.ml b/vernac/declareDef.ml
new file mode 100644
index 00000000..77177dfa
--- /dev/null
+++ b/vernac/declareDef.ml
@@ -0,0 +1,66 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Decl_kinds
+open Declare
+open Entries
+open Globnames
+open Impargs
+
+let warn_definition_not_visible =
+  CWarnings.create ~name:"definition-not-visible" ~category:"implicits"
+    Pp.(fun ident ->
+        strbrk "Section definition " ++
+        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) ->
+        Names.Id.print id ++ strbrk " is declared as a local " ++ str kind)
+
+let get_locality id ~kind = function
+| Discharge ->
+  (** If a Let is defined outside a section, then we consider it as a local definition *)
+   warn_local_declaration (id,kind);
+  true
+| Local -> true
+| Global -> false
+
+let declare_global_definition ident ce local k pl imps =
+  let local = get_locality ident ~kind:"definition" local in
+  let kn = declare_constant ident ~local (DefinitionEntry ce, IsDefinition k) in
+  let gr = ConstRef kn in
+  let () = maybe_declare_manual_implicits false gr imps in
+  let () = Declare.declare_univ_binders gr pl in
+  let () = definition_message ident in
+  gr
+
+let declare_definition ident (local, p, k) ce pl imps hook =
+  let fix_exn = Future.fix_exn_of ce.const_entry_body in
+  let r = match local with
+  | Discharge when Lib.sections_are_opened () ->
+    let c = SectionLocalDef ce in
+    let _ = declare_variable ident (Lib.cwd(), c, IsDefinition k) in
+    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
+    gr
+  | Discharge | Local | Global ->
+    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 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
new file mode 100644
index 00000000..010874e2
--- /dev/null
+++ b/vernac/declareDef.mli
@@ -0,0 +1,24 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Decl_kinds
+open Names
+
+val get_locality : Id.t -> kind:string -> Decl_kinds.locality -> bool
+
+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 -> Entries.constant_universes_entry ->
+  Id.t -> Safe_typing.private_constants Entries.proof_output ->
+  Constr.types -> Impargs.manual_implicits ->
+  Globnames.global_reference
diff --git a/toplevel/explainErr.ml b/vernac/explainErr.ml
index 17897460..f9167f96 100644
--- a/toplevel/explainErr.ml
+++ b/vernac/explainErr.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -18,7 +20,7 @@ let guill s = str "\"" ++ str s ++ str "\""
 (** Invariant : exceptions embedded in EvaluatedError satisfy
     Errors.noncritical *)
 
-exception EvaluatedError of std_ppcmds * exn option
+exception EvaluatedError of Pp.t * exn option
 
 (** Registration of generic errors
     Nota: explain_exn does NOT end with a newline anymore!
@@ -27,11 +29,12 @@ exception EvaluatedError of std_ppcmds * exn option
 let explain_exn_default = function
   (* Basic interaction exceptions *)
   | Stream.Error txt -> hov 0 (str "Syntax error: " ++ str txt ++ str ".")
-  | Compat.Token.Error txt -> hov 0 (str "Syntax error: " ++ str txt ++ str ".")
+  | Token.Error txt -> hov 0 (str "Syntax error: " ++ str txt ++ str ".")
   | CLexer.Error.E err -> hov 0 (str (CLexer.Error.to_string err))
   | 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 *)
@@ -45,15 +48,9 @@ let _ = CErrors.register_handler explain_exn_default
 
 (** Pre-explain a vernac interpretation error *)
 
-let wrap_vernac_error with_header (exn, info) strm =
-  if with_header then
-    let header = Pp.tag (Pp.Tag.inj Ppstyle.error_tag Ppstyle.tag) (str "Error:") in
-    let e = EvaluatedError (hov 0 (header ++ spc () ++ strm), None) in
-    (e, info)
-  else
-    (EvaluatedError (strm, None), info)
+let wrap_vernac_error (exn, info) strm = (EvaluatedError (strm, None), info)
 
-let process_vernac_interp_error with_header exn = match fst exn with
+let process_vernac_interp_error exn = match fst exn with
   | Univ.UniverseInconsistency i ->
     let msg =
       if !Constrextern.print_universes then
@@ -61,40 +58,41 @@ let process_vernac_interp_error with_header exn = match fst exn with
 	  Univ.explain_universe_inconsistency Universes.pr_with_global_universes i
       else
 	mt() in
-    wrap_vernac_error with_header exn (str "Universe inconsistency" ++ msg ++ str ".")
+    wrap_vernac_error exn (str "Universe inconsistency" ++ msg ++ str ".")
   | TypeError(ctx,te) ->
-      wrap_vernac_error with_header exn (Himsg.explain_type_error ctx Evd.empty te)
+      let te = Himsg.map_ptype_error EConstr.of_constr te in
+      wrap_vernac_error exn (Himsg.explain_type_error ctx Evd.empty te)
   | PretypeError(ctx,sigma,te) ->
-      wrap_vernac_error with_header exn (Himsg.explain_pretype_error ctx sigma te)
+      wrap_vernac_error exn (Himsg.explain_pretype_error ctx sigma te)
   | Typeclasses_errors.TypeClassError(env, te) ->
-      wrap_vernac_error with_header exn (Himsg.explain_typeclass_error env te)
+      wrap_vernac_error exn (Himsg.explain_typeclass_error env te)
   | InductiveError e ->
-      wrap_vernac_error with_header exn (Himsg.explain_inductive_error e)
+      wrap_vernac_error exn (Himsg.explain_inductive_error e)
   | Modops.ModuleTypingError e ->
-      wrap_vernac_error with_header exn (Himsg.explain_module_error e)
+      wrap_vernac_error exn (Himsg.explain_module_error e)
   | Modintern.ModuleInternalizationError e ->
-      wrap_vernac_error with_header exn (Himsg.explain_module_internalization_error e)
+      wrap_vernac_error exn (Himsg.explain_module_internalization_error e)
   | RecursionSchemeError e ->
-      wrap_vernac_error with_header exn (Himsg.explain_recursion_scheme_error e)
+      wrap_vernac_error exn (Himsg.explain_recursion_scheme_error e)
   | Cases.PatternMatchingError (env,sigma,e) ->
-      wrap_vernac_error with_header exn (Himsg.explain_pattern_matching_error env sigma e)
+      wrap_vernac_error exn (Himsg.explain_pattern_matching_error env sigma e)
   | Tacred.ReductionTacticError e ->
-      wrap_vernac_error with_header exn (Himsg.explain_reduction_tactic_error e)
-  | Logic.RefinerError e ->
-      wrap_vernac_error with_header exn (Himsg.explain_refiner_error e)
+      wrap_vernac_error exn (Himsg.explain_reduction_tactic_error e)
+  | Logic.RefinerError (env, sigma, e) ->
+    wrap_vernac_error exn (Himsg.explain_refiner_error env sigma e)
   | Nametab.GlobalizationError q ->
-      wrap_vernac_error with_header exn
+      wrap_vernac_error exn
         (str "The reference" ++ spc () ++ Libnames.pr_qualid q ++
 	 spc () ++ str "was not found" ++
 	 spc () ++ str "in the current" ++ spc () ++ str "environment.")
   | Refiner.FailError (i,s) ->
       let s = Lazy.force s in
-      wrap_vernac_error with_header exn
+      wrap_vernac_error exn
 	(str "Tactic failure" ++
-         (if Pp.is_empty s then s else str ": " ++ s) ++
+         (if Pp.ismt s then s else str ": " ++ s) ++
          if Int.equal i 0 then str "." else str " (level " ++ int i ++ str").")
   | AlreadyDeclared msg ->
-      wrap_vernac_error with_header exn (msg ++ str ".")
+      wrap_vernac_error exn (msg ++ str ".")
   | _ ->
       exn
 
@@ -108,13 +106,13 @@ let additional_error_info = ref []
 let register_additional_error_info f =
   additional_error_info := f :: !additional_error_info
 
-let process_vernac_interp_error ?(allow_uncaught=true) ?(with_header=true) (exc, info) =
+let process_vernac_interp_error ?(allow_uncaught=true) (exc, info) =
   let exc = strip_wrapping_exceptions exc in
-  let e = process_vernac_interp_error with_header (exc, info) in
+  let e = process_vernac_interp_error (exc, info) in
   let () =
     if not allow_uncaught && not (CErrors.handled (fst e)) then
       let (e, info) = e in
-      let msg = str "Uncaught exception " ++ str (Printexc.to_string e) in
+      let msg = str "Uncaught exception " ++ str (Printexc.to_string e) ++ str "." in
       let err = CErrors.make_anomaly msg in
       Util.iraise (err, info)
   in
@@ -122,8 +120,9 @@ let process_vernac_interp_error ?(allow_uncaught=true) ?(with_header=true) (exc,
     try Some (CList.find_map (fun f -> f e) !additional_error_info)
     with _ -> None
   in
+  let add_loc_opt ?loc info = Option.cata (fun l -> Loc.add_loc info l) info loc in
   match e' with
   | None -> e
-  | Some (None, loc) -> (fst e, Loc.add_loc (snd e) loc)
-  | Some (Some msg, loc) ->
-    (EvaluatedError (msg, Some (fst e)), Loc.add_loc (snd e) loc)
+  | Some (loc, None) -> (fst e, add_loc_opt ?loc (snd e))
+  | Some (loc, Some msg) ->
+    (EvaluatedError (msg, Some (fst e)), add_loc_opt ?loc (snd e))
diff --git a/vernac/explainErr.mli b/vernac/explainErr.mli
new file mode 100644
index 00000000..b54912a1
--- /dev/null
+++ b/vernac/explainErr.mli
@@ -0,0 +1,23 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Toplevel Exception *)
+exception EvaluatedError of Pp.t * exn option
+
+(** Pre-explain a vernac interpretation error *)
+
+val process_vernac_interp_error : ?allow_uncaught:bool -> Util.iexn -> Util.iexn
+
+(** General explain function. Should not be used directly now,
+    see instead function [Errors.print] and variants *)
+
+val explain_exn_default : exn -> Pp.t
+
+val register_additional_error_info : (Util.iexn -> (Pp.t option Loc.located) option) -> unit
diff --git a/toplevel/himsg.ml b/vernac/himsg.ml
index f98505c3..2d2f1cd2 100644
--- a/toplevel/himsg.ml
+++ b/vernac/himsg.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
@@ -11,7 +13,7 @@ open Util
 open Names
 open Nameops
 open Namegen
-open Term
+open Constr
 open Termops
 open Indtypes
 open Environ
@@ -25,85 +27,91 @@ open Printer
 open Evd
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* This simplifies the typing context of Cases clauses *)
 (* hope it does not disturb other typing contexts *)
-let contract env lc =
+let contract env sigma lc =
+  let open EConstr in
   let l = ref [] in
   let contract_context decl env =
     match decl with
-      | LocalDef (_,c',_) when isRel c' ->
+      | LocalDef (_,c',_) when isRel sigma c' ->
           l := (Vars.substl !l c') :: !l;
           env
       | _ ->
-          let t' = Vars.substl !l (get_type decl) in
-          let c' = Option.map (Vars.substl !l) (get_value decl) in
-          let na' = named_hd env t' (get_name decl) in
+          let t = Vars.substl !l (RelDecl.get_type decl) in
+          let decl = decl |> RelDecl.map_name (named_hd env sigma t) |> RelDecl.map_value (Vars.substl !l) |> RelDecl.set_type t in
           l := (mkRel 1) :: List.map (Vars.lift 1) !l;
-          match c' with
-          | None -> push_rel (LocalAssum (na',t')) env
-          | Some c' -> push_rel (LocalDef (na',c',t')) env
+          push_rel decl env
   in
   let env = process_rel_context contract_context env in
   (env, List.map (Vars.substl !l) lc)
 
-let contract2 env a b = match contract env [a;b] with
+let contract2 env sigma a b = match contract env sigma [a;b] with
   | env, [a;b] -> env,a,b | _ -> assert false
 
-let contract3 env a b c = match contract env [a;b;c] with
+let contract3 env sigma a b c = match contract env sigma [a;b;c] with
   | env, [a;b;c] -> env,a,b,c | _ -> assert false
 
-let contract4 env a b c d = match contract env [a;b;c;d] with
+let contract4 env sigma a b c d = match contract env sigma [a;b;c;d] with
   | env, [a;b;c;d] -> (env,a,b,c),d | _ -> assert false
 
-let contract1_vect env a v =
-  match contract env (a :: Array.to_list v) with
+let contract1_vect env sigma a v =
+  match contract env sigma (a :: Array.to_list v) with
   | env, a::l -> env,a,Array.of_list l
   | _ -> assert false
 
-let rec contract3' env a b c = function
-  | OccurCheck (evk,d) -> let x,d = contract4 env a b c d in x,OccurCheck(evk,d)
+let rec contract3' env sigma a b c = function
+  | OccurCheck (evk,d) ->
+    let x,d = contract4 env sigma a b c d in x,OccurCheck(evk, d)
   | NotClean ((evk,args),env',d) ->
-      let env',d,args = contract1_vect env' d args in
-      contract3 env a b c,NotClean((evk,args),env',d)
+      let env',d,args = contract1_vect env' sigma d args in
+      contract3 env sigma a b c,NotClean((evk,args),env',d)
   | ConversionFailed (env',t1,t2) ->
-      let (env',t1,t2) = contract2 env' t1 t2 in
-      contract3 env a b c, ConversionFailed (env',t1,t2)
+      let (env',t1,t2) = contract2 env' sigma t1 t2 in
+      contract3 env sigma a b c, ConversionFailed (env',t1,t2)
   | NotSameArgSize | NotSameHead | NoCanonicalStructure
   | MetaOccurInBody _ | InstanceNotSameType _ | ProblemBeyondCapabilities
-  | UnifUnivInconsistency _ as x -> contract3 env a b c, x
+  | UnifUnivInconsistency _ as x -> contract3 env sigma a b c, x
   | CannotSolveConstraint ((pb,env',t,u),x) ->
-      let env',t,u = contract2 env' t u in
-      let y,x = contract3' env a b c x in
+      let t = EConstr.of_constr t in
+      let u = EConstr.of_constr u in
+      let env',t,u = contract2 env' sigma t u in
+      let t = EConstr.Unsafe.to_constr t in
+      let u = EConstr.Unsafe.to_constr u in
+      let y,x = contract3' env sigma a b c x in
       y,CannotSolveConstraint ((pb,env',t,u),x)
 
 (** 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 (j_nf_betaiotaevar sigma) 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_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)
 
 (** A canonisation procedure for constr such that comparing there
     externalisation catches more equalities *)
-let canonize_constr c =
+let canonize_constr sigma c =
   (* replaces all the names in binders by [dn] ("default name"),
      ensures that [alpha]-equivalent terms will have the same
      externalisation. *)
+  let open EConstr in
   let dn = Name.Anonymous in
   let rec canonize_binders c =
-    match Term.kind_of_term c with
+    match EConstr.kind sigma c with
     | Prod (_,t,b) -> mkProd(dn,t,b)
     | Lambda (_,t,b) -> mkLambda(dn,t,b)
     | LetIn (_,u,t,b) -> mkLetIn(dn,u,t,b)
-    | _ -> Term.map_constr canonize_binders c
+    | _ -> EConstr.map sigma canonize_binders c
   in
   canonize_binders c
 
@@ -111,8 +119,8 @@ let canonize_constr c =
 let display_eq ~flags env sigma t1 t2 =
   (* terms are canonized, then their externalisation is compared syntactically *)
   let open Constrextern in
-  let t1 = canonize_constr t1 in
-  let t2 = canonize_constr t2 in
+  let t1 = canonize_constr sigma t1 in
+  let t2 = canonize_constr sigma t2 in
   let ct1 = Flags.with_options flags (fun () -> extern_constr false env sigma t1) () in
   let ct2 = Flags.with_options flags (fun () -> extern_constr false env sigma t2) () in
   Constrexpr_ops.constr_expr_eq ct1 ct2
@@ -122,7 +130,7 @@ let display_eq ~flags env sigma t1 t2 =
 let rec pr_explicit_aux env sigma t1 t2 = function
 | [] ->
   (** no specified flags: default. *)
-  (quote (Printer.pr_lconstr_env env sigma t1), quote (Printer.pr_lconstr_env env sigma t2))
+  (quote (Printer.pr_leconstr_env env sigma t1), quote (Printer.pr_leconstr_env env sigma t2))
 | flags :: rem ->
   let equal = display_eq ~flags env sigma t1 t2 in
   if equal then
@@ -145,12 +153,13 @@ let explicit_flags =
     [print_implicits; print_coercions; print_no_symbol]; (** Then more! *)
     [print_universes; print_implicits; print_coercions; print_no_symbol] (** and more! *) ]
 
-let pr_explicit env sigma t1 t2 = pr_explicit_aux env sigma t1 t2 explicit_flags
+let pr_explicit env sigma t1 t2 =
+  pr_explicit_aux env sigma t1 t2 explicit_flags
 
 let pr_db env i =
   try
-    match lookup_rel i env |> get_name with
-      | Name id -> pr_id id
+    match env |> lookup_rel i |> get_name with
+      | Name id -> Id.print id
       | Anonymous -> str "<>"
   with Not_found -> str "UNBOUND_REL_" ++ int i
 
@@ -160,11 +169,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 () ++
@@ -178,10 +186,10 @@ let explain_bad_assumption env sigma j =
   brk(1,1) ++ pc ++ spc () ++ str "of type" ++ spc () ++ pt ++ spc () ++
   str "because this term is not a type."
 
-let explain_reference_variables id c =
+let explain_reference_variables sigma id c =
   (* c is intended to be a global reference *)
-  let pc = pr_global (Globnames.global_of_constr c) in
-  pc ++ strbrk " depends on the variable " ++ pr_id id ++
+  let pc = pr_global (fst (Termops.global_of_constr sigma c)) in
+  pc ++ strbrk " depends on the variable " ++ Id.print id ++
   strbrk " which is not declared in the context."
 
 let rec pr_disjunction pr = function
@@ -197,9 +205,10 @@ let pr_puniverses f env (c,u) =
   else mt())
 
 let explain_elim_arity env sigma ind sorts c pj okinds =
-  let env = make_all_name_different env in
+  let open EConstr in
+  let env = make_all_name_different env sigma in
   let pi = pr_inductive env (fst ind) in
-  let pc = pr_lconstr_env env sigma c in
+  let pc = pr_leconstr_env env sigma c in
   let msg = match okinds with
   | Some(kp,ki,explanation) ->
       let pki = pr_sort_family ki in
@@ -212,7 +221,7 @@ let explain_elim_arity env sigma ind sorts c pj okinds =
 	| WrongArity ->
 	  "wrong arity" in
       let ppar = pr_disjunction (fun s -> quote (pr_sort_family s)) sorts in
-      let ppt = pr_lconstr_env env sigma ((strip_prod_assum pj.uj_type)) in
+      let ppt = pr_leconstr_env env sigma (snd (decompose_prod_assum sigma pj.uj_type)) in
       hov 0
 	(str "the return type has sort" ++ spc () ++ ppt ++ spc () ++
 	 str "while it" ++ spc () ++ str "should be " ++ ppar ++ str ".") ++
@@ -231,11 +240,10 @@ 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 in
-  let pc = pr_lconstr_env env sigma cj.uj_val in
-  let pct = pr_lconstr_env env sigma cj.uj_type in
-    match kind_of_term cj.uj_type with
+  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
+    match EConstr.kind sigma cj.uj_type with
       | Evar _ ->
 	  str "Cannot infer a type for this expression."
       | _ ->
@@ -244,19 +252,17 @@ 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 in
-  let pc = pr_lconstr_env env sigma cj.uj_val in
-  let pct = pr_lconstr_env env sigma cj.uj_type 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
   str "Matching on term" ++ brk(1,1) ++ pc ++ spc () ++
   str "of type" ++ brk(1,1) ++ pct ++ spc () ++
   str "expects " ++  int expn ++ str " branches."
 
 let explain_ill_formed_branch env sigma c ci actty expty =
-  let simp t = Reduction.nf_betaiota env (Evarutil.nf_evar sigma t) in
-  let c = Evarutil.nf_evar sigma c in
-  let env = make_all_name_different env in
-  let pc = pr_lconstr_env env sigma c 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
   strbrk "In pattern-matching on term" ++ brk(1,1) ++ pc ++
   spc () ++ strbrk "the branch for constructor" ++ spc () ++
@@ -266,7 +272,7 @@ let explain_ill_formed_branch env sigma c ci actty expty =
 
 let explain_generalization env sigma (name,var) j =
   let pe = pr_ne_context_of (str "In environment") env sigma in
-  let pv = pr_ltype_env env sigma var in
+  let pv = pr_letype_env env sigma var in
   let (pc,pt) = pr_ljudge_env (push_rel_assum (name,var) env) sigma j in
   pe ++ str "Cannot generalize" ++ brk(1,1) ++ pv ++ spc () ++
   str "over" ++ brk(1,1) ++ pc ++ str "," ++ spc () ++
@@ -278,27 +284,24 @@ let explain_unification_error env sigma p1 p2 = function
   | Some e ->
      let rec aux p1 p2 = function
      | OccurCheck (evk,rhs) ->
-        let rhs = Evarutil.nf_evar sigma rhs in
         [str "cannot define " ++ quote (pr_existential_key sigma evk) ++
-	strbrk " with term " ++ pr_lconstr_env env sigma rhs ++
+	strbrk " with term " ++ pr_leconstr_env env sigma rhs ++
         strbrk " that would depend on itself"]
      | NotClean ((evk,args),env,c) ->
-        let c = Evarutil.nf_evar sigma c in
-        let args = Array.map (Evarutil.nf_evar sigma) args in
         [str "cannot instantiate " ++ quote (pr_existential_key sigma evk)
-        ++ strbrk " because " ++ pr_lconstr_env env sigma c ++
+        ++ strbrk " because " ++ pr_leconstr_env env sigma c ++
 	strbrk " is not in its scope" ++
         (if Array.is_empty args then mt() else
          strbrk ": available arguments are " ++
-         pr_sequence (pr_lconstr_env env sigma) (List.rev (Array.to_list args)))]
+         pr_sequence (pr_leconstr_env env sigma) (List.rev (Array.to_list args)))]
      | NotSameArgSize | NotSameHead | NoCanonicalStructure ->
         (* Error speaks from itself *) []
      | ConversionFailed (env,t1,t2) ->
-        if Term.eq_constr t1 p1 && Term.eq_constr t2 p2 then [] else
-        let env = make_all_name_different env in
-        let t1 = Evarutil.nf_evar sigma t1 in
-        let t2 = Evarutil.nf_evar sigma t2 in
-        if not (Term.eq_constr t1 p1) || not (Term.eq_constr t2 p2) then
+        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
+        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]
         else []
@@ -319,11 +322,11 @@ let explain_unification_error env sigma p1 p2 = function
 	else
           [str "universe inconsistency"]
      | CannotSolveConstraint ((pb,env,t,u),e) ->
-        let t = Evarutil.nf_evar sigma t in
-        let u = Evarutil.nf_evar sigma u in
-        let env = make_all_name_different env in
-        (strbrk "cannot satisfy constraint " ++ pr_lconstr_env env sigma t ++
-        str " == " ++ pr_lconstr_env env sigma u)
+        let t = EConstr.of_constr t in
+        let u = EConstr.of_constr 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)
         :: aux t u e
      | ProblemBeyondCapabilities ->
         []
@@ -334,12 +337,12 @@ let explain_unification_error env sigma p1 p2 = function
             prlist_with_sep pr_semicolon (fun x -> x) l ++ str ")"
 
 let explain_actual_type env sigma j t reason =
-  let env = make_all_name_different env in
-  let j = j_nf_betaiotaevar sigma j in
-  let t = Reductionops.nf_betaiota sigma t in
+  let env = make_all_name_different env sigma 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_lconstr_env env sigma (Environ.j_val j) in
+  let pc = pr_leconstr_env env sigma (Environ.j_val j) in
   let (pt, pct) = pr_explicit env sigma t (Environ.j_type j) in
   let ppreason = explain_unification_error env sigma j.uj_type t reason in
   pe ++
@@ -350,11 +353,9 @@ 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 env = make_all_name_different env 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
 (*  let pe = pr_ne_context_of (str "in environment") env sigma in*)
@@ -378,17 +379,15 @@ 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 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*)
-  let pr = pr_lconstr_env env sigma rator.uj_val in
-  let prt = pr_lconstr_env env sigma rator.uj_type in
+  let pr = pr_leconstr_env env sigma rator.uj_val in
+  let prt = pr_leconstr_env env sigma rator.uj_type in
   let appl = prvect_with_sep fnl
 	       (fun c ->
-		  let pc = pr_lconstr_env env sigma c.uj_val in
-		  let pct = pr_lconstr_env env sigma c.uj_type in
+		  let pc = pr_leconstr_env env sigma c.uj_val in
+		  let pct = pr_leconstr_env env sigma c.uj_type in
 		  hov 2 (pc ++ spc () ++ str ": " ++ pct)) randl
   in
   str "Illegal application (Non-functional construction): " ++
@@ -399,25 +398,24 @@ 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."
 
 let explain_not_product env sigma c =
-  let c = Evarutil.nf_evar sigma c in
+  let c = EConstr.to_constr sigma c in
   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 *)
 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
@@ -427,12 +425,12 @@ let explain_ill_formed_rec_body env sigma err names i fixenv vdefj =
       str "Not enough abstractions in the definition"
   | RecursionNotOnInductiveType c ->
       str "Recursive definition on" ++ spc () ++ pr_lconstr_env env sigma c ++
-      spc () ++ str "which should be an inductive type"
+      spc () ++ str "which should be a recursive inductive type"
   | RecursionOnIllegalTerm(j,(arg_env, arg),le,lt) ->
-      let arg_env = make_all_name_different arg_env in
+      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 =
@@ -452,7 +450,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"
 
@@ -495,16 +493,14 @@ let explain_ill_formed_rec_body env sigma err names i fixenv vdefj =
   pr_ne_context_of (str "In environment") env sigma ++
   st ++ str "." ++ fnl () ++
   (try (* May fail with unresolved globals. *)
-      let fixenv = make_all_name_different fixenv in
+      let fixenv = make_all_name_different fixenv sigma in
       let pvd = pr_lconstr_env fixenv sigma vdefj.(i).uj_val in
 	str"Recursive definition is:" ++ spc () ++ pvd ++ str "."
     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 in
-  let pvd = pr_lconstr_env env sigma vdefj.(i).uj_val 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
   str "The " ++
   (match vdefj with [|_|] -> mt () | _ -> pr_nth (i+1) ++ spc ()) ++
@@ -513,16 +509,14 @@ let explain_ill_typed_rec_body env sigma i names vdefj vargs =
   str "while it should be" ++ spc () ++ pv ++ str "."
 
 let explain_cant_find_case_type env sigma c =
-  let c = Evarutil.nf_evar sigma c in
-  let env = make_all_name_different env in
-  let pe = pr_lconstr_env env sigma c in
+  let env = make_all_name_different env sigma in
+  let pe = pr_leconstr_env env sigma c in
   str "Cannot infer the return type of pattern-matching on" ++ ws 1 ++
     pe ++ str "."
 
 let explain_occur_check env sigma ev rhs =
-  let rhs = Evarutil.nf_evar sigma rhs in
-  let env = make_all_name_different env in
-  let pt = pr_lconstr_env env sigma rhs in
+  let env = make_all_name_different env sigma in
+  let pt = pr_leconstr_env env sigma rhs in
   str "Cannot define " ++ pr_existential_key sigma ev ++ str " with term" ++
   brk(1,1) ++ pt ++ spc () ++ str "that would depend on itself."
 
@@ -533,6 +527,8 @@ let pr_trailing_ne_context_of env sigma =
   else (str " in environment:"++ pr_context_unlimited env sigma)
 
 let rec explain_evar_kind env sigma evk ty = function
+  | Evar_kinds.NamedHole id ->
+      strbrk "the existential variable named " ++ Id.print id
   | Evar_kinds.QuestionMark _ ->
       strbrk "this placeholder of type " ++ ty
   | Evar_kinds.CasesType false ->
@@ -541,12 +537,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
@@ -562,20 +558,20 @@ 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_lconstr_env env sigma (Evarutil.nf_evar sigma c)
+      | Evar_defined c -> pr_leconstr_env env sigma (EConstr.of_constr c)
       | Evar_empty -> assert false in
-      let ty' = Evarutil.nf_evar sigma 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'
-      (pr_lconstr_env env sigma ty') (snd evi.evar_source)
+      (pr_leconstr_env env sigma ty') (snd evi.evar_source)
 
 let explain_typeclass_resolution env sigma evi k =
-  match Typeclasses.class_of_constr evi.evar_concl with
+  match Typeclasses.class_of_constr sigma (EConstr.of_constr evi.evar_concl) with
   | Some _ ->
     let env = Evd.evar_filtered_env evi in
       fnl () ++ str "Could not find an instance for " ++
@@ -588,7 +584,7 @@ let explain_placeholder_kind env sigma c e =
   | Some (SeveralInstancesFound n) ->
       strbrk " (several distinct possible type class instances found)"
   | None ->
-      match Typeclasses.class_of_constr c with
+      match Typeclasses.class_of_constr sigma (EConstr.of_constr c) with
       | Some _ -> strbrk " (no type class instance found)"
       | _ -> mt ()
 
@@ -602,7 +598,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 "."
 
@@ -618,9 +614,7 @@ let explain_wrong_case_info env (ind,u) ci =
     spc () ++ pc ++ str "."
 
 let explain_cannot_unify env sigma m n e =
-  let env = make_all_name_different env in
-  let m = Evarutil.nf_evar sigma m in
-  let n = Evarutil.nf_evar sigma n in
+  let env = make_all_name_different env sigma 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
@@ -628,40 +622,45 @@ let explain_cannot_unify env sigma m n e =
   str "with" ++ brk(1,1) ++ pn ++ ppreason ++ str "."
 
 let explain_cannot_unify_local env sigma m n subn =
-  let pm = pr_lconstr_env env sigma m in
-  let pn = pr_lconstr_env env sigma n in
-  let psubn = pr_lconstr_env env sigma subn in
+  let pm = pr_leconstr_env env sigma m in
+  let pn = pr_leconstr_env env sigma n in
+  let psubn = pr_leconstr_env env sigma subn in
     str "Unable to unify" ++ brk(1,1) ++ pm ++ spc () ++
       str "with" ++ brk(1,1) ++ pn ++ spc () ++ str "as" ++ brk(1,1) ++
       psubn ++ str " contains local variables."
 
 let explain_refiner_cannot_generalize env sigma ty =
   str "Cannot find a well-typed generalisation of the goal with type: " ++
-  pr_lconstr_env env sigma ty ++ str "."
+  pr_leconstr_env env sigma ty ++ str "."
 
 let explain_no_occurrence_found env sigma c id =
+  let c = EConstr.to_constr sigma c in
   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 =
-  let pm = pr_lconstr_env env sigma m in
-  let pn = pr_lconstr_env env sigma n in
+  let pm = pr_leconstr_env env sigma m in
+  let pn = pr_leconstr_env env sigma n in
   str "This binding has type" ++ brk(1,1) ++ pm ++ spc () ++
   str "which should be unifiable with" ++ brk(1,1) ++ pn ++ str "."
 
 let explain_cannot_find_well_typed_abstraction env sigma p l e =
+  let p = EConstr.to_constr sigma p in
   str "Abstracting over the " ++
   str (String.plural (List.length l) "term") ++ spc () ++
-  hov 0 (pr_enum (pr_lconstr_env env sigma) l) ++ spc () ++
+  hov 0 (pr_enum (fun c -> pr_lconstr_env env sigma (EConstr.to_constr sigma c)) l) ++ spc () ++
   str "leads to a term" ++ spc () ++ pr_lconstr_goal_style_env env sigma p ++
   spc () ++ str "which is ill-typed." ++
   (match e with None -> mt () | Some e -> fnl () ++ str "Reason is: " ++ e)
 
 let explain_wrong_abstraction_type env sigma na abs expected result =
-  let ppname = match na with Name id -> pr_id id ++ spc () | _ -> mt () in
+  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 -> 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 " ++
@@ -669,21 +668,22 @@ let explain_wrong_abstraction_type env sigma na abs expected result =
 
 let explain_abstraction_over_meta _ m n =
   strbrk "Too complex unification problem: cannot find a solution for both " ++
-  pr_name m ++ spc () ++ str "and " ++ pr_name n ++ str "."
+  Name.print m ++ spc () ++ str "and " ++ Name.print n ++ str "."
 
 let explain_non_linear_unification env sigma m t =
+  let t = EConstr.to_constr sigma t in
   strbrk "Cannot unambiguously instantiate " ++
-  pr_name m ++ str ":" ++
+  Name.print m ++ str ":" ++
   strbrk " which would require to abstract twice on " ++
   pr_lconstr_env env sigma t ++ str "."
 
 let explain_unsatisfied_constraints env sigma cst =
   strbrk "Unsatisfied constraints: " ++ 
-    Univ.pr_constraints (Evd.pr_evd_level sigma) cst ++ 
+    Univ.pr_constraints (Termops.pr_evd_level sigma) cst ++ 
     spc () ++ str "(maybe a bugged tactic)."
 
 let explain_type_error env sigma err =
-  let env = make_all_name_different env in
+  let env = make_all_name_different env sigma in
   match err with
   | UnboundRel n ->
       explain_unbound_rel env sigma n
@@ -694,7 +694,7 @@ let explain_type_error env sigma err =
   | BadAssumption c ->
       explain_bad_assumption env sigma c
   | ReferenceVariables (id,c) ->
-      explain_reference_variables id c
+      explain_reference_variables sigma id c
   | ElimArity (ind, aritylst, c, pj, okinds) ->
       explain_elim_arity env sigma ind aritylst c pj okinds
   | CaseNotInductive cj ->
@@ -723,9 +723,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 =
@@ -733,12 +733,16 @@ let explain_cannot_unify_occurrences env sigma nested ((cl2,pos2),t2) ((cl1,pos1
     str "Found nested occurrences of the pattern at positions " ++
     int pos1 ++ strbrk " and " ++ pr_position (cl2,pos2) ++ str "."
   else
-    let ppreason = match e with None -> mt() | Some (c1,c2,e) -> explain_unification_error env sigma c1 c2 (Some e) in
+    let ppreason = match e with
+    | None -> mt()
+    | Some (c1,c2,e) ->
+      explain_unification_error env sigma c1 c2 (Some e)
+    in
     str "Found incompatible occurrences of the pattern" ++ str ":" ++
-    spc () ++ str "Matched term " ++ pr_lconstr_env env sigma t2 ++
+    spc () ++ str "Matched term " ++ pr_lconstr_env env sigma (EConstr.to_constr sigma t2) ++
     strbrk " at position " ++ pr_position (cl2,pos2) ++
     strbrk " is not compatible with matched term " ++
-    pr_lconstr_env env sigma t1 ++ strbrk " at position " ++
+    pr_lconstr_env env sigma (EConstr.to_constr sigma t1) ++ strbrk " at position " ++
     pr_position (cl1,pos1) ++ ppreason ++ str "."
 
 let pr_constraints printenv env sigma evars cstrs =
@@ -758,14 +762,14 @@ let pr_constraints printenv env sigma evars cstrs =
         (fun (ev, evi) -> fnl () ++ pr_existential_key sigma ev ++
             str " : " ++ pr_lconstr_env env' sigma evi.evar_concl ++ fnl ()) l
       in
-      h 0 (pe ++ evs ++ pr_evar_constraints cstrs)
+      h 0 (pe ++ evs ++ pr_evar_constraints sigma cstrs)
     else
       let filter evk _ = Evar.Map.mem evk evars in
       pr_evar_map_filter ~with_univs:false filter sigma
 
 let explain_unsatisfiable_constraints env sigma constr comp =
   let (_, constraints) = Evd.extract_all_conv_pbs sigma in
-  let undef = Evd.undefined_map (Evarutil.nf_evar_map_undefined sigma) in
+  let undef = Evd.undefined_map sigma in
   (** Only keep evars that are subject to resolution and members of the given
      component. *)
   let is_kept evk evi = match comp with
@@ -794,23 +798,23 @@ let explain_unsatisfiable_constraints env sigma constr comp =
 
 let explain_pretype_error env sigma err =
   let env = Evardefine.env_nf_betaiotaevar sigma env in
-  let env = make_all_name_different env in
+  let env = make_all_name_different env sigma in
   match err with
   | CantFindCaseType c -> explain_cant_find_case_type env sigma c
   | ActualTypeNotCoercible (j,t,e) ->
     let {uj_val = c; uj_type = actty} = j in
-    let (env, c, actty, expty), e = contract3' env c actty t e in
+    let (env, c, actty, expty), e = contract3' env sigma c actty t e in
     let j = {uj_val = c; uj_type = actty} in
     explain_actual_type env sigma j expty (Some e)
   | UnifOccurCheck (ev,rhs) -> explain_occur_check env sigma ev rhs
   | UnsolvableImplicit (evk,exp) -> explain_unsolvable_implicit env sigma evk exp
   | VarNotFound id -> explain_var_not_found env id
   | UnexpectedType (actual,expect) ->
-    let env, actual, expect = contract2 env actual expect in
+    let env, actual, expect = contract2 env sigma actual expect in
     explain_unexpected_type env sigma actual expect
   | NotProduct c -> explain_not_product env sigma c
   | CannotUnify (m,n,e) ->
-    let env, m, n = contract2 env m n in
+    let env, m, n = contract2 env sigma m n in
     explain_cannot_unify env sigma m n e
   | CannotUnifyLocal (m,n,sn) -> explain_cannot_unify_local env sigma m n sn
   | CannotGeneralize ty -> explain_refiner_cannot_generalize env sigma ty
@@ -840,7 +844,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) ->
@@ -865,12 +869,13 @@ 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 ->
-    strbrk "a definition whose type is constrained can only be subtype " ++
-    strbrk "of a definition whose type is itself constrained"
+  | CumulativeStatusExpected b ->
+    let status b = if b then str"cumulative" else str"non-cumulative" in
+      str "a " ++ status b ++ str" declaration was expected, but a " ++ 
+	status (not b) ++ str" declaration was found"
   | PolymorphicStatusExpected b ->
     let status b = if b then str"polymorphic" else str"monomorphic" in
       str "a " ++ status b ++ str" declaration was expected, but a " ++ 
@@ -887,14 +892,15 @@ let explain_not_match_error = function
       quote (Printer.safe_pr_lconstr_env env Evd.empty t2)
   | IncompatibleConstraints cst ->
     str " the expected (polymorphic) constraints do not imply " ++
-      quote (Univ.pr_constraints (Evd.pr_evd_level Evd.empty) cst)
+      let cst = Univ.AUContext.instantiate (Univ.AUContext.instance cst) cst in
+      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 " ++
@@ -924,11 +930,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."
@@ -937,19 +943,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 =
@@ -1003,10 +1009,11 @@ let explain_module_internalization_error = function
 (* Typeclass errors *)
 
 let explain_not_a_class env c =
+  let c = EConstr.to_constr Evd.empty c in
   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 () ++
+let explain_unbound_method env cid { CAst.v = id } =
+  str "Unbound method name " ++ Id.print (id) ++ spc () ++
   str"of class" ++ spc () ++ pr_global cid ++ str "."
 
 let pr_constr_exprs exprs =
@@ -1027,52 +1034,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 pr_name l ++ str"."
+  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_lconstr 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 *)
@@ -1091,8 +1098,8 @@ 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 c) 0 in
-  str "The type of constructor" ++ brk(1,1) ++ pr_id id ++ brk(1,1) ++
+  let atomic = Int.equal (nb_prod Evd.empty (EConstr.of_constr c)) (** FIXME *) 0 in
+  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 ++
@@ -1110,7 +1117,7 @@ let error_ill_formed_constructor env id c v nparams nargs =
 
 let pr_ltype_using_barendregt_convention_env env c =
   (* Use goal_concl_style as an approximation of Barendregt's convention (?) *)
-  quote (pr_goal_concl_style_env env Evd.empty c)
+  quote (pr_goal_concl_style_env env Evd.empty (EConstr.of_constr c))
 
 let error_bad_ind_parameters env c n v1 v2  =
   let pc = pr_ltype_using_barendregt_convention_env env c in
@@ -1120,17 +1127,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 () ++
@@ -1151,7 +1158,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 "."
 
@@ -1192,7 +1199,8 @@ let explain_recursion_scheme_error = function
 (* Pattern-matching errors *)
 
 let explain_bad_pattern env sigma cstr ty =
-  let env = make_all_name_different env in
+  let ty = EConstr.to_constr sigma ty in
+  let env = make_all_name_different env sigma in
   let pt = pr_lconstr_env env sigma ty in
   let pc = pr_constructor env cstr in
   str "Found the constructor " ++ pc ++ brk(1,1) ++
@@ -1235,13 +1243,15 @@ let explain_non_exhaustive env pats =
   spc () ++ hov 0 (prlist_with_sep pr_comma pr_cases_pattern pats)
 
 let explain_cannot_infer_predicate env sigma typs =
-  let env = make_all_name_different env in
+  let inj c = EConstr.to_constr sigma c in
+  let typs = Array.map_to_list (fun (c1, c2) -> (inj c1, inj c2)) typs in
+  let env = make_all_name_different env sigma in
   let pr_branch (cstr,typ) =
     let cstr,_ = decompose_app cstr in
     str "For " ++ pr_lconstr_env env sigma cstr ++ str ": " ++ pr_lconstr_env env sigma typ
   in
   str "Unable to unify the types found in the branches:" ++
-  spc () ++ hov 0 (prlist_with_sep fnl pr_branch (Array.to_list typs))
+  spc () ++ hov 0 (prlist_with_sep fnl pr_branch typs)
 
 let explain_pattern_matching_error env sigma = function
   | BadPattern (c,t) ->
@@ -1259,8 +1269,48 @@ let explain_pattern_matching_error env sigma = function
   | CannotInferPredicate typs ->
       explain_cannot_infer_predicate env sigma typs
 
+let map_pguard_error f = function
+| NotEnoughAbstractionInFixBody -> NotEnoughAbstractionInFixBody
+| RecursionNotOnInductiveType c -> RecursionNotOnInductiveType (f c)
+| RecursionOnIllegalTerm (n, (env, c), l1, l2) -> RecursionOnIllegalTerm (n, (env, f c), l1, l2)
+| NotEnoughArgumentsForFixCall n -> NotEnoughArgumentsForFixCall n
+| CodomainNotInductiveType c -> CodomainNotInductiveType (f c)
+| NestedRecursiveOccurrences -> NestedRecursiveOccurrences
+| UnguardedRecursiveCall c -> UnguardedRecursiveCall (f c)
+| RecCallInTypeOfAbstraction c -> RecCallInTypeOfAbstraction (f c)
+| RecCallInNonRecArgOfConstructor c -> RecCallInNonRecArgOfConstructor (f c)
+| RecCallInTypeOfDef c -> RecCallInTypeOfDef (f c)
+| RecCallInCaseFun c -> RecCallInCaseFun (f c)
+| RecCallInCaseArg c -> RecCallInCaseArg (f c)
+| RecCallInCasePred c -> RecCallInCasePred (f c)
+| NotGuardedForm c -> NotGuardedForm (f c)
+| ReturnPredicateNotCoInductive c -> ReturnPredicateNotCoInductive (f c)
+
+let map_ptype_error f = function
+| UnboundRel n -> UnboundRel n
+| UnboundVar id -> UnboundVar id
+| NotAType j -> NotAType (on_judgment f j)
+| BadAssumption j -> BadAssumption (on_judgment f j)
+| ReferenceVariables (id, c) -> ReferenceVariables (id, f c)
+| ElimArity (pi, dl, c, j, ar) -> ElimArity (pi, dl, f c, on_judgment f j, ar)
+| CaseNotInductive j -> CaseNotInductive (on_judgment f j)
+| WrongCaseInfo (pi, ci) -> WrongCaseInfo (pi, ci)
+| NumberBranches (j, n) -> NumberBranches (on_judgment f j, n)
+| IllFormedBranch (c, pc, t1, t2) -> IllFormedBranch (f c, pc, f t1, f t2)
+| Generalization ((na, t), j) -> Generalization ((na, f t), on_judgment f j)
+| ActualType (j, t) -> ActualType (on_judgment f j, f t)
+| CantApplyBadType ((n, c1, c2), j, vj) ->
+  CantApplyBadType ((n, f c1, f c2), on_judgment f j, Array.map (on_judgment f) vj)
+| CantApplyNonFunctional (j, jv) -> CantApplyNonFunctional (on_judgment f j, Array.map (on_judgment f) jv)
+| IllFormedRecBody (ge, na, n, env, jv) ->
+  IllFormedRecBody (map_pguard_error f ge, na, n, env, Array.map (on_judgment f) jv)
+| IllTypedRecBody (n, na, jv, t) ->
+  IllTypedRecBody (n, na, Array.map (on_judgment f) jv, Array.map f t)
+| UnsatisfiedConstraints g -> UnsatisfiedConstraints g
+
 let explain_reduction_tactic_error = function
   | Tacred.InvalidAbstraction (env,sigma,c,(env',e)) ->
+      let e = map_ptype_error EConstr.of_constr e in
       str "The abstracted term" ++ spc () ++
       quote (pr_goal_concl_style_env env sigma c) ++
       spc () ++ str "is not well typed." ++ fnl () ++
diff --git a/vernac/himsg.mli b/vernac/himsg.mli
new file mode 100644
index 00000000..0e20d18c
--- /dev/null
+++ b/vernac/himsg.mli
@@ -0,0 +1,46 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Indtypes
+open Environ
+open Type_errors
+open Pretype_errors
+open Typeclasses_errors
+open Indrec
+open Cases
+open Logic
+
+(** This module provides functions to explain the type errors. *)
+
+val explain_type_error : env -> Evd.evar_map -> type_error -> Pp.t
+
+val explain_pretype_error : env -> Evd.evar_map -> pretype_error -> Pp.t
+
+val explain_inductive_error : inductive_error -> Pp.t
+
+val explain_typeclass_error : env -> typeclass_error -> Pp.t
+
+val explain_recursion_scheme_error : recursion_scheme_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
+
+val explain_reduction_tactic_error :
+  Tacred.reduction_tactic_error -> Pp.t
+
+val explain_module_error : Modops.module_typing_error -> Pp.t
+
+val explain_module_internalization_error :
+  Modintern.module_internalization_error -> Pp.t
+
+val map_pguard_error : ('c -> 'd) -> 'c pguard_error -> 'd pguard_error
+val map_ptype_error : ('c -> 'd) -> ('c, 'c) ptype_error -> ('d, 'd) ptype_error
diff --git a/toplevel/indschemes.ml b/vernac/indschemes.ml
index e8ea617f..49414862 100644
--- a/toplevel/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Hugo Herbelin from contents related to inductive schemes
@@ -21,6 +23,7 @@ open Names
 open Declarations
 open Entries
 open Term
+open Constr
 open Inductive
 open Decl_kinds
 open Indrec
@@ -30,7 +33,6 @@ open Globnames
 open Goptions
 open Nameops
 open Termops
-open Pretyping
 open Nametab
 open Smartlocate
 open Vernacexpr
@@ -45,8 +47,7 @@ open Context.Rel.Declaration
 let elim_flag = ref true
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "automatic declaration of induction schemes";
       optkey   = ["Elimination";"Schemes"];
       optread  = (fun () -> !elim_flag) ;
@@ -55,26 +56,16 @@ let _ =
 let bifinite_elim_flag = ref false
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "automatic declaration of induction schemes for non-recursive types";
       optkey   = ["Nonrecursive";"Elimination";"Schemes"];
       optread  = (fun () -> !bifinite_elim_flag) ;
       optwrite = (fun b -> bifinite_elim_flag := b) }
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = true; (* compatibility 2014-09-03*)
-      optname  = "automatic declaration of induction schemes for non-recursive types";
-      optkey   = ["Record";"Elimination";"Schemes"];
-      optread  = (fun () -> !bifinite_elim_flag) ;
-      optwrite = (fun b -> bifinite_elim_flag := b) }
 
 let case_flag = ref false
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "automatic declaration of case analysis schemes";
       optkey   = ["Case";"Analysis";"Schemes"];
       optread  = (fun () -> !case_flag) ;
@@ -83,28 +74,18 @@ let _ =
 let eq_flag = ref false
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "automatic declaration of boolean equality";
       optkey   = ["Boolean";"Equality";"Schemes"];
       optread  = (fun () -> !eq_flag) ;
       optwrite = (fun b -> eq_flag := b) }
-let _ = (* compatibility *)
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
-      optname  = "automatic declaration of boolean equality";
-      optkey   = ["Equality";"Scheme"];
-      optread  = (fun () -> !eq_flag) ;
-      optwrite = (fun b -> eq_flag := b) }
 
-let is_eq_flag () = !eq_flag && Flags.version_strictly_greater Flags.V8_2
+let is_eq_flag () = !eq_flag
 
 let eq_dec_flag = ref false 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "automatic declaration of decidable equality";
       optkey   = ["Decidable";"Equality";"Schemes"];
       optread  = (fun () -> !eq_dec_flag) ;
@@ -113,8 +94,7 @@ let _ =
 let rewriting_flag = ref false
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  ="automatic declaration of rewriting schemes for equality types";
       optkey   = ["Rewriting";"Schemes"];
       optread  = (fun () -> !rewriting_flag) ;
@@ -124,13 +104,17 @@ let _ =
 
 let define id internal ctx c t =
   let f = declare_constant ~internal in
+  let 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
       { const_entry_body = c;
         const_entry_secctx = None;
         const_entry_type = t;
-	const_entry_polymorphic = Flags.is_universe_polymorphism ();
-	const_entry_universes = snd (Evd.universe_context ctx);
+	const_entry_universes = univs;
         const_entry_opaque = false;
         const_entry_inline_code = false;
         const_entry_feedback = None;
@@ -186,6 +170,12 @@ let try_declare_scheme what f internal names kn =
     | DecidabilityMutualNotSupported ->
         alarm what internal
           (str "Decidability lemma for mutual inductive types not supported.")
+    | EqUnknown s ->
+         alarm what internal
+           (str "Found unsupported " ++ str s ++ str " while building Boolean equality.")
+    | NoDecidabilityCoInductive ->
+         alarm what internal
+           (str "Scheme Equality is only for inductive types.")
     | e when CErrors.noncritical e ->
         alarm what internal
 	  (str "Unexpected error during scheme creation: " ++ CErrors.print e)
@@ -193,7 +183,7 @@ let try_declare_scheme what f internal names kn =
   in
   match msg with
   | None -> ()
-  | Some msg -> iraise (UserError ("", msg), snd e)
+  | Some msg -> iraise (UserError (None, msg), snd e)
 
 let beq_scheme_msg mind =
   let mib = Global.lookup_mind mind in
@@ -263,7 +253,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;
@@ -273,7 +263,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 *)
@@ -313,7 +303,7 @@ let warn_cannot_build_congruence =
           strbrk "Cannot build congruence scheme because eq is not found")
 
 let declare_congr_scheme ind =
-  if Hipattern.is_equality_type (mkInd ind) then begin
+  if Hipattern.is_equality_type Evd.empty (EConstr.of_constr (mkInd ind)) (** FIXME *) then begin
     if
       try Coqlib.check_required_library Coqlib.logic_module_name; true
       with e when CErrors.noncritical e -> false
@@ -350,40 +340,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.ghost,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 do_mutual_induction_scheme ?(force_mutual=false) lnamedepindsort =
+  let lrecnames = List.map (fun ({CAst.v},_,_,_) -> v) lnamedepindsort
   and env0 = Global.env() in
   let sigma, lrecspec, _ =
     List.fold_right
@@ -392,18 +380,18 @@ let do_mutual_induction_scheme lnamedepindsort =
 	 match inst with
 	 | None ->
 	    let _, ctx = Global.type_of_global_in_context env0 (IndRef ind) in
-	    let ctxs = Univ.ContextSet.of_context ctx in
-	    let evd = Evd.from_ctx (Evd.evar_universe_context_of ctxs) in
-	    let u = Univ.UContext.instance ctx in
+	    let u, ctx = Universes.fresh_instance_from ctx None in
+            let evd = Evd.from_ctx (UState.of_context_set ctx) in
 	      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
+  let sigma, listdecl = Indrec.build_mutual_induction_scheme env0 sigma ~force_mutual lrecspec in
   let declare decl fi lrecref =
-    let decltype = Retyping.get_type_of env0 sigma decl in
+    let decltype = Retyping.get_type_of env0 sigma (EConstr.of_constr decl) in
+    let decltype = EConstr.to_constr sigma decltype in
     let proof_output = Future.from_val ((decl,Univ.ContextSet.empty),Safe_typing.empty_private_constants) in
     let cst = define fi UserIndividualRequest sigma proof_output (Some decltype) in
     ConstRef cst :: lrecref
@@ -414,15 +402,15 @@ 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')))
       | [] ->
 	  if not (List.distinct_f Int.compare (List.map snd (List.map snd all)))
-          then error "A type occurs twice";
+          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
@@ -430,7 +418,7 @@ let do_scheme l =
 tried to declare different schemes at once *)
     if not (List.is_empty ischeme) && not (List.is_empty escheme)
     then
-      error "Do not declare equality and induction scheme at the same time."
+      user_err Pp.(str "Do not declare equality and induction scheme at the same time.")
     else (
       if not (List.is_empty ischeme) then do_mutual_induction_scheme ischeme
       else
@@ -454,15 +442,18 @@ let fold_left' f = function
     [] -> invalid_arg "fold_left'"
   | hd :: tl -> List.fold_left f hd tl
 
+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 defs = List.map (fun cst -> (* FIXME *)
-    let evd, c = Evd.fresh_constant_instance env (Evd.from_env env) cst in
-      (c, Typeops.type_of_constant_in env c)) schemes in
-(*   let nschemes = List.length schemes in *)
+  let evdref = ref (Evd.from_env env) in
+  let defs = List.map (fun cst ->
+    let evd, c = Evd.fresh_constant_instance env !evdref cst in
+    evdref := evd; (c, Typeops.type_of_constant_in env c)) schemes in
   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
@@ -472,39 +463,41 @@ let build_combined_scheme env schemes =
   let (c, t) = List.hd defs in
   let ctx, ind, nargs = find_inductive t in
   (* Number of clauses, including the predicates quantification *)
-  let prods = nb_prod t - (nargs + 1) in
-  let coqand = Coqlib.build_coq_and () and coqconj = Coqlib.build_coq_conj () in
+  let prods = nb_prod !evdref (EConstr.of_constr t) - (nargs + 1) in
+  let sigma, coqand  = mk_coq_and !evdref in
+  let sigma, coqconj = mk_coq_conj sigma in
+  let () = evdref := sigma in
   let relargs = rel_vect 0 prods in
   let concls = List.rev_map
-    (fun (cst, t) -> (* FIXME *)
+    (fun (cst, t) ->
       mkApp(mkConstU cst, relargs),
       snd (decompose_prod_n prods t)) defs in
   let concl_bod, concl_typ =
     fold_left'
       (fun (accb, acct) (cst, x) ->
-	mkApp (coqconj, [| x; acct; cst; accb |]),
-	mkApp (coqand, [| x; acct |])) concls
+	mkApp (EConstr.to_constr !evdref coqconj, [| x; acct; cst; accb |]),
+	mkApp (EConstr.to_constr !evdref coqand, [| x; acct |])) concls
   in
   let ctx, _ =
     list_split_rev_at prods
       (List.rev_map (fun (x, y) -> LocalAssum (x, y)) ctx) in
-  let typ = it_mkProd_wo_LetIn concl_typ ctx in
+  let typ = List.fold_left (fun d c -> Term.mkProd_wo_LetIn c d) concl_typ ctx in
   let body = it_mkLambda_or_LetIn concl_bod ctx in
-  (body, typ)
+  (!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 -> error ((string_of_qualid (snd qualid))^" is not declared."))
+    List.map (fun {CAst.loc;v} ->
+        let qualid = qualid_of_ident v in
+        try Nametab.locate_constant qualid
+        with Not_found -> user_err ?loc Pp.(pr_qualid qualid ++ str " is not declared."))
       schemes
   in
-  let body,typ = build_combined_scheme (Global.env ()) csts 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 Evd.empty 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 +506,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
new file mode 100644
index 00000000..43915788
--- /dev/null
+++ b/vernac/indschemes.mli
@@ -0,0 +1,53 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Constr
+open Environ
+open Vernacexpr
+
+(** See also Auto_ind_decl, Indrec, Eqscheme, Ind_tables, ... *)
+
+(** Build and register the boolean equalities associated to an inductive type *)
+
+val declare_beq_scheme : MutInd.t -> unit
+
+val declare_eq_decidability : MutInd.t -> unit
+
+(** Build and register a congruence scheme for an equality-like inductive type *)
+
+val declare_congr_scheme : inductive -> unit
+
+(** Build and register rewriting schemes for an equality-like inductive type *)
+
+val declare_rewriting_schemes : inductive -> unit
+
+(** Mutual Minimality/Induction scheme.
+    [force_mutual] forces the construction of eliminators having the same predicates and
+    methods even if some of the inductives are not recursive.
+    By default it is [false] and some of the eliminators are defined as simple case analysis.
+ *)
+
+val do_mutual_induction_scheme : ?force_mutual:bool ->
+  (Misctypes.lident * bool * inductive * Sorts.family) list -> unit
+
+(** Main calls to interpret the Scheme command *)
+
+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.t list -> Evd.evar_map * constr * types
+
+val do_combined_scheme : Misctypes.lident -> Misctypes.lident list -> unit
+
+(** Hook called at each inductive type definition *)
+
+val declare_default_schemes : MutInd.t -> unit
diff --git a/stm/lemmas.ml b/vernac/lemmas.ml
index 022c89ad..30dd6ec7 100644
--- a/stm/lemmas.ml
+++ b/vernac/lemmas.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Created by Hugo Herbelin from contents related to lemma proofs in
@@ -11,14 +13,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
@@ -28,10 +28,11 @@ open Pretyping
 open Termops
 open Namegen
 open Reductionops
-open Constrexpr
 open Constrintern
 open Impargs
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 type 'a declaration_hook = Decl_kinds.locality -> Globnames.global_reference -> 'a
 let mk_hook hook = hook
@@ -43,13 +44,16 @@ let call_hook fix_exn hook l c =
 
 (* Support for mutually proved theorems *)
 
-let retrieve_first_recthm = function
+let retrieve_first_recthm uctx = function
   | VarRef id ->
-      let open Context.Named.Declaration in
-      (get_value (Global.lookup_named id),variable_opacity id)
+      (NamedDecl.get_value (Global.lookup_named id),variable_opacity id)
   | ConstRef cst ->
       let cb = Global.lookup_constant cst in
-      (Global.body_of_constant_body cb, is_opaque cb)
+      (* 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)
   | _ -> assert false
 
 let adjust_guardness_conditions const = function
@@ -58,9 +62,9 @@ let adjust_guardness_conditions const = function
   (* Try all combinations... not optimal *)
      let env = Global.env() in
      { const with const_entry_body =
-        Future.chain ~greedy:true ~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 ->
@@ -79,58 +83,42 @@ let adjust_guardness_conditions const = function
                     List.fold_left (fun e (_,c,cb,_) -> add c cb e) env l)
                 env (Safe_typing.side_effects_of_private_constants eff) in
               let indexes =
-                search_guard Loc.ghost env
+                search_guard env
                   possible_indexes fixdecls in
 		(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,annot)) ->
-      let (hyps,ccl) = decompose_prod_assum t in
+    let inds = List.map (fun (id,(t,impls)) ->
+      let (hyps,ccl) = EConstr.decompose_prod_assum sigma t in
       let x = (id,(t,impls)) in
-      match annot with
-      (* Explicit fixpoint decreasing argument is given *)
-      | Some (Some (_,id),CStructRec) ->
-          let i,b,typ = lookup_rel_id id hyps in
-          (match kind_of_term t with
-          | Ind ((kn,_ as ind), u) when
-              let mind = Global.lookup_mind kn in
-              mind.mind_finite == Decl_kinds.Finite && Option.is_empty b ->
-              [ind,x,i],[]
-          | _ ->
-              error "Decreasing argument is not an inductive assumption.")
-      (* Unsupported cases *)
-      | Some (_,(CWfRec _|CMeasureRec _)) ->
-          error "Only structural decreasing is supported for mutual statements."
-      (* Cofixpoint or fixpoint w/o explicit decreasing argument *)
-      | None | Some (None, CStructRec) ->
-      let whnf_hyp_hds = map_rel_context_in_env
-        (fun env c -> fst (whd_all_stack env Evd.empty 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 = get_type decl in
-          match kind_of_term t with
+          let t = RelDecl.get_type decl in
+          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 && is_local_assum decl ->
+                mind.mind_finite <> Declarations.CoFinite ->
               [ind,x,i]
           | _ ->
-              []) 0 (List.rev 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 cclenv = EConstr.push_rel_context hyps (Global.env()) in
         let whnf_ccl,_ = whd_all_stack cclenv Evd.empty ccl in
-        match kind_of_term whnf_ccl with
+        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 =
@@ -150,7 +138,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, []
       | [], _::_ ->
@@ -158,7 +146,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."));
@@ -169,35 +157,39 @@ let find_mutually_recursive_statements thms =
 	  (* assume the largest indices as possible *)
 	  List.last common_same_indhyp, false, possible_guards
       | _, [] ->
-	  error
+	  user_err Pp.(str
             ("Cannot find common (mutual) inductive premises or coinductive" ^
-             " conclusions in the statements.")
+             " conclusions in the statements."))
     in
     (finite,guard,None), ordered_inds
 
-let look_for_possibly_mutual_statements = function
-  | [id,(t,impls,None)] ->
+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
@@ -206,9 +198,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
@@ -216,18 +212,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 (loc,"",pr_id id ++ str " already exists.");
-      id, pl
-  | None ->
-      next_global_ident_away default_thm_id (Pfedit.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 ->
@@ -235,7 +231,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 ->
@@ -245,37 +247,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) 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)
@@ -284,30 +285,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
-    error "This command can only be used for unnamed theorem."
+    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
-  check_anonymity id save_ident;
-  save ?export_seff save_ident const cstrs pl do_guard persistence hook
-
-let save_anonymous_with_strength ?export_seff proof kind save_ident =
-  let id,const,(cstrs,pl),do_guard,_,hook = proof in
+  let id,const,uctx,do_guard,persistence,hook = proof in
   check_anonymity id save_ident;
-  (* we consider that non opaque behaves as local for discharge *)
-  save ?export_seff save_ident const cstrs pl do_guard
-      (Global, const.const_entry_polymorphic, Proof kind) 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 () =
@@ -317,7 +311,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 *)
@@ -332,32 +326,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 (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),None) -> save_anonymous ~export_seff proof id
-      | Some ((_,id),Some kind) -> 
-          save_anonymous_with_strength ~export_seff proof kind id
-      end;
-      check_exist exports
+      | Some { CAst.v = id } -> save_anonymous ~export_seff proof id
+      end
   end
 
 let standard_proof_terminator compute_guard hook =
@@ -391,7 +376,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,t)) thms with
+    match List.map (fun (id,(t,_)) -> (id,t)) thms with
     | (id,_)::l -> Tactics.mutual_cofix id l 0
     | _ -> assert false
   else
@@ -399,11 +384,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,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
@@ -427,62 +412,60 @@ let start_proof_with_initialization kind ctx recguard thms snl hook =
       let () = match thms with [_] -> () | _ -> assert false in
       (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 ->
+  | [] -> anomaly (Pp.str "No proof to start.")
+  | (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 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 body,opaq = retrieve_first_recthm ctx ref 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 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,guard)) ->
-    let impls, ((env, ctx), imps) = interp_context_evars env0 evdref bl in
-    let t', imps' = interp_type_evars_impls ~impls env evdref t in
+  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,!evdref);
-    let ids = List.map get_name ctx in
-      (compute_proof_name (pi1 kind) sopt,
-      (nf_evar !evdref (it_mkProd_or_LetIn t' ctx),
-       (ids, imps @ lift_implicits (List.length ids) imps'),
-       guard)))
-    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
+    let evd = solve_remaining_evars flags env evd Evd.empty in
+    let ids = List.map RelDecl.get_name ctx 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 *)
 
@@ -491,8 +474,7 @@ let keep_admitted_vars = ref true
 let _ =
   let open Goptions in
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "keep section variables in admitted proofs";
       optkey   = ["Keep"; "Admitted"; "Variables"];
       optread  = (fun () -> !keep_admitted_vars);
@@ -505,36 +487,36 @@ let save_proof ?proof = function
         match proof with
         | Some ({ id; entries; persistence = k; universes }, _) ->
             if List.length entries <> 1 then
-              error "Admitted does not support multiple statements";
+              user_err Pp.(str "Admitted does not support multiple statements");
             let { const_entry_secctx; const_entry_type } = List.hd entries in
             if const_entry_type = None then
-              error "Admitted requires an explicit statement";
+              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 = Pfedit.get_pftreestate () in
+            let pftree = Proof_global.give_me_the_proof () in
             let id, k, typ = Pfedit.current_proof_statement () in
+            let typ = EConstr.Unsafe.to_constr typ in
             let universes = Proof.initial_euctx pftree in
             (* This will warn if the proof is complete *)
             let pproofs, _univs =
               Proof_global.return_proof ~allow_partial:true () in
             let sec_vars =
               if not !keep_admitted_vars then None
-              else match  Pfedit.get_used_variables(), pproofs with
+              else match Proof_global.get_used_variables(), pproofs with
               | Some _ as x, _ -> x
               | None, (pproof, _) :: _ -> 
                   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 = Pfedit.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) ->
@@ -545,11 +527,9 @@ let save_proof ?proof = function
         | Some proof -> proof
       in
       (* if the proof is given explicitly, nothing has to be deleted *)
-      if Option.is_empty proof then Pfedit.delete_current_proof ();
+      if Option.is_empty proof then Proof_global.discard_current ();
       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
new file mode 100644
index 00000000..ad4c278e
--- /dev/null
+++ b/vernac/lemmas.mli
@@ -0,0 +1,72 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Decl_kinds
+
+type 'a declaration_hook
+val mk_hook :
+  (Decl_kinds.locality -> Globnames.global_reference -> 'a) -> 'a declaration_hook
+
+val call_hook :
+  Future.fix_exn -> 'a declaration_hook -> Decl_kinds.locality -> Globnames.global_reference -> 'a
+
+(** 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: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: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 -> 
+  (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 -> Univdecls.universe_decl ->
+  (bool * Proof_global.lemma_possible_guards * unit Proofview.tactic list option) option ->
+  (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 ->
+    (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.t -> unit) -> unit
+
+val save_proof : ?proof:Proof_global.closed_proof -> Vernacexpr.proof_end -> unit
+
+
+(** [get_current_context ()] returns the evar context and env of the
+   current open proof if any, otherwise returns the empty evar context
+   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
new file mode 100644
index 00000000..21be73b3
--- /dev/null
+++ b/vernac/locality.ml
@@ -0,0 +1,68 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Decl_kinds
+
+(** * Managing locality *)
+
+let local_of_bool = function
+  | true -> Local
+  | false -> Global
+
+
+(** Positioning locality for commands supporting discharging and export
+     outside of modules *)
+
+(* For commands whose default is to discharge and export:
+   Global is the default and is neutral;
+   Local in a section deactivates discharge,
+   Local not in a section deactivates export *)
+let make_non_locality = function Some false -> false | _ -> true
+
+let make_locality = function Some true -> true | _ -> false
+
+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 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;
+   Local in sections is the default, Local not in section forces non-export *)
+
+let make_section_locality =
+  function Some b -> b | None -> Lib.sections_are_opened ()
+
+let enforce_section_locality locality_flag =
+  make_section_locality locality_flag
+
+(** Positioning locality for commands supporting export but not discharge *)
+
+(* For commands whose default is to export (if not in section):
+   Global in sections is forbidden, Global not in section is neutral;
+   Local in sections is the default, Local not in section forces non-export *)
+
+let make_module_locality = function
+  | Some false ->
+      if Lib.sections_are_opened () then
+	CErrors.user_err Pp.(str
+	  "This command does not support the Global option in sections.");
+      false
+  | Some true -> true
+  | None -> false
+
+let enforce_module_locality locality_flag =
+  make_module_locality locality_flag
diff --git a/toplevel/locality.mli b/vernac/locality.mli
index 2ec392ee..3c63c821 100644
--- a/toplevel/locality.mli
+++ b/vernac/locality.mli
@@ -1,17 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** * 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 +20,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 +37,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
new file mode 100644
index 00000000..8c9d8f6b
--- /dev/null
+++ b/vernac/metasyntax.ml
@@ -0,0 +1,1551 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pp
+open CErrors
+open Util
+open Names
+open Constrexpr
+open Constrexpr_ops
+open Notation_term
+open Notation_ops
+open Ppextend
+open Extend
+open Libobject
+open Constrintern
+open Vernacexpr
+open Libnames
+open Tok
+open Notation
+open Nameops
+
+(**********************************************************************)
+(* Tokens                                                             *)
+
+let cache_token (_,s) = CLexer.add_keyword s
+
+let inToken : string -> obj =
+  declare_object {(default_object "TOKEN") with
+       open_function = (fun i o -> if Int.equal i 1 then cache_token o);
+       cache_function = cache_token;
+       subst_function = Libobject.ident_subst_function;
+       classify_function = (fun o -> Substitute o)}
+
+let add_token_obj s = Lib.add_anonymous_leaf (inToken s)
+
+(**********************************************************************)
+(* Printing grammar entries                                           *)
+
+let entry_buf = Buffer.create 64
+
+let pr_entry e =
+  let () = Buffer.clear entry_buf in
+  let ft = Format.formatter_of_buffer entry_buf in
+  let () = Pcoq.Gram.entry_print ft e in
+  str (Buffer.contents entry_buf)
+
+let pr_registered_grammar name =
+  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 (Pcoq.AnyEntry e) =
+      str "Entry " ++ str (Pcoq.Gram.Entry.name e) ++ str " is" ++ fnl () ++
+      pr_entry e
+    in
+    prlist pr_one entries
+
+let pr_grammar = function
+  | "constr" | "operconstr" | "binder_constr" ->
+      str "Entry constr is" ++ fnl () ++
+      pr_entry Pcoq.Constr.constr ++
+      str "and lconstr is" ++ fnl () ++
+      pr_entry Pcoq.Constr.lconstr ++
+      str "where binder_constr is" ++ fnl () ++
+      pr_entry Pcoq.Constr.binder_constr ++
+      str "and operconstr is" ++ fnl () ++
+      pr_entry Pcoq.Constr.operconstr
+  | "pattern" ->
+      pr_entry Pcoq.Constr.pattern
+  | "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 () ++
+      pr_entry Pcoq.Vernac_.syntax ++
+      str "Entry gallina is" ++ fnl () ++
+      pr_entry Pcoq.Vernac_.gallina ++
+      str "Entry gallina_ext is" ++ fnl () ++
+      pr_entry Pcoq.Vernac_.gallina_ext
+  | name -> pr_registered_grammar name
+
+(**********************************************************************)
+(* Parse a format (every terminal starting with a letter or a single
+   quote (except a single quote alone) must be quoted) *)
+
+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 < len && str.[i] == ' ' then spaces (n+1) (i+1)
+    else n in
+  let rec nonspaces quoted n i =
+    if i < len && str.[i] != ' ' then
+      if str.[i] == '\'' && quoted &&
+        (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 ?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 (make_loc i (i+n-1)) (UnpTerminal (String.sub str i n)) (parse_token 1 (i+n))
+  and parse_quoted n i =
+    if i < len then match str.[i] with
+      (* Parse " // " *)
+      | '/' 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+1 < len ->
+	  let p = spaces 0 (i+1) in
+	  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 i n (match c with
+      | '[' ->
+	  if i+1 < len then match str.[i+1] with
+	    (* Parse " [h .. ",  *)
+	    | 'h' when i+1 <= len && str.[i+2] == 'v' ->
+		  (parse_box i (fun n -> PpHVB n) (i+3))
+		(* Parse " [v .. ",  *)
+	    | 'v' ->
+		    parse_box i (fun n -> PpVB n) (i+2)
+		(* Parse " [ .. ",  *)
+	    | ' ' | '\'' ->
+		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 "]"  *)
+      | ']' ->
+	  ((i,[]) :: parse_token 1 (close_quotation i (i+1)))
+      (* Parse a non formatting token *)
+      | c ->
+	  let n = nonspaces true 0 i in
+	  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 ?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 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 < len then match str.[i] with
+      (* Parse a ' *)
+      |	'\'' 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-k) (i+1)
+      (* Otherwise *)
+      | _ ->
+          push_white (i-n) (n-k) (parse_non_format i)
+    else push_white (i-n) n [(len,[])]
+  in
+  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 *)
+
+(* Interpret notations with a recursive component *)
+
+let out_nt = function NonTerminal x -> x | _ -> assert false
+
+let msg_expected_form_of_recursive_notation =
+  "In the notation, the special symbol \"..\" must occur in\na configuration of the form \"x symbs .. symbs y\"."
+
+let rec find_pattern nt xl = function
+  | Break n as x :: l, Break n' :: l' when Int.equal n n' ->
+      find_pattern nt (x::xl) (l,l')
+  | Terminal s as x :: l, Terminal s' :: l' when String.equal s s' ->
+      find_pattern nt (x::xl) (l,l')
+  | [], NonTerminal x' :: l' ->
+      (out_nt nt,x',List.rev xl),l'
+  | _, Break s :: _ | Break s :: _, _ ->
+      user_err Pp.(str ("A break occurs on one side of \"..\" but not on the other side."))
+  | _, Terminal s :: _ | Terminal s :: _, _ ->
+      user_err ~hdr:"Metasyntax.find_pattern"
+        (str "The token \"" ++ str s ++ str "\" occurs on one side of \"..\" but not on the other side.")
+  | _, [] ->
+      user_err Pp.(str msg_expected_form_of_recursive_notation)
+  | ((SProdList _ | NonTerminal _) :: _), _ | _, (SProdList _ :: _) ->
+      anomaly (Pp.str "Only Terminal or Break expected on left, non-SProdList on right.")
+
+let rec interp_list_parser hd = function
+  | [] -> [], List.rev hd
+  | NonTerminal id :: tl when Id.equal id ldots_var ->
+      if List.is_empty hd then user_err Pp.(str msg_expected_form_of_recursive_notation);
+      let hd = List.rev hd in
+      let ((x,y,sl),tl') = find_pattern (List.hd hd) [] (List.tl hd,tl) in
+      let xyl,tl'' = interp_list_parser [] tl' in
+      (* We remember each pair of variable denoting a recursive part to *)
+      (* remove the second copy of it afterwards *)
+      (x,y)::xyl, SProdList (x,sl) :: tl''
+  | (Terminal _ | Break _) as s :: tl ->
+      if List.is_empty hd then
+        let yl,tl' = interp_list_parser [] tl in
+        yl, s :: tl'
+      else
+        interp_list_parser (s::hd) tl
+  | NonTerminal _ as x :: tl ->
+      let xyl,tl' = interp_list_parser [x] tl in
+      xyl, List.rev_append hd tl'
+  | SProdList _ :: _ -> anomaly (Pp.str "Unexpected SProdList in interp_list_parser.")
+
+
+(* Find non-terminal tokens of notation *)
+
+(* To protect alphabetic tokens and quotes from being seen as variables *)
+let quote_notation_token x =
+  let n = String.length x in
+  let norm = CLexer.is_ident x in
+  if (n > 0 && norm) || (n > 2 && x.[0] == '\'') then "'"^x^"'"
+  else x
+
+let is_numeral symbs =
+  match List.filter (function Break _ -> false | _ -> true) symbs with
+  | ([Terminal "-"; Terminal x] | [Terminal x]) ->
+      (try let _ = Bigint.of_string x in true with Failure _ -> false)
+  | _ ->
+      false
+
+let rec get_notation_vars onlyprint = function
+  | [] -> []
+  | NonTerminal id :: sl ->
+      let vars = get_notation_vars onlyprint sl in
+      if Id.equal id ldots_var then vars else
+	(* 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 " ++ 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 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 " ++ Id.print x ++ str " and " ++ Id.print y ++ str " must be in the same scope.")
+
+(**********************************************************************)
+(* Build pretty-printing rules                                        *)
+
+let prec_assoc = function
+  | RightA -> (L,E)
+  | LeftA -> (E,L)
+  | NonA -> (L,L)
+
+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
+  | 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) *)
+(* "x =S y" : "x /1 =S /1 y" (protect from confusion; each side for symmetry)*)
+(* "+ {" : "+ {" may breaks reversibility without space but oth. not elegant *)
+(* "x y" : "x spc y" *)
+(* "{ x } + { y }" : "{ x } / + { y }" *)
+(* "< x , y > { z , t }" : "< x , / y > / { z , / t }" *)
+
+let starts_with_left_bracket s =
+  let l = String.length s in not (Int.equal l 0) &&
+  (s.[0] == '{' || s.[0] == '[' || s.[0] == '(')
+
+let ends_with_right_bracket s =
+  let l = String.length s in not (Int.equal l 0) &&
+  (s.[l-1] == '}' || s.[l-1] == ']' || s.[l-1] == ')')
+
+let is_left_bracket s =
+  starts_with_left_bracket s && not (ends_with_right_bracket s)
+
+let is_right_bracket s =
+  not (starts_with_left_bracket s) && ends_with_right_bracket s
+
+let is_comma s =
+  let l = String.length s in not (Int.equal l 0) &&
+  (s.[0] == ',' || s.[0] == ';')
+
+let is_operator s =
+  let l = String.length s in not (Int.equal l 0) &&
+  (s.[0] == '+' || s.[0] == '*' || s.[0] == '=' ||
+   s.[0] == '-' || s.[0] == '/' || s.[0] == '<' || s.[0] == '>' ||
+   s.[0] == '@' || s.[0] == '\\' || s.[0] == '&' || s.[0] == '~' || s.[0] == '$')
+
+let is_non_terminal = function
+  | NonTerminal _ | SProdList _ -> true
+  | _ -> 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 = (None,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
+  | Terminal s -> str s
+  | Break n -> str "�"
+  | _ -> assert false
+  in
+  if isopen && not (List.is_empty sl) then
+    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 b = function
+    | NonTerminal m :: prods ->
+	let i = index_id m vars in
+        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
+          (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 *)
+          (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 *)
+          (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 *)
+          (None, UnpTerminal (s^" ")) :: make b prods
+        else
+          (* Rely on user spaces *)
+          (None, UnpTerminal s) :: make b prods
+
+    | Terminal s :: prods ->
+        (* Separate but do not cut a trailing sequence of terminal *)
+        (match prods with
+        | Terminal _ :: _ -> (None,UnpTerminal (s^" ")) :: make b prods
+        | _ -> (None,UnpTerminal s) :: make b prods)
+
+    | Break n :: prods ->
+        add_break n (make b prods)
+
+    | SProdList (m,sl) :: prods ->
+	let i = index_id m vars in
+	let typ = List.nth typs (i-1) in
+	let _,prec = precedence_of_entry_type from typ in
+        let sl' =
+          (* 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 make true sl in
+	let hunk = match typ with
+	  | ETConstr _ -> UnpListMetaVar (i,prec,List.map snd sl')
+	  | ETBinder isopen ->
+	      check_open_binder isopen sl m;
+	      UnpBinderListMetaVar (i,isopen,List.map snd sl')
+	  | _ -> assert false in
+        (None, hunk) :: make_with_space b 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 *)
+          (None,UnpTerminal (" "^s')) :: add_break_if_none 1 b (make b prods')
+        else if is_comma s' then
+          (* No space whatsoever before comma *)
+          make b prods
+        else if is_right_bracket s' then
+          make b prods
+        else
+          (* A breakable space between any other two terminals *)
+          add_break_if_none 1 b (make b prods)
+    | (NonTerminal _ | SProdList _) :: _ ->
+        (* A breakable space before a non-terminal *)
+        add_break_if_none 1 b (make b prods)
+    | Break _ :: _ ->
+        (* Rely on user wish *)
+        make b prods
+    | [] -> []
+
+  in make false symbols
+
+(* Build default printing rules from explicit format *)
+
+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
+  | (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)) ->
+      (try
+        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 find_prod_list_loc sfmt fmt =
+  (* [fmt] is some [UnpTerminal x :: sfmt @ UnpTerminal ".." :: sfmt @ UnpTerminal y :: rest] *)
+  if List.is_empty sfmt then
+    (* No separators; we highlight the sequence "x .." *)
+    Loc.merge_opt (fst (List.hd fmt)) (fst (List.hd (List.tl fmt)))
+  else
+    (* A separator; we highlight the separating sequence *)
+    Loc.merge_opt (fst (List.hd sfmt)) (fst (List.last sfmt))
+
+let skip_var_in_recursive_format = function
+  | (_,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
+  | (loc,_) :: _ -> error_not_same ?loc ()
+  | [] -> assert false
+
+let read_recursive_format sl fmt =
+  (* Turn [[UnpTerminal s :: some-list @ UnpTerminal ".." :: same-some-list @ UnpTerminal s' :: rest] *)
+  (* into [(some-list,rest)] *)
+  let get_head fmt =
+    let sl = skip_var_in_recursive_format fmt 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
+    | (loc,a) :: sepfmt, (_,b) :: fmt when Pervasives.(=) a b -> get_tail (sepfmt, fmt) (* FIXME *)
+    | [], tail -> skip_var_in_recursive_format tail
+    | (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
+      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
+      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') ->
+      let i = index_id s vars in
+      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,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
+      let typ = List.nth typs (i-1) in
+      let _,prec = precedence_of_entry_type from typ in
+      let loc_slfmt,rfmt = read_recursive_format sl fmt in
+      let sl, slfmt = aux (sl,loc_slfmt) in
+      if not (List.is_empty sl) then error_format ?loc:(find_prod_list_loc loc_slfmt fmt) ();
+      let symbs, l = aux (symbs,rfmt) in
+      let hunk = match typ with
+	| ETConstr _ -> UnpListMetaVar (i,prec,slfmt)
+	| ETBinder isopen ->
+	    check_open_binder isopen sl m;
+	    UnpBinderListMetaVar (i,isopen,slfmt)
+	| _ -> assert false in
+      symbs, hunk :: l
+  | symbs, [] -> symbs, []
+  | Break _ :: symbs, fmt -> warn_format_break (); aux (symbs,fmt)
+  | _, fmt -> error_format ?loc:(fst (List.hd fmt)) ()
+  in
+  match aux symfmt with
+  | [], l -> l
+  | _ -> error_format ()
+
+(**********************************************************************)
+(* Build parsing rules                                                *)
+
+let assoc_of_type n (_,typ) = precedence_of_entry_type n typ
+
+let is_not_small_constr = function
+    ETProdConstr _ -> true
+  | ETProdOther("constr","binder_constr") -> true
+  | _ -> false
+
+let rec define_keywords_aux = function
+  | GramConstrNonTerminal(e,Some _) as n1 :: GramConstrTerminal(IDENT k) :: l
+      when is_not_small_constr e ->
+      Flags.if_verbose Feedback.msg_info (str "Identifier '" ++ str k ++ str "' now a keyword");
+      CLexer.add_keyword k;
+      n1 :: GramConstrTerminal(KEYWORD k) :: define_keywords_aux l
+  | n :: l -> n :: define_keywords_aux l
+  | [] -> []
+
+  (* Ensure that IDENT articulation terminal symbols are keywords *)
+let define_keywords = function
+  | GramConstrTerminal(IDENT k)::l ->
+      Flags.if_verbose Feedback.msg_info (str "Identifier '" ++ str k ++ str "' now a keyword");
+      CLexer.add_keyword k;
+      GramConstrTerminal(KEYWORD k) :: define_keywords_aux l
+  | l -> define_keywords_aux l
+
+let distribute a ll = List.map (fun l -> a @ l) ll
+
+  (* Expand LIST1(t,sep);sep;t;...;t (with the trailing pattern
+     occurring p times, possibly p=0) into the combination of
+     t;sep;t;...;t;sep;t (p+1 times)
+     t;sep;t;...;t;sep;t;sep;t (p+2 times)
+     ...
+     t;sep;t;...;t;sep;t;...;t;sep;t (p+n times)
+     t;sep;t;...;t;sep;t;...;t;sep;t;LIST1(t,sep) *)
+
+let expand_list_rule typ tkl x n p ll =
+  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 (ETProdConstrList (typ,tkl), Some x)] in
+    distribute hds ll
+  else
+    distribute (GramConstrListMark (i+1,false,p) :: hds @ [main]) ll @
+       aux (i+1) (main :: tks @ hds) ll in
+  aux 0 [] ll
+
+let is_constr_typ typ x etyps =
+  match List.assoc x etyps with
+  | ETConstr typ' | ETConstrAsBinder (_,typ') -> typ = typ'
+  | _ -> false
+
+let include_possible_similar_trailing_pattern typ etyps sl l =
+  let rec aux n = function
+  | Terminal s :: sl, Terminal s'::l' when s = s' -> aux n (sl,l')
+  | [], NonTerminal x ::l' when is_constr_typ typ x etyps -> try_aux n l'
+  | _ -> raise Exit
+  and try_aux n l =
+    try aux (n+1) (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 (prod_entry_type typ, Some m)] (aux l)
+    | Terminal s :: l ->
+        distribute [GramConstrTerminal (CLexer.terminal s)] (aux l)
+    | Break _ :: l ->
+        aux l
+    | SProdList (x,sl) :: l ->
+        let tkl = List.flatten
+          (List.map (function Terminal s -> [CLexer.terminal s]
+            | Break _ -> []
+            | _ -> anomaly (Pp.str "Found a non terminal token in recursive notation separator.")) sl) in
+	match List.assoc x etyps with
+        | ETConstr typ ->
+            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 ->
+            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
+  List.map define_keywords prods
+
+let rec find_symbols c_current c_next c_last = function
+  | [] -> []
+  | NonTerminal id :: sl ->
+      let prec = if not (List.is_empty sl) then c_current else c_last in
+      (id, prec) :: (find_symbols c_next c_next c_last sl)
+  | Terminal s :: sl -> find_symbols c_next c_next c_last sl
+  | Break n :: sl -> find_symbols c_current c_next c_last sl
+  | SProdList (x,_) :: sl' ->
+      (x,c_next)::(find_symbols c_next c_next c_last sl')
+
+let border = function
+  | (_,ETConstr(_,BorderProd (_,a))) :: _ -> a
+  | (_,(ETConstrAsBinder(_,(_,BorderProd (_,a))))) :: _ -> a
+  | _ -> None
+
+let recompute_assoc typs =
+  match border typs, border (List.rev typs) with
+    | Some LeftA, Some RightA -> assert false
+    | Some LeftA, _ -> Some LeftA
+    | _, Some RightA -> Some RightA
+    | _ -> None
+
+(**************************************************************************)
+(* Registration of syntax extensions (parsing/printing, no interpretation)*)
+
+let pr_arg_level from (lev,typ) =
+  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
+  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() ++
+  prlist_with_sep pr_comma (pr_arg_level from) (List.combine args typs)
+
+let error_incompatible_level ntn oldprec prec =
+  user_err 
+    (str "Notation " ++ qstring ntn ++ str " is already defined" ++ spc() ++
+    pr_level ntn oldprec ++
+    spc() ++ str "while it is now required to be" ++ spc() ++
+    pr_level ntn prec ++ str ".")
+
+let error_parsing_incompatible_level ntn ntn' oldprec prec =
+  user_err
+    (str "Notation " ++ qstring ntn ++ str " relies on a parsing rule for " ++ qstring ntn' ++ spc() ++
+    str " which is already defined" ++ spc() ++
+    pr_level ntn oldprec ++
+    spc() ++ str "while it is now required to be" ++ spc() ++
+    pr_level ntn prec ++ str ".")
+
+type syntax_extension = {
+  synext_level : Notation_term.level;
+  synext_notation : notation;
+  synext_notgram : notation_grammar;
+  synext_unparsing : unparsing list;
+  synext_extra : (string * string) list;
+  synext_compat : Flags.compat_version option;
+}
+
+let is_active_compat = function
+| None -> true
+| Some v -> 0 <= Flags.version_compare v !Flags.compat_version
+
+type syntax_extension_obj = locality_flag * syntax_extension
+
+let check_and_extend_constr_grammar ntn rule =
+  try
+    let ntn_for_grammar = rule.notgram_notation in
+    if String.equal ntn ntn_for_grammar then raise Not_found;
+    let prec = rule.notgram_level in
+    let oldprec = Notation.level_of_notation ntn_for_grammar in
+    if not (Notation.level_eq prec oldprec) then error_parsing_incompatible_level ntn ntn_for_grammar oldprec prec;
+  with Not_found ->
+    Egramcoq.extend_constr_grammar rule
+
+let cache_one_syntax_extension se =
+  let ntn = se.synext_notation in
+  let prec = se.synext_level in
+  let onlyprint = se.synext_notgram.notgram_onlyprinting in
+  try
+    let oldprec = Notation.level_of_notation ~onlyprint ntn in
+    if not (Notation.level_eq prec oldprec) then error_incompatible_level ntn oldprec prec;
+  with Not_found ->
+    if is_active_compat se.synext_compat then begin
+      (* Reserve the notation level *)
+      Notation.declare_notation_level ntn prec ~onlyprint;
+      (* Declare the parsing rule *)
+      if not onlyprint then List.iter (check_and_extend_constr_grammar ntn) se.synext_notgram.notgram_rules;
+      (* Declare the notation rule *)
+      Notation.declare_notation_rule ntn
+        ~extra:se.synext_extra (se.synext_unparsing, pi1 prec) se.synext_notgram
+    end
+
+let cache_syntax_extension (_, (_, sy)) =
+  cache_one_syntax_extension sy
+
+let subst_parsing_rule subst x = x
+
+let subst_printing_rule subst x = x
+
+let subst_syntax_extension (subst, (local, sy)) =
+  (local, { sy with
+    synext_notgram = { sy.synext_notgram with notgram_rules = List.map (subst_parsing_rule subst) sy.synext_notgram.notgram_rules };
+    synext_unparsing = subst_printing_rule subst sy.synext_unparsing;
+  })
+
+let classify_syntax_definition (local, _ as o) =
+  if local then Dispose else Substitute o
+
+let inSyntaxExtension : syntax_extension_obj -> obj =
+  declare_object {(default_object "SYNTAX-EXTENSION") with
+       open_function = (fun i o -> if Int.equal i 1 then cache_syntax_extension o);
+       cache_function = cache_syntax_extension;
+       subst_function = subst_syntax_extension;
+       classify_function = classify_syntax_definition}
+
+(**************************************************************************)
+(* Precedences                                                            *)
+
+(* Interpreting user-provided modifiers *)
+
+(* XXX: We could move this to the parser itself *)
+module NotationMods = struct
+
+type notation_modifier = {
+  assoc         : gram_assoc option;
+  level         : int option;
+  etyps         : (Id.t * simple_constr_prod_entry_key) list;
+
+  (* common to syn_data below *)
+  only_parsing  : bool;
+  only_printing : bool;
+  compat        : Flags.compat_version option;
+  format        : Misctypes.lstring option;
+  extra         : (string * string) list;
+}
+
+let default = {
+  assoc         = None;
+  level         = None;
+  etyps         = [];
+  only_parsing  = false;
+  only_printing = false;
+  compat        = None;
+  format        = None;
+  extra         = [];
+}
+
+end
+
+let interp_modifiers modl = let open NotationMods in
+  let rec interp acc = function
+    | [] -> acc
+    | SetEntryType (s,typ) :: l ->
+	let id = Id.of_string s in
+	if Id.List.mem_assoc id acc.etyps then
+	  user_err ~hdr:"Metasyntax.interp_modifiers"
+            (str s ++ str " is already assigned to an entry or constr level.");
+        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 (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.");
+        interp { acc with assoc = Some a; } l
+     | SetOnlyParsing :: l ->
+        interp { acc with only_parsing = true; } l
+    | SetOnlyPrinting :: l ->
+        interp { acc with only_printing = true; } l
+    | SetCompatVersion v :: l ->
+        interp { acc with compat = Some v; } l
+    | SetFormat ("text",s) :: l ->
+	if not (Option.is_empty acc.format) then user_err Pp.(str "A format is given more than once.");
+        interp { acc with format = Some s; } l
+    | SetFormat (k,{CAst.v=s}) :: l ->
+        interp { acc with extra = (k,s)::acc.extra; } l
+  in interp default modl
+
+let check_infix_modifiers modifiers =
+  let t = (interp_modifiers modifiers).NotationMods.etyps in
+  if not (List.is_empty t) then
+    user_err Pp.(str "Explicit entry level or type unexpected in infix notation.")
+
+let check_useless_entry_types recvars mainvars etyps =
+  let vars = let (l1,l2) = List.split recvars in l1@l2@mainvars in
+  match List.filter (fun (x,etyp) -> not (List.mem x vars)) etyps with
+  | (x,_)::_ -> user_err ~hdr:"Metasyntax.check_useless_entry_types"
+                  (Id.print x ++ str " is unbound in the notation.")
+  | _ -> ()
+
+let check_binder_type recvars etyps =
+  let l1,l2 = List.split recvars in
+  let l = l1@l2 in
+  List.iter (function
+    | (x,ETBinder b) when not (List.mem x l) ->
+       CErrors.user_err (str (if b then "binder" else "closed binder") ++
+                 strbrk " is only for use in recursive notations for binders.")
+    | _ -> ()) etyps
+
+let not_a_syntax_modifier = function
+| SetOnlyParsing -> true
+| SetOnlyPrinting -> true
+| SetCompatVersion _ -> true
+| _ -> false
+
+let no_syntax_modifiers mods = List.for_all not_a_syntax_modifier mods
+
+let is_only_parsing mods =
+  let test = function SetOnlyParsing -> true | _ -> false in
+  List.exists test mods
+
+let is_only_printing mods =
+  let test = function SetOnlyPrinting -> true | _ -> false in
+  List.exists test mods
+
+let get_compat_version mods =
+  let test = function SetCompatVersion v -> Some v | _ -> None in
+  try Some (List.find_map test mods) with Not_found -> None
+
+(* Compute precedences from modifiers (or find default ones) *)
+
+let set_entry_type etyps (x,typ) =
+  let typ = try
+    match List.assoc x etyps, typ with
+      | ETConstr (Some n), (_,BorderProd (left,_)) ->
+          ETConstr (n,BorderProd (left,None))
+      | 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)
+
+let join_auxiliary_recursive_types recvars etyps =
+  List.fold_right (fun (x,y) typs ->
+    let xtyp = try Some (List.assoc x etyps) with Not_found -> None in
+    let ytyp = try Some (List.assoc y etyps) with Not_found -> None in
+    match xtyp,ytyp with
+    | None, None -> typs
+    | Some _, None -> typs
+    | None, Some ytyp -> (x,ytyp)::typs
+    | Some xtyp, Some ytyp when Pervasives.(=) xtyp ytyp -> typs (* FIXME *)
+    | Some xtyp, Some ytyp ->
+	user_err 
+	  (strbrk "In " ++ Id.print x ++ str " .. " ++ Id.print y ++
+	   strbrk ", both ends have incompatible types."))
+    recvars etyps
+
+let internalization_type_of_entry_type = function
+  | 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
+
+let make_internalization_vars recvars mainvars typs =
+  let maintyps = List.combine mainvars typs in
+  let extratyps = List.map (fun (x,y) -> (y,List.assoc x maintyps)) recvars in
+  maintyps @ extratyps
+
+let make_interpretation_type isrec isonlybinding = function
+  | 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
+    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) ->
+    (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
+    user_err Pp.(str "A notation must include at least one symbol.");
+  if (match l with SProdList _ :: _ -> true | _ -> false) then
+    user_err Pp.(str "A recursive notation must start with at least one symbol.")
+
+let warn_notation_bound_to_variable =
+  CWarnings.create ~name:"notation-bound-to-variable" ~category:"parsing"
+         (fun () ->
+          strbrk "This notation will not be used for printing as it is bound to a single variable.")
+
+let warn_non_reversible_notation =
+  CWarnings.create ~name:"non-reversible-notation" ~category:"parsing"
+         (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 && reversibility <> APrioriReversible then
+     (warn_non_reversible_notation reversibility; true)
+  else onlyparse
+
+
+let find_precedence lev etyps symbols onlyprint =
+  let first_symbol =
+    let rec aux = function
+      | Break _ :: t -> aux t
+      | h :: t -> Some h
+      | [] -> None in
+    aux symbols in
+  let last_is_terminal () =
+    let rec aux b = function
+      | Break _ :: t -> aux b t
+      | Terminal _ :: t -> aux true t
+      | _ :: t -> aux false t
+      | [] -> b in
+    aux false symbols in
+  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 _ -> 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.")
+            end
+        | (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.")
+	else [],Option.get lev)
+  | Some (Terminal _) when last_is_terminal () ->
+      if Option.is_empty lev then
+	([Feedback.msg_info ?loc:None ,strbrk "Setting notation at level 0."], 0)
+      else [],Option.get lev
+  | Some _ ->
+      if Option.is_empty lev then user_err Pp.(str "Cannot determine the level.");
+      [],Option.get lev
+
+let check_curly_brackets_notation_exists () =
+  try let _ = Notation.level_of_notation "{ _ }" in ()
+  with Not_found ->
+    user_err Pp.(str "Notations involving patterns of the form \"{ _ }\" are treated \n\
+specially and require that the notation \"{ _ }\" is already reserved.")
+
+(* Remove patterns of the form "{ _ }", unless it is the "{ _ }" notation *)
+let remove_curly_brackets l =
+  let rec skip_break acc = function
+    | Break _ as br :: l -> skip_break (br::acc) l
+    | l -> List.rev acc, l in
+  let rec aux deb = function
+  | [] -> []
+  | Terminal "{" as t1 :: l ->
+      let br,next = skip_break [] l in
+      (match next with
+        | NonTerminal _ as x :: l' ->
+            let br',next' = skip_break [] l' in
+            (match next' with
+              | Terminal "}" as t2 :: l'' ->
+		  if deb && List.is_empty l'' then [t1;x;t2] else begin
+                    check_curly_brackets_notation_exists ();
+                    x :: aux false l''
+                  end
+              | l1 -> t1 :: br @ x :: br' @ aux false l1)
+        | l0 -> t1 :: aux false l0)
+  | x :: l -> x :: aux false l
+  in aux true l
+
+module SynData = struct
+
+  type subentry_types = (Id.t * (production_level * production_position) constr_entry_key_gen) list
+
+  (* XXX: Document *)
+  type syn_data = {
+
+    (* Notation name and location *)
+    info          : notation * notation_location;
+
+    (* Fields coming from the vernac-level modifiers *)
+    only_parsing  : bool;
+    only_printing : bool;
+    compat        : Flags.compat_version option;
+    format        : Misctypes.lstring option;
+    extra         : (string * string) list;
+
+    (* XXX: Callback to printing, must remove *)
+    msgs          : ((Pp.t -> unit) * Pp.t) list;
+
+    (* Fields for internalization *)
+    recvars       : (Id.t * Id.t) list;
+    mainvars      : Id.List.elt list;
+    intern_typs   : notation_var_internalization_type list;
+
+    (* Notation data for parsing *)
+    level         : level;
+    pa_syntax_data : subentry_types * symbol list;
+    pp_syntax_data : subentry_types * symbol list;
+    not_data      : notation *                   (* notation *)
+                    level *                      (* level, precedence, types *)
+                    bool;                        (* needs_squash *)
+  }
+
+end
+
+let find_subentry_types n assoc etyps symbols =
+  let innerlevel = NumLevel 200 in
+  let typs =
+    find_symbols
+      (NumLevel n,BorderProd(Left,assoc))
+      (innerlevel,InternalProd)
+      (NumLevel n,BorderProd(Right,assoc))
+      symbols in
+  let sy_typs = List.map (set_entry_type etyps) typs in
+  let prec = List.map (assoc_of_type n) sy_typs in
+  sy_typs, prec
+
+let compute_syntax_data df modifiers =
+  let open SynData in
+  let open NotationMods in
+  let mods = interp_modifiers modifiers in
+  let onlyprint = mods.only_printing in
+  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 (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
+
+  (* Notations for interp and grammar  *)
+  let ntn_for_interp = make_notation_key symbols in
+  let symbols_for_grammar = remove_curly_brackets symbols in
+  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 onlyprint in
+  (* To globalize... *)
+  let etyps = join_auxiliary_recursive_types recvars mods.etyps in
+  let sy_typs, prec =
+    find_subentry_types n assoc etyps symbols in
+  let sy_typs_for_grammar, prec_for_grammar =
+    if need_squash then
+      find_subentry_types n assoc etyps symbols_for_grammar
+    else
+      sy_typs, prec in
+  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,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
+
+  (* Return relevant data for interpretation and for parsing/printing *)
+  { info = i_data;
+
+    only_parsing  = mods.only_parsing;
+    only_printing = mods.only_printing;
+    compat        = mods.compat;
+    format        = mods.format;
+    extra         = mods.extra;
+
+    msgs;
+
+    recvars;
+    mainvars;
+    intern_typs = i_typs;
+
+    level  = (n,prec,List.map snd sy_typs);
+    pa_syntax_data = pa_sy_data;
+    pp_syntax_data = pp_sy_data;
+    not_data    = sy_fulldata;
+  }
+
+let compute_pure_syntax_data df mods =
+  let open SynData in
+  let sd = compute_syntax_data df mods in
+  let msgs =
+    if sd.only_parsing then
+      (Feedback.msg_warning ?loc:None,
+      strbrk "The only parsing modifier has no effect in Reserved Notation.")::sd.msgs
+    else sd.msgs in
+  { sd with msgs }
+
+(**********************************************************************)
+(* Registration of notations interpretation                            *)
+
+type notation_obj = {
+  notobj_local : bool;
+  notobj_scope : scope_name option;
+  notobj_interp : interpretation;
+  notobj_onlyparse : bool;
+  notobj_onlyprint : bool;
+  notobj_compat : Flags.compat_version option;
+  notobj_notation : notation * notation_location;
+}
+
+let load_notation _ (_, nobj) =
+  Option.iter Notation.declare_scope nobj.notobj_scope
+
+let open_notation i (_, nobj) =
+  let scope = nobj.notobj_scope in
+  let (ntn, df) = nobj.notobj_notation in
+  let pat = nobj.notobj_interp in
+  let onlyprint = nobj.notobj_onlyprint  in
+  let fresh = not (Notation.exists_notation_in_scope scope ntn onlyprint pat) in
+  let active = is_active_compat nobj.notobj_compat in
+  if Int.equal i 1 && fresh && active then begin
+    (* Declare the interpretation *)
+    let () = Notation.declare_notation_interpretation ntn scope pat df ~onlyprint in
+    (* Declare the uninterpretation *)
+    if not nobj.notobj_onlyparse then
+      Notation.declare_uninterpretation (NotationRule (scope, ntn)) pat
+  end
+
+let cache_notation o =
+  load_notation 1 o;
+  open_notation 1 o
+
+let subst_notation (subst, nobj) =
+  { nobj with notobj_interp = subst_interpretation subst nobj.notobj_interp; }
+
+let classify_notation nobj =
+  if nobj.notobj_local then Dispose else Substitute nobj
+
+let inNotation : notation_obj -> obj =
+  declare_object {(default_object "NOTATION") with
+       open_function = open_notation;
+       cache_function = cache_notation;
+       subst_function = subst_notation;
+       load_function = load_notation;
+       classify_function = classify_notation}
+
+(**********************************************************************)
+
+let with_lib_stk_protection f x =
+  let fs = Lib.freeze ~marshallable:`No in
+  try let a = f x in Lib.unfreeze fs; a
+  with reraise ->
+    let reraise = CErrors.push reraise in
+    let () = Lib.unfreeze fs in
+    iraise reraise
+
+let with_syntax_protection f x =
+  with_lib_stk_protection
+    (Pcoq.with_grammar_rule_protection
+       (with_notation_protection f)) x
+
+(**********************************************************************)
+(* Recovering existing syntax                                         *)
+
+exception NoSyntaxRule
+
+let recover_notation_syntax ntn =
+  try
+    let prec = Notation.level_of_notation ~onlyprint:true ntn (* Be as little restrictive as possible *) in
+    let pp_rule,_ = Notation.find_notation_printing_rule ntn in
+    let pp_extra_rules = Notation.find_notation_extra_printing_rules ntn in
+    let pa_rule = Notation.find_notation_parsing_rules ntn in
+    { synext_level = prec;
+      synext_notation = ntn;
+      synext_notgram = pa_rule;
+      synext_unparsing = pp_rule;
+      synext_extra = pp_extra_rules;
+      synext_compat = None;
+    }
+  with Not_found ->
+    raise NoSyntaxRule
+
+let recover_squash_syntax sy =
+  let sq = recover_notation_syntax "{ _ }" in
+  sy :: sq.synext_notgram.notgram_rules
+
+(**********************************************************************)
+(* Main entry point for building parsing and printing rules           *)
+
+let make_pa_rule level (typs,symbols) ntn need_squash =
+  let assoc = recompute_assoc typs in
+  let prod = make_production typs symbols in
+  let sy = {
+    notgram_level = level;
+    notgram_assoc = assoc;
+    notgram_notation = ntn;
+    notgram_prods = prod;
+  } in
+  (* By construction, the rule for "{ _ }" is declared, but we need to
+     redeclare it because the file where it is declared needs not be open
+     when the current file opens (especially in presence of -nois) *)
+  if need_squash then recover_squash_syntax sy else [sy]
+
+let make_pp_rule level (typs,symbols) fmt =
+  match fmt with
+  | None ->
+     let hunks = make_hunks typs symbols level in
+     if List.exists (function _,(UnpCut (PpBrk _) | UnpListMetaVar _) -> true | _ -> false) hunks then
+       [UnpBox (PpHOVB 0,hunks)]
+     else
+       (* Optimization to work around what seems an ocaml Format bug (see Mantis #7804/#7807) *)
+       List.map snd hunks (* drop locations which are dummy *)
+  | Some fmt ->
+     hunks_of_format (level, List.split typs) (symbols, parse_format fmt)
+
+(* let make_syntax_rules i_typs (ntn,prec,need_squash) sy_data fmt extra onlyprint compat = *)
+let make_syntax_rules (sd : SynData.syn_data) = let open SynData in
+  let ntn_for_grammar, prec_for_grammar, need_squash = sd.not_data in
+  let pa_rule = make_pa_rule prec_for_grammar sd.pa_syntax_data ntn_for_grammar need_squash in
+  let pp_rule = make_pp_rule (pi1 sd.level) sd.pp_syntax_data sd.format in {
+    synext_level    = sd.level;
+    synext_notation = fst sd.info;
+    synext_notgram  = { notgram_onlyprinting = sd.only_printing; notgram_rules = pa_rule };
+    synext_unparsing = pp_rule;
+    synext_extra  = sd.extra;
+    synext_compat = sd.compat;
+  }
+
+(**********************************************************************)
+(* Main functions about notations                                     *)
+
+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 env c mods scope =
+  let open SynData in
+  let sd = compute_syntax_data df mods in
+  (* Prepare the interpretation *)
+  (* Prepare the parsing and printing rules *)
+  let sy_rules = make_syntax_rules sd in
+  let i_vars = make_internalization_vars sd.recvars sd.mainvars sd.intern_typs in
+  let nenv = {
+    ninterp_var_type = to_map i_vars;
+    ninterp_rec_vars = to_map sd.recvars;
+  } 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 reversibility ac in
+  let notation = {
+    notobj_local = local;
+    notobj_scope = scope;
+    notobj_interp = (List.map_filter map i_vars, ac);
+    (** Order is important here! *)
+    notobj_onlyparse = onlyparse;
+    notobj_onlyprint = sd.only_printing;
+    notobj_compat = sd.compat;
+    notobj_notation = sd.info;
+  } in
+  (* Ready to change the global state *)
+  Flags.if_verbose (List.iter (fun (f,x) -> f x)) sd.msgs;
+  Lib.add_anonymous_leaf (inSyntaxExtension (local, sy_rules));
+  Lib.add_anonymous_leaf (inNotation notation);
+  sd.info
+
+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
+    let () = Lib.add_anonymous_leaf (inSyntaxExtension (local,sy)) in
+    (** If the only printing flag has been explicitly requested, put it back *)
+    let onlyprint = onlyprint || sy.synext_notgram.notgram_onlyprinting in
+    pi3 sy.synext_level, onlyprint
+  end else [], false in
+  (* Declare interpretation *)
+  let path = (Lib.library_dp(), Lib.current_dirpath true) in
+  let df'  = (make_notation_key symbs, (path,df)) in
+  let 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, 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 reversibility ac in
+  let notation = {
+    notobj_local = local;
+    notobj_scope = scope;
+    notobj_interp = (List.map_filter map i_vars, ac);
+    (** Order is important here! *)
+    notobj_onlyparse = onlyparse;
+    notobj_onlyprint = onlyprint;
+    notobj_compat = compat;
+    notobj_notation = df';
+  } in
+  Lib.add_anonymous_leaf (inNotation notation);
+  df'
+
+(* Notations without interpretation (Reserved Notation) *)
+
+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;
+  Lib.add_anonymous_leaf (inSyntaxExtension(local,sy_rules))
+
+(* Notations with only interpretation *)
+
+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 env impls ({CAst.v=df},c,sc) =
+  (try ignore
+    (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 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 env c sc onlyparse onlyprint compat
+    with NoSyntaxRule ->
+      (* Try to determine a default syntax rule *)
+      add_notation_in_scope local df env c modifiers sc
+   else
+    (* Declare both syntax and interpretation *)
+    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 _,_, symbs = analyze_notation_tokens ~onlyprint:true df in
+    make_notation_key symbs in
+  Notation.add_notation_extra_printing_rule notk k v
+
+(* Infix notations *)
+
+let inject_var x = CAst.make @@ CRef (CAst.make @@ Ident (Id.of_string x),None)
+
+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 = CAst.make ?loc @@ "x "^(quote_notation_token inf)^" y" in
+  add_notation local env c (df,modifiers) sc
+
+(**********************************************************************)
+(* Delimiters and classes bound to scopes                             *)
+
+type scope_command =
+  | ScopeDelim of string
+  | ScopeClasses of scope_class list
+  | ScopeRemove
+
+let load_scope_command _ (_,(scope,dlm)) =
+  Notation.declare_scope scope
+
+let open_scope_command i (_,(scope,o)) =
+  if Int.equal i 1 then
+    match o with
+    | ScopeDelim dlm -> Notation.declare_delimiters scope dlm
+    | ScopeClasses cl -> List.iter (Notation.declare_scope_class scope) cl
+    | ScopeRemove -> Notation.remove_delimiters scope
+
+let cache_scope_command o =
+  load_scope_command 1 o;
+  open_scope_command 1 o
+
+let subst_scope_command (subst,(scope,o as x)) = match o with
+  | ScopeClasses cl ->
+      let cl' = List.map_filter (subst_scope_class subst) cl in
+      let cl' =
+        if List.for_all2eq (==) cl cl' then cl
+        else cl' in
+      scope, ScopeClasses cl'
+  | _ -> x
+
+let inScopeCommand : scope_name * scope_command -> obj =
+  declare_object {(default_object "DELIMITERS") with
+      cache_function = cache_scope_command;
+      open_function = open_scope_command;
+      load_function = load_scope_command;
+      subst_function = subst_scope_command;
+      classify_function = (fun obj -> Substitute obj)}
+
+let add_delimiters scope key =
+  Lib.add_anonymous_leaf (inScopeCommand(scope,ScopeDelim key))
+
+let remove_delimiters scope =
+  Lib.add_anonymous_leaf (inScopeCommand(scope,ScopeRemove))
+
+let add_class_scope scope cl =
+  Lib.add_anonymous_leaf (inScopeCommand(scope,ScopeClasses cl))
+
+(* Check if abbreviation to a name and avoid early insertion of
+   maximal implicit arguments *)
+let try_interp_name_alias = function
+  | [], { CAst.v = CRef (ref,_) } -> intern_reference ref
+  | _ -> raise Not_found
+
+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 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, 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 reversibility pat) -> Some Flags.Current
+    | p -> p
+  in
+  Syntax_def.declare_syntactic_definition local ident onlyparse (vars,pat)
diff --git a/toplevel/metasyntax.mli b/vernac/metasyntax.mli
index 085cc87c..a6c12e08 100644
--- a/toplevel/metasyntax.mli
+++ b/vernac/metasyntax.mli
@@ -1,26 +1,29 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
-open Tacexpr
 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
@@ -34,11 +37,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 *)
@@ -48,12 +51,12 @@ 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.std_ppcmds
+val pr_grammar : string -> Pp.t
 
 val check_infix_modifiers : syntax_modifier list -> unit
 
diff --git a/toplevel/mltop.ml b/vernac/mltop.ml
index b6690fe4..343b0925 100644
--- a/toplevel/mltop.ml
+++ b/vernac/mltop.ml
@@ -1,15 +1,16 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open CErrors
 open Util
 open Pp
-open Flags
 open Libobject
 open System
 
@@ -124,13 +125,13 @@ let ml_load s =
         | (UserError _ | Failure _ | Not_found as u) -> Exninfo.iraise (u, snd e)
         | exc ->
             let msg = report_on_load_obj_error exc in
-            errorlabstrm "Mltop.load_object" (str"Cannot link ml-object " ++
+            user_err ~hdr:"Mltop.load_object" (str"Cannot link ml-object " ++
                   str s ++ str" to Coq code (" ++ msg ++ str ")."))
     | WithoutTop ->
         try
           Dynlink.loadfile s; s
 	with Dynlink.Error a ->
-          errorlabstrm "Mltop.load_object"
+          user_err ~hdr:"Mltop.load_object"
             (strbrk "while loading " ++ str s ++
              strbrk ": " ++ str (Dynlink.error_message a))
 
@@ -138,7 +139,7 @@ let dir_ml_load s =
   match !load with
     | WithTop _ -> ml_load s
     | WithoutTop ->
-        let warn = Flags.is_verbose() in
+        let warn = not !Flags.quiet in
         let _,gname = find_file_in_path ~warn !coq_mlpath_copy s in
         ml_load gname
 
@@ -151,7 +152,7 @@ let dir_ml_use s =
 	 if Dynlink.is_native then " Loading ML code works only in bytecode."
 	 else ""
        in
-      errorlabstrm "Mltop.dir_ml_use" (str "Could not load ML code." ++ str moreinfo)
+      user_err ~hdr:"Mltop.dir_ml_use" (str "Could not load ML code." ++ str moreinfo)
 
 (* Adds a path to the ML paths *)
 let add_ml_dir s =
@@ -175,6 +176,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 +186,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 +215,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
@@ -226,7 +252,7 @@ let get_ml_object_suffix name =
 let file_of_name name =
   let suffix = get_ml_object_suffix name in
   let fail s =
-    errorlabstrm "Mltop.load_object"
+    user_err ~hdr:"Mltop.load_object"
       (str"File not found on loadpath : " ++ str s ++ str"\n" ++
        str"Loadpath: " ++ str(String.concat ":" !coq_mlpath_copy)) in
   if not (Filename.is_relative name) then
@@ -360,12 +386,12 @@ let trigger_ml_object verb cache reinit ?path name =
     add_loaded_module name (known_module_path name);
     if cache then perform_cache_obj name
   end else if not has_dynlink then
-    errorlabstrm "Mltop.trigger_ml_object"
+    user_err ~hdr:"Mltop.trigger_ml_object"
       (str "Dynamic link not supported (module " ++ str name ++ str ")")
   else begin
     let file = file_of_name (Option.default name path) in
     let path =
-      if_verbose_load (verb && is_verbose ()) 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 +404,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/toplevel/mltop.mli b/vernac/mltop.mli
index 6633cb93..da195f4f 100644
--- a/toplevel/mltop.mli
+++ b/vernac/mltop.mli
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (** {5 Toplevel management} *)
@@ -42,14 +44,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
@@ -83,6 +97,6 @@ val declare_ml_modules : Vernacexpr.locality_flag -> string list -> unit
 
 (** {5 Utilities} *)
 
-val print_ml_path : unit -> Pp.std_ppcmds
-val print_ml_modules : unit -> Pp.std_ppcmds
-val print_gc : unit -> Pp.std_ppcmds
+val print_ml_path : unit -> Pp.t
+val print_ml_modules : unit -> Pp.t
+val print_gc : unit -> Pp.t
diff --git a/toplevel/obligations.ml b/vernac/obligations.ml
index 29d74573..765d6851 100644
--- a/toplevel/obligations.ml
+++ b/vernac/obligations.ml
@@ -1,5 +1,4 @@
 open Printf
-open Globnames
 open Libobject
 open Entries
 open Decl_kinds
@@ -8,11 +7,12 @@ open Declare
 (**
    - Get types of existentials ;
    - Flatten dependency tree (prefix order) ;
-   - Replace existentials by De Bruijn indices in term, applied to the right arguments ;
+   - Replace existentials by de Bruijn indices in term, applied to the right arguments ;
    - Apply term prefixed by quantification on "existentials".
 *)
 
 open Term
+open Constr
 open Vars
 open Names
 open Evd
@@ -20,8 +20,9 @@ open Pp
 open CErrors
 open Util
 
-let declare_fix_ref = ref (fun ?opaque _ _ _ _ _ _ -> assert false)
-let declare_definition_ref = ref (fun _ _ _ _ _ -> assert false)
+module NamedDecl = Context.Named.Declaration
+
+let get_fix_exn, stm_get_fix_exn = Hook.make ()
 
 let succfix (depth, fixrels) =
   (succ depth, List.map succ fixrels)
@@ -34,7 +35,7 @@ let check_evars env evm =
      | Evar_kinds.QuestionMark _
      | Evar_kinds.ImplicitArg (_,_,false) -> ()
      | _ ->
-       Pretype_errors.error_unsolvable_implicit loc env evm key None)
+       Pretype_errors.error_unsolvable_implicit ?loc env evm key None)
   (Evd.undefined_map evm)
 
 type oblinfo =
@@ -47,21 +48,20 @@ type oblinfo =
     ev_tac: unit Proofview.tactic option;
     ev_deps: Int.Set.t }
 
-(** Substitute evar references in t using De Bruijn indices,
+(** Substitute evar references in t using de Bruijn indices,
   where n binders were passed through. *)
 
 let subst_evar_constr evs n idf t =
-  let open Context.Named.Declaration in
   let seen = ref Int.Set.empty in
   let transparent = ref Id.Set.empty in
   let evar_info id = List.assoc_f Evar.equal id evs in
-  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 } =
 	  try evar_info k
 	  with Not_found ->
-	    anomaly ~label:"eterm" (Pp.str "existential variable " ++ int (Evar.repr k) ++ str " not found")
+	    anomaly ~label:"eterm" (Pp.str "existential variable " ++ int (Evar.repr k) ++ str " not found.")
 	in
         seen := Int.Set.add id !seen;
 	  (* Evar arguments are created in inverse order,
@@ -74,6 +74,7 @@ let subst_evar_constr evs n idf t =
 	in
 	let args =
 	  let rec aux hyps args acc =
+             let open Context.Named.Declaration in
 	     match hyps, args with
 		 (LocalAssum _ :: tlh), (c :: tla) ->
 		   aux tlh tla ((substrec (depth, fixrels) c) :: acc)
@@ -84,27 +85,27 @@ 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
 
 
-(** Substitute variable references in t using De Bruijn indices,
+(** Substitute variable references in t using de Bruijn indices,
   where n binders were passed through. *)
 let subst_vars acc n t =
   let var_index id = 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
 
@@ -116,9 +117,9 @@ let etype_of_evar evs hyps concl =
   let open Context.Named.Declaration in
   let rec aux acc n = function
       decl :: tl ->
-	let t', s, trans = subst_evar_constr evs n mkVar (get_type decl) in
+	let t', s, trans = subst_evar_constr evs n mkVar (NamedDecl.get_type decl) in
 	let t'' = subst_vars acc 0 t' in
-	let rest, s', trans' = aux (get_id decl :: acc) (succ n) tl in
+	let rest, s', trans' = aux (NamedDecl.get_id decl :: acc) (succ n) tl in
 	let s' = Int.Set.union s s' in
 	let trans' = Id.Set.union trans trans' in
 	  (match decl with
@@ -140,10 +141,11 @@ let trunc_named_context n ctx =
     List.firstn (len - n) ctx
 
 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
-      | Prod (_, _, b) ->  if noccurn 1 b then chop_product (pred n) (Termops.pop b) else None
+    match Constr.kind t with
+      | Prod (_, _, b) ->  if noccurn 1 b then chop_product (pred n) (pop b) else None
       | _ -> None
 
 let evar_dependencies evm oev =
@@ -152,7 +154,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
@@ -161,7 +163,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 -> 
@@ -216,7 +218,7 @@ let eterm_obligations env name evm fs ?status t ty =
 	 in
 	 let loc, k = evar_source id evm in
 	 let status = match k with
-           | Evar_kinds.QuestionMark o -> o
+           | Evar_kinds.QuestionMark (o,_) -> o
            | _ -> match status with
                  | Some o -> o
                  | None -> Evar_kinds.Define (not (Program.get_proofs_transparency ()))
@@ -255,14 +257,14 @@ let eterm_obligations env name evm fs ?status t ty =
 let tactics_module = ["Program";"Tactics"]
 let safe_init_constant md name () =
   Coqlib.check_required_library ("Coq"::md);
-  Coqlib.gen_constant "Obligations" md name
+  Universes.constr_of_global (Coqlib.coq_reference "Obligations" md name)
 let hide_obligation = safe_init_constant tactics_module "obligation"
 
-let pperror cmd = CErrors.errorlabstrm "Program" cmd
+let pperror cmd = CErrors.user_err ~hdr:"Program" cmd
 let error s = pperror (str s)
 
 let reduce c =
-  Reductionops.clos_norm_flags CClosure.betaiota (Global.env ()) Evd.empty c
+  EConstr.Unsafe.to_constr (Reductionops.clos_norm_flags CClosure.betaiota (Global.env ()) Evd.empty (EConstr.of_constr c))
 
 exception NoObligations of Id.t option
 
@@ -271,7 +273,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
 
@@ -283,7 +285,7 @@ type obligation =
   { obl_name : Id.t;
     obl_type : types;
     obl_location : Evar_kinds.t Loc.located;
-    obl_body : constant obligation_body option;
+    obl_body : pconstant obligation_body option;
     obl_status : bool * Evar_kinds.obligation_definition_status;
     obl_deps : Int.Set.t;
     obl_tac : unit Proofview.tactic option;
@@ -292,17 +294,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 ;
@@ -310,7 +312,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;
 }
@@ -320,7 +322,7 @@ type program_info = program_info_aux CEphemeron.key
 let get_info x =
   try CEphemeron.get x
   with CEphemeron.InvalidKey ->
-    CErrors.anomaly Pp.(str "Program obligation can't be accessed by a worker")
+    CErrors.anomaly Pp.(str "Program obligation can't be accessed by a worker.")
 
 let assumption_message = Declare.assumption_message
 
@@ -335,8 +337,7 @@ let get_hide_obligations () = !hide_obligations
 open Goptions
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "Hidding of Program obligations";
       optkey   = ["Hide";"Obligations"];
       optread  = get_hide_obligations;
@@ -349,8 +350,7 @@ let get_shrink_obligations () = !shrink_obligations
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = true;
+    { optdepr  = true; (* remove in 8.8 *)
       optname  = "Shrinking of Program obligations";
       optkey   = ["Shrink";"Obligations"];
       optread  = get_shrink_obligations;
@@ -358,18 +358,8 @@ let _ =
 
 let evar_of_obligation o = make_evar (Global.named_context_val ()) o.obl_type
 
-let get_body obl =
-  match obl.obl_body with
-  | None -> None
-  | Some (DefinedObl c) ->
-    let ctx = Environ.constant_context (Global.env ()) c in
-    let pc = (c, Univ.UContext.instance ctx) in
-      Some (DefinedObl pc)
-  | Some (TermObl c) ->
-      Some (TermObl c)
-
 let get_obligation_body expand obl =
-  match get_body obl with
+  match obl.obl_body with
   | None -> None
   | Some c ->
      if expand && snd obl.obl_status == Evar_kinds.Expand then
@@ -394,11 +384,11 @@ let subst_deps expand obls deps t =
     (Vars.replace_vars (List.map (fun (n, (_, b)) -> n, b) osubst) t)
 
 let rec prod_app t n =
-  match kind_of_term (strip_outer_cast t) with
+  match 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
     | _ ->
-	errorlabstrm "prod_app"
+	user_err ~hdr:"prod_app"
 	  (str"Needed a product, but didn't find one" ++ fnl ())
 
 
@@ -410,13 +400,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
@@ -438,15 +428,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
-      errorlabstrm "Program" 
+      user_err ~hdr:"Program" 
 	(str "Unsolved obligations when closing " ++ str sec ++ str":" ++ spc () ++
-	   prlist_with_sep spc (fun x -> Nameops.pr_id x) keys ++
+	   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"))
 
@@ -481,29 +471,26 @@ let subst_body expand prg =
 let declare_definition prg =
   let body, typ = subst_body true prg in
   let nf = Universes.nf_evars_and_universes_opt_subst (fun x -> None)
-    (Evd.evar_universe_context_subst prg.prg_ctx) in
+    (UState.subst prg.prg_ctx) in
   let opaque = prg.prg_opaque in
-  let fix_exn = Stm.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 fix_exn = Hook.get get_fix_exn () 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 =
-    !declare_definition_ref 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
-      
-open Pp
+  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) ->
@@ -512,14 +499,14 @@ 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,
 	 but doing it properly involves delta-reduction, and it finally
          doesn't seem to worth the effort (except for huge mutual
 	 fixpoints ?) *)
-      let m = Termops.nb_prod fixtype in
+      let m = Termops.nb_prod Evd.empty (EConstr.of_constr fixtype) (** FIXME *) in
       let ctx = fst (decompose_prod_n_assum m fixtype) in
 	List.map_i (fun i _ -> i) 0 ctx
 
@@ -532,8 +519,12 @@ let declare_mutual_definition l =
     List.split3
       (List.map (fun x -> 
 	let subs, typ = (subst_body true x) in
-	let term = snd (Reductionops.splay_lam_n (Global.env ()) Evd.empty len subs) in
-	let typ = snd (Reductionops.splay_prod_n (Global.env ()) Evd.empty len typ) in
+        let env = Global.env () in
+        let sigma = Evd.from_ctx x.prg_ctx in
+        let term = snd (Reductionops.splay_lam_n env sigma len (EConstr.of_constr subs)) in
+        let typ = snd (Reductionops.splay_prod_n env sigma len (EConstr.of_constr typ)) in
+        let term = EConstr.to_constr sigma term in
+        let typ = EConstr.to_constr sigma typ in
 	  x.prg_reduce term, x.prg_reduce typ, x.prg_implicits) l)
   in
 (*   let fixdefs = List.map reduce_fix fixdefs in *)
@@ -551,8 +542,7 @@ let declare_mutual_definition l =
 	    List.map3 compute_possible_guardness_evidences
               wfl fixdefs fixtypes in
 	  let indexes = 
-              Pretyping.search_guard
-              Loc.ghost (Global.env())
+              Pretyping.search_guard (Global.env())
               possible_indexes fixdecls in
           Some indexes, 
           List.map_i (fun i _ ->
@@ -563,24 +553,23 @@ 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 fix_exn = Stm.get_fix_exn () in
-  let kns = List.map4 (!declare_fix_ref ~opaque (local, poly, kind) ctx)
+  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) 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
     Lemmas.call_hook fix_exn first.prg_hook local gr first.prg_ctx;
-    List.iter progmap_remove l; kn
+    List.iter progmap_remove l; gr
 
 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) ->
@@ -598,7 +587,6 @@ let decompose_lam_prod c ty =
   in aux Context.Rel.empty c ty
 
 let shrink_body c ty =
-  let open Context.Rel.Declaration in
   let ctx, b, ty =
     match ty with
     | None ->
@@ -613,6 +601,7 @@ let shrink_body c ty =
         if noccurn 1 b && Option.cata (noccurn 1) true ty then
 	  subst1 mkProp b, Option.map (subst1 mkProp) ty, succ i, args
 	else
+          let open Context.Rel.Declaration in
 	  let args = if is_local_assum decl then mkRel i :: args else args in
           mkLambda_or_LetIn decl b, Option.map (mkProd_or_LetIn decl) ty,
 	  succ i, args)
@@ -624,6 +613,16 @@ let unfold_entry cst = Hints.HintsUnfoldEntry [EvalConstRef cst]
 let add_hint local prg cst =
   Hints.add_hints local [Id.to_string prg.prg_name] (unfold_entry cst)
 
+let it_mkLambda_or_LetIn_or_clean t ctx =
+  let open Context.Rel.Declaration in
+  let fold t decl =
+    if is_local_assum decl then mkLambda_or_LetIn decl t
+    else
+      if noccurn 1 t then subst1 mkProp t
+      else mkLambda_or_LetIn decl t
+  in
+  Context.Rel.fold_inside fold ctx ~init:t
+
 let declare_obligation prg obl body ty uctx =
   let body = prg.prg_reduce body in
   let ty = Option.map prg.prg_reduce ty in
@@ -641,8 +640,7 @@ let declare_obligation prg obl body ty uctx =
         { const_entry_body = Future.from_val ~fix_exn:(fun x -> x) body;
           const_entry_secctx = None;
 	  const_entry_type = ty;
-	  const_entry_polymorphic = poly;
-	  const_entry_universes = uctx;
+          const_entry_universes = uctx;
 	  const_entry_opaque = opaque;
           const_entry_inline_code = false;
           const_entry_feedback = None;
@@ -651,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 false prg constant;
-	definition_message obl.obl_name;
-	true, { obl with obl_body =
-	    if poly then
-	      Some (DefinedObl constant)
-	    else
-	      Some (TermObl (it_mkLambda_or_LetIn (mkApp (mkConst constant, args)) ctx)) }
-
-let init_prog_info ?(opaque = false) sign n pl b t ctx deps fixkind
+      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
@@ -667,7 +667,7 @@ let init_prog_info ?(opaque = false) sign n pl b t ctx deps fixkind
 	assert(Int.equal (Array.length obls) 0);
 	let n = Nameops.add_suffix n "_obligation" in
 	  [| { obl_name = n; obl_body = None;
-	       obl_location = Loc.ghost, Evar_kinds.InternalHole; obl_type = t;
+	       obl_location = Loc.tag Evar_kinds.InternalHole; obl_type = t;
 	       obl_status = false, Evar_kinds.Expand; obl_deps = Int.Set.empty;
 	       obl_tac = None } |],
 	mkVar n
@@ -679,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; 
@@ -717,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
-                errorlabstrm ""
+                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
@@ -768,8 +769,8 @@ let update_obls prg obls rem =
 	  let progs = List.map (fun x -> get_info (ProgMap.find x !from_prg)) prg'.prg_deps in
 	    if List.for_all (fun x -> obligations_solved x) progs then
 	      let kn = declare_mutual_definition progs in
-		Defined (ConstRef kn)
-	    else Dependent)
+                Defined kn
+            else Dependent)
 
 let is_defined obls x = not (Option.is_empty obls.(x).obl_body)
 
@@ -813,16 +814,15 @@ let rec string_of_list sep f = function
 
 let solve_by_tac name evi t poly ctx =
   let id = name in
-  let concl = evi.evar_concl in
+  let concl = EConstr.of_constr evi.evar_concl in
   (* spiwack: the status is dropped. *)
-  let (entry,_,ctx') = Pfedit.build_constant_by_tactic 
+  let (entry,_,ctx') = Pfedit.build_constant_by_tactic
     id ~goal_kind:(goal_kind poly) ctx evi.evar_hyps concl (Tacticals.New.tclCOMPLETE t) in
   let env = Global.env () in
   let entry = Safe_typing.inline_private_constants_in_definition_entry env entry in
-  let body, eff = Future.force entry.const_entry_body in
-  assert(Safe_typing.empty_private_constants = eff);
+  let body, () = Future.force entry.const_entry_body in
   let ctx' = Evd.merge_context_set ~sideff:true Evd.univ_rigid (Evd.from_ctx ctx') (snd body) in
-  Inductiveops.control_only_guard (Global.env ()) (fst body);
+  Inductiveops.control_only_guard env ctx' (EConstr.of_constr (fst body));
   (fst body), entry.const_entry_type, Evd.evar_universe_context ctx'
 
 let obligation_terminator name num guard hook auto pf =
@@ -831,47 +831,65 @@ 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), eff = Future.force entry.Entries.const_entry_body in
-      assert(Safe_typing.empty_private_constants = eff);
-      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 ()) sigma (EConstr.of_constr 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 (defined, 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, if defined,
+            declares the univs of the constant,
+            each subsequent obligation declares its own additional
+            universes and constraints if any *)
+        if defined then UState.make (Global.universes ())
+        else ctx
+    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
@@ -883,20 +901,23 @@ let obligation_hook prg obl num auto ctx' _ gr =
        if not transparent then err_not_transp ()
     | _ -> ()
 in
-  let obl = { obl with obl_body = Some (DefinedObl cst) } in
-  let () = if transparent then add_hint true prg cst in
-  let obls = Array.copy obls in
-  let _ = obls.(num) <- obl in
   let ctx' = match ctx' with None -> prg.prg_ctx | Some ctx' -> ctx' in
-  let ctx' =
+  let inst, ctx' =
     if not (pi2 prg.prg_kind) (* Not polymorphic *) then
       (* The universe context was declared globally, we continue
          from the new global environment. *)
       let evd = Evd.from_env (Global.env ()) in
       let ctx' = Evd.merge_universe_subst evd (Evd.universe_subst (Evd.from_ctx ctx')) in
-        Evd.evar_universe_context ctx'
-    else ctx'
+      Univ.Instance.empty, Evd.evar_universe_context ctx'
+    else
+      (* 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
+  let () = if transparent then add_hint true prg cst in
+  let obls = Array.copy obls in
+  let _ = obls.(num) <- obl in
   let prg = { prg with prg_ctx = ctx' } in
   let () =
     try ignore (update_obls prg obls (pred rem))
@@ -931,15 +952,15 @@ let rec solve_obligation prg num tac =
     Proof_global.make_terminator
       (obligation_terminator prg.prg_name num guard hook auto) in
   let hook ctx = Lemmas.mk_hook (obligation_hook prg obl num auto ctx) in
-  let () = Lemmas.start_proof_univs ~sign:prg.prg_sign obl.obl_name kind evd obl.obl_type ~terminator hook in
+  let () = Lemmas.start_proof_univs ~sign:prg.prg_sign obl.obl_name kind evd (EConstr.of_constr obl.obl_type) ~terminator hook in
   let _ = Pfedit.by !default_tactic in
-  Option.iter (fun tac -> Pfedit.set_end_tac tac) tac
+  Option.iter (fun tac -> Proof_global.set_endline_tactic tac) tac
 
 and obligation (user_num, name, typ) tac =
   let num = pred user_num in
   let prg = get_prog_err name in
   let obls, rem = prg.prg_obligations in
-    if num < Array.length obls then
+    if num >= 0 && num < Array.length obls then
       let obl = obls.(num) in
 	match obl.obl_body with
 	    None -> solve_obligation prg num tac
@@ -966,13 +987,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
@@ -985,7 +1009,7 @@ and solve_obligation_by_tac prg obls i tac =
           let (e, _) = CErrors.push e in
           match e with
 	  | Refiner.FailError (_, s) ->
-	      user_err_loc (fst obl.obl_location, "solve_obligation", Lazy.force s)
+	      user_err ?loc:(fst obl.obl_location) ~hdr:"solve_obligation" (Lazy.force s)
           | e -> None (* FIXME really ? *)
 
 and solve_prg_obligations prg ?oblset tac =
@@ -1069,11 +1093,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 ".");
@@ -1081,20 +1106,21 @@ let add_definition n ?term t ctx ?pl ?(implicits=[]) ?(kind=Global,false,Definit
       Defined cst)
   else (
     let len = Array.length obls in
-    let _ = Flags.if_verbose Feedback.msg_info (info ++ str ", generating " ++ int len ++ str " obligation(s)") in
+    let _ = Flags.if_verbose Feedback.msg_info (info ++ str ", generating " ++ int len ++ str (String.plural len " obligation")) in
       progmap_add n (CEphemeron.create prg);
       let res = auto_solve_obligations (Some n) tactic in
 	match res with
 	| 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 =
@@ -1118,12 +1144,12 @@ 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) }
+              obls.(i) <- { x with obl_body = Some (DefinedObl (kn, Univ.Instance.empty)) }
         | Some _ -> ())
       obls;
     ignore(update_obls prg obls 0)
@@ -1161,7 +1187,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/toplevel/obligations.mli b/vernac/obligations.mli
index 69d20696..cc2cacd8 100644
--- a/toplevel/obligations.mli
+++ b/vernac/obligations.mli
@@ -1,28 +1,23 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Environ
-open Term
+open Constr
 open Evd
 open Names
-open Pp
 open Globnames
-open Vernacexpr
-open Decl_kinds
 
-(** Forward declaration. *)
-val declare_fix_ref : (?opaque:bool -> definition_kind -> Univ.universe_context -> Id.t ->
-  Safe_typing.private_constants Entries.proof_output -> types -> Impargs.manual_implicits -> global_reference) ref
-
-val declare_definition_ref :
-  (Id.t -> definition_kind ->
-     Safe_typing.private_constants Entries.definition_entry -> Impargs.manual_implicits
-       -> global_reference Lemmas.declaration_hook -> global_reference) ref
+(* This is a hack to make it possible for Obligations to craft a Qed
+ * behind the scenes.  The fix_exn the Stm attaches to the Future proof
+ * is not available here, so we provide a side channel to get it *)
+val stm_get_fix_exn : (unit -> Exninfo.iexn -> Exninfo.iexn) Hook.t
 
 val check_evars : env -> evar_map -> unit
 
@@ -39,14 +34,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 *)
@@ -58,38 +53,38 @@ 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
 
 val obligation : int * Names.Id.t option * Constrexpr.constr_expr option ->
-  Tacexpr.raw_tactic_expr option -> unit
+  Genarg.glob_generic_argument option -> unit
 
-val next_obligation : Names.Id.t option -> Tacexpr.raw_tactic_expr option -> unit
+val next_obligation : Names.Id.t option -> Genarg.glob_generic_argument option -> unit
 
 val solve_obligations : Names.Id.t option -> unit Proofview.tactic option -> progress
 (* Number of remaining obligations to be solved for this program *)
@@ -102,12 +97,15 @@ val try_solve_obligations : Names.Id.t option -> unit Proofview.tactic option ->
 
 val show_obligations : ?msg:bool -> Names.Id.t option -> unit
 
-val show_term : Names.Id.t option -> std_ppcmds
+val show_term : Names.Id.t option -> Pp.t
 
 val admit_obligations : Names.Id.t option -> unit
 
 exception NoObligations of Names.Id.t option
 
-val explain_no_obligations : Names.Id.t option -> Pp.std_ppcmds
+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 caa9b328..f8b085f3 100644
--- a/proofs/proof_using.ml
+++ b/vernac/proof_using.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Names
@@ -12,15 +14,7 @@ open Util
 open Vernacexpr
 open 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
+module NamedDecl = Context.Named.Declaration
 
 let known_names = Summary.ref [] ~name:"proofusing-nameset"
 
@@ -35,21 +29,31 @@ let in_nameset =
 let rec close_fwd e s =
   let s' =
     List.fold_left (fun s decl ->
-      let (id,b,ty) = Context.Named.Declaration.to_tuple decl in
-      let vb = Option.(default Id.Set.empty (map (global_vars_set e) b)) in
-      let vty = global_vars_set e ty in
+      let vb = match decl with
+               | LocalAssum _ -> Id.Set.empty
+               | LocalDef (_,b,_) -> global_vars_set e b
+      in
+      let vty = global_vars_set e (NamedDecl.get_type decl) in
       let vbty = Id.Set.union vb vty in
       if Id.Set.exists (fun v -> Id.Set.mem v s) vbty
-      then Id.Set.add id (Id.Set.union s vbty) else s)
+      then Id.Set.add (NamedDecl.get_id decl) (Id.Set.union s vbty) else s)
     s (named_context e)
     in
   if Id.Set.equal s s' then s else close_fwd e s'
-;;
+
+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)
@@ -57,23 +61,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
-    List.fold_right Id.Set.add (List.map get_id (named_context env)) Id.Set.empty
+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 get_id (named_context env)) Id.Set.empty
-
 let process_expr env e ty =
-  let ty_expr = SsSingl(Loc.ghost, Id.of_string "Type") in
-  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
 
@@ -101,19 +97,28 @@ 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 = prerr_endline (string_of_ppcmds x) in
+  let print x = Feedback.msg_debug x in
   let pr_set parens s =
     let wrap ppcmds =
       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);
@@ -129,38 +134,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.optsync  = true;
-      Goptions.optdepr  = false;
+    { 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.optsync  = true;
-      Goptions.optdepr  = false;
+    { 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/vernac/proof_using.mli b/vernac/proof_using.mli
new file mode 100644
index 00000000..7d1110aa
--- /dev/null
+++ b/vernac/proof_using.mli
@@ -0,0 +1,23 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Utility code for section variables handling in Proof using... *)
+
+val process_expr :
+  Environ.env -> Vernacexpr.section_subset_expr -> Constr.types list ->
+    Names.Id.t list
+
+val name_set : Names.Id.t -> Vernacexpr.section_subset_expr -> unit
+
+val suggest_constant : Environ.env -> Names.Constant.t -> unit
+
+val suggest_variable : Environ.env -> Names.Id.t -> unit
+
+val get_default_proof_using : unit -> Vernacexpr.section_subset_expr option
diff --git a/toplevel/record.ml b/vernac/record.ml
index ef09f6fa..78e68e8a 100644
--- a/toplevel/record.ml
+++ b/vernac/record.ml
@@ -1,18 +1,22 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 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
@@ -24,17 +28,17 @@ open Type_errors
 open Constrexpr
 open Constrexpr_ops
 open Goptions
-open Sigma.Notations
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (********** definition d'un record (structure) **************)
 
 (** Flag governing use of primitive projections. Disabled by default. *)
 let primitive_flag = ref false
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "use of primitive projections";
       optkey   = ["Primitive";"Projections"];
       optread  = (fun () -> !primitive_flag) ;
@@ -43,8 +47,7 @@ let _ =
 let typeclasses_strict = ref false
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "strict typeclass resolution";
       optkey   = ["Typeclasses";"Strict";"Resolution"];
       optread  = (fun () -> !typeclasses_strict);
@@ -53,123 +56,133 @@ let _ =
 let typeclasses_unique = ref false
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "unique typeclass instances";
       optkey   = ["Typeclasses";"Unique";"Instances"];
       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 t' impl) impls
+        | Name id -> Id.Map.add id (compute_internalization_data env sigma Constrintern.Method 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;
-      (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) ->
     let univ = 
       if is_local_assum d then
-	let s = Retyping.get_sort_of env evars (get_type d) in
+	let s = Retyping.get_sort_of env evars (RelDecl.get_type d) in
 	  Univ.sup (univ_of_sort s) univ 
       else univ
-    in (push_rel d env, univ)) 
+    in (EConstr.push_rel d env, univ))
     l (env, Univ.type0m_univ)
 
 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 -> CHole (fst n, 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 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 (loc, "record", str "Record parameters must be named")
+        user_err ?loc ~hdr:"record" (str "Record parameters must be named")
       | _ -> ()
     in
       List.iter 
-	(function LocalRawDef (b, _) -> error default_binder_kind b
-	   | LocalRawAssum (ls, bk, ce) -> List.iter (error bk) ls
-           | LocalPattern _ -> assert false) ps
+	(function CLocalDef (b, _, _) -> error default_binder_kind b
+	   | CLocalAssum (ls, bk, ce) -> List.iter (error bk) ls
+           | 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 t', 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 = push_rel_context newps env0 in
+       let env = EConstr.push_rel_context newps env0 in
        let poly =
          match t with
-         | CSort (_, Misctypes.GType []) -> true | _ -> false in
-       let s = interp_type_evars env evars ~impls:empty_internalization_env t in
-       let sred = Reductionops.whd_all env !evars s in
-	 (match kind_of_term sred with
-	 | Sort s' -> 
+         | { CAst.v = CSort (Misctypes.GType []) } -> true | _ -> false in
+       let sigma, s = interp_type_evars env sigma ~impls:empty_internalization_env t in
+       let sred = Reductionops.whd_allnolet env sigma s in
+         (match EConstr.kind sigma sred with
+	 | Sort s' ->
+            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 true l; 
-	                  sred, true
-	       | None -> s, false
-             else s, false)
-	 | _ -> user_err_loc (constr_loc t,"", str"Sort expected."))
+               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
-	mkSort (Evarutil.evd_comb0 (Evd.new_sort_variable uvarkind) evars), true
+      let sigma, s = Evd.new_sort_variable uvarkind sigma in
+      sigma, EConstr.mkSort s, s, true
   in
-  let fullarity = it_mkProd_or_LetIn t' newps in
-  let env_ar = push_rel_context newps (push_rel (LocalAssum (Name id,fullarity)) env0) in
-  let env2,impls,newfs,data =
-    interp_fields_evars env_ar evars impls_env nots (binders_of_decls fs)
+  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 %> Name.get_id) assums in
+  let ty = Inductive (params,(finite != Declarations.BiFinite)) in
+  let impls_env = compute_internalization_env env0 sigma ~impls:impls_env ty [id] [arity] [imps] in
+  let env2,sigma,impls,newfs,data =
+    interp_fields_evars env_ar sigma impls_env nots (binders_of_decls fs)
   in
-  let sigma = 
-    Pretyping.solve_remaining_evars Pretyping.all_and_fail_flags env_ar !evars (Evd.empty,!evars) in
-  let evars, nf = Evarutil.nf_evars_and_universes sigma in
-  let arity = nf t' in
-  let arity, evars = 
-    let _, univ = compute_constructor_level evars env_ar newfs in
-    let ctx, aritysort = Reduction.dest_arity env0 arity in
-      assert(List.is_empty ctx); (* Ensured by above analysis *)
-      if not def && (Sorts.is_prop aritysort || 
-	(Sorts.is_set aritysort && is_impredicative_set env0)) then
-	arity, evars
+  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
+        sigma, typ
       else
-	let evars = Evd.set_leq_sort env_ar evars (Type univ) aritysort 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 aritysort) 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 *)
-	  mkArity (ctx, Sorts.sort_of_univ univ),
-	  Evd.set_eq_sort env_ar evars (Prop Pos) aritysort
-	else arity, 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 newps = Context.Rel.map nf newps in
-  let newfs = Context.Rel.map nf newfs in
-  let ce t = Pretyping.check_evars env0 Evd.empty evars 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, nf arity, template, imps, newps, impls, newfs
+    ubinders, univs, typ, template, imps, newps, impls, newfs
 
 let degenerate_decl decl =
-  let id = match get_name decl with
+  let id = match RelDecl.get_name decl with
     | Name id -> id
-    | Anonymous -> anomaly (Pp.str "Unnamed record variable") in
+    | Anonymous -> anomaly (Pp.str "Unnamed record variable.") in
   match decl with
     | LocalAssum (_,t) -> (id, LocalAssumEntry t)
     | LocalDef (_,b,_) -> (id, LocalDefEntry b)
@@ -189,27 +202,27 @@ 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 errorlabstrm "structure" st;
-  Flags.if_verbose Feedback.msg_info (hov 0 st)
+  if coe then user_err ~hdr:"structure" st;
+  warn_cannot_define_projection (hov 0 st)
 
 type field_status =
   | NoProjection of Name.t
@@ -225,7 +238,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
@@ -235,12 +248,12 @@ let subst_projection fid l c =
 	    | Projection t -> lift depth t
 	    | NoProjection (Name id) -> bad_projs := id :: !bad_projs; mkRel k
 	    | NoProjection Anonymous ->
-                errorlabstrm "" (str "Field " ++ pr_id fid ++
+                user_err  (str "Field " ++ 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
@@ -259,17 +272,19 @@ 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 u = Declareops.inductive_instance mib in
+  let poly = Declareops.inductive_is_polymorphic mib 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 poly = mib.mind_polymorphic in
-  let ctx = Univ.instantiate_univ_context mib.mind_universes in
   let indu = indsp, u in
   let r = mkIndU (indsp,u) in
-  let rp = applist (r, Context.Rel.to_extended_list 0 paramdecls) in
-  let paramargs = Context.Rel.to_extended_list 1 paramdecls in (*def in [[params;x:rp]]*)
+  let rp = applist (r, Context.Rel.to_extended_list mkRel 0 paramdecls) in
+  let paramargs = Context.Rel.to_extended_list mkRel 1 paramdecls in (*def in [[params;x:rp]]*)
   let x = Name binder_name in
   let fields = instantiate_possibly_recursive_type indu paramdecls fields in
   let lifted_fields = Termops.lift_rel_context 1 fields in
@@ -288,8 +303,8 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
   let (_,_,kinds,sp_projs,_) =
     List.fold_left3
       (fun (nfi,i,kinds,sp_projs,subst) coe decl impls ->
-        let fi = get_name decl in
-        let ti = get_type decl in
+        let fi = RelDecl.get_name decl in
+        let ti = RelDecl.get_type decl in
 	let (sp_projs,i,subst) =
 	  match fi with
 	  | Anonymous ->
@@ -298,9 +313,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
@@ -324,9 +341,7 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
 		      Future.from_val (Safe_typing.mk_pure_proof proj);
 		    const_entry_secctx = None;
 		    const_entry_type = Some projtyp;
-		    const_entry_polymorphic = poly;
-		    const_entry_universes =
-		      if poly then ctx else Univ.UContext.empty;
+                    const_entry_universes = ctx;
 		    const_entry_opaque = false;
 		    const_entry_inline_code = false;
 		    const_entry_feedback = None } in
@@ -335,8 +350,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))) 
@@ -356,34 +372,23 @@ 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 = Sigma.Unsafe.of_evar_map evm in
-        let Sigma (_, evm, _) = Evarutil.new_pure_evar env evm (get_type decl) in
-        let evm = Sigma.to_evar_map evm in
-        evm
-      | decl::tl ->
-          let env = Environ.empty_named_context_val in
-          let evm = Sigma.Unsafe.of_evar_map evm in
-          let Sigma (ev, evm, _) = Evarutil.new_pure_evar env evm (get_type decl) in
-          let evm = Sigma.to_evar_map evm in
-	  let new_tl = Util.List.map_i
-	    (fun pos decl ->
-	       map_type (fun t -> Termops.replace_term (mkRel pos) (mkEvar(ev,[||])) t) decl) 1 tl in
-	  deps_to_evar evm new_tl in
-  deps_to_evar Evd.empty (List.rev ctx)
-
 open Typeclasses
 
-let declare_structure finite poly ctx 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 nfields params 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 template, ctx =
+    match univs with
+    | 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
     | None -> Id.of_string (Unicode.lowercase_first_char (Id.to_string id)) 
@@ -392,7 +397,7 @@ let declare_structure finite poly ctx id idbuild paramimpls params arity templat
   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
@@ -401,16 +406,17 @@ let declare_structure finite poly ctx id idbuild paramimpls params arity templat
       mind_entry_record = Some (if !primitive_flag then Some binder_name else None);
       mind_entry_finite = finite;
       mind_entry_inds = [mie_ind];
-      mind_entry_polymorphic = poly;
       mind_entry_private = None;
-      mind_entry_universes = ctx;
+      mind_entry_universes = univs;
     }
   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 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
@@ -422,44 +428,46 @@ let implicits_of_context ctx =
       | Name n -> Some n
       | Anonymous -> None
     in ExplByPos (i, explname), (true, true, true))
-    1 (List.rev (Anonymous :: (List.map get_name ctx)))
+    1 (List.rev (Anonymous :: (List.map RelDecl.get_name ctx)))
 
-let declare_class finite def poly ctx id idbuild paramimpls params arity 
-    template fieldimpls fields ?(kind=StructureComponent) is_coe coers priorities sign =
+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) 
@@ -467,28 +475,51 @@ let declare_class finite def poly ctx id idbuild paramimpls params arity
       in
       cref, [Name proj_name, sub, Some proj_cst]
     | _ ->
-       let ind = declare_structure BiFinite poly ctx (snd id) idbuild paramimpls
+       let univs =
+         match univs with
+         | Polymorphic_const_entry univs ->
+           if cum then
+             Cumulative_ind_entry (Univ.CumulativityInfo.from_universe_context univs)
+           else
+             Polymorphic_ind_entry univs
+         | Monomorphic_const_entry univs ->
+           Monomorphic_ind_entry univs
+       in
+       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 -> 
 			      if b then Backward, pri else Forward, pri) coe)
 	  coers priorities
        in
-       let l = List.map3 (fun decl b y -> get_name decl, b, y)
+       let l = List.map3 (fun decl b y -> RelDecl.get_name decl, b, y)
          (List.rev fields) coers (Recordops.lookup_projections ind)
        in IndRef ind, l
   in
   let ctx_context =
     List.map (fun decl ->
-      match Typeclasses.class_of_constr (get_type decl) with
-      | Some (_, ((cl,_), _)) -> Some (cl.cl_impl, true)
+      match Typeclasses.class_of_constr Evd.empty (EConstr.of_constr (RelDecl.get_type decl)) with
+      | Some (_, ((cl,_), _)) -> Some cl.cl_impl
       | None -> None)
       params, params
   in
+  let univs, ctx_context, fields =
+    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
+    | Monomorphic_const_entry _ ->
+      Univ.AUContext.empty, ctx_context, fields
+  in
   let k =
-    { cl_impl = impl;
+    { cl_univs = univs;
+      cl_impl = impl;
       cl_strict = !typeclasses_strict;
       cl_unique = !typeclasses_unique;
       cl_context = ctx_context;
@@ -499,10 +530,11 @@ let declare_class finite def poly ctx id idbuild paramimpls params arity
 
 
 let add_constant_class cst =
-  let ty = Universes.unsafe_type_of_global (ConstRef cst) in
+  let ty, univs = Global.type_of_global_in_context (Global.env ()) (ConstRef cst) in
   let ctx, arity = decompose_prod_assum ty in
   let tc = 
-    { cl_impl = ConstRef cst;
+    { cl_univs = univs;
+      cl_impl = ConstRef cst;
       cl_context = (List.map (const None) ctx, ctx);
       cl_props = [LocalAssum (Anonymous, arity)];
       cl_projs = [];
@@ -516,12 +548,13 @@ let add_inductive_class ind =
   let mind, oneind = Global.lookup_inductive ind in
   let k =
     let ctx = oneind.mind_arity_ctxt in
-    let inst = Univ.UContext.instance mind.mind_universes in
-    let ty = Inductive.type_of_inductive
-      (push_rel_context ctx (Global.env ()))
-      ((mind,oneind),inst)
-    in
-      { cl_impl = IndRef ind;
+    let univs = Declareops.inductive_polymorphic_context mind in
+    let env = push_context ~strict:false (Univ.AUContext.repr univs) (Global.env ()) in
+    let env = push_rel_context ctx env in
+    let inst = Univ.make_abstract_instance univs in
+    let ty = Inductive.type_of_inductive env ((mind, oneind), inst) in
+      { cl_univs = univs;
+        cl_impl = IndRef ind;
 	cl_context = List.map (const None) ctx, ctx;
 	cl_props = [LocalAssum (Anonymous, ty)];
 	cl_projs = [];
@@ -533,47 +566,55 @@ let declare_existing_class g =
   match g with
   | ConstRef x -> add_constant_class x
   | IndRef x -> add_inductive_class x
-  | _ -> user_err_loc (Loc.dummy_loc, "declare_existing_class", 
-		      Pp.str"Unsupported class type, only constants and inductives are allowed")
+  | _ -> user_err ~hdr:"declare_existing_class"
+		      (Pp.str"Unsupported class type, only constants and inductives are allowed")
 
 open Vernacexpr
 
 (* [fs] corresponds to fields and [ps] to parameters; [coers] is a
    list telling if the corresponding fields must me declared as coercions 
    or subinstances. *)
-let definition_structure (kind,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
-  if not (List.distinct_f Id.compare allnames)
-  then error "Two objects have the same name";
+  let () = match List.duplicates Id.equal allnames with
+  | [] -> ()
+  | id :: _ -> user_err (str "Two objects have the same name" ++ spc () ++ quote (Id.print id))
+  in
   let isnot_class = match kind with Class false -> false | _ -> true in
   if isnot_class && List.exists (fun opt -> not (Option.is_empty opt)) priorities then
-    error "Priorities only allowed for type class substructures";
+    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 (kind = Class true) idstruc pl s ps notations fs) () in
-  let sign = structure_signature (fields@params) in
-  let gr = match kind with
+      typecheck_params_and_fields finite (kind = Class true) idstruc poly pl s ps notations fs) () in
+  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 poly ctx (loc,idstruc) idbuild
-	  implpars params arity template implfs fields is_coe coers priorities sign in
-	gr
-    | _ ->
-	let implfs = List.map
+    let priorities = List.map (fun id -> {hint_priority = id; hint_pattern = None}) priorities in
+    declare_class finite def cum pl univs (loc,idstruc) idbuild
+      implpars params arity template implfs fields is_coe coers priorities
+  | _ ->
+      let implfs = List.map
 	  (fun impls -> implpars @ Impargs.lift_implicits
-	    (succ (List.length params)) impls) implfs in
-	let ind = declare_structure finite poly ctx idstruc
+	           (succ (List.length params)) impls) implfs 
+      in
+      let univs =
+        match univs with
+        | Polymorphic_const_entry univs ->
+          if cum then
+            Cumulative_ind_entry (Univ.CumulativityInfo.from_universe_context univs)
+          else
+            Polymorphic_ind_entry univs
+        | Monomorphic_const_entry univs ->
+          Monomorphic_ind_entry univs
+      in
+      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
-	IndRef ind
-  in
-  Universes.register_universe_binders gr pl;
-  gr
+          fields is_coe (List.map (fun coe -> not (Option.is_empty coe)) coers) in
+      IndRef ind
diff --git a/vernac/record.mli b/vernac/record.mli
new file mode 100644
index 00000000..992da2aa
--- /dev/null
+++ b/vernac/record.mli
@@ -0,0 +1,35 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Vernacexpr
+open Constrexpr
+open Globnames
+
+val primitive_flag : bool ref
+
+val declare_projections :
+  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 *
+  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
+
+val declare_existing_class : global_reference -> unit
diff --git a/toplevel/search.ml b/vernac/search.ml
index ff3c7a4f..a2a4fb40 100644
--- a/toplevel/search.ml
+++ b/vernac/search.ml
@@ -1,24 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Pp
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Libobject
 open Environ
 open Pattern
-open Printer
 open Libnames
 open Globnames
 open Nametab
-open Goptions
+
+module NamedDecl = Context.Named.Declaration
 
 type filter_function = global_reference -> env -> constr -> bool
 type display_function = global_reference -> env -> constr -> unit
@@ -40,7 +42,6 @@ module SearchBlacklist =
       let title = "Current search blacklist : "
       let member_message s b =
 	str "Search blacklist does " ++ (if b then mt () else str "not ") ++ str "include " ++ str s
-      let synchronous = true
      end)
 
 (* The functions iter_constructors and iter_declarations implement the behavior
@@ -57,8 +58,7 @@ let iter_constructors indsp u fn env nconstr =
   done
 
 let iter_named_context_name_type f =
-  let open Context.Named.Declaration in
-  List.iter (fun decl -> f (get_id decl) (get_type decl))
+  List.iter (fun decl -> f (NamedDecl.get_id decl) (NamedDecl.get_type decl))
 
 (* General search over hypothesis of a goal *)
 let iter_hypothesis glnum (fn : global_reference -> env -> constr -> unit) =
@@ -70,25 +70,24 @@ let iter_hypothesis glnum (fn : global_reference -> env -> constr -> unit) =
 
 (* General search over declarations *)
 let iter_declarations (fn : global_reference -> env -> constr -> unit) =
-  let open Context.Named.Declaration in
   let env = Global.env () in
   let iter_obj (sp, kn) lobj = match object_tag lobj with
   | "VARIABLE" ->
     begin try
       let decl = Global.lookup_named (basename sp) in
-      fn (VarRef (get_id decl)) env (get_type decl)
+      fn (VarRef (NamedDecl.get_id decl)) env (NamedDecl.get_type decl)
     with Not_found -> (* we are in a section *) () end
   | "CONSTANT" ->
     let cst = Global.constant_of_delta_kn kn in
     let gr = ConstRef cst in
-    let typ = Global.type_of_global_unsafe gr in
+    let (typ, _) = Global.type_of_global_in_context (Global.env ()) gr in
       fn gr env typ
   | "INDUCTIVE" ->
     let mind = Global.mind_of_delta_kn kn in
     let mib = Global.lookup_mind mind in
     let iter_packet i mip =
       let ind = (mind, i) in
-      let u = Declareops.inductive_instance mib in
+      let u = Univ.make_abstract_instance (Declareops.inductive_polymorphic_context mib) in
       let i = (ind, u) in
       let typ = Inductiveops.type_of_inductive env i in
       let () = fn (IndRef ind) env typ in
@@ -107,24 +106,90 @@ let generic_search glnumopt fn =
   | Some glnum ->  iter_hypothesis glnum fn);
   iter_declarations fn
 
+(** This module defines a preference on constrs in the form of a
+    [compare] function (preferred constr must be big for this
+    functions, so preferences such as small constr must use a reversed
+    order). This priority will be used to order search results and
+    propose first results which are more likely to be relevant to the
+    query, this is why the type [t] contains the other elements
+    required of a search. *)
+module ConstrPriority = struct
+
+  (* The priority is memoised here. Because of the very localised use
+     of this module, it is not worth it making a convenient interface. *)
+  type t =
+    Globnames.global_reference * Environ.env * Constr.t * priority
+  and priority = int
+
+  module ConstrSet = CSet.Make(Constr)
+
+  (** A measure of the size of a term *)
+  let rec size t =
+    Constr.fold (fun s t -> 1 + s + size t) 0 t
+
+  (** Set of the "symbols" (definitions, inductives, constructors)
+      which appear in a term. *)
+  let rec symbols acc t =
+    let open Constr in
+    match kind t with
+    | Const _ | Ind _ | Construct _ -> ConstrSet.add t acc
+    | _ -> Constr.fold symbols acc t
+
+  (** The number of distinct "symbols" (see {!symbols}) which appear
+      in a term. *)
+  let num_symbols t =
+    ConstrSet.(cardinal (symbols empty t))
+
+  let priority t : priority =
+    -(3*(num_symbols t) + size t)
+
+  let compare (_,_,_,p1) (_,_,_,p2) =
+    Pervasives.compare p1 p2
+end
+
+module PriorityQueue = Heap.Functional(ConstrPriority)
+
+let rec iter_priority_queue q fn =
+  (* use an option to make the function tail recursive. Will be
+     obsoleted with Ocaml 4.02 with the [match … with | exception …]
+     syntax. *)
+  let next = begin
+      try Some (PriorityQueue.maximum q)
+      with Heap.EmptyHeap -> None
+  end in
+  match next with
+  | Some (gref,env,t,_) ->
+    fn gref env t;
+    iter_priority_queue (PriorityQueue.remove q) fn
+  | None -> ()
+
+let prioritize_search seq fn =
+  let acc = ref PriorityQueue.empty in
+  let iter gref env t =
+    let p = ConstrPriority.priority t in
+    acc := PriorityQueue.add (gref,env,t,p) !acc
+  in
+  let () = seq iter in
+  iter_priority_queue !acc fn
+
 (** Filters *)
 
 (** This function tries to see whether the conclusion matches a pattern. *)
 (** FIXME: this is quite dummy, we may find a more efficient algorithm. *)
-let rec pattern_filter pat ref env typ =
-  let typ = strip_outer_cast typ in
-  if Constr_matching.is_matching env Evd.empty pat typ then true
-  else match kind_of_term typ with
+let rec pattern_filter pat ref env sigma typ =
+  let typ = Termops.strip_outer_cast sigma typ in
+  if Constr_matching.is_matching env sigma pat typ then true
+  else match EConstr.kind sigma typ with
   | Prod (_, _, typ)
-  | LetIn (_, _, _, typ) -> pattern_filter pat ref env typ
+  | LetIn (_, _, _, typ) -> pattern_filter pat ref env sigma typ
   | _ -> false
 
-let rec head_filter pat ref env typ =
-  let typ = strip_outer_cast typ in
-  if Constr_matching.is_matching_head env Evd.empty pat typ then true
-  else match kind_of_term typ with
+let rec head_filter pat ref env sigma typ =
+  let typ = Termops.strip_outer_cast sigma typ in
+  if Constr_matching.is_matching_head env sigma pat typ then true
+  else match EConstr.kind sigma typ with
   | Prod (_, _, typ)
-  | LetIn (_, _, _, typ) -> head_filter pat ref env typ
+  | LetIn (_, _, _, typ) -> head_filter pat ref env sigma typ
   | _ -> false
 
 let full_name_of_reference ref =
@@ -151,7 +216,7 @@ let name_of_reference ref = Id.to_string (basename_of_global ref)
 
 let search_about_filter query gr env typ = match query with
 | GlobSearchSubPattern pat ->
-  Constr_matching.is_matching_appsubterm ~closed:false env Evd.empty pat typ
+  Constr_matching.is_matching_appsubterm ~closed:false env Evd.empty pat (EConstr.of_constr typ)
 | GlobSearchString s ->
   String.string_contains ~where:(name_of_reference gr) ~what:s
 
@@ -162,7 +227,7 @@ let search_pattern gopt pat mods pr_search =
   let blacklist_filter = blacklist_filter_aux () in
   let filter ref env typ =
     module_filter mods ref env typ &&
-    pattern_filter pat ref env typ &&
+    pattern_filter pat ref env Evd.empty (* FIXME *) (EConstr.of_constr typ) &&
     blacklist_filter ref env typ
   in
   let iter ref env typ =
@@ -186,8 +251,8 @@ let search_rewrite gopt pat mods pr_search =
   let blacklist_filter = blacklist_filter_aux () in
   let filter ref env typ =
     module_filter mods ref env typ &&
-    (pattern_filter pat1 ref env typ ||
-       pattern_filter pat2 ref env typ) &&
+    (pattern_filter pat1 ref env Evd.empty (* FIXME *) (EConstr.of_constr typ) ||
+       pattern_filter pat2 ref env Evd.empty (EConstr.of_constr typ)) &&
     blacklist_filter ref env typ
   in
   let iter ref env typ =
@@ -201,7 +266,7 @@ let search_by_head gopt pat mods pr_search =
   let blacklist_filter = blacklist_filter_aux () in
   let filter ref env typ =
     module_filter mods ref env typ &&
-    head_filter pat ref env typ &&
+    head_filter pat ref env Evd.empty (* FIXME *) (EConstr.of_constr typ) &&
     blacklist_filter ref env typ
   in
   let iter ref env typ =
@@ -265,12 +330,12 @@ let interface_search =
       toggle (Str.string_match regexp id 0) flag
     in
     let match_type (pat, flag) =
-      toggle (Constr_matching.is_matching env Evd.empty pat constr) flag
+      toggle (Constr_matching.is_matching env Evd.empty pat (EConstr.of_constr constr)) flag
     in
     let match_subtype (pat, flag) =
       toggle
         (Constr_matching.is_matching_appsubterm ~closed:false 
-	   env Evd.empty pat constr) flag
+	   env Evd.empty pat (EConstr.of_constr constr)) flag
     in
     let match_module (mdl, flag) =
       toggle (Libnames.is_dirpath_prefix_of mdl path) flag
@@ -301,7 +366,7 @@ let interface_search =
     let answer = {
       coq_object_prefix = prefix;
       coq_object_qualid = qualid;
-      coq_object_object = string_of_ppcmds (pr_lconstr_env env Evd.empty constr);
+      coq_object_object = constr;
     } in
     ans := answer :: !ans;
   in
diff --git a/toplevel/search.mli b/vernac/search.mli
index ba3d48ef..a1fb7ed3 100644
--- a/toplevel/search.mli
+++ b/vernac/search.mli
@@ -1,14 +1,15 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
-open Pp
 open Names
-open Term
+open Constr
 open Environ
 open Pattern
 open Globnames
@@ -67,10 +68,18 @@ type 'a coq_object = {
 }
 
 val interface_search : ?glnum:int -> (search_constraint * bool) list ->
-  string coq_object list
+  constr coq_object list
 
 (** {6 Generic search function} *)
 
 val generic_search : int option -> display_function -> unit
 (** This function iterates over all hypothesis of the goal numbered
     [glnum] (if present) and all known declarations. *)
+
+(** {6 Search function modifiers} *)
+
+val prioritize_search : (display_function -> unit) -> display_function -> unit
+(** [prioritize_search iter] iterates over the values of [iter] (seen
+    as a sequence of declarations), in a relevance order. This requires to
+    perform the entire iteration of [iter] before starting streaming. So
+    [prioritize_search] should not be used for low-latency streaming. *)
diff --git a/vernac/topfmt.ml b/vernac/topfmt.ml
new file mode 100644
index 00000000..1d720330
--- /dev/null
+++ b/vernac/topfmt.ml
@@ -0,0 +1,334 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pp
+
+(** Pp control also belongs here as the terminal is private to the toplevel *)
+
+type pp_global_params = {
+  margin : int;
+  max_indent : int;
+  max_depth : int;
+  ellipsis : string }
+
+(* Default parameters of pretty-printing *)
+
+let dflt_gp = {
+  margin     = 78;
+  max_indent = 50;
+  max_depth  = 50;
+  ellipsis   = "..." }
+
+(* A deeper pretty-printer to print proof scripts *)
+
+let deep_gp = {
+  margin     = 78;
+  max_indent = 50;
+  max_depth  = 10000;
+  ellipsis   = "..." }
+
+(* set_gp : Format.formatter -> pp_global_params -> unit
+ * set the parameters of a formatter *)
+
+let set_gp ft gp =
+  Format.pp_set_margin ft gp.margin ;
+  Format.pp_set_max_indent ft gp.max_indent ;
+  Format.pp_set_max_boxes ft gp.max_depth ;
+  Format.pp_set_ellipsis_text ft gp.ellipsis
+
+let set_dflt_gp ft = set_gp ft dflt_gp
+
+let get_gp ft =
+  { margin = Format.pp_get_margin ft ();
+    max_indent = Format.pp_get_max_indent ft ();
+    max_depth = Format.pp_get_max_boxes ft ();
+    ellipsis = Format.pp_get_ellipsis_text ft () }
+
+(* with_fp : 'a pp_formatter_params -> Format.formatter
+ * returns of formatter for given formatter functions *)
+
+let with_fp chan out_function flush_function =
+  let ft = Format.make_formatter out_function flush_function in
+  Format.pp_set_formatter_out_channel ft chan;
+  ft
+
+(* Output on a channel ch *)
+
+let with_output_to ch =
+  let ft = with_fp ch (output_substring ch) (fun () -> flush ch) in
+  set_gp ft deep_gp;
+  ft
+
+let std_ft = ref Format.std_formatter
+let _ = set_dflt_gp !std_ft
+
+let err_ft = ref Format.err_formatter
+let _ = set_gp !err_ft deep_gp
+
+let deep_ft = ref (with_output_to stdout)
+let _ = set_gp !deep_ft deep_gp
+
+(* For parametrization through vernacular *)
+let default = Format.pp_get_max_boxes !std_ft ()
+let default_margin = Format.pp_get_margin !std_ft ()
+
+let get_depth_boxes () = Some (Format.pp_get_max_boxes !std_ft ())
+let set_depth_boxes v =
+  Format.pp_set_max_boxes !std_ft (match v with None -> default | Some v -> v)
+
+let get_margin () = Some (Format.pp_get_margin !std_ft ())
+let set_margin v =
+  let v = match v with None -> default_margin | Some v -> v in
+  Format.pp_set_margin Format.str_formatter v;
+  Format.pp_set_margin !std_ft v;
+  Format.pp_set_margin !deep_ft v;
+  Format.pp_set_margin !err_ft v;
+  (* Heuristic, based on usage: the column on the right of max_indent
+     column is 20% of width, capped to 30 characters *)
+  let m = max (64 * v / 100) (v-30) in
+  Format.pp_set_max_indent Format.str_formatter m;
+  Format.pp_set_max_indent !std_ft m;
+  Format.pp_set_max_indent !deep_ft m;
+  Format.pp_set_max_indent !err_ft m
+
+(** Console display of feedback *)
+
+(** Default tags *)
+module Tag = struct
+
+  let error   = "message.error"
+  let warning = "message.warning"
+  let debug   = "message.debug"
+
+end
+
+let msgnl_with ?pre_hdr fmt strm =
+  pp_with fmt (strm ++ fnl ());
+  Format.pp_print_flush fmt ()
+
+module Emacs = struct
+
+  (* Special chars for emacs, to detect warnings inside goal output *)
+  let quote_warning_start = "<warning>"
+  let quote_warning_end = "</warning>"
+
+  let quote_info_start = "<infomsg>"
+  let quote_info_end = "</infomsg>"
+
+  let quote_emacs q_start q_end msg =
+    hov 0 (seq [str q_start; brk(0,0); msg; brk(0,0); str q_end])
+
+  let quote_warning = quote_emacs quote_warning_start quote_warning_end
+  let quote_info = quote_emacs quote_info_start quote_info_end
+
+end
+
+let  dbg_hdr = tag Tag.debug   (str "Debug:")   ++ spc ()
+let info_hdr = mt ()
+let warn_hdr = tag Tag.warning (str "Warning:") ++ spc ()
+let  err_hdr = tag Tag.error   (str "Error:")   ++ spc ()
+
+let make_body quoter info ?pre_hdr s =
+  pr_opt_no_spc (fun x -> x ++ fnl ()) pre_hdr ++ quoter (hov 0 (info ++ s))
+
+(* The empty quoter *)
+let noq x = x
+(* Generic logger *)
+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)
+  | Warning -> Flags.if_warn (fun () ->
+               msgnl_with !err_ft (make_body warn warn_hdr ?pre_hdr msg)) ()
+  | Error   -> msgnl_with !err_ft (make_body noq   err_hdr ?pre_hdr msg)
+
+(** Standard loggers *)
+
+(* We provide a generic clear_log_backend callback for backends
+   wanting to do cleanup after the print.
+*)
+let std_logger_cleanup = ref (fun () -> ())
+
+let std_logger ?pre_hdr level msg =
+  gen_logger (fun x -> x) (fun x -> x) ?pre_hdr level msg;
+  !std_logger_cleanup ()
+
+(** Color logging. Moved from Ppstyle, it may need some more refactoring  *)
+
+(* Tag map for terminal style *)
+let default_tag_map () = let open Terminal in [
+  (* Local to console toplevel *)
+    "message.error"    , make ~bold:true ~fg_color:`WHITE ~bg_color:`RED ()
+  ; "message.warning"  , make ~bold:true ~fg_color:`WHITE ~bg_color:`YELLOW ()
+  ; "message.debug"    , make ~bold:true ~fg_color:`WHITE ~bg_color:`MAGENTA ()
+  (* Coming from the printer *)
+  ; "constr.evar"      , make            ~fg_color:`LIGHT_BLUE ()
+  ; "constr.keyword"   , make ~bold:true ()
+  ; "constr.type"      , make ~bold:true ~fg_color:`YELLOW ()
+  ; "constr.notation"  , make ~fg_color:`WHITE ()
+  (* ["constr"; "variable"] is not assigned *)
+  ; "constr.reference" , make ~fg_color:`LIGHT_GREEN ()
+  ; "constr.path"      , make ~fg_color:`LIGHT_MAGENTA ()
+  ; "module.definition", make ~bold:true ~fg_color:`LIGHT_RED ()
+  ; "module.keyword"   , make ~bold:true ()
+  ; "tactic.keyword"   , make ~bold:true ()
+  ; "tactic.primitive" , make ~fg_color:`LIGHT_GREEN ()
+  ; "tactic.string"    , make ~fg_color:`LIGHT_RED ()
+  ]
+
+let tag_map = ref CString.Map.empty
+
+let init_tag_map styles =
+  let set accu (name, st) = CString.Map.add name st accu in
+  tag_map := List.fold_left set !tag_map styles
+
+let default_styles () =
+  init_tag_map (default_tag_map ())
+
+let parse_color_config file =
+  let styles = Terminal.parse file in
+  init_tag_map styles
+
+let dump_tags () = CString.Map.bindings !tag_map
+
+(** Not thread-safe. We should put a lock somewhere if we print from
+    different threads. Do we? *)
+let make_style_stack () =
+  (** Default tag is to reset everything *)
+  let empty = Terminal.make () in
+  let default_tag = Terminal.({
+      fg_color = Some `DEFAULT;
+      bg_color = Some `DEFAULT;
+      bold = Some false;
+      italic = Some false;
+      underline = Some false;
+      negative = Some false;
+      prefix = None;
+      suffix = None;
+    })
+  in
+  let style_stack = ref [] in
+  let peek () = match !style_stack with
+  | []      -> default_tag  (** Anomalous case, but for robustness *)
+  | st :: _ -> st
+  in
+  let push tag =
+    let style =
+      try CString.Map.find tag !tag_map
+      with | Not_found -> empty
+    in
+    (** Use the merging of the latest tag and the one being currently pushed.
+    This may be useful if for instance the latest tag changes the background and
+    the current one the foreground, so that the two effects are additioned. *)
+    let style = Terminal.merge (peek ()) style in
+    style_stack := style :: !style_stack;
+    Terminal.eval style
+  in
+  let pop _ = match !style_stack with
+  | []       -> (** Something went wrong, we fallback *)
+                Terminal.eval default_tag
+  | _ :: rem -> style_stack := rem;
+                Terminal.eval (peek ())
+  in
+  let clear () = style_stack := [] in
+  push, pop, clear
+
+let make_printing_functions () =
+  let empty = Terminal.make () in
+  let print_prefix ft tag =
+    let style =
+      try CString.Map.find tag !tag_map
+      with | Not_found -> empty
+    in
+    match style.Terminal.prefix with Some s -> Format.pp_print_string ft s | None -> ()
+  in
+  let print_suffix ft tag =
+    let style =
+      try CString.Map.find tag !tag_map
+      with | Not_found -> empty
+    in
+    match style.Terminal.suffix with Some s -> Format.pp_print_string ft s | None -> ()
+  in
+  print_prefix, print_suffix
+
+let init_terminal_output ~color =
+  let push_tag, pop_tag, clear_tag = make_style_stack () in
+  let print_prefix, print_suffix = make_printing_functions () in
+  let tag_handler ft = {
+    Format.mark_open_tag   = push_tag;
+    Format.mark_close_tag  = pop_tag;
+    Format.print_open_tag  = print_prefix ft;
+    Format.print_close_tag = print_suffix ft;
+  } in
+  if color then
+    (* Use 0-length markers *)
+    begin
+      std_logger_cleanup := clear_tag;
+      Format.pp_set_mark_tags !std_ft true;
+      Format.pp_set_mark_tags !err_ft true
+    end
+  else
+    (* Use textual markers *)
+    begin
+      Format.pp_set_print_tags !std_ft true;
+      Format.pp_set_print_tags !err_ft true
+    end;
+  Format.pp_set_formatter_tag_functions !std_ft (tag_handler !std_ft);
+  Format.pp_set_formatter_tag_functions !err_ft (tag_handler !err_ft)
+
+(* Rules for emacs:
+   - Debug/info: emacs_quote_info
+   - Warning/Error: emacs_quote_err
+   - Notice: unquoted
+ *)
+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
+    match fname with
+    | Loc.ToplevelInput ->
+      Loc.(str"Toplevel input, characters " ++ int loc.bp ++
+	   str"-" ++ int loc.ep ++ str":")
+    | 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) ++
+	   str":")
+
+let print_err_exn ?extra any =
+  let (e, info) = CErrors.push any in
+  let loc = Loc.get_loc info in
+  let msg_loc = Option.cata pr_loc (mt ()) loc in
+  let pre_hdr = pr_opt_no_spc (fun x -> x) extra ++ msg_loc in
+  let msg = CErrors.iprint (e, info) ++ fnl () in
+  std_logger ~pre_hdr Feedback.Error msg
+
+let with_output_to_file fname func input =
+  let channel = open_out (String.concat "." [fname; "out"]) in
+  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
+    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
+    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/topfmt.mli b/vernac/topfmt.mli
new file mode 100644
index 00000000..579b456a
--- /dev/null
+++ b/vernac/topfmt.mli
@@ -0,0 +1,62 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Console printing options *)
+
+type pp_global_params = {
+  margin : int;
+  max_indent : int;
+  max_depth : int;
+  ellipsis : string }
+
+val dflt_gp : pp_global_params
+val deep_gp : pp_global_params
+val set_gp : Format.formatter -> pp_global_params -> unit
+val set_dflt_gp : Format.formatter -> unit
+val get_gp : Format.formatter -> pp_global_params
+
+(** {6 Output functions of pretty-printing. } *)
+
+val with_output_to : out_channel -> Format.formatter
+
+val std_ft  : Format.formatter ref
+val err_ft  : Format.formatter ref
+val deep_ft : Format.formatter ref
+
+(** {6 For parametrization through vernacular. } *)
+
+val set_depth_boxes : int option -> unit
+val get_depth_boxes : unit -> int option
+
+val set_margin : int option -> unit
+val get_margin : unit -> int option
+
+(** Console display of feedback, we may add some location information *)
+val std_logger   : ?pre_hdr:Pp.t -> Feedback.level -> Pp.t -> unit
+val emacs_logger : ?pre_hdr:Pp.t -> Feedback.level -> Pp.t -> unit
+
+(** Color output *)
+val default_styles : unit -> unit
+val parse_color_config : string -> unit
+val dump_tags : unit -> (string * Terminal.style) list
+
+(** Initialization of interpretation of tags *)
+val init_terminal_output : color:bool -> unit
+
+(** Error printing *)
+(* To be deprecated when we can fully move to feedback-based error
+   printing. *)
+val pr_loc : Loc.t -> Pp.t
+val print_err_exn : ?extra:Pp.t -> exn -> unit
+
+(** [with_output_to_file file f x] executes [f x] with logging
+    redirected to a file [file] *)
+val with_output_to_file : string -> ('a -> 'b) -> 'a -> 'b
+
diff --git a/vernac/vernac.mllib b/vernac/vernac.mllib
new file mode 100644
index 00000000..f001b572
--- /dev/null
+++ b/vernac/vernac.mllib
@@ -0,0 +1,26 @@
+Vernacprop
+Proof_using
+Lemmas
+Himsg
+ExplainErr
+Class
+Locality
+Metasyntax
+Auto_ind_decl
+Search
+Indschemes
+DeclareDef
+Obligations
+ComDefinition
+ComAssumption
+ComInductive
+ComFixpoint
+ComProgramFixpoint
+Classes
+Record
+Assumptions
+Vernacstate
+Vernacinterp
+Mltop
+Topfmt
+Vernacentries
diff --git a/toplevel/vernacentries.ml b/vernac/vernacentries.ml
index 41ee165f..fceb0bf3 100644
--- a/toplevel/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -1,26 +1,26 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 (* Concrete syntax of the mathematical vernacular MV V2.6 *)
 
 open Pp
 open CErrors
+open CAst
 open Util
-open Flags
 open Names
 open Nameops
 open Term
-open Pfedit
 open Tacmach
 open Constrintern
 open Prettyp
 open Printer
-open Command
 open Goptions
 open Libnames
 open Globnames
@@ -31,14 +31,17 @@ open Redexpr
 open Lemmas
 open Misctypes
 open Locality
-open Sigma.Notations
+open Vernacinterp
+
+module NamedDecl = Context.Named.Declaration
 
 (** TODO: make this function independent of Ltac *)
 let (f_interp_redexp, interp_redexp_hook) = Hook.make ()
 
 let debug = false
-let prerr_endline x =
-  if debug then prerr_endline (x ()) else ()
+(* XXX Should move to a common library *)
+let vernac_pperr_endline pp =
+  if debug then Format.eprintf "@[%a@]@\n%!" Pp.pp_with (pp ()) else ()
 
 (* Misc *)
 
@@ -56,63 +59,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_constr pprf)
-
-let show_node () =
-  (* spiwack: I'm have little clue what this function used to do. I deactivated it, 
-      could, possibly, be cleaned away. (Feb. 2010) *)
-  ()
-
-let show_thesis () =
-     Feedback.msg_error (anomaly (Pp.str "TODO") )
+  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 = get_pftreestate () in
-  let gls = Proof.V82.subgoals pfts in
-  let sigma = gls.Evd.sigma in
-  Feedback.msg_notice (pr_evars_int sigma 1 (Evarutil.non_instantiated sigma))
+  let pfts = Proof_global.give_me_the_proof () in
+  let gls,_,shelf,givenup,sigma = Proof.proof pfts in
+  pr_evars_int sigma ~shelf ~givenup 1 (Evd.undefined_map sigma)
 
 let show_universes () =
-  let pfts = get_pftreestate () in
-  let gls = Proof.V82.subgoals pfts in
-  let sigma = gls.Evd.sigma in
-  let ctx = Evd.universe_context_set (Evd.nf_constraints sigma) in
-    Feedback.msg_notice (Evd.pr_evar_universe_context (Evd.evar_universe_context sigma));
-    Feedback.msg_notice (str"Normalized constraints: " ++ Univ.pr_universe_context_set (Evd.pr_evd_level sigma) ctx)
-
-let show_prooftree () =
-  (* Spiwack: proof tree is currently not working *)
-  ()
-
-let enable_goal_printing = ref true
-
-let print_subgoals () =
-  if !enable_goal_printing && is_verbose ()
-  then begin
-    Feedback.msg_notice (pr_open_subgoals ())
-  end
-
-let try_print_subgoals () =
-  try print_subgoals () with Proof_global.NoCurrentProof | UserError _ -> ()
-
-
-  (* Simulate the Intro(s) tactic *)
+  let pfts = Proof_global.give_me_the_proof () in
+  let gls,_,_,_,sigma = Proof.proof pfts in
+  let ctx = Evd.universe_context_set (Evd.minimize_universes sigma) in
+  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 pf = get_pftreestate() in
-  let {Evd.it=gls ; sigma=sigma; } = Proof.V82.subgoals pf in
+  let open EConstr in
+  let pf = Proof_global.give_me_the_proof() 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 (strip_outer_cast (pf_concl gl)) 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
@@ -120,24 +99,40 @@ let show_intro all =
     [Not_found] is raised if the given string isn't the qualid of
     a known inductive type. *)
 
+(*
+
+  HH notes in PR #679:
+
+  The Show Match could also be made more robust, for instance in the
+  presence of let in the branch of a constructor. A
+  decompose_prod_assum would probably suffice for that, but then, it
+  is a Context.Rel.Declaration.t which needs to be matched and not
+  just a pair (name,type).
+
+  Otherwise, this is OK. After all, the API on inductive types is not
+  so canonical in general, and in this simple case, working at the
+  low-level of mind_nf_lc seems reasonable (compared to working at the
+  higher-level of Inductiveops).
+
+*)
+    
 let make_cases_aux glob_ref =
   match glob_ref with
-    | Globnames.IndRef i ->
-	let {Declarations.mind_nparams = np}
-	    , {Declarations.mind_consnames = carr ; Declarations.mind_nf_lc = tarr }
-	      = Global.lookup_inductive i in
-	Util.Array.fold_right2
-	  (fun consname typ l ->
+    | Globnames.IndRef ind ->
+	let {Declarations.mind_nparams = np} , {Declarations.mind_nf_lc = tarr} = Global.lookup_inductive ind in
+	Util.Array.fold_right_i
+	  (fun i typ l ->
 	     let al = List.rev (fst (decompose_prod typ)) in
 	     let al = Util.List.skipn np al in
 	     let rec rename avoid = function
 	       | [] -> []
 	       | (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 consname :: al') :: l)
-	  carr tarr []
+		   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 []
     | _ -> raise Not_found
 
 let make_cases s =
@@ -150,20 +145,20 @@ let make_cases s =
 let show_match id =
   let patterns =
     try make_cases_aux (Nametab.global id)
-    with Not_found -> error "Unknown inductive type."
+    with Not_found -> user_err Pp.(str "Unknown inductive type.")
   in
   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
-  (dir ++ str " " ++ tbrk (0, 0) ++ path)
+  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 =
   let l = Loadpath.get_load_paths () in
@@ -173,9 +168,8 @@ let print_loadpath dir =
     let filter p = is_dirpath_prefix_of dir (Loadpath.logical p) in
     List.filter filter l
   in
-  Pp.t (str "Logical Path:                 " ++
-                tab () ++ str "Physical path:" ++ fnl () ++
-                prlist_with_sep fnl print_path_entry l)
+  str "Logical Path / Physical path:" ++ fnl () ++
+    prlist_with_sep fnl print_path_entry l
 
 let print_modules () =
   let opened = Library.opened_libraries ()
@@ -185,34 +179,34 @@ 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 =
-  let (loc,qid) = qualid_of_reference r in
+  let qid = qualid_of_reference r in
   try
-    let globdir = Nametab.locate_dir qid in
+    let globdir = Nametab.locate_dir qid.v 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.v)
 
 let print_modtype r =
-  let (loc,qid) = qualid_of_reference r in
+  let qid = qualid_of_reference r in
   try
-    let kn = Nametab.locate_modtype qid in
-    Feedback.msg_notice (Printmod.print_modtype kn)
+    let kn = Nametab.locate_modtype qid.v in
+    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)
+      let mp = Nametab.locate_module qid.v in
+      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.v)
 
 let print_namespace ns =
   let ns = List.rev (Names.DirPath.repr ns) in
@@ -259,14 +253,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 = Typeops.type_of_constant_type (Global.env ()) body.Declarations.const_type in
-    print_kn k ++ str":" ++ spc() ++ Printer.pr_type t
+    let t = body.Declarations.const_type in
+    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
@@ -274,14 +269,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
@@ -311,16 +306,16 @@ 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
     | VarRef id -> VarKey id
     | ConstRef cst -> ConstKey cst
-    | IndRef _ | ConstructRef _ -> error "The reference is not unfoldable"
+    | 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
@@ -354,7 +349,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 ();
@@ -369,58 +364,55 @@ 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 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
-    (loc,"locate_library",
-     strbrk "Cannot find a physical path bound to logical path matching suffix " ++
-       pr_dirpath dir ++ prefix)
+  user_err ?loc
+    ~hdr:"locate_library"
+    (strbrk "Cannot find a physical path bound to logical path matching suffix " ++
+       DirPath.print dir ++ prefix)
 
-let err_notfound_library loc ?from qid =
+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
-    (loc,"locate_library",
-     strbrk "Unable to locate library " ++ pr_qualid qid ++ prefix)
+  user_err ?loc ~hdr:"locate_library"
+     (strbrk "Unable to locate library " ++ pr_qualid qid ++ prefix)
 
 let print_located_library r =
-  let (loc,qid) = qualid_of_reference r in
+  let {loc;v=qid} = qualid_of_reference r in
   try msg_found_library (Library.locate_qualified_library ~warn:false qid)
   with
-    | Library.LibUnmappedDir -> err_unmapped_library loc qid
-    | Library.LibNotFound -> err_notfound_library loc qid
+    | Library.LibUnmappedDir -> err_unmapped_library ?loc qid
+    | Library.LibNotFound -> err_notfound_library ?loc qid
 
 let smart_global r =
   let gr = Smartlocate.smart_global r in
-    Dumpglob.add_glob (Constrarg.loc_of_or_by_notation loc_of_reference r) gr;
-    gr
+  Dumpglob.add_glob ?loc:r.loc gr;
+  gr
 
 let dump_global r =
   try
     let gr = Smartlocate.smart_global r in
-    Dumpglob.add_glob (Constrarg.loc_of_or_by_notation loc_of_reference r) gr
+    Dumpglob.add_glob ?loc:r.loc gr
   with e when CErrors.noncritical e -> ()
 (**********)
 (* 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
@@ -429,21 +421,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 *)
@@ -454,17 +446,20 @@ 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
-          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)
-          in Evd.set_universe_context sigma ctx, c
+          in Evd.set_universe_context sigma ctx, EConstr.of_constr c
         with Logic_monad.TacticFailure e when Logic.catchable_exception e ->
-          error "The statement obligations could not be resolved \
-                 automatically, write a statement definition first."
+          user_err Pp.(str "The statement obligations could not be resolved \
+                 automatically, write a statement definition first.")
       in Some hook
     else None
   in
@@ -479,87 +474,98 @@ 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,None)] 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 lettop =
-  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;
-  if not(refining ()) then
-    if lettop then
-      errorlabstrm "Vernacentries.StartProof"
-	(str "Let declarations can only be used in proof editing mode.");
-  start_proof_and_print (local, p, Proof kind) l no_hook
-
-let qed_display_script = ref true
+    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
-  | Proved (_,_) as e ->
-    if is_verbose () && !qed_display_script && !Flags.coqtop_ui then
-      Stm.show_script ?proof ();
-    save_proof ?proof e
-
-  (* A stupid macro that should be replaced by ``Exact c. Save.'' all along
-     the theories [??] *)
+  | Admitted          -> save_proof ?proof Admitted
+  | Proved (_,_) as e -> save_proof ?proof e
 
 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 = by (Tactics.exact_proof c) in
-  save_proof (Vernacexpr.(Proved(Opaque None,None)));
+  let status = Pfedit.by (Tactics.exact_proof c) in
+  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 vernac_record k poly finite struc binders sort nameopt cfs =
+let should_treat_as_cumulative cum poly =
+  if poly then
+    match cum with
+    | GlobalCumulativity | LocalCumulativity -> true
+    | GlobalNonCumulativity | LocalNonCumulativity -> false
+  else
+    match cum with
+    | GlobalCumulativity | GlobalNonCumulativity -> false
+    | LocalCumulativity -> 
+      user_err Pp.(str "The Cumulative prefix can only be used in a polymorphic context.")
+    | LocalNonCumulativity ->
+      user_err Pp.(str "The NonCumulative prefix can only be used in a polymorphic context.")
+
+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,poly,finite,struc,binders,cfs,const,sort))
+    ignore(Record.definition_structure (k,is_cumulative,poly,finite,struc,binders,cfs,const,sort))
 
 (** When [poly] is true the type is declared polymorphic. When [lo] is true,
     then the type is declared private (as per the [Private] keyword). [finite]
     indicates whether the type is inductive, co-inductive or
     neither. *)
-let vernac_inductive poly lo finite indl =
+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
@@ -570,45 +576,56 @@ let vernac_inductive poly lo finite indl =
 	| _ -> () (* dumping is done by vernac_record (called below) *) )
       indl;
   match indl with
-  | [ ( _ , _ , _ ,Record, Constructors _ ),_ ] ->
-      CErrors.error "The Record keyword cannot be used to define a variant type. Use Variant instead."
+  | [ ( _ , _ , _ ,(Record|Structure), Constructors _ ),_ ] ->
+      user_err Pp.(str "The Record keyword is for types defined using the syntax { ... }.")
   | [ (_ , _ , _ ,Variant, RecordDecl _),_ ] ->
-      CErrors.error "The Variant keyword cannot be used to define a record type. Use Record instead."
+      user_err Pp.(str "The Variant keyword does not support syntax { ... }.")
   | [ ( id , bl , c , b, RecordDecl (oc,fs) ), [] ] ->
-      vernac_record (match b with Class _ -> Class false | _ -> b)
-       poly finite id bl c oc fs
+      vernac_record cum (match b with Class _ -> Class false | _ -> b)
+       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 (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 _), [] ] ->
-      CErrors.error "Inductive classes not supported"
+      user_err Pp.(str "Inductive classes not supported")
   | [ ( id , bl , c , Class _, _), _ :: _ ] ->
-      CErrors.error "where clause not supported for classes"
+      user_err Pp.(str "where clause not supported for classes")
   | [ ( _ , _ , _ , _, RecordDecl _ ) , _ ] ->
-      CErrors.error "where clause not supported for (co)inductive records"
+      user_err Pp.(str "where clause not supported for (co)inductive records")
   | _ -> let unpack = function
       | ( (false, id) , bl , c , _ , Constructors l ) , ntn  -> ( id , bl , c , l ) , ntn
       | ( (true,_),_,_,_,Constructors _),_ ->
-          CErrors.error "Variant types do not handle the \"> Name\" syntax, which is reserved for records. Use the \":>\" syntax on constructors instead."
-      | _ -> CErrors.error "Cannot handle mutually (co)inductive records."
+          user_err Pp.(str "Variant types do not handle the \"> Name\" syntax, which is reserved for records. Use the \":>\" syntax on constructors instead.")
+      | _ -> user_err Pp.(str "Cannot handle mutually (co)inductive records.")
     in
     let indl = List.map unpack indl in
-    do_mutual_inductive indl 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
@@ -623,139 +640,138 @@ 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 (make ?loc @@ Misctypes.AN (make ?loc @@ Ident 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 (loc, "vernac_universe",
-		  str"Polymorphic universes can only be declared inside sections, " ++
+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 (loc, "vernac_constraint",
-		  str"Polymorphic universe constraints can only be declared"
+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            *)
 
 let vernac_import export refl =
-  Library.import_module export (List.map qualid_of_reference refl);
-  Lib.add_frozen_state ()
+  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
-    error "Modules and Module Types are not allowed inside sections.";
+    user_err Pp.(str "Modules and Module Types are not allowed inside sections.");
   let binders_ast = List.map
    (fun (export,idl,ty) ->
      if not (Option.is_empty export) then
-      error "Arguments of a functor declaration cannot be exported. Remove the \"Export\" and \"Import\" keywords from every functor argument."
+      user_err Pp.(str "Arguments of a functor declaration cannot be exported. Remove the \"Export\" and \"Import\" keywords from every functor argument.")
      else (idl,ty)) binders_ast in
   let mp =
     Declaremods.declare_module Modintern.interp_module_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");
-  Option.iter (fun export -> vernac_import export [Ident (Loc.ghost,id)]) export
+  Dumpglob.dump_moddef ?loc mp "mod";
+  Flags.if_verbose Feedback.msg_info (str "Module " ++ Id.print id ++ str " is declared");
+  Option.iter (fun export -> vernac_import export [make @@ Ident 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
-    error "Modules and Module Types are not allowed inside sections.";
+    user_err Pp.(str "Modules and Module Types are not allowed inside sections.");
   match mexpr_ast_l with
     | [] ->
-       check_no_pending_proofs ();
+       Proof_global.check_no_pending_proof ();
        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");
+       Dumpglob.dump_moddef ?loc mp "mod";
+       Flags.if_verbose Feedback.msg_info
+         (str "Interactive Module " ++ Id.print id ++ str " started");
        List.iter
          (fun (export,id) ->
            Option.iter
-             (fun export -> vernac_import export [Ident (Loc.ghost,id)]) export
+             (fun export -> vernac_import export [make @@ Ident id]) export
          ) argsexport
     | _::_ ->
        let binders_ast = List.map
         (fun (export,idl,ty) ->
           if not (Option.is_empty export) then
-           error "Arguments of a functor definition can be imported only if the definition is interactive. Remove the \"Export\" and \"Import\" keywords from every functor argument."
+           user_err Pp.(str "Arguments of a functor definition can be imported only if the definition is interactive. Remove the \"Export\" and \"Import\" keywords from every functor argument.")
           else (idl,ty)) binders_ast in
        let mp =
          Declaremods.declare_module Modintern.interp_module_ast
 	   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");
-       Option.iter (fun export -> vernac_import export [Ident (Loc.ghost,id)])
+       Dumpglob.dump_moddef ?loc mp "mod";
+       Flags.if_verbose Feedback.msg_info
+	 (str "Module " ++ Id.print id ++ str " is defined");
+       Option.iter (fun export -> vernac_import export [make @@ Ident 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
+  Dumpglob.dump_modref ?loc mp "mod";
+  Flags.if_verbose Feedback.msg_info (str "Module " ++ Id.print id ++ str " is defined");
+  Option.iter (fun export -> vernac_import export [make ?loc @@ Ident 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
-    error "Modules and Module Types are not allowed inside sections.";
+    user_err Pp.(str "Modules and Module Types are not allowed inside sections.");
 
   match mty_ast_l with
     | [] ->
-       check_no_pending_proofs ();
+       Proof_global.check_no_pending_proof ();
        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_modtype Modintern.interp_module_ast
            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");
+       Dumpglob.dump_moddef ?loc mp "modtype";
+       Flags.if_verbose Feedback.msg_info
+	 (str "Interactive Module Type " ++ Id.print id ++ str " started");
        List.iter
          (fun (export,id) ->
            Option.iter
-             (fun export -> vernac_import export [Ident (Loc.ghost,id)]) export
+             (fun export -> vernac_import export [make ?loc @@ Ident id]) export
          ) argsexport
 
     | _ :: _ ->
 	let binders_ast = List.map
           (fun (export,idl,ty) ->
             if not (Option.is_empty export) then
-              error "Arguments of a functor definition can be imported only if the definition is interactive. Remove the \"Export\" and \"Import\" keywords from every functor argument."
+              user_err Pp.(str "Arguments of a functor definition can be imported only if the definition is interactive. Remove the \"Export\" and \"Import\" keywords from every functor argument.")
             else (idl,ty)) binders_ast in
 	let mp =
           Declaremods.declare_modtype Modintern.interp_module_ast
 	    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")
+        Dumpglob.dump_moddef ?loc mp "modtype";
+	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")
+  Dumpglob.dump_modref ?loc mp "modtype";
+  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
@@ -765,22 +781,22 @@ let vernac_include l =
 
 (* Sections *)
 
-let vernac_begin_section (_, id as lid) =
-  check_no_pending_proofs ();
+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,_) =
-  Dumpglob.dump_reference 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) =
-  check_no_pending_proofs ();
+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
   | Lib.OpenedModule (true,_,_,_) -> vernac_end_modtype lid
@@ -789,27 +805,34 @@ let vernac_end_segment (_,id as lid) =
 
 (* Libraries *)
 
+let warn_require_in_section =
+  let name = "require-in-section" in
+  let category = "deprecated" in
+  CWarnings.create ~name ~category
+    (fun () -> strbrk "Use of “Require� inside a section is deprecated.")
+
 let vernac_require from import qidl =
+  if Lib.sections_are_opened () then warn_require_in_section ();
   let qidl = List.map qualid_of_reference qidl in
   let root = match from with
   | None -> None
   | Some from ->
-    let (_, qid) = Libnames.qualid_of_reference from in
-    let (hd, tl) = Libnames.repr_qualid qid in
+    let qid = Libnames.qualid_of_reference from in
+    let (hd, tl) = Libnames.repr_qualid qid.v in
     Some (Libnames.add_dirpath_suffix hd tl)
   in
-  let locate (loc, qid) =
+  let locate {loc;v=qid} =
     try
-      let warn = Flags.is_verbose () in
+      let warn = not !Flags.quiet in
       let (_, dir, f) = Library.locate_qualified_library ?root ~warn qid in
       (dir, f)
     with
-      | Library.LibUnmappedDir -> err_unmapped_library loc ?from:root qid
-      | Library.LibNotFound -> err_notfound_library loc ?from:root qid
+      | Library.LibUnmappedDir -> err_unmapped_library ?loc ?from:root qid
+      | Library.LibNotFound -> err_notfound_library ?loc ?from:root qid
   in
   let modrefl = List.map locate qidl in
   if Dumpglob.dump () then
-    List.iter2 (fun (loc, _) dp -> Dumpglob.dump_libref loc dp "lib") qidl (List.map fst modrefl);
+    List.iter2 (fun {CAst.loc} dp -> Dumpglob.dump_libref ?loc dp "lib") qidl (List.map fst modrefl);
   Library.require_library_from_dirpath modrefl import
 
 (* Coercions and canonical structures *)
@@ -817,32 +840,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 =
@@ -860,35 +884,35 @@ let focus_command_cond = Proof.no_cond command_focus
      there are no more goals to solve. It cannot be a tactic since
      all tactics fail if there are no further goals to prove. *)
 
-let vernac_solve_existential = instantiate_nth_evar_com
+let vernac_solve_existential = Pfedit.instantiate_nth_evar_com
 
 let vernac_set_end_tac tac =
-  if not (refining ()) then
-    error "Unknown command of the non proof-editing mode.";
-  match tac with
-  | Tacexpr.TacId [] -> ()
-  | _ -> set_end_tac tac
+  let env = Genintern.empty_glob_sign (Global.env ()) in
+  let _, tac = Genintern.generic_intern env tac in
+  if not (Proof_global.there_are_pending_proofs ()) then
+    user_err Pp.(str "Unknown command of the non proof-editing mode.");
+  Proof_global.set_endline_tactic tac
     (* TO DO verifier s'il faut pas mettre exist s | TacId s ici*)
 
 let vernac_set_used_variables e =
-  let open Context.Named.Declaration in
   let env = Global.env () in
   let tys =
     List.map snd (Proof.initial_goals (Proof_global.give_me_the_proof ())) in
+  let tys = List.map EConstr.Unsafe.to_constr tys in
   let l = Proof_using.process_expr env e tys in
   let vars = Environ.named_context env in
   List.iter (fun id -> 
-    if not (List.exists (Id.equal id % get_id) vars) then
-      errorlabstrm "vernac_set_used_variables"
-        (str "Unknown variable: " ++ pr_id id))
+    if not (List.exists (NamedDecl.get_id %> Id.equal id) vars) then
+      user_err ~hdr:"vernac_set_used_variables"
+        (str "Unknown variable: " ++ Id.print id))
     l;
-  let _, to_clear = set_used_variables l in
-  let to_clear = List.map snd to_clear in
+  let _, to_clear = Proof_global.set_used_variables l in
+  let to_clear = List.map (fun x -> x.CAst.v) to_clear in
   Proof_global.with_current_proof begin fun _ p ->
     if List.is_empty to_clear then (p, ())
     else
       let tac = Tactics.clear to_clear in
-      fst (solve SelectAll None tac p), ()
+      fst (Pfedit.solve SelectAll None tac p), ()
   end
 
 (*****************************)
@@ -898,9 +922,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)
@@ -908,10 +934,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
@@ -923,46 +950,45 @@ let vernac_chdir = function
 	  (* Cd is typically used to control the output directory of
 	  extraction. A failed Cd could lead to overwriting .ml files
 	  so we make it an error. *)
-	  CErrors.error ("Cd failed: " ^ err)
+	  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 *)
 
 let vernac_write_state file =
-  Pfedit.delete_all_proofs ();
+  Proof_global.discard_all ();
   let file = CUnix.make_suffix file ".coq" in
   States.extern_state file
 
 let vernac_restore_state file =
-  Pfedit.delete_all_proofs ();
+  Proof_global.discard_all ();
   let file = Loadpath.locate_file (CUnix.make_suffix file ".coq") in
   States.intern_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)
@@ -982,7 +1008,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
@@ -992,7 +1018,7 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
   let never_unfold_flag = List.mem `ReductionNeverUnfold flags in
 
   let err_incompat x y =
-    error ("Options \""^x^"\" and \""^y^"\" are incompatible.") in
+    user_err Pp.(str ("Options \""^x^"\" and \""^y^"\" are incompatible.")) in
 
   if assert_flag && rename_flag then
     err_incompat "assert" "rename";
@@ -1007,8 +1033,10 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
 
   let sr = smart_global reference in
   let inf_names =
-    let ty = Global.type_of_global_unsafe sr in
-    Impargs.compute_implicits_names (Global.env ()) ty
+    let ty, _ = Global.type_of_global_in_context (Global.env ()) sr in
+    let env = Global.env () in
+    let sigma = Evd.from_env env in
+    Impargs.compute_implicits_names env sigma (EConstr.of_constr ty)
   in
   let prev_names =
     try Arguments_renaming.arguments_names sr with Not_found -> inf_names
@@ -1021,14 +1049,14 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
   (* Checks *)
 
   let err_extra_args names =
-    errorlabstrm "vernac_declare_arguments"
+    user_err ~hdr:"vernac_declare_arguments"
                  (strbrk "Extra arguments: " ++
-                    prlist_with_sep pr_comma pr_name names ++ str ".")
+                    prlist_with_sep pr_comma Name.print names ++ str ".")
   in
   let err_missing_args names =
-    errorlabstrm "vernac_declare_arguments"
+    user_err ~hdr:"vernac_declare_arguments"
                  (strbrk "The following arguments are not declared: " ++
-                    prlist_with_sep pr_comma pr_name names ++ str ".")
+                    prlist_with_sep pr_comma Name.print names ++ str ".")
   in
 
   let rec check_extra_args extra_args =
@@ -1038,7 +1066,7 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
     | { name = Anonymous; notation_scope = Some _ } :: args ->
        check_extra_args args
     | _ ->
-       error "Extra notation scopes can be set on anonymous and explicit arguments only."
+       user_err Pp.(str "Extra notation scopes can be set on anonymous and explicit arguments only.")
   in
 
   let args, scopes =
@@ -1052,12 +1080,12 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
   in
 
   if Option.cata (fun n -> n > num_args) false nargs_for_red then
-    error "The \"/\" modifier should be put before any extra scope.";
+    user_err Pp.(str "The \"/\" modifier should be put before any extra scope.");
 
   let scopes_specified = List.exists Option.has_some scopes in
   
   if scopes_specified && clear_scopes_flag then
-    error "The \"clear scopes\" flag is incompatible with scope annotations.";
+    user_err Pp.(str "The \"clear scopes\" flag is incompatible with scope annotations.");
 
   let names = List.map (fun { name } -> name) args in
   let names = names :: List.map (List.map fst) more_implicits in
@@ -1082,7 +1110,7 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
     | name1 :: names1, name2 :: names2 ->
        if Name.equal name1 name2 then
          name1 :: names_union names1 names2
-       else error "Argument lists should agree on the names they provide."
+       else user_err Pp.(str "Argument lists should agree on the names they provide.")
   in
 
   let names = List.fold_left names_union [] names in
@@ -1107,21 +1135,21 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
   let renaming_specified = Option.has_some !example_renaming in
 
   if !rename_flag_required && not rename_flag then
-    errorlabstrm "vernac_declare_arguments"
+    user_err ~hdr:"vernac_declare_arguments"
       (strbrk "To rename arguments the \"rename\" flag must be specified."
     ++ spc () ++
        match !example_renaming with
        | None -> mt ()
        | Some (o,n) ->
-          str "Argument " ++ pr_name o ++
-            str " renamed to " ++ pr_name n ++ str ".");
+          str "Argument " ++ Name.print o ++
+            str " renamed to " ++ Name.print n ++ str ".");
 
   let duplicate_names =
     List.duplicates Name.equal (List.filter ((!=) Anonymous) names)
   in
   if not (List.is_empty duplicate_names) then begin
-    let duplicates = prlist_with_sep pr_comma pr_name duplicate_names in
-    errorlabstrm "_" (strbrk "Some argument names are duplicated: " ++ duplicates)
+    let duplicates = prlist_with_sep pr_comma Name.print duplicate_names in
+    user_err (strbrk "Some argument names are duplicated: " ++ duplicates)
   end;
 
   (* Parts of this code are overly complicated because the implicit arguments
@@ -1148,8 +1176,8 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
     (* With the current impargs API, it is impossible to make an originally
        anonymous argument implicit *)
     | Anonymous :: _, (name, _) :: _ ->
-       errorlabstrm "vernac_declare_arguments"
-                    (strbrk"Argument "++ pr_name name ++ 
+       user_err ~hdr:"vernac_declare_arguments"
+                    (strbrk"Argument "++ Name.print name ++ 
                        strbrk " cannot be declared implicit.")
 
     | Name id :: inf_names, (name, impl) :: implicits ->
@@ -1163,10 +1191,10 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
   let implicits_specified = match implicits with [[]] -> false | _ -> true in
 
   if implicits_specified && clear_implicits_flag then
-    error "The \"clear implicits\" flag is incompatible with implicit annotations";
+    user_err Pp.(str "The \"clear implicits\" flag is incompatible with implicit annotations");
 
   if implicits_specified && default_implicits_flag then
-    error "The \"default implicits\" flag is incompatible with implicit annotations";
+    user_err Pp.(str "The \"default implicits\" flag is incompatible with implicit annotations");
 
   let rargs =
     Util.List.map_filter (function (n, true) -> Some n | _ -> None)
@@ -1190,32 +1218,32 @@ 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 (o,k) -> 
+      let scopes = List.map (Option.map (fun {loc;v=k} ->
         try ignore (Notation.find_scope k); k
         with UserError _ ->
-          Notation.find_delimiters_scope o k)) scopes
+          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)
-    | _ -> errorlabstrm ""
+    | _ -> user_err
              (strbrk "Modifiers of the behavior of the simpl tactic "++
               strbrk "are relevant for constants only.")
   end;
@@ -1236,28 +1264,26 @@ 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) t in
+    let t = Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_ctx ctx) 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 _ =
   declare_bool_option
-    { optsync  = false;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "silent";
       optkey   = ["Silent"];
-      optread  = is_silent;
-      optwrite = make_silent }
+      optread  = (fun () -> !Flags.quiet);
+      optwrite = ((:=) Flags.quiet) }
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "implicit arguments";
       optkey   = ["Implicit";"Arguments"];
       optread  = Impargs.is_implicit_args;
@@ -1265,8 +1291,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "strict implicit arguments";
       optkey   = ["Strict";"Implicit"];
       optread  = Impargs.is_strict_implicit_args;
@@ -1274,8 +1299,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "strong strict implicit arguments";
       optkey   = ["Strongly";"Strict";"Implicit"];
       optread  = Impargs.is_strongly_strict_implicit_args;
@@ -1283,8 +1307,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "contextual implicit arguments";
       optkey   = ["Contextual";"Implicit"];
       optread  = Impargs.is_contextual_implicit_args;
@@ -1292,8 +1315,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "implicit status of reversible patterns";
       optkey   = ["Reversible";"Pattern";"Implicit"];
       optread  = Impargs.is_reversible_pattern_implicit_args;
@@ -1301,8 +1323,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "maximal insertion of implicit";
       optkey   = ["Maximal";"Implicit";"Insertion"];
       optread  = Impargs.is_maximal_implicit_args;
@@ -1310,17 +1331,15 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = true; (* remove in 8.8 *)
       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
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "coercion printing";
       optkey   = ["Printing";"Coercions"];
       optread  = (fun () -> !Constrextern.print_coercions);
@@ -1328,8 +1347,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "printing of existential variable instances";
       optkey   = ["Printing";"Existential";"Instances"];
       optread  = (fun () -> !Detyping.print_evar_arguments);
@@ -1337,8 +1355,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "implicit arguments printing";
       optkey   = ["Printing";"Implicit"];
       optread  = (fun () -> !Constrextern.print_implicits);
@@ -1346,8 +1363,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "implicit arguments defensive printing";
       optkey   = ["Printing";"Implicit";"Defensive"];
       optread  = (fun () -> !Constrextern.print_implicits_defensive);
@@ -1355,8 +1371,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "projection printing using dot notation";
       optkey   = ["Printing";"Projections"];
       optread  = (fun () -> !Constrextern.print_projections);
@@ -1364,8 +1379,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "notations printing";
       optkey   = ["Printing";"Notations"];
       optread  = (fun () -> not !Constrextern.print_no_symbol);
@@ -1373,8 +1387,7 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "raw printing";
       optkey   = ["Printing";"All"];
       optread  = (fun () -> !Flags.raw_print);
@@ -1382,35 +1395,33 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "record printing";
-      optkey   = ["Printing";"Records"];
-      optread  = (fun () -> !Flags.record_print);
-      optwrite = (fun b -> Flags.record_print := b) }
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "use of the program extension";
       optkey   = ["Program";"Mode"];
       optread  = (fun () -> !Flags.program_mode);
       optwrite = (fun b -> Flags.program_mode:=b) }
 
+let universe_polymorphism_option_name = ["Universe"; "Polymorphism"]
+
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "universe polymorphism";
-      optkey   = ["Universe"; "Polymorphism"];
+      optkey   = universe_polymorphism_option_name;
       optread  = Flags.is_universe_polymorphism;
       optwrite = Flags.make_universe_polymorphism }
 
 let _ =
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "Polymorphic inductive cumulativity";
+      optkey   = ["Polymorphic"; "Inductive"; "Cumulativity"];
+      optread  = Flags.is_polymorphic_inductive_cumulativity;
+      optwrite = Flags.make_polymorphic_inductive_cumulativity }
+
+let _ =
   declare_int_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "the level of inlining during functor application";
       optkey   = ["Inline";"Level"];
       optread  = (fun () -> Some (Flags.get_inline_level ()));
@@ -1420,56 +1431,39 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "kernel term sharing";
       optkey   = ["Kernel"; "Term"; "Sharing"];
       optread  = (fun () -> !CClosure.share);
       optwrite = (fun b -> CClosure.share := b) }
 
-(* No more undo limit in the new proof engine.
-   The command still exists for compatibility (e.g. with ProofGeneral) *)
-
-let _ =
-  declare_int_option
-    { optsync  = false;
-      optdepr  = true;
-      optname  = "the undo limit (OBSOLETE)";
-      optkey   = ["Undo"];
-      optread  = (fun _ -> None);
-      optwrite = (fun _ -> ()) }
-
 let _ =
-  declare_int_option
-    { optsync  = false;
-      optdepr  = false;
-      optname  = "the hypotheses limit";
-      optkey   = ["Hyps";"Limit"];
-      optread  = Flags.print_hyps_limit;
-      optwrite = Flags.set_print_hyps_limit }
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "display compact goal contexts";
+      optkey   = ["Printing";"Compact";"Contexts"];
+      optread  = (fun () -> Printer.get_compact_context());
+      optwrite = (fun b -> Printer.set_compact_context b) }
 
 let _ =
   declare_int_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "the printing depth";
       optkey   = ["Printing";"Depth"];
-      optread  = Pp_control.get_depth_boxes;
-      optwrite = Pp_control.set_depth_boxes }
+      optread  = Topfmt.get_depth_boxes;
+      optwrite = Topfmt.set_depth_boxes }
 
 let _ =
   declare_int_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "the printing width";
       optkey   = ["Printing";"Width"];
-      optread  = Pp_control.get_margin;
-      optwrite = Pp_control.set_margin }
+      optread  = Topfmt.get_margin;
+      optwrite = Topfmt.set_margin }
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "printing of universes";
       optkey   = ["Printing";"Universes"];
       optread  = (fun () -> !Constrextern.print_universes);
@@ -1477,8 +1471,7 @@ let _ =
      
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "dumping bytecode after compilation";
       optkey   = ["Dump";"Bytecode"];
       optread  = Flags.get_dump_bytecode;
@@ -1486,8 +1479,15 @@ let _ =
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { 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);
@@ -1495,47 +1495,89 @@ let _ =
 
 let _ =
   declare_string_option ~preprocess:CWarnings.normalize_flags_string
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "warnings display";
       optkey   = ["Warnings"];
       optread  = CWarnings.get_flags;
       optwrite = CWarnings.set_flags }
 
-let vernac_set_strategy locality l =
-  let local = make_locality locality in
+let _ =
+  declare_string_option 
+    { optdepr  = false;
+      optname  = "native_compute profiler output";
+      optkey   = ["NativeCompute"; "Profile"; "Filename"];
+      optread  = Nativenorm.get_profile_filename;
+      optwrite = Nativenorm.set_profile_filename }
+
+let _ =
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "enable native compute profiling";
+      optkey   = ["NativeCompute"; "Profiling"];
+      optread  = Nativenorm.get_profiling_enabled;
+      optwrite = Nativenorm.set_profiling_enabled }
+
+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
       | VarRef id -> EvalVarRef id
-      | _ -> error
-          "cannot set an inductive type or a constructor as transparent" in
+      | _ -> user_err Pp.(str
+          "cannot set an inductive type or a constructor as transparent") in
   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
       | VarRef id -> EvalVarRef id
-      | _ -> error
-          "cannot set an inductive type or a constructor as transparent" in
+      | _ -> user_err Pp.(str
+          "cannot set an inductive type or a constructor as transparent") in
   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_append_option locality key s =
-  set_string_option_append_value_gen locality key s
+let get_option_locality export local =
+  if export then
+    if Option.is_empty local then OptExport
+    else user_err Pp.(str "Locality modifiers forbidden with Export")
+  else match local with
+  | Some true -> OptLocal
+  | Some false -> OptGlobal
+  | None -> OptDefault
+
+let vernac_set_option0 ~atts export key opt =
+  let locality = get_option_locality export atts.locality in
+  match opt with
+  | 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_append_option ~atts export key s =
+  let locality = get_option_locality export atts.locality in
+  set_string_option_append_value_gen ~locality key s
+
+let vernac_set_option ~atts export table v = match v with
+| StringValue s ->
+  (* We make a special case for warnings because appending is their
+  natural semantics *)
+  if CString.List.equal table ["Warnings"] then
+    vernac_set_append_option ~atts export table s
+  else
+    let (last, prefix) = List.sep_last table in
+    if String.equal last "Append" && not (List.is_empty prefix) then
+      vernac_set_append_option ~atts export prefix s
+    else
+      vernac_set_option0 ~atts export table v
+| _ -> vernac_set_option0 ~atts export table v
 
-let vernac_unset_option locality key =
-  unset_option_value_gen locality key
+let vernac_unset_option ~atts export key =
+  let locality = get_option_locality export atts.locality in
+  unset_option_value_gen ~locality key
 
 let vernac_add_option key lv =
   let f = function
@@ -1567,115 +1609,135 @@ let vernac_print_option key =
   with Not_found -> error_undeclared_key key
 
 let get_current_context_of_args = function
-  | Some n -> get_goal_context n
-  | None -> get_current_context ()
+  | Some n -> Pfedit.get_goal_context n
+  | None -> Pfedit.get_current_context ()
 
-let vernac_check_may_eval redexp glopt rc =
+let query_command_selector ?loc = function
+  | None -> None
+  | Some (SelectNth n) -> Some n
+  | _ -> user_err ?loc ~hdr:"query_command_selector"
+      (str "Query commands only support the single numbered goal selector.")
+
+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 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 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 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' c then
-      Evarutil.j_nf_evar sigma' (Retyping.get_judgment_of env sigma' c)
+    if Evarutil.has_undefined_evars sigma (EConstr.of_constr c) then
+      Evarutil.j_nf_evar sigma (Retyping.get_judgment_of env sigma (EConstr.of_constr c))
     else
       (* OK to call kernel which does not support evars *)
-      Arguments_renaming.rename_typing env c in
-  match redexp with
+      Termops.on_judgment EConstr.of_constr (Arguments_renaming.rename_typing env c)
+  in
+  let pp = match redexp with
     | None ->
-        let l = Evar.Set.union (Evd.evars_of_term j.Environ.uj_val) (Evd.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 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 env sigma j.Environ.uj_type } in
+        print_judgment env sigma j ++
+        pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma l
     | Some r ->
-        let (sigma',r_interp) = Hook.get f_interp_redexp env sigma' r in
+        let (sigma,r_interp) = Hook.get f_interp_redexp env sigma r in
 	let redfun env evm c =
           let (redfun, _) = reduction_of_red_expr env r_interp in
-          let evm = Sigma.Unsafe.of_evar_map evm in
-          let Sigma (c, _, _) = redfun.Reductionops.e_redfun env evm c in
+          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
+  in
+  pp ++ Printer.pr_universe_ctx_set sigma uctx
 
-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 c = EConstr.to_constr sigma c 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 = get_pftreestate() in
-  let {Evd.it=gls ; sigma=sigma; } = Proof.V82.subgoals pf in
+  let pf = Proof_global.give_me_the_proof() 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 ref_or_by_not glnumopt =
+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
-      | None,AN (Ident (_loc,id)) -> (* goal number not given, catch any failure *)
+      match glnumopt, ref_or_by_not.v with
+      | None,AN {v=Ident id} -> (* goal number not given, catch any failure *)
 	 (try get_nth_goal 1,id with _ -> raise NoHyp)
-      | Some n,AN (Ident (_loc,id)) ->  (* goal number given, catch if wong *)
+      | Some n,AN {v=Ident id} ->  (* goal number given, catch if wong *)
 	 (try get_nth_goal n,id
 	  with
-	    Failure _ -> errorlabstrm "print_about_hyp_globs"
-                           (str "No such goal: " ++ int n ++ str "."))
+	    Failure _ -> user_err ?loc ~hdr:"print_about_hyp_globs"
+                          (str "No such goal: " ++ int n ++ str "."))
       | _ , _ -> raise NoHyp in
     let hyps = pf_hyps gl in
     let decl = Context.Named.lookup id hyps in
     let natureofid = match decl with
                      | LocalAssum _ -> "Hypothesis"
                      | LocalDef (_,bdy,_) ->"Constant (let in)" in
-    v 0 (pr_id id ++ str":" ++ pr_constr (get_type decl) ++ fnl() ++ fnl()
+    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 = 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
@@ -1684,23 +1746,24 @@ let vernac_print = 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 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
@@ -1708,15 +1771,15 @@ let vernac_print = 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 =
-  let (loc,qid) = qualid_of_reference r in
+  let {loc;v=qid} = qualid_of_reference r in
   try Nametab.full_name_module qid
   with Not_found ->
-    user_err_loc (loc, "global_module",
-      str "Module/section " ++ pr_qualid qid ++ str " not found.")
+    user_err ?loc ~hdr:"global_module"
+     (str "Module/section " ++ pr_qualid qid ++ str " not found.")
 
 let interp_search_restriction = function
   | SearchOutside l -> (List.map global_module l, true)
@@ -1724,21 +1787,21 @@ let interp_search_restriction = function
 
 open Search
 
-let interp_search_about_item env =
+let interp_search_about_item env sigma =
   function
   | SearchSubPattern pat ->
-      let _,pat = intern_constr_pattern env pat in
+      let _,pat = intern_constr_pattern env sigma pat in
       GlobSearchSubPattern pat
   | SearchString (s,None) when Id.is_valid s ->
       GlobSearchString s
   | SearchString (s,sc) ->
       try
 	let ref =
-	  Notation.interp_notation_as_global_reference Loc.ghost
+	  Notation.interp_notation_as_global_reference
 	    (fun _ -> true) s sc in
 	GlobSearchSubPattern (Pattern.PRef ref)
       with UserError _ ->
-	errorlabstrm "interp_search_about_item"
+	user_err ~hdr:"interp_search_about_item"
           (str "Unable to interp \"" ++ str s ++ str "\" either as a reference or as an identifier component")
 
 (* 05f22a5d6d5b8e3e80f1a37321708ce401834430 introduced the
@@ -1756,14 +1819,14 @@ let search_output_name_only = ref false
 
 let _ =
   declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
+    { optdepr  = false;
       optname  = "output-name-only search";
       optkey   = ["Search";"Output";"Name";"Only"];
       optread  = (fun () -> !search_output_name_only);
       optwrite = (:=) search_output_name_only }
 
-let vernac_search s gopt r =
+let 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 ->
@@ -1773,49 +1836,49 @@ let vernac_search s gopt r =
     (* if goal selector is given and wrong, then let exceptions be raised. *)
     | Some g -> snd (Pfedit.get_goal_context g) , Some g
   in
-  let get_pattern c = snd (intern_constr_pattern env c) in
+  let get_pattern c = snd (intern_constr_pattern env Evd.(from_env env) c) in
   let pr_search ref env c =
     let pr = pr_global ref in
     let pp = if !search_output_name_only
       then pr
       else begin
-        let pc = pr_lconstr_env env Evd.empty c in
+        let pc = pr_lconstr_env env Evd.(from_env env) c in
         hov 2 (pr ++ str":" ++ spc () ++ pc)
       end
     in Feedback.msg_notice pp
   in
   match s with
   | SearchPattern c ->
-      Search.search_pattern gopt (get_pattern c) r pr_search
+      (Search.search_pattern gopt (get_pattern c) r |> Search.prioritize_search) pr_search
   | SearchRewrite c ->
-      Search.search_rewrite gopt (get_pattern c) r pr_search
+      (Search.search_rewrite gopt (get_pattern c) r |> Search.prioritize_search) pr_search
   | SearchHead c ->
-      Search.search_by_head gopt (get_pattern c) r pr_search
+      (Search.search_by_head gopt (get_pattern c) r |> Search.prioritize_search) pr_search
   | SearchAbout sl ->
-      Search.search_about gopt (List.map (on_snd (interp_search_about_item env)) sl) r 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)
-  | 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)
+      (Search.search_about gopt (List.map (on_snd (interp_search_about_item env Evd.(from_env env))) sl) r |>
+       Search.prioritize_search) pr_search
+
+let vernac_locate = function
+  | LocateAny {v=AN qid}  -> print_located_qualid qid
+  | LocateTerm {v=AN qid} -> print_located_term qid
+  | LocateAny {v=ByNotation (ntn, sc)} (** TODO : handle Ltac notations *)
+  | LocateTerm {v=ByNotation (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 Pfedit.refining () then
-    error "Cannot register a primitive while in proof editing mode.";
-  let t = (Constrintern.global_reference (snd id)) in
-  if not (isConst t) then
-    error "Register inline: a constant is expected";
-  let kn = destConst t in
+ 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 id.v in
+  if not (isConstRef kn) then
+    user_err Pp.(str "Register inline: a constant is expected");
   match r with
-  | RegisterInline -> Global.register_inline (Univ.out_punivs kn)
+  | RegisterInline -> Global.register_inline (destConstRef kn)
 
 (********************)
 (* Proof management *)
@@ -1825,7 +1888,7 @@ let vernac_focus gln =
     match gln with
       | None -> Proof.focus focus_command_cond () 1 p
       | Some 0 ->
-         CErrors.error "Invalid goal number: 0. Goal numbering starts with 1."
+         user_err Pp.(str "Invalid goal number: 0. Goal numbering starts with 1.")
       | Some n ->
          Proof.focus focus_command_cond () n p)
 
@@ -1838,16 +1901,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
-    error "The proof is not fully unfocused."
+    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
@@ -1856,62 +1916,61 @@ 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 ->
     Proof.unfocus subproof_kind p ())
 
-let vernac_bullet (bullet:Proof_global.Bullet.t) =
+let vernac_bullet (bullet : Proof_bullet.t) =
   Proof_global.simple_with_current_proof (fun _ p ->
-    Proof_global.Bullet.put p bullet)
+    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
-  | ShowGoalImplicitly None ->
-      Constrextern.with_implicits msg_notice (pr_open_subgoals ())
-  | ShowGoalImplicitly (Some n) ->
-      Constrextern.with_implicits msg_notice (pr_nth_open_subgoal n)
+    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 ()
-  | ShowNode -> show_node ()
-  | ShowScript -> Stm.show_script ()
   | ShowExistentials -> show_top_evars ()
   | ShowUniverses -> show_universes ()
-  | ShowTree -> show_prooftree ()
   | ShowProofNames ->
-      msg_notice (pr_sequence pr_id (Pfedit.get_all_proof_names()))
+    pr_sequence Id.print (Proof_global.get_all_proof_names())
   | ShowIntros all -> show_intro all
   | ShowMatch id -> show_match id
-  | ShowThesis -> show_thesis ()
-
 
 let vernac_check_guard () =
-  let pts = get_pftreestate () in
+  let pts = Proof_global.give_me_the_proof () in
   let pfterm = List.hd (Proof.partial_proof pts) in
   let message =
     try
       let { Evd.it=gl ; sigma=sigma } = Proof.V82.top_goal pts in
-      Inductiveops.control_only_guard (Goal.V82.env sigma gl)
-	pfterm;
+      Inductiveops.control_only_guard (Goal.V82.env sigma gl) sigma pfterm;
       (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
 
+(* XXX: This won't properly set the proof mode, as of today, it is
+   controlled by the STM. Thus, we would need access information from
+   the classifier. The proper fix is to move it to the STM, however,
+   the way the proof mode is set there makes the task non trivial
+   without a considerable amount of refactoring.
+ *)
 let vernac_load interp fname =
+  if Proof_global.there_are_pending_proofs () then
+    CErrors.user_err Pp.(str "Load is not supported inside proofs.");
   let interp x =
-    let proof_mode = Proof_global.get_default_proof_mode_name () in
-    Proof_global.activate_proof_mode proof_mode;
+    let proof_mode = Proof_global.get_default_proof_mode_name () [@ocaml.warning "-3"] in
+    Proof_global.activate_proof_mode proof_mode [@ocaml.warning "-3"];
     interp x in
   let parse_sentence = Flags.with_option Flags.we_are_parsing
     (fun po ->
@@ -1924,53 +1983,74 @@ 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
-  try while true do interp (snd (parse_sentence input)) done
-  with End_of_input -> ()
+    Pcoq.Gram.parsable ~file:(Loc.InFile longfname) (Stream.of_channel in_chan) in
+  begin
+    try while true do interp (snd (parse_sentence input)) done
+    with End_of_input -> ()
+  end;
+  (* If Load left a proof open, we fail too. *)
+  if Proof_global.there_are_pending_proofs () then
+    CErrors.user_err Pp.(str "Files processed by Load cannot leave open proofs.")
 
 (* "locality" is the prefix "Local" attribute, while the "local" component
  * is the outdated/deprecated "Local" attribute of some vernacular commands
  * still parsed as the obsolete_locality grammar entry for retrocompatibility.
  * loc is the Loc.t of the vernacular command being interpreted. *)
-let interp ?proof ~loc locality poly c =
-  prerr_endline (fun () -> "interpreting: " ^ Pp.string_of_ppcmds (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
-  (* Done later in this file *)
+
+  (* Loading a file requires access to the control interpreter *)
   | VernacLoad _ -> assert false
-  | VernacFail _ -> assert false
-  | VernacTime _ -> assert false
-  | VernacRedirect _ -> assert false
-  | VernacTimeout _ -> assert false
-  | VernacStm _ -> assert false
 
-  | VernacError e -> raise e
+  (* The STM should handle that, but LOAD bypasses the STM... *)
+  | VernacAbortAll    -> CErrors.user_err  (str "AbortAll cannot be used through the Load command")
+  | VernacRestart     -> CErrors.user_err  (str "Restart cannot be used through the Load command")
+  | VernacUndo _      -> CErrors.user_err  (str "Undo cannot be used through the Load command")
+  | VernacUndoTo _    -> CErrors.user_err  (str "UndoTo cannot be used through the Load command")
+  | VernacBacktrack _ -> CErrors.user_err  (str "Backtrack cannot be used through the Load command")
+
+  (* Toplevel control *)
+  | VernacToplevelControl e -> raise e
+
+  (* Resetting *)
+  | VernacResetName _  -> anomaly (str "VernacResetName not handled by Stm.")
+  | VernacResetInitial -> anomaly (str "VernacResetInitial not handled by Stm.")
+  | VernacBack _       -> anomaly (str "VernacBack not handled by Stm.")
+  | VernacBackTo _     -> anomaly (str "VernacBackTo not handled by Stm.")
+
+  (* This one is possible to handle here *)
+  | VernacAbort id    -> CErrors.user_err  (str "Abort cannot be used through the Load command")
 
   (* 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,top) -> vernac_start_proof locality poly k l top
+  | 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 (priv,finite,l) -> vernac_inductive 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) ->
@@ -1991,15 +2071,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 *)
@@ -2009,90 +2089,74 @@ 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 *)
   | VernacWriteState s -> vernac_write_state s
   | VernacRestoreState s -> vernac_restore_state s
 
-  (* Resetting *)
-  | VernacResetName _ -> anomaly (str "VernacResetName not handled by Stm")
-  | VernacResetInitial -> anomaly (str "VernacResetInitial not handled by Stm")
-  | VernacBack _ -> anomaly (str "VernacBack not handled by Stm")
-  | VernacBackTo _ -> anomaly (str "VernacBackTo not handled by Stm")
-
   (* Commands *)
-  | VernacCreateHintDb (dbname,b) -> vernac_create_hintdb locality dbname b
-  | VernacRemoveHints (dbnames,ids) -> vernac_remove_hints locality dbnames ids
-  | 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 (export, key,v) -> vernac_set_option ~atts export key v
+  | VernacUnsetOption (export, key) -> vernac_unset_option ~atts export 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 r g c
-  | VernacDeclareReduction (s,r) -> vernac_declare_reduction locality s r
-  | VernacGlobalCheck c -> vernac_global_check c
-  | VernacPrint p -> vernac_print p
-  | VernacSearch (s,g,r) -> vernac_search 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")
 
-  (* The STM should handle that, but LOAD bypasses the STM... *)
-  | VernacAbort id -> CErrors.errorlabstrm "" (str "Abort cannot be used through the Load command")
-  | VernacAbortAll -> CErrors.errorlabstrm "" (str "AbortAll cannot be used through the Load command")
-  | VernacRestart -> CErrors.errorlabstrm "" (str "Restart cannot be used through the Load command")
-  | VernacUndo _ -> CErrors.errorlabstrm "" (str "Undo cannot be used through the Load command")
-  | VernacUndoTo _ -> CErrors.errorlabstrm "" (str "UndoTo cannot be used through the Load command")
-  | VernacBacktrack _ -> CErrors.errorlabstrm "" (str "Backtrack cannot be used through the Load command")
-  
   (* Proof management *)
-  | VernacGoal t -> vernac_start_proof locality poly Theorem [None,([],t,None)] false
   | 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
-  | VernacProofMode mn -> Proof_global.set_proof_mode mn
-  (* Toplevel control *)
-  | VernacToplevelControl e -> raise e
+  | 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)
-
-  (* Handled elsewhere *)
-  | VernacProgram _
-  | VernacPolymorphic _
-  | VernacLocal _ -> assert false
+  | 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 =
@@ -2111,11 +2175,11 @@ let check_vernac_supports_locality c l =
     | VernacArgumentsScope _ | VernacDeclareImplicits _ | VernacArguments _
     | VernacGeneralizable _
     | VernacSetOpacity _ | VernacSetStrategy _
-    | VernacSetOption _ | VernacSetAppendOption _ | VernacUnsetOption _
+    | VernacSetOption _ | VernacUnsetOption _
     | VernacDeclareReduction _
     | VernacExtend _ 
     | VernacInductive _) -> ()
-  | Some _, _ -> CErrors.error "This command does not support Locality"
+  | Some _, _ -> user_err Pp.(str "This command does not support Locality")
 
 (* Vernaculars that take a polymorphism flag *)
 let check_vernac_supports_polymorphism c p =
@@ -2123,17 +2187,13 @@ let check_vernac_supports_polymorphism c p =
   | None, _ -> ()
   | Some _, (
       VernacDefinition _ | VernacFixpoint _ | VernacCoFixpoint _
-    | VernacAssumption _ | VernacInductive _ 
+    | VernacAssumption _ | VernacInductive _
     | VernacStartTheoremProof _
     | VernacCoercion _ | VernacIdentityCoercion _
     | VernacInstance _ | VernacDeclareInstances _
     | VernacHints _ | VernacContext _
     | VernacExtend _ | VernacUniverse _ | VernacConstraint _) -> ()
-  | Some _, _ -> CErrors.error "This command does not support Polymorphism"
-
-let enforce_polymorphism = function
-  | None -> Flags.is_universe_polymorphism ()
-  | Some b -> Flags.make_polymorphic_flag b; b
+  | Some _, _ -> user_err Pp.(str "This command does not support Polymorphism")
 
 (** A global default timeout, controlled by option "Set Default Timeout n".
     Use "Unset Default Timeout" to deactivate it (or set it to 0). *)
@@ -2142,8 +2202,7 @@ let default_timeout = ref None
 
 let _ =
   Goptions.declare_int_option
-    { Goptions.optsync  = true;
-      Goptions.optdepr  = false;
+    { Goptions.optdepr  = false;
       Goptions.optname  = "the default timeout";
       Goptions.optkey   = ["Default";"Timeout"];
       Goptions.optread  = (fun () -> !default_timeout);
@@ -2158,84 +2217,108 @@ 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
 
-let locate_if_not_already loc (e, info) =
+let locate_if_not_already ?loc (e, info) =
   match Loc.get_loc info with
-  | None -> (e, Loc.add_loc info loc)
-  | Some l -> if Loc.is_ghost l then (e, Loc.add_loc info loc) else (e, info)
+  | None   -> (e, Option.cata (Loc.add_loc info) info loc)
+  | Some l -> (e, info)
 
 exception HasNotFailed
-exception HasFailed of std_ppcmds
+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 ~with_header: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 ->
-          errorlabstrm "Fail" (str "The command has not failed!")
+          user_err ~hdr:"Fail" (str "The command has not failed!")
       | HasFailed msg ->
-          if is_verbose () || !test_mode || !ide_slave then Feedback.msg_info
+          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 {CAst.loc;v=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
-    | VernacProgram c when not isprogcmd -> aux ?locality ?polymorphism true c
-    | VernacProgram _ -> CErrors.error "Program mode specified twice"
-    | VernacLocal (b, c) when Option.is_empty locality -> 
-      aux ~locality:b ?polymorphism isprogcmd c
-    | VernacPolymorphic (b, c) when polymorphism = None -> 
-      aux ?locality ~polymorphism:b isprogcmd c
-    | VernacPolymorphic (b, c) -> CErrors.error "Polymorphism specified twice"
-    | VernacLocal _ -> CErrors.error "Locality specified twice"
-    | VernacStm (Command c) -> aux ?locality ?polymorphism isprogcmd c
-    | VernacStm (PGLast c) -> aux ?locality ?polymorphism isprogcmd c
-    | VernacStm _ -> assert false (* Done by Stm *)
-    | 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)) ->
-         Feedback.with_output_to_file s (aux false) 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
@@ -2244,14 +2327,23 @@ let interp ?(verbosely=true) ?proof (loc,c) =
               | e -> CErrors.noncritical e)
           ->
             let e = CErrors.push reraise in
-            let e = locate_if_not_already loc e 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
 
-let () = Hook.set Stm.interp_hook interp
-let () = Hook.set Stm.with_fail_hook with_fail
+(* 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
new file mode 100644
index 00000000..f6199e82
--- /dev/null
+++ b/vernac/vernacentries.mli
@@ -0,0 +1,42 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Misctypes
+
+val dump_global : Libnames.reference or_by_notation -> unit
+
+(** Vernacular entries *)
+val vernac_require :
+  Libnames.reference option -> bool option -> Libnames.reference list -> unit
+
+(** The main interpretation function of vernacular expressions *)
+val interp :
+  ?verbosely:bool ->
+  ?proof:Proof_global.closed_proof ->
+  st:Vernacstate.t -> Vernacexpr.vernac_control CAst.t -> Vernacstate.t
+
+(** Prepare a "match" template for a given inductive type.
+    For each branch of the match, we list the constructor name
+    followed by enough pattern variables.
+    [Not_found] is raised if the given string isn't the qualid of
+    a known inductive type. *)
+
+val make_cases : string -> string list list
+
+(* 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/toplevel/vernacinterp.ml b/vernac/vernacinterp.ml
index d81e3d6b..1f2d2e4b 100644
--- a/toplevel/vernacinterp.ml
+++ b/vernac/vernacinterp.ml
@@ -1,9 +1,11 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*         *   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)         *)
 (************************************************************************)
 
 open Util
@@ -11,18 +13,28 @@ 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
     Hashtbl.add vernac_tab s (depr, f)
   with Failure _ ->
-    errorlabstrm "vinterp_add"
+    user_err ~hdr:"vinterp_add"
       (str"Cannot add the vernac command " ++ str (fst s) ++ str" twice.")
 
 let overwriting_vinterp_add s f =
@@ -37,7 +49,7 @@ let vinterp_map s =
   try
     Hashtbl.find vernac_tab s
   with Failure _ | Not_found ->
-    errorlabstrm "Vernac Interpreter"
+    user_err ~hdr:"Vernac Interpreter"
       (str"Cannot find vernac command " ++ str (fst s) ++ str".")
 
 let vinterp_init () = Hashtbl.clear vernac_tab
@@ -49,8 +61,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 +74,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
new file mode 100644
index 00000000..935cacf7
--- /dev/null
+++ b/vernac/vernacinterp.mli
@@ -0,0 +1,30 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Interpretation of extended vernac phrases. *)
+
+type deprecation = bool
+
+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 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
new file mode 100644
index 00000000..a837b77a
--- /dev/null
+++ b/vernac/vernacprop.ml
@@ -0,0 +1,60 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* We define some high-level properties of vernacular commands, used
+   mainly by the UI components *)
+
+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 is_navigation_vernac_expr = function
+  | VernacResetInitial
+  | VernacResetName _
+  | VernacBacktrack _
+  | VernacBackTo _
+  | 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
+  | VernacExpr ( _, VernacResetInitial)
+  | VernacExpr (_, VernacResetName _) -> true
+  | _ -> false
+
+let is_debug cmd = match under_control cmd with
+  | VernacSetOption (_, ["Ltac";"Debug"], _) -> true
+  | _ -> false
+
+let is_undo cmd = match under_control cmd with
+  | VernacUndo _ | VernacUndoTo _ -> true
+  | _ -> false
diff --git a/vernac/vernacprop.mli b/vernac/vernacprop.mli
new file mode 100644
index 00000000..8296a039
--- /dev/null
+++ b/vernac/vernacprop.mli
@@ -0,0 +1,28 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* We define some high-level properties of vernacular commands, used
+   mainly by the UI components *)
+
+open Vernacexpr
+
+(* 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 00000000..aa8bcdc3
--- /dev/null
+++ b/vernac/vernacstate.ml
@@ -0,0 +1,43 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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 00000000..b4d478d1
--- /dev/null
+++ b/vernac/vernacstate.mli
@@ -0,0 +1,21 @@
+(************************************************************************)
+(*         *   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          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+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